[slime-cvs] CVS update: slime/swank-cmucl.lisp slime/swank-sbcl.lisp slime/swank-clisp.lisp slime/swank-allegro.lisp slime/swank-openmcl.lisp slime/swank-lispworks.lisp slime/swank-corman.lisp slime/swank-abcl.lisp slime/swank-backend.lisp
Helmut Eller
heller at common-lisp.net
Tue Jul 5 20:31:02 UTC 2005
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv32240
Modified Files:
swank-cmucl.lisp swank-sbcl.lisp swank-clisp.lisp
swank-allegro.lisp swank-openmcl.lisp swank-lispworks.lisp
swank-corman.lisp swank-abcl.lisp swank-backend.lisp
Log Message:
(swank-compile-file): New optional argument `external-format'.
Date: Tue Jul 5 22:30:59 2005
Author: heller
Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.149 slime/swank-cmucl.lisp:1.150
--- slime/swank-cmucl.lisp:1.149 Fri Jun 3 13:16:45 2005
+++ slime/swank-cmucl.lisp Tue Jul 5 22:30:58 2005
@@ -299,7 +299,9 @@
(c::warning #'handle-notification-condition))
(funcall function))))
-(defimplementation swank-compile-file (filename load-p)
+(defimplementation swank-compile-file (filename load-p
+ &optional external-format)
+ (declare (ignore external-format))
(clear-xref-info filename)
(with-compilation-hooks ()
(let ((*buffer-name* nil)
Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.136 slime/swank-sbcl.lisp:1.137
--- slime/swank-sbcl.lisp:1.136 Fri Jul 1 15:52:55 2005
+++ slime/swank-sbcl.lisp Tue Jul 5 22:30:59 2005
@@ -123,17 +123,20 @@
(sb-bsd-sockets:socket (sb-bsd-sockets:socket-file-descriptor socket))
(file-stream (sb-sys:fd-stream-fd socket))))
+(defun find-external-format (coding-system)
+ (ecase coding-system
+ (:iso-latin-1-unix :iso-8859-1)
+ #+sb-unicode
+ (:utf-8-unix :utf-8)))
+
(defun make-socket-io-stream (socket external-format)
- (let ((encoding (ecase external-format
- (:iso-latin-1-unix :iso-8859-1)
- #+sb-unicode
- (:utf-8-unix :utf-8))))
+ (let ((ef (find-external-format external-format)))
(sb-bsd-sockets:socket-make-stream socket
:output t
:input t
:element-type 'character
#+sb-unicode :external-format
- #+sb-unicode encoding
+ #+sb-unicode ef
)))
(defun accept (socket)
@@ -364,16 +367,20 @@
(defvar *trap-load-time-warnings* nil)
-(defimplementation swank-compile-file (filename load-p)
- (handler-case
- (let ((output-file (with-compilation-hooks ()
- (compile-file filename))))
- (when output-file
- ;; Cache the latest source file for definition-finding.
- (source-cache-get filename (file-write-date filename))
- (when load-p
- (load output-file))))
- (sb-c:fatal-compiler-error () nil)))
+(defimplementation swank-compile-file (filename load-p
+ &optional external-format)
+ (let ((ef (if external-format
+ (find-external-format external-format)
+ :default)))
+ (handler-case
+ (let ((output-file (with-compilation-hooks ()
+ (compile-file filename :external-format ef))))
+ (when output-file
+ ;; Cache the latest source file for definition-finding.
+ (source-cache-get filename (file-write-date filename))
+ (when load-p
+ (load output-file))))
+ (sb-c:fatal-compiler-error () nil))))
;;;; compile-string
Index: slime/swank-clisp.lisp
diff -u slime/swank-clisp.lisp:1.50 slime/swank-clisp.lisp:1.51
--- slime/swank-clisp.lisp:1.50 Sun Jul 3 17:53:33 2005
+++ slime/swank-clisp.lisp Tue Jul 5 22:30:59 2005
@@ -80,15 +80,6 @@
(defimplementation call-without-interrupts (fn)
(funcall fn))
-#+unix
-(ffi:def-call-out getpid (:return-type ffi:int))
-
-#+win32
-(ffi:def-call-out getpid (:name "GetCurrentProcessId")
- (:library "kernel32.dll")
- (:return-type ffi:uint32))
-
-#+(or)
(let ((getpid (or (find-symbol "PROCESS-ID" :system)
;; old name prior to 2005-03-01, clisp <= 2.33.2
(find-symbol "PROGRAM-ID" :system)
@@ -422,13 +413,17 @@
:message (princ-to-string condition)
:location (compiler-note-location))))
-(defimplementation swank-compile-file (filename load-p)
- (with-compilation-hooks ()
- (with-compilation-unit ()
- (let ((fasl-file (compile-file filename)))
- (when (and load-p fasl-file)
- (load fasl-file))
- nil))))
+(defimplementation swank-compile-file (filename load-p
+ &optional external-format)
+ (let ((ef (if external-format
+ (find-encoding external-format)
+ :default)))
+ (with-compilation-hooks ()
+ (with-compilation-unit ()
+ (let ((fasl-file (compile-file filename :external-format ef)))
+ (when (and load-p fasl-file)
+ (load fasl-file))
+ nil)))))
(defimplementation swank-compile-string (string &key buffer position directory)
(declare (ignore directory))
Index: slime/swank-allegro.lisp
diff -u slime/swank-allegro.lisp:1.73 slime/swank-allegro.lisp:1.74
--- slime/swank-allegro.lisp:1.73 Fri Apr 1 21:44:27 2005
+++ slime/swank-allegro.lisp Tue Jul 5 22:30:59 2005
@@ -1,12 +1,11 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil; outline-regexp: ";;;;;*"; -*-
+;;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;;*"; -*-
;;;
;;; swank-allegro.lisp --- Allegro CL specific code for SLIME.
;;;
;;; Created 2003
;;;
;;; This code has been placed in the Public Domain. All warranties
-;;; are disclaimed. This code was written for "Allegro CL Trial
-;;; Edition "5.0 [Linux/X86] (8/29/98 10:57)".
+;;; are disclaimed.
;;;
(in-package :swank-backend)
@@ -57,15 +56,18 @@
(set-external-format s ef)
s))
-(defun set-external-format (stream external-format)
- #-allegro-v5.0
+(defun find-external-format (coding-system)
+ #-(version>= 6) :default
+ #+(version>= 6)
(let* ((name (ecase external-format
(:iso-latin-1-unix :latin1)
(:utf-8-unix :utf-8-unix)
- (:emacs-mule-unix :emacs-mule)))
- (ef (excl:crlf-base-ef
- (excl:find-external-format name :try-variant t))))
- (setf (stream-external-format stream) ef)))
+ (:emacs-mule-unix :emacs-mule))))
+ (excl:crlf-base-ef (excl:find-external-format name :try-variant t))))
+
+(defun set-external-format (stream external-format)
+ (setf (stream-external-format stream)
+ (find-external-format external-format)))
(defimplementation format-sldb-condition (c)
(princ-to-string c))
@@ -287,10 +289,16 @@
)
(funcall function)))
-(defimplementation swank-compile-file (*compile-filename* load-p)
+(defimplementation swank-compile-file (filename load-p
+ &optional external-format)
(with-compilation-hooks ()
- (let ((*buffer-name* nil))
- (compile-file *compile-filename* :load-after-compile load-p))))
+ (let ((*buffer-name* nil)
+ (*compile-filename* filename)
+ (ef (if external-format
+ (find-external-format external-format)
+ :default)))
+ (compile-file *compile-filename* :load-after-compile load-p
+ :external-format ef))))
(defun call-with-temp-file (fn)
(let ((tmpname (system:make-temp-file-name)))
Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.93 slime/swank-openmcl.lisp:1.94
--- slime/swank-openmcl.lisp:1.93 Fri May 6 18:30:02 2005
+++ slime/swank-openmcl.lisp Tue Jul 5 22:30:59 2005
@@ -262,7 +262,9 @@
(handler-bind ((ccl::compiler-warning #'handle-compiler-warning))
(funcall function)))
-(defimplementation swank-compile-file (filename load-p)
+(defimplementation swank-compile-file (filename load-p
+ &optional external-format)
+ (declare (ignore external-format))
(with-compilation-hooks ()
(let ((*buffer-name* nil)
(*buffer-offset* nil))
Index: slime/swank-lispworks.lisp
diff -u slime/swank-lispworks.lisp:1.73 slime/swank-lispworks.lisp:1.74
--- slime/swank-lispworks.lisp:1.73 Mon Jun 13 11:17:32 2005
+++ slime/swank-lispworks.lisp Tue Jul 5 22:30:59 2005
@@ -1,4 +1,4 @@
-;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;; -*- indent-tabs-mode: nil -*-
;;;
;;; swank-lispworks.lisp --- LispWorks specific code for SLIME.
;;;
@@ -84,6 +84,12 @@
(make-instance 'comm:socket-stream :socket fd :direction :io
:element-type 'base-char)))
+(defun find-external-format (coding-system &optional default)
+ (case coding-system
+ (:iso-latin-1-unix '(:latin-1 :eol-style :lf))
+ (:utf-8-unix '(:utf-8 :eol-style :lf))
+ (t default)))
+
(defun set-sigint-handler ()
;; Set SIGINT handler on Swank request handler thread.
#-win32
@@ -366,9 +372,13 @@
(signal-error-data-base compiler::*error-database* ,location)
(signal-undefined-functions compiler::*unknown-functions* ,location)))))
-(defimplementation swank-compile-file (filename load-p)
+(defimplementation swank-compile-file (filename load-p
+ &optional external-format)
(with-swank-compilation-unit (filename)
- (compile-file filename :load load-p)))
+ (let ((ef (if external-format
+ (find-external-format external-format)
+ :default)))
+ (compile-file filename :load load-p :external-format ef))))
(defvar *within-call-with-compilation-hooks* nil
"Whether COMPILE-FILE was called from within CALL-WITH-COMPILATION-HOOKS.")
@@ -745,7 +755,7 @@
;;; Some intergration with the lispworks environment
-(defun swank-sym (name) (find-symbol (string name) (string :swank)))
+(defun swank-sym (name) (find-symbol (string name) :swank))
(defimplementation emacs-connected ()
(when (eq (eval (swank-sym :*communication-style*))
@@ -756,8 +766,7 @@
(defmethod env-internals:environment-display-notifier
(env &key restarts condition)
(declare (ignore restarts))
- (funcall (find-symbol (string :swank-debugger-hook) :swank)
- condition *debugger-hook*))
+ (funcall (swank-sym :swank-debugger-hook) condition *debugger-hook*))
(defmethod env-internals:environment-display-debugger (env)
*debug-io*)))
Index: slime/swank-corman.lisp
diff -u slime/swank-corman.lisp:1.3 slime/swank-corman.lisp:1.4
--- slime/swank-corman.lisp:1.3 Sun Jul 3 17:51:05 2005
+++ slime/swank-corman.lisp Tue Jul 5 22:30:59 2005
@@ -158,7 +158,7 @@
(*stack-trace* (cdr (member 'cl:invoke-debugger real-stack-trace
:key #'car)))
(*frame-trace*
- (let* ((db::*debug-level* 1)
+ (let* ((db::*debug-level* (1+ db::*debug-level*))
(db::*debug-frame-pointer* (db::stash-ebp
(ct:create-foreign-ptr)))
(db::*debug-max-level* (length real-stack-trace))
@@ -214,6 +214,17 @@
(defimplementation frame-source-location-for-emacs (frame-number)
(fspec-location (frame-function (elt *frame-trace* frame-number))))
+(defun break (&optional (format-control "Break") &rest format-arguments)
+ (with-simple-restart (continue "Return from BREAK.")
+ (let ();(*debugger-hook* nil))
+ (let ((condition
+ (make-condition 'simple-condition
+ :format-control format-control
+ :format-arguments format-arguments)))
+ ;;(format *debug-io* ";;; User break: ~A~%" condition)
+ (invoke-debugger condition))))
+ nil)
+
;;; Socket communication
(defimplementation create-socket (host port)
@@ -354,7 +365,9 @@
(list :error "No location"))))))))
(funcall fn)))
-(defimplementation swank-compile-file (*compile-filename* load-p)
+(defimplementation swank-compile-file (*compile-filename* load-p
+ &optional external-format)
+ (declare (ignore external-format))
(with-compilation-hooks ()
(let ((*buffer-name* nil))
(compile-file *compile-filename*)
@@ -496,29 +509,30 @@
(defimplementation spawn (fun &key name)
(declare (ignore name))
- (threads:create-thread
+ (th:create-thread
(lambda ()
- (unwind-protect (funcall fun)
- (with-lock *mailbox-lock*
- (setq *mailboxes* (remove cormanlisp:*current-thread-id*
- *mailboxes* :key #'mailbox.thread)))))))
+ (handler-bind ((serious-condition #'invoke-debugger))
+ (unwind-protect (funcall fun)
+ (with-lock *mailbox-lock*
+ (setq *mailboxes* (remove cormanlisp:*current-thread-id*
+ *mailboxes* :key #'mailbox.thread))))))))
-(defimplementation thread-id (thread)
+(defimplementation thread-id (thread)
thread)
(defimplementation find-thread (thread)
(if (thread-alive-p thread)
thread))
+(defimplementation thread-alive-p (thread)
+ (if (threads:thread-handle thread) t nil))
+
(defimplementation current-thread ()
cormanlisp:*current-thread-id*)
;; XXX implement it
(defimplementation all-threads ()
'())
-
-(defimplementation thread-alive-p (thread)
- t)
;; XXX something here is broken
(defimplementation kill-thread (thread)
Index: slime/swank-abcl.lisp
diff -u slime/swank-abcl.lisp:1.26 slime/swank-abcl.lisp:1.27
--- slime/swank-abcl.lisp:1.26 Sat May 14 11:13:58 2005
+++ slime/swank-abcl.lisp Tue Jul 5 22:30:59 2005
@@ -271,12 +271,15 @@
(list :file *compile-filename*)
(list :position 1))))))))
-(defimplementation swank-compile-file (*compile-filename* load-p)
+(defimplementation swank-compile-file (filename load-p
+ &optional external-format)
+ (declare (ignore external-format))
(handler-bind ((warning #'handle-compiler-warning))
- (let ((*buffer-name* nil))
- (multiple-value-bind (fn warn fail)
- (compile-file *compile-filename*)
- (when load-p (unless fail (load fn)))))))
+ (let ((*buffer-name* nil)
+ (*compile-filename* filename))
+ (multiple-value-bind (fn warn fail) (compile-file filename)
+ (when (and load-p (not fail))
+ (load fn))))))
(defimplementation swank-compile-string (string &key buffer position directory)
(declare (ignore directory))
Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.85 slime/swank-backend.lisp:1.86
--- slime/swank-backend.lisp:1.85 Mon May 2 20:17:19 2005
+++ slime/swank-backend.lisp Tue Jul 5 22:30:59 2005
@@ -293,7 +293,7 @@
(error "Couldn't find ASDF operation ~S" operation-name))
(apply operate operation system-name keyword-args))))
-(definterface swank-compile-file (filename load-p)
+(definterface swank-compile-file (filename load-p &optional external-format)
"Compile FILENAME signalling COMPILE-CONDITIONs.
If LOAD-P is true, load the file after compilation.")
@@ -379,11 +379,12 @@
The property list has an entry for each interesting aspect of the
symbol. The recognised keys are:
- :VARIABLE :FUNCTION :SETF :TYPE :CLASS :MACRO :COMPILER-MACRO
- :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
+ :VARIABLE :FUNCTION :SETF :SPECIAL-OPERATOR :MACRO :COMPILER-MACRO
+ :TYPE :CLASS :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
The value of each property is the corresponding documentation string,
-or :NOT-DOCUMENTED. It is legal to include keys not listed here.
+or :NOT-DOCUMENTED. It is legal to include keys not listed here (but
+slime-print-apropos in Emacs must know about them).
Properties should be included if and only if they are applicable to
the symbol. For example, only (and all) fbound symbols should include
@@ -662,7 +663,7 @@
"Return an inspector object suitable for passing to inspect-for-emacs.")
(definterface inspect-for-emacs (object inspector)
- "Explain to emacs how to inspect OBJECT.
+ "Explain to Emacs how to inspect OBJECT.
The argument INSPECTOR is an object representing how to get at
the internals of OBJECT, it is usually an implementation specific
@@ -695,13 +696,12 @@
Since we don't know how to deal with OBJECT we simply dump the
output of CL:DESCRIBE."
(declare (ignore inspector))
- (values "A value."
- `("Type: " (:value ,(type-of object))
- (:newline)
- "Don't know how to inspect the object, dumping output of CL:DESCIRBE:"
- (:newline) (:newline)
- ,(with-output-to-string (desc)
- (describe object desc)))))
+ (values
+ "A value."
+ `("Type: " (:value ,(type-of object)) (:newline)
+ "Don't know how to inspect the object, dumping output of CL:DESCRIBE:"
+ (:newline) (:newline)
+ ,(with-output-to-string (desc) (describe object desc)))))
;;; Utilities for inspector methods.
;;;
More information about the slime-cvs
mailing list