changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/vc/vc.lisp

changeset 698: 96958d3eb5b0
parent: 35a579313b80
author: Richard Westhaver <ellis@rwest.io>
date: Fri, 04 Oct 2024 22:04:59 -0400
permissions: -rw-r--r--
description: fixes 
     1 ;;; vc/vc.lisp --- VC API
     2 
     3 ;; High-level API for working with VC objects.
     4 
     5 ;;; Code:
     6 (in-package :vc)
     7 (defparameter *default-vc-kind* :hg)
     8 (defvar *repo-roots* nil)
     9 (defvar *repo-registry* (make-hash-table :test 'equal))
    10 
    11 (defun register-repo (repo)
    12   "Register a repo, collecting information from the filesystem and
    13 creating a repo object which is stored in *REPO-REGISTRY*."
    14   (setf (gethash (vc/proto:vc-path repo) *repo-registry*) repo))
    15 
    16 (defun find-repo (name)
    17   "Find a repo in *REPO-REGISTRY*."
    18   (gethash name *repo-registry*))
    19 
    20 (defun make-hg-repo (path &key init update register)
    21   (let ((repo (make-instance 'hg-repo :path path)))
    22     (when init (vc-init repo))
    23     (when update
    24       (setf (vc/hg::vc-requires repo)
    25             (mapcar (lambda (s) (trim s))
    26                     (sb-unicode:lines (vc-run repo "debugrequires")))))
    27     (when register (register-repo repo))
    28     repo))
    29 
    30 (defun make-git-repo (path &key init register)
    31   (let ((repo (make-instance 'git-repo :path path)))
    32     (when init (vc-init repo))
    33     (when register (register-repo repo))
    34     repo))
    35 
    36 (defun make-repo (path &key (type *default-vc-kind*) init register)
    37   (case type
    38     (:hg (make-hg-repo path :init init :register register))
    39     (:git (make-git-repo path :init init :register register))
    40     (t (error "invalid repo type: ~A" type))))
    41 
    42 ;; (defmacro with-hg ((&rest vc-opts) &body body))
    43 
    44 ;; (defmacro with-git ((&rest vc-opts) &body body))
    45 
    46 ;; (defmacro with-repos ((&rest repo-defs) &body body))
    47 
    48 (defun directory-repos (path)
    49   (let ((path (probe-file path)))
    50     (assert (typep path 'directory-pathname))
    51     (loop for p in (directory (merge-pathnames "*/" path))
    52           collect (make-repo p))))
    53 
    54 (defun bundle-repo (path output)
    55   (vc-bundle (make-repo path) output))
    56 
    57 (defun bundle-repos (path output)
    58   (loop for repo in (directory-repos path)
    59         do (let ((out (merge-pathnames output (vc-name repo))))
    60              (vc-bundle repo out))))
    61 
    62 (defun update-repo (repo &optional push (pull t))
    63   (when pull
    64     (vc-pull repo (when (stringp pull) pull)))
    65   (when push
    66     (vc-push repo (when (stringp push) push))))
    67 
    68 (defun update-repos (path &key push (pull t))
    69   (loop for repo in (directory-repos path)
    70         do (update-repo repo push pull)))