branch: externals/vc-got
commit af5ef7cdaa903853a7c4ec598ecfd78a354513d3
Author: Omar Polo <o...@omarpolo.com>
Commit: Omar Polo <o...@omarpolo.com>
initial commit
All the ``BACKEND PROPERTIES'' and ``STATE-QUERYING FUNCTIONS''
functions are implemented. Why don't we start using them while
developing the rest? :)
---
vc-got.el | 228 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 228 insertions(+)
diff --git a/vc-got.el b/vc-got.el
new file mode 100644
index 0000000..89c6e9b
--- /dev/null
+++ b/vc-got.el
@@ -0,0 +1,228 @@
+;; vc-got.el --- Game of Tree backend for VC -*- lexical-binding: t; -*-
+
+;; Copyright © 2020 Omar Polo <o...@omarpolo.com>
+
+;; This file is not part of GNU Emacs.
+
+;; This file is free software.
+;;
+;; Permission to use, copy, modify, and distribute this software for
+;; any purpose with or without fee is hereby granted, provided that
+;; the above copyright notice and this permission notice appear in all
+;; copies.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+;; Author: Omar Polo <o...@omarpolo.com>
+;; URL: https://git.omarpolo.com/vc-got
+;; Keywords: vc vc-backend
+
+;;; Commentary
+
+;; Backend implementation status
+;;
+;; Function marked with `*' are required, those with `-' are optional.
+;;
+;; FUNCTION NAME STATUS
+;;
+;; BACKEND PROPERTIES:
+;; * revision-granularity DONE
+;; - update-on-retrieve-tag XXX: what should this do?
+;;
+;; STATE-QUERYING FUNCTIONS:
+;; * registered DONE
+;; * state DONE
+;; - dir-status-files DONE
+;; - dir-extra-headers NOT IMPLEMENTED
+;; - dir-printer NOT IMPLEMENTED
+;; - status-fileinfo-extra NOT IMPLEMENTED
+;; * working-revision DONE
+;; * checkout-model DONE
+;; - mode-line-string NOT IMPLEMENTED
+
+;; TODO: use the idiom
+;; (let (process-file-side-effects) ...)
+;; when the got command WON'T change the file. This can enable some
+;; emacs optimizations
+
+;;; Code:
+
+(eval-when-compile
+ (require 'subr-x))
+
+(require 'cl-lib)
+(require 'seq)
+
+(defvar vc-got-cmd "got"
+ "The got command.")
+
+;; helpers
+
+(defun vc-got-root (file)
+ "Return the work tree root for FILE, or nil."
+ (or (vc-file-getprop file 'git-root)
+ (vc-file-setprop file 'git-root (vc-find-root file ".got"))))
+
+(defmacro vc-got-with-worktree (file &rest body)
+ "Evaluate BODY in the work tree directory of FILE."
+ (declare (indent defun))
+ `(when-let (default-directory (vc-got-root ,file))
+ ,@body))
+
+(defun vc-got--call (&rest args)
+ "Call `vc-got-cmd' in the `default-directory' with ARGS and put the output
in the current buffer."
+ (apply #'process-file vc-got-cmd nil (current-buffer) nil args))
+
+(defun vc-got--log (limit path)
+ "Execute the log command in the worktree of PATH, with LIMIT commits, and
put the output in the current buffer.
+
+Return nil if the command failed or if PATH isn't included in any worktree."
+ (vc-got-with-worktree path
+ (zerop (vc-got--call "log" "-l" (format "%s" limit) path))))
+
+(defun vc-got--status (dir-or-file &rest files)
+ "Return the output of ``got status''.
+
+DIR-OR-FILE can be either a directory or a file. If FILES is
+given, return the status of those files, otherwise the status of
+DIR-OR-FILE."
+ (vc-got-with-worktree dir-or-file
+ (with-temp-buffer
+ (if files
+ (apply #'vc-got--call "status" files)
+ (vc-got--call "status" dir-or-file))
+ (buffer-string))))
+
+(defun vc-got--parse-status-flag (flag)
+ "Parse FLAG, see `vc-state'."
+ ;; got outputs nothing if the file is up-to-date
+ (if (string-empty-p flag)
+ 'up-to-date
+ ;; trying to follow the order of the manpage
+ (cl-case (aref flag 0)
+ (?M 'edited)
+ (?A 'added)
+ (?D 'removed)
+ (?C 'conflict)
+ (?! 'missing)
+ (?~ 'edited) ;XXX: what does it means for a file to be ``obstructed''?
+ (?? 'unregistered)
+ (?m 'edited) ;modified file modes
+ (?N nil))))
+
+(defun vc-got--parse-status (output)
+ "Parse the OUTPUT of got status and return an alist of (FILE . STATUS)."
+ ;; XXX: the output of got is line-oriented and will break if
+ ;; filenames contains spaces or newlines.
+ (cl-loop for line in (split-string output "\n" t)
+ collect (cl-destructuring-bind (status file) (split-string line " "
t " ")
+ `(,file . ,(vc-got--parse-status-flag status)))))
+
+
+;; Backend properties
+
+(defun vc-got-revision-granularity ()
+ "Got has REPOSITORY granularity."
+ 'repository)
+
+;; XXX: what this should do? The description is not entirely clear
+(defun vc-got-update-on-retrieve-tag ()
+ nil)
+
+
+;; State-querying functions
+
+;;;###autoload (defun vc-got-registered (file)
+;;;###autoload "Return non-nil if FILE is registered with got."
+;;;###autoload (when (vc-find-root file ".got")
+;;;###autoload (load "vc-got" nil t)
+;;;###autoload (vc-got-registered file)))
+
+(defun vc-got-registered (file)
+ "Return non-nil if FILE is registered with got."
+ (if (file-directory-p file)
+ nil ;got doesn't track directories
+ (let ((status (vc-got--status file)))
+ (not (or (string-prefix-p "?" status)
+ (string-prefix-p "N" status))))))
+
+;; (vc-got-registered "/usr/ports/mystuff/net/td")
+;; (vc-got-registered "/usr/ports/mystuff/net/td/Makefile")
+;; (vc-got-registered "/usr/ports/mystuff/tmp")
+;; (vc-got-registered "/usr/ports/mystuff/no-existant")
+
+(defun vc-got-state (file)
+ "Return the current version control state of FILE. See `vc-state'."
+ (unless (file-directory-p file)
+ (vc-got--parse-status-flag (vc-got--status file))))
+
+;; (vc-got-state "/usr/ports/mystuff/net/td")
+;; (vc-got-state "/usr/ports/mystuff/net/td/Makefile")
+;; (vc-got-state "/usr/ports/mystuff/tmp")
+;; (vc-got-state "/usr/ports/mystuff/non-existant")
+
+(defun vc-got-dir-status-files (dir files update-function)
+ (let* ((files (seq-filter (lambda (file)
+ (and (not (string= file ".."))
+ (not (string= file "."))
+ (not (string= file ".got"))))
+ (or files
+ (directory-files dir))))
+ (statuses (vc-got--parse-status
+ (apply #'vc-got--status dir files)))
+ (default-directory dir))
+ (cl-loop
+ with result = nil
+ for file in files
+ do (setq result
+ (cons
+ (if (file-directory-p file)
+ (list file 'unregistered nil)
+ (if-let (status (cdr (assoc file statuses #'string=)))
+ (list file status nil)
+ (list file 'up-to-date nil)))
+ result))
+ finally (funcall update-function result nil))))
+
+;; (let ((dir "/usr/ports/mystuff"))
+;; (vc-got-dir-status-files dir nil (lambda (res _t)
+;; (message "got %s" res))))
+
+(defun vc-got-working-revision (file)
+ "Return the id of the last commit that touched the FILE.
+
+Return \"0\" for a file added but not yet committed."
+ (or
+ (with-temp-buffer
+ (when (vc-got--log 1 file)
+ (let (start)
+ (goto-char (point-min))
+ (forward-line 1) ;skip the ----- line
+ (forward-word) ;skip "commit"
+ (forward-char) ;skip the space
+ (setq start (point)) ;store start of the SHA
+ (forward-word) ;goto SHA end
+ (buffer-substring start (point)))))
+ ;; special case: if this file is added but has no previous commits
+ ;; touching it, got log will fail (as expected), but we have to
+ ;; return "0".
+ (when (eq (vc-got-state file) 'added)
+ "0")))
+
+;; (vc-got-working-revision "/usr/ports/mystuff/non-existant")
+;; (vc-got-working-revision "/usr/ports/mystuff/CVS")
+;; (vc-got-working-revision "/usr/ports/mystuff/tmp")
+;; (vc-got-working-revision "/usr/ports/mystuff/net/td/Makefile")
+
+(defun vc-got-checkout-model (_files)
+ 'implicit)
+
+(provide 'vc-got)
+;;; vc-got.el ends here
