Mercurial > hg > qm-vamp-plugins
changeset 258:84de57beb8d6
Update Repoint
| author | Chris Cannam <cannam@all-day-breakfast.com> |
|---|---|
| date | Mon, 27 Jan 2020 12:34:20 +0000 |
| parents | 34de4d324930 |
| children | 2eb74e345751 |
| files | .gitignore repoint repoint.sml |
| diffstat | 3 files changed, 77 insertions(+), 19 deletions(-) [+] |
line wrap: on
line diff
--- a/.gitignore Mon Jan 27 11:06:42 2020 +0000 +++ b/.gitignore Mon Jan 27 12:34:20 2020 +0000 @@ -16,3 +16,4 @@ test/regression-obtained lib/ *.orig +.repoint*
--- a/repoint Mon Jan 27 11:06:42 2020 +0000 +++ b/repoint Mon Jan 27 12:34:20 2020 +0000 @@ -58,7 +58,7 @@ # That is fixed in v5.7.1, so we could promote it up the order # again at some point in future elif echo | poly -v 2>/dev/null | grep -q 'Poly/ML'; then - sml="poly" + sml="polyml" elif mlton 2>&1 | grep -q 'MLton'; then sml="mlton" # MLKit is at the bottom because it leaves compiled files around @@ -109,7 +109,7 @@ done case "$sml" in - poly) + polyml) if [ -n "$local_install" ] && polyc --help >/dev/null 2>&1 ; then if [ ! -x "$gen_out" ]; then polyc -o "$gen_out" "$program"
--- a/repoint.sml Mon Jan 27 11:06:42 2020 +0000 +++ b/repoint.sml Mon Jan 27 12:34:20 2020 +0000 @@ -38,7 +38,7 @@ authorization. *) -val repoint_version = "0.9.98" +val repoint_version = "1.2" datatype vcs = @@ -136,6 +136,7 @@ structure RepointFilenames = struct val project_file = "repoint-project.json" val project_lock_file = "repoint-lock.json" + val project_completion_file = ".repoint.point" val user_config_file = ".repoint.json" val archive_dir = ".repoint-archive" end @@ -215,6 +216,7 @@ val nonempty_dir_exists : string -> bool val project_spec_path : string -> string val project_lock_path : string -> string + val project_completion_path : string -> string val verbose : unit -> bool end = struct @@ -272,8 +274,23 @@ fun project_lock_path rootpath = project_file_path rootpath (RepointFilenames.project_lock_file) + fun project_completion_path rootpath = + project_file_path rootpath (RepointFilenames.project_completion_file) + fun trim str = hd (String.fields (fn x => x = #"\n" orelse x = #"\r") str) + + fun make_canonical path = + (* SML/NJ doesn't properly handle "/" when splitting paths - + it should be a path separator even on Windows, but SML/NJ + treats it as a normal filename character there. So we must + convert these explicitly *) + OS.Path.mkCanonical + (if OS.Path.concat ("a", "b") = "a\\b" + then String.translate (fn #"/" => "\\" | + c => Char.toString c) + path + else path) fun file_url path = let val forward_path = @@ -312,7 +329,7 @@ then arg else "\"" ^ arg ^ "\"" fun check arg = - let val valid = explode " /#:;?,._-{}@=+" + let val valid = explode " /#:;?,._-{}@=+%" in app (fn c => if isAlphaNum c orelse @@ -422,7 +439,7 @@ ERROR ("Directory creation failed: " ^ e)) fun mkpath path = - mkpath' (OS.Path.mkCanonical path) + mkpath' (make_canonical path) fun dir_contents dir = let open OS @@ -458,7 +475,7 @@ end fun rmpath path = - rmpath' (OS.Path.mkCanonical path) + rmpath' (make_canonical path) fun nonempty_dir_exists path = let open OS.FileSys @@ -1030,6 +1047,13 @@ anon = SOME "https://github.com/{owner}/{repository}", auth = SOME "ssh://{vcs}@github.com/{owner}/{repository}" } + }, + { service = "sourcehut", + supports = [HG, GIT], + remote_spec = { + anon = SOME "https://{vcs}.sr.ht/%7E{owner}/{repository}", + auth = SOME "ssh://{vcs}@{vcs}.sr.ht/%7E{owner}/{repository}" + } } ] @@ -2420,7 +2444,14 @@ in JsonBits.save_json_to lock_file lock_json end - + +fun checkpoint_completion_file rootpath = + let val completion_file = FileBits.project_completion_path rootpath + val stream = TextIO.openOut completion_file + in + TextIO.closeOut stream + end + fun pad_to n str = if n <= String.size str then str else pad_to n (str ^ " ") @@ -2586,8 +2617,12 @@ val _ = if List.exists (fn (_, OK _) => true | _ => false) outcomes then lock_project project else OS.Process.success + val return_code = return_code_for outcomes in - return_code_for outcomes + if OS.Process.isSuccess return_code + then checkpoint_completion_file (#rootpath context) + else (); + return_code end fun load_local_project pintype = @@ -2625,18 +2660,23 @@ fun usage () = (print "\nRepoint "; version (); - print ("\nA simple manager for third-party source code dependencies.\n\n" + print ("\n A simple manager for third-party source code dependencies.\n" + ^ " http://all-day-breakfast.com/repoint/\n\n" ^ "Usage:\n\n" - ^ " repoint <command>\n\n" + ^ " repoint <command> [<options>]\n\n" ^ "where <command> is one of:\n\n" ^ " status print quick report on local status only, without using network\n" ^ " review check configured libraries against their providers, and report\n" ^ " install update configured libraries according to project specs and lock file\n" ^ " update update configured libraries and lock file according to project specs\n" - ^ " lock update lock file to match local library status\n" - ^ " archive pack up project and all libraries into an archive file\n" - ^ " (invoke as 'repoint archive target-file.tar.gz')\n" - ^ " version print the Repoint version number and exit\n\n"); + ^ " lock rewrite lock file to match local library status\n" + ^ " archive pack up project and all libraries into an archive file:\n" + ^ " invoke as 'repoint archive targetfile.tar.gz --exclude unwanted.txt'\n" + ^ " version print the Repoint version number and exit\n\n" + ^ "and <options> may include:\n\n" + ^ " --directory <dir>\n" + ^ " change to directory <dir> before doing anything; in particular,\n" + ^ " expect to find project spec file in that directory\n\n"); OS.Process.failure) fun archive target args = @@ -2647,8 +2687,26 @@ with_local_project USE_LOCKFILE (Archive.archive (target, xs)) | _ => usage () +fun handleSystemArgs args = + let fun handleSystemArgs' leftover args = + case args of + "--directory"::dir::rest => + (OS.FileSys.chDir dir; + handleSystemArgs' leftover rest) + | arg::rest => + handleSystemArgs' (leftover @ [arg]) rest + | [] => leftover + in + OK (handleSystemArgs' [] args) + handle e => ERROR (exnMessage e) + end + fun repoint args = - let val return_code = + case handleSystemArgs args of + ERROR e => (print ("Error: " ^ e ^ "\n"); + OS.Process.exit OS.Process.failure) + | OK args => + let val return_code = case args of ["review"] => review () | ["status"] => status () @@ -2660,10 +2718,9 @@ | arg::_ => (print ("Error: unknown argument \"" ^ arg ^ "\"\n"); usage ()) | _ => usage () - in - OS.Process.exit return_code; - () - end + in + OS.Process.exit return_code + end fun main () = repoint (CommandLine.arguments ())