summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Lisp/util-sequences.lisp61
-rw-r--r--objective-cl.asd3
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"