From 553d628491c2503886715b788a93c7ebe6586bae Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 14 Dec 2007 22:58:31 +0000
Subject: [PATCH] fixed PR 9107

svn: r8013
---
 collects/drscheme/syncheck.ss | 63 ++++++++++++++++++-----------------
 1 file changed, 33 insertions(+), 30 deletions(-)

diff --git a/collects/drscheme/syncheck.ss b/collects/drscheme/syncheck.ss
index 35ed464bc8..9a11ed83c8 100644
--- a/collects/drscheme/syncheck.ss
+++ b/collects/drscheme/syncheck.ss
@@ -2368,36 +2368,39 @@ If the namespace does not, they are colored the unbound color.
     
     ;; document-variable : stx identifier-binding -> void
     (define (document-variable stx get-binding)
-      (let ([defs-frame (currently-processing-drscheme-frame)])
-        (when defs-frame
-          (let* ([defs-text (send defs-frame get-definitions-text)]
-                 [binding-info (get-binding stx)])
-            (when (pair? binding-info)
-              (let* ([start (- (syntax-position stx) 1)]
-                     [fin (+ start (syntax-span stx))]
-                     [source-mod (list-ref binding-info 0)]
-                     [source-id (list-ref binding-info 1)]
-                     [definition-tag (xref-binding->definition-tag (get-xref) source-mod source-id)])
-                (when definition-tag
-                  (let-values ([(path tag) (xref-tag->path+anchor (get-xref) definition-tag)])
-                    (when path
-                      (send defs-text syncheck:add-background-color defs-text "navajowhite" start fin (syntax-e stx))
-                      (send defs-text syncheck:add-menu
-                            defs-text
-                            start 
-                            fin 
-                            (syntax-e stx)
-                            (λ (menu)
-                              (instantiate menu-item% ()
-                                (parent menu)
-                                (label (format (string-constant cs-view-docs) source-id))
-                                (callback
-                                 (λ (x y)
-                                   (send-url (format "file://~a~a"
-                                                     (path->string path) 
-                                                     (if tag
-                                                         (string-append "#" (uri-encode tag))
-                                                         "")))))))))))))))))
+      (when (syntax-original? stx)
+        (let ([defs-frame (currently-processing-drscheme-frame)])
+          (when defs-frame
+            (let* ([defs-text (send defs-frame get-definitions-text)]
+                   [binding-info (get-binding stx)])
+              (when (and (pair? binding-info)
+                         (syntax-position stx)
+                         (syntax-span stx))
+                (let* ([start (- (syntax-position stx) 1)]
+                       [fin (+ start (syntax-span stx))]
+                       [source-mod (list-ref binding-info 0)]
+                       [source-id (list-ref binding-info 1)]
+                       [definition-tag (xref-binding->definition-tag (get-xref) source-mod source-id)])
+                  (when definition-tag
+                    (let-values ([(path tag) (xref-tag->path+anchor (get-xref) definition-tag)])
+                      (when path
+                        (send defs-text syncheck:add-background-color defs-text "navajowhite" start fin (syntax-e stx))
+                        (send defs-text syncheck:add-menu
+                              defs-text
+                              start 
+                              fin 
+                              (syntax-e stx)
+                              (λ (menu)
+                                (instantiate menu-item% ()
+                                  (parent menu)
+                                  (label (format (string-constant cs-view-docs) source-id))
+                                  (callback
+                                   (λ (x y)
+                                     (send-url (format "file://~a~a"
+                                                       (path->string path) 
+                                                       (if tag
+                                                           (string-append "#" (uri-encode tag))
+                                                           ""))))))))))))))))))