Added missing menus. Added icon and Info-plisp.

Pascal J. Bourguignon [2015-06-20 20:14]
Added missing menus. Added icon and Info-plisp.
Filename
Resources/AppIcon.icns
Resources/en.lproj/Credits.rtf
Resources/images/agplv3-155x51.png
Resources/images/hung-0.png
Resources/images/hung-1.png
Resources/images/hung-10.png
Resources/images/hung-11.png
Resources/images/hung-2.png
Resources/images/hung-3.png
Resources/images/hung-4.png
Resources/images/hung-5.png
Resources/images/hung-6.png
Resources/images/hung-7.png
Resources/images/hung-8.png
Resources/images/hung-9.png
Resources/images/icon.png
images/agplv3-155x51.png
images/hung-0.png
images/hung-1.png
images/hung-10.png
images/hung-11.png
images/hung-2.png
images/hung-3.png
images/hung-4.png
images/hung-5.png
images/hung-6.png
images/hung-7.png
images/hung-8.png
images/hung-9.png
images/icon.png
src/generate-application.lisp
src/hangman-controller.lisp
src/nsapi.lisp
src/utils.el
diff --git a/Resources/AppIcon.icns b/Resources/AppIcon.icns
new file mode 100644
index 0000000..c009bda
Binary files /dev/null and b/Resources/AppIcon.icns differ
diff --git a/Resources/en.lproj/Credits.rtf b/Resources/en.lproj/Credits.rtf
new file mode 100644
index 0000000..a68edbd
--- /dev/null
+++ b/Resources/en.lproj/Credits.rtf
@@ -0,0 +1,55 @@
+{\rtf1\ansi\ansicpg1252\cocoartf1347\cocoasubrtf570
+{\fonttbl\f0\fswiss\fcharset0 Helvetica;\f1\fmodern\fcharset0 CourierNewPSMT;}
+{\colortbl;\red255\green255\blue255;}
+\paperw11900\paperh16840\vieww9600\viewh8400\viewkind0
+\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720\pardirnatural
+
+\f0\fs24 \cf0 This application is written in Common Lisp with Clozure CL.\
+\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural
+\cf0 \
+\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720
+
+\b \cf0 Engineering:
+\b0 \
+	Pascal Bourguignon\
+\
+
+\b Human Interface Design:
+\b0 \
+	Pascal Bourguignon\
+\
+
+\b Testing:
+\b0 \
+	Pascal Bourguignon\
+\
+
+\b Documentation:
+\b0 \
+	Pascal Bourguignon\
+\
+
+\b With special thanks to:
+\b0 \
+	Clozure Associates for Clozure Common Lisp.\
+\
+
+\b License:
+\b0 \
+	This software is distributed under the \
+	GNU Affero General Public License v. 3.0\
+\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720
+
+\f1 \cf0 	http://www.gnu.org/licenses/agpl-3.0.html\
+\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720
+
+\f0 \cf0 	The sources of this software are available \
+	from:\
+\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720
+
+\f1 \cf0 git clone \\\
+http://git.informatimago.com/public/hangman-cocoa-lisp\
+\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720
+
+\f0 \cf0 	\
+}
\ No newline at end of file
diff --git a/Resources/images/agplv3-155x51.png b/Resources/images/agplv3-155x51.png
new file mode 100644
index 0000000..ff8c3b7
Binary files /dev/null and b/Resources/images/agplv3-155x51.png differ
diff --git a/Resources/images/hung-0.png b/Resources/images/hung-0.png
new file mode 100644
index 0000000..d4eacb0
Binary files /dev/null and b/Resources/images/hung-0.png differ
diff --git a/Resources/images/hung-1.png b/Resources/images/hung-1.png
new file mode 100644
index 0000000..eda3dc8
Binary files /dev/null and b/Resources/images/hung-1.png differ
diff --git a/Resources/images/hung-10.png b/Resources/images/hung-10.png
new file mode 100644
index 0000000..a33aa80
Binary files /dev/null and b/Resources/images/hung-10.png differ
diff --git a/Resources/images/hung-11.png b/Resources/images/hung-11.png
new file mode 100644
index 0000000..7af18a9
Binary files /dev/null and b/Resources/images/hung-11.png differ
diff --git a/Resources/images/hung-2.png b/Resources/images/hung-2.png
new file mode 100644
index 0000000..1690e71
Binary files /dev/null and b/Resources/images/hung-2.png differ
diff --git a/Resources/images/hung-3.png b/Resources/images/hung-3.png
new file mode 100644
index 0000000..70b3501
Binary files /dev/null and b/Resources/images/hung-3.png differ
diff --git a/Resources/images/hung-4.png b/Resources/images/hung-4.png
new file mode 100644
index 0000000..814ad5f
Binary files /dev/null and b/Resources/images/hung-4.png differ
diff --git a/Resources/images/hung-5.png b/Resources/images/hung-5.png
new file mode 100644
index 0000000..7e42e79
Binary files /dev/null and b/Resources/images/hung-5.png differ
diff --git a/Resources/images/hung-6.png b/Resources/images/hung-6.png
new file mode 100644
index 0000000..a3bf17c
Binary files /dev/null and b/Resources/images/hung-6.png differ
diff --git a/Resources/images/hung-7.png b/Resources/images/hung-7.png
new file mode 100644
index 0000000..4f4586b
Binary files /dev/null and b/Resources/images/hung-7.png differ
diff --git a/Resources/images/hung-8.png b/Resources/images/hung-8.png
new file mode 100644
index 0000000..a347ba0
Binary files /dev/null and b/Resources/images/hung-8.png differ
diff --git a/Resources/images/hung-9.png b/Resources/images/hung-9.png
new file mode 100644
index 0000000..61734a4
Binary files /dev/null and b/Resources/images/hung-9.png differ
diff --git a/Resources/images/icon.png b/Resources/images/icon.png
new file mode 100644
index 0000000..2a28c6a
Binary files /dev/null and b/Resources/images/icon.png differ
diff --git a/images/agplv3-155x51.png b/images/agplv3-155x51.png
deleted file mode 100644
index ff8c3b7..0000000
Binary files a/images/agplv3-155x51.png and /dev/null differ
diff --git a/images/hung-0.png b/images/hung-0.png
deleted file mode 100644
index d4eacb0..0000000
Binary files a/images/hung-0.png and /dev/null differ
diff --git a/images/hung-1.png b/images/hung-1.png
deleted file mode 100644
index eda3dc8..0000000
Binary files a/images/hung-1.png and /dev/null differ
diff --git a/images/hung-10.png b/images/hung-10.png
deleted file mode 100644
index a33aa80..0000000
Binary files a/images/hung-10.png and /dev/null differ
diff --git a/images/hung-11.png b/images/hung-11.png
deleted file mode 100644
index 7af18a9..0000000
Binary files a/images/hung-11.png and /dev/null differ
diff --git a/images/hung-2.png b/images/hung-2.png
deleted file mode 100644
index 1690e71..0000000
Binary files a/images/hung-2.png and /dev/null differ
diff --git a/images/hung-3.png b/images/hung-3.png
deleted file mode 100644
index 70b3501..0000000
Binary files a/images/hung-3.png and /dev/null differ
diff --git a/images/hung-4.png b/images/hung-4.png
deleted file mode 100644
index 814ad5f..0000000
Binary files a/images/hung-4.png and /dev/null differ
diff --git a/images/hung-5.png b/images/hung-5.png
deleted file mode 100644
index 7e42e79..0000000
Binary files a/images/hung-5.png and /dev/null differ
diff --git a/images/hung-6.png b/images/hung-6.png
deleted file mode 100644
index a3bf17c..0000000
Binary files a/images/hung-6.png and /dev/null differ
diff --git a/images/hung-7.png b/images/hung-7.png
deleted file mode 100644
index 4f4586b..0000000
Binary files a/images/hung-7.png and /dev/null differ
diff --git a/images/hung-8.png b/images/hung-8.png
deleted file mode 100644
index a347ba0..0000000
Binary files a/images/hung-8.png and /dev/null differ
diff --git a/images/hung-9.png b/images/hung-9.png
deleted file mode 100644
index 61734a4..0000000
Binary files a/images/hung-9.png and /dev/null differ
diff --git a/images/icon.png b/images/icon.png
deleted file mode 100644
index 2a28c6a..0000000
Binary files a/images/icon.png and /dev/null differ
diff --git a/src/generate-application.lisp b/src/generate-application.lisp
index 2ceaafe..eebbc1d 100644
--- a/src/generate-application.lisp
+++ b/src/generate-application.lisp
@@ -45,7 +45,7 @@

 (defparameter *program-name*      "Hangman")
 (defparameter *release-directory* #P"~/Desktop/")
-(defparameter *version*           "1.0.0")
+(defparameter *version*           "1.0.1")
 (defparameter *copyright*
   "Copyright 2015 Pascal Bourguignon
 License: AGPL3")
@@ -66,51 +66,81 @@ License: AGPL3")
                                              *release-directory*))


-(let ((dest-dir (merge-pathnames (make-pathname :directory (list :relative
-                                                                 (format nil "~A.app" *program-name*)
-                                                                 "Contents" "Resources" "images")
-                                                :name "test" :type "png")
-                                 *release-directory*))
-      (images   (make-pathname :directory (list :relative :up "images") :name :wild :type "png")))
-  (ensure-directories-exist dest-dir)
-  (dolist (image (directory images))
-    (let ((dest-file (make-pathname :name (pathname-name image) :type (pathname-type image)
+(defun copy-files (files dest-dir)
+  (ensure-directories-exist (make-pathname :name "test" :type "test" :defaults dest-dir))
+  (dolist (file (directory files))
+    (let ((dest-file (make-pathname :name (pathname-name file) :type (pathname-type file)
                                     :defaults dest-dir)))
       (format t "Copying ~A~%" dest-file)
-      (com.informatimago.common-lisp.cesarum.file:copy-file image dest-file
+      (com.informatimago.common-lisp.cesarum.file:copy-file file dest-file
                                                             :element-type '(unsigned-byte 8)
                                                             :if-exists :supersede))))


+(let ((resources (merge-pathnames (make-pathname :directory (list :relative
+                                                                  (format nil "~A.app" *program-name*)
+                                                                  "Contents" "Resources"))
+                                  *release-directory*)))
+
+  (copy-files (make-pathname :directory (list :relative :up "Resources" "en.lproj") :name :wild :type :wild)
+              (merge-pathnames #P"en.lproj/" resources))

-(defun save-simple-application (&key (name *program-name*) (directory *release-directory*) (creator-string "????"))
+  (copy-files (make-pathname :directory (list :relative :up "Resources" "images") :name :wild :type "png")
+              (merge-pathnames #P"images/" resources))
+
+  (copy-files (make-pathname :directory (list :relative :up "Resources") :name "AppIcon" :type "icns")
+              resources))
+
+
+
+
+(defun save-hangman-application ()
   ;; ccl::build-application
   ;;  calls ccl::save-application
   ;;  calls ccl::%save-application-interal
   ;;  calls ccl::save-image
   #+ccl
   (ccl::build-application               ; This doesn't return.
-   :name name
-   :directory directory
+   :name *program-name*
+   :directory *release-directory*
    :type-string "APPL"
-   :creator-string creator-string
+   :creator-string "SOSH"
    :copy-ide-resources nil              ; whether to copy the IDE's resources
-   :info-plist nil                      ; optional user-defined info-plist
-   :nibfiles '()
-                                        ; a list of user-specified nibfiles
+   :info-plist (com.informatimago.hangman.cocoa::dictionary
+                :|LSApplicationCategoryType| "public.app-category.word-games"
+                :|CFBundleIconFile| "AppIcon.icns"
+                :|CFBundleIdentifier| "com.informatimago.hangman.lisp"
+                :|CFBundleShortVersionString|  (format nil "~A" *version*)
+                :|CFBundleVersion| (format nil "~A ~A" "ccl" (lisp-implementation-version))
+                :|LSMinimumSystemVersion| "10.7"
+                :|CFBundleDevelopmentRegion| "English"
+                :|NSHumanReadableCopyright| (format nil "Copyright 2015 Pascal Bourguignon~%License: AGPL3")
+                ;; :|CFBundleHelpBookFolder| "Resources"
+                ;; :|CFBundleHelpBookName| "HangmanHelp"
+                ;; :|NSAppleScriptEnabled| nil ; not yet.
+                ;; :|CFBundleDocumentTypes| (cf-bundle-document-types)
+                ;; :|UTExportedTypeDeclarations| (exported-type-utis)
+                ;; (dictionary-version $default-info-dictionary-version)
+                ;; (development-region $default-info-plist-development-region)
+                ;; (executable $default-info-plist-executable)
+                ;; (has-localized-display-name $default-info-plist-has-localized-display-name)
+                ;; overriden by write-info-plist, I assume. :|NSMainNibFile| "MainMenu"
+                ;; overriden by write-info-plist (bundle-name $default-info-plist-bundle-name)
+                ;; overriden by write-info-plist (bundle-package-type $default-info-plist-bundle-package-type)
+                ;; overriden by write-info-plist (bundle-signature $default-info-plist-bundle-signature)
+                :|NSPrincipalClass| "LispApplication")
+   :nibfiles '()                        ; a list of user-specified nibfiles
                                         ; to be copied into the app bundle
-   :main-nib-name "MainMenu"
-                                        ; the name of the nib that is to be loaded
-                                        ; as the app's main. this name gets written
-                                        ; into the Info.plist on the "NSMainNibFile" key
+   ;; :main-nib-name "MainMenu"
+   ;;                                      ; the name of the nib that is to be loaded
+   ;;                                      ; as the app's main. this name gets written
+   ;;                                      ; into the Info.plist on the "NSMainNibFile" key
    :private-frameworks '()
    :toplevel-function nil
-   :altconsole nil))                    ; use t for a console for *standard-output*, *error-output*.
+   :altconsole t))                    ; use t for a console for *standard-output*, *error-output*.


-(save-simple-application :name *program-name*
-                         :directory *release-directory*
-                         :creator-string "SOSH")
+(save-hangman-application)


 ;;;; THE END ;;;;
diff --git a/src/hangman-controller.lisp b/src/hangman-controller.lisp
index a4fa440..aedc2d5 100644
--- a/src/hangman-controller.lisp
+++ b/src/hangman-controller.lisp
@@ -52,7 +52,9 @@
                         (hangman      :initarg :hangman      :accessor controller-hangman)
                         (words        :initarg :words        :accessor controller-words)
                         (loaded-words :initarg :loaded-words :accessor controller-loaded-words)
-                        (finished     :initarg :finished     :accessor controller-finished))])
+                        (finished     :initarg :finished     :accessor controller-finished)
+                        (game-counter :initform 0 :accessor controller-game-counter)
+                        (wins-counter :initform 0 :accessor controller-wins-counter))])



@@ -122,7 +124,9 @@
                                                :has-shadow t
                                                :delegate self
                                                :initial-first-responder self
+                                               :next-responder [NSApplication sharedApplication]
                                                :autodisplay t))
+  [(controller-window self) makeFirstResponder: self]
   (let ((win [(controller-window self) contentView]))
     (setf (controller-image self)   (make-image-view '(180 158 112 71)
                                                      :image-scaling :proportionally-down
@@ -178,16 +182,26 @@
           (controller-buttons self) '()))]


+
 (defun make-menu-bar ()
-  (let* ((empty   (objcl:objc-string ""))
-         (none    oclo:*null*)
-         (menubar [[NSMenu alloc] initWithTitle: empty])
-         (menu    [[NSMenu alloc] initWithTitle: empty]))
-    [menu addItemWithTitle:(objcl:objc-string "Quit")
-      action: (oclo:@selector "terminate:")
-      keyEquivalent:(objcl:objc-string "q")]
-    [[menubar addItemWithTitle: empty action: none keyEquivalent: empty] setSubmenu:menu]
-    menubar))
+  (menu "MenuBar"
+    (menu "Hangman"
+      (item "About Hangman" "orderFrontStandardAboutPanel:")
+      -
+      (menu "Services")
+      -
+      (item "Hide Hangman" "hide:" "h")
+      (item "Hide Others" "hideOtherApplications:" (:command :option "h"))
+      (item "Show All" "unhideAllApplications:")
+      -
+      (item "Quit Hangman" "terminate:" "q"))
+    (menu "Window"
+      (item "Minimize" "performMiniaturize:" "m")
+      (item "Zoom"     "performZoom:")
+      -
+      (item "Bring All to Front" "arrangeInFront:"))
+    (menu "Help"
+      (item "Hangman Help" "showHelp:" "?"))))


 ;; application delegate methods:
@@ -197,7 +211,10 @@
   resultType: (:void)
   body:
   (declare (ignore aNotification))
-  [[NSApplication sharedApplication] setMainMenu: (make-menu-bar)]
+  (let* ((main     (make-menu-bar))
+         (services [[[[main itemAtIndex:0] submenu] itemAtIndex:2] submenu]))
+    [[NSApplication sharedApplication] setMainMenu: main]
+    [[NSApplication sharedApplication] setServicesMenu:services])
   [self createUI]
   [(controller-window self) center]
   [(controller-window self) makeKeyAndOrderFront:nil]
@@ -228,6 +245,10 @@
   resultType: (:char)
   body: YES]

+@[HangmanController
+  method: (resignFirstResponder)
+  resultType: (:char)
+  body: NO]

 @[HangmanController
   method: (keyDown:(:id)event)
@@ -290,7 +311,8 @@
                                                          ofType: (objcl:objc-string "png")
                                                          inDirectory: (objcl:objc-string "images")]]))
     (if (oclo:nullp image)
-        (let ((pathname  (merge-pathnames (make-pathname :directory '(:relative :up "images")
+        ;; While developping, we refer the resources from the src/ directory:
+        (let ((pathname  (merge-pathnames (make-pathname :directory '(:relative :up "Resources" "images")
                                                          :name (format nil "hung-~D" index)
                                                          :type "png")
                                           (or *compile-file-pathname* *load-pathname* #P"./"))))
@@ -321,12 +343,21 @@
     (case (prog1 (hangman-try-letter game (character letter))
             (set-hang-image hc (hangman-error-count game)))
       (:wins
+       (incf (controller-wins-counter hc))
+       (incf (controller-game-counter hc))
        [(controller-guessed hc) setStringValue: (objcl:objc-string (hangman-word game))]
-       [(controller-message hc) setStringValue: (objcl:objc-string "You win!")]
+       [(controller-message hc) setStringValue: (objcl:objc-string (format nil "You win!~%~D/~D"
+                                                                           (controller-wins-counter hc)
+                                                                           (controller-game-counter hc)))]
+       (provide-word-for-services (hangman-word game))
        (setf (controller-finished hc) t))
       (:loses
+       (incf (controller-game-counter hc))
        [(controller-guessed hc) setStringValue: (objcl:objc-string (hangman-word game))]
-       [(controller-message hc) setStringValue: (objcl:objc-string "You lose!")]
+       [(controller-message hc) setStringValue: (objcl:objc-string (format nil "You lose!~%~D/~D"
+                                                                           (controller-wins-counter hc)
+                                                                           (controller-game-counter hc)))]
+       (provide-word-for-services (hangman-word game))
        (setf (controller-finished hc) t))
       (:alreadyTried
        [(controller-guessed hc) setStringValue: (objcl:objc-string (hangman-found-word game))]
@@ -338,7 +369,12 @@
        [(controller-guessed hc) setStringValue: (objcl:objc-string (hangman-found-word game))]
        [(controller-message hc) setStringValue: (objcl:objc-string "Good guess!")]))))

-
+(defun provide-word-for-services (word)
+  ;; This doesn't work. :-(
+  #-(and)
+  (let ((pboard [NSPasteboard pasteboardWithName:#$NSFindPboard]))
+    [pboard clearContents]
+    [pboard setString: (objcl:objc-string word) forType: #$NSPasteboardTypeString]))


 (defvar *controller*)
@@ -352,7 +388,11 @@
   ;; Setting the controller as NSApplication delegate, will let it
   ;; receive the applicationDidFinishLaunching: message so it may
   ;; complete the application initialization (menus, windows).
-  [[NSApplication sharedApplication] setDelegate:*controller*])
+  [[NSApplication sharedApplication] setDelegate:*controller*]
+  #-(and)
+  (progn ;; to debug the application:
+    (ql:quickload :swank)
+    (funcall (intern "CREATE-SERVER" "SWANK") :port 4099)))


 ;;;; THE END ;;;;
diff --git a/src/nsapi.lisp b/src/nsapi.lisp
index ae5bfb4..f233949 100644
--- a/src/nsapi.lisp
+++ b/src/nsapi.lisp
@@ -276,6 +276,15 @@ size list -> NSSize
 point list -> NSPoint
 "))

+(defmethod configure ((self ns:ns-responder)
+                      &key
+                        (next-responder nil next-responder-p)
+                        (menu nil menu-p)
+                      &allow-other-keys)
+  (when (next-method-p) (call-next-method))
+  (when next-responder-p [self setNextResponder: next-responder])
+  (when menu-p [self setMenu: menu])
+  self)

 (defmethod configure ((self ns:ns-view)
                       &key
@@ -644,4 +653,90 @@ point list -> NSPoint
     (apply (function configure) window keys)
     window))

+
+
+(defun ns-key-equivalent-modifier-mask (keywords)
+  (loop
+    :with m = 0
+    :for k :in keywords
+    :do (setf m (logior m (ecase k
+                            ((:shift) #$NSShiftKeyMask)
+                            ((:option :alternate) #$NSAlternateKeyMask)
+                            ((:command) #$NSCommandKeyMask)
+                            ((:control) #$NSControlKeyMask))))
+    :finally (return m)))
+
+(defmacro item (title &optional selector key-equivalent)
+  (cond ((null    key-equivalent))
+        ((stringp key-equivalent))
+        ((listp   key-equivalent)
+         (assert (= 1 (count-if (function stringp) key-equivalent))
+                 (key-equivalent)
+                 "Invalid key-equivalent: ~S~%Must be a string or a list containing a string and modifier keywords."
+                 key-equivalent)
+         (assert (every (lambda (k) (or (stringp k)
+                                        (member k '(:shift :option :alternate :command :control))))
+                        key-equivalent)
+                 (key-equivalent)
+                 "Invalid key-equivalent: ~S~%Must be a string or a list containing a string and modifier keywords."
+                 key-equivalent))
+        (t (error "Invalid key-equivalent: ~S~%Must be a string or a list containing a string and modifier keywords."
+                  key-equivalent)))
+  (let ((item `(let ((title  (objcl:objc-string ,title))
+                     (action ,(if (null selector)
+                                  'oclo:*null*
+                                  `(oclo:@selector ,selector)))
+                     (key-equivalent ,(cond
+                                        ((null key-equivalent)    `(objcl:objc-string ""))
+                                        ((stringp key-equivalent) `(objcl:objc-string ,key-equivalent))
+                                        ((listp key-equivalent)   `(objcl:objc-string ,(find-if (function stringp) key-equivalent))))))
+                 [[[NSMenuItem alloc] initWithTitle: title action: action keyEquivalent: key-equivalent] autorelease])))
+    (if (consp key-equivalent)
+        `(let ((item ,item)
+               (mask ,(ns-key-equivalent-modifier-mask (remove-if-not (function keywordp) key-equivalent))))
+           [item setKeyEquivalentModifierMask: mask]
+           item)
+        item)))
+
+(defmacro menu (title &body items)
+  `(let* ((menu-title ,(if title
+                      `(objcl:objc-string ,title)
+                      `(objcl:objc-string "")))
+          (menu [[[NSMenu alloc] initWithTitle:menu-title] autorelease]))
+     ,@(mapcar (lambda (item-form)
+                 `(let ((item ,(cond
+                                 ((and (or (symbolp item-form) (stringp item-form))
+                                       (string= "-" item-form))
+                                  `[NSMenuItem separatorItem])
+                                 ((atom item-form)
+                                  (error "Invalid item: ~S" item-form))
+                                 (t (ecase (first item-form)
+                                      (menu `(let ((item (item ,(second item-form)))
+                                                   (menu ,item-form))
+                                               [item setSubmenu:menu]
+                                               item))
+                                      (item item-form))))))
+                    [menu addItem: item]))
+               items)
+     menu))
+
+
+
+(defun dictionary (&rest key-values &key &allow-other-keys)
+  (flet ((objclize (object)
+           (typecase object
+             (null       (objcl:objc-string "NO"))
+             ((member t) (objcl:objc-string "YES"))
+             (string     (objcl:objc-string object))
+             (symbol     (objcl:objc-string (symbol-name object)))
+             (t          object))))
+   (loop
+     :with dict = [NSMutableDictionary dictionaryWithCapacity: (truncate (length key-values) 2)]
+     :for (key value) :on key-values :by (function cddr)
+     :do (let ((key   (objclize key))
+               (value (objclize value)))
+           [dict setObject:value forKey:key])
+     :finally (return dict))))
+
+
 ;;; THE END;;;
diff --git a/src/utils.el b/src/utils.el
index 9cfaf10..2590212 100644
--- a/src/utils.el
+++ b/src/utils.el
@@ -40,7 +40,7 @@
     (dolist (arg args)
       (insert (format "%S\n" arg)))
     (insert "&allow-other-keys)\n")
-    (insert "(call-next-method)\n")
+    (insert "(when (next-method-p) (call-next-method))\n")
     (dolist (set sets)
       (insert (format "%S\n" set)))
     (insert "self")))
ViewGit