commit - 8014bde1e7ea7f7d61b9cbd5907e41413ed7a36f
commit + 6ab1c7b4401cfbb856b00bb6e6690620a20a52f7
blob - f70e0482c9b38f1b2524dea53552da28d8dd5592
blob + fadebe6ce424e646701af757de63eb0bbcb60031
--- vc-got.el
+++ vc-got.el
@@ -89,9 +89,7 @@
 ;; - mergebase                          NOT IMPLEMENTED
 ;;
 ;; TAG SYSTEM
-;; - create-tag                         PARTIALLY IMPLEMENTED
-;;      figure out how to read a message for the tag; can only create
-;;      branches.
+;; - create-tag                         DONE
 ;; - retrieve-tag                       NOT IMPLEMENTED
 ;;
 ;; MISCELLANEOUS                        NOT IMPLEMENTED
@@ -798,16 +796,35 @@ Value is returned as floating point fractional number 
 
 
 ;; Tag system
+
+(defun vc-got--tag-callback (tag)
+  "`log-edit' callback for `vc-got-create-tag'.
+Creates the TAG using the content of the current buffer."
+  (interactive)
+  (let ((msg (buffer-substring-no-properties (point-min)
+                                             (point-max))))
+    (with-temp-buffer
+      (unless (zerop (vc-got--call "tag" "-m" msg tag))
+        (error "[vc-got] can't create tag %s: %s" tag (buffer-string))))))
 
 (defun vc-got-create-tag (_dir name branchp)
   "Attach the tag NAME to the state of the worktree.
-DIR is ignored (tags are global, not per-file).
-If BRANCHP is true, NAME should create a new branch."
+DIR is ignored (tags are global, not per-file).  If BRANCHP is
+true, NAME should create a new branch otherwise it will pop-up a
+`log-edit' buffer to provide the tag message."
   ;; TODO: vc reccomends to ensure that all the file are in a clean
   ;; state, but is it useful?
   (if branchp
       (vc-got--branch name)
-    (error "[vc-got] create tags is not implemented (yet)")))
+    (let ((buf (get-buffer-create "*vc-got tag*")))
+      (with-current-buffer buf
+        (erase-buffer)
+        (switch-to-buffer buf)
+        (log-edit (lambda ()
+                    (interactive)
+                    (unwind-protect
+                        (vc-got--tag-callback name)
+                      (kill-buffer buf))))))))
 
 
 ;; Miscellaneous