[slime-cvs] CVS slime
CVS User sboukarev
sboukarev at common-lisp.net
Sat Aug 4 23:48:19 UTC 2012
Update of /project/slime/cvsroot/slime
In directory tiger.common-lisp.net:/tmp/cvs-serv1503
Modified Files:
ChangeLog swank-abcl.lisp swank-allegro.lisp swank-ccl.lisp
swank-clisp.lisp swank-cmucl.lisp swank-corman.lisp
swank-ecl.lisp swank-rpc.lisp swank-sbcl.lisp swank-scl.lisp
swank.lisp
Log Message:
* clean up: (signal (make-condition ...)) => (signal ...)
--- /project/slime/cvsroot/slime/ChangeLog 2012/08/04 23:32:37 1.2346
+++ /project/slime/cvsroot/slime/ChangeLog 2012/08/04 23:48:19 1.2347
@@ -4,6 +4,7 @@
sb-debug::resolve-stack-top-hint instead of just
sb-debug:*stack-top-hint*, because now it can contain things other
than just frames.
+ * clean up: (signal (make-condition ...)) => (signal ...)
2012-07-13 Helmut Eller <heller at common-lisp.net>
--- /project/slime/cvsroot/slime/swank-abcl.lisp 2012/04/07 10:23:38 1.91
+++ /project/slime/cvsroot/slime/swank-abcl.lisp 2012/08/04 23:48:19 1.92
@@ -414,24 +414,23 @@
;; filter condition signaled more than once.
(unless (member condition *abcl-signaled-conditions*)
(push condition *abcl-signaled-conditions*)
- (signal (make-condition
- 'compiler-condition
- :original-condition condition
- :severity :warning
- :message (format nil "~A" condition)
- :location (cond (*buffer-name*
- (make-location
- (list :buffer *buffer-name*)
- (list :offset *buffer-start-position* 0)))
- (loc
- (destructuring-bind (file . pos) loc
- (make-location
- (list :file (namestring (truename file)))
- (list :position (1+ pos)))))
- (t
- (make-location
- (list :file (namestring *compile-filename*))
- (list :position 1)))))))))
+ (signal 'compiler-condition
+ :original-condition condition
+ :severity :warning
+ :message (format nil "~A" condition)
+ :location (cond (*buffer-name*
+ (make-location
+ (list :buffer *buffer-name*)
+ (list :offset *buffer-start-position* 0)))
+ (loc
+ (destructuring-bind (file . pos) loc
+ (make-location
+ (list :file (namestring (truename file)))
+ (list :position (1+ pos)))))
+ (t
+ (make-location
+ (list :file (namestring *compile-filename*))
+ (list :position 1))))))))
(defimplementation swank-compile-file (input-file output-file
load-p external-format
--- /project/slime/cvsroot/slime/swank-allegro.lisp 2012/05/06 16:16:02 1.153
+++ /project/slime/cvsroot/slime/swank-allegro.lisp 2012/08/04 23:48:19 1.154
@@ -341,7 +341,7 @@
`(satisfies redefinition-p))
(defun signal-compiler-condition (&rest args)
- (signal (apply #'make-condition 'compiler-condition args)))
+ (apply #'signal 'compiler-condition args))
(defun handle-compiler-warning (condition)
(declare (optimize (debug 3) (speed 0) (space 0)))
--- /project/slime/cvsroot/slime/swank-ccl.lisp 2012/03/26 15:09:57 1.27
+++ /project/slime/cvsroot/slime/swank-ccl.lisp 2012/08/04 23:48:19 1.28
@@ -158,16 +158,15 @@
(defun handle-compiler-warning (condition)
"Resignal a ccl:compiler-warning as swank-backend:compiler-warning."
- (signal (make-condition
- 'compiler-condition
- :original-condition condition
- :message (compiler-warning-short-message condition)
- :source-context nil
- :severity (compiler-warning-severity condition)
- :location (source-note-to-source-location
- (ccl:compiler-warning-source-note condition)
- (lambda () "Unknown source")
- (ccl:compiler-warning-function-name condition)))))
+ (signal 'compiler-condition
+ :original-condition condition
+ :message (compiler-warning-short-message condition)
+ :source-context nil
+ :severity (compiler-warning-severity condition)
+ :location (source-note-to-source-location
+ (ccl:compiler-warning-source-note condition)
+ (lambda () "Unknown source")
+ (ccl:compiler-warning-function-name condition))))
(defgeneric compiler-warning-severity (condition))
(defmethod compiler-warning-severity ((c ccl:compiler-warning)) :warning)
--- /project/slime/cvsroot/slime/swank-clisp.lisp 2012/04/07 10:23:38 1.101
+++ /project/slime/cvsroot/slime/swank-clisp.lisp 2012/08/04 23:48:19 1.102
@@ -627,10 +627,10 @@
(list :error "No error location available")))))
(defun signal-compiler-warning (cstring args severity orig-fn)
- (signal (make-condition 'compiler-condition
- :severity severity
- :message (apply #'format nil cstring args)
- :location (compiler-note-location)))
+ (signal 'compiler-condition
+ :severity severity
+ :message (apply #'format nil cstring args)
+ :location (compiler-note-location))
(apply orig-fn cstring args))
(defun c-warn (cstring &rest args)
@@ -641,13 +641,13 @@
(signal-compiler-warning cstring args :style-warning *orig-c-style-warn*)))
(defun c-error (&rest args)
- (signal (make-condition 'compiler-condition
- :severity :error
- :message (apply #'format nil
- (if (= (length args) 3)
- (cdr args)
- args))
- :location (compiler-note-location)))
+ (signal 'compiler-condition
+ :severity :error
+ :message (apply #'format nil
+ (if (= (length args) 3)
+ (cdr args)
+ args))
+ :location (compiler-note-location))
(apply *orig-c-error* args))
(defimplementation call-with-compilation-hooks (function)
@@ -659,11 +659,11 @@
(defun handle-notification-condition (condition)
"Handle a condition caused by a compiler warning."
- (signal (make-condition 'compiler-condition
- :original-condition condition
- :severity :warning
- :message (princ-to-string condition)
- :location (compiler-note-location))))
+ (signal 'compiler-condition
+ :original-condition condition
+ :severity :warning
+ :message (princ-to-string condition)
+ :location (compiler-note-location)))
(defimplementation swank-compile-file (input-file output-file
load-p external-format
--- /project/slime/cvsroot/slime/swank-cmucl.lisp 2012/04/07 09:35:42 1.243
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp 2012/08/04 23:48:19 1.244
@@ -373,7 +373,7 @@
(cond ((zerop (length string))
(return-from sis/in
(if eof-errorp
- (error (make-condition 'end-of-file :stream stream))
+ (error 'end-of-file :stream stream)
eof-value)))
(t
(setf buffer string)
@@ -475,15 +475,14 @@
(signal-compiler-condition condition context))))
(defun signal-compiler-condition (condition context)
- (signal (make-condition
- 'compiler-condition
- :original-condition condition
- :severity (severity-for-emacs condition)
- :message (compiler-condition-message condition)
- :source-context (compiler-error-context context)
- :location (if (read-error-p condition)
- (read-error-location condition)
- (compiler-note-location context)))))
+ (signal 'compiler-condition
+ :original-condition condition
+ :severity (severity-for-emacs condition)
+ :message (compiler-condition-message condition)
+ :source-context (compiler-error-context context)
+ :location (if (read-error-p condition)
+ (read-error-location condition)
+ (compiler-note-location context))))
(defun severity-for-emacs (condition)
"Return the severity of CONDITION."
@@ -1586,9 +1585,8 @@
(kernel:*current-level* 0))
(handler-bind ((di::unhandled-condition
(lambda (condition)
- (error (make-condition
- 'sldb-condition
- :original-condition condition)))))
+ (error 'sldb-condition
+ :original-condition condition))))
(unwind-protect
(progn
#+(or)(sys:scrub-control-stack)
--- /project/slime/cvsroot/slime/swank-corman.lisp 2012/04/07 10:23:38 1.27
+++ /project/slime/cvsroot/slime/swank-corman.lisp 2012/08/04 23:48:19 1.28
@@ -347,22 +347,21 @@
;; FIXME
(defimplementation call-with-compilation-hooks (FN)
(handler-bind ((error (lambda (c)
- (signal (make-condition
- 'compiler-condition
- :original-condition c
- :severity :warning
- :message (format nil "~A" c)
- :location
- (cond (*buffer-name*
- (make-location
- (list :buffer *buffer-name*)
- (list :offset *buffer-position* 0)))
- (*compile-filename*
- (make-location
- (list :file *compile-filename*)
- (list :position 1)))
- (t
- (list :error "No location"))))))))
+ (signal 'compiler-condition
+ :original-condition c
+ :severity :warning
+ :message (format nil "~A" c)
+ :location
+ (cond (*buffer-name*
+ (make-location
+ (list :buffer *buffer-name*)
+ (list :offset *buffer-position* 0)))
+ (*compile-filename*
+ (make-location
+ (list :file *compile-filename*)
+ (list :position 1)))
+ (t
+ (list :error "No location")))))))
(funcall fn)))
(defimplementation swank-compile-file (input-file output-file
--- /project/slime/cvsroot/slime/swank-ecl.lisp 2012/06/19 19:46:53 1.76
+++ /project/slime/cvsroot/slime/swank-ecl.lisp 2012/08/04 23:48:19 1.77
@@ -221,7 +221,7 @@
(defvar *buffer-start-position*)
(defun signal-compiler-condition (&rest args)
- (signal (apply #'make-condition 'compiler-condition args)))
+ (apply #'signal 'compiler-condition args))
#-ecl-bytecmp
(defun handle-compiler-message (condition)
--- /project/slime/cvsroot/slime/swank-rpc.lisp 2012/05/06 08:51:26 1.13
+++ /project/slime/cvsroot/slime/swank-rpc.lisp 2012/08/04 23:48:19 1.14
@@ -32,17 +32,17 @@
(let ((packet (read-packet stream)))
(handler-case (values (read-form packet package))
(reader-error (c)
- (error (make-condition 'swank-reader-error
- :packet packet :cause c))))))
+ (error 'swank-reader-error
+ :packet packet :cause c)))))
(defun read-packet (stream)
(let* ((length (parse-header stream))
(octets (read-chunk stream length)))
(handler-case (swank-backend:utf8-to-string octets)
(error (c)
- (error (make-condition 'swank-reader-error
- :packet (asciify octets)
- :cause c))))))
+ (error 'swank-reader-error
+ :packet (asciify octets)
+ :cause c)))))
(defun asciify (packet)
(with-output-to-string (*standard-output*)
@@ -62,7 +62,7 @@
(cond ((= count length)
buffer)
((zerop count)
- (error (make-condition 'end-of-file :stream stream)))
+ (error 'end-of-file :stream stream))
(t
(error "Short read: length=~D count=~D" length count)))))
--- /project/slime/cvsroot/slime/swank-sbcl.lisp 2012/08/04 23:32:37 1.323
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2012/08/04 23:48:19 1.324
@@ -463,24 +463,23 @@
(sb-c::find-error-context nil))))
(defun signal-compiler-condition (condition context)
- (signal (make-condition
- 'compiler-condition
- :original-condition condition
- :severity (etypecase condition
- (sb-ext:compiler-note :note)
- (sb-c:compiler-error :error)
- (reader-error :read-error)
- (error :error)
- #+#.(swank-backend:with-symbol redefinition-warning
- sb-kernel)
- (sb-kernel:redefinition-warning
- :redefinition)
- (style-warning :style-warning)
- (warning :warning))
- :references (condition-references condition)
- :message (brief-compiler-message-for-emacs condition)
- :source-context (compiler-error-context context)
- :location (compiler-note-location condition context))))
+ (signal 'compiler-condition
+ :original-condition condition
+ :severity (etypecase condition
+ (sb-ext:compiler-note :note)
+ (sb-c:compiler-error :error)
+ (reader-error :read-error)
+ (error :error)
+ #+#.(swank-backend:with-symbol redefinition-warning
+ sb-kernel)
+ (sb-kernel:redefinition-warning
+ :redefinition)
+ (style-warning :style-warning)
+ (warning :warning))
+ :references (condition-references condition)
+ :message (brief-compiler-message-for-emacs condition)
+ :source-context (compiler-error-context context)
+ :location (compiler-note-location condition context)))
(defun real-condition (condition)
"Return the encapsulated condition or CONDITION itself."
--- /project/slime/cvsroot/slime/swank-scl.lisp 2012/04/24 11:08:13 1.41
+++ /project/slime/cvsroot/slime/swank-scl.lisp 2012/08/04 23:48:19 1.42
@@ -498,15 +498,14 @@
(signal-compiler-condition condition context))))
(defun signal-compiler-condition (condition context)
- (signal (make-condition
- 'compiler-condition
- :original-condition condition
- :severity (severity-for-emacs condition)
- :message (brief-compiler-message-for-emacs condition)
- :source-context (compiler-error-context context)
- :location (if (read-error-p condition)
- (read-error-location condition)
- (compiler-note-location context)))))
+ (signal 'compiler-condition
+ :original-condition condition
+ :severity (severity-for-emacs condition)
+ :message (brief-compiler-message-for-emacs condition)
+ :source-context (compiler-error-context context)
+ :location (if (read-error-p condition)
+ (read-error-location condition)
+ (compiler-note-location context))))
(defun severity-for-emacs (condition)
"Return the severity of 'condition."
@@ -1354,9 +1353,8 @@
(kernel:*current-level* 0))
(handler-bind ((di::unhandled-condition
(lambda (condition)
- (error (make-condition
- 'sldb-condition
- :original-condition condition)))))
+ (error 'sldb-condition
+ :original-condition condition))))
(funcall debugger-loop-fn))))
(defun frame-down (frame)
--- /project/slime/cvsroot/slime/swank.lisp 2012/05/06 08:51:26 1.790
+++ /project/slime/cvsroot/slime/swank.lisp 2012/08/04 23:48:19 1.791
@@ -291,8 +291,8 @@
(:report (lambda (c s) (princ (swank-error.condition c) s)))
(:documentation "Condition which carries a backtrace."))
-(defun make-swank-error (condition &optional (backtrace (safe-backtrace)))
- (make-condition 'swank-error :condition condition :backtrace backtrace))
+(defun signal-swank-error (condition &optional (backtrace (safe-backtrace)))
+ (error 'swank-error :condition condition :backtrace backtrace))
(defvar *debug-on-swank-protocol-error* nil
"When non-nil invoke the system debugger on errors that were
@@ -879,7 +879,7 @@
"Read an S-expression from STREAM using the SLIME protocol."
(log-event "decode-message~%")
(without-slime-interrupts
- (handler-bind ((error (lambda (c) (error (make-swank-error c)))))
+ (handler-bind ((error #'signal-swank-error))
(handler-case (read-message stream *swank-io-package*)
(swank-reader-error (c)
`(:reader-error ,(swank-reader-error.packet c)
@@ -889,7 +889,7 @@
"Write an S-expression to STREAM using the SLIME protocol."
(log-event "encode-message~%")
(without-slime-interrupts
- (handler-bind ((error (lambda (c) (error (make-swank-error c)))))
+ (handler-bind ((error #'signal-swank-error))
(write-message message *swank-io-package* stream))))
More information about the slime-cvs
mailing list