[slime-cvs] CVS slime

[CVS User sboukarev]

Update of /project/slime/cvsroot/slime
In directory tiger.common-lisp.net:/tmp/cvs-serv7416

Modified Files:
	slime.el swank-sbcl.lisp 
Log Message:
Simplify :buffer-and-file handling.


--- /project/slime/cvsroot/slime/slime.el	2012/05/03 15:49:17	1.1403
+++ /project/slime/cvsroot/slime/slime.el	2012/05/03 15:58:39	1.1404
@@ -3446,18 +3446,14 @@
              | (:source-path <list> <start-position>) 
              | (:method <name string> <specializers> . <qualifiers>)"
   (destructure-case location
-    ((:location buffer position hints)
-     (cond ((eql (car buffer) :buffer-and-file)
-            (slime-goto-source-location-buffer-and-file buffer position hints
-                                                        noerror))
-           (t
-            (slime-goto-location-buffer buffer)
-            (let ((pos (slime-location-offset location)))
-              (cond ((and (<= (point-min) pos) (<= pos (point-max))))
-                    (widen-automatically (widen))
-                    (t
-                     (error "Location is outside accessible part of buffer")))
-              (goto-char pos)))))
+    ((:location buffer _position _hints)
+     (slime-goto-location-buffer buffer)
+     (let ((pos (slime-location-offset location)))
+       (cond ((and (<= (point-min) pos) (<= pos (point-max))))
+             (widen-automatically (widen))
+             (t
+              (error "Location is outside accessible part of buffer")))
+       (goto-char pos)))
     ((:error message)
      (if noerror
          (slime-message "%s" message)
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2012/05/03 15:49:17	1.312
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2012/05/03 15:58:39	1.313
@@ -845,36 +845,32 @@
     (make-location (list :buffer-and-file
                          (cadr (location-buffer buffer))
                          (cadr (location-buffer file)))
-                   (list
-                    :buffer-position (location-position buffer)
-                    :file-position (location-position file))
-                   (list
-                    :buffer-hints (location-hints buffer)
-                    :file-hints (location-hints file)))))
+                   (location-position buffer)
+                   (location-hints buffer))))
 
 (defun definition-source-for-emacs (definition-source type name)
   (with-struct ("sb-introspect:definition-source-"
                 pathname form-path character-offset plist
                 file-write-date)
                definition-source
-    (ecase (categorize-definition-source definition-source)
-      (:buffer-and-file
-       (definition-source-buffer-and-file-location definition-source))
-      (:buffer
-       (definition-source-buffer-location definition-source))
-      (:file
-       (definition-source-file-location definition-source))
-      (:file-without-position
-       (make-location `(:file ,(namestring 
-                                (translate-logical-pathname pathname)))
-                      '(:position 1)
-                      (when (eql type :function)
-                        `(:snippet ,(format nil "(defun ~a " 
-                                            (symbol-name name))))))
-      (:invalid
-       (error "DEFINITION-SOURCE of ~(~A~) ~A did not contain ~
+    (:dbg (ecase (categorize-definition-source definition-source)
+       (:buffer-and-file
+        (definition-source-buffer-and-file-location definition-source))
+       (:buffer
+        (definition-source-buffer-location definition-source))
+       (:file
+        (definition-source-file-location definition-source))
+       (:file-without-position
+        (make-location `(:file ,(namestring 
+                                 (translate-logical-pathname pathname)))
+                       '(:position 1)
+                       (when (eql type :function)
+                         `(:snippet ,(format nil "(defun ~a " 
+                                             (symbol-name name))))))
+       (:invalid
+        (error "DEFINITION-SOURCE of ~(~A~) ~A did not contain ~
                meaningful information."
-              type name)))))
+               type name))))))
 
 (defun source-file-position (filename write-date form-path)
   (let ((source (get-source-code filename write-date))