diff --git a/Nukefile b/Nukefile new file mode 100644 index 0000000..b2a7efb --- /dev/null +++ b/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")) diff --git a/README b/README new file mode 100644 index 0000000..055fe31 --- /dev/null +++ b/README @@ -0,0 +1,7 @@ +Extra utility functions for Nu. + +Use via: + +(load "Nutils:cl_utils") + +etc. diff --git a/nu/cl_utils.nu b/nu/cl_utils.nu new file mode 100644 index 0000000..96ec47f --- /dev/null +++ b/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)) + diff --git a/nu/range.nu b/nu/range.nu new file mode 100644 index 0000000..d3bdd3a --- /dev/null +++ b/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)) diff --git a/nu/with_object.nu b/nu/with_object.nu new file mode 100644 index 0000000..c69b2f4 --- /dev/null +++ b/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)) +;)) + diff --git a/nu/with_test.nu b/nu/with_test.nu new file mode 100644 index 0000000..1d661e6 --- /dev/null +++ b/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))))) diff --git a/objc/Nutils.m b/objc/Nutils.m new file mode 100644 index 0000000..1347a59 --- /dev/null +++ b/objc/Nutils.m @@ -0,0 +1,74 @@ +#import +#import +#import + +void NutilsInit() +{ + static initialized = 0; + if (!initialized) { + initialized = 1; + //[Nu loadNuFile:@"cl_utils" fromBundleWithIdentifier:@"nu.programming.Nutils" withContext:nil]; + //[Nu loadNuFile:@"range" fromBundleWithIdentifier:@"nu.programming.Nutils" withContext:nil]; + //[Nu loadNuFile:@"with_test" fromBundleWithIdentifier:@"nu.programming.Nutils" withContext:nil]; + //[Nu loadNuFile:@"with_object" fromBundleWithIdentifier:@"nu.programming.Nutils" withContext:nil]; + } +} + +@interface Nutils : NSObject + +@end + +@implementation Nutils + ++ (void) load +{ + NutilsInit(); +} + ++ (id) objectWithAddress:(unsigned long)address +{ + id object = (id)address; + return object; +} + ++ (long) addressOfObject:(id) obj +{ + return (long)obj; +} + ++ (NSString*) ivarLayoutForClass:(NSString*) className ivar:(NSString*) ivarName +{ + Class cls; + + const char* szClassName = [className UTF8String]; + cls = objc_getClass(szClassName); + const char* szIvarLayout = class_getIvarLayout(cls); + NSString* layout = [[NSString alloc] initWithUTF8String:szIvarLayout]; + return layout; +} + + ++ (NSMutableArray*) ivarsForClass: (NSString*) className +{ + Ivar *ivarList = NULL; + unsigned int ivarListCount; + + const char* szClassName = [className UTF8String]; + Class cls = objc_getClass(szClassName); + ivarList = class_copyIvarList(cls, &ivarListCount); + + NSMutableArray* arr = [[NSMutableArray alloc] init]; + + int i; + for (i = 0; i < ivarListCount; i++) + { + NSString* name = [NSString stringWithCString:ivar_getName(ivarList[i])]; + [arr addObject:name]; + } + + free(ivarList); + + return arr; +} + +@end