support install quicklisp

src/Makefile.am

@@ -3,13 +3,13 @@ AM_CPPFLAGS = -DLISP_PATH=\"$(roslispdir)\"
 roslispdir = $(datadir)/common-lisp/source/$(PACKAGE)
 roslisp_DATA = lisp/init.lisp lisp/install.ros lisp/asdf.lisp
 roslispinstalldir = $(roslispdir)/install
-roslispinstall_DATA = lisp/install/sbcl.lisp
+roslispinstall_DATA = lisp/install/sbcl.lisp lisp/install/quicklisp.lisp
 
 bin_PROGRAMS = ros
 ros_SOURCES = lsp.c opt.c download.c util.c archive.c html.c internal.c \
 	cmds/version/cmd.c \
 	cmds/run/cmd.c cmds/run/sbcl.c\
-	cmds/install/cmd.c cmds/install/sbcl-bin.c \
+	cmds/install/cmd.c cmds/install/sbcl-bin.c cmds/install/quicklisp.c \
 	cmds/list/cmd.c \
 	cmds/help/cmd.c \
 	cmds/config/cmd.c

src/cmds/install/cmd.c

@@ -14,7 +14,8 @@ static char *flags =NULL;
 struct install_impls *install_impl;
 
 struct install_impls *impls_to_install[]={
-  &impls_sbcl_bin
+  &impls_sbcl_bin,
+  &utils_quicklisp
 };
 
 extern int extract(const char *filename, int do_extract, int flags,const char* outputpath,Function2 f,void* p);
@@ -26,8 +27,9 @@ int installed_p(struct install_options* param)
   char *impl;
 
   impl=q(param->impl);
+  //TBD for util.
   i=s_cat(homedir(),q("impls"),q(SLASH),q(param->arch),q(SLASH),q(param->os),q(SLASH),
-          q(impl),q(SLASH),q(param->version),q(SLASH),NULL);
+          q(impl),q(param->version?SLASH:""),q(param->version?param->version:""),q(SLASH),NULL);
   ret=directory_exist_p(i);
   if(verbose>0) {
     fprintf(stderr,"directory_exist_p(%s)=%d\n",i,ret);
@@ -48,18 +50,18 @@ int start(struct install_options* param)
   char* p;
   ensure_directories_exist(home);
   if(installed_p(param)) {
-    printf("%s/%s are already installed.if you intend to reinstall by (TBD).\n",param->impl,param->version);
+    printf("%s/%s are already installed.if you intend to reinstall by (TBD).\n",param->impl,param->version?param->version:"");
     return 0;
   }
   if(install_running_p(param)) {
     printf("It seems running installation process for $1/$2.\n");
     return 0;
   }
-  p=cat(home,"tmp",SLASH,param->impl,"-",param->version,SLASH,NULL);
+  p=cat(home,"tmp",SLASH,param->impl,param->version?"-":"",param->version?param->version:"",SLASH,NULL);
   ensure_directories_exist(p);
   s(p);
 
-  p=cat(home,"tmp",SLASH,param->impl,"-",param->version,".lock",NULL);
+  p=cat(home,"tmp",SLASH,param->impl,param->version?"-":"",param->version?param->version:"",".lock",NULL);
   setup_signal_handler(p);
   touch(p);
 
@@ -70,7 +72,7 @@ int start(struct install_options* param)
 
 char* download_archive_name(struct install_options* param)
 {
-  char* ret=cat(param->impl,"-",param->version,NULL);
+  char* ret=cat(param->impl,param->version?"-":"",param->version?param->version:"",NULL);
   if(param->arch_in_archive_name==0) {
     ret=s_cat(ret,q("."),q((*(install_impl->extention))(param)),NULL);
   }else {
@@ -83,18 +85,14 @@ int download(struct install_options* param)
 {
   char* home= homedir();
   char* url=(*(install_impl->uri))(param);
-  char* impl_archive;
-  if(get_opt("skip.download")) {
-    printf("Skip downloading %s\n",url);
-  }else {
+  char* archive_name=download_archive_name(param);
+  char* impl_archive=cat(home,"archives",SLASH,archive_name,NULL);
+  if(!file_exist_p(impl_archive)
+     || get_opt("download.force")) {
     printf("Downloading archive.:%s\n",url);
     /*TBD proxy support... etc*/
     if(url) {
-      char* archive_name=download_archive_name(param);
-      impl_archive=cat(home,"archives",SLASH,archive_name,NULL);
-      s(archive_name);
       ensure_directories_exist(impl_archive);
-
       if(download_simple(url,impl_archive,0)) {
 	printf("Failed to Download.\n");
 	return 0;
@@ -102,9 +100,12 @@ int download(struct install_options* param)
       }else{
 	printf("\ndone\n");
       }
+      s(url);
     }
-    s(impl_archive),s(url);
+  } else {
+    printf("Skip downloading %s\n",url);
   }
+  s(impl_archive);
   s(home);
   return 1;
 }
@@ -115,7 +116,7 @@ LVal expand_callback(LVal v1,LVal v2) {
   if(param->arch_in_archive_name) {
     int pos=position_char("/",path);
     if(pos!=-1) {
-      return (LVal)s_cat(cat(param->impl,"-",param->version,"-",param->arch,"-",param->os,NULL),subseq(path,pos,0),NULL);
+      return (LVal)s_cat(cat(param->impl,"-",param->version?param->version:"","-",param->arch,"-",param->os,NULL),subseq(path,pos,0),NULL);
     }
   }
   return (LVal)q(path);
@@ -226,17 +227,18 @@ int cmd_install(int argc,char **argv,struct sub_command* cmd)
         char* path=cat(home,"config",NULL);
         char* v=cat(param.impl,".version",NULL);
         char* version=param.version;
-        for(i=0;version[i]!='\0';++i)
-          if(version[i]=='-')
-            version[i]='\0';
         if(!install_impl->util){
+          for(i=0;version[i]!='\0';++i)
+            if(version[i]=='-')
+              version[i]='\0';
           set_opt(opts,"default.lisp",param.impl,0);
           set_opt(opts,v,version,0);
           save_opts(path,opt);
         }
         s(home),s(path),s(v);
       }
-      s(param.version),s(param.impl),s(param.arch),s(param.os);
+      if(param.version)s(param.version);
+      s(param.impl),s(param.arch),s(param.os);
       s(param.expand_path);
     }
   }else {

src/cmds/install/quicklisp.c

@@ -0,0 +1,49 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "util.h"
+#include "ros_install.h"
+#include "opt.h"
+
+int quicklisp_start(struct install_options* param)
+{
+  char* home= homedir();
+  param->version=NULL;
+  param->arch_in_archive_name=0;
+  //param->expand_path=cat(home,"src",SLASH,param->impl,SLASH,NULL);
+  s(home);
+  return 1;
+}
+
+char* quicklisp_uri(struct install_options* param)
+{
+  return q("http://beta.quicklisp.org/quicklisp.lisp");
+}
+
+char* quicklisp_extention(struct install_options* param)
+{
+  return "lisp";
+}
+
+int quicklisp_setup(struct install_options* param)
+{
+  char* home= homedir();
+  char* lisp_path=s_cat(lispdir(),q("install"),q(SLASH),q("quicklisp.lisp"),NULL);
+  char* archive=s_cat(q(home),q("archives"),q(SLASH),q("quicklisp.lisp"),NULL);
+  char* exe_path=truename(argv_orig[0]);
+  char* install_path=cat(q(home),"impls",SLASH,"ALL",SLASH,"ALL",SLASH,param->impl,SLASH,NULL);
+  {char* p[]={"--no-rc"};proccmd(sizeof(p)/sizeof(p[0]),p,top_options,top_commands);}
+  {char* p[]={"-l",archive};proccmd(sizeof(p)/sizeof(p[0]),p,top_options,top_commands);}
+  {char* p[]={"--",lisp_path,exe_path,install_path};proccmd(sizeof(p)/sizeof(p[0]),p,top_options,top_commands);}
+  s(archive),s(lisp_path),s(exe_path),s(home),s(install_path);
+  return 1;
+}
+
+install_cmds install_quicklisp_full[]= {
+  quicklisp_start,
+  start,
+  download,
+  quicklisp_setup,
+  NULL
+};
+
+struct install_impls utils_quicklisp={ "quicklisp", install_quicklisp_full,quicklisp_uri,quicklisp_extention,1};

src/cmds/install/ros_install.h

@@ -31,4 +31,5 @@ struct install_impls
 };
 
 extern struct install_impls impls_sbcl_bin;
+extern struct install_impls utils_quicklisp;
 #endif

src/cmds/run/sbcl.c

@@ -39,6 +39,9 @@ char** cmd_run_sbcl(int argc,char** argv,struct sub_command* cmd)
     offset+=1;
   if(script)
     offset+=1;
+  if(quicklisp)
+    offset+=2;
+
   if(program||script)
     offset+=4;
 
@@ -84,6 +87,11 @@ char** cmd_run_sbcl(int argc,char** argv,struct sub_command* cmd)
   if(script)
     arg[paramc++]=q("--disable-debugger");
 
+  if(quicklisp) {
+    arg[paramc++]=q("--eval");
+    arg[paramc++]=cat("#-quicklisp(cl:load \"",home,"impls",SLASH,"ALL",SLASH,"ALL",SLASH,"quicklisp",SLASH,"setup.lisp\")",NULL);
+  }
+
   if(program || script) {
     char* lisp_path=lispdir();
     arg[paramc++]=q("--load");

src/lisp/install/quicklisp.lisp

@@ -0,0 +1,16 @@
+(in-package #:qlqs-http)
+
+;; use roswell to download everithing.
+'(defun fetch (url file &key (follow-redirects t) quietly
+              (maximum-redirects *maximum-redirects*))
+  "Request URL and write the body of the response to FILE."
+  (declare (ignorable url file follow-redirects quietly
+                   maximum-redirects)))
+
+(in-package #:cl-user)
+
+(defun main (exec path &rest r)
+  (declare (ignorable r))
+  (unless (find-package :quicklisp-quickstart)
+    (error "something wrong"))
+  (quicklisp-quickstart:install :path path))

src/lsp.c

@@ -24,6 +24,7 @@ extern void register_cmd_internal(void);
 
 int verbose=0;
 int rc=1;
+int quicklisp=1;
 //dummy
 int cmd_notyet(int argc,char **argv,struct sub_command* cmd)
 {
@@ -139,6 +140,17 @@ int opt_top_rc(int argc,char** argv,struct sub_command* cmd) {
   return 1;
 }
 
+int opt_top_ql(int argc,char** argv,struct sub_command* cmd) {
+  if(strcmp(cmd->name,"quicklisp")==0) {
+    quicklisp=1;
+  }else if(strcmp(cmd->name,"no-quicklisp")==0) {
+    quicklisp=0;
+  }
+  if(verbose>0)
+    fprintf(stderr,"opt_quicklisp:%s\n",cmd->name);
+  return 1;
+}
+
 int opt_top_build0(int argc,char** argv,struct sub_command* cmd) {
   if(cmd->name) {
     char* current=get_opt("program");
@@ -184,8 +196,8 @@ LVal register_runtime_options(LVal opt) {
   /* opt=add_command(opt,"no-include","+I",cmd_notyet,1,0,"disable cl-launch installation feature",NULL); */
   opt=add_command(opt,"rc","-R",cmd_notyet,1,0,"try read /etc/rosrc, ~/.rosrc",NULL);
   opt=add_command(opt,"no-rc","+R",opt_top_rc,1,0,"skip /etc/rosrc, ~/.rosrc",NULL);
-  opt=add_command(opt,"quicklisp","-Q",cmd_notyet,1,0,"use quicklisp",NULL);
-  opt=add_command(opt,"no-quicklisp","+Q",cmd_notyet,1,0,"do not use quicklisp",NULL);
+  opt=add_command(opt,"quicklisp","-Q",opt_top_ql,1,0,"use quicklisp",NULL);
+  opt=add_command(opt,"no-quicklisp","+Q",opt_top_ql,1,0,"do not use quicklisp",NULL);
   opt=add_command(opt,"verbose","-v",opt_top_verbose,1,0,"be quite noisy while building",NULL);
   opt=add_command(opt,"quiet",NULL,opt_top_verbose,1,0,"be quite quiet while building (default)",NULL);
   return opt;

src/opt.h

@@ -49,6 +49,7 @@ extern struct opts* global_opt;
 extern struct opts* local_opt;
 extern LVal subcommand_name;
 extern int verbose;
+extern int quicklisp;
 
 LVal add_help(LVal help,const char* name,const char* usage,LVal commands,LVal opts,const char* header,const char* footer);
 LVal add_command(LVal cmd,const char* name,const char* short_name,sub_command_fnc call,int show_opt,int terminating,char* description,char* arg_example);