diff --git a/.gitignore b/.gitignore index 42a51e01b3a370ace611e5701f04e711181b6206..9d478680f3edfad29ab216a08b20df6b89a14413 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,10 @@ .git-branch-name +*.tmp +*.a +*.o +*.fasl +*.so +stub-*.c +Clim-sizes.n +build.out +concat.out diff --git a/ChangeLog.n b/ChangeLog.n index 42bb26745894f26a8ccabd8716d226aa4eb06e7e..c2d830fdcdd5d8005eafb6fb299942c7972af536 100644 --- a/ChangeLog.n +++ b/ChangeLog.n @@ -1,3 +1,57 @@ +******************************************************************************* +join from trunk_afuchs4 to trunk + changes from: + 2009-03-17 Andreas Fuchs <afuchs@franz.com> + to + 2008-09-23 Andreas Fuchs <afuchs@franz.com> + +******************************************************************************* +2009-03-17 Andreas Fuchs <afuchs@franz.com> + + * silica/medium.lisp: Define condition unsupported-ink: signaled when a medium + doesn't support an ink. + * postscript/postscript-medium.lisp: Check for stippled ink and signal + unsupported-ink if found (spr34881). + +2009-03-17 Andreas Fuchs <afuchs@franz.com> + + * tk-silica/xm-gadgets.lisp: Don't turn on scroll bars on text editor fields + if word-wrap is enabled explicitly. (spr34758) + +2009-02-18 Andreas Fuchs <afuchs@franz.com> + + * tk-silica/xt-gadgets.lisp: Ignore pointer button press/release events that have no + button set. These are generated for mouse wheel scroll events, particularly + horizontal scroll events. (spr35616) + * silica/event.lisp: Ditto. (spr35616) + +2009-02-18 Andreas Fuchs <afuchs@franz.com> + + * tk/xt-funs.lisp: New function tk_unmap_widget + * tk/widget.lisp: New function tk-unmap-widget: use it. + * tk-silica/xm-gadgets.lisp: Make sure option menus never have more than 31 items, + as that causes the menu to be occluded by screen boundaries on both ends + (spr35478). + +2009-01-30 Andreas Fuchs <afuchs@franz.com> + + * aclpc/acl-widget.lisp: Use unsigned-nat from the right package when + querying text field cursors (spr34360) + * silica/db-border.lisp: Support :left and :right aligned labels, to emulate + option Motif's pane labels on windows (spr34997) + +2008-10-21 Andreas Fuchs <afuchs@franz.com> + + * tk-silica/xm-gadgets.lisp: In multi-select list panes, don't scroll + to the first selected item anymore. (spr35194) + +2008-09-23 Andreas Fuchs <afuchs@franz.com> + + * tk/xm-widgets.lisp: Remove spurious (force-output *debug-io*) statement + (spr35062). + * tk/gcontext.lisp: Don't break on 64bit Unixes when changing frame layouts + if pixmaps are involved. (spr35034) + 2008-07-31 <layer@HOBART> * aclpc/acl-frames.lisp (initialize-tooltips): bug18026: use @@ -6342,4 +6396,4 @@ IGNORE JDI SPECIFIC CHANGES TO Makefile Lots of other stuff ******************************************************************************* -$Revision: 2.44 $ +$Revision: 2.45 $ diff --git a/aclpc/acl-widget.lisp b/aclpc/acl-widget.lisp index bdcf3ab74af1e278844cb26090c9c92b75dd7f96..b6dc2fd26059d62bac198ada9784632a48fafab0 100644 --- a/aclpc/acl-widget.lisp +++ b/aclpc/acl-widget.lisp @@ -17,7 +17,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: acl-widget.lisp,v 2.17 2008/07/22 16:29:54 layer Exp $ +;; $Id: acl-widget.lisp,v 2.18 2009/03/25 22:49:36 layer Exp $ #|**************************************************************************** * * @@ -479,20 +479,19 @@ (declare (values startpos endpos)) (let ((mirror (sheet-direct-mirror pane))) (cond (mirror - (let ((startptr - (make-array 1 :element-type 'unsigned-nat - :initial-element 0)) - (endptr (make-array 1 :element-type 'unsigned-nat - :initial-element 0))) - (acl-clim::frame-send-message (pane-frame pane) - mirror - win:EM_GETSEL - startptr endptr) - (values (aref startptr 0) - (aref endptr 0))) - ) - (t - (values 0 0))))) + (let ((startptr + (make-array 1 :element-type 'acl-clim::unsigned-nat + :initial-element 0)) + (endptr (make-array 1 :element-type 'acl-clim::unsigned-nat + :initial-element 0))) + (acl-clim::frame-send-message (pane-frame pane) + mirror + win:EM_GETSEL + startptr endptr) + (values (aref startptr 0) + (aref endptr 0)))) + (t + (values 0 0))))) ;;; Set the postion of the caret in the mswin-text-edit gadget. ;;; NOTE: This uses set-selection, which in turn uses the @@ -561,24 +560,24 @@ (let ((mirror (sheet-direct-mirror pane))) (when mirror (let* ((wl (acl-clim::frame-send-message (pane-frame pane) - mirror - win:WM_GETTEXTLENGTH - 0 0)) - (teb (make-array wl :element-type '(unsigned-byte 8))) - (tlen (win:GetWindowText mirror teb (1+ wl))) - (startptr (make-array 1 :element-type 'unsigned-nat - :initial-element 0)) - (endptr (make-array 1 :element-type 'unsigned-nat - :initial-element 0))) - (declare (ignorable tlen)) - (acl-clim::frame-send-message (pane-frame pane) - mirror - win:EM_GETSEL - startptr endptr) - (unxlat-newline-return - (excl:mb-to-string teb - :start (aref startptr 0) - :end (aref endptr 0))))))) + mirror + win:WM_GETTEXTLENGTH + 0 0)) + (teb (make-array wl :element-type '(unsigned-byte 8))) + (tlen (win:GetWindowText mirror teb (1+ wl))) + (startptr (make-array 1 :element-type 'acl-clim::unsigned-nat + :initial-element 0)) + (endptr (make-array 1 :element-type 'acl-clim::unsigned-nat + :initial-element 0))) + (declare (ignorable tlen)) + (acl-clim::frame-send-message (pane-frame pane) + mirror + win:EM_GETSEL + startptr endptr) + (unxlat-newline-return + (excl:mb-to-string teb + :start (aref startptr 0) + :end (aref endptr 0))))))) (defmethod text-edit-flags ((sheet mswin-text-edit)) (logior diff --git a/postscript/postscript-medium.lisp b/postscript/postscript-medium.lisp index 8fc65ec92f7216e3adfcd68c1647ae25405eb4e6..1ae313298049b3fb99178603f86754ef9263ffde 100644 --- a/postscript/postscript-medium.lisp +++ b/postscript/postscript-medium.lisp @@ -1,9 +1,25 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: POSTSCRIPT-CLIM; Base: 10; Lowercase: Yes -*- -;; $Id: postscript-medium.lisp,v 2.6 2008/07/22 16:29:54 layer Exp $ +;; $Id: postscript-medium.lisp,v 2.7 2009/03/25 22:49:36 layer Exp $ (in-package :postscript-clim) +(defmethod medium-ink :around ((medium postscript-medium)) + "Typecheck medium ink for compatibility and implementedness." + (let ((ink (call-next-method))) + (typecase ink + (rectangular-tile + (if (decode-tile-as-stipple ink) + ink + (restart-case + (error 'silica::unsupported-ink :ink ink + :message "Rectangular tiles other than stipples ~ + are not supported yet") + (use-value (other-ink) + :report "Use a different ink" + other-ink)))) + (t ink)))) + "Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." (defmacro convert-to-postscript-coordinates (transform &body positions) diff --git a/postscript/postscript-port.lisp b/postscript/postscript-port.lisp index b5e51b31545e042469a41f14cb153b5c2b37327f..909c6526acf2cff13bd9b82b8aa5d790751c53ca 100644 --- a/postscript/postscript-port.lisp +++ b/postscript/postscript-port.lisp @@ -1,6 +1,12 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: POSTSCRIPT-CLIM; Base: 10; Lowercase: Yes -*- -;; $Id: postscript-port.lisp,v 2.5 2005/08/03 05:07:14 layer Exp $ +#+(version= 8 1) +(sys:defpatch "climps" 6 + "v1: Handle unsupported inks in CLIM's Postscript backend in a correctable way." + :type :clim2 + :post-loadable t) + +;; $Id: postscript-port.lisp,v 2.10 2009/04/01 14:48:18 layer Exp $ (provide :climps) diff --git a/silica/db-border.lisp b/silica/db-border.lisp index 0fc8b4621e30b165f0da72830dd1c74d96f300ad..3a5fc9db6a34d4cb8bcea351f915d960e686fc0b 100644 --- a/silica/db-border.lisp +++ b/silica/db-border.lisp @@ -17,7 +17,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: db-border.lisp,v 2.7 2007/04/17 21:45:52 layer Exp $ +;; $Id: db-border.lisp,v 2.8 2009/03/25 22:49:36 layer Exp $ ;;;"Copyright (c) 1989, 1990 by Xerox Corporation. All rights reserved. ;;; Portions copyright (c) 1991, 1992 by Symbolics, Inc. All rights reserved." @@ -122,6 +122,9 @@ (defparameter *default-label-text-style* (make-text-style :sans-serif :italic :small)) +(defparameter *default-horizontal-label-text-style* + (make-text-style :sans-serif :roman :small)) + (defclass label-pane (sheet-with-resources-mixin labelled-gadget-mixin @@ -132,6 +135,11 @@ ;; mechanism for the Motif/OpenLook ports :text-style nil)) +(defun horizontally-aligned-p (alignment) + (ecase alignment + ((:top :bottom) nil) + ((:left :right) t))) + (defmacro labelling ((&rest options &key (label-alignment #+Genera :bottom #-Genera :top) &allow-other-keys) @@ -143,19 +151,30 @@ (setq options (remove-keywords options '(:label-alignment))) (let ((lvar '#:label) (cvar '#:contents)) - `(let ((,lvar (make-pane 'label-pane ,@options)) + `(let ((,lvar (make-pane 'label-pane ,@options + ,@(when (horizontally-aligned-p label-alignment) + (list :text-style + *default-horizontal-label-text-style*)))) (,cvar (progn ,@contents))) ,(if (constantp label-alignment #+(or Genera Minima) env) (ecase (eval label-alignment #+(or Genera Minima-Developer) env) (:bottom `(vertically () ,cvar ,lvar)) (:top - `(vertically () ,lvar ,cvar))) + `(vertically () ,lvar ,cvar)) + (:left + `(horizontally () ,lvar ,cvar)) + (:right + `(horizontally () ,cvar ,lvar))) `(ecase ,label-alignment (:bottom (vertically () ,cvar ,lvar)) (:top - (vertically () ,lvar ,cvar))))))) + (vertically () ,lvar ,cvar)) + (:left + (horizontally () ,lvar ,cvar)) + (:right + (horizontally () ,cvar ,lvar))))))) diff --git a/silica/event.lisp b/silica/event.lisp index 92b0b21a4f36d132ad79de8d04734546aed1003c..96ac5a36680c814e73b01b2c64d9fb9937636eb0 100644 --- a/silica/event.lisp +++ b/silica/event.lisp @@ -17,7 +17,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: event.lisp,v 2.7 2007/04/17 21:45:52 layer Exp $ +;; $Id: event.lisp,v 2.8 2009/03/25 22:49:36 layer Exp $ (in-package :silica) @@ -527,13 +527,16 @@ (defmethod distribute-event :before ((port basic-port) (event pointer-button-press-event)) (let ((pointer (pointer-event-pointer event))) - (setf (pointer-button-state pointer) - (logior (pointer-button-state pointer) (pointer-event-button event))))) + (when (pointer-event-button event) + (setf (pointer-button-state pointer) + (logior (pointer-button-state pointer) + (pointer-event-button event)))))) (defmethod distribute-event :before ((port basic-port) (event pointer-button-release-event)) (let ((pointer (pointer-event-pointer event))) - (setf (pointer-button-state pointer) - (logandc2 (pointer-button-state pointer) (pointer-event-button event))))) + (when (pointer-event-button event) + (setf (pointer-button-state pointer) + (logandc2 (pointer-button-state pointer) (pointer-event-button event)))))) ;;; diff --git a/silica/medium.lisp b/silica/medium.lisp index e662cc59603e8de030469c58247f05fff0fbab9f..6a8a119b71bbf537aaf080fbcaf0355a882dc087 100644 --- a/silica/medium.lisp +++ b/silica/medium.lisp @@ -17,10 +17,18 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: medium.lisp,v 2.7 2007/04/17 21:45:52 layer Exp $ +;; $Id: medium.lisp,v 2.8 2009/03/25 22:49:36 layer Exp $ (in-package :silica) +(define-condition unsupported-ink (error) + ((ink :initarg :ink :reader unsupported-ink) + (message :initarg :message :reader unsupported-ink-message)) + (:report (lambda (c s) + (format s "Ink ~A is not supported by the backend: ~A." + (unsupported-ink c) + (unsupported-ink-message c))))) + ;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. ;;; Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved." diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp index 53865c7d58157e5385b08209f38769677226c287..c68f3958a9046533a95d9237c4846d08966c8ce4 100644 --- a/tk-silica/xm-gadgets.lisp +++ b/tk-silica/xm-gadgets.lisp @@ -16,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: xm-gadgets.lisp,v 2.12 2007/12/11 17:20:21 layer Exp $ +;; $Id: xm-gadgets.lisp,v 2.13 2009/03/25 22:49:37 layer Exp $ (in-package :xm-silica) @@ -981,7 +981,8 @@ (and (typep p 'motif-scroller-pane) (scroller-pane-scroll-bar-policy p))))) (append `(:scroll-horizontal - ,(and (member scroll-mode '(t :both :horizontal :dynamic)) t)) + ,(and (not word-wrap) + (member scroll-mode '(t :both :horizontal :dynamic)) t)) `(:scroll-vertical ,(and (member scroll-mode '(t :both :vertical :dynamic)) t)) (and (not editable) '(:cursor-position-visible nil)) @@ -1511,15 +1512,14 @@ (let ((mirror (sheet-direct-mirror l))) (when mirror (multiple-value-bind (selected-items m n) - (compute-list-pane-selected-items l nv) - (let ((position (tk::get-values mirror :top-item-position))) - (with-no-value-changed-callbacks - (tk::set-values mirror - :top-item-position (if selected-items - (1+ (min n (max m (1- position)))) - position) - :selected-item-count (length selected-items) - :selected-items selected-items))))))) + (compute-list-pane-selected-items l nv) + (declare (ignore m n)) + (let ((position (tk::get-values mirror :top-item-position))) + (with-no-value-changed-callbacks + (tk::set-values mirror + :top-item-position position + :selected-item-count (length selected-items) + :selected-items selected-items))))))) ;;; Option buttons @@ -1538,40 +1538,61 @@ (update-option-menu-buttons port sheet pdm) `(:sub-menu-id ,pdm :margin-height 0))) +(defun update-option-menu-buttons-1-batch (sheet pdm initargs items) + (with-accessors ((printer silica::option-pane-printer) + (name-key set-gadget-name-key) + (value-key set-gadget-value-key)) sheet + (mapcar #'(lambda (item) + (let* ((name (funcall name-key item)) + (pixmap (unless (or (null printer) (eq printer #'write-token)) + (pixmap-from-menu-item + (sheet-parent sheet) name printer nil + :text-style (pane-text-style sheet) + :background (pane-background sheet) + :foreground (pane-foreground sheet)))) + (button + (if (null pixmap) + (apply #'make-instance 'tk::xm-push-button + :label-string name + :parent pdm + initargs) + (apply #'make-instance 'tk::xm-push-button + :label-pixmap pixmap + :label-type :pixmap + :parent pdm + initargs)))) + (tk::add-callback + button + :activate-callback + 'option-menu-callback-function + (funcall value-key item) + sheet + pdm) + button)) + items))) + +(defparameter *items-per-batch* 30) + (defun update-option-menu-buttons (port sheet pdm) - (let ((initargs (find-widget-resource-initargs-for-sheet port sheet))) - (with-accessors ((items set-gadget-items) - (printer silica::option-pane-printer) - (name-key set-gadget-name-key) - (value-key set-gadget-value-key)) sheet - (setf (motif-option-menu-buttons sheet) - (mapcar #'(lambda (item) - (let* ((name (funcall name-key item)) - (pixmap (unless (or (null printer) (eq printer #'write-token)) - (pixmap-from-menu-item - (sheet-parent sheet) name printer nil - :text-style (pane-text-style sheet) - :background (pane-background sheet) - :foreground (pane-foreground sheet)))) - (button - (if (null pixmap) - (apply #'make-instance 'tk::xm-push-button - :label-string name - :parent pdm - initargs) - (apply #'make-instance 'tk::xm-push-button - :label-pixmap pixmap - :label-type :pixmap - :parent pdm - initargs)))) - (tk::add-callback - button - :activate-callback - 'option-menu-callback-function - (funcall value-key item) - sheet) - button)) - items))))) + (let ((initargs (find-widget-resource-initargs-for-sheet port sheet)) + (items (set-gadget-items sheet))) + (setf (motif-option-menu-buttons sheet) + (loop for size = (min (length items) *items-per-batch*) + for batch = (update-option-menu-buttons-1-batch + sheet pdm initargs (subseq items 0 size)) + append batch + while (and (not (zerop size)) + (= size *items-per-batch*)) + do (setf items (subseq items size)) + when items + do (let* ((sub-pdm (make-instance 'xt::xm-pulldown-menu + :managed nil :parent pdm)) + (button (apply #'make-instance 'tk::xm-cascade-button + :label-string "More" + :sub-menu-id sub-pdm + :parent pdm + initargs))) + (setf pdm sub-pdm)))))) (defmethod (setf set-gadget-items) :after (items (gadget motif-option-pane)) (declare (ignore items)) @@ -1585,8 +1606,14 @@ (tk::set-values m :sub-menu-id pdm) (tk::destroy-widget old-pdm))))) -(defun option-menu-callback-function (widget count value sheet) +(defun option-menu-callback-function (widget count value sheet pdm) (declare (ignore count)) + (let ((shell (tk::widget-parent (tk::widget-parent pdm)))) + (loop + (unless (typep shell 'tk::xm-menu-shell) + (return)) + (tk::unmap-widget shell) + (setf shell (tk::widget-parent shell)))) (queue-value-changed-event widget sheet value)) (defmethod (setf gadget-value) :after diff --git a/tk-silica/xt-gadgets.lisp b/tk-silica/xt-gadgets.lisp index 9c09166ac036c226c70e185bea0e855dc2393a1d..bea7a52a35d3b63b2fc7aadd2ca50f31e2480f4d 100644 --- a/tk-silica/xt-gadgets.lisp +++ b/tk-silica/xt-gadgets.lisp @@ -16,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: xt-gadgets.lisp,v 2.8 2007/04/17 21:45:54 layer Exp $ +;; $Id: xt-gadgets.lisp,v 2.9 2009/03/25 22:49:37 layer Exp $ (in-package :xm-silica) @@ -274,6 +274,17 @@ (let ((sheet (frame-top-level-sheet (pane-frame menubar)))) (push gesture (slot-value sheet 'accelerator-gestures)))) +;;; Mouse wheel scroll events generate pointer-button-press/release-events +;;; with nil buttons. +;;; Ignore them for now (afuchs/spr35616): +(defmethod distribute-event ((port xt-port) (event pointer-button-press-event)) + (when (pointer-event-button event) + (call-next-method))) +(defmethod distribute-event ((port xt-port) + (event pointer-button-release-event)) + (when (pointer-event-button event) + (call-next-method))) + (defmethod distribute-event ((port xt-port) (event keyboard-event)) (unless (discard-accelerator-event-p port event) (call-next-method))) diff --git a/tk/gcontext.lisp b/tk/gcontext.lisp index a2d0c5baf29586e041c84a50f0e6d29e32bf0018..ab852449b83bd5ce89acc919fc5a6a6c2c649241 100644 --- a/tk/gcontext.lisp +++ b/tk/gcontext.lisp @@ -17,7 +17,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: gcontext.lisp,v 2.7 2007/04/17 21:45:53 layer Exp $ +;; $Id: gcontext.lisp,v 2.8 2009/03/25 22:49:36 layer Exp $ (in-package :tk) @@ -500,22 +500,22 @@ (defun decode-font (gc x) (if (= x - #+alpha #xffffffffffffffff - #-alpha #xffffffff) + #+64bit #xffffffffffffffff + #-64bit #xffffffff) (error "cannot decode font") (let* ((display (object-display gc)) - (font (find-object-from-xid x display nil))) + (font (find-object-from-xid x display nil))) (or font - (query-font display x))))) + (query-font display x))))) (defun decode-pixmap (gc x) (and (/= x - #+alpha #xffffffffffffffff - #-alpha #xffffffff) + #+64bit #xffffffffffffffff + #-64bit #xffffffff) (intern-object-xid - x - 'pixmap - (object-display gc)))) + x + 'pixmap + (object-display gc)))) (defun decode-clip-mask (gc x) (declare (ignore gc)) diff --git a/tk/widget.lisp b/tk/widget.lisp index e5c31e807f0a7560627a3e45df8e29b0c8a5202e..8bf889d23e32c8eac135ff93c784b233c2e23e88 100644 --- a/tk/widget.lisp +++ b/tk/widget.lisp @@ -16,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: widget.lisp,v 2.11 2008/02/13 17:06:46 layer Exp $ +;; $Id: widget.lisp,v 2.12 2009/03/25 22:49:36 layer Exp $ (in-package :tk) @@ -108,6 +108,9 @@ (defun unmanage-child (child) (xt_unmanage_child child)) +(defun unmap-widget (widget) + (xt_unmap_widget widget)) + (defun is-managed-p (widget) (not (zerop (xt_is_managed widget)))) diff --git a/tk/xm-widgets.lisp b/tk/xm-widgets.lisp index 3457a1e6ad05d854be84eeb519add7513a185103..e09d2cd85a794aa484709bc1117eb4d1189293fa 100644 --- a/tk/xm-widgets.lisp +++ b/tk/xm-widgets.lisp @@ -16,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: xm-widgets.lisp,v 2.11 2008/02/13 17:06:46 layer Exp $ +;; $Id: xm-widgets.lisp,v 2.12 2009/03/25 22:49:37 layer Exp $ (in-package :tk) @@ -336,7 +336,6 @@ *lookup-string-buffer-size* &keysym &status))) (declare (fixnum nbytes)) - (force-output *debug-io*) (cond ((= status x11::XBufferOverflow) (warn "Too small buffer looking up the key event at size ~A." diff --git a/tk/xt-funs.lisp b/tk/xt-funs.lisp index a819809c7aad0a7cb30fe29ae7c604824e3d71ea..e5176262e61d18fa8e2b08578844973c9d215e03 100644 --- a/tk/xt-funs.lisp +++ b/tk/xt-funs.lisp @@ -16,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: xt-funs.lisp,v 2.11 2007/12/11 17:20:21 layer Exp $ +;; $Id: xt-funs.lisp,v 2.12 2009/03/25 22:49:37 layer Exp $ ;; ;; This file contains compile time only code -- put in clim-debug.fasl. @@ -170,6 +170,12 @@ :call-direct t :arg-checking nil) +(def-foreign-call (xt_unmap_widget "XtUnmapWidget") + ((x :foreign-address)) + :returning (:int fixnum) + :call-direct t + :arg-checking nil) + (def-foreign-call (xt_manage_children "XtManageChildren") ((x :foreign-address) (y :int fixnum)) :returning :void