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)))))) +