[slime-cvs] CVS slime
heller
heller at common-lisp.net
Sat Feb 9 18:44:13 UTC 2008
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv21376
Modified Files:
ChangeLog slime.el swank.lisp
Log Message:
Limit the length of the inspector content.
That's similar to the limitation of the length of backtraces in
the debugger.
* swank.lisp (*inspectee-content*): New variable.
(content-range): New function.
(inspect-object): Use it with a length of 1000.
(inspector-range): New function. Called from Emacs.
* slime.el (slime-inspector-insert-content)
(slime-inspector-insert-range, slime-inspector-insert-range-button)
(slime-inspector-fetch-range): New functions.
(slime-inspector-operate-on-point): Handle range-buttons.
--- /project/slime/cvsroot/slime/ChangeLog 2008/02/09 18:42:34 1.1285
+++ /project/slime/cvsroot/slime/ChangeLog 2008/02/09 18:44:12 1.1286
@@ -1,5 +1,21 @@
2008-02-09 Helmut Eller <heller at common-lisp.net>
+ Limit the length of the inspector content.
+ That's similar to the limitation of the length of backtraces in
+ the debugger.
+
+ * swank.lisp (*inspectee-content*): New variable.
+ (content-range): New function.
+ (inspect-object): Use it with a length of 1000.
+ (inspector-range): New function. Called from Emacs.
+
+ * slime.el (slime-inspector-insert-content)
+ (slime-inspector-insert-range, slime-inspector-insert-range-button)
+ (slime-inspector-fetch-range): New functions.
+ (slime-inspector-operate-on-point): Handle range-buttons.
+
+2008-02-09 Helmut Eller <heller at common-lisp.net>
+
Make slime-property-bounds more useful.
* slime.el (slime-property-bounds): Remove special casing for
--- /project/slime/cvsroot/slime/slime.el 2008/02/09 18:42:35 1.903
+++ /project/slime/cvsroot/slime/slime.el 2008/02/09 18:44:12 1.904
@@ -7515,8 +7515,8 @@
(while (eq (char-before) ?\n)
(backward-delete-char 1))
(insert "\n" (fontify label "--------------------") "\n")
- (save-excursion
- (mapc slime-inspector-insert-ispec-function content))
+ (save-excursion
+ (slime-inspector-insert-content content))
(pop-to-buffer (current-buffer))
(when point
(check-type point cons)
@@ -7524,6 +7524,22 @@
(goto-line (car point))
(move-to-column (cdr point)))))))))
+(defun slime-inspector-insert-content (content)
+ (destructuring-bind (ispecs len start end) content
+ (slime-inspector-insert-range ispecs len start end t t)))
+
+(defun slime-inspector-insert-range (ispecs len start end prev next)
+ "Insert ISPECS at point.
+LEN is the length of the entire content on the Lisp side.
+START and END are the positions of the subsequnce that ISPECS represents.
+If PREV resp. NEXT are true insert range-buttons as needed."
+ (let ((limit 2000))
+ (when (and prev (> start 0))
+ (slime-inspector-insert-range-button (max 0 (- start limit)) start t))
+ (mapc #'slime-inspector-insert-ispec ispecs)
+ (when (and next (< end len))
+ (slime-inspector-insert-range-button end (min len (+ end limit)) nil))))
+
(defun slime-inspector-insert-ispec (ispec)
(if (stringp ispec)
(insert ispec)
@@ -7555,10 +7571,14 @@
(current-column))))
(defun slime-inspector-operate-on-point ()
- "If point is on a value then recursivly call the inspector on
- that value. If point is on an action then call that action."
+ "Invoke the command for the text at point.
+1. If point is on a value then recursivly call the inspector on
+that value.
+2. If point is on an action then call that action.
+3. If point is on a range-button fetch and insert the range."
(interactive)
(let ((part-number (get-text-property (point) 'slime-part-number))
+ (range-button (get-text-property (point) 'slime-range-button))
(action-number (get-text-property (point) 'slime-action-number))
(opener (lexical-let ((point (slime-inspector-position)))
(lambda (parts)
@@ -7568,6 +7588,8 @@
(slime-eval-async `(swank:inspect-nth-part ,part-number)
opener)
(push (slime-inspector-position) slime-inspector-mark-stack))
+ (range-button
+ (slime-inspector-fetch-range range-button))
(action-number
(slime-eval-async `(swank::inspector-call-nth-action ,action-number)
opener)))))
@@ -7668,7 +7690,6 @@
(progn (goto-char maxpos) (setq previously-wrapped-p t))
(error "No inspectable objects")))))))
-
(defun slime-inspector-previous-inspectable-object (arg)
"Move point to the previous inspectable object.
With optional ARG, move across that many objects.
@@ -7692,6 +7713,25 @@
(lambda (parts)
(slime-open-inspector parts point)))))
+(defun slime-inspector-insert-range-button (start end previous)
+ (slime-insert-propertized
+ (list 'slime-range-button (list start end previous)
+ 'mouse-face 'highlight
+ 'face 'slime-inspector-action-face)
+ (if previous " [--more--]\n" " [--more--]")))
+
+(defun slime-inspector-fetch-range (button)
+ (destructuring-bind (start end previous) button
+ (slime-eval-async
+ `(swank:inspector-range ,start ,end)
+ (slime-rcurry
+ (lambda (content prev)
+ (let ((inhibit-read-only t))
+ (apply #'delete-region (slime-property-bounds 'slime-range-button))
+ (destructuring-bind (i l s e) content
+ (slime-inspector-insert-range i l s e prev (not prev)))))
+ previous))))
+
(slime-define-keys slime-inspector-mode-map
([return] 'slime-inspector-operate-on-point)
((kbd "M-RET") 'slime-inspector-copy-down)
--- /project/slime/cvsroot/slime/swank.lisp 2008/02/09 18:39:02 1.528
+++ /project/slime/cvsroot/slime/swank.lisp 2008/02/09 18:44:13 1.529
@@ -2678,6 +2678,7 @@
;;;; Inspecting
(defvar *inspectee*)
+(defvar *inspectee-content*)
(defvar *inspectee-parts*)
(defvar *inspectee-actions*)
(defvar *inspector-stack*)
@@ -2685,9 +2686,10 @@
(defun reset-inspector ()
(setq *inspectee* nil
- *inspector-stack* '()
+ *inspectee-content* nil
*inspectee-parts* (make-array 10 :adjustable t :fill-pointer 0)
*inspectee-actions* (make-array 10 :adjustable t :fill-pointer 0)
+ *inspector-stack* '()
*inspector-history* (make-array 10 :adjustable t :fill-pointer 0)))
(defslimefun init-inspector (string)
@@ -2695,19 +2697,19 @@
(reset-inspector)
(inspect-object (eval (read-from-string string)))))
-(defun inspect-object (object)
- (push (setq *inspectee* object) *inspector-stack*)
- (unless (find object *inspector-history*)
- (vector-push-extend object *inspector-history*))
- (let ((*print-pretty* nil) ; print everything in the same line
+(defun inspect-object (o)
+ (push (setq *inspectee* o) *inspector-stack*)
+ (unless (find o *inspector-history*)
+ (vector-push-extend o *inspector-history*))
+ (let ((*print-pretty* nil) ; print everything in the same line
(*print-circle* t)
(*print-readably* nil))
- (multiple-value-bind (_ content) (emacs-inspect object)
- (declare (ignore _))
- (list :title (with-output-to-string (s)
- (print-unreadable-object (object s :type t :identity t)))
- :id (assign-index object *inspectee-parts*)
- :content (inspector-content content)))))
+ (setq *inspectee-content*
+ (inspector-content (nth-value 1 (emacs-inspect o)))))
+ (list :title (with-output-to-string (s)
+ (print-unreadable-object (o s :type t :identity t)))
+ :id (assign-index o *inspectee-parts*)
+ :content (content-range *inspectee-content* 0 500)))
(defun inspector-content (specs)
(loop for part in specs collect
@@ -2744,6 +2746,10 @@
(format nil "#~D=~A" pos string)
string)))
+(defun content-range (list start end)
+ (let* ((len (length list)) (end (min len end)))
+ (list (subseq list start end) len start end)))
+
(defslimefun inspector-nth-part (index)
(aref *inspectee-parts* index))
@@ -2751,6 +2757,9 @@
(with-buffer-syntax ()
(inspect-object (inspector-nth-part index))))
+(defslimefun inspector-range (from to)
+ (content-range *inspectee-content* from to))
+
(defslimefun inspector-call-nth-action (index &rest args)
(destructuring-bind (fun refreshp) (aref *inspectee-actions* index)
(apply fun args)
More information about the slime-cvs
mailing list