summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-03-14 18:16:05 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-03-14 18:16:05 +0100
commit4714129a8ba875f082f522c07c039fba12395ded (patch)
treec1049a0b120904f73910519b76b0629754eed508 /Lisp
parent19a3dc32e4fdc1743f0317cacf8c80acbd71d4ae (diff)
Implement the generic sequence protocol for NSArray on SBCL.
darcs-hash:af39e2a05a060e7f805e7218ef808c1721edcdd3
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/util-sequences.lisp61
1 files changed, 61 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))))