[slime-cvs] CVS slime/contrib
CVS User sboukarev
sboukarev at common-lisp.net
Sun Apr 18 01:35:10 UTC 2010
Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv28087
Modified Files:
ChangeLog slime-presentations.el swank-presentations.lisp
Log Message:
* slime-presentations.el
(slime-repl-grab-old-output,slime-copy-or-inspect-presentation-at-mouse):
If the presentation at point is no longer available, remove
presentation properties from the object.
* swank-presentations.lisp (lookup-presented-object): defun->defslimefun.
--- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/06 13:24:29 1.370
+++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/18 01:35:10 1.371
@@ -1,3 +1,11 @@
+2010-04-18 Stas Boukarev <stassats at gmail.com>
+
+ * slime-presentations.el
+ (slime-repl-grab-old-output,slime-copy-or-inspect-presentation-at-mouse):
+ If the presentation at point is no longer available, remove
+ presentation properties from the object.
+ * swank-presentations.lisp (lookup-presented-object): defun->defslimefun.
+
2010-04-06 Stas Boukarev <stassats at gmail.com>
* slime-c-p-c.el (slime-complete-symbol*-fancy-bit): There is no
--- /project/slime/cvsroot/slime/contrib/slime-presentations.el 2010/03/20 08:27:50 1.30
+++ /project/slime/cvsroot/slime/contrib/slime-presentations.el 2010/04/18 01:35:10 1.31
@@ -348,15 +348,22 @@
(unless presentation
(error "No presentation at click"))
(values presentation start end (current-buffer))))))
-
+
+(defun slime-check-presentation (from to buffer presentation)
+ (unless (slime-eval `(cl:nth-value 1 (swank:lookup-presented-object
+ ',(slime-presentation-id presentation))))
+ (with-current-buffer buffer
+ (slime-remove-presentation-properties from to presentation))))
+
(defun slime-copy-or-inspect-presentation-at-mouse (event)
(interactive "e") ; no "@" -- we don't want to select the clicked-at window
(multiple-value-bind (presentation start end buffer)
(slime-presentation-around-click event)
+ (slime-check-presentation start end buffer presentation)
(if (with-current-buffer buffer
(eq major-mode 'slime-repl-mode))
(slime-copy-presentation-at-mouse-to-repl event)
- (slime-inspect-presentation-at-mouse event))))
+ (slime-inspect-presentation-at-mouse event))))
(defun slime-inspect-presentation (presentation start end buffer)
(let ((reset-p
@@ -382,7 +389,7 @@
(let* ((id (slime-presentation-id presentation))
(presentation-string (format "Presentation %s" id))
(location (slime-eval `(swank:find-definition-for-thing
- (swank::lookup-presented-object
+ (swank:lookup-presented-object
',(slime-presentation-id presentation))))))
(slime-edit-definition-cont
(and location (list (make-slime-xref :dspec `(,presentation-string)
@@ -670,6 +677,7 @@
output; otherwise the new input is appended."
(multiple-value-bind (presentation beg end)
(slime-presentation-around-or-before-point (point))
+ (slime-check-presentation beg end (current-buffer) presentation)
(let ((old-output (buffer-substring beg end))) ;;keep properties
;; Append the old input or replace the current input
(cond (replace (goto-char slime-repl-input-start-mark))
@@ -789,12 +797,11 @@
(point-max)))
(defun slime-presentation-on-return-pressed ()
- (cond ((and (car (slime-presentation-around-or-before-point (point)))
- (< (point) slime-repl-input-start-mark))
- (slime-repl-grab-old-output end-of-input)
- (slime-repl-recenter-if-needed)
- t)
- (t nil)))
+ (when (and (car (slime-presentation-around-or-before-point (point)))
+ (< (point) slime-repl-input-start-mark))
+ (slime-repl-grab-old-output end-of-input)
+ (slime-repl-recenter-if-needed)
+ t))
(defun slime-presentation-on-stream-open (stream)
(require 'bridge)
--- /project/slime/cvsroot/slime/contrib/swank-presentations.lisp 2010/03/09 14:42:22 1.6
+++ /project/slime/cvsroot/slime/contrib/swank-presentations.lisp 2010/04/18 01:35:10 1.7
@@ -46,11 +46,11 @@
(setf (gethash object *object-to-presentation-id*) id)
id))))
-(defun lookup-presented-object (id)
+(defslimefun lookup-presented-object (id)
"Retrieve the object corresponding to ID.
The secondary value indicates the absence of an entry."
(etypecase id
- (integer
+ (integer
;;
(multiple-value-bind (object foundp)
(gethash id *presentation-id-to-object*)
More information about the slime-cvs
mailing list