source: trunk/source/contrib/krueger/InterfaceProjects/Menu/menu-utils.lisp @ 13390

Last change on this file since 13390 was 13390, checked in by plkrueger, 10 years ago

New contrib from Paul Krueger

File size: 7.2 KB
Line 
1;; menu-uitls.lisp
2
3#|
4The MIT license.
5
6Copyright (c) 2010 Paul L. Krueger
7
8Permission is hereby granted, free of charge, to any person obtaining a copy of this software
9and associated documentation files (the "Software"), to deal in the Software without restriction,
10including without limitation the rights to use, copy, modify, merge, publish, distribute,
11sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is
12furnished to do so, subject to the following conditions:
13
14The above copyright notice and this permission notice shall be included in all copies or substantial
15portions of the Software.
16
17THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT
18LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
19IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
20WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
21SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
22
23|#
24
25(require :selector-utils)
26
27(defpackage :interface-utilities
28  (:nicknames :iu)
29  (:export make-and-install-menu make-and-install-menuitems-after 
30           test-menu test2-menu))
31
32(in-package :iu)
33
34;; Utility functions that allow lisp programs to add menus to the existing menubar
35
36#|
37(defun make-menu-item (title-str action-str &key (key-equiv ""))
38  (let* ((ns-title (ccl::%make-nsstring name-str))
39         (action-selector (get-selector action-str))
40         (ns-key (ccl::%make-nsstring key-equiv))
41         (mi (#/initWithTitle:action:keyEquivalent:
42              (#/alloc ns:ns-menu-item)
43              ns-title
44              action-selector
45              ns-key)))
46    (#/autorelease ns-title)
47    (#/autorelease ns-key)
48    (#/autorelease mi)
49    mi))
50
51|#
52
53;; For the following function menu-item-specs should be a list where each
54;; element of the list is itself a list of the form:
55;;  (menu-item-name menu-item-action menu-item-key-equivalent menu-item-target)
56;; where each of these except the menu-item-target must be acceptable as an
57;; argument to the function "string". Menu-item-target must be an Ojbective-C object,
58;; but can be nil to signify no target (the default)
59;; Used "menumadness" sample code from Apple Developer website to know what to do ...
60;;    NSMenu *newMenu;
61;;    NSMenuItem *newItem;
62;;
63;;    // Add the submenu
64;;    newItem = [[NSMenuItem allocWithZone:[NSMenu menuZone]] initWithTitle:@"Flashy" action:NULL keyEquivalent:@""];
65;;    newMenu = [[NSMenu allocWithZone:[NSMenu menuZone]] initWithTitle:@"Flashy"];
66;;    [newItem setSubmenu:newMenu];
67;;    [newMenu release];
68;;    [[NSApp mainMenu] addItem:newItem];
69;;    [newItem release];
70;;  Basically you need to create both a menuitem and a menu for any menu displayed in the menubar
71;;  and link them together. Then add the menuitem to the main menu (i.e. menubar)
72
73(defun make-and-install-menu (menu-name &rest menu-item-specs)
74  (let* ((ns-menu-name (ccl::%make-nsstring menu-name))
75         (menuitem (#/initWithTitle:action:keyEquivalent: 
76                    (#/allocWithZone: ns:ns-menu-item 
77                                      (#/menuZone ns:ns-menu))
78                    ns-menu-name
79                    (%null-ptr)
80                    #@""))
81         (menu (#/initWithTitle: (#/allocWithZone: 
82                                  ns:ns-menu (#/menuZone ns:ns-menu))
83                                 ns-menu-name))
84         (main-menu (#/mainMenu #&NSApp)))
85    (dolist (mi menu-item-specs)
86      (destructuring-bind (mi-title mi-selector &optional (mi-key "") mi-target) mi
87        (let* ((ns-title (ccl::%make-nsstring (string mi-title)))
88               (action-selector (get-selector (string mi-selector)))
89               (ns-key (ccl::%make-nsstring (string mi-key)))
90               (men-item (#/addItemWithTitle:action:keyEquivalent: menu 
91                                                                   ns-title 
92                                                                   action-selector
93                                                                   ns-key)))
94          (when mi-target
95            (#/setTarget: men-item mi-target))
96          (#/release ns-title)
97          (#/release ns-key))))
98    ;; Link up the new menuitem and new menu
99    (#/setSubmenu: menuitem menu)
100    (#/release menu)
101    ;; Now tell the main menu to make this a sub-menu
102    (#/addItem: main-menu menuitem)
103    (#/release ns-menu-name)
104    (#/release menuitem)
105    menu))
106
107;; The following function inserts one or more new menu-items immediately
108;; following a specified menu-item.
109;; If the menu-item-name is "" the insertion will be after the first divider
110;; (which has a blank name). If the menu-item-name does not exist in the menu,
111;;  the items will be placed at the beginning of the menu.
112;; menu-item-specs are as defined above for the make-and-install-menu function.
113;; menu-name and menu-item-name arguments must be acceptable as argument to the
114;; "string" function.
115(defun make-and-install-menuitems-after (menu-name menu-item-name &rest menu-item-specs)
116  (let* ((ns-menu-name (ccl::%make-nsstring menu-name))
117         (main-menu (#/mainMenu #&NSApp))
118         (menuitem (or (#/itemWithTitle: main-menu ns-menu-name) 
119                       (error "~s is not a valid menu title" menu-name)))
120         (sub-menu (#/submenu menuitem))
121         (ns-menu-item-name (ccl::%make-nsstring menu-item-name))
122         (insert-index (#/indexOfItemWithTitle: sub-menu ns-menu-item-name)))
123    (dolist (mi menu-item-specs)
124      (destructuring-bind (mi-title mi-selector &optional (mi-key "") mi-target) mi
125        (let* ((ns-title (ccl::%make-nsstring (string mi-title)))
126               (action-selector (get-selector (string mi-selector)))
127               (ns-key (ccl::%make-nsstring (string mi-key)))
128               (men-item (#/insertItemWithTitle:action:keyEquivalent:atIndex: 
129                          sub-menu 
130                          ns-title 
131                          action-selector
132                          ns-key
133                          (incf insert-index))))
134          (when mi-target
135            (#/setTarget: men-item mi-target))
136          (#/release ns-title)
137          (#/release ns-key))))
138    (#/release ns-menu-item-name)
139    (#/release ns-menu-name)))
140
141(defun menu-item-action-selector (menu-name menu-item-name)
142  (let* ((ns-menu-name (ccl::%make-nsstring menu-name))
143         (main-menu (#/mainMenu #&NSApp))
144         (menuitem (or (#/itemWithTitle: main-menu ns-menu-name) 
145                       (error "~s is not a valid menu title" menu-name)))
146         (sub-menu (#/submenu menuitem))
147         (ns-menu-item-name (ccl::%make-nsstring menu-item-name))
148         (target-mi (#/itemWithTitle: sub-menu ns-menu-item-name)))
149    (#/release ns-menu-item-name)
150    (#/release ns-menu-name)
151    (#/action target-mi)))
152
153
154(defun test-menu ()
155  (make-and-install-menu "New App Menu" 
156                         '("Menu Item1" "doFirstThing")
157                         '("Menu Item2" "doSecondThing")))
158
159(defun test2-menu ()
160  (make-and-install-menuitems-after "File" "New"
161                                    '("New myDoc" "newMyDoc")))
162                                         
163
164(provide :menu-utils)
Note: See TracBrowser for help on using the repository browser.