If lde is on path, don't bother with MAIKODIR (#478 )

Minor cleanups in LLSUBRS to support new subrs.h for YIELD subr. (#479 )
Keep the \INITSUBRS in sorted order: move (YIELD 210) to the end of the list. Change the output of WRITECALLSUBRS so that the guard wraps the whole subrs.h include file. Avoid using literal tabs in the output #defines, pad with spaces and arrange the minimum field widths so that everything lines up better.
2026-03-15 14:47:09 +00:00 · 2021-09-13 21:34:03 -07:00 · 2021-09-13 20:33:43 -07:00 · 2021-09-13 05:54:31 -07:00 · 2021-09-12 11:47:14 -07:00 · 2021-09-11 17:07:57 -07:00
18 changed files with 246 additions and 174 deletions
--- a/greetfiles/NOGREET
+++ b/greetfiles/NOGREET
@@ -0,0 +1,19 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(FILECREATED "10-Sep-2021 21:25:42" {DSK}<home>larry>medley>greetfiles>NOGREET.;1 537    )
+
+
+(PRETTYCOMPRINT NOGREETCOMS)
+
+(RPAQQ NOGREETCOMS [(P (COND ((STKPOS 'GREET)
+                                  (SETQ USERGREETFILES NIL)
+                                  (CLOSEF? (INPUT))
+                                  (RETFROM 'GREET])
+
+[COND
+   ((STKPOS 'GREET)
+    (SETQ USERGREETFILES NIL)
+    (CLOSEF? (INPUT))
+    (RETFROM 'GREET]
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL)))
+STOP
--- a/lispusers/POSTSCRIPTSTREAM.TEDIT
+++ b/lispusers/POSTSCRIPTSTREAM.TEDIT
--- a/103
+++ b/103
@@ -1,16 +1,18 @@
 #!/bin/sh
 #               Run Medley
 #
-# Syntax: run-medley [--dimensions WIDTHxHEIGHT] \  sets both -g -sc
-#                    [-g WIDTHxHEIGHT]           \
-#                    [-sc WIDTHxHEIGHT]          \
-#                    [--display X_DISPLAY]       \
-#                    [--vmem | --vmfile FILE]    \
-#                    [--nogreet | --greet FILE]  \
-#                    [-n | -nl | 
-#                    [URL_OR_FILE]
+# Syntax: run-medley [--dimensions WIDTHxHEIGHT] #  sets both -g -sc
+#                    [-g WIDTHxHEIGHT]
+#                    [-sc WIDTHxHEIGHT]
+#                    [--display X_DISPLAY]       # defaults to $DISPLAY or :0
+#                    [-prog LDEFILE]
+#                    [--vmem | --vmfile FILE]
+#                    [--nogreet | --greet FILE |
+#                           --loadup FILE ]      # will separate from GREET
+#                    [-n | -nl | -full | -lisp |  
+#                    [SYSOUTFILE]

-# Directory variables are accessible from Lisp via UNIX-GETENV
+# Variables accessible from Lisp via UNIX-GETENV
 # LDESRCESYSOUT         SYSOUT full-file name you want to run
 # LDEDESTSYSOUT         name for destination of SaveVM/LOGOUT
 # MEDLEYDIR             used by init file to set other path variables
@@ -53,8 +55,17 @@ export LDEKBDTYPE=x

 while [ "$#" -ne 0 ]; do
    case "$1" in
+	"-loadup")
+	    export MEDLEYLOADUP="$2"
+	    export LDEINIT="$2"
+	    shift
+	    ;;
        "-nogreet" | "--nogreet")
-            export LDEINIT=""
+	    # Keep (GREET) from finding an init file
+	    mkdir -p $MEDLEYDIR/tmp/logindir
+	    export HOME=$MEDLEYDIR/tmp/logindir
+	    export LOGINDIR=$MEDLEYDIR/tmp/logindir
+            export LDEINIT="$MEDLEYDIR/greetfiles/NOGREET"
            ;;
        "-greet" | "--greet")
            export LDEINIT="$2"
@@ -120,8 +131,6 @@ while [ "$#" -ne 0 ]; do
    shift
 done

-# not set on command line
-
 if [ -z "$LDESRCESYSOUT" ] ; then
    if [ -f "$LDEDESTSYSOUT" ] ; then
        export LDESRCESYSOUT="$LDEDESTSYSOUT"
@@ -136,45 +145,39 @@ if [ -z "$geometry" ] ; then
    screensize="-sc 1440x900"
 fi

-case "$LDESRCSYSOUT" in
-    "http:*" | "https:*")
-    echo URL not supported yet
-    exit 1
-esac
-
-inferred_maikodir=false
-
-if [ -z "$MAIKODIR" ] ; then
-    # here we try two options relative to MEDLEYDIR: ./maiko and ../maiko
-    # this is highly imperfect, but the user can always set the env variables
-    export MAIKODIR="$MEDLEYDIR/../maiko"
-    if [ ! -d "$MAIKODIR" ] ; then
-        export MAIKODIR="$MEDLEYDIR/maiko"
-    fi
-    inferred_maikodir=true
-fi
-
-if [ ! -d "$MAIKODIR/bin" ] ; then
-    echo "MAIKODIR has no bin: $MAIKODIR"
-    if [ inferred_maikodir = true ] ; then
-        echo "I tried to infer it based on your working directory, but that didn't work."
-        echo "Try setting the MAIKODIR environment variable to the right location."
-    fi
-    exit 1
-fi
-
-
-oldpath="$PATH"
-
-export PATH=.:"$PATH"
-cd "$MAIKODIR"/bin
-export PATH="$MAIKODIR"/`osversion`.`machinetype`:"$oldpath"
-
-cd "$OLDPWD"
-
 if ! command -v "$prog" > /dev/null 2>&1; then
-    echo "$prog" not found
-    exit 1
+    # if lde is already on path, don't reset it
+    # otherwise check for MAIKODIR
+
+    if [ -z "$MAIKODIR" ] ; then
+	# try two options relative to MEDLEYDIR: ./maiko and ../maiko
+	MAIKODIR="$MEDLEYDIR/../maiko"
+	if ! command -v "$MAIKODIR/bin/osversion" > /dev/null 2>&1; then
+            MAIKODIR="$MEDLEYDIR/maiko"
+	fi
+    fi
+
+    if ! command -v "$MAIKODIR/bin/osversion" > /dev/null 2>&1; then
+	echo "Could not find 'lde' on PATH"
+	echo "nor MAIKODIR with 'bin/osversion' (to look for it)"
+	exit 1
+    fi
+
+    oldpath="$PATH"
+    oldpwd=`pwd`
+    PATH=.:"$PATH"
+    cd "$MAIKODIR"/bin
+    osv=`osversion`
+    mct=`machinetype`
+    newpath="$MAIKODIR"/"$osv.$mct"
+    PATH="$newpath":"$oldpath"
+    cd "$oldpwd"
+    if ! command -v $prog > /dev/null 2>&1; then
+	echo $prog not found in $newpath
+	echo osversion = $osv
+	echo machinetype = $mct
+	exit 1
+    fi
 fi

 echo "running: $prog $geometry $screensize $mem $passthrough_args $LDESRCESYSOUT"
--- a/scripts/loadup-all.sh
+++ b/scripts/loadup-all.sh
@@ -7,10 +7,6 @@ if [ ! -x run-medley ] ; then
    exit 1
 fi

-# set timestamp
-mkdir -p ./tmp
-touch ./tmp/loadup.timestamp
-
 ./scripts/loadup-init.sh && \
    ./scripts/loadup-mid-from-init.sh && \
    ./scripts/loadup-lisp-from-mid.sh && \
--- a/scripts/loadup-aux.sh
+++ b/scripts/loadup-aux.sh
@@ -9,10 +9,15 @@ fi

 touch tmp/loadup.timestamp

+# Keep (GREET) from finding an init file
+mkdir -p $MEDLEYDIR/tmp/logindir
+export HOME=$MEDLEYDIR/tmp/logindir
+export LOGINDIR=$MEDLEYDIR/tmp/logindir
+
 scr="-sc 1024x768 -g 1042x790"

 echo '" (IL:MEDLEY-INIT-VARS)(IL:LOAD(QUOTE MEDLEY-UTILS))(IL:MAKE-EXPORTS-ALL)(IL:MAKE-WHEREIS-HASH)(IL:LOGOUT T)"' > tmp/loadup-aux.cm
-./run-medley $scr -greet "$MEDLEYDIR"/tmp/loadup-aux.cm tmp/full.sysout
+./run-medley $scr -loadup "$MEDLEYDIR"/tmp/loadup-aux.cm tmp/full.sysout

 if [ tmp/whereis.hash -nt tmp/loadup.timestamp ]; then
    
--- a/scripts/loadup-full-from-lisp.sh
+++ b/scripts/loadup-full-from-lisp.sh
@@ -10,7 +10,12 @@ scr="-sc 1024x768 -g 1042x790"

 touch tmp/loadup.timestamp

-./run-medley $scr -greet "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/tmp/lisp.sysout"
+# Keep (GREET) from finding an init file
+mkdir -p $MEDLEYDIR/tmp/logindir
+export HOME=$MEDLEYDIR/tmp/logindir
+export LOGINDIR=$MEDLEYDIR/tmp/logindir
+
+./run-medley $scr -loadup "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/tmp/lisp.sysout"

 if [ tmp/full.sysout -nt tmp/loadup.timestamp ]; then
    
--- a/scripts/loadup-full.sh
+++ b/scripts/loadup-full.sh
@@ -6,11 +6,17 @@ if [ ! -x run-medley ] ; then
    echo must run from MEDLEYDIR ;
    exit 1 ;
 fi
+
+# Keep (GREET) from finding an init file
+mkdir -p $MEDLEYDIR/tmp/logindir
+export HOME=$MEDLEYDIR/tmp/logindir
+export LOGINDIR=$MEDLEYDIR/tmp/logindir
+
 scr="-sc 1024x768 -g 1042x790"

 touch tmp/loadup.timestamp

-./run-medley $scr -greet "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/loadups/lisp.sysout"
+./run-medley $scr -loadup "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/loadups/lisp.sysout"

 if [ tmp/full.sysout -nt tmp/loadup.timestamp ]; then
    
--- a/scripts/loadup-init.sh
+++ b/scripts/loadup-init.sh
@@ -9,10 +9,14 @@ fi

 scr="-sc 1024x768 -g 1042x790"

-mkdir -p "$MEDLEYDIR/tmp"
+# Keep (GREET) from finding an init file
+mkdir -p $MEDLEYDIR/tmp/logindir
+export HOME=$MEDLEYDIR/tmp/logindir
+export LOGINDIR=$MEDLEYDIR/tmp/logindir
+
 touch tmp/loadup.timestamp

-./run-medley $scr -greet "$MEDLEYDIR"/sources/LOADUP-INIT.LISP loadups/starter.sysout
+./run-medley $scr -loadup "$MEDLEYDIR"/sources/LOADUP-INIT.LISP loadups/starter.sysout

 if [ tmp/init.dlinit -nt tmp/loadup.timestamp ]; then
    
--- a/scripts/loadup-lisp-from-mid.sh
+++ b/scripts/loadup-lisp-from-mid.sh
@@ -12,7 +12,7 @@ touch tmp/loadup.timestamp
 scr="-sc 1024x768 -g 1042x790"


-./run-medley $scr -greet "$MEDLEYDIR/sources/LOADUP-LISP.CM" tmp/init-mid.sysout
+./run-medley $scr -loadup "$MEDLEYDIR/sources/LOADUP-LISP.CM" tmp/init-mid.sysout

 if [ tmp/lisp.sysout -nt tmp/loadup.timestamp ]; then
    
--- a/scripts/loadup-mid-from-init.sh
+++ b/scripts/loadup-mid-from-init.sh
@@ -12,7 +12,7 @@ touch tmp/loadup.timestamp

 scr="-sc 1024x768 -g 1042x790"

-./run-medley -prog ldeinit -greet $MEDLEYDIR/sources/XREM.CM $scr -vmem tmp/init-mid.sysout tmp/init.dlinit
+./run-medley -prog ldeinit -loadup $MEDLEYDIR/sources/XREM.CM $scr -vmem tmp/init-mid.sysout tmp/init.dlinit


 echo 
--- a/sources/ASTACK
+++ b/sources/ASTACK
@@ -1,13 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-(FILECREATED "23-May-91 14:25:00" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>ASTACK.;4| 43099  
+(FILECREATED "11-Sep-2021 12:54:19" {DSK}<home>larry>medley>sources>ASTACK.;2 43098  

-      changes to%:  (FNS \STKARG)
+      changes to%:  (FNS STKARGNAME)

-      previous date%: "20-Feb-91 13:47:06" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>ASTACK.;3|)
+      previous date%: "23-May-91 14:25:00" {DSK}<home>larry>medley>sources>ASTACK.;1)


 (* ; "
-Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1982-1987, 1990-1991 by Venue & Xerox Corporation.
 ")

 (PRETTYCOMPRINT ASTACKCOMS)
@@ -501,7 +501,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Co
                     (T (LISPERROR "ILLEGAL STACK ARG" N])

 (STKARGNAME
-  [LAMBDA (N POS)                                        (* ; "Edited 18-Feb-91 16:55 by jds")
+  [LAMBDA (N POS NOERROR)                              (* ; "Edited 11-Sep-2021 12:51 by larry")

    (* ;; "Given an interpreted frame and an argument number, return the name of that argument (actually, just the n-th NameTable entry)")

@@ -552,6 +552,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Co
                                                                           WORDSPERCELL]
                                (RETURN)))
                            (MAKE-NTENTRY PVARCODE (SUB1 NTENTRY)))
+                           (NOERROR (RETURN))
                           (T (LISPERROR "ILLEGAL STACK ARG" N]
          (RETURN (for NT1 from (fetch (FNHEADER OVERHEADWORDS) of T)
                     by (CONSTANT (WORDSPERNAMEENTRY)) as NT2
@@ -789,13 +790,13 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Co
 )
 (PUTPROPS ASTACK COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1991))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1519 4724 (ARG 1529 . 1688) (SETARG 1690 . 1874) (\ARG 1876 . 2111) (\ARGPTR 2113 . 
-4455) (\SETARG 4457 . 4722)) (4725 8940 (\RETURN 4735 . 5093) (\STACKARGPTR 5095 . 8938)) (8985 12362 
-(STKNTH 8995 . 9893) (STKNTHNAME 9895 . 10782) (STKNAME 10784 . 10929) (SETSTKNAME 10931 . 12360)) (
-12363 16138 (STKPOS 12373 . 13294) (STKSCAN 13296 . 13942) (RETFROM 13944 . 14298) (RETTO 14300 . 
-14575) (RESUME 14577 . 15950) (\RESUME 15952 . 16136)) (16139 42186 (STKARG 16149 . 16484) (\STKARG 
-16486 . 21189) (SETSTKARG 21191 . 25374) (STKARGNAME 25376 . 29599) (\SPREADFRAMEP 29601 . 30142) (
-SETSTKARGNAME 30144 . 33435) (STKNARGS 33437 . 35846) (FRAMESCAN 35848 . 36298) (\INTERPFRAMENT 36300
- . 36700) (\FRAMESCAN 36702 . 39755) (\VAROFFSET 39757 . 42184)) (42228 42781 (\RECLAIMSTACKP 42238 . 
-42779)))))
+  (FILEMAP (NIL (1470 4675 (ARG 1480 . 1639) (SETARG 1641 . 1825) (\ARG 1827 . 2062) (\ARGPTR 2064 . 
+4406) (\SETARG 4408 . 4673)) (4676 8891 (\RETURN 4686 . 5044) (\STACKARGPTR 5046 . 8889)) (8936 12313 
+(STKNTH 8946 . 9844) (STKNTHNAME 9846 . 10733) (STKNAME 10735 . 10880) (SETSTKNAME 10882 . 12311)) (
+12314 16089 (STKPOS 12324 . 13245) (STKSCAN 13247 . 13893) (RETFROM 13895 . 14249) (RETTO 14251 . 
+14526) (RESUME 14528 . 15901) (\RESUME 15903 . 16087)) (16090 42185 (STKARG 16100 . 16435) (\STKARG 
+16437 . 21140) (SETSTKARG 21142 . 25325) (STKARGNAME 25327 . 29598) (\SPREADFRAMEP 29600 . 30141) (
+SETSTKARGNAME 30143 . 33434) (STKNARGS 33436 . 35845) (FRAMESCAN 35847 . 36297) (\INTERPFRAMENT 36299
+ . 36699) (\FRAMESCAN 36701 . 39754) (\VAROFFSET 39756 . 42183)) (42227 42780 (\RECLAIMSTACKP 42237 . 
+42778)))))
 STOP
--- a/sources/ASTACK.LCOM
+++ b/sources/ASTACK.LCOM
--- a/sources/DEBUGGER
+++ b/sources/DEBUGGER
@@ -1,14 +1,14 @@
-(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "DEBUGGER" (PREFIX-NAME "DBG") (NICKNAMES 
-"DBG")))
-(IL:FILECREATED "16-Aug-91 17:38:56" IL:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>DEBUGGER.;3| 84381  
+(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "DEBUGGER" (PREFIX-NAME "DBG") (NICKNAMES "DBG")) READTABLE 
+"XCL" BASE 10)
+(IL:FILECREATED "11-Sep-2021 12:57:01" IL:|{DSK}<home>larry>medley>sources>DEBUGGER.;2| 84311  

-      IL:|changes| IL:|to:|  (IL:FUNCTIONS DEBUGGER-EVAL)
+      IL:|changes| IL:|to:|  (IL:FUNCTIONS STACK-FRAME-PROPERTIES)

-      IL:|previous| IL:|date:| "16-May-90 15:26:02" IL:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>DEBUGGER.;2|
+      IL:|previous| IL:|date:| "16-Aug-91 17:38:56" IL:|{DSK}<home>larry>medley>sources>DEBUGGER.;1|
 )


-; Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation.  All rights reserved.
+; Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.

 (IL:PRETTYCOMPRINT IL:DEBUGGERCOMS)

@@ -520,14 +520,13 @@

 (DEFVAR IL:LASTPOS)

-(XCL:DEFCOMMAND ("@" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV) 
+(XCL:DEFCOMMAND ("@" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV)
   "Set debugger stack pointer to location specified by PLACE (or default)"
   (FORMAT T "@ = ~S~%" (IL:STKNAME (FIND-DEBUGGER-STACK-FRAME IL:PLACE IL:ENV)))
   (VALUES))

-(XCL:DEFCOMMAND ("REVERT" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV) (DECLARE (SPECIAL
-                                                                                        IL:BRKVALUES)
-                                                                                 )
+(XCL:DEFCOMMAND ("REVERT" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV)
+   (DECLARE (SPECIAL IL:BRKVALUES))
   "Unwind to specified frame (or LASTPOS) and enter breakpoint"

   (IL:* IL:|;;| "Find the stack frame that the user asked to unwind to , if any:")
@@ -561,7 +560,8 @@
                                         (IL:RELSTK IL:POS))))))))
    (THROW 'DEBUGGER-EXIT NIL)))

-(XCL:DEFCOMMAND ("?=" :DEBUGGER) NIL "Show arguments"
+(XCL:DEFCOMMAND ("?=" :DEBUGGER) ()
+   "Show arguments"
   (MULTIPLE-VALUE-BIND (IL:NAME IL:DEFN)
          (FIND-ORIGINAL-NAME-AND-DEFINITION IL:LASTPOS)
          (MULTIPLE-VALUE-BIND (IL:LAMBDA-CAR IL:ARGLIST)
@@ -589,7 +589,7 @@
                                           0 T))))))
   (VALUES))

-(XCL:DEFCOMMAND ("EVAL" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL IL:EXPRESSION-PROVIDED?)) 
+(XCL:DEFCOMMAND ("EVAL" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL IL:EXPRESSION-PROVIDED?))
   (DECLARE (SPECIAL IL:BRKENV IL:BRKVALUES))
   "Evaluate expression in debugged context"
   (XCL:CONDITION-CASE (IF IL:EXPRESSION-PROVIDED?
@@ -600,14 +600,15 @@
          (SI::DEBUGGER-EVAL-ABORTED (IL:C)
                 (VALUES :ABORTED (SI::DEBUGGER-EVAL-ABORTED-CONDITION IL:C)))))

-(XCL:DEFCOMMAND ("VALUE" :DEBUGGER :QUIET) NIL 
+(XCL:DEFCOMMAND ("VALUE" :DEBUGGER :QUIET) ()
   "Show value from previous evaluation of debug expression"
   (IF IL:BRKVALUES
       (VALUES-LIST (CDR IL:BRKVALUES))
       (PROGN (FORMAT T "Not yet evaluated~&")
              (VALUES))))

-(XCL:DEFCOMMAND ("UB" :DEBUGGER) (&OPTIONAL (IL:FN IL:BRKFN)) "Unbreak function with breakpoint"
+(XCL:DEFCOMMAND ("UB" :DEBUGGER) (&OPTIONAL (IL:FN IL:BRKFN))
+   "Unbreak function with breakpoint"
   (DECLARE (SPECIAL IL:BRKFN))
   (IL:EVAL (LIST 'XCL:UNBREAK IL:FN)))

@@ -882,26 +883,32 @@
              (return nil))))
 )

-(XCL:DEFCOMMAND ("BT" :DEBUGGER) NIL "Print backtrace of external frames"
+(XCL:DEFCOMMAND ("BT" :DEBUGGER) ()
+   "Print backtrace of external frames"
   (PRINT-BACKTRACE :FROM IL:LASTPOS :TEST 'XCL::INTERESTING-FRAME-P)
   (VALUES))

-(XCL:DEFCOMMAND ("BT!" :DEBUGGER) NIL "Print backtrace of all frames"
+(XCL:DEFCOMMAND ("BT!" :DEBUGGER) ()
+   "Print backtrace of all frames"
   (PRINT-BACKTRACE :FROM IL:LASTPOS :TEST NIL)
   (VALUES))

-(XCL:DEFCOMMAND ("BTV" :DEBUGGER) NIL "Print backtrace of frames and special bindings"
+(XCL:DEFCOMMAND ("BTV" :DEBUGGER) ()
+   "Print backtrace of frames and special bindings"
   (PRINT-BACKTRACE :FROM IL:LASTPOS :PRINT-VARIABLES T)
   (VALUES))

-(XCL:DEFCOMMAND ("BTV!" :DEBUGGER) NIL "Print backtrace of all frame information"
+(XCL:DEFCOMMAND ("BTV!" :DEBUGGER) ()
+   "Print backtrace of all frame information"
   (PRINT-BACKTRACE :FROM IL:LASTPOS :PRINT-VARIABLES T :PRINT-JUNK T)
   (VALUES))

-(XCL:DEFCOMMAND ("DBT" :DEBUGGER) NIL (ATTACH-BACKTRACE-MENU NIL T)
+(XCL:DEFCOMMAND ("DBT" :DEBUGGER) ()
+   (ATTACH-BACKTRACE-MENU NIL T)
   (VALUES))

-(XCL:DEFCOMMAND ("DBT!" :DEBUGGER) NIL (ATTACH-BACKTRACE-MENU)
+(XCL:DEFCOMMAND ("DBT!" :DEBUGGER) ()
+   (ATTACH-BACKTRACE-MENU)
   (VALUES))

 (DEFUN ATTACH-BACKTRACE-MENU (&OPTIONAL IL:TTYWINDOW IL:SKIP)
@@ -1209,7 +1216,7 @@
                                                                                         0
                        IL:AS I IL:|from| (1+ NUM-ARGS) IL:|to| TOTAL-SLOTS
                        IL:|when| (AND (IL:NEQ NOVALUE (IL:STKARG I POS NOVALUE))
-                                           (OR (SETF ARGNAME (IL:STKARGNAME I POS))
+                                           (OR (SETF ARGNAME (IL:STKARGNAME I POS T))
                                               (AND LOTS? (SETQ ARGNAME (FORMAT NIL "local ~D" PVAR))
                                                    ))) IL:|collect| (LIST ARGNAME I))))
             (AND SLOTS (CONS '("locals")
@@ -1345,16 +1352,19 @@
                 (T 0)))
          OUTPUT))

-(XCL:DEFCOMMAND ("STOP" :DEBUGGER :QUIET) NIL "Exit this debugger level"
+(XCL:DEFCOMMAND ("STOP" :DEBUGGER :QUIET) ()
+   "Exit this debugger level"
   (IL:SETQ IL:BRKVALUES '(IL:ERROR!))
   (THROW 'DEBUGGER-EXIT NIL))

-(XCL:DEFCOMMAND ("^" :DEBUGGER :QUIET) NIL "Abort out of debugger"
+(XCL:DEFCOMMAND ("^" :DEBUGGER :QUIET) ()
+   "Abort out of debugger"
   (IL:SETQ IL:BRKVALUES '(IL:ERROR!))
   (THROW 'DEBUGGER-EXIT NIL))

-(XCL:DEFCOMMAND ("RETURN" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL)
-                                            &ENVIRONMENT IL:ENV) "Return value from debugger"
+(XCL:DEFCOMMAND ("RETURN" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL)
+                                                &ENVIRONMENT IL:ENV)
+   "Return value from debugger"
   (XCL:CONDITION-CASE (PROGN (IL:SETQ IL:BRKVALUES (LIST 'RETURN (MULTIPLE-VALUE-LIST (
                                                                                      DEBUGGER-EVAL
                                                                                        IL:EXPRESSION
@@ -1364,20 +1374,23 @@
          (SI::DEBUGGER-EVAL-ABORTED (IL:C)
                 (VALUES :ABORTED (SI::DEBUGGER-EVAL-ABORTED-CONDITION IL:C)))))

-(XCL:DEFCOMMAND ("PR" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER) "Select and invoke a proceed case."
-   (ESCAPE-FROM-DEBUGGER T IL:NAME-OR-NUMBER)
-   (VALUES))
-
-(XCL:DEFCOMMAND ("PR!" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER) "Select and invoke a proceed case."
-   (ESCAPE-FROM-DEBUGGER NIL IL:NAME-OR-NUMBER)
-   (VALUES))
-
-(XCL:DEFCOMMAND ("PROCEED" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER) 
+(XCL:DEFCOMMAND ("PR" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
   "Select and invoke a proceed case."
   (ESCAPE-FROM-DEBUGGER T IL:NAME-OR-NUMBER)
   (VALUES))

-(XCL:DEFCOMMAND ("OK" :DEBUGGER :QUIET) NIL (DECLARE (SPECIAL IL:BRKENV))
+(XCL:DEFCOMMAND ("PR!" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
+   "Select and invoke a proceed case."
+   (ESCAPE-FROM-DEBUGGER NIL IL:NAME-OR-NUMBER)
+   (VALUES))
+
+(XCL:DEFCOMMAND ("PROCEED" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
+   "Select and invoke a proceed case."
+   (ESCAPE-FROM-DEBUGGER T IL:NAME-OR-NUMBER)
+   (VALUES))
+
+(XCL:DEFCOMMAND ("OK" :DEBUGGER :QUIET) ()
+   (DECLARE (SPECIAL IL:BRKENV))
   "Exit/proceed from debugger"
   (XCL:CONDITION-CASE (PROGN (WHEN (TYPEP IL:BRKCOND 'SI::BREAKPOINT)

@@ -1530,6 +1543,27 @@
 )
 (IL:PUTPROPS XCL:DEBUGGER IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991))
 (IL:DECLARE\: IL:DONTCOPY
-  (IL:FILEMAP (NIL (18680 18967 (IL:WBREAK 18693 . 18965)) (42297 47159 (IL:BAKTRACE 42310 . 45094) (
-IL:BAKTRACE1 45096 . 47157)) (81689 83655 (IL:FIND-STACK-FRAME 81702 . 83653)))))
+  (IL:FILEMAP (NIL (4639 6450 (XCL:ENTER-DEBUGGER-P 4639 . 6450)) (6452 13574 (XCL:DEBUGGER 6452 . 13574
+)) (13576 13890 (EMERGENCY-PANIC-LOOP 13576 . 13890)) (13892 15347 (IL:FIND-DEBUGGER-ENTRY-FRAME 13892
+ . 15347)) (15349 16038 (PRINT-ENTRY-MESSAGE 15349 . 16038)) (16040 16341 (SIMPLE-REPORT-CONDITION 
+16040 . 16341)) (16343 18083 (XCL::INTERESTING-FRAME-P 16343 . 18083)) (18668 18955 (IL:WBREAK 18681
+ . 18953)) (19068 20177 (REUSE-CURRENT-WINDOW 19068 . 20177)) (20179 21483 (CREATE-DEBUGGER-WINDOW 
+20179 . 21483)) (21485 22437 (SET-UP-DEBUGGER-WINDOW 21485 . 22437)) (22439 23454 (
+CLOSE-DEBUGGER-WINDOW 22439 . 23454)) (23456 23942 (RELEASE-DEBUGGER-WINDOW 23456 . 23942)) (23944 
+24881 (NEAR-BY-REGION 23944 . 24881)) (24883 25993 (DEBUGGER-BUTTON-EVENT 24883 . 25993)) (25995 26932
+ (DEBUGGER-MENU-HELP 25995 . 26932)) (31872 33690 (DEBUGGER-EVAL 31872 . 33690)) (33692 38041 (
+FIND-DEBUGGER-STACK-FRAME 33692 . 38041)) (38043 38782 (FIND-NAMED-STACK-POSITION 38043 . 38782)) (
+38784 39416 (FIND-ORIGINAL-NAME-AND-DEFINITION 38784 . 39416)) (39418 39552 (STKPTR-CCODE 39418 . 
+39552)) (42143 47005 (IL:BAKTRACE 42156 . 44940) (IL:BAKTRACE1 44942 . 47003)) (47841 54770 (
+ATTACH-BACKTRACE-MENU 47841 . 54770)) (54772 57983 (REGION-NEXT-TO 54772 . 57983)) (57985 59428 (
+BACKTRACE-MENU-BUTTONEVENTFN 57985 . 59428)) (59430 63704 (BACKTRACE-ITEM-SELECTED 59430 . 63704)) (
+63706 67543 (STACK-FRAME-PROPERTIES 63706 . 67543)) (67545 68555 (STACK-FRAME-FETCHFN 67545 . 68555)) 
+(68557 69744 (STACK-FRAME-STOREFN 68557 . 69744)) (69746 70321 (STACK-FRAME-VALUE-COMMAND 69746 . 
+70321)) (70323 70733 (STACK-FRAME-PROPERTY 70323 . 70733)) (70735 72720 (MAKE-FRAME-INSPECT-WINDOW 
+70735 . 72720)) (72722 72919 (%RELEASE-STACK-DATUM 72722 . 72919)) (72921 73627 (PRINT-BACKTRACE 72921
+ . 73627)) (76856 76950 (EXIT-DEBUGGER 76856 . 76950)) (76952 77271 (INVOKE-ESCAPE-FROM-MENU 76952 . 
+77271)) (77273 78696 (ESCAPE-FROM-DEBUGGER 77273 . 78696)) (78698 79076 (MENU-FROM-ESCAPE-LIST 78698
+ . 79076)) (79078 80237 (KEYLIST-FROM-ESCAPE-LIST 79078 . 80237)) (80239 81247 (COLLECT-ACTIVE-ESCAPES
+ 80239 . 81247)) (81249 81618 (IL:FIND-LEXICAL-ENVIRONMENT 81249 . 81618)) (81619 83585 (
+IL:FIND-STACK-FRAME 81632 . 83583)))))
 IL:STOP
--- a/sources/DEBUGGER.DFASL
+++ b/sources/DEBUGGER.DFASL
--- a/sources/LLSUBRS
+++ b/sources/LLSUBRS
@@ -1,17 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-(FILECREATED "17-Mar-2021 11:10:55" {DSK}<home>larry>ilisp>medley>sources>LLSUBRS.;6 27745  
+(FILECREATED "13-Sep-2021 17:12:03" {DSK}<Users>briggs>Projects>medley>sources>LLSUBRS.;8 27017  

      changes to%:  (VARS \INITSUBRS)
-                    (FNS MISCN-NUMBER \MISCN.UFN \UNDEFINED-MISCN-UFN MISCN-COLLECT \GET-MY-BF 
-                         \INIT-MISCN-TABLE \USER-SUBR-UFN \INIT-USER-SUBR-TABLE 
-                         \UNDEFINED-USER-SUBR-UFN USER-SUBR-NUMBER EQ-TO-CAR EQ-TO-CADR SUBRNUMBER 
-                         WRITECALLSUBRS FIX-SUBR-NAME \MOREVMEMFILE \WRITEMAP \COPYSYS0SUBR 
-                         \PUPLEVEL1STATE SHOWDISPLAY SETSCREENCOLOR \WRITERAWPBI \READRAWPBI RAID 
-                         \LISPFINISH \GETPACKETBUFFER \GATHERSTATS \DSPRATE DSPBOUT DISKPARTITION 
-                         \CHECKBCPLPASSWORD SUSPEND-LISP UNIX-USERNAME UNIX-FULLNAME UNIX-GETENV 
-                         UNIX-GETPARM)
+                    (FNS WRITECALLSUBRS)

-      previous date%: "16-Mar-2021 23:00:15" {DSK}<home>larry>ilisp>medley>sources>LLSUBRS.;3)
+      previous date%: "13-Sep-2021 16:07:08" {DSK}<VAR>TMP>LLSUBRS.;1)


 (* ; "
@@ -316,8 +309,7 @@ Copyright (c) 1983-1986, 1988-1992, 2021 by Venue & Xerox Corporation.

 (* "FOLLOWING DEFINITIONS EXPORTED")
 (RPAQQ \INITSUBRS
-       ((YIELD 210)
-        (BACKGROUNDSUBR 6)
+       ((BACKGROUNDSUBR 6)
        (CHECKBCPLPASSWORD 7)
        (DISKPARTITION 8)
        (DSPBOUT 9)
@@ -442,7 +434,8 @@ Copyright (c) 1983-1986, 1988-1992, 2021 by Venue & Xerox Corporation.
        (CHAR-READP 206)
        (CHAR-BINS 207)
        (CHAR-BOUTS 208)
-        (CHAR-FILLBUFFER 209)))
+        (CHAR-FILLBUFFER 209)
+        (YIELD 210)))

 (* "END EXPORTED DEFINITIONS")

@@ -485,25 +478,25 @@ Copyright (c) 1983-1986, 1988-1992, 2021 by Venue & Xerox Corporation.
 (DEFINEQ

 (WRITECALLSUBRS
-  [LAMBDA NIL                                          (* ; "Edited 17-Mar-2021 11:05 by larry")
+  [LAMBDA NIL                                         (* ; "Edited 13-Sep-2021 15:19 by briggs")
    (CL:WITH-OPEN-FILE (*STANDARD-OUTPUT* "subrs.h" :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION)
-           (CL:FORMAT T "/* This file written from LLSUBRS on ~A                      */~&" (DATE))
-           (CL:FORMAT T "/* Do not edit this file! Instead, edit the list \initsubrs */~&")
-           (CL:FORMAT T "/* on the lisp file LLSUBRS and then call WRITECALLSUBRS to  */~&")
-           (CL:FORMAT T "/* generate a new version.                                   */~&")
           (CL:FORMAT T "#ifndef SUBRS_H~&#define SUBRS_H 1~&")
-           (for X in \INITSUBRS do (CL:FORMAT T "#define sb_~A	0~O~&" (FIX-SUBR-NAME
-                                                                                   (CAR X))
+           (CL:FORMAT T "/* This file written from LLSUBRS on ~22A */~&" (DATE))
+           (CL:FORMAT T "/* Do not edit this file! Instead, edit the list \initsubrs */~&")
+           (CL:FORMAT T "/* on the lisp file LLSUBRS and then call WRITECALLSUBRS to */~&")
+           (CL:FORMAT T "/* generate a new version.                                  */~&")
+           (for X in \INITSUBRS do (CL:FORMAT T "#define sb_~42A 0~O~&"
+                                                      (FIX-SUBR-NAME (CAR X))
                                                      (CADR X)))
           (CL:FORMAT T "~&~&/* MISCN opcodes */~&")
-           (for X in \MISCN-TABLE-LIST do (CL:FORMAT T "#define miscn_~A	0~O~&"
+           (for X in \MISCN-TABLE-LIST do (CL:FORMAT T "#define miscn_~39A 0~O~&"
                                                             (FIX-SUBR-NAME (CAR X))
                                                             (CADR X)))
           (CL:FORMAT T "~&~&/* Assigned USER SUBR numbers */~&")
-           (for X in \USER-SUBR-LIST do (CL:FORMAT T "#define user_subr_~A	0~O~&"
+           (for X in \USER-SUBR-LIST do (CL:FORMAT T "#define user_subr_~35A 0~O~&"
                                                           (FIX-SUBR-NAME (CAR X))
                                                           (CADR X)))
-           (CL:FORMAT T "#endif ~&"])
+           (CL:FORMAT T "#endif~&"])

 (FIX-SUBR-NAME
  [LAMBDA (NAME)                                         (* ; "Edited 13-Feb-89 16:17 by jds")
@@ -695,16 +688,16 @@ Copyright (c) 1983-1986, 1988-1992, 2021 by Venue & Xerox Corporation.
 (PUTPROPS LLSUBRS COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1988 1989 1990 1991 1992 
 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4322 9066 (MISCN-NUMBER 4332 . 4548) (\MISCN.UFN 4550 . 6807) (\UNDEFINED-MISCN-UFN 
-6809 . 7125) (MISCN-COLLECT 7127 . 7344) (\GET-MY-BF 7346 . 7558) (\INIT-MISCN-TABLE 7560 . 9064)) (
-10450 11739 (ADD-USER-SUBR 10450 . 11739)) (11740 13491 (\USER-SUBR-UFN 11750 . 12325) (
-\INIT-USER-SUBR-TABLE 12327 . 12792) (\UNDEFINED-USER-SUBR-UFN 12794 . 13137) (USER-SUBR-NUMBER 13139
- . 13361) (EQ-TO-CAR 13363 . 13424) (EQ-TO-CADR 13426 . 13489)) (17774 18423 (SUBRNUMBER 17784 . 18421
-)) (18484 20832 (WRITECALLSUBRS 18494 . 20075) (FIX-SUBR-NAME 20077 . 20830)) (21041 26945 (
-\MOREVMEMFILE 21051 . 21216) (\WRITEMAP 21218 . 21378) (\COPYSYS0SUBR 21380 . 21540) (\PUPLEVEL1STATE 
-21542 . 21706) (SHOWDISPLAY 21708 . 21997) (SETSCREENCOLOR 21999 . 22162) (\WRITERAWPBI 22164 . 22322)
- (\READRAWPBI 22324 . 22476) (RAID 22478 . 22633) (\LISPFINISH 22635 . 22793) (\GETPACKETBUFFER 22795
- . 22957) (\GATHERSTATS 22959 . 23117) (\DSPRATE 23119 . 23386) (DSPBOUT 23388 . 23542) (DISKPARTITION
- 23544 . 23839) (\CHECKBCPLPASSWORD 23841 . 24020) (SUSPEND-LISP 24022 . 24280) (UNIX-USERNAME 24282
- . 24804) (UNIX-FULLNAME 24806 . 25332) (UNIX-GETENV 25334 . 25931) (UNIX-GETPARM 25933 . 26943)))))
+  (FILEMAP (NIL (3639 8383 (MISCN-NUMBER 3649 . 3865) (\MISCN.UFN 3867 . 6124) (\UNDEFINED-MISCN-UFN 
+6126 . 6442) (MISCN-COLLECT 6444 . 6661) (\GET-MY-BF 6663 . 6875) (\INIT-MISCN-TABLE 6877 . 8381)) (
+9767 11056 (ADD-USER-SUBR 9767 . 11056)) (11057 12808 (\USER-SUBR-UFN 11067 . 11642) (
+\INIT-USER-SUBR-TABLE 11644 . 12109) (\UNDEFINED-USER-SUBR-UFN 12111 . 12454) (USER-SUBR-NUMBER 12456
+ . 12678) (EQ-TO-CAR 12680 . 12741) (EQ-TO-CADR 12743 . 12806)) (17091 17740 (SUBRNUMBER 17101 . 17738
+)) (17801 20104 (WRITECALLSUBRS 17811 . 19347) (FIX-SUBR-NAME 19349 . 20102)) (20313 26217 (
+\MOREVMEMFILE 20323 . 20488) (\WRITEMAP 20490 . 20650) (\COPYSYS0SUBR 20652 . 20812) (\PUPLEVEL1STATE 
+20814 . 20978) (SHOWDISPLAY 20980 . 21269) (SETSCREENCOLOR 21271 . 21434) (\WRITERAWPBI 21436 . 21594)
+ (\READRAWPBI 21596 . 21748) (RAID 21750 . 21905) (\LISPFINISH 21907 . 22065) (\GETPACKETBUFFER 22067
+ . 22229) (\GATHERSTATS 22231 . 22389) (\DSPRATE 22391 . 22658) (DSPBOUT 22660 . 22814) (DISKPARTITION
+ 22816 . 23111) (\CHECKBCPLPASSWORD 23113 . 23292) (SUSPEND-LISP 23294 . 23552) (UNIX-USERNAME 23554
+ . 24076) (UNIX-FULLNAME 24078 . 24604) (UNIX-GETENV 24606 . 25203) (UNIX-GETPARM 25205 . 26215)))))
 STOP
--- a/sources/LLSUBRS.LCOM
+++ b/sources/LLSUBRS.LCOM
--- a/sources/PRETTY
+++ b/sources/PRETTY
@@ -1,15 +1,14 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
-(FILECREATED " 9-Jul-2021 14:12:19" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRETTY.;19 64744  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(FILECREATED "11-Sep-2021 09:14:19" {DSK}<home>larry>medley>sources>PRETTY.;5 65019  

-      changes to%:  (FNS PRETTYDEF)
+      changes to%:  (VARS PRETTYCOMS)
+                    (FNS PRINTCOPYRIGHT)

-      previous date%: " 3-Jul-2021 15:24:17" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRETTY.;17)
+      previous date%: " 9-Jul-2021 14:12:19" {DSK}<home>larry>medley>sources>PRETTY.;1)


 (* ; "
-Copyright (c) 1984-1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
+Copyright (c) 1984-1990, 1999, 2018 by Venue & Xerox Corporation.
 The following program was created in 1984 but has not been published
 within the meaning of the copyright law, is furnished under license,
 and may not be used, copied and/or disclosed except in accordance
@@ -24,7 +23,7 @@ with the terms of said license.
             PRETTYPRINT2 PRETTYPRINT3 PRINTDEF1 SUPERPRINTEQ SUPERPRINTGETPROP CHANGEFONT)
        (FNS READARRAY PRINTARRAY READARRAY-FROM-LIST PRINTARRAY-TO-LIST)
        (COMS (DECLARE%: DONTCOPY (MACROS CHANGFONT)))
-        (COMS                                                (* ; "COPYRIGHT")
+        (COMS                                                (* ; "COPYRIGHT")
              (FNS PRINTCOPYRIGHT PRINTCOPYRIGHT1 SAVECOPYRIGHT)
              (BLOCKS (NIL PRINTCOPYRIGHT PRINTCOPYRIGHT1 SAVECOPYRIGHT (LOCALVARS . T)
                           (NOLINKFNS PRINTCOPYRIGHT1)))
@@ -89,8 +88,8 @@ with the terms of said license.
        [DECLARE%: EVAL@COMPILE DOCOPY (P (CL:PROCLAIM '(CL:SPECIAL DEFAULTFONT LAMBDAFONT 
                                                               PRETTYCOMFONT COMMENTFONT 
                                                               **COMMENT**FLG PRETTYPRINTMACROS]
-        (DECLARE%: DOEVAL@COMPILE DONTCOPY                   (* ; 
-                   "IMPORT because FILEPKG has records EXPORTed but is not a member of EXPORTFILES")
+        (DECLARE%: DOEVAL@COMPILE DONTCOPY                   (* ; 
+                   "IMPORT because FILEPKG has records EXPORTed but is not a member of EXPORTFILES")
               (FILES (IMPORT)
                      FILEPKG))
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA PPT PP* PP)
@@ -455,15 +454,18 @@ must replace the declare: by a nop addvars.") (SETQ PRTTYCOM (SUBPAIR (QUOTE (NL
 (DEFINEQ

 (PRINTCOPYRIGHT
-  [LAMBDA (FILENAME)                                         (* ; "Edited 31-Aug-99 09:06 by rmk:")
-                                                             (* ; "Edited 31-Aug-99 09:01 by rmk:")
-                                                             (* edited%: " 1-Jan-85 20:16")
+  [LAMBDA (FILENAME)                                   (* ; "Edited 11-Sep-2021 09:07 by larry")
+                                                             (* ; "Edited 31-Aug-99 09:01 by rmk:")
+                                                             (* edited%: " 1-Jan-85 20:16")

-(* ;;; "CALLED BY PRETTYDEF TO PUT a copyright notice on a file.  The globalvar COPYRIGHTOWNERS is used to determine the possible copyright owners when it is determined the file doesn't have a copyright yet and has never been asked if the programmer wanted one.  The whole copyright mechanism can be turned off by setting COPYRIGHTFLG to NEVER -- originaly NIL.  If the file is copyrighted, any year the file is editted the new year is tacked on to the list of copyright years.  The copyright notice comes immediately after the FILECREATED expression * *")
+(* ;;; "CALLED BY PRETTYDEF TO PUT a copyright notice on a file.  The globalvar COPYRIGHTOWNERS is used to determine the possible copyright owners when it is determined the file doesn't have a copyright yet and has never been asked if the programmer wanted one.  The whole copyright mechanism can be turned off by setting COPYRIGHTFLG to NEVER -- originaly NIL.  If the file is copyrighted, any year the file is editted the new year is tacked on to the list of copyright years.  The copyright notice comes immediately after the FILECREATED expression ")
+
+    (* ;; 
+ "9/10/2021 LMM: Add COPYRIGHTFLG value PRESERVE meaning no new copyright (or year) but retain old")

    (PROG [(OWNER (GETPROP FILENAME 'COPYRIGHT]
          (AND [OR OWNER
-                   (AND COPYRIGHTFLG
+                   (AND COPYRIGHTFLG (NEQ COPYRIGHTFLG 'PRESERVE)
                        (SETQ OWNER
                         (ASKUSER (if (EQ COPYRIGHTFLG 'DEFAULT)
                                      then 0
@@ -500,7 +502,11 @@ must replace the declare: by a nop addvars.") (SETQ PRTTYCOM (SUBPAIR (QUOTE (NL
                        'NONE)
                   (PROG ((CURRENTYEAR (SUBATOM (DATE (DATEFORMAT YEAR.LONG NO.TIME))
                                              -4 -1)))
-                         (OR (MEMBER CURRENTYEAR (CDR OWNER))
+
+                    (* ;; " see github Interlisp/medley issue #207  (lmm 9/11/2021)")
+
+                         (OR (EQ COPYRIGHTFLG 'PRESERVE)
+                             (MEMBER CURRENTYEAR (CDR OWNER))
                             (NCONC1 OWNER CURRENTYEAR)))
                   (PRINTCOPYRIGHT1 OWNER])

@@ -687,16 +693,16 @@ must replace the declare: by a nop addvars.") (SETQ PRTTYCOM (SUBPAIR (QUOTE (NL
 (ADDTOVAR LAMA )
 )
 (PUTPROPS PRETTY COPYRIGHT ("Venue & Xerox Corporation" T 1984 1985 1986 1987 1988 1989 1990 1999 2018
- 2021))
+))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5950 48101 (PRETTYDEF 5960 . 21633) (PRETTYDEFCOMS 21635 . 22317) (PRETTYDEF0 22319 . 
-22510) (PRETTYDEF1 22512 . 24275) (PRINTDATE 24277 . 25513) (PRINTDATE1 25515 . 26720) (PRINTFNS 26722
- . 27291) (PRETTYCOM 27293 . 33634) (PRETTYVAR 33636 . 34674) (PRETTYVAR1 34676 . 36894) (PRETTYCOM1 
-36896 . 37600) (ENDFILE 37602 . 37698) (MAKEDEFLIST 37700 . 38104) (PP 38106 . 38382) (PP* 38384 . 
-38697) (PPT 38699 . 39018) (PRETTYPRINT 39020 . 42172) (PRETTYPRINT1 42174 . 44060) (PRETTYPRINT2 
-44062 . 45378) (PRETTYPRINT3 45380 . 46335) (PRINTDEF1 46337 . 47345) (SUPERPRINTEQ 47347 . 47441) (
-SUPERPRINTGETPROP 47443 . 47587) (CHANGEFONT 47589 . 48099)) (48102 53448 (READARRAY 48112 . 49038) (
-PRINTARRAY 49040 . 50780) (READARRAY-FROM-LIST 50782 . 51887) (PRINTARRAY-TO-LIST 51889 . 53446)) (
-53575 60788 (PRINTCOPYRIGHT 53585 . 57357) (PRINTCOPYRIGHT1 57359 . 60483) (SAVECOPYRIGHT 60485 . 
-60786)))))
+  (FILEMAP (NIL (5925 48076 (PRETTYDEF 5935 . 21608) (PRETTYDEFCOMS 21610 . 22292) (PRETTYDEF0 22294 . 
+22485) (PRETTYDEF1 22487 . 24250) (PRINTDATE 24252 . 25488) (PRINTDATE1 25490 . 26695) (PRINTFNS 26697
+ . 27266) (PRETTYCOM 27268 . 33609) (PRETTYVAR 33611 . 34649) (PRETTYVAR1 34651 . 36869) (PRETTYCOM1 
+36871 . 37575) (ENDFILE 37577 . 37673) (MAKEDEFLIST 37675 . 38079) (PP 38081 . 38357) (PP* 38359 . 
+38672) (PPT 38674 . 38993) (PRETTYPRINT 38995 . 42147) (PRETTYPRINT1 42149 . 44035) (PRETTYPRINT2 
+44037 . 45353) (PRETTYPRINT3 45355 . 46310) (PRINTDEF1 46312 . 47320) (SUPERPRINTEQ 47322 . 47416) (
+SUPERPRINTGETPROP 47418 . 47562) (CHANGEFONT 47564 . 48074)) (48077 53423 (READARRAY 48087 . 49013) (
+PRINTARRAY 49015 . 50755) (READARRAY-FROM-LIST 50757 . 51862) (PRINTARRAY-TO-LIST 51864 . 53421)) (
+53550 61068 (PRINTCOPYRIGHT 53560 . 57637) (PRINTCOPYRIGHT1 57639 . 60763) (SAVECOPYRIGHT 60765 . 
+61066)))))
 STOP
--- a/sources/PRETTY.LCOM
+++ b/sources/PRETTY.LCOM
Author	SHA1	Message	Date
Larry Masinter	8ec1ca966d	If lde is on path, don't bother with MAIKODIR (#478 )	2021-09-13 21:34:03 -07:00
Nick Briggs	c55239f744	Minor cleanups in LLSUBRS to support new subrs.h for YIELD subr. (#479 ) Keep the \INITSUBRS in sorted order: move (YIELD 210) to the end of the list. Change the output of WRITECALLSUBRS so that the guard wraps the whole subrs.h include file. Avoid using literal tabs in the output #defines, pad with spaces and arrange the minimum field widths so that everything lines up better.	2021-09-13 20:33:43 -07:00
Larry Masinter	d6f7ad7de9	run-medley improvements (#476 )	2021-09-13 05:54:31 -07:00
Larry Masinter	0236971881	Add NOERROR extra parameter to STKARGNAME, and set it in DEBUGGER (#471 )	2021-09-12 11:47:14 -07:00
Larry Masinter	d04f734295	Move POSTSCRIPTSTREAM.TEDIT with its implementation (#467 )	2021-09-11 17:07:57 -07:00
Larry Masinter	27a52b6ce0	Add COPYRIGHTFLG=PRESERVE meaning 'no new copyright dates, but keep previous' (#468 )	2021-09-11 17:07:07 -07:00
Larry Masinter	0e2e16f183	changes from #453 redone: NOGREET for run-medley, dummy HOME LOGINDIR for loadups (#464 )	2021-09-09 22:26:06 -07:00