View file File name : slshrl.sl Content :% -*- mode: SLang; mode: fold -*- % This file was written with the help of Mike Noble and John Houck. require ("slshhelp"); if (is_defined ("slsh_help")) use_namespace ("slsh_interactive"); else implements ("slsh_interactive"); #ifnexists quit public define quit () { exit (0); } #endif public define slsh_apropos () { if (_NARGS == 0) { vmessage ("apropos what?"); return; } variable name = (); variable help = _apropos ("Global", "\\C"+name, 0xF); variable ns = current_namespace (); if (strlen (ns) and (ns != "Global")) { variable help1 = _apropos (ns, "\\C"+name, 0xF); help1 = (ns + "->") + help1; help = [help, help1]; } if (0 == length (help)) { () = fprintf (stdout, "No matches for %S\n", name); return; } () = fprintf (stdout, " apropos %s ==>\n", name); help = help[array_sort(help)]; foreach (help) { help = (); () = fprintf (stdout, " %s\n", help); } } private define generic_help () { variable help = [ "Most commands must end in a semi-colon.", "If a command begins with '!', then the command is passed to the shell.", " Examples: !ls, !pwd, !cd foo, ...", "Parenthesis are automatically added if the first word is a function and", "is followed by a ','. For example:", " plot, 1, 2;color=\"red\" ==> plot(1,2;color=\"red\");", "Special commands:", " help <help-topic>", " apropos <something>", " start_log( <optional-log-file> );", " start logging input to a file (default is slsh.log)", " stop_log();", " stop logging input", " save_input (<optional-file>);", " save all previous input to a file (default: slsh.log)", " who;", " show a list of locally defined variables and functions", " quit;" ]; foreach (help) { variable h = (); () = fprintf (stdout, "%s\n", h); } } public define slsh_help () { if (_NARGS == 0) { generic_help (); return; } variable name = (); variable help = slsh_get_doc_string (name); if (help != NULL) { print (help; noescape); return; } () = fprintf (stdout, "*** No help on %s\n", name); slsh_apropos (name); } public define slsh_who () { variable a, name, obj; variable pat; if (_NARGS == 0) ""; pat = (); variable names = _apropos ("", pat, 8); % user defined variable foreach (names[array_sort (names)]) % user defined variable { name = (); variable type; obj = __get_reference (name); if (__is_initialized (obj)) { obj = @obj; type = typeof (obj); } else { type = Undefined_Type; obj = ""; } if ((type == String_Type) || (type == BString_Type)) print (obj, &obj); variable txt = sprintf ("%S %S=%S", type, name, obj); if (strlen(txt) > 79) txt = substr (txt, 1, 76) + "..."; message (txt); } names = _apropos ("", pat, 2); % user defined function foreach (names[array_sort(names)]) { name = (); vmessage ("function %s()", name); } } private variable Append_Semicolon = 0; public define slsh_append_semicolon (val) { Append_Semicolon = val; } static define sys_shell_cmd (cmd) { variable status; status = system (cmd); !if (status) return; () = fprintf (stdout, "shell command returned %d\n", status); } static define sys_chdir_cmd (dir) %{{{ { if (-1 == chdir (dir)) () = fprintf (stderr, "chdir(%s) failed: %s\n", dir, errno_string (errno)); } %}}} % Support interactive mode which doesn't require the ';' EOL mark. % Note that this no-semicolon-required mode causes surprising % behavior in the '.source' intrinsic. I'm taking the view % that that's the price users must pay for the convenience of % not typing the semicolons. private define maybe_append_semicolon (input) { !if (Append_Semicolon) return input; if (input[-1] != ';') input = strcat (input, ";"); return input; } % This function is called after input has been read. % It should be rewritten and made cleaner. public define slsh_interactive_massage_hook (input) { variable s, n; variable s0; variable ch; input = strtrim (input); !if (strlen (input)) return input; ch = input[0]; if (ch == '!') { % shell command, unlesss !if if (string_match (input, "^!if[ \t]*(", 1)) return input; input = strtrim (input[[1:]]); input = str_quote_string (input, "\"", '\\'); % cd is special. On unix systems we do not want to execute it in % a shell. if (strtok (input)[0] == "cd") { return sprintf ("slsh_interactive->sys_chdir_cmd(\"%s\");", strtrim (input[[2:]])); } return sprintf ("slsh_interactive->sys_shell_cmd(\"%s\");", input); } if (ch != '.') { % If the first non-word character is a comma, and the first % word is callable, then wrap the rest of the arguments in % parenthesis. s = strtrim (strtrans (input, "\\w", "")); if (s[0] == ',') { s0 = strtok (input, ", \t")[0]; if (__is_callable(__get_reference(s0))) { (s,) = strreplace (input, ",", "(", 1); return strcat (s, ");"); } } s = strtok (input, " \t"); s = strtok (input, " \t()\";"); if (length (s) == 0) return input; s0 = s[0]; if ((s0 == "exit") && (length (s)==1)) usage ("Try 'quit' to exit"); if (all (s0 != ["help", "apropos", "quit", "who"])) return maybe_append_semicolon (input); } else % line begins with "." { if (input[1] == ' ') { % RPN return input; } % The only thing that is syntactically valid here that begins % with a '.' is a floating point number. if (isdigit(input[1])) { % Do not allow the line to be parsed as RPN. So prefix % with a space. return strcat (" ", maybe_append_semicolon (input)); } %return sprintf ("eval(\" %s\");", input); input = input[[1:]]; s = strtok (input); s0 = s[0]; } if (length (s) < 2) { if (s0 == "help") return "slsh_help();"; if (s0 == "quit") return "exit(0);"; if (s0 == "who") return "slsh_who();"; return input; } if (length (s) == 2) { % Here the input consists of 2 words such as: % cd foo % load bar % help goo % apropos boo variable s1 = s[1]; if (s1[0] != '(') { if ((s0 == "apropos") or (s0 == "help")) { s0 = strcat ("slsh_", s0); if (0 == is_substr (s1, "\"")) return sprintf ("%s(\"%s\");", s0, s1); else return sprintf ("%s(%s);", s0, s1); } if (s0 == "cd") return sprintf ("slsh_interactive->sys_chdir_cmd(\"%s\");", s1); % Assume the next arg is a slang script. if ((strlen(path_extname (s1)) == 0) and (NULL != stat_file (s1 + ".sl"))) s1 = s1 + ".sl"; if (s0 == "load") return sprintf ("()=evalfile(\"%s\");", s1); #iffalse if (s0 == "source") return sprintf ("%s(\"%s\");", s0, s1); #endif } } % Anything else that does not look like a slang command will be converted % to a function call input = sprintf ("%s(%s);", s0, input[[strlen (s0):]]); return input; } %}}} %--------------------------------------------------------------------------- % Logging Functions %--------------------------------------------------------------------------- private variable Log_File = "slsh.log"; public define slsh_set_log_file (logfile) { Log_File = logfile; } private variable Log_File_Fp = NULL; private variable Input_Line_List = NULL; private variable Last_Input_Line = NULL; private define open_log_file (file) { variable fp = fopen (file, "w"); if (fp == NULL) vmessage ("***Warning: Unable to log to %s\n", file); return fp; } private define log_this () { variable args = __pop_args (_NARGS); if (Log_File_Fp == NULL) return; if (-1 == fprintf (Log_File_Fp, __push_args(args))) { vmessage ("Failed to write to log file-- logging stopped\n"); Log_File_Fp = NULL; } } public define start_log () { if (_NARGS) Log_File = (); Log_File_Fp = open_log_file (Log_File); if (Log_File_Fp == NULL) return; log_this ("%% Logging started on %s\n", time ()); log_this ("_auto_declare=%d;\n\n", _auto_declare); vmessage ("Logging input to %s\n", Log_File); } public define stop_log () { log_this ("%% Logging stopped on %s\n", time ()); Log_File_Fp = NULL; } public define save_input () { variable file; !if (_NARGS) Log_File; file = (); if (Input_Line_List == NULL) return; variable fp = open_log_file (file); if (fp == NULL) return; variable l = Input_Line_List; while (l != NULL) { () = fprintf (fp, "%s\n", l.line); l = l.next; } vmessage ("Input saved to %s", file); } private define log_input (buf) { buf = strtrim (buf); !if (strlen (buf)) return; variable l = struct { line, next }; l.line = buf; if (Input_Line_List == NULL) { Input_Line_List = l; } else Last_Input_Line.next = l; Last_Input_Line = l; if (Log_File_Fp != NULL) log_this ("%s\n", buf); } public define slsh_interactive_after_hook (line) { log_input (line); } public define slsh_interactive_before_hook () { variable n = _stkdepth (); _stk_reverse (n); loop (n) { variable v = (); () = fprintf (stdout, "%S\n", v); } }