mcclim-cvs January 2008

mcclim-cvs@common-lisp.net

7 participants
255 discussions

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

09 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv8234/Drei Modified Files: views.lisp Log Message: Start out with a recoreded buffer size of -1 to force reparsing. --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/08 21:05:50 1.15 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/09 19:26:14 1.16 @@ -574,7 +574,7 @@ :documentation "The number of unchanged objects at the end of the buffer.") (%recorded-buffer-size :accessor buffer-size - :initform 0 + :initform -1 :documentation "The size of the buffer the last time the view was synchronized.")) (:documentation "A buffer-view that maintains a parse tree of

1 0

[mcclim-cvs] CVS mcclim/Drei
by crhodes 09 Jan '08

09 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv23439/Drei Modified Files: syntax.lisp Log Message: Minor documentation-style update: make the default for values-max-min method combination be :most-specific-first, and explicitly make update-syntax use the :most-specific-last method combination. --- /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp 2008/01/07 22:01:58 1.10 +++ /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp 2008/01/09 18:21:44 1.11 @@ -82,7 +82,7 @@ delimited by `begin' and `end' has an up to date parse. Returns two values, offsets into the buffer of the syntax, denoting the buffer region thas has an up to date parse.") - (:method-combination values-max-min) + (:method-combination values-max-min :most-specific-last) (:method values-max-min ((syntax syntax) (unchanged-prefix integer) (unchanged-suffix integer) &optional (begin 0) (end (- (size (buffer syntax)) unchanged-suffix)))

1 0

[mcclim-cvs] CVS mcclim/ESA
by crhodes 09 Jan '08

09 Jan '08

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv23439/ESA Modified Files: utils.lisp Log Message: Minor documentation-style update: make the default for values-max-min method combination be :most-specific-first, and explicitly make update-syntax use the :most-specific-last method combination. --- /project/mcclim/cvsroot/mcclim/ESA/utils.lisp 2008/01/07 22:01:59 1.7 +++ /project/mcclim/cvsroot/mcclim/ESA/utils.lisp 2008/01/09 18:21:44 1.8 @@ -234,7 +234,7 @@ array) (define-method-combination values-max-min - (&optional (order ':most-specific-last)) + (&optional (order ':most-specific-first)) ((around (:around)) (before (:before)) (after (:after))

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by thenriksen 09 Jan '08

09 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv3396/Apps/Listener Modified Files: dev-commands.lisp Log Message: Added Display Image command to Listener. Note that, by default, it only loads the libraries for XPM reading. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2007/09/04 20:45:54 1.43 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2008/01/09 17:19:47 1.44 @@ -1417,6 +1417,18 @@ ((object 'pathname :prompt "pathname")) (show-file object)) +(define-command (com-display-image :name t :command-table filesystem-commands + :menu t) + ((image-pathname 'pathname + :default (user-homedir-pathname) :insert-default t)) + (if (probe-file image-pathname) + (handler-case + (with-room-for-graphics () + (draw-design *standard-output* (mcclim-images:load-image image-pathname))) + (mcclim-images:unsupported-image-format (c) + (format t "Image format ~A not recognized" (mcclim-images:image-format c)))) + (format t "No such file: ~A" image-pathname))) + (define-command (com-edit-definition :name "Edit Definition" :command-table lisp-commands :menu t

1 0

[mcclim-cvs] CVS mcclim/Extensions
by thenriksen 09 Jan '08

09 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Extensions In directory clnet:/tmp/cvs-serv28086/Extensions Modified Files: rgb-image.lisp Log Message: Added fixes for drawing of rgb-images so that they properly add output records. --- /project/mcclim/cvsroot/mcclim/Extensions/rgb-image.lisp 2008/01/06 16:05:46 1.3 +++ /project/mcclim/cvsroot/mcclim/Extensions/rgb-image.lisp 2008/01/09 16:59:04 1.4 @@ -44,7 +44,8 @@ (defclass rgb-image-design (design) ((medium :initform nil :initarg :medium) - (image :initarg :image) + (image :reader image + :initarg :image) (medium-data :initform nil))) (defun make-rgb-image-design (image) @@ -71,6 +72,39 @@ (setf medium current-medium) (setf medium-data nil)))) +(defmethod medium-draw-image-design* + ((medium sheet-with-medium-mixin) design x y) + (medium-draw-image-design* (sheet-medium medium) design x y)) + +;;; Output recording stuff, this was copied from the pattern code. + +(def-grecording draw-image-design (() image-design x y) () + (let ((width (image-width (image image-design))) + (height (image-height (image image-design))) + (transform (medium-transformation medium))) + (setf (values x y) (transform-position transform x y)) + (values x y (+ x width) (+ y height)))) + +(defmethod* (setf output-record-position) :around + (nx ny (record draw-image-design-output-record)) +(with-standard-rectangle* (:x1 x1 :y1 y1) + record + (with-slots (x y) + record + (let ((dx (- nx x1)) + (dy (- ny y1))) + (multiple-value-prog1 + (call-next-method) + (incf x dx) + (incf y dy)))))) + +(defrecord-predicate draw-image-design-output-record (x y image-design) + (and (if-supplied (x coordinate) + (coordinate= (slot-value record 'x) x)) + (if-supplied (y coordinate) + (coordinate= (slot-value record 'y) y)) + (if-supplied (image-design rgb-image-design) + (eq (slot-value record 'image-design) image-design)))) ;;; Fetching protocol @@ -93,15 +127,10 @@ (defgeneric sheet-rgb-data (port sheet &key x y width height)) -;;; Output recording - -(defun draw-image-design* - (medium design &rest options &key x y &allow-other-keys) - (unless (and x y) - (setf (values x y) (clim:stream-cursor-position medium))) - (climi::with-medium-options (medium options) - (medium-draw-image-design* (sheet-medium medium) design x y))) - (defmethod draw-design - (medium (design rgb-image-design) &rest options &key &allow-other-keys) - (apply #'draw-image-design* medium design options)) + (medium (design rgb-image-design) &rest options + &key x y &allow-other-keys) + (unless (and x y) + (setf (values x y) (stream-cursor-position medium))) + (with-medium-options (medium options) + (medium-draw-image-design* medium design x y)))

1 0

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

09 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv27817 Modified Files: graphics.lisp Log Message: Added draw-design method for patterns. I'm not completely sure that it is correct, but it worked for my test cases. --- /project/mcclim/cvsroot/mcclim/graphics.lisp 2007/07/19 06:52:51 1.58 +++ /project/mcclim/cvsroot/mcclim/graphics.lisp 2008/01/09 16:57:54 1.59 @@ -992,6 +992,11 @@ ;;;; +(defmethod draw-design (medium (pattern pattern) &key clipping-region transformation + &allow-other-keys) + (draw-pattern* medium pattern 0 0 + :clipping-region clipping-region :transformation transformation)) + (defun draw-pattern* (medium pattern x y &key clipping-region transformation) ;; Note: I believe the sample implementation in the spec is incorrect. ;; --GB

1 0

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

09 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv19300/Drei Modified Files: drei-redisplay.lisp Log Message: Fixed typo, dispatcer -> dispatcher. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/08 14:52:18 1.23 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/09 12:47:31 1.24 @@ -99,7 +99,7 @@ (ink +foreground-ink+) (style nil)) -(defconstant +default-stroke-drawer-dispatcer+ +(defconstant +default-stroke-drawer-dispatcher+ #'(lambda (stream view stroke cursor-x cursor-y default-drawing-fn) (funcall default-drawing-fn stream view stroke cursor-x cursor-y)) "A simple function of six arguments that simply calls the first @@ -109,7 +109,7 @@ (defstruct drawing-options "A set of options for how to display a stroke." (face (make-face)) - (function +default-stroke-drawer-dispatcer+)) + (function +default-stroke-drawer-dispatcher+)) (defun drawing-options-equal (o1 o2) "Return true if `o1' and `o2' are equal, that is, they specify @@ -123,13 +123,13 @@ (and (equal (face-ink f1) (face-ink f2)) (equal (face-style f1) (face-style f2)) (or (not (eq (drawing-options-function o1) - +default-stroke-drawer-dispatcer+)) + +default-stroke-drawer-dispatcher+)) (eq (drawing-options-function o2) - +default-stroke-drawer-dispatcer+)) + +default-stroke-drawer-dispatcher+)) (or (not (eq (drawing-options-function o2) - +default-stroke-drawer-dispatcer+)) + +default-stroke-drawer-dispatcher+)) (eq (drawing-options-function o1) - +default-stroke-drawer-dispatcer+))))) + +default-stroke-drawer-dispatcher+))))) (defconstant +default-drawing-options+ (make-drawing-options) "The default set of drawing options used for strokes when

1 0

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

09 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv28792/Drei Modified Files: lisp-syntax-swine.lisp lisp-syntax.lisp lr-syntax.lisp packages.lisp Log Message: Improved performance of LR syntax, and Lisp syntax's handling of non-character buffer objects. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-swine.lisp 2008/01/09 08:55:24 1.11 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-swine.lisp 2008/01/09 11:14:08 1.12 @@ -588,7 +588,7 @@ (operands (when (and form (form-list-p form)) (mapcar #'(lambda (operand) (when operand - (form-to-object syntax operand))) + (form-to-object syntax operand :no-error t))) (form-operands syntax form)))) (current-operand-indices (when form (find-operand-info syntax offset form)))) --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/09 08:55:24 1.61 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/09 11:14:08 1.62 @@ -2571,9 +2571,11 @@ (defun invoke-reader (syntax form) "Use the system reader to handle `form' and signal a `reader-invoked' condition with the resulting data." - (let* ((start-mark (make-buffer-mark (buffer syntax) (start-offset form)))) + (let* ((start-mark (make-buffer-mark (buffer syntax) (start-offset form))) + (end-mark (make-buffer-mark (buffer syntax) (end-offset form)))) (let* ((stream (make-buffer-stream :buffer (buffer syntax) - :start-mark start-mark)) + :start-mark start-mark + :end-mark end-mark)) (object (read-preserving-whitespace stream))) (signal 'reader-invoked :end-mark (point stream) :object object)))) @@ -2920,7 +2922,10 @@ (defmethod form-to-object ((syntax lisp-syntax) (form complete-string-form) &key &allow-other-keys) - (invoke-reader syntax form)) + (if (notany #'literal-object-p (children form)) + (invoke-reader syntax form) + (form-conversion-error + syntax form "String form contains non-character element"))) (defmethod form-to-object ((syntax lisp-syntax) (form function-form) &rest args) (list 'cl:function (apply #'form-to-object syntax (second (children form)) args))) --- /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/01/09 08:55:24 1.15 +++ /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/01/09 11:14:08 1.16 @@ -99,6 +99,11 @@ (:documentation "Mixin for parser symbols representing literal (non-character) objects in the buffer.")) +(defun literal-object-p (parser-symbol) + "Return true if `parser-symbol' is of type +`literal-object-mixin'." + (typep parser-symbol 'literal-object-mixin)) + (defmethod start-offset ((state parser-symbol)) (let ((mark (start-mark state))) (when mark @@ -378,7 +383,7 @@ (parser-state stack-top) stack-top))) (loop do (parse-patch syntax))))) - (values 0 (offset (scan syntax))))) + (values 0 (size (buffer syntax))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/07 22:55:11 1.37 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/09 11:14:08 1.38 @@ -515,7 +515,7 @@ #:parser-symbol #:parent #:children #:start-offset #:end-offset #:parser-state #:preceding-parse-tree - #:literal-object-mixin + #:literal-object-mixin #:literal-object-p #:define-parser-state #:lexeme #:nonterminal #:action #:new-state #:done

1 0

[mcclim-cvs] CVS mcclim/Extensions/Images
by thenriksen 09 Jan '08

09 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Extensions/Images In directory clnet:/tmp/cvs-serv14506/Extensions/Images Modified Files: gif.lisp Log Message: Handle GIFs with no transparency. --- /project/mcclim/cvsroot/mcclim/Extensions/Images/gif.lisp 2008/01/07 14:18:15 1.2 +++ /project/mcclim/cvsroot/mcclim/Extensions/Images/gif.lisp 2008/01/09 10:20:23 1.3 @@ -26,8 +26,9 @@ (pattern-array (make-array (list (skippy:height first-image) (skippy:width first-image)))) (designs (coerce (loop with color-table = (skippy:color-table data-stream) + with transparency-index = (skippy:transparency-index first-image) for i below (skippy:color-table-size color-table) - when (= i (skippy:transparency-index first-image)) + when (and transparency-index (= i transparency-index)) collect +transparent-ink+ else collect (multiple-value-bind (r g b)

1 0

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

09 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv30926/Drei Modified Files: lisp-syntax-swine.lisp lisp-syntax.lisp lr-syntax.lisp Log Message: Do less incrementality-pretending in Lr syntax, but be more aware of the possibility in Lisp syntax. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-swine.lisp 2007/12/16 14:42:07 1.10 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-swine.lisp 2008/01/09 08:55:24 1.11 @@ -566,7 +566,7 @@ provided are, in order: the form, the forms operator, the indices to the operand at `offset', or the indices to an operand entered at that position if none is there, and the operands in the form." - (update-parse syntax 0 offset) + (update-parse syntax) (let* ((form ;; Find a form with a valid (fboundp) operator. (let ((immediate-form --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/08 21:16:16 1.60 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/09 08:55:24 1.61 @@ -1209,7 +1209,6 @@ (defun need-to-update-package-list-p (prefix-size suffix-size syntax) (let ((low-mark-offset prefix-size) (high-mark-offset (- (size (buffer syntax)) suffix-size))) - (update-parse syntax) (flet ((test (x) (let ((start-offset (start-offset x)) (end-offset (end-offset x))) @@ -1249,17 +1248,18 @@ (defun update-package-list (syntax) (setf (package-list syntax) nil) + (update-parse syntax) (flet ((test (x) (when (form-list-p x) (let ((candidate (first-form (children x)))) (and (form-token-p candidate) (eq (form-to-object syntax candidate - :no-error t) + :no-error t) 'cl:in-package))))) (extract (x) (let ((designator (second-form (children x)))) (form-to-object syntax designator - :no-error t)))) + :no-error t)))) (with-slots (stack-top) syntax (loop for child in (children stack-top) when (test child) --- /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/01/08 21:05:50 1.14 +++ /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/01/09 08:55:24 1.15 @@ -267,8 +267,7 @@ (print-unreadable-object (mark stream :type t :identity t) (format stream "~s" (offset mark)))) -(defun parse-patch (syntax begin end) - (declare (ignore begin)) +(defun parse-patch (syntax) (with-slots (current-state stack-top scan potentially-valid-trees) syntax (parser-step syntax) (finish-output *trace-output*) @@ -359,12 +358,13 @@ (defmethod update-syntax values-max-min ((syntax lr-syntax-mixin) prefix-size suffix-size &optional (begin 0) (end (size (buffer syntax)))) + (declare (ignore begin end)) (let* ((low-mark-offset prefix-size) (high-mark-offset (- (size (buffer syntax)) suffix-size))) (when (<= low-mark-offset high-mark-offset) (catch 'done - (with-slots (current-state stack-top scan potentially-valid-trees - initial-state) syntax + (with-slots (current-state stack-top scan potentially-valid-trees + initial-state) syntax (setf potentially-valid-trees (if (null stack-top) nil @@ -373,12 +373,12 @@ (setf stack-top (find-last-valid-lexeme stack-top low-mark-offset)) (setf (offset scan) (if (null stack-top) 0 (end-offset stack-top)) current-state (if (null stack-top) - initial-state + initial-state (new-state syntax (parser-state stack-top) stack-top))) - (loop do (parse-patch syntax begin end))))) - (values 0 end))) + (loop do (parse-patch syntax))))) + (values 0 (offset (scan syntax))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

← Newer
1
...
16
17
18
19
20
21
22
...
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