[rdnzl-devel] Menus Experiment
Matthew O Connor
matthew.oconnor at calyptech.com
Thu Mar 27 09:39:42 UTC 2008
Hi all,
This time I have a little menus experiment. Again all you should have to do is change the path to RDNZL itself.
Have fun!
Regards,
Matthew
;; ========================================================================
;; Menus Experiment.
;;
;; Matthew O'Connor
;;
;; In this experiment I create some menus. I link the menus back to
;; callbacks when they are pressed and even control the state of the 'Save'
;; menu item by pressing the 'Save' or 'Save As' menu items.
;;
;; As usual there is no warranty. Use at your own peril. I am relatively
;; new to Lisp so you are warned.
;; NOTE: You need to modify this to point to the location of RDNZL on your system.
(load "../RDNZL/rdnzl-0.12.0/load.lisp")
(rdnzl:enable-rdnzl-syntax)
(rdnzl:import-types "System.Windows.Forms"
"Application" "Form" "MenuStrip" "ToolStripMenuItem"
"ToolStripSeparator" "MessageBox" "MessageBoxButtons"
"MessageBoxIcon")
(rdnzl:use-namespace "System.Windows.Forms")
;; Display a message in a message box.
(defun message(text &optional (caption "Message"))
[MessageBox.Show text caption
;; we want the message box to have just the "OK" button
[$MessageBoxButtons.OK]
;; We want an exclamation mark as the icon.
[$MessageBoxIcon.Information]]
nil)
;; Create a menu item and add it to the supplied menu strip.
(defun create-menu (menu-strip-item x)
(let ((menu (rdnzl:new "ToolStripMenuItem" (second x))))
;; Bind the menu to the sybmol.
(setf (symbol-value (first x)) menu)
;; Add the callback if one is supplied.
(if (cddr x)
[+Click menu (rdnzl:new "System.EventHandler" (car (cddr x)))])
(if (cdddr x)
(setf [%Image menu] (rdnzl:property "Resources" (car (cdddr x)))))
;; Add the menu item to the parent.
[Add [%DropDownItems menu-strip-item] menu]))
;; Create a menu splitter and add it to the supplied menu strip.
(defun create-splitter (menu-strip-item)
[Add [%DropDownItems menu-strip-item] (rdnzl:new "ToolStripSeparator")])
;; Add either a menu item or a splitter to the supplied menu strip.
(defun add-menus (menu-strip-item menus)
(mapcar #'(lambda (x) (if (= (length x) 1)
(create-splitter menu-strip-item)
(create-menu menu-strip-item x)))
menus))
;; Build the menus.
(defun build-menus (menu-strip menus)
(mapcar #'(lambda (x) (let ((menu (rdnzl:new "ToolStripMenuItem" (second x))))
;; Bind the menu to the symbol
(setf (symbol-value (first x)) menu)
;; Take care of the children.
(add-menus menu (third x))
;; Add the menu to the MenuStrip.
[Add [%Items menu-strip] menu])) menus))
;; Callbacks.
(defun file-new-clicked (object event)
(message "file-new-clicked!!"))
(defun file-open-clicked (object event)
(message "file-open-clicked!!"))
;; Disable the Save menu item.
(defun file-save-clicked (object event)
(message "Disabling Save!")
(setf [%Enabled menu-file-save] nil))
;; Enable the Save menu item.
(defun file-save-as-clicked (object event)
(message "Enabling Save!")
(setf [%Enabled menu-file-save] t))
;; Exit the application
(defun file-exit-clicked (object event)
[Application.Exit])
(defun edit-undo-clicked (object event)
(message "edit-undo-clicked!!"))
(defun edit-redo-clicked (object event)
(message "edit-redo-clicked!!"))
;; Create my experimental menu system.
(defun create-menus (menu-strip)
(setf menus '((menu-file "File"
((menu-file-new "New" file-new-clicked)
(menu-file-open "Open" file-open-clicked)
(menu-file-save "Save" file-save-clicked)
(menu-file-save-as "Save As" file-save-as-clicked)
(menu-file-splitter)
(menu-file-exit "Exit" file-exit-clicked)))
(menu-edit "Edit"
((menu-edit-undo "Undo" edit-undo-clicked)
(menu-edit-redo "Redo" edit-redo-clicked)))
(menu-help "Help")))
(build-menus menu-strip menus))
(defun run-menus-experiment ()
(let ((menu-strip (rdnzl:new "MenuStrip"))
(form (rdnzl:new "Form")))
(setf [%Text form] "Menus Experiment")
[Add [%Controls form] menu-strip]
(create-menus menu-strip)
[Application.Run form]))
(run-menus-experiment)
(rdnzl:disable-rdnzl-syntax)
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/rdnzl-devel/attachments/20080327/8387231f/attachment.html>
More information about the rdnzl-devel
mailing list