diff --git a/collects/stepper/private/find-tag.rkt b/collects/stepper/private/find-tag.rkt
new file mode 100644
index 0000000000..8f08b9d248
--- /dev/null
+++ b/collects/stepper/private/find-tag.rkt
@@ -0,0 +1,52 @@
+#lang racket/base
+(require racket/class
+         racket/gui/base
+         racket/contract)
+
+(provide/contract 
+ [find-tag 
+  (-> (is-a?/c text%)
+      exact-nonnegative-integer?
+      (or/c #f string?))])
+
+;; finds the name of the XML tag just before `start' in `text'.
+;; returns the tag name, with no trailing space of > or anything like that.
+(define (find-tag text start)
+  ;; loop iterates backwards, searching for #\<
+  ;; when it finds it, it gets the string starting
+  ;; there, forwards to last-space (if there was a space)
+  ;; or start-1.
+  ;; If there is a #\/ or a #\> just after the #\<, return #f
+  ;; (in that case, they are typing a close tag or closing an empty tag)
+  ;; this technique gleaned from the spec at:
+  ;;  http://www.w3.org/TR/2000/REC-xml-20001006
+  ;; If there are two hyphens after the #\<, then assume this is a
+  ;; comment and just give up.
+  (let loop ([pos (- start 2)]
+             [last-space #f])
+    (cond
+      [(< pos 0) #f]
+      [else
+       (let ([char (send text get-character pos)])
+         (case char
+           [(#\>) #f]
+           [(#\/) (if last-space
+                      (loop (- pos 1) last-space)
+                      #f)]
+           [(#\<) 
+            (cond
+              [(or (char=? (send text get-character (+ pos 1)) #\/)
+                   (char=? (send text get-character (+ pos 1)) #\>))
+               ;;technique gleaned, as above
+               #f]
+              [(and (< (+ pos 3) (send text last-position))
+                    (char=? (send text get-character (+ pos 1)) #\!)
+                    (char=? (send text get-character (+ pos 2)) #\-)
+                    (char=? (send text get-character (+ pos 3)) #\-))
+               ;; comment, just give up
+               #f]
+              [else
+               (send text get-text (+ pos 1) (or last-space (- start 1)))])]
+           [(#\space #\return #\newline #\tab)
+            (loop (- pos 1) pos)]
+           [else (loop (- pos 1) last-space)]))])))
\ No newline at end of file
diff --git a/collects/stepper/xml-tool.rkt b/collects/stepper/xml-tool.rkt
index 84208c660b..c29fe32f90 100644
--- a/collects/stepper/xml-tool.rkt
+++ b/collects/stepper/xml-tool.rkt
@@ -1,6 +1,7 @@
 
 (module xml-tool mzscheme
-  (require "private/xml-snip-helpers.ss"
+  (require "private/xml-snip-helpers.rkt"
+           "private/find-tag.rkt"
            "xml-sig.ss"
            mzlib/unit
            mzlib/contract
@@ -333,40 +334,8 @@
             (send text insert ">")
             (send text set-position start)))
         (send text end-edit-sequence))
-      
-      ;; find-tag : (is-a?/c text%) number? -> (union false? string?)
-      ;; finds the name of the XML tag just before `start' in `text'.
-      ;; returns the tag name, with no trailing space of > or anything like that.
-      (define (find-tag text start)
-        ;; loop iterates backwards, searching for #\<
-        ;; when it finds it, it gets the string starting
-        ;; there, forwards to last-space (if there was a space)
-        ;; or start-1.
-        ;; If there is a #\/ or a #\> just after the #\<, return #f
-        ;; (in that case, they are typing a close tag or closing an empty tag)
-        ;; this technique gleaned from the spec at:
-        ;;  http://www.w3.org/TR/2000/REC-xml-20001006
-        (let loop ([pos (- start 2)]
-                   [last-space #f])
-          (cond
-            [(< pos 0) #f]
-            [else
-             (let ([char (send text get-character pos)])
-               (case char
-                 [(#\>) #f]
-                 [(#\/) (if last-space
-                            (loop (- pos 1) last-space)
-                            #f)]
-                 [(#\<) 
-                  (if (or (char=? (send text get-character (+ pos 1)) #\/)
-                          (char=? (send text get-character (+ pos 1)) #\>))
-                      #f
-                      (send text get-text (+ pos 1) (or last-space (- start 1))))]
-                 [(#\space #\return #\newline #\tab)
-                  (loop (- pos 1) pos)]
-                 [else (loop (- pos 1) last-space)]))])))
-      
-      (define (xml-box-frame-extension super%)
+
+    (define (xml-box-frame-extension super%)
         (class super%
           (inherit get-editor register-capability-menu-item get-insert-menu get-edit-target-object)
           
diff --git a/collects/tests/stepper/find-tag-test.rkt b/collects/tests/stepper/find-tag-test.rkt
new file mode 100644
index 0000000000..39a648a64e
--- /dev/null
+++ b/collects/tests/stepper/find-tag-test.rkt
@@ -0,0 +1,26 @@
+#lang racket/base
+(require stepper/private/find-tag
+         racket/gui/base
+         rackunit
+         racket/class)
+
+(define (mk-txt str)
+  (define t (new text%))
+  (send t insert str)
+  t)
+
+(define (find-tag/end str)
+  (find-tag (mk-txt str) (string-length str)))
+
+(check-equal? (find-tag/end "<a>") "a")
+(check-equal? (find-tag/end "<abcdef>") "abcdef")
+(check-equal? (find-tag/end "<abcdef x=\"3\">") "abcdef")
+
+(check-equal? (find-tag/end "<a></a>") #f)
+
+(check-equal? (find-tag/end "<!-- whatever -->") #f)
+(check-equal? (find-tag/end "<!--whatever -->") #f)
+(check-equal? (find-tag/end "<!--whatever-->") #f)
+(check-equal? (find-tag/end "<!-->") #f)
+
+(check-equal? (find-tag/end "<>") #f)