The Developer Connection - Device Driver Kit for OS/2 3

home *** CD-ROM | disk | FTP | other *** search

/ The Developer Connection…ice Driver Kit for OS/2 3 / DEV3-D1.ISO / devtools / dataflex / menu.src < prev next >

Wrap

Text File | 1993-05-19 | 102.5 KB | 2,962 lines

//**************************************************************************** // Copyright 1987-1992 Data Access Corporation, Miami FL, USA // All Rights reserved // // Name: menu.src // Purpose: 1 menu-driven front-end to DataFlex 3.0 // 2 sample code for developers // Creator: Theo van Dongeren // Date: June 26, 1991 // //Modified: AJG // Date: June 5, 1992 // Purpose: Modifiy the Quit Application Method to Instead override the // Exit_Application Message. This needs to get forwarded to // windows. // //**************************************************************************** use ui use menu use help // provide a name to the application set application_name to 'System' // the module name will default to the name of this program, // but it can also be set manually: set module_name to 'Menu' // open the menu file open menu // Define a string to contain the OS directory seperator and one for the // wildcard mask of the OS. String Dir_Separator Wild_Card_Mask Move ( SysConf( SYSCONF_DIR_SEPARATOR )) to Dir_Separator Move ( SysConf( SYSCONF_FILE_MASK )) to Wild_Card_Mask /main_title ________________________________________________________________________________ /main_action_bar ____ ___ ____ /main_object ┌────────────────────────────────┐ │ ______________________________ │ │ ______________________________ │ ├────────────────────────────────┤ │ ______________________________ │ │ ______________________________ │ │ ______________________________ │ │ ______________________________ │ │ ______________________________ │ │ ______________________________ │ │ ______________________________ │ │ ______________________________ │ │ ______________________________ │ └────────────────────────────────┘ <_________________> <___________> <_______> /* sub_page menu_head from main_object 1 2 sub_page menu_body from main_object vertical 3 9 sub_page menu_button from main_object horizontal 12 3 /file_pull_down ┌──────────────────┐ │ ________________ │ │ ________________ │ │ ________________ │ │ ________________ │ │ ________________ │ ├──────────────────┤ │ ________________ │ └──────────────────┘ /run_pull_down ┌─────────────────────┐ │ ___________________ │ │ ___________________ │ │ ___________________ │ └─────────────────────┘ /password ╔════════════════════════════════════╗ ║ __________________________________ ║ ║ __________________________________ ║ ╚════════════════════════════════════╝ /* sub_page invalid_password from password 1 /question ╔══════════════════════════════════════════════════════╗ ║ ____________________________________________________ ║ ║ ____________________________________________________ ║ ║ ║ ║ ____________________________________________________ ║ ║ ║ ║ <_____> <__________> <_______> ║ ╚══════════════════════════════════════════════════════╝ /* sub_page question_text from question 1 2 sub_page question_reply from question 3 sub_page question_button from question horizontal 4 3 /run_stuff ╔════════════════════════════════════════════════════════════════════════╗ ║________________________________________________________________________║ ║ ║ ║ System command: ______________________________________________________ ║ ║ ║ ║ <_____> <__________> <_______> ║ ╚════════════════════════════════════════════════════════════════════════╝ /* sub_page run_title from run_stuff 1 sub_page run_this from run_stuff 2 sub_page run_button from run_stuff horizontal 3 3 /chain_stuff ╔════════════════════════════════════════════════════════════════════════╗ ║________________________________________________________________________║ ║ ║ ║ DataFlex program: ____________________________________________________ ║ ║ ║ ║ <_____> <__________> <_______> ║ ╚════════════════════════════════════════════════════════════════════════╝ /* sub_page chain_title from chain_stuff 1 sub_page chain_this from chain_stuff 2 sub_page chain_button from chain_stuff horizontal 3 3 /file_1 ╔═════════════════════════════════════════════════╗ ║_________________________________________________║ ║ ║ ║ File name: ____________ ║ ║ Directory is: _____________________________ ║ ║ ║ ║ ║ ║ Files Directories ║ ║ ┌─────────────┐ ┌─────────────┐ ║ ║ │____________ │ │____________ │ ║ ║ │____________ │ │____________ │ ║ ║ │____________ │ │____________ │ ║ ║ │____________ │ │____________ │ ║ ║ │____________ │ │____________ │ ║ ║ │____________ │ │____________ │ ║ ║ │____________ │ │____________ │ ║ ║ └─────────────┘ └─────────────┘ ║ ║ <_________________> <___________________> ║ ║ <_____> <__________> <_______> ║ ╚═════════════════════════════════════════════════╝ /* sub_page file_1_title from file_1 1 sub_page file_1_spec from file_1 vertical 2 2 sub_page file_1_file_list from file_1 vertical 4 7 sub_page file_1_dir_list from file_1 vertical 5 7 sub_page file_1_list_button from file_1 horizontal 18 2 sub_page file_1_button from file_1 horizontal 20 3 format file_1.1 {autoclear} format file_1.2 {autoclear} /file_2 ╔═════════════════════════════════════════════════╗ ║_________________________________________________║ ║ ║ ║ File name: ____________ ║ ║ Directory is: _____________________________ ║ ║ ___________ is: _____________________________ ║ ║ ║ ║ Files Directories ║ ║ ┌─────────────┐ ┌─────────────┐ ║ ║ │____________ │ │____________ │ ║ ║ │____________ │ │____________ │ ║ ║ │____________ │ │____________ │ ║ ║ │____________ │ │____________ │ ║ ║ │____________ │ │____________ │ ║ ║ │____________ │ │____________ │ ║ ║ │____________ │ │____________ │ ║ ║ └─────────────┘ └─────────────┘ ║ ║ <_________________> <___________________> ║ ║ <_____> <__________> <_______> ║ ╚═════════════════════════════════════════════════╝ /* sub_page file_2_title from file_2 1 4 sub_page file_2_spec from file_2 vertical 2 3 sub_page file_2_file_list from file_2 vertical 6 7 sub_page file_2_dir_list from file_2 vertical 7 7 sub_page file_2_list_button from file_2 horizontal 20 2 sub_page file_2_button from file_2 horizontal 22 3 format file_2.1 {autoclear} format file_2.2 {autoclear} format file_2.3 {autoclear} /working ╔═══════════════════════════════════════════════╗ ║ _____________________________________________ ║ ║ _____________________________________________ ║ ╚═══════════════════════════════════════════════╝ /invalid_spec ╔═══════════════════════════════════╗ ║ ║ ║ -- WARNING -- ║ ║ ║ ║ _________________________________ ║ ║ ║ ║ _________________________________ ║ ║ ║ ║ ║ ║ <__> ║ ║ ║ ╚═══════════════════════════════════╝ /* sub_page invalid_spec_button from invalid_spec 3 /nothing_marked ╔═══════════════════════════════════╗ ║ ║ ║ -- WARNING -- ║ ║ ║ ║ You have not selected any ║ ║ ║ ║ files to be ________ ║ ║ ║ ║ ║ ║ <__> ║ ║ ║ ╚═══════════════════════════════════╝ /* sub_page nothing_marked_button from nothing_marked 2 /delete_confirm ╔═══════════════════════════════════╗ ║ ║ ║ -- WARNING -- ║ ║ ║ ║ You have selected files to be ║ ║ ║ ║ deleted. Do you really want to ║ ║ ║ ║ delete these files? ║ ║ ║ ║ <__> <______> ║ ║ ║ ╚═══════════════════════════════════╝ /* sub_page delete_confirm_button from delete_confirm horizontal 1 2 /dummy_console_title ______________________________________________________________________________ /about ╔═════════════════════════════════════════════════════╗ ║_____________________________________________________║ ║ ║ ║ ║ ║ Menu ║ ║ ║ ║ Version 1.00b ║ ║ ║ ║ ║ ║ Copyright 1987-1992 Data Access Corporation ║ ║ Miami FL, USA - All rights reserved ║ ║ ║ ║ Memory: __________ Bytes ║ ║ ║ ║ <__> <____> ║ ╚═════════════════════════════════════════════════════╝ /* sub_page about_title from about 1 2 sub_page about_button from about horizontal 3 2 indicator interrupted // used to signal a user interrupt in listing files/directories to // the virtual console // forward function declarations for functions that are used in the class // definitions below. // the actual functions are defined further down. register_function ask_question integer qnum returns integer register_function reply returns string register_function validate string password returns integer register_function add_path string path string newdir returns string register_function check_flx string cmdtail returns integer register_function verify_delete returns integer //**************************************************************************** // // Name: SELLIST // Purpose: skeleton picklist for DIR_LIST and FILE_LIST classes // // Notes: This class is an auto-select list (one item is always selected // unless the list is empty) and it can provide its parent with // the selected item(s), one by one, and it can tell its parent // if any items are selected. // //**************************************************************************** class sellist is a list procedure construct_object integer img forward send construct_object img // default selection mode: always 1 item selected unless empty set select_mode to auto_select // user may search by typing a name set search_mode to incremental // selection cursor won't wrap set wrap_state to false // this sets the entry message to be sent when receiving the focus set entry_msg to initialize end_procedure // this gets executed every time an object of this class gets the focus procedure initialize local integer dynupdt // when the list has no 'official' items if (item_count(current_object)) lt 1 begin // remember the current dynamic update state get dynamic_update_state to dynupdt // this 'hides' changes to the list from becoming visible on // screen set dynamic_update_state to false // initialize the list send fill_list // restore the old dynamic update state set dynamic_update_state to dynupdt end end_procedure // this is the default initialization procedure fill_list // wipe the list send delete_data end_procedure // this spoonfeeds each selected item to the instance, one at a time procedure process_selections local integer item# local integer mx // calculate highest item number move (item_count(current_object) - 1) to mx // do all items for item# from 0 to mx // if the current item is selected if (select_state(current_object,item#)) ne 0 begin // send it to the instance send process_selection item# // turn the selection off set select_state item item# to false end loop end_procedure // this returns a 1 if items are slected and 0 if no items are selected function check_selections returns integer function_return (integer(select_count(current_object) > 0)) end_function // this returns the number of items in the list function list_count returns integer function_return (integer(item_count(current_object) > 0)) end_function // this is used to add new items at the bottom of the list procedure select_and_rotate set select_state to true send next end_procedure end_class //**************************************************************************** // // Name: DIR_LIST // Purpose: picklist for directories // // Notes: the following class 'knows' about listing directories in a // sellist and 'knows' about what message to send when a selected // item is processed. // //**************************************************************************** class dir_list is a sellist procedure construct_object integer list_image forward send construct_object list_image // this defines the default accelerator key message // it is set 'private' so children don't inherit it on_key kenter send process_selections private end_procedure // this loads the list according to the supplied filespec procedure load_list string dirspec local string astr // don't update the screen while it is filling set dynamic_update_state to false // call the parent class procedure to clear the list send fill_list // make sure at least ".." is in the list send add_item msg_select_and_rotate ".." // append a backslash if needed if (right(dirspec,1)) ne Dir_Separator append dirspec Dir_Separator // open the directory as a file // // note: directory names CAN HAVE extensions, although seldom used // that's why the filespec is "*.*" direct_input ("DIR:" + dirspec + Wild_Card_Mask) repeat // read a filename readln astr [not seqeof] trim astr to astr // check if it's a directory [not seqeof] indicate got_one as (left(astr,1)) eq '[' // trim off the square brackets [not seqeof got_one] mid astr to astr (length(astr) - 2) 2 // check if it's ".." (which we already have) [not seqeof got_one] indicate got_one as astr ne ".." // or '.' (which is useless for us) [not seqeof got_one] indicate got_one as astr ne '.' // add it to the list [not seqeof got_one] send add_item msg_select_and_rotate astr until [seqeof] close_input // sort the list send sort_items ascending // this causes the screen to be updated set dynamic_update_state to true end_procedure // this gets called by the parent class when a directory is selected procedure process_selection integer item# // don't bother them with an item number, just give 'em the name send dir_selected (value(current_object,item#)) end_procedure end_class //**************************************************************************** // // Name: FILE_LIST // Purpose: picklist for files // // Notes: the following class 'knows' about listing files in a // sellist and 'knows' about what message to send when a selected // item is processed. // //**************************************************************************** class file_list is a sellist procedure construct_object integer list_image forward send construct_object list_image // we must be able to select multiple files set select_mode to multi_select end_procedure // this loads the list according to the supplied filespec and dirspec procedure load_list string filespec string dirspec local string astr // don't update the screen while it is filling set dynamic_update_state to false // call the parent class procedure to clear the list send fill_list // append a backslash if needed if (right(dirspec,1)) ne Dir_Separator append dirspec Dir_Separator // open the directory as a file direct_input ("DIR:" + dirspec + filespec) repeat // read a filename readln astr [not seqeof] trim astr to astr // check if it's not a directory [not seqeof] indicate got_one as (left(astr,1)) ne '[' // add it to the list [not seqeof got_one] send add_item msg_select_and_rotate astr until [seqeof] close_input // sort the list send sort_items ascending // this causes the screen to be updated set dynamic_update_state to true end_procedure // this gets called by the parent class for each selected file procedure process_selection integer item# // don't bother them with an item number, just give 'em the name send file_selected (value(current_object,item#)) end_procedure // this entrypoint quickly selects/deselects all items procedure select_all integer mode // set the select count property (0 deselects, 1 or greater // selects all) set select_count mode end_procedure end_class //**************************************************************************** // // Name: FILE_SPEC // Purpose: filespec entry form // //**************************************************************************** class file_spec is a form // this initializes the item windows procedure init_specs local string astring // default file spec set value item 0 to Wild_Card_Mask // get the current directory name and set it up as the default get_current_directory to astring set value item 1 to astring // fill the lists using the defaults send do_dirlist end_procedure // this loads a new list of files if the filename item was changed procedure get_filelist local integer item_changed get item_changed_state item current to item_changed if (item_changed = true) send do_filelist send next end_procedure // this loads a new list of files for the new directory if the directory // item was changed procedure get_dirlist local integer item_changed get item_changed_state item current to item_changed if (item_changed = true) send do_dirlist send next end_procedure // this loads the filelist according to the entered directory- // and file specs procedure do_filelist send load_filelist (value(current_object,0)) (value(current_object,1)) // flag the item back to unchanged; we're done with it send item_done end_procedure // this loads the directorylist according to the entered directory // specs and then reloads the file list procedure do_dirlist send load_dirlist (value(current_object,1)) send do_filelist // flag the item back to unchanged; we're done with it send item_done end_procedure // this flags all items back to unchanged procedure item_done set changed_state of current_object to false end_procedure // this processes the directory name that was selected from the list procedure dir_selected string thedir local string path // get the current directory spec get value item 1 to path // amend the current path with the supplied directory set value item 1 to (add_path(current_object,path,thedir)) // reload both lists send do_dirlist end_procedure // this checks if unprocessed item changes exist. // If yes, then one or both lists are rebuilt procedure check_changes local integer has_changed // see if the directory spec has changed get item_changed_state item 1 to has_changed if (has_changed = true) send do_dirlist // this rebuilds both else begin // see if only the file spec has changed get item_changed_state item 0 to has_changed // this rebuilds files only if (has_changed = true) send do_filelist end end_procedure end_class //**************************************************************************** // // Name: FILE_LIST_BUTTON // Purpose: general purpose buttons for a FILE_SPEC // //**************************************************************************** class file_list_button is a button procedure construct_object integer image forward send construct_object image set focus_mode to pointer_only // set up the buttons item_list on_item "Alt+F1=Select All" send select_all_files on_item "Alt+F2=Deselect All" send deselect_all_files end_item_list end_procedure end_class //**************************************************************************** // // Name: FILE_CLIENT // Purpose: file manipulation skeleton // // Notes: this defines the common structure of the five file operations // copy, delete, rename, print and type //**************************************************************************** class file_client is a client procedure construct_object integer image forward send construct_object image // prevent activation as a regular child set focus_mode to no_activate // prevent mouse-activation of any objects outside of this one set block_mouse_state to true // position the object's image on the screen set location to 0 14 relative // prevent accelerator-key activation of the action bar on_key kaction_bar send default_key on_key kuser send select_all_files on_key kuser2 send deselect_all_files end_procedure // these will be set up in the instances register_object file_stuff register_object dir_stuff // the procedures below route message traffic between siblings. // it is 'a good thing' to NOT have siblings 'talk' to each other // directly, since that would make them dependent on each other. // so, to resolve this, their common parent must act as traffic cop. // this routes a message to its proper object procedure load_filelist string filespec string dirspec send load_list to (file_stuff(current_object)) filespec dirspec end_procedure // this routes a message to its proper object procedure load_dirlist string dirspec send load_list to (dir_stuff(current_object)) dirspec end_procedure // this routes a message to its proper object and returns the // result to the caller function check_selections returns integer function_return (check_selections(file_stuff(current_object))) end_function // this routes a message to its proper object and returns the // result to the caller function list_count returns integer function_return (list_count(file_stuff(current_object))) end_function // this routes a message to its proper object procedure process_selections send process_selections to (file_stuff(current_object)) end_procedure // this processes the "Select All" button procedure select_all_files // have file_stuff select all files send select_all to (file_stuff(current_object)) true end_procedure // this processes the "Deselect All" button procedure deselect_all_files // have file_stuff deselect all files send select_all to (file_stuff(current_object)) false end_procedure end_class //**************************************************************************** // // Name: ABOUT // Purpose: provide information about the program // //**************************************************************************** object about is a client set location to 5 12 absolute set block_mouse_state to true //************************************************************************ // // Name: ABOUT_TITLE // Purpose: displays title of ABOUT object // //************************************************************************ object about_title is a title set center_state item 0 to true set value item 0 to "DataFlex Menu System" end_object //************************************************************************ // // Name: ABOUT_BUTTON // Purpose: implements buttons of ABOUT object // //************************************************************************ object about_button is a button item_list on_item "OK" send deactivate to (parent(current_object)) on_item "Help" send help end_item_list procedure init local integer mem memory mem set value of (about_title(about.obj)) item 1 to mem end_procedure send init end_object end_object procedure about send activate to about.obj end_procedure procedure focus_help for desktop send help to (focus(desktop)) end_procedure //**************************************************************************** // // Name: MAIN // Purpose: main object // //**************************************************************************** object main_object is a client set location to 2 0 absolute // set up accelerator key for the action bar on_key kaction_bar send do_action_bar on_key kexit_application send quit //************************************************************************ // // Name: MAIN_TITLE // Purpose: displays program title // //************************************************************************ object main_title is a title set location to -2 0 relative set center_state item 0 to true set value item 0 to "DataFlex Menu System" end_object //************************************************************************ // // Name: MENU_HEAD // Purpose: displays menu title // //************************************************************************ object menu_head is a title // this displays the menu header text procedure display_title set value item 0 to menu.header1 set value item 1 to menu.header2 end_procedure end_object //************************************************************************ // // Name: MENU_BODY // Purpose: implements navigation and activation of menu items // //************************************************************************ object menu_body is a menu set auto_top_item_state to false register_object main_action_bar register_object file_pulldown register_object run_pulldown register_object help_pull_down // set up accelerator keys on_key key_alt+key_f send pull_down_file private on_key key_alt+key_r send pull_down_run private on_key key_alt+key_h send pull_down_help private on_key kcancel send back_one // what to do on escape on_key kdownarrow send go_down // what to do with up and down arrows on_key kuparrow send go_up on_key knext_item send go_down on_key kprevious_item send go_up // set up the items for this object item_list repeat_item 9 times "" send do_action // ie. execute the option end_item_list procedure switch end_procedure procedure switch_back end_procedure // make sure the mouse can't select empty menu lines procedure set current_item integer inum indicate not valid_option as (shadow_state(current_object,inum)) [valid_option] forward set current_item to inum end_procedure procedure mouse_click integer win integer char [valid_option] forward send mouse_click win char end_procedure procedure mouse_up integer win integer char [valid_option] forward send mouse_up win char end_procedure // this displays the menu that is currently in the buffer procedure display_menu local integer inum integer imin // go display the title send display_title // keep track of which item is the first non-empty item move 8 to imin // turn off automatic screen update set dynamic_update_state to false // for all nine options do: for inum from 0 to 8 // make a pointer into the menu buffer move (inum * 3) to fieldindex // write the option prompt to the image set value item inum to menu.pr1& // check if it's empty and shadow the item if it's empty if (trim(menu.pr1&)) eq "" set shadow_state item inum to true else begin // un-shadow it to be safe (might be left shadowed by // previous menu) set shadow_state item inum to false // check if this is the first non-empty item move (inum min imin) to imin end // start at the first non-empty item set current_item to imin loop // show the updated menu image set dynamic_update_state to true // remember which menu is currently loaded move menu.recnum to next_menu end_procedure // this loads a specified menu procedure load_menu integer thisone // go get the menu record move thisone to menu.recnum find eq menu.recnum // if it exists, then show it [found] send display_menu // else default to the main menu [finderr] send load_menu 1 // nb. observe that this is a recursive call! end_procedure // this backs up to the parent menu procedure back_one send load_menu (integer(menu.default)) end_procedure // this initializes the menu body object procedure activating // eat all keys pressed since invocation repeat keycheck [keypress] loop // load the main menu or reload the last used menu send load_menu next_menu forward send activating end_procedure // this moves the selection cursor to the next non-empty option // this will wrap up if necessary procedure go_down local integer icount inum istate // find out where we are get current_item to inum // try upto nine times for icount from 0 to 8 // go to the next option increment inum // wrap if necessary if inum gt 8 move 0 to inum // find out if this option is non-empty get shadow_state item inum to istate // terminate loop early if a non-empty (non-shadowed) option // is found if (istate = false) move 8 to icount loop // move the selection cursor to the new option set current_item to inum end_procedure // this moves the selection cursor to the previous non-empty option // this will wrap up if necessary procedure go_up local integer icount inum istate // find out where we are get current_item to inum // try upto nine times for icount from 0 to 8 // go to the previous option decrement inum // wrap if necessary if inum lt 0 move 8 to inum // find out if this option is non-empty get shadow_state item inum to istate // terminate loop early if a non-empty (non-shadowed) option // is found if (istate = false) move 8 to icount loop // move the selection cursor to the new option set current_item to inum end_procedure // this executes the action as defined for this option procedure do_action local string action password cmdhead cmdtail qtoken local integer space inum qpos qnum // find out where we are get current_item to inum // make a pointer into the menu buffer move (inum * 3) to fieldindex // get the action trim menu.ac1& to action // forget it if there is no action indicate go as action gt "" [go] begin // see if there is a password attached to this option trim menu.pw1& to password indicate go as password eq "" // there is a password, so go ask for it [not go] indicate go as (validate(current_object,password)) end [go] begin // check for questions in the action repeat // set up the string search for a question token move '$' to qtoken // is there a question? pos qtoken in action to qpos if qpos begin // remember which question token to replace with the // answer mid action to qnum 1 (qpos + 1) append qtoken qnum // go ask the question indicate go as (ask_question(current_object,qnum)) ; eq msg_ok // replace the token if the question was answered // normally [go] replace qtoken in action with ; (reply(current_object)) end // keep going until all questions are answered, or until // the user stopped the questions-and-answers session [go] until qpos eq 0 end [go] begin // parse the action pos ' ' in action to space if space begin trim (right(action,(length(action) - space))) to cmdtail uppercase (left(action,(space - 1))) to cmdhead end else begin uppercase action to cmdhead move "" to cmdtail end // load the requested menu if cmdhead eq "MENU" send load_menu (integer(cmdtail)) // exit to the O/S else if cmdhead eq "SYSTEM" send quit // run the requested DataFlex program else if cmdhead eq "CHAIN" begin // proceed only when there is something to run in the // first place if cmdtail gt "" begin // find out in what mode to run this thing if (pos("WAIT ",uppercase(cmdtail)) = 1) begin // trim off the WAIT word trim (right(cmdtail,(length(cmdtail) - 5))) ; to cmdtail // check if the program can be found in dfpath if (check_flx(current_object,cmdtail)) begin // run it as a child chain wait cmdtail // rebuild the screen upon return send refresh_screen end end // run it as a sibling when the program can be found // in dfpath else if (check_flx(current_object,cmdtail)) ; chain cmdtail end end // copy the requested file(s) else if cmdhead eq "COPYFILE" begin // get the source and the destination specs pos ' ' in cmdtail to space left cmdtail to cmdhead (space - 1) trim (right(cmdtail,(length(cmdtail) - space))) ; to cmdtail // proceed only if: // 1) there is something to copy, and // 2) there is a place to copy it to if ((cmdhead > "") and (cmdtail > "")) begin // show what we're about to copy send working_on "Copying:" cmdhead // copy it send copy_it cmdhead cmdtail // remove the "working on" message send working_off end end // delete the requested file(s) else if cmdhead eq "ERASEFILE" begin // proceed only if there is something to delete if (cmdtail > "") begin if (verify_delete(current_object) = msg_ok) begin // show what we're about to delete send working_on "Deleting:" cmdtail // delete it send delete_it cmdtail // remove the "working on" message send working_off end end end // rename the requested file(s) else if cmdhead eq "RENAMEFILE" begin // get the old- and new name specs pos ' ' in cmdtail to space left cmdtail to cmdhead (space - 1) trim (right(cmdtail,(length(cmdtail) - space))) ; to cmdtail // proceed only if: // 1) there is something to rename, and // 2) a new name is provided if ((cmdhead > "") and (cmdtail > "")) begin // show what we're about to rename send working_on "Renaming:" cmdhead // rename it send rename_it cmdhead cmdtail // remove the "working on" message send working_off end end // type the requested file(s) else if cmdhead eq "TYPE" begin // proceed only if there is something to type if (cmdtail > "") send type_it cmdtail end // list the specified directory/filespec else if cmdhead eq "DIRECTORY" begin if cmdtail eq "" move Wild_Card_Mask to cmdtail // open the directory as a file direct_input ("DIR:" + cmdtail) // turn on our virtual console send virtual_console_on ("Directory of " + cmdtail) repeat // reset our output line to empty move "" to cmdhead repeat // read a filename readln cmdtail // if we have read a filename, then pad it to // our output line [not seqeof] append cmdhead (pad(cmdtail,16)) // keep going until: // 1) there is nothing more to read, or // 2) our output line is over 78 characters long [not seqeof] until (length(cmdhead) > 78) // do we have something to write? if cmdhead gt ""begin // adjust the output line length to the // width of the virtual console pad cmdhead to cmdhead 78 // write the output line and check for user // interrupt send write_a_line cmdhead end // keep going until: // 1) all files are listed, or // 2) the listing was interrupted [not seqeof not interrupted] loop // turn off the virtual console (give it back to the // desktop) send virtual_console_off // close the directory file close_input end // run the action as a regular program else begin send run action set current_item to imin end end end_procedure end_object //************************************************************************ // // Name: MENU_BUTTON // Purpose: implements general purpose program buttons // //************************************************************************ object menu_button is a button set focus_mode to pointer_only item_list on_item "Esc=Previous Menu" send back_one on_item "Alt+F4=Exit" send quit on_item "F1=Help" send focus_help end_item_list end_object //************************************************************************ // // Name: MAIN_ACTION_BAR // Purpose: implements program's action bar // //************************************************************************ create_menu main_action_bar set location to -1 0 relative // always position on second line of client area (CUA spec) // this defines the "File" pulldown menu on_item "File" begin_pull_down file_pull_down // set up pulldown items on_item "Copy... " send do_copy on_item "Delete... " send do_delete on_item "Print... " send do_print on_item "Rename... " send do_rename on_item "Type... " send do_type on_item "Exit Alt+F4" send quit // MUST BE "Exit" (CUA spec) end_pull_down // this defines the "Run" pulldown menu on_item "Run" begin_pull_down run_pull_down // set up pulldown items on_item "DataFlex Program..." send do_chain on_item "System Command..." send do_run on_item "O/S Shell" send do_os end_pull_down // this defines the "Help" pulldown menu #include helpa_pd.inc procedure pull_down_file send activate_pull_down to (file_pull_down(current_object)) end_procedure procedure pull_down_run send activate_pull_down to (run_pull_down(current_object)) end_procedure procedure pull_down_help send activate_pull_down to (help_pull_down(current_object)) end_procedure end_menu //************************************************************************ // // Name: PASSWORD // Purpose: implements password entry and verification // //************************************************************************ object password is a message // prevent activation as a regular child set focus_mode to no_activate // fancy way to position the object two lines above the end of its // parent's area set location to (main_object.lines - password.lines - 2) 21 relative // prevent activation of any objects outside of this one set block_mouse_state to true on_key kaction_bar send default_key // auto-center the two windows set center_state item 0 to true set center_state item 1 to true //******************************************************************** // // Name: INVALID_PASSWORD // Purpose: notifies user of invalid password // //******************************************************************** object invalid_password is a warning_msg // prevent activation as a regular child set focus_mode to no_activate // auto-center the window set center_state item 0 to true // this notifies the user of the invalid password procedure tell_em // put the message in the window set value item 0 to "Invalid password for this option!" // allow it to become visible set focus_mode to focusable // make it visible send activate // wait three seconds sleep 3 // remove the message send deactivate // return to the default activation mode set focus_mode to no_activate end_procedure end_object // this validates an entered password against the supplied one function validate string password returns integer local integer okay local string stemp akey // put the message in the first window set value item 0 to "Enter the password for this option" // clear the second window set value item 1 to "" // allow it to become visible set focus_mode to focusable // make it visible send activate // start from scratch move "" to stemp repeat // wait for a key inkey akey // if it is not the return key, then... [not key.return] begin // append it to what we have already append stemp akey // add a question mark to the second window to show we // got the key set value item 1 (trim((value(current_object,1))) + '?') end // keep going until the return key is pressed until [key.return] // go away send deactivate // reset the default activation mode set focus_mode to no_activate // compare against the supplied password move (password = stemp) to okay // if it's wrong, then tell the user if not okay send tell_em to (invalid_password(current_object)) // return the result to the caller function_return okay end_function end_object //************************************************************************ // // Name: QUESTION // Purpose: implements the asking of questions for menu items // //************************************************************************ object question is a client // prevent activation as a regular child set focus_mode to no_activate on_key ksave_record send ok on_key kcancel send cancel // fancy way to position the object one line above the end of its // parent's area set location to (main_object.lines - question.lines - 1) 12 relative // prevent activation of any objects outside of this one set block_mouse_state to true on_key kaction_bar send default_key //******************************************************************** // // Name: QUESTION_TEXT // Purpose: displays the question // //******************************************************************** object question_text is a title // this displays the question text procedure display_question string q1 string q2 set value item 0 to q1 set value item 1 to q2 end_procedure end_object //******************************************************************** // // Name: QUESTION_REPLY // Purpose: implements entry of a response to a question // //******************************************************************** object question_reply is a form set local_rotate_state to true // set up the reply item window item_list on_item "" send next end_item_list // this initializes the reply item window procedure activating // clear the reply item window set value item 0 to "" forward send activating end_procedure // this returns the contents of the reply item window to the // caller function reply returns string function_return (value(current_object,0)) end_function end_object //******************************************************************** // // Name: QUESTION_BUTTON // Purpose: implements Q&A buttons // //******************************************************************** object question_button is a button // set up the button item windows and their messages when // clicked on item_list on_item "F2=OK" send ok on_item "Esc=Cancel" send cancel on_item "F1=Help" send help end_item_list end_object // this asks a question and lets the user enter a reply function ask_question integer qnum returns integer local integer result_msg // allow the reply object to take the focus set focus_mode to focusable // make a pointer into the menu buffer move ((qnum - 1) * 2) to fieldindex // show the question text send display_question to (question_text(current_object)) ; menu.qa1& menu.qb1& // let the user reply (returns either the msg_ok or msg_cancel // message) ui_accept current_object to result_msg // return the result message to the caller function_return result_msg end_function // this routes a reply request to the proper object function reply returns string function_return (reply(question_reply(current_object))) end_function end_object //************************************************************************ // // Name: RUN_STUFF // Purpose: implements entry and invocation of executables // //************************************************************************ object run_stuff is a client // prevent activation as a regular child set focus_mode to no_activate // fancy way to position the object one line above the end of its // parent's area set location to (main_object.lines - run_stuff.lines - 1) 3 relative set local_rotate_state to true // prevent activation of any objects outside of this one set block_mouse_state to true on_key kaction_bar send default_key // set up accelerator keys on_key ksave_record send run_it on_key kcancel send run_stuff_off //******************************************************************** // // Name: RUN_TITLE // Purpose: displays title of RUN_STUFF object // //******************************************************************** object run_title is a title set center_state item 0 to true set value item 0 to "Run A System Command..." end_object //******************************************************************** // // Name: RUN_THIS // Purpose: implements entry of executable's name // //******************************************************************** object run_this is a form // set up the items item_list on_item "" send next end_item_list // this initializes the item window procedure activating set value item 0 to "" end_procedure end_object //******************************************************************** // // Name: RUN_BUTTONS // Purpose: implements buttons of the RUN_STUFF object // //******************************************************************** object run_button is a button // set up the button items item_list on_item "F2=OK" send run_it on_item "Esc=Cancel" send run_stuff_off on_item "F1=Help" send help end_item_list end_object // this activates the object procedure run_stuff_on // allow to become visible and to take the focus set focus_mode to focusable // give it the focus send activate end_procedure // this deactivates the object procedure run_stuff_off // return the focus to whoever had it before send deactivate // reset the default activation mode set focus_mode to no_activate end_procedure // this executes the supplied command procedure run string theprogram local string cmd local string arg local integer space // remove this object's image send run_stuff_off // return to normal screen i/o screen_optimize false // clear the screen clearscreen // see if a command was specified trim theprogram to cmd if cmd ne "" begin // separate the command from its arguments (if any) pos ' ' in cmd to space if space begin move (trim(right(cmd,(length(cmd) - space)))) to arg left cmd to cmd (space - 1) end else move "" to arg // execute it runprogram cmd arg clearscreen end // no command specified, we're going to run a shell else begin // tell the user what to do to get back to us showln 'Enter "EXIT" to return to DataFlex.' // run the shell runprogram wait clearscreen end // return to optimized screen i/o screen_optimize true // repaint the screen send refresh_screen end_procedure // this processes the OK message on the entered command procedure run_it send run (value(run_this(current_object),0)) end_procedure // this processes an external request to run a shell procedure run_shell send run "" end_procedure end_object //************************************************************************ // // Name: CHAIN_STUFF // Purpose: implements entry and invocation of DataFlex programs // //************************************************************************ object chain_stuff is a client // prevent activation as a regular child set focus_mode to no_activate // fancy way to position the object one line above the end of its // parent's area set location to (main_object.lines - chain_stuff.lines - 1) 3 relative set local_rotate_state to true // prevent activation of any objects outside of this one set block_mouse_state to true on_key kaction_bar send default_key // set up accelerator keys on_key ksave_record send chain_it on_key kcancel send chain_stuff_off //******************************************************************** // // Name: CHAIN_TITLE // Purpose: displays title of CHAIN_STUFF object // //******************************************************************** object chain_title is a title set center_state item 0 to true set value item 0 to "Run A DataFlex Program..." end_object //******************************************************************** // // Name: CHAIN_THIS // Purpose: implements entry of DataFlex program's name // //******************************************************************** object chain_this is a form // set up the items item_list on_item "" send next end_item_list // this initializes the item window procedure activating set value item 0 to "" end_procedure end_object //******************************************************************** // // Name: CHAIN_BUTTON // Purpose: implements buttons of CHAIN_STUFF object // //******************************************************************** object chain_button is a button // set up the button items item_list on_item "F2=OK" send chain_it on_item "Esc=Cancel" send chain_stuff_off on_item "F1=Help" send help end_item_list end_object // this activates the object procedure chain_stuff_on // allow to become visible and to take the focus set focus_mode to focusable // give it the focus send activate end_procedure // this deactivates the object procedure chain_stuff_off // return the focus to whoever had it before send deactivate // reset the default activation mode set focus_mode to no_activate end_procedure // this processes the "OK" button procedure chain_it local string cmdtail get value of (chain_this(current_object)) to cmdtail // proceed only if there is something to chain to if cmdtail gt "" begin // check if the program can be found in dfpath and, // if yes, chain to it if (check_flx(current_object,cmdtail)) chain cmdtail end // remove the object's image send chain_stuff_off end_procedure end_object //************************************************************************ // // Name: FILE_COPY // Purpose: implements the copy file function // //************************************************************************ object file_copy is a file_client file_2 on_key ksave_record send copy_ok on_key kcancel send file_copy_off //******************************************************************** // // Name: FILE_COPY_TITLE // Purpose: displays title of FILE_COPY object // //******************************************************************** object file_copy_title is a title file_2_title set center_state item 0 to true set shadow_state item 1 to true end_object //******************************************************************** // // Name: FILE_COPY_SPEC // Purpose: implements entry of filespec // //******************************************************************** object file_copy_spec is a file_spec file_2_spec // set up the items item_list on_item "" send get_filelist on_item "" send get_dirlist on_item "" send next end_item_list procedure init_specs forward send init_specs set value item 2 to "" end_procedure // this copies file(s) from source to destination procedure copy_it string source string destination copyfile source to destination end_procedure // this informs the user what is copied procedure copying string source string destination // proceed only if there is a destination if (value(current_object,2)) gt "" begin // show what is going to be copied send working_on "Copying:" source // copy it send copy_it source destination end // no destination given: show a warning message else send spec_invalid "You have not specified" ; "the destination!" end_procedure // this processes a file that was selected from the list procedure file_selected string thefile local string source destination // get the path trim (value(current_object,1)) to source // append a backslash if needed if (right(source,1)) ne Dir_Separator append source Dir_Separator // append the supplied filename append source thefile // get the destination trim (value(current_object,2)) to destination // go copy it send copying source destination end_procedure // this processes the OK message procedure copy_ok local string source destination if (changed_state(current_object) = true) send check_changes // if files were selected from the list, then let the // list tell us which ones were selected if (check_selections(current_object)) begin send process_selections // turn off the "working on" message send working_off // reload file list send do_filelist end // else, tell 'em to select files first else send nothing_to_do 'copied.' end_procedure end_object //******************************************************************** // // Name: FILE_STUFF // Purpose: displays selection list of files // //******************************************************************** object file_stuff is a file_list file_2_file_list end_object // this defines the directory list (see class definition above) object dir_stuff is a dir_list file_2_dir_list end_object // this defines the select-all and deselect-all buttons object file_copy_list_button is a file_list_button file_2_list_button end_object // this sets up the buttons for this module object file_copy_button is a button file_2_button set focus_mode to pointer_only // set up the items item_list on_item "F2=OK" send copy_ok on_item "Esc=Cancel" send file_copy_off on_item "F1=Help" send focus_help end_item_list end_object // this activates this object procedure file_copy_on set value of (file_copy_title(current_object)) item 0 ; to "Copy Files..." set value of (file_copy_title(current_object)) item 1 ; to "Destination" send init_specs to (file_copy_spec(current_object)) set focus_mode to focusable send activate end_procedure // this deactivates this object procedure file_copy_off send deactivate set focus_mode to no_activate end_procedure // this routes a message to its proper object procedure file_selected string thefile send file_selected to (file_copy_spec(current_object)) thefile end_procedure // this routes a message to its proper object procedure dir_selected string thedir send dir_selected to (file_copy_spec(current_object)) thedir end_procedure // this routes a message to its proper object, but only if all items // have been processed. procedure copy_ok send copy_ok to (file_copy_spec(current_object)) end_procedure // this routes a message to its proper object procedure copy_it string source string destination send copy_it to (file_copy_spec(current_object)) source ; destination end_procedure // class override // this should check for item changes first // and process them if they exist. procedure select_all_files // check item changes and rebuild list(s) if necessary send check_changes to (file_copy_spec(current_object)) // continue with original job, as per class definition forward send select_all_files end_procedure // class override // this should check for item changes first // and process them if they exist. procedure deselect_all_files // check item changes and rebuild list(s) if necessary send check_changes to (file_copy_spec(current_object)) // continue with original job, as per class definition forward send deselect_all_files end_procedure end_object //************************************************************************ // // Name: FILE_DELETE // Purpose: implements the delete file function // // Notes: structurally identical to FILE_COPY // //************************************************************************ object file_delete is a file_client file_1 on_key ksave_record send delete_ok on_key kcancel send file_delete_off object file_delete_title is a title file_1_title set center_state item 0 to true end_object object file_delete_spec is a file_spec file_1_spec item_list on_item "" send get_filelist on_item "" send get_dirlist end_item_list procedure delete_it string source erasefile source end_procedure procedure deleting string source send working_on "Deleting:" source send delete_it source end_procedure procedure file_selected string thefile local string source trim (value(file_delete_spec(current_object),1)) to source if (right(source,1)) ne Dir_Separator append source Dir_Separator append source thefile send deleting source end_procedure procedure delete_ok local string source if (changed_state(current_object) = true) send check_changes if (check_selections(current_object)) begin if (verify_delete(current_object) = msg_ok) ; send process_selections send working_off send do_filelist end else send nothing_to_do 'deleted.' end_procedure end_object object file_stuff is a file_list file_1_file_list end_object object dir_stuff is a dir_list file_1_dir_list end_object object file_delete_list_button is a file_list_button ; file_1_list_button end_object object file_delete_button is a button file_1_button set focus_mode to pointer_only item_list on_item "F2=OK" send delete_ok on_item "Esc=Cancel" send file_delete_off on_item "F1=Help" send focus_help end_item_list end_object procedure file_delete_on set value of (file_delete_title(current_object)) item 0 ; to "Delete Files..." send init_specs to (file_delete_spec(current_object)) set focus_mode to focusable send activate end_procedure procedure file_delete_off send deactivate set focus_mode to no_activate end_procedure procedure file_selected string thefile send file_selected to (file_delete_spec(current_object)) thefile end_procedure procedure dir_selected string thedir send dir_selected to (file_delete_spec(current_object)) thedir end_procedure procedure delete_ok send delete_ok to (file_delete_spec(current_object)) end_procedure procedure delete_it string source send delete_it to (file_delete_spec(current_object)) source end_procedure procedure select_all_files send check_changes to (file_delete_spec(current_object)) forward send select_all_files end_procedure procedure deselect_all_files send check_changes to (file_delete_spec(current_object)) forward send deselect_all_files end_procedure end_object //************************************************************************ // // Name: FILE_PRINT // Purpose: implements the print file function // // Notes: structurally identical to FILE_COPY // //************************************************************************ object file_print is a file_client file_1 on_key ksave_record send print_ok on_key kcancel send file_print_off object file_print_title is a title file_1_title set center_state item 0 to true end_object object file_print_spec is a file_spec file_1_spec item_list on_item "" send get_filelist on_item "" send get_dirlist end_item_list procedure print_it string source local string aline direct_output "LST:" direct_input source [not seqeof] repeat readln aline writeln aline [not seqeof] loop close_output close_input [multiuser] despool end_procedure procedure printing string source send working_on "Printing:" source send print_it source end_procedure procedure file_selected string thefile local string source trim (value(file_print_spec(current_object),1)) to source if (right(source,1)) ne Dir_Separator append source Dir_Separator append source thefile send printing source end_procedure procedure print_ok local string source if (changed_state(current_object) = true) send check_changes if (check_selections(current_object)) begin send process_selections send working_off end else send nothing_to_do 'printed.' end_procedure end_object object file_stuff is a file_list file_1_file_list end_object object dir_stuff is a dir_list file_1_dir_list end_object object file_print_list_button is a file_list_button ; file_1_list_button end_object object file_print_button is a button file_1_button set focus_mode to pointer_only item_list on_item "F2=OK" send print_ok on_item "Esc=Cancel" send file_print_off on_item "F1=Help" send focus_help end_item_list end_object procedure file_print_on set value of (file_print_title(current_object)) item 0 ; to "Print Files..." send init_specs to (file_print_spec(current_object)) set focus_mode to focusable send activate end_procedure procedure file_print_off send deactivate set focus_mode to no_activate end_procedure procedure file_selected string thefile send file_selected to (file_print_spec(current_object)) thefile end_procedure procedure dir_selected string thedir send dir_selected to (file_print_spec(current_object)) thedir end_procedure procedure print_ok send print_ok to (file_print_spec(current_object)) end_procedure procedure print_it string source send print_it to (file_print_spec(current_object)) source end_procedure procedure select_all_files send check_changes to (file_print_spec(current_object)) forward send select_all_files end_procedure procedure deselect_all_files send check_changes to (file_print_spec(current_object)) forward send deselect_all_files end_procedure end_object //************************************************************************ // // Name: FILE_RENAME // Purpose: implements the rename file function // // Notes: structurally identical to FILE_COPY // //************************************************************************ object file_rename is a file_client file_2 on_key ksave_record send rename_ok on_key kcancel send file_rename_off object file_rename_title is a title file_2_title set center_state item 0 to true set shadow_state item 1 to true end_object object file_rename_spec is a file_spec file_2_spec item_list on_item "" send get_filelist on_item "" send get_dirlist on_item "" send next end_item_list procedure init_specs forward send init_specs set value item 2 to "" end_procedure procedure rename_it string source string destination renamefile source to destination end_procedure procedure renaming string source string destination if (value(current_object,2)) gt "" begin send working_on "Renaming:" source send rename_it source destination end else send spec_invalid "You have not specified" ; "the new name!" end_procedure procedure file_selected string thefile local string source destination trim (value(file_rename_spec(current_object),1)) to source if (right(source,1)) ne Dir_Separator append source Dir_Separator append source thefile trim (value (file_rename_spec(current_object),2)) ; to destination send renaming source destination end_procedure procedure rename_ok local string source destination if (changed_state(current_object) = true) send check_changes if (check_selections(current_object)) begin send process_selections send working_off send do_filelist end else send nothing_to_do 'renamed.' end_procedure end_object object file_stuff is a file_list file_2_file_list end_object object dir_stuff is a dir_list file_2_dir_list end_object object file_rename_list_button is a file_list_button ; file_2_list_button end_object object file_rename_button is a button file_2_button set focus_mode to pointer_only item_list on_item "F2=OK" send rename_ok on_item "Esc=Cancel" send file_rename_off on_item "F1=Help" send focus_help end_item_list end_object procedure file_rename_on set value of (file_rename_title(current_object)) item 0 ; to "Rename Files..." set value of (file_rename_title(current_object)) item 1 ; to " New name" send init_specs to (file_rename_spec(current_object)) set focus_mode to focusable send activate end_procedure procedure file_rename_off send deactivate set focus_mode to no_activate end_procedure procedure file_selected string thefile send file_selected to (file_rename_spec(current_object)) thefile end_procedure procedure dir_selected string thedir send dir_selected to (file_rename_spec(current_object)) thedir end_procedure procedure rename_ok send rename_ok to (file_rename_spec(current_object)) end_procedure procedure rename_it string source string destination send rename_it to (file_rename_spec(current_object)) source ; destination end_procedure procedure select_all_files send check_changes to (file_rename_spec(current_object)) forward send select_all_files end_procedure procedure deselect_all_files send check_changes to (file_rename_spec(current_object)) forward send deselect_all_files end_procedure end_object //************************************************************************ // // Name: FILE_TYPE // Purpose: implements the type file function // // Notes: structurally identical to FILE_COPY // //************************************************************************ object file_type is a file_client file_1 on_key ksave_record send type_ok on_key kcancel send file_type_off object file_type_title is a title file_1_title set center_state item 0 to true end_object object file_type_spec is a file_spec file_1_spec item_list on_item "" send get_filelist on_item "" send get_dirlist end_item_list procedure type_it string source local string aline akey direct_input source send virtual_console_on ("Typing " + source) repeat readln aline [not seqeof] send write_a_line aline [not seqeof not interrupted] loop send virtual_console_off close_input [interrupted] send deselect_all_files end_procedure procedure file_selected string thefile local string source trim (value(file_type_spec(current_object),1)) to source if (right(source,1)) ne Dir_Separator append source Dir_Separator append source thefile send type_it source end_procedure procedure type_ok local string source if (changed_state(current_object) = true) send check_changes if (check_selections(current_object)) ; send process_selections else send nothing_to_do 'typed.' end_procedure end_object object file_stuff is a file_list file_1_file_list end_object object dir_stuff is a dir_list file_1_dir_list end_object object file_type_list_button is a file_list_button file_1_list_button end_object object file_type_button is a button file_1_button set focus_mode to pointer_only item_list on_item "F2=OK" send type_ok on_item "Esc=Cancel" send file_type_off on_item "F1=Help" send focus_help end_item_list end_object procedure file_type_on set value of (file_type_title(current_object)) item 0 ; to "Type Files..." send init_specs to (file_type_spec(current_object)) set focus_mode to focusable send activate end_procedure procedure file_type_off send deactivate set focus_mode to no_activate end_procedure procedure file_selected string thefile send file_selected to (file_type_spec(current_object)) thefile end_procedure procedure dir_selected string thedir send dir_selected to (file_type_spec(current_object)) thedir end_procedure procedure type_ok send type_ok to (file_type_spec(current_object)) end_procedure procedure type_it string source send type_it to (file_type_spec(current_object)) source end_procedure procedure select_all_files send check_changes to (file_type_spec(current_object)) forward send select_all_files end_procedure procedure deselect_all_files send check_changes to (file_type_spec(current_object)) forward send deselect_all_files end_procedure end_object //************************************************************************ // // Name: WORKING // Purpose: implements general "working, please wait"-style message // //************************************************************************ object working is a message // prevent activation as a regular child set focus_mode to no_activate // auto-center both item windows set center_state item 0 to true set center_state item 1 to true // set the color on both item windows to the image's background color set shadow_state item 0 to true set shadow_state item 1 to true // position it within the parent's client area set location to 12 15 relative // this displays what we are doing at this time procedure working_on string action string afile // allow it to become visible set focus_mode to focusable // put the supplied text in the item windows set value item 0 to action set value item 1 to afile // display it on the screen send activate end_procedure // this removes the object's image procedure working_off // return the focus to whoever had it before send deactivate // return the activation mode to the default mode set focus_mode to no_activate end_procedure end_object //************************************************************************ // // Name: INVALID_SPEC // Purpose: implements general purpose warning message // //************************************************************************ object invalid_spec is a warning_msg // prevent activation as a regular child set focus_mode to no_activate // fancy way to center the object vertically within its parent's // client area below the action bar set location to (((main_object.lines + 2) - invalid_spec.lines) / 2) ; 21 relative // adjust for title and action bar-----^ (one line each) // auto-center both item windows set center_state item 0 to true set center_state item 1 to true // set the color on both item windows to the image's background color set shadow_state item 0 to true set shadow_state item 1 to true // this 'does' the OK button object invalid_spec_button is a button // prevent activation of any objects outside of this one set block_mouse_state to true set local_rotate_state to true // set up button item item_list on_item "OK" send ok end_item_list end_object // this pops up the object's image with the supplied text in it procedure tell_em string amsg string bmsg local integer temp // put the text in the item windows set value item 0 to amsg set value item 1 to bmsg ui_accept (invalid_spec_button(current_object)) to temp end_procedure end_object //************************************************************************ // // Name: NOTHING_MARKED // Purpose: implements notification message // //************************************************************************ object nothing_marked is a warning_msg // prevent activation as a regular child set focus_mode to no_activate // fancy way to center the object vertically within its parent's // client area below the action bar set location to (((main_object.lines + 2) - nothing_marked.lines) / 2) ; 21 relative // adjust for title and action bar-----^ (one line each) // set the color on both item windows to the image's background color set shadow_state item 0 to true // this 'does' the OK button object nothing_marked_button is a button // prevent activation of any objects outside of this one set block_mouse_state to true set local_rotate_state to true // set up button item item_list on_item "OK" send ok end_item_list end_object // this pops up the object's image with the supplied text in it procedure tell_em string amsg local integer temp // put the text in the item window set value item 0 to amsg ui_accept (nothing_marked_button(current_object)) to temp end_procedure end_object //************************************************************************ // // Name: DELETE_CONFIRM // Purpose: implements deletion verification // //************************************************************************ object delete_confirm is a warning_msg // prevent activation as a regular child set focus_mode to no_activate // fancy way to center the object vertically within its parent's // client area below the action bar set location to (((main_object.lines + 2) - delete_confirm.lines) / 2) ; 21 relative // adjust for title and action bar-----^ (one line each) // this 'does' the OK button object delete_confirm_button is a button // prevent activation of any objects outside of this one set block_mouse_state to true set local_rotate_state to true on_key knext_item send swap on_key kprevious_item send swap // set up button item item_list on_item "OK" send ok on_item "Cancel" send cancel end_item_list procedure swap local integer item# get current_item to item# set current_item to (1 - item#) end_procedure procedure activating set current_item to 1 forward send activating end_procedure end_object function verify_delete returns integer local integer retval set focus_mode to focusable ui_accept (delete_confirm_button(current_object)) to retval set focus_mode to no_activate function_return retval end_function end_object // this routes a message to its proper object procedure do_action_bar send activate to (main_action_bar(current_object)) end_procedure // this routes a message to its proper object procedure display_title send display_title to (menu_head(current_object)) end_procedure // this routes a message to its proper object and returns the result // to the caller function ask_question integer qnum returns integer function_return (ask_question(question(current_object),qnum)) end_function // this routes a message to its proper object and returns the result // to the caller function validate string option_password returns integer function_return (validate(password(current_object),option_password)) end_function // this routes a message to its proper object and returns the result // to the caller function reply returns string function_return (reply(question(current_object))) end_function // this routes a message to its proper object procedure run string theprogram send run to (run_stuff(current_object)) theprogram end_procedure // this routes a message to its proper object procedure do_chain send chain_stuff_on to (chain_stuff(current_object)) end_procedure // this routes a message to its proper object procedure do_run send run_stuff_on to (run_stuff(current_object)) end_procedure // this routes a message to its proper object procedure do_copy send file_copy_on to (file_copy(current_object)) end_procedure // this routes a message to its proper object procedure copy_it string source string destination send copy_it to (file_copy(current_object)) source destination end_procedure // this routes a message to its proper object procedure do_delete send file_delete_on to (file_delete(current_object)) end_procedure // this routes a message to its proper object procedure delete_it string source send delete_it to (file_delete(current_object)) source end_procedure // this routes a message to its proper object procedure do_print send file_print_on to (file_print(current_object)) end_procedure // this routes a message to its proper object procedure do_rename send file_rename_on to (file_rename(current_object)) end_procedure // this routes a message to its proper object procedure rename_it string source string destination send rename_it to (file_rename(current_object)) source destination end_procedure // this routes a message to its proper object procedure do_type send file_type_on to (file_type(current_object)) end_procedure // this routes a message to its proper object procedure type_it string source send type_it to (file_type(current_object)) source end_procedure // this routes a message to its proper object procedure do_os send run_shell to (run_stuff(current_object)) end_procedure // this terminates the menu program procedure quit move -1 to next_menu send exit_application end_procedure // Override the exit_application message and forward. procedure exit_application for DESKTOP move -1 to next_menu system end_procedure // this routes a message to its proper object procedure working_on string action string afile send working_on to (working(current_object)) action afile end_procedure // this routes a message to its proper object procedure working_off send working_off to (working(current_object)) end_procedure // this amends the supplied path with the supplied directory name // and returns the result function add_path string path string newdir returns string local integer slash colon // go to parent directory if newdir eq ".." begin // find out if there is a drive spec in the path pos ':' in path to colon // scan for backslash from right to left, but not past the colon // (if any) or past the beginning of the string length path to slash while ((slash > colon) and (mid(path,1,slash) <> Dir_Separator)) decrement slash end // if a backslash is found, then trim it and everything to the // right of it off if (slash > colon) left path to path (slash - 1) end // go to subdirectory else begin // append a backslash if needed if (right(path,1)) ne Dir_Separator append path Dir_Separator // append the subdirectory name append path newdir end // return the result to the caller function_return path end_function // this checks if a supplied DataFlex program file can be found // in dfpath function check_flx string cmdtail returns integer local string action something local integer space // trim the program name from the arguments (if any) pos ' ' in cmdtail to space if space trim (left(cmdtail,(space - 1))) to action else trim cmdtail to action // add the proper extension append action ".flx" // open it direct_input action // see if we can read from it readln something // all go if read succeeded indicate go as [not seqeof] // close it close_input // the file does not exist (the read failed) [not go] begin // make message text insert "The program file " in action at 1 // and have it displayed send spec_invalid action "could not be located!" // return failure to caller function_return 0 end // return success to caller [go] function_return 1 end_procedure // these route messages to their proper objects procedure spec_invalid string amsg string bmsg send tell_em to (invalid_spec(current_object)) amsg bmsg end_procedure procedure nothing_to_do string amsg send tell_em to (nothing_marked(current_object)) amsg end_procedure function verify_delete returns integer function_return (verify_delete(delete_confirm(current_object))) end_function procedure back_one send back_one to (menu_body(current_object)) end_procedure procedure pull_down_file send pull_down_file to (main_action_bar(current_object)) end_procedure procedure pull_down_run send pull_down_run to (main_action_bar(current_object)) end_procedure procedure pull_down_help send pull_down_help to (main_action_bar(current_object)) end_procedure end_object object dummy_console_title is a message set focus_mode to no_activate set center_state item 0 to true set value item 0 to "" set location to 1 1 absolute procedure dummy_title_on string atitle set value item 0 to atitle set focus_mode to focusable send activate end_procedure procedure dummy_title_off send deactivate set focus_mode to no_activate end_procedure end_object // this is our virtual console (see the class definition above) object dummy_console is a vconsole // make it look like a monochrome screen set object_color to 7 7 // position it within its parent (the desktop) set location to 2 1 absolute // set its size in rows and columns set size to 21 78 // this initializes the virtual console procedure dummy_on // wipe it clean send delete_data // turn it on send virtual_console // give it the focus send activate end_procedure // this terminates the virtual console procedure dummy_off // acknowledge the abort request [interrupted] show "Interrupted, " // if not aborted, then complete the last screenfull [not interrupted] while ( Hi( Position( Current_Object ))) lt 20 showln end // ready to go back show "Press Any Key To Return..." inkey termchar // give the virtual console back to the desktop send virtual_console to desktop // remove the focus send deactivate end_procedure // this writes a string, followed by a newline procedure write_one string aline // write the string showln aline // assume no user interrupt indicate interrupted false // check if screen is full if ( Hi( Position( Current_Object ))) ge 20 begin // let the user read the screen show "Press [Esc] To Stop, Other Key To Continue..." inkey aline clearscreen // did the user interrupt? indicate interrupted as [key.escape] end else begin // screen is filling // check for a user interrupt keycheck indicate interrupted as [keypress] end end_procedure end_object procedure virtual_console_on string atitle send dummy_title_on to (dummy_console_title(current_object)) atitle send dummy_on to (dummy_console(current_object)) end_procedure // this routes a message to its proper object procedure virtual_console_off send dummy_off to (dummy_console(current_object)) send dummy_title_off to (dummy_console_title(current_object)) end_procedure // this routes a message to its proper object procedure write_a_line string aline send write_one to (dummy_console(current_object)) aline end_procedure // this is where we start move (next_menu max 1) to next_menu // start the user interface at the main object start_ui main_object // clear the screen clearscreen // bye bye system