source: abuse/trunk/src/install.cpp @ 2

Last change on this file since 2 was 2, checked in by Sam Hocevar, 14 years ago
  • imported original 0.7.0 tarball
File size: 6.6 KB
Line 
1#define NO_LIBS 1
2#include "lisp.c"
3#include "trig.c"
4#include "lisp_gc.c"
5#include "lisp_opt.c"
6#include "text_gui.c"
7
8
9enum { LINUX, WATCOM, AIX, SUN, SGI };
10
11char *plat_names[] = {"Linux (SVGA & X11)",
12                      "Watcom for MS-DOS",
13                      "IBM AIX for RS6000's",
14                      "Sun OS",
15                      "Silicon Graphics"};
16
17char *plat_name[] = {"LINUX","WATCOM","AIX","SUN","SGI"};
18
19
20int detect_platform()
21{
22#ifdef __linux__
23  return LINUX;
24#endif
25
26#ifdef __WATCOMC__
27  return WATCOM;
28#endif
29
30#ifdef _AIX
31  return AIX;
32#endif
33
34#ifdef sun
35  return SUN;
36#endif
37
38#ifdef SUN3
39  return SUN;
40#endif
41
42#ifdef SUN4
43  return SUN;
44#endif
45
46#ifdef __sgi
47  return SGI;
48#endif
49
50  printf("Cannot detect platform\n");
51  exit(1);
52
53  return 0;
54}
55
56
57long c_caller(long number, void *arg)  // exten c function switches on number
58{
59  switch (number)
60  {
61    case 0 :
62    {
63      char cd[100];
64      getcwd(cd,100);
65      int t=change_dir(lstring_value(CAR(arg)));
66      change_dir(cd);
67      return t;
68    } break;   
69    case 1 :
70    {
71      if (change_dir(lstring_value(eval(CAR(arg)))))
72        return 1;
73      else return 0;
74    } break;
75    case 2 :
76    {
77      return K_avail(lstring_value(CAR(arg)));
78    } break;
79    case 3 :
80    {
81      void *title=eval(CAR(arg)); arg=CDR(arg);   p_ref r1(title);
82      void *source=eval(CAR(arg)); arg=CDR(arg);  p_ref r2(source);
83      void *dest=eval(CAR(arg)); arg=CDR(arg);    p_ref r3(dest);
84
85      return nice_copy(lstring_value(title),lstring_value(source),lstring_value(dest));
86    } break;
87    case 4 :
88    {
89      if (access(lstring_value(eval(CAR(arg))),R_OK)==0)
90        return 1;
91      else
92        return 0;
93    } break;
94  }
95  return 0;
96}
97
98
99int nice_copy(char *title, char *source, char *dest);
100
101 void *l_obj_get(long number) { return NULL; }  // exten lisp function switches on number
102 void l_obj_set(long number, void *arg) { ; }  // exten lisp function switches on number
103 void l_obj_print(long number) { ; }  // exten lisp function switches on number
104
105void clisp_init()
106{                      // external initalizer call by lisp_init()
107  void *platform=make_find_symbol("platform");
108  set_symbol_value(platform,make_find_symbol(plat_name[detect_platform()])); 
109  add_lisp_function("system",1,1,                   0);
110  add_lisp_function("split_filename",2,2,           1);
111  add_lisp_function("convert_slashes",2,2,          2);
112  add_lisp_function("make_dir",1,1,                 3);
113  add_lisp_function("extension",1,1,                4);
114  add_lisp_function("nice_input",3,3,               5);  // title, prompt, default -> returns input
115  add_lisp_function("nice_menu",3,3,                6);  // title, menu_title, list -> return selection number
116  add_lisp_function("show_yes_no",4,4,              7);
117  add_lisp_function("get_cwd",0,0,                  8);
118  add_lisp_function("getenv",1,1,                   9);
119  add_lisp_function("modify_install_path",1,1,     10);
120 
121
122  add_c_bool_fun("dir_exsist",1,1,                  0);
123  add_c_bool_fun("chdir",1,1,                       1);
124  add_c_function("K_avail",1,1,                     2);  // path
125  add_c_bool_fun("nice_copy",3,3,                   3);  // source file, dest file
126  add_c_bool_fun("file_exsist",1,1,                 4);
127 
128  char esc_str[2]={27,0};
129  set_symbol_value(make_find_symbol("ESC_string"),new_lisp_string(esc_str));
130}
131
132
133
134
135void *l_caller(long number, void *arg)
136{
137  p_ref r1(arg);
138  void *ret=NULL;
139  switch (number)
140  {
141    case 0 :
142    { system(lstring_value(eval(CAR(arg)))); } break;
143    case 1 :
144    {
145      void *fn=eval(CAR(arg));  arg=CDR(arg);
146      p_ref r1(fn);
147      char *current_dir=lstring_value(eval(CAR(arg)));
148      char *filename=lstring_value(fn);
149
150      char *last=NULL,*s=filename,*dp;
151      char dir[200],name[200];
152      while (*s) { if (*s=='\\' || *s=='/') last=s+1; s++; }
153      if (last)
154      {
155        for (dp=dir,s=filename;s!=last;dp++,s++) { *dp=*s; }
156        *dp=0;
157        strcpy(name,last);
158      } else
159      {
160        strcpy(dir,current_dir);
161        strcpy(name,filename);
162      }
163      void *cs=(void *)new_cons_cell();
164      p_ref r24(cs);
165      ((cons_cell *)cs)->car=new_lisp_string(dir);
166      ((cons_cell *)cs)->cdr=new_lisp_string(name);
167      ret=cs;
168    } break;
169    case 2 :
170    {
171      void *fn=eval(CAR(arg)); arg=CDR(arg);
172      p_ref r1(fn);
173      char *slash=lstring_value(eval(CAR(arg)));
174      char *filename=lstring_value(fn);
175
176      char tmp[200],*s=filename,*tp;
177     
178      for (tp=tmp;*s;s++,tp++)
179      {
180        if (*s=='/' || *s=='\\')
181        {
182          *tp=*slash;
183//        if (*slash=='\\')
184//        { tp++; *tp='\\'; }
185        }
186        else *tp=*s;
187      }
188      *tp=0;
189      ret=new_lisp_string(tmp);
190    } break;
191    case 3 :
192    {
193      char cd[100];
194      getcwd(cd,100);
195
196      char name_so_far[100];
197      char *dir=lstring_value(eval(CAR(arg)));
198      char *d,ch;
199      d=dir;
200      int err=0;
201      while (*d && !err)
202      {
203        if ((*d=='\\' || *d=='/') && d!=dir && *(d-1)!=':')
204        {
205          ch=*d;
206          *d=0;
207          if (!change_dir(dir))
208            if (make_dir(dir)!=0)
209              err=1;
210
211          *d=ch;
212         
213        }
214        d++;
215      }
216      change_dir(cd);
217
218      if (err)
219        ret=NULL;
220      else ret=true_symbol;
221    } break;
222    case 4 :
223    {
224      char *fn=lstring_value(eval(CAR(arg)));
225      char *l=NULL,*s=fn;
226      while (*s) { if (*s=='.') l=s; s++; }
227      if (l) ret=new_lisp_string(l);
228      else ret=new_lisp_string("");
229    } break;
230    case 5 :
231    {
232      void *tit=eval(CAR(arg));  arg=CDR(arg);
233      p_ref r1(tit);
234      void *prompt=eval(CAR(arg));  arg=CDR(arg);
235      p_ref r2(prompt);
236      void *def=eval(CAR(arg));  arg=CDR(arg);
237      p_ref r3(def);
238
239      return nice_input(lstring_value(tit),lstring_value(prompt),lstring_value(def));
240    } break;
241    case 6 :
242    {
243      return nice_menu(CAR(arg),CAR(CDR(arg)),CAR(CDR(CDR(arg))));
244    } break;
245    case 7 :
246    {
247      return show_yes_no(CAR(arg),CAR(CDR(arg)),CAR(CDR(CDR(arg))),CAR(CDR(CDR(CDR(arg)))));
248    } break;
249    case 8 :
250    {
251      char cd[150];
252      getcwd(cd,100);
253      return new_lisp_string(cd);
254    } break;
255    case 9 :
256    {
257      return new_lisp_string(getenv(lstring_value(eval(CAR(arg)))));
258    } break;
259    case 10 :
260    {
261      char str[200];
262      strcpy(str,lstring_value(eval(CAR(arg))));
263      modify_install_path(str);
264      return new_lisp_string(str);
265    } break;
266  }
267  return ret;
268}
269
270
271 // exten lisp function switches on number
272
273
274main(int argc, char **argv)
275{
276  lisp_init(100000,0x2000);
277  char *use_file="install.lsp";
278  for (int i=1;i<argc;i++)
279  {
280    if (!strcmp(argv[i],"-f"))
281    {
282      i++;
283      use_file=argv[i];
284    }
285  }
286
287  char prog[100],*s;
288  sprintf(prog,"(compile-file \"%s\")\n",use_file);
289  s=prog;
290  if (!eval(compile(s)))
291  {
292    printf("unable to open file %s",use_file);
293    exit(0);
294  }
295  return 0;
296}
297
Note: See TracBrowser for help on using the repository browser.