TweetFollow Us on Twitter

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.
(***************************************)

 

Community Search:
MacTech Search:

Software Updates via MacUpdate

Latest Forum Discussions

See All

Tokkun Studio unveils alpha trailer for...
We are back on the MMORPG news train, and this time it comes from the sort of international developers Tokkun Studio. They are based in France and Japan, so it counts. Anyway, semantics aside, they have released an alpha trailer for the upcoming... | Read more »
Win a host of exclusive in-game Honor of...
To celebrate its latest Jujutsu Kaisen crossover event, Honor of Kings is offering a bounty of login and achievement rewards kicking off the holiday season early. [Read more] | Read more »
Miraibo GO comes out swinging hard as it...
Having just launched what feels like yesterday, Dreamcube Studio is wasting no time adding events to their open-world survival Miraibo GO. Abyssal Souls arrives relatively in time for the spooky season and brings with it horrifying new partners to... | Read more »
Ditch the heavy binders and high price t...
As fun as the real-world equivalent and the very old Game Boy version are, the Pokemon Trading Card games have historically been received poorly on mobile. It is a very strange and confusing trend, but one that The Pokemon Company is determined to... | Read more »
Peace amongst mobile gamers is now shatt...
Some of the crazy folk tales from gaming have undoubtedly come from the EVE universe. Stories of spying, betrayal, and epic battles have entered history, and now the franchise expands as CCP Games launches EVE Galaxy Conquest, a free-to-play 4x... | Read more »
Lord of Nazarick, the turn-based RPG bas...
Crunchyroll and A PLUS JAPAN have just confirmed that Lord of Nazarick, their turn-based RPG based on the popular OVERLORD anime, is now available for iOS and Android. Starting today at 2PM CET, fans can download the game from Google Play and the... | Read more »
Digital Extremes' recent Devstream...
If you are anything like me you are impatiently waiting for Warframe: 1999 whilst simultaneously cursing the fact Excalibur Prime is permanently Vault locked. To keep us fed during our wait, Digital Extremes hosted a Double Devstream to dish out a... | Read more »
The Frozen Canvas adds a splash of colou...
It is time to grab your gloves and layer up, as Torchlight: Infinite is diving into the frozen tundra in its sixth season. The Frozen Canvas is a colourful new update that brings a stylish flair to the Netherrealm and puts creativity in the... | Read more »
Back When AOL WAS the Internet – The Tou...
In Episode 606 of The TouchArcade Show we kick things off talking about my plans for this weekend, which has resulted in this week’s show being a bit shorter than normal. We also go over some more updates on our Patreon situation, which has been... | Read more »
Creative Assembly's latest mobile p...
The Total War series has been slowly trickling onto mobile, which is a fantastic thing because most, if not all, of them are incredibly great fun. Creative Assembly's latest to get the Feral Interactive treatment into portable form is Total War:... | Read more »

Price Scanner via MacPrices.net

Early Black Friday Deal: Apple’s newly upgrad...
Amazon has Apple 13″ MacBook Airs with M2 CPUs and 16GB of RAM on early Black Friday sale for $200 off MSRP, only $799. Their prices are the lowest currently available for these newly upgraded 13″ M2... Read more
13-inch 8GB M2 MacBook Airs for $749, $250 of...
Best Buy has Apple 13″ MacBook Airs with M2 CPUs and 8GB of RAM in stock and on sale on their online store for $250 off MSRP. Prices start at $749. Their prices are the lowest currently available for... Read more
Amazon is offering an early Black Friday $100...
Amazon is offering early Black Friday discounts on Apple’s new 2024 WiFi iPad minis ranging up to $100 off MSRP, each with free shipping. These are the lowest prices available for new minis anywhere... Read more
Price Drop! Clearance 14-inch M3 MacBook Pros...
Best Buy is offering a $500 discount on clearance 14″ M3 MacBook Pros on their online store this week with prices available starting at only $1099. Prices valid for online orders only, in-store... Read more
Apple AirPods Pro with USB-C on early Black F...
A couple of Apple retailers are offering $70 (28%) discounts on Apple’s AirPods Pro with USB-C (and hearing aid capabilities) this weekend. These are early AirPods Black Friday discounts if you’re... Read more
Price drop! 13-inch M3 MacBook Airs now avail...
With yesterday’s across-the-board MacBook Air upgrade to 16GB of RAM standard, Apple has dropped prices on clearance 13″ 8GB M3 MacBook Airs, Certified Refurbished, to a new low starting at only $829... Read more
Price drop! Apple 15-inch M3 MacBook Airs now...
With yesterday’s release of 15-inch M3 MacBook Airs with 16GB of RAM standard, Apple has dropped prices on clearance Certified Refurbished 15″ 8GB M3 MacBook Airs to a new low starting at only $999.... Read more
Apple has clearance 15-inch M2 MacBook Airs a...
Apple has clearance, Certified Refurbished, 15″ M2 MacBook Airs now available starting at $929 and ranging up to $410 off original MSRP. These are the cheapest 15″ MacBook Airs for sale today at... Read more
Apple drops prices on 13-inch M2 MacBook Airs...
Apple has dropped prices on 13″ M2 MacBook Airs to a new low of only $749 in their Certified Refurbished store. These are the cheapest M2-powered MacBooks for sale at Apple. Apple’s one-year warranty... Read more
Clearance 13-inch M1 MacBook Airs available a...
Apple has clearance 13″ M1 MacBook Airs, Certified Refurbished, now available for $679 for 8-Core CPU/7-Core GPU/256GB models. Apple’s one-year warranty is included, shipping is free, and each... Read more

Jobs Board

Seasonal Cashier - *Apple* Blossom Mall - J...
Seasonal Cashier - Apple Blossom Mall Location:Winchester, VA, United States (https://jobs.jcp.com/jobs/location/191170/winchester-va-united-states) - Apple Read more
Seasonal Fine Jewelry Commission Associate -...
…Fine Jewelry Commission Associate - Apple Blossom Mall Location:Winchester, VA, United States (https://jobs.jcp.com/jobs/location/191170/winchester-va-united-states) Read more
Seasonal Operations Associate - *Apple* Blo...
Seasonal Operations Associate - Apple Blossom Mall Location:Winchester, VA, United States (https://jobs.jcp.com/jobs/location/191170/winchester-va-united-states) - Read more
Hair Stylist - *Apple* Blossom Mall - JCPen...
Hair Stylist - Apple Blossom Mall Location:Winchester, VA, United States (https://jobs.jcp.com/jobs/location/191170/winchester-va-united-states) - Apple Blossom Read more
Cashier - *Apple* Blossom Mall - JCPenney (...
Cashier - Apple Blossom Mall Location:Winchester, VA, United States (https://jobs.jcp.com/jobs/location/191170/winchester-va-united-states) - Apple Blossom Mall Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.