(IF SPECIAL (SPECIAL '(olde ptest cavar bell prna)) (DEFUN SPECIAL (x) nil) ) (DEFUN pstart (tit qust setv / xlen xpos xvar) (SETQ olde *ERROR* *ERROR* (IF ptest NIL errhan) cavar (APPEND '(("CLAYER")("CMDECHO")) setv) xlen (LENGTH cavar) xpos 0 ) (REPEAT xlen (SETQ xvar (CAR (NTH xpos cavar)) cavar (SUBST (CONS xvar (GETVAR xvar)) (NTH xpos cavar) cavar) xpos (1+ xpos) ) ) (SETVAR "CMDECHO" 0) (COMMAND "ZURšCK" "GRUPPE") ; (COMMAND "ZURUECK" "GRUPPE") ;fr Version 10 (GRAPHSCR) (PROMPT (STRCAT "\n***** " tit " *****\n\n " qust)) (PRINC) ) (DEFUN pend (/ xpos xlen xvar) (IF cavar (PROGN (COMMAND) (COMMAND "ZURšCK" "E") ; (COMMAND "ZURUECK" "E") ;fr Version 10 (SETQ xpos 1 xlen (LENGTH cavar) ) (IF (/= (GETVAR "CLAYER") (CAAR cavar)) (COMMAND "LAYER" "SE" (CDAR CAVAR) "") ) (REPEAT (1- xlen) (SETQ xvar (NTH xpos cavar) xpos (1+ xpos) ) (SETVAR (CAR xvar)(CDR xvar)) ) ) ) (IF olde (SETQ *ERROR* olde)) (PRINC) ) (DEFUN errhan (em) (IF (= em "Function cancelled") (PRINC) (PRINC em) ) (GRTEXT) (COMMAND) (COMMAND) (pend) ) (DEFUN ques (dial defa) ;Std Abfrage (IF defa (PROGN (INITGET 1 "Ja Nein Ja") (= (GETKWORD (STRCAT "\n" dial " J/N : ")) "Nein") ) (PROGN (INITGET 1 "Ja Nein Nein") (= (GETKWORD (STRCAT "\n" dial " J/N : ")) "Ja") ) ) ) (DEFUN emsg (etxt) (IF (NOT bell)(PROMPT "\007")) (TERPRI) (PROMPT etxt) (TERPRI) ) (DEFUN ques (dial defa) ;Std Abfrage (IF defa (PROGN (INITGET 1 "Ja Nein Ja") (= (GETKWORD (STRCAT "\n" dial " J/N : ")) "Nein") ) (PROGN (INITGET 1 "Ja Nein Nein") (= (GETKWORD (STRCAT "\n" dial " J/N : ")) "Ja") ) ) ) (DEFUN renv (envn prnn / penv) (IF (SETQ penv (GETENV envn)) (EVAL (STRCAT penv "" prnn)) (EVAL prnn) ) ) (DEFUN C:PRG (/ nprg cprg prna) (SETQ nprg (GETSTRING) cprg (STRCAT "C:" nprg) prna (renv "ACADLSP" nprg) ) (IF (NULL (EVAL (READ cprg))) (PROGN (PRINC " wird geladen!\n") (COND ((FINDFILE (STRCAT prna ".BI4")) (LOAD prna ".BI4")) ((FINDFILE (STRCAT prna ".BI2")) (LOAD prna ".BI2")) ((FINDFILE (STRCAT prna ".LSP")) (LOAD prna ".LSP")) ( T (emsg "Datei nicht gefunden")) ) ) ) (PRINC) ) (DEFUN C:ed (/ prnn) (IF (NULL prna) (SETQ prna "") ) (SETQ prnn (GETSTRING (STRCAT "Programmname <" prna ">: "))) (IF (AND (= (STRLEN prna) 0)(= (STRLEN prnn) 0)) (emsg "kein gltiger Name!") (PROGN (IF (> (STRLEN prnn) 0) (SETQ prna (renv "ACADLSP" prnn)) ) (COMMAND "SHELL" (STRCAT "ED " prna )) (INITGET 1 "Ja Nein Ja") (IF (NOT (ques "Pragramm laden" T)) (LOAD prna) ) ) ) (PRINC) )