Commit 595b1dd2 authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

Merged in branch 20141013+ccl-1.11+macOS_Sierra.

parents ce3e511e 499ea80c
......@@ -666,7 +666,7 @@ RETURN: The equivalence classes of SET, via KEY, modulo TEST.
"
RETURN: The value of the entry INDICATOR of the a-list PLACE, or DEFAULT.
"
(let ((a (assoc indicator place)))=
(let ((a (assoc indicator place)))
(if a (cdr a) default)))
......
......@@ -58,8 +58,8 @@ cover generic FFI to both Apple and GNUstep objc2 runtimes.
((#:albert #:docbook #:textcolor) . "black"))
#+asdf-unicode :encoding #+asdf-unicode :utf-8
:depends-on ("com.informatimago.common-lisp.cesarum")
:components ((:file "objc-support" :depends-on ("packages"))
(:file "packages" :depends-on ())
:components ((:file "packages" :depends-on ("objc-support"))
(:file "objc-support" :depends-on ())
(:file "mac-roman" :depends-on ("packages"))
. #+(and ccl darwin)
((:file "oclo-ccl" :depends-on ("packages"))
......
......@@ -31,11 +31,13 @@
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************
(in-package "COMMON-LISP-USER")
;; We'll try to catch in this variable the objective-c reader macros
;; installed by ccl require cocoa.
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar com.informatimago.objcl.readtable:*ccl-readtable* nil))
(defvar *ccl-readtable* nil))
#+(and ccl darwin); for now, not on non-darwin
(eval-when (:compile-toplevel :load-toplevel :execute)
......@@ -51,11 +53,12 @@
#-darwin (require :objc-support)
#+darwin (require :cocoa)
(unless com.informatimago.objcl.readtable:*ccl-readtable*
(setf com.informatimago.objcl.readtable:*ccl-readtable* (copy-readtable *readtable*)))
(unless *ccl-readtable*
(setf *ccl-readtable* (copy-readtable *readtable*)))
(pushnew :objc-support *features*))
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *readtable* (copy-readtable nil)))
;;;; THE END ;;;;
This diff is collapsed.
......@@ -70,4 +70,22 @@ RETURN: The Objective-C selector named NAME.
(ccl::%get-selector (ccl::ensure-objc-selector name)))
(in-package "CCL")
;; patch:
(defmacro send (o msg &rest args &environment env)
(make-optimized-send o msg args env))
(defmacro send/stret (s o msg &rest args &environment env)
(make-optimized-send o msg args env s))
(defmacro send-super (o msg &rest args &environment env)
(make-optimized-send o msg args env nil t))
(defmacro send-super/stret (s o msg &rest args &environment env)
(make-optimized-send o msg args env s t))
;;;; THE END ;;;;
......@@ -42,6 +42,7 @@
`(slet ((,result ,(macroexpand expression env))) ,result)))
#-(and)
(defun needs-stret (o msg args env &optional sclassname)
(multiple-value-bind (msg args vargs) (ccl::parse-message (cons msg args))
(let ((message-info (ccl::get-objc-message-info msg)))
......@@ -79,6 +80,7 @@
(error "Cannot find method result type for message -~A sent to ~S. Try declaring the class of the recipient."
(ccl::objc-message-info-message-name message-info) o)))))))
#-(and)
(defmacro send (&whole w o msg &rest args &environment env)
(if (needs-stret o msg args env)
......
......@@ -33,6 +33,7 @@
;;;;**************************************************************************
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *readtable* (copy-readtable nil)))
(in-package "COMMON-LISP-USER")
;; #+(and ccl ccl-1.9)
;; (let ((initialized nil))
......@@ -63,8 +64,8 @@ See source file for details.
"))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *oclo-ccl-symbol-names*)
(defparameter *oclo-objc-symbol-names*
(defparameter *oclo-symbol-names*
'("*OBJC-DESCRIPTION-MAX-LENGTH*"
"@CLASS"
"@SELECTOR"
......@@ -100,7 +101,33 @@ See source file for details.
"OBJC-TO-LISP-CLASSNAME"
"OBJC-TO-LISP-MESSAGE"
"SLET"
"UPDATE-OBJC-METHOD-INFO")))
"UPDATE-OBJC-METHOD-INFO"))
(defparameter *oclo-ccl-symbol-names*
'("UPDATE-OBJC-METHOD-INFO" "SLET" "OBJC-TO-LISP-MESSAGE"
"OBJC-TO-LISP-CLASSNAME" "LISP-TO-OBJC-MESSAGE"
"LISP-TO-OBJC-CLASSNAME" "DEFINE-CLASSNAME-TRANSLATION" "@"
"WITH-AUTORELEASED-NSSTRINGS" "WITH-AUTORELEASE-POOL"
"SEND/STRET" "SEND" "SEND-SUPER/STRET" "SEND-SUPER"
"OBJC-MESSAGE-SEND-SUPER-STRET" "OBJC-MESSAGE-SEND-SUPER"
"OBJC-MESSAGE-SEND-STRET" "OBJC-MESSAGE-SEND"
"MAKE-OBJC-INSTANCE" "LISP-STRING-FROM-NSSTRING" "DEFMETHOD"
"DEFINE-OBJC-METHOD" "DEFINE-OBJC-CLASS-METHOD" "@SELECTOR"
"@CLASS" "*OBJC-DESCRIPTION-MAX-LENGTH*"))
(defparameter *oclo-objc-symbol-names*
'("RETURNING-FOREIGN-STRUCT" "REMOVE-LISP-SLOTS" "OBJC-OBJECT"
"OBJC-METACLASS" "OBJC-CLASS-OBJECT" "OBJC-CLASS" "MAKE-NSSTRING"
"LOAD-FRAMEWORK"))
#-(and)
(dolist (s *oclo-symbol-names*)
(cond
((find-symbol s "CCL") (push s *oclo-ccl-symbol-names*))
((find-symbol s "OBJC") (push s *oclo-objc-symbol-names*))
(t (error "~A is not found in OBJC or CCL" s))))
) ;;eval-when
(defpackage "COM.INFORMATIMAGO.OBJECTIVE-C.LOWER"
(:nicknames "COM.INFORMATIMAGO.OCLO"
......@@ -108,64 +135,18 @@ See source file for details.
(:use "CL")
#+(and ccl objc-support)
(:shadowing-import-from "OBJC" . #.(let ((o '())
(c '()))
(dolist (s *oclo-objc-symbol-names*)
(cond
((find-symbol s "OBJC") (push s o))
((find-symbol s "CCL") (push s c))
(t (error "~A is not found in OBJC or CCL" s))))
(setf *oclo-ccl-symbol-names* c)
o))
(:shadowing-import-from "OBJC" . #.*oclo-objc-symbol-names*)
#+(and ccl objc-support)
(:shadowing-import-from "CCL" . #.*oclo-ccl-symbol-names*)
(:shadowing-import-from "CCL" . #.*oclo-ccl-symbol-names*)
(:export . #.*oclo-symbol-names*)
(:export
"SELF" "SUPER"
;; from objc.
"*OBJC-DESCRIPTION-MAX-LENGTH*"
"@CLASS"
"@SELECTOR"
"DEFINE-OBJC-CLASS-METHOD"
"DEFINE-OBJC-METHOD"
"DEFMETHOD"
"LISP-STRING-FROM-NSSTRING"
"LOAD-FRAMEWORK"
"MAKE-NSSTRING"
"MAKE-OBJC-INSTANCE"
"OBJC-CLASS"
"OBJC-CLASS-OBJECT"
"OBJC-MESSAGE-SEND"
"OBJC-MESSAGE-SEND-STRET"
"OBJC-MESSAGE-SEND-SUPER"
"OBJC-MESSAGE-SEND-SUPER-STRET"
"OBJC-METACLASS"
"OBJC-OBJECT"
"REMOVE-LISP-SLOTS"
"RETURNING-FOREIGN-STRUCT"
"SEND"
"SEND-SUPER"
"SEND-SUPER/STRET"
"SEND/STRET"
"SLET"
"WITH-AUTORELEASE-POOL"
"WITH-AUTORELEASED-NSSTRINGS"
;; from ccl.
#-ccl-1.9 "*COCOA-APPLICATION-FRAMEWORKS*"
"@"
"DEFINE-CLASSNAME-TRANSLATION"
"LISP-TO-OBJC-CLASSNAME"
"LISP-TO-OBJC-MESSAGE"
"OBJC-TO-LISP-CLASSNAME"
"OBJC-TO-LISP-MESSAGE"
"UPDATE-OBJC-METHOD-INFO"
;; implemented in oclo.lisp
;; implemented in oclo.lisp:
"STRET"
;; implemented in oclo-<implementation>.lisp
;; implemented in oclo-<implementation>.lisp:
"LISP-TO-OBJC-CLASSNAME-P"
"OBJC-TO-LISP-CLASSNAME-P"
"*NULL*" "NULLP"
......@@ -177,7 +158,6 @@ basically the ccl Objective-C bridge, in a nifty
single package exporting all these symbols.
"))
(defpackage "COM.INFORMATIMAGO.OBJECTIVE-CL"
(:nicknames "COM.INFORMATIMAGO.OBJCL"
"OBJCL")
......@@ -191,9 +171,9 @@ single package exporting all these symbols.
"ENABLE-OBJCL-READER-MACROS"
"SET-OBJECTIVE-CL-SYNTAX" ; deprecated; use (enable-objc-reader-macros).
"READ-ERROR" "READ-ERROR-CONTROL-STRING" "READ-ERROR-ARGUMENTS"
"OBJC-DEFINITION-READER-MACRO" ; #\@
"OBJC-EXPRESSION-READER-MACRO" ; \#[
"@" ; macro to make NSString literals with unicode.
"OBJC-DEFINITION-READER-MACRO" ; #\@
"OBJC-EXPRESSION-READER-MACRO" ; #\[
"@" ; macro to make NSString literals with unicode.
"OBJC-STRING" "LISP-STRING" #|deprecated:|# "OBJCL-STRING"
"YES" "NO")
(:documentation "
......@@ -201,5 +181,8 @@ This package exports a readtable with a couple of reader macros to
read Objective-C bracketed expressions, and @\"\" strings.
"))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar cl-user::*ccl-readtable* nil)
(defvar com.informatimago.objcl.readtable:*ccl-readtable* cl-user::*ccl-readtable*))
;;;; THE END ;;;;
......@@ -239,18 +239,8 @@ System and distrib are keywords, release is a string."
(:darwin
(when (probe-file "/System/Library/Frameworks/AppKit.framework/AppKit")
(setf distrib :apple))
(let ((hostinfo (shell-command-to-string "hostinfo")))
(when hostinfo
(setf release (with-input-from-string (inp hostinfo)
(loop
:for line = (read-line inp nil nil)
:while line
:when (search "Darwin Kernel Version" line)
:return (let ((release (fourth (words line))))
(subseq release 0 (position #\: release)))
:finally (return :unknown))))
(setf release :unknown))))
#-(or linux darwin windowd)
(setf release (string-trim #(#\newline) (shell-command-to-string "sw_vers -productVersion"))))
#-(or linux darwin window)
(:unknown
(let ((host (trim (shell-command-to-string "hostinfo"))))
(cond
......@@ -261,10 +251,6 @@ System and distrib are keywords, release is a string."
(list system distrib release))))
(defun lisp-implementation-type-keyword ()
"Return the keyword specific to each implementation (as found in *features*),
or else interns the (lisp-implementation-type), with space substituted by dashes
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment