[slime-cvs] CVS slime/contrib

[CVS User heller]

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv19621/contrib

Modified Files:
	slime-parse.el 
Log Message:
* slime.el (slime-current-tlf-number,slime-current-form-path):
Moved to contrib/slime-parse.el.

--- /project/slime/cvsroot/slime/contrib/slime-parse.el	2010/05/28 14:15:30	1.37
+++ /project/slime/cvsroot/slime/contrib/slime-parse.el	2010/06/18 12:31:55	1.38
@@ -396,4 +396,45 @@
   (let ((state (slime-current-parser-state)))
     (or (nth 3 state) (nth 4 state))))
 
+;;; The following two functions can be handy when inspecting
+;;; source-location while debugging `M-.'.
+;;;
+(defun slime-current-tlf-number ()
+  "Return the current toplevel number."
+  (interactive)
+  (let ((original-pos (car (slime-region-for-defun-at-point)))
+        (n 0))
+    (save-excursion
+      ;; We use this and no repeated `beginning-of-defun's to get
+      ;; reader conditionals right.
+      (goto-char (point-min))
+      (while (progn (slime-forward-sexp)
+                    (< (point) original-pos))
+        (incf n)))
+    n))
+
+;;; This is similiar to `slime-enclosing-form-paths' in the
+;;; `slime-parse' contrib except that this does not do any duck-tape
+;;; parsing, and gets reader conditionals right.
+(defun slime-current-form-path ()
+  "Returns the path from the beginning of the current toplevel
+form to the atom at point, or nil if we're in front of a tlf."
+  (interactive)
+  (let ((source-path nil))
+    (save-excursion
+      ;; Moving forward to get reader conditionals right.
+      (loop for inner-pos = (point)
+            for outer-pos = (nth-value 1 (slime-current-parser-state))
+            while outer-pos do
+            (goto-char outer-pos)
+            (unless (eq (char-before) ?#) ; when at #(...) continue.
+              (forward-char)
+              (let ((n 0))
+                (while (progn (slime-forward-sexp)
+                              (< (point) inner-pos))
+                  (incf n))
+                (push n source-path)
+                (goto-char outer-pos)))))
+    source-path))
+
 (provide 'slime-parse)