[slime-cvs] CVS slime
CVS User sboukarev
sboukarev at common-lisp.net
Thu May 3 15:49:17 UTC 2012
Update of /project/slime/cvsroot/slime
In directory tiger.common-lisp.net:/tmp/cvs-serv6427
Modified Files:
ChangeLog slime.el swank-sbcl.lisp
Log Message:
* slime.el (slime-goto-source-location): Allow for
:buffer-and-file locations, prefer buffer if the buffer exists.
* swank-sbcl.lisp (definition-source-for-emacs): Send
:buffer-and-file when both are available.
(quit-lisp): Use sb-ext:exit when it's present.
--- /project/slime/cvsroot/slime/ChangeLog 2012/05/03 14:28:17 1.2326
+++ /project/slime/cvsroot/slime/ChangeLog 2012/05/03 15:49:17 1.2327
@@ -1,8 +1,10 @@
2012-05-03 Stas Boukarev <stassats at gmail.com>
- * swank-sbcl.lisp (definition-source-for-emacs): Prefer :file over
- :buffer, because the buffer can be killed in the mean time and the
- silly "No buffer named x.lisp" would be displayed.
+ * slime.el (slime-goto-source-location): Allow for
+ :buffer-and-file locations, prefer buffer if the buffer exists.
+
+ * swank-sbcl.lisp (definition-source-for-emacs): Send
+ :buffer-and-file when both are available.
(quit-lisp): Use sb-ext:exit when it's present.
2012-05-03 Stas Boukarev <stassats at gmail.com>
--- /project/slime/cvsroot/slime/slime.el 2012/05/01 10:07:34 1.1402
+++ /project/slime/cvsroot/slime/slime.el 2012/05/03 15:49:17 1.1403
@@ -3307,6 +3307,11 @@
((:buffer buffer-name)
(slime-check-location-buffer-name-sanity buffer-name)
(set-buffer buffer-name))
+ ((:buffer-and-file buffer filename)
+ (slime-goto-location-buffer
+ (if (get-buffer buffer)
+ (list :buffer buffer)
+ (list :file filename))))
((:source-form string)
(set-buffer (get-buffer-create (slime-buffer-name :source)))
(erase-buffer)
@@ -3430,6 +3435,7 @@
<buffer> ::= (:file <filename>)
| (:buffer <buffername>)
+ | (:buffer-and-file <buffername> <filename>)
| (:source-form <string>)
| (:zip <file> <entry>)
@@ -3440,18 +3446,38 @@
| (:source-path <list> <start-position>)
| (:method <name string> <specializers> . <qualifiers>)"
(destructure-case location
- ((: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)))
+ ((: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)))))
((:error message)
(if noerror
(slime-message "%s" message)
(error "%s" message)))))
+(defun slime-goto-source-location-buffer-and-file (buffer position hints
+ noerror)
+ (destructuring-bind (type buffer file) buffer
+ (slime-goto-source-location
+ (if (get-buffer buffer)
+ (list :location
+ (list :buffer buffer)
+ (getf position :buffer-position)
+ (getf hints :buffer-hints))
+ (list :location
+ (list :file file)
+ (getf position :file-position)
+ (getf hints :file-hints)))
+ noerror)))
+
(defun slime-location-offset (location)
"Return the position, as character number, of LOCATION."
(save-restriction
@@ -3964,6 +3990,7 @@
(if buffer
(format "%S" buffer) ; "#<buffer foo.lisp>"
(format "%s (previously existing buffer)" bufname))))
+ ((:buffer-and-file buffer filename) filename)
((:source-form _) "(S-Exp)")
((:zip _zip entry) entry)))
(t
--- /project/slime/cvsroot/slime/swank-sbcl.lisp 2012/05/03 14:28:17 1.311
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2012/05/03 15:49:17 1.312
@@ -792,11 +792,13 @@
(with-struct ("sb-introspect:definition-source-"
pathname form-path character-offset plist)
definition-source
- (cond ((getf plist :emacs-buffer) :buffer)
- ((and pathname (or form-path character-offset)
- (probe-file pathname)) :file)
- (pathname :file-without-position)
- (t :invalid))))
+ (let ((file-p (and pathname (probe-file pathname)
+ (or form-path character-offset))))
+ (cond ((and (getf plist :emacs-buffer) file-p) :buffer-and-file)
+ ((getf plist :emacs-buffer) :buffer)
+ (file-p :file)
+ (pathname :file-without-position)
+ (t :invalid)))))
(defun definition-source-buffer-location (definition-source)
(with-struct ("sb-introspect:definition-source-"
@@ -837,12 +839,27 @@
`(:position ,(1+ pos))
`(:snippet ,snippet)))))
+(defun definition-source-buffer-and-file-location (definition-source)
+ (let ((buffer (definition-source-buffer-location definition-source))
+ (file (definition-source-file-location definition-source)))
+ (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)))))
+
(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
More information about the slime-cvs
mailing list