Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
marvel
GitHub Repository: marvel/qnf
 Path: blob/master/elisp/slime/contrib/slime-mdot-fu.el
990 views
1


2
(define-slime-contrib slime-mdot-fu

3
  "Making M-. work on local functions."

4
  (:authors "Tobias C. Rittweiler <[email protected]>")

5
  (:license "GPL")

6
  (:slime-dependencies slime-enclosing-context)

7
  (:on-load

8
   (add-hook 'slime-edit-definition-hooks 'slime-edit-local-definition))

9
  (:on-unload

10
   (remove-hook 'slime-edit-definition-hooks 'slime-edit-local-definition)))

11


12


13
(defun slime-edit-local-definition (name &optional where)

14
  "Like `slime-edit-definition', but tries to find the definition

15
in a local function binding near point."

16
  (interactive (list (slime-read-symbol-name "Name: ")))

17
  (multiple-value-bind (binding-name point)

18
      (multiple-value-call #'some #'(lambda (binding-name point)

19
				      (when (equalp binding-name name)

20
					(values binding-name point)))

21
			   (slime-enclosing-bound-names))

22
    (when (and binding-name point)

23
      (slime-edit-definition-cont 

24
       `((,binding-name

25
	  ,(make-slime-buffer-location (buffer-name (current-buffer)) point)))

26
       name

27
       where))))

28


29
;;; Tests

30


31
(def-slime-test find-local-definitions.1

32
    (buffer-sexpr definition target-regexp)

33
    "Check that finding local definitions work."

34
    '(((defun foo (x)

35
	  (let ((y (+ x 1)))

36
	    (- x y *HERE*)))

37
       y

38
       "(y (+ x 1))")

39


40
      ((defun bar (x)

41
	 (flet ((foo (z) (+ x z)))

42
	   (* x (foo *HERE*))))

43
       foo

44
       "(foo (z) (+ x z))")

45


46
      ((defun quux (x)

47
	 (flet ((foo (z) (+ x z)))

48
	   (let ((foo (- 1 x)))

49
	     (+ x foo *HERE*))))

50
       foo

51
       "(foo (- 1 x)")

52
      

53
      ((defun zurp (x)

54
	 (macrolet ((frob (x y) `(quux ,x ,y)))

55
	   (frob x *HERE*)))

56
       frob

57
       "(frob (x y)"))

58
  (slime-check-top-level)

59
  (with-temp-buffer

60
    (let ((tmpbuf (current-buffer)))

61
      (insert (prin1-to-string buffer-sexpr))

62
      (search-backward "*HERE*")

63
      (slime-edit-local-definition (prin1-to-string definition))

64
      (slime-sync)

65
      (slime-check "Check that we didnt leave the temp buffer." 

66
	(eq (current-buffer) tmpbuf))

67
      (slime-check "Check that we are at the local definition."

68
	(looking-at (regexp-quote target-regexp))))))

69


70
(provide 'slime-mdot-fu)

71


72