[slime-cvs] CVS slime
heller
heller at common-lisp.net
Mon Sep 10 15:39:05 UTC 2007
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv18471
Modified Files:
ChangeLog slime.el swank.lisp swank-backend.lisp
swank-allegro.lisp swank-sbcl.lisp
Log Message:
Move SBCL doc references to contrib.
* slime.el (sldb-insert-condition): Merge REFERENCES and EXTRAS.
(sldb-extras-hooks, sldb-dispatch-extras): New hook.
* swank.lisp (debugger-condition-for-emacs): Merge REFERENCES and EXTRAS.
* swank-backend.lisp (condition-references): Removed. Merged with
condition-extras.
* swank-sbcl.lisp (condition-references): Removed.
(condition-extras): Include references.
(externalize-reference): New function. Don't return plain
symbols.
* swank-allegro.lisp (condition-references): Removed.
* contrib/slime-references.el: New file.
--- /project/slime/cvsroot/slime/ChangeLog 2007/09/10 00:42:56 1.1208
+++ /project/slime/cvsroot/slime/ChangeLog 2007/09/10 15:39:04 1.1209
@@ -1,3 +1,20 @@
+2007-09-10 Helmut Eller <heller at common-lisp.net>
+
+ Move SBCL doc references to contrib.
+
+ * slime.el (sldb-insert-condition): Merge REFERENCES and EXTRAS.
+ (sldb-extras-hooks, sldb-dispatch-extras): New hook.
+
+ * swank-backend.lisp (condition-references): Removed. Merged with
+ condition-extras.
+
+ * swank-sbcl.lisp (condition-references): Removed.
+ (condition-extras): Include references.
+ (externalize-reference): New function. Don't return plain
+ symbols.
+
+ * swank-allegro.lisp (condition-references): Removed.
+
2007-09-10 Tobias C. Rittweiler <tcr at freebits.de>
* slime.el (slime-cl-symbol-name, slime-cl-symbol-package):
@@ -44,7 +61,7 @@
Fix message displaying on XEmacs. Reported by Steven E. Harris,
and Ken Causey.
-
+
* slime.el (slime-display-message): Resurrect secondary
`buffer-name' argument which got lost in 2007-08-24.
(slime-format-display-message): Resurrect passing "*SLIME Note*"
@@ -53,7 +70,7 @@
2007-09-08 Matt Pillsbury <mtbp at rci.rutgers.edu>
* swank-backend.lisp (definterface): Updated docstring.
-
+
2007-09-06 Matthias Koeppe <mkoeppe at mail.math.uni-magdeburg.de>
* slime.el (slime-repl-write-string): Use case, not ecase, for
--- /project/slime/cvsroot/slime/slime.el 2007/09/10 00:42:25 1.855
+++ /project/slime/cvsroot/slime/slime.el 2007/09/10 15:39:05 1.856
@@ -387,8 +387,7 @@
"function names and arguments in a detailed (expanded) frame")
(local-name "local variable names")
(local-value "local variable values")
- (catch-tag "catch tags")
- (reference "documentation references" '(:underline t)))
+ (catch-tag "catch tags"))
;;;;; slime-repl
@@ -4155,12 +4154,10 @@
"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.short-message notes "\n"))
- (new-references (reduce #'append notes :key #'slime-note.references)))
+ (new-message (mapconcat #'slime-note.short-message notes "\n")))
(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)))
;; XXX: unused function
@@ -4204,8 +4201,8 @@
(defun slime-maybe-list-compiler-notes (notes &optional emacs-snapshot)
"Show the compiler notes if appropriate."
- ;; don't pop up a buffer if all notes will are already annotated in
- ;; the buffer itself
+ ;; don't pop up a buffer if all notes are already annotated in the
+ ;; buffer itself
(unless (every #'slime-note-has-location-p notes)
(slime-list-compiler-notes notes emacs-snapshot)))
@@ -4228,8 +4225,8 @@
(goto-char (point-min)))))
(defun slime-alistify (list key test)
- "Partition the elements of LIST into an alist. KEY extracts the key
-from an element and TEST is used to compare keys."
+ "Partition the elements of LIST into an alist.
+KEY extracts the key from an element and TEST is used to compare keys."
(declare (type function key))
(let ((alist '()))
(dolist (e list)
@@ -4252,9 +4249,6 @@
(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))
@@ -4266,12 +4260,12 @@
(:read-error "Read Errors")
(:style-warning "Style Warnings")))
+(defvar slime-tree-printer 'slime-tree-default-printer)
+
(defun slime-tree-for-note (note)
(make-slime-tree :item (slime-note.message note)
:plist (list 'note note)
- :print-fn (if (slime-note.references note)
- 'slime-tree-print-with-references
- 'slime-tree-default-printer)))
+ :print-fn slime-tree-printer))
(defun slime-tree-for-severity (severity notes collapsed-p)
(make-slime-tree :item (format "%s (%d)"
@@ -4345,35 +4339,6 @@
(defun slime-tree-default-printer (tree)
(princ (slime-tree.item tree) (current-buffer)))
-(defun slime-tree-print-with-references (tree)
- ;; for SBCL-style references
- (slime-tree-default-printer tree)
- (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 ref)
- (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) "-- ")
((slime-tree.collapsed-p tree) "[+] ")
@@ -4452,9 +4417,9 @@
(goto-char start)
(let ((severity (plist-get note :severity))
(message (plist-get note :message))
- (appropriate-overlay (slime-note-at-point)))
- (if appropriate-overlay
- (slime-merge-note-into-overlay appropriate-overlay severity message)
+ (overlay (slime-note-at-point)))
+ (if overlay
+ (slime-merge-note-into-overlay overlay severity message)
(slime-create-note-overlay note start end severity message))))))
(defun slime-create-note-overlay (note start end severity message)
@@ -6810,10 +6775,9 @@
(defun sldb-insert-condition (condition)
"Insert the text for CONDITION.
-CONDITION should be a list (MESSAGE TYPE REFERENCES EXTRAS).
-REFERENCES a references to additional documentation.
+CONDITION should be a list (MESSAGE TYPE EXTRAS).
EXTRAS is currently used for the stepper."
- (destructuring-bind (message type references extras) condition
+ (destructuring-bind (message type extras) condition
(when (> (length message) 70)
(add-text-properties 0 (length message) (list 'help-echo message)
message))
@@ -6821,19 +6785,20 @@
(in-sldb-face topline message)
"\n"
(in-sldb-face condition type))
- (when references
- (insert "See also:\n")
- (slime-with-rigid-indentation 2
- (sldb-insert-references references))
- (insert "\n"))
(sldb-dispatch-extras extras)))
+(defvar sldb-extras-hooks)
+
(defun sldb-dispatch-extras (extras)
;; this is (mis-)used for the stepper
(dolist (extra extras)
(destructure-case extra
((:show-frame-source n)
- (sldb-show-frame-source n)))))
+ (sldb-show-frame-source n))
+ (t
+ (or (run-hook-with-args-until-success sldb-extras-hooks extra)
+ ;;(error "Unhandled extra element:" extra)
+ )))))
(defun sldb-insert-restarts (restarts)
"Insert RESTARTS and add the needed text props
@@ -7396,74 +7361,6 @@
((:abort)))))
-;;;;; SLDB references (rather SBCL specific)
-
-(defun sldb-insert-references (references)
- "Insert documentation references from a condition.
-See SWANK-BACKEND:CONDITION-REFERENCES for the datatype."
- (loop for ref in references do
- (destructuring-bind (where type what) ref
- (insert (sldb-format-reference-source where) ", ")
- (slime-insert-propertized (sldb-reference-properties ref)
- (sldb-format-reference-node what))
- (insert (format " [%s]" (slime-cl-symbol-name type)) "\n"))))
-
-(defun sldb-reference-properties (reference)
- "Return the properties for a reference.
-Only add clickability to properties we actually know how to lookup."
- (destructuring-bind (where type what) reference
- (if (or (and (eq where :sbcl) (eq type :node))
- (and (eq where :ansi-cl)
- (symbolp type)
- (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 ,reference
- 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))))
-
-(defun sldb-format-reference-node (what)
- (if (symbolp what)
- (upcase (slime-cl-symbol-name what))
- (if (listp what)
- (mapconcat (lambda (x) (format "%S" x)) what ".")
- what)))
-
-(defun sldb-lookup-reference ()
- "Browse the documentation reference at point."
- (destructuring-bind (where type what)
- (get-text-property (point) 'sldb-reference)
- (case where
- (:ansi-cl
- (case type
- (:section
- (browse-url (funcall common-lisp-hyperspec-section-fun what)))
- (:glossary
- (browse-url (funcall common-lisp-glossary-fun what)))
- (:issue
- (browse-url (funcall 'common-lisp-issuex what)))
- (t
- (hyperspec-lookup (if (symbolp what)
- (slime-cl-symbol-name what)
- what)))))
- (t
- (let ((url (format "%s%s.html" slime-sbcl-manual-root
- (subst-char-in-string ?\ ?\- what))))
- (browse-url url))))))
-
-
;;;; Thread control panel
(defun slime-list-threads ()
--- /project/slime/cvsroot/slime/swank.lisp 2007/09/04 10:32:05 1.509
+++ /project/slime/cvsroot/slime/swank.lisp 2007/09/10 15:39:05 1.510
@@ -2003,7 +2003,6 @@
(list (safe-condition-message *swank-debugger-condition*)
(format nil " [Condition of type ~S]"
(type-of *swank-debugger-condition*))
- (condition-references *swank-debugger-condition*)
(condition-extras *swank-debugger-condition*)))
(defun format-restarts-for-emacs ()
--- /project/slime/cvsroot/slime/swank-backend.lisp 2007/09/08 21:37:21 1.125
+++ /project/slime/cvsroot/slime/swank-backend.lisp 2007/09/10 15:39:05 1.126
@@ -686,20 +686,12 @@
"Format a condition for display in SLDB."
(princ-to-string condition))
-(definterface condition-references (condition)
- "Return a list of documentation references for a condition.
-Each reference is one of:
- (:ANSI-CL
- {:FUNCTION | :SPECIAL-OPERATOR | :MACRO | :SECTION | :GLOSSARY }
- symbol-or-name)
- (:SBCL :NODE node-name)"
- (declare (ignore condition))
- '())
-
(definterface condition-extras (condition)
"Return a list of extra for the debugger.
The allowed elements are of the form:
- (:SHOW-FRAME-SOURCE frame-number)"
+ (:SHOW-FRAME-SOURCE frame-number)
+ (:REFERENCES &rest refs)
+"
(declare (ignore condition))
'())
--- /project/slime/cvsroot/slime/swank-allegro.lisp 2007/08/23 19:03:37 1.96
+++ /project/slime/cvsroot/slime/swank-allegro.lisp 2007/09/10 15:39:05 1.97
@@ -66,10 +66,6 @@
(defimplementation format-sldb-condition (c)
(princ-to-string c))
-(defimplementation condition-references (c)
- (declare (ignore c))
- '())
-
(defimplementation call-with-syntax-hooks (fn)
(funcall fn))
--- /project/slime/cvsroot/slime/swank-sbcl.lisp 2007/09/04 09:49:09 1.182
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2007/09/10 15:39:05 1.183
@@ -691,10 +691,25 @@
(defimplementation install-debugger-globally (function)
(setq sb-ext:*invoke-debugger-hook* function))
-#+#.(swank-backend::sbcl-with-new-stepper-p)
(defimplementation condition-extras (condition)
- (when (typep condition 'sb-impl::step-form-condition)
- `((:show-frame-source 0))))
+ (cond #+#.(swank-backend::sbcl-with-new-stepper-p)
+ ((typep condition 'sb-impl::step-form-condition)
+ `((:show-frame-source 0)))
+ ((typep condition 'sb-int:reference-condition)
+ (let ((refs (sb-int:reference-condition-references condition)))
+ (if refs
+ `((:references ,(externalize-reference refs))))))))
+
+(defun externalize-reference (ref)
+ (etypecase ref
+ (null nil)
+ (cons (cons (externalize-reference (car ref))
+ (externalize-reference (cdr ref))))
+ ((or string number) ref)
+ (symbol
+ (cond ((eq (symbol-package ref) (symbol-package :test))
+ ref)
+ (t (symbol-name ref))))))
(defimplementation call-with-debugging-environment (debugger-loop-fn)
(declare (type function debugger-loop-fn))
@@ -946,11 +961,6 @@
(let ((sb-int:*print-condition-references* nil))
(princ-to-string condition)))
-(defimplementation condition-references (condition)
- (if (typep condition 'sb-int:reference-condition)
- (sb-int:reference-condition-references condition)
- '()))
-
;;;; Profiling
More information about the slime-cvs
mailing list