;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-;; $Id: gdk.lisp,v 1.26 2006/04/25 13:37:28 espen Exp $
+;; $Id: gdk.lisp,v 1.27 2006/04/25 20:19:32 espen Exp $
(in-package "GDK")
;;; Cursor
-(defmethod allocate-foreign ((cursor cursor) &key type mask fg bg
+(defmethod allocate-foreign ((cursor cursor) &key source mask fg bg
(x 0) (y 0) (display (display-get-default)))
- (etypecase type
- (keyword (%cursor-new-for-display display type))
- (pixbuf (%cursor-new-from-pixbuf display type x y))
- (pixmap (%cursor-new-from-pixmap type mask fg bg x y))))
-
+ (etypecase source
+ (keyword (%cursor-new-for-display display source))
+ (pixbuf (%cursor-new-from-pixbuf display source x y))
+ (pixmap (%cursor-new-from-pixmap source mask
+ (or fg (ensure-color #(0.0 0.0 0.0)))
+ (or bg (ensure-color #(1.0 1.0 1.0))) x y))
+ (pathname (%cursor-new-from-pixbuf display (pixbuf-load source) x y))))
+
+(defun ensure-cursor (cursor &rest args)
+ (if (typep cursor 'cursor)
+ cursor
+ (apply #'make-instance 'cursor :type cursor args)))
(defbinding %cursor-new-for-display () pointer
(display display)
;; 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.21 2006/04/10 18:42:08 espen Exp $
+;; $Id: gtkwidget.lisp,v 1.22 2006/04/25 20:19:32 espen Exp $
(in-package "GTK")
(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))