[slime-cvs] CVS slime/contrib
trittweiler
trittweiler at common-lisp.net
Sun Sep 7 12:24:37 UTC 2008
Update of /project/slime/cvsroot/slime/contrib
In directory clnet:/tmp/cvs-serv5878/contrib
Modified Files:
slime-mdot-fu.el ChangeLog
Added Files:
slime-enclosing-context.el
Log Message:
* slime-enclosing-context.el: New utility contrib on top of
`slime-parse' to extract some context around point, like bound
variables or bound functions.
* slime-mdot-fu.el: Move context stuff out to the new contrib.
--- /project/slime/cvsroot/slime/contrib/slime-mdot-fu.el 2008/08/07 14:49:51 1.2
+++ /project/slime/cvsroot/slime/contrib/slime-mdot-fu.el 2008/09/07 12:24:37 1.3
@@ -5,52 +5,7 @@
;; License: GNU GPL (same license as Emacs)
;;
-(require 'slime-parse)
-
-(defvar slime-binding-ops-alist
- '((flet &bindings &body)
- (labels &bindings &body)
- (macrolet &bindings &body)
- (let &bindings &body)))
-
-(defun slime-lookup-binding-op (op)
- (assoc* op slime-binding-ops-alist :test 'equalp :key 'symbol-name))
-
-(defun slime-binding-op-p (op)
- (and (slime-lookup-binding-op op) t))
-
-(defun slime-binding-op-body-pos (op)
- (when-let (special-lambda-list (slime-lookup-binding-op op))
- (position '&body special-lambda-list)))
-
-(defun slime-binding-op-bindings-pos (op)
- (when-let (special-lambda-list (slime-lookup-binding-op op))
- (position '&bindings special-lambda-list)))
-
-(defun slime-enclosing-bound-names ()
- "Returns all bound function names as first value, and the
-points where their bindings are established as second value."
- (multiple-value-bind (ops indices points)
- (slime-enclosing-form-specs)
- (let ((binding-names) (binding-start-points))
- (save-excursion
- (loop for (op . nil) in ops
- for index in indices
- for point in points
- do (when (and (slime-binding-op-p op)
- ;; Are the bindings of OP in scope?
- (= index (slime-binding-op-body-pos op)))
- (goto-char point)
- (forward-sexp (slime-binding-op-bindings-pos op))
- (down-list)
- (ignore-errors
- (loop
- (down-list)
- (push (slime-symbol-name-at-point) binding-names)
- (push (save-excursion (backward-up-list) (point))
- binding-start-points)
- (up-list)))))
- (values (nreverse binding-names) (nreverse binding-start-points))))))
+(require 'slime-enclosing-context)
(defun slime-edit-local-definition (name &optional where)
"Like `slime-edit-definition', but tries to find the definition
--- /project/slime/cvsroot/slime/contrib/ChangeLog 2008/08/27 17:53:11 1.125
+++ /project/slime/cvsroot/slime/contrib/ChangeLog 2008/09/07 12:24:37 1.126
@@ -1,3 +1,11 @@
+2008-07-09 Tobias C. Rittweiler <tcr at freebits.de>
+
+ * slime-enclosing-context.el: New utility contrib on top of
+ `slime-parse' to extract some context around point, like bound
+ variables or bound functions.
+
+ * slime-mdot-fu.el: Move context stuff out to the new contrib.
+
2008-08-27 Helmut Eller <heller at common-lisp.net>
* swank-arglists.lisp (variable-desc-for-echo-area): Limit the
--- /project/slime/cvsroot/slime/contrib/slime-enclosing-context.el 2008/09/07 12:24:37 NONE
+++ /project/slime/cvsroot/slime/contrib/slime-enclosing-context.el 2008/09/07 12:24:37 1.1
;;; slime-enclosing-context.el --- Utilities on top of slime-parse.
;;
;; Author: Tobias C. Rittweiler <tcr at freebits.de>
;;
;; License: GNU GPL (same license as Emacs)
;;
(require 'slime-parse)
(defvar slime-variable-binding-ops-alist
'((let &bindings &body)))
(defvar slime-function-binding-ops-alist
'((flet &bindings &body)
(labels &bindings &body)
(macrolet &bindings &body)))
(defun slime-lookup-binding-op (op &optional binding-type)
(flet ((lookup-in (list) (assoc* op list :test 'equalp :key 'symbol-name)))
(cond ((eq binding-type :variable) (lookup-in slime-variable-binding-ops-alist))
((eq binding-type :function) (lookup-in slime-function-binding-ops-alist))
(t (or (lookup-in slime-variable-binding-ops-alist)
(lookup-in slime-function-binding-ops-alist))))))
(defun slime-binding-op-p (op &optional binding-type)
(and (slime-lookup-binding-op op binding-type) t))
(defun slime-binding-op-body-pos (op)
(when-let (special-lambda-list (slime-lookup-binding-op op))
(position '&body special-lambda-list)))
(defun slime-binding-op-bindings-pos (op)
(when-let (special-lambda-list (slime-lookup-binding-op op))
(position '&bindings special-lambda-list)))
(defun slime-enclosing-bound-names ()
"Returns all bound function names as first value, and the
points where their bindings are established as second value."
(multiple-value-call #'slime-find-bound-names (slime-enclosing-form-specs)))
(defun slime-find-bound-names (ops indices points)
(let ((binding-names) (binding-start-points))
(save-excursion
(loop for (op . nil) in ops
for index in indices
for point in points
do (when (and (slime-binding-op-p op)
;; Are the bindings of OP in scope?
(= index (slime-binding-op-body-pos op)))
(goto-char point)
(forward-sexp (slime-binding-op-bindings-pos op))
(down-list)
(ignore-errors
(loop
(down-list)
(push (slime-symbol-name-at-point) binding-names)
(push (save-excursion (backward-up-list) (point))
binding-start-points)
(up-list)))))
(values (nreverse binding-names) (nreverse binding-start-points)))))
(defun slime-enclosing-bound-functions ()
(multiple-value-call #'slime-find-bound-functions (slime-enclosing-form-specs)))
(defun slime-find-bound-functions (ops indices points)
(let ((names) (arglists) (start-points))
(save-excursion
(loop for (op . nil) in ops
for index in indices
for point in points
do (when (and (slime-binding-op-p op :function)
;; Are the bindings of OP in scope?
(= index (slime-binding-op-body-pos op)))
(goto-char point)
(forward-sexp (slime-binding-op-bindings-pos op))
(down-list)
(ignore-errors
(loop
(down-list)
(push (slime-symbol-name-at-point) names)
(slime-end-of-symbol)
(push (slime-parse-sexp-at-point 1 t) arglists)
(push (save-excursion (backward-up-list) (point))
start-points)
(up-list)))))
(values (nreverse names)
(nreverse arglists)
(nreverse start-points)))))
(provide 'slime-enclosing-context)
More information about the slime-cvs
mailing list