# HG changeset patch # User Chris Cannam # Date 1517571624 0 # Node ID 762ef5d2722abe46175ab7b322e43f7e2aa97643 # Parent bfdffe725fe43d8b6718103dc28882df98938c44 Update Vext diff -r bfdffe725fe4 -r 762ef5d2722a vext.sml --- a/vext.sml Fri Feb 02 11:40:02 2018 +0000 +++ b/vext.sml Fri Feb 02 11:40:24 2018 +0000 @@ -38,7 +38,7 @@ authorization. *) -val vext_version = "0.9.94" +val vext_version = "0.9.95" datatype vcs = @@ -342,7 +342,7 @@ in print (" " ^ Vector.sub(tick_chars, !tick_cycle) ^ " " ^ - pad_to 24 name ^ + pad_to 70 name ^ "\r"); tick_cycle := (if !tick_cycle = n - 1 then 0 else 1 + !tick_cycle) end @@ -352,8 +352,7 @@ val dir = libpath context libname val cmd = expand_commandline cmdlist val _ = if verbose () - then print ("Running: " ^ cmd ^ - " (in dir " ^ dir ^ ")...\n") + then print ("\n=== " ^ dir ^ "\n<<< " ^ cmd ^ "\n") else tick libname cmdlist val _ = FileSys.chDir dir val status = case redirect of @@ -375,7 +374,7 @@ val result = run_command context libname cmdlist (SOME tmpFile) val contents = file_contents tmpFile val _ = if verbose () - then print ("Output was:\n\"" ^ contents ^ "\"\n") + then print (">>> \"" ^ contents ^ "\"\n") else () in FileSys.remove tmpFile handle _ => (); @@ -1378,15 +1377,29 @@ if String.isPrefix id_or_tag id orelse String.isPrefix id id_or_tag then OK true - else + else is_at_tag context (libname, id, id_or_tag) + + and is_at_tag context (libname, id, tag) = + (* For annotated tags (with message) show-ref returns the tag + object ref rather than that of the revision being tagged; + we need the subsequent rev-list to chase that up. In fact + the rev-list on its own is enough to get us the id direct + from the tag name, but it fails with an error if the tag + doesn't exist, whereas we want to handle that quietly in + case the tag simply hasn't been pulled yet *) + case git_command_output context libname + ["show-ref", "refs/tags/" ^ tag, "--"] of + OK "" => OK false (* Not a tag *) + | ERROR _ => OK false + | OK s => + let val tag_ref = hd (String.tokens (fn c => c = #" ") s) + in case git_command_output context libname - ["show-ref", - "refs/tags/" ^ id_or_tag, - "--"] of - OK "" => OK false + ["rev-list", "-1", tag_ref] of + OK tagged => OK (id = tagged) | ERROR _ => OK false - | OK s => OK (id = hd (String.tokens (fn c => c = #" ") s)) - + end + fun branch_tip context (libname, branch) = (* We don't have access to the source info or the network here, as this is used by status (e.g. via is_on_branch) as @@ -2377,7 +2390,7 @@ fun hline_to 0 = "" | hline_to n = "-" ^ hline_to (n-1) -val libname_width = 25 +val libname_width = 28 val libstate_width = 11 val localstate_width = 17 val notes_width = 5