├── README.md ├── install-repo.sh ├── repo-index.lisp ├── repo.1.png ├── repo.asd ├── repo.lisp └── repo.png /README.md: -------------------------------------------------------------------------------- 1 | # repo 0.2 2 | 3 | Copyright 2016-2022 kmx.io 4 | 5 | Permission is hereby granted to use this software granted 6 | the above copyright notice and this permission paragraph 7 | are included in all copies and substantial portions of this 8 | software. 9 | 10 | THIS SOFTWARE IS PROVIDED "AS-IS" WITHOUT ANY GUARANTEE OF 11 | PURPOSE AND PERFORMANCE. IN NO EVENT WHATSOEVER SHALL THE 12 | AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF 13 | THIS SOFTWARE. 14 | 15 | 16 | ## Description 17 | 18 | Common interface for version control systems. 19 | 20 | Repo allows you to use source repositories directly as ASDF-installable 21 | packages and keep them synced with upstream for development purposes. 22 | 23 | Each repo is installed in a subdirectory. 24 | Github repositories are installed in the user subdirectory. 25 | 26 | 27 | ## Quickstart 28 | 29 | ``` SH 30 | ftp https://git.kmx.io/kmx.io/repo/_blob/master/install-repo.sh 31 | sh install-repo.sh 32 | ``` 33 | 34 | ``` Common-Lisp 35 | ;; install Thot 36 | (repo:install :thot) 37 | 38 | ;; update ASDF 39 | (repo:update :asdf) 40 | ``` 41 | 42 | 43 | ## Manifest 44 | 45 | https://git.kmx.io/kmx.io/repo/_blob/master/repo.manifest 46 | 47 | 48 | ## Installation 49 | 50 | This is what the `install-repo.sh` script does : 51 | 52 | Install ASDF from git : 53 | 54 | ``` SH 55 | mkdir -p ~/common-lisp/fare 56 | cd ~/common-lisp/fare 57 | git clone https://github.com/fare/asdf.git 58 | cd asdf 59 | make 60 | ``` 61 | 62 | Install REPO from git : 63 | 64 | ``` SH 65 | mkdir -p ~/common-lisp/kmx.io 66 | cd ~/common-lisp/kmx.io 67 | git clone https://git.kmx.io/kmx.io/repo.git 68 | cd ~/common-lisp 69 | ln -s kmx.io/repo/repo.manifest 70 | ``` 71 | 72 | In your Common Lisp implementation startup file : 73 | 74 | ``` Common-Lisp 75 | (load "~/common-lisp/fare/asdf/build/asdf") 76 | (load "~/common-lisp/kmx.io/repo/repo") 77 | (repo:boot) 78 | ``` 79 | 80 | ## Usage 81 | 82 | Repo integrates with ASDF : 83 | 84 | ``` Common-Lisp 85 | (asdf:load-system :thot) 86 | ``` 87 | 88 | To update all repositories : 89 | 90 | ``` Common-Lisp 91 | (repo:update repo:*manifest*) 92 | ``` 93 | 94 | Other functions : 95 | 96 | ``` Common-Lisp 97 | (repo:repo "github:kmx-io/repo") ;; Define repository by URI 98 | 99 | (repo:repo "thodg/repo") ;; Find repository by dir/name 100 | (repo:repo :repo) ;; Find repository by name 101 | 102 | (setf repo:*repo-dir* "/tmp/repo-test") ;; Change installation directory 103 | 104 | (repo:install "github:kmx-io/repo") ;; Install repository by URI 105 | (repo:install "kmx.io/repo") ;; Install repository by dir/name 106 | (repo:install :repo) ;; Install repository by name 107 | 108 | (repo:update "github:kmx-io/repo") ;; Update repository by URI 109 | (repo:update "kmx-io/repo") ;; Update repository by dir/name 110 | (repo:update :repo) ;; Update repository by name 111 | 112 | repo:*repos* ;; List of defined repositories 113 | 114 | (repo:clear-repos) ;; Clear all definitions 115 | ``` 116 | 117 | 118 | ## Version informations 119 | 120 | This version only supports git repositories and relies on /bin/sh. 121 | Next releases will support other VCS / systems. 122 | 123 | SBCL and CLISP are supported. 124 | 125 | ## TODO 126 | 127 | * use UIOP:RUN-PROGRAM 128 | * git tags and branches 129 | * CVS 130 | * subversion 131 | * bzr 132 | * darcs 133 | * mercurial 134 | -------------------------------------------------------------------------------- /install-repo.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | ## Copyright 2016-2022 kmx.io 3 | ## 4 | ## Permission is hereby granted to use this software granted 5 | ## the above copyright notice and this permission paragraph 6 | ## are included in all copies and substantial portions of this 7 | ## software. 8 | ## 9 | ## THIS SOFTWARE IS PROVIDED "AS-IS" WITHOUT ANY GUARANTEE OF 10 | ## PURPOSE AND PERFORMANCE. IN NO EVENT WHATSOEVER SHALL THE 11 | ## AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF 12 | ## THIS SOFTWARE. 13 | 14 | set -e 15 | 16 | REPO_DIR=$HOME/common-lisp 17 | 18 | GITHUB='https://github.com/' 19 | KMX='https://git.kmx.io/' 20 | 21 | # detect gnu make 22 | 23 | if which gmake > /dev/null; then 24 | MAKE=gmake 25 | else 26 | MAKE=make 27 | fi 28 | 29 | # clone git repo 30 | 31 | maybe_clone() { 32 | HOST="$1" 33 | OWNER="$2" 34 | NAME="$3" 35 | if ! [ -d "${REPO_DIR}/${OWNER}/${NAME}" ]; then 36 | echo "Installing ${HOST}${OWNER}/${NAME} into ${REPO_DIR}/${OWNER}/${NAME}" 37 | mkdir -p "${REPO_DIR}/${OWNER}" 38 | git -C "${REPO_DIR}/${OWNER}" clone "${HOST}${OWNER}/${NAME}" 39 | fi 40 | } 41 | 42 | # Install ASDF from Github 43 | 44 | maybe_clone "${GITHUB}" 'fare' 'asdf' 45 | "${MAKE}" -C "${REPO_DIR}/fare/asdf" 46 | 47 | # Install Repo from Github 48 | 49 | maybe_clone "${KMX}" 'kmx.io' 'repo' 50 | if ! [ -f "${REPO_DIR}/repo-index.lisp" ]; then 51 | echo "Linking ${REPO_DIR}/repo-index.lisp" 52 | ( cd "${REPO_DIR}" && ln -s kmx.io/repo/repo-index.lisp; ) 53 | fi 54 | 55 | # Configure SBCL 56 | 57 | if grep -q "(load \"${REPO_DIR}/fare/asdf/build/asdf\")" ~/.sbclrc && 58 | grep -q "(load \"${REPO_DIR}/kmx.io/repo/repo\")" ~/.sbclrc && 59 | grep -q "(repo:boot)" ~/.sbclrc; then 60 | : 61 | else 62 | echo Appending to ~/.sbclrc 63 | { 64 | echo "(load \"${REPO_DIR}/fare/asdf/build/asdf\")" 65 | echo "(load \"${REPO_DIR}/kmx.io/repo/repo\")" 66 | echo "(repo:boot)" 67 | } >> ~/.sbclrc 68 | fi 69 | -------------------------------------------------------------------------------- /repo-index.lisp: -------------------------------------------------------------------------------- 1 | ;; repo 2 | ;; Copyright 2016-2022 kmx.io 3 | ;; 4 | ;; Permission is hereby granted to use this software granted 5 | ;; the above copyright notice and this permission paragraph 6 | ;; are included in all copies and substantial portions of this 7 | ;; software. 8 | ;; 9 | ;; THIS SOFTWARE IS PROVIDED "AS-IS" WITHOUT ANY GUARANTEE OF 10 | ;; PURPOSE AND PERFORMANCE. IN NO EVENT WHATSOEVER SHALL THE 11 | ;; AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF 12 | ;; THIS SOFTWARE. 13 | 14 | (in-package :repo-user) 15 | 16 | (git "http://git.kpe.io/cl-base64.git") 17 | (git "http://git.kpe.io/puri.git") 18 | (git "https://gitlab.common-lisp.net/alexandria/alexandria.git") 19 | (git "https://gitlab.common-lisp.net/cl-irregsexp/cl-irregsexp.git") 20 | (git "https://gitlab.common-lisp.net/cl-smtp/cl-smtp.git") 21 | (git "https://gitlab.common-lisp.net/cl-utilities/cl-utilities.git") 22 | (git "https://gitlab.common-lisp.net/metabang-bind/metabang-bind.git") 23 | (git "https://gitlab.common-lisp.net/rfc2388/rfc2388.git") 24 | 25 | (github "3b" "3bmd") 26 | (github "AccelerationNet" "cl-inflector") 27 | (github "BnMcGn" "html-entities") 28 | (github "KDr2" "cl-fastcgi") 29 | (github "KDr2" "sb-fastcgi") 30 | (github "adamczykm" "iterate") 31 | (github "ahefner" "shuffletron") 32 | (github "binghe" "portable-threads") 33 | (github "cffi" "cffi") 34 | (github "chaitanyagupta" "chronicity") 35 | (github "cl-babel" "babel") 36 | (github "cl-plus-ssl" "cl-plus-ssl" :packages '("cl+ssl")) 37 | (github "cosmos72" "stmx") 38 | (github "didierverna" "clon") 39 | (github "didierverna" "declt") 40 | (github "didierverna" "tfm") 41 | (github "diogoalexandrefranco" "cl-strings") 42 | (github "dlowe-net" "local-time") 43 | (github "drdo" "do-urlencode") 44 | (github "e-user" "cl-heredoc") 45 | (github "edicl" "chunga") 46 | (github "edicl" "cl-fad") 47 | (github "edicl" "cl-interpol") 48 | (github "edicl" "cl-ppcre") 49 | (github "edicl" "cl-unicode") 50 | (github "edicl" "drakma") 51 | (github "edicl" "flexi-streams") 52 | (github "edicl" "hunchentoot") 53 | (github "eugeneia" "cl-qprint") 54 | (github "fare" "asdf") 55 | (github "filonenko-mikhail" "cl-portaudio") 56 | (github "froydnj" "chipz") 57 | (github "fukamachi" "fast-http") 58 | (github "fukamachi" "proc-parse") 59 | (github "fukamachi" "quri") 60 | (github "fukamachi" "smart-buffer") 61 | (github "fukamachi" "trivial-utf-8") 62 | (github "fukamachi" "xsubseq") 63 | (github "gwkkwg" "trivial-backtrace") 64 | (github "hankhero" "cl-json") 65 | (github "jdz" "rfc2388") 66 | (github "jech" "cl-yacc") 67 | (github "keithj" "deoxybyte-unix") 68 | (github "lmj" "global-vars") 69 | (github "marijnh" "parse-js") 70 | (github "melisgl" "named-readtables") 71 | (github "mishoo" "cl-uglify-js") 72 | (github "nallen05" "rw-ut") 73 | (github "nallen05" "trivial-email-utf-8") 74 | (github "next-browser" "next") 75 | (github "nightfly19" "cl-arrows") 76 | (github "nikodemus" "esrap") 77 | (github "orthecreedence" "blackbird") 78 | (github "orthecreedence" "cl-async" :packages '("cl-async" "cl-async-repl" "cl-async-ssl")) 79 | (github "orthecreedence" "cl-libuv") 80 | (github "orthecreedence" "vom") 81 | (github "orthecreedence" "wookie") 82 | (github "pcostanza" "closer-mop") 83 | (github "phmarek" "yason") 84 | (github "phoe" "safe-read") 85 | (github "pmai" "md5") 86 | (github "robert-strandh" "Acclimation") 87 | (github "robert-strandh" "Awele") 88 | (github "robert-strandh" "CLIM-demo-adventure") 89 | (github "robert-strandh" "CLIMatis") 90 | (github "robert-strandh" "Claire") 91 | (github "robert-strandh" "Claret") 92 | (github "robert-strandh" "Classeur") 93 | (github "robert-strandh" "Climacs") 94 | (github "robert-strandh" "Climed") 95 | (github "robert-strandh" "Cloak") 96 | (github "robert-strandh" "Clobber") 97 | (github "robert-strandh" "Clordane") 98 | (github "robert-strandh" "Cluffer-Emacs-compatibility") 99 | (github "robert-strandh" "Clump") 100 | (github "robert-strandh" "Cluster") 101 | (github "robert-strandh" "Compta") 102 | (github "robert-strandh" "Concrete-Syntax-Tree") 103 | (github "robert-strandh" "Ducling") 104 | (github "robert-strandh" "Eclector") 105 | (github "robert-strandh" "Enamel") 106 | (github "robert-strandh" "First-Climacs") 107 | (github "robert-strandh" "Flexichain") 108 | (github "robert-strandh" "GF-font-viewer") 109 | (github "robert-strandh" "Gsharp") 110 | (github "robert-strandh" "Incremental-reader") 111 | (github "robert-strandh" "McCLIM") 112 | (github "robert-strandh" "Nomenclatura") 113 | (github "robert-strandh" "SICL") 114 | (github "robert-strandh" "Second-Climacs") 115 | (github "robert-strandh" "Spell") 116 | (github "robert-strandh" "Stealth-mixin") 117 | (github "robert-strandh" "Subsequence") 118 | (github "robert-strandh" "Sudoku") 119 | (github "robert-strandh" "Text-annotation") 120 | (github "robert-strandh" "Trans-Clime") 121 | (github "robert-strandh" "USE-finder") 122 | (github "robert-strandh" "dpANS-parser") 123 | (github "rpav" "c2ffi") 124 | (github "rpav" "cl-autowrap") 125 | (github "rpav" "fast-io") 126 | (github "sellout" "external-program") 127 | (github "sharplispers" "ironclad") 128 | (github "sharplispers" "nibbles") 129 | (github "sharplispers" "parse-number") 130 | (github "sharplispers" "split-sequence") 131 | (github "sionescu" "bordeaux-threads") 132 | (github "sionescu" "static-vectors") 133 | (github "slime" "slime") 134 | (github "thephoeron" "let-over-lambda") 135 | (github "tpapp" "ffa") 136 | (github "trivial-features" "trivial-features") 137 | (github "trivial-garbage" "trivial-garbage") 138 | (github "trivial-gray-streams" "trivial-gray-streams") 139 | (github "usocket" "usocket") 140 | (github "vii" "teepeedee2") 141 | (github "vseloved" "cl-redis") 142 | (github "vseloved" "rutils") 143 | (github "zkat" "chanl") 144 | 145 | (kmx "RailsOnLisp" "bootstrap") 146 | (kmx "RailsOnLisp" "bordeaux-queue") 147 | (kmx "RailsOnLisp" "bordeaux-set") 148 | (kmx "RailsOnLisp" "can") 149 | (kmx "RailsOnLisp" "font-awesome") 150 | (kmx "RailsOnLisp" "gravatar") 151 | (kmx "RailsOnLisp" "rol-assets") 152 | (kmx "RailsOnLisp" "rol-files") 153 | (kmx "RailsOnLisp" "rol-log") 154 | (kmx "RailsOnLisp" "rol-server") 155 | (kmx "RailsOnLisp" "rol-template") 156 | (kmx "RailsOnLisp" "rol-uri") 157 | (kmx "RailsOnLisp" "thot") 158 | (kmx "cffi-posix" "cffi-dirent") 159 | (kmx "cffi-posix" "cffi-epoll") 160 | (kmx "cffi-posix" "cffi-errno") 161 | (kmx "cffi-posix" "cffi-fcntl") 162 | (kmx "cffi-posix" "cffi-socket") 163 | (kmx "cffi-posix" "cffi-stat") 164 | (kmx "cffi-posix" "cffi-unistd") 165 | (kmx "cl-remap" "remap") 166 | (kmx "cl-remap" "uiop-remap") 167 | (kmx "cl-remap" "unistd-remap") 168 | (kmx "cl-stream" "babel-stream") 169 | (kmx "cl-stream" "cl-stream") 170 | (kmx "cl-stream" "matcher-stream") 171 | (kmx "cl-stream" "parser-stream") 172 | (kmx "cl-stream" "token-stream") 173 | (kmx "cl-stream" "unistd-stdio") 174 | (kmx "cl-stream" "unistd-stream") 175 | (kmx "facts-db" "cl-facts") 176 | (kmx "facts-db" "cl-lessp") 177 | (kmx "facts-db" "cl-rollback") 178 | (kmx "idl" "excel-fun.git") 179 | (kmx "idl" "idl-calc.git") 180 | (kmx "kmx.io" "cl-debug") 181 | (kmx "kmx.io" "repo") 182 | (kmx "lowh" "exec-js") 183 | (kmx "thodg" "cffi-portaudio") 184 | (kmx "thodg" "cfg") 185 | (kmx "thodg" "cl-github-v3") 186 | (kmx "thodg" "cl-github-v3") 187 | (kmx "thodg" "cl-unix-cybernetics") 188 | (kmx "thodg" "css-lexer") 189 | (kmx "thodg" "css-parser") 190 | (kmx "thodg" "less-lexer") 191 | (kmx "thodg" "less-parser") 192 | (kmx "thodg" "positional") 193 | (kmx "thodg" "random-sequence") 194 | (kmx "thodg" "re.git") 195 | (kmx "thodg" "str") 196 | (kmx "thodg" "str.git") 197 | -------------------------------------------------------------------------------- /repo.1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kmx-io/repo/8606f385aef9ff32a4eac366acec7c7494a2d60f/repo.1.png -------------------------------------------------------------------------------- /repo.asd: -------------------------------------------------------------------------------- 1 | ;; repo 2 | ;; Copyright 2016-2022 kmx.io 3 | ;; 4 | ;; Permission is hereby granted to use this software granted 5 | ;; the above copyright notice and this permission paragraph 6 | ;; are included in all copies and substantial portions of this 7 | ;; software. 8 | ;; 9 | ;; THIS SOFTWARE IS PROVIDED "AS-IS" WITHOUT ANY GUARANTEE OF 10 | ;; PURPOSE AND PERFORMANCE. IN NO EVENT WHATSOEVER SHALL THE 11 | ;; AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF 12 | ;; THIS SOFTWARE. 13 | 14 | (defpackage :repo.system 15 | (:use :cl :asdf)) 16 | 17 | (in-package :repo.system) 18 | 19 | (defsystem :repo 20 | :name "repo" 21 | :author "Thomas de Grivel " 22 | :version "0.2" 23 | :description "common interface for version control systems" 24 | :depends-on () 25 | :components 26 | ((:file "repo"))) 27 | -------------------------------------------------------------------------------- /repo.lisp: -------------------------------------------------------------------------------- 1 | ;; repo 2 | ;; Copyright 2016-2022 kmx.io 3 | ;; 4 | ;; Permission is hereby granted to use this software granted 5 | ;; the above copyright notice and this permission paragraph 6 | ;; are included in all copies and substantial portions of this 7 | ;; software. 8 | ;; 9 | ;; THIS SOFTWARE IS PROVIDED "AS-IS" WITHOUT ANY GUARANTEE OF 10 | ;; PURPOSE AND PERFORMANCE. IN NO EVENT WHATSOEVER SHALL THE 11 | ;; AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF 12 | ;; THIS SOFTWARE. 13 | 14 | (in-package :common-lisp-user) 15 | 16 | (defpackage :repo 17 | (:use :common-lisp) 18 | (:export #:boot 19 | #:clear-repos 20 | #:find-repo 21 | #:find-repo-by-package 22 | #:git 23 | #:github 24 | #:index 25 | #:index! 26 | #:*index* 27 | #:index-repos 28 | #:install 29 | #:kmx 30 | #:*log-commands* 31 | #:repo 32 | #:repo! 33 | #:*repos* 34 | #:run-program 35 | #:sh 36 | #:sh-quote 37 | #:str 38 | #:sysdef 39 | #:update)) 40 | 41 | (defpackage :repo-user 42 | (:use :common-lisp :repo)) 43 | 44 | (in-package :repo) 45 | 46 | ;; variables 47 | 48 | (defvar *index*) 49 | 50 | (defvar *log-commands* t) 51 | 52 | (defvar *repos* ()) 53 | 54 | ;; string functions 55 | 56 | (defvar *spaces* (coerce '(#\Space #\Tab) 'string)) 57 | 58 | (defun string-starts-with (x string) 59 | (let ((lx (length x)) 60 | (ls (length string))) 61 | (when (and (>= ls lx) 62 | (string= x string :end2 lx)) 63 | lx))) 64 | 65 | (defun string-ends-with (x string) 66 | (let* ((lx (length x)) 67 | (ls (length string)) 68 | (dl (- ls lx))) 69 | (when (and (>= ls lx) 70 | (string= x string :start2 dl)) 71 | dl))) 72 | 73 | (defun string-split (s x) 74 | (let ((p (search s x))) 75 | (if p 76 | (cons (subseq x 0 p) 77 | (string-split s (subseq x (+ (length s) p)))) 78 | (cons x nil)))) 79 | 80 | (defun first-line (x) 81 | (let ((newline (position #\Newline x))) 82 | (if newline 83 | (subseq x 0 newline) 84 | x))) 85 | 86 | (defun dirname (x) 87 | (let ((slash (position #\/ x :from-end t 88 | :end (or (string-ends-with "/" x) (length x))))) 89 | (cond ((null slash) "") 90 | ((= 0 slash) "/") 91 | (t (subseq x 0 slash))))) 92 | 93 | (defun basename (x) 94 | (let* ((end (or (string-ends-with "/" x) (length x))) 95 | (slash (position #\/ x :from-end t :end end))) 96 | (cond ((null slash) (subseq x 0 end)) 97 | (t (subseq x (1+ slash) end))))) 98 | 99 | (defun probe-dir (x) 100 | #+clisp (ext:probe-directory (format nil "~A/" x)) 101 | #-clisp (probe-file (format nil "~A/" x))) 102 | 103 | (defun str (&rest parts) 104 | (labels ((to-str (x) 105 | (typecase x 106 | (string x) 107 | (null "") 108 | (cons (apply 'str x)) 109 | (pathname (namestring x)) 110 | (t (prin1-to-string x))))) 111 | (apply 'concatenate 'string (mapcar #'to-str parts)))) 112 | 113 | (defun kw (x) 114 | (intern (string-upcase x) (find-package :keyword))) 115 | 116 | (defun translate-home (x) 117 | (if (string-starts-with "~/" x) 118 | (str (user-homedir-pathname) (subseq x 2)) 119 | x)) 120 | 121 | ;; shell commands 122 | 123 | #+sbcl 124 | (defun run-program (cmd &rest args) 125 | (when *log-commands* 126 | (format t "~&$ ~S~{ ~S~}~%" cmd args) 127 | (force-output)) 128 | (let* ((out (make-string-output-stream)) 129 | (err (make-string-output-stream))) 130 | (let* ((process (sb-ext:run-program cmd args 131 | :output out 132 | :error err 133 | :external-format :utf-8)) 134 | (exit-code (sb-ext:process-exit-code process))) 135 | (close out) 136 | (close err) 137 | (let ((out (get-output-stream-string out)) 138 | (err (get-output-stream-string err))) 139 | (format t "~&~S~&" out) 140 | (format t "~&~S~&" err) 141 | (unless (= 0 exit-code) 142 | (with-simple-restart (continue "Ignore command error") 143 | (error "~&$ ~S~{ ~S~}~%~S" cmd args err))) 144 | (values out err exit-code))))) 145 | 146 | #+clisp 147 | (defun run-program (cmd &rest args) 148 | (when *log-commands* 149 | (format t "~&$ ~A~{ ~A~}~%" cmd args) 150 | (force-output)) 151 | (let* ((buf (make-array '(4096) :element-type 'character)) 152 | (stream (ext:run-program cmd :arguments args 153 | :output :stream :wait t)) 154 | (len (read-sequence buf stream)) 155 | (out (subseq buf 0 len))) 156 | (format t "~&~A~&" out) 157 | (values out "" 0))) 158 | 159 | (defun sh (&rest parts) 160 | (let ((cmd (str parts))) 161 | (when *log-commands* 162 | (format t "~&$ ~A~%" cmd) 163 | (force-output)) 164 | (let ((*log-commands* nil)) 165 | (run-program "/bin/sh" "-c" cmd)))) 166 | 167 | (defvar *sh-unquoted-chars* 168 | "+,-./0123456789:=ABCDEFGHIJKLMNOPQRSTUVWXYZ^_abcdefghijklmnopqrstuvwxyz") 169 | 170 | (defvar *sh-quoted-chars* 171 | "\"$\\`") 172 | 173 | (defun sh-need-quote (x) 174 | (dotimes (i (length x)) 175 | (unless (find (char x i) *sh-unquoted-chars*) 176 | (return t)))) 177 | 178 | (defun sh-quote (x) 179 | (if (sh-need-quote x) 180 | (with-output-to-string (out) 181 | (write-char #\" out) 182 | (dotimes (i (length x)) 183 | (let ((c (char x i))) 184 | (when (find c *sh-quoted-chars*) 185 | (write-char #\\ out)) 186 | (write-char c out))) 187 | (write-char #\" out)) 188 | x)) 189 | 190 | (defun sh-quote-dir (x) 191 | (let ((home (string-starts-with "~/" x))) 192 | (if home 193 | (str "~/" (sh-quote (subseq x home))) 194 | (sh-quote x)))) 195 | 196 | ;; property list functions 197 | 198 | (defun plist-merge (to add &rest more-lists) 199 | (cond 200 | ((endp add) 201 | (if (endp more-lists) 202 | to 203 | (plist-merge to 204 | (first more-lists) 205 | (rest more-lists)))) 206 | ((endp (rest add)) 207 | (error "Incomplete property list")) 208 | (t 209 | (setf (getf to (first add)) 210 | (first (rest add))) 211 | (plist-merge to (rest (rest add)))))) 212 | 213 | ;; classes 214 | 215 | (defclass index () 216 | ((write-date :initarg :write-date 217 | :accessor index-write-date 218 | :type rational) 219 | (dir :initarg :dir 220 | :reader index-dir 221 | :type string) 222 | (repos :initarg :repos 223 | :accessor index-repos 224 | :type list))) 225 | 226 | (defclass repo () 227 | ((dir :initarg :dir 228 | :reader repo-dir 229 | :type string) 230 | (name :initarg :name 231 | :reader repo-name 232 | :type string) 233 | (head :initarg :head 234 | :type string) 235 | (uri :initarg :uri 236 | :reader repo-uri 237 | :type string) 238 | (url :initarg :url 239 | :reader repo-url 240 | :type string) 241 | (local-dir :initarg :local-dir 242 | :reader repo-local-dir 243 | :type string) 244 | (packages :initarg :packages 245 | :reader repo-packages 246 | :type list) 247 | (index :initarg :index 248 | :reader repo-index 249 | :type index))) 250 | 251 | (defclass git-repo (repo) ()) 252 | 253 | (defclass github-repo (git-repo) ()) 254 | 255 | (defclass kmx-repo (git-repo) ()) 256 | 257 | ;; generic functions 258 | 259 | (defgeneric install (repo)) 260 | (defgeneric update (repo)) 261 | 262 | ;; repo 263 | 264 | (defgeneric repo-asd (repo &optional package)) 265 | (defgeneric repo-dir/name (repo)) 266 | (defgeneric repo-head (repo)) 267 | (defgeneric repo-head-default (repo)) 268 | (defgeneric repo-local-file (repo &rest parts)) 269 | (defgeneric repo-package-p (x repo)) 270 | 271 | (defmethod print-object ((obj repo) stream) 272 | (print-unreadable-object (obj stream :type t :identity t) 273 | (with-slots (dir name uri local-dir packages) obj 274 | (format stream "~A/~A ~S ~S ~S" dir name uri local-dir 275 | (when (slot-boundp obj 'packages) 276 | packages))))) 277 | 278 | (defmethod repo-asd ((repo repo) &optional 279 | (package (first (repo-packages repo)))) 280 | (let ((found (first 281 | (directory 282 | (str (translate-home (repo-local-dir repo)) "/**/" 283 | (string-downcase package) ".asd"))))) 284 | (when found 285 | (namestring found)))) 286 | 287 | (defun repo-by-url (url) 288 | (find url *repos* :key #'repo-url :test #'string=)) 289 | 290 | (defun repo-by-uri (uri) 291 | (find uri *repos* :key #'repo-uri :test #'string=)) 292 | 293 | (defmethod repo-dir/name ((repo repo)) 294 | (str (repo-dir repo) "/" (repo-name repo))) 295 | 296 | (defmethod repo-head ((repo repo)) 297 | (if (slot-boundp repo 'head) 298 | (slot-value repo 'head) 299 | (repo-head-default repo))) 300 | 301 | (defmethod repo-local-file ((repo repo) &rest parts) 302 | (str (repo-local-dir repo) "/" parts)) 303 | 304 | (defmethod repo-package-p (x repo) 305 | (find x (repo-packages repo) :test #'string-equal)) 306 | 307 | ;; git 308 | 309 | (defvar *git* 310 | (or (probe-file "/usr/bin/git") 311 | (probe-file "/usr/local/bin/git") 312 | (first-line (sh "which git")))) 313 | 314 | (defun $git (&rest args) 315 | (apply 'run-program *git* args)) 316 | 317 | ;; git repo 318 | 319 | (defgeneric $git-checkout (repo)) 320 | (defgeneric $git-clone (repo)) 321 | (defgeneric $git-fetch (repo)) 322 | (defgeneric $git-pull (repo)) 323 | 324 | (defmethod $git-checkout ((repo git-repo)) 325 | (let* ((local (repo-local-dir repo)) 326 | (head (repo-head repo)) 327 | (str-head (str head)) 328 | (args `("-C" ,(translate-home local) "checkout" 329 | ,@(unless (= 0 (length str-head)) 330 | '(str-head))))) 331 | (apply #'$git args) 332 | nil)) 333 | 334 | (defmethod $git-clone ((repo git-repo)) 335 | (let ((local (repo-local-dir repo)) 336 | (url (repo-url repo))) 337 | (when (probe-dir local) 338 | (error "git clone: not overwriting existing local directory~&~S" local)) 339 | (let ((parent (dirname local))) 340 | (ensure-directories-exist (str parent "/") :verbose t) 341 | ($git "-C" (translate-home parent) "clone" url) 342 | nil))) 343 | 344 | (defmethod $git-fetch ((repo git-repo)) 345 | (let ((local (repo-local-dir repo))) 346 | ($git "-C" (translate-home local) "fetch") 347 | nil)) 348 | 349 | (defmethod $git-pull ((repo git-repo)) 350 | (let ((local (repo-local-dir repo))) 351 | ($git "-C" (translate-home local) "pull") 352 | nil)) 353 | 354 | (defmethod install ((repo git-repo)) 355 | (let ((local (repo-local-dir repo))) 356 | (unless (probe-dir local) 357 | ($git-clone repo)) 358 | (let ((asd (repo-asd repo))) 359 | (when asd 360 | (asdf::load-asd asd))))) 361 | 362 | (defmethod repo-head-default ((repo git-repo)) 363 | "master") 364 | 365 | (defmethod update ((repo git-repo)) 366 | (when (probe-dir (repo-local-dir repo)) 367 | ($git-pull repo))) 368 | 369 | (defun git-repo-uri-handler (uri &key dir &allow-other-keys) 370 | (let ((uri (first (string-split "#" uri)))) 371 | (let ((start (or (string-starts-with "git://" uri) 372 | (string-starts-with "http://" uri) 373 | (string-starts-with "https://" uri)))) 374 | (when start 375 | (let* ((dot (search ".git" uri :from-end t)) 376 | (slash (position #\/ uri :end dot :from-end t)) 377 | (slash2 (position #\/ uri :end slash :from-end t)) 378 | (dir (or dir (subseq uri (1+ slash2) slash))) 379 | (name (subseq uri (1+ slash) dot))) 380 | `(git-repo :dir ,dir 381 | :index ,*index* 382 | :name ,name 383 | :uri ,uri 384 | :url ,uri)))))) 385 | 386 | (defun git (url &rest initargs) 387 | (or (repo-by-url url) 388 | (let ((repo (apply #'make-instance 389 | (append (apply #'git-repo-uri-handler 390 | url 391 | initargs) 392 | initargs)))) 393 | (push repo *repos*) 394 | repo))) 395 | 396 | ;; github repo 397 | 398 | (defmethod print-object ((obj github-repo) stream) 399 | (print-unreadable-object (obj stream :type t :identity t) 400 | (with-slots (dir name local-dir packages) obj 401 | (format stream "~A/~A ~S ~S" dir name local-dir packages)))) 402 | 403 | (defun github-uri (user name &optional head package) 404 | (str "github:" user "/" name 405 | (when head "?") head 406 | (when package "#") package)) 407 | 408 | (defun github-url (user name) 409 | (str "https://github.com/" user "/" name ".git")) 410 | 411 | (defun github-repo-uri-handler (uri &key dir &allow-other-keys) 412 | (let ((uri (first (string-split "#" uri)))) 413 | (let ((start (or (string-starts-with "github:" uri) 414 | (string-starts-with "git://github.com/" uri) 415 | (string-starts-with "http://github.com/" uri) 416 | (string-starts-with "https://github.com/" uri)))) 417 | (when start 418 | (let* ((slash (or (position #\/ uri :start start) 419 | (error "Invalid repo uri ~S" uri))) 420 | (dot (or (string-ends-with ".git/" uri) 421 | (string-ends-with ".git" uri) 422 | (string-ends-with "/" uri))) 423 | (user (subseq uri start slash)) 424 | (name (subseq uri (1+ slash) dot))) 425 | `(github-repo :dir ,(or dir user) 426 | :index ,*index* 427 | :name ,name 428 | :uri ,(github-uri user name) 429 | :url ,(github-url user name))))))) 430 | 431 | (defun github (user name &rest initargs &key dir &allow-other-keys) 432 | (let ((uri (github-uri user name))) 433 | (or (repo-by-uri uri) 434 | (let ((repo (apply #'make-instance 'github-repo 435 | :dir (or dir user) 436 | :index *index* 437 | :name name 438 | :uri uri 439 | :url (github-url user name) 440 | initargs))) 441 | (push repo *repos*) 442 | repo)))) 443 | 444 | ;; kmx repo 445 | 446 | (defmethod print-object ((obj kmx-repo) stream) 447 | (print-unreadable-object (obj stream :type t :identity t) 448 | (with-slots (dir name local-dir packages) obj 449 | (format stream "~A/~A ~S ~S" dir name local-dir packages)))) 450 | 451 | (defun kmx-uri (dir name &optional tree package) 452 | (str "kmx:" dir "/" name 453 | (when tree "?") tree 454 | (when package "#") package)) 455 | 456 | (defun kmx-url (dir name) 457 | (str "https://git.kmx.io/" dir "/" name ".git")) 458 | 459 | (defun kmx (dir name &rest initargs) 460 | (let ((uri (kmx-uri dir name))) 461 | (or (repo-by-uri uri) 462 | (let ((repo (apply #'make-instance 'kmx-repo 463 | :dir dir 464 | :index *index* 465 | :name name 466 | :uri uri 467 | :url (kmx-url dir name) 468 | initargs))) 469 | (push repo *repos*) 470 | repo)))) 471 | 472 | ;; repo uri handler 473 | 474 | (defparameter *repo-uri-handlers* 475 | '(github-repo-uri-handler 476 | git-repo-uri-handler)) 477 | 478 | (defun clear-repos () 479 | (setf *repos* nil)) 480 | 481 | (defun find-repo (uri) 482 | (let ((uri (string uri))) 483 | (or (find uri *repos* :key 'repo-uri :test 'string=) 484 | (if (position #\/ uri) 485 | (find uri *repos* :key 'repo-dir/name :test 'string-equal) 486 | (find uri *repos* :key 'repo-name :test 'string-equal))))) 487 | 488 | (defun find-repo-by-package (x) 489 | (find x *repos* :test #'repo-package-p)) 490 | 491 | (defun uri-fragment (x) 492 | (second (string-split "#" x))) 493 | 494 | (defun repo (uri) 495 | "Factory function for repository classes using *REPO-URI-HANDLERS*." 496 | (when (symbolp uri) 497 | (setq uri (symbol-name uri))) 498 | (destructuring-bind (uri &rest packages) (string-split " " uri) 499 | (or (find-repo uri) 500 | (when (stringp uri) 501 | (labels ((do-handlers (handlers) 502 | (when handlers 503 | (or (funcall (first handlers) uri) 504 | (do-handlers (rest handlers)))))) 505 | (let ((spec (do-handlers *repo-uri-handlers*))) 506 | (when spec 507 | (let* ((class (first spec)) 508 | (initargs (rest spec)) 509 | (uri (getf initargs :uri)) 510 | (kw (kw (getf initargs :name))) 511 | (initargs (plist-merge initargs 512 | `(:packages ,(or packages 513 | `(,kw)))))) 514 | (or (find-repo uri) 515 | (let ((repo (apply 'make-instance class initargs))) 516 | (push repo *repos*) 517 | repo)))))))))) 518 | 519 | (defun repo! (x) 520 | (or (repo x) 521 | (error "unknown repository : ~S" x))) 522 | 523 | (defmethod $git-clone ((uri string)) 524 | ($git-clone (repo! uri))) 525 | 526 | (defmethod $git-pull ((uri string)) 527 | ($git-pull (repo! uri))) 528 | 529 | ;; repos list 530 | 531 | (defmethod install ((repos cons)) 532 | (map nil 'install repos)) 533 | 534 | (defmethod update ((repos cons)) 535 | (map nil 'update repos)) 536 | 537 | ;; index 538 | 539 | (defgeneric index-file (index)) 540 | (defgeneric reload-index (index)) 541 | (defgeneric maybe-reload-index (index)) 542 | 543 | (defmethod print-object ((obj index) stream) 544 | (print-unreadable-object (obj stream :type t :identity t) 545 | (format stream "~S ~A repos" 546 | (index-file obj) 547 | (length (index-repos obj))))) 548 | 549 | (defmethod index-file ((index index)) 550 | (str (index-dir index) "/repo-index.lisp")) 551 | 552 | (defun index-from-file (pathname) 553 | (let* ((*repos* nil) 554 | (write-date (file-write-date pathname)) 555 | (*index* (make-instance 'index 556 | :write-date write-date 557 | :dir (dirname pathname) 558 | :repos *repos*))) 559 | (load pathname) 560 | (setf (index-repos *index*) *repos*) 561 | *index*)) 562 | 563 | (defmethod reload-index ((index index)) 564 | (let* ((pathname (index-file index)) 565 | (*repos* nil) 566 | (write-date (file-write-date pathname))) 567 | (load pathname) 568 | (setf (index-write-date index) write-date 569 | (index-repos index) *repos*)) 570 | index) 571 | 572 | (defmethod maybe-reload-index ((index index)) 573 | (if (< (index-write-date index) 574 | (file-write-date (index-file index))) 575 | (reload-index index) 576 | index)) 577 | 578 | (defmethod install ((index index)) 579 | (let ((index (maybe-reload-index index))) 580 | (let ((*repos* (index-repos index))) 581 | (install *repos*)))) 582 | 583 | (defmethod update ((index index)) 584 | (let ((index (maybe-reload-index index))) 585 | (let ((*repos* (index-repos index))) 586 | (update *repos*)))) 587 | 588 | ;; index uri handlers 589 | 590 | (defun index-file-p (x) 591 | (or (string= "repo-index.lisp" x) 592 | (string-ends-with "/repo-index.lisp" x))) 593 | 594 | (defun local-index-uri-handler (x) 595 | (let ((end (string-ends-with "/repo-index.lisp" x))) 596 | (when end 597 | (let* ((dir (subseq x 0 end)) 598 | (index (str dir "/repo-index.lisp"))) 599 | (when (probe-file index) 600 | (index-from-file index)))))) 601 | 602 | (defvar *index-uri-handlers* 603 | '(local-index-uri-handler)) 604 | 605 | (defun index (uri) 606 | "Load index from uri" 607 | (labels ((do-handlers (handlers) 608 | (unless (endp handlers) 609 | (or (funcall (first handlers) uri) 610 | (do-handlers (rest handlers)))))) 611 | (do-handlers *index-uri-handlers*))) 612 | 613 | (defun index! (uri) 614 | (or (index uri) (error "failed to load index ~S" uri))) 615 | 616 | ;; repo 617 | 618 | (defmethod initialize-instance :after ((repo repo) &rest initargs) 619 | (declare (ignore initargs)) 620 | (with-slots (dir index name packages) repo 621 | (setf (slot-value repo 'local-dir) 622 | (format nil "~A/~A/~A" (index-dir index) dir name)) 623 | (unless (slot-boundp repo 'packages) 624 | (setf packages (list name))))) 625 | 626 | ;; install and update commands 627 | 628 | (defmethod install ((x string)) 629 | (when *index* 630 | (maybe-reload-index *index*) 631 | (setq *repos* (index-repos *index*))) 632 | (if (index-file-p x) 633 | (install (index! x)) 634 | (install (repo! x)))) 635 | 636 | (defmethod install ((x null)) 637 | nil) 638 | 639 | (defmethod install ((x symbol)) 640 | (when *index* 641 | (maybe-reload-index *index*) 642 | (setq *repos* (index-repos *index*))) 643 | (install (repo! x))) 644 | 645 | (defmethod update ((x string)) 646 | (when *index* 647 | (maybe-reload-index *index*) 648 | (setq *repos* (index-repos *index*))) 649 | (if (index-file-p x) 650 | (update (index! x)) 651 | (update (repo! x)))) 652 | 653 | (defmethod update ((x null)) 654 | nil) 655 | 656 | (defmethod update ((x symbol)) 657 | (when *index* 658 | (maybe-reload-index *index*) 659 | (setq *repos* (index-repos *index*))) 660 | (update (repo! x))) 661 | 662 | ;; system-definition 663 | 664 | (defun sysdef (x sysdef-file) 665 | (declare (type function sysdef-file)) 666 | (when *index* 667 | (maybe-reload-index *index*) 668 | (setq *repos* (index-repos *index*))) 669 | (let ((repo (or (find-repo-by-package x) 670 | (repo x)))) 671 | (when repo 672 | (install repo) 673 | (pathname (funcall sysdef-file repo x))))) 674 | 675 | (defun sysdef-asdf (x) 676 | (sysdef x #'repo-asd)) 677 | 678 | ;; start repo : load index and link with ASDF 679 | 680 | (defun boot (&optional (dir "~/common-lisp")) 681 | (let ((index-file (str dir "/repo-index.lisp"))) 682 | (when (probe-file index-file) 683 | (setq *index* (index index-file)) 684 | (setq *repos* (index-repos *index*)) 685 | (when (find-package :asdf) 686 | (pushnew 'sysdef-asdf 687 | (symbol-value 688 | (intern "*SYSTEM-DEFINITION-SEARCH-FUNCTIONS*" 689 | :asdf))))))) 690 | -------------------------------------------------------------------------------- /repo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kmx-io/repo/8606f385aef9ff32a4eac366acec7c7494a2d60f/repo.png --------------------------------------------------------------------------------