Added git-tag and structured listing with -l/--list

2026-08-13 14:32:57 +02:00
parent 2e7cf0290a
commit 2d0aae1f87
3 changed files with 98 additions and 9 deletions
@@ -256,9 +256,71 @@
 ; goal   : List, create, delete or verify tags.
 ; pre    : The supplied arguments are valid for git tag.
 ; post   : Git tag has completed successfully or an exception has been raised.
-; result : #t after a successful tag command.
+; result : A list of tag names with --list/-l, a list of (tag annotation)
+;          items when -n is combined with --list/-l, otherwise #t.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(def-cmd git-tag cmd-git-tag 'tag)
+(def-cmd git-tag cmd-git-tag 'tag
+  (λ (args info)
+    (let* ((split-id (format "git-cli-tag-split-~a-~a"
+                             (random 1000000000)
+                             (random 1000000000)))
+           (record-id (format "git-cli-tag-record-~a-~a"
+                              (random 1000000000)
+                              (random 1000000000)))
+           (scheme-format #f)
+           (tag-lines #f))
+      (for-each
+       (λ (e)
+         (let* ((o (format "~a" e))
+                (m (regexp-match #px"^[-]n([0-9]+)?$" o)))
+           (when (or (string=? o "--list")
+                     (string=? o "-l"))
+             (set! scheme-format #t))
+           (when m
+             (set! tag-lines
+                   (if (cadr m)
+                       (string->number (cadr m))
+                       1)))))
+       args)
+
+      (hash-set! info 'scheme-format scheme-format)
+      (hash-set! info 'tag-lines tag-lines)
+      (hash-set! info 'tag-split-id split-id)
+      (hash-set! info 'tag-record-id record-id)
+
+      (map
+       (λ (e)
+         (let* ((o (format "~a" e))
+                (m (regexp-match #px"^[-]n([0-9]+)?$" o)))
+           (if (and scheme-format m)
+               (format "--format=%(refname:strip=2)~a~a~a"
+                       split-id
+                       (if (> tag-lines 1)
+                           (format "%(contents:lines=~a)" tag-lines)
+                           "%(contents:subject)")
+                       record-id)
+               e)))
+       args)))
+
+  (λ (cmd exit-code result output out info)
+    (if (hash-ref info 'scheme-format #f)
+        (if (and (= exit-code 0) result)
+            (let ((tag-lines (hash-ref info 'tag-lines #f)))
+              (if tag-lines
+                  (let* ((split-id (hash-ref info 'tag-split-id))
+                         (record-id (hash-ref info 'tag-record-id))
+                         (text (string-join out "\n"))
+                         (records (string-split text record-id #:trim? #f)))
+                    (map
+                     (λ (record)
+                       (string-split (string-trim record) split-id #:trim? #f))
+                     (filter (λ (record)
+                               (not (string=? (string-trim record) "")))
+                             records)))
+                  out))
+            (std-process-git-result cmd exit-code result output out info))
+        (std-process-git-result cmd exit-code result output out info)))
+  )

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Display the Git commit log or return it as a Racket list.