Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv25801

Modified Files: swine.lisp swine-cmds.lisp Log Message: De-Swankified and slightly improved Eval Region.

--- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/19 10:00:52 1.8 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/20 17:30:30 1.9 @@ -78,13 +78,30 @@ (insert-sequence point expansion-string) (insert-object point #\Newline))))

-(defun eval-region-with-swank (start end syntax) - (with-slots (package) syntax - (let* ((swank::*buffer-package* (or package *package*)) - (swank::*buffer-readtable* *readtable*) - (message (swank::interactive-eval-region - (buffer-substring (buffer start) (offset start) (offset end))))) - (climacs-gui::display-message message)))) +(defun eval-string (string) + "Evaluate all expressions in STRING and return a list of +results." + (with-input-from-string (stream string) + (loop for form = (read stream nil stream) + while (not (eq form stream)) + collecting (multiple-value-list (eval form))))) + +(defun eval-region (start end syntax) + ;; Must be (mark>= end start). + (with-slots (package) syntax + (let* ((string (buffer-substring (buffer start) + (offset start) + (offset end))) + (values (multiple-value-list + (handler-case (eval-string string) + (error (condition) + (progn (beep) + (esa:display-message "~A" condition) + (return-from eval-region nil)))))) + ;; Enclose each set of values in {}. + (result (apply #'format nil "~{{~:[No values~;~:*~{~S~^,~}~]}~}" + values))) + (esa:display-message result))))

(defun compile-defun-with-swank (mark pane syntax) (with-slots (package) syntax --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/19 10:00:52 1.14 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/20 17:30:30 1.15 @@ -77,9 +77,12 @@ (define-command (com-eval-region :name t :command-table lisp-table) () "Evaluate the current region." - (eval-region-with-swank (point (current-window)) - (mark (current-window)) - (syntax (buffer (current-window))))) + (let ((mark (mark (current-window))) + (point (point (current-window)))) + (when (mark> mark point) + (rotatef mark point)) + (eval-region mark point + (syntax (buffer (current-window))))))

(esa:set-key 'com-eval-region 'lisp-table