branch: elpa/slime
commit 1ebe29f3471444579a52fc6035c105526ef81489
Author: Stas Boukarev <stass...@gmail.com>
Commit: Stas Boukarev <stass...@gmail.com>
Remove *shebang-readtable* for sbcl.
It's not used anymore for a long time.
---
contrib/slime-repl.el | 5 ++-
contrib/swank-repl.lisp | 10 +++---
swank.lisp | 4 +--
swank/backend.lisp | 4 ---
swank/ecl.lisp | 5 ---
swank/sbcl.lisp | 89 ++++---------------------------------------------
6 files changed, 16 insertions(+), 101 deletions(-)
diff --git a/contrib/slime-repl.el b/contrib/slime-repl.el
index dfb2e07182..c4c7db90bd 100644
--- a/contrib/slime-repl.el
+++ b/contrib/slime-repl.el
@@ -1720,9 +1720,8 @@ expansion will be added to the REPL's history.)"
(defun slime-repl-connected-hook-function ()
(cl-destructuring-bind (package prompt)
- (let ((slime-current-thread t)
- (cs (slime-repl-choose-coding-system)))
- (slime-eval `(swank-repl:create-repl nil :coding-system ,cs)))
+ (let ((slime-current-thread t))
+ (slime-eval `(swank-repl:create-repl nil)))
(setf (slime-lisp-package) package)
(setf (slime-lisp-package-prompt-string) prompt))
(slime-hide-inferior-lisp-buffer)
diff --git a/contrib/swank-repl.lisp b/contrib/swank-repl.lisp
index 52e8781db3..cbb23d2db0 100644
--- a/contrib/swank-repl.lisp
+++ b/contrib/swank-repl.lisp
@@ -78,7 +78,7 @@ When :STARTED-FROM-EMACS redirect when launched by M-x slime")
((t) t)
(:started-from-emacs swank-loader:*started-from-emacs*)))
-(defun open-streams (connection properties)
+(defun open-streams (connection)
"Return the 4 streams for IO redirection:
INPUT OUTPUT IO REPL-RESULTS"
(let* ((input-fn
@@ -148,10 +148,10 @@ INPUT OUTPUT IO REPL-RESULTS"
;;; We always redirect the standard streams to Emacs while evaluating
;;; an RPC. This is done with simple dynamic bindings.
-(defslimefun create-repl (target &key coding-system)
+(defslimefun create-repl (target)
(assert (eq target nil))
(let ((conn *emacs-connection*))
- (initialize-streams-for-connection conn `(:coding-system ,coding-system))
+ (initialize-streams-for-connection conn)
(with-struct* (connection. @ conn)
(setf (@ env)
`((*standard-input* . ,(@ user-input))
@@ -184,9 +184,9 @@ INPUT OUTPUT IO REPL-RESULTS"
(list (package-name *package*)
(package-string-for-prompt *package*)))))
-(defun initialize-streams-for-connection (connection properties)
+(defun initialize-streams-for-connection (connection)
(multiple-value-bind (in out io repl-results)
- (open-streams connection properties)
+ (open-streams connection)
(setf (connection.user-io connection) io
(connection.user-output connection) out
(connection.user-input connection) in
diff --git a/swank.lisp b/swank.lisp
index 522c90cfb0..7d7a4ed71d 100644
--- a/swank.lisp
+++ b/swank.lisp
@@ -1674,13 +1674,13 @@ Return nil if no package matches."
(if (find #\! string) ; for SBCL
(guess-package (substitute #\- #\! string))))))
-(defvar *readtable-alist* (default-readtable-alist)
+(defvar *readtable-alist* nil
"An alist mapping package names to readtables.")
(defun guess-buffer-readtable (package-name)
(let ((package (guess-package package-name)))
(or (and package
- (cdr (assoc (package-name package) *readtable-alist*
+ (cdr (assoc (package-name package) *readtable-alist*
:test #'string=)))
*readtable*)))
diff --git a/swank/backend.lisp b/swank/backend.lisp
index b1266d6243..ccf8a57032 100644
--- a/swank/backend.lisp
+++ b/swank/backend.lisp
@@ -477,10 +477,6 @@ This is used to resolve filenames without directory
component."
"Call FN with hooks to handle special syntax."
(funcall fn))
-(definterface default-readtable-alist ()
- "Return a suitable initial value for SWANK:*READTABLE-ALIST*."
- '())
-
;;;; Packages
diff --git a/swank/ecl.lisp b/swank/ecl.lisp
index 0c5bb1ceb7..1ed3bd6c6f 100644
--- a/swank/ecl.lisp
+++ b/swank/ecl.lisp
@@ -245,11 +245,6 @@
;;; `ffi:c-inline' to be handled as C/C++ code?
;;;
;;; call-with-syntax-hooks
-
-;;; Return a suitable initial value for SWANK:*READTABLE-ALIST*.
-;;;
-;;; default-readtable-alist
-
;;;; Packages
diff --git a/swank/sbcl.lisp b/swank/sbcl.lisp
index ada18abff6..3e1204fff0 100644
--- a/swank/sbcl.lisp
+++ b/swank/sbcl.lisp
@@ -355,98 +355,24 @@
(sb-bsd-sockets:interrupted-error ()))))
-;;;; Support for SBCL syntax
-
-;;; SBCL's source code is riddled with #! reader macros. Also symbols
-;;; containing `!' have special meaning. We have to work long and
-;;; hard to be able to read the source. To deal with #! reader
-;;; macros, we use a special readtable. The special symbols are
-;;; converted by a condition handler.
-
-(defun feature-in-list-p (feature list)
- (etypecase feature
- (symbol (member feature list :test #'eq))
- (cons (flet ((subfeature-in-list-p (subfeature)
- (feature-in-list-p subfeature list)))
- ;; Don't use ECASE since SBCL also has :host-feature,
- ;; don't need to handle it or anything else appearing in
- ;; the future or in erronous code.
- (case (first feature)
- (:or (some #'subfeature-in-list-p (rest feature)))
- (:and (every #'subfeature-in-list-p (rest feature)))
- (:not (destructuring-bind (e) (cdr feature)
- (not (subfeature-in-list-p e)))))))))
-
-(defun shebang-reader (stream sub-character infix-parameter)
- (declare (ignore sub-character))
- (when infix-parameter
- (error "illegal read syntax: #~D!" infix-parameter))
- (let ((next-char (read-char stream)))
- (unless (find next-char "+-")
- (error "illegal read syntax: #!~C" next-char))
- ;; When test is not satisfied
- ;; FIXME: clearer if order of NOT-P and (NOT NOT-P) were reversed? then
- ;; would become "unless test is satisfied"..
- (when (let* ((*package* (find-package "KEYWORD"))
- (*read-suppress* nil)
- (not-p (char= next-char #\-))
- (feature (read stream)))
- (if (feature-in-list-p feature *features*)
- not-p
- (not not-p)))
- ;; Read (and discard) a form from input.
- (let ((*read-suppress* t))
- (read stream t nil t))))
- (values))
-
-(defvar *shebang-readtable*
- (let ((readtable (copy-readtable nil)))
- (set-dispatch-macro-character #\# #\!
- (lambda (s c n) (shebang-reader s c n))
- readtable)
- ;; Cross-floats
- (set-macro-character #\$ (lambda (stream char) (values)) nil readtable)
- readtable))
-
(defun sbcl-package-p (package)
(let ((name (package-name package)))
(eql (mismatch "SB-" name) 3)))
-(defun sbcl-source-file-p (filename)
- (when filename
- (loop for (nil pattern) in (logical-pathname-translations "SYS")
- thereis (pathname-match-p filename pattern))))
-
-(defun guess-readtable-for-filename (filename)
- (if (sbcl-source-file-p filename)
- *shebang-readtable*
- *readtable*))
-
-(defvar *debootstrap-packages* t)
-
(defun call-with-debootstrapping (fun)
(let ((*features* (append *features*
#+#.(swank/backend:with-symbol
'+internal-features+ 'sb-impl)
sb-impl:+internal-features+)))
- (handler-bind ((sb-int:bootstrap-package-not-found
- #'sb-int:debootstrap-package))
- (funcall fun))))
+ (funcall fun)))
(defmacro with-debootstrapping (&body body)
`(call-with-debootstrapping (lambda () ,@body)))
(defimplementation call-with-syntax-hooks (fn)
- (cond ((and *debootstrap-packages*
- (sbcl-package-p *package*))
+ (cond ((sbcl-package-p *package*)
(with-debootstrapping (funcall fn)))
(t
(funcall fn))))
-
-(defimplementation default-readtable-alist ()
- (let ((readtable *shebang-readtable*))
- (loop for p in (remove-if-not #'sbcl-package-p (list-all-packages))
- collect (cons (package-name p) readtable))))
-
;;; Packages
#+#.(swank/backend:with-symbol 'package-local-nicknames 'sb-ext)
@@ -895,7 +821,7 @@ QUALITIES is an alist with (quality . value)"
(defun file-form-number-position (definition-source)
(let* ((code-date (sb-introspect:definition-source-file-write-date
definition-source))
(filename (sb-introspect:definition-source-pathname
definition-source))
- (*readtable* (guess-readtable-for-filename filename))
+ (*readtable* *readtable*)
(source-code (get-source-code filename code-date)))
(with-debootstrapping
(with-input-from-string (s source-code)
@@ -908,10 +834,9 @@ QUALITIES is an alist with (quality . value)"
(defun definition-source-buffer-location (definition-source)
(with-definition-source (form-path character-offset plist) definition-source
- (destructuring-bind (&key emacs-buffer emacs-position emacs-directory
- emacs-string &allow-other-keys)
+ (destructuring-bind (&key emacs-buffer emacs-position emacs-string
&allow-other-keys)
plist
- (let ((*readtable* (guess-readtable-for-filename emacs-directory))
+ (let ((*readtable* *readtable*)
start
end)
(with-debootstrapping
@@ -990,7 +915,7 @@ QUALITIES is an alist with (quality . value)"
(defun source-file-position (filename write-date form-path)
(let ((source (get-source-code filename write-date))
- (*readtable* (guess-readtable-for-filename filename)))
+ (*readtable* *readtable*))
(with-debootstrapping
(source-path-string-position form-path source))))
@@ -1351,7 +1276,7 @@ stack."
(defun source-file-source-location (code-location)
(let* ((code-date (code-location-debug-source-created code-location))
(filename (code-location-debug-source-name code-location))
- (*readtable* (guess-readtable-for-filename filename))
+ (*readtable* *readtable*)
(source-code (get-source-code filename code-date)))
(with-debootstrapping
(with-input-from-string (s source-code)
