November 2008 - mcclim-cvs@common-lisp.net

[mcclim-cvs] CVS mcclim
by ahefner 30 Nov '08

30 Nov '08

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv32619 Modified Files: text-formatting.lisp Log Message: Fix bug in stream-write-string on filling-streams which caused an error if the END keyword is nil, observable when climacs attempts to print a lisp arglist (strange this wasn't observed earlier, though). --- /project/mcclim/cvsroot/mcclim/text-formatting.lisp 2008/05/15 16:07:59 1.10 +++ /project/mcclim/cvsroot/mcclim/text-formatting.lisp 2008/11/30 22:26:21 1.11 @@ -81,8 +81,8 @@ (call-next-method)))) (defmethod stream-write-string :around ((stream filling-stream) string - &optional (start 0) (end (length string))) - (dotimes (i (- end start)) + &optional (start 0) end) + (dotimes (i (- (or end (length string)) start)) (stream-write-char stream (aref string (+ i start))))) ;;; All the monkey business with the lambda form has to do with capturing the

1 0

[mcclim-cvs] CVS mcclim
by ahefner 30 Nov '08

30 Nov '08

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv31753 Modified Files: panes.lisp Log Message: In fit-pane-to-output, accomodate the space preferences of the pane by calling compose-space, so that an empty window can still enforce a minimum size. Fixes the disappearing pointer documentation pane bug. --- /project/mcclim/cvsroot/mcclim/panes.lisp 2008/11/09 19:58:26 1.192 +++ /project/mcclim/cvsroot/mcclim/panes.lisp 2008/11/30 22:22:29 1.193 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -;;; $Id: panes.lisp,v 1.192 2008/11/09 19:58:26 ahefner Exp $ +;;; $Id: panes.lisp,v 1.193 2008/11/30 22:22:29 ahefner Exp $ (in-package :clim-internals) @@ -906,7 +906,10 @@ &key resize-frame &allow-other-keys) (declare (ignore space-req-keys)) (cond (*changing-space-requirements* - ;; just record what we have + ;; Record changed space requirements. + ;; What happens if we change the requirements successively + ;; with different values? Only the first takes effect? + ;; -Hefner (unless (find pane *changed-space-requirements* :key #'second) (push (list (pane-frame pane) pane resize-frame) *changed-space-requirements*))) @@ -2972,9 +2975,15 @@ (defmethod fit-pane-to-output ((stream clim-stream-pane)) (when (sheet-mirror stream) (let* ((output (stream-output-history stream)) - (width (bounding-rectangle-max-x output)) - (height (bounding-rectangle-max-y output))) + (fit-width (bounding-rectangle-max-x output)) + (fit-height (bounding-rectangle-max-y output))) + (multiple-value-bind (width min-width max-width + height min-height max-height) + (space-requirement-components (compose-space stream)) (change-space-requirements stream - :min-width width :min-height height - ;;:max-width width :max-height height - :width width :height height)))) \ No newline at end of file + :min-width (max fit-width min-width) + :min-height (max fit-height min-height) + :width (max fit-width width) + :height (max fit-height height) + :max-width max-width + :max-height max-height)))))

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by ahefner 30 Nov '08

30 Nov '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory cl-net:/tmp/cvs-serv29980 Modified Files: dev-commands.lisp Log Message: Two error handling fixes to com-eval: First, don't handle errors when evaluating in the foreground thread, so that errors can be handled in the SLIME debugger or similar.. Second, rebind *debugger-hook* if evaluating in a background thread. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2008/10/23 20:54:53 1.64 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2008/11/30 22:19:52 1.65 @@ -1516,21 +1516,25 @@ ((form 'clim:form :prompt "form")) (let ((standard-output *standard-output*) (standard-input *standard-input*) + (debugger-hook *debugger-hook*) (application-frame *application-frame*)) (flet ((evaluate () (let ((- form) (*standard-output* standard-output) (*standard-input* standard-input) (*error-output* standard-output) + (*debugger-hook* debugger-hook) (*application-frame* application-frame) error success) - (unwind-protect (handler-case (prog1 (cons :values (multiple-value-list (eval form))) - (setf success t)) - (serious-condition (e) - (setf error e) - (error e))) - (when (not success) - (return-from evaluate (cons :error error))))))) + (if *use-background-eval* + (unwind-protect (handler-case (prog1 (cons :values (multiple-value-list (eval form))) + (setf success t)) + (serious-condition (e) + (setf error e) + (error e))) + (when (not success) + (return-from evaluate (cons :error error)))) + (cons :values (multiple-value-list (eval form))))))) ;; If possible, use a thread for evaluation, permitting us to ;; interrupt it. (let ((start-time (get-internal-real-time)))

1 0

[mcclim-cvs] CVS mcclim/Apps/Inspector
by ahefner 09 Nov '08

09 Nov '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory cl-net:/tmp/cvs-serv11274/Apps/Inspector Modified Files: inspector.lisp Log Message: Fit space requirements to output history bounding rectangle automatically after redisplay and drawing of graphs/tables. --- /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2008/02/11 22:51:42 1.44 +++ /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2008/11/09 19:58:26 1.45 @@ -71,14 +71,6 @@ (- (bounding-rectangle-height scrollable-pane) (bounding-rectangle-height viewport))))))) -(defmethod redisplay-frame-pane :after ((frame inspector) - (pane application-pane) - &key force-p) - (declare (ignore force-p)) - (change-space-requirements - pane - :height (bounding-rectangle-height (stream-output-history pane)))) - (defun inspector (obj &key (new-process nil)) (flet ((run () (let ((*print-length* 10)

1 0

[mcclim-cvs] CVS mcclim
by ahefner 09 Nov '08

09 Nov '08

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv11274 Modified Files: panes.lisp graph-formatting.lisp table-formatting.lisp Log Message: Fit space requirements to output history bounding rectangle automatically after redisplay and drawing of graphs/tables. --- /project/mcclim/cvsroot/mcclim/panes.lisp 2008/08/21 22:34:29 1.191 +++ /project/mcclim/cvsroot/mcclim/panes.lisp 2008/11/09 19:58:26 1.192 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -;;; $Id: panes.lisp,v 1.191 2008/08/21 22:34:29 ahefner Exp $ +;;; $Id: panes.lisp,v 1.192 2008/11/09 19:58:26 ahefner Exp $ (in-package :clim-internals) @@ -2472,7 +2472,8 @@ (pane pane-display-mixin) &key force-p) (declare (ignore force-p)) - (invoke-display-function frame pane)) + (invoke-display-function frame pane) + (fit-pane-to-output pane)) (defgeneric pane-double-buffering (pane)) @@ -2965,3 +2966,15 @@ (warn "Are you sure you want to use schedule-timer-event? It probably doesn't work.") (schedule-event pane (make-instance 'timer-event :token token :sheet pane) delay)) +(defgeneric fit-pane-to-output (pane) + (:method (pane) (declare (ignore pane)))) + +(defmethod fit-pane-to-output ((stream clim-stream-pane)) + (when (sheet-mirror stream) + (let* ((output (stream-output-history stream)) + (width (bounding-rectangle-max-x output)) + (height (bounding-rectangle-max-y output))) + (change-space-requirements stream + :min-width width :min-height height + ;;:max-width width :max-height height + :width width :height height)))) \ No newline at end of file --- /project/mcclim/cvsroot/mcclim/graph-formatting.lisp 2007/09/17 19:20:49 1.22 +++ /project/mcclim/cvsroot/mcclim/graph-formatting.lisp 2008/11/09 19:58:26 1.23 @@ -3,7 +3,7 @@ ;;; Title: Graph Formatting ;;; Created: 2002-08-13 ;;; License: LGPL (See file COPYING for details). -;;; $Id: graph-formatting.lisp,v 1.22 2007/09/17 19:20:49 crhodes Exp $ +;;; $Id: graph-formatting.lisp,v 1.23 2008/11/09 19:58:26 ahefner Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 2002 by Gilbert Baumann @@ -188,6 +188,7 @@ (setf (stream-cursor-position stream) (values (bounding-rectangle-max-x graph-output-record) (bounding-rectangle-max-y graph-output-record)))) + (fit-pane-to-output stream) graph-output-record)))) ;;;; Graph Output Records --- /project/mcclim/cvsroot/mcclim/table-formatting.lisp 2007/07/21 14:17:15 1.40 +++ /project/mcclim/cvsroot/mcclim/table-formatting.lisp 2008/11/09 19:58:26 1.41 @@ -336,7 +336,8 @@ (values (bounding-rectangle-max-x table) (bounding-rectangle-max-y table))) (setf (stream-cursor-position stream) - (values cursor-old-x cursor-old-y)))))) + (values cursor-old-x cursor-old-y))))) + (fit-pane-to-output stream)) ;;; Think about rewriting this using a common superclass for row and ;;; column records.

1 0

[mcclim-cvs] CVS mcclim/Backends/CLX
by ahefner 09 Nov '08

09 Nov '08

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory cl-net:/tmp/cvs-serv11057 Modified Files: medium.lisp Log Message: Fix typo in with-clx-graphics. --- /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp 2008/01/30 18:56:40 1.88 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp 2008/11/09 19:55:38 1.89 @@ -612,7 +612,7 @@ (defmacro with-clx-graphics ((medium) &body body) `(let* ((port (port ,medium)) - (mirror (or (medium-buffer medium) (port-lookup-mirror port (medium-sheet ,medium))))) + (mirror (or (medium-buffer ,medium) (port-lookup-mirror port (medium-sheet ,medium))))) (when mirror (let* ((line-style (medium-line-style ,medium)) (ink (medium-ink ,medium))

1 0

[mcclim-cvs] CVS mcclim
by ahefner 09 Nov '08

09 Nov '08

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv10554 Modified Files: text-editor-gadget.lisp Log Message: Eliminate allocate-space method on text-field-panes, because it blocks the vbox layout from running, which stops the child (substrate) pane from being sized correctly. --- /project/mcclim/cvsroot/mcclim/text-editor-gadget.lisp 2008/01/11 02:44:14 1.11 +++ /project/mcclim/cvsroot/mcclim/text-editor-gadget.lisp 2008/11/09 19:52:44 1.12 @@ -376,9 +376,6 @@ (setf (substrate object) substrate) (sheet-adopt-child object substrate))) -(defmethod allocate-space ((pane text-field-pane) w h) - (resize-sheet pane w h)) - ;;; ------------------------------------------------------------------------------------------ ;;; 30.4.9 The concrete text-editor Gadget

1 0

[mcclim-cvs] CVS mcclim/Looks
by ahefner 09 Nov '08

09 Nov '08

Update of /project/mcclim/cvsroot/mcclim/Looks In directory cl-net:/tmp/cvs-serv10554/Looks Modified Files: pixie.lisp Log Message: Eliminate allocate-space method on text-field-panes, because it blocks the vbox layout from running, which stops the child (substrate) pane from being sized correctly. --- /project/mcclim/cvsroot/mcclim/Looks/pixie.lisp 2008/08/22 22:36:00 1.25 +++ /project/mcclim/cvsroot/mcclim/Looks/pixie.lisp 2008/11/09 19:52:44 1.26 @@ -1150,9 +1150,6 @@ :max-width width :max-height height :min-width width :min-height height))))) -(defmethod allocate-space ((pane pixie-text-field-pane) w h) - (resize-sheet pane w h)) - ;;;; Pixie tab-layout. Reuses implementation of the generic tab-layout-pane. (define-pixie-gadget clim-tab-layout:tab-layout pixie-tab-layout-pane)

1 0

[mcclim-cvs] CVS mcclim
by ahefner 09 Nov '08

09 Nov '08

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv10292 Modified Files: gadgets.lisp Log Message: Nicer gadget range handling, and handle stream designators in w-o-a-g. --- /project/mcclim/cvsroot/mcclim/gadgets.lisp 2008/05/09 22:16:11 1.111 +++ /project/mcclim/cvsroot/mcclim/gadgets.lisp 2008/11/09 19:49:17 1.112 @@ -1405,12 +1405,15 @@ (:vertical +identity-transformation+) (:horizontal (make-transformation 0 1 1 0 0 0)))) -(defun translate-range-value (a mina maxa mino maxo) +(defun translate-range-value (a mina maxa mino maxo + &optional (empty-result (/ (+ mino maxo) 2))) "When \arg{a} is some value in the range from \arg{mina} to \arg{maxa}, proportionally translate the value into the range \arg{mino} to \arg{maxo}." - (+ mino (* (/ (- a mina) - (- maxa mina)) ;### avoid divide by zero here. - (- maxo mino)))) + (if (zerop (- maxa mina)) + empty-result + (+ mino (* (/ (- a mina) + (- maxa mina)) + (- maxo mino))))) ;;;; SETF :after methods @@ -1487,18 +1490,13 @@ (multiple-value-bind (y1 y2 y3) (scroll-bar/thumb-bed* sb) (declare (ignore y3)) (multiple-value-bind (minv maxv) (gadget-range* sb) - (if (= y1 y2) ;### fix this in translate-range-value - minv - (translate-range-value y y1 y2 minv maxv))))) + (translate-range-value y y1 y2 minv maxv minv)))) (defun scroll-bar/map-value-to-coordinate (sb v) (multiple-value-bind (y1 y2 y3) (scroll-bar/thumb-bed* sb) (declare (ignore y3)) (multiple-value-bind (minv maxv) (gadget-range* sb) - ;; oops, if the range is empty we lose! - (if (= minv maxv) ;### fix this in translate-range-value - y1 - (round (translate-range-value v minv maxv y1 y2)))))) + (round (translate-range-value v minv maxv y1 y2 y1))))) (defmethod scroll-bar-thumb-region ((sb scroll-bar-pane)) (with-bounding-rectangle* (x1 y1 x2 y2) (scroll-bar-thumb-bed-region sb) @@ -2666,6 +2664,7 @@ ;; gadget is ever adopted, and an erase-output-record called on a newer ;; gadget-output-record will face a sheet-not-child error when trying ;; to disown the never adopted gadget. + (setf stream (stream-designator-symbol stream '*standard-output*)) (let ((gadget-output-record (gensym)) (x (gensym)) (y (gensym)))

1 0