Skip to content
Browse files

* 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.
  • Loading branch information...
1 parent 17188dc commit a9a7173fad177937e81b36348ebd1b4c887fe4e6 @stassats stassats committed May 3, 2012
Showing with 61 additions and 15 deletions.
  1. +5 −3 ChangeLog
  2. +34 −7 slime.el
  3. +22 −5 swank-sbcl.lisp
View
8 ChangeLog
@@ -1,8 +1,10 @@
2012-05-03 Stas Boukarev <stassats@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@gmail.com>
View
41 slime.el
@@ -3307,6 +3307,11 @@ you should check twice before modifying.")
((: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 @@ are supported:
<buffer> ::= (:file <filename>)
| (:buffer <buffername>)
+ | (:buffer-and-file <buffername> <filename>)
| (:source-form <string>)
| (:zip <file> <entry>)
@@ -3440,18 +3446,38 @@ are supported:
| (: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 @@ FILE-ALIST is an alist of the form ((FILENAME . (XREF ...)) ...)."
(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
View
27 swank-sbcl.lisp
@@ -792,11 +792,13 @@ QUALITIES is an alist with (quality . value)"
(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 @@ QUALITIES is an alist with (quality . value)"
`(: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

0 comments on commit a9a7173

Please sign in to comment.
Something went wrong with that request. Please try again.