Building standalone binaries on linux working.

Mostly changes to cook and jpm. Also some
code for file associations in the windows installer, and
adding the :linux value from os/which (instead of just :posix).
This commit is contained in:
Calvin Rose 2019-07-26 22:43:54 -05:00
parent 9118f2ce08
commit dfe00fee94
11 changed files with 488 additions and 113 deletions

3
.gitignore vendored
View File

@ -20,6 +20,9 @@ dist
.project
.cproject
# Gnome Builder
.buildconfig
# Local directory for testing
local

View File

@ -132,6 +132,13 @@ is maybe more convenient and flexible for integrating into existing pipelines.
Meson also provides much better IDE integration than Make or batch files, as well as support
for cross compilation.
## Development
Janet can be hacked on with pretty much any environment you like, but for IDE
lovers, [Gnome Builder](https://wiki.gnome.org/Apps/Builder) is probably the
best option, as it has excellent meson integration. It also offers code completion
for Janet's C API right out of the box, which is very useful for exploring.
## Installation
See [the Introduction](https://janet-lang.org/introduction.html) for more details. If you just want

View File

@ -6,7 +6,7 @@
(def- argpeg
(peg/compile
'(* "--" '(some (if-not "=" 1)) "=" '(any 1))))
'(* "--" '(some (if-not "=" 1)) (+ (* "=" '(any 1)) -1))))
(defn- local-rule
[rule]
@ -16,7 +16,7 @@
(defn- help
[]
(print `
usage: jpm --key=value ... [subcommand] [args]...
usage: jpm [--key=value, --flag] ... [subcommand] [args] ...
Subcommands are:
build : build all artifacts
@ -32,13 +32,17 @@ Subcommands are:
Keys are:
--modpath : The directory to install modules to. Defaults to $JANET_MODPATH or (dyn :syspath)
--headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH or (dyn :headerpath)
--headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH.
--binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH.
--optimize : Optimization level for natives. Defaults to $OPTIMIZE or 2.
--compiler : C compiler to use for natives. Defaults to $COMPILER or cc.
--linker : C linker to use for linking natives. Defaults to $LINKER or cc.
--cflags : Extra compiler flags for native modules. Defaults to $CFLAGS if set.
--lflags : Extra linker flags for native modules. Defaults to $LFLAGS if set.
--libpath : The directory containing janet C libraries (libjanet.*). Defaults to $JANET_LIBPATH.
--optimize : Optimization level for natives. Defaults to 2.
--compiler : C compiler to use for natives. Defaults to cc (cl on windows).
--linker : C linker to use for linking natives. Defaults to cc (link on windows).
--cflags : Extra compiler flags for native modules.
--lflags : Extra linker flags for native modules.
Flags are:
--verbose : Print shell commands as they are executed.
`))
(defn build
@ -85,12 +89,12 @@ Keys are:
# Get flags
(while (< i len)
(def arg (args i))
(unless (string/has-prefix? "--" arg) (break))
(if-let [m (peg/match argpeg arg)]
(let [[key value] m]
(setdyn (keyword key) value))
(print "invalid argument " arg))
(if-let [m (peg/match argpeg (args i))]
(if (= 2 (length m))
(let [[key value] m]
(setdyn (keyword key) value))
(setdyn (keyword (m 0)) true))
(break))
(++ i))
# Run subcommand

View File

@ -15,6 +15,7 @@
(def- sep (if is-win "\\" "/"))
(def- objext (if is-win ".obj" ".o"))
(def- modext (if is-win ".dll" ".so"))
(def- statext (if is-win ".lib" ".a"))
(def- absprefix (if is-win "C:\\" "/"))
#
@ -95,34 +96,44 @@
# Configuration
#
# Installation settings
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
(def JANET_HEADERPATH (os/getenv "JANET_HEADERPATH"))
(def JANET_BINPATH (os/getenv "JANET_BINPATH"))
(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
(if-let [j JANET_MODPATH]
(string j "/../../include/janet"))))
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
(if-let [j JANET_MODPATH]
(string j "/../../bin"))))
(def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH")
(if-let [j JANET_MODPATH]
(string j "/.."))))
# Compilation settings
(def- OPTIMIZE (or (os/getenv "OPTIMIZE") 2))
(def- COMPILER (or (os/getenv "COMPILER") (if is-win "cl" "cc")))
(def- LINKER (or (os/getenv "LINKER") (if is-win "link" COMPILER)))
(def- LFLAGS
(if-let [lflags (os/getenv "LFLAGS")]
(string/split " " lflags)
(if is-win ["/nologo" "/DLL"]
#
# Compilation Defaults
#
(def default-compiler (if is-win "cl" "cc"))
(def default-linker (if is-win "link" "cc"))
(def default-archiver (if is-win "lib" "ar"))
# Default flags for natives, but not required
(def default-lflags [])
(def default-cflags
(if is-win
[]
["-std=c99" "-Wall" "-Wextra"]))
# Required flags for dynamic libraries. These
# are used no matter what for dynamic libraries.
(def- dynamic-cflags
(if is-win
["/nologo"]
["-fpic"]))
(def- dynamic-lflags
(if is-win
["/nologo" "/DLL"]
(if is-mac
["-shared" "-undefined" "dynamic_lookup"]
["-shared"]))))
(def- CFLAGS
(if-let [cflags (os/getenv "CFLAGS")]
(string/split " " cflags)
(if is-win
["/nologo"]
["-std=c99" "-Wall" "-Wextra" "-fpic"])))
# Some defaults
(def default-cflags CFLAGS)
(def default-lflags LFLAGS)
(def default-cc COMPILER)
(def default-ld LINKER)
["-shared"])))
(defn- opt
"Get an option, allowing overrides via dynamic bindings AND some
@ -166,9 +177,21 @@
# OS and shell helpers
#
(def- filepath-replacer
"Convert url with potential bad characters into a file path element."
(peg/compile ~(% (any (+ (/ '(set "<>:\"/\\|?*") "_") '1)))))
(defn filepath-replace
"Remove special characters from a string or path
to make it into a path segment."
[repo]
(get (peg/match filepath-replacer repo) 0))
(defn shell
"Do a shell command"
[& args]
(if (dyn :verbose)
(print ;(interpose " " args)))
(def res (os/execute args :p))
(unless (zero? res)
(error (string "command exited with status " res))))
@ -202,42 +225,20 @@
(string/replace-all sep "___")
(string/replace-all ".janet" "")))
(defn- embed-c-name
"Rename a janet file for embedding."
[path]
(defn- out-path
"Take a source file path and convert it to an output path."
[path from-ext to-ext]
(->> path
(string/replace-all sep "___")
(string/replace-all ".janet" ".janet.c")
(string/replace-all from-ext to-ext)
(string "build" sep)))
(defn- embed-o-name
"Get object file for c file."
[path]
(->> path
(string/replace-all sep "___")
(string/replace-all ".janet" (string ".janet" objext))
(string "build" sep)))
(defn- object-name
"Rename a source file so it can be built in a flat source tree."
[path]
(->> path
(string/replace-all sep "___")
(string/replace-all ".c" (if is-win ".obj" ".o"))
(string "build" sep)))
(defn- lib-name
"Generate name for dynamic library."
[name]
(string "build" sep name modext))
(defn- make-define
"Generate strings for adding custom defines to the compiler."
[define value]
(def pre (if is-win "/D" "-D"))
(if value
(string pre define "=" value)
(string pre define)))
(string (if is-win "/D" "-D") define "=" value)
(string (if is-win "/D" "-D") define)))
(defn- make-defines
"Generate many defines. Takes a dictionary of defines. If a value is
@ -248,16 +249,19 @@
(defn- getcflags
"Generate the c flags from the input options."
[opts]
@[;(opt opts :cflags CFLAGS)
@[;(opt opts :cflags default-cflags)
(string (if is-win "/I" "-I") (dyn :headerpath JANET_HEADERPATH))
(string (if is-win "/O" "-O") (opt opts :optimize OPTIMIZE))])
(string (if is-win "/O" "-O") (opt opts :optimize 2))])
(defn- compile-c
"Compile a C file into an object file."
[opts src dest]
(def cc (opt opts :compiler COMPILER))
(def cflags (getcflags opts))
(def defines (interpose " " (make-defines (opt opts :defines {}))))
[opts src dest &opt static?]
(def cc (opt opts :compiler default-compiler))
(def cflags [;(getcflags opts) ;(if static? [] dynamic-cflags)])
(def entry-defines (if-let [n (opts :name)]
[(string "janet_module_entry_" (filepath-replace n))]
[]))
(def defines [;(make-defines (opt opts :defines {})) ;entry-defines])
(def headers (or (opts :headers) []))
(rule dest [src ;headers]
(print "compiling " dest "...")
@ -265,36 +269,152 @@
(shell cc ;defines "/c" ;cflags (string "/Fo" dest) src)
(shell cc "-c" src ;defines ;cflags "-o" dest))))
(defn- libjanet
"Find libjanet.a (or libjanet.lib on windows) at compile time"
[]
(def libpath (dyn :libpath JANET_LIBPATH))
(unless libpath
(error "cannot find libpath: provide --libpath or JANET_LIBPATH"))
(string (dyn :libpath JANET_LIBPATH)
sep
(if is-win "libjanet.lib" "libjanet.a")))
(defn- win-import-library
"On windows, an import library is needed to link to a dll statically."
[]
(def hpath (dyn :headerpath JANET_HEADERPATH))
(unless hpath
(error "cannot find headerpath: provide --headerpath or JANET_HEADERPATH"))
(string hpath `\\janet.lib`))
(defn- link-c
"Link a number of object files together."
"Link object files together to make a native module."
[opts target & objects]
(def ld (opt opts :linker LINKER))
(def ld (opt opts :linker default-linker))
(def cflags (getcflags opts))
(def lflags (opt opts :lflags LFLAGS))
(def standalone (opts :standalone))
(def lflags [;(opt opts :lflags default-lflags)
;(if (opts :static) [] dynamic-lflags)
;(if standalone (case (os/which)
:posix ["-ldl" "-lm"]
:macos ["-ldl" "-lm"]
:windows []
:linux ["-lm" "-ldl" "-lrt"]
[]) [])])
(rule target objects
(print "linking " target "...")
(if is-win
(shell ld ;lflags (string "/OUT:" target) ;objects (string (dyn :headerpath JANET_HEADERPATH) `\\janet.lib`))
(shell ld ;cflags `-o` target ;objects ;lflags))))
(shell ld ;lflags (string "/OUT:" target) ;objects (if standalone (libjanet) (win-import-library)))
(shell ld ;cflags `-o` target ;objects ;lflags ;(if standalone [(libjanet)] [])))))
(defn- archive-c
"Link object files together to make a static library."
[opts target & objects]
(def ar (opt opts :archiver default-archiver))
(rule target objects
(print "creating static library " target "...")
(if is-win
(do (print "Not Yet Implemented!") (os/exit 1))
(shell ar "rcs" target ;objects))))
(defn- create-buffer-c-impl
[bytes dest name]
(def out (file/open dest :w))
(def chunks (seq [b :in bytes] (string b)))
(file/write out
"#include <janet.h>\n"
"static const unsigned char bytes[] = {"
;(interpose ", " chunks)
"};\n\n"
"const unsigned char *" name "_embed = bytes;\n"
"size_t " name "_embed_size = sizeof(bytes);\n")
(file/close out))
(defn- create-buffer-c
"Inline raw byte file as a c file."
[source dest name]
(rule dest [source]
(print "generating " dest "...")
(def f (file/open source :r))
(if (not f) (error (string "file " f " not found")))
(def out (file/open dest :w))
(def chunks (seq [b :in (file/read f :all)] (string b)))
(file/write out
"#include <janet.h>\n"
"static const unsigned char bytes[] = {"
;(interpose ", " chunks)
"};\n\n"
"const unsigned char *" name "_embed = bytes;\n"
"size_t " name "_embed_size = sizeof(bytes);\n")
(file/close out)
(file/close f)))
(with [f (file/open source :r)]
(create-buffer-c-impl (:read f :all) dest name))))
(def- root-env (table/getproto (fiber/getenv (fiber/current))))
(defn- create-executable
"Links an image with libjanet.a (or .lib) to produce an
executable. Also will try to link native modules into the
final executable as well."
[opts source dest]
# Create executable's janet image
(def cimage_dest (string dest ".c"))
(rule cimage_dest [source]
(print "generating executable c source...")
# Load entry environment and get main function.
(def entry-env (dofile source))
(def main ((entry-env 'main) :value))
# Get environments for every native module for the marshalling
# dictionary
(def mdict (invert (env-lookup root-env)))
# Build image
(def image (marshal main mdict))
# Make image byte buffer
(create-buffer-c-impl image cimage_dest "janet_payload_image")
# Append main function
(spit cimage_dest ```
int main(int argc, const char **argv) {
janet_init();
/* Unmarshal bytecode */
JanetTable *env = janet_core_env(NULL);
JanetTable *lookup = janet_env_lookup(env);
Janet marsh_out = janet_unmarshal(
janet_payload_image_embed,
janet_payload_image_embed_size,
0,
lookup,
NULL);
/* Verify the marshalled object is a function */
if (!janet_checktype(marsh_out, JANET_FUNCTION)) {
fprintf(stderr, "invalid bytecode image - expected function.");
return 1;
}
/* Collect command line arguments */
JanetArray *args = janet_array(argc);
for (int i = 0; i < argc; i++) {
janet_array_push(args, janet_cstringv(argv[i]));
}
/* Create enviornment */
JanetTable *runtimeEnv = janet_table(0);
runtimeEnv->proto = env;
janet_table_put(runtimeEnv, janet_ckeywordv("args"), janet_wrap_array(args));
janet_gcroot(janet_wrap_table(runtimeEnv));
/* Run everything */
JanetFiber *fiber = janet_fiber(janet_unwrap_function(marsh_out), 64, argc, args->data);
fiber->env = runtimeEnv;
Janet out;
JanetSignal result = janet_continue(fiber, janet_wrap_nil(), &out);
if (result) {
janet_stacktrace(fiber, out);
return result;
}
return 0;
}
``` :ab))
# Compile c source
(def entryo (string dest objext))
(compile-c opts cimage_dest entryo true)
# Link
(link-c (merge @{:static true :standalone true} opts)
dest
entryo))
(defn- abspath
"Create an absolute path. Does not resolve . and .. (useful for
@ -308,15 +428,6 @@
# Public utilities
#
(def- filepath-replacer
"Convert url with potential bad characters into a file path element."
(peg/compile ~(% (any (+ (/ '(set "<>:\"/\\|?*") "_") '1)))))
(defn repo-id
"Convert a repo url into a path component that serves as its id."
[repo]
(get (peg/match filepath-replacer repo) 0))
(defn find-manifest-dir
"Get the path to the directory containing manifests for installed
packages."
@ -362,7 +473,7 @@
[repo]
(def cache (find-cache))
(os/mkdir cache)
(def id (repo-id repo))
(def id (filepath-replace repo))
(def module-dir (string cache sep id))
(when (os/mkdir module-dir)
(os/execute ["git" "clone" repo module-dir] :p))
@ -394,26 +505,48 @@
#
(defn declare-native
"Declare a native binary. This is a shared library that can be loaded
dynamically by a janet runtime."
"Declare a native module. This is a shared library that can be loaded
dynamically by a janet runtime. This also builds a static libary that
can be used to bundle janet code and native into a single executable."
[&keys opts]
(def sources (opts :source))
(def name (opts :name))
(def lname (lib-name name))
(def path (dyn :modpath JANET_MODPATH))
# Make dynamic module
(def lname (string "build" sep name modext))
(loop [src :in sources]
(compile-c opts src (object-name src)))
(def objects (map object-name sources))
(compile-c opts src (out-path src ".c" objext)))
(def objects (map (fn [path] (out-path path ".c" objext)) sources))
(when-let [embedded (opts :embedded)]
(loop [src :in embedded]
(def c-src (embed-c-name src))
(def o-src (embed-o-name src))
(def c-src (out-path src ".janet" ".janet.c"))
(def o-src (out-path src ".janet" (if is-win ".janet.obj" ".janet.o")))
(array/push objects o-src)
(create-buffer-c src c-src (embed-name src))
(compile-c opts c-src o-src)))
(link-c opts lname ;objects)
(add-dep "build" lname)
(def path (dyn :modpath JANET_MODPATH))
(install-rule lname path))
(install-rule lname path)
# Make static module
(unless (or is-win (dyn :nostatic))
(def sname (string "build" sep name statext))
(def sobjext (string ".static" objext))
(def sjobjext (string ".janet" sobjext))
(loop [src :in sources]
(compile-c opts src (out-path src ".c" sobjext) true))
(def sobjects (map (fn [path] (out-path path ".c" sobjext)) sources))
(when-let [embedded (opts :embedded)]
(loop [src :in embedded]
(def c-src (out-path src ".janet" ".janet.c"))
(def o-src (out-path src ".janet" sjobjext))
(array/push sobjects o-src)
# Buffer c-src is already declared by dynamic module
(compile-c opts c-src o-src true)))
(archive-c opts sname ;sobjects)
(add-dep "build" sname)
(install-rule sname path)))
(defn declare-source
"Create a Janet modules. This does not actually build the module(s),
@ -430,6 +563,19 @@
[&keys {:main main}]
(install-rule main (dyn :binpath JANET_BINPATH)))
(defn declare-executable
"Declare a janet file to be the entry of a standalone executable program. The entry
file is evaluated and a main function is looked for in the entry file. This function
is marshalled into bytecode which is then embedded in a final executable for distribution.\n\n
This executable can be installed as well to the --binpath given."
[&keys {:install install :name name :entry entry}]
(def name (if is-win (string name ".exe") name))
(def dest (string "build" sep name))
(create-executable @{} entry dest)
(add-dep "build" dest)
(when install
(install-rule dest (dyn :binpath JANET_BINPATH))))
(defn declare-binscript
"Declare a janet file to be installed as an executable script. Creates
a shim on windows."
@ -458,6 +604,7 @@
(rule iname (or (opts :deps) [])
(spit iname (make-image (require entry))))
(def path (dyn :modpath JANET_MODPATH))
(add-dep "build" iname)
(install-rule iname path))
(defn declare-project
@ -494,8 +641,9 @@
(uninstall (meta :name)))
(phony "clean" []
(rm "build")
(print "Deleted build directory."))
(when (os/stat "./build" :mode)
(rm "build")
(print "Deleted build directory.")))
(phony "test" ["build"]
(defn dodir

View File

@ -18,6 +18,7 @@ VIFileVersion "${PRODUCT_VERSION}"
!include "MultiUser.nsh"
!include "MUI2.nsh"
!include ".\tools\EnvVarUpdate.nsh"
!include ".\tools\FileAssociation.nsh"
!include "LogicLib.nsh"
# Basics
@ -114,8 +115,12 @@ section "Janet" BfWSection
# Set up Environment variables
!insertmacro WriteEnv JANET_PATH "$INSTDIR\Library"
!insertmacro WriteEnv JANET_HEADERPATH "$INSTDIR\C"
!insertmacro WriteEnv JANET_LIBPATH "$INSTDIR\C"
!insertmacro WriteEnv JANET_BINPATH "$INSTDIR\bin"
# File Association
${registerExtension} "$INSTDIR\bin\janet.exe" ".janet" "Janet Source File"
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
# Update path
@ -163,12 +168,16 @@ section "uninstall"
# Remove env vars
!insertmacro DelEnv JANET_PATH
!insertmacro DelEnv JANET_HEADERPATH
!insertmacro DelEnv JANET_LIBPATH
!insertmacro DelEnv JANET_BINPATH
# Unset PATH
${un.EnvVarUpdate} $0 "PATH" "R" "HKCU" "$INSTDIR\bin" ; Remove
${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove
# Unregister file assocations
${unregisterExtension} ".janet" "Janet Source File"
# make sure windows knows about the change
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000

View File

@ -206,7 +206,8 @@ test_files = [
'test/suite3.janet',
'test/suite4.janet',
'test/suite5.janet',
'test/suite6.janet'
'test/suite6.janet',
'test/suite7.janet'
]
foreach t : test_files
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())

View File

@ -1732,6 +1732,7 @@
:source (fn [path args]
(put module/loading path true)
(def newenv (dofile path ;args))
(put newenv :source path)
(put module/loading path nil)
newenv)
:image (fn [path &] (load-image (slurp path)))})

View File

@ -270,6 +270,7 @@ static Janet janet_core_native(int32_t argc, Janet *argv) {
janet_panicf("could not load native %S: %S", path, error);
}
init(env);
janet_table_put(env, janet_ckeywordv("native"), argv[0]);
return janet_wrap_table(env);
}

View File

@ -73,6 +73,8 @@ static Janet os_which(int32_t argc, Janet *argv) {
return janet_ckeywordv("macos");
#elif defined(__EMSCRIPTEN__)
return janet_ckeywordv("web");
#elif defined(__linux__)
return janet_ckeywordv("linux");
#else
return janet_ckeywordv("posix");
#endif
@ -763,6 +765,8 @@ static const JanetReg os_cfuns[] = {
"Check the current operating system. Returns one of:\n\n"
"\t:windows - Microsoft Windows\n"
"\t:macos - Apple macos\n"
"\t:web - Web assembly (emscripten)\n"
"\t:linux - Linux\n"
"\t:posix - A POSIX compatible system (default)")
},
{

View File

@ -1306,11 +1306,16 @@ JANET_API void janet_register(const char *name, JanetCFunction cfun);
/* New C API */
/* Allow setting entry name for static libraries */
#ifndef JANET_ENTRY_NAME
#define JANET_ENTRY_NAME _janet_init
#endif
#define JANET_MODULE_ENTRY \
JANET_API JanetBuildConfig _janet_mod_config(void) { \
return janet_config_current(); \
} \
JANET_API void _janet_init
JANET_API void JANET_ENTRY_NAME
JANET_NO_RETURN JANET_API void janet_panicv(Janet message);
JANET_NO_RETURN JANET_API void janet_panic(const char *message);

192
tools/FileAssociation.nsh Normal file
View File

@ -0,0 +1,192 @@
/*
_____________________________________________________________________________
File Association
_____________________________________________________________________________
Based on code taken from http://nsis.sourceforge.net/File_Association
Usage in script:
1. !include "FileAssociation.nsh"
2. [Section|Function]
${FileAssociationFunction} "Param1" "Param2" "..." $var
[SectionEnd|FunctionEnd]
FileAssociationFunction=[RegisterExtension|UnRegisterExtension]
_____________________________________________________________________________
${RegisterExtension} "[executable]" "[extension]" "[description]"
"[executable]" ; executable which opens the file format
;
"[extension]" ; extension, which represents the file format to open
;
"[description]" ; description for the extension. This will be display in Windows Explorer.
;
${UnRegisterExtension} "[extension]" "[description]"
"[extension]" ; extension, which represents the file format to open
;
"[description]" ; description for the extension. This will be display in Windows Explorer.
;
_____________________________________________________________________________
Macros
_____________________________________________________________________________
Change log window verbosity (default: 3=no script)
Example:
!include "FileAssociation.nsh"
!insertmacro RegisterExtension
${FileAssociation_VERBOSE} 4 # all verbosity
!insertmacro UnRegisterExtension
${FileAssociation_VERBOSE} 3 # no script
*/
!ifndef FileAssociation_INCLUDED
!define FileAssociation_INCLUDED
!include Util.nsh
!verbose push
!verbose 3
!ifndef _FileAssociation_VERBOSE
!define _FileAssociation_VERBOSE 3
!endif
!verbose ${_FileAssociation_VERBOSE}
!define FileAssociation_VERBOSE `!insertmacro FileAssociation_VERBOSE`
!verbose pop
!macro FileAssociation_VERBOSE _VERBOSE
!verbose push
!verbose 3
!undef _FileAssociation_VERBOSE
!define _FileAssociation_VERBOSE ${_VERBOSE}
!verbose pop
!macroend
!macro RegisterExtensionCall _EXECUTABLE _EXTENSION _DESCRIPTION
!verbose push
!verbose ${_FileAssociation_VERBOSE}
Push `${_DESCRIPTION}`
Push `${_EXTENSION}`
Push `${_EXECUTABLE}`
${CallArtificialFunction} RegisterExtension_
!verbose pop
!macroend
!macro UnRegisterExtensionCall _EXTENSION _DESCRIPTION
!verbose push
!verbose ${_FileAssociation_VERBOSE}
Push `${_EXTENSION}`
Push `${_DESCRIPTION}`
${CallArtificialFunction} UnRegisterExtension_
!verbose pop
!macroend
!define RegisterExtension `!insertmacro RegisterExtensionCall`
!define un.RegisterExtension `!insertmacro RegisterExtensionCall`
!macro RegisterExtension
!macroend
!macro un.RegisterExtension
!macroend
!macro RegisterExtension_
!verbose push
!verbose ${_FileAssociation_VERBOSE}
Exch $R2 ;exe
Exch
Exch $R1 ;ext
Exch
Exch 2
Exch $R0 ;desc
Exch 2
Push $0
Push $1
ReadRegStr $1 HKCR $R1 "" ; read current file association
StrCmp "$1" "" NoBackup ; is it empty
StrCmp "$1" "$R0" NoBackup ; is it our own
WriteRegStr HKCR $R1 "backup_val" "$1" ; backup current value
NoBackup:
WriteRegStr HKCR $R1 "" "$R0" ; set our file association
ReadRegStr $0 HKCR $R0 ""
StrCmp $0 "" 0 Skip
WriteRegStr HKCR "$R0" "" "$R0"
WriteRegStr HKCR "$R0\shell" "" "open"
WriteRegStr HKCR "$R0\DefaultIcon" "" "$R2,0"
Skip:
WriteRegStr HKCR "$R0\shell\open\command" "" '"$R2" "%1"'
WriteRegStr HKCR "$R0\shell\edit" "" "Edit $R0"
WriteRegStr HKCR "$R0\shell\edit\command" "" '"$R2" "%1"'
Pop $1
Pop $0
Pop $R2
Pop $R1
Pop $R0
!verbose pop
!macroend
!define UnRegisterExtension `!insertmacro UnRegisterExtensionCall`
!define un.UnRegisterExtension `!insertmacro UnRegisterExtensionCall`
!macro UnRegisterExtension
!macroend
!macro un.UnRegisterExtension
!macroend
!macro UnRegisterExtension_
!verbose push
!verbose ${_
FileAssociation_VERBOSE}
Exch $R1 ;desc
Exch
Exch $R0 ;ext
Exch
Push $0
Push $1
ReadRegStr $1 HKCR $R0 ""
StrCmp $1 $R1 0 NoOwn ; only do this if we own it
ReadRegStr $1 HKCR $R0 "backup_val"
StrCmp $1 "" 0 Restore ; if backup="" then delete the whole key
DeleteRegKey HKCR $R0
Goto NoOwn
Restore:
WriteRegStr HKCR $R0 "" $1
DeleteRegValue HKCR $R0 "backup_val"
DeleteRegKey HKCR $R1 ;Delete key with association name settings
NoOwn:
Pop $1
Pop $0
Pop $R1
Pop $R0
!verbose pop
!macroend
!endif # !FileAssociation_INCLUDED