[slime-cvs] CVS slime/contrib

[trittweiler]

Update of /project/slime/cvsroot/slime/contrib
In directory clnet:/tmp/cvs-serv22329

Modified Files:
	slime-presentations.el 
Log Message:

M-. now works on presentations. 

Additionally, a Find Definition entry is presented in the menu
appearing on right clicking on a presentation.
	
* slime-presentations.lisp (slime-M-.-presentation): New function.
  (slime-M-.-presentation-at-mouse): New function.
  (slime-M-.-presentation-at-point): New function.
  (slime-maybe-M-.-presentation-at-point): New function.
  (slime-menu-choices-for-presentation): New entry "Find Definition".
  (slime-presentation-easy-menu): New entry "Find Definition".
  (slime-presentations-init): Hook into `slime-edit-definition-hooks'.


--- /project/slime/cvsroot/slime/contrib/slime-presentations.el	2008/02/15 17:35:29	1.13
+++ /project/slime/cvsroot/slime/contrib/slime-presentations.el	2008/03/02 15:21:42	1.14
@@ -374,6 +374,39 @@
       (slime-presentation-around-or-before-point-or-error point)
     (slime-inspect-presentation presentation start end (current-buffer))))
 
+
+(defun slime-M-.-presentation (presentation start end buffer)
+  (let* ((id (slime-presentation-id presentation))
+	 (presentation-string (format "Presentation %s" id))
+	 (location (slime-eval `(swank:find-definition-for-thing
+				 (swank::lookup-presented-object
+				  ',(slime-presentation-id presentation))))))
+    (slime-edit-definition-cont
+     (and location (list (make-slime-xref :dspec `(,presentation-string)
+					  :location location)))
+     presentation-string
+     nil)))
+
+(defun slime-M-.-presentation-at-mouse (event)
+  (interactive "e")
+  (multiple-value-bind (presentation start end buffer) 
+      (slime-presentation-around-click event)
+    (slime-M-.-presentation presentation start end buffer)))
+
+(defun slime-M-.-presentation-at-point (point)
+  (interactive "d")
+  (multiple-value-bind (presentation start end) 
+      (slime-presentation-around-or-before-point-or-error point)
+    (slime-M-.-presentation presentation start end (current-buffer))))
+
+(defun slime-maybe-M-.-presentation-at-point (point)
+  (interactive "d")
+  (multiple-value-bind (presentation start end whole-p)
+      (slime-presentation-around-or-before-point point)
+    (when presentation
+      (slime-M-.-presentation presentation start end (current-buffer)))))
+
+
 (defun slime-copy-presentation-to-repl (presentation start end buffer)
   (let ((presentation-text 
 	 (with-current-buffer buffer
@@ -550,6 +583,7 @@
       (list
        `(,(format "Presentation %s" what)
          ("" 
+	  ("Find Definition" . ,(savel 'slime-M-.-presentation-at-mouse))
           ("Inspect" . ,(savel 'slime-inspect-presentation-at-mouse))
           ("Describe" . ,(savel 'slime-describe-presentation-at-mouse))
           ("Pretty-print" . ,(savel 'slime-pretty-print-presentation-at-mouse))
@@ -680,6 +714,7 @@
 (defvar slime-presentation-easy-menu
   (let ((P '(slime-presentation-around-or-before-point-p)))
     `("Presentations"
+      [ "Find Definition" slime-M-.-presentation-at-point ,P ]
       [ "Inspect" slime-inspect-presentation-at-point ,P ]
       [ "Describe" slime-describe-presentation-at-point ,P ]
       [ "Pretty-print" slime-pretty-print-presentation-at-point ,P ]
@@ -831,6 +866,7 @@
   (add-hook 'slime-open-stream-hooks 'slime-presentation-on-stream-open)
   (add-hook 'slime-repl-clear-buffer-hook 'slime-clear-presentations)
   (add-hook 'slime-connected-hook 'slime-install-presentations)
+  (add-hook 'slime-edit-definition-hooks 'slime-maybe-M-.-presentation-at-point)
   (setq slime-inspector-insert-ispec-function 'slime-presentation-inspector-insert-ispec)
   (setq sldb-insert-frame-variable-value-function 
 	'slime-presentation-sldb-insert-frame-variable-value)