138 lines
3.5 KiB
Common Lisp
138 lines
3.5 KiB
Common Lisp
(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 <J>: ")) "Nein")
|
|
)
|
|
(PROGN
|
|
(INITGET 1 "Ja Nein Nein")
|
|
(= (GETKWORD (STRCAT "\n" dial " J/N <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 <J>: ")) "Nein")
|
|
)
|
|
(PROGN
|
|
(INITGET 1 "Ja Nein Nein")
|
|
(= (GETKWORD (STRCAT "\n" dial " J/N <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)
|
|
)
|
|
|