;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-;; $Id: gtkwidget.lisp,v 1.18 2005-04-23 16:48:52 espen Exp $
+;; $Id: gtkwidget.lisp,v 1.22 2006-04-25 20:19:32 espen Exp $
(in-package "GTK")
+#-debug-ref-counting
+(defmethod print-object ((widget widget) stream)
+ (if (and
+ (proxy-valid-p widget)
+ (slot-boundp widget 'name) (not (zerop (length (widget-name widget)))))
+ (print-unreadable-object (widget stream :type t :identity nil)
+ (format stream "~S at 0x~X"
+ (widget-name widget) (sap-int (foreign-location widget))))
+ (call-next-method)))
+
(defmethod shared-initialize ((widget widget) names &key (visible nil visible-p))
(when (and visible-p (not visible)) ; widget explicit set as not visible
(setf (user-data widget 'hidden-p) t)
:parent parent :child object))))
((call-next-method))))
-(defmethod slot-boundp-using-class ((class gobject-class) (object widget) slot)
- (or
- (and
- (eq (slot-definition-name slot) 'child-properties)
- (slot-boundp object 'parent))
- (call-next-method)))
(defmethod compute-signal-function ((widget widget) signal function object)
(if (eq object :parent)
(defbinding widget-add-accelerator
(widget signal accel-group key modifiers flags) nil
(widget widget)
- ((name-to-string signal) string)
+ ((signal-name-to-string signal) string)
(accel-group accel-group)
((gdk:keyval-from-name key) unsigned-int)
(modifiers gdk:modifier-type)
(state state-type)
(color gdk:color))
-(defbinding widget-modify-font () nil
+(defbinding widget-modify-font (widget font-desc) nil
(widget widget)
- (state state-type)
- (font-desc pango:font-description))
+ ((etypecase font-desc
+ (pango:font-description font-desc)
+ (string (pango:font-description-from-string font-desc)))
+ pango:font-description))
(defbinding widget-create-pango-context () pango:context
(widget widget))
(event gdk:event))
(defun (setf widget-cursor) (cursor-type widget)
- (let ((cursor (make-instance 'gdk:cursor :type cursor-type)))
- (gdk:window-set-cursor (widget-window widget) cursor)))
+ (warn "(SETF WIDGET-CURSOR) is deprecated, use WIDGET-SET-CURSOR instead")
+ (widget-set-cursor widget cursor-type))
+
+(defun widget-set-cursor (widget cursor &rest args)
+ (gdk:window-set-cursor (widget-window widget)
+ (apply #'gdk:ensure-cursor cursor args)))
(defbinding %widget-get-parent-window () gdk:window
(widget widget))