Transfer Menu
| Volume Number: | | 7
|
| Issue Number: | | 12
|
| Column Tag: | | Pascal Procedures
|
Related Info: Segment Loader List Manager Menu Manager
Transfer Menu
By Clifford Story, Goleta, CA
Note: Source code files accompanying article are located on MacTech CD-ROM or source code disks.
A Transfer Menu... Again
You may have seen my earlier article on a Transfer DA, which adds a Transfer menu to any application. A Transfer DA has to do its work without any help from the application; consequently, my DA did a lot of hacking with the system and low-memory globals. One result became apparent just about the time the article was published: my Transfer DA bombs under System 6.0.2. Sic transit gloria..[A revised version is now on the source code disk for the Transfer DA (#37)].
The Transfer DA finds all applications on the boot disk and puts them on the Transfer menu. This is fine, so long as all the applications you’re interested in are on the same disk as your System folder. And so long as you haven’t too many of them; scrolling the menu for item #358 can be a pain! Lately, though, I’ve been working with my System folder on a separate partition of my hard disk; this makes it easy to use different System versions (I have a System 4.2 partition and a System 6.0.2 partition) but my Transfer menu comes up empty.
This article presents a different sort of Transfer menu, with a different sort of Transfer. First, it’s an application Transfer menu, not a DA; this means that the application will shut itself down before the transfer; no system hacking required. It’s all high-level stuff, and the program works under all system versions I have tested, and under the MultiFinder. Second, the menu is built and maintained by the user. He can add applications via an SFget dialog, and remove them with a delete dialog. (But the menu doesn’t scroll, so he can’t add too many.)
Components of the Program
The program may be broken into several parts:
• The main program, which contains the code to perform the transfer and maintain the menu. The program doesn’t do anything but support desk accessories and the Transfer menu. This menu looks like this:
• When the user selects the first item, the program puts up an SFget dialog, and transfers to the selected program after adding it to the menu. If he selects the second item, the program puts up a delete dialog, with the applications on a scrolling list. He can then select applications to delete from the menu. If he selects one of the named applications, the program transfers to that application.
• The menu definition procedure (MDEF) which draws and hit-tests the menu. This is a fairly simple MDEF but I went through a lot of screen shots with fatbits to determine the constants that would reproduce the spacing on a standard menu. I didn’t reproduce scrolling; this menu doesn’t scroll.
• The list definition procedure (LDEF) which draws the list of menu items used in the delete dialog.
These three parts use a common data structure, stored as a “TRNS” resource, that lists all the applications on the menu. The main program uses it to transfer to a selected application; it is also in charge of adding and deleting applications. The MDEF uses it in place of the menuhandle as its source of data, and the LDEF uses it in the same way.
Source Files
Seven source files make up the program, which is written in Pascal and compiled under MPW. The seven are:
• Transfer.make, the MPW make file;
• Transfer.r, the Rez input file (resource source file);
• mytypes.p, a catchall unit of constant and type declarations;
• Common.p, which contains the declaration of the common data structure;
• Transfer Menu.p, the MDEF source;
• Transfer List.p, the LDEF source; and
• Transfer.p, the main program source.
I will discuss them individually in that order (the first three don’t require much discussion).
A Note from Apple
I ran into a problem while I was working on this program: It failed (although, at least, it didn’t crash) under the Multifinder. So I wrote a letter to Apple and asked for help. They actually replied to my letter (which is something), but their reply was less than helpful. Anyway, I quote from the reply:
In general, we do not recommend that applications contain a Transfer menu or menu item. There are various system compatibility problems.
I wonder if they’ve taken a look at Resedit lately... And they enclosed a copy of Tech Note 126, which is about sublaunching! I wonder if they read their letters before they mail them out. Anyway, there’s the Word from Olympus.
#1
#***************************************
#
#Transfer.make
#
#(c) 1988, by Clifford Story
#& Attic Software
#
#***************************************
#***************************************
#Compile the resources
#***************************************
Transfer ƒƒ Transfer.make Transfer.r
Rez Transfer.r -append -o Transfer
#***************************************
#Compile the common data declarations
#***************************************
Common.p.o ƒ Transfer.make Common.p
Pascal Common.p
#***************************************
#Compile the MDEF
#***************************************
‘Transfer Menu’.p.o ƒ Transfer.make
‘Transfer Menu’.p Common.p.o
Pascal ‘Transfer Menu’.p
Transfer ƒƒ Transfer.make
‘Transfer Menu’.p.o
Link -m MENUDEF -w -t ‘APPL’
-c ‘????’ -rt MDEF=1001
-sn Main=’Transfer Menu’
‘Transfer Menu’.p.o
“{Libraries}”Interface.o
“{Libraries}”Runtime.o
“{PLibraries}”PasLib.o
“{PLibraries}”SANELib.o
-o Transfer
#***************************************
#Compile the LDEF
#***************************************
‘Transfer List’.p.o ƒ Transfer.make
‘Transfer List’.p Common.p.o
Pascal ‘Transfer List’.p
Transfer ƒƒ Transfer.make
‘Transfer List’.p.o
Link -m LISTDEF -w -t ‘APPL’
-c ‘????’ -rt LDEF=1001
-sn Main=’Transfer List’
‘Transfer List’.p.o
“{Libraries}”Interface.o
“{Libraries}”Runtime.o
“{PLibraries}”PasLib.o
“{PLibraries}”SANELib.o
-o Transfer
#***************************************
#Compile the main program
#***************************************
Transfer.p.o ƒ Transfer.make
Transfer.p Common.p.o
Pascal Transfer.p
Transfer ƒƒ Transfer.make Transfer.p.o
Link -w -t APPL -c ‘????’
Transfer.p.o
“{Libraries}”Interface.o
“{Libraries}”Runtime.o
“{PLibraries}”PasLib.o
“{PLibraries}”SANELib.o
-o Transfer
#***************************************
The Program’s Resources
Here we have a standard set of resources, with MENUs and ALRTs and DITLs and so on. Two resources are a bit out of the ordinary: MENU 1004 and the TRNS resource.
MENU 1004 is, of course, the Transfer menu. Notice that it uses MDEF 1001 instead of textMenuProc. You might wonder why it has any data, since I’ve already said that the MDEF will use a separate data structure in place of the menuhandle to draw the menu. It’s true that it doesn’t need alot of the data included here, but it does plain need the first item, since that item has a keyboard equivalent. The MDEF may not look at the menuhandle, but MenuKey does.
The TRNS resource is the menu list data structure. The record is declared in Common.p; suffice it to say here that the first word is the number of applications in the list. So what is declared here is an empty list.
/* 2 */
/****************************************
Transfer.r
Resources for Transfer menu demo.
(c) 1988, by Clifford Story
& Attic Software
****************************************/
#include “types.r”
/****************************************
Menu resources
****************************************/
resource ‘MENU’ (1001) {
1001,
textMenuProc,
$7FFFFFFB,
enabled,
apple,
{ /* array: 3 elements */
/* [1] */
“About Transfer...”, noicon,
“”, “”, plain,
/* [2] */
“About Attic Software...”, noicon,
“”, “”, plain,
/* [3] */
“-”, noIcon, “”, “”, plain
}
};
resource ‘MENU’ (1002, preload) {
1002,
textMenuProc,
0x7FFFFF83,
enabled,
“File”,
{ /* array: 1 elements */
/* [1] */
“Quit”, noIcon, “Q”, “”, plain
}
};
resource ‘MENU’ (1003, preload) {
1003,
textMenuProc,
0x7FFFFFFD,
enabled,
“Edit”,
{ /* array: 7 elements */
/* [1] */
“Undo”, noIcon, “Z”, “”, plain,
/* [2] */
“-”, noIcon, “”, “”, plain,
/* [3] */
“Cut”, noIcon, “X”, “”, plain,
/* [4] */
“Copy”, noIcon, “C”, “”, plain,
/* [5] */
“Paste”, noIcon, “V”, “”, plain,
/* [6] */
“Clear”, noIcon, “V”, “”, plain
}
};
resource ‘MENU’ (1004, preload) {
1004,
1001,
0x7FFFFFF9,
enabled,
“Transfer”,
{ /* array: 3 elements */
/* [1] */
“Transfer...”, noIcon,
“T”, “”, plain,
/* [2] */
“Edit Menu...”, noIcon,
“”, “”, plain,
/* [3] */
“-”, noIcon, “”, “”, plain
}
};
/****************************************
Transfer resource
****************************************/
data ‘TRNS’ (1001, purgeable) {
$”0000"
};
/****************************************
Picture resources
****************************************/
resource ‘PICT’ (1001,
“About”, purgeable) {
1319,
{7, 7, 307, 498},
$”1101 A000 82A0 008C”
$”0100 0A00 0700 0701"
$”3301 F20A 0000 0000"
$”0000 0000 0B00 1B00"
$”1B44 0009 0009 0131"
$”01F0 0700 0200 0248"
$”A100 9600 0606 0000"
$”0002 03A1 009A 0008"
$”FFFD 0000 00D4 0000"
$”A000 9803 0003 0D00"
$”0A28 0129 0025 22A9"
$”2031 3938 3820 6279"
$”2043 6C69 6666 6F72"
$”6420 5374 6F72 7920"
$”616E 6420 4174 7469"
$”6329 AC22 2053 6F66"
$”7477 6172 652C 2050"
$”2E4F 2E20 426F 7820"
$”3231 392C 2047 6F6C”
$”6574 612C 2043 29A6"
$”1161 6C69 666F 726E”
$”6961 2020 2039 3331"
$”3136 A000 99A0 0097"
$”A100 9600 0606 0000"
$”0002 03A1 009A 0008"
$”FFFA 0000 002C 0000"
$”A000 9804 050D 0012"
$”2800 2C00 D108 5472"
$”616E 7366 6572 A000"
$”99A0 0097 A100 9600"
$”0605 0000 0002 03A1"
$”009A 0008 0054 0000"
$”00E1 0000 A000 9804"
$”000D 000C 2800 4700"
$”1C22 5472 616E 7366"
$”6572 2064 656D 6F6E”
$”7374 7261 7465 7320"
$”6120 6479 6E61 6D69"
$”6320 5472 29E3 1F61"
$”6E73 6665 7220 6D65"
$”6E75 2E20 2054 6865"
$”2070 726F 6772 616D”
$”2077 696C 6C0D A000"
$”99A1 009A 0008 0044"
$”0000 00E1 0000 A000"
$”9828 0057 001C 2274"
$”7261 6E73 6665 7220"
$”746F 2061 6E79 2061"
$”7070 6C69 6361 7469"
$”6F6E 2079 6F75 2063"
$”6829 D322 6F6F 7365"
$”2066 726F 6D20 6120"
$”7374 616E 6461 7264"
$”206F 7065 6E20 6669"
$”6C65 2064 6961 29D5"
$”056C 6F67 3B0D A000"
$”99A1 009A 0008 0034"
$”0000 00E1 0000 A000"
$”9828 0067 001C 2274"
$”6865 206E 6578 7420"
$”7469 6D65 2079 6F75"
$”2072 756E 2054 7261"
$”6E73 6665 722C 2074"
$”6829 D422 6174 2061"
$”7070 6C69 6361 7469"
$”6F6E 2077 696C 6C20"
$”6170 7065 6172 206F”
$”6E20 7468 650D A000"
$”99A1 009A 0008 0024"
$”0000 00E1 0000 A000"
$”9828 0077 001C 226D”
$”656E 7520 616E 6420"
$”796F 7520 6361 6E20"
$”7472 616E 7366 6572"
$”2074 6F20 6974 2077"
$”6929 D722 7468 6F75"
$”7420 676F 696E 6720"
$”7468 726F 7567 6820"
$”7468 6520 6469 616C”
$”6F67 2E20 2028 29CB”
$”0341 6E0D A000 99A1"
$”009A 0008 0014 0000"
$”00E1 0000 A000 9828"
$”0087 001C 2265 7863"
$”6570 7469 6F6E 3A20"
$”2069 6620 7468 6520"
$”6170 706C 6963 6174"
$”696F 6E20 6973 2029"
$”C822 6F6E 2061 6E6F”
$”7468 6572 2066 6C6F”
$”7070 792C 2069 7420"
$”7769 6C6C 206E 6F74"
$”2062 6520 29CB 0661"
$”6464 6564 0DA0 0099"
$”A100 9A00 0800 0400"
$”0000 E100 00A0 0098"
$”2800 9700 1C22 746F”
$”2074 6865 206D 656E”
$”752E 2920 2059 6F75"
$”2063 616E 2072 656D”
$”6F76 6520 6170 706C”
$”29D6 2069 6361 7469"
$”6F6E 7320 6672 6F6D”
$”2074 6865 206D 656E”
$”7520 7769 7468 2074"
$”6865 0DA0 0099 A100"
$”9A00 08FF F400 0000"
$”E100 00A0 0098 2800"
$”A700 1C18 D245 6469"
$”7420 4D65 6E75 2E2E”
$”2ED3 2063 6F6D 6D61"
$”6E64 2E0D A000 99A1"
$”009A 0008 FFE4 0000"
$”00E1 0000 A000 982A”
$”1001 0DA0 0099 A100"
$”9A00 08FF D400 0000"
$”E100 00A0 0098 2A10"
$”2249 2068 6176 6520"
$”7375 626D 6974 7465"
$”6420 616E 2061 7274"
$”6963 6C65 206F 6E20"
$”7468 6929 D122 7320"
$”7072 6F67 7261 6D2C”
$”2069 6E63 6C75 6469"
$”6E67 2063 6F6D 706C”
$”6574 6520 5061 7363"
$”29DD 0361 6C0D A000"
$”99A1 009A 0008 FFC4"
$”0000 00E1 0000 A000"
$”9828 00D7 001C 2273"
$”6F75 7263 652C 2074"
$”6F20 4D61 6320 5475"
$”746F 722E 2020 4966"
$”2074 6865 7920 646F”
$”6E29 CD22 2774 2070"
$”7562 6C69 7368 2069"
$”742C 2049 276C 6C20"
$”7265 6C65 6173 6520"
$”6974 206D 7973 29C1"
$”0965 6C66 2E20 2049"
$”6E0D A000 99A1 009A”
$”0008 FFB4 0000 00E1"
$”0000 A000 9828 00E7"
$”001C 2274 6865 206D”
$”6561 6E74 696D 652C”
$”2079 6F75 2063 616E”
$”206C 6561 7665 2061"
$”2063 6F70 7929 DB22"
$”206F 6620 5472 616E”
$”7366 6572 206F 6E20"
$”7468 6520 6465 736B”
$”746F 702C 2074 6F20"
$”6F70 29D0 0365 6E0D”
$”A000 99A1 009A 0008"
$”FFA4 0000 00E1 0000"
$”A000 9828 00F7 001C”
$”2261 7070 6C69 6361"
$”7469 6F6E 7320 7769"
$”7468 6F75 7420 6861"
$”7669 6E67 2074 6F20"
$”6F70 6529 D80A 6E20"
$”666F 6C64 6572 732E”
$”A000 99A0 0097 A000"
$”8DA0 0083 FF”
};
resource ‘PICT’ (1002,
“Attic”, purgeable) {
1125,
{7, 7, 306, 497},
$”1101 A000 82A0 008C”
$”0100 0A00 0700 0701"
$”3201 F10A 0000 0000"
$”0000 0000 0B00 1B00"
$”1B44 0009 0009 0130"
$”01EF 0700 0200 0248"
$”A100 9600 0606 0000"
$”0002 03A1 009A 0008"
$”FFFA 0000 004B 0000"
$”A000 9803 0003 0405"
$”0D00 122B BA2B 0E41"
$”7474 6963 2053 6F66"
$”7477 6172 65A0 0099"
$”A000 97A1 0096 0006"
$”0500 0000 0203 A100"
$”9A00 0800 5C00 0000"
$”E600 00A0 0098 0400"
$”0D00 0C28 004D 001D”
$”2241 7474 6963 2053"
$”6F66 7477 6172 6520"
$”6973 2061 2073 6D61"
$”6C6C 204D 6163 696E”
$”746F 7329 DC22 6820"
$”7072 6F67 7261 6D6D”
$”696E 6720 636F 6D70"
$”616E 792E 2069 6E20"
$”6275 7369 6E65 7373"
$”29E2 010D A000 99A1"
$”009A 0008 004C 0000"
$”00E6 0000 A000 9828"
$”005D 001D 2273 696E”
$”6365 2031 3938 362E”
$”2020 5765 2064 6F20"
$”6120 7661 7269 6574"
$”7920 6F66 2077 6F29"
$”D722 726B 3B20 D249"
$”6465 616C 696E 6572"
$”D32C 2061 2073 6861"
$”7265 7761 7265 206F”
$”7574 6C69 29D1 056E”
$”6572 2C0D A000 99A1"
$”009A 0008 003C 0000"
$”00E6 0000 A000 9828"
$”006D 001D 2269 7320"
$”6F75 7220 6265 7374"
$”2D6B 6E6F 776E 2070"
$”726F 6475 6374 2E20"
$”2057 6520 616C 7329"
$”D81B 6F20 646F 2063"
$”6F6E 7472 6163 7420"
$”7072 6F67 7261 6D6D”
$”696E 672E 0DA0 0099"
$”A100 9A00 0800 2C00"
$”0000 E600 00A0 0098"
$”2800 7D00 1D01 0DA0"
$”0099 A100 9A00 0800"
$”1C00 0000 E600 00A0"
$”0098 2A10 1E57 6520"
$”6361 6E20 6265 2072"
$”6561 6368 6564 2062"
$”7920 6D61 696C 2061"
$”743A 0DA0 0099 A100"
$”9A00 0800 0C00 0000"
$”E600 00A0 0098 2A10"
$”010D A000 99A1 009A”
$”0008 FFFC 0000 00E6"
$”0000 A000 982A 1022"
$”2020 2020 2020 2020"
$”2020 2020 2020 2020"
$”2020 2020 2020 2020"
$”2020 2020 2020 2041"
$”7474 2991 0C69 6320"
$”536F 6674 7761 7265"
$”0DA0 0099 A100 9A00"
$”08FF EC00 0000 E600"
$”00A0 0098 2800 BD00"
$”1D22 2020 2020 2020"
$”2020 2020 2020 2020"
$”2020 2020 2020 2020"
$”2020 2020 2020 2020"
$”2050 2E4F 298F 0A2E”
$”2042 6F78 2032 3139"
$”0DA0 0099 A100 9A00"
$”08FF DC00 0000 E600"
$”00A0 0098 2800 CD00"
$”1D22 2020 2020 2020"
$”2020 2020 2020 2020"
$”2020 2020 2020 2020"
$”2020 2020 2020 2020"
$”2047 6F6C 2990 1865"
$”7461 2C20 4361 6C69"
$”666F 726E 6961 2020"
$”2039 3331 3136 0DA0"
$”0099 A100 9A00 08FF”
$”CC00 0000 E600 00A0"
$”0098 2800 DD00 1D01"
$”0DA0 0099 A100 9A00"
$”08FF BC00 0000 E600"
$”00A0 0098 2A10 2257"
$”6520 616C 736F 206F”
$”7065 7261 7465 2061"
$”2062 756C 6C65 7469"
$”6E20 626F 6172 6420"
$”7329 D422 7973 7465"
$”6D20 6174 2028 3830"
$”3529 2036 3833 2D30"
$”3332 322C 2062 6574"
$”7765 656E 2074 29E6"
$”0368 650D A000 99A1"
$”009A 0008 FFAC 0000"
$”00E6 0000 A000 9828"
$”00FD 001D 2268 6F75"
$”7273 206F 6620 363A”
$”3030 2050 4D20 616E”
$”6420 323A 3030 2041"
$”4D2C 2050 6163 6929"
$”D822 6669 6320 7469"
$”6D65 2C20 7365 7665"
$”6E20 6461 7973 2061"
$”2077 6565 6B2E 2020"
$”506C 6561 29D3 0373"
$”650D A000 99A1 009A”
$”0008 FF9C 0000 00E6"
$”0000 A000 9828 010D”
$”001D 1566 6565 6C20"
$”6672 6565 2074 6F20"
$”6361 6C6C 2069 6E21"
$”A000 99A0 0097 A100"
$”9600 0606 0000 0002"
$”03A1 009A 0008 FFFD”
$”0000 006D 0000 A000"
$”980D 000A 2B73 1722"
$”A920 3139 3838 2062"
$”7920 436C 6966 666F”
$”7264 2053 746F 7279"
$”2061 6E64 2041 7474"
$”6963 29AC 0920 536F”
$”6674 7761 7265 A000"
$”99A0 0097 A000 8DA0"
$”0083 FF”
};
/***************************************
Alert resource
****************************************/
resource ‘ALRT’ (1001,
“Message”, purgeable) {
{0, 0, 106, 300},
1001,
{ /* array: 4 elements */
/* [1] */
OK, visible, sound1,
/* [2] */
OK, visible, sound1,
/* [3] */
OK, visible, sound1,
/* [4] */
OK, visible, sound1
}
};
/****************************************
Dialog resources
****************************************/
resource ‘DLOG’ (1002,
“Edit Transfer”, purgeable) {
{0, 0, 148, 300},
dBoxProc,
invisible,
noGoAway,
0x0,
1002,
“”
};
/****************************************
Item list resources
****************************************/
resource ‘DITL’ (1001,
“Message”, purgeable) {
{ /* array DITLarray: 3 elements */
/* [1] */
{76, 120, 96, 180},
Button {
enabled,
“OK”
},
/* [2] */
{10, 10, 58, 290},
StaticText {
disabled,
“^0^1^2^3”
}
}
};
resource ‘DITL’ (1002,
“Edit Transfer”, purgeable) {
{ /* array DITLarray: 6 elements */
/* [1] */
{70, 232, 90, 288},
Button {
enabled,
“OK”
},
/* [2] */
{100, 230, 120, 290},
Button {
enabled,
“Cancel”
},
/* [3] */
{67, 229, 93, 291},
UserItem {
disabled
},
/* [4] */
{10, 10, 138, 220},
UserItem {
enabled
},
/* [5] */
{28, 230, 48, 290},
Button {
enabled,
“Delete”
},
/* [6] */
{57, 230, 58, 290},
UserItem {
disabled
}
}
};
/****************************************
Multifinder resource
****************************************/
resource ‘SIZE’ (-1) {
saveScreen,
acceptSuspendResumeEvents,
enableOptionSwitch,
cannotBackground,
MultiFinderAware,
98304,
98304
};
/***************************************/
Common Declarations
This is a collection of useful stuff that I keep in my PInterfaces folder and update from time to time, as the need arises. So it has a lot of things that aren’t used in this particular program (like most of the low-memory globals).
The Menu Data Structure
The unit also declares the common data structure that holds the menu data, and is used by all three parts of the program.
Each application in the list is represented by a “tline”. A tline includes the application name, and its location (volume and directory).
The list itself consists of an integer holding the number of applications in the list, followed by a tline for each. An empty list, then, is just an integer zero (which is how the TRNS resource was declared in the Transfer.p file).
{3}
(****************************************
Common.p
Declarations for
dynamic Transfer menu demo.
(c) 1988, by Clifford Story
& Attic Software
****************************************)
unit Common;
(***************************************)
interface
(***************************************)
uses memtypes, quickdraw,
osintf, toolintf;
(****************************************
Key codes:
****************************************)
const
enterkey = 3;
backspace= 8;
tabkey = 9;
returnkey= 13;
clearkey = 27;
leftarrow= 28;
rightarrow = 29;
uparrow= 30;
downarrow= 31;
periodkey= 46;
(****************************************
Dialog items:
****************************************)
themask= 3;
(****************************************
Low-memory globals:
****************************************)
applscratch= $A78;
bootdrive= $210;
curappname = $910;
curdirstore= $398;
currenta5= $904;
findername = $2E0;
fsfcblen = $3F6;
grayrgn= $9EE;
iaznotify= $33C;
mbarheight = $BAA;
menuflash= $A24;
resload= $A5E;
rom85 = $28E;
sfsavedisk = $214;
sysmap = $A58;
windowlist = $9D6;
(****************************************
Standard types:
****************************************)
type
logical= boolean;
long = longint;
shortpointer = ^integer;
longpointer= ^long;
str31 = String[31];
tline = record
volume : integer;
directory: long;
name : str31;
end;
trecord= record
count : integer;
appl : array
[1..100] of tline;
end;
tpointer = ^trecord;
thandle= ^tpointer;
(***************************************)
end.
(***************************************)
The List Definition Procedure (LDEF)
LDEFs are so easy to write, and so useful to have, that I can fearlessly declare that you should never use the standard LDEF. Why not? First, LDEF 0 (the standard LDEF) must handle all sorts of data, in varying amounts, perhaps two- dimensional. So it has to be very general. A custom LDEF can be crafted to fit your needs. Second, if you use LDEF 0, you have to stuff your data into its data structure, which is really slow. A custom LDEF, on the other hand, can get its data directly.
This LDEF gets the data with GetResource, directly from the resource file. I usually load the handle in the list’s “refcon” or “userhandle” field, and doing so here would be marginally more efficient, since it would lift that GetResource call out of the drawing loop.
{4}
(****************************************
Transfer List.p
LDEF for dynamic Transfer menu demo.
(c) 1988, by Clifford Story
& Attic Software
****************************************)
unit Transferlist;
(***************************************)
interface
(***************************************)
uses memtypes, quickdraw, osintf,
toolintf, packintf, Common;
(***************************************)
procedure listdef(
message : integer;
select : logical;
therect : Rect;
thecell : Cell;
dataoffset : integer;
datalen : integer;
thelist : ListHandle);
(***************************************)
implementation
(***************************************)
{$R-}
{$SC+}
(***************************************)
procedure drawcell(
thelist : ListHandle;
therect : Rect;
thecell: Cell;
select : logical); forward;
(***************************************)
procedure listdef(
message : integer;
select : logical;
therect : Rect;
thecell : Cell;
dataoffset : integer;
datalen : integer;
thelist : ListHandle);
begin
case message of
lInitMsg : ;
lDrawMsg : drawcell(thelist,
therect, thecell, select);
lHiliteMsg :
InvertRect(therect);
lCloseMsg: ;
end;
end;
(***************************************)
procedure drawcell(
thelist : ListHandle;
therect : Rect;
thecell : Cell;
select : logical);
var
thehandle: thandle;
begin
thehandle := thandle(
GetResource(‘TRNS’, 1001));
MoveTo(therect.left + 4,
therect.bottom - 4);
DrawString(thehandle^^.appl[
thecell.v + 1].name);
if select then
InvertRect(therect);
end;
(***************************************)
end.
(***************************************)
The Menu Definition Procedure (MDEF)
The point of this MDEF is to avoid the awful problems involved in maintaining a menu that changes as you work. In fact, a menu like this cannot (as far as I know) be maintained on the 64K ROM using standard methods - there’s no DeleteItem trap. Instead of trying to keep up with the menu via the standard menu structure and traps, I use the alternate structure declared in the Common.p file, and do it all myself. This has the added benefit of directness: I get the data immediately from the program, rather than second hand through the menuhandle.
The data I’m looking for is in the TRNS 1001 resource, which is maintained by the main program. The MDEF’s job is to draw the menu from that data, to hit-test it, and to calcuate its size.
There’s a certain amount of hard-coded data in the MDEF itself. The first three lines of the menu are pre-determined, so the drawing routine draws them and the size routine measures them without reference to data. (I really should get them from the menuhandle, since I did declare them in the resource file, and that would make it easy to change them to Finnish or Hindustani or whatever...)
The “Transfer...” is always active, but the “Edit Menu” item is disabled if there aren’t any applications in the menu. (Again, perhaps I should consult the menuhandle’s flags to see if the main program has disabled these items, although I don’t see why it should.) I show that it’s disabled by overdrawing it with gray, using a patBic transfer mode. (The gray pattern comes from the QD globals; the “QDglobals” routine returns a pointer to these globals.) And if it’s disabled, it can’t be selected, so “menuchoose” should return zero. It should also return zero if the mouse is in the third item, the dividing line.
There are a couple of oddities in the “menusize” routine. First, this routine apparently executes with “resload” set false. This means that the GetResource call returns a nil handle. So I set resload true, and restore it on exit. The second thing is that the current grafport’s text settings are unreliable, so I have to set them explicitly.
{5}
(****************************************
Transfer Menu.p
MDEF for dynamic Transfer menu demo.
(c) 1988, by Clifford Story
& Attic Software
****************************************)
unit Transfermenu;
(***************************************)
interface
(***************************************)
uses memtypes, quickdraw,
osintf, toolintf, Common;
(***************************************)
procedure menudef(
message : integer;
themenu : MenuHandle;
var menurect : Rect;
hitpoint : Point;
var whichitem : integer);
(***************************************)
implementation
(***************************************)
type
QDrecord= record
randSeed : long;
screenBits : BitMap;
arrow : Cursor;
dkGray : Pattern;
ltGray : Pattern;
gray : Pattern;
black : Pattern;
white : Pattern;
thePort: GrafPtr;
end;
QDpointer = ^QDrecord;
(***************************************)
procedure menudraw(
themenu : MenuHandle;
var menurect : Rect); forward;
procedure menuchoose(
themenu : MenuHandle;
var menurect : Rect;
hitpoint : Point;
var whichitem : integer); forward;
procedure menusize(
themenu : MenuHandle); forward;
(***************************************)
{$R-}
{$SC+}
(***************************************)
procedure menudef(
message : integer;
themenu : MenuHandle;
var menurect : Rect;
hitpoint : Point;
var whichitem : integer);
begin
case message of
mDrawMsg : menudraw(
themenu, menurect);
mChooseMsg : menuchoose(
themenu, menurect,
hitpoint, whichitem);
mSizeMsg : menusize(themenu);
end;
end;
(**************************************)
function QDglobals : QDpointer;
var
thepointer : longpointer;
begin
thepointer := longpointer(
currenta5);
thepointer := longpointer(
thepointer^);
QDglobals := QDpointer(
long( thepointer^)
- sizeof(QDrecord)
+ sizeof(GrafPtr));
end;
(***************************************)
procedure menudraw(
themenu: MenuHandle;
var menurect: Rect);
var
thehandle: thandle;
height : integer;
width : integer;
therect: Rect;
index : integer;
thestring: Str255;
begin
thehandle := thandle(
GetResource(‘TRNS’, 1001));
HLock(Handle(thehandle));
height := menurect.top + 12;
width := menurect.left + 12;
MoveTo(width, height);
DrawString(‘Transfer...’);
MoveTo(menurect.right
- CharWidth(‘T’) - 15, height);
DrawChar(chr(17));
DrawChar(‘T’);
height := height + 16;
MoveTo(width, height);
DrawString(‘Edit Menu...’);
if thehandle^^.count = 0 then begin
PenPat(QDglobals^.gray);
PenMode(patBic);
with menurect do
SetRect(therect,
left, top + 16,
right, top + 32);
PaintRect(therect);
PenNormal;
end;
height := height + 16;
MoveTo(menurect.left,
menurect.top + 40);
Line(menurect.right
- menurect.left, 0);
for index := 1 to thehandle^^.count
do begin
height := height + 16;
MoveTo(width, height);
BlockMove(@thehandle^^.appl[index]
.name, @thestring, 32);
DrawString(thestring);
end;
HUnlock(Handle(thehandle));
end;
(***************************************)
procedure menuchoose(
themenu : MenuHandle;
var menurect : Rect;
hitpoint : Point;
var whichitem : integer);
var
theitem: integer;
thehandle: thandle;
therect: Rect;
begin
if PtInRect(hitpoint, menurect) then
theitem := 1 + ((hitpoint.v
- menurect.top) div 16)
else
theitem := 0;
if theitem = 3 then
theitem := 0
else if theitem = 2 then begin
thehandle := thandle(
GetResource(‘TRNS’, 1001));
if thehandle^^.count = 0 then
theitem := 0;
end;
if theitem <> whichitem then begin
therect := menurect;
therect.bottom := therect.top
+ 16 * theitem;
therect.top := therect.bottom - 16;
InvertRect(therect);
if whichitem > 0 then begin
OffsetRect(therect, 0, 16
* (whichitem - theitem));
InvertRect(therect);
end;
whichitem := theitem;
end;
end;
(***************************************)
procedure menusize(
themenu : MenuHandle);
var
savedload: logical;
thewidth : integer;
thehandle: thandle;
index : integer;
thestring: Str255;
newwidth : integer;
begin
savedload := logical(Ptr(resload)^);
SetResLoad(true);
TextFont(systemFont);
TextSize(12);
TextFace([]);
thewidth := StringWidth(‘Transfer...’)
+ CharWidth(‘T’) + 39;
newwidth := StringWidth(
‘Edit Menu...’) + 16;
if newwidth > thewidth then
thewidth := newwidth;
thehandle := thandle(
GetResource(‘TRNS’, 1001));
HLock(Handle(thehandle));
for index := 1 to thehandle^^.count
do begin
BlockMove(@thehandle^^.appl[index]
.name, @thestring, 32);
newwidth := StringWidth(
thestring) + 16;
if newwidth > thewidth then
thewidth := newwidth;
end;
HUnlock(Handle(thehandle));
themenu^^.menuHeight := 48
+ 16 * thehandle^^.count;
themenu^^.menuWidth := thewidth;
SetResLoad(savedload);
end;
(***************************************)
end.
(***************************************)
The Main Program
Let’s have a blow-by-blow account of how this program reacts to selections from the Transfer menu. First, here’s the menu (reprise):
• If the user selects the “Transfer...” item, the program will display an SFget dialog. If he then choses an application from this dialog, the program will first add that application to the TRNS resource (the menu data), and then transfer to it.
• If the user selects the “Edit Menu...” item, the program will display a dialog with a list of all the applications in the menu.
He may select and delete as many of these as he wishes; those he deletes will be removed from the TRNS resource (and hence the menu) if he dismisses the dialog by clicking “OK”.
• If he selects one of the applications listed on the menu, the program will transfer to that application.
There are some complications. What if the application isn’t there? The program will delete it from the TRNS resource and alert the user. What if the user selects “Transfer...” and then chooses an application on a floppy? Wouldn’t this very likely lead to the first problem? The program will not add an application to the TRNS resource unless it is either on a non-ejectable volume, or it is on the same volume as the Transfer program (the user can still transfer to the application via the SFget dialog).
This leads to the only unusual code in the first part of the program. In the “initglobals” routine, the global variable DEFVOL is set to the volume reference number of the Transfer program’s volume. Later, this will be compared to the vrefnum of the chosen application.
{6}
(****************************************
Transfer.p
Demo of a dynamic Transfer menu.
(c) 1988, by Clifford Story
& Attic Software
****************************************)
program Transfer;
(***************************************)
uses memtypes, quickdraw, osintf,
toolintf, packintf, Common;
(****************************************
Program constants:
****************************************)
const
applenum = 1001;
aboutitem= 1;
atticitem= 2;
filenum= 1002;
quititem = 1;
editnum= 1003;
undoitem = 1;
cutitem= 3;
copyitem = 4;
pasteitem= 5;
clearitem= 6;
transnum = 1004;
transitem= 1;
edititem = 2;
messagedialog = 1001;
editdialog = 1002;
editlist = 4;
editdelete = 5;
editline = 6;
(****************************************
Program variables:
****************************************)
var
APPLEMENU: MenuHandle;
FILEMENU : MenuHandle;
EDITMENU : MenuHandle;
TRANSMENU : MenuHandle;
DONE : logical;
JEVENT : logical;
HARDDISK : logical;
DEFVOL : integer;
MENUHEIGHT : integer;
MAINEVENT: EventRecord;
(***************************************)
procedure _datainit; external;
(***************************************)
{$R-}
{$SC+}
(***************************************)
procedure panic;
begin
ExitToShell;
end;
(***************************************)
procedure centerdialog(
thetype : OSType;
theid : integer);
var
thehandle: AlertTHndl;
begin
thehandle := AlertTHndl(
GetResource(thetype, theid));
HLock(Handle(thehandle));
with thehandle^^ do begin
with boundsRect do
SetRect(boundsRect, 0, 0,
right - left,
bottom - top);
with screenBits.bounds,
boundsRect.botright do
OffsetRect(boundsRect,
(right - left - h) div 2,
(bottom - top - v
+ 2 * MENUHEIGHT) div 3);
end;
HUnlock(Handle(thehandle));
end;
(***************************************)
procedure message(
what : Str255);
var
dummy : integer;
begin
InitCursor;
ParamText(what, ‘’, ‘’, ‘’);
centerdialog(‘ALRT’, messagedialog);
dummy := Alert(messagedialog, nil);
end;
(***************************************)
procedure initmac;
begin
MaxApplZone;
InitGraf(@thePort);
InitFonts;
InitWindows;
InitCursor;
InitMenus;
TEInit;
InitDialogs(@panic);
UnloadSeg(@_datainit);
end;
(***************************************)
procedure setupmenus;
begin
APPLEMENU := GetMenu(applenum);
AddResMenu(APPLEMENU, ‘DRVR’);
InsertMenu(APPLEMENU, 0);
FILEMENU := GetMenu(filenum);
InsertMenu(FILEMENU, 0);
EDITMENU := GetMenu(editnum);
InsertMenu(EDITMENU, 0);
TRANSMENU := GetMenu(transnum);
InsertMenu(TRANSMENU, 0);
DrawMenuBar;
end;
(***************************************)
procedure initglobals;
var
index : integer;
begin
for index := 1 to 10 do
MoreMasters;
if BitTst(Ptr(rom85), 0) then begin
MENUHEIGHT := 20;
JEVENT := false;
end else begin
MENUHEIGHT := shortpointer(
mbarheight)^;
JEVENT := (NGetTrapAddress(
$A860, ToolTrap)
<> NGetTrapAddress(
$A89F, ToolTrap));
end;
if GetVol(nil, DEFVOL) <> noErr then
DEFVOL := 0;
DONE := false;
end;
(***************************************)
procedure clickapplemenu(
theitem : integer);
var
itemname : Str255;
savedport: GrafPtr;
dummy : integer;
newport: GrafPort;
thepicture : PicHandle;
therect: Rect;
begin
if theitem > 3 then begin
GetItem(APPLEMENU,
theitem, itemname);
GetPort(savedport);
dummy := OpenDeskAcc(itemname);
SetPort(savedport);
end else if theitem < 3 then begin
InitCursor;
GetPort(savedport);
OpenPort(@newport);
SetPort(@newport);
thepicture := PicHandle(
GetResource(‘PICT’,
1000 + theitem));
with thepicture^^.picFrame do
SetRect(therect, 0, 0,
right - left,
bottom - top);
with screenBits.bounds,
therect.botright do
OffsetRect(therect,
(right - left - h) div 2,
(bottom - top - v)
div 3);
DrawPicture(thepicture, therect);
repeat until Button;
ClosePort(@newport);
DrawMenuBar;
PaintBehind(WindowPeek(
FrontWindow), RgnHandle(
longpointer(grayrgn)^));
SetPort(savedport);
FlushEvents(everyEvent, 0);
end;
end;
(***************************************)
The Transfer Mechanism
Here’s the functional heart of the program. The routine “transferappl” gets the application’s name and location (volume and directory). It sets the volume directly if the program is running under MFS (no directories). If HFS is running, it first opens a working directory, and then sets the volume to that working directory. Now I know we’re looking in the right place.
The next step is to see if there’s an application with the right name in the directory. If there isn’t, the routine posts an alert and returns. If there is, then the routine first shuts down the program by calling “doquit”. It then calls “launch” to transfer to the new application. That should be it; the program should terminate right here. If for any reason control continues in this routine, something went wrong, so post an alert.
The “doquit” routine will kill the program entirely, if the “quitting” flag is true, or leave it able to recover and run, if the flag is false. If the transfer fails, the program should continue, so doquit should only close windows (including document windows, in a real program).
The “launch” routine is glue for the _launch trap, which is register-based. _launch expects a pointer to a launch record in A0; the glue routine pushes the lauch record onto the stack, copies the stack pointer to A0, and then calls the trap.
{7}
(***************************************)
procedure doquit(
quitting : logical);
var
thewindow: windowpeek;
begin
thewindow := windowpeek(frontwindow);
while thewindow <> nil do
with thewindow^ do begin
if windowkind < 0 then
closedeskacc(windowkind);
thewindow := nextwindow;
end;
if quitting then
DONE := true;
end;
(***************************************)
procedure launch(
config : integer;
name : Ptr); inline $204F, $A9F2;
(* movea.lSP,A0
_launch
*)
(***************************************)
procedure transferappl(
name : str31;
volume : integer;
directory : long);
const
procID = $54524E53;
var
thestring: Str255;
anerror: integer;
theblock : WDPBRec;
theinfo: FInfo;
begin
BlockMove(@name, @thestring, 32);
if shortpointer(fsfcblen)^ = -1 then
anerror := SetVol(nil, volume)
else with theblock do begin
ioCompletion := nil;
ioNamePtr := nil;
ioVRefNum := volume;
ioWDProcID := procID;
ioWDDirID := directory;
anerror := PBOpenWD(
@theblock, false);
if anerror = noErr then
anerror := SetVol(
nil, ioVRefNum)
end;
if anerror = noErr then begin
anerror := GetFInfo(thestring,
0, theinfo);
if (anerror = noErr) and
(theinfo.fdType = ‘APPL’)
then begin
doquit(false);
launch(0, @thestring);
end;
end;
message(concat(
‘Sorry! Couldn’’t find “‘,
thestring, ‘”.’));
end;
(***************************************)
Handling the “Transfer...” Item
Here the program responds to the user’s selection of the “Transfer...” item. It calls SFgetfile to bring up the getfile dialog. If the user selected an application, it gets the application’s volume and directory from low-memory globals, and the name from the SFReply record.
The low-memory global “sfsavedisk” holds the additive inverse of the selected application’s volume reference number - not the working directory. This is a key point, since if it’s an ejectable volume, the vrefnum should be compared with DEFVOL to see if the application is on the same disk as the Transfer program.
If the application is on a non-ejectable volume, or the same volume as the Transfer program, then I add it to the TRNS resource. There’s some fumbling around here, because I want to insert it in alphabetical order.
Now, the question: how do I find out whether the application is on an ejectable volume? The global HARDDISK has the answer, but where did that come from? I confess that I have no idea how to find out if a volume is ejectable or not (I asked Apple and they remained silent) but I know who does: the Standard File package. If the volume is ejectable, the “Eject” button is active; otherwise, it’s dimmed. So I just check the button in the “diskfilter” routine.
Finally, after all that, I call “transferappl” to launch the application.
{8}
(***************************************)
function diskfilter(
theitem : integer;
thedialog : DialogPtr) : integer;
var
thetype: integer;
thehandle: Handle;
therect: Rect;
begin
if theitem = getOpen then begin
GetDItem(thedialog, getEject,
thetype, thehandle,
therect);
HARDDISK := ControlHandle(
thehandle)^^.contrlhilite
= 255;
end;
diskfilter := theitem;
end;
(***************************************)
procedure newtransfer;
var
thepoint : Point;
thelist: SFTypeList;
thereply : SFReply;
newappl: tline;
thehandle: thandle;
thecount : integer;
index : integer;
begin
with screenBits.bounds do
SetPt(thepoint,
(right - left - 348) div 2,
(bottom - top - 200
+ 2 * MENUHEIGHT) div 3);
thelist[0] := ‘APPL’;
SFGetFile(thepoint, ‘’, nil, 1,
thelist, @diskfilter,
thereply);
if thereply.good then begin
with newappl do begin
volume := - shortpointer(
sfsavedisk)^;
directory := longpointer(
curdirstore)^;
BlockMove(@thereply.fname,
@name, 32);
end;
if HARDDISK or (newappl.volume
= DEFVOL) then begin
thehandle := thandle(
GetResource(
‘TRNS’, 1001));
thecount := thehandle^^.count
+ 1;
thehandle^^.count := thecount;
SetHandleSize(Handle(thehandle),
2 + thecount
* sizeof(tline));
HLock(Handle(thehandle));
with thehandle^^ do begin
for index := 1
to thecount do
if (IUCompString(appl
[index].name,
thereply.fname)
> 0) then begin
thecount := index;
leave;
end;
BlockMove(@appl[thecount],
@appl[thecount + 1],
GetHandleSize(Handle(
thehandle)) - long(
@appl[thecount + 1])
+ long(thehandle^));
BlockMove(@newappl,
@appl[thecount],
sizeof(tline));
ChangedResource(
Handle(thehandle));
WriteResource(
Handle(thehandle));
end;
HUnlock(Handle(thehandle));
end;
with newappl do
transferappl(name,
volume, directory);
end;
end;
(***************************************)
The Delete Dialog
This dialog contains a list; “OK” and “Cancel” buttons, with the OK button outlined; a “Delete” button; and a line between the Delete button and the OK and Cancel buttons. “dothelist” draws the list; “dotheok” outlines the OK button, and “dotheline” draws the line.
The dialog has a filter function, that detects keyboard equivalents for the buttons, and passes clicks in the list to LClick. The second argument to LClick is supposed to be the modifiers field of the eventrecord. Since I don’t want any fancy selections, I ignore the modifiers and pass zero instead.
If the user clicks the Delete button, then the currently-selected list item is deleted from the TRNS resource, and from the list as well. This is easy; just chop it out of the TRNS resource with a _blockmove, and update the count.
If the user clicks the OK button, then the TRNS resource should be written back to disk, to save the changes. Then the MDEF must be told to recompute the menu dimensions; CalcMenuSize does this. If, on the other hand, he clicks the Cancel button, then I discard the resource; the next call to GetResource will read the unchanged copy in from disk.
{9}
(***************************************)
procedure deleteappl(
thehandle : thandle;
theappl : integer);
begin
HLock(Handle(thehandle));
with thehandle^^ do begin
count := count - 1;
BlockMove(@appl[theappl + 1],
@appl[theappl],
GetHandleSize(Handle(
thehandle)) - long(@appl
[theappl + 1])
+ long(thehandle^));
end;
HUnlock(Handle(thehandle));
SetHandleSize(Handle(thehandle),
GetHandleSize(Handle(thehandle))
- sizeof(tline));
end;
(***************************************)
procedure dotheok(
thewindow : WindowPtr;
theitem : integer);
var
thetype: integer;
thehandle: Handle;
therect: Rect;
begin
GetDItem(thewindow, ok,
thetype, thehandle, therect);
PenSize(3, 3);
InsetRect(therect, -4, -4);
FrameRoundRect(therect, 16, 16);
PenSize(1, 1);
end;
(***************************************)
procedure dothelist(
thewindow : WindowPtr;
theitem : integer);
var
thetype: integer;
thehandle: Handle;
therect: Rect;
begin
LUpdate(thewindow^.visRgn,
ListHandle(GetWRefCon(
thewindow)));
GetDItem(thewindow, theitem,
thetype, thehandle, therect);
InsetRect(therect, - 1, - 1);
FrameRect(therect);
end;
(***************************************)
procedure dotheline(
thewindow : WindowPtr;
theitem : integer);
var
thetype: integer;
thehandle: Handle;
therect: Rect;
begin
GetDItem(thewindow, theitem,
thetype, thehandle, therect);
MoveTo(therect.left, therect.top);
LineTo(therect.right, therect.top);
end;
(***************************************)
function editfilter(
thedialog : DialogPtr;
var theevent : EventRecord;
var theitem : integer): logical;
var
thekey : integer;
thepoint : Point;
thetype: integer;
thehandle: Handle;
therect: Rect;
begin
editfilter := false;
if theevent.what = keyDown then begin
thekey := BitAnd(charCodeMask,
theevent.message);
if (thekey = enterkey)
or (thekey = returnkey)
then begin
theitem := ok;
editfilter := true;
end else if thekey = periodkey
then begin
theitem := cancel;
editfilter := true;
end else if (thekey = ord(‘d’))
or (thekey = ord(‘D’))
then begin
theitem := editdelete;
editfilter := true;
end;
end else if theevent.what = mouseDown
then begin
thepoint := theevent.where;
GlobalToLocal(thepoint);
GetDItem(thedialog, editlist,
thetype, thehandle,
therect);
if PtInRect(thepoint, therect)
then begin
editfilter := true;
if LClick(thepoint, 0,
ListHandle(GetWRefCon(
thedialog))) then
;
theitem := editlist;
end;
end;
end;
(***************************************)
procedure edittransfer;
var
savedport: GrafPtr;
thedialog: DialogPtr;
therecord: DialogRecord;
thetype: integer;
thehandle: Handle;
therect: Rect;
bounds : Rect;
thepoint : Point;
thethandle : thandle;
thelist: ListHandle;
choice : integer;
begin
GetPort(savedport);
centerdialog(‘DLOG’, editdialog);
thedialog := GetNewDialog(editdialog,
@therecord, pointer(-1));
SetPort(thedialog);
GetDItem(thedialog, themask,
thetype, thehandle, therect);
thehandle := Handle(@dotheok);
SetDItem(thedialog, themask,
userItem, thehandle, therect);
GetDItem(thedialog, editlist,
thetype, thehandle, therect);
thehandle := Handle(@dothelist);
SetDItem(thedialog, editlist,
userItem, thehandle, therect);
therect.right := therect.right - 15;
thethandle := thandle(
GetResource(‘TRNS’, 1001));
SetRect(bounds, 0, 0, 1,
thethandle^^.count);
SetPt(thepoint, therect.right
- therect.left, 16);
thelist := LNew(therect, bounds,
thepoint, 1001, thedialog,
true, false, false, true);
SetWRefCon(thedialog, long(thelist));
GetDItem(thedialog, editline,
thetype, thehandle, therect);
thehandle := Handle(@dotheline);
SetDItem(thedialog, editline,
userItem, thehandle, therect);
ShowWindow(thedialog);
repeat
ModalDialog(@editfilter, choice);
if choice = editdelete then begin
SetPt(thepoint, 0, 0);
if LGetSelect(true, thepoint,
thelist) then begin
deleteappl(thethandle,
thepoint.v + 1);
LDelRow(1, thepoint.v,
thelist);
end;
end;
until (choice = ok)
or (choice = cancel);
if choice = cancel then
ReleaseResource(Handle(thethandle))
else begin
ChangedResource(
Handle(thethandle));
WriteResource(
Handle(thethandle));
CalcMenuSize(TRANSMENU);
end;
LDispose(thelist);
CloseDialog(thedialog);
SetPort(savedport);
end;
(***************************************)
Transfer to a Listed Application
If the user chooses an application from the menu, I just look it up in the TRNS resource and call “transferappl”. That should be it; if transferappl returns, the transfer must have failed. So that one’s no good anymore; delete it from the resource, write the resource back to disk, and recompute the menu dimensions.
That’s it; the remainder of the program is routine.
{10}
(***************************************)
procedure clicktransfermenu(
theitem : integer);
var
thehandle: thandle;
thecount : integer;
begin
case theitem of
transitem: newtransfer;
edititem : edittransfer;
otherwise
thehandle := thandle(
GetResource(‘TRNS’, 1001));
HLock(Handle(thehandle));
with thehandle^^.appl
[theitem - 3] do
transferappl(name,
volume, directory);
deleteappl(thehandle, theitem - 3);
ChangedResource(Handle(thehandle));
WriteResource(Handle(thehandle));
CalcMenuSize(TRANSMENU);
end;
end;
(***************************************)
procedure checkmenu;
begin
if FrontWindow = nil then
DisableItem(EDITMENU, 0)
else
EnableItem(EDITMENU, 0);
end;
(***************************************)
procedure clickinmenu;
var
choice : long;
begin
checkmenu;
choice := MenuSelect(MAINEVENT.where);
case HiWord(choice) of
applenum : clickapplemenu(LoWord(choice));
filenum: doquit(true);
editnum: if SystemEdit(
LoWord(choice) - 1) then;
transnum : clicktransfermenu(LoWord(choice));
end;
HiliteMenu(0);
end;
(***************************************)
procedure aclick;
var
location : integer;
thewindow: WindowPtr;
begin
location := FindWindow(
MAINEVENT.where, thewindow);
case location of
inDesk : SysBeep(1);
inMenuBar: clickinmenu;
inSysWindow: SystemClick(
MAINEVENT, thewindow);
end;
end;
(***************************************)
procedure akey;
var
charcode : integer;
choice : long;
begin
if BitAnd(MAINEVENT.modifiers, cmdKey)
<> 0 then begin
charcode := BitAnd(
MAINEVENT.message,
charCodeMask);
checkmenu;
choice := MenuKey(chr(charcode));
if choice <> 0 then begin
case HiWord(choice) of
applenum :
clickapplemenu(LoWord(choice));
filenum: doquit(true);
editnum:
if SystemEdit(LoWord(choice) - 1)
then;
transnum :
clicktransfermenu(LoWord(choice));
end;
HiliteMenu(0);
end;
end;
end;
(***************************************)
procedure mainloop;
var
dummy : logical;
begin
repeat
if JEVENT then
dummy := waitnextevent(
everyEvent, MAINEVENT,
GetCaretTime, nil)
else begin
SystemTask;
dummy := GetNextEvent(everyEvent, MAINEVENT);
end;
if dummy then begin
case MAINEVENT.what of
mouseDown: aclick;
keyDown: akey;
end;
end;
until DONE;
end;
(***************************************)
begin
initmac;
setupmenus;
initglobals;
mainloop;
end.
(***************************************)
