branch: externals/sly
commit b2732f4a56cedd9ed926138d9c772a61735dea40
Author: Christian Schafmeister <meis...@temple.edu>
Commit: João Távora <joaotav...@gmail.com>
Add line, column kw args to slynk-compile-string
* slynk/backend/abcl.lisp (slynk-compile-string): Add new args.
* slynk/backend/allegro.lisp (slynk-compile-string): Add new args.
* slynk/backend/ccl.lisp (slynk-compile-string): Add new args.
* slynk/backend/clasp.lisp (slynk-compile-string): Add new args.
* slynk/backend/clisp.lisp (slynk-compile-string): Add new args.
* slynk/backend/cmucl.lisp (slynk-compile-string): Add new args.
* slynk/backend/corman.lisp (slynk-compile-string): Add new args.
* slynk/backend/ecl.lisp (slynk-compile-string): Add new args.
* slynk/backend/lispworks.lisp (slynk-compile-string): Add new args.
* slynk/backend/mkcl.lisp (slynk-compile-string): Add new args.
* slynk/backend/sbcl.lisp (slynk-compile-string): Add new args.
* slynk/backend/scl.lisp (slynk-compile-string): Add new args.
* slynk/slynk-backend.lisp (slynk-compile-string): Tweak docstring.
* slynk/slynk.lisp (compile-string-for-emacs): Pass new args to backend.
Co-authored-by: João Távora <joaotav...@gmail.com>
Cherry-pick-from: SLIME commit ebf170aed587e98d9af75151df1d497e185f5ae0
---
slynk/backend/abcl.lisp | 4 ++--
slynk/backend/allegro.lisp | 6 +++---
slynk/backend/ccl.lisp | 4 ++--
slynk/backend/clasp.lisp | 4 ++--
slynk/backend/clisp.lisp | 4 ++--
slynk/backend/cmucl.lisp | 4 ++--
slynk/backend/corman.lisp | 4 ++--
slynk/backend/ecl.lisp | 4 ++--
slynk/backend/lispworks.lisp | 4 ++--
slynk/backend/mkcl.lisp | 4 ++--
slynk/backend/sbcl.lisp | 3 ++-
slynk/backend/scl.lisp | 4 ++--
slynk/slynk-backend.lisp | 7 ++++++-
slynk/slynk.lisp | 7 ++++++-
14 files changed, 37 insertions(+), 26 deletions(-)
diff --git a/slynk/backend/abcl.lisp b/slynk/backend/abcl.lisp
index 571fac6..7fbd34c 100644
--- a/slynk/backend/abcl.lisp
+++ b/slynk/backend/abcl.lisp
@@ -489,8 +489,8 @@
(not (load fn)))))))))
(defimplementation slynk-compile-string (string &key buffer position filename
- policy)
- (declare (ignore filename policy))
+ line column policy)
+ (declare (ignore filename line column policy))
(let ((jvm::*resignal-compiler-warnings* t)
(*abcl-signaled-conditions* nil))
(handler-bind ((warning #'handle-compiler-warning))
diff --git a/slynk/backend/allegro.lisp b/slynk/backend/allegro.lisp
index 792d0be..8a80532 100644
--- a/slynk/backend/allegro.lisp
+++ b/slynk/backend/allegro.lisp
@@ -583,9 +583,9 @@ to do this, this factors in the length of the inserted
header itself."
(not failure?)))))
(defimplementation slynk-compile-string (string &key buffer position filename
- policy)
- (declare (ignore policy))
- (handler-case
+ line column policy)
+ (declare (ignore line column policy))
+ (handler-case
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-start-position* position)
diff --git a/slynk/backend/ccl.lisp b/slynk/backend/ccl.lisp
index 266fe0c..c054e9e 100644
--- a/slynk/backend/ccl.lisp
+++ b/slynk/backend/ccl.lisp
@@ -207,8 +207,8 @@
;; Use a temp file rather than in-core compilation in order to handle
;; eval-when's as compile-time.
(defimplementation slynk-compile-string (string &key buffer position filename
- policy)
- (declare (ignore policy))
+ line column policy)
+ (declare (ignore line column policy))
(with-compilation-hooks ()
(let ((temp-file-name (ccl:temp-pathname))
(ccl:*save-source-locations* t))
diff --git a/slynk/backend/clasp.lisp b/slynk/backend/clasp.lisp
index 8bfee5e..55d402b 100644
--- a/slynk/backend/clasp.lisp
+++ b/slynk/backend/clasp.lisp
@@ -285,8 +285,8 @@
(defun tmpfile-to-buffer (tmp-file)
(gethash tmp-file *tmpfile-map*))
-(defimplementation slynk-compile-string (string &key buffer position filename
policy)
- (declare (ignore policy))
+(defimplementation slynk-compile-string (string &key buffer position filename
line column policy)
+ (declare (ignore line column policy)) ;; We will use line and column in the
future
(with-compilation-hooks ()
(let ((*buffer-name* buffer) ; for compilation hooks
(*buffer-start-position* position))
diff --git a/slynk/backend/clisp.lisp b/slynk/backend/clisp.lisp
index bd0c9d6..0937625 100644
--- a/slynk/backend/clisp.lisp
+++ b/slynk/backend/clisp.lisp
@@ -691,8 +691,8 @@ Execute BODY with NAME's function slot set to FUNCTION."
(not (load fasl-file)))))))))
(defimplementation slynk-compile-string (string &key buffer position filename
- policy)
- (declare (ignore filename policy))
+ line column policy)
+ (declare (ignore filename line column policy))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-offset* position))
diff --git a/slynk/backend/cmucl.lisp b/slynk/backend/cmucl.lisp
index 802b532..fba9701 100644
--- a/slynk/backend/cmucl.lisp
+++ b/slynk/backend/cmucl.lisp
@@ -290,8 +290,8 @@ NIL if we aren't compiling from a buffer.")
(not (load output-file)))))))))
(defimplementation slynk-compile-string (string &key buffer position filename
- policy)
- (declare (ignore filename policy))
+ line column policy)
+ (declare (ignore filename line column policy))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-start-position* position)
diff --git a/slynk/backend/corman.lisp b/slynk/backend/corman.lisp
index 36f3d89..e923a4f 100644
--- a/slynk/backend/corman.lisp
+++ b/slynk/backend/corman.lisp
@@ -378,8 +378,8 @@
(or failure? (and load-p (load output-file))))))))
(defimplementation slynk-compile-string (string &key buffer position filename
- policy)
- (declare (ignore filename policy))
+ line column policy)
+ (declare (ignore filename line column policy))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-position* position)
diff --git a/slynk/backend/ecl.lisp b/slynk/backend/ecl.lisp
index ecb0869..9ebeff5 100644
--- a/slynk/backend/ecl.lisp
+++ b/slynk/backend/ecl.lisp
@@ -313,8 +313,8 @@
(gethash tmp-file *tmpfile-map*))
(defimplementation slynk-compile-string
- (string &key buffer position filename policy)
- (declare (ignore policy))
+ (string &key buffer position filename line column policy)
+ (declare (ignore line column policy))
(with-compilation-hooks ()
(let ((*buffer-name* buffer) ; for compilation hooks
(*buffer-start-position* position))
diff --git a/slynk/backend/lispworks.lisp b/slynk/backend/lispworks.lisp
index 7634426..ce8f690 100644
--- a/slynk/backend/lispworks.lisp
+++ b/slynk/backend/lispworks.lisp
@@ -764,8 +764,8 @@ function names like \(SETF GET)."
htab))
(defimplementation slynk-compile-string (string &key buffer position filename
- policy)
- (declare (ignore filename policy))
+ line column policy)
+ (declare (ignore filename line column policy))
(assert buffer)
(assert position)
(let* ((location (list :emacs-buffer buffer position))
diff --git a/slynk/backend/mkcl.lisp b/slynk/backend/mkcl.lisp
index 0b02aec..a96d896 100644
--- a/slynk/backend/mkcl.lisp
+++ b/slynk/backend/mkcl.lisp
@@ -265,8 +265,8 @@
(or failure-p
(and load-p (not (load output-truename))))))))))
-(defimplementation slynk-compile-string (string &key buffer position filename
policy)
- (declare (ignore filename policy))
+(defimplementation slynk-compile-string (string &key buffer position filename
line column policy)
+ (declare (ignore filename line column policy))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-start-position* position)
diff --git a/slynk/backend/sbcl.lisp b/slynk/backend/sbcl.lisp
index 1914c27..53db168 100644
--- a/slynk/backend/sbcl.lisp
+++ b/slynk/backend/sbcl.lisp
@@ -755,7 +755,8 @@ QUALITIES is an alist with (quality . value)"
(defvar *trap-load-time-warnings* t)
(defimplementation slynk-compile-string (string &key buffer position filename
- policy)
+ line column policy)
+ (declare (ignore line column))
(let ((*buffer-name* buffer)
(*buffer-offset* position)
(*buffer-substring* string)
diff --git a/slynk/backend/scl.lisp b/slynk/backend/scl.lisp
index 1786af1..c31106f 100644
--- a/slynk/backend/scl.lisp
+++ b/slynk/backend/scl.lisp
@@ -157,8 +157,8 @@
(not (load output-file)))))))))
(defimplementation slynk-compile-string (string &key buffer position filename
- policy)
- (declare (ignore filename policy))
+ line column policy)
+ (declare (ignore filename line column policy))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-start-position* position)
diff --git a/slynk/slynk-backend.lisp b/slynk/slynk-backend.lisp
index de9fb23..8c5f892 100644
--- a/slynk/slynk-backend.lisp
+++ b/slynk/slynk-backend.lisp
@@ -626,7 +626,7 @@ such package."
`(call-with-compilation-hooks (lambda () (progn ,@body))))
(definterface slynk-compile-string (string &key buffer position filename
- policy)
+ line column policy)
"Compile source from STRING.
During compilation, compiler conditions must be trapped and
resignalled as COMPILER-CONDITIONs.
@@ -644,6 +644,11 @@ If POLICY is supplied, and non-NIL, it may be used by
certain
implementations to compile with optimization qualities of its
value.
+If LINE and COLUMN are supplied, and non-NIL, they may be used by
+certain implementations (presumably instead of POSITION) as the line
+and column of the start of the string in FILENAME. Both LINE and
+COLUMN are 1-based.
+
Should return T on successful compilation, NIL otherwise.
")
diff --git a/slynk/slynk.lisp b/slynk/slynk.lisp
index f89f7f1..6217ab5 100644
--- a/slynk/slynk.lisp
+++ b/slynk/slynk.lisp
@@ -2888,7 +2888,10 @@ Record compiler notes signalled as
`compiler-condition's."
(defslyfun compile-string-for-emacs (string buffer position filename policy)
"Compile STRING (exerpted from BUFFER at POSITION).
Record compiler notes signalled as `compiler-condition's."
- (let ((offset (cadr (assoc :position position))))
+ (let* ((offset (cadr (assoc :position position)))
+ (line-column (cdr (assoc :line position)))
+ (line (first line-column))
+ (column (second line-column)))
(with-buffer-syntax ()
(collect-notes
(lambda ()
@@ -2899,6 +2902,8 @@ Record compiler notes signalled as `compiler-condition's."
:buffer buffer
:position offset
:filename filename
+ :line line
+ :column column
:policy policy)))))))
(defslyfun compile-multiple-strings-for-emacs (strings policy)
