[slime-cvs] CVS update: slime/ChangeLog slime/slime.el slime/swank-backend.lisp slime/swank-sbcl.lisp slime/swank.lisp
Christophe Rhodes
crhodes at common-lisp.net
Tue Jul 13 18:14:04 UTC 2004
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv28961
Modified Files:
ChangeLog slime.el swank-backend.lisp swank-sbcl.lisp
swank.lisp
Log Message:
Implement actionable references in *slime-compiler-notes*. Tested with
sbcl-0.8.12 and sbcl CVS head -- I hope I haven't broken things for
non-SBCL users...
(There are some things in this that I think are suboptimal: they have
been marked with FIXMEs. I lack elispfu in sufficient measure to clean
them up confidently)
Date: Tue Jul 13 11:14:04 2004
Author: crhodes
Index: slime/ChangeLog
diff -u slime/ChangeLog:1.467 slime/ChangeLog:1.468
--- slime/ChangeLog:1.467 Mon Jul 12 03:55:19 2004
+++ slime/ChangeLog Tue Jul 13 11:14:03 2004
@@ -1,3 +1,23 @@
+2004-07-13 Christophe Rhodes <csr21 at cam.ac.uk>
+
+ * slime.el: add support for actionable references in the
+ *slime-compiler-notes* buffer.
+ (slime-merge-notes): merge references if applicable.
+ (slime-compiler-notes-mode-map): use new functions defaulting to
+ show-details, but overrideable by text properties.
+ (slime-tree-default-printer): destroy generality by assuming a
+ tree of conditions, and insert references if applicable.
+ (sldb-format-reference-source): add :amop
+
+ * swank-sbcl.lisp (signal-compiler-condition,
+ brief-compiler-message-for-emacs,
+ long-compiler-message-for-emacs): handle references in compiler
+ conditions.
+
+ * swank.lisp (make-compiler-note): propagate references.
+
+ * swank-backend.lisp (compiler-condition): add references slot.
+
2004-07-12 Luke Gorrie <luke at bluetail.com>
* slime.el (slime-easy-menu): Added "Apropos all" menu item.
Index: slime/slime.el
diff -u slime/slime.el:1.360 slime/slime.el:1.361
--- slime/slime.el:1.360 Tue Jul 13 01:08:56 2004
+++ slime/slime.el Tue Jul 13 11:14:03 2004
@@ -3066,10 +3066,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)
@@ -3166,6 +3168,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))
@@ -3203,10 +3208,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))
@@ -3222,13 +3244,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
@@ -3265,7 +3280,36 @@
(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))
+ ;; FIXME: slime-tree above is pretty general. This stuff (below) is
+ ;; tree-of-conditions specific. At the moment we only use
+ ;; slime-trees for trees-of-conditions, so that's OK, if potentially
+ ;; confusing.
+ (when-let (note (plist-get (slime-tree.plist tree) 'note))
+ (when-let (references (slime-note.references note))
+ (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
+ ;; FIXME: this is poorly factored, and shares some code and
+ ;; data with sldb that it shouldn't: notably
+ ;; sldb-reference-face. Probably the names of
+ ;; sldb-reference-foo should be altered to be not sldb
+ ;; specific.
+ (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) "-- ")
@@ -5562,12 +5606,16 @@
(member (slime-cl-symbol-name type)
'("function" "special-operator" "macro" "section" "glossary" "issue"))))
`(sldb-default-action sldb-lookup-reference
+ ;; FIXME: this is a hack! slime-compiler-notes and sldb are a
+ ;; little too intimately entwined.
+ slime-compiler-notes-default-action sldb-lookup-reference
sldb-reference ,ref
face sldb-reference-face
mouse-face highlight)))
(defun sldb-format-reference-source (where)
(case where
+ (:amop "The Art of the Metaobject Protocol")
(:ansi-cl "Common Lisp Hyperspec")
(:sbcl "SBCL Manual")
(t (format "%S" where))))
Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.61 slime/swank-backend.lisp:1.62
--- slime/swank-backend.lisp:1.61 Sat Jul 3 20:21:43 2004
+++ slime/swank-backend.lisp Tue Jul 13 11:14:03 2004
@@ -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: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.94 slime/swank-sbcl.lisp:1.95
--- slime/swank-sbcl.lisp:1.94 Wed Jun 30 06:45:32 2004
+++ slime/swank-sbcl.lisp Tue Jul 13 11:14:03 2004
@@ -178,11 +178,23 @@
(style-warning :style-warning)
(warning :warning))
:short-message (brief-compiler-message-for-emacs condition)
+ :references
+ ;; FIXME: delete the reader conditionaloid after sbcl
+ ;; 0.8.13 is released.
+ #+#.(cl:if (cl:find-symbol "ENCAPSULATED-CONDITION" "SB-INT")
+ '(and) '(or))
+ (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)))
+ #-#.(cl:if (cl:find-symbol "ENCAPSULATED-CONDITION" "SB-INT")
+ '(and) '(or))
+ (when (typep condition 'sb-int:reference-condition)
+ (sb-int:reference-condition-references condition))
: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 +250,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 +260,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: slime/swank.lisp
diff -u slime/swank.lisp:1.212 slime/swank.lisp:1.213
--- slime/swank.lisp:1.212 Mon Jul 12 03:35:22 2004
+++ slime/swank.lisp Tue Jul 13 11:14:03 2004
@@ -1469,6 +1469,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)))))
More information about the slime-cvs
mailing list