mcclim-cvs

mcclim-cvs@common-lisp.net

1697 discussions

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 03 Dec '06

03 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv20865/Drei Modified Files: core.lisp Log Message: Oops, these arguments should be the other way around. --- /project/mcclim/cvsroot/mcclim/Drei/core.lisp 2006/11/08 01:15:33 1.1 +++ /project/mcclim/cvsroot/mcclim/Drei/core.lisp 2006/12/03 22:50:13 1.2 @@ -250,8 +250,8 @@ syntax-line-indentation-function fill-column tab-width - compress-whitespaces - syntax)))) + syntax + compress-whitespaces)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[mcclim-cvs] CVS mcclim/Doc/Guided-Tour
by thenriksen 03 Dec '06

03 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Doc/Guided-Tour In directory clnet:/tmp/cvs-serv26347/Doc/Guided-Tour Modified Files: guided-tour.tex Log Message: Added mention of Gtkairo. --- /project/mcclim/cvsroot/mcclim/Doc/Guided-Tour/guided-tour.tex 2006/11/05 16:54:10 1.5 +++ /project/mcclim/cvsroot/mcclim/Doc/Guided-Tour/guided-tour.tex 2006/12/03 19:59:29 1.6 @@ -223,9 +223,10 @@ facilities will automatically adapt to use whatever toolkit is available on and appropriate for the host environment. In addition, portable Lisp-based implementations of the abstract gadget pane -protocols are provided.\footnote{\mcclim{} does not support look and feel - adaptiveness at the moment except for the experimental beagle backend for Mac - OS X's Cocoa platform. Hence, \mcclim{} mostly uses this portable Lisp-based +protocols are provided.\footnote{\mcclim{} does not support look and + feel adaptiveness at the moment except for the experimental beagle + backend for Mac OS X's Cocoa platform, or the Gtkairo backend using + GTK. Hence, \mcclim{} mostly uses this portable Lisp-based implementation.} \paragraph*{Application Building} \CLIM{} provides a set of tools for

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 03 Dec '06

03 Dec '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv18496 Modified Files: input-editing-drei.lisp Log Message: Stuff inserted via the presentation history should never be an accept result. --- /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2006/11/27 07:44:46 1.3 +++ /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2006/12/03 19:18:06 1.4 @@ -208,7 +208,9 @@ (multiple-value-bind (object type) (presentation-history-next history accepting-type) (when type - (presentation-replace-input stream object type (stream-default-view stream))))))) + (presentation-replace-input stream object type (stream-default-view stream) + :allow-other-keys t + :accept-result nil)))))) (defun history-yank-previous (stream input-buffer gesture numeric-argument) (declare (ignore input-buffer gesture numeric-argument)) @@ -219,7 +221,9 @@ (multiple-value-bind (object type) (presentation-history-previous history accepting-type) (when type - (presentation-replace-input stream object type (stream-default-view stream))))))) + (presentation-replace-input stream object type (stream-default-view stream) + :allow-other-keys t + :accept-result nil)))))) (add-input-editor-command '((#\n :meta)) 'history-yank-next)

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 03 Dec '06

03 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv18224 Modified Files: event.lisp Log Message: * event.lisp (gdkmodifiertype->modifier-state): Uncomment the mod2 -> super-key mapping, it has been reported to be incorrect. (key-handler): Map symbol :TAB to character #\tab. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/11/25 21:14:53 1.14 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/12/03 19:17:26 1.15 @@ -169,7 +169,7 @@ (if (logtest GDK_SHIFT_MASK state) +shift-key+ 0) (if (logtest GDK_CONTROL_MASK state) +control-key+ 0) (if (logtest GDK_MOD1_MASK state) +meta-key+ 0) - (if (logtest GDK_MOD2_MASK state) +super-key+ 0) + ;; (if (logtest GDK_MOD2_MASK state) +super-key+ 0) (if (logtest GDK_MOD3_MASK state) +hyper-key+ 0) ;;; (if (logtest GDK_MOD4_MASK state) ??? 0) ;;; (if (logtest GDK_MOD5_MASK state) ??? 0) @@ -224,6 +224,8 @@ (cond ((eq sym :backspace) (setf char #\backspace)) + ((eq sym :tab) + (setf char #\tab)) ((null char)) ((eql char #\return)) ((eql char #\escape)

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 03 Dec '06

03 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv3918 Modified Files: medium.lisp pixmap.lisp port.lisp Log Message: Set the antialising mode on /all/ cairo crs. * medium.lisp (set-antialias): New function. (sync-sheet, sync-ink, make-cairo-surface): Call set-antialias. * port.lisp ((initialize-instance :after), mirror-drawable): Call set-antialias. Fix the beams: * pixmap.lisp (%medium-copy-area): Perform clipping. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/medium.lisp 2006/11/19 15:55:11 1.12 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/medium.lisp 2006/12/03 15:24:09 1.13 @@ -74,6 +74,12 @@ (not (region-equal (last-seen-region medium) (sheet-region (medium-sheet medium))))))) +(defun set-antialias (cr) + (cairo_set_antialias cr + (if *antialiasingp* + :CAIRO_ANTIALIAS_DEFAULT + :CAIRO_ANTIALIAS_NONE))) + (defun sync-sheet (medium) (when (medium-sheet medium) ;ignore the metrik-medium (setf (gethash medium (dirty-mediums (port medium))) t)) @@ -85,7 +91,7 @@ (setf (cr medium) (gdk_cairo_create drawable)) (dispose-flipping-pixmap medium) (pushnew medium (mirror-mediums mirror)) - (cairo_set_antialias (cr medium) (if *antialiasingp* 0 1))) + (set-antialias (cr medium))) (setf (last-seen-sheet medium) (medium-sheet medium)) (setf (last-seen-region medium) (sheet-region (medium-sheet medium)))))) @@ -250,6 +256,7 @@ (setf (flipping-pixmap medium) (gdk_pixmap_new drawable width height -1))))) (setf (cr medium) (gdk_cairo_create pixmap)) + (set-antialias (cr medium)) (setf (flipping-region medium) region) (cairo_paint (cr medium)) (sync-transformation medium) @@ -938,6 +945,7 @@ (cairo_get_target (cr compatible-medium)) format width height)) (c (cairo_create s))) + (set-antialias c) (make-instance 'gtkairo-medium :cr c :surface s))) (defmacro with-pattern ((m1 mp) &body body) --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/pixmap.lisp 2006/04/17 18:40:27 1.1 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/pixmap.lisp 2006/12/03 15:24:09 1.2 @@ -44,16 +44,23 @@ (to-drawable (medium-gdkdrawable to-medium))) (cairo_surface_flush from-surface) (cairo_surface_flush to-surface) - (let ((gc (gdk_gc_new to-drawable))) - (gdk_draw_drawable to-drawable - gc - from-drawable - (truncate from-x) - (truncate from-y) - (truncate to-x) - (truncate to-y) - (truncate width) - (truncate height)) + (let ((gc (gdk_gc_new to-drawable)) + (region (medium-clipping-region to-medium))) + (unless (eq region +nowhere+) + (setf region + (region-intersection + region + (make-rectangle* to-x to-y (+ to-x width) (+ to-y height)))) + (loop for (x y w h) in (clipping-region->rect-seq region) do + (gdk_draw_drawable to-drawable + gc + from-drawable + (truncate (+ from-x x (- to-x))) + (truncate (+ from-y y (- to-y))) + (truncate x) + (truncate y) + (truncate w) + (truncate h)))) (gdk_gc_unref gc)) (cairo_surface_mark_dirty to-surface)))) --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/port.lisp 2006/11/19 17:31:20 1.11 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/port.lisp 2006/12/03 15:24:09 1.12 @@ -83,6 +83,7 @@ (gtk_init (cffi:null-pointer) (cffi:null-pointer)) (let ((cr (gdk_cairo_create (gdk_screen_get_root_window (gdk_screen_get_default))))) + (set-antialias cr) (setf (metrik-medium port) (make-instance 'metrik-medium :port port :cr cr)))) (when clim-sys:*multiprocessing-p* @@ -150,6 +151,7 @@ (height (floor (bounding-rectangle-max-y region))) (pixmap (gdk_pixmap_new window width height -1)) (cr (gdk_cairo_create pixmap))) + (set-antialias cr) (cairo_set_source_rgba cr 1.0d0 1.0d0

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 03 Dec '06

03 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv20228 Modified Files: gadgets.lisp Log Message: Fix gsharp startup crash reported by "C Y": * gadgets.lisp (realize-native-widget :around): Don't call gadget-active-p unless it's actually a gadget. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp 2006/11/26 17:54:08 1.14 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp 2006/12/03 08:09:06 1.15 @@ -587,7 +587,8 @@ (defmethod realize-native-widget :around ((gadget native-widget-mixin)) (let ((widget (call-next-method))) - (gtk_widget_set_sensitive widget (if (gadget-active-p gadget) 1 0)) + (when (typep gadget 'gadget) + (gtk_widget_set_sensitive widget (if (gadget-active-p gadget) 1 0))) widget)) (defmethod activate-gadget :after ((gadget native-widget-mixin))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 02 Dec '06

02 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv7322 Modified Files: lisp-syntax.lisp Log Message: Improved and fixed some `token-to-object' methods. Soon, Drei will be able to compile itself! --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2006/11/27 12:28:01 1.7 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2006/12/02 20:28:18 1.8 @@ -1709,6 +1709,8 @@ (define-form-predicate form-token-p (token-mixin)) (define-form-predicate form-string-p (string-form)) (define-form-predicate form-quoted-p (quote-form backquote-form)) +(define-form-predicate form-comma-p (comma-form)) +(define-form-predicate form-comma-at-p (comma-at-form)) (define-form-predicate comment-p (comment)) @@ -2563,7 +2565,13 @@ (defmethod token-to-object (syntax (token backquote-form) &rest args) (let ((backquoted-form (first-form (children token)))) (if (form-list-p backquoted-form) - `'(,@(apply #'token-to-object syntax backquoted-form args)) + `(list ,@(loop for element in (children backquoted-form) + if (form-comma-p element) + collect (apply #'token-to-object syntax element args) + else if (form-comma-at-p element) + nconc (apply #'token-to-object syntax element args) + else if (formp element) + collect (apply #'token-to-object syntax element :quote t args))) `',(apply #'token-to-object syntax backquoted-form args)))) (defmethod token-to-object (syntax (token comma-form) &rest args) @@ -2634,7 +2642,7 @@ ""))))) (defmethod token-to-object ((syntax lisp-syntax) (token complete-function-form) &rest args &key &allow-other-keys) - (fdefinition (apply #'token-to-object syntax (second (children token)) args))) + (list 'function (apply #'token-to-object syntax (second (children token)) args))) (defmethod token-to-object ((syntax lisp-syntax) (token bit-vector-form) &key &allow-other-keys)

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 01 Dec '06

01 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv18978/Drei Modified Files: input-editor.lisp Log Message: Implement `erase-input-buffer' (somewhat, mostly so older CLIM programs won't hit a NO-APPLICABLE-METHOD error). --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2006/12/01 22:39:14 1.8 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2006/12/01 23:02:59 1.9 @@ -560,6 +560,13 @@ ;; figure out what to redraw than to just redraw everything. (display-drei (drei-instance stream))) +(defmethod erase-input-buffer ((stream drei-input-editing-mixin) + &optional (start-position 0)) + (declare (ignore start-position)) + ;; Again, we ignore `start-position'. What is the big idea behind + ;; this function anyway? + (clear-output-record (drei-instance stream))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; `Add-input-editor-command'

1 0

[mcclim-cvs] CVS mcclim/Goatee
by thenriksen 01 Dec '06

01 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Goatee In directory clnet:/tmp/cvs-serv18978/Goatee Modified Files: editing-stream.lisp Log Message: Implement `erase-input-buffer' (somewhat, mostly so older CLIM programs won't hit a NO-APPLICABLE-METHOD error). --- /project/mcclim/cvsroot/mcclim/Goatee/editing-stream.lisp 2006/11/22 14:23:22 1.23 +++ /project/mcclim/cvsroot/mcclim/Goatee/editing-stream.lisp 2006/12/01 23:02:59 1.24 @@ -406,3 +406,8 @@ (defmethod redraw-input-buffer ((stream goatee-input-editing-mixin) &optional (start-position 0)) (declare (ignore start-position)) (redisplay-area (area stream))) + +(defmethod erase-input-buffer ((stream goatee-input-editing-mixin) + &optional (start-position 0)) + (declare (ignore start-position)) + (clear-output-record (area stream)))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 01 Dec '06

01 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv14362 Modified Files: input-editor.lisp Log Message: Now support for CLIM 2.2 (Franz User Guide) style input buffers. --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2006/12/01 21:51:08 1.7 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2006/12/01 22:39:14 1.8 @@ -41,7 +41,12 @@ :initform nil) (%rescanning-p :reader stream-rescanning-p :writer (setf stream-rescanning) - :initform nil)) + :initform nil) + (%input-buffer-array :accessor input-buffer-array + :initform nil + :documentation "After a command has been +executed, the contents of the Drei area instance shall be +replaced by the contents of this array, if non-NIL.")) (:documentation "An mixin that helps in implementing Drei-based input-editing streams. This class should not be directly instantiated.")) @@ -170,15 +175,62 @@ ;; want to permit the user to undo input for this context. (clear-undo-history (buffer (drei-instance stream)))) +(defun update-drei-buffer (stream) + "Update the Drei buffer of the Drei instance used by `stream' +if the `input-buffer-array' of `stream' is non-NIl. This will set +the contents of the array to the contents of the array up to the +fill pointer. When this function returns, the +`input-buffer-array' of `stream' will be NIL. Also, the syntax +will be up-to-date." + (with-accessors ((array input-buffer-array)) stream + (let ((buffer (buffer (drei-instance stream)))) + (when array + ;; Attempt to minimise the changes to the buffer, so the + ;; position of marks will not be changed too much. Find the + ;; first mismatch between buffer contents and array contents. + (let ((index (loop + for index from 0 below (min (length array) + (size buffer)) + unless (eql (buffer-object buffer index) + (aref array index)) + do (return index) + finally (return nil))) + (insertion-pointer (stream-insertion-pointer stream))) + (when index ; NIL if buffer and array are identical. + ;; Delete from the first mismatch to the end of the buffer. + (delete-buffer-range buffer index + (- (size buffer) index)) + ;; Insert from the mismatch to array end into the buffer. + (insert-buffer-sequence buffer index + (subseq array index)) + ;; We also need to update the syntax. + (update-syntax buffer (syntax buffer)) + ;; Finally, see if it is possible to maintain the old + ;; position of the insertion pointer. + (setf (stream-insertion-pointer stream) + (min insertion-pointer (size buffer))))) + (setf array nil))))) + +;; While the CLIM spec says that user-commands are not allowed to do +;; much with the input buffer, the Franz User Guide provides some +;; examples that hint to the opposite. How do we make modifications of +;; the input-buffer, which must be a standard array with a fill +;; pointer, to be applied to the "real" buffer? This is how: when this +;; method is called, we store the object in the stream object. In the +;; command loop, we check the stream object and update the buffer +;; (using `update-drei-buffer') to reflect the changes done to the +;; buffer. (defmethod stream-input-buffer ((stream drei-input-editing-mixin)) - ;; NOTE: This is very slow, please do not use it unless you want to - ;; be compatible with other editor substrates. Use the Drei buffer - ;; directly instead. - (with-accessors ((buffer buffer)) (drei-instance stream) - (let* ((array (buffer-sequence buffer 0 (size buffer)))) - (make-array (length array) - :fill-pointer (length array) - :initial-contents array)))) + ;; NOTE: This is very slow (consing up a whole new array - twice!), + ;; please do not use it unless you want to be compatible with other + ;; editor substrates. Use the Drei buffer directly instead. + (or (input-buffer-array stream) + (setf (input-buffer-array stream) + (with-accessors ((buffer buffer)) (drei-instance stream) + (let* ((array (buffer-sequence buffer 0 (size buffer)))) + (make-array (length array) + :fill-pointer (length array) + :initial-contents array)))))) (defmethod replace-input ((stream drei-input-editing-mixin) (new-input array) &key @@ -372,21 +424,25 @@ *pointer-documentation-output* minibuffer) :prompt "M-x ") - ;; We narrow the buffer to the input position, so the user won't - ;; be able to erase the original command (when entering command - ;; arguments) or stuff like argument prompts. - (accepting-from-user (drei) - (drei-core:with-narrowed-buffer (drei (input-position stream) t t) - (handler-case (process-gestures-or-command drei) - (unbound-gesture-sequence (c) - (display-message "~A is unbound" (gesture-name (gestures c)))) - (abort-gesture (c) - (if (member (abort-gesture-event c) - *abort-gestures* - :test #'event-matches-gesture-name-p) - (signal 'abort-gesture :event (abort-gesture-event c)) - (when was-directly-processing - (display-message "Aborted"))))))) + ;; Commands are permitted to signal immediate rescans, but + ;; we may need to do some stuff first. + (unwind-protect + (accepting-from-user (drei) + ;; We narrow the buffer to the input position, so the user won't + ;; be able to erase the original command (when entering command + ;; arguments) or stuff like argument prompts. + (drei-core:with-narrowed-buffer (drei (input-position stream) t t) + (handler-case (process-gestures-or-command drei) + (unbound-gesture-sequence (c) + (display-message "~A is unbound" (gesture-name (gestures c)))) + (abort-gesture (c) + (if (member (abort-gesture-event c) + *abort-gestures* + :test #'event-matches-gesture-name-p) + (signal 'abort-gesture :event (abort-gesture-event c)) + (when was-directly-processing + (display-message "Aborted"))))))) + (update-drei-buffer stream)) ;; Will also take care of redisplaying minibuffer. (display-drei drei) (let ((first-mismatch (offset (high-mark buffer))))

1 0

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