[slime-devel] swank-clisp, bug report, stream encoding proposal, and a few bugfixes
sedachv
sedachv at cpsc.ucalgary.ca
Tue Dec 30 23:41:08 UTC 2003
Hello,
I sent mail to Luke about this a few days ago, but I guess he's busy
partying like it's 2003 :) (if not, then please check your
common-lisp.net mailbox and disregard it!). Anyway, I've gotten the
swank backend mostly working on CLISP. The file is attached. On the
way, I've also discovered that the slime state machine generates an
error on :read-string (and gives the "you've encountered an error in
SLIME" message). This should probably be fixed (and I'm not man enough
to do it), as it means that interactive restarts (and probably
anything else that does query-io) doesn't work.
I also have a proposal stemming from potential problems with the
current message-length and character encoding schemes. The stream
character encoding should be specified by a slime variable (which
defaults to something like "iso-8859-1"), whose value gets passed to a
swank function on initialization, which then converts it to internal
representation and binds it to a special variable, which is used when
opening slime sockets. The message length should then be represented
by arabic numerals - the first character in a message is 0-9 and
indicated how many (1+) subsequent chars to read to get the message
length (giving maximum message length of 10 9s). This is a lot less
efficient than the current method, but it'll work with any character
encoding scheme supporting arabic numerals (which the ANSI spec says
are part of standard characters and so must be provided by every
conforming implementation). I propose character encoding should be
specified by ASCII strings like "UTF-8", with standard names used so
you can just run find-symbol or equivalent on them to get at the
encoding object in Lisp and Emacs.
Also, here are some patches for things I've changed along the way:
In slime.el (the RE doesn't work for CLISP's output, and I belive this
type of formatting should be done in swank):
***************
*** 3689,3697 ****
for (number string) = frame
do
(let (label framestring)
! (setq label (format "%s" number)
! framestring string)
! (slime-insert-propertized `(frame ,frame) " "
(in-sldb-face frame-label label) " "
(in-sldb-face frame-line framestring) "\n")))
(let ((number (sldb-previous-frame-number)))
--- 3689,3699 ----
for (number string) = frame
do
(let (label framestring)
! (if (string-match "\\([0-9]*:\\)?\\s *\\(.*\\)" string)
! (setq label (match-string 1 string)
! framestring (match-string 2 string))
! (setq label "" framestring string))
! (slime-insert-propertized `(frame ,frame) " "
(in-sldb-face frame-label label) " "
(in-sldb-face frame-line framestring) "\n")))
(let ((number (sldb-previous-frame-number)))
In swank-backend.lisp:
***************
*** 134,141 ****
(defgeneric call-with-compilation-hooks (func)
(:documentation
"Call FUNC with hooks to trigger SLDB on compiler errors."))
! (defmacro with-compilation-hooks ((&rest ignore) &body body)
! (declare (ignore ignore))
`(call-with-compilation-hooks (lambda () (progn , at body))))
(defgeneric compile-string-for-emacs (string &key buffer position)
--- 134,140 ----
(defgeneric call-with-compilation-hooks (func)
(:documentation
"Call FUNC with hooks to trigger SLDB on compiler errors."))
! (defmacro with-compilation-hooks (() &body body)
`(call-with-compilation-hooks (lambda () (progn , at body))))
(defgeneric compile-string-for-emacs (string &key buffer position)
In swank.lisp (CLISP didn't like the for loop, and neither did I :)
***************
*** 434,455 ****
(defun eval-region (string &optional package-update-p)
"Evaluate STRING and return the result.
! If PACKAGE-UPDATE-P is non-nil, and evaluation causes a package
! change, then send Emacs an update."
! (let ((*package* *buffer-package*)
! form
! (pos 0)
! return-values
! (end-symbol (gensym)))
(unwind-protect
! (loop (multiple-value-setq (form pos)
! (read-from-string string nil end-symbol :start pos))
! (if (eq form end-symbol)
! (return return-values)
! (setq return-values
! (multiple-value-list (eval form)))))
(when (and package-update-p (not (eq *package* *buffer-package*)))
! (send-to-emacs (list :new-package (shortest-package-nickname *package*)))))))
(defun shortest-package-nickname (package)
"Return the shortest nickname (or canonical name) of PACKAGE."
--- 434,452 ----
(defun eval-region (string &optional package-update-p)
"Evaluate STRING and return the result.
! If PACKAGE-UPDATE-P is non-nil, and evaluation causes a package
! change, then send Emacs an update."
! (let ((*package* *buffer-package*))
(unwind-protect
! (with-input-from-string (stream string)
! (loop for form = (read stream nil stream)
! until (eq form stream)
! for - = form
! for values = (multiple-value-list (eval form))
! do (force-output)
! finally (return (values values -))))
(when (and package-update-p (not (eq *package* *buffer-package*)))
! (send-to-emacs (list :new-package (shortest-package-nickname *package*)))))))
(defun shortest-package-nickname (package)
"Return the shortest nickname (or canonical name) of PACKAGE."
Happy New Years!
Vladimir
-------------- next part --------------
;;; swank-clisp.lisp - SWANK for CLISP
;;; Created 2003, Vladimir Sedach <sedachv at cpsc.ucalgary.ca>
;;;
;;; As seems to be fashionable,
;;; This code has been placed in the Public Domain. All warranties are
;;; disclaimed.
;;; Confirmed working under CLISP 2.31. Maybe also works on 2.30 (untested)
;;; Definitly will not run on CLISP 2.29 or below
;;; The goodies (what's working):
;; - All communication stuff seems to have been massaged
;; - Completion, arglist, apropos, describe symbol, disassemble symbol, macroexpansion
;; - Everything in eval easy-menu
;; - Most things to do with compiling
;; - A lot (most?) of debugging stuff
;;; What doesn't work:
;; - Most debugging conditions use *query-io*, and the slime state-machine gets stuck on :read-string
;; - Compiler notes aren't implemented
;; - SLIME's completion fails, so we use CLISP's native one (you won't notice the difference!)
;; - CLISP apropos seems a little funny
;; - ASDF and hence the system functions
;; - XREF (until it's ported)
;; - Frame source location
;; - Multiprocessing (until someone finishes it for CLISP)
(in-package :swank)
;;; Gray streams stuff
(import
'(gray:fundamental-character-output-stream
gray:stream-write-char
gray:stream-force-output
gray:fundamental-character-input-stream
gray:stream-read-char
gray:stream-listen
gray:stream-unread-char
gray:stream-clear-input
gray:stream-line-column))
(defvar *swank-debug-p* t
"When true, print extra debugging information.")
;;; Multiprocessing stuff
(setq *multiprocessing-enabled* nil)
(defun without-interrupts* (body)
(funcall body))
;;; System stuff
;;;; !!! Does this work on windows?
(defslimefun getpid ()
(system::program-id))
;;; Networking code
(defvar *use-dedicated-output-stream* t
"Right now in CLISP, we have no choice but to use it. This is here mostly for
documentation purposes")
(defun get-socket-stream (port announce close-socket-p)
(let ((socket (socket:socket-server port)))
(socket:socket-wait socket 0)
(funcall announce (socket:socket-server-port socket))
(prog1
(socket:socket-accept socket :external-format charset:iso-8859-1) ; note that we need 8-bit chars
(when close-socket-p
(socket:socket-server-close socket)))))
(defun serve-request (*emacs-io* *slime-output* *slime-input* *slime-io*)
"Read and process a request from a SWANK client.
The request is read from the socket as a sexp and then evaluated."
(catch 'slime-toplevel
(handler-case (read-from-emacs)
(ext:simple-charset-type-error (err)
(format *debug-io* "Wrong slime stream encoding:~%~A" err))
(slime-read-error (e)
(when *swank-debug-p*
(format *debug-io* "~&;; Connection to Emacs lost.~%;; [~A]~%" e))
(close *emacs-io* :abort t)
(when *use-dedicated-output-stream*
(close *slime-output* :abort t))
(throw 'closed-connection
(print "Connection to emacs closed" *debug-io*))))))
(defun open-stream-to-emacs ()
"Return an output-stream to Emacs' output buffer."
(let* ((listener (socket:socket-server))
(port (socket:socket-server-port listener)))
(unwind-protect
(prog2
(eval-in-emacs `(slime-open-stream-to-lisp ,port))
(socket:socket-accept listener))
(socket:socket-server-close listener))))
(defun create-swank-server (port &key (announce #'simple-announce-function)
reuse-address
background
(close-socket-p t))
(declare (ignore reuse-address background))
(let* ((emacs (get-socket-stream port announce close-socket-p))
(slime-out (let ((*emacs-io* emacs)) (open-stream-to-emacs)))
(slime-in (make-instance 'slime-input-stream))
(slime-io (make-two-way-stream slime-in slime-out)))
(catch 'closed-connection
(loop (serve-request emacs slime-out slime-in slime-io)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Utilities
;;; Cribbed from swank-sbcl
(defslimefun set-default-directory (directory)
(setf *default-pathname-defaults* (merge-pathnames directory))
(namestring *default-pathname-defaults*))
(defmethod arglist-string (fname)
(let ((*print-case* :downcase))
(multiple-value-bind (arglist condition)
(ignore-errors (let ((*package* *buffer-package*))
(cl-user::arglist (read-from-string fname))))
(if condition
(return-from arglist-string (format nil "(-- ~A)" condition))
(princ-to-string arglist)))))
(defslimefun completions (string default-package-name)
"CLISP doesn't like SLIME's routine."
(let ((comps (system::completion string 0 (length string))))
(list comps (car comps))))
;;; Cribbed from SBCL
(defmethod describe-symbol-for-emacs (symbol)
"Return a plist describing SYMBOL.
Return NIL if the symbol is unbound."
(let ((result ()))
(labels ((doc (kind)
(or (documentation symbol kind) :not-documented))
(maybe-push (property value)
(when value
(setf result (list* property value result)))))
(when (fboundp symbol)
(if (macro-function symbol)
(setf (getf result :macro) (doc 'function))
(setf (getf result :function) (doc 'function))))
(maybe-push :variable (when (boundp symbol) (doc 'variable)))
(maybe-push :class (when (find-class symbol nil) (doc 'type))) ;this should be fixed
result)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Debugging stuff
(defvar *swank-debugger-stack-frame* nil)
(defvar *swank-debugger-condition*)
(defvar *sldb-restarts* nil)
(defvar *sldb-topframe* nil)
(setq *sldb-initial-frames* 5)
; debugging hooks
(defmethod call-with-debugging-environment (func)
(let ((*sldb-topframe* (system::the-frame))
(*sldb-restarts*
(compute-restarts *swank-debugger-condition*))
(*debugger-hook* nil)
(*print-level* nil)
(*print-length* nil)
(*print-circle* t)
(*print-escape* nil)
(*print-readably* nil)
(*print-pretty* nil))
(system::same-env-as *sldb-topframe* (funcall func))))
;;; Taken from swank-sbcl
(defun format-condition-for-emacs ()
(format nil "~A~% [Condition of type ~S]"
(ignore-errors *swank-debugger-condition*)
(type-of *swank-debugger-condition*)))
;;; Taken from swank-cmucl
(defun format-restarts-for-emacs ()
"Return a list of restarts for *swank-debugger-condition* in a
format suitable for Emacs."
(loop for restart in *sldb-restarts*
collect (list (princ-to-string (restart-name restart))
(princ-to-string restart))))
;;; cribbed from swank-cmucl
(defun nth-frame (index)
(do ((frame *sldb-topframe* (system::frame-down-1 frame 1))
(i index (1- i)))
((zerop i) frame)))
;(defun nth-frame (index)
; (system::frame-limit1 index))
;;; from swank-cmucl
(defun nth-restart (index)
(nth index *sldb-restarts*))
;;; from swank-cmucl
(defun compute-backtrace (start end)
"Return a list of frames starting with frame number START and
continuing to frame number END or, if END is nil, the last frame on the
stack."
(loop for f = (nth-frame start) then (system::frame-down-1 f 1)
for i from start below end
while f
collect (cons i f)))
;;; from swank-cmucl
(defun format-frame-for-emacs (frame)
(remove #\Newline
(with-output-to-string (*frame-output*)
(let ((*print-pretty* *sldb-pprint-frames*))
(system::describe-frame *frame-output* frame)))))
;;; from swank-cmucl
(defmethod backtrace (start end)
(loop for (n . frame) in (compute-backtrace start end)
collect (list n (format-frame-for-emacs frame))))
;;; Cribbed from swank-sbcl
(defmethod debugger-info-for-emacs (start end)
(list (format-condition-for-emacs)
(format-restarts-for-emacs)
(backtrace start end)))
(defmethod eval-in-frame (form index)
(system::same-env-as (nth-frame index) (eval form)))
;;; from swank-sbcl
(defslimefun invoke-nth-restart (index)
(invoke-restart-interactively (nth-restart index)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compilation hooks
(defmethod compile-system-for-emacs (system-name)
nil)
;;; Cribbed from swank-sbcl
(defmethod compile-file-for-emacs (filename load-p)
(with-compilation-hooks ()
(multiple-value-bind (comp-file w-p f-p) (compile-file filename)
(cond ((and comp-file (not f-p) load-p)
(load comp-file))
(t comp-file)))))
;;; Cribbed from swank-sbcl
(defmethod compile-string-for-emacs (string &key buffer position)
(with-compilation-hooks ()
(let ((*package* *buffer-package*)
(*buffer-name* buffer)
(*buffer-offset* position))
(eval (from-string
(format nil "(funcall (compile nil '(lambda () ~A)))"
string))))))
(defun handle-compiler-error (comp-error)
(signal (make-condition
'compiler-condition
:original-condition condition
:severity :error
:message (format nil "~A" condition))))
;;; borrowed from swank-sbcl
(defmethod call-with-compilation-hooks (func)
(handler-bind ((system::compiler-error #'handle-compiler-error)
;(cl-user::style-warning #'handle-notification-condition) in the future there will be warnings
;(cl-user::simple-warning #'handle-notification-condition)
;(cl-user::warning #'handle-notification-condition)
)
(funcall func)))
(defmethod macroexpand-all (form)
"Expand-form returns the expanded form as the primary value and t if
any macroexpansion has been done."
(ext:expand-form form))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Unimplemented
;;; Cribbed from swank-sbcl (CLISP likewise has an xref deficiency)
(defslimefun-unimplemented who-calls (function-name))
(defslimefun-unimplemented who-references (variable))
(defslimefun-unimplemented who-binds (variable))
(defslimefun-unimplemented who-sets (variable))
(defslimefun-unimplemented who-macroexpands (macro))
More information about the slime-devel
mailing list