home *** CD-ROM | disk | FTP | other *** search
/ Carousel Volume 2 #1 / carousel.iso / mactosh / util / multimac.sit / MWIndex.Ras < prev    next >
Text File  |  1986-02-20  |  14KB  |  696 lines
  1.  
  2.  
  3. Program Index;
  4.  
  5. (* Index.
  6.     By Scott Gillespie @Reed College.  Program to index MacWrite 4.5
  7.        files *)
  8.  
  9. (* All of the libraries below are standard Rascal libraries *)
  10.  
  11. Uses __ToolTraps,
  12.      __OSTraps,
  13.      __EasyED,
  14. (*$U+*)
  15.      uToolIntf,
  16.      uOSIntf ;
  17.  
  18.  
  19. Link __Help, __Extendio, __Uniform, __EasyMenus,__SFNames,
  20.      __EasyED, __OSTraps, __Extras, __IO ;
  21.  
  22. EventMask  362; (*2+8+32+64+256 mdown, kdown, auto, update, activate *)
  23.  
  24. Const
  25.   DocMenu = 1000;
  26.   IndexMenu = 1001;
  27.   WordsMenu = 1002;
  28.  
  29.   RasEditId = 302;
  30.   RasRunID = 301;
  31.   RasRunItem = 1;
  32.  
  33.   RunID = IndexMenu;
  34.   RunItem = 9;
  35.  
  36.   dbReturn  = 1;
  37.   dbWord    = 2;
  38.   dbChapter = 3;
  39.   dbPage    = 4;
  40.   dbInc     = 5;
  41.   dbDec     = 6;
  42.   dbAdd     = 7;
  43.   dbBackUp  = 8;
  44.  
  45.   SelectNum = $13D;
  46.   KeyNum = $13E;
  47.  
  48.  
  49. Type
  50.   FileName = Byte[64];
  51.   pFileName = ^FileName;
  52.  
  53. Var
  54.   Speaking: Boolean;
  55.   DontHave: Boolean;
  56.   CurrentPara,Vref: Integer;
  57.     LastNib: byte;
  58.     NextAsc,
  59.     NeedNib: Boolean;
  60.   SHand: ^StringPtr;
  61.   TE: TEHandle;
  62.   TEChars: CharsHandle;
  63.   TEWind: WindowPtr;
  64.   MyLog: DialogPtr;
  65.   LastEntry: Str255;
  66.   LastWord: Str255;
  67.  
  68.   fInd,vrefInd: Integer;
  69.   nameInd: Str255;
  70.  
  71.   CurPnum: Integer;
  72.   AbsPageNum: Boolean;
  73.  
  74.   DocName: FileName;
  75.  
  76.   SelectTrap,
  77.   KeyTrap: PtrL;
  78.  
  79. ExtDef  (* variables stolen from Easymenus *)
  80.     MaxMenus,
  81.     NumMenus: Integer;
  82.     MenuIDs: Integer[10];
  83.  
  84.   (* The next few procedures comprise a sneaky way of getting Run... into
  85.      my Index menu.  It's a long story... *)
  86.  
  87. Function DoRemap(L: Longint): Longint;
  88. Var
  89.   Id,Item: Integer;
  90. {
  91.   Id := HiWord(L);
  92.   Item := LoWord(L);
  93.   If (ID = RunID) and (Item = RunItem) Then
  94.     L := (Longint(RasRunID)<<16) or RasRunItem;
  95.   DoRemap := L; 
  96. };
  97.  
  98. Function MyMenuSelect(StartPt: Longint): Longint; Clean;
  99. Var
  100.   TLong: Longint;
  101. {
  102.   RegCall(Call SelectTrap,,,,Result TLong, StartPt);
  103.   Return(DoRemap(TLong));
  104. };
  105.  
  106. Function MyMenuKey(theKey: Integer): Longint; Clean;
  107. Var
  108.   TLong: Longint;
  109. {
  110.   RegCall(Call KeyTrap,,,,Result TLong, theKey);
  111.   Return(DoRemap(TLong));
  112. };
  113.  
  114. Proc InitRunMenuTrick();
  115. {
  116.   SelectTrap := GetTrapAddress(SelectNum);
  117.   KeyTrap := GetTrapAddress(KeyNum);
  118.  
  119.   SetTrapAddress(@MyMenuSelect,SelectNum);
  120.   SetTrapAddress(@MyMenuKey,KeyNum);
  121. };
  122.  
  123. Proc HaltRunMenuTrick();
  124. {
  125.   SetTrapAddress(SelectTrap,SelectNum);
  126.   SetTrapAddress(KeyTrap,KeyNum);
  127. };
  128.  
  129. PROCEDURE hider();  
  130. var w: ptrL;
  131. {                             (* Hides all but the front window *)
  132.  w := FrontWindow();
  133.  w += $90;
  134.  loop(w^,w:=w^,w+=$90;w:=w^,w=0)
  135.    HideWindow(w);   
  136. };
  137.  
  138.  
  139.     (* The following procedures are taken almost verbatim from
  140.        ReadMacWrite.src, posted a while ago *)
  141.  
  142. Func IsBit(b: byte; bitnum:integer): Boolean; { Return((b>>bitnum) and 1)
  143. };
  144. Proc ffread(f: integer; buf: ptrb; amt: longint); { fread(f,buf,@amt) };
  145.  
  146. Function Decompress(b: byte): Integer;
  147. {
  148.   if neednib Then {
  149.     neednib := False;
  150.     Decompress := (LastNib or b);
  151.     }
  152.   Else
  153.     if nextasc Then {
  154.       nextasc := False;
  155.       neednib := True;
  156.       LastNib := b << 4;
  157.       Decompress := -1;
  158.       }
  159.   Else
  160.     if b=15 Then {
  161.       nextasc := True;
  162.       Decompress := -1;
  163.       }
  164.   Else
  165.     Return(ptrb(++b + " etnroaisdlhcfp")^);
  166. };
  167.  
  168. Procedure Addchar(c: integer);
  169. Var
  170.   size: longint;
  171. {
  172.   size := GethandleSize(TEChars);
  173.   SethandleSize(TEChars,size+1);
  174.   TEChars^^[Size] := c;
  175. };
  176.  
  177. Proc FileDone(); { Sysbeep(5) };
  178.  
  179. Proc Flush();
  180. var
  181.   io: integer;
  182. {
  183.   io := FlushVol(Nil,VrefInd);
  184. };
  185.  
  186. Func NextScreen(StartPara: Integer): Integer;
  187. Const
  188.   MaxChars = 10000;
  189. Type
  190.   IArray = Record
  191.     height: integer;
  192.     pagepos: integer;
  193.     ParaHand: Union
  194.         pagenum: byte;
  195.         Hand: ^^Longint;
  196.     End;
  197.     StPos: Union
  198.        St: byte;  (* first byte is status *)
  199.        Pos: longint;
  200.     End;
  201.     DataLength: integer;
  202.     formats: Integer;
  203.   End;
  204.  
  205. Var
  206.     GotOne: Boolean;
  207.     StartPNum,
  208.     LastPNum: Integer;
  209.     Buf: ^Byte[20];
  210.     press: Boolean;
  211.     off: Longint;
  212.     infohand: ^^Iarray[20];
  213.     f, count,i,c,j,d,k,len: integer;
  214.     DocVars: Record
  215.        IApos: Longint;
  216.        IAlength: Integer;
  217.        End;
  218. {
  219.  
  220.   If StartPara < 0 Then Return(-1);
  221.  
  222.   GotOne := False;
  223.   Buf := NewPtr(0L);
  224.   New_Ed(DocName);
  225.   watch();
  226.  
  227.   fopen(@f,DocName,0,vref);
  228.   If absPageNum Then {
  229.     fmoveto(f,16L);
  230.     ffread(f,@StartPNum,2L);
  231.     };
  232.  
  233.   fmoveto(f,252L);           (* Main Document info *)
  234.   fmove(f,12L);
  235.   ffread(f,DocVars,6L);
  236.  
  237.   InfoHand := NewHandle(Longint(DocVars.IALength));
  238.   fmoveto(f,DocVars.IAPos);  (* Paragraph Array *)
  239.   Hlock(InfoHand);
  240.   ffread(f,InfoHand^,Longint(DocVars.IALength));
  241.   Hunlock(InfoHand);
  242.   Count := DocVars.IALength/16;
  243.   loop(count,i:=StartPara,,++i=count) {
  244.     Off := InfoHand^^[i].stpos.pos and $00FFFFFF;  (* clear status byte
  245. *)
  246.     press := isbit(InfoHand^^[i].stpos.st,3);
  247.     If (!Gotone and absPageNum) Then
  248.       CurPNum := InfoHand^^[i].ParaHand.PageNum;
  249.     If InfoHand^^[i].ParaHand.PageNum > CurPNum Then
  250.        Break;
  251.     GotOne := True;
  252.     LastPNum := InfoHand^^[i].ParaHand.PageNum;
  253.     fMoveTo(f,off);
  254.     if InfoHand^^[i].height <= 0 Then Continue; (* not text *)
  255.     fgetint(f,@len);
  256.  
  257.     If (GetHandleSize(TEChars)+len) > MaxChars Then
  258.       If i<>StartPara Then
  259.         Break;
  260.  
  261.     SetPtrSize(buf,longint(len));
  262.     ffread(f,buf,longint(len));
  263.     If !press Then
  264.         loop(len,j:=0,,++j=len)
  265.            Addchar(Integer(buf^[j]))
  266.       Else
  267.         loop(len,NextAsc:=False;NeedNib:=False;j:=0;k:=0,++k,) {
  268.           d := Decompress(buf^[k] >> 4);
  269.           If d > 0 then {
  270.             Addchar(d);
  271.             If ++j>=len then break;
  272.             };
  273.           d := Decompress(buf^[k] and Byte($0F));
  274.           If d > 0 then {
  275.             Addchar(d);
  276.             If ++j>=len then break;
  277.             };
  278.           };
  279.     };
  280.  
  281.   If !absPageNum Then {
  282.     ++CurPNum;
  283.     ChangePage(1);
  284.     }
  285.   Else
  286.     SetPage(LastPNum+StartPNum);
  287.  
  288.  
  289.   If i=count Then
  290.     NextScreen := -1
  291.    Else
  292.     NextScreen := i;
  293.  
  294.   Disposptr(Buf);
  295.   Disposhandle(infohand);
  296.   fclose(f);
  297.   Flush();
  298.   TECalText(TE);
  299.   adjust_ed();
  300.   arrow();
  301. };
  302.  
  303. Proc NewFile();
  304. Var
  305.     good : Integer;
  306.     np: ptrb;
  307. {
  308.   ngetfile(100,70,@np," WORD"+2,1,@vref,@good);
  309.   if !good then return;
  310.   DocName := pFileName(np)^;
  311.   CurPNum := 0;
  312.   CurrentPara := NextScreen(0);
  313.   If CurrentPara = -1 Then
  314.     FileDone();
  315. };
  316.  
  317. Func ItemHandle(Item: Integer): Handle;
  318. Var
  319.   R: Rect;
  320.   aType: Integer;
  321.   THand: Handle;
  322. {
  323.   GetDItem(MyLog,Item,@atype,@THand,@R);
  324.   Return(THand);
  325. };
  326.  
  327. Proc FlashIt(Item: Integer);
  328. Var
  329.   C: Controlhandle;
  330.   T: Longint;
  331. {
  332.   C := ItemHandle(Item);
  333.   HiliteControl(C,1);
  334.   Loop(,T:=TickCount()+12,,TickCount()>T);
  335.   HiliteControl(C,0);
  336. };
  337.  
  338. Proc ShowWord(s,f: integer);
  339. Var
  340.   TextHand: Handle;
  341.   NewWord: Str255;
  342.   i: integer;
  343. {
  344.   If ((f=s) or ((f-s)>255)) then Return;
  345.   TextHand := ItemHandle(dbWord);
  346.   NewWord[0]:= f-s;
  347.   Loop(,i:=s,,++i>f)
  348.     NewWord[i-s+1] := TEChars^^[i];
  349.   SetIText(TextHand,NewWord);
  350.   SelIText(MyLog,dbWord,0,30000);
  351. };
  352.  
  353. Procedure SetPage(i: integer);
  354. Var
  355.  PHand: Handle;
  356.  Str: Str255;
  357.  Num: Longint;
  358. {
  359.   PHand := ItemHandle(dbPage);
  360.   Num := i;
  361.   NumToString(Num,Str);
  362.   SetIText(pHand,Str);
  363. };
  364.  
  365. Procedure ChangePage(amt: integer);
  366. Var
  367.  PHand: Handle;
  368.  Str: Str255;
  369.  Num: Longint;
  370. {
  371.   PHand := ItemHandle(dbPage);
  372.   GetIText(pHand,@Str);
  373.   StringToNum(Str,@Num);
  374.   Num += amt;
  375.   NumToString(Num,Str);
  376.   SetIText(pHand,Str);
  377. };
  378.  
  379. Procedure MyCat(s1,s2: Str255);
  380. Var
  381.   i: integer;
  382. {
  383.   If (s1[0] + s2[0]) > 254 Then Return;
  384.   Loop(s2[0],i:=s2[0],,!--i)
  385.     s1[s1[0]+i] := s2[i];
  386.   s1[0]+=s2[0];
  387. };
  388.  
  389. Proc PutWord(Word: Str255);
  390. Var
  391.   err: integer;
  392. {
  393.   If DontHave Then Return;
  394.   fputs(FInd,Word);
  395.   fputc(FInd,13);
  396.   ferr(@err);
  397.   if err Then {sysbeep(2);sysbeep(2);sysbeep(2);sysbeep(2);};
  398. };
  399.  
  400. Procedure AddEntry();
  401. Var
  402.   Str: Str255;
  403.   tHand: Handle;
  404. {
  405.   tHand := ItemHandle(dbWord);
  406.   GetIText(tHand,@str);
  407.   if !str[0] Then Return;
  408.   if LastEntry[0] Then
  409.     PutWord(LastEntry);
  410.   LastEntry := Str;
  411.   LastWord := Str;
  412.   If Speaking Then sysbeep(1);
  413.   tHand := ItemHandle(dbChapter);
  414.   GetIText(tHand,@str);
  415.   MyCat(LastEntry," ");
  416.   MyCat(LastEntry,Str);
  417.   tHand := ItemHandle(dbPage);
  418.   GetIText(tHand,@str);
  419.   MyCat(LastEntry,Str);
  420. };
  421.  
  422. Procedure RemoveLast();
  423. Var
  424.   THand: Handle;
  425.   Str: Str255;
  426. {
  427.   If !LastEntry[0] Then { Sysbeep(2); Return };
  428.   LastEntry[0]:=0;
  429.   THand := ItemHandle(dbWord);
  430.   SetIText(THand,LastWord);
  431.   SelIText(Mylog,dbWord,0,30000);
  432. };
  433.  
  434. Procedure HandleDlog(item: integer);
  435. {
  436.   Case Item of
  437.     dbInc: ChangePage(1);
  438.     dbDec: ChangePage(-1);
  439.     dbAdd: AddEntry();
  440.     dbBackUp: RemoveLast();
  441.   End;
  442. };
  443.  
  444. Proc CloseIndex();
  445. {
  446.   If DontHave Then
  447.     Return;
  448.   if LastEntry[0] Then
  449.     PutWord(LastEntry);
  450.   FClose(fInd);
  451.   Flush();
  452.   HideWindow(MyLog);
  453. };
  454.  
  455. Proc NewIndex(nameptr:ptrb;vref:integer);
  456. Var
  457.   Good: Integer;
  458. {
  459.   Good := 1;
  460.  
  461.   If !nameptr Then
  462.     PutFile(@nameptr,@vref,@good);
  463.  
  464.   If !good Then Return;
  465.   CloseIndex();
  466.   DontHave := False;
  467.   fcreate(nameptr," rIND"+2," TEXT"+2,vref);
  468.   fopen(@fInd,nameptr,3,vref);
  469.   VrefInd := vref;
  470.   SetWTitle(MyLog,nameptr);
  471.   fseek(fInd,0L,2);
  472.   ShowWindow(MyLog);
  473. };
  474.  
  475. Proc OpenIndex();
  476. Var
  477.  nameptr: ptrb;
  478.  vref,good: integer;
  479. {
  480.   GetFile(@nameptr,@vref,@good);
  481.   If !good then
  482.     Return;
  483.   NewIndex(nameptr,vref);
  484. };
  485.  
  486. Proc SaveIndex();
  487. Var
  488.   io: Integer;
  489. {
  490.     if LastEntry[0] Then PutWord(LastEntry);
  491.     Flush();
  492. };  
  493.  
  494. Proc InitMyMenus();
  495. Var m: ptrl;
  496. {
  497.   m := NewMenu(IndexMenu,"Index");
  498.   InsertMenu(m,RasEditID);
  499.   MenuIds[0] := IndexMenu;
  500.   ++Nummenus;
  501.  
  502.   AddItem(IndexMenu, "New...");
  503.   AddItem(IndexMenu, "Open...");
  504.   AddItem(IndexMenu, "Save");
  505.   AddItem(IndexMenu, "Close");
  506.   AddItem(IndexMenu, "(-");
  507.   AddItem(IndexMenu, "Feedback");
  508.   AddItem(IndexMenu, "(-");
  509.   AddItem(IndexMenu, "Help");
  510.   AddItem(IndexMenu, "Run...");
  511.   AddItem(IndexMenu, "Quit");
  512.  
  513.   AddMenu(DocMenu, "Document");
  514.   AddItem(DocMenu, "Open.../O");
  515.   AddItem(DocMenu, "(-");
  516.   AddItem(DocMenu, "Next Page/N");
  517.   AddItem(DocMenu, "Go To First Page/G");
  518.   AddItem(DocMenu, "(-");
  519.   AddItem(DocMenu, "Up/Q");
  520.   AddItem(DocMenu, "Down/W");
  521.   AddItem(DocMenu, "(-");
  522.   AddItem(DocMenu, "True Numbering");
  523.  
  524.   AddMenu(WordsMenu, "Words");
  525.   AddItem(WordsMenu, "Add Word/A");
  526.   AddItem(WordsMenu, "Back Up/B");
  527. };
  528.  
  529.  
  530. Proc _Init();
  531. Var
  532.   TheInfo: AppFile;
  533.   message,count: Integer;
  534. {
  535.   CurPNum := 0;
  536.   AbsPageNum := False;
  537.  
  538.   Speaking := False;
  539.   DontHave := True;
  540.   InitEasyMenus();
  541.   InitMyMenus();
  542.   Init_ED("Untitled",3,12,5,41,506,238);
  543.   hider();
  544.   TE := Get_EDHandle();
  545.   TEChars :=  Get_EDChars();
  546.   TEWind := Get_EDWindow();
  547.  
  548.   MyLog := GetNewDialog(1000,Nil,-1L);
  549.   CurrentPara := -1;
  550.  
  551.   LastEntry[0] := 0;
  552.   InitRunMenuTrick();
  553.   CountAppFiles(@message,@count);
  554.   if !count or (message = AppPrint) Then return;
  555.   GetAppFiles(1,theInfo);
  556.   if EqualString("index.help",theInfo.fname,false,True) Then {
  557.     Help(theInfo.fname,0);
  558.     Return;
  559.     };
  560.   NewIndex(theInfo.fname,theInfo.vrefNum);
  561. };
  562.  
  563. Proc _Menu(id,item: integer);
  564. {
  565.   Case id of
  566.     DocMenu:
  567.       Case item of
  568.         1: NewFile();
  569.         3:{ CurrentPara := NextScreen(CurrentPara);
  570.             If CurrentPara = -1 Then
  571.               FileDone();
  572.             };
  573.         4:{ ChangePage(-CurPNum);
  574.             CurPNum := 0;
  575.             CurrentPara := NextScreen(0);
  576.             If CurrentPara = -1 Then
  577.               FileDone();
  578.            };
  579.         6: EDPage(-1);
  580.         7: EDPage(1);
  581.         9: {
  582.           absPageNum := !absPageNum;
  583.           CheckEasy(ID,Item,absPageNum);
  584.           };
  585.       End;
  586.  
  587.     IndexMenu:
  588.       Case item of
  589.         1: NewIndex(Nil,0);
  590.         2: OpenIndex();
  591.         3: SaveIndex();
  592.         4: CloseIndex();
  593.         5:;
  594.         6:   {
  595.                Speaking := !Speaking;
  596.                CheckEasy(IndexMenu,item,Speaking);
  597.              };
  598.         7:;
  599.         8: Help("Index.Help",0);
  600.         9: (* Run... *) ;
  601.         10: ReqHalt();
  602.       End;
  603.  
  604.     WordsMenu:
  605.       Case item of
  606.         1: { AddEntry(); FlashIt(dbAdd) };
  607.         2: { RemoveLast(); FlashIt(dbBackUp) };
  608.         3: { ChangePage(1); FlashIt(dbInc) };
  609.         4: { ChangePage(-1); FlashIt(dbDec) };
  610.       End;
  611.   End;
  612. };
  613.  
  614. Proc _Halt();
  615. {
  616.   HaltRunMenuTrick();
  617.   DisposDialog(MyLog);
  618.   HaltEasyMenus();
  619.   Halt_ED();
  620.   PutWord(LastEntry);
  621.   fclose(FInd);
  622.   Flush();
  623. };
  624.  
  625. procedure _event(Event: EventRecord);
  626. Const
  627.     Comkey      = 256;
  628. Var
  629.   Men: Longint;
  630.   WhichWindow: WindowPtr;
  631.   WhichDlog: DialogPtr;
  632.   item,start,finish: integer;
  633.   TEHit,
  634.   DontLog: Boolean;
  635.  
  636. {
  637.  
  638.   TEHit := False;
  639.   DontLog := False;
  640.  
  641.   If Event.What = MouseDown Then
  642.     If FindWindow(Event.Where.vh,@WhichWindow) > 2 Then
  643.       Begin
  644.         SelectWindow(WhichWindow);
  645.         If (WhichWindow = TEWind) Then
  646.           TEHit := True;
  647.       End;
  648.  
  649.   If Event.What = KeyDown Then
  650.     If (Event.Modifiers and ComKey) Then
  651.       DontLog := True
  652.     Else
  653.       If ((Event.Message % 128) = 13) Then
  654.         If FrontWindow() = MyLog Then {
  655.           HandleDlog(dbAdd);
  656.           Flashit(dbAdd);
  657.           SelIText(MyLog,dbWord,0,30000);
  658.           Event.What := -1;
  659.           Return;
  660.           };
  661.  
  662.   If (IsDialogEvent(Event) and !DontLog) Then {
  663.     If DialogSelect(Event,@Whichdlog,@item) Then
  664.       HandleDlog(item);
  665.     Event.What := -1;
  666.     Return;
  667.     };
  668.  
  669.   Event_ED(Event);
  670.  
  671.   Case Event.What of
  672.     KeyDown:
  673.         If (Event.Modifiers and ComKey) then {
  674.             Men := MenuKey(Integer(Event.Message%256));
  675.             If Hiword(Men) < 1000 Then Return;
  676.             HiliteMenu(Hiword(Men));
  677.             _Menu(Hiword(Men),LoWord(Men));
  678.             HiliteMenu(0);
  679.             Event.What := -1;
  680.             };
  681.   End;
  682.  
  683.   If TEHit Then
  684.     Begin
  685.       Get_EDSelect(@start,@finish);
  686.       If start<>finish Then
  687.         ShowWord(start,finish);
  688.     End;
  689.  };
  690.  
  691.  
  692. procedure _main();
  693. {
  694.   Main_ED();
  695. };
  696.