[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!



;; ========================================================================
;; 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:import-types "System.Windows.Forms"
                    "Application" "Form" "MenuStrip" "ToolStripMenuItem" 
                    "ToolStripSeparator" "MessageBox" "MessageBoxButtons"
(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
    ;; We want an exclamation mark as the icon.

;; 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)))

;; 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) 

(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-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]))



-------------- 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