[slime-cvs] CVS update: slime/ChangeLog slime/slime.el slime/swank.lisp slime/swank-openmcl.lisp
Alan Ruttenberg
aruttenberg at common-lisp.net
Tue Sep 13 05:37:23 UTC 2005
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv13328/slime
Modified Files:
ChangeLog slime.el swank.lisp swank-openmcl.lisp
Log Message:
Date: Tue Sep 13 07:37:22 2005
Author: aruttenberg
Index: slime/ChangeLog
diff -u slime/ChangeLog:1.776 slime/ChangeLog:1.777
--- slime/ChangeLog:1.776 Tue Sep 13 06:14:53 2005
+++ slime/ChangeLog Tue Sep 13 07:37:16 2005
@@ -1,6 +1,29 @@
2005-09-13 Alan Ruttenberg <alanr-l at mumble.net>
+
* slime.el (defcustom slime-ed-use-dedicated-frame ... vs defvar
- * swank.lisp (run-repl-eval-hooks .. finally (return vs no return
+
+ (defcustom slime-when-complete-filename-expand: Use
+ comint-replace-by-expanded-filename instead of
+ comint-dynamic-complete-as-filename to complete file names
+
+ * swank.lisp (run-repl-eval-hooks .. finally (return vs no return
+
+ inspector-call-nth-action Allow second value :replace for inspector actions
+
+ (defvar *slime-inspect-contents-limit* default nil. How many elements of
+ a hash table or array to show by default. If table has more than
+ this then offer actions to view more. Set to nil for no limit. Probably should
+ set default to reasonable value - I like 200.
+
+ (inspect-for-emacs ((ht hash-table) inspector)) - banner line is hash table object.
+ Respect *slime-inspect-contents-limit*
+
+ (defmethod inspect-for-emacs ((array array) inspector)
+ Respect *slime-inspect-contents-limit*
+
+ * swank-openmcl.lisp inspector for closures shows closed-over
+ values. To be fixed: inspector-princ needs to be loaded earlier
+ since swank package not available when compiling
2005-09-13 Helmut Eller <heller at common-lisp.net>
Index: slime/slime.el
diff -u slime/slime.el:1.543 slime/slime.el:1.544
--- slime/slime.el:1.543 Tue Sep 13 06:14:53 2005
+++ slime/slime.el Tue Sep 13 07:37:16 2005
@@ -205,6 +205,11 @@
(const :tag "Compound" slime-complete-symbol*)
(const :tag "Fuzzy" slime-fuzzy-complete-symbol)))
+(defcustom slime-when-complete-filename-expand nil
+ "Use comint-replace-by-expanded-filename instead of comint-dynamic-complete-as-filename to complete file names"
+ :group 'slime-mode
+ :type 'boolean)
+
(defcustom slime-complete-symbol*-fancy nil
"Use information from argument lists for DWIM'ish symbol completion."
:group 'slime-mode
@@ -5337,7 +5342,9 @@
Return nil iff if point is not at filename."
(if (save-excursion (re-search-backward "\"[^ \t\n]+\\=" nil t))
(let ((comint-completion-addsuffix '("/" . "\"")))
- (comint-dynamic-complete-as-filename)
+ (if slime-when-complete-filename-expand
+ (comint-replace-by-expanded-filename)
+ (comint-dynamic-complete-as-filename))
t)
nil))
@@ -5471,7 +5478,9 @@
(interactive)
(when (save-excursion (re-search-backward "\"[^ \t\n]+\\=" nil t))
(return-from slime-fuzzy-complete-symbol
- (comint-dynamic-complete-as-filename)))
+ (if slime-when-complete-filename-expand
+ (comint-replace-by-expanded-filename)
+ (comint-dynamic-complete-as-filename))))
(let* ((end (move-marker (make-marker) (slime-symbol-end-pos)))
(beg (move-marker (make-marker) (slime-symbol-start-pos)))
(prefix (buffer-substring-no-properties beg end))
@@ -5884,7 +5893,7 @@
(defcustom slime-ed-use-dedicated-frame t
"*When non-nil, `slime-ed' will create and reuse a dedicated frame."
:type 'boolean
- :group 'slime)
+ :group 'slime-mode)
(defun slime-ed (what)
"Edit WHAT.
Index: slime/swank.lisp
diff -u slime/swank.lisp:1.333 slime/swank.lisp:1.334
--- slime/swank.lisp:1.333 Tue Sep 13 06:14:53 2005
+++ slime/swank.lisp Tue Sep 13 07:37:16 2005
@@ -1830,7 +1830,6 @@
(if *slime-repl-eval-hooks*
(setq values (run-repl-eval-hooks form))
(setq values (multiple-value-list (eval form))))
- (ccl::print-db values)
(force-output)))))
(when (and package-update-p (not (eq *package* *buffer-package*)))
(send-to-emacs
@@ -3313,9 +3312,13 @@
((and (eq fast slow) (> n 0)) (return nil))
((not (consp (cdr fast))) (return (values (1+ n) (cdr fast)))))))
+(defvar *slime-inspect-contents-limit* nil "How many elements of
+ a hash table or array to show by default. If table has more than
+ this then offer actions to view more. Set to nil for no limit." )
+
(defmethod inspect-for-emacs ((ht hash-table) inspector)
(declare (ignore inspector))
- (values "A hash table."
+ (values (prin1-to-string ht)
(append
(label-value-line*
("Count" (hash-table-count ht))
@@ -3324,9 +3327,48 @@
("Rehash size" (hash-table-rehash-size ht))
("Rehash threshold" (hash-table-rehash-threshold ht)))
'("Contents: " (:newline))
+ (if (and *slime-inspect-contents-limit*
+ (>= (hash-table-count ht) *slime-inspect-contents-limit*))
+ (inspect-bigger-piece-actions ht (hash-table-count ht))
+ nil)
(loop for key being the hash-keys of ht
- for value being the hash-values of ht
- append `((:value ,key) " = " (:value ,value) (:newline))))))
+ for value being the hash-values of ht
+ repeat (or *slime-inspect-contents-limit* most-positive-fixnum)
+ append `((:value ,key) " = " (:value ,value) (:newline))
+ )
+
+ )))
+
+(defmethod inspect-bigger-piece-actions (thing size)
+ (append
+ (if (> size *slime-inspect-contents-limit*)
+ (list (inspect-factor-more-action thing)
+ '(:newline))
+ nil)
+ (list (inspect-whole-thing-action thing size)
+ '(:newline))))
+
+(defmethod inspect-whole-thing-action (thing size)
+ `(:action ,(format nil "Inspect all ~a elements."
+ size)
+ ,(lambda()
+ (let ((*slime-inspect-contents-limit* nil))
+ (values
+ (swank::inspect-object thing)
+ :replace)
+ ))))
+
+(defmethod inspect-factor-more-action (thing)
+ `(:action ,(format nil "~a elements shown. Prompt for how many to inspect..."
+ *slime-inspect-contents-limit* )
+ ,(lambda()
+ (let ((*slime-inspect-contents-limit*
+ (read)))
+ (values
+ (swank::inspect-object thing)
+ :replace)
+ ))
+ ))
(defmethod inspect-for-emacs ((array array) inspector)
(declare (ignore inspector))
@@ -3340,7 +3382,11 @@
(when (array-has-fill-pointer-p array)
(label-value-line "Fill pointer" (fill-pointer array)))
'("Contents:" (:newline))
- (loop for i below (array-total-size array)
+ (if (and *slime-inspect-contents-limit*
+ (>= (array-total-size array) *slime-inspect-contents-limit*))
+ (inspect-bigger-piece-actions array (length array))
+ nil)
+ (loop for i below (or *slime-inspect-contents-limit* (array-total-size array))
append (label-value-line i (row-major-aref array i))))))
(defmethod inspect-for-emacs ((char character) inspector)
@@ -3893,9 +3939,11 @@
(with-buffer-syntax ()
(inspect-object (inspector-nth-part index))))
-(defslimefun inspector-call-nth-action (index)
- (funcall (aref *inspectee-actions* index))
- (inspect-object (pop *inspector-stack*)))
+(defslimefun inspector-call-nth-action (index &rest args)
+ (multiple-value-bind (value replace) (apply (aref *inspectee-actions* index) args)
+ (if (eq replace :replace)
+ value
+ (inspect-object (pop *inspector-stack*)))))
(defslimefun inspector-pop ()
"Drop the inspector stack and inspect the second element. Return
Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.99 slime/swank-openmcl.lisp:1.100
--- slime/swank-openmcl.lisp:1.99 Fri Sep 9 04:01:10 2005
+++ slime/swank-openmcl.lisp Tue Sep 13 07:37:16 2005
@@ -735,6 +735,38 @@
collect `(:value ,(ccl::uvref object index))
collect `(:newline)))))
+(defun closure-closed-over-values (closure)
+ (let ((howmany (nth-value 8 (ccl::function-args (ccl::closure-function closure)))))
+ (loop for n below howmany
+ collect
+ (let* ((value (ccl::%svref closure (+ 1 (- howmany n))))
+ (map (car (ccl::function-symbol-map (ccl::closure-function closure))))
+ (label (or (and map (svref map n)) n))
+ (cellp (ccl::closed-over-value-p value)))
+ (list label (if cellp (ccl::closed-over-value value) value))))))
+
+(defmethod inspect-for-emacs ((c ccl::compiled-lexical-closure) (inspector t))
+ (declare (ignore inspector))
+ (values
+ (format nil "A closure: ~a" c)
+ `(,@(if (arglist c)
+ (list "Its argument list is: "
+ (funcall (intern "INSPECTOR-PRINC" 'swank) (arglist c)))
+ ;; FIXME inspector-princ should load earlier
+ (list "A function of no arguments"))
+ (:newline)
+ ,@(when (documentation c t)
+ `("Documentation:" (:newline) ,(documentation c t) (:newline)))
+ ,(format nil "Closed over ~a values" (length (closure-closed-over-values c)))
+ (:newline)
+ ,@(loop for (name value) in (closure-closed-over-values c)
+ for count from 1
+ append
+ (label-value-line* ((format nil "~2,' d) ~a" count (string name)) value))))))
+
+
+
+
;;; Multiprocessing
(defvar *known-processes* '() ; FIXME: leakage. -luke
More information about the slime-cvs
mailing list