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

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

15 Jan '08

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv21737/ESA Modified Files: esa-io.lisp Log Message: Fix another file-write-date issue. --- /project/mcclim/cvsroot/mcclim/ESA/esa-io.lisp 2008/01/15 08:05:09 1.7 +++ /project/mcclim/cvsroot/mcclim/ESA/esa-io.lisp 2008/01/15 16:24:23 1.8 @@ -236,7 +236,7 @@ (defun check-file-times (buffer filepath question answer) "Return NIL if filepath newer than buffer and user doesn't want to overwrite." - (let ((f-w-d (file-write-date filepath)) + (let ((f-w-d (and (probe-file filepath) (file-write-date filepath))) (f-w-t (file-write-time buffer))) (if (and f-w-d f-w-t (> f-w-d f-w-t)) (if (accept 'boolean

1 0

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

15 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv10638/Drei Modified Files: lisp-syntax.lisp Log Message: Removed superfluous (drei-motion:define-motion-fns list). --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/13 17:10:24 1.67 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/15 15:53:53 1.68 @@ -2133,8 +2133,6 @@ do (setf (offset mark) (start-offset potential-form)) (return t))) -(drei-motion:define-motion-fns list) - (defun down-list (mark syntax selector next-offset-fn target-offset-fn) (update-parse syntax 0 (offset mark)) (labels ((next (continue-from)

1 0

[mcclim-cvs] CVS mcclim
by crhodes 15 Jan '08

15 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv8335 Modified Files: regions.lisp Log Message: Frob standard-ellipse and standard-elliptical-arc superclasses (Otherwise, methods on clim:design are more specific than methods on climi::elliptical-thing, which means that everything goes haywire.) --- /project/mcclim/cvsroot/mcclim/regions.lisp 2008/01/14 07:03:18 1.35 +++ /project/mcclim/cvsroot/mcclim/regions.lisp 2008/01/15 15:45:17 1.36 @@ -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.35 2008/01/14 07:03:18 ahefner Exp $ +;;; $Id: regions.lisp,v 1.36 2008/01/15 15:45:17 crhodes Exp $ ;;; -------------------------------------------------------------------------------------- ;;; (c) copyright 1998,1999,2001 by Gilbert Baumann ;;; (c) copyright 2001 by Arnaud Rouanet (rouanet(a)emi.u-bordeaux.fr) @@ -552,8 +552,8 @@ (and end-angle (* (/ 180 pi) end-angle)) tr))) -(defclass standard-ellipse (ellipse elliptical-thing) ()) -(defclass standard-elliptical-arc (elliptical-arc elliptical-thing) ()) +(defclass standard-ellipse (elliptical-thing ellipse) ()) +(defclass standard-elliptical-arc (elliptical-thing elliptical-arc) ()) ;;; ---- 2.5.6.1 Constructor Functions for Ellipses and Elliptical Arcs in CLIM ---------

1 0

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

15 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv18243/Drei Modified Files: drei-redisplay.lisp views.lisp Log Message: Reintroduce early support for long lines (and horizontal scrolling) in Drei. Still doesn't deal properly with cursors, and is very eager at scrolling back. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/15 09:35:27 1.33 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/15 14:08:19 1.34 @@ -547,14 +547,17 @@ (funcall (drawing-options-function (stroke-drawing-options stroke)) stream view stroke cursor-x cursor-y #'stroke-drawing-fn nil))) -(defun draw-stroke (stream view stroke cursor-x cursor-y) - "Draw `stroke' on `stream' with a baseline at +(defun draw-stroke (pane view stroke cursor-x cursor-y) + "Draw `stroke' on `pane' with a baseline at `cursor-y'. Drawing starts at the horizontal offset `cursor-x'. Stroke must thus have updated dimensional -informational. Nothing will be done unless `stroke' is dirty." +information. Nothing will be done unless `stroke' is dirty." (when (stroke-dirty stroke) + (when (> (x2 (stroke-dimensions stroke)) + (bounding-rectangle-width pane)) + (change-space-requirements pane :width (x2 (stroke-dimensions stroke)))) (funcall (drawing-options-function (stroke-drawing-options stroke)) - stream view stroke cursor-x cursor-y #'stroke-drawing-fn t))) + pane view stroke cursor-x cursor-y #'stroke-drawing-fn t))) (defun end-line (line x1 y1 line-width line-height) "End the addition of strokes to `line' for now, and update the @@ -565,7 +568,7 @@ (x2 dimensions) (+ x1 line-width) (y2 dimensions) (+ y1 line-height)))) -(defun end-line-cleaning-up (stream line line-x1 line-y1 +(defun end-line-cleaning-up (view pane line line-x1 line-y1 line-width line-height) "End the addition of strokes to `line' for now, and update the dimensions of `line'. Update all undisplayed lines to have no @@ -575,6 +578,9 @@ (end-line line line-x1 line-y1 line-width line-height) (with-accessors ((line-x1 x1) (line-y1 y1) (line-x2 x2) (line-y2 y2)) (line-dimensions line) + (setf (max-line-width view) + (max (max-line-width view) + (dimensions-width (line-dimensions line)))) ;; If a has a lesser height than the line, clear from the top of ;; the line stroke to the top of the stroke, to avoid artifacts ;; left over from previous redisplays. @@ -583,7 +589,7 @@ (with-accessors ((stroke-x1 x1) (stroke-y1 y1) (stroke-x2 x2) (stroke-y2 y2)) stroke-dimensions (when (> line-height (dimensions-height stroke-dimensions)) - (clear-rectangle* stream stroke-x1 line-y1 + (clear-rectangle* pane stroke-x1 line-y1 stroke-x2 stroke-y1))))) ;; Reset the dimensions of undisplayed lines. (do-undisplayed-line-strokes (stroke line) @@ -645,7 +651,7 @@ for stroke = (aref (line-strokes line) stroke-index) for stroke-dimensions = (stroke-dimensions stroke) do (draw-stroke pane view stroke (x1 stroke-dimensions) baseline) - finally (progn (end-line-cleaning-up pane line orig-x-offset cursor-y + finally (progn (end-line-cleaning-up view pane line orig-x-offset cursor-y line-width line-height) (incf (displayed-lines-count view)) (return (values pump-state line-height))))))) @@ -882,6 +888,54 @@ (when (> br-height (bounding-rectangle-height stream)) (change-space-requirements stream :height br-height)))) +(defmethod bounding-rectangle* ((view drei-buffer-view)) + "Return the bounding rectangle of the visual appearance of +`view' as four values, just as `bounding-rectangle*'. Will return +0, 0, 0, 0 when `view' has not been redisplayed." + (if (zerop (displayed-lines-count view)) + (values 0 0 0 0) + (let ((first-line (aref (displayed-lines view) 0)) + (last-line (last-displayed-line view)) + (max-x2 0)) + (do-displayed-lines (line view) + (setf max-x2 (max max-x2 + (x2 (line-dimensions line))))) + (values (x1 (line-dimensions first-line)) + (y1 (line-dimensions first-line)) + max-x2 + (y2 (line-dimensions last-line)))))) + +(defmethod bounding-rectangle-width ((view drei-buffer-view)) + (multiple-value-bind (x1 y1 x2) + (bounding-rectangle* view) + (declare (ignore y1)) + (- x2 x1))) + +(defun drei-bounding-rectangle* (drei-instance) + "Return the bounding rectangle of the visual appearance of +`drei-instance' as four values, just as +`bounding-rectangle*'. Takes the cursors of `drei-instance' into +account." + (multiple-value-bind (x1 y1 x2 y2) + (view-bounding-rectangle* (view drei-instance)) + (dolist (cursor (cursors drei-instance)) + (multiple-value-bind (cursor-x1 cursor-y1 cursor-x2 cursor-y2) + (bounding-rectangle* cursor) + (unless (= cursor-x1 cursor-y1 cursor-x2 cursor-y2 0) + (setf x1 (min x1 cursor-x1) + y1 (min y1 cursor-y1) + x2 (max x2 cursor-x2) + y2 (max y2 cursor-y2))))) + (values x1 y1 x2 y2))) + +(defun drei-bounding-rectangle-width (drei-instance) + "Return the width of the bounding rectangle of `drei-instance', +calculated by `drei-bounding-rectangle*'." + (multiple-value-bind (x1 y1 x2) + (drei-bounding-rectangle* drei-instance) + (declare (ignore y1)) + (- x2 x1))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Drei area redisplay. @@ -903,13 +957,14 @@ (height (+ ascent descent))) (multiple-value-bind (x1 y1 x2 y2) (call-next-method) - (values x1 y1 (max x2 (+ x1 style-width) - (cond ((numberp min-width) - (+ x1 min-width)) - ;; Must be T, then. - ((pane-viewport pane) - (+ x1 (bounding-rectangle-width (pane-viewport-region pane)))) - (t 0))) + (values x1 y1 + (max x2 (+ x1 style-width) + (cond ((numberp min-width) + (+ x1 min-width)) + ;; Must be T, then. + ((pane-viewport pane) + (+ x1 (bounding-rectangle-width (pane-viewport-region pane)))) + (t 0))) (max y2 (+ y1 height))))))) ;; XXX: Full redraw for every replay, should probably use the `region' @@ -949,25 +1004,21 @@ (defun display-drei-area (drei) (with-accessors ((stream editor-pane) (view view)) drei (replay drei stream) - (with-bounding-rectangle* (dx1 dy1 dx2 dy2) drei - (declare (ignore dx1 dy1 dy2)) - (when (point-cursor drei) - (with-bounding-rectangle* (x1 y1 x2 y2) (point-cursor drei) - (apply #'change-space-requirements stream (when (> x2 dx2) - (list :width x2))) - (when (pane-viewport stream) - (let* ((viewport (pane-viewport stream)) - (viewport-height (bounding-rectangle-height viewport)) - (viewport-width (bounding-rectangle-width viewport)) - (viewport-region (pane-viewport-region stream))) - ;; Scroll if point went outside the visible area. - (when (and (active drei) - (pane-viewport stream) - (not (and (region-contains-position-p viewport-region x2 y2) - (region-contains-position-p viewport-region x1 y1)))) - (scroll-extent stream - (max 0 (- x2 viewport-width)) - (max 0 (- y2 viewport-height))))))))))) + (when (point-cursor drei) + (with-bounding-rectangle* (x1 y1 x2 y2) (point-cursor drei) + (when (pane-viewport stream) + (let* ((viewport (pane-viewport stream)) + (viewport-height (bounding-rectangle-height viewport)) + (viewport-width (bounding-rectangle-width viewport)) + (viewport-region (pane-viewport-region stream))) + ;; Scroll if point went outside the visible area. + (when (and (active drei) + (pane-viewport stream) + (not (and (region-contains-position-p viewport-region x2 y2) + (region-contains-position-p viewport-region x1 y1)))) + (scroll-extent stream + (max 0 (- x2 viewport-width)) + (max 0 (- y2 viewport-height)))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -1019,7 +1070,7 @@ has `view'.")) (defmethod fix-pane-viewport ((pane drei-pane) (view drei-view)) - (let* ((output-width (bounding-rectangle-width (stream-current-output-record pane))) + (let* ((output-width (bounding-rectangle-width view)) (viewport (pane-viewport pane)) (viewport-width (and viewport (bounding-rectangle-width viewport))) (pane-width (bounding-rectangle-width pane))) --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/15 07:43:05 1.19 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/15 14:08:19 1.20 @@ -532,7 +532,12 @@ :type integer :documentation "The number of lines in the views `displayed-lines' array that are actually live, that -is, used for display right now.")) +is, used for display right now.") + (%max-line-width :accessor max-line-width + :initform 0 + :type integer + :documentation "The width of the longest +displayed line in device units.")) (:metaclass modual-class) (:documentation "A view that contains a `drei-buffer' object. The buffer is displayed on a simple line-by-line basis, @@ -562,13 +567,6 @@ (setf (fill-pointer string) 0) string)) -(defmethod observer-notified ((view drei-buffer-view) (buffer drei-buffer) - changed-region) - (dotimes (i (displayed-lines-count view)) - (let ((line (line-information view i))) - (when (<= (car changed-region) (line-end-offset line)) - (invalidate-line-strokes line :modified t))))) - (defclass drei-syntax-view (drei-buffer-view) ((%syntax :accessor syntax :documentation "An instance of the syntax class used

1 0

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

15 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv20463/Drei Modified Files: drei-redisplay.lisp Log Message: Fixed drawing of tabs, I thinl --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/15 09:10:29 1.32 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/15 09:35:27 1.33 @@ -409,9 +409,19 @@ (y2 dimensions) y2 (center dimensions) center))) -(defconstant +roman-face-style+ (make-text-style nil :roman nil) - "A text style specifying a roman face, but with unspecified -family and size.") +(defun non-graphic-char-rep (object) + "Return the appropriate representation of `object', a non-graphic char. +This will be a string of the format \"^[letter]\" for non-graphic chars +with a char-code of less than #o200, \"\\[octal code]\" for those above +#o200, and the #\\Tab character in the case of a #\\Tab. +NOTE: Assumes an ASCII/Unicode character encoding." + (let ((code (char-code object))) + (cond ((eql object #\Tab) + object) + ((< code #o200) + (format nil "^~C" (code-char (+ code (char-code #\@))))) + (t + (format nil "\\~O" code))))) (defun analyse-stroke-string (string) "Return a list of parts of `string', where each part is a continuous @@ -432,20 +442,6 @@ into parts finally (return parts))) -(defun non-graphic-char-rep (object) - "Return the appropriate representation of `object', a non-graphic char. -This will be a string of the format \"^[letter]\" for non-graphic chars -with a char-code of less than #o200, \"\\[octal code]\" for those above -#o200, and the #\\Tab character in the case of a #\\Tab. -NOTE: Assumes an ASCII/Unicode character encoding." - (let ((code (char-code object))) - (cond ((eql object #\Tab) - object) - ((< code #o200) - (format nil "^~C" (code-char (+ code (char-code #\@))))) - (t - (format nil "\\~O" code))))) - (defun calculate-stroke-width (stroke-string text-style stream x-position) "Calculate the width information of `stroke-string' when displayed with `text-style' (which must be fully specified) on @@ -458,7 +454,7 @@ with widths = (make-array 1 :adjustable t :fill-pointer t) with tab-width for (start end object) in parts - do (cond ((and object (eql object #\Tab)) + do (cond ((eql object #\Tab) (incf width (- (or tab-width (setf tab-width (tab-width stream (stream-default-view stream)))) @@ -479,6 +475,10 @@ (vector-push-extend width widths)))) finally (return (values width parts widths)))) +(defconstant +roman-face-style+ (make-text-style nil :roman nil) + "A text style specifying a roman face, but with unspecified +family and size.") + (defun stroke-drawing-fn (stream view stroke cursor-x cursor-y draw) "Draw `stroke' to `stream' baseline-adjusted at the position (`cursor-x', `cursor-y'). `View' is the view object that `stroke' belongs @@ -515,7 +515,7 @@ (when draw (loop for (start end object) in stroke-parts for width across part-widths - do (cond ((and object (eq object #\Tab)) + do (cond ((eql object #\Tab) nil) (object (draw-text* stream object (+ cursor-x width) @@ -540,7 +540,8 @@ at (`cursor-x', `cursor-y'), but without actually drawing anything. Will use the function specified in the drawing-options of `stroke' to carry out the actual calculations." - (unless (= cursor-x (x1 (stroke-dimensions stroke))) + (unless (and (= cursor-x (x1 (stroke-dimensions stroke))) + (not (stroke-dirty stroke))) (invalidate-stroke stroke :modified t)) (when (stroke-dirty stroke) (funcall (drawing-options-function (stroke-drawing-options stroke)) stream view stroke

1 0

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

15 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv15912/Drei Modified Files: drei-redisplay.lisp Log Message: Removed unused values in a multiple-value-bind. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/15 07:56:15 1.31 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/15 09:10:29 1.32 @@ -465,18 +465,16 @@ (mod (+ width x-position) tab-width))) (vector-push-extend width widths)) (object - (multiple-value-bind (w ignore1 ignore2 ignore3 ignore4) + (multiple-value-bind (w) (text-size stream object :text-style text-style) - (declare (ignore ignore1 ignore2 ignore3 ignore4)) (incf width w) (vector-push-extend width widths))) (t - (multiple-value-bind (w ignore1 ignore2 ignore3 ignore4) + (multiple-value-bind (w) (text-size stream stroke-string :start start :end end :text-style text-style) - (declare (ignore ignore1 ignore2 ignore3 ignore4)) (incf width w) (vector-push-extend width widths)))) finally (return (values width parts widths))))

1 0

[mcclim-cvs] CVS mcclim/Experimental/freetype
by ahefner 15 Jan '08

15 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Experimental/freetype In directory clnet:/tmp/cvs-serv15462 Modified Files: freetype-fonts.lisp Log Message: Fix busted text size calculation in the fixed-width path. Typed (length string), meant (- end start). Could happen to anyone. --- /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-fonts.lisp 2008/01/13 23:02:34 1.17 +++ /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-fonts.lisp 2008/01/15 09:06:52 1.18 @@ -252,15 +252,15 @@ ;; out of here, but I doubt it would shave more than a few percent ;; off a draw-text benchmark. (macrolet ((compute () - `(loop with cache = (slot-value font 'glyph-width-cache) + `(loop with width-cache = (slot-value font 'glyph-width-cache) for i from start below end as char = (aref string i) as code = (char-code char) - sum (or (gcache-get cache code) - (gcache-set cache code (clim-clx::font-glyph-width font char))) + sum (or (gcache-get width-cache code) + (gcache-set width-cache code (clim-clx::font-glyph-width font char))) #+NIL (clim-clx::font-glyph-width font char)))) (if (numberp (slot-value font 'fixed-width)) - (* (slot-value font 'fixed-width) (length string)) + (* (slot-value font 'fixed-width) (- end start)) (typecase string (simple-string (locally (declare (type simple-string string))

1 0

[mcclim-cvs] CVS mcclim/ESA
by thenriksen 15 Jan '08

15 Jan '08

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv4848/ESA Modified Files: esa-io.lisp Log Message: When saving a buffer with no associated pathname, act as Write Buffer. This needs some more thought, the save/write buffer dichotomy is not awesome. --- /project/mcclim/cvsroot/mcclim/ESA/esa-io.lisp 2008/01/13 22:22:06 1.6 +++ /project/mcclim/cvsroot/mcclim/ESA/esa-io.lisp 2008/01/15 08:05:09 1.7 @@ -269,18 +269,22 @@ (setf (needs-saving buffer) nil))) (define-command (com-save-buffer :name t :command-table esa-io-table) () - "Write the contents of the buffer to a file. + "Write the contents of the buffer to a file. If there is filename associated with the buffer, write to that file, replacing its contents. If not, prompt for a filename." (let ((buffer (current-buffer))) - (if (or (null (filepath buffer)) - (needs-saving buffer)) - (handler-case (save-buffer buffer) - (buffer-writing-error (e) - (with-minibuffer-stream (minibuffer) - (let ((*print-escape* nil)) - (print-object e minibuffer))))) - (display-message "No changes need to be saved from ~a" (name buffer))))) + (if (null (filepath buffer)) + (com-write-buffer (accept 'pathname :prompt "Write Buffer to File: " + :prompt-mode :raw + :default (directory-of-current-buffer) :insert-default t + :default-type 'pathname)) + (if (needs-saving buffer) + (handler-case (save-buffer buffer) + (buffer-writing-error (e) + (with-minibuffer-stream (minibuffer) + (let ((*print-escape* nil)) + (print-object e minibuffer))))) + (display-message "No changes need to be saved from ~a" (name buffer)))))) (set-key 'com-save-buffer 'esa-io-table '((#\x :control) (#\s :control)))

1 0

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

15 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv2727/Drei Modified Files: drei-redisplay.lisp Log Message: Removed optimisation that destroyed tab support. Also some other cleanup as a bonus. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/14 21:43:48 1.30 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/15 07:56:15 1.31 @@ -455,7 +455,7 @@ of the stroke." (loop with parts = (analyse-stroke-string stroke-string) with width = 0 - with widths = (make-array (length parts) :adjustable t :fill-pointer t) + with widths = (make-array 1 :adjustable t :fill-pointer t) with tab-width for (start end object) in parts do (cond ((and object (eql object #\Tab)) @@ -567,14 +567,12 @@ (y2 dimensions) (+ y1 line-height)))) (defun end-line-cleaning-up (stream line line-x1 line-y1 - line-width old-line-width - line-height old-line-height) + line-width line-height) "End the addition of strokes to `line' for now, and update the dimensions of `line'. Update all undisplayed lines to have no associated dimensions. Also clear from the bottom of strokes to the bottom of the line, and from the end of the line to the end of the sheet." - (declare (ignore old-line-width)) (end-line line line-x1 line-y1 line-width line-height) (with-accessors ((line-x1 x1) (line-y1 y1) (line-x2 x2) (line-y2 y2)) (line-dimensions line) @@ -603,8 +601,6 @@ buffer offset `start-offset', and will be drawn starting at (`cursor-x', `cursor-y')." (let* ((line (line-information view (displayed-lines-count view))) - (old-line-height (dimensions-height (line-dimensions line))) - (old-line-width (dimensions-width (line-dimensions line))) (orig-x-offset cursor-x) (offset-change (- start-offset (line-start-offset line))) (line-spacing (stream-vertical-spacing pane))) @@ -651,8 +647,7 @@ for stroke-dimensions = (stroke-dimensions stroke) do (draw-stroke pane view stroke (x1 stroke-dimensions) baseline) finally (progn (end-line-cleaning-up pane line orig-x-offset cursor-y - line-width old-line-width - line-height old-line-height) + line-width line-height) (incf (displayed-lines-count view)) (return (values pump-state line-height)))))))

1 0

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

15 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv1160/Drei Modified Files: views.lisp Log Message: Removed attempts at figuring out when not to reparse from view code, only the syntax modules can really make that decision. --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/13 10:33:10 1.18 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/15 07:43:05 1.19 @@ -662,14 +662,10 @@ force-p (begin 0) (end (size (buffer view)))) (assert (>= end begin)) ;; If nothing changed, then don't call the other methods. - (let ((high-offset (- (size (buffer view)) (suffix-size view)))) - (when (or (and (> begin (prefix-size view)) - (> high-offset begin)) - (and (> end (prefix-size view)) - (>= (prefix-size view) begin)) - (/= (size (buffer view)) (buffer-size view)) - force-p) - (call-next-method)))) + (when (or (not (= (prefix-size view) (suffix-size view) + (buffer-size view) (size (buffer view)))) + force-p) + (call-next-method))) (defmethod synchronize-view ((view drei-syntax-view) &key (begin 0) (end (size (buffer view))))

1 0

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

15 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv31482/Drei Modified Files: syntax.lisp Log Message: Removed default method on update-syntax that did nothing but confuse the results and sometimes lower performance. --- /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp 2008/01/13 10:33:10 1.14 +++ /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp 2008/01/15 07:27:14 1.15 @@ -94,11 +94,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 :most-specific-last) - (:method values-max-min ((syntax syntax) (unchanged-prefix integer) - (unchanged-suffix integer) &optional (begin 0) - (end (- (size (buffer syntax)) unchanged-suffix))) - (values begin end))) + (:method-combination values-max-min :most-specific-last)) (defgeneric eval-defun (mark syntax))

1 0

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

15 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv21518/Drei Modified Files: motion.lisp Log Message: Make paragraph-movement commands move the beginning or end of buffer even if no paragraph delimiter can be found. --- /project/mcclim/cvsroot/mcclim/Drei/motion.lisp 2008/01/05 20:08:32 1.6 +++ /project/mcclim/cvsroot/mcclim/Drei/motion.lisp 2008/01/15 06:55:30 1.7 @@ -476,10 +476,9 @@ (unless (beginning-of-buffer-p mark) (backward-object mark 1) (if (search-backward mark (coerce (paragraph-delimiter syntax) 'vector)) - (progn (forward-object mark (length (paragraph-delimiter syntax))) - t) - (progn (beginning-of-buffer mark) - nil)))) + (forward-object mark (length (paragraph-delimiter syntax))) + (beginning-of-buffer mark)) + t)) (defgeneric forward-one-paragraph (mark syntax) (:documentation @@ -490,10 +489,9 @@ (unless (end-of-buffer-p mark) (forward-object mark 1) (if (search-forward mark (coerce (paragraph-delimiter syntax) 'vector)) - (progn (backward-object mark (length (paragraph-delimiter syntax))) - t) - (progn (end-of-buffer mark) - nil)))) + (backward-object mark (length (paragraph-delimiter syntax))) + (end-of-buffer mark)) + t)) (define-motion-fns paragraph)

1 0

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

14 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv2479/Drei Modified Files: drei-redisplay.lisp Log Message: Don't draw the cursor if the result would be a null rectangle. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/14 20:58:29 1.29 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/14 21:43:48 1.30 @@ -875,10 +875,11 @@ (multiple-value-bind (cursor-x cursor-y stroke-height object-width) (offset-to-screen-position stream view (offset (mark cursor))) (letf (((stream-current-output-record stream) cursor)) - (draw-rectangle* stream - cursor-x cursor-y - (+ cursor-x object-width) (+ cursor-y stroke-height) - :ink (ink cursor))))) + (unless (zerop (* object-width stroke-height)) + (draw-rectangle* stream + cursor-x cursor-y + (+ cursor-x object-width) (+ cursor-y stroke-height) + :ink (ink cursor)))))) (defmethod display-drei-view-cursor :after ((stream extended-output-stream) (view drei-view) (cursor point-cursor))

1 0

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

14 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv25330/Drei Modified Files: drei-redisplay.lisp Log Message: Fixed cursor-height calculation when at end of line. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/14 19:57:02 1.28 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/14 20:58:29 1.29 @@ -822,9 +822,12 @@ (- (x2 stroke-dimensions) absolute-x-position) (- (offset-in-stroke-position pane view stroke (1+ offset)) relative-x-position))))))))) - (return-from - worker (values (x2 line-dimensions) (y1 line-dimensions) - (dimensions-height line-dimensions)))))))) + ;; If we reach this point, we are just past the last + ;; stroke, so let's extract information from it. + (let ((stroke-dimensions (stroke-dimensions (line-last-stroke line)))) + (return-from + worker (values (x2 stroke-dimensions) (y1 stroke-dimensions) + (dimensions-height stroke-dimensions))))))))) (with-accessors ((buffer buffer) (top top) (bot bot)) view (let ((default-object-width (text-style-width

1 0

[mcclim-cvs] CVS mcclim/ESA
by thenriksen 14 Jan '08

14 Jan '08

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv24744/ESA Modified Files: esa.lisp Log Message: Fixed ESA macro replaying. --- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/12/19 11:01:57 1.13 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2008/01/14 20:50:11 1.14 @@ -1542,7 +1542,7 @@ (define-command (com-call-last-kbd-macro :name t :command-table keyboard-macro-table) - ((count 'integer :prompt "How many times?")) + ((count 'integer :prompt "How many times?" :default 1)) "Run the last keyboard macro that was defined. Use C-x ( to start and C-x ) to finish recording a keyboard macro." (setf (remaining-keys *command-processor*)

1 0

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

14 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv15402/Drei Modified Files: drei-redisplay.lisp Log Message: Try to reduce the number of calls to `draw-rectangle*' in Drei. This improved performance in my trivial test by 15%. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/14 18:42:43 1.27 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/14 19:57:02 1.28 @@ -594,17 +594,12 @@ (with-accessors ((stroke-x1 x1) (stroke-y1 y1) (stroke-x2 x2) (stroke-y2 y2)) stroke-dimensions (setf stroke-x1 0 stroke-y1 0 - stroke-x2 0 stroke-y2 0)))) - ;; Clear from end of line to end of sheet. - (clear-rectangle* stream line-x2 line-y1 - (bounding-rectangle-width stream) - (+ line-y1 (max line-height old-line-height) - (stream-vertical-spacing stream))))) + stroke-x2 0 stroke-y2 0)))))) -(defun draw-line-strokes (stream view initial-pump-state +(defun draw-line-strokes (pane view initial-pump-state start-offset cursor-x cursor-y) "Pump strokes from `view', using `initial-pump-state' to begin -with, and draw them on `stream'. The line is set to start at the +with, and draw them on `pane'. The line is set to start at the buffer offset `start-offset', and will be drawn starting at (`cursor-x', `cursor-y')." (let* ((line (line-information view (displayed-lines-count view))) @@ -612,7 +607,7 @@ (old-line-width (dimensions-width (line-dimensions line))) (orig-x-offset cursor-x) (offset-change (- start-offset (line-start-offset line))) - (line-spacing (stream-vertical-spacing stream))) + (line-spacing (stream-vertical-spacing pane))) (setf (line-start-offset line) start-offset (line-stroke-count line) 0) ;; So yeah, this is fairly black magic, but it's not actually @@ -624,29 +619,38 @@ for stroke-dimensions = (stroke-dimensions stroke) for pump-state = (put-stroke view line initial-pump-state offset-change) then (put-stroke view line pump-state offset-change) - do (update-stroke-dimensions stream view stroke cursor-x cursor-y) + do (update-stroke-dimensions pane view stroke cursor-x cursor-y) (setf cursor-x (x2 stroke-dimensions)) maximizing (dimensions-height stroke-dimensions) into line-height maximizing (+ (center stroke-dimensions) cursor-y) into baseline summing (dimensions-width stroke-dimensions) into line-width when (stroke-at-end-of-line (buffer view) stroke) return (values line-width line-height baseline pump-state)) + ;; Loop over the strokes and clear the parts of the pane that + ;; has to be redrawn, trying to minimise the number of calls to + ;; `clear-rectangle*'.. + (flet ((maybe-clear (x1 x2) + (unless (= x1 x2) + (clear-rectangle* pane x1 cursor-y x2 + (+ cursor-y line-height line-spacing))))) + (loop with last-clear-x = orig-x-offset + for stroke-index below (line-stroke-count line) + for stroke = (aref (line-strokes line) stroke-index) + for stroke-dimensions = (stroke-dimensions stroke) + do (unless (= baseline (+ cursor-y (center stroke-dimensions))) + (invalidate-stroke stroke)) + (unless (stroke-dirty stroke) + (maybe-clear last-clear-x (x1 stroke-dimensions)) + (setf last-clear-x (x2 stroke-dimensions))) + ;; This clears from end of line to the end of the sheet. + finally (maybe-clear last-clear-x (bounding-rectangle-width pane)))) ;; Now actually draw them in a way that makes sure they all ;; touch the bottom of the line. - (loop with last-clear-x = orig-x-offset - for stroke-index below (line-stroke-count line) + (loop for stroke-index below (line-stroke-count line) for stroke = (aref (line-strokes line) stroke-index) for stroke-dimensions = (stroke-dimensions stroke) - do (unless (= baseline (+ cursor-y (center stroke-dimensions))) - (invalidate-stroke stroke)) - (when (stroke-dirty stroke) - (clear-rectangle* stream (x1 stroke-dimensions) cursor-y - (x2 stroke-dimensions) - (+ cursor-y line-height line-spacing)) - (setf last-clear-x (x2 stroke-dimensions))) - (draw-stroke stream view stroke - (x1 stroke-dimensions) baseline) - finally (progn (end-line-cleaning-up stream line orig-x-offset cursor-y + do (draw-stroke pane view stroke (x1 stroke-dimensions) baseline) + finally (progn (end-line-cleaning-up pane line orig-x-offset cursor-y line-width old-line-width line-height old-line-height) (incf (displayed-lines-count view))

1 0

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

14 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv8142 Modified Files: NEWS Log Message: Added Drei stuff to NEWS. --- /project/mcclim/cvsroot/mcclim/NEWS 2008/01/11 06:01:38 1.28 +++ /project/mcclim/cvsroot/mcclim/NEWS 2008/01/14 19:06:52 1.29 @@ -6,6 +6,10 @@ applications. ** New extension: MCCLIM-IMAGES. This extension makes it easy to use McCLIM for loading and displaying images of various formats. +** Drei improvements +*** New redisplay engine that is faster and has more features. +*** Support for "views" concept. +*** Support for modes a la Emacs "mini-modes". * Changes in mcclim-0.9.5 relative to 0.9.4: ** Installation: the systems clim-listener, clim-examples,

1 0

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

14 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv4573/Drei Modified Files: drei-redisplay.lisp Log Message: Baseline-adjusted drawing for Drei. Please test. Is very slightly slower than it used to be, but enables an optimisation (reduction in number of distinct calls to draw-rectangle*) that I'll finish up shortly. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/14 12:43:05 1.26 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/14 18:42:43 1.27 @@ -100,11 +100,12 @@ (style nil)) (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 -argument as a function with the remaining five arguments. Used as -the default drawing-function of `drawing-options' objects.") + #'(lambda (stream view stroke cursor-x cursor-y default-drawing-fn draw) + (funcall default-drawing-fn stream view stroke cursor-x cursor-y draw)) + "A simple function of seven arguments that simply calls the +first argument as a function with the remaining sex +arguments. Used as the default drawing-function of +`drawing-options' objects.") (defstruct drawing-options "A set of options for how to display a stroke." @@ -142,7 +143,7 @@ be absolute coordinates in the coordinate system of a sheet. A special `center' slot is also provided to enable the recording of what might be considered a *logical* centre of the dimensions on -the vertical axis." +the vertical axis. `Center' should be relative to `y1'." (x1 0) (y1 0) (x2 0) @@ -189,6 +190,13 @@ (widths) (parts)) +(defun stroke-at-end-of-line (buffer stroke) + "Return true if the end offset of `stroke' is at the end of a +line in `buffer'. Otherwise, return nil. The end offset of +`stroke' must be a valid offset for `buffer' or an error will be +signalled." + (offset-end-of-line-p buffer (stroke-end-offset stroke))) + (defstruct (displayed-line (:conc-name line-)) "A line on display. A line delimits a buffer region (always bounded by newline objects or border beginning/end) and contains @@ -391,8 +399,7 @@ sets the modified-bit of `stroke' to false, as it updates the dimensions." (let ((dimensions (stroke-dimensions stroke))) - (setf (stroke-dirty stroke) (and (stroke-dirty stroke) - (not drawn)) + (setf (stroke-dirty stroke) (and (stroke-dirty stroke) (not drawn)) (stroke-modified stroke) nil (stroke-parts stroke) parts (stroke-widths stroke) widths @@ -443,12 +450,11 @@ "Calculate the width information of `stroke-string' when displayed with `text-style' (which must be fully specified) on `stream', starting at the horizontal device unit offset -`x-position'. Four values will be returned: the total width of -the stroke, the baseline, the parts of the stroke and the widths -of the parts of the stroke." +`x-position'. Three values will be returned: the total width of +the stroke, the parts of the stroke and the widths of the parts +of the stroke." (loop with parts = (analyse-stroke-string stroke-string) with width = 0 - with baseline = 0 with widths = (make-array (length parts) :adjustable t :fill-pointer t) with tab-width for (start end object) in parts @@ -459,32 +465,32 @@ (mod (+ width x-position) tab-width))) (vector-push-extend width widths)) (object - (multiple-value-bind (w ignore1 ignore2 ignore3 b) + (multiple-value-bind (w ignore1 ignore2 ignore3 ignore4) (text-size stream object :text-style text-style) - (declare (ignore ignore1 ignore2 ignore3)) + (declare (ignore ignore1 ignore2 ignore3 ignore4)) (incf width w) - (setf baseline (max baseline b)) (vector-push-extend width widths))) (t - (multiple-value-bind (w ignore1 ignore2 ignore3 b) + (multiple-value-bind (w ignore1 ignore2 ignore3 ignore4) (text-size stream stroke-string :start start :end end :text-style text-style) - (declare (ignore ignore1 ignore2 ignore3)) + (declare (ignore ignore1 ignore2 ignore3 ignore4)) (incf width w) - (setf baseline (max baseline b)) (vector-push-extend width widths)))) - finally (return (values width baseline parts widths)))) + finally (return (values width parts widths)))) -(defun stroke-drawing-fn (stream view stroke cursor-x cursor-y) - "Draw `stroke' to `stream' at the position (`cursor-x', +(defun stroke-drawing-fn (stream view stroke cursor-x cursor-y draw) + "Draw `stroke' to `stream' baseline-adjusted at the position (`cursor-x', `cursor-y'). `View' is the view object that `stroke' belongs -to. It is assumed that the buffer region delimited by `stroke' -only contains characters. `Stroke' is drawn with face given by -the drawing options of `stroke', using the default text style of -`stream' to fill out any holes. The screen area beneath `stroke' -will be cleared before any actual output takes place." +to. If `draw' is true, actually draw the stroke to `stream', +otherwise, just calculate its size. It is assumed that the buffer +region delimited by `stroke' only contains characters. `Stroke' +is drawn with face given by the drawing options of `stroke', +using the default text style of `stream' to fill out any +holes. The screen area beneath `stroke' will be cleared before +any actual output takes place." (with-accessors ((start-offset stroke-start-offset) (end-offset stroke-end-offset) (dimensions stroke-dimensions) @@ -500,56 +506,56 @@ ;; Ignore face when computing height, otherwise we get ;; bouncy lines when things like parenmatching bolds parts ;; of the line. - (roman-text-style (merge-text-styles +roman-face-style+ - merged-text-style)) + (roman-text-style (merge-text-styles +roman-face-style+ merged-text-style)) (text-style-ascent (text-style-ascent roman-text-style (sheet-medium stream))) - (text-style-descent (text-style-descent roman-text-style (sheet-medium stream))) - (text-style-height (+ text-style-ascent text-style-descent))) + (text-style-descent (text-style-descent roman-text-style (sheet-medium stream)))) (with-accessors ((x1 x1) (x2 x2) (center center)) dimensions - (multiple-value-bind (width baseline stroke-parts part-widths) + (multiple-value-bind (width stroke-parts part-widths) (if (stroke-modified stroke) (calculate-stroke-width stroke-string merged-text-style stream cursor-x) - (values (- x2 x1) center parts widths)) - (clear-rectangle* stream cursor-x cursor-y - (+ cursor-x width) (+ cursor-y text-style-height - (stream-vertical-spacing stream))) - (loop for (start end object) in stroke-parts - for width across part-widths - do (cond ((and object (eq object #\Tab)) - nil) - (object - (draw-text* stream object (+ cursor-x width) - (+ cursor-y - (- text-style-ascent - baseline)) - :text-style merged-text-style - :ink +darkblue+ - :align-y :top)) - (t - (draw-text* stream stroke-string (+ cursor-x width) - (+ cursor-y - (- text-style-ascent - baseline)) - :start start :end end - :text-style merged-text-style - :ink (face-ink (drawing-options-face drawing-options)) - :align-y :top)))) - (record-stroke stroke stroke-parts part-widths cursor-x cursor-y - (+ width cursor-x) (+ text-style-height cursor-y) - t baseline)))))) + (values (- x2 x1) parts widths)) + (when draw + (loop for (start end object) in stroke-parts + for width across part-widths + do (cond ((and object (eq object #\Tab)) + nil) + (object + (draw-text* stream object (+ cursor-x width) + cursor-y + :text-style merged-text-style + :ink +darkblue+ + :align-y :baseline)) + (t + (draw-text* stream stroke-string (+ cursor-x width) + cursor-y + :start start :end end + :text-style merged-text-style + :ink (face-ink (drawing-options-face drawing-options)) + :align-y :baseline))))) + (record-stroke stroke stroke-parts part-widths + cursor-x (- cursor-y text-style-ascent) + (+ width cursor-x) (+ cursor-y text-style-descent) + draw text-style-ascent)))))) + +(defun update-stroke-dimensions (stream view stroke cursor-x cursor-y) + "Calculate the dimensions of `stroke' on `stream' +at (`cursor-x', `cursor-y'), but without actually drawing +anything. Will use the function specified in the drawing-options +of `stroke' to carry out the actual calculations." + (unless (= cursor-x (x1 (stroke-dimensions stroke))) + (invalidate-stroke stroke :modified t)) + (when (stroke-dirty stroke) + (funcall (drawing-options-function (stroke-drawing-options stroke)) stream view stroke + cursor-x cursor-y #'stroke-drawing-fn nil))) (defun draw-stroke (stream view stroke cursor-x cursor-y) - "Draw `stroke' on `stream' at (`cursor-x', `cursor-y'). Nothing -will be done unless `stroke' is dirty. Will use the function -specified in the drawing-options of `stroke' to carry out the -actual drawing." - (let* ((drawing-options (stroke-drawing-options stroke))) - (unless (and (= cursor-x (x1 (stroke-dimensions stroke))) - (= cursor-y (y1 (stroke-dimensions stroke)))) - (invalidate-stroke stroke :modified t)) - (when (stroke-dirty stroke) - (funcall (drawing-options-function drawing-options) stream view stroke - cursor-x cursor-y #'stroke-drawing-fn)))) + "Draw `stroke' on `stream' with a baseline at +`cursor-y'. Drawing starts at the horizontal offset +`cursor-x'. Stroke must thus have updated dimensional +informational. Nothing will be done unless `stroke' is dirty." + (when (stroke-dirty stroke) + (funcall (drawing-options-function (stroke-drawing-options stroke)) + stream view stroke cursor-x cursor-y #'stroke-drawing-fn t))) (defun end-line (line x1 y1 line-width line-height) "End the addition of strokes to `line' for now, and update the @@ -568,21 +574,20 @@ associated dimensions. Also clear from the bottom of strokes to the bottom of the line, and from the end of the line to the end of the sheet." + (declare (ignore old-line-width)) (end-line line line-x1 line-y1 line-width line-height) (with-accessors ((line-x1 x1) (line-y1 y1) (line-x2 x2) (line-y2 y2)) (line-dimensions line) - ;; If a has a lesser height than the line, clear from the bottom - ;; of the stroke to the bottom of the line, to avoid artifacts - ;; left over from prefvious redisplays. + ;; If a has a lesser height than the line, clear from the top of + ;; the line stroke to the top of the stroke, to avoid artifacts + ;; left over from previous redisplays. (do-displayed-line-strokes (stroke line) (let ((stroke-dimensions (stroke-dimensions stroke))) (with-accessors ((stroke-x1 x1) (stroke-y1 y1) (stroke-x2 x2) (stroke-y2 y2)) stroke-dimensions (when (> line-height (dimensions-height stroke-dimensions)) - (clear-rectangle* stream stroke-x1 stroke-y2 - stroke-x2 (+ stroke-y2 (- line-height - (dimensions-height stroke-dimensions)) - (stream-vertical-spacing stream))))))) + (clear-rectangle* stream stroke-x1 line-y1 + stroke-x2 stroke-y1))))) ;; Reset the dimensions of undisplayed lines. (do-undisplayed-line-strokes (stroke line) (let ((stroke-dimensions (stroke-dimensions stroke))) @@ -594,43 +599,58 @@ (clear-rectangle* stream line-x2 line-y1 (bounding-rectangle-width stream) (+ line-y1 (max line-height old-line-height) - (stream-vertical-spacing stream))) - (when (or (> old-line-height line-height) - (> old-line-width line-width)) - (clear-rectangle* stream line-x1 (+ line-y1 line-height) - (+ line-x1 (max old-line-width line-width)) - (+ line-y1 (max old-line-height line-height)))))) + (stream-vertical-spacing stream))))) (defun draw-line-strokes (stream view initial-pump-state start-offset cursor-x cursor-y) "Pump strokes from `view', using `initial-pump-state' to begin with, and draw them on `stream'. The line is set to start at the buffer offset `start-offset', and will be drawn starting -at (`cursor-x', `cursor-y')" +at (`cursor-x', `cursor-y')." (let* ((line (line-information view (displayed-lines-count view))) (old-line-height (dimensions-height (line-dimensions line))) (old-line-width (dimensions-width (line-dimensions line))) (orig-x-offset cursor-x) - (offset-change (- start-offset (line-start-offset line)))) + (offset-change (- start-offset (line-start-offset line))) + (line-spacing (stream-vertical-spacing stream))) (setf (line-start-offset line) start-offset (line-stroke-count line) 0) - (loop for index from 0 - for stroke = (line-stroke-information line index) - for stroke-dimensions = (stroke-dimensions stroke) - for pump-state = (put-stroke view line initial-pump-state offset-change) then - (put-stroke view line pump-state offset-change) - do (draw-stroke stream view stroke cursor-x cursor-y) - (setf cursor-x (x2 stroke-dimensions)) - maximizing (dimensions-height stroke-dimensions) into line-height - summing (- (x2 stroke-dimensions) - (x1 stroke-dimensions)) into line-width - when (or (= (stroke-end-offset stroke) (size (buffer view))) - (eql (buffer-object (buffer view) (stroke-end-offset stroke)) #\Newline)) - return (progn (end-line-cleaning-up stream line orig-x-offset cursor-y - line-width old-line-width - line-height old-line-height) - (incf (displayed-lines-count view)) - (values pump-state line-height))))) + ;; So yeah, this is fairly black magic, but it's not actually + ;; ugly, just complex. + (multiple-value-bind (line-width line-height baseline pump-state) + ;; Pump all the line strokes and calculate their dimensions. + (loop for index from 0 + for stroke = (line-stroke-information line index) + for stroke-dimensions = (stroke-dimensions stroke) + for pump-state = (put-stroke view line initial-pump-state offset-change) then + (put-stroke view line pump-state offset-change) + do (update-stroke-dimensions stream view stroke cursor-x cursor-y) + (setf cursor-x (x2 stroke-dimensions)) + maximizing (dimensions-height stroke-dimensions) into line-height + maximizing (+ (center stroke-dimensions) cursor-y) into baseline + summing (dimensions-width stroke-dimensions) into line-width + when (stroke-at-end-of-line (buffer view) stroke) + return (values line-width line-height baseline pump-state)) + ;; Now actually draw them in a way that makes sure they all + ;; touch the bottom of the line. + (loop with last-clear-x = orig-x-offset + for stroke-index below (line-stroke-count line) + for stroke = (aref (line-strokes line) stroke-index) + for stroke-dimensions = (stroke-dimensions stroke) + do (unless (= baseline (+ cursor-y (center stroke-dimensions))) + (invalidate-stroke stroke)) + (when (stroke-dirty stroke) + (clear-rectangle* stream (x1 stroke-dimensions) cursor-y + (x2 stroke-dimensions) + (+ cursor-y line-height line-spacing)) + (setf last-clear-x (x2 stroke-dimensions))) + (draw-stroke stream view stroke + (x1 stroke-dimensions) baseline) + finally (progn (end-line-cleaning-up stream line orig-x-offset cursor-y + line-width old-line-width + line-height old-line-height) + (incf (displayed-lines-count view)) + (return (values pump-state line-height))))))) (defun clear-stale-lines (pane view) "Clear from the last displayed line to the end of `pane'." @@ -652,7 +672,7 @@ (widths (make-array 2 :initial-contents (list 0 0))) (parts (list 0 1))) #'(lambda (stream view stroke cursor-x cursor-y - default-drawing-fn) + default-drawing-fn draw) (declare (ignore default-drawing-fn)) (with-accessors ((start-offset stroke-start-offset) (drawing-options stroke-drawing-options)) stroke @@ -665,20 +685,17 @@ ;; like the changing position is ignored. So add some ;; minuscule amount to it, and all will be well. 0.1 ;; device units shouldn't even be visible. - (setf (output-record-position output-record) (values (+ cursor-x 0.1) cursor-y)) (let ((width (bounding-rectangle-width output-record)) (height (bounding-rectangle-height output-record))) - (clear-rectangle* stream cursor-x cursor-y - (+ cursor-x width) (+ cursor-y height - (stream-vertical-spacing stream))) - (replay output-record stream) + (setf (output-record-position output-record) + (values (+ cursor-x 0.1) (- cursor-y height))) + (when draw + (replay output-record stream)) (setf (aref widths 1) width) (record-stroke stroke parts widths - cursor-x cursor-y (+ width cursor-x) - (+ (if (zerop height) - (text-style-height (medium-text-style stream) stream) - height) - cursor-y)))))))) + cursor-x (- cursor-y height) + (+ width cursor-x) cursor-y + draw height))))))) (defmethod pump-state-for-offset ((view drei-buffer-view) (offset integer)) "For a `drei-buffer-view' a pump-state is merely an offset into @@ -767,7 +784,7 @@ (defgeneric offset-to-screen-position (pane view offset) (:documentation "Returns the position of offset as a screen -position. Returns `x', `y', `line-height', `OBJECT-WIDTH' as +position. Returns `x', `y', `stroke-height', `object-width' as values if offset is on the screen, NIL if offset is before the beginning of the screen, and T if offset is after the end of the screen. `Object-width' may be an approximation if `offset' is at @@ -786,7 +803,7 @@ (/= start-offset end-offset)) (return-from worker (values (x1 stroke-dimensions) (y1 stroke-dimensions) - (dimensions-height line-dimensions) + (dimensions-height stroke-dimensions) (if (= end-offset (1+ start-offset)) (dimensions-width stroke-dimensions) (offset-in-stroke-position pane view stroke (1+ offset)))))) @@ -796,7 +813,7 @@ (let* ((relative-x-position (offset-in-stroke-position pane view stroke offset)) (absolute-x-position (+ (x1 stroke-dimensions) relative-x-position))) (values absolute-x-position (y1 stroke-dimensions) - (dimensions-height line-dimensions) + (dimensions-height stroke-dimensions) (if (= (1+ offset) end-offset) (- (x2 stroke-dimensions) absolute-x-position) (- (offset-in-stroke-position pane view stroke (1+ offset)) @@ -815,9 +832,9 @@ ;; Search through strokes, returning when we find one that ;; `offset' is in. Strokes with >1 object are assumed to be ;; strings. - (multiple-value-bind (x y line-height object-width) (worker) - (if (and x y line-height) - (values x y line-height (or object-width default-object-width)) [21 lines skipped]

1 0

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

14 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv17192/Drei Modified Files: drei-redisplay.lisp Log Message: Made some small cleanups in Drei redisplay to prepare for bottom-adjusted drawing. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/13 22:01:31 1.25 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/14 12:43:05 1.26 @@ -383,13 +383,16 @@ (setf (line-end-offset line) (stroke-end-offset stroke))))) (defun record-stroke (stroke parts widths x1 y1 x2 y2 - &optional (center (/ (- y2 y1) 2))) - "Record the fact that `stroke' has been drawn, that it consists -of parts `parts' with the widths `widths', and that it -covers the specified area on screen. Updates the dirty- and -modified-bits of `stroke' as well as the dimensions." + &optional (drawn t) (center (/ (- y2 y1) 2))) + "Record the fact that `stroke' has been drawn (if `drawn' is +true), that it consists of parts `parts' with the widths +`widths', and that it covers the specified area on screen. Sets +the dirty-bit of `stroke' to false if `drawn' is true, and always +sets the modified-bit of `stroke' to false, as it updates the +dimensions." (let ((dimensions (stroke-dimensions stroke))) - (setf (stroke-dirty stroke) nil + (setf (stroke-dirty stroke) (and (stroke-dirty stroke) + (not drawn)) (stroke-modified stroke) nil (stroke-parts stroke) parts (stroke-widths stroke) widths @@ -436,6 +439,44 @@ (t (format nil "\\~O" code))))) +(defun calculate-stroke-width (stroke-string text-style stream x-position) + "Calculate the width information of `stroke-string' when +displayed with `text-style' (which must be fully specified) on +`stream', starting at the horizontal device unit offset +`x-position'. Four values will be returned: the total width of +the stroke, the baseline, the parts of the stroke and the widths +of the parts of the stroke." + (loop with parts = (analyse-stroke-string stroke-string) + with width = 0 + with baseline = 0 + with widths = (make-array (length parts) :adjustable t :fill-pointer t) + with tab-width + for (start end object) in parts + do (cond ((and object (eql object #\Tab)) + (incf width + (- (or tab-width + (setf tab-width (tab-width stream (stream-default-view stream)))) + (mod (+ width x-position) tab-width))) + (vector-push-extend width widths)) + (object + (multiple-value-bind (w ignore1 ignore2 ignore3 b) + (text-size stream object + :text-style text-style) + (declare (ignore ignore1 ignore2 ignore3)) + (incf width w) + (setf baseline (max baseline b)) + (vector-push-extend width widths))) + (t + (multiple-value-bind (w ignore1 ignore2 ignore3 b) + (text-size stream stroke-string + :start start :end end + :text-style text-style) + (declare (ignore ignore1 ignore2 ignore3)) + (incf width w) + (setf baseline (max baseline b)) + (vector-push-extend width widths)))) + finally (return (values width baseline parts widths)))) + (defun stroke-drawing-fn (stream view stroke cursor-x cursor-y) "Draw `stroke' to `stream' at the position (`cursor-x', `cursor-y'). `View' is the view object that `stroke' belongs @@ -465,38 +506,10 @@ (text-style-descent (text-style-descent roman-text-style (sheet-medium stream))) (text-style-height (+ text-style-ascent text-style-descent))) (with-accessors ((x1 x1) (x2 x2) (center center)) dimensions - (multiple-value-bind (stroke-parts width baseline part-widths) + (multiple-value-bind (width baseline stroke-parts part-widths) (if (stroke-modified stroke) - (loop with parts = (analyse-stroke-string stroke-string) - with width = 0 - with baseline = 0 - with widths = (make-array 1 :adjustable t :fill-pointer t) - with tab-width - for (start end object) in parts - do (cond ((and object (eql object #\Tab)) - (incf width - (- (or tab-width (setf tab-width (tab-width stream view))) - (mod (+ width cursor-x) tab-width))) - (vector-push-extend width widths)) - (object - (multiple-value-bind (w ignore1 ignore2 ignore3 b) - (text-size stream object - :text-style merged-text-style) - (declare (ignore ignore1 ignore2 ignore3)) - (incf width w) - (setf baseline (max baseline b)) - (vector-push-extend width widths))) - (t - (multiple-value-bind (w ignore1 ignore2 ignore3 b) - (text-size stream stroke-string - :start start :end end - :text-style merged-text-style) - (declare (ignore ignore1 ignore2 ignore3)) - (incf width w) - (setf baseline (max baseline b)) - (vector-push-extend width widths)))) - finally (return (values parts width baseline widths))) - (values parts (- x2 x1) center widths)) + (calculate-stroke-width stroke-string merged-text-style stream cursor-x) + (values (- x2 x1) center parts widths)) (clear-rectangle* stream cursor-x cursor-y (+ cursor-x width) (+ cursor-y text-style-height (stream-vertical-spacing stream))) @@ -523,7 +536,7 @@ :align-y :top)))) (record-stroke stroke stroke-parts part-widths cursor-x cursor-y (+ width cursor-x) (+ text-style-height cursor-y) - baseline)))))) + t baseline)))))) (defun draw-stroke (stream view stroke cursor-x cursor-y) "Draw `stroke' on `stream' at (`cursor-x', `cursor-y'). Nothing

1 0

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

14 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv2325/Drei Modified Files: base.lisp lisp-syntax-commands.lisp Log Message: Fixed Indent Expression. --- /project/mcclim/cvsroot/mcclim/Drei/base.lisp 2008/01/05 20:08:32 1.10 +++ /project/mcclim/cvsroot/mcclim/Drei/base.lisp 2008/01/14 09:14:47 1.11 @@ -117,7 +117,7 @@ (as-region (,mark-sym ,mark2-sym) (loop while (and (mark<= ,mark-sym ,mark2-sym) (not (end-of-buffer-p ,mark-sym))) - do + do (let ((,line-var (clone-mark ,mark-sym))) ,@body) (end-of-line ,mark-sym) --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-commands.lisp 2007/12/19 11:02:02 1.14 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-commands.lisp 2008/01/14 09:14:48 1.15 @@ -71,7 +71,7 @@ (define-command (com-indent-expression :name t :command-table lisp-table) ((count 'integer :prompt "Number of expressions" :default 1)) - (let ((mark (point))) + (let ((mark (clone-mark (point)))) (if (plusp count) (loop repeat count do (forward-expression mark (current-syntax))) (loop repeat (- count) do (backward-expression mark (current-syntax))))

1 0

[mcclim-cvs] CVS mcclim
by ahefner 14 Jan '08

14 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv9791 Modified Files: design.lisp regions.lisp Log Message: Plug holes in the design composition functions. --- /project/mcclim/cvsroot/mcclim/design.lisp 2007/02/05 02:54:20 1.26 +++ /project/mcclim/cvsroot/mcclim/design.lisp 2008/01/14 07:03:15 1.27 @@ -47,6 +47,8 @@ ;; ;; --GB +;; I agree with this interpretation. -Hefner + ;; It might be handy to have the equivalent of parent-relative ;; backgrounds. We can specify new indirect inks: ;; @@ -283,13 +285,26 @@ ||# +;;;; Design <-> Region Equivalences + +;;; As Gilbert points in his notes, transparent ink is in every +;;; respect interchangable with the nowhere region, and likewise +;;; foreground ink is interchangable with the everywhere region. +;;; By defining the following mixins and adding them to the +;;; appropriate ink/region class pairs, we can reduce the number +;;; of methods necessary. + +(defclass everywhere-mixin () ()) +(defclass nowhere-mixin () ()) ;;;; ;;;; 13.6 Indirect Inks ;;;; (defclass indirect-ink (design) ()) -(defvar +foreground-ink+ (make-instance 'indirect-ink)) +(defclass %foreground-ink (indirect-ink everywhere-mixin) ()) + +(defvar +foreground-ink+ (make-instance '%foreground-ink)) (defvar +background-ink+ (make-instance 'indirect-ink)) (defmethod print-object ((ink (eql +foreground-ink+)) stream) @@ -313,15 +328,25 @@ :type (real 0 1) :reader opacity-value))) -(defvar +transparent-ink+ - (make-instance 'standard-opacity :value 0)) +(defclass %transparent-ink (standard-opacity nowhere-mixin) + () + (:default-initargs :value 0)) + +(defvar +transparent-ink+ + (make-instance '%transparent-ink :value 0)) + +(defmethod opacity-value ((region everywhere-mixin)) + (declare (ignore region)) + 1.0) + +(defmethod opacity-value ((region nowhere-mixin)) + (declare (ignore region)) + 0.0) (defun make-opacity (value) (setf value (clamp value 0 1)) ;defensive programming - (cond ((= value 0) - +transparent-ink+) - ((= value 1) - +foreground-ink+) + (cond ((= value 0) +transparent-ink+) + ((= value 1) +everywhere+) ; used to say +foreground-ink+ (t (make-instance 'standard-opacity :value value)))) @@ -427,10 +452,6 @@ :initarg :design :reader transformed-design-design))) -#+NIL -;; Commeted out because CLOS bites here. Ellipises will be transformed -;; by this method. No idea why. -;; --GB 2003-05-28 (defmethod transform-region (transformation (design design)) (make-instance 'transformed-design :transformation transformation @@ -456,34 +477,43 @@ ;;; -(defclass in-compositum (design) +(defclass masked-compositum (design) ((ink :initarg :ink :reader compositum-ink) (mask :initarg :mask :reader compositum-mask))) -(defmethod print-object ((object in-compositum) stream) - (print-unreadable-object (object stream :identity nil :type t) +(defmethod print-object ((object masked-compositum) stream) + (print-unreadable-object (object stream :identity nil :type t) (format stream "~S ~S ~S ~S" - :ink (compositum-ink object) + :ink (compositum-ink object) :mask (compositum-mask object)))) -(defclass uniform-compositum (in-compositum) - ;; we use this class to represent rgbo values - ()) - -(defclass over-compositum (design) - ((foreground :initarg :foreground :reader compositum-foreground) - (background :initarg :background :reader compositum-background))) +(defclass in-compositum (masked-compositum) ()) (defmethod compose-in ((ink design) (mask design)) (make-instance 'in-compositum :ink ink :mask mask)) +(defclass out-compositum (masked-compositum) ()) + +(defmethod compose-out ((ink design) (mask design)) + (make-instance 'out-compositum + :ink ink + :mask mask)) + +(defclass over-compositum (design) + ((foreground :initarg :foreground :reader compositum-foreground) + (background :initarg :background :reader compositum-background))) + (defmethod compose-over ((foreground design) (background design)) (make-instance 'over-compositum :foreground foreground :background background)) +(defclass uniform-compositum (in-compositum) + ;; we use this class to represent rgbo values + ()) + ;;; ;;; color ;;; opacity @@ -542,6 +572,14 @@ (defmethod compose-in ((ink color) (mask uniform-compositum)) (make-uniform-compositum ink (opacity-value mask))) +(defmethod compose-in ((design design) (mask everywhere-mixin)) + (declare (ignore mask)) + design) + +(defmethod compose-in ((design design) (mask nowhere-mixin)) + (declare (ignore design mask)) + +nowhere+) + ;;; IN-COMPOSITUM ;; Since compose-in is associative, we can write it this way: @@ -648,6 +686,29 @@ ;;;; ------------------------------------------------------------------------------------------ ;;;; +;;;; Compose-Out +;;;; + +(defmethod compose-out ((design design) (mask everywhere-mixin)) + (declare (ignore design mask)) + +nowhere+) + +(defmethod compose-out ((design design) (mask nowhere-mixin)) + (declare (ignore mask)) + design) + +(defmethod compose-out ((design design) (mask color)) + (declare (ignore design mask)) + +nowhere+) + +(defmethod compose-out ((design design) (mask uniform-compositum)) + (compose-in design (make-opacity (- 1.0 (compositum-mask (opacity-value mask)))))) + +(defmethod compose-out ((design design) (mask standard-opacity)) + (compose-in design (make-opacity (- 1.0 (opacity-value mask))))) + +;;;; ------------------------------------------------------------------------------------------ +;;;; ;;;; Compose-Over ;;;; @@ -702,7 +763,6 @@ (multiple-value-bind (r g b o) (multiple-value-call #'color-blend-function (color-rgb foreground) - 1 (color-rgb (compositum-ink background)) (opacity-value (compositum-mask background))) (make-uniform-compositum --- /project/mcclim/cvsroot/mcclim/regions.lisp 2007/02/05 03:07:22 1.34 +++ /project/mcclim/cvsroot/mcclim/regions.lisp 2008/01/14 07:03:18 1.35 @@ -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.34 2007/02/05 03:07:22 ahefner Exp $ +;;; $Id: regions.lisp,v 1.35 2008/01/14 07:03:18 ahefner Exp $ ;;; -------------------------------------------------------------------------------------- ;;; (c) copyright 1998,1999,2001 by Gilbert Baumann ;;; (c) copyright 2001 by Arnaud Rouanet (rouanet(a)emi.u-bordeaux.fr) @@ -81,8 +81,8 @@ (in-package :clim-internals) -(defclass nowhere-region (region) ()) -(defclass everywhere-region (region) ()) +(defclass nowhere-region (region nowhere-mixin) ()) +(defclass everywhere-region (region everywhere-mixin) ()) ;; coordinate is defined in coordinates.lisp

1 0

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

14 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv8448/Apps/Listener Modified Files: icons.lisp Log Message: Fixed the Listener to use MCCLIM-IMAGES for drawing rather than DRAW-PATTERN*. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/icons.lisp 2008/01/06 15:32:11 1.6 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/icons.lisp 2008/01/14 06:52:00 1.7 @@ -58,10 +58,8 @@ (defun draw-icon (stream pattern &key (extra-spacing 0) ) (let ((stream (if (eq stream t) *standard-output* stream))) - (multiple-value-bind (x y) - (stream-cursor-position stream) - (draw-pattern* stream pattern x y) - (stream-increment-cursor-position stream (+ (pattern-width pattern) extra-spacing) 0)))) + (mcclim-images:draw-image stream pattern) + (stream-increment-cursor-position stream (+ (mcclim-images:image-width pattern) extra-spacing) 0))) (defun precache-icons () (let ((pathnames (remove-if #'directoryp

1 0

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

14 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory clnet:/tmp/cvs-serv15001 Modified Files: port.lisp Log Message: Better handle the situation where the DISPLAY variable is not set, which often causes problems on fringe platforms such as Win32 or the Macintosh. Specifically, McCLIM merged the user-provided server path against the server path read from the environment, which is wrong. Worse, it errored unless the environment variable was set, even if the user supplied their own server path. --- /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2008/01/14 00:01:04 1.130 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2008/01/14 04:53:11 1.131 @@ -167,8 +167,7 @@ (selection-timestamp :initform nil :accessor selection-timestamp) (font-families :accessor font-families))) -(defun parse-clx-server-path (path) - (pop path) +(defun automagic-clx-server-path () (let ((name (get-environment-variable "DISPLAY"))) (assert name (name) "Environment variable DISPLAY is not set") @@ -178,13 +177,13 @@ (decnet-colon-p (eql (elt name (1+ colon-i)) #\:)) (host (subseq name (1+ slash-i) colon-i)) (dot-i (and colon-i (position #\. name :start colon-i))) - (display (when colon-i + (display (and colon-i (parse-integer name :start (if decnet-colon-p (+ colon-i 2) (1+ colon-i)) :end dot-i))) - (screen (when dot-i + (screen (and dot-i (parse-integer name :start (1+ dot-i)))) (protocol (cond ((or (string= host "") (string-equal host "unix")) :local) @@ -194,10 +193,20 @@ :keyword)) (t :internet)))) (list :clx - :host (getf path :host host) - :display-id (getf path :display-id (or display 0)) - :screen-id (getf path :screen-id (or screen 0)) - :protocol protocol)))) + :host host + :display-id (or display 0) + :screen-id (or screen 0) + :protocol protocol)))) + +(defun parse-clx-server-path (path) + (pop path) + (if path + (list :clx + :host (getf path :host "localhost") + :display-id (getf path :display-id 0) + :screen-id (getf path :screen-id 0) + :protocol (getf path :protocol :internet)) + (automagic-clx-server-path))) (setf (get :x11 :port-type) 'clx-port) (setf (get :x11 :server-path-parser) 'parse-clx-server-path)

1 0

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

14 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory clnet:/tmp/cvs-serv28382 Modified Files: port.lisp Log Message: Surely we mean finish rather than force output. --- /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2007/09/11 19:54:40 1.129 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2008/01/14 00:01:04 1.130 @@ -279,7 +279,7 @@ #'clx-error-handler) #+nil ;; Uncomment this when debugging CLX backend if asynchronous errors become troublesome.. - (setf (xlib:display-after-function (clx-port-display port)) #'xlib:display-force-output)) + (setf (xlib:display-after-function (clx-port-display port)) #'xlib:display-finish-output)) (setf (clx-port-screen port) (nth (getf options :screen-id)

1 0

[mcclim-cvs] CVS mcclim/Experimental/freetype
by ahefner 14 Jan '08

14 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Experimental/freetype In directory clnet:/tmp/cvs-serv16465 Modified Files: freetype-fonts.lisp Log Message: Attempt to workaround nil text style issue. --- /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-fonts.lisp 2008/01/13 20:23:59 1.16 +++ /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-fonts.lisp 2008/01/13 23:02:34 1.17 @@ -461,6 +461,7 @@ (let ((display (clim-clx::clx-port-display port))) (setf face (or face :roman)) + (setf family (or family :fix)) (setf size (or size :normal)) (cond (size (setf size (getf *sizes* size size))

1 0

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