diff options
-rw-r--r-- | Lisp/util-sequences.lisp | 61 | ||||
-rw-r--r-- | objective-cl.asd | 3 |
2 files changed, 64 insertions, 0 deletions
diff --git a/Lisp/util-sequences.lisp b/Lisp/util-sequences.lisp new file mode 100644 index 0000000..da651dc --- /dev/null +++ b/Lisp/util-sequences.lisp @@ -0,0 +1,61 @@ +;;;; Objective-CL, an Objective-C bridge for Common Lisp. +;;;; Copyright (C) 2007, 2008 Matthias Andreas Benkard. +;;;; +;;;; This program is free software: you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public License +;;;; as published by the Free Software Foundation, either version 3 of +;;;; the License, or (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, but +;;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this program. If not, see +;;;; <http://www.gnu.org/licenses/>. + +(in-package #:mulk.objective-cl) + + +#+sbcl +(progn + (eval-when (:compile-toplevel :load-toplevel :execute) + (find-objc-class "NSArray" t)) + + (defmethod sb-sequence:length ((array ns::ns-array)) + (invoke-by-name array "count")) + + (defmethod sb-sequence:elt ((array ns::ns-array) index) + (invoke-by-name array "objectAtIndex:" index)) + + (defmethod (setf sb-sequence:elt) (new-value (array ns::ns-array) index) + (invoke-by-name array "setObject:atIndex:" new-value index)) + + (defmethod sb-sequence:adjust-sequence ((array ns::ns-array) + length + &key initial-element + initial-contents) + (cond ((< length (sb-sequence:length array)) + (dotimes (i (- (sb-sequence:length array) length)) + (invoke-by-name array "removeLastObject"))) + ((> length (sb-sequence:length array)) + (loop for i from (sb-sequence:length array) below length + do (invoke-by-name array + "addObject:" + (if (> (length initial-contents) i) + (elt initial-contents i) + initial-element))))) + array) + + (defmethod sb-sequence:make-sequence-like ((array ns::ns-array) + length + &key initial-element + initial-contents) + (let ((new-array (invoke-by-name (class-of array) + "arrayWithArray:" + array))) + (sb-sequence:adjust-sequence new-array + length + :initial-element initial-element + :initial-contents initial-contents)))) diff --git a/objective-cl.asd b/objective-cl.asd index c35f7fa..4e72ec0 100644 --- a/objective-cl.asd +++ b/objective-cl.asd @@ -137,6 +137,9 @@ "method-definition" "reader-syntax" "data-types")) + (:file "util-sequences" :depends-on ("defpackage" + "method-invocation" + "libobjcl")) (:file "post-init" :depends-on ("defpackage" "libobjcl" "init" |