-- file Translit.mesa
-- last modified by Satterthwaite,  9-Mar-82 14:20:14

DIRECTORY
  Ascii: TYPE USING [CR, SP, TAB],
  DCSFileTypes: TYPE USING [tLeaderPage],
  Directory: TYPE USING [CreateFile, Error, Lookup, UpdateDates, ignore],
  Exec: TYPE USING [AddCommand, commandLine, w],
  File: TYPE USING [Capability, Permissions, delete, grow, read, shrink, write],
  FileStream: TYPE USING [Create, EndOf],
  Stream: TYPE USING [Handle, Delete, GetChar, PutChar],
  TTY: TYPE USING [Handle, GetLine, LineOverflow, PutChar, Rubout];

Translit: PROGRAM
    IMPORTS Directory, Exec, FileStream, Stream, TTY = {

 -- characters and strings
 
  MAXCHAR: NAT = LAST[CHARACTER] - 0c;
  MAXSTR: NAT = 100;
  
  character: TYPE = [-1..MAXCHAR];
  string: TYPE = PACKED ARRAY [1..MAXSTR] OF character;
  
  ENDFILE:   character = -1;
  ENDSTR:    character =  0;
  BACKSPACE: character =  9;
  TAB:       character =  9;
  NEWLINE:   character = 13;
  BLANK:     character = 32;
  ESCAPE:    character = ord['@];
  
 -- file descriptors and io-related stuff
 
  MAXOPEN: NAT = 10;
  
  filedesc: TYPE = [0..MAXOPEN];
  
  IOERROR: filedesc = 0;
  STDIN:   filedesc = 1;
  STDOUT:  filedesc = 2;
  STDERR:  filedesc = 3;
  
  IOREAD:  INTEGER = 1;
  IOWRITE: INTEGER = 2;
  IOBOTH:  INTEGER = 3;  
  

-- standard (Pascal) procedures
   
  ord: PROC [c: CHARACTER] RETURNS [character] = INLINE {RETURN [c - 0c]};
  chr: PROC [c: character] RETURNS [CHARACTER] = INLINE {RETURN [c + 0c]};
  
  
-- file primitives
   
  tty: TTY.Handle;
 
  kbdline: STRING _ [MAXSTR];
  kbdx: CARDINAL;
  kbdend: BOOLEAN;
  
  
  readkbd: PROC = {
    IF (kbdend) THEN
      kbdline.length _ 0
    ELSE {
      ENABLE {
	TTY.LineOverflow => {
	  putcf[NEWLINE, STDERR];
	  message["*** line too long"L];
	  putcf[NEWLINE, STDERR];
	  RETRY};
	TTY.Rubout => {
	  IF (kbdline.length) > 0 THEN
	    RESUME
	  ELSE {
	    kbdend _ TRUE;
	    CONTINUE}}};
      IF (kbdline.length > 0)
       AND (kbdline[kbdline.length-1] = Ascii.CR) THEN
        kbdline.length _ kbdline.length - 1;	-- for ESC
      tty.GetLine[kbdline];
      IF kbdline.length >= kbdline.maxlength THEN
        [] _ ERROR TTY.LineOverflow[kbdline];
      kbdline[kbdline.length] _ Ascii.CR;
      kbdline.length _ kbdline.length + 1};
    kbdx _ 0};
	   
    
    
  filerec: TYPE = RECORD [
    type: {none, stream, tty} _ none,
    handle: Stream.Handle _ NIL];
    
  filetab: ARRAY filedesc OF filerec;
  
  accessmap: PROC [mode: INTEGER] RETURNS [File.Permissions] = {
    RETURN [SELECT mode FROM
      IOREAD => File.read,
      IOWRITE => File.write + File.grow + File.shrink + File.delete,
      IOBOTH => File.read + File.write + File.grow + File.shrink + File.delete,
      ENDCASE => File.read]};
    
  fdalloc: PROC RETURNS [fd: filedesc] = {
    -- find a free slot in filetab
    FOR fd IN (STDERR .. MAXOPEN] DO
      IF (filetab[fd].type = none) THEN EXIT
      REPEAT
        FINISHED => fd _ IOERROR; 
      ENDLOOP;
    RETURN};
  
  fileerror: ERROR = CODE;
  
  findfile: PROC [name: STRING, access: File.Permissions]
      RETURNS [File.Capability] = {
    cap: File.Capability;
    old: BOOLEAN _ (access = File.read);
    IF ~old THEN { 
      cap _ Directory.CreateFile[name, DCSFileTypes.tLeaderPage, 0
	      ! Directory.Error => {
		 IF type = fileAlreadyExists THEN GOTO fileExists 
		 ELSE GO TO fileProblem}];
      EXITS
        fileExists => old _ TRUE};
    IF old THEN
       cap _ Directory.Lookup[fileName: name, permissions: Directory.ignore
	! Directory.Error => {GO TO fileProblem}];
    RETURN [Directory.UpdateDates[cap, access]]
    EXITS
      fileProblem => ERROR fileerror};
  
  makestream: PROC [name: POINTER TO string, mode: INTEGER, fd: filedesc] = {
    i: INTEGER _ 0;
    intname: STRING _ [MAXSTR];
    WHILE (name[i+1] # ENDSTR) DO
      intname[i] _ chr[name[i+1]];
      i _ i + 1;
      ENDLOOP;
    intname.length _ i;
    filetab[fd] _ [
	type: stream,
	handle: FileStream.Create[findfile[intname, accessmap[mode]]]]};
  

  open: PROC [name: POINTER TO string, mode: INTEGER] RETURNS [fd: filedesc] = {
    fd _ fdalloc[];
    IF fd # IOERROR THEN {
      makestream[name, mode, fd ! fileerror => {GOTO fail}];
      EXITS fail => {filetab[fd] _ [type: none]; fd _ IOERROR}};
    RETURN};

  create: PROC [name: POINTER TO string, mode: INTEGER] RETURNS [filedesc] = open;
    -- check positioning of files opened for output
    
  close: PROC [fd: filedesc] = {
    SELECT filetab[fd].type FROM
      stream => {
        h: Stream.Handle = filetab[fd].handle;
	Stream.Delete[h]};
      tty => NULL;
      ENDCASE => NULL;
    filetab[fd] _ [type: none]};

  remove: PROC [s: POINTER TO string] = {
    -- this version just prints a message
    message["If we had remove, we would be deleting "L];
    putcf[TAB, STDERR];
    putstr[s, STDERR];
    putcf[NEWLINE, STDERR]};

  getc: PROC [c: POINTER TO character] RETURNS [character] = INLINE {
    RETURN [getcf[c, STDIN]]};

  getcf: PROC [c: POINTER TO character, fd: filedesc] RETURNS [character] = {
    SELECT filetab[fd].type FROM
      stream => {
        h: Stream.Handle = filetab[fd].handle;
	c^ _ IF FileStream.EndOf[h] THEN ENDFILE ELSE ord[h.GetChar[]]};
      tty =>
        IF (kbdx < kbdline.length) THEN {
	  c^ _ ord[kbdline[kbdx]];
	  kbdx _ kbdx + 1}
	ELSE {
	  readkbd[];
	  IF (kbdline.length = 0) THEN	-- iff kbdend
	    c^ _ ENDFILE
	  ELSE {
	    c^ _ ord[kbdline[kbdx]];
	    kbdx _ kbdx + 1}};
      ENDCASE => error["bad file descriptor"L];
    RETURN [c^]};

  getline: PROC [s: POINTER TO string, fd: filedesc, maxsize: INTEGER _ MAXSTR]
      RETURNS [BOOLEAN] = {
    i: INTEGER _ 1;
    c: character;
    DO
      s[i] _ getcf[@c, fd];
      i _ i + 1;
      IF (c = ENDFILE) OR (c = NEWLINE) OR (i >= maxsize) THEN EXIT
      ENDLOOP;
    IF (c = ENDFILE) THEN	-- went one too far
      i _ i - 1;
    s[i] _ ENDSTR;
    RETURN [c # ENDFILE]};


  putc: PROC [c: character] = INLINE {putcf[c, STDOUT]};

  putcf: PROC [c: character, fd: filedesc] = {
    SELECT filetab[fd].type FROM
      stream => {
        h: Stream.Handle = filetab[fd].handle;
	h.PutChar[chr[c]]};
      tty => tty.PutChar[chr[c]];
      ENDCASE => error["bad file descriptor"L]};

  putstr: PROC [s: POINTER TO string, fd: filedesc] = {
    i: INTEGER _ 1;
    WHILE (s[i] # ENDSTR) DO
      putcf[s[i], fd];
      i _ i + 1
      ENDLOOP};
      

-- errors and messages

  message: PROC [msg: STRING] = {
    FOR i: CARDINAL IN [0 .. msg.length) DO
      putcf[ord[msg[i]], STDERR] ENDLOOP};

  exit: ERROR = CODE;
  
  error: PROC [msg: STRING] = {
    message[msg];  ERROR exit};
   

-- command arg primitives

  MAXCMD: NAT = 20;

  cmdargs: [0 .. MAXCMD];
  cmd: ARRAY [1 .. MAXCMD] OF RECORD [idx, len: CARDINAL];
  
  getarg: PROC [n: INTEGER, str: POINTER TO string, maxsize: INTEGER]
      RETURNS [BOOLEAN] = {
    b: BOOLEAN _ ((n > 0) AND (n <= cmdargs));
    IF (b) THEN
      commandstr[cmd[n].idx, cmd[n].len, str, 1, maxsize];
    RETURN [b]};

  nargs: PROC RETURNS [INTEGER] = {RETURN [cmdargs]};
  
  commandstr: PROC [i, n: INTEGER,
      dest: POINTER TO string, j: INTEGER, maxsize: INTEGER] = {
    WHILE (n > 0) AND (j < maxsize) DO
      dest[j] _ ord[Exec.commandLine.s[i]];
      i _ i + 1;
      j _ j + 1;
      n _ n - 1;
      ENDLOOP;
    dest[j] _ ENDSTR}; 
  

-- utilities

 -- esc: map s[i^] into escaped character, increment i^
  esc: PROC [s: POINTER TO string, i: POINTER TO INTEGER] RETURNS [c: character] = {
    IF (s[i^] = ESCAPE) THEN
      c _ s[i^]
    ELSE IF (s[i^+1] = ENDSTR) THEN	-- @ not special at end
      c _ ESCAPE
    ELSE {
      i^ _ i^ + 1;
      IF (s[i^] = ord['n]) THEN
        c _ NEWLINE
      ELSE IF (s[i^] = ord['t]) THEN
        c _ TAB
      ELSE
      	c _ s[i^]};
    RETURN};
     
 -- index: find position of character c in string s
  index: PROC [s: POINTER TO string, c: character] RETURNS [INTEGER] = {
    i: INTEGER _ 1;
    WHILE (s[i] # c) AND (s[i] # ENDSTR) DO
      i _ i + 1 ENDLOOP;
    RETURN [IF (s[i] = ENDSTR) THEN 0 ELSE i]};

 -- isalphanum: true if c is a letter or digit
  isalphanum: PROC [c: character] RETURNS [BOOLEAN] = {
    RETURN [
      (c IN [ord['a] .. ord['z]])
       OR (c IN [ord['A] .. ord['Z]])
       OR (c IN [ord['0] .. ord['9]])]};

 -- length: compute length of string
  length: PROC [s: POINTER TO string] RETURNS [INTEGER] = {
    n: INTEGER _ 1;
    WHILE (s[n] # ENDSTR) DO
      n _ n + 1 ENDLOOP;
    RETURN [n - 1]};
    
-- insert main proc here
 
 -- translit: map characters
  translit: PROC = {
    NEGATE: character = ord['^];
    arg, fromset, toset: string;
    c: character;
    i, lastto: [0..MAXSTR];
    allbut, squash: BOOLEAN;

    makeset: PROC [inset: POINTER TO string, k: INTEGER,
        outset: POINTER TO string, maxset: INTEGER] RETURNS [BOOLEAN] = {
      -- makeset: make set from inset[k] in outset

      addstr: PROC [c: character, outset: POINTER TO string,
          j: POINTER TO INTEGER, maxset: INTEGER] RETURNS [added: BOOLEAN] = {
	-- addstr: put c in outset[j] if it fits, increment j
	IF (j^ > maxset) THEN
	  added _ FALSE
	ELSE {
	  outset[j^] _ c;
	  j^ _ j^ + 1;
	  added _ TRUE};
	RETURN};
	
      dodash: PROC [delim: character, src: POINTER TO string,
          i: POINTER TO INTEGER, dest: POINTER TO string,
	  j: POINTER TO INTEGER, maxset: INTEGER] = {
	-- dodash: expand set at src[i^] into dest[j^], stop at delim
	DASH: character = ord['-];
	WHILE (src[i^] # delim) AND (src[i^] # ENDSTR) DO
	  IF (src[i^] = ESCAPE) THEN
	    [] _ addstr[esc[src, i], dest, j, maxset]
	  ELSE IF (src[i^] # DASH) THEN
	    [] _ addstr[src[i^], dest, j, maxset]
	  ELSE IF (j^ <= 1) OR (src[i^+1] = ENDSTR) THEN
	    [] _ addstr[DASH, dest, j, maxset]	-- literal -
	  ELSE IF (isalphanum[src[i^-1]])
	   AND (isalphanum[src[i^+1]])
	   AND (src[i^-1] <= src[i^+1]) THEN {
	    FOR k: character IN (src[i^-1] .. src[i^+1]] DO
	      [] _ addstr[k, dest, j, maxset] ENDLOOP;
	    i^ _ i^ + 1}
	  ELSE
	    [] _ addstr[DASH, dest, j, maxset];
	  i^ _ i^ + 1
	  ENDLOOP};
	  
      j: INTEGER _ 1;
      dodash[ENDSTR, inset, @k, outset, @j, maxset];
      RETURN [addstr[ENDSTR, outset, @j, maxset]]};
      
    xindex: PROC [inset: POINTER TO string, c: character,
        allbut: BOOLEAN, lastto: INTEGER] RETURNS [INTEGER] = {
      -- xindex: conditionally invert value from index
      RETURN [
        IF (c = ENDFILE) THEN 0
	ELSE IF (~allbut) THEN index[inset, c]
	ELSE IF (index[inset, c] > 0) THEN 0
	ELSE lastto + 1]};

    IF (~getarg[1, @arg, MAXSTR]) THEN
      error["usage: translit from to"L];
    allbut _ (arg[1] = NEGATE);
    i _ IF (allbut) THEN 2 ELSE 1;
    IF (~makeset[@arg, i, @fromset, MAXSTR]) THEN
      error["translit: ""from"" set too large"L];
    IF (~getarg[2, @arg, MAXSTR]) THEN
      toset[1] _ ENDSTR
    ELSE IF (~makeset[@arg, 1, @toset, MAXSTR]) THEN
      error["translit: ""to"" set too large"L]
    ELSE IF (length[@fromset] < length[@toset]) THEN
      error["translit: ""from"" shorter than ""to"""L];
    
    lastto _ length[@toset];
    squash _ (length[@fromset] > lastto) OR (allbut);
    DO
      i _ xindex[@fromset, getc[@c], allbut, lastto];
      IF (squash) AND (i>=lastto) AND (lastto>0) THEN {
        putc[toset[lastto]];
	DO
	  i _ xindex[@fromset, getc[@c], allbut, lastto];
	  IF (i < lastto) THEN EXIT;
	  ENDLOOP};
      IF (c = ENDFILE) THEN EXIT;
      IF (i > 0) AND (lastto > 0) THEN	-- translate
        putc[toset[i]]
      ELSE IF (i = 0) THEN	-- copy
        putc[c]
      -- ELSE delete --
      ENDLOOP};
  
  
 -- here begins the shell
 
  initcmd: PROC = {
    idx: CARDINAL _ Exec.commandLine.i;
    limx: CARDINAL =
      IF Exec.commandLine.s = NIL THEN 0 ELSE Exec.commandLine.s.length-1;
    tty _ Exec.w;
    kbdx _ kbdline.length _ 0;
    kbdend _ FALSE;
    filetab[STDIN].type _ filetab[STDOUT].type _ filetab[STDERR].type _ tty;
    cmdargs _ 0;
    WHILE (idx < limx) DO
      WHILE (Exec.commandLine.s[idx] = Ascii.SP) AND (idx < limx) DO
        idx _ idx + 1 ENDLOOP;
      IF (idx < limx) THEN {
        startidx: CARDINAL = idx;
	WHILE (idx < limx)
	 AND (Exec.commandLine.s[idx] # Ascii.SP)
	 AND (Exec.commandLine.s[idx] # Ascii.TAB) DO
	  idx _ idx + 1 ENDLOOP;
	SELECT Exec.commandLine.s[startidx] FROM
	  '< => {
	    name: string;
	    commandstr[startidx+1, idx - (startidx+1), @name, 1, MAXSTR];
	    close[STDIN];
	    makestream[@name, IOREAD, STDIN]};
	  '> => {
	    name: string;
	    commandstr[startidx+1, idx - (startidx+1), @name, 1, MAXSTR];
	    close[STDOUT];
	    makestream[@name, IOWRITE, STDOUT]};
	  ENDCASE => {
	    cmdargs _ cmdargs + 1;
	    IF cmdargs > MAXCMD THEN {
	      putcf[NEWLINE, STDERR];
	      message["*** too many arguments"L];
	      putcf[NEWLINE, STDERR]}
	    ELSE
	      cmd[cmdargs] _ [idx: startidx, len: idx - startidx]}};
      ENDLOOP;
    putcf[NEWLINE, STDERR]};
      
   endcmd: PROC = {
     FOR fd: filedesc IN (IOERROR .. MAXOPEN] DO
       close[fd] ENDLOOP;
     IF Exec.commandLine.s # NIL THEN
       Exec.commandLine.i _ Exec.commandLine.s.length};
   

  main: PROC = {
    initcmd[];
    translit[ ! exit => {CONTINUE}];
    endcmd[]};
  
  Exec.AddCommand["translit.~"L, main];
  
  }.