Updated TODO and changed how we find the location where we have to build the doc
Tue Oct 2 19:29:42 PDT 2007 matley@muppetslab.org
* Updated TODO and changed how we find the location where we have to build the doc
diff -rN -u old-cl-objc/TODO new-cl-objc/TODO
--- old-cl-objc/TODO 2014-07-30 08:09:47.000000000 -0700
+++ new-cl-objc/TODO 2014-07-30 08:09:47.000000000 -0700
@@ -1,26 +1,34 @@
;; -*- outline -*-
* Docs & Examples
-** Update the docs: Improve the clos section, call to super, add a tutorial on the clos interface, extract a README file
+** Update the docs: Improve the clos section, call to super, add a tutorial on the clos interface, extract a README file, update the framework management documentation
-** Add more examples (one using the clos interface)
+** Add other two examples: one using the clos interface, one with a cool Cocoa widget
** Use cl-launch for the examples
* New minor features
+** when types of args are available, method should be specialized on the corresponding lisp types. actually they are just ignored
+
** Make ensure-objc-class try to add the ivars to a class if the definition is the same as previous
** Support for Variadic ObjC methods
** Remove warning from test suite :lisp-objc
+** Change objc-let such that it doesn't need a quoted class name argument
+
* New major features
+** C Function to pass argument of struct type by value to function
+
** Define a variadic defun to call foreign functions instead of using a variadic macro
** Complete the ObjC CLOS interface (objc ivars in slots, mixed slots, defmethod mixed)
-** Let user add effective protocols to classes
+** @protocol feature
** Integration with XCode
+
+** Package installer for easy deployment of cl-objc
diff -rN -u old-cl-objc/cl-objc.asd new-cl-objc/cl-objc.asd
--- old-cl-objc/cl-objc.asd 2014-07-30 08:09:47.000000000 -0700
+++ new-cl-objc/cl-objc.asd 2014-07-30 08:09:47.000000000 -0700
@@ -26,13 +26,18 @@
"cffi"
"msg-send"
"lisp-interface"
- "structs")))))
+ "structs"))
+ (:module :frameworks)))
+ (:module :doc
+ :components ((:file "docstrings")
+ (:module :include))))
:depends-on (:cffi :yacc :closer-mop :memoize))
(defsystem cl-objc.examples
:components ((:module :examples
:components ((:file "hello-world")
- (:file "converter"))))
+ (:file "converter")
+ (:file "circle-view"))))
:depends-on (:cl-objc :swank))
(defparameter *framework-directory* nil)
@@ -45,11 +50,16 @@
"frameworks"))))
(defmethod asdf:perform :after ((op asdf:load-op) (system (eql (find-system 'cl-objc))))
- (asdf:oos 'asdf:load-op 'cl-objc.doc)
+ ;; Compile documentation
(dolist (package (mapcar 'find-package '("OBJC-CFFI" "OBJC-CLOS" "OBJC-READER" "CL-OBJC")))
(funcall (intern "DOCUMENT-PACKAGE" "SB-TEXINFO")
package
- (make-pathname :directory (symbol-value (intern "*DOC-DIR*" "CL-OBJC-UTILS"))
+ (make-pathname :directory
+ (pathname-directory
+ (asdf:component-pathname
+ (asdf:find-component
+ (asdf:find-component system "doc")
+ "include")))
:name (package-name package)
:type "texinfo"))))
diff -rN -u old-cl-objc/examples/circle-view.lisp new-cl-objc/examples/circle-view.lisp
--- old-cl-objc/examples/circle-view.lisp 1969-12-31 16:00:00.000000000 -0800
+++ new-cl-objc/examples/circle-view.lisp 2014-07-30 08:09:47.000000000 -0700
@@ -0,0 +1,202 @@
+;;; This example has been translated from one provided by Apple in the
+;;; default XCode SDK
+
+(in-package "CL-OBJC-EXAMPLES")
+
+(import-framework "Foundation")
+
+(defun make-range (location length)
+ (slet ((range ns-range))
+ (setf (ns-range-location range) location
+ (ns-range-length range) length)
+ range))
+
+(defun make-point (x y)
+ (slet ((p ns-point))
+ (setf (ns-point-x p) x
+ (ns-point-y p) y)
+ p))
+
+(defun max-range (range)
+ (slet ((r ns-range range))
+ (+ (ns-range-location r) (ns-range-length r))))
+
+(defun make-nsstring (string)
+ (invoke (invoke 'ns-string alloc) :init-with-utf8-string string))
+
+(import-framework "AppKit")
+
+(import-framework "Cocoa")
+
+(define-objc-class circle-view ns-view
+ ((center ns-point)
+ (radius :float)
+ (starting-angle :float)
+ (angular-velocity :float)
+ (text-storage ns-text-storage)
+ (layout-manager ns-layout-manager)
+ (text-container ns-text-container)
+ (timer ns-timer)
+ (last-time ns-time-interval)))
+
+(define-objc-method :init-with-frame () ((self circle-view) (frame ns-rect))
+ (with-super
+ (invoke self :init-with-frame frame))
+ (with-ivar-accessors circle-view
+ (setf (objc-struct-slot-value (center self) 'ns-point 'x)
+ (objc-struct-slot-value (objc-struct-slot-value frame 'ns-rect 'size) 'ns-size 'width)
+ (objc-struct-slot-value (center self) 'ns-point 'y)
+ (objc-struct-slot-value (objc-struct-slot-value frame 'ns-rect 'size) 'ns-size 'height)
+ (radius self) 115.0
+ (starting-angle self) (* 2 (atan 1))
+ (angular-velocity self) (* 2 (atan 1))))
+ (objc-let ((text-storage 'ns-text-storage :init-with-string (make-nsstring "Here's to the crazy ones, the misfits, the rebels, the troublemakers, the round pegs in the square holes, the ones who see things differently.")))
+ (objc-letr ((layout-manager 'ns-layout-manager init)
+ (text-container 'ns-text-container init))
+ (invoke layout-manager :add-text-container text-container)
+ (invoke text-storage :add-layout-manager layout-manager)
+ (invoke layout-manager :set-uses-screen-fonts 0)
+ self)))
+
+(define-objc-method dealloc (:return-type :void) ((self circle-view))
+ (with-ivar-accessors circle-view
+ (invoke (timer self) invalidate)
+ (invoke (timer self) release)
+ (invoke (text-storage self) release)
+ (with-super (invoke self dealloc))))
+
+(define-objc-method :draw-rect (:return-type :void) ((self circle-view) (rect ns-rect))
+ (declare (ignore rect))
+ (invoke (invoke 'ns-color white-color) set)
+ (with-ivar-accessors circle-view
+ (ns-rect-fill (invoke self bounds))
+ (slet* ((glyph-range ns-range (invoke (layout-manager self) :glyph-range-for-text-container (text-container self)))
+ (used-rect ns-rect (invoke (layout-manager self) :user-rect-for-text-container (text-container self)))
+ (size ns-size (ns-rect-size used-rect)))
+ (loop
+ for glyph-index = (ns-range-location glyph-range) then (incf glyph-index)
+ while (< glyph-index (max-range glyph-range))
+ for context = (invoke 'ns-graphics-context current-context)
+ for transform = (invoke 'ns-affine-transformation transform)
+ do
+ (slet* ((layout-location ns-point (invoke (layout-manager self) :location-for-glyph-at-index glyph-index))
+ (line-fragment-rect ns-rect (invoke (layout-manager self)
+ :line-fragment-rect-for-glyph-at-index glyph-index
+ :effective-range 0))
+ (view-location ns-point)
+ (origin ns-point (ns-rect-origin line-fragment-rect)))
+ (incf (ns-point-x layout-location) (ns-point-x origin))
+ (incf (ns-point-y layout-location) (ns-point-y origin))
+ (let* ((distance (+ (radius self)
+ (ns-size-height size)
+ (- (ns-point-y layout-location))))
+ (angle (+ (starting-angle self)
+ (/ (ns-point-x layout-location) distance))))
+ (setf (ns-point-x view-location) (+ (ns-point-x (center self))
+ (* distance (sin angle)))
+ (ns-point-y view-location) (+ (ns-point-y (center self))
+ (* distance (cos angle))))
+ (invoke transform :translate-x-by (ns-point-x view-location) :y-by (ns-point-y view-location))
+ (invoke transform :rotate-by-radians (- angle))
+ (invoke context save-graphics-state)
+ (invoke transform concat)
+ (invoke (layout-manager self)
+ :draw-glyphs-for-glyph-range (make-range glyph-index 1)
+ :at-point (make-point (- (ns-point-x layout-location)) (- (ns-point-y layout-location))))
+ (invoke context restore-graphics-state)))))))
+
+(define-objc-method is-opaque (:return-type :boolean) ((self circle-view))
+ t)
+
+(define-objc-method :mouse-down (:return-type :void) ((self circle-view) (event ns-event))
+ (with-ivar-accessors circle-view
+ (slet ((event-location ns-point (invoke event location-in-window)))
+ (setf (center self) (invoke self :convert-point event-location :from-view objc-nil-object))
+ (invoke self :set-needs-displays t))))
+
+(define-objc-method :mouse-dragged (:return-type :void) ((self circle-view) (event ns-event))
+ (with-ivar-accessors circle-view
+ (slet ((event-location ns-point (invoke event location-in-window)))
+ (setf (center self) (invoke self :convert-point event-location :from-view objc-nil-object))
+ (invoke self :set-needs-displays t))))
+
+(define-objc-method :set-color (:return-type :void) ((self circle-view) (color ns-color))
+ (with-ivar-accessors circle-view
+ (invoke (text-storage self)
+ :add-attribute *ns-foreground-color-attribute-name*
+ :value color :range (make-range 0 (invoke (text-storage self) length)))
+ (invoke self :set-needs-displays t)))
+
+(define-objc-method :set-radius (:return-type :void) ((self circle-view) (distance :float))
+ (with-ivar-accessors circle-view
+ (setf (radius self) distance)
+ (invoke self set-needs-display t)))
+
+(define-objc-method :set-starting-angle (:return-type :void) ((self circle-view) (distance :float))
+ (with-ivar-accessors circle-view
+ (setf (starting-angle self) distance)
+ (invoke self set-needs-display t)))
+
+(define-objc-method :set-angular-velocity (:return-type :void) ((self circle-view) (velocity :float))
+ (with-ivar-accessors circle-view
+ (setf (angular-velocity self) velocity)
+ (invoke self set-needs-display t)))
+
+(define-objc-method :set-string (:return-type :void) ((self circle-view) (string ns-string))
+ (with-ivar-accessors circle-view
+ (invoke (text-storage self)
+ :replace-characters-in-range (make-range 0 (invoke (text-storage self)))
+ :with-string string)
+ (invoke self set-needs-display t)))
+
+(define-objc-method :take-color-form () ((self circle-view) (sender objc-id))
+ (invoke self :set-color (invoke sender color)))
+
+(define-objc-method :take-radius-from () ((self circle-view) (sender objc-id))
+ (invoke self set-radius (invoke sender float-value)))
+
+(define-objc-method :take-starting-angle-from () ((self circle-view) (sender objc-id))
+ (invoke self set-starting-angle (invoke sender float-value)))
+
+(define-objc-method :take-angular-velocity-from () ((self circle-view) (sender objc-id))
+ (invoke self set-angular-velocity (invoke sender float-value)))
+
+(define-objc-method :take-string-from () ((self circle-view) (sender objc-id))
+ (invoke self set-string (invoke sender string-value)))
+
+(define-objc-method :start-animation () ((self circle-view) (sender objc-id))
+ (invoke self :stop-animation sender)
+ (let ((timer (invoke
+ (invoke 'ns-timer :scheduled-timer-with-time-interval (/ 1.0 30) :target self :selector (selector :perform-animation) :user-info objc-nil-class :repeats t)
+ retain)))
+ (invoke (invoke 'ns-run-loop current-run-loop) :add-timer timer :for-mode *ns-modal-panel-run-loop-mode*)
+ (invoke (invoke 'ns-run-loop current-run-loop) :add-timer timer :for-mode *ns-event-tracking-run-loop-mode*)
+ (with-ivar-accessors circle-view
+ (setf (last-time self) (invoke 'ns-date time-interval-since-reference-date)))))
+
+(define-objc-method :stop-animation () ((self circle-view) (sender objc-id))
+ (declare (ignore sender))
+ (with-ivar-accessors circle-view
+ (invoke (timer self) invalidate)
+ (invoke (timer self) release)
+ (setf (timer self) objc-nil-object)))
+
+(define-objc-method :toggle-animation () ((self circle-view) (sender objc-id))
+ (with-ivar-accessors circle-view
+ (if (objc-nil-object-p (timer self))
+ (invoke self :start-animation sender)
+ (invoke self :stop-animation sender))))
+
+(define-objc-method :perform-animation (:return-type :void) ((self circle-view) (a-timer ns-timer))
+ (declare (ignore a-timer))
+ (with-ivar-accessors circle-view
+ (let ((this-time (invoke 'ns-date time-interval-since-reference-date)))
+ (invoke self :set-starting-angle (+ (starting-angle self)
+ (* (angular-velocity self)
+ (- this-time (last-time self)))))
+ (setf (last-time self) (float this-time 1.0)))))
+
+(defun circle-view ()
+ (invoke 'ns-application shared-application)
+ (invoke 'ns-bundle :load-nib-named (lisp-string-to-nsstring "MainMenu") :owner *nsapp*)
+ (invoke *nsapp* run))
\ No newline at end of file
diff -rN -u old-cl-objc/src/lisp-interface.lisp new-cl-objc/src/lisp-interface.lisp
--- old-cl-objc/src/lisp-interface.lisp 2014-07-30 08:09:47.000000000 -0700
+++ new-cl-objc/src/lisp-interface.lisp 2014-07-30 08:09:47.000000000 -0700
@@ -210,10 +210,11 @@
If CLASS-METHOD is true then a class method will be added.
-ARGUMENT-LIST is a list of list with two elements. The first
-one is the name of the argument, while the second is its CFFI
+ARGUMENT-LIST is a list of list with two elements. The first one
+is the name of the argument, while the second is its ObjectiveC
type. The first pair has to have as first element the symbol self
-and as second element the class which the method will be added to.
+and as second element the class which the method will be added
+to.
In BODY is also bound the symbol `SEL` pointing to the
selector.
diff -rN -u old-cl-objc/src/utils.lisp new-cl-objc/src/utils.lisp
--- old-cl-objc/src/utils.lisp 2014-07-30 08:09:47.000000000 -0700
+++ new-cl-objc/src/utils.lisp 2014-07-30 08:09:47.000000000 -0700
@@ -69,10 +69,5 @@
`(mapcar ,(car fns) ,list)
`(composite-mapcar (mapcar ,(car fns) ,list) ,@(cdr fns))))
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defparameter *doc-dir* (append
- (butlast (pathname-directory (or *load-pathname* *compile-file-pathname*)))
- (list "doc" "include"))))
-
(defun gensym-list (n)
(loop for i upto n collecting (gensym)))
\ No newline at end of file