summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/constant-data.lisp6
-rw-r--r--Lisp/data-types.lisp37
-rw-r--r--Lisp/libobjcl.lisp10
-rw-r--r--Lisp/memory-management.lisp6
-rw-r--r--Lisp/type-conversion.lisp4
5 files changed, 36 insertions, 27 deletions
diff --git a/Lisp/constant-data.lisp b/Lisp/constant-data.lisp
index eebe3e9..575d46e 100644
--- a/Lisp/constant-data.lisp
+++ b/Lisp/constant-data.lisp
@@ -61,10 +61,10 @@
(defparameter *objcl-type-map*
- '((id . objc-id)
+ '((id . id)
(class . objc-class)
- (sel . objc-selector)
- (exc . objc-exception)
+ (sel . selector)
+ (exc . exception)
(chr . character)
(int . integer)
(uint . integer)
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp
index 7bb4d5f..6181a3b 100644
--- a/Lisp/data-types.lisp
+++ b/Lisp/data-types.lisp
@@ -45,12 +45,12 @@
:initform nil)))
-(defclass objc-selector (c-pointer-wrapper) ())
-(defclass objc-id (c-pointer-wrapper) ())
-(defclass objc-class (c-pointer-wrapper) ())
+(defclass selector (c-pointer-wrapper) ())
+(defclass id (c-pointer-wrapper) ())
+(defclass objc-class (c-pointer-wrapper) ())
-(define-condition objc-exception (error)
+(define-condition exception (error)
((pointer :type c-pointer
:accessor pointer-to
:initarg :pointer))
@@ -81,21 +81,30 @@
(foreign-free obj-data))
-(defmethod print-object ((object objc-id) stream)
+(defmethod print-object ((object id) stream)
(print-unreadable-object (object stream)
(format stream "~A `~A' {~X}"
- (objcl-class-name
- (invoke-by-name object "class"))
- (invoke-by-name
- (invoke-by-name object "description")
- "UTF8String")
+ (objcl-class-name (invoke-by-name object "class"))
+ (invoke-by-name (invoke-by-name object "description")
+ "UTF8String")
(invoke-by-name object "hash"))))
-(defmethod print-object ((object objc-class) stream)
- (print-unreadable-object (object stream)
- (format stream "OBJC-CLASS ~A"
- (objcl-class-name object))))
+(defmethod print-object ((class objc-class) stream)
+ (print-unreadable-object (class stream)
+ (format stream "~S ~A {~X}"
+ 'objc-class
+ (objcl-class-name class)
+ (invoke-by-name class "hash"))))
+
+
+(defmethod print-object ((exception exception) stream)
+ (print-unreadable-object (exception stream)
+ (format stream "~S ~A {~X}"
+ 'exception
+ (invoke-by-name (invoke-by-name exception "name")
+ "UTF8String")
+ (invoke-by-name exception "hash"))))
;;;; (@* "Convenience types")
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index 12a880c..e4b64f0 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -170,20 +170,20 @@ conventional case for namespace identifiers in Objective C."
(defun objcl-class-name (class)
- (declare (type (or objc-class objc-id objc-exception) class))
+ (declare (type (or objc-class id exception) class))
(let ((obj-data (foreign-alloc 'obj-data)))
(with-foreign-slots ((type data) obj-data obj-data)
(setf (foreign-slot-value data
'obj-data-union
(etypecase class
(objc-class 'class-val)
- (objc-id 'id-val)
- (objc-exception 'exc-val)))
+ (id 'id-val)
+ (exception 'exc-val)))
(pointer-to class))
(setf type (foreign-string-alloc (etypecase class
(objc-class "#")
- (objc-id "@")
- (objc-exception "E")))))
+ (id "@")
+ (exception "E")))))
(prog1
(%objcl-class-name obj-data)
(dealloc-obj-data obj-data))))
diff --git a/Lisp/memory-management.lisp b/Lisp/memory-management.lisp
index 8331932..1a3055b 100644
--- a/Lisp/memory-management.lisp
+++ b/Lisp/memory-management.lisp
@@ -11,16 +11,16 @@
;; (i.e. those whose name starts with `alloc' or `new'). Upon
;; Lisp-side finalization of an object, wie `release' it.
(eval-when (:load-toplevel)
- (dolist (type '(objc-id objc-class objc-exception))
+ (dolist (type '(id objc-class exception))
(funcall
(compile
nil
`(lambda ()
(defmethod make-instance ((class (eql ',type)) &rest initargs &key)
(let* ((hash-table ,(ecase type
- ((objc-id) '*id-objects*)
+ ((id) '*id-objects*)
((objc-class) '*class-objects*)
- ((objc-exception) '*exception-objects*)))
+ ((exception) '*exception-objects*)))
(hash-key (pointer-address (getf initargs :pointer)))
(obj (weak-gethash hash-key hash-table nil)))
(typecase obj
diff --git a/Lisp/type-conversion.lisp b/Lisp/type-conversion.lisp
index 6869ff9..8839b3b 100644
--- a/Lisp/type-conversion.lisp
+++ b/Lisp/type-conversion.lisp
@@ -10,7 +10,7 @@
'obj-data-union
(type-name->slot-name type-name))
(typecase value
- ((or objc-id objc-class objc-selector objc-exception)
+ ((or id objc-class selector exception)
(pointer-to value))
(string (foreign-string-alloc value))
(otherwise value)))
@@ -29,7 +29,7 @@
'obj-data-union
(type-name->slot-name type-name)))))
(case lisp-type
- ((objc-id objc-class objc-selector objc-exception)
+ ((id objc-class selector exception)
(make-instance lisp-type :pointer value))
((string) (foreign-string-to-lisp value))
(otherwise value))))) \ No newline at end of file