1 ;;; vc-got.el --- Game of Tree backend for VC        -*- lexical-binding: t; -*-
2 
3 ;; Copyright (C) 2020  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 ;; Backend implementation status
24 ;;
25 ;; Function marked with `*' are required, those with `-' are optional.
26 ;;
27 ;; FUNCTION NAME                        STATUS
28 ;;
29 ;; BACKEND PROPERTIES:
30 ;; * revision-granularity               DONE
31 ;; - update-on-retrieve-tag             XXX: what should this do?
32 ;;
33 ;; STATE-QUERYING FUNCTIONS:
34 ;; * registered                         DONE
35 ;; * state                              DONE
36 ;; - dir-status-files                   DONE
37 ;; - dir-extra-headers                  DONE
38 ;; - dir-printer                        DONE
39 ;; - status-fileinfo-extra              NOT IMPLEMENTED
40 ;; * working-revision                   DONE
41 ;; * checkout-model                     DONE
42 ;; - mode-line-string                   DONE
43 ;;
44 ;; STATE-CHANGING FUNCTIONS:
45 ;; * create-repo                        NOT IMPLEMENTED
46 ;;      I don't think got init does what this function is supposed to
47 ;;      do.
48 ;; * register                           DONE
49 ;; - responsible-p                      DONE
50 ;; - receive-file                       NOT NEEDED, default `register' works fine
51 ;; - unregister                         NOT IMPLEMENTED, no use case
52 ;; * checkin                            DONE
53 ;; * find-revision                      DONE
54 ;; * checkout                           NOT IMPLEMENTED
55 ;;      I'm not sure how to properly implement this.  Does filling
56 ;;      FILE with the find-revision do the trick?  Or use got update?
57 ;; * revert                             DONE
58 ;; - merge-file                         NOT IMPLEMENTED
59 ;; - merge-branch                       DONE
60 ;; - merge-news                         NOT IMPLEMENTED
61 ;; - pull                               DONE
62 ;; - push                               DONE
63 ;;      uses git
64 ;; - steal-lock                         NOT NEEDED, `got' is not using locks
65 ;; - modify-change-comment              NOT IMPLEMENTED
66 ;;      can be implemented via histedit, if I understood correctly
67 ;;      what it is supposed to do.
68 ;; - mark-resolved                      NOT IMPLEMENTED
69 ;; - find-admin-dir                     NOT IMPLEMENTED
70 ;;
71 ;; HISTORY FUNCTIONS
72 ;; * print-log                          DONE
73 ;; * log-outgoing                       DONE
74 ;; * log-incoming                       DONE
75 ;; - log-search                         DONE
76 ;; - log-view-mode                      NOT IMPLEMENTED
77 ;; - show-log-entry                     NOT IMPLEMENTED
78 ;; - comment-history                    NOT IMPLEMENTED
79 ;; - update-changelog                   NOT IMPLEMENTED
80 ;; * diff                               DONE
81 ;; - revision-completion-table          NOT IMPLEMENTED
82 ;; - annotate-command                   DONE
83 ;; - annotate-time                      DONE
84 ;; - annotate-current-time              NOT IMPLEMENTED
85 ;; - annotate-extract-revision-at-line  DONE
86 ;; - region-history                     NOT IMPLEMENTED
87 ;; - region-history-mode                NOT IMPLEMENTED
88 ;; - mergebase                          NOT IMPLEMENTED
89 ;;
90 ;; TAG SYSTEM
91 ;; - create-tag                         NOT IMPLEMENTED
92 ;; - retrieve-tag                       NOT IMPLEMENTED
93 ;;
94 ;; MISCELLANEOUS                        NOT IMPLEMENTED
95 ;; - make-version-backups-p             NOT NEEDED, `got' works fine locally
96 ;; - root                               DONE
97 ;; - ignore                             NOT IMPLEMENTED
98 ;; - ignore-completion-table            NOT IMPLEMENTED
99 ;; - previous-revision                  DONE
100 ;; - next-revision                      DONE
101 ;; - log-edit-mode                      NOT IMPLEMENTED
102 ;; - check-headers                      NOT NEEDED, `got' does not use headers
103 ;; - delete-file                        DONE
104 ;; - rename-file                        NOT NEEDED, `delete' + `register' is enough
105 ;; - find-file-hook                     NOT NEEDED, no need for hooks yet
106 ;; - extra-menu                         NOT IMPLEMENTED, add `import', `integrate', `stage'?
107 ;; - extra-dir-menu                     NOT IMPLEMENTED, same as above
108 ;; - conflicted-files                   DONE
109 ;; - repository-url                     DONE
110 
111 ;; TODO: vc-git has most function that starts with:
112 ;;
113 ;;    (let* ((root (vc-git-root default-directory))
114 ;;           (buffer (format "*vc-git : %s*" (expand-file-name root)))
115 ;;           ...)
116 ;;      ...)
117 ;;
118 ;; we should 1) investigate if also other backends do something like
119 ;; this (or if there is a better way) and 2) try to do the same.
120 
121 ;;; Code:
122 
123 (eval-when-compile
124   (require 'subr-x))
125 
126 (require 'cl-lib)
127 (require 'cl-seq)
128 (require 'seq)
129 (require 'vc)
130 (require 'vc-annotate)
131 
132 ;; FIXME: avoid loading this?  We only need it for
133 ;; vc-dir-filename-mouse-map in our custom printer.
134 (require 'vc-dir)
135 
136 (require 'vc-got-stage)
137 
138 (defgroup vc-got nil
139   "VC GoT backend."
140   :group 'vc)
141 
142 (defcustom vc-got-program "got"
143   "Name of the Got executable (excluding any arguments)."
144   :type 'string)
145 
146 (defcustom vc-got-diff-switches t
147   "String or list of strings specifying switches for Got diff under VC.
148 If nil, use the value of `vc-diff-switches'.  If t, use no switches."
149   :type '(choice (const :tag "Unspecified" nil)
150                  (const :tag "None" t)
151                  (string :tag "Argument String")
152                  (repeat :tag "Argument List" :value ("") string)))
153 
154 ;; helpers
155 (defun vc-got--program-version ()
156   "Return string representing the got version."
157   (let (process-file-side-effects)
158     (with-temp-buffer
159       (vc-got--call "-V")
160       (substring (buffer-string) 4 -1))))
161 
162 (defun vc-got-root (file)
163   "Return the work tree root for FILE, or nil."
164   (or (vc-file-getprop file 'got-root)
165       (vc-file-setprop file 'got-root (vc-find-root file ".got"))))
166 
167 (defmacro vc-got-with-worktree (file &rest body)
168   "Evaluate BODY in the work tree directory of FILE."
169   (declare (indent defun))
170   `(when-let (default-directory (vc-got-root ,file))
171      ,@body))
172 
173 (defun vc-got--repo-root ()
174   "Return the path to the repository root.
175 Assume `default-directory' is inside a got worktree."
176   (vc-got-with-worktree default-directory
177     (with-temp-buffer
178       (insert-file-contents ".got/repository")
179       (string-trim (buffer-string) "" "\n"))))
180 
181 (defun vc-got--call (&rest args)
182   "Call `vc-got-program' with ARGS.
183 The output will be placed in the current buffer."
184   (apply #'process-file vc-got-program nil (current-buffer) nil
185          (cl-remove-if #'null (flatten-list args))))
186 
187 (defun vc-got--add (files)
188   "Add FILES to got, passing `vc-register-switches' to the command invocation."
189   (with-temp-buffer
190     (vc-got--call "add" vc-register-switches files)))
191 
192 (defun vc-got--log (&optional path limit start-commit stop-commit
193                               search-pattern reverse)
194   "Execute the log command in the worktree of PATH in the current buffer.
195 LIMIT limits the maximum number of commit returned.
196 
197 START-COMMIT: start traversing history at the specified commit.
198 STOP-COMMIT: stop traversing history at the specified commit.
199 SEARCH-PATTERN: limit to log messages matched by the regexp given.
200 REVERSE: display the log messages in reverse order.
201 
202 Return nil if the command failed or if PATH isn't included in any
203 worktree."
204   (let (process-file-side-effects)
205     (vc-got-with-worktree (or path default-directory)
206       (zerop
207        (vc-got--call "log"
208                      (when limit (list "-l" (format "%s" limit)))
209                      (when start-commit (list "-c" start-commit))
210                      (when stop-commit (list "-x" stop-commit))
211                      (when search-pattern (list "-s" search-pattern))
212                      (when reverse '("-R"))
213                      path)))))
214 
215 (defun vc-got--status (status-codes dir-or-file &rest files)
216   "Return a list of lists '(FILE STATUS STAGE-STATUS).
217 DIR-OR-FILE can be either a directory or a file.  If FILES is
218 given, return the status of those files, otherwise the status of
219 DIR-OR-FILE.  STATUS-CODES is either nil, or a string that's
220 passed as the -s flag to got status to limit the types of status
221 to report (e.g. \"CD\" to report only conflicts and deleted
222 files)."
223   (vc-got-with-worktree dir-or-file
224     (with-temp-buffer
225       (let (process-file-side-effects)
226         (when (zerop (vc-got--call "status"
227                                    (when status-codes (list "-s" status-codes))
228                                    (or files dir-or-file)))
229           (goto-char (point-min))
230           (cl-loop until (eobp)
231                    ;; the format of each line is
232                    ;; <status-char> <stage-char> <spc> <filename> \n
233                    collect (let* ((file-status (prog1 (vc-got--parse-status-char
234                                                        (char-after))
235                                                  (forward-char)))
236                                   (stage-status (prog1 (vc-got--parse-stage-char
237                                                         (char-after))
238                                                   (forward-char)))
239                                   (filename (progn
240                                               (forward-char)
241                                               (buffer-substring (point)
242                                                                 (line-end-position)))))
243                              (list filename
244                                    (or file-status (and stage-status 'staged))
245                                    stage-status))
246                    do (forward-line)))))))
247 
248 (defun vc-got--parse-status-char (c)
249   "Parse status char C into a symbol accepted by `vc-state'."
250   (cl-case c
251     (?M 'edited)
252     (?A 'added)
253     (?D 'removed)
254     (?C 'conflict)
255     (?! 'missing)
256     (?~ 'edited) ; XXX: what does it means for a file to be ``obstructed''?
257     (?? 'unregistered)
258     (?m 'edited) ; modified file modes
259     (?N nil)))
260 
261 (defun vc-got--parse-stage-char (c)
262   "Parse the stage status char C into a symbol."
263   (cl-case c
264     (?M 'edit)
265     (?A 'add)
266     (?D 'remove)))
267 
268 (defun vc-got--tree-parse ()
269   "Parse into an alist the output of got tree -i in the current buffer."
270   (goto-char (point-min))
271   (cl-loop
272    until (= (point) (point-max))
273    collect (let* ((obj-start (point))
274                   (_ (forward-word))
275                   (obj (buffer-substring obj-start (point)))
276                   (_ (forward-char))         ; skip the space
277                   (filename-start (point))
278                   (_ (move-end-of-line nil))
279                   (filename (buffer-substring filename-start (point))))
280              ;; goto the start of the next line
281              (forward-line)
282              (move-beginning-of-line nil)
283              `(,filename . ,obj))))
284 
285 (defun vc-got--tree (commit path)
286   "Return an alist representing the got tree command output.
287 The outputted tree will be localised in the given PATH at the
288 given COMMIT."
289   (vc-got-with-worktree path
290     (let (process-file-side-effects)
291       (with-temp-buffer
292         (when (zerop (vc-got--call "tree" "-c" commit "-i" path))
293           (vc-got--tree-parse))))))
294 
295 (defun vc-got--cat (commit obj-id)
296   "Execute got cat -c COMMIT OBJ-ID in the current buffer."
297   (let (process-file-side-effects)
298     (zerop (vc-got--call "cat" "-c" commit obj-id))))
299 
300 (defun vc-got--revert (&rest files)
301   "Execute got revert FILES."
302   (vc-got-with-worktree (car files)
303     (with-temp-buffer
304       (zerop (vc-got--call "revert" files)))))
305 
306 (defun vc-got--list-branches ()
307   "Return an alist of (branch . commit)."
308   (let (process-file-side-effects)
309     (with-temp-buffer
310       (when (zerop (vc-got--call "branch" "-l"))
311         (goto-char (point-min))
312         (cl-loop
313          until (= (point) (point-max))
314          ;; parse the `* $branchname: $commit', from the end
315          ;; XXX: use a regex?
316          collect (let* ((_ (move-end-of-line nil))
317                         (end-commit (point))
318                         (_ (backward-word))
319                         (start-commit (point))
320                         (_ (backward-char 2))
321                         (end-branchname (point))
322                         (_ (move-beginning-of-line nil))
323                         (_ (forward-char 2))
324                         (start-branchname (point))
325                         (branchname (buffer-substring start-branchname end-branchname))
326                         (commit (buffer-substring start-commit end-commit)))
327                    (forward-line)
328                    (move-beginning-of-line nil)
329                    `(,branchname . ,commit)))))))
330 
331 (defun vc-got--current-branch ()
332   "Return the current branch."
333   (let (process-file-side-effects)
334     (with-temp-buffer
335       (when (zerop (vc-got--call "branch"))
336         (string-trim (buffer-string) "" "\n")))))
337 
338 (defun vc-got--integrate (branch)
339   "Integrate BRANCH into the current one."
340   (with-temp-buffer
341     (zerop (vc-got--call "integrate" branch))))
342 
343 (defun vc-got--diff (&rest args)
344   "Call got diff with ARGS.  The result will be stored in the current buffer."
345   (let (process-file-side-effects)
346     (zerop (vc-got--call "diff"
347                          (vc-switches 'got 'diff)
348                          (mapcar #'file-relative-name args)))))
349 
350 (defun vc-got--unstage (file-or-directory)
351   "Unstage all the staged hunks at or within FILE-OR-DIRECTORY.
352 If it's nil, unstage every staged changes across the entire work
353 tree."
354   (zerop (vc-got--call "unstage" file-or-directory)))
355 
356 (defun vc-got--remove (file &optional force keep-local)
357   "Use got to remove FILE.
358 If FORCE is non-nil perform the operation even if a file contains
359 local modification.  If KEEP-LOCAL is non-nil keep the affected
360 files on disk."
361   (vc-got-with-worktree (or file default-directory)
362     (with-temp-buffer
363       (zerop (vc-got--call "remove"
364                            (when force "-f")
365                            (when keep-local "-k")
366                            file)))))
367 
368 
369 ;; Backend properties
370 
371 (defun vc-got-revision-granularity ()
372   "Got has REPOSITORY granularity."
373   'repository)
374 
375 ;; XXX: what this should do?  The description is not entirely clear
376 (defun vc-got-update-on-retrieve-tag ()
377   nil)
378 
379 
380 ;; State-querying functions
381 
382 ;;;###autoload (defun vc-got-registered (file)
383 ;;;###autoload   "Return non-nil if FILE is registered with got."
384 ;;;###autoload   (when (vc-find-root file ".got")
385 ;;;###autoload     (load "vc-got" nil t)
386 ;;;###autoload     (vc-got-registered file)))
387 
388 (defun vc-got-registered (file)
389   "Return non-nil if FILE is registered with got."
390   (if (file-directory-p file)
391       nil                               ; got doesn't track directories
392     (when (vc-find-root file ".got")
393       (let ((s (vc-got-state file)))
394         (not (or (eq s 'unregistered)
395                  (null s)))))))
396 
397 (defun vc-got-state (file)
398   "Return the current version control state of FILE.  See `vc-state'."
399   (unless (file-directory-p file)
400     (let (process-file-side-effects)
401       ;; Manually calling got status and checking the result inline to
402       ;; avoid building the data structure in vc-got--status.
403       (with-temp-buffer
404         (when (zerop (vc-got--call "status" file))
405           (goto-char (point-min))
406           (if (eobp)
407               'up-to-date
408             (vc-got--parse-status-char (char-after))))))))
409 
410 (defun vc-got--dir-filter-files (files)
411   "Remove ., .. and .got from FILES."
412   (cl-loop for file in files
413            unless (or (string= file "..")
414                       (string= file ".")
415                       (string= file ".got"))
416            collect file))
417 
418 (defun vc-got-dir-status-files (dir files update-function)
419   "Build the status for FILES in DIR.
420 The builded result is given to the callback UPDATE-FUNCTION.  If
421 FILES is nil, consider all the files in DIR."
422   (let* ((fs (vc-got--dir-filter-files (or files (directory-files dir))))
423          ;; XXX: we call with files, wich will probably be nil on the
424          ;; first run, so we catch deleted, missing and edited files
425          ;; in subdirectories.
426          (res (vc-got--status nil dir files))
427          double-check)
428     (cl-loop for file in fs
429              do (when (and (not (cdr (assoc file res #'string=)))
430                            (not (file-directory-p file))
431                            ;; if file doesn't exists, it's a
432                            ;; untracked file that was removed.
433                            (file-exists-p file))
434                   ;; if we don't know the status of a file here, it's
435                   ;; either up-to-date or ignored.  Save it for a
436                   ;; double check
437                   (push file double-check)))
438     (cl-loop with statuses = (vc-got--status nil dir double-check)
439              for file in double-check
440              unless (eq 'unregistered (cadr (assoc file statuses #'string=)))
441              do (push (list file 'up-to-date nil) res))
442     (funcall update-function res nil)))
443 
444 (defun vc-got-dir-extra-headers (dir)
445   "Return a string for the `vc-dir' buffer heading for directory DIR."
446   (let ((remote (vc-got-repository-url dir)))
447     (concat (propertize "Repository : " 'face 'font-lock-type-face)
448             (vc-got--repo-root) "\n"
449             (when remote
450               (concat
451                (propertize "Remote URL : " 'face 'font-lock-type-face)
452                (vc-got-repository-url dir) "\n"))
453             (propertize "Branch     : " 'face 'font-lock-type-face)
454             (vc-got--current-branch))))
455 
456 (defun vc-got-dir-printer (info)
457   "Pretty-printer for the vc-dir-fileinfo structure INFO."
458   (let* ((isdir (vc-dir-fileinfo->directory info))
459          (state (if isdir "" (vc-dir-fileinfo->state info)))
460          (stage-state (vc-dir-fileinfo->extra info))
461          (filename (vc-dir-fileinfo->name info)))
462     (insert
463      (propertize
464       (format "%c" (if (vc-dir-fileinfo->marked info) ?* ? ))
465       'face 'font-lock-type-face)
466      " "
467      (propertize
468       (if stage-state
469           (format "staged:%-6s" stage-state)
470         (format "%-13s" ""))
471       'face (cond ((memq stage-state '(add edit)) 'font-lock-constant-face)
472                   ((eq stage-state 'remove) 'font-lock-warning-face)
473                   (t 'font-lock-variable-name-face)))
474      " "
475      (propertize
476       (format "%-14s" state)
477       'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
478                   ((memq state '(missing conflict)) 'font-lock-warning-face)
479                   ((eq state 'edited) 'font-lock-constant-face)
480                   (t 'font-lock-variable-name-face))
481       'mouse-face 'highlight)
482      " "
483      (propertize
484       (format "%s" filename)
485       'face
486       (if isdir 'font-lock-comment-delimiter-face 'font-lock-function-name-face)
487       'help-echo
488       (if isdir
489           "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
490         "File\nmouse-3: Pop-up menu")
491       'mouse-face 'highlight
492       'keymap vc-dir-filename-mouse-map))))
493 
494 (defun vc-got-working-revision (file)
495   "Return the id of the last commit that touched the FILE or \"0\" for a new (but added) file."
496   (or
497    (with-temp-buffer
498      (when (vc-got--log file 1)
499        (let (start)
500          (goto-char (point-min))
501          (forward-line 1)               ; skip the ----- line
502          (forward-word)                 ; skip "commit"
503          (forward-char)                 ; skip the space
504          (setq start (point))           ; store start of the SHA
505          (forward-word)                 ; goto SHA end
506          (buffer-substring start (point)))))
507    ;; special case: if this file is added but has no previous commits
508    ;; touching it, got log will fail (as expected), but we have to
509    ;; return "0".
510    (when (eq (vc-got-state file) 'added)
511      "0")))
512 
513 (defun vc-got-checkout-model (_files)
514   "Got uses an implicit checkout model for every file."
515   'implicit)
516 
517 (defun vc-got-mode-line-string (file)
518   "Return the VC mode line string for FILE."
519   (vc-got-with-worktree file
520     (let ((def (vc-default-mode-line-string 'Got file)))
521       (concat (substring def 0 4) (vc-got--current-branch)))))
522 
523 
524 ;; state-changing functions
525 
526 (defun vc-got-create-repo (_backend)
527   (error "vc got: create-repo not implemented"))
528 
529 (defun vc-got-register (files &optional _comment)
530   "Register FILES, passing `vc-register-switches' to the backend command."
531   (vc-got--add files))
532 
533 (defalias 'vc-got-responsible-p #'vc-got-root)
534 
535 ;; XXX: generally speaking, files cannot be nil.  But we have to
536 ;; handle that case too, because vc-got-stage-commit will call
537 ;; vc-got-checkin with fileset nil to commit the current staged hunks.
538 (defun vc-got-checkin (files comment &optional _rev)
539   "Commit FILES with COMMENT as commit message."
540   (with-temp-buffer
541     (vc-got--call "commit" "-m"
542                   ;; emacs add ``Summary:'' at the start of the commit
543                   ;; message.  vc-git doesn't seem to treat this specially.
544                   ;; Since it's annoying, remove it.
545                   (string-remove-prefix "Summary: " comment)
546                   files)))
547 
548 (defun vc-got-find-revision (file rev buffer)
549   "Fill BUFFER with the content of FILE in the given revision REV."
550   (when-let (obj-id (assoc file (vc-got--tree rev file) #'string=))
551     (with-current-buffer buffer
552       (vc-got-with-worktree file
553         (vc-got--cat rev obj-id)))))
554 
555 (defun vc-got-find-ignore-file (file)
556   "Return the gitignore file that controls FILE."
557   (expand-file-name ".gitignore"
558                     (vc-got-root file)))
559 
560 (defun vc-got-checkout (_file &optional _rev)
561   "Checkout revision REV of FILE.
562 If REV is t, checkout from the head."
563   (error "vc got: checkout not implemented"))
564 
565 (defun vc-got-revert (file &optional _content-done)
566   "Revert FILE back to working revision."
567   (vc-got--revert file))
568 
569 (defun vc-got-merge-branch ()
570   "Prompt for a branch and integrate it into the current one."
571   ;; XXX: be smart and try to "got rebase" if "got integrate" fails?
572   (let* ((branches (cl-loop for (branch . commit) in (vc-got--list-branches)
573                             collect branch))
574          (branch (completing-read "Merge from branch: " branches)))
575     (when branch
576       (vc-got--integrate branch))))
577 
578 (defun vc-got--push-pull (cmd op prompt root)
579   "Execute CMD OP, or prompt the user if PROMPT is non-nil.
580 ROOT is the worktree root."
581   (let ((buffer (format "*vc-got : %s*" (expand-file-name root))))
582     (when-let (cmd (if prompt
583                        (split-string
584                         (read-shell-command (format "%s %s command: " cmd op)
585                                             (format "%s %s" cmd op))
586                         " " t)
587                      (list cmd op)))
588       (apply #'vc-do-command buffer 0 (car cmd) nil (cdr cmd)))))
589 
590 (defun vc-got-pull (prompt)
591   "Execute got pull, prompting the user for the full command if PROMPT is not nil."
592   (vc-got--push-pull vc-got-program "fetch" prompt (vc-got-root default-directory)))
593 
594 (defun vc-got-push (prompt)
595   "Run git push (not got!) in the repository dir.
596 If PROMPT is non-nil, prompt for the git command to run."
597   (let* ((root (vc-got-root default-directory))
598          (default-directory (vc-got--repo-root)))
599     (vc-got--push-pull "git" "push" prompt root)))
600 
601 (defun vc-got-print-log (files buffer &optional _shortlog start-revision limit)
602   "Insert the revision log for FILES into BUFFER.
603 LIMIT limits the number of commits, optionally starting at
604 START-REVISION."
605   (with-current-buffer buffer
606     ;; the *vc-diff* may be read only
607     (let ((inhibit-read-only t))
608       (cl-loop for file in files
609                do (vc-got--log (file-relative-name file) limit start-revision)))))
610 
611 ;; XXX: this includes also the latest commit in REMOTE-LOCATION.
612 (defun vc-got-log-outgoing (buffer remote-location)
613   "Fill BUFFER with the diff between the local worktree branch and REMOTE-LOCATION."
614   (vc-setup-buffer buffer)
615   (let ((rl (if (or (not remote-location) (string-empty-p remote-location))
616                 (concat "origin/" (vc-got--current-branch))
617               remote-location))
618         (inhibit-read-only t))
619     (with-current-buffer buffer
620       (vc-got--log nil nil nil rl))))
621 
622 (defun vc-got-incoming (buffer remote-location)
623   "Fill BUFFER with the diff between the REMOTE-LOCATION and the local worktree branch."
624   (let ((rl (if (or (not remote-location) (string-empty-p remote-location))
625                 (concat "origin/" (vc-got--current-branch))
626               remote-location))
627         (inhibit-read-only t))
628     (with-current-buffer buffer
629       (vc-got--log nil nil (vc-got--current-branch) rl))))
630 
631 (defun vc-got-log-search (buffer pattern)
632   "Search commits for PATTERN and write the results found in BUFFER."
633   (with-current-buffer buffer
634     (let ((inhibit-read-only t))
635       (vc-got--log nil nil nil nil pattern))))
636 
637 ;; TODO: async
638 ;; TODO: return 0 or 1
639 (defun vc-got-diff (files &optional rev1 rev2 buffer _async)
640   "Insert into BUFFER (or *vc-diff*) the diff for FILES from REV1 to REV2."
641   (let* ((buffer (get-buffer-create (or buffer "*vc-diff*")))
642          (inhibit-read-only t))
643     (with-current-buffer buffer
644       (vc-got-with-worktree (car files)
645         (cond ((and (null rev1)
646                     (null rev2))
647                (dolist (file files)
648                  (vc-got--diff file)))
649               (t (error "Not implemented")))))))
650 
651 (defun vc-got-annotate-command (file buf &optional rev)
652   "Show annotated contents of FILE in buffer BUF.  If given, use revision REV."
653   (let (process-file-side-effects)
654     (with-current-buffer buf
655       ;; FIXME: vc-ensure-vc-buffer won't recognise this buffer as managed
656       ;; by got unless vc-parent-buffer points to a buffer managed by got.
657       ;; investigate why this is needed.
658       (set (make-local-variable 'vc-parent-buffer) (find-file-noselect file))
659       (vc-got--call "blame"
660                     (when rev (list "-c" rev))
661                     file))))
662 
663 (defconst vc-got--annotate-re
664   (concat "^[0-9]\\{1,\\}) " ; line number followed by )
665           "\\([a-z0-9]+\\) " ; SHA-1 of commit
666           "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\) " ; year-mm-dd
667           "\\([^ ]\\)+ ")    ; author
668   "Regexp to match annotation output lines.
669 
670 Provides capture groups for:
671 1. revision id
672 2. date of commit
673 3. author of commit")
674 
675 (defconst vc-got--commit-re "^commit \\([a-z0-9]+\\)"
676   "Regexp to match commit lines.
677 
678 Provides capture group for the commit revision id.")
679 
680 (defun vc-got-annotate-time ()
681   "Return the time of the next line of annotation at or after point.
682 Value is returned as floating point fractional number of days."
683   (save-excursion
684     (beginning-of-line)
685     (when (looking-at vc-got--annotate-re)
686       (let ((str (match-string-no-properties 2)))
687         (vc-annotate-convert-time
688          (encode-time 0 0 0
689                       (string-to-number (substring str 8 10))
690                       (string-to-number (substring str 5 7))
691                       (string-to-number (substring str 0 4))))))))
692 
693 (defun vc-got-annotate-extract-revision-at-line ()
694   "Return revision corresponding to the current line or nil."
695   (save-excursion
696     (beginning-of-line)
697     (when (looking-at vc-got--annotate-re)
698       (match-string-no-properties 1))))
699 
700 (defun vc-got-previous-revision (file rev)
701   "Return the revision number that precedes REV for FILE, or nil if no such revision exists."
702   (with-temp-buffer
703     (vc-got--log file 2 rev nil nil t)
704     (goto-char (point-min))
705     (keep-lines "^commit")
706     (when (looking-at vc-got--commit-re)
707       (match-string-no-properties 1))))
708 
709 (defun vc-got-next-revision (file rev)
710   "Return the revision number that follows REV for FILE, or nil if no such revision exists."
711   (with-temp-buffer
712     (vc-got--log file nil nil rev)
713     (keep-lines "^commit" (point-min) (point-max))
714     (goto-char (point-max))
715     (forward-line -1)    ; return from empty line to last actual commit
716     (unless (= (point) (point-min))
717       (forward-line -1)
718       (when (looking-at vc-got--commit-re)
719         (match-string-no-properties 1)))))
720 
721 (defun vc-got-delete-file (file)
722   "Delete FILE locally and mark it deleted in work tree."
723   (vc-got--remove file t))
724 
725 (defun vc-got-conflicted-files (dir)
726   "Return the list of files with conflicts in directory DIR."
727   (let* ((root (vc-got-root dir))
728          (default-directory root)
729          (process-file-side-effects))
730     (cl-loop with conflicts = nil
731              for (file status _) in (vc-got--status "C" ".")
732              do (when (and (eq status 'conflict)
733                            (file-in-directory-p file dir))
734                   (push file conflicts))
735              finally return conflicts)))
736 
737 (defun vc-got-repository-url (_file &optional remote-name)
738   "Return URL for REMOTE-NAME, or for \"origin\" if nil."
739   (let* ((default-directory (vc-got--repo-root))
740          (remote-name (or remote-name "origin"))
741          (heading (concat "[remote \"" remote-name "\"]"))
742          (conf (cond ((file-exists-p ".git/config") ".git/config")
743                      ((file-exists-p ".git")        nil)
744                      ((file-exists-p "config")      "config")))
745          found)
746     (when conf
747       (with-temp-buffer
748         (insert-file-contents conf)
749         (goto-char (point-min))
750         (when (search-forward heading nil t)
751           (forward-line)
752           (while (and (not found)
753                       (looking-at ".*=") ; too broad?
754                       (not (= (point) (point-max))))
755             (when (looking-at ".*url = \\(.*\\)")
756               (setq found (match-string-no-properties 1)))
757             (forward-line))
758           found)))))
759 
760 
761 ;; hacks
762 (defun vc-got-fix-dir-move-to-goal-column (fn)
763   "Move the cursor on the file column.
764 Adviced around `vc-dir-move-to-goal-column' (FN) because it hardcodes column 25."
765   (if (not (vc-find-root default-directory ".got"))
766       (funcall fn)
767     (beginning-of-line)
768     (unless (eolp)
769       (forward-char 31))))
770 (advice-add 'vc-dir-move-to-goal-column :around #'vc-got-fix-dir-move-to-goal-column)
771 
772 (provide 'vc-got)
773 ;;; vc-got.el ends here