[net.sources.mac] Index.src

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();
};