home *** CD-ROM | disk | FTP | other *** search
- 18-Jun-88 14:35:08-MDT,14844;000000000000
- Return-Path: <u-lchoqu%sunset@cs.utah.edu>
- Received: from cs.utah.edu by SIMTEL20.ARPA with TCP; Sat, 18 Jun 88 14:34:42 MDT
- Received: by cs.utah.edu (5.54/utah-2.0-cs)
- id AA22392; Sat, 18 Jun 88 14:34:36 MDT
- Received: by sunset.utah.edu (5.54/utah-2.0-leaf)
- id AA24679; Sat, 18 Jun 88 14:34:33 MDT
- Date: Sat, 18 Jun 88 14:34:33 MDT
- From: u-lchoqu%sunset@cs.utah.edu (Lee Choquette)
- Message-Id: <8806182034.AA24679@sunset.utah.edu>
- To: rthum@simtel20.arpa
- Subject: MWIndex.Ras
-
-
-
- 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();
- };
-