home *** CD-ROM | disk | FTP | other *** search
Perl Script | 1997-11-10 | 2.7 KB | 110 lines | [TEXT/McPL] |
- #!/usr/bin/perl
- # StandardFile.pl
- # Standard File Package Utility for MacPerl 4.1.1
- #
- # 1994.01.05 v4.1.1 Matthias Neeracher <neeri@iis.ee.ethz.ch>
- # Minor changes to reflect future plans for standard file support.
- #
- # 1993.10.27 v1.2 wm
- # Change the calling syntax to adopt the 4.1.0 release.
- #
- # 1993.10.19 v1.1 wm
- # convert for 4.1b6
- #
- # 1993.8.10 V1.0
- # Watanabe Maki (Watanabe.Maki@tko.dec.com)
- #
-
- require "GUSI.ph";
-
- package StandardFile;
-
- # Name
- # GetFile
- # Syntax
- # $filename = &GetFile([$prompt, ] @types [, $default]);
- # Description
- # Query a existing file name to user by Standard File Dialog Box.
- # $prompt is a user prompt, which is ignored under 4.1.1, but will
- # probably be shown in a future version. $prompt should never be a
- # string of length 4.
- # @types is a list of the file type which is used for
- # filtering the file list in the dialog box.
- #
- sub GetFile {
- local($prompt,@types) = @_;
- local($default) = pop(@types);
-
- if (length($prompt) == 4) {
- unshift(@types, $prompt);
- $prompt = "";
- }
- if (length($default) == 4) {
- push(@types, $default);
- $default = "";
- }
-
- &MacPerl::Choose(
- &GUSI::AF_FILE, # domain
- 0, # type
- $prompt, # prompt
- &GUSI::pack_sa_constr_file(@types),
- # constraint
- ($default ? &GUSI::CHOOSE_DEFAULT : 0),
- # flag
- $default # default filename
- );
- }
-
- # Name
- # PutFile/GetNewFile
- # Syntax
- # $filename = &PutFile($prompt [, $default]);
- # $filename = &GetNewFile($prompt [, $default]);
- # Description
- # Query a new file name to user by Standard File Dialog Box.
- # $prompt is a prompt sting on the dialog box.
- # $default is a default file name.
- #
- sub PutFile {
- local($prompt, $default) = @_;
-
- &MacPerl::Choose(
- &GUSI::AF_FILE, # domain
- 0, # type
- $prompt, # prompt
- "", # constraint
- &GUSI::CHOOSE_NEW + ($default ? &GUSI::CHOOSE_DEFAULT : 0),
- # flag
- $default # default filename
- );
- }
-
- sub GetNewFile {
- &PutFile;
- }
-
- # Name
- # GetFolder
- # Syntax
- # $foldername = &GetFolder($prompt [, $default]);
- # Description
- # Query a folder name to user by Standard File Dialog Box.
- # $default is the default dialog
- #
- sub GetFolder {
- local($prompt, $default) = @_;
-
- &MacPerl::Choose(
- &GUSI::AF_FILE, # domain
- 0, # type
- $prompt, # prompt
- "", # constraint
- &GUSI::CHOOSE_DIR + ($default ? &GUSI::CHOOSE_DEFAULT : 0),
- # flag
- $default
- );
- }
-
- 1;
-