Author: junrue Date: Thu May 4 21:08:48 2006 New Revision: 118
Modified: trunk/docs/manual/api.texinfo trunk/src/packages.lisp trunk/src/uitoolkit/widgets/menu-language.lisp trunk/src/uitoolkit/widgets/menu.lisp trunk/src/uitoolkit/widgets/widget-generics.lisp Log: implemented append-separator method for programmatically adding separators to menus
Modified: trunk/docs/manual/api.texinfo ============================================================================== --- trunk/docs/manual/api.texinfo (original) +++ trunk/docs/manual/api.texinfo Thu May 4 21:08:48 2006 @@ -668,6 +668,11 @@ the newly-created item. @end deffn
+@deffn GenericFunction append-separator self +Adds a separator item to the object, and returns the newly-created +item. +@end deffn + @deffn GenericFunction append-submenu self text submenu dispatcher Adds a submenu anchored to a parent menu and returns the corresponding item. @end deffn
Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Thu May 4 21:08:48 2006 @@ -310,6 +310,7 @@ #:alignment #:ancestor-p #:append-item + #:append-separator #:append-submenu #:background-color #:background-pattern
Modified: trunk/src/uitoolkit/widgets/menu-language.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/menu-language.lisp (original) +++ trunk/src/uitoolkit/widgets/menu-language.lisp Thu May 4 21:08:48 2006 @@ -202,13 +202,8 @@ (check item checked)))
(defmethod define-separator ((gen win32-menu-generator)) - (let* ((owner (first (menu-stack-of gen))) - (it (make-instance 'menu-item)) - (hmenu (gfs:handle owner))) - (put-menuitem (thread-context) it) - (insert-separator hmenu) - (setf (slot-value it 'gfs:handle) hmenu) - (vector-push-extend it (items owner)))) + (let ((owner (first (menu-stack-of gen)))) + (append-separator owner)))
(defmethod define-submenu ((gen win32-menu-generator) label dispatcher disabled) (let* ((submenu (make-instance 'menu :handle (gfs::create-popup-menu)))
Modified: trunk/src/uitoolkit/widgets/menu.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/menu.lisp (original) +++ trunk/src/uitoolkit/widgets/menu.lisp Thu May 4 21:08:48 2006 @@ -87,7 +87,7 @@ (if (zerop (gfs::insert-menu-item hparent #x7FFFFFFF 1 mii-ptr)) (error 'gfs::win32-error :detail "insert-menu-item failed")))))
-(defun insert-separator (hmenu) +(defun insert-separator (hmenu mid) (cffi:with-foreign-object (mii-ptr 'gfs::menuiteminfo) (cffi:with-foreign-slots ((gfs::cbsize gfs::mask gfs::type gfs::state gfs::id gfs::hsubmenu @@ -96,10 +96,10 @@ gfs::hbmpitem) mii-ptr gfs::menuiteminfo) (setf gfs::cbsize (cffi:foreign-type-size 'gfs::menuiteminfo)) - (setf gfs::mask gfs::+miim-ftype+) + (setf gfs::mask (logior gfs::+miim-id+ gfs::+miim-ftype+)) (setf gfs::type gfs::+mft-separator+) (setf gfs::state 0) - (setf gfs::id 0) + (setf gfs::id mid) (setf gfs::hsubmenu (cffi:null-pointer)) (setf gfs::hbmpchecked (cffi:null-pointer)) (setf gfs::hbmpunchecked (cffi:null-pointer)) @@ -142,6 +142,19 @@ (vector-push-extend item (items owner)) item))
+(defmethod append-separator ((owner menu)) + (if (gfs:disposed-p owner) + (error 'gfs:disposed-error)) + (let* ((tc (thread-context)) + (id (increment-menuitem-id tc)) + (howner (gfs:handle owner)) + (item (make-instance 'menu-item :handle howner))) + (insert-separator howner id) + (setf (item-id item) id) + (put-menuitem tc item) + (vector-push-extend item (items owner)) + item)) + (defmethod append-submenu ((parent menu) text (submenu menu) disp) (if (or (gfs:disposed-p parent) (gfs:disposed-p submenu)) (error 'gfs:disposed-error))
Modified: trunk/src/uitoolkit/widgets/widget-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-generics.lisp Thu May 4 21:08:48 2006 @@ -48,6 +48,9 @@ (defgeneric append-item (self text image dispatcher) (:documentation "Adds the new item with the specified text to the object, and returns the newly-created item."))
+(defgeneric append-separator (self) + (:documentation "Add a separator item to the object, and returns the newly-created item.")) + (defgeneric append-submenu (self text submenu dispatcher) (:documentation "Adds a submenu anchored to a parent menu and returns the corresponding item."))