[slime-cvs] CVS slime
heller
heller at common-lisp.net
Wed Sep 17 06:19:56 UTC 2008
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv24065
Modified Files:
ChangeLog slime.el swank-abcl.lisp swank-allegro.lisp
swank-clisp.lisp swank-cmucl.lisp swank-corman.lisp
swank-ecl.lisp swank-lispworks.lisp swank-openmcl.lisp
swank-sbcl.lisp swank-scl.lisp
Log Message:
Adjust positions in files with CRLF-style end-on-line markers.
* slime.el (slime-eol-conversion-fixup): New function.
(slime-goto-location-position): Use it. Also add a new position
type :offset, so that we don't adjust offsets in strings that were
sent over the wire (which uses LF eol-convention).
* swank-abcl.lisp
* swank-allegro.lisp
* swank-clisp.lisp
* swank-cmucl.lisp
* swank-corman.lisp
* swank-ecl.lisp
* swank-lispworks.lisp
* swank-openmcl.lisp
* swank-sbcl.lisp
* swank-scl.lisp: Create :offset style positions where needed.
* swank-lispworks.lisp (skip-comments): New function.
(dspec-stream-position): Use it.
--- /project/slime/cvsroot/slime/ChangeLog 2008/09/16 18:15:14 1.1509
+++ /project/slime/cvsroot/slime/ChangeLog 2008/09/17 06:19:47 1.1510
@@ -4,6 +4,29 @@
there which is defined by paredit.el.
Use `(down-list -1)' instead.
+2008-09-16 Helmut Eller <heller at common-lisp.net>
+
+ Adjust positions in files with CRLF style end-on-line markers.
+
+ * slime.el (slime-eol-conversion-fixup): New function.
+ (slime-goto-location-position): Use it. Also add a new position
+ type :offset, so that we don't adjust offsets in strings that were
+ sent over the wire (which uses LF eol-convention).
+
+ * swank-abcl.lisp
+ * swank-allegro.lisp
+ * swank-clisp.lisp
+ * swank-cmucl.lisp
+ * swank-corman.lisp
+ * swank-ecl.lisp
+ * swank-lispworks.lisp
+ * swank-openmcl.lisp
+ * swank-sbcl.lisp
+ * swank-scl.lisp: Create :offset style positions where needed.
+
+ * swank-lispworks.lisp (skip-comments): New function.
+ (dspec-stream-position): Use it.
+
2008-09-15 Helmut Eller <heller at common-lisp.net>
* swank-lispworks.lisp (describe-symbol-for-emacs): Revert last
--- /project/slime/cvsroot/slime/slime.el 2008/09/16 18:15:14 1.1017
+++ /project/slime/cvsroot/slime/slime.el 2008/09/17 06:19:47 1.1018
@@ -4627,11 +4627,12 @@
(defun slime-goto-location-position (position)
(destructure-case position
- ((:position pos &optional align-p)
- (goto-char pos)
- (when align-p
- (slime-forward-sexp)
- (beginning-of-sexp)))
+ ((:position pos)
+ (goto-char 1)
+ (forward-char (- (1- pos) (slime-eol-conversion-fixup (1- pos)))))
+ ((:offset start offset)
+ (goto-char start)
+ (forward-char offset))
((:line start &optional column)
(goto-line start)
(cond (column (move-to-column column))
@@ -4654,13 +4655,22 @@
(goto-char start-position)
(slime-forward-positioned-source-path source-path))
(t
- (slime-forward-source-path source-path))))
- ;; Goes to "start" then looks for the anchor text, then moves
- ;; delta from that position.
- ((:text-anchored start text delta)
- (goto-char start)
- (slime-isearch text)
- (forward-char delta))))
+ (slime-forward-source-path source-path))))))
+
+(defun slime-eol-conversion-fixup (n)
+ ;; Return the number of \r\n eol markers that we need to cross when
+ ;; moving N chars forward. N is the number of chars but \r\n are
+ ;; counted as 2 separate chars.
+ (let* ((eol-type (coding-system-eol-type buffer-file-coding-system)))
+ (ecase eol-type
+ ((0 2) 0)
+ ((1)
+ (save-excursion
+ (do ((pos (+ (point) n))
+ (count 0 (1+ count)))
+ ((>= (point) pos) (1- count))
+ (forward-line)
+ (decf pos)))))))
(defun slime-search-method-location (name specializers qualifiers)
;; Look for a sequence of words (def<something> method name
@@ -4710,11 +4720,11 @@
| (:source-form <string>)
| (:zip <file> <entry>)
-<position> ::= (:position <fixnum> [<align>]) ; 1 based
+<position> ::= (:position <fixnum>) ; 1 based (for files)
+ | (:offset <start> <offset>) ; start+offset (for C-c C-c)
| (:line <line> [<column>])
| (:function-name <string>)
| (:source-path <list> <start-position>)
- | (:text-anchored <fixnum> <string> <fixnum>)
| (:method <name string> <specializer strings> . <qualifiers strings>)"
(destructure-case location
((:location buffer position hints)
@@ -4738,7 +4748,10 @@
(when-let (snippet (getf hints :snippet))
(slime-isearch snippet))
(when-let (fname (getf hints :call-site))
- (slime-search-call-site fname)))
+ (slime-search-call-site fname))
+ (when (getf hints :align)
+ (slime-forward-sexp)
+ (beginning-of-sexp)))
(point)))
--- /project/slime/cvsroot/slime/swank-abcl.lisp 2008/09/12 12:27:38 1.54
+++ /project/slime/cvsroot/slime/swank-abcl.lisp 2008/09/17 06:19:48 1.55
@@ -317,7 +317,7 @@
:location (cond (*buffer-name*
(make-location
(list :buffer *buffer-name*)
- (list :position *buffer-start-position*)))
+ (list :offset *buffer-start-position* 0)))
(loc
(destructuring-bind (file . pos) loc
(make-location
@@ -385,8 +385,8 @@
`(((,symbol)
(:location
(:file ,(namestring (ext:source-pathname symbol)))
- (:position ,(or (ext:source-file-position symbol) 0) t)
- (:snippet nil))))))
+ (:position ,(or (ext:source-file-position symbol) 1))
+ (:align t))))))
(defimplementation find-definitions (symbol)
--- /project/slime/cvsroot/slime/swank-allegro.lisp 2008/09/12 12:27:38 1.113
+++ /project/slime/cvsroot/slime/swank-allegro.lisp 2008/09/17 06:19:48 1.114
@@ -255,7 +255,7 @@
(cond (*buffer-name*
(make-location
(list :buffer *buffer-name*)
- (list :position *buffer-start-position*)))
+ (list :offset *buffer-start-position* 0)))
(loc
(destructuring-bind (file . pos) loc
(make-location
@@ -366,7 +366,7 @@
(start (and part
(scm::source-part-start part)))
(pos (if start
- (list :position (1+ (- start (count-cr file start))))
+ (list :position (1+ start))
(list :function-name (string (fspec-primary-name fspec))))))
(make-location (list :file (namestring (truename file)))
pos)))
@@ -375,7 +375,7 @@
(let ((pos (position #\; filename :from-end t)))
(make-location
(list :buffer (subseq filename 0 pos))
- (list :position (parse-integer (subseq filename (1+ pos)))))))
+ (list :offset (parse-integer (subseq filename (1+ pos))) 0))))
(defun find-fspec-location (fspec type file top-level)
(etypecase file
@@ -404,8 +404,9 @@
(declare (ignore top-level-form))
(list
(list (list nil fspec)
- (make-location (list :buffer file)
- (list :position position t))))))
+ (make-location (list :buffer file) ; FIXME: should use :file
+ (list :position position)
+ (list :align t))))))
((and (listp fspec) (eq (car fspec) :internal))
(destructuring-bind (_internal next _n) fspec
(declare (ignore _internal _n))
--- /project/slime/cvsroot/slime/swank-clisp.lisp 2008/09/15 10:41:03 1.77
+++ /project/slime/cvsroot/slime/swank-clisp.lisp 2008/09/17 06:19:48 1.78
@@ -559,7 +559,7 @@
(list ':line lineno1)))
(*buffer-name*
(make-location (list ':buffer *buffer-name*)
- (list ':position *buffer-offset*)))
+ (list ':offset *buffer-offset* 0)))
(t
(list :error "No error location available")))))
--- /project/slime/cvsroot/slime/swank-cmucl.lisp 2008/09/15 10:41:03 1.195
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp 2008/09/17 06:19:48 1.196
@@ -199,7 +199,8 @@
(when ready (return ready)))
(when timeout (return nil))
(when (check-slime-interrupts) (return :interrupt))
- (let* ((f (constantly t))
+ (let* (#+(or)(lisp::*descriptor-handlers* '()) ; ignore other handlers
+ (f (constantly t))
(handlers (loop for s in streams
collect (add-one-shot-handler s f))))
(unwind-protect
@@ -449,7 +450,7 @@
(pos (c::compiler-read-error-position condition)))
(cond ((and (eq file :stream) *buffer-name*)
(make-location (list :buffer *buffer-name*)
- (list :position (+ *buffer-start-position* pos))))
+ (list :offset *buffer-start-position* pos)))
((and (pathnamep file) (not *buffer-name*))
(make-location (list :file (unix-truename file))
(list :position (1+ pos))))
@@ -474,17 +475,15 @@
(defun locate-compiler-note (file source source-path)
(cond ((and (eq file :stream) *buffer-name*)
;; Compiling from a buffer
- (let ((position (+ *buffer-start-position*
- (source-path-string-position
- source-path *buffer-substring*))))
- (make-location (list :buffer *buffer-name*)
- (list :position position))))
+ (make-location (list :buffer *buffer-name*)
+ (list :offset *buffer-start-position*
+ (source-path-string-position
+ source-path *buffer-substring*))))
((and (pathnamep file) (null *buffer-name*))
;; Compiling from a file
(make-location (list :file (unix-truename file))
- (list :position
- (1+ (source-path-file-position
- source-path file)))))
+ (list :position (1+ (source-path-file-position
+ source-path file)))))
((and (eq file :lisp) (stringp source))
;; No location known, but we have the source form.
;; XXX How is this case triggered? -luke (16/May/2004)
@@ -784,7 +783,7 @@
string)))
(make-location
(list :buffer (getf info :emacs-buffer))
- (list :position (+ (getf info :emacs-buffer-offset) position))
+ (list :offset (getf info :emacs-buffer-offset) position)
(list :snippet (with-input-from-string (s string)
(file-position s position)
(read-snippet s))))))
@@ -1131,7 +1130,7 @@
(with-input-from-string (s emacs-buffer-string)
(let ((pos (form-number-stream-position tlf-number form-number s)))
(make-location `(:buffer ,emacs-buffer)
- `(:position ,(+ emacs-buffer-offset pos))))))))
+ `(:offset ,emacs-buffer-offset ,pos)))))))
;; XXX predicates for 18e backward compatibilty. Remove them when
;; we're 19a only.
--- /project/slime/cvsroot/slime/swank-corman.lisp 2008/09/12 12:27:38 1.17
+++ /project/slime/cvsroot/slime/swank-corman.lisp 2008/09/17 06:19:48 1.18
@@ -356,7 +356,7 @@
(cond (*buffer-name*
(make-location
(list :buffer *buffer-name*)
- (list :position *buffer-position*)))
+ (list :offset *buffer-position* 0)))
(*compile-filename*
(make-location
(list :file *compile-filename*)
--- /project/slime/cvsroot/slime/swank-ecl.lisp 2008/08/27 17:53:16 1.29
+++ /project/slime/cvsroot/slime/swank-ecl.lisp 2008/09/17 06:19:48 1.30
@@ -122,7 +122,7 @@
:location
(if *buffer-name*
(make-location (list :buffer *buffer-name*)
- (list :position *buffer-start-position*))
+ (list :offset *buffer-start-position* 0))
;; ;; compiler::*current-form*
;; (if compiler::*current-function*
;; (make-location (list :file *compile-filename*)
--- /project/slime/cvsroot/slime/swank-lispworks.lisp 2008/09/15 21:11:19 1.116
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp 2008/09/17 06:19:49 1.117
@@ -459,14 +459,14 @@
(delete-file binary-filename))))
(delete-file filename)))
-(defun dspec-buffer-position (dspec offset)
+(defun dspec-function-name-position (dspec fallback)
(etypecase dspec
(cons (let ((name (dspec:dspec-primary-name dspec)))
(typecase name
((or symbol string)
(list :function-name (string name)))
- (t (list :position offset)))))
- (null (list :position offset))
+ (t fallback))))
+ (null fallback)
(symbol (list :function-name (string dspec)))))
(defmacro with-fairly-standard-io-syntax (&body body)
@@ -480,10 +480,17 @@
(*readtable* ,readtable))
, at body)))))
+(defun skip-comments (stream)
+ (let ((pos0 (file-position stream)))
+ (cond ((equal (ignore-errors (list (read-delimited-list #\( stream)))
+ '(()))
+ (file-position stream (1- (file-position stream))))
+ (t (file-position stream pos0)))))
+
#-(or lispworks4.1 lispworks4.2) ; no dspec:parse-form-dspec prior to 4.3
(defun dspec-stream-position (stream dspec)
(with-fairly-standard-io-syntax
- (loop (let* ((pos (file-position stream))
+ (loop (let* ((pos (progn (skip-comments stream) (file-position stream)))
(form (read stream nil '#1=#:eof)))
(when (eq form '#1#)
(return nil))
@@ -517,8 +524,8 @@
#-(or lispworks4.1 lispworks4.2)
(dspec-stream-position stream dspec)))
(if pos
- (list :position (1+ pos) t)
- (dspec-buffer-position dspec 1))))))
+ (list :position (1+ pos))
+ (dspec-function-name-position dspec `(:position 1)))))))
(defun emacs-buffer-location-p (location)
(and (consp location)
@@ -540,7 +547,7 @@
(destructuring-bind (_ buffer offset string) location
(declare (ignore _ string))
(make-location `(:buffer ,buffer)
- (dspec-buffer-position dspec offset)
+ (dspec-function-name-position dspec `(:offset ,offset 0))
hints)))))
(defun make-dspec-progenitor-location (dspec location)
--- /project/slime/cvsroot/slime/swank-openmcl.lisp 2008/09/12 12:27:38 1.133
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp 2008/09/17 06:19:49 1.134
@@ -300,11 +300,13 @@
(if *buffer-name*
(make-location
(list :buffer *buffer-name*)
- (list :position position t))
+ (list :offset position 0)
+ (list :align t))
(if (ccl::compiler-warning-file-name condition)
(make-location
(list :file (namestring (truename (ccl::compiler-warning-file-name condition))))
- (list :position position t))))))))
+ (list :position position)
+ (list :align t))))))))
(defun temp-file-name ()
"Return a temporary file name to compile strings into."
--- /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/09/12 12:27:38 1.218
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/09/17 06:19:49 1.219
@@ -371,17 +371,15 @@
(defun locate-compiler-note (file source-path source)
(cond ((and (not (eq file :lisp)) *buffer-name*)
;; Compiling from a buffer
- (let ((position (+ *buffer-offset*
- (source-path-string-position
- source-path *buffer-substring*))))
- (make-location (list :buffer *buffer-name*)
- (list :position position))))
+ (make-location (list :buffer *buffer-name*)
+ (list :offset *buffer-offset*
+ (source-path-string-position
+ source-path *buffer-substring*))))
((and (pathnamep file) (null *buffer-name*))
;; Compiling from a file
(make-location (list :file (namestring file))
- (list :position
- (1+ (source-path-file-position
- source-path file)))))
+ (list :position (1+ (source-path-file-position
+ source-path file)))))
((and (eq file :lisp) (stringp source))
;; Compiling macro generated code
(make-location (list :source-form source)
@@ -590,7 +588,7 @@
character-offset))
(snippet (string-path-snippet emacs-string form-path pos)))
(make-location `(:buffer ,emacs-buffer)
- `(:position ,(+ pos emacs-position))
+ `(:offset ,emacs-position ,pos)
`(:snippet ,snippet))))
((not pathname)
`(:error ,(format nil "Source definition of ~A ~A not found"
@@ -603,7 +601,7 @@
(make-location `(:file ,namestring)
;; /file positions/ in Common Lisp start
;; from 0, in Emacs they start from 1.
- `(:position ,(1+ pos))
+ `(:position (1+ ,pos))
`(:snippet ,snippet))))))))
(defun string-path-snippet (string form-path position)
@@ -905,7 +903,7 @@
(defun lisp-source-location (code-location)
(let ((source (prin1-to-string
(sb-debug::code-location-source-form code-location 100))))
- (make-location `(:source-form ,source) '(:position 0))))
+ (make-location `(:source-form ,source) '(:position 1))))
(defun emacs-buffer-source-location (code-location plist)
(if (code-location-has-debug-block-info-p code-location)
@@ -916,7 +914,7 @@
(snipped (with-input-from-string (s emacs-string)
(read-snippet s pos))))
(make-location `(:buffer ,emacs-buffer)
- `(:position ,(+ emacs-position pos))
+ `(:offset ,emacs-position ,pos)
`(:snippet ,snipped))))
(fallback-source-location code-location)))
@@ -930,7 +928,7 @@
(let* ((pos (stream-source-position code-location s))
(snippet (read-snippet s pos)))
(make-location `(:file ,filename)
- `(:position ,(1+ pos))
+ `(:position ,pos)
`(:snippet ,snippet)))))))
(defun code-location-debug-source-name (code-location)
--- /project/slime/cvsroot/slime/swank-scl.lisp 2008/09/12 12:27:38 1.24
+++ /project/slime/cvsroot/slime/swank-scl.lisp 2008/09/17 06:19:49 1.25
@@ -455,7 +455,7 @@
(pos (c::compiler-read-error-position condition)))
(cond ((and (eq file :stream) *buffer-name*)
(make-location (list :buffer *buffer-name*)
- (list :position (+ *buffer-start-position* pos))))
+ (list :offset *buffer-start-position* pos)))
((and (pathnamep file) (not *buffer-name*))
(make-location (list :file (unix-truename file))
(list :position (1+ pos))))
@@ -480,17 +480,15 @@
(defun locate-compiler-note (file source source-path)
(cond ((and (eq file :stream) *buffer-name*)
;; Compiling from a buffer
- (let ((position (+ *buffer-start-position*
- (source-path-string-position
- source-path *buffer-substring*))))
- (make-location (list :buffer *buffer-name*)
- (list :position position))))
+ (make-location (list :buffer *buffer-name*)
+ (list :offset *buffer-start-position*
+ (source-path-string-position
+ source-path *buffer-substring*))))
((and (pathnamep file) (null *buffer-name*))
;; Compiling from a file
(make-location (list :file (unix-truename file))
- (list :position
- (1+ (source-path-file-position
- source-path file)))))
+ (list :position (1+ (source-path-file-position
+ source-path file)))))
((and (eq file :lisp) (stringp source))
;; No location known, but we have the source form.
;; XXX How is this case triggered? -luke (16/May/2004)
@@ -712,7 +710,7 @@
(with-input-from-string (s source-code)
(make-location (list :file (unix-truename filename))
(list :position (1+ (code-location-stream-position
- code-location s)))
+ code-location s)))
`(:snippet ,(read-snippet s))))))
(defun location-in-stream (code-location debug-source)
@@ -727,7 +725,7 @@
string)))
(make-location
(list :buffer (getf info :emacs-buffer))
- (list :position (+ (getf info :emacs-buffer-offset) position))
+ (list :offset (getf info :emacs-buffer-offset) position)
(list :snippet (with-input-from-string (s string)
(file-position s position)
(read-snippet s))))))
More information about the slime-cvs
mailing list