maclab@reed.UUCP (Mac DLab) (02/14/86)
Below is the Rascal source for Index, a MacWrite Indexing program (application and help file posted earlier). Scott Gillespie Reed College -------------------------------------------------------------- Program Index; (* Index. By Scott Gillespie @Reed College. Program to index MacWrite 4.5 files *) (* All of the libraries below are standard Rascal libraries *) Uses __ToolTraps, __OSTraps, __EasyED, (*$U+*) uToolIntf, uOSIntf ; Link __Help, __Extendio, __Uniform, __EasyMenus,__SFNames, __EasyED, __OSTraps, __Extras, __IO ; EventMask 362; (*2+8+32+64+256 mdown, kdown, auto, update, activate *) Const DocMenu = 1000; IndexMenu = 1001; WordsMenu = 1002; RasEditId = 302; RasRunID = 301; RasRunItem = 1; RunID = IndexMenu; RunItem = 9; dbReturn = 1; dbWord = 2; dbChapter = 3; dbPage = 4; dbInc = 5; dbDec = 6; dbAdd = 7; dbBackUp = 8; SelectNum = $13D; KeyNum = $13E; Type FileName = Byte[64]; pFileName = ^FileName; Var Speaking: Boolean; DontHave: Boolean; CurrentPara,Vref: Integer; LastNib: byte; NextAsc, NeedNib: Boolean; SHand: ^StringPtr; TE: TEHandle; TEChars: CharsHandle; TEWind: WindowPtr; MyLog: DialogPtr; LastEntry: Str255; LastWord: Str255; fInd,vrefInd: Integer; nameInd: Str255; CurPnum: Integer; AbsPageNum: Boolean; DocName: FileName; SelectTrap, KeyTrap: PtrL; ExtDef (* variables stolen from Easymenus *) MaxMenus, NumMenus: Integer; MenuIDs: Integer[10]; (* The next few procedures comprise a sneaky way of getting Run... into my Index menu. It's a long story... *) Function DoRemap(L: Longint): Longint; Var Id,Item: Integer; { Id := HiWord(L); Item := LoWord(L); If (ID = RunID) and (Item = RunItem) Then L := (Longint(RasRunID)<<16) or RasRunItem; DoRemap := L; }; Function MyMenuSelect(StartPt: Longint): Longint; Clean; Var TLong: Longint; { RegCall(Call SelectTrap,,,,Result TLong, StartPt); Return(DoRemap(TLong)); }; Function MyMenuKey(theKey: Integer): Longint; Clean; Var TLong: Longint; { RegCall(Call KeyTrap,,,,Result TLong, theKey); Return(DoRemap(TLong)); }; Proc InitRunMenuTrick(); { SelectTrap := GetTrapAddress(SelectNum); KeyTrap := GetTrapAddress(KeyNum); SetTrapAddress(@MyMenuSelect,SelectNum); SetTrapAddress(@MyMenuKey,KeyNum); }; Proc HaltRunMenuTrick(); { SetTrapAddress(SelectTrap,SelectNum); SetTrapAddress(KeyTrap,KeyNum); }; PROCEDURE hider(); var w: ptrL; { (* Hides all but the front window *) w := FrontWindow(); w += $90; loop(w^,w:=w^,w+=$90;w:=w^,w=0) HideWindow(w); }; (* The following procedures are taken almost verbatim from ReadMacWrite.src, posted a while ago *) Func IsBit(b: byte; bitnum:integer): Boolean; { Return((b>>bitnum) and 1) }; Proc ffread(f: integer; buf: ptrb; amt: longint); { fread(f,buf,@amt) }; Function Decompress(b: byte): Integer; { if neednib Then { neednib := False; Decompress := (LastNib or b); } Else if nextasc Then { nextasc := False; neednib := True; LastNib := b << 4; Decompress := -1; } Else if b=15 Then { nextasc := True; Decompress := -1; } Else Return(ptrb(++b + " etnroaisdlhcfp")^); }; Procedure Addchar(c: integer); Var size: longint; { size := GethandleSize(TEChars); SethandleSize(TEChars,size+1); TEChars^^[Size] := c; }; Proc FileDone(); { Sysbeep(5) }; Proc Flush(); var io: integer; { io := FlushVol(Nil,VrefInd); }; Func NextScreen(StartPara: Integer): Integer; Const MaxChars = 10000; Type IArray = Record height: integer; pagepos: integer; ParaHand: Union pagenum: byte; Hand: ^^Longint; End; StPos: Union St: byte; (* first byte is status *) Pos: longint; End; DataLength: integer; formats: Integer; End; Var GotOne: Boolean; StartPNum, LastPNum: Integer; Buf: ^Byte[20]; press: Boolean; off: Longint; infohand: ^^Iarray[20]; f, count,i,c,j,d,k,len: integer; DocVars: Record IApos: Longint; IAlength: Integer; End; { If StartPara < 0 Then Return(-1); GotOne := False; Buf := NewPtr(0L); New_Ed(DocName); watch(); fopen(@f,DocName,0,vref); If absPageNum Then { fmoveto(f,16L); ffread(f,@StartPNum,2L); }; fmoveto(f,252L); (* Main Document info *) fmove(f,12L); ffread(f,DocVars,6L); InfoHand := NewHandle(Longint(DocVars.IALength)); fmoveto(f,DocVars.IAPos); (* Paragraph Array *) Hlock(InfoHand); ffread(f,InfoHand^,Longint(DocVars.IALength)); Hunlock(InfoHand); Count := DocVars.IALength/16; loop(count,i:=StartPara,,++i=count) { Off := InfoHand^^[i].stpos.pos and $00FFFFFF; (* clear status byte *) press := isbit(InfoHand^^[i].stpos.st,3); If (!Gotone and absPageNum) Then CurPNum := InfoHand^^[i].ParaHand.PageNum; If InfoHand^^[i].ParaHand.PageNum > CurPNum Then Break; GotOne := True; LastPNum := InfoHand^^[i].ParaHand.PageNum; fMoveTo(f,off); if InfoHand^^[i].height <= 0 Then Continue; (* not text *) fgetint(f,@len); If (GetHandleSize(TEChars)+len) > MaxChars Then If i<>StartPara Then Break; SetPtrSize(buf,longint(len)); ffread(f,buf,longint(len)); If !press Then loop(len,j:=0,,++j=len) Addchar(Integer(buf^[j])) Else loop(len,NextAsc:=False;NeedNib:=False;j:=0;k:=0,++k,) { d := Decompress(buf^[k] >> 4); If d > 0 then { Addchar(d); If ++j>=len then break; }; d := Decompress(buf^[k] and Byte($0F)); If d > 0 then { Addchar(d); If ++j>=len then break; }; }; }; If !absPageNum Then { ++CurPNum; ChangePage(1); } Else SetPage(LastPNum+StartPNum); If i=count Then NextScreen := -1 Else NextScreen := i; Disposptr(Buf); Disposhandle(infohand); fclose(f); Flush(); TECalText(TE); adjust_ed(); arrow(); }; Proc NewFile(); Var good : Integer; np: ptrb; { ngetfile(100,70,@np," WORD"+2,1,@vref,@good); if !good then return; DocName := pFileName(np)^; CurPNum := 0; CurrentPara := NextScreen(0); If CurrentPara = -1 Then FileDone(); }; Func ItemHandle(Item: Integer): Handle; Var R: Rect; aType: Integer; THand: Handle; { GetDItem(MyLog,Item,@atype,@THand,@R); Return(THand); }; Proc FlashIt(Item: Integer); Var C: Controlhandle; T: Longint; { C := ItemHandle(Item); HiliteControl(C,1); Loop(,T:=TickCount()+12,,TickCount()>T); HiliteControl(C,0); }; Proc ShowWord(s,f: integer); Var TextHand: Handle; NewWord: Str255; i: integer; { If ((f=s) or ((f-s)>255)) then Return; TextHand := ItemHandle(dbWord); NewWord[0]:= f-s; Loop(,i:=s,,++i>f) NewWord[i-s+1] := TEChars^^[i]; SetIText(TextHand,NewWord); SelIText(MyLog,dbWord,0,30000); }; Procedure SetPage(i: integer); Var PHand: Handle; Str: Str255; Num: Longint; { PHand := ItemHandle(dbPage); Num := i; NumToString(Num,Str); SetIText(pHand,Str); }; Procedure ChangePage(amt: integer); Var PHand: Handle; Str: Str255; Num: Longint; { PHand := ItemHandle(dbPage); GetIText(pHand,@Str); StringToNum(Str,@Num); Num += amt; NumToString(Num,Str); SetIText(pHand,Str); }; Procedure MyCat(s1,s2: Str255); Var i: integer; { If (s1[0] + s2[0]) > 254 Then Return; Loop(s2[0],i:=s2[0],,!--i) s1[s1[0]+i] := s2[i]; s1[0]+=s2[0]; }; Proc PutWord(Word: Str255); Var err: integer; { If DontHave Then Return; fputs(FInd,Word); fputc(FInd,13); ferr(@err); if err Then {sysbeep(2);sysbeep(2);sysbeep(2);sysbeep(2);}; }; Procedure AddEntry(); Var Str: Str255; tHand: Handle; { tHand := ItemHandle(dbWord); GetIText(tHand,@str); if !str[0] Then Return; if LastEntry[0] Then PutWord(LastEntry); LastEntry := Str; LastWord := Str; If Speaking Then sysbeep(1); tHand := ItemHandle(dbChapter); GetIText(tHand,@str); MyCat(LastEntry," "); MyCat(LastEntry,Str); tHand := ItemHandle(dbPage); GetIText(tHand,@str); MyCat(LastEntry,Str); }; Procedure RemoveLast(); Var THand: Handle; Str: Str255; { If !LastEntry[0] Then { Sysbeep(2); Return }; LastEntry[0]:=0; THand := ItemHandle(dbWord); SetIText(THand,LastWord); SelIText(Mylog,dbWord,0,30000); }; Procedure HandleDlog(item: integer); { Case Item of dbInc: ChangePage(1); dbDec: ChangePage(-1); dbAdd: AddEntry(); dbBackUp: RemoveLast(); End; }; Proc CloseIndex(); { If DontHave Then Return; if LastEntry[0] Then PutWord(LastEntry); FClose(fInd); Flush(); HideWindow(MyLog); }; Proc NewIndex(nameptr:ptrb;vref:integer); Var Good: Integer; { Good := 1; If !nameptr Then PutFile(@nameptr,@vref,@good); If !good Then Return; CloseIndex(); DontHave := False; fcreate(nameptr," rIND"+2," TEXT"+2,vref); fopen(@fInd,nameptr,3,vref); VrefInd := vref; SetWTitle(MyLog,nameptr); fseek(fInd,0L,2); ShowWindow(MyLog); }; Proc OpenIndex(); Var nameptr: ptrb; vref,good: integer; { GetFile(@nameptr,@vref,@good); If !good then Return; NewIndex(nameptr,vref); }; Proc SaveIndex(); Var io: Integer; { if LastEntry[0] Then PutWord(LastEntry); Flush(); }; Proc InitMyMenus(); Var m: ptrl; { m := NewMenu(IndexMenu,"Index"); InsertMenu(m,RasEditID); MenuIds[0] := IndexMenu; ++Nummenus; AddItem(IndexMenu, "New..."); AddItem(IndexMenu, "Open..."); AddItem(IndexMenu, "Save"); AddItem(IndexMenu, "Close"); AddItem(IndexMenu, "(-"); AddItem(IndexMenu, "Feedback"); AddItem(IndexMenu, "(-"); AddItem(IndexMenu, "Help"); AddItem(IndexMenu, "Run..."); AddItem(IndexMenu, "Quit"); AddMenu(DocMenu, "Document"); AddItem(DocMenu, "Open.../O"); AddItem(DocMenu, "(-"); AddItem(DocMenu, "Next Page/N"); AddItem(DocMenu, "Go To First Page/G"); AddItem(DocMenu, "(-"); AddItem(DocMenu, "Up/Q"); AddItem(DocMenu, "Down/W"); AddItem(DocMenu, "(-"); AddItem(DocMenu, "True Numbering"); AddMenu(WordsMenu, "Words"); AddItem(WordsMenu, "Add Word/A"); AddItem(WordsMenu, "Back Up/B"); }; Proc _Init(); Var TheInfo: AppFile; message,count: Integer; { CurPNum := 0; AbsPageNum := False; Speaking := False; DontHave := True; InitEasyMenus(); InitMyMenus(); Init_ED("Untitled",3,12,5,41,506,238); hider(); TE := Get_EDHandle(); TEChars := Get_EDChars(); TEWind := Get_EDWindow(); MyLog := GetNewDialog(1000,Nil,-1L); CurrentPara := -1; LastEntry[0] := 0; InitRunMenuTrick(); CountAppFiles(@message,@count); if !count or (message = AppPrint) Then return; GetAppFiles(1,theInfo); if EqualString("index.help",theInfo.fname,false,True) Then { Help(theInfo.fname,0); Return; }; NewIndex(theInfo.fname,theInfo.vrefNum); }; Proc _Menu(id,item: integer); { Case id of DocMenu: Case item of 1: NewFile(); 3:{ CurrentPara := NextScreen(CurrentPara); If CurrentPara = -1 Then FileDone(); }; 4:{ ChangePage(-CurPNum); CurPNum := 0; CurrentPara := NextScreen(0); If CurrentPara = -1 Then FileDone(); }; 6: EDPage(-1); 7: EDPage(1); 9: { absPageNum := !absPageNum; CheckEasy(ID,Item,absPageNum); }; End; IndexMenu: Case item of 1: NewIndex(Nil,0); 2: OpenIndex(); 3: SaveIndex(); 4: CloseIndex(); 5:; 6: { Speaking := !Speaking; CheckEasy(IndexMenu,item,Speaking); }; 7:; 8: Help("Index.Help",0); 9: (* Run... *) ; 10: ReqHalt(); End; WordsMenu: Case item of 1: { AddEntry(); FlashIt(dbAdd) }; 2: { RemoveLast(); FlashIt(dbBackUp) }; 3: { ChangePage(1); FlashIt(dbInc) }; 4: { ChangePage(-1); FlashIt(dbDec) }; End; End; }; Proc _Halt(); { HaltRunMenuTrick(); DisposDialog(MyLog); HaltEasyMenus(); Halt_ED(); PutWord(LastEntry); fclose(FInd); Flush(); }; procedure _event(Event: EventRecord); Const Comkey = 256; Var Men: Longint; WhichWindow: WindowPtr; WhichDlog: DialogPtr; item,start,finish: integer; TEHit, DontLog: Boolean; { TEHit := False; DontLog := False; If Event.What = MouseDown Then If FindWindow(Event.Where.vh,@WhichWindow) > 2 Then Begin SelectWindow(WhichWindow); If (WhichWindow = TEWind) Then TEHit := True; End; If Event.What = KeyDown Then If (Event.Modifiers and ComKey) Then DontLog := True Else If ((Event.Message % 128) = 13) Then If FrontWindow() = MyLog Then { HandleDlog(dbAdd); Flashit(dbAdd); SelIText(MyLog,dbWord,0,30000); Event.What := -1; Return; }; If (IsDialogEvent(Event) and !DontLog) Then { If DialogSelect(Event,@Whichdlog,@item) Then HandleDlog(item); Event.What := -1; Return; }; Event_ED(Event); Case Event.What of KeyDown: If (Event.Modifiers and ComKey) then { Men := MenuKey(Integer(Event.Message%256)); If Hiword(Men) < 1000 Then Return; HiliteMenu(Hiword(Men)); _Menu(Hiword(Men),LoWord(Men)); HiliteMenu(0); Event.What := -1; }; End; If TEHit Then Begin Get_EDSelect(@start,@finish); If start<>finish Then ShowWord(start,finish); End; }; procedure _main(); { Main_ED(); };