;; Cocoa Menus
;; (c) 2004 Brendan Burns (brendanburns@comcast.net)
;; Adds support for adding menus to cocoa applications

(in-package :ccl)
(require 'cocoa)

;; make-menu-item
;; Create an NSMenuItem
;; @title The title of the item
;; @action The action (method) to execute when the item is selected
;; @target The target object on which to execute the method
;; @equiv The key equivalent (short-cut) for this item
;;
(defun make-menu-item (title action target &key (equiv ""))
  (let ((item (make-instance 'ns:ns-menu-item
		      :with-title (%make-nsstring title)
		      :action action
		      :key-equivalent (%make-nsstring equiv))))	
	(send item :set-target target)
	item))

;; make-menu
;; Create an NSMenu from a list of NSMenuItems
;; @items The list of items
;;
(defun make-menu (items)
  (let ((menu (make-objc-instance 'ns-menu)))
    (loop for item in items
	  do (send menu :add-item item))
    menu))

;; add-menu
;; Add a menu with a title to an existing menu
;; @parent The menu to add to
;; @menu The menu to add
;; @title The title of the menu to add
;;
(defun add-menu (parent menu title)
  (let ((item (send parent :item-with-title title)))
    (send parent :set-submenu menu :for-item item)
    (send parent :item-changed item)))

;; add-application-menu
;; Add a toplevel (Application) menu
;; @menu The menu to add
;; @title The name of the menu
;;
(defun add-application-menu (menu title)
  (let ((parent (send *NSApp* 'main-menu))
	(ns-title (%make-nsstring title)))
    (send parent :add-item-with-title ns-title :action (%null-ptr)
	  :key-equivalent #@"")
    (add-menu parent menu ns-title)))

;; insert-application-menu
;; Insert a top level menu at a particular index
;; @menu The menu to add
;; @title The title for the menu
;; @ix The index at which to add the menu
;;
(defun insert-application-menu (menu title ix)
  (let ((parent (send *NSApp* 'main-menu))
        (ns-title (%make-nsstring title)))
     (send parent :insert-item-with-title ns-title :action (%null-ptr)
                  :key-equivalent #@"" :at-index ix)
     (add-menu parent menu ns-title)))	

;; insert-item-at-index
;; Insert an item in a top level menu
;; @menu-name The name of the menu to add the item to
;; @item The item to add
;; @index The index at which to add the item
;;
(defun insert-item-at-index (menu-name item index)
  (let* ((main-menu (send *NSApp* 'main-menu))
	 (main-item 
		(send main-menu :item-with-title (%make-nsstring menu-name)))
	 (menu (send main-item 'submenu)))
    (send item :set-enabled T)
    (send menu :insert-item item :at-index index)))

;; remove-item-at-index
;; Remove an item from a top level menu
;; @menu-name The name of the menu to remove from (e.g. "File")
;; @index The index of the item to remove
;;
(defun remove-item-at-index (menu-name index)
   (let* ((main-menu (send *NSApp* 'main-menu))
	  (main-item (send main-menu 
			:item-with-title (%make-nsstring menu-name)))
	  (menu (send main-item 'submenu)))
    	(send menu :remove-item-at-index index)))

;; def-menu-select-method
;; Define a method for execution when an item is selected
;; @name The name of the method
;; @class The name of the handler class
;; @def The definition of the method
;;
(defmacro def-menu-select-method (name class &rest def)
	`(define-objc-method ((:void ,name) ,class) ,@def))	

;; def-handler-class
;; Define a handler class to serve as the target of a menu item.
;; @name The name of the class
;; @slots Any extra slots for the class
;;
(defmacro def-handler-class (name slots)
  `(defclass ,name (ns:ns-object) ,slots (:metaclass ns:+ns-object)))

#|
Sample Code...

Executing this will add a new menu named "Test" with three items
and a menu item named "Load" to the File menu.

(def-handler-class my-handler ())

(def-menu-select-method first my-handler
  (#_NSRunInformationalAlertPanel #@"Selection"
				  #@"First item selected"
				  #@"Ok"
				  (%null-ptr)
				  (%null-ptr)))

(def-menu-select-method second my-handler
  (#_NSRunInformationalAlertPanel #@"Selection"
				  #@"Second item selected"
				  #@"Ok"
				  (%null-ptr)
				  (%null-ptr)))

(def-menu-select-method third my-handler
  (#_NSRunInformationalAlertPanel #@"Selection"
				  #@"Third item selected"
				  #@"Ok"
				  (%null-ptr)
				  (%null-ptr)))

(def-menu-select-method load my-handler
  (loop for file in (open-dialog "lisp")
	do (load file)))

(setf *handler* (make-instance 'my-handler))

(add-application-menu 
 (make-menu 
	(list 	(make-menu-item "First Item" (@selector "first") *handler*)
		(make-menu-item "Second Item" (@selector "second") *handler*)
		(make-menu-item "Third Item" (@selector "third") *handler*)))
 "Test")

(insert-item-at-index 
 "File" (make-menu-item  "Load" (@selector "load") *handler* :equiv "l") 4)
|#