mirrors/lqml
1
Fork 0
mirror of https://gitlab.com/eql/lqml.git synced 2025-12-06 02:30:38 -08:00
Code Issues Projects Releases Packages Wiki Activity

important: several revisions, simplifications (this commit is tested and stable)

Browse source
This commit is contained in:
pls.153 2022-03-17 16:15:32 +01:00
parent fee4358760
commit 5bd6b31630
19 changed files with 216 additions and 324 deletions
Download patch file Download diff file Expand all files Collapse all files

115
examples/advanced-qml-auto-reload/lisp/swank-quicklisp.lisp
View file

@ -2,88 +2,20 @@
(in-package :qml)
;; for mobile app updates:
;; to be incremented on every ECL upgrade in order to replace all asset files
#+(or android ios)
(defconstant +app-version+ 1)
#+(and ios (not interpreter))
#+(and (or android ios) (not interpreter))
(ffi:clines "extern void init_lib_ASDF(cl_object);")
#+(or android ios)
(defvar *assets* #+android "assets:/lib/"
#+ios "assets/")
#+ios
(defvar *bundle-root* (namestring *default-pathname-defaults*))
#+(or android ios)
(defun copy-asset-files (&optional (dir-name *assets*) origin)
"Copy asset files to home directory."
(flet ((directory-p (path)
(x:ends-with "/" path))
(translate (name)
#+android
(if (x:starts-with *assets* name)
(subseq name (length *assets*))
name)
#+ios
(namestring
(merge-pathnames (x:cc "../" (subseq name (length origin)))))))
(ensure-directories-exist (translate dir-name))
;; note: both QDIRECTORY and QCOPY-FILE are prepared for accessing
;; APK asset files, which can't be accessed directly from Lisp
(dolist (from (qdirectory dir-name))
(if (directory-p from)
(copy-asset-files from origin)
(let ((to (translate from)))
(when (probe-file to)
(delete-file to))
(unless (qcopy-file from to)
(qlog "Error copying asset file: ~S" from)
(return-from copy-asset-files))))))
t)
#+(or android ios)
(let ((file ".app-version"))
(defun app-version ()
(if (probe-file file)
(with-open-file (s file)
(let ((str (make-string (file-length s))))
(read-sequence str s)
(values (parse-integer str))))
0))
(defun save-app-version ()
(with-open-file (s file :direction :output :if-exists :supersede)
(princ +app-version+ s))
(values)))
(defun %sym (symbol package)
(intern (symbol-name symbol) package))
;;; Quicklisp setup
#+ios
(defun load-asdf ()
(unless (find-package :asdf)
;; needed for ASDF and Quicklisp
(setf (logical-pathname-translations "SYS")
(list (list "sys:**;*.*"
(merge-pathnames "**/*.*" (user-homedir-pathname)))))
(setf (logical-pathname-translations "HOME")
(list (list "home:**;*.*"
(merge-pathnames "**/*.*" (user-homedir-pathname)))))
(ffi:c-inline nil nil :void "ecl_init_module(NULL, init_lib_ASDF)" :one-liner t)
(in-package :qml-user))
:asdf)
#+(or android ios)
(defun ensure-asdf ()
(unless (find-package :asdf)
#+android
(require :asdf)
#+ios
(load-asdf)))
(ffi:c-inline nil nil :void "ecl_init_module(NULL, init_lib_ASDF)" :one-liner t)
(in-package :qml-user))
:asdf)
#+(or android ios)
(defun quicklisp ()
@ -147,45 +79,6 @@
#+(or android ios)
(export (list #+ios
'load-asdf
'start-swank
'stop-swank
'quicklisp))
#+ios
(progn
;; adapt paths to iOS specific values
(defvar *user-homedir-pathname-orig* (symbol-function 'user-homedir-pathname))
(ext:package-lock :common-lisp nil)
(defun cl:user-homedir-pathname (&optional host)
(merge-pathnames "Library/" (funcall *user-homedir-pathname-orig* host)))
(ext:package-lock :common-lisp t)
(dolist (el '(("XDG_DATA_HOME" . "")
("XDG_CONFIG_HOME" . "")
("XDG_DATA_DIRS" . "")
("XDG_CONFIG_DIRS" . "")
("XDG_CACHE_HOME" . ".cache")))
(ext:setenv (car el) (namestring (merge-pathnames (cdr el)
(user-homedir-pathname))))))
;;; ini
#+(or android ios)
(defun startup-ini ()
#+ios
(setf *default-pathname-defaults* (user-homedir-pathname))
(ext:install-bytecodes-compiler)
(and (/= +app-version+ (app-version))
#+ios
(let ((dir (namestring (merge-pathnames *assets* *bundle-root*))))
(copy-asset-files dir dir))
#+android
(copy-asset-files)
(save-app-version)))
#+(or android ios)
(qlater 'startup-ini)