@@ -66,7 +66,7 @@ From demo-app.lisp:

 ** Type-directed Objective-C extractors

  #+name: extractor-framework

- #+begin_src lisp :tangle no :results no

+ #+begin_src lisp :tangle no :results no :comments both

    (defvar *objc-extractors* (list)

      "Functions called to extract specific data types")

@@ -118,33 +118,39 @@ From demo-app.lisp:

      (defun main ()

        <<disable-sbcl-debugger>>

        (make-org-file *standard-output*

-                      (translate-plist 

-                       (get-bookmark-filename))

-                      (get-readinglist-info bookmarks)))

+                      (get-readinglist-info 

+                       (translate-plist 

+                        (get-bookmark-filename)))))

    #+end_src

-   This pair of functions builds an org file from data extracted from the Safari bookmark file.

+   This pair of functions builds an org file from data extracted from the Safari bookmark file. 

    #+name: make-org-file

    #+begin_src lisp :tangle no :results no

-     (defun make-org-file (s bookmarks reading-list-info)

+     (defun make-org-file (s reading-list-info)

        (format s "~&* Safari Reading List~%")

        (serapeum:mapply (serapeum:partial 'make-org-entry s)

                         reading-list-info))

-     (defun make-org-entry (s title url preview tag)

-       (format s "~&** ~a :~{~a:~}~% ~a~2% ~{~<~% ~1,80:;~a~> ~}~%"

-               title (alexandria:ensure-list tag)

+     (defun make-org-entry (s date title url preview tag)

+       (format s "~&** ~a (~a) :~{~a:~}~% ~a~2% ~{~<~% ~1,80:;~a~> ~}~2%"

+               title

+               (local-time:format-timestring nil date

+                                             :format local-time:+rfc3339-format/date-only+)

+               (alexandria:ensure-list tag)

                url

                (serapeum:tokens preview)))

    #+end_src

+   

+   Here we extract the data from Bookmarks.plist using our polymorphic objc data extractor framework

    #+name: translate-plist

    #+begin_src lisp :tangle no :results no

      (defparameter *reading-list-location* "Library/Safari/Bookmarks.plist")

      (defun get-bookmark-filename ()

-       (merge-pathnames *reading-list-location*

-                        (truename "~/")))

+       (uiop:native-namestring

+        (merge-pathnames *reading-list-location*

+                         (truename "~/"))))

      (defun translate-plist (fn)

        (objc-runtime.data-extractors:extract-from-objc

@@ -154,37 +160,30 @@ From demo-app.lisp:

    #+name: translate-data

    #+begin_src lisp :tangle no :results no

      (defun get-readinglist-info (bookmarks)

-       (mapcar 'extract-link-info

-               (gethash "Children"

-                        (car

-                         (select-child bookmarks

-                                       "com.apple.ReadingList")))))

+       (sort (mapcar 'extract-link-info

+                     (gethash "Children"

+                              (car

+                               (select-child bookmarks

+                                             "com.apple.ReadingList"))))

+             'local-time:timestamp>

+             :key 'car))

      (defun extract-link-info (link)

-       (list (fw.lu:pick '("URIDictionary" "title") link)

+       (list (local-time:parse-rfc3339-timestring (or (fw.lu:pick '("ReadingList" "DateAdded") link)

+                                                      (fw.lu:pick '("ReadingList" "DateLastViewed") link)

+                                                      (fw.lu:pick '("ReadingListNonSync" "DateLastFetched") link)

+                                                      (local-time:now)))

+             (fw.lu:pick '("URIDictionary" "title") link)

              (fw.lu:pick '("URLString") link)

              (plump:decode-entities (coerce (fw.lu:pick '("ReadingList" "PreviewText") link) 'simple-string) t)

              (fw.lu:may (slugify (fw.lu:pick '("ReadingListNonSync" "siteName") link)))))

-

-     (defun slugify (s)

-       (cl-ppcre:regex-replace-all "\\s+"

-                                   (string-downcase s)

-                                   "_"))

-

-     (defun select-child (d title)

-       (flet ((get-title (h)

-                (equal (gethash "Title" h)

-                       title)))

-         (fw.lu:let-each (:be *)

-           (gethash "Children" d)

-           (remove-if-not #'get-title *))))

    #+end_src

 ** Appendices

 *** objc-data-extractor.lisp

-    #+begin_src lisp :tangle objc-data-extractors.lisp :noweb yes

+    #+begin_src lisp :tangle objc-data-extractors.lisp :noweb yes :comments both

       (defpackage :objc-runtime.data-extractors

         (:use :cl )

         (:export

@@ -320,10 +319,26 @@ From demo-app.lisp:

       (serapeum:eval-always

         (named-readtables:in-readtable :objc-readtable))

-      <<r-l-r-main>>

-      <<translage-plist>>

+      (defun slugify (s)

+        (cl-ppcre:regex-replace-all "\\s+"

+                                    (string-downcase s)

+                                    "_"))

+

+      (defun select-child (d title)

+        (flet ((get-title (h)

+                 (equal (gethash "Title" h)

+                        title)))

+          (fw.lu:let-each (:be *)

+            (gethash "Children" d)

+            (remove-if-not #'get-title *))))

+

+      <<translate-plist>>

+

       <<make-org-file>>

+

       <<translate-data>>

+

+      <<r-l-r-main>>

     #+end_src

     #+name: disable-sbcl-debugger

new file mode 100644

@@ -0,0 +1,91 @@

+(defpackage :clim-objc-browser

+  (:use :clim-lisp :clim))

+(in-package :clim-objc-browser)

+

+(define-application-frame class-browser ()

+  ((classes :initarg :classes :reader classes)

+   (visible-classes :initform nil :accessor visible-classes)

+   (current-class :initform nil :accessor current-class))

+  (:panes (classes :application

+                   :incremental-redisplay t

+                   :display-function 'display-classes)

+          (methods :application

+                   :incremental-redisplay t

+                   :display-function 'display-methods)

+          (int :interactor))

+  (:pointer-documentation t)

+  (:layouts (default (vertically ()

+                       (horizontally ()

+                         classes methods)

+                       int)))

+  (:default-initargs

+      :classes (sort (remove-if (serapeum:op (alexandria:starts-with #\_

+                                                                     (objc-runtime::objc-class-get-name _)))

+                                (objc-runtime::get-classes))

+                     #'string-lessp

+                     :key 'objc-runtime::objc-class-get-name)))

+

+(defun reset-application-frame ()

+  (setf (visible-classes clim:*application-frame*) nil

+        (current-class clim:*application-frame*) nil

+        (slot-value clim:*application-frame* 'classes)

+        (sort (remove-if (serapeum:op (alexandria:starts-with #\_

+                                                              (objc-runtime::objc-class-get-name _)))

+                         (objc-runtime::get-classes))

+              #'string-lessp

+              :key 'objc-runtime::objc-class-get-name)))

+

+(define-presentation-type objc-class ())

+(define-presentation-method present (object (type objc-class) stream view &key)

+  (declare (ignore view))

+  (format stream "#[OBJC Class: ~a]"

+          (objc-runtime::objc-class-get-name object)))

+

+(define-presentation-type objc-method ())

+(define-presentation-method present (object (type objc-method) stream view &key)

+  (declare (ignore view))

+  (format stream "@(~a)"

+          (objc-runtime::get-method-name object)))

+

+(defun display-classes (frame pane)

+  (updating-output (pane :unique-id (or (visible-classes frame)

+                                        (classes frame))

+                         :id-test 'eq)

+    (loop for class in (or (visible-classes frame)

+                           (classes frame))

+       do

+         (updating-output (pane :unique-id (cffi:pointer-address class)

+                                :id-test 'eql

+                                :cache-value class

+                                :cache-test 'eql)

+           (with-output-as-presentation (pane class 'objc-class)

+             (format pane "~&   ~a~%" (objc-runtime::objc-class-get-name class)))))))

+

+(defun display-methods (frame pane)

+  (updating-output (pane :unique-id (current-class frame)

+                         :id-test 'eq)

+    (when (current-class frame)

+      (loop for method in (sort (objc-runtime::get-methods (current-class frame))

+                                'string<

+                                :key 'objc-runtime::get-method-name)

+         do

+           (with-output-as-presentation (pane method 'objc-method)

+             (format pane "   Method: ~a~%" (objc-runtime::get-method-name method)))))))

+

+(define-class-browser-command (com-get-methods :name t :menu t) ((the-class objc-class :gesture :select))

+  (setf (current-class *application-frame*) the-class))

+

+

+(define-class-browser-command (com-refresh-classes :name t :menu t) ()

+  (reset-application-frame))

+

+(define-class-browser-command (com-filter-classes :name t :menu t) ((prefix string))

+  (setf (visible-classes *application-frame*)

+        (remove-if-not (serapeum:op

+                         (alexandria:starts-with-subseq prefix _ :test #'char-equal))

+                       (classes *application-frame*)

+                       :key 'objc-runtime::objc-class-get-name)))

+

+(defun main ()

+  (clim:run-frame-top-level

+   (clim:make-application-frame 'class-browser)))

@@ -1,3 +1,7 @@

+;; objc-data-extractor.lisp

+

+

+;; [[file:~/git_repos/objc-lisp-bridge/README.org::*objc-data-extractor.lisp][objc-data-extractor.lisp:1]]

 (defpackage :objc-runtime.data-extractors

   (:use :cl )

   (:export

@@ -119,3 +123,4 @@

                    'objc-subclass-p

                    :key 'car)))

     *objc-extractors*))

+;; objc-data-extractor.lisp:1 ends here

@@ -10,10 +10,12 @@

                #:serapeum

                #:fwoar.lisputils

                #:cffi

+               #:cffi-libffi

                #:trivial-main-thread

                #:trivial-features

                #:cffi-libffi)

-  :defsystem-depends-on (#:cffi-grovel)

+  :defsystem-depends-on (#:cffi-grovel

+                         #:cffi-libffi)

   :components ((:file "package")

                (:cffi-grovel-file "objc-runtime-types" :depends-on ("package"))

                (:file "readtable" :depends-on ("package"))

@@ -99,8 +99,10 @@

   (sel o-selector)

   &rest)

-(defun objc-msg-send-nsstring (thing selector &rest args)

-  [(apply 'objc-msg-send thing selector args) @(UTF8String)]s)

+;;; This is a macro, because objc-msg-send is a macro.... which makes "apply" impossible

+;;; \o/

+(defmacro objc-msg-send-nsstring (thing selector &rest args)

+  `[[,thing ,selector ,@args] @(UTF8String)]s)

 (defcfun (class-copy-method-list "class_copyMethodList" :library foundation)

     :pointer

@@ -159,13 +161,12 @@

   (prop :pointer))

 (defun get-classes ()

-  (let ((num-classes (objc-get-class-list (null-pointer) 0)))

+  (let ((num-classes (objc-get-class-list (null-pointer) 0))

+        (result (list)))

     (with-foreign-object (classes :pointer num-classes)

-      (objc-get-class-list classes num-classes)

-      (let ((result (list)))

-        (dotimes (n num-classes (nreverse result))

+      (dotimes (n (objc-get-class-list classes num-classes) (nreverse result))

           (push (mem-aref classes :pointer n)

-                result))))))

+              result)))))

 (defgeneric get-methods (class)

   (:method ((class string))

@@ -196,6 +197,9 @@

 (defun extract-nsstring (ns-str)

   [ns-str @(UTF8String)]s)

+(defun get-method-name (method)

+  (sel-get-name (method-get-name method)))

+

 (defun get-method-names (thing)

   (mapcar (alexandria:compose #'sel-get-name

                               #'method-get-name)

@@ -6,46 +6,69 @@

 (serapeum:eval-always

   (named-readtables:in-readtable :objc-readtable))

-(defun main ()

-  #+(and build sbcl)

-  (progn (sb-ext:disable-debugger)

-         (sb-alien:alien-funcall

-          (sb-alien:extern-alien "disable_lossage_handler"

-                                 (function sb-alien:void))))

-  (make-org-file *standard-output*

-                 (translate-plist (get-bookmark-filename))))

+(defun slugify (s)

+  (cl-ppcre:regex-replace-all "\\s+"

+                              (string-downcase s)

+                              "_"))

+

+(defun select-child (d title)

+  (flet ((get-title (h)

+           (equal (gethash "Title" h)

+                  title)))

+    (fw.lu:let-each (:be *)

+      (gethash "Children" d)

+      (remove-if-not #'get-title *))))

+

+(defparameter *reading-list-location* "Library/Safari/Bookmarks.plist")

+(defun get-bookmark-filename ()

+  (uiop:native-namestring

+   (merge-pathnames *reading-list-location*

+                    (truename "~/"))))

+

+(defun translate-plist (fn)

+  (objc-runtime.data-extractors:extract-from-objc

+   (objc-runtime.data-extractors:get-plist fn)))

-(defun make-org-file (s bookmarks)

+(defun make-org-file (s reading-list-info)

   (format s "~&* Safari Reading List~%")

   (serapeum:mapply (serapeum:partial 'make-org-entry s)

-                   (get-readinglist-info bookmarks)))

-(defun make-org-entry (s title url preview tag)

-  (format s "~&** ~a :~{~a:~}~% ~a~2% ~{~<~% ~1,80:;~a~> ~}~%"

-          title (alexandria:ensure-list tag)

+                   reading-list-info))

+

+(defun make-org-entry (s date title url preview tag)

+  (format s "~&** ~a (~a) :~{~a:~}~% ~a~2% ~{~<~% ~1,80:;~a~> ~}~2%"

+          title

+          (local-time:format-timestring nil date

+                                        :format local-time:+rfc3339-format/date-only+)

+          (alexandria:ensure-list tag)

           url

           (serapeum:tokens preview)))

+

 (defun get-readinglist-info (bookmarks)

-  (mapcar 'extract-link-info

+  (sort (mapcar 'extract-link-info

           (gethash "Children"

                    (car

                     (select-child bookmarks

-                                  "com.apple.ReadingList")))))

+                                        "com.apple.ReadingList"))))

+        'local-time:timestamp>

+        :key 'car))

 (defun extract-link-info (link)

-  (list (fw.lu:pick '("URIDictionary" "title") link)

+  (list (local-time:parse-rfc3339-timestring (or (fw.lu:pick '("ReadingList" "DateAdded") link)

+                                                 (fw.lu:pick '("ReadingList" "DateLastViewed") link)

+                                                 (fw.lu:pick '("ReadingListNonSync" "DateLastFetched") link)

+                                                 (local-time:now)))

+        (fw.lu:pick '("URIDictionary" "title") link)

         (fw.lu:pick '("URLString") link)

         (plump:decode-entities (coerce (fw.lu:pick '("ReadingList" "PreviewText") link) 'simple-string) t)

         (fw.lu:may (slugify (fw.lu:pick '("ReadingListNonSync" "siteName") link)))))

-(defun slugify (s)

-  (cl-ppcre:regex-replace-all "\\s+"

-                              (string-downcase s)

-                              "_"))

-

-(defun select-child (d title)

-  (flet ((get-title (h)

-           (equal (gethash "Title" h)

-                  title)))

-    (fw.lu:let-each (:be *)

-      (gethash "Children" d)

-      (remove-if-not #'get-title *))))

+(defun main ()

+  #+(and build sbcl)

+  (progn (sb-ext:disable-debugger)

+         (sb-alien:alien-funcall

+          (sb-alien:extern-alien "disable_lossage_handler"

+                                 (function sb-alien:void))))

+  (make-org-file *standard-output*

+                 (get-readinglist-info 

+                  (translate-plist 

+                   (get-bookmark-filename)))))