Browse code
feature: add utilities for getting mac directories
Ed Langley authored on 21/10/2019 07:17:08Showing 3 changed files
| 1 | 1 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,107 @@ |
| 1 |
+(in-package :objc-runtime.bundle-utils) |
|
| 2 |
+(named-readtables:in-readtable :objc-readtable) |
|
| 3 |
+ |
|
| 4 |
+(defun bundle-resource-root () |
|
| 5 |
+ (uiop:ensure-directory-pathname |
|
| 6 |
+ [[[#@NSBundle @(mainBundle)] @(resourceURL)] @(fileSystemRepresentation)]s)) |
|
| 7 |
+ |
|
| 8 |
+(defun application-support-directory (&optional (scope :user)) |
|
| 9 |
+ (let ((next-step (make-pathname :directory (list :relative (objc-runtime.data-extractors:extract-from-objc |
|
| 10 |
+ [[[#@NSBundle @(mainBundle)] |
|
| 11 |
+ @(infoDictionary)] |
|
| 12 |
+ @(objectForKey:) |
|
| 13 |
+ :pointer @"CFBundleIdentifier"]))))) |
|
| 14 |
+ (car |
|
| 15 |
+ (mapcan (alexandria:compose 'serapeum:unsplice |
|
| 16 |
+ (lambda (p) (when p (merge-pathnames next-step p))) |
|
| 17 |
+ 'probe-file) |
|
| 18 |
+ (mapcar (lambda (it) [it @(fileSystemRepresentation)]?s) |
|
| 19 |
+ (objc-runtime.data-extractors:extract-from-objc |
|
| 20 |
+ [[#@NSFileManager @(defaultManager)] @(URLsForDirectory:inDomains:) |
|
| 21 |
+ :int 14 ;; NSApplicationSupportDirectory |
|
| 22 |
+ :int (ccase scope |
|
| 23 |
+ (:user 1) |
|
| 24 |
+ (:local 2) |
|
| 25 |
+ (:network 4))])))))) |
|
| 26 |
+ |
|
| 27 |
+(defun setup-bundle-logical-pathnames () |
|
| 28 |
+ (setf (logical-pathname-translations "BUNDLE") |
|
| 29 |
+ `(("BUNDLE:RESOURCES;**;*.*.*" ,(bundle-resource-root))
|
|
| 30 |
+ ("BUNDLE:SUPPORT;USER;**;*.*.*" ,(application-support-directory :user))
|
|
| 31 |
+ ("BUNDLE:SUPPORT;LOCAL;**;*.*.*" ,(application-support-directory :local)))))
|
|
| 32 |
+ |
|
| 33 |
+(defun ensure-application-support () |
|
| 34 |
+ (setup-bundle-logical-pathnames) |
|
| 35 |
+ (translate-logical-pathname |
|
| 36 |
+ (ensure-directories-exist |
|
| 37 |
+ #P"BUNDLE:APPLICATION-SUPPORT;USER;"))) |
|
| 38 |
+ |
|
| 39 |
+(named-readtables:defreadtable config |
|
| 40 |
+ (:case :preserve) |
|
| 41 |
+ (:syntax-from :standard #\) #\)) |
|
| 42 |
+ (:macro-char #\( (lambda (s c) |
|
| 43 |
+ c |
|
| 44 |
+ (read-delimited-list #\) s t)) |
|
| 45 |
+ nil) |
|
| 46 |
+ (:macro-char #\, (lambda (s c) |
|
| 47 |
+ c |
|
| 48 |
+ (values)) |
|
| 49 |
+ nil) |
|
| 50 |
+ (:syntax-from :standard #\" #\") |
|
| 51 |
+ (:syntax-from :standard #\: #\:) |
|
| 52 |
+ (:syntax-from :standard #\) #\}) |
|
| 53 |
+ (:macro-char #\{ (lambda (s c)
|
|
| 54 |
+ c |
|
| 55 |
+ (alexandria:plist-hash-table (read-delimited-list #\} s t) |
|
| 56 |
+ :test 'equal)) |
|
| 57 |
+ nil) |
|
| 58 |
+ (:syntax-from :standard #\) #\]) |
|
| 59 |
+ (:macro-char #\[ (lambda (s c) |
|
| 60 |
+ c |
|
| 61 |
+ (apply #'vector (read-delimited-list #\] s t))) |
|
| 62 |
+ nil)) |
|
| 63 |
+ |
|
| 64 |
+(defparameter *config-pprint* |
|
| 65 |
+ (copy-pprint-dispatch)) |
|
| 66 |
+ |
|
| 67 |
+(set-pprint-dispatch 'hash-table |
|
| 68 |
+ (lambda (s hash-table) |
|
| 69 |
+ (pprint-logical-block (s nil) |
|
| 70 |
+ (princ "{" s)
|
|
| 71 |
+ (let ((v (fset:convert 'list (fset:convert 'fset:map hash-table)))) |
|
| 72 |
+ (when v |
|
| 73 |
+ (pprint-logical-block (s v) |
|
| 74 |
+ (pprint-indent :block 0 s) |
|
| 75 |
+ (loop do |
|
| 76 |
+ (destructuring-bind (key . value) (pprint-pop) |
|
| 77 |
+ (format s "~s ~s" key value) |
|
| 78 |
+ (pprint-exit-if-list-exhausted) |
|
| 79 |
+ (princ ", " s) |
|
| 80 |
+ (pprint-newline :linear s)))))) |
|
| 81 |
+ (princ #\} s))) |
|
| 82 |
+ 1 *config-pprint*) |
|
| 83 |
+ |
|
| 84 |
+(set-pprint-dispatch 'vector |
|
| 85 |
+ (lambda (s vector) |
|
| 86 |
+ (pprint-logical-block (s nil) |
|
| 87 |
+ (princ "[" s) |
|
| 88 |
+ (let ((v (coerce vector 'list))) |
|
| 89 |
+ (when v |
|
| 90 |
+ (pprint-logical-block (s v) |
|
| 91 |
+ (pprint-indent :block 0 s) |
|
| 92 |
+ (loop do |
|
| 93 |
+ (prin1 (pprint-pop) s) |
|
| 94 |
+ (pprint-exit-if-list-exhausted) |
|
| 95 |
+ (princ ", " s) |
|
| 96 |
+ (pprint-newline :linear s))))) |
|
| 97 |
+ (princ #\] s))) |
|
| 98 |
+ 1 *config-pprint*) |
|
| 99 |
+ |
|
| 100 |
+(defun print-for-config (object s) |
|
| 101 |
+ (let ((*print-readably* t) |
|
| 102 |
+ (*print-pprint-dispatch* *config-pprint*)) |
|
| 103 |
+ (pprint object s))) |
|
| 104 |
+ |
|
| 105 |
+(defun read-from-config (s) |
|
| 106 |
+ (let ((*readtable* (named-readtables:find-readtable 'config))) |
|
| 107 |
+ (read s))) |
| ... | ... |
@@ -2,28 +2,29 @@ |
| 2 | 2 |
(in-package :asdf-user) |
| 3 | 3 |
|
| 4 | 4 |
(defsystem :objc-runtime |
| 5 |
- :description "" |
|
| 6 |
- :author "Ed L <edward@elangley.org>" |
|
| 7 |
- :license "MIT" |
|
| 8 |
- :depends-on (#:alexandria |
|
| 9 |
- #:uiop |
|
| 10 |
- #:data-lens |
|
| 11 |
- #:serapeum |
|
| 12 |
- #:fwoar-lisputils |
|
| 13 |
- #:cffi |
|
| 14 |
- #:cffi-libffi |
|
| 15 |
- #:trivial-main-thread |
|
| 16 |
- #:trivial-features |
|
| 17 |
- #:cffi-libffi) |
|
| 18 |
- :defsystem-depends-on (#:cffi-grovel |
|
| 19 |
- #:cffi-libffi) |
|
| 20 |
- :components ((:file "package") |
|
| 21 |
- (:cffi-grovel-file "objc-runtime-types" :depends-on ("package"))
|
|
| 22 |
- (:file "readtable" :depends-on ("package"))
|
|
| 23 |
- (:file "gcd" :depends-on ("objc-runtime"))
|
|
| 24 |
- (:file "objc-runtime" :depends-on ("package" "readtable" "objc-runtime-types"))
|
|
| 25 |
- (:file "objc-data-extractors" :depends-on ("objc-runtime" "readtable"))
|
|
| 26 |
- (:file "manipulators" :depends-on ("objc-data-extractors" "readtable" "objc-runtime"))))
|
|
| 5 |
+ :description "" |
|
| 6 |
+ :author "Ed L <edward@elangley.org>" |
|
| 7 |
+ :license "MIT" |
|
| 8 |
+ :depends-on (#:alexandria |
|
| 9 |
+ #:uiop |
|
| 10 |
+ #:data-lens |
|
| 11 |
+ #:serapeum |
|
| 12 |
+ #:fwoar-lisputils |
|
| 13 |
+ #:cffi |
|
| 14 |
+ #:cffi-libffi |
|
| 15 |
+ #:trivial-main-thread |
|
| 16 |
+ #:trivial-features |
|
| 17 |
+ #:cffi-libffi) |
|
| 18 |
+ :defsystem-depends-on (#:cffi-grovel |
|
| 19 |
+ #:cffi-libffi) |
|
| 20 |
+ :components ((:file "package") |
|
| 21 |
+ (:cffi-grovel-file "objc-runtime-types" :depends-on ("package"))
|
|
| 22 |
+ (:file "bundle-utils" :depends-on ("package"))
|
|
| 23 |
+ (:file "readtable" :depends-on ("package"))
|
|
| 24 |
+ (:file "gcd" :depends-on ("objc-runtime"))
|
|
| 25 |
+ (:file "objc-runtime" :depends-on ("package" "readtable" "objc-runtime-types"))
|
|
| 26 |
+ (:file "objc-data-extractors" :depends-on ("objc-runtime" "readtable"))
|
|
| 27 |
+ (:file "manipulators" :depends-on ("objc-data-extractors" "readtable" "objc-runtime"))))
|
|
| 27 | 28 |
|
| 28 | 29 |
(defsystem :objc-runtime/scripting-bridge |
| 29 | 30 |
:description "" |
| ... | ... |
@@ -44,3 +44,12 @@ |
| 44 | 44 |
(:use :cl :data-lens) |
| 45 | 45 |
(:export :sel :ext :<> :add-index :<count) |
| 46 | 46 |
(:reexport :data-lens)) |
| 47 |
+ |
|
| 48 |
+(defpackage :objc-runtime.bundle-utils |
|
| 49 |
+ (:use :cl) |
|
| 50 |
+ (:export #:bundle-resource-root |
|
| 51 |
+ #:application-support-directory |
|
| 52 |
+ #:setup-bundle-logical-pathnames |
|
| 53 |
+ #:ensure-application-support |
|
| 54 |
+ #:print-for-config |
|
| 55 |
+ #:read-from-config)) |