Loading scripts/build-wxs.lisp +143 −122 Original line number Diff line number Diff line Loading @@ -15,27 +15,43 @@ (setup-asdf "default") (asdf:load-system :s-xml) (asdf:load-system :uuid) (defun directory-tree (pn file-base-id dir-base-id) (let ((files (directory (merge-pathnames "*.*" pn))) (defun gen-uuid () (format nil "~A" (uuid:make-v4-uuid))) (defun sanitize-id (id) (substitute #\_ #\- id)) (defun directory-tree (pn component-base-id file-base-id dir-base-id) (let* ((files (directory (merge-pathnames "*.*" pn))) (dirs (directory (merge-pathnames "*/" pn))) (out nil)) (dir-name (car (last (pathname-directory pn)))) (dir-id (uiop:strcat dir-base-id "." dir-name)) (out `(("Directory" "Name" ,dir-name "Id" ,(sanitize-id dir-id)))) (component-name (sanitize-id (uiop:strcat component-base-id "_" dir-name))) (component-names (list component-name)) (component (list (list (list "CreateFolder")) (list "Component" "Id" component-name "Guid" (gen-uuid) "DiskId" "1" "Win64" "yes")))) (dolist (file files) (unless (or (uiop:directory-pathname-p file) (equal "fasl" (pathname-type file))) (let ((enough (enough-namestring file pn))) (push `(("File" "Name" ,enough "Id" ,(uiop:strcat file-base-id "." enough) "Id" ,(sanitize-id (uiop:strcat file-base-id "." dir-name "." enough)) "Source" ,(enough-namestring file *build-root-pathname*))) out)))) component)))) (push (nreverse component) out) (dolist (dir dirs) (let ((name (car (last (pathname-directory dir))))) (push `(("Directory" "Name" ,name "Id" ,(uiop:strcat dir-base-id "." name)) ,@(directory-tree dir (uiop:strcat file-base-id "." name) (uiop:strcat dir-base-id "." name))) out))) out)) (multiple-value-bind (subdir-tree sub-component-names) (directory-tree dir component-name (uiop:strcat file-base-id "." dir-name) dir-id) (setf component-names (append sub-component-names component-names)) (push subdir-tree out))) (values (nreverse out) component-names))) (defun directory-files (pn) (let ((files (directory (merge-pathnames "*.*" pn))) Loading @@ -49,6 +65,9 @@ out)) (defun build-wxs () (multiple-value-bind (src-dir-tree src-dir-component-names) (directory-tree (merge-pathnames "lib/clpm/src/clpm/" *build-root-pathname*) "CLPM_Src" "CLPM_SrcFile" "CLPM_SrcDir") `(("Wix" "xmlns" "http://schemas.microsoft.com/wix/2006/wi") (("Product" "Id" "*" "Name" "Common Lisp Package Manager (CLPM)" Loading Loading @@ -83,7 +102,7 @@ (("Directory" "Id" "BaseFolder" "Name" "CLPM") (("Directory" "Id" "VersionFolder" "Name" "0.2.0") "Name" "v0.2.0-alpha.1") (("Directory" "Id" "INSTALLDIR") (("Directory" "Id" "BINDIR" "Name" "bin") Loading Loading @@ -139,7 +158,8 @@ "Guid" "639DDC25-7C6D-4F7B-809E-A7989A3D15BE" "DiskId" "1" "Win64" "yes") ,@(directory-files (merge-pathnames "lib/clpm/src/clpm-groveler/" *build-root-pathname*))))))))))) ,@(directory-files (merge-pathnames "lib/clpm/src/clpm-groveler/" *build-root-pathname*)))) ,src-dir-tree))))))) (("Feature" "Id" "Minimal" "Title" "CLPM Executable" Loading @@ -149,6 +169,7 @@ (("ComponentRef" "Id" "CLPM_Libs")) (("ComponentRef" "Id" "CLPM_Client")) (("ComponentRef" "Id" "CLPM_Groveler")) ,@(mapcar (lambda (id) `(("ComponentRef" "Id" ,id))) src-dir-component-names) (("Feature" "Id" "SetPath" "Level" "1" "Title" "Set Environment Variable: PATH") Loading @@ -161,7 +182,7 @@ "Value" "License.rtf")) (("Property" "Id" "WIXUI_INSTALLDIR" "Value" "INSTALLDIR")) (("UIRef" "Id" "WixUI_FeatureTree"))))) (("UIRef" "Id" "WixUI_FeatureTree")))))) (defun write-wxs () (with-open-file (s (merge-pathnames "clpm.wxs" *build-root-pathname*) Loading Loading
scripts/build-wxs.lisp +143 −122 Original line number Diff line number Diff line Loading @@ -15,27 +15,43 @@ (setup-asdf "default") (asdf:load-system :s-xml) (asdf:load-system :uuid) (defun directory-tree (pn file-base-id dir-base-id) (let ((files (directory (merge-pathnames "*.*" pn))) (defun gen-uuid () (format nil "~A" (uuid:make-v4-uuid))) (defun sanitize-id (id) (substitute #\_ #\- id)) (defun directory-tree (pn component-base-id file-base-id dir-base-id) (let* ((files (directory (merge-pathnames "*.*" pn))) (dirs (directory (merge-pathnames "*/" pn))) (out nil)) (dir-name (car (last (pathname-directory pn)))) (dir-id (uiop:strcat dir-base-id "." dir-name)) (out `(("Directory" "Name" ,dir-name "Id" ,(sanitize-id dir-id)))) (component-name (sanitize-id (uiop:strcat component-base-id "_" dir-name))) (component-names (list component-name)) (component (list (list (list "CreateFolder")) (list "Component" "Id" component-name "Guid" (gen-uuid) "DiskId" "1" "Win64" "yes")))) (dolist (file files) (unless (or (uiop:directory-pathname-p file) (equal "fasl" (pathname-type file))) (let ((enough (enough-namestring file pn))) (push `(("File" "Name" ,enough "Id" ,(uiop:strcat file-base-id "." enough) "Id" ,(sanitize-id (uiop:strcat file-base-id "." dir-name "." enough)) "Source" ,(enough-namestring file *build-root-pathname*))) out)))) component)))) (push (nreverse component) out) (dolist (dir dirs) (let ((name (car (last (pathname-directory dir))))) (push `(("Directory" "Name" ,name "Id" ,(uiop:strcat dir-base-id "." name)) ,@(directory-tree dir (uiop:strcat file-base-id "." name) (uiop:strcat dir-base-id "." name))) out))) out)) (multiple-value-bind (subdir-tree sub-component-names) (directory-tree dir component-name (uiop:strcat file-base-id "." dir-name) dir-id) (setf component-names (append sub-component-names component-names)) (push subdir-tree out))) (values (nreverse out) component-names))) (defun directory-files (pn) (let ((files (directory (merge-pathnames "*.*" pn))) Loading @@ -49,6 +65,9 @@ out)) (defun build-wxs () (multiple-value-bind (src-dir-tree src-dir-component-names) (directory-tree (merge-pathnames "lib/clpm/src/clpm/" *build-root-pathname*) "CLPM_Src" "CLPM_SrcFile" "CLPM_SrcDir") `(("Wix" "xmlns" "http://schemas.microsoft.com/wix/2006/wi") (("Product" "Id" "*" "Name" "Common Lisp Package Manager (CLPM)" Loading Loading @@ -83,7 +102,7 @@ (("Directory" "Id" "BaseFolder" "Name" "CLPM") (("Directory" "Id" "VersionFolder" "Name" "0.2.0") "Name" "v0.2.0-alpha.1") (("Directory" "Id" "INSTALLDIR") (("Directory" "Id" "BINDIR" "Name" "bin") Loading Loading @@ -139,7 +158,8 @@ "Guid" "639DDC25-7C6D-4F7B-809E-A7989A3D15BE" "DiskId" "1" "Win64" "yes") ,@(directory-files (merge-pathnames "lib/clpm/src/clpm-groveler/" *build-root-pathname*))))))))))) ,@(directory-files (merge-pathnames "lib/clpm/src/clpm-groveler/" *build-root-pathname*)))) ,src-dir-tree))))))) (("Feature" "Id" "Minimal" "Title" "CLPM Executable" Loading @@ -149,6 +169,7 @@ (("ComponentRef" "Id" "CLPM_Libs")) (("ComponentRef" "Id" "CLPM_Client")) (("ComponentRef" "Id" "CLPM_Groveler")) ,@(mapcar (lambda (id) `(("ComponentRef" "Id" ,id))) src-dir-component-names) (("Feature" "Id" "SetPath" "Level" "1" "Title" "Set Environment Variable: PATH") Loading @@ -161,7 +182,7 @@ "Value" "License.rtf")) (("Property" "Id" "WIXUI_INSTALLDIR" "Value" "INSTALLDIR")) (("UIRef" "Id" "WixUI_FeatureTree"))))) (("UIRef" "Id" "WixUI_FeatureTree")))))) (defun write-wxs () (with-open-file (s (merge-pathnames "clpm.wxs" *build-root-pathname*) Loading