[Openmcl-devel] Nibs not being loaded with build-application

[mikel evins]

On Mar 6, 2014, at 4:29 PM, Michael Minerva <minerva at agentsheets.com> wrote:

> Hey Paul,
> 
> I've been looking through your contributions but haven't found anything about setting up a main menu for the app. Do you have anything about that in your contribs?

Try this, and let me know how it works. It's slightly dated; beware of possible bitrot.

(in-package :cl-user)

(defpackage testapp (:use :common-lisp :ccl))

(in-package :testapp)

;;; ---------------------------------------------------------------------
;;; menu utils
;;; ---------------------------------------------------------------------

(defun make-menu (menu-title)
  (#/autorelease (#/initWithTitle: (#/alloc (objc:@class ns:ns-menu)) menu-title)))

(defun add-menu-separator (menu)
  (#/addItem: menu (#/separatorItem ns:ns-menu-item)))

(defun add-menu-item (menu item-title 
                      &key
                      (action (%null-ptr))
                      (target (%null-ptr)) ; by default target the First Responder
                      (key-equivalent #@"")
                      (key-equivalent-modifier-mask nil)
                      (tag nil))
  (let ((item (#/addItemWithTitle:action:keyEquivalent: menu item-title action key-equivalent)))
    (when key-equivalent-modifier-mask
      (#/setKeyEquivalentModifierMask: item key-equivalent-modifier-mask))
    (when tag
      (#/setTag: item tag))
    (#/setTarget: item target)
    item))

;;; ---------------------------------------------------------------------
;;; application menu
;;; ---------------------------------------------------------------------

(defun populate-application-menu (main-menu)
  (let* ((main-item (add-menu-item main-menu #@"Apple"))
         (menu (make-menu #@"Apple")))
    (perform-selector (ccl::nsapp)
                      (objc:@selector "setAppleMenu:")
                      :with-object menu)

    (add-menu-item menu #@"About Testapp" :action (objc:@selector "orderFrontStandardAboutPanel:") :target (ccl::nsapp))
    (add-menu-separator menu)

    (add-menu-item menu #@"Preferences..." :key-equivalent #@"," :target (ccl::nsapp))
    (let ((services-menu (make-menu #@"Services"))
          (services-item (add-menu-item menu #@"Services" :target (ccl::nsapp))))
      (#/setSubmenu:forItem: menu services-menu services-item)
      (#/setServicesMenu: (ccl::nsapp) services-menu))
    (add-menu-separator menu)

    (add-menu-item menu #@"Hide Testapp" :action (objc:@selector "hide:") :target (ccl::nsapp) :key-equivalent #@"h")
    (add-menu-item menu #@"Hide Others" :action (objc:@selector "hideOtherApplications:") :target (ccl::nsapp)
                   :key-equivalent #@"h" :key-equivalent-modifier-mask (logior #$NSCommandKeyMask #$NSAlternateKeyMask))
    (add-menu-item menu #@"Show All" :action (objc:@selector "unhideAllApplications:") :target (ccl::nsapp))
    (add-menu-separator menu)

    (add-menu-item menu #@"Quit" :action (objc:@selector "terminate:") :target (ccl::nsapp) :key-equivalent #@"q")
    
    (#/setSubmenu:forItem: main-menu menu main-item)))


;;; ---------------------------------------------------------------------
;;; file menu
;;; ---------------------------------------------------------------------

(defun populate-file-menu (main-menu)
  (let* ((main-item (add-menu-item main-menu #@"File"))
         (menu (make-menu #@"File")))
    
    (add-menu-item menu #@"New" :action (objc:@selector "newDocument:") :key-equivalent #@"n")
    (add-menu-item menu #@"Open..." :action (objc:@selector "openDocument:") :key-equivalent #@"o")
    (let ((recent-menu (make-menu #@"Open Recent"))
          (recent-item (add-menu-item menu #@"Open Recent")))
      (perform-selector recent-menu
                        (objc:@selector "_setMenuName:")
                        :with-object #@"NSRecentDocumentsMenu")
      (#/setSubmenu:forItem: menu recent-menu recent-item))
    (add-menu-separator menu)

    (add-menu-item menu #@"Close" :action (objc:@selector "performClose:") :key-equivalent #@"w")
    (add-menu-item menu #@"Save" :action (objc:@selector "saveDocument:") :key-equivalent #@"s")
    (add-menu-item menu #@"Save As..." :key-equivalent #@"S")
    (add-menu-item menu #@"Revert" :action (objc:@selector "revertDocumentToSaved:"))
    (add-menu-separator menu)

    (add-menu-item menu #@"Page Setup..." :action (objc:@selector "runPageLayout:") :target (ccl::nsapp) :key-equivalent #@"P")
    (add-menu-item menu #@"Print..." :action (objc:@selector "printDocument:") :target (ccl::nsapp) :key-equivalent #@"p")

    (#/setSubmenu:forItem: main-menu menu main-item)))




(defun setup-menus ()
  (let ((main-menu (#/autorelease (#/initWithTitle: (#/alloc (objc:@class ns:ns-menu)) #@"MainMenu"))))
    (populate-application-menu main-menu)
    (populate-file-menu main-menu)
    (#/setMainMenu: (ccl::nsapp) main-menu)))

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://lists.clozure.com/pipermail/openmcl-devel/attachments/20140306/add0511c/attachment.htm>