[mcclim-cvs] CVS mcclim/Apps/Listener

[ahefner]

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener
In directory cl-net:/tmp/cvs-serv8102

Modified Files:
	dev-commands.lisp util.lisp 
Log Message:
Fix a couple careless oversights, and add a backdoor variable to disable
threaded evaluation.


--- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp	2008/10/20 17:04:29	1.62
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp	2008/10/22 23:58:12	1.63
@@ -1155,7 +1155,7 @@
              (setf (stream-cursor-position *standard-output*) (values 0 y))))
           (:list (dolist (ent group)
                    (let ((ent (merge-pathnames ent pathname)))
-                    (pretty-pretty-pathname ent *standard-output* :long-name full-names))))))))))
+                    (pretty-pretty-pathname ent *standard-output* full-names))))))))))
 
 #+nil   ; OBSOLETE
 (define-presentation-to-command-translator show-directory-translator
@@ -1175,7 +1175,7 @@
   ((pathname 'pathname :prompt "pathname"))
   (let ((pathname (merge-pathnames
                    ;; helpfully fix things if trailing slash wasn't entered
-                   (directorify-pathname pathname))))
+                   (coerce-to-directory pathname))))
     (if (not (probe-file pathname))
         (note "~A does not exist.~%" pathname)
         (change-directory pathname))))
@@ -1311,7 +1311,7 @@
                                     :menu t
                                     :command-table directory-stack-commands)
   ((pathname 'pathname :prompt "directory"))
-  (let ((pathname (merge-pathnames (directorify-pathname pathname))))
+  (let ((pathname (merge-pathnames (coerce-to-directory pathname))))
     (if (not (probe-file pathname))
         (note "~A does not exist.~%" pathname)
         (progn (push *default-pathname-defaults* *directory-stack*)
@@ -1324,7 +1324,7 @@
         (format t "~&The top of the directory stack is now ")
         (present (truename (first *directory-stack*)))
         (terpri))
-      (format "~&The directory stack is now empty.~%")))
+      (format t "~&The directory stack is now empty.~%")))
 
 (define-command (com-pop-directory :name "Pop Directory"
                                   :menu t
@@ -1504,6 +1504,13 @@
         **  *
         *   (first values)))
 
+;;; The background evaluation feature is neat, but some people (namely
+;;; myself) sometimes need a backdoor to disable it when evaluating
+;;; code which does a lot of graphics in the listener, due to thread
+;;; safety issues with concurrent access to a CLIM stream.
+(defparameter *use-background-eval* t
+  "Perform evaluation in a background thread, which can be interrupted.")
+
 (define-command (com-eval :menu t :command-table lisp-commands)
     ((form 'clim:form :prompt "form"))
   (let ((standard-output *standard-output*)
@@ -1527,7 +1534,7 @@
       ;; interrupt it.
       (let ((start-time (get-internal-real-time)))
         (destructuring-bind (result . value)
-            (if clim-sys:*multiprocessing-p*
+            (if (and *use-background-eval* clim-sys:*multiprocessing-p*)
                 (catch 'done
                   (let* ((orig-process (clim-sys:current-process))
                          (evaluating t)
@@ -1571,7 +1578,7 @@
                                         :command-table show-commands)
     ((table 'clim:command-table :prompt "command table")
      &key
-     (locally 'boolean :default nil :mentioned-default t)
+     ;;(locally 'boolean :default nil :mentioned-default t)
      (show-commands 'boolean :default t))
   (let ((our-tables nil)
 	(processed-commands (make-hash-table :test #'eq)))
--- /project/mcclim/cvsroot/mcclim/Apps/Listener/util.lisp	2008/10/20 17:04:29	1.26
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/util.lisp	2008/10/22 23:58:12	1.27
@@ -505,8 +505,7 @@
         (with-drawing-options (stream :ink ink)
           (unless (zerop range)
             (when (eql t scale-y)
-              (setf scale-y (/ 250 range))
-              #+NIL (hef:debugf scale-y))
+              (setf scale-y (/ 250 range)))
             (draw-thin-bar-graph-1 
              stream 
              (lambda (i) (funcall key (aref vector i)))
@@ -533,3 +532,4 @@
                                (float (/ height (- max-y min-y)) 0.0f0)
                                min-x max-x
                                (/ (- max-x min-x) width))))))
+