\ $VER: ReplaceTool.f 2.04 (19 Jan 1992 23:34) \ Program to change the default tool of a number project icons simultaneously, \ using the Workbench and Intuition. \ Written in JForth Professional 2.0 \ \ (c) Copyright 1989, 1990, 1992 by Richard Mazzarisi \ All rights reserved. \ \ address: \ 891 Post St. #207 \ San Francisco, CA \ 94109 \ \ email: \ rich@californium.cchem.berkeley.edu \ rmazz@hydrogen.cchem.berkeley.edu \ nmr@garnet.berkeley.edu \ \ \ v. 1.00 9/2/89 \ v. 1.01 10/9/89 order of clicking icons no longer matters \ v. 2.00 2/1/90 added arp file requester if no tool clicked \ v. 2.01 3/22/90 fixed problem with final slash in drawer names from WB; if \ a drawer was selected prog does error exit \ (not a problem with JazzBench) \ 3/24/90 fixed problem similar to '/' with ':' on device icons \ 3/25/90 moved arp library openning away from startup - it is not \ needed unless no tool icon is selected; no need to \ abort if user clicks on a tool along with projects \ v. 2.02 5/15/90 fixed the tendency to crash if the arp file req returns \ a null string for the drawer \ 5/20/90 fixed the ability to find the font size and use this info \ in opening the window \ v. 2.03 1/1/92 fixed once and for all the finding of the font size \ 1/7/92 put all icontools common stuff into icontools.f \ 1/7/92 made the situatin where one clicks only on a tool a little \ more helpful in explaining why nothing happens \ 1/13/92 moved the resource management routines to IconTools.f \ put in the use of 2.04's file requester so that arp is \ not needed unless WB 1.3 is being used \ v. 2.04 1/19/92 moved window down so that requester will not obscure the \ name of the tool to be used if a large screen \ font is used \ recompiled with new IconTools.f (cf) \ \ \ Instructions: \ 1 - Click on the icon for this program. \ 2 - Shift click on the Project icons to have their \ DefaultTool changed AND the icon for the Tool to be \ set as the DefaultTool. \ 3 - <> shift click only on one or more Project icons; \ a file requester will appear allowing the DefaultTool to be selected. \ \ (NOTE: The author assumes no responsibility for any damages \ resulting from the use of this program.) INCLUDE? TASK-ICONTOOLS ICONTOOLS.F \ for arp file rquester INCLUDE? LIBRARIES_ARPBASE_H JARP:ARPBASE.J INCLUDE? TASK-ARP_SUPPORT JARP:ARP_SUPPORT \ for asl file rquester INCLUDE? LIBRARIES_ASL_H JI:LIBRARIES/ASL.J INCLUDE? TASK-ASL_SUPPORT JU:ASL_SUPPORT ANEW task-replacetool DECIMAL \ *** constants *** \ # bytes to be allocated for the path string; biggest string which can \ be returned from arp filerequester LONG_DSIZE LONG_FSIZE + 1+ CONSTANT pathsize \ *** variables *** VARIABLE toolarg \ holds the position of the Tool arg CREATE pathstr pathsize ALLOT \ holds path to be put into Icons \ *** main window stuff *** : open.rt-window ( -- window/null ) getWBscreendata it-newwindow NEWWINDOW.SETUP 45 21 set.vert-params it-newwindow ..! nw_Height it-newwindow ..! nw_TopEdge 20 56 set.horiz-params it-newwindow ..! nw_Width it-newwindow ..! nw_LeftEdge 0" ReplaceTool 2.04" >ABS it-newwindow ..! nw_Title CLOSEWINDOW it-newwindow ..! nw_IDCMPFlags WINDOWCLOSE WINDOWDRAG | WINDOWDEPTH | WINDOWSIZING | ACTIVATE | it-newwindow ..! nw_Flags it-newwindow GR.OPENCURW ; \ *** file requester stuff *** VARIABLE rt-filereq VARIABLE ASL-flg \ flag for which file requester we are using 4 CONSTANT nalloctags CREATE alloctaglist nalloctags 2* CELLS ALLOT : fill.tags ( tags1 ... tagN taglist ntags -- ) 2* CELLS OVER + SWAP DO I ! 1 CELLS +LOOP ; : hail.txt ( -- 0string ) 0" Select Tool to be used:" ; : dir.txt ( -- 0string ) 0" SYS:" ; : fr-dir ( -- 0string ) rt-filereq @ ASL-flg @ IF ..@ rf_Dir ELSE ..@ fr_Dir THEN >REL ; : fr-file ( -- 0string ) rt-filereq @ ASL-flg @ IF ..@ rf_File ELSE ..@ fr_File THEN >REL ; : open.fr-lib ( -- t/f) open.asl-lib -DUP IF ASL-flg ON ELSE ASL-flg OFF open.arp-lib DUP 0= IF " ERROR: Could not open asl or arp library!" con.write.itl con.cr con.cr prt.it-instr THEN THEN ; : alloc.fr ( -- t/f ) ASL-flg @ IF 0 TAG_END 0" ~(#?.info)" >ABS ASL_Pattern dir.txt >ABS ASL_Dir hail.txt >ABS ASL_Hail alloctaglist nalloctags fill.tags ASL_FileRequest alloctaglist AllocAslRequest() DUP rt-filereq ! ELSE ArpAllocFreq() DUP rt-filereq ! DUP 0= IF " ERROR: Could not get file requester!" con.write.itl con.cr THEN THEN ; : do.rt-filereq ( -- t/f ) rt-filereq @ ASL-flg @ IF RequestFile() ELSE hail.txt >ABS OVER ..! fr_Hail \ set default dir (make sure CMOVE's count is OK) dir.txt OVER ..@ fr_Dir >REL 5 CMOVE FileRequest() THEN 0= IF \ return is 0 => Cancel hit " Cancelled!" con.write.itl con.cr FALSE ELSE fr-file C@ 0= IF \ string empty => return key hit with \ no file selected " ERROR: No tool selected!" con.write.itl con.cr con.cr prt.it-instr FALSE ELSE TRUE THEN THEN ; : close.fr-lib ( -- ) ASL-flg @ IF rt-filereq @ FreeAslRequest() -ASL ELSE -ARP THEN ; \ *** support *** : rt.greeting ( -- ) " Replace the DefaultTool of Project Icons." con.write.itl con.cr " © Copyright by Richard Mazzarisi 1989, 1990, 1992" con.write.c3 con.cr " All rights reserved." con.write.c3 con.cr " Written in JForth Professional 2.0." con.write.c3 con.cr con.cr ; : prt.rt-instr ( -- ) " Instructions:" con.write con.cr " 1 - Click on the icon for this program." con.write con.cr " 2 - Shift click on the Project icons to have their" con.write con.cr " DefaultTool changed " con.write " and " con.write.itl " the icon for the Tool to" con.write con.cr " be set as the DefaultTool. Order is not important." con.write con.cr " 3 - " con.write " OR " con.write.itl " Shift click only on one or more Project icons;" con.write con.cr " a file requester will appear allowing the" con.write con.cr " DefaultTool to be selected." con.write con.cr con.cr " (NOTE: The author assumes no responsibility for any" con.write con.cr " damages resulting from the use of this program.)" con.write con.cr ; : check.if.tool { wb-arg -- t/f } \ check if file in wb-arg is a tool \ this will abort if fed a drawer under WB; OK however under JazzBench \ get file's path name wb-arg get.full-path IF PAD $it.get-icon theIcon @ ..@ do_Type WBTOOL = it.abort-icon ELSE " ERROR: Could not get path for:" con.write.itl wreq @ wb-arg ..@ wa_Name >REL ConPutStr() it.abort THEN ; : find.tool ( wb-arg #args -- ) \ sets toolarg to # of the first(!) Tool found; 0 if none found 0 toolarg ! \ go thru icons to find the Tool 1+ 1 DO DUP SizeOf() WBArg I * + check.if.tool IF I toolarg ! LEAVE THEN LOOP DROP ; : verify.tool-path ( -- t/f ) \ verify with user that path is OK " DefaultTool path will be: " con.write con.cr " " con.write pathstr con.write con.cr con.cr " Is the DefaultTool path OK to use?" " OK, do it!" " No, Cancel" $it.auto.request IF " Click closebox to abort." con.write con.cr con.cr TRUE ELSE " Cancelled!" con.write.itl con.cr FALSE THEN ; : do.requester ( -- t/f ) \ uses a file requester to get tool path \ returns relative pointer to filerequester structure or false alloc.fr IF do.rt-filereq ELSE FALSE THEN ; : setup.pathstr ( -- ) \ writes path and tool name from file requester into pathstr pathstr init.name \ build directory name if one given fr-dir DUP C@ 0> IF \ path is not empty 0COUNT 2DUP pathstr build.name \ make sure this not a device name 1- + C@ DUP ASCII : = NOT SWAP ASCII / = NOT AND IF \ ok to put in a '/' " /" COUNT pathstr build.name THEN ELSE DROP THEN \ now add file name fr-file 0COUNT pathstr build.name ; : request.tool-path ( -- t/f ) \ get Tool via a file requester, set up string and check with user \ (probably should check if in fact a Tool was selected, but we have no icon) open.fr-lib IF do.requester IF setup.pathstr verify.tool-path ELSE FALSE THEN close.fr-lib ELSE FALSE THEN ; : find.tool-path { wb-arg -- t/f } \ writes full path of tool into pathstr wb-arg toolarg @ SizeOf() WBArg * + get.full-path IF PAD pathstr $MOVE verify.tool-path ELSE " ERROR: Could not get path for the tool: " con.write.itl wreq @ wb-arg toolarg @ SizeOf() WBArg * + ..@ wa_Name >REL ConPutStr() con.cr FALSE THEN ; : get.tool-path ( wbarg -- t/f ) toolarg @ IF find.tool-path ELSE \ no tool specified, use requester DROP request.tool-path THEN ; : replace.it ( -- ) \ replaces the DefaultTool only if the icon represents a Project PAD $it.get-icon theIcon @ ..@ do_Type WBPROJECT = IF [ clone-it @ ] .IF pathstr $SET-DEFAULT-TOOL PAD $it.save-icon .ELSE \ don't really do it if we are testing things in the interpreter it.abort-icon .THEN ELSE " is not a project! Default tool not replaced" con.write.itl con.cr con.cr it.abort-icon THEN ; : make.one-rplcmt { wb-arg -- } \ get file's path name wb-arg get.full-path IF " " con.write PAD con.write con.cr replace.it ELSE " ERROR: Could not get path for project:" con.write.itl con.cr " " con.write wreq @ wb-arg ..@ wa_Name >REL ConPutStr() con.cr THEN ; : do.replacements ( wb-arg #args -- ) \ go thru icons of the projects to be changed \ skipping the tool " Replacing the DefaultTool for:" con.write con.cr 1+ 1 DO I toolarg @ = NOT IF DUP SizeOf() WBArg I * + make.one-rplcmt THEN \ check for stop action ?CLOSEBOX IF LEAVE THEN LOOP DROP con.cr " Done. " con.write.itl ; \ *** main *** : replacetool ( -- ) ' prt.rt-instr IS prt.it-instr ' open.rt-window IS open.it-window open.it-things cursor.off rt.greeting check.WB 2 check.num.args IF ( #args ) \ get pointer to args WBMESSAGE @ >REL ..@ sm_ArgList >REL SWAP ( wbarg #args ) 2DUP find.tool toolarg @ 0= NOT OVER 2 < AND IF " Need to click on at least one project icon!" con.write.itl con.cr con.cr prt.rt-instr 2DROP ELSE \ Ok to try to do it! OVER get.tool-path IF do.replacements ELSE 2DROP THEN THEN THEN close.it-things ; : rt replacetool ; clone-it @ .IF initclone clone replacetool save-image replacetool ReplaceTool -icon .THEN CR CR ." Type 'rt' to run." CR CR