mcclim-cvs

mcclim-cvs@common-lisp.net

1697 discussions

[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-serv9192 Modified Files: input-editor.lisp Log Message: Removed all non-specified use of `stream-input-buffer' because it's very slow (consing up a brand new array). --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2006/11/22 14:15:53 1.6 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2006/12/01 21:51:08 1.7 @@ -171,8 +171,9 @@ (clear-undo-history (buffer (drei-instance stream)))) (defmethod stream-input-buffer ((stream drei-input-editing-mixin)) - ;; NOTE: This is very slow, we should attempt to replace uses of - ;; this function in McCLIM with something more efficient. + ;; 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) @@ -275,71 +276,70 @@ &allow-other-keys) (with-keywords-removed (rest-args (:peek-p)) (rescan-if-necessary stream) - (with-accessors ((buffer stream-input-buffer) - (insertion-pointer stream-insertion-pointer) + (with-accessors ((insertion-pointer stream-insertion-pointer) (scan-pointer stream-scan-pointer) (activation-gesture activation-gesture)) stream - (loop - (loop - while (< scan-pointer insertion-pointer) - while (< scan-pointer (length buffer)) - do (let ((gesture (aref buffer scan-pointer))) - ;; Skip noise strings. - (cond ((typep gesture 'noise-string) - (incf scan-pointer)) - ((and (not peek-p) - (typep gesture 'accept-result)) - (incf scan-pointer) - #+(or mcclim building-mcclim) - (climi::throw-object-ptype (object gesture) - (result-type gesture))) - ;; Note that this implies that - ;; `stream-read-gesture' may return accept - ;; results, which might as well be arbitrary - ;; objects to the code calling - ;; `stream-read-gesture', since it can't really - ;; do anything with them except for asserting - ;; that they exist. According to the spec, - ;; "accept results are treated as a single - ;; gesture", and this kind of behavior is - ;; necessary to make sure `stream-read-gesture' - ;; doesn't simply claim that there are no more - ;; gestures in the input-buffer when the - ;; remaining gesture(s) is an accept result. - ((typep gesture 'accept-result) - (return-from stream-read-gesture gesture)) - (t - (unless peek-p + (let ((buffer (buffer (drei-instance stream)))) + (loop + (loop + while (< scan-pointer insertion-pointer) + while (< scan-pointer (size buffer)) + do (let ((gesture (buffer-object buffer scan-pointer))) + ;; Skip noise strings. + (cond ((typep gesture 'noise-string) (incf scan-pointer)) - (return-from stream-read-gesture gesture)) - (t (incf scan-pointer))))) - (setf (stream-rescanning stream) nil) - (when activation-gesture - (return-from stream-read-gesture - (prog1 activation-gesture - (unless peek-p - (setf activation-gesture nil))))) - ;; In McCLIM, stream-process-gesture is responsible for - ;; inserting characters into the buffer, changing the - ;; insertion pointer and possibly setting up the - ;; activation-gesture slot. - (loop - with gesture and type - do (setf (values gesture type) - (apply #'stream-read-gesture - (encapsulating-stream-stream stream) rest-args)) - when (null gesture) - do (return-from stream-read-gesture (values gesture type)) - when (stream-process-gesture stream gesture type) - do (loop-finish)))))) + ((and (not peek-p) + (typep gesture 'accept-result)) + (incf scan-pointer) + #+(or mcclim building-mcclim) + (climi::throw-object-ptype (object gesture) + (result-type gesture))) + ;; Note that this implies that + ;; `stream-read-gesture' may return accept + ;; results, which might as well be arbitrary + ;; objects to the code calling + ;; `stream-read-gesture', since it can't really + ;; do anything with them except for asserting + ;; that they exist. According to the spec, + ;; "accept results are treated as a single + ;; gesture", and this kind of behavior is + ;; necessary to make sure `stream-read-gesture' + ;; doesn't simply claim that there are no more + ;; gestures in the input-buffer when the + ;; remaining gesture(s) is an accept result. + ((typep gesture 'accept-result) + (return-from stream-read-gesture gesture)) + (t + (unless peek-p + (incf scan-pointer)) + (return-from stream-read-gesture gesture)) + (t (incf scan-pointer))))) + (setf (stream-rescanning stream) nil) + (when activation-gesture + (return-from stream-read-gesture + (prog1 activation-gesture + (unless peek-p + (setf activation-gesture nil))))) + ;; In McCLIM, stream-process-gesture is responsible for + ;; inserting characters into the buffer, changing the + ;; insertion pointer and possibly setting up the + ;; activation-gesture slot. + (loop + with gesture and type + do (setf (values gesture type) + (apply #'stream-read-gesture + (encapsulating-stream-stream stream) rest-args)) + when (null gesture) + do (return-from stream-read-gesture (values gesture type)) + when (stream-process-gesture stream gesture type) + do (loop-finish))))))) (defmethod stream-unread-gesture ((stream drei-input-editing-mixin) gesture) - (with-accessors ((buffer stream-input-buffer) - (scan-pointer stream-scan-pointer) + (with-accessors ((scan-pointer stream-scan-pointer) (activation-gesture activation-gesture)) stream (when (> scan-pointer 0) - (if (and (eql scan-pointer (fill-pointer buffer)) + (if (and (eql scan-pointer (stream-insertion-pointer stream)) (activation-gesture-p gesture)) (setf activation-gesture gesture) (decf scan-pointer))))) @@ -355,8 +355,8 @@ `stream-read-gesture' for the stream encapsulated by `stream'. The second return value of this function will be `type' if stuff is inserted after the insertion pointer." - (let* ((before (stream-input-buffer stream)) - (drei (drei-instance stream)) + (let* ((drei (drei-instance stream)) + (buffer (buffer drei)) (*command-processor* drei) (was-directly-processing (directly-processing-p drei)) (minibuffer (or (minibuffer drei) *minibuffer*)) @@ -389,7 +389,8 @@ (display-message "Aborted"))))))) ;; Will also take care of redisplaying minibuffer. (display-drei drei) - (let ((first-mismatch (mismatch before (stream-input-buffer stream)))) + (let ((first-mismatch (offset (high-mark buffer)))) + (clear-modify buffer) (cond ((null first-mismatch) ;; No change actually took place, even though IP may ;; have moved.

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 30 Nov '06

30 Nov '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv7984 Modified Files: drei.lisp Log Message: Fixed `with-bound-drei-special-variables' to also allow null values. --- /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2006/11/19 11:39:45 1.8 +++ /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2006/11/30 17:33:31 1.9 @@ -706,17 +706,17 @@ (princ c minibuffer)))))) (defmacro with-bound-drei-special-variables ((drei-instance &key - current-buffer - current-window - current-mark - current-point - current-syntax - kill-ring - minibuffer - command-parser - partial-command-parser - previous-command - prompt) + (current-buffer nil current-buffer-p) + (current-window nil current-window-p) + (current-mark nil current-mark-p) + (current-point nil current-point-p) + (current-syntax nil current-syntax-p) + (kill-ring nil kill-ring-p) + (minibuffer nil minibuffer-p) + (command-parser nil command-parser-p) + (partial-command-parser nil partial-command-parser-p) + (previous-command nil previous-command-p) + (prompt nil prompt-p)) &body body) "Evaluate `body' with a set of Drei special variables (`*current-buffer*', `*current-window*', @@ -731,17 +731,28 @@ variables, but also some CLIM special variables needed for ESA-style command parsing." (once-only (drei-instance) - `(let* ((*current-buffer* ,(or current-buffer `(buffer ,drei-instance))) - (*current-window* ,(or current-window drei-instance)) - (*current-mark* ,(or current-mark `(mark ,drei-instance))) - (*current-point* ,(or current-point `(point ,drei-instance))) - (*current-syntax* ,(or current-syntax `(syntax *current-buffer*))) - (*kill-ring* ,(or kill-ring `(kill-ring ,drei-instance))) - (*minibuffer* ,(or minibuffer `(or (minibuffer ,drei-instance) *minibuffer*))) - (*command-parser* ,(or command-parser ''esa-command-parser)) - (*partial-command-parser* ,(or partial-command-parser ''esa-partial-command-parser)) - (*previous-command* ,(or previous-command `(previous-command ,drei-instance))) - (*extended-command-prompt* ,(or prompt "Extended command: "))) + `(let* ((*current-buffer* ,(if current-buffer-p current-buffer + `(buffer ,drei-instance))) + (*current-window* ,(if current-window-p current-window + drei-instance)) + (*current-mark* ,(if current-mark-p current-mark + `(mark ,drei-instance))) + (*current-point* ,(if current-point-p current-point + `(point ,drei-instance))) + (*current-syntax* ,(if current-syntax-p current-syntax + `(syntax *current-buffer*))) + (*kill-ring* ,(if kill-ring-p kill-ring + `(kill-ring ,drei-instance))) + (*minibuffer* ,(if minibuffer-p minibuffer + `(or (minibuffer ,drei-instance) *minibuffer*))) + (*command-parser* ,(if command-parser-p command-parser + ''esa-command-parser)) + (*partial-command-parser* ,(if partial-command-parser-p partial-command-parser + ''esa-partial-command-parser)) + (*previous-command* ,(if previous-command-p previous-command + `(previous-command ,drei-instance))) + (*extended-command-prompt* ,(if prompt-p prompt + "Extended command: "))) ,@body))) (defgeneric invoke-performing-drei-operations (drei continuation &key with-undo update-syntax redisplay)

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 30 Nov '06

30 Nov '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv2898 Modified Files: motion.lisp Log Message: Improved the page and paragraph motion methods. Basically, my philosophy is that all the unit methods must behave similarly wrt. where they move to within the seperator whitespace. This will mean that the Climacs paragraph motion commands are not identical to those of Emacs, but I believe the consistency is worth this. --- /project/mcclim/cvsroot/mcclim/Drei/motion.lisp 2006/11/18 22:02:41 1.2 +++ /project/mcclim/cvsroot/mcclim/Drei/motion.lisp 2006/11/30 17:00:09 1.3 @@ -351,8 +351,13 @@ reached.")) (defmethod forward-one-page (mark syntax) - (when (search-forward mark (coerce (page-delimiter syntax) 'vector)) - t)) + (unless (end-of-buffer-p mark) + (forward-object mark 1) + (if (search-forward mark (coerce (page-delimiter syntax) 'vector)) + (progn (backward-object mark (length (page-delimiter syntax))) + t) + (progn (end-of-buffer mark) + nil)))) (defgeneric backward-one-page (mark syntax) (:documentation @@ -361,9 +366,13 @@ reached.")) (defmethod backward-one-page (mark syntax) - (when (search-backward mark (coerce (page-delimiter syntax) 'vector)) - (forward-object mark) - t)) + (unless (beginning-of-buffer-p mark) + (backward-object mark 1) + (if (search-backward mark (coerce (page-delimiter syntax) 'vector)) + (progn (forward-object mark (length (page-delimiter syntax))) + t) + (progn (beginning-of-buffer mark) + nil)))) (define-motion-fns page) @@ -464,9 +473,13 @@ Return T if successful, or NIL if the buffer limit was reached.")) (defmethod backward-one-paragraph (mark syntax) - (when (search-backward mark (coerce (paragraph-delimiter syntax) 'vector)) - (forward-object mark) - t)) + (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)))) (defgeneric forward-one-paragraph (mark syntax) (:documentation @@ -474,9 +487,13 @@ Return T if successful, or NIL if the buffer limit was reached.")) (defmethod forward-one-paragraph (mark syntax) - (when (search-forward mark (coerce (paragraph-delimiter syntax) 'vector)) - (backward-object mark) - t)) + (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)))) (define-motion-fns paragraph)

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 29 Nov '06

29 Nov '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv19881 Modified Files: editing.lisp Log Message: We also need different line-transposition methods for left- and right-sticky-marks. --- /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2006/11/29 09:39:57 1.3 +++ /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2006/11/29 09:59:00 1.4 @@ -299,7 +299,7 @@ ;; Autogenerated TRANSPOSE-LINES is not good enough. (defmethod transpose-lines - (mark syntax) + ((mark left-sticky-mark) syntax) (beginning-of-line mark) (unless (beginning-of-buffer-p mark) (backward-line mark syntax)) @@ -312,11 +312,28 @@ (unless (end-of-buffer-p mark) (delete-range mark)) (end-of-line mark) - (insert-object mark #\Newline) (forward-line mark syntax 0) (insert-sequence mark line) (insert-object mark #\Newline))) +(defmethod transpose-lines + ((mark right-sticky-mark) syntax) + (beginning-of-line mark) + (unless (beginning-of-buffer-p mark) + (backward-line mark syntax)) + (let* ((bol (offset mark)) + (eol (progn (end-of-line mark) + (offset mark))) + (line (buffer-sequence (buffer mark) bol eol))) + (delete-region bol mark) + ;; Remove newline at end of line as well. + (unless (end-of-buffer-p mark) + (delete-range mark)) + (end-of-line mark) + (insert-object mark #\Newline) + (forward-line mark syntax 0) + (insert-sequence mark line))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Word editing

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 29 Nov '06

29 Nov '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv17375 Modified Files: editing.lisp Log Message: Hm! Apparently we need different transposition methods for left- and right-sticky-marks. --- /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2006/11/14 10:31:37 1.2 +++ /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2006/11/29 09:39:57 1.3 @@ -166,7 +166,7 @@ (:documentation ,(concat "Transpose two " plural " at MARK."))) (defmethod ,transpose - (mark syntax) + ((mark right-sticky-mark) syntax) (let (start1 end1 start2 end2) (,backward mark syntax 1 nil) (setf start1 (clone-mark mark)) @@ -190,7 +190,33 @@ (insert-sequence mark obj2) (update-syntax (buffer syntax) syntax) - (,forward mark syntax 1 nil)))))))) + (,forward mark syntax 1 nil)))) + (defmethod ,transpose + ((mark left-sticky-mark) syntax) + (let (start1 end1 start2 end2) + (,backward mark syntax 1 nil) + (setf start1 (clone-mark mark)) + (,forward mark syntax 1 #'error-limit-action) + (setf end1 (clone-mark mark)) + (,forward mark syntax 1 #'error-limit-action) + (setf end2 (clone-mark mark)) + (,backward mark syntax 1 nil) + (setf start2 (clone-mark mark)) + (let ((obj1 (buffer-sequence (buffer mark) (offset start1) (offset end1))) + (obj2 (buffer-sequence (buffer mark) (offset start2) (offset end2)))) + (,forward-delete mark syntax 1 nil) + (insert-sequence mark obj1) + (,forward mark syntax 1 nil) + ;; KLUDGE: Having to do this manually is ugly, but it + ;; is necessary if the motion functions uses syntax + ;; information. + (update-syntax (buffer syntax) + syntax) + (,backward mark syntax 2 nil) + (,forward-delete mark syntax 1 nil) + (insert-sequence mark obj2) + (update-syntax (buffer syntax) + syntax)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 28 Nov '06

28 Nov '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv21217 Modified Files: kill-ring.lisp Log Message: Oops. This should obviously be `setf' and not `set'. --- /project/mcclim/cvsroot/mcclim/Drei/kill-ring.lisp 2006/11/19 11:39:45 1.2 +++ /project/mcclim/cvsroot/mcclim/Drei/kill-ring.lisp 2006/11/28 23:34:10 1.3 @@ -118,8 +118,8 @@ (unless (typep size 'integer) (error "Error, ~S, is not an integer value" size)) (if (< size 5) - (set (slot-value kr 'max-size) 5) - (setf (slot-value kr 'max-size) size)) + (setf (slot-value kr 'max-size) 5) + (setf (slot-value kr 'max-size) size)) (let ((len (kill-ring-length kr))) (if (> len size) (loop for n from 1 to (- len size)

1 0

[mcclim-cvs] CVS mcclim/Drei
by rstrandh 27 Nov '06

27 Nov '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv21171/Drei Modified Files: lisp-syntax.lisp Log Message: Make Drei handle package names given as options at the beginning of the buffer. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2006/11/22 13:50:44 1.6 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2006/11/27 12:28:01 1.7 @@ -1376,7 +1376,7 @@ (let ((osp (option-specified-package syntax))) (typecase osp (package osp) - (string osp))) + (string (find-package osp)))) (find-package (option-specified-package syntax)) (find-package :clim-user)))))

1 0

[mcclim-cvs] CVS mcclim/ESA
by rstrandh 27 Nov '06

27 Nov '06

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv15811/ESA Modified Files: esa.lisp Log Message: Make the ESA example work again after recent changes. --- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2006/11/18 20:47:46 1.2 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2006/11/27 11:54:49 1.3 @@ -1559,8 +1559,8 @@ (defclass example-pane (esa-pane-mixin application-pane) ((contents :initform "hello" :accessor contents))) -(define-application-frame example (standard-application-frame - esa-frame-mixin) +(define-application-frame example (esa-frame-mixin + standard-application-frame) () (:panes (window (let* ((my-pane

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 27 Nov '06

27 Nov '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv17221 Modified Files: presentation-defs.lisp input-editing-drei.lisp Log Message: The presentation history functions are now named more sensibly. Also, a change to `accept': we add the object to the presentation history of the type that was asked for, not the type that was returned. Input history should work in the Listener now (but there are still issues for non-trivial forms, unfortunately). --- /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2006/11/22 14:53:12 1.60 +++ /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2006/11/27 07:44:46 1.61 @@ -500,6 +500,18 @@ finally (return (values nil nil)))) (defun presentation-history-next (history ptype) + (let ((first-object (goatee::backward history))) + (loop + for first-time = t then nil + for cell = first-object then (goatee::backward history) + for (object . object-ptype) = (goatee::contents cell) + while (or first-time (not (eq first-object cell))) + if (presentation-subtypep object-ptype ptype) + return (values object object-ptype) + end + finally (return (values nil nil))))) + +(defun presentation-history-previous (history ptype) (let ((first-object (goatee::forward history))) (loop for first-time = t then nil @@ -511,18 +523,6 @@ end finally (return (values nil nil))))) -(defun presentation-history-previous (history ptype) - (let ((first-object (goatee::backward history))) - (loop - for first-time = t then nil - for cell = first-object then (goatee::backward history) - for (object . object-ptype) = (goatee::contents cell) - while (or first-time (not (eq first-object cell))) - if (presentation-subtypep object-ptype ptype) - return (values object object-ptype) - end - finally (return (values nil nil))))) - (defmacro with-object-on-history ((history object ptype) &body body) `(goatee::with-object-on-ring ((cons ,object ,ptype) ,history) ,@body)) @@ -723,7 +723,7 @@ (let* ((default-from-history (and (not defaultp) provide-default)) (history (get-history)) (results - (multiple-value-list + (multiple-value-list (if history (let ((*active-history-type* real-history-type)) (cond (defaultp @@ -746,7 +746,7 @@ (when results-history (presentation-history-add results-history (car results) - (cadr results))) + real-type)) (values-list results))))))) (defmethod stream-accept ((stream standard-extended-input-stream) type --- /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2006/11/20 09:00:56 1.2 +++ /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2006/11/27 07:44:46 1.3 @@ -199,16 +199,8 @@ ;;; rely on internal features and implement input-editor support in ;;; CLIM-INTERNALS (Goatee does the same trick). -(defun history-yank (stream input-buffer gesture numeric-argument) - (let* ((accepting-type *active-history-type*) - (history (and accepting-type - (presentation-type-history accepting-type)))) - (when history - (multiple-value-bind (object type) - (presentation-history-head history accepting-type) - (presentation-replace-input stream object type (stream-default-view stream)))))) - (defun history-yank-next (stream input-buffer gesture numeric-argument) + (declare (ignore input-buffer gesture numeric-argument)) (let* ((accepting-type *active-history-type*) (history (and accepting-type (presentation-type-history accepting-type)))) @@ -219,6 +211,7 @@ (presentation-replace-input stream object type (stream-default-view stream))))))) (defun history-yank-previous (stream input-buffer gesture numeric-argument) + (declare (ignore input-buffer gesture numeric-argument)) (let* ((accepting-type *active-history-type*) (history (and accepting-type (presentation-type-history accepting-type)))) @@ -228,8 +221,6 @@ (when type (presentation-replace-input stream object type (stream-default-view stream))))))) -(add-input-editor-command '((#\y :control :meta)) 'history-yank) - -(add-input-editor-command '((#\p :meta)) 'history-yank-next) +(add-input-editor-command '((#\n :meta)) 'history-yank-next) -(add-input-editor-command '((#\n :meta)) 'history-yank-previous) +(add-input-editor-command '((#\p :meta)) 'history-yank-previous)

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 26 Nov '06

26 Nov '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv3899 Modified Files: ffi.lisp gadgets.lisp Log Message: Implement DE-/ACTIVATE-GADGET natively. * ffi.lisp: Regenerated. * gagets.lisp ((realize-native-widget :around) (activate-gadget :after native-widget-mixin) (deactivate-gadget :after native-widget-mixin)): De/activate the widget. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/ffi.lisp 2006/11/25 21:11:33 1.6 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/ffi.lisp 2006/11/26 17:54:08 1.7 @@ -1293,6 +1293,12 @@ (events :int) ;gint ) +(defcfun "gtk_widget_set_sensitive" + :void + (widget :pointer) ;GtkWidget * + (sensitive :int) ;gboolean + ) + (defcfun "gtk_widget_set_size_request" :void (widget :pointer) ;GtkWidget * --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp 2006/11/25 21:11:33 1.13 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp 2006/11/26 17:54:08 1.14 @@ -585,6 +585,21 @@ (gtk_toggle_button_set_active (mirror-widget mirror) (if value 1 0)))))) +(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)) + widget)) + +(defmethod activate-gadget :after ((gadget native-widget-mixin)) + (with-gtk () + (when (native-widget gadget) + (gtk_widget_set_sensitive (native-widget gadget) 1)))) + +(defmethod deactivate-gadget :after ((gadget native-widget-mixin)) + (with-gtk () + (when (native-widget gadget) + (gtk_widget_set_sensitive (native-widget gadget) 0)))) + ;;; Scroll bars.

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