hyperprint impl to fix the stangeness related to pprintall

This commit is contained in:
Able 2024-11-22 21:04:31 -06:00
parent 2dd2605c0c
commit 21fe30c5fe

View file

@ -59,6 +59,41 @@ object *fn_savescreen (object *args, object *env) {
}
void hyperprint (object *form, int lm, pfun_t pfun) {
if (atom(form)) {
if (isbuiltin(form, NOTHING)) printsymbol(form, pfun);
else printobject(form, pfun);
} else if (quoted(form)) {
pfun('\'');
hyperprint(car(cdr(form)), lm + 1, pfun);
} else {
lm = lm + PPINDENT;
bool fits = (subwidth(form, PPWIDTH - lm - PPINDENT) >= 0);
int special = 0, extra = 0; bool separate = true;
object *arg = car(form);
if (symbolp(arg) && builtinp(arg->name)) {
uint8_t minmax = getminmax(builtin(arg->name));
if (minmax == 0327 || minmax == 0313) special = 2; // defun, setq, setf, defvar
else if (minmax == 0317 || minmax == 0017 || minmax == 0117 || minmax == 0123) special = 1;
}
while (form != NULL) {
if (atom(form)) { pfstring(PSTR(" . "), pfun); printobject(form, pfun); pfun(')'); return; }
else if (separate) {
pfun('(');
separate = false;
} else if (special) {
pfun(' ');
special--;
} else if (fits) {
pfun(' ');
} else { pln(pfun); indent(lm, ' ', pfun); }
hyperprint(car(form), lm+extra, pfun);
form = cdr(form);
}
pfun(')');
}
}
object *fn_sym_def (object *args, object *env) {
(void) env;
object *obj = first(args);
@ -71,9 +106,9 @@ object *fn_sym_def (object *args, object *env) {
object *val = cdr(pair);
pln(pfun);
if (consp(val) && symbolp(car(val)) && builtin(car(val)->name) == LAMBDA) {
superprint(cons(bsymbol(DEFUN), cons(var, cdr(val))), 0, false, pfun);
hyperprint(cons(bsymbol(DEFUN), cons(var, cdr(val))), 0, pfun);
} else {
superprint(cons(bsymbol(DEFVAR), cons(var, cons(quote(val), NULL))), 0, false, pfun);
hyperprint(cons(bsymbol(DEFVAR), cons(var, cons(quote(val), NULL))), 0, pfun);
}
pln(pfun);
ppwidth = PPWIDTH;