summaryrefslogtreecommitdiff
path: root/ipl/packs/idol/mpw.icn
blob: 0518dec399bdd31039ccc9bf1c28254d8a9d276f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
#
# @(#)mpw.icn	1.4 5/5/90
# OS-specific code for Macintosh MPW
# Adapted from unix.icn by Charles Lakos
#
global icontopt,env,sysok

procedure mysystem(s)
  if \loud then write(s)
  return system(s)
end

procedure filename(s,ext)
  s ||:= \ext
  return s
end
# if the filename s has extension ext then return the filename less the
# extension, otherwise fail.
procedure fileroot(s,ext)
  if s[- *ext : 0] == ext then return s[1 : - *ext]
end
procedure writesublink(s)
  writelink(env||"_"||s)
end
procedure envpath(filename)
  return env||"_"||filename
end
#
# Installation.
# Uses hierarchical filesystem on some systems (see initialize)
#
procedure install(args)
  write("Installing idol environment with prefix ",env)
  fout := envopen("i_object.icn","w")
  write(fout,"record idol_object(__state,__methods)")
  close(fout)
  fout := &null
  cdicont(["i_object"])
end
procedure uninstall(args)
  # not implemented yet
end

procedure makeexe(args,i)
  exe := args[i]
  if icont(exe) = \sysok then {
      mysystem("delete "||exe||".icn")
      if \exec then {
	write("Executing:")
	every i := exec+1 to *args do exe ||:= " "||args[i]
	mysystem(exe)
      }
  }
end
#
# system-dependent compilation of idolfile.icn
#   (in the idol subdirectory, if there is one)
#
procedure cdicont(idolfiles)
  args := " -c"
  rms  := ""
  every ifile := !idolfiles do args ||:= " " || envpath(ifile)
  every ifile := !idolfiles do rms  ||:= " " || envpath(ifile) || ".icn"

  if comp = -2 then return  # -t --> don't translate at all
  if icont(args,"") = \sysok
  then mysystem("delete "||rms)
  return
end
procedure sysinitialize()
  icontopt := " -Sr500 -SF30 -Si1000 "
  env:= "C"
  sysok := 0
  loud := &null
  write(&errout)
  write(&errout, "*** Select and run the following commands ***")
  write(&errout)
end

procedure system(s)
  write(&errout,s)
  return sysok
end