-
-
-;;;; The follwing code will probably be removed soon
-
-(defun create-action (name &optional stock-id label accelerator tooltip
- callback &rest initargs)
- (let ((action (apply #'make-instance 'action
- :name (string name) :stock-id stock-id :label label
- :tooltip tooltip :accelerator accelerator initargs)))
- (when callback
- (apply #'signal-connect action 'activate (mklist callback)))
- action))
-
-(defun create-toggle-action (name &optional stock-id label accelerator
- tooltip active callback &rest initargs)
- (let ((action (apply #'make-instance 'toggle-action
- :name (string name) :stock-id stock-id :label label
- :tooltip tooltip :active active :accelerator accelerator
- initargs)))
- (when callback
- (destructuring-bind (function &key object after) (mklist callback)
- (signal-connect action 'activate
- (if object
- #'(lambda (object)
- (funcall function object (toggle-action-active-p action)))
- #'(lambda ()
- (funcall function (toggle-action-active-p action))))
- :object object :after after)
- ;(funcall callback active)
- (when active
- (action-activate action))))
- action))
-
-(defun create-radio-actions (specs &optional active callback &rest initargs)
- (loop
- with group = nil
- for spec in specs
- collect (destructuring-bind (name &optional stock-id label accelerator
- tooltip (value name))
- (mklist spec)
- (let ((action (apply #'make-instance 'radio-action
- :name (string name) :stock-id stock-id
- :label label :tooltip tooltip
- :accelerator accelerator initargs)))
- (when (equal active value)
- (setf (toggle-action-active-p action) t)
- (when callback
- (funcall callback value)))
-
- (if (not group)
- (setq group action)
- (radio-action-add-to-group action group))
- (when callback
- (signal-connect action 'activate
- #'(lambda ()
- (funcall callback value))))
- action))))