path: root/system/multiuser/1.7.5/src/nameset

(* ------------------- VERSION 3     17.03.86 ------------------- *)
PACKET name set DEFINES                       (* Autor: J.Liedtke *)
 
       ALL ,
       SOME ,
       LIKE ,
       + ,
       - ,
       / ,
       do ,
       FILLBY ,
       remainder ,
       
       fetch ,
       save ,
       fetch all ,
       save all ,
       forget ,
       erase ,
       insert ,
       edit :


LET cr lf = ""13""10"" ;

TEXT VAR name ;
DATASPACE VAR edit space ;

THESAURUS VAR remaining thesaurus := empty thesaurus ;


THESAURUS OP + (THESAURUS CONST left, right) :

  THESAURUS VAR union := left ;
  INT VAR index := 0 ;
  get (right, name, index) ;
  WHILE name <> "" REP
    IF NOT (union CONTAINS name)
      THEN insert (union, name)
    FI ;
    get (right, name, index)
  PER ;
  union .

ENDOP + ;

THESAURUS OP + (THESAURUS CONST left, TEXT CONST right) :

  THESAURUS VAR union := left ;
  IF NOT (union CONTAINS right)
    THEN insert (union, right)
  FI ;
  union .

ENDOP + ;

THESAURUS OP - (THESAURUS CONST left, right) :

  THESAURUS VAR difference := empty thesaurus ;
  INT VAR index := 0 ;
  get (left, name, index) ;
  WHILE name <> "" REP
    IF NOT (right CONTAINS name)
      THEN insert (difference, name)
    FI ;
    get (left, name, index)
  PER ;
  difference .

ENDOP - ;

THESAURUS OP - (THESAURUS CONST left, TEXT CONST right) :

  THESAURUS VAR difference := left ;
  INT VAR index ;
  delete (difference, right, index) ;
  difference .

ENDOP - ;

THESAURUS OP / (THESAURUS CONST left, right) :

  THESAURUS VAR intersection := empty thesaurus ;
  INT VAR index := 0 ;
  get (left, name, index) ;
  WHILE name <> "" REP
    IF right CONTAINS name
      THEN insert (intersection, name)
    FI ;
    get (left, name, index)
  PER ;
  intersection .

ENDOP / ;

THESAURUS OP ALL (TEXT CONST file name) :

  FILE VAR file := sequential file (input, file name) ;
  THESAURUS VAR thesaurus := empty thesaurus ;
  thesaurus FILLBY file ;
  thesaurus .

ENDOP ALL ;

THESAURUS OP SOME (THESAURUS CONST thesaurus) :

  copy thesaurus into file ;
  edit file ;
  copy file into thesaurus .

copy thesaurus into file :
  forget (edit space) ;
  edit space := nilspace ;
  FILE VAR file := sequential file (output, edit space) ;
  file FILLBY thesaurus .
  
edit file :
  modify (file) ;
  edit (file) .

copy file into thesaurus :
  THESAURUS VAR result := empty thesaurus ;
  input (file) ;
  result FILLBY file ;
  forget (edit space) ;
  result .

ENDOP SOME ;

THESAURUS OP SOME (TASK CONST task) :

  SOME ALL task

ENDOP SOME ;

THESAURUS OP SOME (TEXT CONST file name) :

  SOME ALL file name

ENDOP SOME ;

THESAURUS OP LIKE (THESAURUS CONST thesaurus, TEXT CONST pattern) : 
 
  THESAURUS VAR result:= empty thesaurus ; 
  INT VAR index:= 0 ; 
  REP get (thesaurus, name, index) ; 
    IF name = "" 
      THEN LEAVE LIKE WITH result 
    ELIF name LIKE pattern 
      THEN insert (result, name) 
    FI 
 PER ; 
 result .
 
ENDOP LIKE ; 

THESAURUS PROC remainder :

  remaining thesaurus

ENDPROC remainder ;

PROC do (PROC (TEXT CONST) operate, THESAURUS CONST thesaurus) :

  INT VAR index := 0 , operation number := 0 ;
  TEXT VAR name ;
  
  remaining thesaurus := empty thesaurus ;
  disable stop ;
  work off thesaurus ;
  fill leftover with remainder .

work off thesaurus :
  REP
    get (thesaurus, name, index) ;
    IF name = ""
      THEN LEAVE work off thesaurus
    FI ;
    operation number INCR 1 ;
    cout (operation number) ;
    execute (PROC (TEXT CONST) operate, name)
  UNTIL is error ENDREP .

fill leftover with remainder :
  WHILE name <> "" REP
    insert (remaining thesaurus, name) ;
    get (thesaurus, name, index)
  PER .

ENDPROC do ;
 
PROC execute (PROC (TEXT CONST) operate, TEXT CONST name) :

  enable stop ;
  operate (name)

ENDPROC execute ;
 
PROC do (PROC (TEXT CONST, TASK CONST) operate, THESAURUS CONST thesaurus,
         TASK CONST task) :

  INT VAR index := 0 , operation number := 0 ;
  TEXT VAR name ;
  
  remaining thesaurus := empty thesaurus ;
  disable stop ;
  work off thesaurus ;
  fill leftover with remainder .

work off thesaurus :
  REP
    get (thesaurus, name, index) ;
    IF name = ""
      THEN LEAVE work off thesaurus
    FI ;
    operation number INCR 1 ;
    cout (operation number) ;
    execute (PROC (TEXT CONST, TASK CONST) operate, name, task)
  UNTIL is error ENDREP .

fill leftover with remainder :
  WHILE name <> "" REP
    insert (remaining thesaurus, name) ;
    get (thesaurus, name, index)
  PER .

ENDPROC do ;
 
PROC execute (PROC (TEXT CONST, TASK CONST) operate,
              TEXT CONST name, TASK CONST task) :

  enable stop ;
  operate (name, task)

ENDPROC execute ;
 
OP FILLBY (THESAURUS VAR thesaurus, FILE VAR file) :

  WHILE NOT eof (file) REP
    getline (file, name) ;
    delete trailing blanks ;
    IF name <> "" CAND NOT (thesaurus CONTAINS name)
      THEN insert (thesaurus, name)
    FI
  PER .

delete trailing blanks :
  WHILE (name SUB LENGTH name) = " " REP
    name := subtext (name, 1, LENGTH name - 1)
  PER .

ENDOP FILLBY ;

OP FILLBY (FILE VAR file, THESAURUS CONST thesaurus) :

  INT VAR index := 0 ;
  REP
    get (thesaurus, name, index) ;
    IF name = ""
      THEN LEAVE FILLBY
    FI ;
    putline (file, name)
  PER .

ENDOP FILLBY ;

OP FILLBY (TEXT CONST file name, THESAURUS CONST thesaurus) :

  FILE VAR f := sequential file (output, file name) ;
  f FILLBY thesaurus

ENDOP FILLBY ;


 
PROC fetch (THESAURUS CONST nameset) :

  do (PROC (TEXT CONST) fetch, nameset)

ENDPROC fetch ;
 
PROC fetch (THESAURUS CONST nameset, TASK CONST task) :

  do (PROC (TEXT CONST, TASK CONST) fetch, nameset, task)

ENDPROC fetch ;
 
PROC save (THESAURUS CONST nameset) :

  do (PROC (TEXT CONST) save, nameset)

ENDPROC save ;
 
PROC save (THESAURUS CONST nameset, TASK CONST task) :

  do (PROC (TEXT CONST, TASK CONST) save, nameset, task)

ENDPROC save ;
 
PROC fetch all :

  fetch all (father)

ENDPROC fetch all ;

PROC fetch all (TASK CONST manager) :

  fetch (ALL manager, manager)

ENDPROC fetch all ;

PROC save all :

  save all (father)

ENDPROC save all ;

PROC save all (TASK CONST manager) :

  save (ALL myself, manager)

ENDPROC save all ;

PROC forget (THESAURUS CONST nameset) :

  do (PROC (TEXT CONST) forget, nameset)

ENDPROC forget ;
 
PROC erase (THESAURUS CONST nameset) :

  do (PROC (TEXT CONST) erase, nameset)

ENDPROC erase ;
 
PROC erase (THESAURUS CONST nameset, TASK CONST task) :

  do (PROC (TEXT CONST, TASK CONST) erase, nameset, task)

ENDPROC erase ;
 
PROC insert (THESAURUS CONST nameset) :

  do (PROC (TEXT CONST) insert, nameset)

ENDPROC insert ;
 
PROC edit (THESAURUS CONST nameset) :

  do (PROC (TEXT CONST) edit, nameset)

ENDPROC edit ;
 
ENDPACKET name set ;