home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 2 / LSD and 17bit Compendium Deluxe - Volume II.iso / a / prog / amigae / ged-e2.0.lha / GED-E / ECOpt.e < prev    next >
Encoding:
Text File  |  1994-10-09  |  8.2 KB  |  207 lines
  1. /* Sauve les options de compilations selectionnées par l'intermédiaire    */
  2. /* d'une fenêtre gadtools dans une variable d'environnement.              */
  3.  
  4.     OPT OSVERSION=37
  5.  
  6.     MODULE 'dos/dos','dos/rdargs'
  7.     MODULE 'gadtools','libraries/gadtools'
  8.     MODULE 'intuition/intuition','intuition/screens','intuition/gadgetclass',
  9.            'intuition/intuitionbase','intuition/gadgetclass'
  10.     MODULE 'graphics/text'
  11.     MODULE 'utility/tagitem'
  12.  
  13.     ENUM OWN_ERROR=21,IO_ERROR,FIND_ERROR,MEM_ERROR,GAD
  14.  
  15.     DEF ecoptionswnd:PTR TO window,ecoptionsglist:PTR TO gadget,
  16.         scr:PTR TO screen,visual=NIL,tattr,optstr[50]:STRING,
  17.         opthandle,opt,optname1:PTR TO CHAR,
  18.         optname2:PTR TO CHAR,args:PTR TO rdargs,gad:PTR TO gadget,
  19.         g:PTR TO gadget,argarray:PTR TO LONG
  20.  
  21.     RAISE GAD IF CreateGadgetA()=NIL
  22.  
  23. /*FOLDER "main()"*/
  24. PROC main() HANDLE
  25.     openpwindow()
  26.     wait4message(ecoptionswnd)
  27.     quit(RETURN_OK,NIL)
  28. EXCEPT
  29.     SELECT exception
  30.         CASE GAD ; quit(OWN_ERROR,'CreateGadgetA()')
  31.     ENDSELECT
  32. ENDPROC
  33. /*FEND*/
  34. CHAR '$VER: ECOpt 1.010 (09 Oct 1994) © BURGHARD Eric | WANABOSO/AGOA'
  35.  
  36. /*FOLDER "openpwindow()"*/
  37. PROC openpwindow()
  38.     DEF ib:PTR TO intuitionbase,gtname:PTR TO CHAR
  39.  
  40.     ib:=intuitionbase
  41.     scr:=ib.activescreen
  42.     gtname:='gadtools.library'
  43.     IF (gadtoolsbase:=OpenLibrary(gtname,37))=NIL THEN quit(FIND_ERROR,gtname)
  44.     IF (visual:=GetVisualInfoA(scr,NIL))=NIL THEN quit(OWN_ERROR,'GetVisualInfo()')
  45.     tattr:=['topaz.font',8,0,0]:textattr
  46.     IF (g:=CreateContext({ecoptionsglist}))=NIL THEN quit(OWN_ERROR,'CreateContext()')
  47.     g:=CreateGadgetA(INTEGER_KIND,g,[143,89,99,14,'',tattr,0,0,visual,0]:newgadget,
  48.                                     [GTIN_NUMBER,0,GTIN_MAXCHARS,1,
  49.                                      NIL])
  50.     g:=CreateGadgetA(CHECKBOX_KIND,g,[19,89,26,11,'REGISTERS',tattr,1,PLACETEXT_RIGHT,visual,0]:newgadget,
  51.                                      [NIL])
  52.     g:=CreateGadgetA(CHECKBOX_KIND,g,[19,24,26,11,'IGNORE CACHE',tattr,2,PLACETEXT_RIGHT,visual,0]:newgadget,
  53.                                      [NIL])
  54.     g:=CreateGadgetA(CHECKBOX_KIND,g,[19,76,26,11,'OPTIMISATIONS',tattr,3,PLACETEXT_RIGHT,visual,0]:newgadget,
  55.                                      [NIL])
  56.     g:=CreateGadgetA(CHECKBOX_KIND,g,[19,50,26,11,'SYMBOLS',tattr,4,PLACETEXT_RIGHT,visual,0]:newgadget,
  57.                                      [NIL])
  58.     g:=CreateGadgetA(CHECKBOX_KIND,g,[19,63,26,11,'LINEDEBUG',tattr,5,PLACETEXT_RIGHT,visual,0]:newgadget,
  59.                                      [NIL])
  60.     g:=CreateGadgetA(CHECKBOX_KIND,g,[19,37,26,11,'LARGE MODEL',tattr,6,PLACETEXT_RIGHT,visual,0]:newgadget,
  61.                                      [NIL])
  62.     g:=CreateGadgetA(BUTTON_KIND,g,[12,110,77,17,'USE',tattr,7,PLACETEXT_IN,visual,0]:newgadget,
  63.                                    [NIL])
  64.     g:=CreateGadgetA(BUTTON_KIND,g,[92,110,77,17,'SAVE',tattr,8,PLACETEXT_IN,visual,0]:newgadget,
  65.                                    [NIL])
  66.     g:=CreateGadgetA(BUTTON_KIND,g,[172,110,77,17,'CANCEL',tattr,9,PLACETEXT_IN,visual,0]:newgadget,
  67.                                    [NIL])
  68.     optname1:='ENV:ECOpt'
  69.     optname2:='ENVARC:ECOpt'
  70.     IF setflg(optname1)=FALSE THEN setflg(optname2)
  71.     SetStr(optstr,0)
  72.     IF (ecoptionswnd:=OpenWindowTagList(NIL,[WA_LEFT,184,WA_TOP,48,
  73.                                              WA_WIDTH,260,WA_HEIGHT,131,
  74.                                              WA_IDCMP,(IDCMP_REFRESHWINDOW OR IDCMP_GADGETUP OR IDCMP_CLOSEWINDOW),
  75.                                              WA_FLAGS,(WFLG_DEPTHGADGET OR WFLG_CLOSEGADGET OR WFLG_DRAGBAR OR WFLG_ACTIVATE),
  76.                                              WA_TITLE,'ECompiler Options',
  77.                                              WA_CUSTOMSCREEN,scr,
  78.                                              WA_AUTOADJUST,1,
  79.                                              WA_GADGETS,ecoptionsglist,
  80.                                              NIL]))=NIL THEN quit(OWN_ERROR,'OpenWindowTagList()')
  81.     DrawBevelBoxA(ecoptionswnd.rport,12,17,237,92,[GT_VISUALINFO,visual,NIL])
  82. ENDPROC
  83. /*FEND*/
  84. /*FOLDER "setflg(name)"*/
  85. PROC setflg(name)
  86.     IF (opthandle:=Open(name,MODE_OLDFILE))
  87.         ReadStr(opthandle,optstr)
  88.         Close(opthandle) ; opthandle:=0
  89.         IF (args:=AllocDosObject(DOS_RDARGS,NIL))
  90.             args::csource.buffer:=optstr
  91.             args::csource.length:=EstrLen(optstr)
  92.             argarray:=[-1,0,0,0,0,0]:LONG
  93.             IF ReadArgs('REG/K/N,IGNORECACHE/S,OPTI/S,SYM/S,LINEDEBUG/S,LARGE/S',argarray,args)
  94.                 gad:=ecoptionsglist.nextgadget
  95.                 g:=gad.nextgadget
  96.                 Gt_SetGadgetAttrsA(g,NIL,NIL,[GTCB_CHECKED,IF argarray[0]<>-1 THEN TRUE ELSE FALSE,TAG_END])
  97.                 Gt_SetGadgetAttrsA(gad,NIL,NIL,[GA_DISABLED,IF argarray[0]<>-1 THEN FALSE ELSE TRUE,GTIN_NUMBER,IF argarray[0]<>-1 THEN Long(argarray[0]) ELSE 0,TAG_END])
  98.                 g:=g.nextgadget
  99.                 FOR opt:=1 TO 5
  100.                     Gt_SetGadgetAttrsA(g,NIL,NIL,[GTCB_CHECKED,IF argarray[opt] THEN TRUE ELSE FALSE,TAG_END])
  101.                     g:=g.nextgadget
  102.                 ENDFOR
  103.                 FreeArgs(args)
  104.             ELSE ; quit(IO_ERROR,'ECOpt')
  105.             ENDIF
  106.         ELSE ; quit(MEM_ERROR,'AllocDosObject()')
  107.         ENDIF
  108.     ELSE ; RETURN FALSE
  109.     ENDIF
  110. ENDPROC TRUE
  111.  
  112. /*FEND*/
  113. /*FOLDER "wait4message(win:PTR TO window)"*/
  114. PROC wait4message(win:PTR TO window)
  115.     DEF mes:PTR TO intuimessage,type:PTR TO gadget,gadid
  116.  
  117.     REPEAT
  118.         type:=0
  119.         IF mes:=Gt_GetIMsg(win.userport)
  120.             type:=mes.class
  121.             IF type<>IDCMP_CLOSEWINDOW
  122.                 SELECT type
  123.                     CASE IDCMP_GADGETUP
  124.                         type:=mes.iaddress
  125.                         gadid:=type.gadgetid
  126.                         SELECT gadid
  127.                             CASE 1
  128.                                 gad:=ecoptionsglist.nextgadget
  129.                                 Gt_SetGadgetAttrsA(gad,ecoptionswnd,NIL,[GA_DISABLED,IF (type.flags AND GFLG_SELECTED) THEN FALSE ELSE TRUE,TAG_END])
  130.                                 type:=0
  131.                             CASE 7
  132.                                 optfmt()
  133.                                 saveopt(optname1)
  134.                             CASE 8
  135.                                 optfmt()
  136.                                 saveopt(optname1)
  137.                                 saveopt(optname2)
  138.                             CASE 9 ; NOP
  139.                             DEFAULT ; type:=0
  140.                         ENDSELECT
  141.                     CASE IDCMP_REFRESHWINDOW
  142.                         Gt_BeginRefresh(win)
  143.                         Gt_EndRefresh(win,TRUE)
  144.                         type:=0
  145.                 ENDSELECT
  146.             ENDIF
  147.             Gt_ReplyIMsg(mes)
  148.         ELSE ; WaitPort(win.userport)
  149.         ENDIF
  150.     UNTIL type
  151. ENDPROC type
  152. /*FEND*/
  153. /*FOLDER "optfmt()"*/
  154. PROC optfmt()
  155.     DEF tmpstr[15]:STRING,sinfo:PTR TO stringinfo
  156.  
  157.     gad:=ecoptionsglist.nextgadget
  158.     sinfo:=gad.specialinfo
  159.     gad:=gad.nextgadget
  160.     FOR opt:=0 TO 5
  161.         IF (gad.flags AND GFLG_SELECTED)
  162.             StringF(tmpstr,ListItem(['REG \d ','IGNORECACHE ','OPTI ','SYM ','LINEDEBUG ','LARGE ']:LONG,opt),sinfo.longint)
  163.             StrAdd(optstr,tmpstr,ALL)
  164.         ENDIF
  165.         gad:=gad.nextgadget
  166.     ENDFOR
  167. ENDPROC
  168.  
  169. /*FEND*/
  170. /*FOLDER "saveopt(name)"*/
  171. PROC saveopt(name)
  172.     IF (opthandle:=Open(name,MODE_NEWFILE))
  173.         IF Fputs(opthandle,optstr) THEN quit(IO_ERROR,name)
  174.         Close(opthandle) ; opthandle:=0
  175.     ENDIF
  176. ENDPROC
  177.  
  178. /*FEND*/
  179. /*FOLDER "quit(err,obj)"*/
  180. PROC quit(err,obj)
  181.     DEF flt=0
  182.  
  183.     IF err<>RETURN_OK
  184.         IF err<>OWN_ERROR
  185.             SELECT err
  186.                 CASE IO_ERROR  ; flt:=IoErr()
  187.                 CASE MEM_ERROR ; flt:=ERROR_NO_FREE_STORE
  188.                 CASE FIND_ERROR; flt:=ERROR_OBJECT_NOT_FOUND
  189.             ENDSELECT
  190.             err:=RETURN_ERROR
  191.             PrintFault(flt,obj)
  192.         ELSE
  193.             WriteF('Error with \s\n',obj)
  194.             err:=RETURN_ERROR
  195.         ENDIF
  196.     ENDIF
  197.     IF args THEN FreeDosObject(DOS_RDARGS,args)
  198.     IF opthandle THEN Close(opthandle)
  199.     IF visual THEN FreeVisualInfo(visual)
  200.     IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  201.     IF ecoptionswnd THEN CloseWindow(ecoptionswnd)
  202.     IF ecoptionsglist THEN FreeGadgets(ecoptionsglist)
  203.     CleanUp(err)
  204. ENDPROC
  205. /*FEND*/
  206.  
  207.