From a387094eab5c893ada119e4a2767d5936791361a Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Sun, 18 Sep 2022 08:10:15 -0700 Subject: [PATCH] Rmk68: Fix GITFNS PRC file lists, plus a few minor fixups (#937) * INSPECT: Allow optional user-specified tags in window titles to help keep track of multiple instances of the same datatype * DWIM: Remove warning about order of evaluation change that happened in 1980 * BREAK-AND-TRACE: remake to get functions in filemap * GITFNS, COMPAREDIRECTORIES: prc file list correlates with github PR web page * DWIM, DWIMIFY: Removed WARNUSER and its calls * INSPECT: Value of INSPECT is the inspect window (as IRM says it should be) --- lispusers/COMPAREDIRECTORIES | 57 ++-- lispusers/COMPAREDIRECTORIES.LCOM | Bin 40771 -> 40797 bytes lispusers/GITFNS | 221 ++++++++------ lispusers/GITFNS.LCOM | Bin 48254 -> 48868 bytes sources/BREAK-AND-TRACE | 244 ++++++++-------- sources/BREAK-AND-TRACE.DFASL | Bin 18528 -> 18614 bytes sources/DWIM | 65 ++--- sources/DWIM.LCOM | Bin 16030 -> 15462 bytes sources/DWIMIFY | 334 ++++++++++++--------- sources/DWIMIFY.LCOM | Bin 78189 -> 78259 bytes sources/INSPECT | 469 +++++++++++++++++------------- sources/INSPECT.LCOM | Bin 49496 -> 51208 bytes 12 files changed, 763 insertions(+), 627 deletions(-) diff --git a/lispusers/COMPAREDIRECTORIES b/lispusers/COMPAREDIRECTORIES index 70f74eb4..dcdebeb6 100644 --- a/lispusers/COMPAREDIRECTORIES +++ b/lispusers/COMPAREDIRECTORIES @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "11-Aug-2022 21:10:25"  -{DSK}kaplan>local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;249 128449 +(FILECREATED "14-Aug-2022 12:13:45"  +{DSK}kaplan>local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;250 128556 :CHANGES-TO (FNS CDBROWSER.STRINGS) - :PREVIOUS-DATE "25-Jul-2022 15:31:50" -{DSK}kaplan>Local>medley3.5>release-medley>lispusers>COMPAREDIRECTORIES.;1) + :PREVIOUS-DATE "11-Aug-2022 21:10:25" +{DSK}kaplan>local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;249) (* ; " @@ -1707,7 +1707,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp BROWSER)]) (CDBROWSER.STRINGS - [LAMBDA (CDVALUE COLHEADINGS SEPARATEDIRECTIONS) (* ; "Edited 11-Aug-2022 20:23 by rmk") + [LAMBDA (CDVALUE COLHEADINGS SEPARATEDIRECTIONS) (* ; "Edited 14-Aug-2022 12:13 by rmk") + (* ; "Edited 11-Aug-2022 20:23 by rmk") (* ; "Edited 25-Jul-2022 15:31 by rmk") (* ; "Edited 20-Jul-2022 21:14 by rmk") (* ; "Edited 22-Feb-2022 18:30 by rmk") @@ -1759,8 +1760,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (* ;; "Stick a blank object between") (SETQ PAIRS (NCONC (DREVERSE L2R) - [APPEND '(("") - (""] + [COPY '(("") + (""] (DREVERSE R2L))))) (CL:WHEN COLHEADERS (PUSH PAIRS (LIST COLHEADERS))) @@ -2154,25 +2155,25 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998 2018 2020 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2632 22189 (COMPAREDIRECTORIES 2642 . 7475) (COMPAREDIRECTORIES.INFOS 7477 . 10351) ( -COMPAREDIRECTORIES.CANDIDATES 10353 . 13738) (CDENTRIES.SELECT 13740 . 18515) ( -COMPAREDIRECTORIES.INFOS.TYPE 18517 . 19423) (MATCHNAME 19425 . 20105) (CD.INSURECDVALUE 20107 . 21721 -) (CD.UPDATEWIDTHS 21723 . 22187)) (22190 31859 (CDFILES 22200 . 27953) (CDFILES.MATCH 27955 . 29580) -(CDFILES.PATS 29582 . 31857)) (31860 49681 (CDPRINT 31870 . 34387) (CDPRINT.HEADER 34389 . 35286) ( -CDPRINT.LINE 35288 . 38520) (CDPRINT.MAXWIDTHS 38522 . 42637) (CDPRINT.COLHEADERS 42639 . 43924) ( -CDPRINT.COLUMNS 43926 . 49046) (CDTEDIT 49048 . 49679)) (49682 58051 (CDMAP 49692 . 51124) (CDENTRY -51126 . 51435) (CDSUBSET 51437 . 52876) (CDMERGE 52878 . 56732) (CDMERGE.COMMON 56734 . 58049)) (58052 - 65590 (BINCOMP 58062 . 62351) (EOLTYPE 62353 . 64915) (EOLTYPE.SHOW 64917 . 65588)) (66118 78645 ( -FIND-UNCOMPILED-FILES 66128 . 69771) (FIND-UNSOURCED-FILES 69773 . 72157) (FIND-SOURCE-FILES 72159 . -73897) (FIND-COMPILED-FILES 73899 . 75776) (FIND-UNLOADED-FILES 75778 . 76631) (FIND-LOADED-FILES -76633 . 77061) (FIND-MULTICOMPILED-FILES 77063 . 78643)) (78646 87077 (CREATED-AS 78656 . 83453) ( -SOURCE-FOR-COMPILED-P 83455 . 86382) (COMPILE-SOURCE-DATE-DIFF 86384 . 87075)) (87078 97384 ( -FIX-DIRECTORY-DATES 87088 . 90081) (FIX-EQUIV-DATES 90083 . 91608) (COPY-COMPARED-FILES 91610 . 93431) - (COPY-MISSING-FILES 93433 . 95590) (COMPILED-ON-SAME-SOURCE 95592 . 97382)) (97578 105311 (CDBROWSER -97588 . 101515) (CDBROWSER.STRINGS 101517 . 105309)) (105473 107209 (CD.TABLEITEM 105483 . 105703) ( -CD.TABLEITEM.PRINTFN 105705 . 105904) (CD.TABLEITEM.COPYFN 105906 . 106964) ( -CDTABLEBROWSER.HEADING.REPAINTFN 106966 . 107207)) (107210 127865 (CDTABLEBROWSER.WHENSELECTEDFN -107220 . 107688) (CD.COMMANDSELECTEDFN 107690 . 112791) (CD-MENUFN 112793 . 117104) (CD-COMPARE-FILES -117106 . 120458) (CDBROWSER-COPY 120460 . 124129) (CDBROWSER-DELETE-FILE 124131 . 127344) (CD-SWAPDIRS - 127346 . 127863))))) + (FILEMAP (NIL (2634 22191 (COMPAREDIRECTORIES 2644 . 7477) (COMPAREDIRECTORIES.INFOS 7479 . 10353) ( +COMPAREDIRECTORIES.CANDIDATES 10355 . 13740) (CDENTRIES.SELECT 13742 . 18517) ( +COMPAREDIRECTORIES.INFOS.TYPE 18519 . 19425) (MATCHNAME 19427 . 20107) (CD.INSURECDVALUE 20109 . 21723 +) (CD.UPDATEWIDTHS 21725 . 22189)) (22192 31861 (CDFILES 22202 . 27955) (CDFILES.MATCH 27957 . 29582) +(CDFILES.PATS 29584 . 31859)) (31862 49683 (CDPRINT 31872 . 34389) (CDPRINT.HEADER 34391 . 35288) ( +CDPRINT.LINE 35290 . 38522) (CDPRINT.MAXWIDTHS 38524 . 42639) (CDPRINT.COLHEADERS 42641 . 43926) ( +CDPRINT.COLUMNS 43928 . 49048) (CDTEDIT 49050 . 49681)) (49684 58053 (CDMAP 49694 . 51126) (CDENTRY +51128 . 51437) (CDSUBSET 51439 . 52878) (CDMERGE 52880 . 56734) (CDMERGE.COMMON 56736 . 58051)) (58054 + 65592 (BINCOMP 58064 . 62353) (EOLTYPE 62355 . 64917) (EOLTYPE.SHOW 64919 . 65590)) (66120 78647 ( +FIND-UNCOMPILED-FILES 66130 . 69773) (FIND-UNSOURCED-FILES 69775 . 72159) (FIND-SOURCE-FILES 72161 . +73899) (FIND-COMPILED-FILES 73901 . 75778) (FIND-UNLOADED-FILES 75780 . 76633) (FIND-LOADED-FILES +76635 . 77063) (FIND-MULTICOMPILED-FILES 77065 . 78645)) (78648 87079 (CREATED-AS 78658 . 83455) ( +SOURCE-FOR-COMPILED-P 83457 . 86384) (COMPILE-SOURCE-DATE-DIFF 86386 . 87077)) (87080 97386 ( +FIX-DIRECTORY-DATES 87090 . 90083) (FIX-EQUIV-DATES 90085 . 91610) (COPY-COMPARED-FILES 91612 . 93433) + (COPY-MISSING-FILES 93435 . 95592) (COMPILED-ON-SAME-SOURCE 95594 . 97384)) (97580 105418 (CDBROWSER +97590 . 101517) (CDBROWSER.STRINGS 101519 . 105416)) (105580 107316 (CD.TABLEITEM 105590 . 105810) ( +CD.TABLEITEM.PRINTFN 105812 . 106011) (CD.TABLEITEM.COPYFN 106013 . 107071) ( +CDTABLEBROWSER.HEADING.REPAINTFN 107073 . 107314)) (107317 127972 (CDTABLEBROWSER.WHENSELECTEDFN +107327 . 107795) (CD.COMMANDSELECTEDFN 107797 . 112898) (CD-MENUFN 112900 . 117211) (CD-COMPARE-FILES +117213 . 120565) (CDBROWSER-COPY 120567 . 124236) (CDBROWSER-DELETE-FILE 124238 . 127451) (CD-SWAPDIRS + 127453 . 127970))))) STOP diff --git a/lispusers/COMPAREDIRECTORIES.LCOM b/lispusers/COMPAREDIRECTORIES.LCOM index c2f1db4b692e9878455323fc7b3a1e80f69d0043..600b162367e3b469b36716e1c97c0435d7fa40c2 100644 GIT binary patch delta 317 zcmX@SkLm6{rU?AFS+Mn(#TMplN#Rwkwsvs3C#4Kx+Flnjj!vPM8DGb>|L zC55D-)a3l!g3O%M6ou4^f}&zoD+Om4ry&3EVAmkM;E*6sKlfmT%sd4pw@@D+ps@%; z^z`(U6jBmPfI6|7ZlR>frQzo3BkSrMY|`zi0Q(~iHxC~rUpQhElf?#Chuo7 zo9xG!wK0&i;PRMheCj=16QK1(zV#FxQ}9R|R8pGX-b=fXL06<+s!UfpSwj delta 343 zcmcb+kLmC}rU?AFS+Mn(!ohE|3KR>lSsvs3C#EHxFll#C5@y-IVSvPM=W zhE}HLN(xCusmb}d1(`XiDGI3-1x3ZGRtkCfB^jA{=?a;73QBIFK0XS_TJ`kwloV1D zOMvPz%`~zyFjUgy(s1+iadi%IbqsNJQBa!vpD~MF!O+OU#Kdy)Nk%hABU6M+3{9?n>I4mO+Hsz!pJ(=x$F_QqVFa-A5I1! r$e(OluB2>Xt`Otr?CyKZhSzoiZUf8$`& diff --git a/lispusers/GITFNS b/lispusers/GITFNS index 1a38c6e7..a089a18c 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,13 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "11-Aug-2022 17:54:59"  -{DSK}kaplan>local>medley3.5>working-medley>lispusers>GITFNS.;444 115395 +(FILECREATED "12-Sep-2022 14:58:28"  +{DSK}kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;448 118078 - :CHANGES-TO (FNS GIT-MAKE-PROJECT GIT-INIT) - (VARS GITFNSCOMS) + :CHANGES-TO (FNS GIT-BRANCH-DIFF GIT-GET-DIFFERENT-FILES GIT-BRANCHES-COMPARE-DIRECTORIES) + (COMMANDS prc) - :PREVIOUS-DATE "25-Jul-2022 15:14:26" -{DSK}kaplan>Local>medley3.5>release-medley>lispusers>GITFNS.;1) + :PREVIOUS-DATE " 4-Sep-2022 12:52:33" +{DSK}kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;445) (PRETTYCOMPRINT GITFNSCOMS) @@ -26,7 +26,7 @@ (COMS (FNS GIT-CLONEP GIT-INIT GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PROJECT-PATH FIND-ANCESTOR-DIRECTORY GIT-FIND-CLONE GIT-MAINBRANCH GIT-MAINBRANCH?) - (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS GIT-PROJECT)) + (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS GIT-PROJECT PULLREQUEST)) (INITVARS (GIT-DEFAULT-PROJECT 'MEDLEY) [GIT-DEFAULT-PROJECTS '((MEDLEY T T (EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ @@ -370,8 +370,10 @@ MB)]) (GIT-MAINBRANCH? - [LAMBDA (BRANCH PROJECT NOERROR) (* ; "Edited 9-May-2022 15:06 by rmk") - (IF (STRING.EQUAL (STRIPWHERE (GIT-MAINBRANCH PROJECT NIL T)) + [LAMBDA (BRANCH PROJECT NOERROR) (* ; "Edited 9-Aug-2022 10:40 by rmk") + (* ; "Edited 9-May-2022 15:06 by rmk") + (IF (STRING.EQUAL (STRIPWHERE (GIT-MAINBRANCH PROJECT NIL T) + T) (STRIPWHERE BRANCH)) ELSEIF NOERROR THEN NIL @@ -381,6 +383,8 @@ (DECLARE%: EVAL@COMPILE (TYPERECORD GIT-PROJECT (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH)) + +(RECORD PULLREQUEST (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS)) ) ) @@ -473,8 +477,8 @@ (IF PRS THEN (CL:WHEN (OR RB (SETQ RB (GIT-PICK-BRANCH (GIT-PRC-MENU DR PROJECT PRS) "Pull requests"))) - (GIT-BRANCHES-COMPARE-DIRECTORIES RB (GIT-MAINBRANCH PROJECT) - NIL PROJECT)) + (GIT-BRANCHES-COMPARE-DIRECTORIES (GIT-MAINBRANCH PROJECT) + RB NIL PROJECT)) ELSE "No open pull requests"))) (DEFCOMMAND cob (BRANCH NEXTTITLESTRING PROJECT) @@ -726,9 +730,17 @@ NIL]) (STRIPWHERE - [LAMBDA (BRANCH) (* ; "Edited 9-May-2022 14:31 by rmk") + [LAMBDA (BRANCH ORIGINTOO) (* ; "Edited 9-Aug-2022 10:39 by rmk") + (* ; "Edited 4-Aug-2022 10:31 by rmk") + (* ; "Edited 9-May-2022 14:31 by rmk") + + (* ;; "Leave origin/ unless ORIGINTOO") + (LET ((POS (STRPOS "/" BRANCH))) - (CL:IF POS + (CL:IF [AND POS (MEMB [L-CASE (MKATOM (SUBSTRING BRANCH 1 (SUB1 POS] + (CL:IF ORIGINTOO + '(local origin) + '(local))] (SUBSTRING BRANCH (ADD1 POS)) BRANCH)]) ) @@ -982,6 +994,8 @@ (GIT-BRANCH-DIFF [LAMBDA (BRANCH1 BRANCH2 PROJECT) + (* ;; "Edited 12-Sep-2022 14:13 by rmk") + (* ;; "Edited 17-Jul-2022 09:36 by rmk") (* ;; "Edited 4-Jun-2022 20:43 by rmk") @@ -996,18 +1010,19 @@ (SETQ BRANCH1 (GIT-MAINBRANCH PROJECT))) (CL:UNLESS BRANCH2 (SETQ BRANCH2 (GIT-MAINBRANCH PROJECT))) - (GIT-REMOTE-UPDATE NIL PROJECT) (* (* ;; "Returns the status (M, R, D, A, C), but not sure what comparison is used for the letters. With --name-only, you just get the list of files in the commit. (GIT-COMMIT-DIFFS gives the commits that differ between 2 branches. But what if a given file shows up in 2 different commits in a sequence? E.g. it was changed and then deleted? For each files we can calculate the sequence of changes and figure out what the net effect is? e.g (file D (R file2) (C file3) A) would say that that file didn't exist at the beginning and doesn't exist at the end, so don't report it?") - (GIT-COMMAND (CONCAT - "git diff-tree --no-commit-id --name-STATUS -r " - COMMIT) NIL NIL PROJECT)) + (GIT-REMOTE-UPDATE NIL PROJECT) (* ;; "We don't use GIT-COMMAND because we want to deal with the warning messages here, to give the option of increasing the rename limit..") (PROG (POS LIMIT ERRORFILE RLINES ELINES RESULTFILE) RETRY + + + (* ;; "Nick previously suggested: %"git diff --name-status -C --find-copies-harder branch1%", but that brought in too many files. The merge-base seems to match the Git desktop.") + (SETQ RESULTFILE (GIT-COMMAND-TO-FILE (CONCAT - "git diff --name-status -C --find-copies-harder " - BRANCH1 " " BRANCH2) + "git diff -C --find-copies-harder --merge-base " + BRANCH1 " " BRANCH2 " --name-status") PROJECT)) (SETQ ELINES NIL) (SETQ RLINES NIL) @@ -1085,7 +1100,8 @@ NIL NIL PROJECT]) (GIT-BRANCH-RELATIONS - [LAMBDA (BRANCHES BRANCH2 STRIPWHERE PROJECT) (* ; "Edited 29-May-2022 21:59 by rmk") + [LAMBDA (BRANCHES BRANCH2 STRIPWHERE PROJECT) (* ; "Edited 4-Aug-2022 10:38 by rmk") + (* ; "Edited 29-May-2022 21:59 by rmk") (* ; "Edited 9-May-2022 16:12 by rmk") (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) @@ -1093,8 +1109,12 @@ (LET ((MAIN (GIT-MAINBRANCH PROJECT))) + (CL:WHEN STRIPWHERE + (SETQ MAIN (STRIPWHERE MAIN))) (FOR DTAIL D1 MORE1 MORE2 SUPERSETS EQUALS - ON (FOR B IN BRANCHES COLLECT (CONS B (GIT-COMMIT-DIFFS B MAIN PROJECT))) + ON (FOR B IN BRANCHES COLLECT (CL:WHEN STRIPWHERE + (SETQ B (STRIPWHERE B))) + (CONS B (GIT-COMMIT-DIFFS B MAIN PROJECT))) DO (* ;; "For each branch we now have the list of commit identifiers (hexstrings) that they do not share with the main branch.") @@ -1231,7 +1251,8 @@ NIL]) (GIT-BRANCHES - [LAMBDA (WHERE PROJECT EXCLUDEMERGED) (* ; "Edited 18-Jul-2022 08:11 by rmk") + [LAMBDA (WHERE PROJECT EXCLUDEMERGED) (* ; "Edited 9-Aug-2022 10:45 by rmk") + (* ; "Edited 18-Jul-2022 08:11 by rmk") (* ; "Edited 8-Jul-2022 10:33 by rmk") (* ; "Edited 23-May-2022 14:25 by rmk") (* ; "Edited 19-May-2022 10:06 by rmk") @@ -1253,6 +1274,8 @@ 0])] BRANCHES) (SETQ BRANCHES (UNION LOCAL REMOTE)) + (CL:WHEN (THEREIS B IN BRANCHES SUCHTHAT (STRPOS "HEAD detached" B)) + (PRINTOUT T "Execute %"git gc%" to eliminate a branch with a detached HEAD" T)) (CL:WHEN EXCLUDEMERGED (SETQ BRANCHES (FOR B (MAINBRANCH _ (GIT-MAINBRANCH PROJECT 'LOCAL)) IN BRANCHES WHEN (EQUAL (GIT-COMMAND (CONCAT "git merge-base " B " " MAINBRANCH)) @@ -1282,53 +1305,64 @@ MENUFONT _ DEFAULTFONT)))]) (GIT-PRC-MENU - [LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 9-Jul-2022 19:01 by rmk") + [LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk") + (* ; "Edited 4-Aug-2022 18:55 by rmk") + (* ; "Edited 9-Jul-2022 19:01 by rmk") (* ; "Edited 16-May-2022 19:44 by rmk") (CL:UNLESS PRS (SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT))) (CL:WHEN PRS (LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR))) NIL T PROJECT))) - (SORT [FOR PR REL LABEL (SUPERSETS _ (CAR RELATIONS)) + (SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS)) (EQUALS _ (CADR RELATIONS)) IN PRS - COLLECT (SETQ LABEL (IF [SETQ REL (CAR (CDR (SASSOC (CADDR PR) - SUPERSETS] - THEN (CONCAT (CADDR PR) - " > " REL) - ELSEIF [SETQ REL (CAR (CDR (SASSOC (CADDR PR) - EQUALS] - THEN (CONCAT (CADDR PR) - " = " REL) - ELSE (CADDR PR))) - (LIST (CL:IF (MEMB 'DRAFT PR) + COLLECT (SETQ PRNAME (fetch PRNAME of PR)) + (SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR) + " " + (IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS] + THEN (CONCAT PRNAME " > " REL) + ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS] + THEN (CONCAT PRNAME " = " REL) + ELSE PRNAME))) + (LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR)) (CONCAT LABEL " (draft)") LABEL) - (GITORIGIN (CADDR PR)) - (CONCAT " " (CADR PR) + (GITORIGIN PRNAME) + (CONCAT " " (FETCH PRDESCRIPTION OF PR) " #" - (CAR PR] + (FETCH PRNUMBER OF PR] T)))]) (GIT-PULL-REQUESTS - [LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 17-Jul-2022 11:12 by rmk") + [LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 8-Aug-2022 13:12 by rmk") + (* ; "Edited 4-Aug-2022 19:01 by rmk") + (* ; "Edited 17-Jul-2022 11:12 by rmk") (* ; "Edited 9-May-2022 16:54 by rmk") (* ; "Edited 25-Feb-2022 09:26 by rmk") (CL:UNLESS (EQ 0 (PROCESS-COMMAND "command -v gh")) (ERROR "gh must be installed in order to enumerate pull requests:")) - (FOR LINE TAB1 TAB2 TAB3 VAL IN (GIT-COMMAND "gh pr list" T NIL PROJECT) + (FOR LINE PR TAB1 TAB2 TAB3 VAL IN (GIT-COMMAND "gh pr list" T NIL PROJECT) WHEN [AND (SETQ TAB1 (STRPOS " " LINE)) (SETQ TAB2 (STRPOS " " LINE (ADD1 TAB1))) (SETQ TAB3 (STRPOS " " LINE (ADD1 TAB2))) (OR INCLUDEDRAFTS (NEQ 'DRAFT (SUBATOM LINE (ADD1 TAB3] - COLLECT (IF ALLINFO - THEN `[,(SUBATOM LINE 1 (SUB1 TAB1)) - ,(SUBSTRING LINE (ADD1 TAB1) - (SUB1 TAB2)) - ,(SUBSTRING LINE (ADD1 TAB2) - (SUB1 TAB3)) - ,(SUBATOM LINE (ADD1 TAB3] - ELSE (SUBATOM LINE (ADD1 TAB2) - (SUB1 TAB3]) + COLLECT [SETQ PR (IF ALLINFO + THEN (CREATE PULLREQUEST + PRNUMBER _ (SUBATOM LINE 1 (SUB1 TAB1)) + PRDESCRIPTION _ (SUBSTRING LINE (ADD1 TAB1) + (SUB1 TAB2)) + PRNAME _ (SUBSTRING LINE (ADD1 TAB2) + (SUB1 TAB3)) + PRSTATUS _ (SUBATOM LINE (ADD1 TAB3))) + ELSE (CREATE PULLREQUEST + PRNAME _ (SUBSTRING LINE (ADD1 TAB2) + (SUB1 TAB3] + (CL:WHEN (STRPOS ":" (fetch (PULLREQUEST PRNAME) of PR)) + (PRINTOUT T "Ignoring PR for forked repo %%%"" (fetch (PULLREQUEST PRNAME) + of PR) + "%"" T) + (GO $$ITERATE)) + PR]) (GIT-SHORT-BRANCH-NAME [LAMBDA (BRANCH) (* ; "Edited 22-May-2022 22:36 by rmk") @@ -1502,6 +1536,8 @@ [LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2 PROJECT) (DECLARE (USEDFREE FROMGITN)) + (* ;; "Edited 12-Sep-2022 14:58 by rmk") + (* ;; "Edited 21-May-2022 23:38 by rmk") (* ;; "Edited 9-May-2022 14:17 by rmk: Ask git for the files that differ between the branches, copy those files down to local DIR1 and DIR2, return the directories and a list of (dir1-file1 file2) mappings for renamed and copied files.") @@ -1561,8 +1597,8 @@ (* ;; "For copied files, presumably 2 files are exactly the same. But we hope we can show them on the same line, by virtue of the mapping.") - (LET ((GFILE (CDR D)) - F1) + [LET ((GFILE (CDR D)) + F1 F1) (* ;; "GFILE is a triple (F2 F1 N )") @@ -1571,31 +1607,41 @@ (SETQ F1 (GIT-GET-FILE BRANCH1 (CADR GFILE) (CONCAT DIR1 (CADR GFILE)) T PROJECT)) - (IF (EQ (CADDR GFILE) - 100) - THEN + (SETQ F2 (GIT-GET-FILE BRANCH2 (CADR GFILE) + (CONCAT DIR2 (CADR GFILE)) + T PROJECT)) + + (* ;; "Let the directories figure it out") + + (AND NIL (IF (EQ (CADDR GFILE) + 100) + THEN (* ;; "A little tricky to figure out what corresponds to the real file in the mapping, which directory it belongs to. Maybe the first one should always be one that exists, the second may just be a useful name. But we have to know whether to match against INFO1 or INFO2") - (PUSH MAPPINGS (LIST (FULLNAME F1) + (HELP GFILE 100) + (PUSH MAPPINGS + (LIST (LIST) + (FULLNAME F1) (SLASHIT (U-CASE (CONCAT DIR2 (CAR GFILE)) ) T) (NTHCHAR (CAR D) 1) 100)) - ELSE - (* ;; + ELSE + (* ;;  "If not a perfect match, then the directory should figure it out") - (GIT-GET-FILE BRANCH2 (CAR GFILE) - (CONCAT DIR2 (CAR GFILE)) - T PROJECT)))) + (GIT-GET-FILE BRANCH2 (CAR GFILE) + (CONCAT DIR2 (CAR GFILE)) + T PROJECT]) (HELP "UNKNOWN GIT-DIFF TAG" D))) (LIST DIR1 DIR2 MAPPINGS))]) (GIT-BRANCHES-COMPARE-DIRECTORIES - [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 20-Jul-2022 21:18 by rmk") + [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 12-Sep-2022 14:41 by rmk") + (* ; "Edited 20-Jul-2022 21:18 by rmk") (* ; "Edited 22-May-2022 22:47 by rmk") (* ; "Edited 9-May-2022 15:14 by rmk") (* ; "Edited 3-May-2022 23:04 by rmk") @@ -1632,6 +1678,7 @@ (FETCH (CDINFO FULLNAME) OF INFO1) FILEDIRCASEARRAY)))] + (CL:WHEN MAP (HELP MAP)) (CL:WHEN INFO1 (CHANGE (FETCH (CDINFO FULLNAME) OF INFO1) (SLASHIT (PACKFILENAME.STRING 'VERSION NIL @@ -2160,31 +2207,31 @@ (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4005 19253 (GIT-CLONEP 4015 . 5278) (GIT-INIT 5280 . 5707) (GIT-MAKE-PROJECT 5709 . -14094) (GIT-GET-PROJECT 14096 . 16021) (GIT-PROJECT-PATH 16023 . 17067) (FIND-ANCESTOR-DIRECTORY 17069 - . 17418) (GIT-FIND-CLONE 17420 . 18501) (GIT-MAINBRANCH 18503 . 18898) (GIT-MAINBRANCH? 18900 . 19251 -)) (25634 28422 (ALLSUBDIRS 25644 . 26930) (MEDLEYSUBDIRS 26932 . 27625) (GITSUBDIRS 27627 . 28420)) ( -28423 33213 (TOGIT 28433 . 29839) (FROMGIT 29841 . 30822) (GIT-DELETE-FILE 30824 . 31670) ( -MYMEDLEY-DELETE-FILES 31672 . 33211)) (33214 35746 (MYMEDLEYSUBDIR 33224 . 33680) (GITSUBDIR 33682 . -34125) (STRIPDIR 34127 . 34498) (STRIPHOST 34500 . 34740) (STRIPNAME 34742 . 35495) (STRIPWHERE 35497 - . 35744)) (35747 37649 (GFILE4MFILE 35757 . 36120) (MFILE4GFILE 36122 . 36691) (GIT-REPO-FILENAME -36693 . 37647)) (37698 47520 (GIT-COMMIT 37708 . 38534) (GIT-PUSH 38536 . 39180) (GIT-PULL 39182 . -39794) (GIT-APPROVAL 39796 . 40145) (GIT-GET-FILE 40147 . 42112) (GIT-FILE-EXISTS? 42114 . 42388) ( -GIT-REMOTE-UPDATE 42390 . 43114) (GIT-REMOTE-ADD 43116 . 43423) (GIT-FILE-DATE 43425 . 44356) ( -GIT-FILE-HISTORY 44358 . 46292) (GIT-PRINT-FILE-HISTORY 46294 . 47344) (GIT-FETCH 47346 . 47518)) ( -47550 58282 (GIT-BRANCH-DIFF 47560 . 54344) (GIT-COMMIT-DIFFS 54346 . 54899) (GIT-BRANCH-RELATIONS -54901 . 58280)) (58327 69129 (GIT-BRANCH-NUM 58337 . 58910) (GIT-CHECKOUT 58912 . 59971) ( -GIT-WHICH-BRANCH 59973 . 60271) (GIT-MAKE-BRANCH 60273 . 62486) (GIT-BRANCHES 62488 . 64461) ( -GIT-BRANCH-EXISTS? 64463 . 65167) (GIT-PICK-BRANCH 65169 . 65497) (GIT-PRC-MENU 65499 . 67247) ( -GIT-PULL-REQUESTS 67249 . 68515) (GIT-SHORT-BRANCH-NAME 68517 . 68808) (GIT-LONG-NAME 68810 . 69127)) -(69159 72494 (GIT-MY-CURRENT-BRANCH 69169 . 69539) (GIT-MY-BRANCHP 69541 . 70046) (GIT-MY-NEXT-BRANCH -70048 . 70542) (GIT-MY-BRANCHES 70544 . 72492)) (72540 76492 (GIT-ADD-WORKTREE 72550 . 74034) ( -GIT-REMOVE-WORKTREE 74036 . 74966) (GIT-LIST-WORKTREES 74968 . 75772) (WORKTREEDIR 75774 . 76490)) ( -76540 106741 (GIT-GET-DIFFERENT-FILES 76550 . 82375) (GIT-BRANCHES-COMPARE-DIRECTORIES 82377 . 88358) -(GIT-WORKING-COMPARE-DIRECTORIES 88360 . 93186) (GIT-COMPARE-WORKTREE 93188 . 97166) (GITCDOBJBUTTONFN - 97168 . 101658) (GIT-CD-LABELFN 101660 . 102742) (GIT-CD-MENUFN 102744 . 104951) ( -GIT-WORKING-COMPARE-FILES 104953 . 105573) (GIT-BRANCHES-COMPARE-FILES 105575 . 106739)) (106811 -115328 (CDGITDIR 106821 . 107381) (GIT-COMMAND 107383 . 108941) (GITORIGIN 108943 . 109640) ( -GIT-INITIALS 109642 . 109946) (GIT-COMMAND-TO-FILE 109948 . 113437) (PROCESS-COMMAND 113439 . 114052) -(GIT-RESULT-TO-LINES 114054 . 114661) (STRIPLOCAL 114663 . 115326))))) + (FILEMAP (NIL (4063 19451 (GIT-CLONEP 4073 . 5336) (GIT-INIT 5338 . 5765) (GIT-MAKE-PROJECT 5767 . +14152) (GIT-GET-PROJECT 14154 . 16079) (GIT-PROJECT-PATH 16081 . 17125) (FIND-ANCESTOR-DIRECTORY 17127 + . 17476) (GIT-FIND-CLONE 17478 . 18559) (GIT-MAINBRANCH 18561 . 18956) (GIT-MAINBRANCH? 18958 . 19449 +)) (25899 28687 (ALLSUBDIRS 25909 . 27195) (MEDLEYSUBDIRS 27197 . 27890) (GITSUBDIRS 27892 . 28685)) ( +28688 33478 (TOGIT 28698 . 30104) (FROMGIT 30106 . 31087) (GIT-DELETE-FILE 31089 . 31935) ( +MYMEDLEY-DELETE-FILES 31937 . 33476)) (33479 36482 (MYMEDLEYSUBDIR 33489 . 33945) (GITSUBDIR 33947 . +34390) (STRIPDIR 34392 . 34763) (STRIPHOST 34765 . 35005) (STRIPNAME 35007 . 35760) (STRIPWHERE 35762 + . 36480)) (36483 38385 (GFILE4MFILE 36493 . 36856) (MFILE4GFILE 36858 . 37427) (GIT-REPO-FILENAME +37429 . 38383)) (38434 48256 (GIT-COMMIT 38444 . 39270) (GIT-PUSH 39272 . 39916) (GIT-PULL 39918 . +40530) (GIT-APPROVAL 40532 . 40881) (GIT-GET-FILE 40883 . 42848) (GIT-FILE-EXISTS? 42850 . 43124) ( +GIT-REMOTE-UPDATE 43126 . 43850) (GIT-REMOTE-ADD 43852 . 44159) (GIT-FILE-DATE 44161 . 45092) ( +GIT-FILE-HISTORY 45094 . 47028) (GIT-PRINT-FILE-HISTORY 47030 . 48080) (GIT-FETCH 48082 . 48254)) ( +48286 58760 (GIT-BRANCH-DIFF 48296 . 54517) (GIT-COMMIT-DIFFS 54519 . 55072) (GIT-BRANCH-RELATIONS +55074 . 58758)) (58805 71037 (GIT-BRANCH-NUM 58815 . 59388) (GIT-CHECKOUT 59390 . 60449) ( +GIT-WHICH-BRANCH 60451 . 60749) (GIT-MAKE-BRANCH 60751 . 62964) (GIT-BRANCHES 62966 . 65234) ( +GIT-BRANCH-EXISTS? 65236 . 65940) (GIT-PICK-BRANCH 65942 . 66270) (GIT-PRC-MENU 66272 . 68275) ( +GIT-PULL-REQUESTS 68277 . 70423) (GIT-SHORT-BRANCH-NAME 70425 . 70716) (GIT-LONG-NAME 70718 . 71035)) +(71067 74402 (GIT-MY-CURRENT-BRANCH 71077 . 71447) (GIT-MY-BRANCHP 71449 . 71954) (GIT-MY-NEXT-BRANCH +71956 . 72450) (GIT-MY-BRANCHES 72452 . 74400)) (74448 78400 (GIT-ADD-WORKTREE 74458 . 75942) ( +GIT-REMOVE-WORKTREE 75944 . 76874) (GIT-LIST-WORKTREES 76876 . 77680) (WORKTREEDIR 77682 . 78398)) ( +78448 109424 (GIT-GET-DIFFERENT-FILES 78458 . 84882) (GIT-BRANCHES-COMPARE-DIRECTORIES 84884 . 91041) +(GIT-WORKING-COMPARE-DIRECTORIES 91043 . 95869) (GIT-COMPARE-WORKTREE 95871 . 99849) (GITCDOBJBUTTONFN + 99851 . 104341) (GIT-CD-LABELFN 104343 . 105425) (GIT-CD-MENUFN 105427 . 107634) ( +GIT-WORKING-COMPARE-FILES 107636 . 108256) (GIT-BRANCHES-COMPARE-FILES 108258 . 109422)) (109494 +118011 (CDGITDIR 109504 . 110064) (GIT-COMMAND 110066 . 111624) (GITORIGIN 111626 . 112323) ( +GIT-INITIALS 112325 . 112629) (GIT-COMMAND-TO-FILE 112631 . 116120) (PROCESS-COMMAND 116122 . 116735) +(GIT-RESULT-TO-LINES 116737 . 117344) (STRIPLOCAL 117346 . 118009))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index d94fa3620a1b3470c660823ba01fb8ac27565e1c..e24dafe53af8cb71cab61770b43847a1b18527d4 100644 GIT binary patch delta 3123 zcmZWr-ESLN756wTRZNpj(>7_-6rE0!)>hY%?|hFXT955?zAs%4&vY=fdkkCE>4{l8aXuE`eVTFXsI}ZpRSP8W33zT#3*iO<$itm|o z&pG$p^YJ_Pe_w|G`rq&m-#jhFEB;PgN=OnAIVnp?qP@3q{{8Sp+7vE#^%#hR9EeDA zQqq#LEJCF1uWfJcv>y5m@ZZ^K?=B|cW}zBSdzO>Q$Fqf84q96v=2nVDIBa5RX-R}e zy@PtMm^PD&BE}-oT%l-ZJli@~wX-Pos*m&w;VN^mrlV~=VVIE2U5Qs+h~}IM zL|*bH2GNXLDp^jp0z2)s7$nP{y;^WrD)FpUwLt{s;GRTEsuJFl{ztgN&Joo9jj(X` zwbw(T(3sV1eHGVGD?**wg(v~r^IQ)k1u9jq;M`oY-&nEm(kA~d-_F~fjlrcK%`T#y zKh8EMx&&OWaI@f4T^9z$H)>DA}bn$Ql&mnJKGcgG`{bY*pP7NE)pzT)bdH z^x^he{b39gc|gK;yS3ihiuHFFzkgaV=nErpf*&|>oF>fY!fby$xfJf23CP>UGU&P* z1mhCunhaKDd8J}|psNOCTqk2yK}XYpsGMNoDZ3TWOe5fFhQwUvK505Rv$9|AJ7=z3L<6FO9Fuk00&OaQL9D`9vB zrG~*}$H5IIE7AXmHeg`Ci=|+G6-H_?j4RBN$8@I5&wcYli?Qhmw zTdl2ic!039djofLjEcD8cy`9U>D)y#7&Rys92>W=a>TdmZKjX}F#tX?k z9=zS^G`AmhpblG)Ht+jw5i}VU#&J#HndtW&aNH_hhM6v)Z4p$Ah?sd*H3F)va$UtV zQGz2?_7!ynvnq}sM<7xNoljl3XrNMX`sQ3)>#^$tAr>$@GsAcQupThj*8@%UDK z(~s|V>YYcsBJEkTkxjq7?#J)fcm4j~tuF=r#l=wQScc=#{jW6mdWwvtf1Ky!?@pyo zqR_nYGEsE)}xpg+KQ%WcP%wiEYYCUcuXDJ-g(t+DH%jK+%i;>1Xd;1rii*jlr?lNkDxI~~CD0K5Y;G?$BpWxcjW zPv7fp3ZHPDWxn;n^4_yn@AtRDcY8hhmXq)P#GScPJG0;Wm&1)Abj#RC!EMQb>o~a( zv*lrD%Ly{N72A?bZMY>dv<&c3k`*phvIR?;F72m11cYQ1g2`8<{SL_A0c~B6Hi^wMCZ7T~6zf)gp`VHiN? z-Z?&1dzajKcXG7*v!lC@-T9L&v9-B<7Y&C6p61Vg>dtW+5uUZj?wmVMe_K)R72Gpd zYSa6@e}|%yJW7{@(*cVx82cEN5keDvBtsDG2DnWW4JuZp;%2Z%54c35xoXkHD$jaW zuFCQx;Rq7}E@P-Mu`D?RD?x;4qg{W{iQy-fzX)Gv8xo_gGb+I-wkANlOh2p6Uo~MB zA1!6zvq44zCyb?SR+=E8V({t2iaI9DN2t9LtGzd#AKN=tm=d1xNECSl?_n?e zDfo6ap7Z$DCXp9pqv%c!nN!I8rPZG)x>JL9OAy%ipM+@YH%f7Xezr2VjGMvJ=RmC4 zJKf-RMtjZ19R7XEPc31FxFb(r=ih@)MK*myJJSt1_IssIZtYDjH|Or&+0TdHeDY#u z`O4ki7nm~D9CZiIr@`b^hO?8k$bg5@9yA$Y7&dxp5gkYA;1xqOPBWyz7Xra)wQxuf zt&RlAfs$#^_0>WS=hH!wu^hxj5pyhIJMnqP=3Lo>2itA-zk$!`w!gCti;G+g-w$F^ z1jC?zSgnsmK z36QgMGqW?_&Nq91`?vg`&*ZmnJx^5Yu&&Y=r9jLiV@XZ_$<7Or!-HDuU}2|nf490zk96;jV36|WygW@hV%3D3RElYTJ_lg zG#MkxTzGal@7QVIwn}ye6!L#b=}DGQCLsLXOmX#lUwt;U3px=x5rp*RQ0HQ!#(d*z~rTrC%EA7u(@&rMq;Fg3GpN_Da6npXrPL3=vGG@w{s zvPxb741)=|mnRtPsg;JSzArJr?UZuqoaLvzj14T#dchdxG6=>PR(KkWX+gbWYeo{_ zp7)LoFw*1noQrOpW~=M852G$h5K%hZG%lxu-r@sD8}p~Otsi4@RYKFnk0;V7=owO z3rI`~C2I*t51s&b!pHzya)uKjLCXlpFrAF;2r@vtmxa&&zVO^-Gk&T!3ID^wxXg6^ zcz!~P^O40&hr$LJx(2@OS_Nbf(+x~*Esvs(Y2f*}Ss@c9!q|dj8cTqc$)H5>z&C)# z@T`%DV45Z<6YxDaOBVU6ai?|D|<(TI*Z3YQk1Qo-(0n zgP?v}C}NC%ZmnSBD)`kfXM_a;SX8xH*{i7s?MnOb0Ms<7>b*v@s&4JyZ`2Od?Mka! zYjwZ1^qC}m!oQIje|a=DoH}~3Ds4upxpXi>q8}7ahMn!`od?d$@8!_R$K5|>PNa^B z?IJo>Hwa{WyWp+cpflugpwx9J*o7rLR%AfX*m^+Se1F!^9J#pDZ%pV6gDULbb$t7>(N+YOmMB1E?WyuW|va~sMJnjj_ zz9`L`3eNB7dZ6+mXGUYs82up7Y(^gi*m)Cy?a#ev5GYtY@S@&C2xIdbW&O72jm>Oc zd35xzp;=1JGbosV!t?XlybA=!dmlbxCVKrKCeA=7hPhQNdTH!vGSDXC{G+n7h?61X zTg#;YJe<`Ez{`Rjf;HIiIDizGt+p!n+H<(X(WSr*@qi$dumJq)>n}na*71(R%Sp^S z4Fy986a^*(!rxnGp`phY`N!*XTMsVeLMLCyk4PT`B|AaQU;D+wp*MT$!p@Tb%{#}3 zJ%!s>Y(|c^tnQfOMRuM9P62}d=(?$6=Ij)9{t~!3=+F0FiFN{$?I?cUaxesX^$dQu za&mcfJNoKxa`LT*|Gm39^V_3Ohh_<0C4;++80MLb1Lo{rBgnRMD=oOddPAKcOZyiq z&hKK0zjbRlflocal>lde>lispcore>sources>BREAK-AND-TRACE.;2| 38319 +(DEFINE-FILE-INFO PACKAGE "SYSTEM" READTABLE "XCL" BASE 10) - IL:|changes| IL:|to:| (IL:VARS IL:BREAK-AND-TRACECOMS) +(IL:FILECREATED "12-Sep-2022 21:16:02"  +IL:|{DSK}kaplan>local>medley3.5>working-medley>sources>BREAK-AND-TRACE.;2| 37228 - IL:|previous| IL:|date:| "12-Jul-88 18:49:08" -IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) + :PREVIOUS-DATE "16-May-90 12:12:42" +IL:|{DSK}kaplan>local>medley3.5>working-medley>sources>BREAK-AND-TRACE.;1|) -; Copyright (c) 1987, 1988, 1990 by Venue & Xerox Corporation. All rights reserved. +; Copyright (c) 1987-1988, 1990 by Venue & Xerox Corporation. (IL:PRETTYCOMPRINT IL:BREAK-AND-TRACECOMS) @@ -63,14 +63,14 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) ) (DEFVAR IL:TRACEREGION (IL:|create| IL:REGION - IL:LEFT IL:_ 8 - IL:BOTTOM IL:_ 3 - IL:WIDTH IL:_ 547 - IL:HEIGHT IL:_ 310)) + IL:LEFT IL:_ 8 + IL:BOTTOM IL:_ 3 + IL:WIDTH IL:_ 547 + IL:HEIGHT IL:_ 310)) (DEFUN XCL:CREATE-TRACE-WINDOW (&KEY (XCL::REGION IL:TRACEREGION) - (XCL::OPEN? NIL) - (XCL::TITLE "*Trace-Output*")) + (XCL::OPEN? NIL) + (XCL::TITLE "*Trace-Output*")) (IL:* IL:|;;;| "Create and return a window suitable for use as the value of *TRACE-OUTPUT*.") @@ -92,8 +92,8 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) ARG-LIST) ,@(AND ARG-LIST (MEMBER LAMBDA-CAR '(IL:LAMBDA IL:NLAMBDA)) `((DECLARE (SPECIAL ,@(IF (SYMBOLP ARG-LIST) - (LIST ARG-LIST) - ARG-LIST))))) + (LIST ARG-LIST) + ARG-LIST))))) (IL:\\CALLME '(:TRACED ,(IF (NULL IN-FN) TRACED-FN `(,TRACED-FN :IN ,IN-FN)))) @@ -103,18 +103,18 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) (LET ((*STANDARD-OUTPUT* $THE-REAL-TRACE-OUTPUT$) (IL:FONTCHANGEFLG $IMAGE-STREAM?$)) (DECLARE (SPECIAL IL:FONTCHANGEFLG)) - ,@(CONSTRUCT-ENTRY-PRINTING-CODE TRACED-FN IN-FN LAMBDA-CAR ARG-LIST)) + ,@(CONSTRUCT-ENTRY-PRINTING-CODE TRACED-FN IN-FN LAMBDA-CAR ARG-LIST)) (LET (($TRACED-FN-VALUES$ (MULTIPLE-VALUE-LIST (LET ((XCL:*TRACE-DEPTH* (1+ XCL:*TRACE-DEPTH*))) ,CALLING-FORM)))) (LET ((*STANDARD-OUTPUT* $THE-REAL-TRACE-OUTPUT$) (IL:FONTCHANGEFLG $IMAGE-STREAM?$)) (DECLARE (SPECIAL IL:FONTCHANGEFLG)) - (PRINT-TRACE-EXIT-INFO ',TRACED-FN ',IN-FN $TRACED-FN-VALUES$)) + (PRINT-TRACE-EXIT-INFO ',TRACED-FN ',IN-FN $TRACED-FN-VALUES$)) (VALUES-LIST $TRACED-FN-VALUES$)))))) (DEFUN CONSTRUCT-ENTRY-PRINTING-CODE (TRACED-FN IN-FN LAMBDA-CAR ARG-LIST) - `((PRINT-TRACE-ENTRY-INFO ',TRACED-FN ',IN-FN) + `((PRINT-TRACE-ENTRY-INFO ',TRACED-FN ',IN-FN) (LET ((*PRINT-LEVEL* XCL:*TRACE-LEVEL*) (*PRINT-LENGTH* XCL:*TRACE-LENGTH*)) @@ -124,46 +124,45 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) IL:THEN (IL:* IL:|;;| - "Interlisp spread function. The ARG-LIST is, in fact, a list of argument names.") + "Interlisp spread function. The ARG-LIST is, in fact, a list of argument names.") `((LET (($$INDENT$$ (+ 10 (* XCL:*TRACE-DEPTH* 4)))) ,@(IL:FOR VAR IL:IN ARG-LIST - IL:COLLECT `(PRINT-TRACED-ARGUMENT ',VAR ,VAR $$INDENT$$)))) + IL:COLLECT `(PRINT-TRACED-ARGUMENT ',VAR ,VAR $$INDENT$$)))) IL:ELSEIF (EQ LAMBDA-CAR 'IL:LAMBDA) IL:THEN (IL:* IL:|;;| - "Interlisp Lambda no-spread function. Print out at most *TRACE-LENGTH* arguments.") + "Interlisp Lambda no-spread function. Print out at most *TRACE-LENGTH* arguments.") - `((IL:BIND ($$INDENT$$ IL:_ (+ 10 (* XCL:*TRACE-DEPTH* 4))) IL:FOR - + `((IL:BIND ($$INDENT$$ IL:_ (+ 10 (* XCL:*TRACE-DEPTH* 4))) IL:FOR $ARG-COUNTER$ IL:FROM 1 IL:TO (IF (NULL XCL:*TRACE-LENGTH*) - ,ARG-LIST - (MIN XCL:*TRACE-LENGTH* ,ARG-LIST)) - IL:DO (PRINT-TRACED-ARGUMENT $ARG-COUNTER$ (IL:ARG ,ARG-LIST - $ARG-COUNTER$) - $$INDENT$$))) + ,ARG-LIST + (MIN XCL:*TRACE-LENGTH* ,ARG-LIST)) + IL:DO (PRINT-TRACED-ARGUMENT $ARG-COUNTER$ (IL:ARG ,ARG-LIST + $ARG-COUNTER$) + $$INDENT$$))) IL:ELSE (IL:* IL:|;;| "Interlisp NLambda no-spread function. Print out at most *TRACE-LENGTH* arguments. Also, be careful to check that the argument list is really a list.") `((LET (($$INDENT$$ (+ 10 (* XCL:*TRACE-DEPTH* 4)))) (IF (LISTP ,ARG-LIST) - (IL:FOR $ARGUMENT$ IL:IN ,ARG-LIST IL:AS $ARG-COUNTER$ - IL:FROM 1 IL:WHILE (OR (NULL XCL:*TRACE-LENGTH*) - (<= $ARG-COUNTER$ - XCL:*TRACE-LENGTH*)) - IL:DO (PRINT-TRACED-ARGUMENT $ARG-COUNTER$ $ARGUMENT$ - $$INDENT$$)) - (PRINT-TRACED-ARGUMENT ',ARG-LIST ,ARG-LIST $$INDENT$$)))))) + (IL:FOR $ARGUMENT$ IL:IN ,ARG-LIST IL:AS $ARG-COUNTER$ IL:FROM + 1 + IL:WHILE (OR (NULL XCL:*TRACE-LENGTH*) + (<= $ARG-COUNTER$ XCL:*TRACE-LENGTH*)) + IL:DO (PRINT-TRACED-ARGUMENT $ARG-COUNTER$ $ARGUMENT$ $$INDENT$$ + )) + (PRINT-TRACED-ARGUMENT ',ARG-LIST ,ARG-LIST $$INDENT$$)))))) ((LAMBDA) (IL:* IL:|;;| "A Common Lisp function.") (MULTIPLE-VALUE-BIND (REQUIRED OPTIONAL REST KEY KEY-APPEARED? ALLOW-OTHER-KEYS) (PARSE-CL-ARGLIST ARG-LIST) - `((PRINT-TRACED-CL-ARGLIST XCL:ARGLIST ',REQUIRED ',OPTIONAL + `((PRINT-TRACED-CL-ARGLIST XCL:ARGLIST ',REQUIRED ',OPTIONAL ',REST ',KEY ,KEY-APPEARED? @@ -203,8 +202,8 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) (PRINC " =>") (TERPRI) (IL:FOR VALUE IL:IN FN-VALUES IL:DO (IL:SPACES (+ 10 (* XCL:*TRACE-DEPTH* 4))) - (PRIN1 VALUE) - (TERPRI))) + (PRIN1 VALUE) + (TERPRI))) (DEFUN PRINT-TRACED-ARGUMENT (NAME VALUE INDENT &OPTIONAL PRIN1-THE-NAME?) (IL:SPACES INDENT) @@ -218,52 +217,49 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) (TERPRI)) (DEFUN PRINT-TRACED-CL-ARGLIST (ARGS REQUIRED OPTIONAL REST KEY KEY-APPEARED? ALLOW-OTHER-KEYS - SMALL-INDENT VERBOSE?) + SMALL-INDENT VERBOSE?) (DECLARE (SPECIAL IL:BOLDFONT IL:DEFAULTFONT)) (LET* ((INDENT (+ SMALL-INDENT 2))) (WHEN REQUIRED (IL:FOR VAR IL:IN REQUIRED IL:DO (COND - ((NULL ARGS) - (IL:SPACES INDENT) - (PRINC VAR) - (IL:CHANGEFONT IL:BOLDFONT) - (PRINC " ** NOT SUPPLIED **") - (IL:CHANGEFONT IL:DEFAULTFONT) - (TERPRI)) - (T (PRINT-TRACED-ARGUMENT VAR - (POP ARGS) - INDENT))))) + ((NULL ARGS) + (IL:SPACES INDENT) + (PRINC VAR) + (IL:CHANGEFONT IL:BOLDFONT) + (PRINC " ** NOT SUPPLIED **") + (IL:CHANGEFONT IL:DEFAULTFONT) + (TERPRI)) + (T (PRINT-TRACED-ARGUMENT VAR (POP ARGS) + INDENT))))) (WHEN OPTIONAL (WHEN VERBOSE? (IL:SPACES SMALL-INDENT) (PRINC '&OPTIONAL) (TERPRI)) (IL:FOR VAR IL:IN OPTIONAL IL:DO (IF (NULL ARGS) - (WHEN VERBOSE? - (IL:SPACES INDENT) - (PRINC VAR) - (PRINC " not supplied") - (TERPRI)) - (PRINT-TRACED-ARGUMENT VAR (POP ARGS) - INDENT)))) + (WHEN VERBOSE? + (IL:SPACES INDENT) + (PRINC VAR) + (PRINC " not supplied") + (TERPRI)) + (PRINT-TRACED-ARGUMENT VAR (POP ARGS) + INDENT)))) (WHEN REST (WHEN VERBOSE? (IL:SPACES SMALL-INDENT) (PRINC '&REST) (TERPRI)) - (PRINT-TRACED-ARGUMENT REST ARGS INDENT)) + (PRINT-TRACED-ARGUMENT REST ARGS INDENT)) (WHEN KEY (WHEN VERBOSE? (IL:SPACES SMALL-INDENT) (PRINC '&KEY) (TERPRI)) (IL:FOR VAR IL:IN KEY IL:DO (IL:FOR TAIL IL:ON ARGS IL:BY CDDR - IL:DO (WHEN (EQ VAR (CAR TAIL)) - (PRINT-TRACED-ARGUMENT - VAR - (CADR TAIL) - INDENT T) - (RETURN))))) + IL:DO (WHEN (EQ VAR (CAR TAIL)) + (PRINT-TRACED-ARGUMENT VAR (CADR TAIL) + INDENT T) + (RETURN))))) (WHEN KEY-APPEARED? (LET (TEMP) (COND @@ -278,8 +274,8 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) (TERPRI)) ((SETQ TEMP (IL:FIND KEYWORD IL:IN ARGS IL:BY (CDDR KEYWORD) IL:SUCHTHAT (IF ALLOW-OTHER-KEYS - (NOT (KEYWORDP KEYWORD)) - (NOT (MEMBER KEYWORD KEY :TEST 'EQ))))) + (NOT (KEYWORDP KEYWORD)) + (NOT (MEMBER KEYWORD KEY :TEST 'EQ))))) (IL:SPACES SMALL-INDENT) (IL:CHANGEFONT IL:BOLDFONT) (PRINC "** Illegal &KEY argument: **") @@ -322,7 +318,7 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) ) -(DEFVAR *TRACE-OUTPUT* (XCL:CREATE-TRACE-WINDOW)) +(DEFVAR *TRACE-OUTPUT* (XCL:CREATE-TRACE-WINDOW)) (IL:DEFINEQ (trace @@ -359,21 +355,19 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) ) (DEFUN XCL:TRACE-FUNCTION (XCL::FN-TO-TRACE &KEY ((:IN XCL::IN-FN)) - XCL::REBREAK?) + XCL::REBREAK?) (COND ((CONSP XCL::FN-TO-TRACE) - (IL:FOR XCL::FN IL:IN XCL::FN-TO-TRACE IL:JOIN (XCL:TRACE-FUNCTION XCL::FN :IN - XCL::IN-FN))) + (IL:FOR XCL::FN IL:IN XCL::FN-TO-TRACE IL:JOIN (XCL:TRACE-FUNCTION XCL::FN :IN XCL::IN-FN))) ((CONSP XCL::IN-FN) - (IL:FOR XCL::FN IL:IN XCL::IN-FN IL:JOIN (XCL:TRACE-FUNCTION XCL::FN-TO-TRACE :IN - XCL::FN))) + (IL:FOR XCL::FN IL:IN XCL::IN-FN IL:JOIN (XCL:TRACE-FUNCTION XCL::FN-TO-TRACE :IN XCL::FN))) ((NULL (IL:GETD XCL::FN-TO-TRACE)) (ERROR 'XCL:UNDEFINED-FUNCTION :NAME XCL::FN-TO-TRACE) NIL) ((IL:UNSAFE.TO.MODIFY XCL::FN-TO-TRACE "trace") (FORMAT *ERROR-OUTPUT* "~S not traced.~%" XCL::FN-TO-TRACE) NIL) - (T (XCL:UNBREAK-FUNCTION XCL::FN-TO-TRACE :IN XCL::IN-FN :NO-ERROR T) + (T (XCL:UNBREAK-FUNCTION XCL::FN-TO-TRACE :IN XCL::IN-FN :NO-ERROR T) (UNLESS XCL::REBREAK? (IL:* IL:\; "Save the breaking information for REBREAK, but don't save it if we're being called from REBREAK itself.") (SETF (GETHASH (IF (NULL XCL::IN-FN) XCL::FN-TO-TRACE @@ -385,7 +379,7 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) (MAKE-SYMBOL (FORMAT NIL "Original ~A" XCL::FN-TO-TRACE))))) (IL:PUTD XCL::ORIGINAL (IL:GETD XCL::FN-TO-TRACE) T) - (IL:PUTD XCL::FN-TO-TRACE (COMPILE NIL (CREATE-TRACED-DEFINITION XCL::FN-TO-TRACE + (IL:PUTD XCL::FN-TO-TRACE (COMPILE NIL (CREATE-TRACED-DEFINITION XCL::FN-TO-TRACE NIL XCL::ORIGINAL)) T) (SETF (GET XCL::FN-TO-TRACE 'IL:BROKEN) @@ -397,7 +391,7 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) (LET ((XCL::MIDDLE-MAN (CONSTRUCT-MIDDLE-MAN XCL::FN-TO-TRACE XCL::IN-FN))) (IF (NOT (HAS-CALLS XCL::IN-FN XCL::FN-TO-TRACE)) (ERROR "~S is not called from ~S." XCL::FN-TO-TRACE XCL::IN-FN)) - (COMPILE XCL::MIDDLE-MAN (CREATE-TRACED-DEFINITION XCL::FN-TO-TRACE XCL::IN-FN + (COMPILE XCL::MIDDLE-MAN (CREATE-TRACED-DEFINITION XCL::FN-TO-TRACE XCL::IN-FN XCL::FN-TO-TRACE)) (CHANGE-CALLS XCL::FN-TO-TRACE XCL::MIDDLE-MAN XCL::IN-FN 'UNBREAK-FROM-RESTORE-CALLS) @@ -414,19 +408,19 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) (DEFUN XCL:BREAK-FUNCTION (XCL::FN-TO-BREAK &KEY ((:IN XCL::IN-FN)) - ((:WHEN XCL::WHEN-EXPR) - T) - XCL::TRACE? XCL::REBREAK?) + ((:WHEN XCL::WHEN-EXPR) + T) + XCL::TRACE? XCL::REBREAK?) (COND - (XCL::TRACE? (XCL:TRACE-FUNCTION XCL::FN-TO-BREAK :IN XCL::IN-FN :REBREAK? XCL::REBREAK?)) + (XCL::TRACE? (XCL:TRACE-FUNCTION XCL::FN-TO-BREAK :IN XCL::IN-FN :REBREAK? XCL::REBREAK?)) ((CONSP XCL::FN-TO-BREAK) - (IL:FOR XCL::FN IL:IN XCL::FN-TO-BREAK - IL:JOIN (XCL:BREAK-FUNCTION XCL::FN :IN XCL::IN-FN :WHEN XCL::WHEN-EXPR :REBREAK? - XCL::REBREAK?))) + (IL:FOR XCL::FN IL:IN XCL::FN-TO-BREAK IL:JOIN (XCL:BREAK-FUNCTION XCL::FN :IN XCL::IN-FN + :WHEN XCL::WHEN-EXPR :REBREAK? + XCL::REBREAK?))) ((CONSP XCL::IN-FN) - (IL:FOR XCL::FN IL:IN XCL::IN-FN - IL:JOIN (XCL:BREAK-FUNCTION XCL::FN-TO-BREAK :IN XCL::FN :WHEN XCL::WHEN-EXPR :REBREAK? - XCL::REBREAK?))) + (IL:FOR XCL::FN IL:IN XCL::IN-FN IL:JOIN (XCL:BREAK-FUNCTION XCL::FN-TO-BREAK :IN XCL::FN + :WHEN XCL::WHEN-EXPR :REBREAK? XCL::REBREAK?)) + ) ((IL:UNSAFE.TO.MODIFY XCL::FN-TO-BREAK "break") (FORMAT *ERROR-OUTPUT* "~S not broken." XCL::FN-TO-BREAK) NIL) @@ -442,14 +436,14 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) #'(LAMBDA NIL (IF XCL::TRIGGERED-YET? NIL (SETQ XCL::TRIGGERED-YET? T))))))) - (XCL:UNBREAK-FUNCTION XCL::FN-TO-BREAK :IN XCL::IN-FN :NO-ERROR T) + (XCL:UNBREAK-FUNCTION XCL::FN-TO-BREAK :IN XCL::IN-FN :NO-ERROR T) (IF (NULL XCL::IN-FN) (LET* ((XCL::ORIGINAL-DEF (OR (IL:GETD XCL::FN-TO-BREAK) (ERROR 'XCL:UNDEFINED-FUNCTION :NAME XCL::FN-TO-BREAK))) (XCL::ORIGINAL (LET ((*PRINT-CASE* :UPCASE)) (MAKE-SYMBOL (FORMAT NIL "Original ~A" XCL::FN-TO-BREAK))))) (IL:PUTD XCL::ORIGINAL XCL::ORIGINAL-DEF T) - (IL:PUTD XCL::FN-TO-BREAK (COMPILE NIL (CREATE-BROKEN-DEFINITION XCL::FN-TO-BREAK + (IL:PUTD XCL::FN-TO-BREAK (COMPILE NIL (CREATE-BROKEN-DEFINITION XCL::FN-TO-BREAK XCL::FN-TO-BREAK XCL::ORIGINAL XCL::WHEN-EXPR XCL::FN-TO-BREAK)) T) @@ -462,7 +456,7 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) (IF (NOT (HAS-CALLS XCL::IN-FN XCL::FN-TO-BREAK)) (ERROR "~S is not called from ~S." XCL::FN-TO-BREAK XCL::IN-FN)) (XCL:UNADVISE-FUNCTION XCL::FN-TO-BREAK :IN XCL::IN-FN :NO-ERROR T) - (COMPILE XCL::MIDDLE-MAN (CREATE-BROKEN-DEFINITION XCL::FN-TO-BREAK XCL::MIDDLE-MAN + (COMPILE XCL::MIDDLE-MAN (CREATE-BROKEN-DEFINITION XCL::FN-TO-BREAK XCL::MIDDLE-MAN XCL::FN-TO-BREAK XCL::WHEN-EXPR `(,XCL::FN-TO-BREAK :IN ,XCL::IN-FN))) (CHANGE-CALLS XCL::FN-TO-BREAK XCL::MIDDLE-MAN XCL::IN-FN @@ -474,14 +468,12 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) (LIST `(,XCL::FN-TO-BREAK :IN ,XCL::IN-FN))))))) (DEFUN XCL:UNBREAK-FUNCTION (XCL::BROKEN-FN &KEY ((:IN XCL::IN-FN)) - XCL::NO-ERROR) + XCL::NO-ERROR) (COND ((CONSP XCL::BROKEN-FN) - (IL:FOR XCL::FN IL:IN XCL::BROKEN-FN IL:JOIN (XCL:UNBREAK-FUNCTION XCL::FN :IN - XCL::IN-FN))) + (IL:FOR XCL::FN IL:IN XCL::BROKEN-FN IL:JOIN (XCL:UNBREAK-FUNCTION XCL::FN :IN XCL::IN-FN))) ((CONSP XCL::IN-FN) - (IL:FOR XCL::FN IL:IN XCL::IN-FN IL:JOIN (XCL:UNBREAK-FUNCTION XCL::BROKEN-FN :IN - XCL::FN))) + (IL:FOR XCL::FN IL:IN XCL::IN-FN IL:JOIN (XCL:UNBREAK-FUNCTION XCL::BROKEN-FN :IN XCL::FN))) ((NULL XCL::IN-FN) (LET ((XCL::ORIGINAL (GET XCL::BROKEN-FN 'IL:BROKEN))) (COND @@ -509,17 +501,17 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) XCL::BROKEN-FN XCL::IN-FN)) NIL) (T (CHANGE-CALLS XCL::MIDDLE-MAN XCL::BROKEN-FN XCL::IN-FN) - (FINISH-UNBREAKING XCL::BROKEN-FN XCL::IN-FN XCL::MIDDLE-MAN XCL::ENTRY) + (FINISH-UNBREAKING XCL::BROKEN-FN XCL::IN-FN XCL::MIDDLE-MAN XCL::ENTRY) (LIST `(,XCL::BROKEN-FN :IN ,XCL::IN-FN)))))))) (DEFUN XCL:REBREAK-FUNCTION (XCL::FN-TO-REBREAK &KEY ((:IN XCL::IN-FN))) (COND ((CONSP XCL::FN-TO-REBREAK) - (IL:FOR XCL::FN IL:IN XCL::FN-TO-REBREAK IL:JOIN (XCL:REBREAK-FUNCTION XCL::FN :IN - XCL::IN-FN))) + (IL:FOR XCL::FN IL:IN XCL::FN-TO-REBREAK IL:JOIN (XCL:REBREAK-FUNCTION XCL::FN :IN XCL::IN-FN) + )) ((CONSP XCL::IN-FN) - (IL:FOR XCL::FN IL:IN XCL::IN-FN IL:JOIN (XCL:REBREAK-FUNCTION XCL::FN-TO-REBREAK - :IN XCL::FN))) + (IL:FOR XCL::FN IL:IN XCL::IN-FN IL:JOIN (XCL:REBREAK-FUNCTION XCL::FN-TO-REBREAK :IN XCL::FN) + )) (T (LET* ((XCL::NAME (IF (NULL XCL::IN-FN) XCL::FN-TO-REBREAK `(,XCL::FN-TO-REBREAK :IN ,XCL::IN-FN))) @@ -530,8 +522,7 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) NIL) (T (APPLY 'XCL:BREAK-FUNCTION XCL::INFO))))))) -(DEFUN CREATE-BROKEN-DEFINITION (WRAPPED-FN-NAME BROKEN-FN-NAME FN-TO-CALL WHEN-EXPR - BREAKPOINT-NAME) +(DEFUN CREATE-BROKEN-DEFINITION (WRAPPED-FN-NAME BROKEN-FN-NAME FN-TO-CALL WHEN-EXPR BREAKPOINT-NAME) (IL:* IL:|;;;| "WRAPPED-FN-NAME must be the symbol naming the function that will break when it is called.") @@ -553,8 +544,8 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) ARG-LIST) ,@(AND ARG-LIST (MEMBER LAMBDA-CAR '(IL:LAMBDA IL:NLAMBDA)) `((DECLARE (SPECIAL ,@(IF (SYMBOLP ARG-LIST) - (LIST ARG-LIST) - ARG-LIST))))) + (LIST ARG-LIST) + ARG-LIST))))) (IL:\\CALLME '(:BROKEN ,BREAKPOINT-NAME)) (IF ,WHEN-EXPR (LET (($POS$ (IL:STKNTH -1))) @@ -578,7 +569,7 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) IL:BROKENFNS))) (ASSERT (EQ TO (THIRD ENTRY)) NIL "BUG: Inconsistency in SI::UNBREAK-FROM-RESTORE-CALLS") - (FINISH-UNBREAKING FROM FN TO ENTRY) + (FINISH-UNBREAKING FROM FN TO ENTRY) (FORMAT *TERMINAL-IO* "(~S :IN ~S) unbroken.~%" FROM FN))) (DEFUN FINISH-UNBREAKING (BROKEN-FN IN-FN MIDDLE-MAN ENTRY) @@ -696,7 +687,7 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) ) (XCL:DEFINE-SPECIAL-FORM IL:BREAK1 (&OPTIONAL IL:EXP IL:WHEN IL:FN IL:COMS TYPE XCL:CONDITION - &ENVIRONMENT IL:ENV) + &ENVIRONMENT IL:ENV) (IL:IF (EVAL IL:WHEN IL:ENV) IL:THEN (WHEN IL:COMS (IL:PRINTOUT T "BRKCOMS no longer supported:" IL:COMS T)) (LET ((IL:POS (IL:STKNTH 0 IL:FN))) @@ -708,25 +699,23 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) IL:ELSE (EVAL IL:EXP IL:ENV))) (XCL:DEFOPTIMIZER IL:BREAK1 (&OPTIONAL IL:EXP IL:WHEN IL:FN IL:COMS TYPE XCL:CONDITION) - (WHEN IL:COMS (IL:PRINTOUT T "BRKCOMS no longer supported:" IL:COMS T - )) - `(FLET - (($BRKEXP$ NIL ,IL:EXP)) - (IL:IF ,IL:WHEN - IL:THEN - (LET - (($POS$ (IL:STKNTH 0 ',IL:FN))) - (UNWIND-PROTECT - (XCL:DEBUGGER - :FORM - `(FUNCALL ',#'$BRKEXP$) - :ENVIRONMENT NIL :STACK-POSITION $POS$ :CONDITION - ,(OR XCL:CONDITION - `(IL:LOADTIMECONSTANT (XCL:MAKE-CONDITION - 'BREAKPOINT :FUNCTION - ',IL:FN)))) - (IL:RELSTK $POS$))) - IL:ELSE ($BRKEXP$)))) + (WHEN IL:COMS (IL:PRINTOUT T "BRKCOMS no longer supported:" IL:COMS T)) + `(FLET + (($BRKEXP$ NIL ,IL:EXP)) + (IL:IF ,IL:WHEN + IL:THEN + (LET + (($POS$ (IL:STKNTH 0 ',IL:FN))) + (UNWIND-PROTECT + (XCL:DEBUGGER + :FORM + `(FUNCALL ',#'$BRKEXP$) + :ENVIRONMENT NIL :STACK-POSITION $POS$ :CONDITION + ,(OR XCL:CONDITION `(IL:LOADTIMECONSTANT + (XCL:MAKE-CONDITION 'BREAKPOINT + :FUNCTION ',IL:FN)))) + (IL:RELSTK $POS$))) + IL:ELSE ($BRKEXP$)))) @@ -746,7 +735,14 @@ IL:|{DSK}local>lde>lispcore>sources>BREAK-AND-TRACE.;1|) ) (IL:PUTPROPS IL:BREAK-AND-TRACE IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1990)) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (15387 17225 (TRACE 15400 . 15987) (UNTRACE 15989 . 17223)) (30814 34614 (IL:BREAK -30827 . 31413) (IL:BREAK0 31415 . 32227) (IL:REBREAK 32229 . 33091) (XCL:UNBREAK 33093 . 34284) ( -IL:UNBREAK0 34286 . 34612)) (34615 35663 (IL:BREAK1 34628 . 35661))))) + (IL:FILEMAP (NIL (2635 3370 (XCL:CREATE-TRACE-WINDOW 2635 . 3370)) (3372 5298 ( +CREATE-TRACED-DEFINITION 3372 . 5298)) (5300 8596 (CONSTRUCT-ENTRY-PRINTING-CODE 5300 . 8596)) (8598 +9058 (PRINT-TRACE-ENTRY-INFO 8598 . 9058)) (9060 9726 (PRINT-TRACE-EXIT-INFO 9060 . 9726)) (9728 9994 +(PRINT-TRACED-ARGUMENT 9728 . 9994)) (9996 14052 (PRINT-TRACED-CL-ARGLIST 9996 . 14052)) (14764 16602 +(TRACE 14777 . 15364) (UNTRACE 15366 . 16600)) (16604 19681 (XCL:TRACE-FUNCTION 16604 . 19681)) (19731 + 23843 (XCL:BREAK-FUNCTION 19731 . 23843)) (23845 25958 (XCL:UNBREAK-FUNCTION 23845 . 25958)) (25960 +26848 (XCL:REBREAK-FUNCTION 25960 . 26848)) (26850 28538 (CREATE-BROKEN-DEFINITION 26850 . 28538)) ( +28540 29405 (UNBREAK-FROM-RESTORE-CALLS 28540 . 29405)) (29407 29647 (FINISH-UNBREAKING 29407 . 29647) +) (29904 33704 (IL:BREAK 29917 . 30503) (IL:BREAK0 30505 . 31317) (IL:REBREAK 31319 . 32181) (XCL:UNBREAK + 32183 . 33374) (IL:UNBREAK0 33376 . 33702)) (33705 34753 (IL:BREAK1 33718 . 34751))))) IL:STOP diff --git a/sources/BREAK-AND-TRACE.DFASL b/sources/BREAK-AND-TRACE.DFASL index 0ab2b637e446bd572da29d781a0352cacec54101..128a5062b0727bd3f626e93330271ccc2efc202a 100644 GIT binary patch literal 18614 zcmdsfdw5*Ob>F>r7mFvs1xSG;#K%g4_yD`X_3F@G=__Gi<%U<6t`M*ORH< zYRpBx z6x~KDlGN%^!DIAhLDB=THms*3Tv=OOJWV;(sbDA;?2Z%*p3L4%Hj*GL^evnXcE*wG z!dxNC-5Jb8>QrETI(cGf=qUvwR_=2K%Y)<*&oa13##<~jZJslVaVjxg)Opp5&R3&r zskD)D-HXJ6Idc~>5*ZKjYiVd$zS!(#>F(YHDs$1IvRYw(C{Cr|0u`RFGVev3HqYXb-H|wPW2(?-u`wP=c7uP;2Ay~$hUrX#n=wWp~wZNwtUvT0&QwU#KQjf6iP$z+Xm z#2*UA;~6e*qDjp}{T3RgjacXg3$a#&B#nEj(A+L#jSL;}>BAGbv7y27QQsgzkM={#PK@}<*yS-FLai$9 zhERhL-3X}K;tP6-N#SyEA8lKSjWk767ac&AO-Ld!FO!Od^kCfIWuy}sGefykg*x5RFIGHDKbiiNeov9bQ)qmcYi0u$)-=-9|8#O#2rBl?Gr_(uB&j`bhSQKc?v zq=uw|HT;E%U<`W*0x*)?t*4D7uVx4a5+60;NGKjmM>?oyVI!H1><-2QaU&Q;Mq}9E zB({4B^%)%~AtSXHaD$bdhR8sNNqSTV!(mAg?W$xvm^d`e84?tRW;HREY8_eaZN+ZUOwPxI0ewViMR@*Bo+qN1P`C8t# zIpHx+prsYulKHr~f*V+O+rbUh47rB22Zq&;I z+w_?axK-_$8~DenkQNqH_R3gfFO;pv(kWjoRFM+jg{-Qqo{dMe5EfHyIFrhR(ndVK zl@_Dukv{hhBs3$r%zOsTJUgF1pHcbqjJmQ&Vi!6v=Qr5gYR9-%L4^ZZZ3=X9-(+>D zm!jG}^-7PXUe$H(`Sr6ru9LCY%o?4+r8CR9LvSSuKwZ+#|zGVc^K z6nrTlUz(AV0Y)Qa&Sa7f#K}NVk1_Lr&qZ^77%5KFY+7>&IQY~Wr-A^up46I?Kp}IX zwbiSbtEv>mWzCGMSg7UYLQAt)sM3@Ct?Nqqvjz)$H*v9+_DC>=`3lnv6wTE&G(86r zyGeDrApP#KwUECrO^9hr88;FBe@6AHM|zEHgi=4_c{@YkPt11ud>`d5NIQaG=hCwT zeiPXX620-Po`UFuRO^k9!NO=?C&kiM>bjI>+RT+y@v9Dv=LGyTNV(BM`=eNInw~sJ zD^Y6imF{GDK&0Lhkq-0mEvQg!N!EJ-dm!aH!@)Wt|FF%fNCZcN$?iy3yqjwLfXFe$CdXE`ZHTGDqPA=_0u>CE!+rKk5k_m% zei`hT-=-&E?D}C+MS_W47BAkC&O#b8eQncPb2&Bnyj@kg#XWqP3cf&yR+qod*}rQi zU*_aD23Pp6IMT<45|2Rq3%F;BrAP0Ns$UIDQn=KOJPdd z^h=4wcbXj1MVNy7sQ~L~C7C2>w%Rt}mSNkkwzmCW-e!wnBb4pSPR6OK8`OQ{jE8n^qvh=j~dD}TatxUiC< zlVZpwQ{D(QT*_y<^pkI$e##!tc!&k;94UK1y%yIFs)rh9liDG#dZ>BU@M`Lzg`%*X zhINqR6!;}T!Ul{+Kt{8%&>ogGpp(ePe-LM@aWZq46wR&0nXDYhvvjdggZ082R>L}0 zKf$YQioh`}CT|Ls5Ukv?W5I(|_6LkcGE2SUfHMyGssnzF!FLGvE9N@-406tw2-F?C zu(_6UwqR{TA`!R|J*aE5k1Mi))wL*h!O|pz`)T2m2ux9m4jh`^Mc@J^%Tn{d5oXMMO6AYc*%%8VcN%2z26wQ9d!>Kc> zxuzZ@)F07~$JyZdg1WZG0@}^xZgV4*vKdNzYeS1T<+WLS+g3bHN=gf6nA-dN`xCNQ ztNNm33o}K{NQ*piCwt>@bAy$;eTP+P1Aoy2x4E{A&L1)Sb7~*H2GRzSf$9wWw9bb9 z3>_st{BK(+P$lIzc8YoTJ-hy2$Sgph3Ynjyx9TA~RY~*{Hi@5O1b6Gfeau3VoAcV` z0BoIZahRms#!{{va5q4ft|^{#4W)+Mf6BXhHg)XB0`N{0@Dce0S5UiVFgfzxdvF8wcByrxY>AVcof6&V5wu6 z9|u@P!wvOojiaY;A-d!9`yzA*CDXbc{G+)(n=bJ%eG49DDtMT^9S!OG9E*RUM$R~ zRkq1bW*VXIs_x((yC0ST`}tFKzkFIHvq@4cIn)|OTMdV#Z-=h|O$Nt~(sF&lM?Z+2`Grhq}`h{sjSNB~G%-quxP_G2E!#H}H#%pIc6(>;?Y2r-50@i#Qj_7^Hu)eb-&fgeS$j@9S3@(a@7PW#V2vU?ler^e z7$%tR+J7oGIo+~k?qyE6St8sv{6FTbI@lfV3! zO#ZQ7UY~h9a4CN!e^qyV>{McMdZl``>%}+^`&9mOgP)Cumy#8DE`BP0a`4J?x&|VD z8rwJXq|K(gv9^*U!iMRc|G?VTQkB{;OFtJmm47zC;`RT9ls6AqD?0Y?UDdP-vGvz^ zG^N%OthKZR)7=>uOXP3C0XnPQ&8Bz3MJM{gJpB6U$Oj)(co$szI6~nRU|=t# z{U`&KhD-vPI1!S51|`d7x@!|H?jGI-Btf*WYzzWf|Ee_ve#Al8$e@RES2I{eAiD)r z&TZjbs;1s3Ra5_#!D`C=z(M#c2jQ0t5(V|o86>*ukDS~eFvxV@VUYSOrl87n-*OPX z?I66uAk+N{gG~2~llw0jWV(5Xlp64>&q#;ayo({jBOYgJY@?WqHC%(67s){+mH%0y zqx{OU?MisczhjW`{;h*|*+G!bGXmSODuXXOxM$6^Y$&Vl-x69P-D}c9BhDX>OkdSU zCB+7wTE$kAT64d-mX+b(QK2$PKR;&hyF-k=gqqYIC>C1U+ab>p((v_<9X)Y8H#{-k z;cF*1f%<2~LK{krBS#Q88a_Ia_mNMjgy(|~c*4egu~=9NTzzOLceH<~64Am@UdQ6~ z4UbIt#t}>z8q6KR>Ro`gd`Tng%k-vFaXk`7`a}Bs)>r!cN+AP^BHYRkx8C-{t^be> zY$z6%-0aY_ViLD%VT0YmhP$*dX!#L077ML6w_ry&Zq>v_yNQk5M7h=HXcF?uvJkVH z+2pt@EiPHU4yOfItNB2a?H%1@H?j#z@!{gR>VA=ohn1P#fhJXH@~TZVwZ2PgC;vy-t)F~&R>Gd7Be)awsBtgsqW@3`^E-bGu<~mnITw7iB7@+JK3i#F2#> zV9(`?Fj7|pcx+z@$m$GOi_`|RC{tk<{%io@5K!9R=WQME&c^zhTL+qF zttP3UZy_T)H3k-z7w22OT-2mi=gWpCLTaBdVo|Z2;OIcU6J)!V|~I1>s@=P;58J~9)MQXlMyxy z6)`1gV9Mvrtp}M#yxZJbjXpF&2k>PFKeO0eN&JK|!z~v&m{Nk2Q8U7wLeXyrZp>vU zRDWtx|I{KXczRQ`A}IOW)P@Mjr!bN#914QW*e8fEZmuv}*^(2in7NDUiTpiCm2VJ5 zUL91Tuu0Ci%6};lSAGhlnxr9pCp7WeF#=DTVg?0Uq}#!Hl5$gH7m9^?V{Gu~;4lon zr-PKW4i?kX8Q2xxAtVMF7vbf# zV(aqZ6V8Ryp`9L7q6DaGLUBHz^!9o{Ezxo!75^z!}5$p-}rBma&?gp?`~V_HpS5f#NA0C2%L@vW(Qk@i9iZ za-be3aD{{55rO+Rr5yEVO!EZrR5@vL`fE<^mmS=v807HQ6Qrq#Pw?1K-BFV8Ml!^D zU_aL;d9F%7pCr(52n9-@@>eBXMcgZd3&lsj{KHB`W##Z3<39P%r7+8>gS@m9bGxM0 z^Jl`xpC_B?qnIq0M{bt;-@l98R|_!0=SSaFPUXFWM_8(m(Y<)6|M=k}{p8H&^; z%e*@o-tR@<)r86}K$TS92Hi68awjrBMCF-WrI_w(WGQsH2M6&hJu@3(AO|!N!ve>8 zM6B8kp_s%ggqHs1J$+sl`GP5Uh;zKFyrWs&TD5ORM_N4JmOQj6iSS0s>cv3gEG3#n zFg9~yVJpmJ>_riCWT4!DPQU^gVvV za*c~v9R04j{c%YhGPhe&shS98#PZuJA3j;jKK&}8D`ua3{9O6OB1w@?PyKDU%^WMs z+6rt(Aw*qhMNx;IgvDjsVdWUg``C#~Ez4&?K*bDPe*x!VO#XHFB*1u3aJHp&FSC4O zs@x&km}O^TbXcMNr-+RIydZtyytzX{D$0Aew&Un9Tsr>pRS$#+F7$YH^W>=OlD+MWG)e&|C-no30_fmBJlp46YSpIyiWJM#2x72gtxDe z_k(4}h(kXl&V2QNxx=GX=y6>0nkRbPI*Re^S!=U~_*8KcfrSr;eta(#d>gW=8fPo} z4ukeK-XyiZUafpAJ!3@p$aS9xWQSxP%_K2R` zWtn?la1OOFF9>NJRp=j+ zv@6K2FT49pd0%I`bg4%9D#TssjwUaa@^2 zyYe>OisSTm`S%^{pIs1jeWZo=z=-IC;ZUiO)4ZZC1rgg+uYa+?YmQHhv(tYADGUJ| z)J4%|xJ>dm2ij1BHl!Olcq|b~a`2<%0@q0#>DcIoEM6m0ZBm`eE^NA67XGsvrh%=bQ5O zZS_tla4YPC>*KP-5s`4BF1AspICSAx@*N zHmtAtEPb4(BhnEUpM2D@R$foza7o(T3Vp~SBcNR#>FQ{wJ>N{+4ZP7oA> z;Ui{pJrWJL$*U*3*Rz|D#gdv(x0^|I4a9(+#Bh_vbG0P(aQkEdGm?Kg#o7+NBntTY zsr)l^0k;ezBpAWp89a=gCUzywq{q5#1P%-7CES2m^Z$+E>-_s` z{_UA0YaQ1u+0S5d9vk+PX7aGPjqjJLf4zwoSBPD}e5X?VAEeqvXR1%iG5*OkRaVT! zW~K_;0TZ*fSa`5^IQPV8Zh#(3N!O6`nO6$BU-%Rb=oFkNAd0@b(F>U*)|b9ITLP^;TVG$$8VT!<28y20&Q%ptuu% zGqb3#h3>n2$WUb|oOq}3?)!Z$|G4o;o`VlQWH9oByDl7<%W%$xO`{?ZDe;G%Nj9|P zUP=6b%)Yh56f4#!O5g^~?PnmUmSLOVV8sF=V28oWB8_#Ww}Duca}^v#z!#Z2yygy- zjeOE6+~|!?`e<%RusGJ-=gpKomH(eboMEMMAl6)V_i2V%NgI3F-6tBD6!|xoku%mz zRm?YWSI$*)0?*9x^oNZ(YjlHJ`Oq_3xCmpvmxs{C}!+q z^70Fkzs&HpB}8chARLDK@;GcLRhSOvbYd=3_&p?qAics=NSs$A!7@ua`)d~Glv$GK zcqbae(aOxIxKwN@O_@a=8F)wYx|sRO@*G2?95&drdpIBS-39UOriYtrIOpPhXxzHf z+zOEIG;d-bsJ5K@qAgWiaBaAQyv-lsUpaTC8BU!_m4zBItjp%{l^o{PV}Zt52G|;< z4&4KtPv0f5O6j{$?h32F29vxnmdcMw?dD3wJy&wLx;Otb_cp4le0ei}ru_6#r&sak z70-R9ORWBHEa041#fW`P`1LI@wO?11Em%-Bsmku*u61K*DAzyiKQYRGKVV#;7o9|( zU9_sq(3@x-_i2|}^L8tJ)S+(TYM(z3#(Mb$@#t7?!p}Qllei$1uhI(IGaHx+s3#=| z70~uh=}27Gwf$2u$<=0K+JUJ!67=jvJJfjEXp|E7Y!E(M&uov_8#9qa<;u0JxLJGU z;_$_W2`bghIkw3Hj{3>@8GYBoXm|xfbF>B%T6Q#@Ey*4KR|`mTGr?3x35e}@Iejjg!( zEQJO0QFoL|l`rq&&r}C})ai%$^NMGk>5{ec4G|NsHgUmg?5k9r1w$kz(eb+IyEWFb zAw;dM(v7c*@}f0@OR0BUBid8k(&sB2_gm-~(85e`ek?1oSh$bg97~MdU;bX)$0sa$ zOpbQ#6N1-V02M%eTtkP2hVlxknZaEy^#V&fL+`JU#6zsc8F@i%$xNfMQg}Ke%5zLJZ#~d*@*U_g1}PRwhg$wP zg$%KjW@xT6%xFGsG*6escpcOVszR2WWAu-aq&W+egtZa2VONyBaIJ1@>x&xn2R~#d z@Hdp*<6;k{wv26NZFztvU^!iwkSntaJFR{!zO6sx74Qlbevc#tJ+Q}n{|Mjt2qx(Q zgmQ^-UM27?2HD&5I)krK?yC%bi$Hdes;?8sn^K)7@GK*|LEvWyRL;oCyZ8hbeADts z4WkEcT(C~&0pJPPen{n-HqkwJ{Agad5!eXQjWs;A}A7?sSpzBrZiR@I1&}*(Qd{wuN9>W2q892&6xcQe(yH z()DJB9idtuZ$R4X<(FG|*|BhuzX@Z>8T@^fhi?BjVJv<33z1vDVEXDW6xSl+Vhg4c z=0|F8TJMf#>Ct>)$?n|niJWhxZ%=M)B_LI8{f*<-Y2rju0 zL4XE8m25>aC|i!4Y)S$_(fcGi5*^F3qr)f%424ozhbc?PqG#r*pd}HuNb^=iPU2L1Jsymd>ticXll8^{1oK zl2s>tVvH+nz01=-GD z#D!xTNEDvV*Ypm=0~tLLFU+db+FB5F2SdGjJme+1sNS1!gQ7E$48^rNRB$B*G9c*! zSR2$+A+D^gF3dV92mJ_U{5{c7A@2bHkyV}a2O|DHWVq7%(wR_91@uV##OUaw3I?jI zx5vn1p+p(jvq&NcXuJ*oIY{<`1phf&eX)v@W|Ma4jL=S?eV8{8fv<5 zD!;Uy1;rZ-B{Sjn!VLPnH}5l?4Q1A&Y;6wjpg zd6OwUp3&od=v^>mYyiqi&N7=3B$|3ITTxNASI@9iTvHVE`cr)aF;wQFRb{n;-awQ} z!38Rutuk8Brp2>pXiq3g+&GnQFxeOl#rwcV&Rb^Y?FprN66p|SK2<^#VQiOqbAYQT zt74V{s2;#*v3v`&8ndfG=E&kN@zG(dG*%VzE6S(&AXfKLnP*{hgNRC5y;FJjKzy;> zRA`Z0YnpmeiAX43HciZ^mJ+2@BIZqn(wRgm+X>{!a3v|vD^hQ677$q-t zROv(#iKXdeD4_eJ-rhtimNrt9dn&&Kz13s-{!l7yv{EL`pHAnH$rx~ONtL_8DP{6_5I3ej{PTji|BBxKp~uxltM-DJ&^w)ZqK#gpV{2a&=4scP9U2A%gHp(WyLjmOc%eu}zzxoW1YdR7s-l{X$T3p8^GO$B;`mWAKaxK%57BD>5 z@_24KXBRW%f6gagnvrQAqY*M^GD#caq|dKMn0dhGq6I&U6eVgFtpx;Zd}@tTegIrg zYAr~hkh##(;#Q1}Rf^&;XU0*;*Rr^fXcqESdYr#YdgI5L4!^+erBDqI%WtfkY-mslVoVnu9pw(F zHG*H|($fUKg6!q7foMigLdQXU4TQ)tVYC-%2WcyHT}sn!#s;eRf=%NI0UrS=Ct7Gf z40+S^`28e_QhT3tC&L4xeJmF0GEUru3e~0xT?5z!b=DK~FCp^(N?MKeLLGN1&AnnW zXQ=$YqTEjX6sVkfj(`(rW@#_!+OR*~7wV1nQH>uGIi}cX+rpNya4Ns5EfWr5uf^WN zefCNbMr+YN2X-uL(_^q)y|A4^{@5;)7vGZ3LK`xDt@AcxEj9U+RaLshJv>JRze|W_ zm%qZU@|v~{ z*fc(Gf?s}3?Ff)^L*5es$IQrdt{7!3UR;6mxeK|Axl7?M>vJ7p^|IXxE!U{E059pM z`y(4KehzwLKQzwyxu4Neeoc*=trVwhk~Rs3j@oHy(M|`b^Ys6sN+V!4ZuNl?37MN# z{(|XnVI@U7#gIj&yb)@+l+SeOC)YCfs5PF+0PEKUO7>p$N>saFeV}1Ju07yZA849S zxHa{GX4$XphINqR6!;}T%mNY(fD%oKW@}jHfTod+|Deq_;RNO^?K6vOGZ7r9vs58p z199Q?szLtLhgjHV2>c{u$(@A718cU-{3nH?{(#X)WvLf!@HHF!nhpLTgWn_EKQL~i zPmXiW5*W7e0!BOKY=dY+ArW{7da$I;I+n=#mBSq@NT3!t+Xra$G2uKp>3uQ2wH2z-H1dT{omM1k`!kMd{sh|wNn==4_pT-hYWt&%Al z`>cyo(4m{_KtlZ)EqI&(p31AY)tErLvDRtaL8WYN65ra;B2IH{Cf~XWv$RKP{xnnj zDgVAjmTA>sm~39As3q7;$L0_ph(-;Zm8l(V$314H4*sGCPNThy&JP)WhuU9d>Q@@< zJE+bjZ!fW+zeGo==zm&!0##D}#Y!>n{uBe`YJVrQ0DUTC-a&8G2dq>j(T6M&?=S~U z3Lnyg^~^$2n@ii}plhCDSj}|e(*yq93jWbtpH7u{m|BE~=?WfZK8%MZ zn#n^GZ6Ocmd(MZ?<=kQQ!srre)toV1h%%e!X*>EG#i4=MB4qEuWT$?)+0Eu2;?cc6jdDS;p}i;`qZO zQ^fFg?EStTlbu!Svt`@~e9@HA&zs+}GLxmI5E|_mmbIT$VQS<47@UDsJZN~SM9DyY zYB$osJ`wjv3;AUvWSw3z(g=N5br<*8u}uc-<&X0g`Lsx8qojD@tJR9O87@fAJ)U|r z>7O`4YkFjwp;9`17&*YuesybG5j^-zm}4{LD)>aMSBwX8Y2nJa748r`<9S3G2C+FH#7-GIl5y!c?mi~x(^=yAcQ^Rs9oqr;tX_w~yp2qlQ z=*zDu-_KoqP^SLq-(M|0|Hj&;ph|6+q)&!sa-Z|DZvDR@<<3FT$_D$M zqncz83;#Bkrqr5RwUz`h)t82)lnU)0fXh4x(3W*4o85T_o#yjP@$04I9vn@9I-2K*XKq=IbQ>Bw-2Tbar`#8%{aljfBY zN#(zn=qUdnhTY$C4)sF$OB?S;Hr{y~K|0Si%1bux3pVbo(au(~>NqatSt;AiA4h~g zRRJmcxTHEI#U_(lz20c&zWguBRi^3ZO$O(WGTv&QzV(It%Jz0>bHpt?LlZ|%9LtVP zO?G+O*-U=BkZ(h2;?N-kg~pCd3x#|uaP`sA?2)0-N<IdXCc2FZF%B}j3+&iOh)xk5b2NT@AFpr`$};E3KcBogY#NGIPXVn zpreq#=~`!|8F*N%g$}EQjvKTvV)_v8DCAqNZNUm-EY`#wRugw{6XhnKy^)YdmX(;< z%of{KX>!T*bJ#67T8vv7Ezjr{tC20(67MXWss4m$#)C?6z}KiMjc&Ektu?wG;d44H zpGMUgm1FzzsLH*FYMRPBw zYc*_WYm51l-cU3ou_BFJ9ZhB~bRjHLL@)HHu>tW-9JeY;kf|WE+05+KQ|XL1JqHSXih`A5a&gU!zkHmgTDne$>x_;+CBU^8>I zQLSopyBgiqjqaM*xwt!q8LCY*S#38x;GR!3oJlk!+&9fXo^XFR;pRCp5^k;z-$6{f zGWQ=9ja-mb9O~0*m^%TDw=XrQiCPS4Rh-|eu|2EyXl&oA0ZnYIpe9@mX`(xO5di>$ z)IP@&aDUs9Yq-y)`bkppifH@Dr_l)nhp;Hpp<`Sg88EuzMz=H(RYR1i6x4dm;YplS zsDU(PVLFtXeLS}3eIl4XQ!d>yLv95s$qWG^po73Cs;Llx>OeG+9!TND3a=x=(Iyve zGP;|LZgq*YXbvVV`{BN`#`eM)>bcgKeehpiI+_y)JuirL+PAB6wxgd?r#Y-VJ;#&C0aajwP9MU858u55VB%%=Uqh!N?gFXzkkGsyk0a=E(X&-5t z&5TJcTJ11)iG_+*4JocSPy7KtV$_Zr!|$jy)?pVqvBUc3QT;F_|1yjq6|?3U)ljQIrRw4qKdLe=FJ=n6oyeOV!<2ZM-H#QbrNLZ}p2 zq?;ZT;06ihZ;WpGyw1%WCh$DQfXIB>-y7=4BsyY=px(QW3SLG*?Y-EI^>~O4LPbo- z2o-+b*nS_=i1ZrUtI>xBD1W}m;N@8}HY^7kcCV-9^ooS~KG2#F;uMNrD_CQ+QsK`H z@)oLRP{B2jB#EFTpY4?bffPNd!ePMAjD3g*<5~){^+D>1VClwALKdxiA7#Hs6j?fU zQIbt@##Me;V2b!3ip!YKzU0RKPDj#jnyrhdp-m5P{+EhmgY2*KZ`uPeiEuqJf ziiv)6n{H}k^6isGZY>|Yv^P?zktOqLaT5=fe{$jXnw5E)0#=jFO1N1=CH!}>oLp%m zz(K#@(^>yr(JQpNZmLrzD=f8Y#e6Yeze$dIBokw*{g~jIYG0?gM9bjHmf@8q19^CZ ztL-i`=J4wBVyI!!>F_o@Wn&7ru5d=9y5!oO;QpAU?sGn0yx&*WF{^+p%jSxGK>9Vf zS~dXm0WB*U8wl!tM;&y0J@h*-AN7Ev0Xn^_&RL<;U06<{)8*0&EemrE(xM*>hs1|B zNlQ?@kF=T*VyN;l9txwxJx=!`+egc`h14bxloRkS<3w+=aN#??q!ga zuIU~)M4+f*Zbi(#Bgj?%m2p{R|Axt{e+xy|I1u*-_vi@ZRO&f7$g?`X%oTG)<68`l z5cm>nXjKll4^oae9jITbhw+XQC@f@U{41jiIT8s`Ip=Ak>wvMnp0SUuN1^sS>sRd{ zXC0@UJq(T!xSPRo0@-WG`cb=`b3aMBn;4uRkQJaHXrgS{k0I*!ZN{4do+`l(R^2by zxz7?PxSwK><5^R*OA(*orJ=f`G|`E8fcJnwu1&gJm3}@#ARqaK(2f#K zxMr}Qx?(zud1LsjAUrCyGg6a9ODQl(^*-VJq;UO_Cc$K#eDqqK|0g%l`RbD}zn6vI zP-b%OkwdIi$lP8%I&|#dp&|0#v%Ht&1-F9~?$iJ*?r9_x8aG_D4d%viaAN#uc8sT|TEn}!SBBV@~+f*Q5=CNrtVbtkGRK!@HMp&F&KRLE-VL#>P=g z`cIpGVu(Lhu2}0Bi>UW|09BaWrp5k-#wzc6HuulMZ)iefC!h)<-v!k&<#IhLKSkYQ zwo*wCHn0x5*pIXKrT*d_5s(9#C}Dvk{i0N@hEPn(6)H>r=88c#D}2EeJcKpgP`zQM+nI5SBLBJ4;@7#>zHM}w71T#uE}SB&lxlDgmMHgytv9CwS&cb9xv zrSgha{(#Vx0&6Ix;N{9wt0a@Wc%g(~IKxy?UKjiK{DM(*9YwVB^ zit^*dEjT&^myW%Bu>(PYbNy~zy^n=o&VrXCrz24ud!rY{vvfxMNSAcP1?*#QMfEFU zPsCWBu2=uf1t-^idss^MKgaF&bHY8?z^lQuVZ?#oBhGvEfU(1+RqWxo(zR6faPtVp zb7x9s4RNXB1Om$*4*cjoD)>6|R5i|2)`{gQW@qGKV@E=uj~hE=_dQ0MSSiZp$7d6z zFu@HKw#vt}(pAEP#k~dsksE?djvM_Go`c!!7;fUS4t;C`?CpCX7r;~-{{64(1)*l- zKjv|Of0@AyE%>nuY=}{EWf$~_o?Kj6csFnXwIBTd3p@zMXuEpR5L@0&ZLAZvf zC)$mjnpS>YfNupA=$;UMdgD$p7!U6;}%wkXI0mX3J%#+bvVc<8weLObMjdUCuVt)#?Drtj5y#CeE}xWp6BBSnTHWgT zh(iukMz*@zNqkBVOzckBBM(?j1gHt6-d-?dpjlwm5NL&Jo2e9bUIh+Ogs3s5Sn5$omj_~()ncGo@uN%vHjUrjNK(_ZI z210&eL|rs*)Z#^VEN1hP@?Lo1Yt|I3Nq&FK);_dW45pM3LUOLaN(|;~%D;AliOmOye42 zZ`_DsFX!bB21}@FH8=2U{uO)vzcKtP{?$*CrH-4G>|qe63LEv)M(m)`r8Clh=_Jt# zu;X_b=lq5?c7<U|w!32}LUi%gc{ht~_{zB$Wx>G`#hWLcB_MC7+zR7Ow}-R7d4XW^rerxRy1(Y<%+p^E)D@>x1&L3+lei*tHZxN%nC80~g|Pz)-3% z9rlUDXjN!;tcL2N=adR5aZ0eJlFt5$l{jUV^f(@TMsS=mQmUf5%$-tB#5^)he%W23 zvKH6aJkwV2LXsP5m~XNNob&?oR-S?HtViSKrDb|2%a@iro4C$e?u)iYao~*X^z#be z&A)QiOfj6CNtT5c(!7H$zqFilz9yFIE5fj^i+%ma zigFhuswP?4zvVdE21c_(W8M?T`40e0D)eNN=(A5&l_@HsbzGTkH79PdZKzA_)u#;a~!>3vGJ0o1J^&o%N?w3zLe;`mab$Ku#&LV{7 z%&*J*)|g-C>F^uQxw1PA=>2shjLEON_5ei^v(?G|P323w2uqpiqL2FOHvW9ob-UpZ z;d$vM&iPs+e_pBOk1a7&_au70B>YB=DK~_neXP=PuZjgnLV~NO*A)_tV-f0;6|VZb z$oOB$T(Eyk>#&etPp^t4qV6q!`t9L!6}<~byVkkDZ8RYQM}6E(M}+$F3aXL9l`Z5h z8$UiZa%|+&*$UxQm-@85r@|04dcAt89{^sk+H!a*jvVumm3Eq*SRskGRt-gYBW;Ra zqM=d-?GfcTikUOtVA=UL^dN&2{iLHTf9yhrSWh#w&;^!gnoTs#l|^-J)C#IXmRw@= zkCCJ~6O@Fx61uP~%HFV6x3vw16ZB_1WGV1BklE`sS0{4kEi<~zTx4I({%^)9@y6i{1&6LkLOheU!mNW8T>kd&olVP z1oEm>UnTGv&YdHWqhQLcNZxlI=7N`b^^wmL{S50 zFK*DVANB+B89Cv4qFZ7_NDEL4zbSJp6@@-!|HN`2iT~*(%KM7>%t-x4W#MNQ&sSzm zH1&_9xvm>5Fg{3cT_81fJV#!ghu7jMCgX(Vo)!lL%ym}!Lkji+iVZMr4=+Gk>*ZHiS?pN3$e(vH^$h-0%AFtn z=UvPV?_JSb?}~xlarry>ilisp>medley>sources>DWIM.;6 45614 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS /DWIMCHECKTRAN) - (VARS DWIMCOMS) +(FILECREATED "14-Sep-2022 10:25:40" {DSK}kaplan>local>medley3.5>working-medley>sources>DWIM.;3 43925 - previous date%: "22-Mar-2021 13:29:02" {DSK}larry>ilisp>medley>sources>DWIM.;4) + :CHANGES-TO (VARS DWIMCOMS) + + :PREVIOUS-DATE "13-Sep-2022 09:16:44" +{DSK}kaplan>local>medley3.5>working-medley>sources>DWIM.;2) (* ; " @@ -27,7 +28,7 @@ Copyright (c) 1982-1986, 1988, 1990-1991, 2021 by Venue & Xerox Corporation. (FNS CLISPLOOKUP0 CLISPLOOKUP1 CLISPLOOKUP2 CLISPERROR CLISPDEC CLISPDEC0 CLISPDEC1 GETLOCALDEC) (FNS COMPILEUSERFN COMPILEUSERFN1 USEDFREE CLISPTRAN compilation) - (FNS CLISPFORERR CLISPFORERR1 I.S.OPR WARNUSER) + (FNS CLISPFORERR CLISPFORERR1 I.S.OPR) (DECLARE%: EVAL@COMPILE DONTCOPY (ADDVARS (NLAML BREAK1))) (BLOCKS (NEWFAULT1BLOCK NEWFAULT1 /DWIMCHECKTRAN (ENTRIES NEWFAULT1) (GLOBALVARS %#CLISPARRAY) @@ -138,7 +139,7 @@ Copyright (c) 1982-1986, 1988, 1990-1991, 2021 by Venue & Xerox Corporation. (RPAQ? LCASEFLG T) (RPAQQ DWIMODELST ((C CAUTIOUS (APPROVEFLG . T)) - (T TRUSTING (APPROVEFLG)))) + (T TRUSTING (APPROVEFLG)))) (DEFINEQ (RETDWIM2 @@ -942,38 +943,6 @@ Copyright (c) 1982-1986, 1988, 1990-1991, 2021 by Venue & Xerox Corporation. LC)) 'I.S.OPRS NEWFLG)) (RETURN NAME]) - -(WARNUSER - [LAMBDA (X) (* wt%: "24-MAR-80 08:23") - [SOME PROGVARS (FUNCTION (LAMBDA (VAR) - (COND - ((EDITFINDP (CADR X) - (COND - ((LISTP VAR) - (CAR VAR)) - (T VAR))) - (PROG (TEM) - (LISPXPRIN1 "****Warning: the iterative statement: -" T) - (LISPXPRIN2 (RETDWIM2 EXP NIL 8 2) - T) - (LISPXPRIN1 " -now translates so that " T) - (CLISPFORERR1 X T) - (LISPXPRIN1 " ... is evaluated BEFORE " T) - (COND - ((LISTP VAR) - (LISPXPRIN2 (CAR VAR) - T) - (LISPXPRIN1 " is bound and initialized to: -" T) - (LISPXPRIN2 (RETDWIM2 (CADR VAR) - 3) - T)) - (T (LISPXPRIN1 " it is bound" T))) - (LISPXTERPRI T)) - T] - (CADR X]) ) (DECLARE%: EVAL@COMPILE DONTCOPY @@ -1011,13 +980,13 @@ now translates so that " T) ) (PUTPROPS DWIM COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1988 1990 1991 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2613 6301 (DWIM 2623 . 3275) (NEWFAULT1 3277 . 5755) (/DWIMCHECKTRAN 5757 . 6299)) ( -6456 12996 (RETDWIM2 6466 . 6842) (RETDWIM3 6844 . 7857) (FIXATOM2 7859 . 8063) (SPLIT89 8065 . 9268) -(WTFIXLOADEF 9270 . 12233) (CLISP% 12235 . 12994)) (12997 16055 (VARSBOUNDINEDITCHAIN 13007 . 13358) -(VARSBOUNDINFORM 13360 . 16053)) (16176 17131 (DWIMLOADFNS? 16186 . 17129)) (17210 32134 (CLISPLOOKUP0 - 17220 . 19485) (CLISPLOOKUP1 19487 . 22050) (CLISPLOOKUP2 22052 . 22291) (CLISPERROR 22293 . 25057) ( -CLISPDEC 25059 . 28483) (CLISPDEC0 28485 . 28737) (CLISPDEC1 28739 . 30355) (GETLOCALDEC 30357 . 32132 -)) (32135 36538 (COMPILEUSERFN 32145 . 34315) (COMPILEUSERFN1 34317 . 35354) (USEDFREE 35356 . 35667) -(CLISPTRAN 35669 . 36470) (compilation 36472 . 36536)) (36539 44206 (CLISPFORERR 36549 . 38018) ( -CLISPFORERR1 38020 . 38708) (I.S.OPR 38710 . 42521) (WARNUSER 42523 . 44204))))) + (FILEMAP (NIL (2611 6299 (DWIM 2621 . 3273) (NEWFAULT1 3275 . 5753) (/DWIMCHECKTRAN 5755 . 6297)) ( +6450 12990 (RETDWIM2 6460 . 6836) (RETDWIM3 6838 . 7851) (FIXATOM2 7853 . 8057) (SPLIT89 8059 . 9262) +(WTFIXLOADEF 9264 . 12227) (CLISP% 12229 . 12988)) (12991 16049 (VARSBOUNDINEDITCHAIN 13001 . 13352) +(VARSBOUNDINFORM 13354 . 16047)) (16170 17125 (DWIMLOADFNS? 16180 . 17123)) (17204 32128 (CLISPLOOKUP0 + 17214 . 19479) (CLISPLOOKUP1 19481 . 22044) (CLISPLOOKUP2 22046 . 22285) (CLISPERROR 22287 . 25051) ( +CLISPDEC 25053 . 28477) (CLISPDEC0 28479 . 28731) (CLISPDEC1 28733 . 30349) (GETLOCALDEC 30351 . 32126 +)) (32129 36532 (COMPILEUSERFN 32139 . 34309) (COMPILEUSERFN1 34311 . 35348) (USEDFREE 35350 . 35661) +(CLISPTRAN 35663 . 36464) (compilation 36466 . 36530)) (36533 42517 (CLISPFORERR 36543 . 38012) ( +CLISPFORERR1 38014 . 38702) (I.S.OPR 38704 . 42515))))) STOP diff --git a/sources/DWIM.LCOM b/sources/DWIM.LCOM index 662524bb55183f429775b515f35d7253f68ad05d..681dc3053eb2397423512a65fc55ce13ed50a60a 100644 GIT binary patch delta 909 zcmb7@-Afcv6u=qFK5hlJ`B@s5p=3szX?J!v-Rn9w?#yh1HQxHTCg#<~jy-Sq%Aat&U81>@I@60*pp3ggXZsyx`E2nC@ zVQGSHn3`Z%x{Z%!lvJOR)-Y>Wp5~Z_n_*`UHeKyiTn$IUJVG2joN_e9(^SkxVuI_J z1Su>@;3iU>#KJ7**wNxdX)N#OaIt_{jBcoI-%Rpa#V=Rn@oXudEy(%eXf`iT__@4) zJu1fKsbYD2tZ-QfR+ze5Q65r9x1^RxTq2PKi$}`-W^Uw9m&%pn1Q&{vS0EOTK{0*6 zH1XD0Q50F6%T7Ww|H&!ESpJ`xdbU*F9BSJ$U=)icq&Oz2Gm4egT*0$3H>fx+R)>uK zl-=+0m}DGn(69$wL4}3>-C#IDBBw|!w!QuR-l$v&)|dm$5|3!XUVFe&;i6T;gI){^ z6SWfsY}FG6ExfJjs{#?KUSt>)eBAY&+IBC4vha9s3%G(e`$j=IwtsmCgYMQmfbY4Q z3iXFV&!~8P=p_xEsyh!{s`~(ZS}%g*Q$0idOAW7Rh1tUb)fSIf*~#qe8{Z<@9`2i-t!uDgxY(6PWxvtwVn7ud&4JJfsNtYV7eb(-x+-E zXad7(M;18T=>g|Ehk<(%lp~2tz;}skElSaUTels}aU$3dUD3`2X+kUCA@tBsasfEl zMfsxZBCsKu1Kv#1F~1~z;OXuphd3vrobB1T(;>z1HeSgeo0)=Vqnl~$@vxI_6GB$H R+knk-BQP%Ks*z=w=obp*0!sh@ delta 1518 zcmb7E-EZ4e6pvj38_c2~>V}3o9eEnE+a^t%Z)eKp#ZGHAU$YJAgb;X*SuDABWjlp} zM#LY$#}uBB0Ks@bJQbB9Rh!la9^i>5#Dpfq0}>KwZwMhCCUI_BmS)<^BIS2|&hK|V z?)5$X{q>Kpa-6JG)VdO@s8uDV)+-G-r74nZNEfOKuxi~$YRH!E=FyH)VbK>e-IBW|bV%_cu$nV+ZS{ zHLLAdo29_(`m0t@l3QvmUd-~qjHXSAsic_1w3q#!bwBZH$8@h)!5I-2NMLzMDK8tE zR0kU?)&`jYDqY6`eG@B$aJbcYJkA2sHbd<2VZ{pU!#CO+*=gnxcLwQ9HkpQl&LQ-$ zd5)>n^#``V1NVZY=`h$=qo(t)?pqtS*9{s#dd9E^n-&UULclFO%1NhrrVsQp6w@!z z*C}TE7kZh-g^%u0==XUWjG=L2{3A4W#sebYC%+`i zk5juO_TA~15bsX^fOzA09Em@VQ-r^J;sz=4#mN}4etOm*%iK&Qib9|LG|F&INcV4^ zp4rZveg}(efBPKC+jqG|#BaEN5w~~&iQjmI5d7RZM0@Twx}^EPNt3ySe-IZEZ=>t0 z#J$IQElI0CuPYjea-I}Of}zx)2?@Yc1{K#8sDJ=Xt+6;b_X?yyS!wbRxlYp&O55_= z)C3hdPg6_nvG=JbBl!FJ#ffpsBTx3g-qSnI5r;l@$aBE@r_L;m?XZVq z?4v|JWlw%ikL|qI*~1Fs6jAn;Xv!HIB;HTI^<9KZW(q(CaiyuLbpeu@6ljV;E(scG zVaVYqrV>LF*~CF4jxq+LJ)+KMhvFpU(opV^I+cc|Xj&4oBXlM`6bq2f4|_m!bOs6{-+zSfn5Sc8}jO)Dyp>Mi@gJb}K2Vutyk;S86XYtoEeb;uci0HR4z2%#s zyHY^<8J~X6UP4UeUPb&cXU;I? z!>6Uj^?0MH!NINTKblocal>lde>lispcore>sources>DWIMIFY.;2 310177 - changes to%: (VARS DWIMIFYCOMS) +(FILECREATED "14-Sep-2022 10:25:44"  +{DSK}kaplan>local>medley3.5>working-medley>sources>DWIMIFY.;2 310341 - previous date%: " 8-Dec-86 22:57:42" {DSK}local>lde>lispcore>sources>DWIMIFY.;1) + :CHANGES-TO (FNS CLISPFOR0) + + :PREVIOUS-DATE "16-May-90 16:21:27" +{DSK}kaplan>local>medley3.5>working-medley>sources>DWIMIFY.;1) (* ; " -Copyright (c) 1978, 1984, 1985, 1986, 1990 by Venue & Xerox Corporation. All rights reserved. +Copyright (c) 1978, 1984-1986, 1990 by Venue & Xerox Corporation. The following program was created in 1978 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 @@ -3819,18 +3822,20 @@ with the terms of said license. (RETURN]) (CLISPFOR0 - [LAMBDA (EXP) (* rmk%: " 6-Oct-84 12:03") + [LAMBDA (EXP) (* ; "Edited 14-Sep-2022 10:24 by rmk") + (* rmk%: " 6-Oct-84 12:03") (DECLARE (SPECVARS EXP)) (PROG (DWIMIFYCHANGE (I.S. EXP) I.S.TYPE LASTPTR I.S.PTRS I.S.BODY OPR TEM I.S.TYPE1 I.V. FIRSTI.V. IVINITFLG PROGVARS INITVARS MAKEPROGFLG TERMINATEFLG TERM ITER LSTVAR (LSTVARS '($$LST1 $$LST2 $$LST3 $$LST4 $$LST5 $$LST6)) (DUMMYVARS CLISPDUMMYFORVARS) - EXCEPTPREDS RETPREDS AFTERPREDS RETEXP OUTEXP UNDOLST FOR BIND DECLARELST AS FROM TO - IN ON BY FINALLY EACHTIME FIRST CLISPWORD (VARS (APPEND '(I.V. BODY $$VAL) VARS)) + EXCEPTPREDS RETPREDS AFTERPREDS RETEXP OUTEXP UNDOLST FOR BIND DECLARELST AS FROM TO + IN ON BY FINALLY EACHTIME FIRST CLISPWORD (VARS (APPEND '(I.V. BODY $$VAL) + VARS)) I.S.OPRSLST I.S.OPR) - (DECLARE (SPECVARS LASTPTR I.S.PTRS)) (* ; - "Used freely by I.S.OPRS in IDL -- Ron") + (DECLARE (SPECVARS LASTPTR I.S.PTRS)) (* ; + "Used freely by I.S.OPRS in IDL -- Ron") (COND ((NULL DWIMIFYFLG) (SETQ NOFIXFNSLST0 NOFIXFNSLST) @@ -3844,10 +3849,13 @@ with the terms of said license. (GO LP2)) ((OR (NLISTP CLISPWORD) (NEQ (CAR CLISPWORD) - 'FORWORD)) (* ; "E.g. OR, AND,") + 'FORWORD)) (* ; "E.g. OR, AND,") (GO LP2))) [AND LCASEFLG (EQ OPR (CAR I.S.)) - ([LAMBDA (LC) (* ;; "Replaces the uppercase word with the lowercase. the EQ check is so that synonyms are not replaced by their antecedents. the NEQ check so that the replacement is not done when it is already in lowercase.") + ([LAMBDA (LC) + + (* ;; "Replaces the uppercase word with the lowercase. the EQ check is so that synonyms are not replaced by their antecedents. the NEQ check so that the replacement is not done when it is already in lowercase.") + (AND (NEQ LC (CAR I.S.)) (/RPLNODE I.S. LC (CDR I.S.] (COND @@ -3857,21 +3865,27 @@ with the terms of said license. (COND ((EQ (GETP (CDR CLISPWORD) 'I.S.OPR) - 'MODIFIER) (* ; "modifier") + 'MODIFIER) (* ; "modifier") (GO LP2))) (COND - ((AND LASTPTR (NULL (CDDR LASTPTR))) (* ;; "X identifies the end of the operand for the previous i.s.opr needs to be done before the caal to CLISPFOR0A because it might return a new X with some OTHERS in front. e.g. if the i.s. is (FOR X IN Y SUM X + 1 WHILE Z), at the time the WHILE is encountered, the range of the opeand for SUM is X + 1 after the call to CLISPISTYPE, x will be (FIRST (SETQ $$VAL 0) WHILE Z)") + ((AND LASTPTR (NULL (CDDR LASTPTR))) + + (* ;; "X identifies the end of the operand for the previous i.s.opr needs to be done before the caal to CLISPFOR0A because it might return a new X with some OTHERS in front. e.g. if the i.s. is (FOR X IN Y SUM X + 1 WHILE Z), at the time the WHILE is encountered, the range of the opeand for SUM is X + 1 after the call to CLISPISTYPE, x will be (FIRST (SETQ $$VAL 0) WHILE Z)") + (NCONC1 LASTPTR I.S.))) (COND (I.S.OPR (SETQ I.S. (CLISPFOR0A I.S.OPR I.S. LASTPTR)) - (* ; "see comment at end of selectq") + (* ; "see comment at end of selectq") (SETQ I.S.OPR NIL) (GO LP))) (COND - ((NLISTP (CDR CLISPWORD)) (* ;; "This converts everything to the lowercase version thereby simplifying the selectq. (There is no information tored to enable getting back to uppercase from lowercase (using properties) so that lowercase is the only available canonical representation.)") + ((NLISTP (CDR CLISPWORD)) + + (* ;; "This converts everything to the lowercase version thereby simplifying the selectq. (There is no information tored to enable getting back to uppercase from lowercase (using properties) so that lowercase is the only available canonical representation.)") + (SETQ OPR (CDR CLISPWORD))) - (T (* ; - "This implements synonyms, e.g. WHERE is the same as WHEN.") + (T (* ; + "This implements synonyms, e.g. WHERE is the same as WHEN.") (SETQ OPR (CADDR CLISPWORD)) (GO RECHECK))) (COND @@ -3888,17 +3902,23 @@ with the terms of said license. 'MISSING] ([LISTP (SETQ I.S.OPR (GETPROP OPR 'I.S.OPR] [COND - [(NULL (CAR I.S.OPR)) (* ;; "The i.s.type does not define the i.s.type for the i.s. e.g. Larry's UPTO which is defined as (BIND $$MAX_BODY TO $$MAX)") + [(NULL (CAR I.S.OPR)) + + (* ;; "The i.s.type does not define the i.s.type for the i.s. e.g. Larry's UPTO which is defined as (BIND $$MAX_BODY TO $$MAX)") + (COND - ((NULL (CDR I.S.OPR)) (* ;; "the i.s.opr terminates (terminted) the scope of the prvious i.s.opr, but is otherwise a nop, i.e. invisible. this featre is used for i.s.oprs in which one does not want the argument dwimified, but wants a postprocessor to handle it, e.g. (for i from 1 to 10 decl (x fixp) do (foo))") + ((NULL (CDR I.S.OPR)) + + (* ;; "the i.s.opr terminates (terminted) the scope of the prvious i.s.opr, but is otherwise a nop, i.e. invisible. this featre is used for i.s.oprs in which one does not want the argument dwimified, but wants a postprocessor to handle it, e.g. (for i from 1 to 10 decl (x fixp) do (foo))") + (SETQ LASTPTR (LIST NIL I.S.))) (T (SETQ LASTPTR (LIST OPR I.S.] - [(NULL I.S.TYPE) (* ; "e.g. COLLECT. DO, JOIN, SUM ETC.") + [(NULL I.S.TYPE) (* ; "e.g. COLLECT. DO, JOIN, SUM ETC.") (SETQ I.S.TYPE1 OPR) (SETQ LASTPTR (LIST 'I.S.TYPE (SETQ I.S.TYPE I.S.] ((AND (EQ I.S.TYPE1 'do) - (EQ I.S. (CDR I.S.TYPE))) (* ; - "E.g. DO COLLECT, DO JOIN. Ignore the DO") + (EQ I.S. (CDR I.S.TYPE))) (* ; + "E.g. DO COLLECT, DO JOIN. Ignore the DO") (SETQ I.S.TYPE1 OPR) (/RPLNODE I.S.TYPE (CAR I.S.) (CDR I.S.)) @@ -3908,8 +3928,8 @@ with the terms of said license. 'SUCHTHAT) (EQ (CAR I.S.) 'suchthat)) - (NULL FOR)) (* ; - "special glitch to allow ISTHERE -- SUCHTHAT --") + (NULL FOR)) (* ; + "special glitch to allow ISTHERE -- SUCHTHAT --") (SETQ I.S.TYPE1 OPR) (SETQ LASTPTR (LIST 'I.S.TYPE (SETQ I.S.TYPE I.S.))) (SETQ OPR (FASSOC 'I.S.TYPE I.S.PTRS)) @@ -3917,8 +3937,8 @@ with the terms of said license. (SETQ FOR (CADR OPR))) (T (CLISPFORERR I.S.TYPE I.S. 'BOTH] (GO LP0)) - ((GETP OPR '\DURATIONTRAN) (* ; - "Foo, punt out by calling \DURATIONTRAN since it's too complicated to express as an I.S.OPRS") + ((GETP OPR '\DURATIONTRAN) (* ; + "Foo, punt out by calling \DURATIONTRAN since it's too complicated to express as an I.S.OPRS") (SETQ I.S. (\DURATIONTRAN EXP)) (GO OUT))) SELECT @@ -3945,28 +3965,33 @@ with the terms of said license. (as (OR TERMINATEFLG (SETQ TERMINATEFLG (OR IN ON RETPREDS TO))) (COND ((OR FOR AS I.V.)) - ((OR FROM IN ON TO) (* ; - "E.g. IN X AS I FROM 1 TO 10 DO --.") + ((OR FROM IN ON TO) (* ; + "E.g. IN X AS I FROM 1 TO 10 DO --.") (SETQ FIRSTI.V. (SETQ I.V. (GETDUMMYVAR T))) - (* ; - "getdummyvar also adds to progvars and vars") + (* ; + "getdummyvar also adds to progvars and vars") )) (SETQ IN NIL) (SETQ ON NIL) (SETQ FROM NIL) (SETQ TO NIL) - (SETQ BY NIL) (* ;; "Primarily for error detection, i.e. now can just check to see if say both IN/ON and FRM appear in one stretch.") + (SETQ BY NIL) + + (* ;; "Primarily for error detection, i.e. now can just check to see if say both IN/ON and FRM appear in one stretch.") + (SETQ LASTPTR (LIST 'AS (SETQ AS I.S.)))) (bind (SETQ LASTPTR (LIST 'BIND (SETQ BIND I.S.)))) (declare (SETQ DECLARELST (CONS (SETQ LASTPTR (LIST 'DECLARE I.S.)) DECLARELST))) - (while (* ;; "WHILE, UNTIL, UNLESS< WHEN, Finally, FIRST, and EACHTIME can appear more than once. the corresponding FORPTR'S are gathered on a list and processed by a call to either CLISPFOR2 for the first four, and CLISPFOR3 for latter three (which can have imlicit progns as well.)") + (while + (* ;; "WHILE, UNTIL, UNLESS< WHEN, Finally, FIRST, and EACHTIME can appear more than once. the corresponding FORPTR'S are gathered on a list and processed by a call to either CLISPFOR2 for the first four, and CLISPFOR3 for latter three (which can have imlicit progns as well.)") + (SETQ RETPREDS (CONS (SETQ LASTPTR (LIST 'WHILE I.S.)) RETPREDS))) (until (SETQ RETPREDS (CONS (SETQ LASTPTR (LIST 'UNTIL I.S.)) RETPREDS))) - (repeatwhile (* ; - "Like WHILE except test is mae after body of iterative statement.") + (repeatwhile (* ; + "Like WHILE except test is mae after body of iterative statement.") (SETQ AFTERPREDS (CONS (SETQ LASTPTR (LIST 'REPEATWHILE I.S.)) AFTERPREDS))) (repeatuntil (SETQ AFTERPREDS (CONS (SETQ LASTPTR (LIST 'REPEATUNTIL I.S.)) @@ -3982,9 +4007,9 @@ with the terms of said license. (first (SETQ FIRST (CONS (SETQ LASTPTR (LIST 'FIRST I.S.)) FIRST))) (COND - ((EQ I.S.OPR 'MODIFIER) (* ; "e.g. OLD") - (FRPLACD (CDR LASTPTR)) (* ; - "The OLD does not terminate the scope of the previous i.s.") + ((EQ I.S.OPR 'MODIFIER) (* ; "e.g. OLD") + (FRPLACD (CDR LASTPTR)) (* ; + "The OLD does not terminate the scope of the previous i.s.") (GO LP2)) (T (GO LP2] (GO LP0) @@ -3999,19 +4024,19 @@ with the terms of said license. LP1 (COND ((AND (NULL (CDR I.S.)) (EQUAL EXP (CAR HISTENTRY))) - (PRIN1 '... T) + (PRIN1 '|...| T) (PEEKC T) (NCONC EXP (READLINE T)) (GO LP0))) LP2 (COND ((LISTP (SETQ I.S. (CDR I.S.))) (GO LP)) - (I.S. (* ; "i.s. ends in a non-nil tail") + (I.S. (* ; "i.s. ends in a non-nil tail") (AND (NULL DWIMESSGAG) (ERRORMESS (LIST 25 EXP))) (ERROR!)) (LASTPTR (NCONC1 LASTPTR NIL)) - ((NULL I.S.PTRS) (* ; "shouldnt happen") + ((NULL I.S.PTRS) (* ; "shouldnt happen") (AND (NULL DWIMESSGAG) (ERRORMESS1 "No operator in:" EXP)) (ERROR!))) @@ -4025,9 +4050,11 @@ with the terms of said license. (SETQ PROGVARS (SELECTQ (CAAR PTRS) ((BIND AS) (APPEND PROGVARS (CLISPFORVARS PTRS))) - (FOR (* ;; "The reason for the reverse in order in the APPEND beloow is in caseBIND appears before FOR, and a PROG is not being made, must have FOR variables first. NOte if a prog is being made, it doesnt matter.") - (* ; - "The call to CLISPFORVARS will also set I.V. and FIRSTI.V.") + (FOR + + (* ;; "The reason for the reverse in order in the APPEND beloow is in caseBIND appears before FOR, and a PROG is not being made, must have FOR variables first. NOte if a prog is being made, it doesnt matter.") + (* ; + "The call to CLISPFORVARS will also set I.V. and FIRSTI.V.") (APPEND (CLISPFORVARS PTRS) PROGVARS)) ((IN ON) @@ -4035,17 +4062,27 @@ with the terms of said license. (I.S.TYPE TEM) (T VARS] (CLISPFOR1 PTRS T)) - (* ;; "IN/ON should be handled before adding VARS because that is when its operand is evaluqted. (Except when there is no FOROPR, because we really might be DWIMIFYING what will be the FOROPR.)") + + (* ;; "IN/ON should be handled before adding VARS because that is when its operand is evaluqted. (Except when there is no FOROPR, because we really might be DWIMIFYING what will be the FOROPR.)") + PROGVARS) PROGVARS] - (* ;; "Need to do this before CLISPFOR1 to get all ofthe variables 'bound' i.e. added to rs, and to note the names of the i.v. (s)") + + (* ;; "Need to do this before CLISPFOR1 to get all ofthe variables 'bound' i.e. added to rs, and to note the names of the i.v. (s)") + [COND ((AND (NULL I.V.) - (OR FROM IN ON TO)) (* ;; "This can only occur if there is no FOR and no AS. If thee is no FOR and an AS, the I.V. for the initial segment, if one is needed, is set up in the SELECTQ at LP.") + (OR FROM IN ON TO)) + + (* ;; "This can only occur if there is no FOR and no AS. If thee is no FOR and an AS, the I.V. for the initial segment, if one is needed, is set up in the SELECTQ at LP.") + (SETQ I.V. (GETDUMMYVAR T] (SETQ TEM I.S.PTRS) LP3 (COND - ((SETQ TEM (CLISPFOR1 TEM)) (* ;; "maps down forpotrs applying clispfor1 to each one. for most calls, clispfor1 returns CDR of TEM, but for things on i.s.typelst, it jumps ahead and does the next few before finishing up this one so it can substitute.") + ((SETQ TEM (CLISPFOR1 TEM)) + + (* ;; "maps down forpotrs applying clispfor1 to each one. for most calls, clispfor1 returns CDR of TEM, but for things on i.s.typelst, it jumps ahead and does the next few before finishing up this one so it can substitute.") + (GO LP3))) [SETQ I.S.BODY (AND I.S.TYPE (COND @@ -4059,7 +4096,10 @@ with the terms of said license. 'MODIFIER)) (CADDR I.S.TYPE)) (T (CADR I.S.TYPE] - (T (* ;; "This occurs when the FOROPR specifies more than one operation, i.e. an implicit PROGN. In this case, FOROPR was reset to the body of the PROGN.") + (T + + (* ;; "This occurs when the FOROPR specifies more than one operation, i.e. an implicit PROGN. In this case, FOROPR was reset to the body of the PROGN.") + (CAR I.S.TYPE] (COND ((OR RETPREDS AFTERPREDS) @@ -4075,7 +4115,9 @@ with the terms of said license. ([AND (NULL DWIMESSGAG) (NULL TERMINATEFLG) (NULL (CLISPFOR4 (GETPROP I.S.TYPE1 'I.S.OPR] - (* ;; "Before printing this message, check I>S>TYPE for possilb RETURN or GO, as with THEREIS, SUCHTHAT, etc.") + + (* ;; "Before printing this message, check I>S>TYPE for possilb RETURN or GO, as with THEREIS, SUCHTHAT, etc.") + (PRIN1 '"Possible non-terminating iterative statement: " T) (PRINT [MAPCAR EXP (FUNCTION (LAMBDA (I.S.) @@ -4087,7 +4129,9 @@ with the terms of said license. '(collect join do] EXCEPTPREDS (AND ON (EDITFINDP I.S.BODY (LIST 'SETQ I.V. '&] - (* ;; "On TYPE-IN? do not convert to MAPCONC, i.e. convert to a PROG, as otherwise the MAPCONC would be converted toa /MAPCONC, which is unnecessary.") + + (* ;; "On TYPE-IN? do not convert to MAPCONC, i.e. convert to a PROG, as otherwise the MAPCONC would be converted toa /MAPCONC, which is unnecessary.") + (GO MAKEPROG))) [SETQ I.S. (CONS [COND [IN (SELECTQ I.S.TYPE1 @@ -4109,13 +4153,18 @@ with the terms of said license. (COND (BY (NCONC1 I.S. (CLISPFORF/L (LIST (SUBST I.V. (CADR (OR IN ON)) (CADR BY))) - PROGVARS DECLARELST)) (* ;; "The reason for the subst is the manual says you can refer to the current tail in a BY by using either the I.V> or the operand to IN/ON. This normalizes it to I>V., which is always (CAR PROGVARS). NOte similar operation in SUBPAIR about 3 pages from here.") - )) + PROGVARS DECLARELST)) + + (* ;; "The reason for the subst is the manual says you can refer to the current tail in a BY by using either the I.V> or the operand to IN/ON. This normalizes it to I>V., which is always (CAR PROGVARS). NOte similar operation in SUBPAIR about 3 pages from here.") +)) (GO OUT) MAKEPROG [COND ([AND (EQ I.S.TYPE1 'collect) - (SETQ I.S. (GETPROP 'fcollect 'I.S.OPR] (* ;; "This is the form for MAPCAR used by the compiler. Its advantage is it doesnt call NCONC1 and results in no extra function calls. User can disable this by removing the property of FCOLLECT.") + (SETQ I.S. (GETPROP 'fcollect 'I.S.OPR] + + (* ;; "This is the form for MAPCAR used by the compiler. Its advantage is it doesnt call NCONC1 and results in no extra function calls. User can disable this by removing the property of FCOLLECT.") + [SETQ PROGVARS (APPEND PROGVARS (SETQ TEM (LISTGET1 (CDR I.S.) 'BIND] (SETQ VARS (APPEND VARS TEM))) @@ -4128,23 +4177,24 @@ with the terms of said license. '=) (SETQ I.S. (EVAL (CDAR I.S.] (T (SETQ I.S. (CAR I.S.] - [SETQ I.S.BODY (SUBPAIR '(BODY I.V.) (LIST (COND - ((CDR I.S.BODY) - (CONS 'PROGN I.S.BODY)) - (T (CAR I.S.BODY))) - (OR FIRSTI.V. I.V.)) + [SETQ I.S.BODY (SUBPAIR '(BODY I.V.) + (LIST (COND + ((CDR I.S.BODY) + (CONS 'PROGN I.S.BODY)) + (T (CAR I.S.BODY))) + (OR FIRSTI.V. I.V.)) (COND ((LISTP I.S.) (DWIMIFY1 (COPY I.S.))) - (T (* ; "For DO, its just BODY.") + (T (* ; "For DO, its just BODY.") I.S.] [SETQ I.S.BODY (COND ((EQ (CAR I.S.BODY) 'PROGN) (APPEND (CDR I.S.BODY))) - (T (LIST I.S.BODY] (* ; "FORBODY is now a list of forms.") - (CLISPFOR4 I.S.BODY) (* ; - "Checks for GO's so know where you need an $$OUT typeof structure.") + (T (LIST I.S.BODY] (* ; "FORBODY is now a list of forms.") + (CLISPFOR4 I.S.BODY) (* ; + "Checks for GO's so know where you need an $$OUT typeof structure.") MP0 [COND ((NOT (FASSOC '$$VAL PROGVARS)) (SETQ PROGVARS (CONS '$$VAL PROGVARS] @@ -4176,26 +4226,26 @@ with the terms of said license. [COND [(AND [COND [(OR (EQ TEM 'OLD) - (EQ TEM 'old)) (* ; "IN OLD --") + (EQ TEM 'old)) (* ; "IN OLD --") (SETQ TEM (CADDR (OR IN ON] ((OR (EQ (CAR TEM) 'OLD) (EQ (CAR TEM) - 'old)) (* ; "IN (OLD --)") + 'old)) (* ; "IN (OLD --)") (SETQ TEM (CADR TEM] (COND - ((LITATOM TEM) (* ; "IN OLD X or IN (OLD X)") + ((LITATOM TEM) (* ; "IN OLD X or IN (OLD X)") (SETQ LSTVAR TEM)) ((OR (EQ (CAR TEM) 'SETQ) (EQ (CAR TEM) - 'SETQQ)) (* ; - "IN OLD X _ .. or IN (OLD X _ ..), or IN OLD (X _ ..) or IN (OLD (X _ ..))") + 'SETQQ)) (* ; + "IN OLD X _ .. or IN (OLD X _ ..), or IN OLD (X _ ..) or IN (OLD (X _ ..))") (CLISPFORINITVAR (SETQ LSTVAR (CADR TEM)) (CADDR TEM))) (T (SHOULDNT 'CLISPFOR0] - (ON (* ; - "Normal case, no 'OLD'. No need for dummy variable for ON.") + (ON (* ; + "Normal case, no 'OLD'. No need for dummy variable for ON.") (SETQ LSTVAR I.V.) (CLISPFORINITVAR I.V. TEM)) (T (SETQ PROGVARS (CONS (LIST LSTVAR TEM) @@ -4203,16 +4253,19 @@ with the terms of said license. [COND ((EQ I.V. LSTVAR) (SETQ RETPREDS (NCONC1 RETPREDS (LIST 'NLISTP LSTVAR))) - (* ; - "put it on last so when it is revrsed by CLISPFOR2 will come out first.") + (* ; + "put it on last so when it is revrsed by CLISPFOR2 will come out first.") ) (T (SETQ TERM (NCONC1 TERM (LIST 'SETQ I.V. (COND - [IN (* ;; "reason for checking here rather in retpreds is to avoid user setting a pointer to garbage, e.g. (FOR OLD X IN (QUOTE (19 . 20)) DO PRINT) would leave X set to (CAR 20) otherwise") + [IN + + (* ;; "reason for checking here rather in retpreds is to avoid user setting a pointer to garbage, e.g. (FOR OLD X IN (QUOTE (19 . 20)) DO PRINT) would leave X set to (CAR 20) otherwise") + (SETQ MAKEPROGFLG T) - (* ; - "to make sure that a $$OUT gets added") + (* ; + "to make sure that a $$OUT gets added") (SUBST LSTVAR 'VAR '(CAR (OR (LISTP VAR) (GO $$OUT] @@ -4232,7 +4285,10 @@ with the terms of said license. (FROM [COND [(SETQ TEM (FMEMB I.V. PROGVARS)) (RPLACA TEM (LIST I.V. (CADR FROM] - (T (CLISPFORINITVAR I.V. (CADR FROM] (* ;; "the reason for IVINITFLG (instead of simply searching the PROGVAR lst) is that the iv may bbe an OLD variable and it wont appear anywhere. neverhtless need to know if it is being initialized, because in case of TO, it must be initialzed to 1 if not.") + (T (CLISPFORINITVAR I.V. (CADR FROM] + + (* ;; "the reason for IVINITFLG (instead of simply searching the PROGVAR lst) is that the iv may bbe an OLD variable and it wont appear anywhere. neverhtless need to know if it is being initialized, because in case of TO, it must be initialzed to 1 if not.") + (SETQ IVINITFLG T))) [COND (TO [SETQ TEM (COND @@ -4241,8 +4297,10 @@ with the terms of said license. ((MINUSP (CADR BY)) 'LT) (T 'GT] - [BY [SETQ BY (LIST 'BY (LIST 'SETQ (GETDUMMYVAR T) - (WARNUSER BY] + [BY (* ; + "RMK 2022: Removed call to WARNUSER") + [SETQ BY (LIST 'BY (LIST 'SETQ (GETDUMMYVAR T) + (CADR BY] (LIST 'AND (CAR PROGVARS) (LIST 'OR (LIST 'ZEROP (CAR PROGVARS)) (LIST 'COND (LIST (LIST 'MINUSP (CAR PROGVARS)) @@ -4263,8 +4321,9 @@ with the terms of said license. ((NULL IVINITFLG) (SETQ INITVARS (NCONC1 INITVARS (LIST 'SETQ I.V. 1] (SETQ PROGVARS (CONS (LIST (GETDUMMYVAR) - (WARNUSER TO)) - PROGVARS)) + (CADR TO)) + PROGVARS)) (* ; + "RMK 2022: Remove call to WARNUSER") (SETQ RETPREDS (NCONC1 RETPREDS (COND ((NLISTP TEM) (LIST (CLISPLOOKUP TEM I.V.) @@ -4347,8 +4406,10 @@ with the terms of said license. AFTERPREDS ITER (LIST (LIST 'GO '$$LP)) OUTEXP] - OUT [SETQ TEM (CDR (LISTGET1 LISPXHIST 'SIDE] (* ; "TEM holds a list of side info") - (* ;; "Restores those places where I.V.'s where stuck in, e.g. FOR X IN Y COLLECT FOO was temporarily converted to FOR X IN Y COLLECT (FOO X), and IN Y COLLECT FOO would have been chaged to IN Y COLLECT (FOO $$TEM)") + OUT [SETQ TEM (CDR (LISTGET1 LISPXHIST 'SIDE] (* ; "TEM holds a list of side info") + + (* ;; "Restores those places where I.V.'s where stuck in, e.g. FOR X IN Y COLLECT FOO was temporarily converted to FOR X IN Y COLLECT (FOO X), and IN Y COLLECT FOO would have been chaged to IN Y COLLECT (FOO $$TEM)") + [MAPC UNDOLST (FUNCTION (LAMBDA (X) (FRPLACA (CAR X) (CADR X)) @@ -4356,8 +4417,8 @@ with the terms of said license. (CDDR X)) (COND ((SETQ X (FASSOC (CAR X) - TEM)) (* ; - "to tell dwimnewfile? thatthis change was undone, so not to count the function as being changed") + TEM)) (* ; + "to tell dwimnewfile? thatthis change was undone, so not to count the function as being changed") (FRPLACA X '*] (CLISPTRAN EXP I.S.) (RETURN EXP]) @@ -4975,35 +5036,32 @@ with the terms of said license. (PUTPROPS DWIMUNDOCATCH MACRO ((TAG UNDOFORM) - (* ;; "Hairy control structure used by DWIMIFY. Effectively (CATCH TAG (UNDONLSETQ UNDOFORM)), except that it ensures that the undoing occurs not only when the UNDONLSETQ returns NIL (from ERROR!), but also when a non-list is thrown to TAG. THROW is used in various places to tell the caller to do something different (usually try again after a successful spelling correction). The body of this macro is a copy of the UNDONLSETQ macro appropriately modified.") + (* ;; "Hairy control structure used by DWIMIFY. Effectively (CATCH TAG (UNDONLSETQ UNDOFORM)), except that it ensures that the undoing occurs not only when the UNDONLSETQ returns NIL (from ERROR!), but also when a non-list is thrown to TAG. THROW is used in various places to tell the caller to do something different (usually try again after a successful spelling correction). The body of this macro is a copy of the UNDONLSETQ macro appropriately modified.") - (PROG ((LISPXHIST LISPXHIST) - UNDOSIDE0 UNDOSIDE UNDOTEM) - (DECLARE (SPECVARS LISPXHIST)) - [COND - ([LISTP (SETQ UNDOSIDE (LISTGET1 LISPXHIST - 'SIDE] - (SETQ UNDOSIDE0 (CDR UNDOSIDE))) - (T (SETQ UNDOSIDE0 UNDOSIDE) - (SETQ UNDOSIDE (LIST 0)) - (COND - (LISPXHIST (LISTPUT1 LISPXHIST 'SIDE UNDOSIDE)) - (T (SETQ LISPXHIST (LIST 'SIDE UNDOSIDE] - [SETQ UNDOTEM (RESETVARS (%#UNDOSAVES) - (RETURN (CL:CATCH TAG - (XNLSETQ - UNDOFORM] - (COND - ((EQ UNDOSIDE0 'NOSAVE) - (LISTPUT1 LISPXHIST 'SIDE 'NOSAVE)) - (T (UNDOSAVE))) - [COND - ((NLISTP UNDOTEM) - (* ; - "undo side effects on %"error%" return") - (UNDONLSETQ1 (CDR UNDOSIDE) - (LISTP UNDOSIDE0] - (RETURN UNDOTEM)))) + (PROG ((LISPXHIST LISPXHIST) + UNDOSIDE0 UNDOSIDE UNDOTEM) + (DECLARE (SPECVARS LISPXHIST)) + [COND + ([LISTP (SETQ UNDOSIDE (LISTGET1 LISPXHIST 'SIDE] + (SETQ UNDOSIDE0 (CDR UNDOSIDE))) + (T (SETQ UNDOSIDE0 UNDOSIDE) + (SETQ UNDOSIDE (LIST 0)) + (COND + (LISPXHIST (LISTPUT1 LISPXHIST 'SIDE UNDOSIDE)) + (T (SETQ LISPXHIST (LIST 'SIDE UNDOSIDE] + [SETQ UNDOTEM (RESETVARS (%#UNDOSAVES) + (RETURN (CL:CATCH TAG (XNLSETQ UNDOFORM + ] + (COND + ((EQ UNDOSIDE0 'NOSAVE) + (LISTPUT1 LISPXHIST 'SIDE 'NOSAVE)) + (T (UNDOSAVE))) + [COND + ((NLISTP UNDOTEM) (* ; + "undo side effects on %"error%" return") + (UNDONLSETQ1 (CDR UNDOSIDE) + (LISTP UNDOSIDE0] + (RETURN UNDOTEM)))) ) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY @@ -5062,31 +5120,31 @@ with the terms of said license. (RPAQ? DWIM.GIVE.UP.INTERVAL 2000) (PUTPROPS DWIMIFY COPYRIGHT ("Venue & Xerox Corporation" T 1978 1984 1985 1986 1990)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5654 53366 (DWIMIFYFNS 5664 . 7147) (DWIMIFY 7149 . 8208) (DWIMIFY0 8210 . 14587) ( -DWIMIFY0? 14589 . 16658) (DWMFY0 16660 . 17030) (DWIMIFY1 17032 . 17107) (DWIMIFY1? 17109 . 17655) ( -DWMFY1 17657 . 27339) (DWIMIFY1A 27341 . 28276) (DWIMIFY2 28278 . 28372) (DWIMIFY2? 28374 . 28947) ( -DWMFY2 28949 . 41405) (DWIMIFY2A 41407 . 42269) (CLISPANGLEBRACKETS 42271 . 42532) (SHRIEKER 42534 . -52011) (CLISPRESPELL 52013 . 52720) (EXPRCHECK 52722 . 53364)) (53367 148606 (CLISPATOM0 53377 . 55368 -) (CLISPATOM1 55370 . 81116) (CLRPLNODE 81118 . 81902) (STOPSCAN? 81904 . 85770) (CLUNARYMINUS? 85772 - . 88018) (CLBINARYMINUS? 88020 . 89957) (CLISPATOM1A 89959 . 94944) (CLISPATOM1B 94946 . 95904) ( -CLISPATOM2 95906 . 119040) (CLISPNOEVAL 119042 . 120567) (CLISPLOOKUP 120569 . 122877) (CLISPATOM2A -122879 . 126659) (CLISPBROADSCOPE 126661 . 128011) (CLISPBROADSCOPE1 128013 . 129883) (CLISPATOM2C -129885 . 133554) (CLISPATOM2D 133556 . 135828) (CLISPCAR/CDR 135830 . 140128) (CLISPCAR/CDR1 140130 . -143689) (CLISPCAR/CDR2 143691 . 144064) (CLISPATOMIS1 144066 . 145009) (CLISPATOMARE1 145011 . 145845) - (CLISPATOMARE2 145847 . 147391) (CLISPATOMIS2 147393 . 148604)) (148607 224368 (WTFIX 148617 . 148844 -) (WTFIX0 148846 . 149467) (WTFIX1 149469 . 168890) (RETDWIM 168892 . 174459) (DWIMERRORRETURN 174461 - . 174619) (DWIMARKASCHANGED 174621 . 175877) (RETDWIM1 175879 . 181388) (FIX89TYPEIN 181390 . 182844) - (FIXLAMBDA 182846 . 183359) (FIXAPPLY 183361 . 186156) (FIXATOM 186158 . 192364) (FIXATOM1 192366 . -198783) (FIXCONTINUE 198785 . 199238) (FIXCONTINUE1 199240 . 200174) (CLISPATOM 200176 . 204058) ( -GETVARS 204060 . 205587) (GETVARS1 205589 . 205960) (FIX89 205962 . 207791) (FIXPRINTIN 207793 . -209020) (FIX89A 209022 . 209770) (CLISPFUNCTION? 209772 . 214676) (CLISPNOTVARP 214678 . 215242) ( -CLISP-SIMPLE-FUNCTION-P 215244 . 215580) (CLISPELL 215582 . 216701) (FINDFN 216703 . 223479) ( -DWIMUNSAVEDEF 223481 . 224042) (CHECKTRAN 224044 . 224366)) (224369 235334 (CLISPIF 224379 . 226044) ( -CLISPIF0 226046 . 232242) (CLISPIF1 232244 . 232869) (CLISPIF2 232871 . 233980) (CLISPIF3 233982 . -235332)) (235335 298091 (CLISPFOR 235345 . 236589) (CLISPFOR0 236591 . 269818) (CLISPFOR0A 269820 . -271805) (CLISPFOR1 271807 . 283210) (CLISPRPLNODE 283212 . 283699) (CLISPFOR2 283701 . 284733) ( -CLISPFOR3 284735 . 285285) (CLISPFORVARS 285287 . 293567) (CLISPFORVARS1 293569 . 294117) (CLISPFOR4 -294119 . 294723) (CLISPFORF/L 294725 . 295860) (CLISPDSUBST 295862 . 297053) (GETDUMMYVAR 297055 . -297465) (CLISPFORINITVAR 297467 . 298089)) (298092 304205 (\DURATIONTRAN 298102 . 302964) ( -\CLISPKEYWORDPROCESS 302966 . 304203))))) + (FILEMAP (NIL (5666 53378 (DWIMIFYFNS 5676 . 7159) (DWIMIFY 7161 . 8220) (DWIMIFY0 8222 . 14599) ( +DWIMIFY0? 14601 . 16670) (DWMFY0 16672 . 17042) (DWIMIFY1 17044 . 17119) (DWIMIFY1? 17121 . 17667) ( +DWMFY1 17669 . 27351) (DWIMIFY1A 27353 . 28288) (DWIMIFY2 28290 . 28384) (DWIMIFY2? 28386 . 28959) ( +DWMFY2 28961 . 41417) (DWIMIFY2A 41419 . 42281) (CLISPANGLEBRACKETS 42283 . 42544) (SHRIEKER 42546 . +52023) (CLISPRESPELL 52025 . 52732) (EXPRCHECK 52734 . 53376)) (53379 148618 (CLISPATOM0 53389 . 55380 +) (CLISPATOM1 55382 . 81128) (CLRPLNODE 81130 . 81914) (STOPSCAN? 81916 . 85782) (CLUNARYMINUS? 85784 + . 88030) (CLBINARYMINUS? 88032 . 89969) (CLISPATOM1A 89971 . 94956) (CLISPATOM1B 94958 . 95916) ( +CLISPATOM2 95918 . 119052) (CLISPNOEVAL 119054 . 120579) (CLISPLOOKUP 120581 . 122889) (CLISPATOM2A +122891 . 126671) (CLISPBROADSCOPE 126673 . 128023) (CLISPBROADSCOPE1 128025 . 129895) (CLISPATOM2C +129897 . 133566) (CLISPATOM2D 133568 . 135840) (CLISPCAR/CDR 135842 . 140140) (CLISPCAR/CDR1 140142 . +143701) (CLISPCAR/CDR2 143703 . 144076) (CLISPATOMIS1 144078 . 145021) (CLISPATOMARE1 145023 . 145857) + (CLISPATOMARE2 145859 . 147403) (CLISPATOMIS2 147405 . 148616)) (148619 224380 (WTFIX 148629 . 148856 +) (WTFIX0 148858 . 149479) (WTFIX1 149481 . 168902) (RETDWIM 168904 . 174471) (DWIMERRORRETURN 174473 + . 174631) (DWIMARKASCHANGED 174633 . 175889) (RETDWIM1 175891 . 181400) (FIX89TYPEIN 181402 . 182856) + (FIXLAMBDA 182858 . 183371) (FIXAPPLY 183373 . 186168) (FIXATOM 186170 . 192376) (FIXATOM1 192378 . +198795) (FIXCONTINUE 198797 . 199250) (FIXCONTINUE1 199252 . 200186) (CLISPATOM 200188 . 204070) ( +GETVARS 204072 . 205599) (GETVARS1 205601 . 205972) (FIX89 205974 . 207803) (FIXPRINTIN 207805 . +209032) (FIX89A 209034 . 209782) (CLISPFUNCTION? 209784 . 214688) (CLISPNOTVARP 214690 . 215254) ( +CLISP-SIMPLE-FUNCTION-P 215256 . 215592) (CLISPELL 215594 . 216713) (FINDFN 216715 . 223491) ( +DWIMUNSAVEDEF 223493 . 224054) (CHECKTRAN 224056 . 224378)) (224381 235346 (CLISPIF 224391 . 226056) ( +CLISPIF0 226058 . 232254) (CLISPIF1 232256 . 232881) (CLISPIF2 232883 . 233992) (CLISPIF3 233994 . +235344)) (235347 298653 (CLISPFOR 235357 . 236601) (CLISPFOR0 236603 . 270380) (CLISPFOR0A 270382 . +272367) (CLISPFOR1 272369 . 283772) (CLISPRPLNODE 283774 . 284261) (CLISPFOR2 284263 . 285295) ( +CLISPFOR3 285297 . 285847) (CLISPFORVARS 285849 . 294129) (CLISPFORVARS1 294131 . 294679) (CLISPFOR4 +294681 . 295285) (CLISPFORF/L 295287 . 296422) (CLISPDSUBST 296424 . 297615) (GETDUMMYVAR 297617 . +298027) (CLISPFORINITVAR 298029 . 298651)) (298654 304767 (\DURATIONTRAN 298664 . 303526) ( +\CLISPKEYWORDPROCESS 303528 . 304765))))) STOP diff --git a/sources/DWIMIFY.LCOM b/sources/DWIMIFY.LCOM index 4fcee044d91554f1332fd3dde9980588fa23745e..4ea347315d8c7e78f6629c4b7bb0c5058622bcbb 100644 GIT binary patch delta 2970 zcmb7Gdr(x@8TTL$b0rLdyrkCSim(gpav%FvDa-EN&4y(!>@FH2T6r2O2mu`%`yf_r z9yN)28`p^w69OrT)0pC#Zqms#nl=yG)Hc&c+K$DTW+t6zn}=F6+BW^2dl5II|Aarj z?|i@SJHPL7&biA!-%C&YJ$-LrgyW3C`<%>3aXXV!6?xEq@P3?ny?VD@+20GjOYWusp`nvCtEVkNh z14Em7H*YlSNbT^z)}hYs;acCCU}MnVYFQzgkZnXtNhi8(qFZo*zGJ9+HevTS2Zx52 zyQw!6j5hg|2v2)ag1;pcqC(1Ui^XD~UF};?q9GL*G*;1SFx{+E?+vYf`PNjP6xB#p zfx5l7dBOoXYK|$?=nqG)m&}={yD1{C4k|5Cvk#Nr_rJoxm(O(L5Cs#bHfI)QP`A&? zC8o(=(g~M%F|&t!g)^GCHjJx2q<9-@t`AQObkFM~ zPdM`W({i5OI0t`9n&`bnW5NctxZsVnG?I9~Ad}=|4lr2rOR+59Zg}qAHD>6e=r;AJ03Mr6aPc>3Ke5!{}@z`A{9=j{m zV^f<;7iLOSvRip|UrGKFw&Zyl@&)~VD%qR@_2E$ENK~eh)y86q(j*sCRf6?;C05=# zdllqJgi4atMg4knxHpVi{k$ZDFoMDn5zg5rMLa|8>_Upt(9%RD!69Dv3bvV%&3Z)# z4ahNHOJif}Y7a6ALJAo#IKMz9x?Epm7hR$~@zX`)=_8y`aw2sl#%#6IXwZia?G6_$ zD+{3ryTeKY3bb7U5{$_aTxpnA+f0DXfzim`kS7AzX6I>BLj0;*TT!)aY z3S&XzQ90I(6>pna@kkiJF5YRQbs@G8G(dC#fGxVvbz?Bx5^ciTK9djWob*mPqA(B_ z6(x%&%(F1n(Cn=)kQGl)z3o)%pM(V&Mel0pD~YLr`S-kP)GYL>*+P( z8$U((Ub1i2hn7W|_-19;`pDv&RL?&69=-U7?YriqQx{#OwW%(4l%g2r(n|H-eX{y9 zNB#oND1tStL>fIIJ!aZbNVu`w{Y1UwEJpO%hH}EiH)NBteD2ye(Zlon%;ZPab?THW ze+g%F%)VG&W4acs7k$;$p9Z$xm81F~a#o>~MCB^aT%dh*zlW^z?1cQKrx(&vzZG)4 zz6Wx?w+nJ~-C}Jg#H#IK{646AzKdjP zbmTR7OYYr-{E6K=4ze=7y7M=X=Xbsj`Sz}VL7v!+8{sT@ zLlX?UZ|}>H`YAjDICuYE#x$x;^e4FHO+3anjXiUKvATb}j1{u} zD8`$3?Pw8m{q6ZqhIx+N2Pq_l#Fb-tjP2IrcR=*~$;-%ksPSc_8;UE_tll!x1?yCqwzp=v7P)7+ z27aj#yZ^{K8}tH?Tl$ttbb#noD|->xQ|0N<@9 z9Z+7gw&93bD~Pjb#cr~Y)$qM)(Wz^6>KZNNTn%ZR%lVWz8Y_&iHhIO ze&72$=blwQ$@=U0tUXOB&fxP0yzYqC)$a9By=XBtclDVZb}C3tUUEvJo*MMAWN&{@ zBHm4teN<1kdZI1cRwQ}``(w$0c*9_Fcpw%ZZ1Al12mQXzy5)kAa(an31-k}J4ht1| zr-WQ)J>9_aB&xe<57GqV-HG_4sAD#{hBqv9sO6RU~!5zr`fJI-qfmm zniQq9PKE~u8WPD^SE3=&9dEdGUm}$RUa;9{Y;#xNruZNoN>(~4XISNmMCnZT?r<<_ zr2PZ&hkKI4gK9VM(Nnw06OWnfRw{~43);b2xUIapi2t{|VC3XlT^ZpNpY9J?U^I6l zSM=LI&En^pgb!L$_tdfnc zc11!RQ7`HU5>K1F?VgTcuoL$bK<0+{*;AMa799>t*-gbnha}xdr(7vJl7%l`vZJLM zc2**d`aM{I)o!5`6#+D7wWDAd-0A@0Z}&#-EtRjtg+dCq-QxX=zys*t#E6?(U zJ8;cJ2g?PnHm*UaR*MDU?TUKa+aU3?67Mk6CPeXeJ6#!If}jGT0|0c&`-W&Dnd~3r z^sF8)=T;99PJXO9Rr)pGxu|~U@&dz~@HuDjX0hi$p0}thi+%s{ea4}AoI%jWKuy?Q zty!3@1zj*+LeSZo`?R2~E0=0PO|?(waUp*|b^oxo6i!!akANOrMsM-ln6-=_E}Mkg zZj%d-;@7=O?4cAi*UwCc=xmYye!e8l=~&%^|HDbkr114+Id}|PED53xviBPcwK?9k z?ySb}4tkF|`Rvo^;(14+ulva&`Dma~&UemV%Hg4zb>VNys`@G}XRi)Bn_O{FJB5O!C2IFd|2?kTU^uq& zcc8mmJ3#Mf>;WBW90tAExDm9?-A%Z3BAYDHg5G!koB;lT_cz$c8sEDtL&~;X-rW2{ z0N0!MGpp9#J^tY;427m}PY12T&f{^tVFhrW7kXwuJD{ zBcIuh0`fDdU&Ffo@rRIAIXQBGCGXyG3RK*A0krsu&p>l_;hHH|ch#^tE1$Xwg?=ZC z{eM+HJ;AV3dwvO;vW>_uH5bZD_S#{(-aMbkJ@Pgfw01k7&6Q*OYGM5TzC0Fw;K1c< z*mwW<1yK7a8~NX(5!OrO;0vsmYh&+#zBN7$Xz)-MgIKc9pMOY|{th@a@hl7Y^zeR+ zt33W1ibeutMQ<~*7$5sHzSKKUB^yM|6FTVT;XvOg@FpM65 zpBeHMK|VZv2Ef*zb>@M+_sWS}uphlHvV?EH5oN66WQeiBH+$JE=idGvbLl&~lWCVe zSj}uLANj!Ky?-15UGVX4Kw}?oVbGHEKZSDg{3F@7bA|vl@HAkQX>5VA{!bHZkleqh z--P~)L(KccrE{Q1F8>)cWm_Td`Dd2=-aoeA(4K&#ZF#XAys}!=mME`XNwQSpmrh&= zcIVT*bIE30x8Kht6NH=I&XFgPeL6RvJO`dWTtM2PUMnDG28)H{dB)GqCwC#w^u;35 z$lOdN!x4$r{oH+dGnaAfkaplan>local>medley3.5>working-medley>sources>INSPECT.;12 119048 +(FILECREATED "17-Sep-2022 22:30:33"  +{DSK}kaplan>local>medley3.5>working-medley>sources>INSPECT.;22 123809 - :CHANGES-TO (FNS INSPECT/DATATYPE) + :CHANGES-TO (FNS INSPECT) - :PREVIOUS-DATE "11-Oct-2021 14:04:22" -{DSK}kaplan>local>medley3.5>working-medley>sources>INSPECT.;11) + :PREVIOUS-DATE "12-Sep-2022 21:12:51" +{DSK}kaplan>local>medley3.5>working-medley>sources>INSPECT.;21) (* ; " @@ -99,7 +99,9 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (INSPECTW.CREATE [LAMBDA (DATUM PROPERTIES FETCHFN STOREFN PROPCOMMANDFN VALUECOMMANDFN TITLECOMMANDFN TITLE - SELECTIONFN WHERE PROPPRINTFN) (* ; "Edited 5-Aug-87 09:52 by jop") + SELECTIONFN WHERE PROPPRINTFN TAG) (* ; "Edited 12-Sep-2022 21:07 by rmk") + (* ; "Edited 3-Sep-2022 23:48 by rmk") + (* ; "Edited 5-Aug-87 09:52 by jop") (* ;; "Creates a window with an item list made up of properties and values") @@ -111,22 +113,21 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero ((OR (NULL PROPERTIES) (LISTP PROPERTIES)) PROPERTIES) - (T (* ; - "allow PROPERTIES to be a function") + (T (* ; "allow PROPERTIES to be a function") (APPLY* PROPERTIES DATUM] - (SETQ VALUEMARGIN (\INSPECTW.VALUE.MARGIN - (COND - (PROPPRINTFN (for PROP in PROPERTIESLST - collect (APPLY* PROPPRINTFN PROP - DATUM))) - (T PROPERTIESLST)) - IWFONT)) + (SETQ VALUEMARGIN (\INSPECTW.VALUE.MARGIN (COND + (PROPPRINTFN + (for PROP in PROPERTIESLST + collect (APPLY* PROPPRINTFN + PROP DATUM))) + (T PROPERTIESLST)) + IWFONT)) (SETQ MAXVALUEWIDTH (COND (PROPERTIESLST (IMIN (IMAX (bind X for PROP in PROPERTIESLST - largest (STRINGWIDTH (APPLY* FETCHFN - DATUM PROP) - IWFONT T) + largest (STRINGWIDTH (APPLY* FETCHFN DATUM + PROP) + IWFONT T) finally (RETURN $$EXTREME)) 16) MaxInspectorPropertyValueWidth)) @@ -142,13 +143,18 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (\INSPECT.COMPUTE.TITLE TITLE DATUM))) (DSPFONT IWFONT WINDOW) (DSPRIGHTMARGIN 50000 WINDOW) (* ; - "for now, can't handle multiple PROPCOMMANDFN output. Put right margin way out.") + "for now, can't handle multiple PROPCOMMANDFN output. Put right margin way out.") (WINDOWPROP WINDOW 'DATUM DATUM) (* ; - "initialize the properties of the window.") + "initialize the properties of the window.") (WINDOWPROP WINDOW 'STOREFN STOREFN) (WINDOWPROP WINDOW 'FETCHFN FETCHFN) (WINDOWPROP WINDOW 'PROPCOMMANDFN PROPCOMMANDFN) (WINDOWPROP WINDOW 'VALUECOMMANDFN VALUECOMMANDFN) + (CL:WHEN TAG + (SETQ TAG (CONCAT TAG ": ")) + (WINDOWPROP WINDOW 'INSPECTTAG TAG) + [SETQ TITLE (CONCAT TAG (WINDOWPROP WINDOW 'TITLE] + (WINDOWPROP WINDOW 'TITLE TITLE)) (WINDOWPROP WINDOW 'INSPECTWTITLE TITLE) (WINDOWPROP WINDOW 'TITLECOMMANDFN TITLECOMMANDFN) (WINDOWPROP WINDOW 'SELECTIONFN SELECTIONFN) @@ -481,10 +487,10 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero TITLE BORDER NOOPENFLG]) (DEFAULT.INSPECTW.PROPCOMMANDFN - [LAMBDA (PROPERTY DATUM INSPECTW) (* ; "Edited 1-Dec-96 20:16 by rmk:") - (* ; "Edited 22-Jun-87 16:41 by jop") + [LAMBDA (PROPERTY DATUM INSPECTW) (* ; "Edited 1-Dec-96 20:16 by rmk:") + (* ; "Edited 22-Jun-87 16:41 by jop") - (* ;; "allows the user to select a menu item to change the property in an inspect window.") + (* ;; "allows the user to select a menu item to change the property in an inspect window.") (SELECTQ [MENU (COND ((type? MENU SetPropertyMenu) @@ -505,8 +511,8 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (CLEARBUF T T) (printout T "Eval> ") (SETQ NEWVALUE (CL:FUNCALL XCL:*EVAL-FUNCTION* (LISPXREAD T T))) - (* ; - "clear tty buffer because it sometimes has stuff left.") + (* ; + "clear tty buffer because it sometimes has stuff left.") (CLEARBUF T T)) (REMOVEPROMPTWINDOW INSPECTW) (RETURN (INSPECTW.REPLACE INSPECTW PROPERTY NEWVALUE]) @@ -514,7 +520,9 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero NIL]) (DEFAULT.INSPECTW.VALUECOMMANDFN - [LAMBDA (VALUE PROPERTY DATUM WINDOW) (* ; "Edited 28-Jan-93 16:50 by jds") + [LAMBDA (VALUE PROPERTY DATUM WINDOW) (* ; "Edited 2-Sep-2022 18:06 by rmk") + (* ; "Edited 24-Aug-2022 23:38 by rmk") + (* ; "Edited 28-Jan-93 16:50 by jds") (* ;; "allows the user to choose a way to inspect a value in a window") @@ -530,8 +538,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (printout PROMPTWINDOW T "Can't Inspect " VALUE) (until (MOUSESTATE UP)) (CLRPROMPT)) - (LISTP (* ; - "find out how to inspect the list.") + (LISTP (* ; "find out how to inspect the list.") (INSPECT/LISTP VALUE)) (SELECTQ [MENU (COND ((type? MENU InspectMenu) @@ -542,7 +549,9 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero NIL]) (DEFAULT.INSPECTW.TITLECOMMANDFN - [LAMBDA (INSPECTW DATUM) (* rrb "18-Apr-84 17:57") + [LAMBDA (INSPECTW DATUM) (* ; "Edited 4-Sep-2022 13:42 by rmk") + (* ; "Edited 25-Aug-2022 00:00 by rmk") + (* rrb "18-Apr-84 17:57") (SELECTQ [MENU (COND ((type? MENU ItemWCommandMenu) ItemWCommandMenu) @@ -557,14 +566,38 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (IT_selection 'SETITTOSEL "sets the variable IT to the item selected in this window." - ] + ) + ("Add tag" 'ADDTAG + "add a mnemonic tag to this window's title" + ] (REFETCH (INSPECTW.REDISPLAY INSPECTW)) (SETIT (SETQ IT DATUM)) (SETITTOSEL (COND [(WINDOWPROP INSPECTW 'CURRENTITEM) (SETQ IT (fetch (SELECTABLEITEM ITEMINFO) of (WINDOWPROP INSPECTW - 'CURRENTITEM] + 'CURRENTITEM] (T (PROMPTPRINT "No item has been selected from this window.")))) + (ADDTAG [LET (POS TAG (OLDTAG (WINDOWPROP INSPECTW 'INSPECTTAG)) + (TITLE (WINDOWPROP INSPECTW 'TITLE)) + (PWINDOW (GETPROMPTWINDOW INSPECTW 1))) + (RESETLST + (RESETSAVE (TTYDISPLAYSTREAM PWINDOW)) + (RESETSAVE (TTY.PROCESS (THIS.PROCESS))) + (CLEARBUF T T) + (PRINTOUT T "Tag> ") + (SETQ TAG (CL:READ-LINE T)) + (CLEARBUF T T) + (REMOVEPROMPTWINDOW INSPECTW) + (SETQ TAG (CL:IF (EQ 0 (NCHARS TAG)) + NIL + (CONCAT TAG ": "))) + (WINDOWPROP INSPECTW 'INSPECTTAG TAG) + (* ; "Remove the old tag, if any") + (CL:WHEN (AND OLDTAG (SETQ POS (STRPOS OLDTAG TITLE 1 NIL T T))) + (SETQ TITLE (SUBSTRING TITLE POS))) + (WINDOWPROP INSPECTW 'TITLE (CL:IF TAG + (CONCAT TAG TITLE) + TITLE)))]) NIL]) (\SELITEM.FROM.PROPERTY @@ -576,26 +609,28 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero 'PROPERTY)) do (RETURN SELITEM]) (\INSPECT.COMPUTE.TITLE - [LAMBDA (TITLE DATUM WINDOW) (* ; "Edited 18-Mar-87 15:23 by jrb:") + [LAMBDA (TITLE DATUM WINDOW) (* ; "Edited 3-Sep-2022 23:46 by rmk") + (* ; "Edited 2-Sep-2022 18:05 by rmk") + (* ; "Edited 24-Aug-2022 23:35 by rmk") + (* ; "Edited 18-Mar-87 15:23 by jrb:") (* ; - "computes the title for an inspectw from its title field and its datum.") - (PROG (VALUE) - (RETURN (COND - ((NULL TITLE) - (CONCAT (LET ((*PRINT-LEVEL* 3) - (*PRINT-LENGTH* 4)) - (CL:PRINC-TO-STRING DATUM)) - " Inspector")) - ((EQ TITLE 'DON'T) (* ; "no title") - NIL) - ((LITATOM TITLE) (* ; - "it is a function to compute the title.") - (COND - ((NEQ (SETQ VALUE (APPLY* TITLE DATUM WINDOW)) - 'DON'T) - VALUE) - (T NIL))) - (T TITLE]) + "computes the title for an inspectw from its title field and its datum.") + (LET (VALUE) + (COND + ((NULL TITLE) + (LET ((*PRINT-LEVEL* 3) + (*PRINT-LENGTH* 4)) + (CL:PRINC-TO-STRING DATUM))) + ((EQ TITLE 'DON'T) (* ; "no title") + NIL) + ((LITATOM TITLE) (* ; + "it is a function to compute the title.") + (COND + ((NEQ (SETQ VALUE (APPLY* TITLE DATUM WINDOW)) + 'DON'T) + VALUE) + (T NIL))) + (T TITLE]) (LEVELEDFORM [LAMBDA (EXP CARLEV CDRLEV) (* ; "Edited 3-Feb-87 16:35 by jop") @@ -672,7 +707,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero WINDOW]) (\ITEM.WINDOW.BUTTON.HANDLER - [LAMBDA (WINDOW) (* ; "Edited 3-Feb-87 16:45 by jop") + [LAMBDA (WINDOW) (* ; "Edited 3-Feb-87 16:45 by jop") (* ;; "handles button events for item windows. Basically calls left or middle button handler.") @@ -962,7 +997,8 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (DEFINEQ (\ITEM.WINDOW.COPY.HANDLER - [LAMBDA (WINDOW) (* ; "Edited 2-Feb-87 17:27 by jop") + [LAMBDA (WINDOW) (* ; "Edited 4-Sep-2022 08:58 by rmk") + (* ; "Edited 2-Feb-87 17:27 by jop") (* ;; "copy selects an ITEM from the window. An ITEM is an instance of record SELECTABLEITEM.") @@ -980,15 +1016,15 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (\ITEMW.FLIPCOPY CURRENTITEM WINDOW))) (COND ((SETQ CURRENTITEM NEWITEM) - (\ITEMW.FLIPCOPY CURRENTITEM WINDOW] (* ; - "wait for a button up or move out of region") + (\ITEMW.FLIPCOPY CURRENTITEM WINDOW] (* ; + "wait for a button up or move out of region") LP2 (BLOCK) (COND ((NOT (.COPYKEYDOWNP.)) (* ; "Finished, copy selected item") [COND (CURRENTITEM (\ITEMW.FLIPCOPY CURRENTITEM WINDOW) - (BKSYSBUF.GENERAL (fetch (SELECTABLEITEM ITEMINFO) of CURRENTITEM - ] + (BKSYSBUF.GENERAL (fetch (SELECTABLEITEM ITEMINFO) of CURRENTITEM))) + (T (BKSYSBUF.GENERAL (WINDOWPROP WINDOW 'DATUM] (RETURN)) ((MOUSESTATE UP) (* ; "button up, no action") (GO LP2)) @@ -1059,68 +1095,84 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (DEFINEQ (INSPECT - [LAMBDA (ITEM ASTYPE WHERE) (* ; "Edited 1-Dec-96 21:09 by rmk:") - (* ; "Edited 2-Feb-87 17:09 by jop") + [LAMBDA (ITEM ASTYPE WHERE TAG) - (* ;; "sets up a window that allows inspection.") + (* ;; "Edited 17-Sep-2022 22:30 by rmk") - (DECLARE (SPECVARS WHERE)) + (* ;; "Edited 12-Sep-2022 20:54 by rmk") + + (* ;; "Edited 3-Sep-2022 23:32 by rmk") + + (* ;; "Edited 2-Sep-2022 17:59 by rmk") + + (* ;; + "Edited 24-Aug-2022 23:32 by rmk: Added optional TAG as a mnemonic packed onto window title") + + (* ;; "Edited 1-Dec-96 21:09 by rmk:") + + (* ;; "Edited 2-Feb-87 17:09 by jop") + + (* ;; "sets up a window that allows inspection.") + + (DECLARE (SPECVARS WHERE TAG)) (LET ((ITEMTYPE (TYPENAME ITEM)) IWINDOW INSPECTINFO) (CL:SETQ IWINDOW (COND - (ASTYPE (* ; - "if ASTYPE is given, always inspect it as that type. This provides a way of overriding macros.") - (INSPECT/DATATYPE ITEM ASTYPE WHERE)) + (ASTYPE (* ; + "if ASTYPE is given, always inspect it as that type. This provides a way of overriding macros.") + (INSPECT/DATATYPE ITEM ASTYPE WHERE TAG)) [(SETQ INSPECTINFO (for IMACRO in INSPECTMACROS when (COND - [(LISTP (CAR IMACRO)) - (COND - ((EQ (CAAR IMACRO) - 'FUNCTION) - (APPLY* (CADAR IMACRO) - ITEM)) - (T (ERROR + [(LISTP (CAR IMACRO)) + (COND + ((EQ (CAAR IMACRO) + 'FUNCTION) + (APPLY* (CADAR IMACRO) + ITEM)) + (T (ERROR "ERROR in INSPECTMACROS specification" - IMACRO] - (T (EQ (CAR IMACRO) - ITEMTYPE))) + IMACRO] + (T (EQ (CAR IMACRO) + ITEMTYPE))) do (RETURN IMACRO))) (COND - ((LISTP (CDR INSPECTINFO)) (* ; - "inspect information is a list of arguments to INSPECTW.CREATE") + ((LISTP (CDR INSPECTINFO)) (* ; + "inspect information is a list of arguments to INSPECTW.CREATE") (\APPLYINSPECTMACRO ITEM (CDR INSPECTINFO) - WHERE)) - (T (* ; - "if inspect information is an atom, apply it to the ITEM.") + WHERE TAG)) + (T (* ; + "if inspect information is an atom, apply it to the ITEM.") (APPLY* (CDR INSPECTINFO) ITEM (CAR INSPECTINFO) - WHERE] + WHERE TAG] [ITEM (SELECTQ ITEMTYPE - (LITATOM (INSPECT/ATOM ITEM NIL WHERE)) - (LISTP (* ; - "find out how to inspect the list.") - (INSPECT/LISTP ITEM WHERE)) - (ARRAYP (INSPECT/ARRAY ITEM NIL WHERE)) - (HARRAYP (INSPECT/HARRAYP ITEM WHERE)) - (BITMAP (INSPECT/BITMAP ITEM WHERE)) - (CCODEP (INSPECTCODE ITEM WHERE)) - (NIL (INSPECT/TYPELESS ITEM WHERE)) + (LITATOM (INSPECT/ATOM ITEM NIL WHERE TAG)) + (LISTP (* ; "find out how to inspect the list.") + (INSPECT/LISTP ITEM WHERE TAG)) + (ARRAYP (INSPECT/ARRAY ITEM NIL WHERE TAG)) + (HARRAYP (INSPECT/HARRAYP ITEM WHERE TAG)) + (BITMAP (INSPECT/BITMAP ITEM WHERE TAG)) + (CCODEP (INSPECTCODE ITEM WHERE TAG)) + (NIL (INSPECT/TYPELESS ITEM WHERE TAG)) (LET [(DTD (\GETDTD (NTYPX ITEM] (COND ((fetch DTDHUNKP of DTD) (INSPECT/HUNK ITEM WHERE (fetch DTDGCTYPE - of DTD) - (fetch DTDSIZE of DTD))) - (T (INSPECT/DATATYPE ITEM NIL WHERE] + of DTD) + (fetch DTDSIZE of DTD) + TAG)) + (T (INSPECT/DATATYPE ITEM NIL WHERE TAG] (T (printout PROMPTWINDOW T "Can't Inspect NIL.") NIL))) - (CL:WHEN (WINDOWP IWINDOW) (* ; - "Mark it as an inspect window, so that utilities such as WDWHACKS can recognize it") - (WINDOWPROP IWINDOW 'INSPECTWINDOW T))]) + (CL:WHEN (WINDOWP IWINDOW) (* ; + "Mark it as an inspect window, so that utilities such as WDWHACKS can recognize it") + (WINDOWPROP IWINDOW 'INSPECTWINDOW T)) + IWINDOW]) (\APPLYINSPECTMACRO - [LAMBDA (DATUM ARGLST WHERE) (* ; "Edited 3-Feb-87 15:18 by jop") + [LAMBDA (DATUM ARGLST WHERE TAG) (* ; "Edited 12-Sep-2022 20:50 by rmk") + (* ; "Edited 3-Feb-87 15:18 by jop") (* ;; "function that calls INSPECTW.CREATE when given the inspect macro information. Separate because of difficulty of interpreting WHERE argument.") @@ -1134,14 +1186,15 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (pop ARGS) (pop ARGS) (COND - (ARGS (* ; - "WHERE argument must be evaluated.") + (ARGS (* ; "WHERE argument must be evaluated.") (EVAL ARGS)) (T WHERE)) - (pop ARGS]) + (pop ARGS) + TAG]) (INSPECT/BITMAP - [LAMBDA (BITMAP WHERE) (* ; "Edited 2-Feb-87 17:07 by jop") + [LAMBDA (BITMAP WHERE TAG) (* ; "Edited 12-Sep-2022 20:52 by rmk") + (* ; "Edited 2-Feb-87 17:07 by jop") (* ;; "asks whether to use the bitmap editor or not") @@ -1155,12 +1208,13 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (contents 'CONTENTS "Edits the contents of the bitmap." ] - (FIELDS (INSPECT/DATATYPE BITMAP 'BITMAP WHERE)) + (FIELDS (INSPECT/DATATYPE BITMAP 'BITMAP WHERE TAG)) (CONTENTS (EVAL.AS.PROCESS (LIST 'EDITBM BITMAP))) NIL]) (INSPECT/DATATYPE - [LAMBDA (DATUM TYPE WHERE) (* ; "Edited 9-Aug-2022 08:56 by rmk") + [LAMBDA (DATUM TYPE WHERE TAG) (* ; "Edited 12-Sep-2022 20:58 by rmk") + (* ; "Edited 9-Aug-2022 08:56 by rmk") (* ; "Edited 1-Dec-96 20:15 by rmk:") (* ; "Edited 7-Aug-87 10:21 by jop") @@ -1194,24 +1248,24 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (CL:FORMAT NIL "<~a @ ~o,~o>" TYPE (\HILOC DATUM) (\LOLOC DATUM))) - NIL NIL WHERE)) + NIL NIL WHERE NIL TAG)) ([SETQ DEC (fetch DTDDESCRS of (\GETDTD (NTYPX DATUM] (* ;  "No user-level declaration, but we can at least fetch raw fields out of it") (INSPECTW.CREATE DATUM (for I to (LENGTH DEC) collect I) `[LAMBDA (FIELD INSTANCE) (\INSPECT.DATATYPE.RAW.FETCH FIELD INSTANCE ',DEC] - NIL "System datatype: Cann't set any fields" NIL NIL NIL NIL WHERE)) + NIL "System datatype: Cann't set any fields" NIL NIL NIL NIL WHERE NIL TAG)) ((AND (LISTP DATUM) (SELECTQ TYPE (ALIST (CL:WHEN (ALISTP DATUM) - (INSPECT/ALIST DATUM WHERE) + (INSPECT/ALIST DATUM WHERE TAG) T) (ALISTP DATUM)) (PLIST (CL:WHEN (PROPLISTP DATUM) - (INSPECT/PLIST DATUM WHERE) + (INSPECT/PLIST DATUM WHERE TAG) T)) - (LIST (INSPECT/TOP/LEVEL/LIST DATUM WHERE) + (LIST (INSPECT/TOP/LEVEL/LIST DATUM WHERE TAG) T) NIL))) (T (printout PROMPTWINDOW T "No declaration for " DATUM T "Can not inspect.") @@ -1235,7 +1289,8 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (INTERSECTION LST LST]) (INSPECT/ARRAY - [LAMBDA (ARRAY BEGINOFFSET WHERE) (* ; "Edited 2-Feb-87 17:06 by jop") + [LAMBDA (ARRAY BEGINOFFSET WHERE TAG) (* ; "Edited 12-Sep-2022 20:55 by rmk") + (* ; "Edited 2-Feb-87 17:06 by jop") (* ;; "inspects an array") @@ -1244,39 +1299,40 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (PROG [(FIRSTELT (OR (NUMBERP BEGINOFFSET) (ARRAYORIG ARRAY] (RETURN (INSPECTW.CREATE ARRAY (for I from FIRSTELT - to (SUB1 (IMIN (IPLUS (ARRAYORIG ARRAY) - (ARRAYSIZE ARRAY)) - (IPLUS FIRSTELT - MAXINSPECTARRAYLEVEL))) - collect I) + to (SUB1 (IMIN (IPLUS (ARRAYORIG ARRAY) + (ARRAYSIZE ARRAY)) + (IPLUS FIRSTELT MAXINSPECTARRAYLEVEL)) + ) collect I) (FUNCTION ELT) (FUNCTION /SETA) - NIL NIL NIL NIL NIL WHERE] + NIL NIL NIL NIL NIL WHERE NIL TAG] (T (printout PROMPTWINDOW T ARRAY " not an array") NIL]) (INSPECT/TOP/LEVEL/LIST - [LAMBDA (LST WHERE) (* ; "Edited 2-Feb-87 17:02 by jop") + [LAMBDA (LST WHERE TAG) (* ; "Edited 12-Sep-2022 20:56 by rmk") + (* ; "Edited 9-Sep-2022 21:49 by rmk") + (* ; "Edited 2-Feb-87 17:02 by jop") (* ;; "inspects one level of a list structure via numbered fields.") (COND ((LISTP LST) - (INSPECTW.CREATE LST [for I from 1 to MAXINSPECTCDRLEVEL as X - on LST collect I - finally (COND - (X (NCONC1 $$VAL (COND - ((NLISTP X) - '|...|) - (T '&&] + (INSPECTW.CREATE LST [for I from 1 to MAXINSPECTCDRLEVEL as X on LST collect I + finally (COND + (X (NCONC1 $$VAL (COND + ((NLISTP X) + '|...|) + (T '&&] (FUNCTION NTHTOPLEVELELT) (FUNCTION SETNTHTOPLEVELELT) - NIL NIL NIL NIL NIL WHERE)) + NIL NIL NIL NIL NIL WHERE NIL TAG)) (T (printout PROMPTWINDOW T LST " not a LISTP") NIL]) (INSPECT/PROPLIST - [LAMBDA (ATOM ALLPROPSFLG WHERE) (* ; "Edited 3-Feb-87 16:51 by jop") + [LAMBDA (ATOM ALLPROPSFLG WHERE TAG) (* ; "Edited 12-Sep-2022 20:59 by rmk") + (* ; "Edited 3-Feb-87 16:51 by jop") (* ;; "opens an inspect window onto the properties of ATOM") @@ -1285,11 +1341,11 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (T (NONSYSPROPNAMES ATOM] (RETURN (COND (PROPS (INSPECTW.CREATE ATOM (COND - (ALLPROPSFLG (FUNCTION PROPNAMES)) - (T (FUNCTION NONSYSPROPNAMES))) + (ALLPROPSFLG (FUNCTION PROPNAMES)) + (T (FUNCTION NONSYSPROPNAMES))) (FUNCTION GETPROP) (FUNCTION /PUTPROP) - NIL NIL NIL NIL NIL WHERE)) + NIL NIL NIL NIL NIL WHERE NIL TAG)) (T (PROMPTPRINT (COND (ALLPROPSFLG "No properties") (T "No non-system properties"))) @@ -1303,13 +1359,14 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (for PROP in (PROPNAMES ATM) when (NOT (FMEMB PROP SYSPROPS)) collect PROP]) (INSPECT/LISTP - [LAMBDA (LST WHERE) (* ; "Edited 2-Feb-87 17:05 by jop") + [LAMBDA (LST WHERE TAG) (* ; "Edited 12-Sep-2022 20:49 by rmk") + (* ; "Edited 2-Feb-87 17:05 by jop") (* ;; "asks how the user wants to inspect a list and calls the appropriate function.") (APPLY* (OR (SELECT.LIST.INSPECTOR LST) (FUNCTION NILL)) - LST WHERE]) + LST WHERE TAG]) (ALISTP [LAMBDA (LST) (* ; "Edited 3-Feb-87 16:48 by jop") @@ -1336,14 +1393,15 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (T (RETURN NIL]) (INSPECT/ALIST - [LAMBDA (ALST WHERE) (* ; "Edited 2-Feb-87 17:04 by jop") + [LAMBDA (ALST WHERE TAG) (* ; "Edited 12-Sep-2022 20:59 by rmk") + (* ; "Edited 2-Feb-87 17:04 by jop") (* ;; "opens an inspect window onto an ALIST.") (INSPECTW.CREATE ALST (for X in ALST collect (CAR X)) (FUNCTION ASSOCGET) (FUNCTION /ASSOCPUT) - NIL NIL NIL NIL NIL WHERE]) + NIL NIL NIL NIL NIL WHERE NIL TAG]) (ASSOCGET [LAMBDA (ALST KEY) (* ; "Edited 2-Feb-87 17:04 by jop") @@ -1361,25 +1419,28 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (/PUTASSOC KEY VAL ALST]) (INSPECT/PLIST - [LAMBDA (PLST WHERE) (* ; "Edited 2-Feb-87 17:05 by jop") + [LAMBDA (PLST WHERE TAG) (* ; "Edited 12-Sep-2022 20:57 by rmk") + (* ; "Edited 2-Feb-87 17:05 by jop") (* ;; "opens an inspect window onto an ALIST.") (INSPECTW.CREATE PLST (for X in PLST by (CDDR X) collect X) (FUNCTION LISTGET) (FUNCTION /LISTPUT) - NIL NIL NIL NIL NIL WHERE]) + NIL NIL NIL NIL NIL WHERE NIL TAG]) (INSPECT/TYPERECORD - [LAMBDA (X WHERE) (* ; "Edited 2-Feb-87 17:05 by jop") + [LAMBDA (X WHERE TAG) (* ; "Edited 12-Sep-2022 21:05 by rmk") + (* ; "Edited 2-Feb-87 17:05 by jop") (* ;; "inspects X assuming it is a typerecord instance.") (INSPECT X (CAR X) - WHERE]) + WHERE TAG]) (INSPECT/AS/RECORD - [LAMBDA (INSTANCE WHERE) (* ; "Edited 2-Feb-87 17:03 by jop") + [LAMBDA (INSTANCE WHERE TAG) (* ; "Edited 12-Sep-2022 21:04 by rmk") + (* ; "Edited 2-Feb-87 17:03 by jop") (* ;; "offers the user a choice of record types to inspect INSTANCE with.") @@ -1388,16 +1449,16 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero ITEMS _ (SORT (for RECDEC in USERRECLST when (FMEMB (CAR RECDEC) - '(TYPERECORD RECORD)) + '(TYPERECORD RECORD)) collect (CADR RECDEC))) WHENHELDFN _ (FUNCTION (LAMBDA (ITEM) (PROMPTPRINT "Will inspect the list as if it were an instance of this record type." ] - (INSPECT INSTANCE RECORD WHERE]) + (INSPECT INSTANCE RECORD WHERE TAG]) (SELECT.LIST.INSPECTOR - [LAMBDA (LST) (* ; "Edited 2-Feb-87 17:05 by jop") + [LAMBDA (LST) (* ; "Edited 2-Feb-87 17:05 by jop") (* ;; "gives the user a choice of how to edit a list.") @@ -1419,7 +1480,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero ((AND RECDEC (EQ (CAR RECDEC) 'TYPERECORD)) (* ; - "this is likely to be an instance of the typed record.") + "this is likely to be an instance of the typed record.") (CONS (LIST (CONCAT "As a " (CAR LST)) ''INSPECT/TYPERECORD (CONCAT @@ -1553,7 +1614,8 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (DEFINEQ (INSPECT/ATOM - [LAMBDA (ATM ALWAYSASKFLG WHERE) (* ; "Edited 1-Sep-87 10:47 by woz") + [LAMBDA (ATM ALWAYSASKFLG WHERE TAG) (* ; "Edited 12-Sep-2022 20:59 by rmk") + (* ; "Edited 1-Sep-87 10:47 by woz") (* ;; "asks which aspect to inspect and inspects it.") @@ -1562,17 +1624,17 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (PROFILE (MAKE-INSPECTOR-PROFILE)) TYPETOINSPECT) [COND - ((NONSYSPROPNAMES ATM) (* ; - "add the property list to selectable aspects.") + ((NONSYSPROPNAMES ATM) (* ; + "add the property list to selectable aspects.") (push ASPECTS 'PROPS)) ((AND (NULL ASPECTS) (GETPROPLIST ATM)) (* ; - "If there is nothing else to inspect about this atom, offer its propertylist.") + "If there is nothing else to inspect about this atom, offer its propertylist.") (SETQ ASPECTS '(PROPS] [COND ((AND (MEMB 'VARS ASPECTS) (LITATOM (EVALV ATM))) (* ; - "break the loop that can result from inspecting something that has an atom as its value") + "break the loop that can result from inspecting something that has an atom as its value") (SETQ ASPECTS (REMOVE 'VARS ASPECTS] (COND ((NOT ASPECTS) @@ -1595,7 +1657,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (SELECTQ TYPETOINSPECT (PROPS (* ; - "ask what method to use to inspect it.") + "ask what method to use to inspect it.") (SELECTQ [MENU (COND ((type? MENU InspectPropsMenu) InspectPropsMenu) @@ -1696,7 +1758,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (DEFINEQ (INSPECTCODE - [LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER) (* ; "Edited 4-Feb-87 15:41 by jop") + [LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER) (* ; "Edited 4-Feb-87 15:41 by jop") (* ;; "creates a window that shows the compiled code of a function.") @@ -1713,7 +1775,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (WINDOWPROP WINDOW 'SCROLLFN (FUNCTION SCROLLBYREPAINTFN)) (WINDOWPROP WINDOW 'PROFILE (MAKE-INSPECTOR-PROFILE)) (* ; - "call the reshapefn to note the upper left corner and the extent.") + "call the reshapefn to note the upper left corner and the extent.") (\INSPECT/CODE/RESHAPEFN WINDOW]) (\TEDIT.INSPECTCODE @@ -1796,7 +1858,8 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (DEFINEQ (INSPECT/HARRAYP - [LAMBDA (HARRAY WHERE) (* ; "Edited 2-Feb-87 17:06 by jop") + [LAMBDA (HARRAY WHERE TAG) (* ; "Edited 12-Sep-2022 20:57 by rmk") + (* ; "Edited 2-Feb-87 17:06 by jop") (* ;; "opens an inspect window onto the elements of HARRAY") @@ -1805,7 +1868,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (PROPS (INSPECTW.CREATE HARRAY (FUNCTION HARRAYKEYS) (FUNCTION INSPECTW.GETHASH) (FUNCTION INSPECTW.PUTHASH) - NIL NIL NIL NIL NIL WHERE)) + NIL NIL NIL NIL NIL WHERE NIL TAG)) (T (PROMPTPRINT "No keys in that Hash array.") NIL]) @@ -1980,7 +2043,8 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (DEFINEQ (INSPECT/AS/BLOCKRECORD - [LAMBDA (INSTANCE WHERE CHOICES) (* ; "Edited 3-Feb-87 16:50 by jop") + [LAMBDA (INSTANCE WHERE CHOICES TAG) (* ; "Edited 12-Sep-2022 21:04 by rmk") + (* ; "Edited 3-Feb-87 16:50 by jop") (* ;; "offers the user a choice of record types to inspect INSTANCE with.") @@ -1994,10 +2058,11 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (PROMPTPRINT "Will inspect the list as if it were a " ITEM] - (INSPECT INSTANCE RECNAME WHERE]) + (INSPECT INSTANCE RECNAME WHERE TAG]) (INSPECT/TYPELESS - [LAMBDA (ITEM WHERE) (* ; "Edited 2-Feb-87 17:08 by jop") + [LAMBDA (ITEM WHERE TAG) (* ; "Edited 12-Sep-2022 21:01 by rmk") + (* ; "Edited 2-Feb-87 17:08 by jop") (* ;; "Inspects an object that is typeless. Check very carefully to see if it might be an arrayblock, in which case we can try to inspect it as some kind of array. Otherwise, we might be able to interpret it as some block record.") @@ -2014,8 +2079,9 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (INSPECT/HUNK ITEM WHERE (fetch (ARRAYBLOCK GCTYPE) of HDR) (IDIFFERENCE (UNFOLD (fetch (ARRAYBLOCK ARLEN) of HDR) WORDSPERCELL) - \ArrayBlockOverheadWords))) - (T (INSPECT/AS/BLOCKRECORD ITEM WHERE]) + \ArrayBlockOverheadWords) + TAG)) + (T (INSPECT/AS/BLOCKRECORD ITEM WHERE NIL TAG]) (LIST-ALL-BLOCKRECORDS [LAMBDA NIL (* bvm%: "16-Jun-86 11:22") @@ -2023,7 +2089,8 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero 'BLOCKRECORD) collect (CADR RECDEC]) (INSPECT/HUNK - [LAMBDA (DATUM WHERE GCTYPE SIZE) (* ; "Edited 7-Aug-87 10:07 by jop") + [LAMBDA (DATUM WHERE GCTYPE SIZE TAG) (* ; "Edited 12-Sep-2022 20:54 by rmk") + (* ; "Edited 7-Aug-87 10:07 by jop") (* ;; "Inspects a typeless DATUM, which is either a hunk or an array block, with indicated GCTYPE and SIZE in words.") @@ -2033,34 +2100,32 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (RETURN (INSPECTCODE (INSPECT/MAKE/CCODEP DATUM) WHERE))) (PTRBLOCK.GCT (* ; - "Pointers live here, so size is unambiguous") + "Pointers live here, so size is unambiguous") (SETQ ELTSPEC '(32 \INSPECT.FETCH.PTR \INSPECT.STORE.PTR))) (PROGN (* ; - "Completely unboxed, so we don't know how to interpret it") + "Completely unboxed, so we don't know how to interpret it") (COND ([NULL (SETQ ELTSPEC (MENU (create MENU ITEMS _ (COND - ((SETQ BLOCKRECS ( - LIST-ALL-BLOCKRECORDS - )) + ((SETQ BLOCKRECS (LIST-ALL-BLOCKRECORDS) + ) (CONS '("As BLOCKRECORD" 'BLOCKRECORD) INSPECT.HUNK.COMMANDS)) (T INSPECT.HUNK.COMMANDS)) CENTERFLG _ T] (RETURN NIL)) ((EQ ELTSPEC 'BLOCKRECORD) - (RETURN (INSPECT/AS/BLOCKRECORD DATUM WHERE BLOCKRECS] + (RETURN (INSPECT/AS/BLOCKRECORD DATUM WHERE BLOCKRECS TAG] (* ;;; "At this point ELTSPEC is a list of (itemsize fetchfn storefn). Create an inspector that inspects the appropriate number of items, based on the size") - (INSPECTW.CREATE DATUM (for I from 0 - to (IMIN (SUB1 (IQUOTIENT (UNFOLD SIZE BITSPERWORD) - (CAR ELTSPEC))) - MAXINSPECTARRAYLEVEL) collect I) + (INSPECTW.CREATE DATUM (for I from 0 to (IMIN (SUB1 (IQUOTIENT (UNFOLD SIZE BITSPERWORD) + (CAR ELTSPEC))) + MAXINSPECTARRAYLEVEL) collect I) (CADR ELTSPEC) (CADDR ELTSPEC) - NIL NIL NIL NIL NIL WHERE]) + NIL NIL NIL NIL NIL WHERE NIL TAG]) (\INSPECT.DATATYPE.RAW.FETCH [LAMBDA (INSTANCE FIELD DESCRS) (* ; "Edited 3-Feb-87 16:55 by jop") @@ -2143,40 +2208,40 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (PUTPROPS INSPECT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1991 1993 1995 1999 2018 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6989 42717 (INSPECTW.CREATE 6999 . 11754) (INSPECTW.REPAINTFN 11756 . 17292) ( -INSPECTW.REDISPLAY 17294 . 26166) (\INSPECTW.VALUE.MARGIN 26168 . 26571) (INSPECTW.REPLACE 26573 . -27281) (INSPECTW.SELECTITEM 27283 . 28273) (\INSPECTW.REDISPLAYPROP 28275 . 30705) (INSPECTW.FETCH -30707 . 31130) (INSPECTW.PROPERTIES 31132 . 31773) (DECODE.WINDOW.ARG 31775 . 33503) ( -DEFAULT.INSPECTW.PROPCOMMANDFN 33505 . 35523) (DEFAULT.INSPECTW.VALUECOMMANDFN 35525 . 36783) ( -DEFAULT.INSPECTW.TITLECOMMANDFN 36785 . 38475) (\SELITEM.FROM.PROPERTY 38477 . 38919) ( -\INSPECT.COMPUTE.TITLE 38921 . 40047) (LEVELEDFORM 40049 . 40768) (MAKEWITHINREGION 40770 . 42715)) ( -42718 60019 (ITEMW.REPAINTFN 42728 . 43948) (\ITEM.WINDOW.BUTTON.HANDLER 43950 . 44365) ( -\ITEM.WINDOW.SELECTION.HANDLER 44367 . 47034) (\INSPECTW.COMMAND.HANDLER 47036 . 51037) ( -ITEM.WINDOW.SET.STACK.ARG 51039 . 53243) (REPLACESTKARG 53245 . 54344) (IN/ITEM? 54346 . 55228) ( -\ITEMW.DESELECTITEM 55230 . 55494) (\ITEMW.SELECTITEM 55496 . 55758) (\ITEMW.CLEARSELECTION 55760 . -56115) (\ITEMW.FLIPITEM 56117 . 56590) (PRINTANDBOX 56592 . 59101) (PRINTATBOX 59103 . 59620) ( -ITEMOFPROPERTYVALUE 59622 . 60017)) (60020 63625 (\ITEM.WINDOW.COPY.HANDLER 60030 . 61751) ( -\ITEMW.FLIPCOPY 61753 . 62212) (BKSYSBUF.GENERAL 62214 . 63623)) (64017 86547 (INSPECT 64027 . 68290) -(\APPLYINSPECTMACRO 68292 . 69274) (INSPECT/BITMAP 69276 . 70311) (INSPECT/DATATYPE 70313 . 73611) ( -INSPECTABLEFIELDNAMES 73613 . 74134) (REMOVEDUPS 74136 . 74341) (INSPECT/ARRAY 74343 . 75380) ( -INSPECT/TOP/LEVEL/LIST 75382 . 76341) (INSPECT/PROPLIST 76343 . 77318) (NONSYSPROPNAMES 77320 . 77616) - (INSPECT/LISTP 77618 . 77940) (ALISTP 77942 . 78151) (PROPLISTP 78153 . 78793) (INSPECT/ALIST 78795 - . 79150) (ASSOCGET 79152 . 79363) (/ASSOCPUT 79365 . 79630) (INSPECT/PLIST 79632 . 79995) ( -INSPECT/TYPERECORD 79997 . 80237) (INSPECT/AS/RECORD 80239 . 81363) (SELECT.LIST.INSPECTOR 81365 . -83410) (STANDARDEDITE 83412 . 83695) (NTHTOPLEVELELT 83697 . 84013) (SETNTHTOPLEVELELT 84015 . 84775) -(DEDITE 84777 . 84984) (FINDRECDECL 84986 . 85569) (FINDSYSRECDECL 85571 . 85972) ( -MAKE-INSPECTOR-PROFILE 85974 . 86359) (CONFIRM-SET 86361 . 86545)) (88313 96402 (INSPECT/ATOM 88323 . -92303) (SELECT.ATOM.ASPECT 92305 . 93449) (INSPECT/AS/FUNCTION 93451 . 95737) (SELECT.FNS.EDITOR 95739 - . 96400)) (96443 101862 (INSPECTCODE 96453 . 97599) (\TEDIT.INSPECTCODE 97601 . 99579) ( -\INSPECT/CODE/RESHAPEFN 99581 . 101120) (\INSPECT/CODE/REPAINTFN 101122 . 101860)) (101900 103385 ( -INSPECT/HARRAYP 101910 . 102537) (HARRAYKEYS 102539 . 102918) (INSPECTW.GETHASH 102920 . 103147) ( -INSPECTW.PUTHASH 103149 . 103383)) (103434 109643 (RDTBL\NONOTHERCODES 103444 . 104464) (GETSYNTAXPROP - 104466 . 105964) (SETSYNTAXPROP 105966 . 107693) (GETTTBLPROP 107695 . 108613) (SETTTBLPROP 108615 . -109641)) (110122 118505 (INSPECT/AS/BLOCKRECORD 110132 . 111015) (INSPECT/TYPELESS 111017 . 112263) ( -LIST-ALL-BLOCKRECORDS 112265 . 112540) (INSPECT/HUNK 112542 . 115148) (\INSPECT.DATATYPE.RAW.FETCH -115150 . 115476) (\INSPECT.FETCH.8 115478 . 115627) (\INSPECT.FETCH.32 115629 . 115800) ( -\INSPECT.FETCH.CHAR 115802 . 115965) (\INSPECT.FETCH.FATCHAR 115967 . 116129) (\INSPECT.FETCH.PTR -116131 . 116302) (\INSPECT.STORE.8 116304 . 116610) (\INSPECT.STORE.16 116612 . 116912) ( -\INSPECT.STORE.32 116914 . 117349) (\INSPECT.STORE.CHAR 117351 . 117677) (\INSPECT.STORE.FATCHAR -117679 . 118001) (\INSPECT.STORE.PTR 118003 . 118350) (INSPECT/MAKE/CCODEP 118352 . 118503))))) + (FILEMAP (NIL (6980 45333 (INSPECTW.CREATE 6990 . 12285) (INSPECTW.REPAINTFN 12287 . 17823) ( +INSPECTW.REDISPLAY 17825 . 26697) (\INSPECTW.VALUE.MARGIN 26699 . 27102) (INSPECTW.REPLACE 27104 . +27812) (INSPECTW.SELECTITEM 27814 . 28804) (\INSPECTW.REDISPLAYPROP 28806 . 31236) (INSPECTW.FETCH +31238 . 31661) (INSPECTW.PROPERTIES 31663 . 32304) (DECODE.WINDOW.ARG 32306 . 34034) ( +DEFAULT.INSPECTW.PROPCOMMANDFN 34036 . 36064) (DEFAULT.INSPECTW.VALUECOMMANDFN 36066 . 37482) ( +DEFAULT.INSPECTW.TITLECOMMANDFN 37484 . 40933) (\SELITEM.FROM.PROPERTY 40935 . 41377) ( +\INSPECT.COMPUTE.TITLE 41379 . 42663) (LEVELEDFORM 42665 . 43384) (MAKEWITHINREGION 43386 . 45331)) ( +45334 62639 (ITEMW.REPAINTFN 45344 . 46564) (\ITEM.WINDOW.BUTTON.HANDLER 46566 . 46985) ( +\ITEM.WINDOW.SELECTION.HANDLER 46987 . 49654) (\INSPECTW.COMMAND.HANDLER 49656 . 53657) ( +ITEM.WINDOW.SET.STACK.ARG 53659 . 55863) (REPLACESTKARG 55865 . 56964) (IN/ITEM? 56966 . 57848) ( +\ITEMW.DESELECTITEM 57850 . 58114) (\ITEMW.SELECTITEM 58116 . 58378) (\ITEMW.CLEARSELECTION 58380 . +58735) (\ITEMW.FLIPITEM 58737 . 59210) (PRINTANDBOX 59212 . 61721) (PRINTATBOX 61723 . 62240) ( +ITEMOFPROPERTYVALUE 62242 . 62637)) (62640 66381 (\ITEM.WINDOW.COPY.HANDLER 62650 . 64507) ( +\ITEMW.FLIPCOPY 64509 . 64968) (BKSYSBUF.GENERAL 64970 . 66379)) (66773 90797 (INSPECT 66783 . 71313) +(\APPLYINSPECTMACRO 71315 . 72376) (INSPECT/BITMAP 72378 . 73530) (INSPECT/DATATYPE 73532 . 76967) ( +INSPECTABLEFIELDNAMES 76969 . 77490) (REMOVEDUPS 77492 . 77697) (INSPECT/ARRAY 77699 . 78764) ( +INSPECT/TOP/LEVEL/LIST 78766 . 79883) (INSPECT/PROPLIST 79885 . 80973) (NONSYSPROPNAMES 80975 . 81271) + (INSPECT/LISTP 81273 . 81712) (ALISTP 81714 . 81923) (PROPLISTP 81925 . 82565) (INSPECT/ALIST 82567 + . 83043) (ASSOCGET 83045 . 83256) (/ASSOCPUT 83258 . 83523) (INSPECT/PLIST 83525 . 84009) ( +INSPECT/TYPERECORD 84011 . 84368) (INSPECT/AS/RECORD 84370 . 85607) (SELECT.LIST.INSPECTOR 85609 . +87660) (STANDARDEDITE 87662 . 87945) (NTHTOPLEVELELT 87947 . 88263) (SETNTHTOPLEVELELT 88265 . 89025) +(DEDITE 89027 . 89234) (FINDRECDECL 89236 . 89819) (FINDSYSRECDECL 89821 . 90222) ( +MAKE-INSPECTOR-PROFILE 90224 . 90609) (CONFIRM-SET 90611 . 90795)) (92563 100777 (INSPECT/ATOM 92573 + . 96678) (SELECT.ATOM.ASPECT 96680 . 97824) (INSPECT/AS/FUNCTION 97826 . 100112) (SELECT.FNS.EDITOR +100114 . 100775)) (100818 106243 (INSPECTCODE 100828 . 101980) (\TEDIT.INSPECTCODE 101982 . 103960) ( +\INSPECT/CODE/RESHAPEFN 103962 . 105501) (\INSPECT/CODE/REPAINTFN 105503 . 106241)) (106281 107887 ( +INSPECT/HARRAYP 106291 . 107039) (HARRAYKEYS 107041 . 107420) (INSPECTW.GETHASH 107422 . 107649) ( +INSPECTW.PUTHASH 107651 . 107885)) (107936 114145 (RDTBL\NONOTHERCODES 107946 . 108966) (GETSYNTAXPROP + 108968 . 110466) (SETSYNTAXPROP 110468 . 112195) (GETTTBLPROP 112197 . 113115) (SETTTBLPROP 113117 . +114143)) (114624 123266 (INSPECT/AS/BLOCKRECORD 114634 . 115634) (INSPECT/TYPELESS 115636 . 117027) ( +LIST-ALL-BLOCKRECORDS 117029 . 117304) (INSPECT/HUNK 117306 . 119909) (\INSPECT.DATATYPE.RAW.FETCH +119911 . 120237) (\INSPECT.FETCH.8 120239 . 120388) (\INSPECT.FETCH.32 120390 . 120561) ( +\INSPECT.FETCH.CHAR 120563 . 120726) (\INSPECT.FETCH.FATCHAR 120728 . 120890) (\INSPECT.FETCH.PTR +120892 . 121063) (\INSPECT.STORE.8 121065 . 121371) (\INSPECT.STORE.16 121373 . 121673) ( +\INSPECT.STORE.32 121675 . 122110) (\INSPECT.STORE.CHAR 122112 . 122438) (\INSPECT.STORE.FATCHAR +122440 . 122762) (\INSPECT.STORE.PTR 122764 . 123111) (INSPECT/MAKE/CCODEP 123113 . 123264))))) STOP diff --git a/sources/INSPECT.LCOM b/sources/INSPECT.LCOM index 009dd871e1b0b24ebefbf85b93b3b3f072ed52c9..a5ececd40386f76018ecedac553130189c3453f6 100644 GIT binary patch delta 6326 zcmai2du&_RdFMk9o3E?&ak}dGV6GGOtAP(&VLRDRN{*q)kfH z!?w1}Ll>s+#}F^>>AW^xoW{)>6s-e^iq@`4%w`3Oq$m(43x>KKnk`ut3>g9i&48l7 zlzr!1lBO5~(;w7%-S2$oJHPMuec$=@7mQzf()eVm9lHk-ndJe_!EuP=hIz*@&tIA! zhi)ITVdw2hEDQ_$u;8#E(3J5ybIG6_3$|6UE|6Op2?rl%Rcq^m%b$VvCA{g~&_xEM}K+s1gR0<}>eGVmRH$W7z^ z!;bWKj2k;s{qreDYm4RFt`t{vS{yCm)x&AMMc=A)r~31T6i4L+t3PTl@LqS_BHjbw+4dRl^3;zAT>S{|svqGT^&^h@y|`X){brm8*L}vhJmhbi z-fJ+~0rZbG_ZS2RdA7O7?i4&4Zjlq#cDh4iu|%KF)>7t2=(W$7DxN%puz_0(K#Vovubq-J7iK{CoXwk}`d> z+hhk%D<3>HsBw?za5ylq5qz@Q(nTKstLF9IT?Y^8P3xmWvR-c@-*P13_u};fjdZDt zES|fsRbvehuMr8kskRqJ&}}OLW57Krlu7`CWqgew7gEAO__hz}UeGn`^vuta4Cz^` zHEWGqXB*fUL;LpeT$;HGbE+I`=GcN+oibz`nf;s^s~YMg=d zqN#W?8U;eBih%G?E0Oi;1$H2>mthYH0;(b2WVAt$p*m>RVn`d3i!KPHZrDrF3 zcBHG%x?IT@v}hCITFrXu68pNcr_B~M&OL(ESQ=fLQgq;9)R?5!tV>~WD- zA8fa{fDYNUGadjy5%FLN$x%24J++up^(ZlD_N^T{evGw)!kr%Fa5!v~_?Ovl!XSA4g zz72EUm~XHc4B}3b5snOkUjUxzi35<-3}}7@;BCJ}iwatU@zeS(;rn+N^bfb| zbo!c0vwYlY@$C)0NP~Nec7vr**2ivelKs9Uk8OTm-WVO5*tmZOjiXvLW%tf*eA--^ zZYe3|ci(+C->jJP&F|lOc|QEXjaQ;dOXQ#4pW7_%n_KN*A`80G>J3eJX?1OWZu6UK zy5|{P)rhl}rn^dtRTF2W;-=e5^Ge$X)19U1_L9=6bSdpr?xnfMLBx8dUcjLegn8wV zCg2bgupb2M|6sa+O4HpX1t~VAyGFtxd856?ChSyMb6HQ>V9>9ARC96=INeKC-})b= zx6ycQZR=M`FZ%|XudZ#qqqFl)jHX5=C7LzxkbDA?BamN8SaV+v(ts(7snp;|ScYUS zHi0;g7x~8$6A7TI!DCWXii=?wBya9+FK`gtr^cj-s2GtTE+!*>Db7&(*+Iw{>m_3j zl&Raz4GPo?1U~eKmB1JzH{cjU^os`(4Jqp#e(Kg|MS$01T8HPlV(V>SaRRBsgMNn{&CzSfU3~kv`M< za^fG1jV$9P2U9&$OK>3#8eT18gLuU!`UATuI@k0;h6jtKDPr7kW!okBXn$Tx&rTh??xV<_Ex%I6QT zxVNTzp(6F~YJ}>({h4)NsjPddRQY)IthVYq)qzu?A5_~8m7T)ZkZ=3VO^d!+Y58T7 z8NlA*^V4RJ((;-yu&0rp_-pJq^l#Gr6w|Fb;IYd{4X|O!QIo*}ffD)9TL~>O6Lw;F} zh!AhU9m=#j1c5s)PQ(!QR;hT14FRFvUPYq=tbtG=#p6mGd3f^qi4HRbDJvp}L{$NH zCjWk7FZsubT?GK9P*tOxJ@GWHs7(xbnlIN5a1cYLf@(0aJTsf|&z#SI@{lmlV}Q~a zoKw>uL!hqe4Op)n0qmhEI)oty9Z5!6(S`&J!(c?v5ORjH#t{*c;{?z$g4C9ro$S(k z$TueKkSMNC9xQ|WpC@gN59k5pXWjNJ;Onni4vnO%+Y?n`>#@1$f zwwF#Gvb^(EcASag`?;UU*Vc4zkj;}n@6T4wTH^<=H%%0?KAA1Ih)wekr$>KZ43ghI z>@8H6zY^Zq9m!g!UW(4Yz51g_@5`%y@EMD7vEu!Amo(P+cE#1o{nY`@9gBOl`Qm}f zg1;8EnJblnQf?#2v|@^sXr4@-n0CA1K|u2+0ZOm3H#xl&cr?p&(n?QjL4{YD7M$dd z)7ESi8bdLb3^@TT08iF|%nf5CYUpx8?pwK0HU#yTP?_X~>SP55jE~C|Ehh-%bEh6H zKt5fId;xrW+kg|?ar*$^eER^Um0B52h#8vVG+Spa-c!~K@$d?xr9wQQL+*@15QqkV zRDfwlWGNg3dT}E%`P}{%8X3c4#2*yl(FBv?%qMq2g=Y)QETYAw6?iT>znqy}f#)G8 zF-hr>E`t-3TaO&obL&mB|EVv->%Y>6P2ZyM@-;RUv&5Paj&_&AZR{4=Pc{vI{wic{ zL^k$Bv(}R@kIldR(CS;{LIxkG+!f}iwdnm}3<UmrtgUPocedAhoHB}dS%dhO%kfjM z3l;mwquFjp)gw$Qor2}JE17MZO$>QQZ^1HmF zkx@GtzuHgkU+4k*PcIy5WP-`#3s&pbAvH2u9EMX=&;j;q5u3-18$t5og1c##FGSgW zbHTw~iuS&;`UjmIJhf~cFOxV3{uT z>l@aE3vU_V-DAh+{*}Iay#JS!@^g;`VCec|&8=nq)}H8U^W45|xaLr?$44H|w)cru zJ8lOZef(lnqk#@E-+8ecWD6JF6m;-#boSx_*yYm2pS4ykGXM+Txwem7xw^Nk>ZwrZQOY^If@F{lyCQJE2-&-HAANMV6-8{iOs3?VgsoTBSk=!ia3$0Da=J-(hHU0dp z$(y4$C$u#^a%Igvp9rho485lRw|v7bKg;zjICVwn0uiZ zT>U**)$0Z2tR|NRC=8EZZ~St^jqc-YA0$L#h;%M#N-TrMW~1;sU%L tvLZYTi79>5fh15MpBDES;Y~>U?{JVC-+Pdi;Fu@I=f(jDlh1AK|35>@SKdLm# znfk}|?%Cb5=lPwpdg!$I?c?Utse0sX6OSBd;~0)ZjK}A6`JBR;(VbbAYe9CNY1@7z zqb+irPhfpcw;fsbO%4r?ADS4+45iV~(TT~!U-Kb3mW)e5wId{|qS_mm(8w6FclJag zXfc!a_I5i;4@|+quQ2C)3~O((I6CEs6kL~(L{$nQ`~Q*;PZ&EBEQeUu%LpFi3x>s5 zmy~Q%73AoQC6T36m=@%VC#0RS(vxfh0VQN-**0ZxifG0nR`4-`kK+hiBa1stf6c}d zN?b~)vXn%fh~p8N#}jf)?TitEfK*wHNMz_lost?1Yjl@J4=T~97z=4MH%f)21l{XF zNmWTm8r_SM5-6(5N{kYChTcNYW($XT7VQ)xJu73QO|@;ZD%GA7Y)o}zx;bsM8Ecdcsn(1s)m~Fwx3?j$ ztesn~Gz_oZyY4vll&#;oHM3#w>Xb{VQ&zv-PuNA~%*SVpD@MC3$n3i1-K**Cx6kCa zrx<*!jIH)m5ptAXpW^U;${O)+%dAdjFJ ziA}6mka=#SvZXGasl9z6pQ%mvle=$Un7NbB)8WjWpBnet^Ql(F4jOX!)ACIl1eY5e z0AB1$$ssk21V%s+Db@u;-s{2rv-Mft<3;fvH6_PFN{Tog@orZs#RZ;Pxz5r{J0>C_W7)t->zq88D-lR=ASycfT{Y+VB{pr8`(4fLq05|egHH28Ur zKQq5R#j_q%vcNc(WC`b`qUc$~xtGQ}2V&72S_o~<$>U?oua;RIEmquRap4CoPa3PR zqw1{DieIj3)E2JQG|bLdwQe?AXYXQU<1(uQaV`&X;EhKc@Cnw1&CPYVU#Q<8BNjof z_e7D5n4;D#$nccOU@+ll26}OyvvC;>*ZC`L_?UBBy}`k{z?BIl8dqt$12*89&?@|A zYdxNEHEpvxSSOEU73d5K_9PNu6q)ZSNvAhSV zimJp@P&IheC8^OAR0Amq)k;Dv@Ct*QjGFqUA2q$=-);AV868WrORnusDPEG80SFGQxNh_oG)gb1?e2P1M) zg+0)FNQs1!KpqC+YyB&;t_4P-ssO4K?_TJuoQMb)6QdF&J1-Qk(JTN4pxp`pm`-5a z1w<_QZwKww-TGW?i>fXKi zn~L7te!pBu?26Gn>FuB70{QMbyeDnPtwZ(u3TIx8%&mwHuigD}Z1mRjbI~oYOn>G# z=VGFs=4qbHI; zIv{NsIv;&maAD@?nk@7l3uzQ5VSxk)YtlMtF(NQ7Bx*x`Q5sSbv|Vg*5dx^h!H9Fa z^#%=^gRd?N0)Bn}V3sz{3jr^9^%7nPc)?SW5(2=kR^;^^5YkHt04bU>P%JdHc!-9A z)Et9$^e9j_c(9zjItBnA3z8XwI%O#mf+vp?Vav1YsyQek5iuGFiSSbJ;`a~yvk{i; z!GSR}Ha-P!BwD25O$2Qk{&={-1ijbtk!?n1);02x5pN#dY&lEf%3ofQ+m92Y&W?5Y zNF8+_{S2q!FHi`R*P?UQ*znrESGq@UePjAoY|E?DpW-hv4*cF|Srh5Th>Kas&ccX= zXN(4r9v+)Bo@R)1(0hp?2u3X>FkZYb<7yy{4Ln8cR1Z*RU~+QcThMD@_ULN-t4uw9 zKT}tJ3S>9oe`OwAQ4kRtEYR@bLtaRnUmwb@rpTZ((NKl(*ga;)4~}ixuMl()AJO9X zfkFv18p63|zj&S+;KYJ0zG@KhJng1V&@WB1;aY>kt^1moK}Aj%wv96&Phi{wO*L{e zI6J<6B{Wg7aWpYGJ~1>oH8OOVi1qyV14OOHMi9%SNi$bTueBKselcUh!xI~-!HOIL zXo>)Cz@c*!PdBiIHz4Um#Yj?xE|iA`(1iQ$-+Fh^H1L!y$pC`zF4Q3=lS&X?0T5w` zj-h?gnE&$r$CogVFJ_*d+?xIW%xP|Fyva~!t%E8lHVJruCPIh;D`~5>2Q5+NKG1{! zw#lD1ih6}Es?lPtEI>5A`*2q|#cO=>a5otHt;3t~j*Dy7J_Nmu$;Ox{EH=@vO|0xT z&jm3vLwhq! zOstyq9@$~RXS2;l^X%2^nZlTpP|c zY2{-f*l6O3Rtx^_x%v(rfV6<(i*1BnsgSc!M@cgXA@PfIZW3vN^X&O1xD}m$y{2fK zRui)0(?4#&Ef?#tba7Mp6cjNtK6G)Uh8hEmZGa$#CKi8mu?r+`zcfaY5lT3LmF6kE z^G76NuUu-$F7_AcXTfE|B>2GU{&d;F`P_Z^%o_ijw`Udqp*uJ4qj{1GhHn^FjIHXK z&v{`q4~;t;PG2{UzO(D*_M5%ho+eq}v&t{RuHT2R8{f;6y+b>=TED0jymAnhVe!{5 ztuZ4nk54|uEz=7(zV_5l@R7?7^cP@QX7if^>5OR}YBl9wI6pd{lklsTTUUNBAFB(S zphqwni`M`A@-A0B^$K|^9Po>>7KD3i^Gfwxtx^j=XH>ry9lg~Dt4i&bz18{YPe35A ziwI5yqammp=Mf7SBGj6TEAA_RhNh0-&x7yZ`_I