mcclim-cvs January 2008

mcclim-cvs@common-lisp.net

7 participants
255 discussions

[mcclim-cvs] CVS mcclim
by thenriksen 26 Jan '08

26 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv10853 Modified Files: NEWS Log Message: Added mentions of some more bug fixes to NEWS. --- /project/mcclim/cvsroot/mcclim/NEWS 2008/01/23 10:23:50 1.31 +++ /project/mcclim/cvsroot/mcclim/NEWS 2008/01/26 11:33:02 1.32 @@ -15,6 +15,9 @@ *** Improvement: Goal-columns for line movement. *** Improvement: More Emacs-like expression movement for Lisp syntax. ** Bug fix: label panes no longer have a restrictive maximum width. +** Bug fix: ellipses with a zero radius no longer cause errors. +** Bug fix: bezier drawing in CLIM-FIG less likely to cause errors. +** Bug fix: restored somewhat working undo in CLIM-FIG. * Changes in mcclim-0.9.5 relative to 0.9.4: ** Installation: the systems clim-listener, clim-examples,

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by rschlatte 26 Jan '08

26 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv30427/Apps/Listener Modified Files: dev-commands.lisp Log Message: Multiple context-menu commands for text files: Edit, Show Also, activate code for showing file in a separate window --- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2008/01/18 06:54:50 1.46 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2008/01/26 05:09:39 1.47 @@ -1285,11 +1285,7 @@ (mv-or (when mime-type (mime-type-to-command mime-type pathname)) (when command - (values command doc pointer-doc)) - (when (and mime-type (subtypep mime-type 'text)) - (values `(com-edit-file ,pathname) - "Edit File" - (format nil "Edit ~A" pathname))) )))))) + (values command doc pointer-doc)))))))) (define-presentation-translator automagic-pathname-translator (clim:pathname clim:command filesystem-commands @@ -1399,9 +1395,6 @@ ((pathname 'pathname :prompt "pathname")) (clim-sys:make-process (lambda () (ed pathname)))) -;; Leave this translator disabled for now, the automagic translator will now produce -;; com-edit-file where there is not a more specific handler for a text mime type. -#+IGNORE (define-presentation-to-command-translator edit-file (clim:pathname com-edit-file filesystem-commands :gesture :select :pointer-documentation ((object stream) @@ -1410,7 +1403,9 @@ :tester ((object) (and (not (wild-pathname-p object)) (probe-file object) - (pathname-name object)))) + (pathname-name object) + (let ((mime-type (pathname-mime-type object))) + (and mime-type (subtypep mime-type 'text)))))) (object) (list object)) @@ -1420,6 +1415,20 @@ ((object 'pathname :prompt "pathname")) (show-file object)) +(define-presentation-to-command-translator show-file + (clim:pathname com-show-file filesystem-commands :gesture :select + :pointer-documentation ((object stream) + (format stream "Show ~A" object)) + :documentation ((stream) (format stream "Show File")) + :tester ((object) + (and (not (wild-pathname-p object)) + (probe-file object) + (pathname-name object) + (let ((mime-type (pathname-mime-type object))) + (and mime-type (subtypep mime-type 'text)))))) + (object) + (list object)) + (define-command (com-display-image :name t :command-table filesystem-commands :menu t) ((image-pathname 'pathname @@ -1448,10 +1457,8 @@ (list object)) -;; CLIM:OPEN-WINDOW-STREAM seems to be broken. -;; Less broken since I hacked on it, but still bad.. (defun show-file (pathname) - (let ( #+ignore(*standard-output* (open-window-stream :scroll-bars :both)) ) + (let ((*standard-output* (open-window-stream :scroll-bars :both)) ) (with-open-file (in pathname) (loop for line = (read-line in nil) while line

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 26 Jan '08

26 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv16402/Drei Modified Files: buffer.lisp Log Message: Changed DELETE-BUFFER-REGION to use DELETE-ELEMENTS*. Requires Flexichain 1.3 (currently, this means CVS). Increases region-killing performance by more than a hundredfold for most cases. --- /project/mcclim/cvsroot/mcclim/Drei/buffer.lisp 2008/01/03 16:19:42 1.7 +++ /project/mcclim/cvsroot/mcclim/Drei/buffer.lisp 2008/01/26 00:23:40 1.8 @@ -516,8 +516,7 @@ (make-condition 'offset-after-end :offset offset)) (assert (<= (+ offset n) (size buffer)) () (make-condition 'offset-after-end :offset (+ offset n))) - (loop repeat n - do (delete* (contents buffer) offset))) + (delete-elements* (contents buffer) offset n)) (defgeneric delete-range (mark &optional n) (:documentation "Delete `n' objects after `(if n > 0)' or

1 0

[mcclim-cvs] CVS mcclim/Drei/Tests
by thenriksen 26 Jan '08

26 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei/Tests In directory clnet:/tmp/cvs-serv16402/Drei/Tests Modified Files: buffer-tests.lisp Log Message: Changed DELETE-BUFFER-REGION to use DELETE-ELEMENTS*. Requires Flexichain 1.3 (currently, this means CVS). Increases region-killing performance by more than a hundredfold for most cases. --- /project/mcclim/cvsroot/mcclim/Drei/Tests/buffer-tests.lisp 2007/12/08 08:53:49 1.3 +++ /project/mcclim/cvsroot/mcclim/Drei/Tests/buffer-tests.lisp 2008/01/26 00:23:37 1.4 @@ -231,40 +231,40 @@ (let ((m (make-buffer-mark buffer 3 :left)) (m2 (make-buffer-mark buffer 5 :left))) (delete-region m m2) - (is (= (size buffer) 5)) + (is (= 5 (size buffer))) (is (eq (buffer m) (buffer m2))) - (is (= (offset m) 3)) - (is (= (offset m2) 3)) + (is (= 3 (offset m))) + (is (= 3 (offset m2))) (is (string= (buffer-substring buffer 0 5) "clics")))) (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (let ((m (make-buffer-mark buffer 3 :right)) (m2 (make-buffer-mark buffer 5 :right))) (delete-region m m2) - (is (= (size buffer) 5)) + (is (= 5 (size buffer))) (is (eq (buffer m) (buffer m2))) - (is (= (offset m) 3)) - (is (= (offset m2) 3)) + (is (= 3 (offset m))) + (is (= 3 (offset m2))) (is (string= (buffer-substring buffer 0 5) "clics")))) (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (let ((m (make-buffer-mark buffer 3 :left)) (m2 (make-buffer-mark buffer 5 :left))) (delete-region m2 m) - (is (= (size buffer) 5)) + (is (= 5 (size buffer))) (is (eq (buffer m) (buffer m2))) - (is (= (offset m) 3)) - (is (= (offset m2) 3)) + (is (= 3 (offset m))) + (is (= 3 (offset m2))) (is (string= (buffer-substring buffer 0 5) "clics")))) (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (let ((m (make-buffer-mark buffer 3 :right)) (m2 (make-buffer-mark buffer 5 :right))) (delete-region m2 m) - (is (= (size buffer) 5)) + (is (= 5 (size buffer))) (is (eq (buffer m) (buffer m2))) - (is (= (offset m) 3)) - (is (= (offset m2) 3)) + (is (= 3 (offset m))) + (is (= 3 (offset m2))) (is (string= (buffer-substring buffer 0 5) "clics")))) (signals error (let ((buffer (make-instance %%buffer)) @@ -280,11 +280,11 @@ (m2 (make-buffer-mark buffer 5 :left))) (delete-region m 5) (delete-region 1 m2) - (is (= (size buffer) 3)) + (is (= 3 (size buffer))) (is (eq (buffer m) (buffer m2))) - (is (= (offset m) 1)) - (is (= (offset m2) 1)) - (is (string= (buffer-substring buffer 0 3) "ccs"))))) + (is (= 1 (offset m))) + (is (= 1 (offset m2))) + (is (string= "ccs" (buffer-substring buffer 0 3)))))) (buffer-test number-of-lines (let ((buffer (make-instance %%buffer)))

1 0

[mcclim-cvs] CVS mcclim/Backends/CLX
by ahefner 25 Jan '08

25 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory clnet:/tmp/cvs-serv25703 Modified Files: medium.lisp Log Message: Fix clipping bug. The device region is the final determiner of our clipping rectangle. This is computed from both the medium clipping region and the sheet (native) region. When the device region changes, update the clipping region the next time we sync the gcontext, so that it does not continue to clip to the size of the old window. --- /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp 2008/01/21 01:26:43 1.86 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp 2008/01/25 07:36:39 1.87 @@ -37,7 +37,7 @@ (defclass clx-medium (basic-medium) ((gc :initform nil) (picture :initform nil) - (clipping-region-dirty :initform t) + (last-medium-device-region :initform nil) (clipping-region-tmp :initform (vector 0 0 0 0) :documentation "This object is reused to avoid consing in the most common case when configuring the clipping region.") @@ -134,12 +134,6 @@ ;; to clx :] we stick with :unsorted until that can be sorted out (setf (xlib:gcontext-clip-mask gc :unsorted) rect-seq))))))) -(defmethod (setf medium-clipping-region) :after (region (medium clx-medium)) - (declare (ignore region)) - (with-slots (#|gc|# clipping-region-dirty) medium - (setf clipping-region-dirty t) - #+NIL (when gc (%set-gc-clipping-region medium gc)))) - (defgeneric medium-gcontext (medium ink)) @@ -157,7 +151,7 @@ (let* ((port (port medium)) (mirror (port-lookup-mirror port (medium-sheet medium))) (line-style (medium-line-style medium))) - (with-slots (gc clipping-region-dirty) medium + (with-slots (gc last-medium-device-region) medium (unless gc (setq gc (xlib:create-gcontext :drawable mirror)) ;; this is kind of false, since the :unit should be taken @@ -177,9 +171,9 @@ (let ((fn (text-style-to-X-font port (medium-text-style medium)))) (when (typep fn 'xlib:font) (setf (xlib:gcontext-font gc) fn))) - (when clipping-region-dirty - (%set-gc-clipping-region medium gc) - (setf clipping-region-dirty nil)) + (unless (eq last-medium-device-region (medium-device-region medium)) + (setf last-medium-device-region (medium-device-region medium)) + (%set-gc-clipping-region medium gc)) gc))) (defmethod medium-gcontext ((medium clx-medium) (ink (eql +transparent-ink+)))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 24 Jan '08

24 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv8875/Drei Modified Files: packages.lisp Log Message: Export drei:clear-undo-history. --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/23 19:01:40 1.46 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/24 15:45:33 1.47 @@ -205,7 +205,7 @@ #:insert-record #:delete-record #:compound-record - #:with-undo + #:with-undo #:clear-undo-history #:drei-buffer

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 24 Jan '08

24 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv18349/Drei Modified Files: views.lisp Log Message: When clearing the undo history, also clear the undo accumulator. --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/23 19:01:40 1.28 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/24 09:25:17 1.29 @@ -259,7 +259,8 @@ (defmethod clear-undo-history ((undo-maintainer undo-mixin)) (setf (slot-value undo-maintainer 'tree) - (make-instance 'standard-undo-tree))) + (make-instance 'standard-undo-tree) + (undo-accumulate undo-maintainer) '())) ;;; undo-mixin delegation (here because of the package)

1 0

[mcclim-cvs] CVS mcclim/Examples
by thenriksen 23 Jan '08

23 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Examples In directory clnet:/tmp/cvs-serv6723/Examples Modified Files: clim-fig.lisp Log Message: Fixed undo in CLIM-FIG. Remaining bugs (such as the semirandom undo order) is probably not the fault of CLIM-FIG. --- /project/mcclim/cvsroot/mcclim/Examples/clim-fig.lisp 2008/01/23 22:18:03 1.33 +++ /project/mcclim/cvsroot/mcclim/Examples/clim-fig.lisp 2008/01/23 23:07:55 1.34 @@ -320,6 +320,9 @@ status))) (:top-level (default-frame-top-level :prompt 'clim-fig-prompt))) +(defmethod frame-standard-output ((frame clim-fig)) + (find-pane-named frame 'canvas)) + (define-presentation-to-command-translator add-figure (blank-area com-add-figure clim-fig :gesture :select ; XXX @@ -338,7 +341,8 @@ (defmethod generate-panes :after (frame-manager (frame clim-fig)) (declare (ignore frame-manager)) (setf (clim-fig-output-record frame) - (stream-current-output-record (frame-standard-input frame)) + ;; *standard-output* not bound to the canvas pane yet. + (stream-current-output-record (frame-standard-output frame)) (clim-fig-status frame) (find-pane-named frame 'status)))

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 23 Jan '08

23 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv31102 Modified Files: regions.lisp Log Message: Added support for zero-radius ellipses. I hope I didn't break anything... --- /project/mcclim/cvsroot/mcclim/regions.lisp 2008/01/21 01:34:13 1.37 +++ /project/mcclim/cvsroot/mcclim/regions.lisp 2008/01/23 22:37:08 1.38 @@ -4,7 +4,7 @@ ;;; Created: 1998-12-02 19:26 ;;; Author: Gilbert Baumann <unk6(a)rz.uni-karlsruhe.de> ;;; License: LGPL (See file COPYING for details). -;;; $Id: regions.lisp,v 1.37 2008/01/21 01:34:13 ahefner Exp $ +;;; $Id: regions.lisp,v 1.38 2008/01/23 22:37:08 thenriksen Exp $ ;;; -------------------------------------------------------------------------------------- ;;; (c) copyright 1998,1999,2001 by Gilbert Baumann ;;; (c) copyright 2001 by Arnaud Rouanet (rouanet(a)emi.u-bordeaux.fr) @@ -633,15 +633,17 @@ (xn (- (/ yc d))) (yn (/ xc d))) (transform-distance tr xn yn))))) - (multiple-value-bind (vdx vdy) (contact-radius* 1 0) - (declare (ignore vdx)) - (multiple-value-bind (hdx hdy) (contact-radius* 0 1) - (declare (ignore hdy)) - (multiple-value-bind (cx cy) (ellipse-center-point* region) - (let ((rx (abs hdx)) - (ry (abs vdy))) - (values (- cx rx) (- cy ry) - (+ cx rx) (+ cy ry))))))))) + (multiple-value-bind (cx cy) (ellipse-center-point* region) + (if (zerop (ellipse-radii region)) + (values cx cy cx cy) + (multiple-value-bind (vdx vdy) (contact-radius* 1 0) + (declare (ignore vdx)) + (multiple-value-bind (hdx hdy) (contact-radius* 0 1) + (declare (ignore hdy)) + (let ((rx (abs hdx)) + (ry (abs vdy))) + (values (- cx rx) (- cy ry) + (+ cx rx) (+ cy ry)))))))))) (defun intersection-line/unit-circle (x1 y1 x2 y2) "Computes the intersection of the line from (x1,y1) to (x2,y2) and the unit circle.

1 0

[mcclim-cvs] CVS mcclim/Examples
by thenriksen 23 Jan '08

23 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Examples In directory clnet:/tmp/cvs-serv27270/Examples Modified Files: clim-fig.lisp Log Message: Try to make CLIM-FIG not draw null beziers. --- /project/mcclim/cvsroot/mcclim/Examples/clim-fig.lisp 2007/03/20 01:46:14 1.32 +++ /project/mcclim/cvsroot/mcclim/Examples/clim-fig.lisp 2008/01/23 22:18:03 1.33 @@ -84,9 +84,11 @@ (design (climi::make-bezier-thing* 'climi::bezier-area (list x y cp-x1 cp-y1 cp-x2 cp-y2 x1 y1)))) - (climi::draw-bezier-design* pane design) - (draw-line* pane x y cp-x1 cp-y1 :ink +red+) - (draw-line* pane x1 y1 cp-x2 cp-y2 :ink +blue+))))))) + (unless (or (= x cp-x1 x1 cp-x2) + (= y cp-y1 y1 cp-y2)) ; Don't draw null beziers. + (climi::draw-bezier-design* pane design) + (draw-line* pane x y cp-x1 cp-y1 :ink +red+) + (draw-line* pane x1 y1 cp-x2 cp-y2 :ink +blue+)))))))) (defun signum-1 (value) (if (zerop value)

1 0

← Newer
1
...
4
5
6
7
8
9
10
...
26
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs January 2008