[slime-cvs] CVS slime
trittweiler
trittweiler at common-lisp.net
Wed Sep 10 23:10:45 UTC 2008
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv30696
Modified Files:
swank.lisp slime.el ChangeLog
Log Message:
Reimplement recompilation support. The previous implementation
involving specials was subtly broken with the :fd-handler
communcation-style, because of serve-event's polite interplay with
specials. (Cf. my slime-devel post "Per event bindings" on 2008-08-17.)
* swank.lisp (with-swank-compilation-unit): Removed.
(record-note-for-condition): Removed.
(defstruct swank-compilation-unit): Renamed to
`swank-compilation-result'.
(swank-compilation-unit-for-emacs): Renamed to
`swank-compilation-result-for-emacs'.
(swank-compiler): Takes additional argument, the
swank-compilation-result where caught notes should be accumulated
into.
(defslimefun compile-file-for-emacs): Adapted accordingly.
(defslimefun compile-string-for-emacs): Ditto.
(defslimefun compile-multiple-strings-for-emacs): New RPC call.
* slime.el (slime-make-compile-expression-for-swank): Removed.
(slime-compile-string): Don't use above function anymore. Adapted.
(slime-recompile-locations): Rewritten to use new RPC call above.
--- /project/slime/cvsroot/slime/swank.lisp 2008/09/09 23:26:18 1.584
+++ /project/slime/cvsroot/slime/swank.lisp 2008/09/10 23:10:45 1.585
@@ -57,8 +57,7 @@
#:profile-package
#:default-directory
#:set-default-directory
- #:quit-lisp
- #:with-swank-compilation-unit))
+ #:quit-lisp))
(in-package :swank)
@@ -2384,17 +2383,15 @@
;;;; Compilation Commands.
-(defstruct (:swank-compilation-unit
+(defstruct (:swank-compilation-result
(:type list) :named
- (:conc-name swank-compilation-unit.)
- (:constructor make-swank-compilation-unit ()))
+ (:conc-name swank-compilation-result.)
+ (:constructor make-swank-compilation-result ()))
notes ;
- results ; a result is of type (MEMBER T NIL :COMPLAINED)
+ results ; one result is of type (MEMBER T NIL :COMPLAINED)
durations ;
)
-(defvar *swank-compilation-unit* nil)
-
(defun measure-time-interval (fn)
"Call FN and return the first return value and the elapsed time.
The time is measured in microseconds."
@@ -2405,12 +2402,6 @@
(* (- (get-internal-real-time) before)
(/ 1000000 internal-time-units-per-second)))))
-(defun record-note-for-condition (condition)
- "Record a note for a compiler-condition into the currently active
-Swank-Compilation-Unit."
- (push (make-compiler-note condition)
- (swank-compilation-unit.notes *swank-compilation-unit*)))
-
(defun make-compiler-note (condition)
"Make a compiler note data structure from a compiler-condition."
(declare (type compiler-condition condition))
@@ -2421,67 +2412,80 @@
(let ((s (short-message condition)))
(if s (list :short-message s)))))
-(defmacro with-swank-compilation-unit ((&key override) &body body)
- "Similiar to CL:WITH-COMPILATION-UNIT. Within a
-Swank-Compilation-Unit all notes, results etc. produced by
-COMPILE-FILE-FOR-EMACS and COMPILE-STRING-FOR-EMACS (possibly called
-more than once) will be collected into this unit."
- (if override
- `(let ((*swank-compilation-unit* (make-swank-compilation-unit)))
- , at body)
- `(let ((*swank-compilation-unit* (or *swank-compilation-unit*
- (make-swank-compilation-unit))))
- , at body)))
-
-(defun swank-compilation-unit-for-emacs (unit)
+(defun swank-compilation-result-for-emacs (old)
"Make a Swank-Compilation-Unit suitable for Emacs."
- (let ((new (make-swank-compilation-unit)))
- (with-struct (swank-compilation-unit. notes results durations) unit
- (setf (swank-compilation-unit.notes new) (reverse notes))
- (setf (swank-compilation-unit.results new) (reverse results))
- (setf (swank-compilation-unit.durations new)
+ (let ((new (make-swank-compilation-result)))
+ (with-struct (swank-compilation-result. notes results durations) old
+ (setf (swank-compilation-result.notes new) (reverse notes))
+ (setf (swank-compilation-result.results new) (reverse results))
+ (setf (swank-compilation-result.durations new)
(reverse (mapcar #'(lambda (usecs) (/ usecs 1000000.0)) durations))))
new))
-(defun swank-compiler (function)
- (let ((notes-p))
+(defun swank-compiler (swank-compilation-result function)
+ (let ((swank-result swank-compilation-result))
(multiple-value-bind (result usecs)
(with-simple-restart (abort-compilation "Abort SLIME compilation request.")
- (handler-bind ((compiler-condition #'(lambda (c)
- (setf notes-p t)
- (record-note-for-condition c))))
+ (handler-bind ((compiler-condition
+ #'(lambda (c)
+ (push (make-compiler-note c)
+ (swank-compilation-result.notes swank-result)))))
(measure-time-interval function)))
- (when result (setf result (if notes-p :complained t)))
- (when (eql usecs t) (setf usecs 0)) ; compilation aborted.
- (push result (swank-compilation-unit.results *swank-compilation-unit*))
- (push usecs (swank-compilation-unit.durations *swank-compilation-unit*))
- (swank-compilation-unit-for-emacs *swank-compilation-unit*))))
+ (when (eql usecs t) (setf usecs 0)) ; compilation aborted.
+ (when result
+ (let ((notes-p (swank-compilation-result.notes swank-result)))
+ (setf result (if notes-p :complained t))))
+ (push result (swank-compilation-result.results swank-result))
+ (push usecs (swank-compilation-result.durations swank-result))
+ swank-result)))
(defslimefun compile-file-for-emacs (filename load-p)
"Compile FILENAME and, when LOAD-P, load the result.
Record compiler notes signalled as `compiler-condition's."
- (with-swank-compilation-unit (:override nil)
- (with-buffer-syntax ()
- (let ((*compile-print* nil))
- (swank-compiler
- (lambda ()
- (let ((pathname (parse-emacs-filename filename)))
- (swank-compile-file pathname load-p
- (or (guess-external-format pathname)
- :default)))))))))
+ (with-buffer-syntax ()
+ (swank-compilation-result-for-emacs
+ (swank-compiler (make-swank-compilation-result)
+ (lambda ()
+ (let ((pathname (parse-emacs-filename filename))
+ (*compile-print* nil) (*compile-verbose* t))
+ (swank-compile-file pathname load-p
+ (or (guess-external-format pathname)
+ :default))))))))
(defslimefun compile-string-for-emacs (string buffer position directory debug)
"Compile STRING (exerpted from BUFFER at POSITION).
Record compiler notes signalled as `compiler-condition's."
- (with-swank-compilation-unit (:override nil)
- (with-buffer-syntax ()
- (swank-compiler
- (lambda ()
- (let ((*compile-print* nil) (*compile-verbose* t))
- (swank-compile-string string :buffer buffer :position position
- :directory directory
- :debug debug)))))))
+ (with-buffer-syntax ()
+ (swank-compilation-result-for-emacs
+ (swank-compiler (make-swank-compilation-result)
+ (lambda ()
+ (let ((*compile-print* t) (*compile-verbose* nil))
+ (swank-compile-string string
+ :buffer buffer
+ :position position
+ :directory directory
+ :debug debug)))))))
+(defslimefun compile-multiple-strings-for-emacs
+ (strings buffers packages positions directories debug)
+ "Compile STRING (exerpted from BUFFER at POSITION).
+Record compiler notes signalled as `compiler-condition's."
+ (let ((swank-compilation-result (make-swank-compilation-result)))
+ (loop for string in strings
+ for buffer in buffers
+ for package in packages
+ for position in positions
+ for directory in directories do
+ (swank-compiler swank-compilation-result
+ (lambda ()
+ (with-buffer-syntax (package)
+ (let ((*compile-print* t) (*compile-verbose* nil))
+ (swank-compile-string string
+ :buffer buffer
+ :position position
+ :directory directory
+ :debug debug))))))
+ (swank-compilation-result-for-emacs swank-compilation-result)))
(defun file-newer-p (new-file old-file)
"Returns true if NEW-FILE is newer than OLD-FILE."
--- /project/slime/cvsroot/slime/slime.el 2008/08/30 15:33:46 1.1008
+++ /project/slime/cvsroot/slime/slime.el 2008/09/10 23:10:45 1.1009
@@ -3945,17 +3945,14 @@
(defun slime-compile-string (string start-offset)
(slime-eval-async
- (slime-make-compile-expression-for-swank string start-offset)
+ `(swank:compile-string-for-emacs
+ ,string
+ ,(buffer-name)
+ ,start-offset
+ ,(if (buffer-file-name) (file-name-directory (buffer-file-name)))
+ ',slime-compilation-debug-level)
(slime-make-compilation-finished-continuation (current-buffer))))
-(defun slime-make-compile-expression-for-swank (string start-offset)
- `(swank:compile-string-for-emacs
- ,string
- ,(buffer-name)
- ,start-offset
- ,(if (buffer-file-name) (file-name-directory (buffer-file-name)))
- ',slime-compilation-debug-level))
-
(defun slime-make-compilation-finished-continuation (current-buffer &optional emacs-snapshot)
(lexical-let ((buffer current-buffer) (snapshot emacs-snapshot))
(lambda (result)
@@ -4033,32 +4030,26 @@
(slime-compile-defun debug-level)))
(defun slime-recompile-locations (locations &optional debug-level)
- (flet ((make-compile-expr (loc)
- (save-excursion
- (slime-pop-to-location loc 'excursion)
- (multiple-value-bind (start end) (slime-region-for-defun-at-point)
- ;; FIXME: Kludge. The slime-eval-async may send a buffer-package
- ;; that is not necessarily the same as the one the LOC points to.
- `(cl:let ((swank::*buffer-package* (swank::guess-buffer-package
- ,(slime-current-package))))
- ,(slime-make-compile-expression-for-swank
- (buffer-substring-no-properties start end)
- start))))))
- (let ((slime-compilation-debug-level debug-level))
+ (let (strings buffers packages positions directories)
+ (flet ((push-location-data (loc)
+ (save-excursion
+ (slime-pop-to-location loc 'excursion)
+ (multiple-value-bind (start end) (slime-region-for-defun-at-point)
+ (push (buffer-substring-no-properties start end) strings)
+ (push (buffer-name) buffers)
+ (push (slime-current-package) packages)
+ (push start positions)
+ (push (if (buffer-file-name)
+ (file-name-directory (buffer-file-name))
+ nil)
+ directories)))))
+ (mapc #'push-location-data locations)
(slime-eval-async
- `(swank:with-swank-compilation-unit (:override t)
- ;; We have to compile each location separately because of
- ;; buffer and offset tracking during notes generation.
- ,@(loop for loc in locations
- collect (make-compile-expr loc)))
+ `(swank:compile-multiple-strings-for-emacs
+ ',(nreverse strings) ',(nreverse buffers) ',(nreverse packages)
+ ',(nreverse positions) ',(nreverse directories) ,debug-level)
(slime-make-compilation-finished-continuation (current-buffer))))))
-;;; FIXME: implement:
-
-;; (defun slime-recompile-symbol-at-point (name)
-;; (interactive (list (slime-read-symbol-name "Name: ")))
-;; )
-
;;;;; Merging together compiler notes in the same location.
--- /project/slime/cvsroot/slime/ChangeLog 2008/09/09 23:29:44 1.1495
+++ /project/slime/cvsroot/slime/ChangeLog 2008/09/10 23:10:45 1.1496
@@ -1,3 +1,27 @@
+2008-09-11 Tobias C. Rittweiler <tcr at freebits.de>
+
+ Reimplement recompilation support. The previous implementation
+ involving specials was subtly broken with the :fd-handler
+ communcation-style, because of serve-event's polite interplay with
+ specials. (Cf. my slime-devel post "Per event bindings" on 2008-08-17.)
+
+ * swank.lisp (with-swank-compilation-unit): Removed.
+ (record-note-for-condition): Removed.
+ (defstruct swank-compilation-unit): Renamed to
+ `swank-compilation-result'.
+ (swank-compilation-unit-for-emacs): Renamed to
+ `swank-compilation-result-for-emacs'.
+ (swank-compiler): Takes additional argument, the
+ swank-compilation-result where caught notes should be accumulated
+ into.
+ (defslimefun compile-file-for-emacs): Adapted accordingly.
+ (defslimefun compile-string-for-emacs): Ditto.
+ (defslimefun compile-multiple-strings-for-emacs): New RPC call.
+
+ * slime.el (slime-make-compile-expression-for-swank): Removed.
+ (slime-compile-string): Don't use above function anymore. Adapted.
+ (slime-recompile-locations): Rewritten to use new RPC call above.
+
2008-09-10 Tobias C. Rittweiler <tcr at freebits.de>
* swank-backend.lisp (*gray-stream-symbols*): Comment out
More information about the slime-cvs
mailing list