@@ -29,4 +29,5 @@ demo.app

 NSRect-Expose

 *.nib

 .*.sw?

-venv

\ No newline at end of file

+venv

+/reading-list2org

@@ -8,7 +8,7 @@ dylib: nsrect-expose.m

 demo-app: dylib

 	$(CCL) --load ~/quicklisp/setup.lisp \

-           --load save.lisp

+		   --load save.lisp

 demo-app.iconset: demo-app.svg

 	rm -rf demo-app.iconset

@@ -153,13 +153,14 @@

            :pointer p])))

 ;#+null

-(defun main ()

+(defun old-code ()

   #+sbcl

   (sb-int:set-floating-point-modes :traps '())

   (trivial-main-thread:with-body-in-main-thread (:blocking t)

     [#@NSAutoReleasePool @(new)]

     [#@NSApplication @(sharedApplication)]

+    #+nil

     [objc-runtime::ns-app @(setActivationPolicy:) :int 0]

     ;; Setup the app delegate class. We register this one because it's useful

@@ -187,39 +188,47 @@

 (defparameter *application-shim* (make-instance 'application-shim))

-;#+nil

-(defun old-code ()

-  #+null

+                                        ;#+nil

+(defun main ()

+  (load "~/quicklisp/setup.lisp")

+  (funcall (intern "QUICKLOAD" (find-package :QL)) :swank)

+  (funcall (intern "CREATE-SERVER" (find-package :swank)) :port 5060 :dont-close t)

+

   (trivial-main-thread:with-body-in-main-thread (:blocking t)

-    (sb-int:with-float-traps-masked

-     (:underflow :overflow :inexact

-                 :invalid :divide-by-zero)))

-  [#@NSAutoReleasePool @(new)]

-  [#@NSApplication @(sharedApplication)]

-  [objc-runtime::ns-app @(setActivationPolicy) :int 0]

-

-  (let* ((application-name [[#@NSProcessInfo @(processInfo)] @(processName)]))

-    (let* ((menubar [[#@NSMenu @(new)] @(autorelease)])

-           (app-menu-item [[#@NSMenuItem @(new)] @(autorelease)])

-           (app-menu [[#@NSMenu @(new)] @(autorelease)])

-           (quit-name [[#@NSString @(alloc)] @(initWithEncoding) :string "Quit" :uint 4])

-           (key [[#@NSString @(alloc)] @(initWithCString:length:) :string "q" :uint 1])

-           (quit-menu-item

-            [[[#@NSMenuItem @(alloc)] @(initWithTitle:action:keyEquivalent:) :pointer quit-name :pointer @(terminate?) :string key] @(autorelease)]))

-      [menubar @(addItem:) :pointer app-menu-item]

-      [app-menu @(addItem:) :pointer quit-menu-item]

-      [app-menu-item @(setSubmenu:) :pointer app-menu]

-      [objc-runtime::ns-app @(setMainMenu:) :pointer menubar] )

-

-    (setf (main-view *application-shim*)

-          [#@NSStackView @(stackViewWithViews:) :pointer [[#@NSArray @(alloc)] @(init)]])

-    (with-point (p (20 20))

-      (let* ((foreign-rect (make-rect 10 10 120 120))

-             (the-window (init-window [#@NSWindow @(alloc)] foreign-rect 1 2 nil)))

-        

-        [(value-for-key the-window "contentView") @(addSubview:) :pointer (main-view *application-shim*)]

-        [the-window @(cascadeTopLeftFromPoint:) :pointer p]

-        [the-window @(setTitle:) :pointer application-name]

-        [the-window @(makeKeyAndOrderFront:) :pointer (cffi:null-pointer)]

-        [ objc-runtime::ns-app @(activateIgnoringOtherApps:) :boolean t]

-        [ objc-runtime::ns-app @(run)]))))

+    #+sbcl

+    (sb-int:set-floating-point-modes :traps '())

+

+    [#@NSAutoReleasePool @(new)]

+    [#@NSApplication @(sharedApplication)]

+

+    (format t "~&app: ~s~%" objc-runtime::ns-app)

+    #+nil

+    [objc-runtime::ns-app @(setActivationPolicy) :int 0]

+

+    (let* ((application-name [[#@NSProcessInfo @(processInfo)] @(processName)]))

+      (let* ((menubar [[#@NSMenu @(new)] @(autorelease)])

+             (app-menu-item [[#@NSMenuItem @(new)] @(autorelease)])

+             (app-menu [[#@NSMenu @(new)] @(autorelease)])

+             (quit-name @"Quit")

+             (key @"q")

+             (quit-menu-item

+              [[[#@NSMenuItem @(alloc)]

+                @(initWithTitle:action:keyEquivalent:) :pointer quit-name :pointer @(terminate?) :string key]

+               @(autorelease)]))

+        [menubar @(addItem:) :pointer app-menu-item]

+        [app-menu @(addItem:) :pointer quit-menu-item]

+        [app-menu-item @(setSubmenu:) :pointer app-menu]

+        [objc-runtime::ns-app @(setMainMenu:) :pointer menubar] )

+

+      (setf (main-view *application-shim*)

+            [#@NSStackView @(stackViewWithViews:) :pointer [[#@NSArray @(alloc)] @(init)]])

+      (with-point (p (20 20))

+        (let* ((foreign-rect (make-rect 10 10 120 120))

+               (the-window (init-window [#@NSWindow @(alloc)] foreign-rect 1 2 nil)))

+          

+          [(value-for-key the-window "contentView") @(addSubview:) :pointer (main-view *application-shim*)]

+          [the-window @(cascadeTopLeftFromPoint:) :pointer p]

+          [the-window @(setTitle:) :pointer application-name]

+          [the-window @(makeKeyAndOrderFront:) :pointer (cffi:null-pointer)]

+          [ objc-runtime::ns-app @(activateIgnoringOtherApps:) :boolean t]

+          [ objc-runtime::ns-app @(run)])))))

@@ -33,6 +33,3 @@

        (declare (ignorable ,context-sym))

        ,@body)

      (define-symbol-macro ,name (callback ,name))))

-

-(def-gcd-callback foo-callback (context)

-  (demo-app::show-alert "Uh-oh"))

@@ -10,7 +10,7 @@

   (define-foreign-library appkit

     (:darwin (:framework "AppKit")))

   (define-foreign-library expose-stuff

-    (:darwin #p"./libnsrect-expose.dylib")))

+    (:darwin #p"libnsrect-expose.dylib")))

 (use-foreign-library foundation)

@@ -193,6 +193,8 @@

 (defun make-nsstring (str)

   [[#@NSString @(alloc)] @(initWithCString:encoding:) :string str :uint 1])

+(defun extract-nsstring (ns-str)

+  [ns-str @(UTF8String)]s)

 (defun get-method-names (thing)

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

new file mode 100644

@@ -0,0 +1,132 @@

+#+build

+(eval-when (:compile-toplevel :load-toplevel :execute)

+  (setf *default-pathname-defaults* (truename "~/git_repos/objc-lisp-bridge/"))

+  (load (compile-file "objc-runtime.asd")))

+

+#+build

+(eval-when (:compile-toplevel :load-toplevel :execute)

+  (ql:quickload '(:objc-runtime :yason :plump :cl-ppcre)))

+

+(defpackage :reading-list-reader

+  (:use :cl )

+  (:export ))

+(in-package :reading-list-reader)

+

+(serapeum:eval-always

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

+

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

+

+(defun get-plist (file)

+  [#@NSDictionary @(dictionaryWithContentsOfFile:)

+                  :pointer (objc-runtime::make-nsstring file)])

+

+

+(defun objc-isa (obj class)

+  (unless (or (cffi:null-pointer-p obj)

+              (cffi:null-pointer-p class))

+    (= [obj @(isKindOfClass:) :pointer class]#

+       1)))

+

+(serapeum:eval-always

+  (defun make-cases (cases obj)

+    (mapcar (serapeum:op

+              `(if (objc-isa ,obj ,(car _1))

+                   (progn ,@(cdr _1))))

+            cases)))

+

+(defmacro objc-typecase (form &body ((case-type &body case-handler) &rest cases))

+  (alexandria:once-only (form)

+    (let* ((initial-cases `((,case-type ,@case-handler) ,@(butlast cases)))

+           (cases (fw.lu:rollup-list (make-cases initial-cases form)

+                                     (if (eql t (caar (last cases)))

+                                         `((progn ,@(cdar (last cases))))

+                                         (make-cases (last cases) form)))))

+      cases)))

+

+(defun map-nsarray (fn arr)

+  (unless (and (cffi:pointerp arr)

+               (objc-isa arr #@NSArray))

+    (error "must provide a NSArray pointer"))

+  (loop for x below [arr @(count)]#

+       collect (funcall fn [arr @(objectAtIndex:) :int x])))

+

+(defun nsarray-contents (arr)

+  (unless (and (cffi:pointerp arr)

+               (objc-isa arr #@NSArray))

+    (error "must provide a NSArray pointer"))

+  (dotimes (n [arr @(count)]#)

+    (let ((obj [arr @(objectAtIndex:) :int n ]))

+      (objc-typecase obj

+        (#@NSString (format t "~&string~%"))

+        (#@NSArray (format t "~&array~%"))

+        (#@NSDictionary (format t "~&dictionary~%"))

+        (t (format t "~&other... ~s~%" (objc-runtime::objc-class-get-name

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

+

+(defun extract-from-objc (obj)

+  (objc-typecase obj

+    (#@NSDate [[[[#@NSISO8601DateFormatter @(alloc)]

+                 @(init)]

+                @(stringFromDate:) :pointer obj]

+               @(UTF8String)]s)

+    (#@NSString [obj @(UTF8String)]s)

+    (#@NSNumber (parse-number:parse-number

+                 (objc-runtime::extract-nsstring

+                  [obj @(stringValue)])))

+    (#@NSArray (map-nsarray #'extract-from-objc obj))

+    (#@NSDictionary (fw.lu:alist-string-hash-table

+                     (pairlis (map-nsarray #'extract-from-objc [obj @(allKeys)])

+                              (map-nsarray #'extract-from-objc [obj @(allValues)]))))

+    (t (format *error-output* "~&other... ~s~%" (objc-runtime::objc-class-get-name

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

+

+(defun extract-nsdictionary (nsdict)

+  (yason:with-output (*standard-output* :indent t)

+    (maphash 'yason:encode-object-element

+             (extract-from-objc nsdict))))

+

+(defun select-child (d title)

+  (remove-if-not (serapeum:op

+                   (equal (gethash "Title" _)

+                          title))

+                 (gethash "Children" d)))

+

+(defun slugify (s)

+  (when s

+    (cl-ppcre:regex-replace-all "\\s+" (string-downcase s) "_")))

+

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

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

+          title (alexandria:ensure-list tag)

+          url

+          (serapeum:tokens preview)))

+

+(defun get-readinglist-info (bookmarks)

+  (mapcar (serapeum:juxt

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

+           (fw.lu:op (fw.lu:pick '("URLString") _))

+           (fw.lu:op (plump:decode-entities (coerce (fw.lu:pick '("ReadingList" "PreviewText") _)

+                                                    'simple-string)

+                                            t))

+           (fw.lu:op (slugify (fw.lu:pick '("ReadingListNonSync" "siteName") _))))

+          (gethash "Children"

+                   (car

+                    (select-child bookmarks "com.apple.ReadingList")))))

+

+

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

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

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

+                   (get-readinglist-info bookmarks)))

+

+(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*

+                 (extract-from-objc (get-plist (uiop:unix-namestring (truename *reading-list-location*))))))

+

+#+build

+(sb-ext:save-lisp-and-die "reading-list2org" :toplevel 'main :executable t)