Index: slime.el
===================================================================
RCS file: /project/slime/cvsroot/slime/slime.el,v
retrieving revision 1.358
diff -u -r1.358 slime.el
--- slime.el	9 Jul 2004 12:09:18 -0000	1.358
+++ slime.el	9 Jul 2004 15:22:19 -0000
@@ -3058,10 +3058,12 @@
   "Merge NOTES together. Keep the highest severity, concatenate the messages."
   (let* ((new-severity (reduce #'slime-most-severe notes
                                :key #'slime-note.severity))
-         (new-message (mapconcat #'slime-note.message notes "\n")))
+         (new-message (mapconcat #'slime-note.message notes "\n"))
+         (new-references (reduce #'append notes :key #'slime-note.references)))
     (let ((new-note (copy-list (car notes))))
       (setf (getf new-note :message) new-message)
       (setf (getf new-note :severity) new-severity)
+      (setf (getf new-note :references) new-references)
       new-note)))
 
 (defun slime-intersperse (element list)
@@ -3158,6 +3160,9 @@
   (or (plist-get note :short-message)
       (plist-get note :message)))
 
+(defun slime-note.references (note)
+  (plist-get note :references))
+
 (defun slime-note.location (note)
   (plist-get note :location))
 
@@ -3195,10 +3200,27 @@
   (slime-set-truncate-lines))
 
 (slime-define-keys slime-compiler-notes-mode-map
-  ((kbd "RET") 'slime-compiler-notes-show-details)
-  ([mouse-2] 'slime-compiler-notes-show-details/mouse)
+  ((kbd "RET") 'slime-compiler-notes-default-action-or-show-details)
+  ([mouse-2] 'slime-compiler-notes-default-action-or-show-details/mouse)
   ("q" 'slime-compiler-notes-quit))
 
+(defun slime-compiler-notes-default-action-or-show-details/mouse (event)
+  "Invoke the action pointed at by the mouse, or show details."
+  (interactive "e")
+  (destructuring-bind (mouse-2 (w pos &rest _) &rest __) event
+    (save-excursion
+      (goto-char pos)
+      (let ((fn (get-text-property (point) 
+                                   'slime-compiler-notes-default-action)))
+	(if fn (funcall fn) (slime-compiler-notes-show-details))))))
+
+(defun slime-compiler-notes-default-action-or-show-details ()
+  "Invoke the action at point, or show details."
+  (interactive)
+  (let ((fn (get-text-property (point) 
+                               'slime-compiler-notes-default-action)))
+    (if fn (funcall fn) (slime-compiler-notes-show-details))))
+
 (defun slime-compiler-notes-quit ()
   (interactive)
   (let ((config slime-compiler-notes-saved-window-configuration))
@@ -3214,13 +3236,6 @@
            (slime-tree-toggle tree))
           (t
            (slime-show-source-location (slime-note.location note))))))
-
-(defun slime-compiler-notes-show-details/mouse (event)
-  (interactive "e")
-  (destructuring-bind (mouse-2 (w pos &rest _) &rest __) event
-    (goto-char pos)
-    (slime-compiler-notes-show-details)))
-          
 
 ;;;;;;; Tree Widget
 
@@ -3257,7 +3272,29 @@
   (not (slime-tree.kids tree)))
 
 (defun slime-tree-default-printer (tree)
-  (princ (slime-tree.item tree) (current-buffer)))
+  (princ (slime-tree.item tree) (current-buffer))
+  (let ((note (plist-get (slime-tree.plist tree) 'note)))
+    (when note
+      (let ((references (slime-note.references note)))
+        (when references
+          (terpri (current-buffer))
+          (princ "See also:" (current-buffer))
+          (terpri (current-buffer))
+          (slime-tree-insert-references references))))))
+
+(defun slime-tree-insert-references (references)
+  "Insert documentation references from a condition.
+See SWANK-BACKEND:CONDITION-REFERENCES for the datatype."
+  (loop for refs on references
+        for ref = (car refs)
+        do
+        (destructuring-bind (where type what) ref
+          (insert "  " (sldb-format-reference-source where) ", ")
+          (slime-insert-propertized (sldb-reference-properties where type what)
+                                    (sldb-format-reference-node what))
+          (insert (format " [%s]" (slime-cl-symbol-name type)))
+          (when (cdr refs)
+            (terpri (current-buffer))))))
 
 (defun slime-tree-decoration (tree)
   (cond ((slime-tree-leaf-p tree) "-- ")
@@ -5554,6 +5591,7 @@
                (member (slime-cl-symbol-name type)
                        '("function" "special-operator" "macro" "section" "glossary" "issue"))))
       `(sldb-default-action sldb-lookup-reference
+        slime-compiler-notes-default-action sldb-lookup-reference
                             sldb-reference ,ref
                             face sldb-reference-face
                             mouse-face highlight)))
@@ -5569,7 +5607,7 @@
       (upcase (slime-cl-symbol-name what))
     (if (listp what)
         (mapconcat (lambda (x) (format "%S" x)) what ".")
-      what)))
+        what)))
 
 (defun sldb-lookup-reference ()
   "Browse the documentation reference at point."
Index: swank-backend.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-backend.lisp,v
retrieving revision 1.61
diff -u -r1.61 swank-backend.lisp
--- swank-backend.lisp	4 Jul 2004 03:21:43 -0000	1.61
+++ swank-backend.lisp	9 Jul 2004 15:22:19 -0000
@@ -25,6 +25,7 @@
            #:position-pos
            #:print-output-to-string
            #:quit-lisp
+           #:references
            #:unbound-slot-filler))
 
 (in-package :swank-backend)
@@ -238,6 +239,10 @@
    (short-message :initarg :short-message
                   :initform nil
                   :accessor short-message)
+
+   (references :initarg :references
+               :initform nil
+               :accessor references)
 
    (location :initarg :location
              :accessor location)))
Index: swank-sbcl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-sbcl.lisp,v
retrieving revision 1.94
diff -u -r1.94 swank-sbcl.lisp
--- swank-sbcl.lisp	30 Jun 2004 13:45:32 -0000	1.94
+++ swank-sbcl.lisp	9 Jul 2004 15:22:20 -0000
@@ -178,11 +178,14 @@
                        (style-warning        :style-warning)
                        (warning              :warning))
            :short-message (brief-compiler-message-for-emacs condition)
+           :references (let ((c (if (typep condition 'sb-int:encapsulated-condition)
+                                    (sb-int:encapsulated-condition condition)
+                                    condition)))
+                         (when (typep c 'sb-int:reference-condition)
+                           (sb-int:reference-condition-references c)))
            :message (long-compiler-message-for-emacs condition context)
            :location (compiler-note-location context))))
 
-
-
 (defun compiler-note-location (context)
   (cond (context
          (resolve-note-location
@@ -238,7 +241,8 @@
 When Emacs presents the message it already has the source popped up
 and the source form highlighted. This makes much of the information in
 the error-context redundant."
-  (princ-to-string condition))
+  (let ((sb-int:*print-condition-references* nil))
+    (princ-to-string condition)))
 
 (defun long-compiler-message-for-emacs (condition error-context)
   "Describe a compiler error for Emacs including context information."
@@ -247,8 +251,9 @@
       (if error-context
           (values (sb-c::compiler-error-context-enclosing-source error-context)
                   (sb-c::compiler-error-context-source error-context)))
-    (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~%~}~]~A"
-            enclosing source condition)))
+    (let ((sb-int:*print-condition-references* nil))
+      (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~%~}~]~A"
+              enclosing source condition))))
 
 (defun current-compiler-error-source-path (context)
   "Return the source-path for the current compiler error.
Index: swank.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank.lisp,v
retrieving revision 1.210
diff -u -r1.210 swank.lisp
--- swank.lisp	7 Jul 2004 15:09:33 -0000	1.210
+++ swank.lisp	9 Jul 2004 15:22:21 -0000
@@ -1438,6 +1438,7 @@
   (list* :message (message condition)
          :severity (severity condition)
          :location (location condition)
+         :references (references condition)
          (let ((s (short-message condition)))
            (if s (list :short-message s)))))
 
