| 1 | ;; ns-string-utils.lisp
|
|---|
| 2 |
|
|---|
| 3 | (defpackage :interface-utilities
|
|---|
| 4 | (:nicknames :iu)
|
|---|
| 5 | (:export ns-to-lisp-string lisp-str-to-ns-data ns-data-to-lisp-str
|
|---|
| 6 | lisp-object-to-ns-data ns-data-to-lisp-object lisp-to-temp-nsstring
|
|---|
| 7 | nsstring-to-class nsstring-to-func nsstring-to-sym find-func))
|
|---|
| 8 |
|
|---|
| 9 | (in-package :iu)
|
|---|
| 10 |
|
|---|
| 11 | (defun ns-to-lisp-string (ns-str)
|
|---|
| 12 | (if (and (not (eql (%null-ptr) ns-str)) (plusp (#/length ns-str)))
|
|---|
| 13 | (%get-cstring (#/cStringUsingEncoding: ns-str #$NSUTF8StringEncoding))
|
|---|
| 14 | ""))
|
|---|
| 15 |
|
|---|
| 16 | (defun lisp-str-to-ns-data (lisp-str)
|
|---|
| 17 | (with-cstrs ((str lisp-str))
|
|---|
| 18 | (#/dataWithBytes:length: ns:ns-data str (1+ (length lisp-str)))))
|
|---|
| 19 |
|
|---|
| 20 | (defun ns-data-to-lisp-str (nsdata)
|
|---|
| 21 | (%get-cstring (#/bytes nsdata)))
|
|---|
| 22 |
|
|---|
| 23 | (defun lisp-object-to-ns-data (obj)
|
|---|
| 24 | (lisp-str-to-ns-data (format nil "~s" obj)))
|
|---|
| 25 |
|
|---|
| 26 | (defun ns-data-to-lisp-object (nsdata)
|
|---|
| 27 | (read-from-string (ns-data-to-lisp-str nsdata)))
|
|---|
| 28 |
|
|---|
| 29 | (defun lisp-to-temp-nsstring (string)
|
|---|
| 30 | ;; creates a string that is not owned by caller
|
|---|
| 31 | ;; so no release is necessary
|
|---|
| 32 | (with-encoded-cstrs :utf-8 ((s string))
|
|---|
| 33 | (#/stringWithUTF8String: ns:ns-string s)))
|
|---|
| 34 |
|
|---|
| 35 | (defun nsstring-to-class (ns-str)
|
|---|
| 36 | (let ((lisp-obj (read-from-string (ns-to-lisp-string ns-str) nil nil))
|
|---|
| 37 | (classes nil))
|
|---|
| 38 | (if (consp lisp-obj)
|
|---|
| 39 | (dolist (obj lisp-obj (nreverse classes))
|
|---|
| 40 | (push (find-class obj nil) classes))
|
|---|
| 41 | (find-class lisp-obj nil))))
|
|---|
| 42 |
|
|---|
| 43 | (defun find-func (func-str)
|
|---|
| 44 | (let* ((sym (read-from-string func-str nil nil)))
|
|---|
| 45 | (cond ((and (typep sym 'function-name) (fboundp sym))
|
|---|
| 46 | (symbol-function sym))
|
|---|
| 47 | ((and (consp sym) (eq (first sym) 'function))
|
|---|
| 48 | (let ((fsym (second sym)))
|
|---|
| 49 | (and (typep fsym 'function-name)
|
|---|
| 50 | (fboundp fsym)
|
|---|
| 51 | (symbol-function fsym)))))))
|
|---|
| 52 |
|
|---|
| 53 | (defun nsstring-to-func (ns-str)
|
|---|
| 54 | (find-func (ns-to-lisp-string ns-str)))
|
|---|
| 55 |
|
|---|
| 56 | (defun nsstring-to-sym (ns-str)
|
|---|
| 57 | (let ((sym (read-from-string (ns-to-lisp-string ns-str) nil nil)))
|
|---|
| 58 | (if (symbolp sym) sym nil)))
|
|---|
| 59 |
|
|---|
| 60 | (provide :ns-string-utils)
|
|---|
