Added with_object

Nukefile

@@ -0,0 +1,35 @@
+
+;; source files
+(set @nu_files		(filelist "^nu/.*nu$"))
+(set @m_files		(filelist "^objc/.*.m$"))
+(set @nib_files		(filelist "^resources/English\.lproj/.*\.nib$"))
+
+(set @cflags 	"-g -DDARWIN -Iobjc")
+(set @ldflags  "-framework Foundation -framework AppKit -framework Nu")
+
+(ifDarwin
+         (then
+              (set @mflags "-fobjc-exceptions -fobjc-gc"))
+         (else (set @cflags "-Wall -g -std=gnu99 -fPIC")
+               (set @mflags ((NSString stringWithShellCommand:"gnustep-config --objc-flags") chomp))))
+
+;; framework description
+(set @framework					"Nutils")
+(set @framework_identifier		"nu.programming.nutils")
+(set @framework_creator_code	"????")
+
+(compilation-tasks)
+(framework-tasks)
+
+(task "default" => "framework")
+
+(task "clobber" => "clean" is
+      (SH "rm -rf #{@framework_dir}"))
+
+(task "default" => "framework")
+
+; (task "doc" is (SH "nudoc"))
+
+(task "install" => "framework" is
+      (SH "sudo rm -rf /Library/Frameworks/#{@framework}.framework")
+      (SH "ditto #{@framework}.framework /Library/Frameworks/#{@framework}.framework"))

README

@@ -0,0 +1,7 @@
+Extra utility functions for Nu.
+
+Use via:
+
+(load "Nutils:cl_utils")
+
+etc.

nu/cl_utils.nu

@@ -0,0 +1,228 @@
+;; @file       cl_utils.nu
+;; @discussion Nu versions of popular Common Lisp functions and macros.
+;;
+;; @copyright  Copyright (c) 2009 Jeff Buck
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+;; These functions are part of Common Lisp.
+;; The subsequent examples in the book assume they are defined.
+
+
+(function mapcar-1 (f l)
+     (cond
+          ((null? l) nil)
+          (else
+               (cons (f (car l)) (mapcar-1 f (cdr l))))))
+
+;; Nu's cadr-type built-ins are postfix.
+;; Not as suitable for lispy mapping functions.
+(function caar (l)
+     (car (car l)))
+
+(function cadr (l)
+     (car (cdr l)))
+
+(function cddr (x)
+     (cdr (cdr x)))
+
+
+
+(macro-1 incf (n *delta)
+     (if (not (eq *delta '()))
+         (then `(set ,n (+ ,n ,(car *delta))))
+         (else `(set ,n (+ ,n 1)))))
+
+(macro-1 decf (n *delta)
+     (if (not (eq *delta '()))
+         (then `(set ,n (- ,n ,(car *delta))))
+         (else `(set ,n (- ,n 1)))))
+
+
+(function evenp (x)
+     ((eq 0 (% x 2))))
+
+(function oddp (x)
+     (not (evenp x)))
+
+(set even? evenp)
+(set odd? oddp)
+
+(function select-if (f l)
+     (function select-if-acc (f l acc)
+          (if (null? l)
+              (then acc)
+              (else
+                   (if (f (car l))
+                       (then (select-if-acc f (cdr l) (append acc (list (car l)))))
+                       (else (select-if-acc f (cdr l) acc))))))
+     (select-if-acc f l nil))
+
+
+(function nthcdr (n source)
+     (cond ((eq n 0)
+            source)
+           ((> n (source length)) nil)
+           (else (nthcdr (- n 1) (cdr source)))))
+
+
+(function subseq (l start end)
+     (if (eq (l class) ("a" class))
+         (then
+              (if (>= start end)
+                  (then "")
+                  (else
+                       ;; String - use substring
+                       (l substringWithRange:(list start (- end start))))))
+         (else
+              ;; Assume a list - use cdrs
+              (set len (l length))
+              (set i start)
+              (set result nil)
+              (while (and (< i end) (< i len))
+                     (set result (append result (list (car (nthcdr i l)))))
+                     (set i (+ i 1)))
+              result)))
+
+
+(function last (l *n)
+     (let ((len (l length)))
+          (if *n
+              (then (set count (car *n)))
+              (else (set count 1)))
+          (if (> count len)
+              (then (set count len)))
+          (subseq l (- len count) len)))
+
+
+(function butlast (l *n)
+     (if (not (eq *n '()))
+         (then (set count (car *n)))
+         (else (set count 1)))
+     (let ((len (l length)))
+          (if (>= count len)
+              (then '())
+              (else (subseq l 0 (- len count))))))
+
+
+
+(macro-1 let* (bindings *body)
+     (if (null? bindings)
+         (then
+              `(progn
+                     ,@*body))
+         (else
+              (set __nextcall `(let* ,(cdr bindings) ,@*body))
+              `(let (,(car bindings))
+                    ,__nextcall))))
+
+
+;; Not part of Common Lisp, but popular functions to have around...
+
+;; Glue up a string from various substrings.
+(function mkstr (*rest)
+     (set s "")
+     (*rest each:
+            (do (a)
+                (set s (+ s a))))
+     s)
+
+;; Make a symbol name out of a list of substrings.
+(function symb (*rest)
+     ((apply mkstr *rest) symbolValue))
+
+
+;; Group a flat list into lists of length n.
+(function group (source n)
+     (function group-rec (source n acc)
+          (let ((rest (nthcdr n source)))
+               (if (pair? rest)
+                   (then
+                        (group-rec rest n (cons (subseq source 0 n) acc)))
+                   (else
+                        (reverse (cons source acc))))))
+     (if source
+         (then (group-rec source n nil))
+         (else nil)))
+
+
+;; Flatten a nested list.
+(function flatten (x)
+     (function flatten-rec (x acc)
+          (cond
+               ((eq x nil) acc)
+               ((atom? x) (cons x acc))
+               (else (flatten-rec (car x) (flatten-rec (cdr x) acc)))))
+     (flatten-rec x nil))
+
+
+;; A few math functions
+(function fact (x)
+     (if (<= x 0)
+         (then 1)
+         (else (* x (fact (- x 1))))))
+
+(function choose (n r)
+     (/ (fact n)
+        (fact (- n r))
+        (fact r)))
+
+(function perm (n r)
+     (/ (fact n)
+        (fact (- n r))))
+
+
+;; The rest of the functions in this file are not part of
+;; Common Lisp, but they are "Common Lispy" enough to include
+;; here.  They are provided as a convenience functions that a
+;; multi-list mapcar could otherwise provide.
+
+;; returns the obvious on a list of lists.
+(function cars (lists)
+     (mapcar-1 car lists))
+
+(function cdrs (lists)
+     (mapcar-1 cdr lists))
+
+;; Nu's map provides similar functionality to weave,
+;; but doesn't work for quoted lists like this:
+;;   (map list '(a b c) '(x y z))
+;; It tries to eval the list elements.
+;;  ^ the internal apply is the guilty party in map.
+
+;; weave only works for two lists.
+;;  ex: (weave '(a b c) '(x y z)) -> (a x) (b y) (c z)
+(function weave (*lists)
+     (function weave-rec (lists)
+          (cond
+               ((null? lists) nil)
+               ((null? (car lists)) nil)
+               (else
+                    (cons
+                         (cars lists)
+                         (weave-rec (cdrs lists))))))
+     (weave-rec *lists))
+
+
+; Nu adds a "list" method to NSArray.
+; This function turns a string into a list of characters.
+(function listify (s)
+     (let ((i 0)
+           (len (s length))
+           (result '()))
+          (while (< i len)
+                 (set result (append result (list (subseq s i (+ i 1)))))
+                 (set i (+ i 1)))
+          result))
+

nu/range.nu

@@ -0,0 +1,9 @@
+(function range (start end)
+     (set i start)
+     (set result nil)
+     (while (<= i end)
+            (set result (append result (list i)))
+            (set i (+ i 1)))
+     result)
+
+(puts (range 1 10))

nu/with_object.nu

@@ -0,0 +1,24 @@
+
+(macro-1 with-object (o *body)
+     `(progn
+            ,@(*body map:
+              (do (line)
+                  `(,o ,@line)))))
+
+; Example usage:
+;
+;(import "cocoa")
+;
+;(set myTextView (((NSTextView alloc) initWithFrame: NSZeroRect)))
+;
+;(puts (macrox
+;(with-object myTextView
+;     (setDrawsBackground:NO)
+;     (setEditable:NO)
+;     (setSelectable:YES)
+;     (setTextColor:(NSColor redColor))
+;     (setFont:(NSFont controlContentFontOfSize:8))
+;     (setTextContainerInset:'(4 4))
+;     (setVerticallyResizable:NO))
+;))
+

nu/with_test.nu

@@ -0,0 +1,66 @@
+;; @file       with_test.nu
+;; @discussion Adds wrapper around NuTestCase for logging output option.
+;;
+;; @copyright  Copyright (c) 2009 Jeff Buck
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+;; Set to nil to run as normal unit tests.
+;; Set to t to see all code and results of assert_equals.
+(set show-verbose-output nil)
+;(set show-verbose-output t)
+
+;; Set to t to print headers.
+;; Has no effect when show-verbose-output is nil.
+(set show-test-headers t)
+
+
+(macro-1 with-test-class (class-name *body)
+     (if (not show-verbose-output)
+         (then
+              `(class ,class-name is NuTestCase
+                    ,@*body))
+         (else
+              `(progn
+                     (if show-test-headers
+                         (then
+                              (print "-------- ")
+                              (print ',class-name)
+                              (print " --------\n")))
+                     ,@*body))))
+
+(macro-1 with-test-case (test-name *body)
+     (if (not show-verbose-output)
+         (then
+              `(imethod (id) ,test-name is
+                    ,@*body))
+         (else
+              `(progn
+                     (if show-test-headers
+                         (then
+                              (print "  -------- ")
+                              (print ',test-name)
+                              (print " --------\n")))
+                     ,@(mapcar-1
+                       (do (statement)
+                           (if (eq 'assert_equal (car statement))
+                               (then
+                                    `(progn
+                                           (print ',@(cddr statement))
+                                           (print " -> ")
+                                           (print ,@(cddr statement))
+                                           (print "\n")))
+                               (else
+                                    statement)))
+                       *body)))))