[m-rev.] for review: add windows installer generator to extras
Ian MacLarty
maclarty at cs.mu.OZ.AU
Wed Oct 26 01:39:00 AEST 2005
For review by anyone.
Estimated hours taken: 50
Branches: main
Implement a Wix source file generator. Wix is an XML language used to
describe Windows installer packages (.msi files).
extras/windows_installer_generator/README:
extras/windows_installer_generator/wix.m:
extras/windows_installer_generator/wix_files.m:
extras/windows_installer_generator/wix_gui.m:
extras/windows_installer_generator/wix_installer.m:
extras/windows_installer_generator/wix_language.m:
extras/windows_installer_generator/wix_util.m:
Implement a wix library for generating Wix source files.
extras/windows_installer_generator/sample/Mercury.options:
extras/windows_installer_generator/sample/README:
extras/windows_installer_generator/sample/gen_merc_wxs.m:
extras/windows_installer_generator/sample/images/Exclam.ico:
extras/windows_installer_generator/sample/images/Info.ico:
extras/windows_installer_generator/sample/images/banner.bmp:
extras/windows_installer_generator/sample/images/bg.bmp:
Implement an example installer generator for the Mercury
distribution.
Index: extras/windows_installer_generator/README
===================================================================
RCS file: extras/windows_installer_generator/README
diff -N extras/windows_installer_generator/README
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ extras/windows_installer_generator/README 25 Oct 2005 15:30:16 -0000
@@ -0,0 +1,30 @@
+This is the top-level module for a Mercury Wix source file generator.
+WiX is an XML language that is used to generate Microsoft Windows Installer
+(.msi) packages.
+
+To compile the XML into an .msi file you need the WiX compiler, available
+from wix.sourceforge.net. You will also need a tool to generate
+GUID. GUIDs are unique identifiers that Windows uses to identify all
+the components in a package. A GUID generator for Linux is uuidgen.
+Microsoft Visual Studio also comes with a GUID generator, uuidgen.exe.
+
+For documentation on the toolkit API see wix.m in this directory.
+
+The predicate wix.installer.generate_installer will generate a .wxs file
+based on information in its arguments.
+
+The .wxs file can then be compiled to a .msi file using the Wix toolset.
+The following commands will generate <filename>.msi, given <filename>.wxs.
+
+candle <filename>.wxs
+light <filename>.wixobj
+
+NOTE that there are still a few features missing from the current
+implementation. For example the user cannot select different features of a
+product to install -- it's all or nothing. Also Windows installer error codes
+are not converted into friendlier error messages at the moment. The installer
+wizard is also not as customizable as it could be.
+
+To build the wix library execute the command:
+
+mmc --make libwix
Index: extras/windows_installer_generator/wix.m
===================================================================
RCS file: extras/windows_installer_generator/wix.m
diff -N extras/windows_installer_generator/wix.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ extras/windows_installer_generator/wix.m 25 Oct 2005 13:33:27 -0000
@@ -0,0 +1,583 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2005 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%---------------------------------------------------------------------------%
+%
+% Main author: Ian MacLarty (maclarty at cs.mu.oz.au).
+%
+%---------------------------------------------------------------------------%
+
+:- module wix.
+
+:- interface.
+
+:- import_module int.
+:- import_module io.
+:- import_module list.
+:- import_module string.
+
+:- import_module wix_gui.
+
+ % generate_installer(Installer, GUIDGenCommand, FileName, Result, !IO).
+ %
+ % Generate a Wix source file which can then be compiled into a
+ % Windows installer (.msi) file.
+ %
+ % The name of the source file to generate is given by FileName.
+ % By convention Wix source files have the suffix `.wxs'.
+ % The Installer argument contains all the information necessary to
+ % generate the installer (see the installer type below).
+ % GUIDGenCommand is a command to execute to generate a GUID.
+ % A GUID is a unique identifier that Windows uses to keep track of
+ % each installed component. A seperate GUID is generated for
+ % each file installed. `uuidgen.exe' is an example of a GUID generator
+ % and is available for both Windows and Linux.
+ %
+ % To compile the generated .wxs file into a windows installer first
+ % download the Wix toolset from wix.sourceforge.net and then run:
+ %
+ % candle <filename>.wxs
+ % light <filename>.wixobj
+ %
+ % from the Windows command prompt. This will produce <filename>.msi.
+ %
+ % Result unifies with `ok' if the installer was successfully generated
+ % and `wix_error(Error)' if there was a problem. See the definition of
+ % the wix_result type below for the possible errors that could occur.
+ %
+:- pred generate_installer(installer(L)::in, string::in, string::in,
+ wix_result::out, io::di, io::uo)
+ is det <= language_independent_tokens(L).
+
+ % Types of the following class are tokens used to represent
+ % fragments of text in the user interface of the installer in
+ % a language independent way. The translate member should
+ % translate all the tokens for the languages supported by the installer.
+ % If translate fails for a given token/language combination during the
+ % generation of a Wix source file, then the source file will not be
+ % generated and generate_installer will result a wix_error result.
+ % It is a good idea to define translate in terms of another function
+ % that is deterministic for the languages you want to support. That
+ % way the compiler will catch any missing translations.
+ % For a list of possible languages see the file languages.m in this
+ % directory.
+ %
+:- typeclass language_independent_tokens(L) where [
+ pred translate(L::in, language::in, string::out) is semidet
+].
+
+ % The installer type is used to define a Windows installer.
+ % The values of type L are tokens representing fragments of
+ % text in the installer GUI. The tokens are converted to the
+ % appropriate language based on the value of the wix_language field.
+ %
+:- type installer(L)
+ ---> installer(
+
+ % Information about the product being installed.
+ % (see below)
+ wix_product_info :: product(L),
+
+ % The language to be used in the GUI of the installer.
+ wix_language :: language,
+
+ % A list of environment variables to set when installing
+ % the product (see the definition of set_env_var below).
+ wix_set_env_vars :: list(set_env_var(L)),
+
+ % A mapping from filenames to shortcuts which
+ % should be placed on the desktop and/or programs
+ % menu (see the definition of the shortcut_function
+ % type below).
+ wix_shortcut_func :: shortcut_function(L),
+
+ % A token representing the text to display in the
+ % title bar of the installer GUI.
+ wix_title :: L,
+
+ % Tokens representing the heading and description
+ % to display while installation is progressing.
+ wix_install_heading :: L,
+ wix_install_descr :: L,
+
+ % Tokens representing the text in the Next, Back, Cancel
+ % and Install wizard buttons.
+ wix_next_button :: L,
+ wix_back_button :: L,
+ wix_cancel_button :: L,
+ wix_install_button :: L,
+
+ % A token representing the message to display to the user
+ % when confirmin a cancel operation.
+ wix_cancel_message :: L,
+
+ % Tokens representing the heading, confirmation message
+ % and Remove button text displayed in the
+ % uninstallation confirmation dialog.
+ wix_remove_heading :: L,
+ wix_remove_confirm :: L,
+ wix_remove_button :: L,
+
+ % Tokens representing the heading and description to
+ % display while uninstallation is progressing.
+ wix_remove_progress_heading :: L,
+ wix_remove_progress_descr :: L,
+
+ % Tokens representing the heading, message and Finish
+ % button text to display in the final wizard dialog
+ % which is displayed after installation has successfully
+ % completed.
+ wix_finish_heading :: L,
+ wix_finish_message :: L,
+ wix_finish_button :: L,
+
+ % Tokens representing the heading and message to display
+ % if the installer detects that some files are in
+ % use which it needs to delete.
+ % A list of the programs locking the files in use is
+ % displayed after the message.
+ wix_files_in_use_heading :: L,
+ wix_files_in_use_message :: L,
+
+ % Tokens representing the text to display on Ignore,
+ % Retry, Yes and No buttons.
+ wix_ignore_button :: L,
+ wix_retry_button :: L,
+ wix_yes_button :: L,
+ wix_no_button :: L,
+
+ % A token representing the text to display if the
+ % user is not an administrator, but administrator
+ % privileges are required for the installation.
+ % (Administrator privileges will be required if any
+ % system level environment variables need to be set
+ % by the installer).
+ wix_must_be_admin_msg :: L,
+
+ % The path to a bitmap file to be displayed at the top of
+ % each wizard step. The bitmap can be any size, but will
+ % be scaled to fit an area of 370x44 pixels.
+ %
+ wix_banner_source :: string,
+
+ % The path to a larger bitmap image that will be
+ % used as the background for the final wizard step
+ % (after successful installation). This bitmap will
+ % also be used for wizard_start wizard steps
+ % (see the wizard_start function in gui.m).
+ % The bitmap can be any size, but will be scaled
+ % to fit any area of 370x234 pixels.
+ wix_background_source :: string,
+
+ % A list of wizard steps the installer should go through
+ % with the user before installation.
+ wix_wizard_steps :: list(wizard_step(L))
+ ).
+
+ % The shortcut function determines which files should have shortcuts
+ % installed on the Desktop and/or the Programs menu.
+ % It takes two string arguments - the directory of the file and the
+ % name of the file. It returns a list of shortcuts to generate for the
+ % given file.
+ %
+:- type shortcut_function(L) == (func(string, string) = list(shortcut(L))).
+
+:- type shortcut(L)
+ ---> shortcut(
+ shortcut_where :: shortcut_where, % Where to place the
+ % shortcut.
+ shortcut_name :: L % The title of the shortcut
+ % as the user will see it.
+ ).
+
+:- type shortcut_where
+ ---> programs % Place the shortcut in the Programs menu under a
+ % folder with the same name as the product.
+ ; desktop. % Place the shortcut on the Desktop.
+
+ % Values of this type give information about the product being
+ % installed.
+ %
+:- type product(L)
+ ---> product(
+ product_manufacturer :: L,
+ product_name :: L,
+ product_version :: version_no,
+ product_description :: L,
+ product_comments :: L,
+
+ % The path to the directory containing the files
+ % and directories that should be installed to the user's
+ % computer, on the machine where the installer will be
+ % generated.
+ product_files_path :: string,
+
+ % The name of the folder under the "Program Files" folder
+ % to install the product on the user's machine.
+ product_default_install_loc :: L
+ ).
+
+ % Wix only accepts version numbers of the form NN.NN.NN.NN.
+ %
+:- type version_no
+ ---> version_no(
+ version_major :: int,
+ version_minor :: int,
+ version_build :: int,
+ version_other :: int
+ ).
+
+ % This type is used to tell the installer what environment variables
+ % to set during the installation.
+ % Values can be appended or prepended to existing environment variables,
+ % or the value of an old environment variable can be overwritten
+ % completely. If the environment variable doesn't exist it will be
+ % created. Environement variables can also be set in the user or
+ % system environment space. Setting an environment variable in the
+ % system user space will require the user to have administrator privileges.
+ %
+:- type set_env_var(L)
+ ---> set_env_var(
+ env_var_name :: string,
+ env_var_value :: L,
+ env_var_how_set :: env_var_how_set,
+ env_var_system_or_user :: env_var_system_or_user
+ ).
+
+:- type env_var_how_set
+ ---> replace % Replace the value of the environment variable with the
+ % new value.
+ ; prepend % Prepend the new value to the old value, separating the
+ % old and new values with a `;' character.
+ ; append. % Append the new value to the end of the old value,
+ % separating the old and new values with a `;' character.
+
+ % Should the environment variable be set in the system or
+ % user environment space?
+ % Setting an environment variable in the system environment
+ % space requires administrator privileges, but the environment variable
+ % will be visible to all users.
+ %
+:- type env_var_system_or_user
+ ---> system
+ ; user.
+
+ % license_wizard_step(Heading, Instructions, LicenseSrc) = WizardStep.
+ % Generate a wizard step that displays the contents of a rich text format
+ % (.rtf) file. The name of the .rtf file should be given by LicenseSrc.
+ % Heading and Instructions are displayed above the contents
+ % of the .rtf file.
+ %
+:- func license_wizard_step(L, L, L) = wizard_step(L).
+
+ % welcome_wizard_step(Heading, Message) = WizardStep.
+ % Generate a welcome dialog with the given Heading and Message.
+ %
+:- func welcome_wizard_step(L, L) = wizard_step(L).
+
+ % notice_wizard_step(Heading, Message) = WizardStep.
+ % The notice wizard step is similar to the license wizard step,
+ % except that the text to display is given as a string, instead of
+ % in an .rtf file. The text is also not displayed in a scrollable
+ % area, but in a static text area.
+ %
+:- func notice_wizard_step(L, L) = wizard_step(L).
+
+:- type language
+ ---> afrikaans_south_africa
+ ; albanian_albania
+ ; amharic_ethiopia
+ ; arabic_saudi_arabia
+ ; arabic_algeria
+ ; arabic_bahrain
+ ; arabic_egypt
+ ; arabic_iraq
+ ; arabic_jordan
+ ; arabic_kuwait
+ ; arabic_lebanon
+ ; arabic_libya
+ ; arabic_morocco
+ ; arabic_oman
+ ; arabic_qatar
+ ; arabic_syria
+ ; arabic_tunisia
+ ; arabic_u_a_e
+ ; arabic_yemen
+ ; armenian_armenia
+ ; assamese
+ ; azeri_cyrillic
+ ; azeri_latin
+ ; basque
+ ; belarusian
+ ; bengali
+ ; bengali_bangladesh
+ ; bosnian_bosnia_herzegovina
+ ; bulgarian
+ ; burmese
+ ; catalan
+ ; cherokee_united_states
+ ; chinese_peoples_republic_of_china
+ ; chinese_singapore
+ ; chinese_taiwan
+ ; chinese_hong_kong_sar
+ ; chinese_macao_sar
+ ; croatian
+ ; croatian_bosnia_herzegovina
+ ; czech
+ ; danish
+ ; divehi
+ ; dutch_netherlands
+ ; dutch_belgium
+ ; edo
+ ; english_united_states
+ ; english_united_kingdom
+ ; english_australia
+ ; english_belize
+ ; english_canada
+ ; english_caribbean
+ ; english_hong_kong_sar
+ ; english_india
+ ; english_indonesia
+ ; english_ireland
+ ; english_jamaica
+ ; english_malaysia
+ ; english_new_zealand
+ ; english_philippines
+ ; english_singapore
+ ; english_south_africa
+ ; english_trinidad
+ ; english_zimbabwe
+ ; estonian
+ ; faroese
+ ; farsi
+ ; filipino
+ ; finnish
+ ; french_france
+ ; french_belgium
+ ; french_cameroon
+ ; french_canada
+ ; french_democratic_rep_of_congo
+ ; french_cote_divoire
+ ; french_haiti
+ ; french_luxembourg
+ ; french_mali
+ ; french_monaco
+ ; french_morocco
+ ; french_north_africa
+ ; french_reunion
+ ; french_senegal
+ ; french_switzerland
+ ; french_west_indies
+ ; frisian_netherlands
+ ; fulfulde_nigeria
+ ; fyro_macedonian
+ ; gaelic_ireland
+ ; gaelic_scotland
+ ; galician
+ ; georgian
+ ; german_germany
+ ; german_austria
+ ; german_liechtenstein
+ ; german_luxembourg
+ ; german_switzerland
+ ; greek
+ ; guarani_paraguay
+ ; gujarati
+ ; hausa_nigeria
+ ; hawaiian_united_states
+ ; hebrew
+ ; hindi
+ ; hungarian
+ ; ibibio_nigeria
+ ; icelandic
+ ; igbo_nigeria
+ ; indonesian
+ ; inuktitut
+ ; italian_italy
+ ; italian_switzerland
+ ; japanese
+ ; kannada
+ ; kanuri_nigeria
+ ; kashmiri
+ ; kashmiri_arabic
+ ; kazakh
+ ; khmer
+ ; konkani
+ ; korean
+ ; kyrgyz_cyrillic
+ ; lao
+ ; latin
+ ; latvian
+ ; lithuanian
+ ; malay_malaysia
+ ; malay_brunei_darussalam
+ ; malayalam
+ ; maltese
+ ; manipuri
+ ; maori_new_zealand
+ ; marathi
+ ; mongolian_cyrillic
+ ; mongolian_mongolian
+ ; nepali
+ ; nepali_india
+ ; norwegian_bokmal
+ ; norwegian_nynorsk
+ ; oriya
+ ; oromo
+ ; papiamentu
+ ; pashto
+ ; polish
+ ; portuguese_brazil
+ ; portuguese_portugal
+ ; punjabi
+ ; punjabi_pakistan
+ ; quecha_bolivia
+ ; quecha_ecuador
+ ; quecha_peru
+ ; rhaeto_romanic
+ ; romanian
+ ; romanian_moldava
+ ; russian
+ ; russian_moldava
+ ; sami_lappish
+ ; sanskrit
+ ; sepedi
+ ; serbian_cyrillic
+ ; serbian_latin
+ ; sindhi_india
+ ; sindhi_pakistan
+ ; sinhalese_sri_lanka
+ ; slovak
+ ; slovenian
+ ; somali
+ ; sorbian
+ ; spanish_spain_modern_sort
+ ; spanish_spain_traditional_sort
+ ; spanish_argentina
+ ; spanish_bolivia
+ ; spanish_chile
+ ; spanish_colombia
+ ; spanish_costa_rica
+ ; spanish_dominican_republic
+ ; spanish_ecuador
+ ; spanish_el_salvador
+ ; spanish_guatemala
+ ; spanish_honduras
+ ; spanish_latin_america
+ ; spanish_mexico
+ ; spanish_nicaragua
+ ; spanish_panama
+ ; spanish_paraguay
+ ; spanish_peru
+ ; spanish_puerto_rico
+ ; spanish_united_states
+ ; spanish_uruguay
+ ; spanish_venezuela
+ ; sutu
+ ; swahili
+ ; swedish
+ ; swedish_finland
+ ; syriac
+ ; tajik
+ ; tamazight_arabic
+ ; tamazight_latin
+ ; tamil
+ ; tatar
+ ; telugu
+ ; thai
+ ; tibetan_bhutan
+ ; tibetan_peoples_republic_of_china
+ ; tigrigna_eritrea
+ ; tigrigna_ethiopia
+ ; tsonga
+ ; tswana
+ ; turkish
+ ; turkmen
+ ; uighur_china
+ ; ukrainian
+ ; urdu
+ ; urdu_india
+ ; uzbek_cyrillic
+ ; uzbek_latin
+ ; venda
+ ; vietnamese
+ ; welsh
+ ; xhosa
+ ; yi
+ ; yiddish
+ ; yoruba
+ ; zulu
+ ; hid_human_interface_device.
+
+ % The following three types describe the possible errors that could occur
+ % while generating a Wix source file.
+
+:- type wix_result
+ ---> ok
+ ; wix_error(wix_error).
+
+:- type wix_error
+ ---> some [L] no_translation(L, language)
+ ; io_error(io.error)
+ ; guid_gen_error(guid_error).
+
+:- type guid_error
+ ---> guid_eof
+ ; guid_io_error(io.error)
+ ; guid_cmd_error(io.system_result).
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module wix_installer.
+:- import_module wix_files.
+:- import_module wix_util.
+:- import_module wix_language.
+
+:- import_module exception.
+:- import_module std_util.
+:- import_module term_to_xml.
+
+generate_installer(Installer, GUIDGenCmd, FileName, Result, !IO) :-
+ io.open_output(FileName, OpenResult, !IO),
+ (
+ OpenResult = ok(OutStream),
+ %
+ % We know that, operationally, for a given input,
+ % gen_annotated_installer will either always throw an exception
+ % or always succeed.
+ %
+ promise_equivalent_solutions [TryResult, !:IO] (
+ try_io(
+ wix_installer.gen_annotated_installer(Installer, GUIDGenCmd),
+ TryResult,
+ !IO)
+ ),
+ (
+ TryResult = succeeded(AnnInstaller),
+ write_xml_doc(OutStream, AnnInstaller, !IO),
+ Result = ok
+ ;
+ TryResult = exception(Univ),
+ ( if univ_to_type(Univ, WixError) then
+ Result = wix_error(WixError)
+ else
+ throw(Univ)
+ )
+ )
+ ;
+ OpenResult = error(IOError),
+ Result = wix_error(io_error(IOError))
+ ).
+
+welcome_wizard_step(Heading, Message) = wizard_start(Heading, Message).
+
+wix.license_wizard_step(Heading, Instructions, LicenseSrc) =
+ wix_gui.license_wizard_step(Heading, Instructions, LicenseSrc).
+
+wix.notice_wizard_step(Heading, Message) =
+ wix_gui.notice_wizard_step(Heading, Message).
Index: extras/windows_installer_generator/wix_files.m
===================================================================
RCS file: extras/windows_installer_generator/wix_files.m
diff -N extras/windows_installer_generator/wix_files.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ extras/windows_installer_generator/wix_files.m 25 Oct 2005 13:33:27 -0000
@@ -0,0 +1,319 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2005 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%---------------------------------------------------------------------------%
+%
+% Main author: Ian MacLarty (maclarty at cs.mu.oz.au).
+%
+%---------------------------------------------------------------------------%
+%
+% This module is responsible for telling Wix what files and shortcuts to
+% install.
+% Each file corresponds to a `Component' element in the Wix source file.
+% Each component must have a unique GUID.
+% Components are grouped together under Features. Wix allows Features to
+% be installed independently, however the current implementation of this
+% Wix source generator always installs all the Features.
+%
+
+:- module wix_files.
+
+:- interface.
+
+:- import_module io.
+:- import_module list.
+:- import_module term_to_xml.
+
+:- import_module wix.
+:- import_module wix_util.
+
+:- type file(L)
+ ---> file(
+ filename :: string,
+ % A list of shortcuts that should be
+ % created to the file.
+ shortcuts :: list(shortcut(L))
+ )
+ ; directory(
+ dir_name :: string,
+ dir_contents :: list(file(L))
+ ).
+
+ % Files are converted to annotated files and then to XML.
+ % annotated files contain more information, such as the Id and
+ % GUID of each file.
+ %
+:- type annotated_file.
+
+:- func annotated_file_to_xml(annotated_file) = xml.
+:- mode annotated_file_to_xml(in) = (out(xml_doc)) is det.
+
+ % Assign Ids and GUIDs to the files and their descendents.
+ %
+:- pred annotate_files(language::in, list(file(L))::in,
+ id_supply::in, id_supply::out,
+ string::in, string::in, list(annotated_file)::out,
+ io::di, io::uo) is det <= language_independent_tokens(L).
+
+:- pred gen_files(string::in, shortcut_function(L)::in,
+ list(file(L))::out, io::di, io::uo) is det.
+
+ % Generate Feature elements containing the given components.
+ % Multiple features will be generated if there are more than 800
+ % components. This is to get round a limitation of Windows 9X where
+ % each feature may have no more that 817 components.
+ %
+:- func generate_feature_elements(list(annotated_file)) = list(xml).
+
+ % Succeed if there are any shortcuts from the Programs menu to any
+ % of the given files.
+ %
+:- pred is_shortcut_from_programs_menu(list(annotated_file)::in) is semidet.
+
+:- pred gen_guid(string::in, guid::out, io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module bool.
+:- import_module dir.
+:- import_module exception.
+:- import_module int.
+:- import_module require.
+:- import_module string.
+
+:- import_module wix_language.
+
+:- type annotated_file
+ ---> annotated_file(
+ ann_comp_id :: id,
+ ann_comp_guid :: guid,
+ ann_file_id :: id,
+ ann_filename :: string,
+ ann_path :: string,
+ ann_shortcuts :: list(annotated_shortcut)
+ )
+ ; annotated_directory(
+ ann_dir_id :: id,
+ ann_dir_name :: string,
+ ann_contents :: list(annotated_file)
+ ).
+
+:- type annotated_shortcut
+ ---> annotated_shortcut(
+ ann_shortcut_id :: id,
+ ann_shortcut_where :: shortcut_where,
+ ann_shortcut_name :: string
+ ).
+
+gen_files(Dir, ShortCuts, Files, !IO) :-
+ dir.foldl2(add_file(ShortCuts), Dir, [], MaybeFiles, !IO),
+ (
+ MaybeFiles = ok(Files)
+ ;
+ MaybeFiles = error(_, Err),
+ throw(io_error(Err))
+ ).
+
+:- pred add_file(shortcut_function(L)::in, string::in, string::in,
+ io.file_type::in, bool::out,
+ list(file(L))::in, list(file(L))::out,
+ io::di, io::uo) is det.
+
+add_file(ShortCutsMap, DirName, BaseName, FileType, yes, !Files, !IO) :-
+ ( if FileType = directory then
+ gen_files(DirName ++ dir_sep ++ BaseName, ShortCutsMap,
+ FilesInDir, !IO),
+ File = directory(BaseName, FilesInDir),
+ !:Files = [File | !.Files]
+ else
+ ShortCutsMap(DirName, BaseName) = ShortCuts,
+ !:Files = [file(BaseName, ShortCuts) | !.Files]
+ ).
+
+:- pred annotate_file(language::in, file(L)::in, id_supply::in, id_supply::out,
+ string::in, string::in, annotated_file::out,
+ io::di, io::uo) is det <= language_independent_tokens(L).
+
+annotate_file(Language, file(Name, ShortCuts), !IdSupply, GUIDGenCmd, Path,
+ AnnotatedFile, !IO) :-
+ allocate_id(ComponentId, !IdSupply),
+ allocate_id(FileId, !IdSupply),
+ annotate_shortcuts(Language, ShortCuts, AnnShortCuts, !IdSupply),
+ gen_guid(GUIDGenCmd, GUID, !IO),
+ AnnotatedFile = annotated_file(ComponentId, GUID,
+ FileId, Name, Path, AnnShortCuts).
+annotate_file(Language, directory(Name, Files), !IdStore, GUIDGenCmd, Path0,
+ AnnotatedDir, !IO) :-
+ allocate_id(DirId, !IdStore),
+ Path = Path0 ++ dir_sep ++ Name,
+ annotate_files(Language, Files, !IdStore, GUIDGenCmd, Path,
+ AnnotatedFiles, !IO),
+ AnnotatedDir = annotated_directory(DirId, Name, AnnotatedFiles).
+
+annotate_files(_, [], !IdStore, _, _, [], !IO).
+annotate_files(Language, [File | Files], !IdStore, GUIDGenCmd, Path,
+ [AnnFile | AnnFiles], !IO) :-
+ annotate_file(Language, File, !IdStore, GUIDGenCmd, Path, AnnFile,
+ !IO),
+ annotate_files(Language, Files, !IdStore, GUIDGenCmd, Path, AnnFiles,
+ !IO).
+
+:- pred annotate_shortcuts(language::in, list(shortcut(L))::in,
+ list(annotated_shortcut)::out, id_supply::in, id_supply::out) is det
+ <= language_independent_tokens(L).
+
+annotate_shortcuts(_, [], [], !IdSupply).
+annotate_shortcuts(Language, [ShortCut | ShortCuts], AnnShortCuts, !IdSupply)
+ :-
+ ShortCut = shortcut(Where, Name),
+ annotate_shortcuts(Language, ShortCuts, Rest, !IdSupply),
+ det_translate(Name, Language, TranslatedName),
+ allocate_id(ShortCutId, !IdSupply),
+ AnnShortCuts = [annotated_shortcut(ShortCutId,
+ Where, TranslatedName) | Rest].
+
+:- instance xmlable(annotated_file) where [
+ func(to_xml/1) is annotated_file_to_xml
+].
+
+annotated_file_to_xml(annotated_file(CompId, GUID, FileId, Name, Path,
+ ShortCuts)) =
+ elem("Component", [
+ id_attr(CompId),
+ guid_attr(GUID)
+ ],
+ [elem("File", [id_attr(FileId)] ++
+ name_attrs(Name, FileId) ++
+ [attr("src", Path ++ dir_sep ++ Name)]
+ ++ [disk_id_attr],
+ list.map(annotated_shortcut_to_xml,
+ list.sort_and_remove_dups(ShortCuts))
+ )]
+
+ ).
+annotated_file_to_xml(annotated_directory(DirId, Name, Files)) =
+ elem("Directory", [id_attr(DirId)] ++ name_attrs(Name, DirId),
+ list.map(annotated_file_to_xml, Files)).
+
+:- pred file_is_directory(annotated_file::in) is semidet.
+
+file_is_directory(annotated_directory(_, _, _)).
+
+:- func component_refs(annotated_file) = list(xml).
+
+component_refs(annotated_file(CompId, _, _, _, _, _)) =
+ [elem("ComponentRef", [id_attr(CompId)], [])].
+component_refs(annotated_directory(_, _, Files)) =
+ list.condense(list.map(component_refs, Files)).
+
+:- func annotated_shortcut_to_xml(annotated_shortcut) = xml.
+
+annotated_shortcut_to_xml(annotated_shortcut(Id, Where, Name)) =
+ elem("Shortcut", [
+ id_attr(Id),
+ shortcut_where_attr(Where)] ++
+ name_attrs(Name, Id), []).
+
+generate_feature_elements(Contents) = XML :-
+ % Win9X can't handle features with more than 817 components.
+ generate_component_list(Contents, [], Components),
+ list.chunk(Components, 800, ComponentChunks),
+ XML = generate_feature_chunks(1, ComponentChunks).
+
+:- pred generate_component_list(list(annotated_file)::in,
+ list(annotated_file)::in, list(annotated_file)::out) is det.
+
+generate_component_list([], !Components).
+generate_component_list([File | Files], Components0, Components) :-
+ (
+ File = annotated_file(_, _, _, _, _, _),
+ Components1 = [File]
+ ;
+ File = annotated_directory(_, _, FilesInDir),
+ generate_component_list(FilesInDir, [], Components1)
+ ),
+ generate_component_list(Files, Components0 ++ Components1, Components).
+
+:- func generate_feature_chunks(int, list(list(annotated_file))) = list(xml).
+
+generate_feature_chunks(_, []) = [].
+generate_feature_chunks(FeatureNum, [Chunk | Chunks]) = XML :-
+ XML =
+ [elem("Feature", [
+ id_attr("Feature" ++ int_to_string(FeatureNum)),
+ attr("Level", "1")
+ ],
+ ( if FeatureNum = 1 then
+ [elem("ComponentRef", [id_attr(env_vars_component_id)], [])]
+ else
+ []
+ ) ++
+ list.condense(list.map(component_refs, Chunk))
+ )] ++
+ generate_feature_chunks(FeatureNum + 1, Chunks).
+
+is_shortcut_from_programs_menu(
+ [annotated_file(_, _, _, _, _, ShortCuts) | Files]) :-
+ (
+ is_shortcut_from_programs_menu_2(ShortCuts)
+ ;
+ is_shortcut_from_programs_menu(Files)
+ ).
+is_shortcut_from_programs_menu(
+ [annotated_directory(_, _, MoreFiles) | Files]) :-
+ (
+ is_shortcut_from_programs_menu(MoreFiles)
+ ;
+ is_shortcut_from_programs_menu(Files)
+ ).
+
+:- pred is_shortcut_from_programs_menu_2(list(annotated_shortcut)::in)
+ is semidet.
+
+is_shortcut_from_programs_menu_2([annotated_shortcut(_, programs, _) | _]).
+is_shortcut_from_programs_menu_2([_ | Rest]) :-
+ is_shortcut_from_programs_menu_2(Rest).
+
+gen_guid(Cmd, GUID, !IO) :-
+ io.make_temp(TempFile, !IO),
+ io.call_system_return_signal(Cmd ++ " > " ++ TempFile, CallRes, !IO),
+ (
+ CallRes = ok(ExitStatus),
+ ( if ExitStatus = exited(0) then
+ io.see(TempFile, SeeRes, !IO),
+ (
+ SeeRes = ok,
+ io.read_line_as_string(ReadRes, !IO),
+ (
+ ReadRes = ok(Line),
+ GUID = string.to_upper(
+ string.rstrip(Line)),
+ io.seen(!IO),
+ io.remove_file(TempFile, _, !IO)
+ ;
+ ReadRes = eof,
+ io.remove_file(TempFile, _, !IO),
+ throw(guid_gen_error(guid_eof))
+ ;
+ ReadRes = error(Err),
+ io.remove_file(TempFile, _, !IO),
+ throw(guid_gen_error(
+ guid_io_error(Err)))
+ )
+ ;
+ SeeRes = error(Err),
+ io.remove_file(TempFile, _, !IO),
+ throw(guid_gen_error(guid_io_error(Err)))
+ )
+ else
+ io.remove_file(TempFile, _, !IO),
+ throw(guid_gen_error(guid_cmd_error(ExitStatus)))
+ )
+ ;
+ CallRes = error(Err),
+ io.remove_file(TempFile, _, !IO),
+ throw(guid_gen_error(guid_io_error(Err)))
+ ).
Index: extras/windows_installer_generator/wix_gui.m
===================================================================
RCS file: extras/windows_installer_generator/wix_gui.m
diff -N extras/windows_installer_generator/wix_gui.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ extras/windows_installer_generator/wix_gui.m 25 Oct 2005 13:33:27 -0000
@@ -0,0 +1,745 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2005 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%---------------------------------------------------------------------------%
+%
+% Main author: Ian MacLarty (maclarty at cs.mu.oz.au).
+%
+%---------------------------------------------------------------------------%
+%
+% This module is responsible for generating the GUI components of the
+% installer.
+%
+% Throughout this module the type variable L indicates a language
+% independent token and the type variable D indicates a type representing
+% a set of dialog boxes (such as wizard_step_dlg).
+%
+
+:- module wix_gui.
+
+:- interface.
+
+:- import_module wix.
+:- import_module wix_util.
+
+:- import_module list.
+:- import_module map.
+:- import_module term_to_xml.
+
+:- type wizard_step(L)
+ ---> wizard_step(
+ wiz_step_heading :: L,
+ wiz_step_controls :: list(control(L, wizard_step_dlg))
+ )
+ ; wizard_start(L, L).
+
+:- func license_wizard_step(L, L, L) = wizard_step(L).
+
+:- func notice_wizard_step(L, L) = wizard_step(L).
+
+ % Different types of wizard steps that can occur in the installer.
+ %
+:- type wizard_step_dlg
+ ---> wiz_step(int)
+ ; cancel_dlg
+ ; install_progress_dlg
+ ; remove_progress_dlg
+ ; remove_dlg
+ ; finish_dlg
+ ; files_in_use_dlg.
+
+ % A general dialog box.
+ %
+:- type dialog(L, D)
+ ---> dialog(
+ dialog_id :: D,
+ dialog_size :: size,
+ dialog_title :: L,
+ dialog_modeless :: modeless,
+ dialog_controls :: list(control(L, D))
+ ).
+
+ % Various widgets that can be placed in dialog boxes.
+ %
+:- type control(L, D)
+ ---> button(
+ button_pos :: position,
+ button_size :: size,
+ button_default :: button_default,
+ button_text :: L,
+ button_events :: list(event(D))
+ )
+ ; bitmap(
+ bitmap_pos :: position,
+ bitmap_size :: size,
+ bitmap_src :: string
+ )
+ ; line(
+ line_pos :: position,
+ line_size :: size
+ )
+ ; scrollable_text(
+ scroll_text_pos :: position,
+ scroll_text_size :: size,
+ scroll_text_source :: L
+ )
+ ; text(
+ text_pos :: position,
+ text_size :: size,
+ text_text :: L,
+ text_style :: text_style
+ )
+ ; progress_bar(
+ progress_bar_pos :: position,
+ progress_bar_size :: size
+ )
+ ; progress_text(
+ progress_text_pos :: position,
+ progress_text_size :: size
+ )
+ ; files_in_use_list(
+ files_in_use_pos :: position,
+ files_in_use_size :: size
+ ).
+
+ % Used to indicate if a button is selected by default or not.
+ %
+:- type button_default
+ ---> default
+ ; not_default.
+
+:- type text_style
+ ---> normal
+ ; bold
+ ; heading.
+
+:- type event(D)
+ ---> new_dialog(D) % Replace the current dialog with a new one.
+ ; spawn_dialog(D) % Create the dialog in a new window.
+ ; return % End the current sequence.
+ % Ending during the wizard causes installation
+ % to start.
+ ; exit % Exit the installer.
+ ; remove_all % Uninstall the product.
+
+ ; retry % Retry an operation that failed.
+ % Currently this event only makes sense when
+ % triggered from a files-in-use dialog
+ % that tells the user that certain files
+ % are being locked by other applications.
+
+ ; ignore. % Ignore some error condition and continue
+ % the installation regardless.
+ % Currently this event only makes sense when
+ % triggered from a files-in-use dialog
+ % that tells the user that certain files
+ % are being locked by other applications.
+
+:- type annotated_dialog.
+
+:- pred set_ann_dialog_id(id::in,
+ annotated_dialog::in, annotated_dialog::out) is det.
+
+:- pred annotate_dialogs(language::in,
+ list(dialog(L, D))::in, list(annotated_dialog)::out,
+ id_supply::in, id_supply::out,
+ map(D, id)::in, map(D, id)::out,
+ map(string, id)::in, map(string, id)::out) is det
+ <= language_independent_tokens(L).
+
+:- pred annotate_dialog(language::in, dialog(L, D)::in, annotated_dialog::out,
+ id_supply::in, id_supply::out,
+ map(D, id)::in, map(D, id)::out,
+ map(string, id)::in, map(string, id)::out) is det
+ <= language_independent_tokens(L).
+
+:- func bitmaps_to_xml(list(string), list(id)) = list(xml).
+
+:- pred generate_wizard_dialogs(L::in, L::in, L::in, L::in, L::in, string::in,
+ string::in, list(wizard_step(L))::in,
+ list(dialog(L, wizard_step_dlg))::out) is det.
+
+%----------------------------------------------------------------------------%
+%
+% Various default dialogs.
+%
+
+:- func cancel_dialog(L, L, L, L) = dialog(L, wizard_step_dlg).
+
+:- func install_progress_dialog(L, L, L, L, string)
+ = dialog(L, wizard_step_dlg).
+
+:- func remove_progress_dialog(L, L, L, L, string)
+ = dialog(L, wizard_step_dlg).
+
+:- func remove_dialog(L, L, L, L, L, string) = dialog(L, wizard_step_dlg).
+
+:- func finish_dialog(L, L, L, L, string) = dialog(L, wizard_step_dlg).
+
+:- func files_in_use_dialog(L, L, L, L, L, L, string)
+ = dialog(L, wizard_step_dlg).
+
+%----------------------------------------------------------------------------%
+
+ % Generate a list containing one UI element if the input list has
+ % any elements and an empty list if there are no dialogs in the input
+ % list.
+ %
+:- func maybe_ui_elements(list(annotated_dialog), id, id) = list(xml).
+
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module require.
+:- import_module std_util.
+:- import_module string.
+:- import_module svmap.
+
+:- import_module wix_language.
+
+:- type annotated_dialog
+ ---> annotated_dialog(
+ ann_dialog_id :: id,
+ ann_dialog_size :: size,
+ ann_dialog_title :: string,
+ ann_dialog_modeless :: modeless,
+ ann_dialog_controls :: list(annotated_control)
+ ).
+
+set_ann_dialog_id(Id, AD, AD ^ ann_dialog_id := Id).
+
+:- type annotated_control
+ ---> annotated_button(
+ ann_button_id :: id,
+ ann_button_pos :: position,
+ ann_button_size :: size,
+ ann_button_default :: button_default,
+ ann_button_text :: string,
+ ann_button_events :: list(annotated_event)
+ )
+ ; annotated_bitmap(
+ ann_bitmap_id :: id,
+ ann_bitmap_pos :: position,
+ ann_bitmap_size :: size,
+ ann_bitmap_src_id :: id
+ )
+ ; annotated_line(
+ ann_line_id :: id,
+ ann_line_pos :: position,
+ ann_line_size :: size
+ )
+ ; annotated_scrollable_text(
+ ann_scroll_text_id :: id,
+ ann_scroll_text_pos :: position,
+ ann_scroll_text_size :: size,
+ ann_scroll_text_text :: string
+ )
+ ; annotated_text(
+ ann_text_id :: id,
+ ann_text_pos :: position,
+ ann_text_size :: size,
+ ann_text_text :: string,
+ ann_text_style :: text_style
+ )
+ ; annotated_progress_bar(
+ ann_prog_bar_id :: id,
+ ann_prog_bar_pos :: position,
+ ann_prog_bar_size :: size
+ )
+ ; annotated_progress_text(
+ ann_prog_text_id :: id,
+ ann_prog_text_pos :: position,
+ ann_prog_text_size :: size
+ )
+ ; annotated_files_in_use_list(
+ ann_files_in_use_id :: id,
+ ann_files_in_use_pos :: position,
+ ann_files_in_use_size :: size
+ ).
+
+:- type annotated_event
+ ---> annotated_new_dialog(id)
+ ; annotated_spawn_dialog(id)
+ ; annotated_return
+ ; annotated_exit
+ ; annotated_remove_all
+ ; annotated_ignore
+ ; annotated_retry.
+
+license_wizard_step(Heading, Instructions, LicenseSrc) =
+ wizard_step(Heading, [
+ scrollable_text(20 - 60, 330 - 160, LicenseSrc),
+ text(25 - 23, 280 - 15, Instructions, normal)]).
+
+notice_wizard_step(Heading, Notice) =
+ wizard_step(Heading, [text(20 - 60, 330 - 160, Notice, normal)]).
+
+install_progress_dialog(Title, Heading, Description, Cancel, BitMapSrc) =
+ dialog(install_progress_dlg, 370 - 270, Title, modeless, [
+ button(304 - 243, 56 - 17, default, Cancel,
+ [spawn_dialog(cancel_dlg)]),
+ progress_bar(35 - 115, 300 - 10),
+ progress_text(70 - 100, 265 - 10),
+ bitmap(0 - 0, 370 - 44, BitMapSrc),
+ text(35 - 65, 300 - 20, Description, normal),
+ text(20 - 15, 200 - 15, Heading, bold),
+ line(0 - 234, 370 - 0),
+ line(0 - 44, 370 - 0)]).
+
+remove_progress_dialog(Title, Heading, Description, Cancel, BitMapSrc) =
+ dialog(remove_progress_dlg, 370 - 270, Title, modeless, [
+ button(304 - 243, 56 - 17, default, Cancel,
+ [spawn_dialog(cancel_dlg)]),
+ progress_bar(35 - 115, 300 - 10),
+ progress_text(70 - 100, 265 - 10),
+ bitmap(0 - 0, 370 - 44, BitMapSrc),
+ text(35 - 65, 300 - 20, Description, normal),
+ text(20 - 15, 200 - 15, Heading, bold),
+ line(0 - 234, 370 - 0),
+ line(0 - 44, 370 - 0)]).
+
+remove_dialog(Title, Heading, AreYouSure, Remove, Cancel, BitMapSrc) =
+ dialog(remove_dlg, 370 - 270, Title, not_modeless, [
+ button(304 - 243, 56 - 17, default, Cancel,
+ [spawn_dialog(cancel_dlg)]),
+ button(236 - 243, 56 - 17, not_default, Remove,
+ [remove_all, new_dialog(remove_progress_dlg)]),
+ bitmap(0 - 0, 370 - 44, BitMapSrc),
+ text(35 - 65, 300 - 20, AreYouSure, normal),
+ text(20 - 15, 200 - 15, Heading, bold),
+ line(0 - 234, 370 - 0),
+ line(0 - 44, 370 - 0)]).
+
+finish_dialog(Title, Heading, Message, Finish, BackgroundSrc) =
+ dialog(finish_dlg, 370 - 270, Title, not_modeless, [
+ button(236 - 243, 56 - 17, not_default, Finish, [exit]),
+ bitmap(0 - 0, 370 - 234, BackgroundSrc),
+ text(135 - 70, 220 - 60, Message, normal),
+ text(135 - 20, 220 - 60, Heading, heading),
+ line(0 - 234, 370 - 0)]).
+
+files_in_use_dialog(Title, Heading, Message, Retry, Ignore, Cancel, BitMapSrc)
+ = dialog(files_in_use_dlg, 370 - 270, Title, keep_modeless, [
+ button(304 - 243, 56 - 17, default, Retry, [retry]),
+ button(235 - 243, 56 - 17, not_default, Ignore, [ignore]),
+ button(166 - 243, 56 - 17, not_default, Cancel, [exit]),
+ bitmap(0 - 0, 370 - 44, BitMapSrc),
+ text(35 - 65, 300 - 20, Message, normal),
+ text(20 - 15, 200 - 15, Heading, bold),
+ line(0 - 234, 370 - 0),
+ line(0 - 44, 370 - 0),
+ files_in_use_list(20 - 87, 330 - 130)]).
+
+cancel_dialog(Title, CancelMessage, Yes, No) =
+ dialog(cancel_dlg, 260 - 85, Title, not_modeless, [
+ button(132 - 57, 56 - 17, default, No, [return]),
+ button(72 - 57, 56 - 17, not_default, Yes, [exit]),
+ text(48 - 15, 194 - 30, CancelMessage, normal)]).
+
+annotate_dialogs(_, [], [], !IdSupply, !DialogIdMap, !BitMaps).
+annotate_dialogs(Language, [Dialog | Dialogs], [AnnDialog | AnnDialogs],
+ !IdSupply, !DialogIdMap, !BitMaps) :-
+ annotate_dialogs(Language, Dialogs, AnnDialogs, !IdSupply,
+ !DialogIdMap, !BitMaps),
+ annotate_dialog(Language, Dialog, AnnDialog, !IdSupply,
+ !DialogIdMap, !BitMaps).
+
+annotate_dialog(Language, Dialog, AnnDialog, !IdSupply, !DialogIdMap,
+ !BitMaps) :-
+ Dialog = dialog(DialogToken, Size, TitleToken, Modeless, Controls),
+ det_translate(TitleToken, Language, Title),
+ lookup_dialog_id(DialogToken, DialogId, !DialogIdMap, !IdSupply),
+ annotate_controls(Language, Controls, AnnControls, !DialogIdMap,
+ !IdSupply, !BitMaps),
+ AnnDialog = annotated_dialog(DialogId, Size, Title, Modeless,
+ AnnControls).
+
+:- func annotated_dialog_to_xml(annotated_dialog) = xml.
+
+annotated_dialog_to_xml(annotated_dialog(Id, Size, Title, Modeless, Controls))
+ = elem("Dialog",
+ [id_attr(Id)] ++
+ size_attrs(Size) ++
+ [title_attr(Title)] ++
+ [modeless_attr(Modeless)] ++
+ [attr("NoMinimize", "yes")],
+ list.map(annotated_control_to_xml, Controls)).
+
+:- pred annotate_controls(language::in, list(control(L, D))::in,
+ list(annotated_control)::out,
+ map(D, id)::in, map(D, id)::out,
+ id_supply::in, id_supply::out,
+ map(string, id)::in, map(string, id)::out) is det
+ <= language_independent_tokens(L).
+
+annotate_controls(_, [], [], !DialogIdMap, !IdSupply, !BitMaps).
+annotate_controls(Language, [Control | Controls], [AnnControl | AnnControls],
+ !DialogIdMap, !IdSupply, !BitMaps) :-
+ annotate_controls(Language, Controls, AnnControls, !DialogIdMap,
+ !IdSupply, !BitMaps),
+ annotate_control(Language, Control, AnnControl, !DialogIdMap,
+ !IdSupply, !BitMaps).
+
+:- pred annotate_control(language::in,
+ control(L, D)::in,
+ annotated_control::out,
+ map(D, id)::in, map(D, id)::out,
+ id_supply::in, id_supply::out,
+ map(string, id)::in, map(string, id)::out) is det
+ <= language_independent_tokens(L).
+
+annotate_control(Language, Control, AnnControl, !DialogIdMap, !IdSupply,
+ !BitMaps) :-
+ (
+ Control = button(Pos, Size, Default, TextToken, Events),
+ det_translate(TextToken, Language, Text),
+ allocate_id(Id, !IdSupply),
+ annotate_events(Events, AnnEvents, !DialogIdMap, !IdSupply),
+ AnnControl = annotated_button(Id, Pos, Size, Default, Text,
+ AnnEvents)
+ ;
+ Control = bitmap(Pos, Size, Source),
+ allocate_id(BitMapControlId, !IdSupply),
+ ( if map.search(!.BitMaps, Source, FoundSourceId) then
+ BitMapSourceId = FoundSourceId
+ else
+ allocate_id(BitMapSourceId, !IdSupply),
+ svmap.det_insert(Source, BitMapSourceId, !BitMaps)
+ ),
+ AnnControl = annotated_bitmap(BitMapControlId, Pos, Size,
+ BitMapSourceId)
+ ;
+ Control = line(Pos, Size),
+ allocate_id(LineId, !IdSupply),
+ AnnControl = annotated_line(LineId, Pos, Size)
+ ;
+ Control = scrollable_text(Pos, Size, TextSrcToken),
+ det_translate(TextSrcToken, Language, TextSrc),
+ allocate_id(TextId, !IdSupply),
+ AnnControl = annotated_scrollable_text(TextId, Pos, Size,
+ TextSrc)
+ ;
+ Control = text(Pos, Size, TextToken, Style),
+ det_translate(TextToken, Language, Text),
+ allocate_id(TextId, !IdSupply),
+ AnnControl = annotated_text(TextId, Pos, Size, Text, Style)
+ ;
+ Control = progress_bar(Pos, Size),
+ allocate_id(Id, !IdSupply),
+ AnnControl = annotated_progress_bar(Id, Pos, Size)
+ ;
+ Control = progress_text(Pos, Size),
+ allocate_id(Id, !IdSupply),
+ AnnControl = annotated_progress_text(Id, Pos, Size)
+ ;
+ Control = files_in_use_list(Pos, Size),
+ allocate_id(Id, !IdSupply),
+ AnnControl = annotated_files_in_use_list(Id, Pos, Size)
+ ).
+
+:- func annotated_control_to_xml(annotated_control) = xml.
+
+annotated_control_to_xml(annotated_button(Id, Pos, Size, Deflt, Text, Events))
+ = elem(control_elem,
+ [type_attr("PushButton")] ++
+ [id_attr(Id)] ++
+ size_attrs(Size) ++
+ pos_attrs(Pos) ++
+ [default_attr(Deflt)] ++
+ [text_attr(Text)],
+ list.map(annotated_event_to_xml, Events)).
+annotated_control_to_xml(annotated_bitmap(Id, Pos, Size, SrcId)) =
+ elem(control_elem,
+ [type_attr("Bitmap")] ++
+ [id_attr(Id)] ++
+ size_attrs(Size) ++
+ pos_attrs(Pos) ++
+ [text_attr(SrcId)] ++
+ [attr("TabSkip", "no")], []).
+annotated_control_to_xml(annotated_line(Id, Pos, Size)) =
+ elem(control_elem,
+ [type_attr("Line")] ++
+ [id_attr(Id)] ++
+ size_attrs(Size) ++
+ pos_attrs(Pos), []).
+annotated_control_to_xml(annotated_scrollable_text(Id, Pos, Size, TextSrc)) =
+ elem(control_elem,
+ [type_attr("ScrollableText")] ++
+ [id_attr(Id)] ++
+ pos_attrs(Pos) ++
+ size_attrs(Size) ++
+ [attr("Sunken", "yes")] ++
+ [attr("TabSkip", "no")], [
+ elem("Text", [attr("src", TextSrc)], [])]).
+annotated_control_to_xml(annotated_text(Id, Pos, Size, Text, Style)) =
+ elem(control_elem,
+ [type_attr("Text")] ++
+ [id_attr(Id)] ++
+ pos_attrs(Pos) ++
+ size_attrs(Size) ++
+ [attr("Transparent", "yes")] ++
+ [attr("NoPrefix", "yes")], [
+ elem("Text", [], [
+ data(text_style_modifier(Style) ++ Text)])]).
+annotated_control_to_xml(annotated_progress_bar(Id, Pos, Size)) =
+ elem(control_elem,
+ [id_attr(Id)] ++
+ [type_attr("ProgressBar")] ++
+ pos_attrs(Pos) ++
+ size_attrs(Size) ++
+ [attr("ProgressBlocks", "yes")] ++
+ [attr("Text", " ")],
+ [elem("Subscribe", [
+ attr("Event", "SetProgress"),
+ attr("Attribute", "Progress")], [])]).
+annotated_control_to_xml(annotated_progress_text(Id, Pos, Size)) =
+ elem(control_elem,
+ [id_attr(Id)] ++
+ [type_attr("Text")] ++
+ pos_attrs(Pos) ++
+ size_attrs(Size),
+ [elem("Subscribe", [
+ attr("Event", "ActionText"),
+ attr("Attribute", "Text")], [])]).
+annotated_control_to_xml(annotated_files_in_use_list(Id, Pos, Size)) =
+ elem(control_elem,
+ [id_attr(Id)] ++
+ [type_attr("ListBox")] ++
+ pos_attrs(Pos) ++
+ size_attrs(Size) ++
+ [attr("Property", "FileInUseProcess")] ++
+ [attr("TabSkip", "yes")] ++
+ [attr("Sunken", "yes")],
+ [elem("Subscribe", [
+ attr("Event", "ActionText"),
+ attr("Attribute", "Text")], [])]).
+
+:- func text_style_modifier(text_style) = string.
+
+text_style_modifier(normal) = "".
+text_style_modifier(bold) = "{&DlgFontBold8}".
+text_style_modifier(heading) = "{\\VerdanaBold13}".
+
+:- func annotated_event_to_xml(annotated_event) = xml.
+
+annotated_event_to_xml(annotated_new_dialog(DialogId)) =
+ elem(publish_elem, [
+ attr("Event", "NewDialog"),
+ attr("Value", DialogId)],
+ [data("1")]).
+annotated_event_to_xml(annotated_spawn_dialog(DialogId)) =
+ elem(publish_elem, [
+ attr("Event", "SpawnDialog"),
+ attr("Value", DialogId)],
+ [data("1")]).
+annotated_event_to_xml(annotated_return) =
+ elem(publish_elem, [
+ attr("Event", "EndDialog"),
+ attr("Value", "Return")],
+ [data("1")]).
+annotated_event_to_xml(annotated_exit) =
+ elem(publish_elem, [
+ attr("Event", "EndDialog"),
+ attr("Value", "Exit")],
+ [data("1")]).
+annotated_event_to_xml(annotated_remove_all) =
+ elem(publish_elem, [
+ attr("Event", "Remove"),
+ attr("Value", "All")],
+ [data("1")]).
+annotated_event_to_xml(annotated_retry) =
+ elem(publish_elem, [
+ attr("Event", "EndDialog"),
+ attr("Value", "Retry")],
+ [data("1")]).
+annotated_event_to_xml(annotated_ignore) =
+ elem(publish_elem, [
+ attr("Event", "EndDialog"),
+ attr("Value", "Ignore")],
+ [data("1")]).
+
+:- func control_elem = string.
+
+control_elem = "Control".
+
+:- func publish_elem = string.
+
+publish_elem = "Publish".
+
+bitmaps_to_xml([], []) = [].
+bitmaps_to_xml([Source | Sources], [Id | Ids]) =
+ [elem("Binary", [
+ id_attr(Id),
+ attr("src", Source)],
+ [])] ++
+ bitmaps_to_xml(Sources, Ids).
+bitmaps_to_xml([], [_ | _]) = _ :-
+ error("bitmaps_to_xml: more ids than sources").
+bitmaps_to_xml([_ | _], []) = _ :-
+ error("bitmaps_to_xml: more sources than ids").
+
+:- pred annotate_events(list(event(D))::in, list(annotated_event)::out,
+ map(D, id)::in, map(D, id)::out,
+ id_supply::in, id_supply::out) is det.
+
+annotate_events([], [], !DialogIdMap, !IdSupply).
+annotate_events([Event | Events], [AnnEvent | AnnEvents], !DialogIdMap,
+ !IdSupply) :-
+ annotate_events(Events, AnnEvents, !DialogIdMap, !IdSupply),
+ annotate_event(Event, AnnEvent, !DialogIdMap, !IdSupply).
+
+:- pred annotate_event(event(D)::in, annotated_event::out,
+ map(D, id)::in, map(D, id)::out,
+ id_supply::in, id_supply::out) is det.
+
+annotate_event(Event, AnnEvent, !DialogIdMap, !IdSupply) :-
+ (
+ Event = new_dialog(DialogToken),
+ lookup_dialog_id(DialogToken, DialogId, !DialogIdMap,
+ !IdSupply),
+ AnnEvent = annotated_new_dialog(DialogId)
+ ;
+ Event = spawn_dialog(DialogToken),
+ lookup_dialog_id(DialogToken, DialogId, !DialogIdMap,
+ !IdSupply),
+ AnnEvent = annotated_spawn_dialog(DialogId)
+ ;
+ Event = return,
+ AnnEvent = annotated_return
+ ;
+ Event = exit,
+ AnnEvent = annotated_exit
+ ;
+ Event = remove_all,
+ AnnEvent = annotated_remove_all
+ ;
+ Event = retry,
+ AnnEvent = annotated_retry
+ ;
+ Event = ignore,
+ AnnEvent = annotated_ignore
+ ).
+
+:- pred lookup_dialog_id(D::in, id::out,
+ map(D, id)::in, map(D, id)::out,
+ id_supply::in, id_supply::out) is det.
+
+lookup_dialog_id(DialogToken, DialogId, !DialogIdMap, !IdSupply) :-
+ ( if map.search(!.DialogIdMap, DialogToken, FoundDialogId) then
+ DialogId = FoundDialogId
+ else
+ allocate_id(DialogId, !IdSupply),
+ svmap.det_insert(DialogToken, DialogId, !DialogIdMap)
+ ).
+
+generate_wizard_dialogs(Title, Next, Back, Cancel, Install, BannerSrc,
+ BackgroundSrc, WizardSteps, Dialogs) :-
+ generate_wizard_dialogs_2(Title, Next, Back, Cancel, Install,
+ BannerSrc, BackgroundSrc, WizardSteps, 0, [], Dialogs).
+
+:- pred generate_wizard_dialogs_2(L::in, L::in, L::in, L::in, L::in,
+ string::in, string::in, list(wizard_step(L))::in, int::in,
+ list(dialog(L, wizard_step_dlg))::in,
+ list(dialog(L, wizard_step_dlg))::out) is det.
+
+generate_wizard_dialogs_2(_, _, _, _, _, _, _, [], _, Dialogs,
+ list.reverse(Dialogs)).
+generate_wizard_dialogs_2(Title, Next, Back, Cancel, Install, BannerSrc,
+ BackgroundSrc, [WizardStep | WizardSteps], StepNum, !Dialogs)
+ :-
+ (
+ WizardSteps = [],
+ NextButton = [button(236 - 243, 56 - 17, default, Install,
+ [new_dialog(install_progress_dlg)])]
+ ;
+ WizardSteps = [_ | _],
+ NextButton = [button(236 - 243, 56 - 17, default, Next,
+ [new_dialog(wiz_step(StepNum + 1))])]
+ ),
+ ( if StepNum = 0 then
+ BackButton = []
+ else
+ BackButton = [button(180 - 243, 56 - 17, not_default, Back,
+ [new_dialog(wiz_step(StepNum - 1))])]
+ ),
+ CancelButton = [button(304 - 243, 56 - 17, not_default, Cancel,
+ [spawn_dialog(cancel_dlg)])],
+ (
+ WizardStep = wizard_step(Heading, Controls),
+ Banner = [bitmap(0 - 0, 370 - 44, BannerSrc)],
+ BottomLine = [line(0 - 234, 370 - 0)],
+ BannerLine = [line(0 - 44, 370 - 0)],
+ HeadingText = [text(15 - 6, 280 - 15, Heading, bold)],
+ WizControls = Controls ++ NextButton ++ BackButton ++
+ CancelButton ++ Banner ++ BottomLine ++ BannerLine ++
+ HeadingText
+ ;
+ WizardStep = wizard_start(Heading, Message),
+ Background = [bitmap(0 - 0, 370 - 234, BackgroundSrc)],
+ HeadingText = [text(135 - 20, 220 - 60, Heading, heading)],
+ MessageText = [text(135 - 70, 220 - 30, Message, normal)],
+ BottomLine = [line(0 - 234, 370 - 0)],
+ WizControls = NextButton ++ CancelButton ++
+ HeadingText ++ MessageText ++ Background ++
+ BottomLine
+ ),
+ Dialog = dialog(wiz_step(StepNum), 370 - 270, Title, not_modeless,
+ WizControls),
+ generate_wizard_dialogs_2(Title, Next, Back, Cancel, Install,
+ BannerSrc, BackgroundSrc, WizardSteps, StepNum + 1,
+ [Dialog | !.Dialogs], !:Dialogs).
+
+maybe_ui_elements([], _, _) = [].
+maybe_ui_elements([Dialog | Dialogs], RemoveDlgId, FinishDlgId) = XML :-
+ DialogId = Dialog ^ ann_dialog_id,
+ XML = [
+ elem("UI", [],
+ [elem("Property", [id_attr("DefaultUIFont")], [data("DlgFont8")])]
+ ++ list.map(annotated_dialog_to_xml, [Dialog | Dialogs]) ++
+ [elem("InstallUISequence", [], [
+ elem("Show", [
+ %
+ % Launch the first step of the wizard if the product is
+ % not installed.
+ %
+ attr("Dialog", DialogId),
+ attr("After", "LaunchConditions")
+ ], [data("NOT Installed")]),
+ elem("Show", [
+ %
+ % If the product is already installed should the
+ % removal dialog box.
+ %
+ attr("Dialog", RemoveDlgId),
+ attr("After", "MigrateFeatureStates")
+ ], [data("Installed")]),
+ elem("Show", [
+ %
+ % Should the finish dialog when installation is complete.
+ %
+ attr("Dialog", FinishDlgId),
+ attr("OnExit", "success")
+ ], [data("NOT Installed")])
+ ])] ++
+ %
+ % Define some commonly used fonts.
+ %
+ [elem("TextStyle", [
+ id_attr("DlgFont8"),
+ attr("FaceName", "Tahoma"),
+ attr("Size", "8")], [])] ++
+ [elem("TextStyle", [
+ id_attr("DlgFontBold8"),
+ attr("FaceName", "Tahoma"),
+ attr("Size", "8"),
+ attr("Bold", "yes")], [])] ++
+ [elem("TextStyle", [
+ id_attr("VerdanaBold13"),
+ attr("FaceName", "Verdana"),
+ attr("Size", "13"),
+ attr("Bold", "yes")], [])]
+ )].
+
Index: extras/windows_installer_generator/wix_installer.m
===================================================================
RCS file: extras/windows_installer_generator/wix_installer.m
diff -N extras/windows_installer_generator/wix_installer.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ extras/windows_installer_generator/wix_installer.m 25 Oct 2005 13:33:27 -0000
@@ -0,0 +1,334 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2005 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%---------------------------------------------------------------------------%
+%
+% Main author: Ian MacLarty (maclarty at cs.mu.oz.au).
+%
+%---------------------------------------------------------------------------%
+%
+% This moduleis reposible for generating the Wix source code for the
+% installer.
+% The installer is first converted to an annotated installer and then
+% to XML. The annotated installer contains extra information, like Ids
+% for all the elements.
+%
+
+:- module wix_installer.
+
+:- interface.
+
+:- import_module io.
+:- import_module term_to_xml.
+
+:- import_module wix.
+
+% gen_annotated_installer(Installer, GUIDGenCmd, AnnotatedInstaller, !IO).
+%
+
+:- pred gen_annotated_installer(installer(L)::in, string::in,
+ annotated_installer::out, io::di, io::uo) is det
+ <= language_independent_tokens(L).
+
+:- instance xmlable(annotated_installer).
+
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module exception.
+:- import_module int.
+:- import_module list.
+:- import_module map.
+:- import_module std_util.
+:- import_module string.
+:- import_module term_to_xml.
+
+:- import_module wix_files.
+:- import_module wix_gui.
+:- import_module wix_language.
+:- import_module wix_util.
+
+:- type annotated_installer
+ ---> annotated_installer(
+ ann_installer_product_info :: annotated_product,
+ ann_installer_language :: language,
+ ann_installer_env_vars_guid :: guid,
+ ann_installer_set_env_vars :: list(ann_set_env_var),
+ ann_installer_wizard_steps :: list(annotated_dialog),
+ ann_installer_bitmaps :: map(string, id),
+ ann_installer_removedlg_id :: id,
+ ann_installer_finish_id :: id,
+ ann_installer_checkifadmin :: maybe(string)
+ ).
+
+:- type ann_set_env_var
+ ---> ann_set_env_var(
+ ann_env_var :: string,
+ ann_env_var_value :: string,
+ ann_env_var_how_set :: env_var_how_set,
+ ann_env_var_system_or_user :: env_var_system_or_user,
+ ann_env_var_id :: id
+ ).
+
+:- type annotated_product
+ ---> annotated_product(
+ ann_prod_guid :: guid,
+ % XXX Upgrade installers are not yet supported,
+ % however the upgrade code is required so that
+ % deployed packages can be upgraded when
+ % upgrade installers are supported.
+ ann_prod_upgrade_guid :: guid,
+ ann_prod_manufacturer :: string,
+ ann_prod_name :: string,
+ ann_prod_version :: version_no,
+ ann_prod_description :: string,
+ ann_prod_comments :: string,
+ ann_prod_contents :: list(annotated_file),
+ ann_prod_default_install_loc :: string
+ ).
+
+:- instance xmlable(annotated_installer) where [
+ func(to_xml/1) is annotated_installer_to_xml
+].
+
+:- func annotated_installer_to_xml(annotated_installer::in) =
+ (xml::out(xml_doc)) is det.
+
+annotated_installer_to_xml(Installer) = XML :-
+ Installer = annotated_installer(Product, LanguageId, EnvVarsGUID, EnvVars,
+ WizardSteps, BitMaps, RemoveDlgId, FinishDlgId, CheckIfAdmin),
+ language_to_lcid(LanguageId, LCID),
+ Product = annotated_product(
+ GUID,
+ UpgradeGUID,
+ Manufacturer,
+ Name,
+ Version,
+ Description,
+ Comments,
+ Contents,
+ DefInstallLoc),
+ XML = elem("Wix", [
+ attr("xmlns","http://schemas.microsoft.com/wix/2003/01/wix")],
+ [
+ elem("Product", [
+ id_attr(GUID),
+ attr("UpgradeCode", UpgradeGUID),
+ attr("Name", Name),
+ attr("Version", version_no_to_string(Version)),
+ attr("Language", int_to_string(LCID)),
+ attr("Manufacturer", Manufacturer)
+ ],
+ [elem("Package",
+ % The following causes wix to generate a fresh guid each time
+ % it compiles the XML file.
+ [id_attr("????????-????-????-????-????????????")] ++
+ attr_if_not_blank(attr("Description", Description)) ++
+ [attr("Manufacturer", Manufacturer)] ++
+ attr_if_not_blank(attr("Comments", Comments)) ++
+ [attr("InstallerVersion", "150")] ++
+ [attr("Compressed", "yes")]
+ , [])] ++
+ ( if CheckIfAdmin = yes(MustBeAdminMessage) then
+ [elem("Condition", [attr("Message", MustBeAdminMessage)],
+ [data("Privileged")])]
+ else
+ []
+ ) ++
+ [elem("Media", [
+ id_attr("1"),
+ attr("Cabinet", "contents.cab"),
+ attr("EmbedCab", "yes"),
+ attr("CompressionLevel", "high")], [])] ++
+ [elem("Directory", [
+ id_attr("TARGETDIR"),
+ attr("Name", "SourceDir")
+ ], [
+ elem("Component", [
+ id_attr(env_vars_component_id),
+ guid_attr(EnvVarsGUID)
+ ], list.map(ann_set_env_var_to_xml, EnvVars)),
+ elem("Directory", [
+ id_attr("ProgramFilesFolder"),
+ attr("Name", "PFiles")
+ ], [
+ elem("Directory",
+ [id_attr("INSTALLDIR")] ++
+ name_attrs(DefInstallLoc, "INSDIR"),
+ list.map(annotated_file_to_xml, Contents))
+ ]),
+ elem("Directory", [
+ id_attr(desktop_id),
+ attr("Name", "Desktop")],
+ [])
+ ] ++
+ programs_menu_directory_if_required(Name, Contents)
+ )] ++
+ generate_feature_elements(Contents) ++
+ maybe_ui_elements(WizardSteps, RemoveDlgId, FinishDlgId) ++
+ bitmaps_to_xml(map.keys(BitMaps), map.values(BitMaps))
+ )
+ ]).
+
+:- func ann_set_env_var_to_xml(ann_set_env_var) = xml.
+
+ann_set_env_var_to_xml(ann_set_env_var(Name, Value, HowSet, SysOrUser, EnvId))
+ = elem("Environment", [
+ id_attr(EnvId),
+ attr("Name", Name),
+ attr("Part", how_set_to_string(HowSet)),
+ attr("Action", "set"),
+ attr("System", system_or_user_to_string(SysOrUser)),
+ attr("Value", Value)], []).
+
+gen_annotated_installer(Installer, GUIDGenCmd, AnnotatedInstaller, !IO) :-
+ some [!IdSupply, !DialogIdMap, !BitMaps] (
+ !:IdSupply = init_id_supply,
+ !:DialogIdMap = map.init,
+ !:BitMaps = map.init,
+ Installer = installer(
+ Product,
+ Language,
+ EnvVars,
+ ShortCuts,
+ Title, InstallHeading, InstallDescr,
+ Next, Back, Cancel, Install, CancelMessage,
+ RemoveHeading, RemoveConfirm, Remove,
+ RemoveProgressHeading, RemoveProgressDescr,
+ FinishHeading, FinishMessage, Finish,
+ FilesInUseHeading, FilesInUseMessage, Ignore, Retry,
+ Yes, No, MustBeAdminMessage, BannerSrc, BackgroundSrc,
+ WizardSteps),
+ Product = product(
+ ManufacturerToken,
+ NameToken,
+ Version,
+ DescriptionToken,
+ CommentsToken,
+ FilesPath,
+ DefaultInstallToken),
+ generate_wizard_dialogs(Title, Next, Back, Cancel, Install,
+ BannerSrc, BackgroundSrc, WizardSteps, WizDialogs),
+ CancelDlg = cancel_dialog(Title, CancelMessage, Yes, No),
+ FinishDlg = finish_dialog(Title, FinishHeading, FinishMessage,
+ Finish, BackgroundSrc),
+ InstallProgressDlg =
+ install_progress_dialog(Title, InstallHeading, InstallDescr,
+ Cancel, BannerSrc),
+ RemoveProgressDlg =
+ remove_progress_dialog(Title, RemoveProgressHeading,
+ RemoveProgressDescr, Cancel, BannerSrc),
+ RemoveDlg = remove_dialog(Title, RemoveHeading, RemoveConfirm,
+ Remove, Cancel, BannerSrc),
+ annotate_dialogs(Language, WizDialogs ++
+ [CancelDlg, InstallProgressDlg,
+ RemoveDlg, RemoveProgressDlg, FinishDlg],
+ AnnDialogs0, !IdSupply, !DialogIdMap, !BitMaps),
+ %
+ % Generate the default files-in-use dialog which asks the user
+ % to close applications that are using installed files.
+ % The dialog must be handled separately because it has the
+ % reserved id `FilesInUse'.
+ %
+ FilesInUseDlg = files_in_use_dialog(Title, FilesInUseHeading,
+ FilesInUseMessage, Retry, Ignore, Cancel, BannerSrc),
+ annotate_dialog(Language, FilesInUseDlg, AnnFilesInUseDlg0, !IdSupply,
+ !DialogIdMap, !BitMaps),
+ set_ann_dialog_id("FilesInUse", AnnFilesInUseDlg0, AnnFilesInUseDlg),
+ list.append(AnnDialogs0, [AnnFilesInUseDlg], AnnDialogs),
+
+ % Look up the ID assigned to the remove dialog which will be
+ % shown if the product is already installed.
+ map.lookup(!.DialogIdMap, remove_dlg, RemoveDlgId),
+
+ % Look up the ID assigned to the finish dialog so we can call it
+ % after installation has finished.
+ map.lookup(!.DialogIdMap, finish_dlg, FinishDlgId),
+
+ annotate_env_vars(Language, EnvVars, AnnEnvVars, !IdSupply,
+ RequiredPrivilege),
+ (
+ RequiredPrivilege = admin,
+ det_translate(MustBeAdminMessage, Language, MustBeAdminMsgStr),
+ CheckForAdmin = yes(MustBeAdminMsgStr)
+ ;
+ RequiredPrivilege = normal,
+ CheckForAdmin = no
+ ),
+ det_translate(ManufacturerToken, Language, Manufacturer),
+ det_translate(NameToken, Language, Name),
+ det_translate(DescriptionToken, Language, Description),
+ det_translate(CommentsToken, Language, Comments),
+ det_translate(DefaultInstallToken, Language, DefInsLoc),
+ gen_files(FilesPath, ShortCuts, Files, !IO),
+ annotate_files(Language, Files, !.IdSupply, _, GUIDGenCmd, FilesPath,
+ AnnotatedFiles, !IO),
+ gen_guid(GUIDGenCmd, ProductGUID, !IO),
+ gen_guid(GUIDGenCmd, UpgradeGUID, !IO),
+ gen_guid(GUIDGenCmd, EnvVarsGUID, !IO),
+ AnnotatedInstaller =
+ annotated_installer(
+ annotated_product(
+ ProductGUID,
+ UpgradeGUID,
+ Manufacturer,
+ Name,
+ Version,
+ Description,
+ Comments,
+ AnnotatedFiles,
+ DefInsLoc
+ ),
+ Language,
+ EnvVarsGUID,
+ AnnEnvVars,
+ AnnDialogs,
+ !.BitMaps,
+ RemoveDlgId,
+ FinishDlgId,
+ CheckForAdmin
+ )
+ ).
+
+:- pred annotate_env_vars(language::in,
+ list(set_env_var(L))::in, list(ann_set_env_var)::out,
+ id_supply::in, id_supply::out, privilege::out)
+ is det <= language_independent_tokens(L).
+
+annotate_env_vars(_, [], [], !IdSupply, normal).
+annotate_env_vars(Language, [Var | Vars], [AnnVar | AnnVars], !IdSupply, Priv)
+ :-
+ Var = set_env_var(VarName, ValueToken, HowSet, SysOrUser),
+ det_translate(ValueToken, Language, Value),
+ allocate_id(EnvId, !IdSupply),
+ AnnVar = ann_set_env_var(VarName, Value, HowSet, SysOrUser, EnvId),
+ annotate_env_vars(Language, Vars, AnnVars, !IdSupply, Priv0),
+ (
+ SysOrUser = system,
+ Priv = admin
+ ;
+ SysOrUser = user,
+ Priv = Priv0
+ ).
+
+:- func programs_menu_directory_if_required(string, list(annotated_file)) =
+ list(xml).
+
+programs_menu_directory_if_required(Name, Contents) = XML :-
+ ( if is_shortcut_from_programs_menu(Contents) then
+ XML = [elem("Directory", [
+ id_attr("ProgramMenuFolder"),
+ attr("Name", "PMENU"),
+ attr("LongName", "Programs")
+ ], [
+ elem("Directory",
+ [id_attr(programs_menu_id)] ++
+ name_attrs(Name, "PROGMENU"), [])
+ ])]
+ else
+ XML = []
+ ).
Index: extras/windows_installer_generator/wix_language.m
===================================================================
RCS file: extras/windows_installer_generator/wix_language.m
diff -N extras/windows_installer_generator/wix_language.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ extras/windows_installer_generator/wix_language.m 25 Oct 2005 13:33:28 -0000
@@ -0,0 +1,273 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2005 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%---------------------------------------------------------------------------%
+%
+% Main author: Ian MacLarty (maclarty at cs.mu.oz.au).
+%
+%---------------------------------------------------------------------------%
+%
+% A few language-related utility predicates.
+%
+
+:- module wix_language.
+
+:- interface.
+
+:- import_module wix.
+
+:- pred det_translate(L::in, language::in, string::out) is det
+ <= language_independent_tokens(L).
+
+:- type lcid == int.
+
+ % Convert a language to a MicroSoft locale code (lcid).
+ %
+:- pred language_to_lcid(language, lcid).
+:- mode language_to_lcid(in, out) is det.
+:- mode language_to_lcid(out, in) is semidet.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module exception.
+
+:- import_module wix_util.
+
+ % This table was obtained from:
+ % http://www.microsoft.com/globaldev/reference/lcid-all.mspx
+ % on 28 August 2005.
+ %
+language_to_lcid(afrikaans_south_africa, 1078).
+language_to_lcid(albanian_albania, 1052).
+language_to_lcid(amharic_ethiopia, 1118).
+language_to_lcid(arabic_saudi_arabia, 1025).
+language_to_lcid(arabic_algeria, 5121).
+language_to_lcid(arabic_bahrain, 15361).
+language_to_lcid(arabic_egypt, 3073).
+language_to_lcid(arabic_iraq, 2049).
+language_to_lcid(arabic_jordan, 11265).
+language_to_lcid(arabic_kuwait, 13313).
+language_to_lcid(arabic_lebanon, 12289).
+language_to_lcid(arabic_libya, 4097).
+language_to_lcid(arabic_morocco, 6145).
+language_to_lcid(arabic_oman, 8193).
+language_to_lcid(arabic_qatar, 16385).
+language_to_lcid(arabic_syria, 10241).
+language_to_lcid(arabic_tunisia, 7169).
+language_to_lcid(arabic_u_a_e, 14337).
+language_to_lcid(arabic_yemen, 9217).
+language_to_lcid(armenian_armenia, 1067).
+language_to_lcid(assamese, 1101).
+language_to_lcid(azeri_cyrillic, 2092).
+language_to_lcid(azeri_latin, 1068).
+language_to_lcid(basque, 1069).
+language_to_lcid(belarusian, 1059).
+language_to_lcid(bengali, 1093).
+language_to_lcid(bengali_bangladesh, 2117).
+language_to_lcid(bosnian_bosnia_herzegovina, 5146).
+language_to_lcid(bulgarian, 1026).
+language_to_lcid(burmese, 1109).
+language_to_lcid(catalan, 1027).
+language_to_lcid(cherokee_united_states, 1116).
+language_to_lcid(chinese_peoples_republic_of_china, 2052).
+language_to_lcid(chinese_singapore, 4100).
+language_to_lcid(chinese_taiwan, 1028).
+language_to_lcid(chinese_hong_kong_sar, 3076).
+language_to_lcid(chinese_macao_sar, 5124).
+language_to_lcid(croatian, 1050).
+language_to_lcid(croatian_bosnia_herzegovina, 4122).
+language_to_lcid(czech, 1029).
+language_to_lcid(danish, 1030).
+language_to_lcid(divehi, 1125).
+language_to_lcid(dutch_netherlands, 1043).
+language_to_lcid(dutch_belgium, 2067).
+language_to_lcid(edo, 1126).
+language_to_lcid(english_united_states, 1033).
+language_to_lcid(english_united_kingdom, 2057).
+language_to_lcid(english_australia, 3081).
+language_to_lcid(english_belize, 10249).
+language_to_lcid(english_canada, 4105).
+language_to_lcid(english_caribbean, 9225).
+language_to_lcid(english_hong_kong_sar, 15369).
+language_to_lcid(english_india, 16393).
+language_to_lcid(english_indonesia, 14345).
+language_to_lcid(english_ireland, 6153).
+language_to_lcid(english_jamaica, 8201).
+language_to_lcid(english_malaysia, 17417).
+language_to_lcid(english_new_zealand, 5129).
+language_to_lcid(english_philippines, 13321).
+language_to_lcid(english_singapore, 18441).
+language_to_lcid(english_south_africa, 7177).
+language_to_lcid(english_trinidad, 11273).
+language_to_lcid(english_zimbabwe, 12297).
+language_to_lcid(estonian, 1061).
+language_to_lcid(faroese, 1080).
+language_to_lcid(farsi, 1065).
+language_to_lcid(filipino, 1124).
+language_to_lcid(finnish, 1035).
+language_to_lcid(french_france, 1036).
+language_to_lcid(french_belgium, 2060).
+language_to_lcid(french_cameroon, 11276).
+language_to_lcid(french_canada, 3084).
+language_to_lcid(french_democratic_rep_of_congo, 9228).
+language_to_lcid(french_cote_divoire, 12300).
+language_to_lcid(french_haiti, 15372).
+language_to_lcid(french_luxembourg, 5132).
+language_to_lcid(french_mali, 13324).
+language_to_lcid(french_monaco, 6156).
+language_to_lcid(french_morocco, 14348).
+language_to_lcid(french_north_africa, 58380).
+language_to_lcid(french_reunion, 8204).
+language_to_lcid(french_senegal, 10252).
+language_to_lcid(french_switzerland, 4108).
+language_to_lcid(french_west_indies, 7180).
+language_to_lcid(frisian_netherlands, 1122).
+language_to_lcid(fulfulde_nigeria, 1127).
+language_to_lcid(fyro_macedonian, 1071).
+language_to_lcid(gaelic_ireland, 2108).
+language_to_lcid(gaelic_scotland, 1084).
+language_to_lcid(galician, 1110).
+language_to_lcid(georgian, 1079).
+language_to_lcid(german_germany, 1031).
+language_to_lcid(german_austria, 3079).
+language_to_lcid(german_liechtenstein, 5127).
+language_to_lcid(german_luxembourg, 4103).
+language_to_lcid(german_switzerland, 2055).
+language_to_lcid(greek, 1032).
+language_to_lcid(guarani_paraguay, 1140).
+language_to_lcid(gujarati, 1095).
+language_to_lcid(hausa_nigeria, 1128).
+language_to_lcid(hawaiian_united_states, 1141).
+language_to_lcid(hebrew, 1037).
+language_to_lcid(hindi, 1081).
+language_to_lcid(hungarian, 1038).
+language_to_lcid(ibibio_nigeria, 1129).
+language_to_lcid(icelandic, 1039).
+language_to_lcid(igbo_nigeria, 1136).
+language_to_lcid(indonesian, 1057).
+language_to_lcid(inuktitut, 1117).
+language_to_lcid(italian_italy, 1040).
+language_to_lcid(italian_switzerland, 2064).
+language_to_lcid(japanese, 1041).
+language_to_lcid(kannada, 1099).
+language_to_lcid(kanuri_nigeria, 1137).
+language_to_lcid(kashmiri, 2144).
+language_to_lcid(kashmiri_arabic, 1120).
+language_to_lcid(kazakh, 1087).
+language_to_lcid(khmer, 1107).
+language_to_lcid(konkani, 1111).
+language_to_lcid(korean, 1042).
+language_to_lcid(kyrgyz_cyrillic, 1088).
+language_to_lcid(lao, 1108).
+language_to_lcid(latin, 1142).
+language_to_lcid(latvian, 1062).
+language_to_lcid(lithuanian, 1063).
+language_to_lcid(malay_malaysia, 1086).
+language_to_lcid(malay_brunei_darussalam, 2110).
+language_to_lcid(malayalam, 1100).
+language_to_lcid(maltese, 1082).
+language_to_lcid(manipuri, 1112).
+language_to_lcid(maori_new_zealand, 1153).
+language_to_lcid(marathi, 1102).
+language_to_lcid(mongolian_cyrillic, 1104).
+language_to_lcid(mongolian_mongolian, 2128).
+language_to_lcid(nepali, 1121).
+language_to_lcid(nepali_india, 2145).
+language_to_lcid(norwegian_bokmal, 1044).
+language_to_lcid(norwegian_nynorsk, 2068).
+language_to_lcid(oriya, 1096).
+language_to_lcid(oromo, 1138).
+language_to_lcid(papiamentu, 1145).
+language_to_lcid(pashto, 1123).
+language_to_lcid(polish, 1045).
+language_to_lcid(portuguese_brazil, 1046).
+language_to_lcid(portuguese_portugal, 2070).
+language_to_lcid(punjabi, 1094).
+language_to_lcid(punjabi_pakistan, 2118).
+language_to_lcid(quecha_bolivia, 1131).
+language_to_lcid(quecha_ecuador, 2155).
+language_to_lcid(quecha_peru, 3179).
+language_to_lcid(rhaeto_romanic, 1047).
+language_to_lcid(romanian, 1048).
+language_to_lcid(romanian_moldava, 2072).
+language_to_lcid(russian, 1049).
+language_to_lcid(russian_moldava, 2073).
+language_to_lcid(sami_lappish, 1083).
+language_to_lcid(sanskrit, 1103).
+language_to_lcid(sepedi, 1132).
+language_to_lcid(serbian_cyrillic, 3098).
+language_to_lcid(serbian_latin, 2074).
+language_to_lcid(sindhi_india, 1113).
+language_to_lcid(sindhi_pakistan, 2137).
+language_to_lcid(sinhalese_sri_lanka, 1115).
+language_to_lcid(slovak, 1051).
+language_to_lcid(slovenian, 1060).
+language_to_lcid(somali, 1143).
+language_to_lcid(sorbian, 1070).
+language_to_lcid(spanish_spain_modern_sort, 3082).
+language_to_lcid(spanish_spain_traditional_sort, 1034).
+language_to_lcid(spanish_argentina, 11274).
+language_to_lcid(spanish_bolivia, 16394).
+language_to_lcid(spanish_chile, 13322).
+language_to_lcid(spanish_colombia, 9226).
+language_to_lcid(spanish_costa_rica, 5130).
+language_to_lcid(spanish_dominican_republic, 7178).
+language_to_lcid(spanish_ecuador, 12298).
+language_to_lcid(spanish_el_salvador, 17418).
+language_to_lcid(spanish_guatemala, 4106).
+language_to_lcid(spanish_honduras, 18442).
+language_to_lcid(spanish_latin_america, 58378).
+language_to_lcid(spanish_mexico, 2058).
+language_to_lcid(spanish_nicaragua, 19466).
+language_to_lcid(spanish_panama, 6154).
+language_to_lcid(spanish_paraguay, 15370).
+language_to_lcid(spanish_peru, 10250).
+language_to_lcid(spanish_puerto_rico, 20490).
+language_to_lcid(spanish_united_states, 21514).
+language_to_lcid(spanish_uruguay, 14346).
+language_to_lcid(spanish_venezuela, 8202).
+language_to_lcid(sutu, 1072).
+language_to_lcid(swahili, 1089).
+language_to_lcid(swedish, 1053).
+language_to_lcid(swedish_finland, 2077).
+language_to_lcid(syriac, 1114).
+language_to_lcid(tajik, 1064).
+language_to_lcid(tamazight_arabic, 0414).
+language_to_lcid(tamazight_latin, 1119).
+language_to_lcid(tamil, 1097).
+language_to_lcid(tatar, 1092).
+language_to_lcid(telugu, 1098).
+language_to_lcid(thai, 1054).
+language_to_lcid(tibetan_bhutan, 2129).
+language_to_lcid(tibetan_peoples_republic_of_china, 1105).
+language_to_lcid(tigrigna_eritrea, 2163).
+language_to_lcid(tigrigna_ethiopia, 1139).
+language_to_lcid(tsonga, 1073).
+language_to_lcid(tswana, 1074).
+language_to_lcid(turkish, 1055).
+language_to_lcid(turkmen, 1090).
+language_to_lcid(uighur_china, 1152).
+language_to_lcid(ukrainian, 1058).
+language_to_lcid(urdu, 1056).
+language_to_lcid(urdu_india, 2080).
+language_to_lcid(uzbek_cyrillic, 2115).
+language_to_lcid(uzbek_latin, 1091).
+language_to_lcid(venda, 1075).
+language_to_lcid(vietnamese, 1066).
+language_to_lcid(welsh, 1106).
+language_to_lcid(xhosa, 1076).
+language_to_lcid(yi, 1144).
+language_to_lcid(yiddish, 1085).
+language_to_lcid(yoruba, 1130).
+language_to_lcid(zulu, 1077).
+language_to_lcid(hid_human_interface_device, 1279).
+
+det_translate(Token, Language, Translation) :-
+ ( if translate(Token, Language, WasTranslation) then
+ Translation = WasTranslation
+ else
+ throw('new no_translation'(Token, Language))
+ ).
Index: extras/windows_installer_generator/wix_util.m
===================================================================
RCS file: extras/windows_installer_generator/wix_util.m
diff -N extras/windows_installer_generator/wix_util.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ extras/windows_installer_generator/wix_util.m 25 Oct 2005 13:33:28 -0000
@@ -0,0 +1,206 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2005 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%---------------------------------------------------------------------------%
+%
+% Main author: Ian MacLarty (maclarty at cs.mu.oz.au).
+%
+%---------------------------------------------------------------------------%
+%
+% Various misc predicates and functions used by the wix modules.
+%
+
+:- module wix_util.
+
+:- interface.
+
+:- import_module list.
+:- import_module term_to_xml.
+:- import_module std_util.
+
+:- import_module wix.
+:- import_module wix_gui.
+
+ % Mode options for dialog boxes.
+ %
+:- type modeless
+ ---> modeless
+ ; not_modeless
+ ; keep_modeless.
+
+:- type privilege
+ ---> admin
+ ; normal.
+
+%----------------------------------------------------------------------------%
+%
+% Various attributes used in the generation of the Wix source file.
+%
+
+:- func guid_attr(guid) = attr.
+
+:- func id_attr(string) = attr.
+
+:- func disk_id_attr = attr.
+
+:- func name_attrs(string, string) = list(attr).
+
+:- func size_attrs(size) = list(attr).
+
+:- func pos_attrs(position) = list(attr).
+
+:- func title_attr(string) = attr.
+
+:- func default_attr(button_default) = attr.
+
+:- func modeless_attr(modeless) = attr.
+
+:- func text_attr(string) = attr.
+
+:- func type_attr(string) = attr.
+
+:- func shortcut_where_attr(shortcut_where) = attr.
+
+%----------------------------------------------------------------------------%
+
+:- type position == pair(int).
+
+:- type size == pair(int).
+
+:- func dir_sep = string.
+
+:- type id == string.
+
+:- type guid == string.
+
+:- type id_supply.
+
+:- pred allocate_id(id::out, id_supply::in, id_supply::out)
+ is det.
+
+:- func init_id_supply = id_supply.
+
+:- func attr_if_not_blank(attr) = list(attr).
+
+:- func version_no_to_string(version_no) = string.
+
+:- func env_vars_component_id = string.
+
+:- func desktop_id = string.
+
+:- func programs_menu_id = string.
+
+:- func how_set_to_string(env_var_how_set) = string.
+
+:- func system_or_user_to_string(env_var_system_or_user) = string.
+
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module counter.
+:- import_module dir.
+:- import_module exception.
+:- import_module int.
+:- import_module require.
+:- import_module string.
+
+guid_attr(GUID) = attr("Guid", GUID).
+
+id_attr(Id) = attr("Id", Id).
+
+ % XXX Currently installers can span only one volume.
+ %
+disk_id_attr = attr("DiskId", "1").
+
+name_attrs(FileName, ShortName) = Attrs :-
+ ( if is_legal_windows_short_name(FileName) then
+ Attrs = [attr("Name", FileName)]
+ else
+ Attrs = [attr("Name", ShortName), attr("LongName", FileName)]
+ ).
+
+pos_attrs(X - Y) = [attr("X", int_to_string(X)), attr("Y", int_to_string(Y))].
+
+size_attrs(Width - Height) =
+ [attr("Width", int_to_string(Width)),
+ attr("Height", int_to_string(Height))].
+
+title_attr(Title) = attr("Title", Title).
+
+default_attr(default) = attr("Default", "yes").
+default_attr(not_default) = attr("Default", "no").
+
+text_attr(Text) = attr("Text", Text).
+
+type_attr(Type) = attr("Type", Type).
+
+shortcut_where_attr(programs) = attr("Directory", programs_menu_id).
+shortcut_where_attr(desktop) = attr("Directory", desktop_id).
+
+modeless_attr(modeless) = attr("Modeless", "yes").
+modeless_attr(not_modeless) = attr("Modeless", "no").
+modeless_attr(keep_modeless) = attr("KeepModeless", "yes").
+
+%----------------------------------------------------------------------------%
+
+:- pred is_legal_windows_short_name(string::in) is semidet.
+
+is_legal_windows_short_name(FileName) :-
+ Parts = string.words(unify('.'), FileName),
+ (
+ Parts = [BaseName, Extension],
+ string.length(BaseName) =< 8,
+ string.length(Extension) =< 3,
+ string.is_alnum_or_underscore(BaseName),
+ string.is_alnum_or_underscore(Extension)
+ ;
+ Parts = [BaseName],
+ string.length(BaseName) =< 8,
+ string.is_alnum_or_underscore(BaseName)
+ ).
+
+ % XXX I don't know exactly how to do this, so am ignoring it for
+ % now. It should only cause problems on versions of windows which
+ % don't support long file names. To my knowledge this is versions
+ % prior to Windows 95 which Mercury won't run on anyway - Ian MacLarty.
+ %
+:- func make_short_filename(string) = string.
+
+make_short_filename(_) = "XXX.XXX".
+
+dir_sep = char_to_string(dir.directory_separator).
+
+:- type id_supply == counter.
+
+allocate_id("id" ++ int_to_string(Id), !IdSupply) :-
+ counter.allocate(Id, !IdSupply).
+
+init_id_supply = counter.init(1).
+
+attr_if_not_blank(attr(Name, Value)) = AttrList :-
+ ( if Value = "" then
+ AttrList = []
+ else
+ AttrList = [attr(Name, Value)]
+ ).
+
+version_no_to_string(version_no(Major, Minor, Build, Other)) =
+ int_to_string(Major) ++ "." ++ int_to_string(Minor) ++ "." ++
+ int_to_string(Build) ++ "." ++ int_to_string(Other).
+
+%----------------------------------------------------------------------------%
+
+env_vars_component_id = "ENVIRONMENT_VARIABLES_COMPONENT".
+desktop_id = "DesktopFolder".
+programs_menu_id = "PROGRAMSMENU".
+
+%----------------------------------------------------------------------------%
+
+how_set_to_string(replace) = "all".
+how_set_to_string(prepend) = "first".
+how_set_to_string(append) = "last".
+
+system_or_user_to_string(system) = "yes".
+system_or_user_to_string(user) = "no".
Index: extras/windows_installer_generator/sample/Mercury.options
===================================================================
RCS file: extras/windows_installer_generator/sample/Mercury.options
diff -N extras/windows_installer_generator/sample/Mercury.options
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ extras/windows_installer_generator/sample/Mercury.options 25 Oct 2005 15:16:01 -0000
@@ -0,0 +1 @@
+MCFLAGS=-I../ -L../ -lwix
Index: extras/windows_installer_generator/sample/README
===================================================================
RCS file: extras/windows_installer_generator/sample/README
diff -N extras/windows_installer_generator/sample/README
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ extras/windows_installer_generator/sample/README 25 Oct 2005 15:28:43 -0000
@@ -0,0 +1,22 @@
+This directory contains the program gen_merc_wxs, which can be used to generate
+a windows installer for the Mercury distribution.
+
+To compile gen_merc_wxs, first build the wix library in the parent directory
+and then do:
+
+mmc --make gen_merc_wxs
+
+
+Usage: gen_merc_wxs <version> <path to merc files> <guid command> <out file>
+
+For example the command:
+
+gen_merc_wxs 0.12.0 c:\mercury uuidgen installer.wxs
+
+will produce the file installer.wxs based on the files in c:\mercury.
+The .wxs file can then be compiled into a Microsoft installer (.msi)
+file using the Wix compiler and linker (candle.exe and light.exe), available
+from wix.sourceforge.net:
+
+candle installer.wxs
+light installer.wixobj
Index: extras/windows_installer_generator/sample/gen_merc_wxs.m
===================================================================
RCS file: extras/windows_installer_generator/sample/gen_merc_wxs.m
diff -N extras/windows_installer_generator/sample/gen_merc_wxs.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ extras/windows_installer_generator/sample/gen_merc_wxs.m 25 Oct 2005 15:19:01 -0000
@@ -0,0 +1,257 @@
+:- module gen_merc_wxs.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module bool.
+:- import_module list.
+:- import_module std_util.
+:- import_module string.
+:- import_module term_to_xml.
+
+:- import_module wix.
+
+main(!IO) :-
+ io.command_line_arguments(Args, !IO),
+ ( if Args = [Version, Path, GUIDGenCmd, OutFile] then
+ Product = product(
+ merc_group,
+ merc_comp(Version),
+ version_no(0, 0, 0, 0), % This is just to keep the
+ % Wix compiler happy.
+ merc_comp(Version),
+ product_comments,
+ Path,
+ merc_comp(Version)),
+
+ Installer ^ wix_product_info = Product,
+ Installer ^ wix_language = english_south_africa,
+ Installer ^ wix_set_env_vars =
+ [set_env_var("PATH", path, prepend, system)],
+ Installer ^ wix_shortcut_func = doc_shortcuts,
+ Installer ^ wix_title = title,
+ Installer ^ wix_install_heading = install_heading,
+ Installer ^ wix_install_descr = install_descr,
+ Installer ^ wix_next_button = next,
+ Installer ^ wix_back_button = back,
+ Installer ^ wix_cancel_button = cancel,
+ Installer ^ wix_install_button = install,
+ Installer ^ wix_cancel_message = cancel_message,
+ Installer ^ wix_remove_heading = remove_heading,
+ Installer ^ wix_remove_confirm = remove_confirm,
+ Installer ^ wix_remove_button = remove,
+ Installer ^ wix_remove_progress_heading = remove_prog_heading,
+ Installer ^ wix_remove_progress_descr = remove_prog_descr,
+ Installer ^ wix_finish_heading = finish_heading,
+ Installer ^ wix_finish_message = finish_message,
+ Installer ^ wix_finish_button = finish,
+ Installer ^ wix_files_in_use_heading = files_in_use_heading,
+ Installer ^ wix_files_in_use_message = files_in_use_message,
+ Installer ^ wix_ignore_button = ignore,
+ Installer ^ wix_retry_button = retry,
+ Installer ^ wix_yes_button = yes,
+ Installer ^ wix_no_button = no,
+ Installer ^ wix_must_be_admin_msg = admin_message,
+ Installer ^ wix_banner_source = "images\\banner.bmp",
+ Installer ^ wix_background_source = "images\\bg.bmp",
+ Installer ^ wix_wizard_steps = [
+ welcome_wizard_step(welcome, welcome_message),
+ license_wizard_step(license_heading, blank, notice_src)
+ ],
+
+ generate_installer(Installer, GUIDGenCmd, OutFile, Result,
+ !IO),
+ (
+ Result = ok
+ ;
+ Result = wix_error(Error),
+ io.format("Error generating wix source: %s\n",
+ [s(string.string(Error))], !IO)
+ )
+ else
+ io.write_string(merc_installer_usage_message, !IO),
+ io.nl(!IO)
+ ).
+
+:- type language_token
+ ---> merc_group
+ ; merc_comp(string)
+ ; product_comments
+ ; path
+ ; welcome
+ ; welcome_message
+ ; title
+ ; next
+ ; back
+ ; cancel
+ ; install
+ ; license_heading
+ ; notice_src
+ ; cancel_message
+ ; yes
+ ; no
+ ; install_heading
+ ; install_descr
+ ; remove_heading
+ ; remove_confirm
+ ; remove
+ ; files_in_use_message
+ ; files_in_use_heading
+ ; ignore
+ ; retry
+ ; remove_prog_heading
+ ; remove_prog_descr
+ ; admin_message
+ ; finish_heading
+ ; finish_message
+ ; finish
+ ; html_ref_man
+ ; html_lib_ref
+ ; html_user_guide
+ ; pdf_ref_man
+ ; pdf_lib_ref
+ ; pdf_user_guide
+ ; pdf_tutorial
+ ; blank.
+
+ % This function is used to generate shortcuts to the Mercury
+ % documentation in the Start/Programs menu.
+ %
+:- func doc_shortcuts(string, string) = list(shortcut(language_token)).
+
+doc_shortcuts(_, FileName) = Shortcuts :-
+ ( if FileName = "mercury_ref.html" then
+ Shortcuts = [shortcut(programs, html_ref_man)]
+ else if FileName = "mercury_user_guide.html" then
+ Shortcuts = [shortcut(programs, html_user_guide)]
+ else if FileName = "mercury_library.html" then
+ Shortcuts = [shortcut(programs, html_lib_ref)]
+ else if FileName = "reference_manual.pdf" then
+ Shortcuts = [shortcut(programs, pdf_ref_man)]
+ else if FileName = "user_guide.pdf" then
+ Shortcuts = [shortcut(programs, pdf_user_guide)]
+ else if FileName = "library.pdf" then
+ Shortcuts = [shortcut(programs, pdf_lib_ref)]
+ else if FileName = "book.pdf" then
+ Shortcuts = [shortcut(programs, pdf_tutorial)]
+ else
+ Shortcuts = []
+ ).
+
+:- instance language_independent_tokens(language_token) where [
+ pred(translate/3) is translate_token
+].
+
+:- pred translate_token(language_token, language, string).
+:- mode translate_token(in, in, out) is semidet.
+:- mode translate_token(in, in(english), out) is det.
+
+ % Ralph would object...
+ %
+:- inst english
+ ---> english_united_states
+ ; english_united_kingdom
+ ; english_australia
+ ; english_belize
+ ; english_canada
+ ; english_caribbean
+ ; english_hong_kong_sar
+ ; english_india
+ ; english_indonesia
+ ; english_ireland
+ ; english_jamaica
+ ; english_malaysia
+ ; english_new_zealand
+ ; english_philippines
+ ; english_singapore
+ ; english_south_africa
+ ; english_trinidad
+ ; english_zimbabwe.
+
+translate_token(Token, Language, Translation) :-
+ ( Language = english_united_states
+ ; Language = english_united_kingdom
+ ; Language = english_australia
+ ; Language = english_belize
+ ; Language = english_canada
+ ; Language = english_caribbean
+ ; Language = english_hong_kong_sar
+ ; Language = english_india
+ ; Language = english_indonesia
+ ; Language = english_ireland
+ ; Language = english_jamaica
+ ; Language = english_malaysia
+ ; Language = english_new_zealand
+ ; Language = english_philippines
+ ; Language = english_singapore
+ ; Language = english_south_africa
+ ; Language = english_trinidad
+ ; Language = english_zimbabwe
+ ),
+ token_to_english(Token, Translation).
+
+:- pred token_to_english(language_token::in, string::out) is det.
+
+token_to_english(blank, "").
+token_to_english(merc_group, "The Mercury Group").
+token_to_english(merc_comp(Version), "Mercury " ++ Version).
+token_to_english(product_comments, "").
+token_to_english(path, "\"[INSTALLDIR]bin\"").
+token_to_english(welcome, "Welcome.").
+token_to_english(welcome_message,
+ "This program will install the Melbourne Mercury distribution " ++
+ "to your compiler. Click Next to continue.").
+token_to_english(title, "Mercury installer").
+token_to_english(next, "Next >").
+token_to_english(back, "< Back").
+token_to_english(cancel, "Cancel").
+token_to_english(install, "Install").
+token_to_english(license_heading, "Licences").
+token_to_english(notice_src, "NOTICE.rtf").
+token_to_english(cancel_message, "Are you sure you want to cancel?").
+token_to_english(yes, "yes").
+token_to_english(no, "no").
+token_to_english(install_heading, "Installing Mercury").
+token_to_english(install_descr,
+ "Installation may take a few minutes, please be patient.").
+token_to_english(remove_heading, "Uninstall").
+token_to_english(remove_confirm, "Are you sure you wish to uninstall?").
+token_to_english(remove, "Remove").
+token_to_english(files_in_use_heading,
+ "Some files that need to be updated are currently in use.").
+token_to_english(files_in_use_message,
+ "The following applications are using files that need to be " ++
+ "updated by this setup. Close these applications and then click " ++
+ "Retry to continue the installation or Cancel to exit it.").
+token_to_english(retry, "Retry").
+token_to_english(ignore, "Ignore").
+token_to_english(remove_prog_heading, "Uninstalling").
+token_to_english(remove_prog_descr,
+ "Uninstallation may take a few minutes, please be patient.").
+token_to_english(admin_message,
+ "You need to be an administrator to install this software.").
+token_to_english(finish_heading, "All done.").
+token_to_english(finish_message,
+ "Thank you for installing Mercury. " ++
+ "Online documentation is avalible from www.cs.mu.oz.au/mercury. " ++
+ "Please email any bug reports to mercury-bugs at cs.mu.oz.au. " ++
+ "Click finish to exit the Mercury installer.").
+token_to_english(finish, "Finish").
+token_to_english(html_ref_man, "Reference Manual (HTML)").
+token_to_english(pdf_ref_man, "Reference Manual (PDF)").
+token_to_english(html_lib_ref, "Library Reference (HTML)").
+token_to_english(pdf_lib_ref, "Library Reference (PDF)").
+token_to_english(html_user_guide, "User Guide (HTML)").
+token_to_english(pdf_user_guide, "User Guide (PDF)").
+token_to_english(pdf_tutorial, "Introductory Tutorial (PDF)").
+
+:- func merc_installer_usage_message = string.
+
+merc_installer_usage_message =
+ "Usage: gen_merc_wxs <version> <path to merc files> " ++
+ "<guid command> <out file>".
Index: extras/windows_installer_generator/sample/images/Exclam.ico
===================================================================
RCS file: extras/windows_installer_generator/sample/images/Exclam.ico
diff -N extras/windows_installer_generator/sample/images/Exclam.ico
Binary files /dev/null and Exclam.ico differ
Index: extras/windows_installer_generator/sample/images/Info.ico
===================================================================
RCS file: extras/windows_installer_generator/sample/images/Info.ico
diff -N extras/windows_installer_generator/sample/images/Info.ico
Binary files /dev/null and Info.ico differ
Index: extras/windows_installer_generator/sample/images/banner.bmp
===================================================================
RCS file: extras/windows_installer_generator/sample/images/banner.bmp
diff -N extras/windows_installer_generator/sample/images/banner.bmp
Binary files /dev/null and banner.bmp differ
Index: extras/windows_installer_generator/sample/images/bg.bmp
===================================================================
RCS file: extras/windows_installer_generator/sample/images/bg.bmp
diff -N extras/windows_installer_generator/sample/images/bg.bmp
Binary files /dev/null and bg.bmp differ
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list