From f44b96e8705bd98643b67e83b88b549d58727066 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Mon, 27 May 2024 15:16:58 -0700 Subject: [PATCH] Rmk22 gitfns ignores other owners (#1713) * GITFNS: prc ignores PRs from other owners The menu just includes Interlisp PR's. Fixing it to deal with other owners will take more work. * JSON: JSON-GET takes a list of attributes A convenience for accessing objects embedded in objects * GITFNS: a minor cleanup * Remove JSON-GET left over * Put the git commands to install remotes in comments So we don't have to rediscover them when we decide to fix prc to deal with this issue. --- lispusers/GITFNS | 170 +++++++++++++++++++++++++----------------- lispusers/GITFNS.LCOM | Bin 50878 -> 51051 bytes lispusers/JSON | 24 +++--- lispusers/JSON.LCOM | Bin 3639 -> 3532 bytes 4 files changed, 114 insertions(+), 80 deletions(-) diff --git a/lispusers/GITFNS b/lispusers/GITFNS index 4b9790b8..8309c5df 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 2-May-2024 23:35:36" {WMEDLEY}GITFNS.;511 129269 +(FILECREATED "20-May-2024 22:13:04" {WMEDLEY}GITFNS.;530 131382 :EDIT-BY rmk - :CHANGES-TO (FNS GIT-PUSH GIT-PULL GIT-GET-FILE GIT-FILE-DATE GIT-BRANCH-DIFF GIT-COMMIT-DIFFS - GIT-CHECKOUT GIT-MAKE-BRANCH GIT-BRANCHES GIT-BRANCH-EXISTS? GIT-ADD-WORKTREE) + :CHANGES-TO (FNS GIT-PULL-REQUESTS) - :PREVIOUS-DATE " 2-May-2024 22:57:39" {WMEDLEY}GITFNS.;510) + :PREVIOUS-DATE "13-May-2024 19:31:18" {WMEDLEY}GITFNS.;529) (PRETTYCOMPRINT GITFNSCOMS) @@ -404,7 +403,7 @@ (TYPERECORD GIT-PROJECT (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH)) -(RECORD PULLREQUEST (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT)) +(RECORD PULLREQUEST (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT PRURL PRLOGIN)) ) ) @@ -536,7 +535,8 @@ (DEFINEQ (PRC-COMMAND - [LAMBDA (REMOTEBRANCH DRAFTS PROJECT) (* ; "Edited 2-May-2024 11:44 by rmk") + [LAMBDA (REMOTEBRANCH DRAFTS PROJECT) (* ; "Edited 13-May-2024 18:49 by rmk") + (* ; "Edited 2-May-2024 11:44 by rmk") (* ; "Edited 1-Apr-2024 20:24 by rmk") (* ; "Edited 28-Jul-2023 09:03 by rmk") @@ -566,22 +566,30 @@ (SETQ PRS (GIT-PULL-REQUESTS (NEQ 'NODRAFTS DRAFTS) PROJECT)) - (CL:WHEN (AND REMOTEBRANCH (NEQ REMOTEBRANCH 'PinMenu)) - (* ;; "Filter by the REMOTEBRANCH string") + (* ;; "Filter by REMOTEBRANCH properties") - (SETQ PRS (for PR in PRS when (OR (STRPOS REMOTEBRANCH (fetch PRDESCRIPTION of PR) - NIL NIL NIL NIL FILEDIRCASEARRAY) - (STRPOS REMOTEBRANCH (fetch PRNAME of PR) - NIL NIL NIL NIL FILEDIRCASEARRAY)) collect - PR))) + (SETQ PRS (for PR FOUND in PRS + when (if (STRING-EQUAL "Interlisp" (fetch PRLOGIN of PR)) + then (OR (NULL REMOTEBRANCH) + (STRPOS REMOTEBRANCH (fetch PRDESCRIPTION of PR) + NIL NIL NIL NIL FILEDIRCASEARRAY) + (STRPOS REMOTEBRANCH (fetch PRNAME of PR) + NIL NIL NIL NIL FILEDIRCASEARRAY)) + else (CL:UNLESS FOUND + (SETQ FOUND T) + (PRINTOUT T "Ignored because not owned by Interlisp: " T)) + (PRINTOUT T 3 (fetch PRDESCRIPTION of PR) + " (" + (fetch PRLOGIN of PR) + ")" T) + NIL) collect PR)) (IF PRS THEN (if (CDR PRS) then (SETQ MENUWINDOW (ADDMENU (GIT-BRANCH-MENU (GIT-PRC-BRANCHES DRAFTS PROJECT PRS) (CONCAT (LENGTH PRS) - " pull requests") - NIL PROJECT) + " pull requests")) NIL NIL T)) (* ;; "Position the new menu just under the current TTY window, to keep it out of the way of the comparison windows. If we have menus open for other projects, those probably should be pushed down to make room for the new menu, and moved up when a higher menu is closed. An edge case that is not worth the effort. ") @@ -1408,40 +1416,52 @@ WHENSELECTEDFN _ (FUNCTION GIT-BRANCH-WHENSELECTEDFN)))]) (GIT-BRANCH-WHENSELECTEDFN - [LAMBDA (ITEM) (* ; "Edited 1-May-2024 18:17 by rmk") + [LAMBDA (ITEM) (* ; "Edited 11-May-2024 11:05 by rmk") + (* ; "Edited 1-May-2024 18:17 by rmk") (* ; "CAR is git key, 4th is project") (* ;; "This executes the comparison in the current TTY window, either by stuffing the command there or by evaluating there. There probably should be a check to make sure that the TTY is in fact an executive--if not, maybe this should be a no-op. Better than getting the comparison form in the middle of anther SEDIT or TEDIT.") (* ;; "This could also execute in the mouse process, where the menu is clicked. But in that case a terminal window pops up with the header lines of the compare, and that seems a nuisance.") - (if T - then - (* ;; "The COPYINSERT causes the compare to run in the TTY process, by stuffing the characters in the input line. Somehow it executes even if the parens are not there, but that looks funny. But it also works if I stuff the parens on both sides.") + (LET [(PR (CAR (LAST ITEM] + (if [AND NIL (PROGN (GETMOUSESTATE) + (EQ 'MIDDLE (DECODEBUTTONS] + then (LET [(POS (ADD1 (STRPOS "#" (CAR ITEM] + (ShellBrowse (fetch PRURL of PR))) + elseif (PROGN T) + then + (* ;; "PROGN because DWIM is screwed up") - (BKSYSBUF '%() - [COPYINSERT `(GIT-PR-COMPARE ,(CADR ITEM) - ',(CADR (CDDDR ITEM] - (BKSYSBUF '%)) - else - (* ;; "This puts the print out after the next event number in the TTY window, unfortunately. We go to the default font so we don't get TTYIN's input bold for this.") + (* ;; "The COPYINSERT causes the compare to run in the TTY process, by stuffing the characters in the input line. Somehow it executes even if the parens are not there, but that looks funny. But it also works if I stuff the parens on both sides.") - (PROCESS.EVAL (TTY.PROCESS) - `(RESETLST - [RESETSAVE (DSPFONT DEFAULTFONT T) - '(PROGN (DSPFONT OLDVALUE T])]) + (BKSYSBUF '%() + [COPYINSERT `(GIT-PR-COMPARE ,(CADR ITEM) + ',(fetch PRPROJECT of PR] + (BKSYSBUF '%)) + else + (* ;; "This puts the print out after the next event number in the TTY window, unfortunately. We go to the default font so we don't get TTYIN's input bold for this.") + + (PROCESS.EVAL (TTY.PROCESS) + `(RESETLST + [RESETSAVE (DSPFONT DEFAULTFONT T) + '(PROGN (DSPFONT OLDVALUE T])]) (GIT-PULL-REQUESTS - [LAMBDA (INCLUDEDRAFTS PROJECT) (* ; "Edited 1-May-2024 09:23 by rmk") + [LAMBDA (INCLUDEDRAFTS PROJECT) (* ; "Edited 20-May-2024 22:12 by rmk") + (* ; "Edited 13-May-2024 18:59 by rmk") + (* ; "Edited 11-May-2024 10:51 by rmk") + (* ; "Edited 1-May-2024 09:23 by rmk") (* ; "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") + (* ; "Edited 9-May-2022 16:54 by rmk") + + (* ;; "Returns a list of PULLREQUEST records, one for each pull request") + (* ; "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:")) - (LET [(JPARSE (JSON-PARSE (CAR (GIT-COMMAND - "gh pr list --json number,headRefName,title,isDraft,reviewDecision" + (LET [(JPARSE (JSON-PARSE (CAR (GIT-COMMAND "gh pr list --json number,headRefName,title,isDraft,reviewDecision,url,headRepository,headRepositoryOwner" T NIL PROJECT] (FOR JSOBJ DRAFT PR IN (SELECTQ (CAR JPARSE) (ARRAY (CDR JPARSE)) @@ -1449,7 +1469,7 @@ (ERROR "UNRECOGNIZED PRC LIST FROM GIT" JPARSE)) EACHTIME [SETQ DRAFT (EQ 'true (JSON-GET JSOBJ 'isDraft] WHEN (OR INCLUDEDRAFTS (NOT DRAFT)) - COLLECT (SETQ PR (CREATE PULLREQUEST + COLLECT [SETQ PR (CREATE PULLREQUEST PRNUMBER _ (JSON-GET JSOBJ 'number) PRNAME _ (JSON-GET JSOBJ 'headRefName) PRDESCRIPTION _ (JSON-GET JSOBJ 'title) @@ -1459,8 +1479,19 @@ (JSON-GET JSOBJ 'reviewDecision)) " " 'A)) - PRPROJECT _ PROJECT)) + PRPROJECT _ PROJECT + PRURL _ (JSON-GET JSOBJ 'url) + PRLOGIN _ (JSON-GET JSOBJ '(headRepositoryOwner login] (CL:WHEN (STRPOS ":" (fetch (PULLREQUEST PRNAME) of PR)) + + (* ;; "From Nick: Git commands to bring install and deal with the remotes:") + + (* ;; "git remote add [PRLOGIN] https://github.com/[PRLOGIN]/[PROJECT]") + + (* ;; " (project in lower-case)") + + (* ;; "git remote update [PRLOGIN]") + (PRINTOUT T "Ignoring PR for forked repo %%%" #" (JSON-GET JSOBJ 'number) " " (fetch (PULLREQUEST PRNAME) of PR) @@ -1484,7 +1515,9 @@ (FIND B IN (GIT-BRANCHES WHERE PROJECT EXCLUDEMERGED) SUCHTHAT (STRPOS BRANCH B]) (GIT-PRC-BRANCHES - [LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 1-May-2024 21:06 by rmk") + [LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 13-May-2024 19:30 by rmk") + (* ; "Edited 11-May-2024 10:52 by rmk") + (* ; "Edited 1-May-2024 21:06 by rmk") (* ; "Edited 1-Apr-2024 17:09 by rmk") (* ; "Edited 8-Aug-2022 18:15 by rmk") (* ; "Edited 4-Aug-2022 18:55 by rmk") @@ -1496,7 +1529,8 @@ (CL:UNLESS PRS (SETQ PRS (GIT-PULL-REQUESTS T PROJECT))) (CL:WHEN PRS - (LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR))) + (LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS + COLLECT (GITORIGIN (fetch PRNAME of PR))) NIL T PROJECT))) (SORT (FOR PR REL LABEL PRNAME STATUS (SUPERSETS _ (CAR RELATIONS)) (EQUALS _ (CADR RELATIONS)) IN PRS @@ -1517,7 +1551,7 @@ (CONCAT " " STATUS " #" (FETCH PRNUMBER OF PR) " " (FETCH PRDESCRIPTION OF PR)) - NIL PROJECT)) + NIL PR)) T)))]) ) @@ -2368,33 +2402,33 @@ (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4348 20927 (GIT-CLONEP 4358 . 5686) (GIT-INIT 5688 . 6318) (GIT-MAKE-PROJECT 6320 . -13985) (GIT-GET-PROJECT 13987 . 15912) (GIT-PUT-PROJECT-FIELD 15914 . 17555) (GIT-PROJECT-PATH 17557 - . 18601) (FIND-ANCESTOR-DIRECTORY 18603 . 18952) (GIT-FIND-CLONE 18954 . 20035) (GIT-MAINBRANCH 20037 - . 20432) (GIT-MAINBRANCH? 20434 . 20925)) (26376 30458 (PRC-COMMAND 26386 . 30456)) (30514 33302 ( -ALLSUBDIRS 30524 . 31810) (MEDLEYSUBDIRS 31812 . 32505) (GITSUBDIRS 32507 . 33300)) (33303 38093 ( -TOGIT 33313 . 34719) (FROMGIT 34721 . 35702) (GIT-DELETE-FILE 35704 . 36550) (MYMEDLEY-DELETE-FILES -36552 . 38091)) (38094 41097 (MYMEDLEYSUBDIR 38104 . 38560) (GITSUBDIR 38562 . 39005) (STRIPDIR 39007 - . 39378) (STRIPHOST 39380 . 39620) (STRIPNAME 39622 . 40375) (STRIPWHERE 40377 . 41095)) (41098 43000 - (GFILE4MFILE 41108 . 41471) (MFILE4GFILE 41473 . 42042) (GIT-REPO-FILENAME 42044 . 42998)) (43049 -53300 (GIT-COMMIT 43059 . 43885) (GIT-PUSH 43887 . 44647) (GIT-PULL 44649 . 45401) (GIT-APPROVAL 45403 - . 45752) (GIT-GET-FILE 45754 . 47776) (GIT-FILE-EXISTS? 47778 . 48052) (GIT-REMOTE-UPDATE 48054 . -48778) (GIT-REMOTE-ADD 48780 . 49087) (GIT-FILE-DATE 49089 . 50136) (GIT-FILE-HISTORY 50138 . 52072) ( -GIT-PRINT-FILE-HISTORY 52074 . 53124) (GIT-FETCH 53126 . 53298)) (53330 64103 (GIT-BRANCH-DIFF 53340 - . 59740) (GIT-COMMIT-DIFFS 59742 . 60415) (GIT-BRANCH-RELATIONS 60417 . 64101)) (64148 80865 ( -GIT-BRANCH-NUM 64158 . 64731) (GIT-CHECKOUT 64733 . 65908) (GIT-WHICH-BRANCH 65910 . 66208) ( -GIT-MAKE-BRANCH 66210 . 68539) (GIT-BRANCHES 68541 . 71031) (GIT-BRANCH-EXISTS? 71033 . 71904) ( -GIT-PICK-BRANCH 71906 . 72396) (GIT-BRANCH-MENU 72398 . 73279) (GIT-BRANCH-WHENSELECTEDFN 73281 . -74916) (GIT-PULL-REQUESTS 74918 . 77527) (GIT-SHORT-BRANCH-NAME 77529 . 77820) (GIT-LONG-NAME 77822 . -78139) (GIT-PRC-BRANCHES 78141 . 80863)) (80895 84230 (GIT-MY-CURRENT-BRANCH 80905 . 81275) ( -GIT-MY-BRANCHP 81277 . 81782) (GIT-MY-NEXT-BRANCH 81784 . 82278) (GIT-MY-BRANCHES 82280 . 84228)) ( -84276 88351 (GIT-ADD-WORKTREE 84286 . 85893) (GIT-REMOVE-WORKTREE 85895 . 86825) (GIT-LIST-WORKTREES -86827 . 87631) (WORKTREEDIR 87633 . 88349)) (88399 121103 (GIT-GET-DIFFERENT-FILES 88409 . 94833) ( -GIT-BRANCHES-COMPARE-DIRECTORIES 94835 . 101688) (GIT-WORKING-COMPARE-DIRECTORIES 101690 . 107086) ( -GIT-COMPARE-WORKTREE 107088 . 111066) (GITCDOBJBUTTONFN 111068 . 115558) (GIT-CD-LABELFN 115560 . -116642) (GIT-CD-MENUFN 116644 . 119084) (GIT-WORKING-COMPARE-FILES 119086 . 119706) ( -GIT-BRANCHES-COMPARE-FILES 119708 . 120872) (GIT-PR-COMPARE 120874 . 121101)) (121173 129202 (CDGITDIR - 121183 . 121870) (GIT-COMMAND 121872 . 123430) (GITORIGIN 123432 . 124129) (GIT-INITIALS 124131 . -124435) (GIT-COMMAND-TO-FILE 124437 . 127926) (GIT-RESULT-TO-LINES 127928 . 128535) (STRIPLOCAL 128537 - . 129200))))) + (FILEMAP (NIL (4187 20766 (GIT-CLONEP 4197 . 5525) (GIT-INIT 5527 . 6157) (GIT-MAKE-PROJECT 6159 . +13824) (GIT-GET-PROJECT 13826 . 15751) (GIT-PUT-PROJECT-FIELD 15753 . 17394) (GIT-PROJECT-PATH 17396 + . 18440) (FIND-ANCESTOR-DIRECTORY 18442 . 18791) (GIT-FIND-CLONE 18793 . 19874) (GIT-MAINBRANCH 19876 + . 20271) (GIT-MAINBRANCH? 20273 . 20764)) (26229 30851 (PRC-COMMAND 26239 . 30849)) (30907 33695 ( +ALLSUBDIRS 30917 . 32203) (MEDLEYSUBDIRS 32205 . 32898) (GITSUBDIRS 32900 . 33693)) (33696 38486 ( +TOGIT 33706 . 35112) (FROMGIT 35114 . 36095) (GIT-DELETE-FILE 36097 . 36943) (MYMEDLEY-DELETE-FILES +36945 . 38484)) (38487 41490 (MYMEDLEYSUBDIR 38497 . 38953) (GITSUBDIR 38955 . 39398) (STRIPDIR 39400 + . 39771) (STRIPHOST 39773 . 40013) (STRIPNAME 40015 . 40768) (STRIPWHERE 40770 . 41488)) (41491 43393 + (GFILE4MFILE 41501 . 41864) (MFILE4GFILE 41866 . 42435) (GIT-REPO-FILENAME 42437 . 43391)) (43442 +53693 (GIT-COMMIT 43452 . 44278) (GIT-PUSH 44280 . 45040) (GIT-PULL 45042 . 45794) (GIT-APPROVAL 45796 + . 46145) (GIT-GET-FILE 46147 . 48169) (GIT-FILE-EXISTS? 48171 . 48445) (GIT-REMOTE-UPDATE 48447 . +49171) (GIT-REMOTE-ADD 49173 . 49480) (GIT-FILE-DATE 49482 . 50529) (GIT-FILE-HISTORY 50531 . 52465) ( +GIT-PRINT-FILE-HISTORY 52467 . 53517) (GIT-FETCH 53519 . 53691)) (53723 64496 (GIT-BRANCH-DIFF 53733 + . 60133) (GIT-COMMIT-DIFFS 60135 . 60808) (GIT-BRANCH-RELATIONS 60810 . 64494)) (64541 82978 ( +GIT-BRANCH-NUM 64551 . 65124) (GIT-CHECKOUT 65126 . 66301) (GIT-WHICH-BRANCH 66303 . 66601) ( +GIT-MAKE-BRANCH 66603 . 68932) (GIT-BRANCHES 68934 . 71424) (GIT-BRANCH-EXISTS? 71426 . 72297) ( +GIT-PICK-BRANCH 72299 . 72789) (GIT-BRANCH-MENU 72791 . 73672) (GIT-BRANCH-WHENSELECTEDFN 73674 . +75839) (GIT-PULL-REQUESTS 75841 . 79359) (GIT-SHORT-BRANCH-NAME 79361 . 79652) (GIT-LONG-NAME 79654 . +79971) (GIT-PRC-BRANCHES 79973 . 82976)) (83008 86343 (GIT-MY-CURRENT-BRANCH 83018 . 83388) ( +GIT-MY-BRANCHP 83390 . 83895) (GIT-MY-NEXT-BRANCH 83897 . 84391) (GIT-MY-BRANCHES 84393 . 86341)) ( +86389 90464 (GIT-ADD-WORKTREE 86399 . 88006) (GIT-REMOVE-WORKTREE 88008 . 88938) (GIT-LIST-WORKTREES +88940 . 89744) (WORKTREEDIR 89746 . 90462)) (90512 123216 (GIT-GET-DIFFERENT-FILES 90522 . 96946) ( +GIT-BRANCHES-COMPARE-DIRECTORIES 96948 . 103801) (GIT-WORKING-COMPARE-DIRECTORIES 103803 . 109199) ( +GIT-COMPARE-WORKTREE 109201 . 113179) (GITCDOBJBUTTONFN 113181 . 117671) (GIT-CD-LABELFN 117673 . +118755) (GIT-CD-MENUFN 118757 . 121197) (GIT-WORKING-COMPARE-FILES 121199 . 121819) ( +GIT-BRANCHES-COMPARE-FILES 121821 . 122985) (GIT-PR-COMPARE 122987 . 123214)) (123286 131315 (CDGITDIR + 123296 . 123983) (GIT-COMMAND 123985 . 125543) (GITORIGIN 125545 . 126242) (GIT-INITIALS 126244 . +126548) (GIT-COMMAND-TO-FILE 126550 . 130039) (GIT-RESULT-TO-LINES 130041 . 130648) (STRIPLOCAL 130650 + . 131313))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index 1b58e8570e4cf64e635c1199c624ab1ee2e0778c..f267d0f62cac87360f00b2d3bd2e948ea65e6efd 100644 GIT binary patch delta 1499 zcmZux-A^M`6z{arg%SvmrlDoklSx1tw>Wq144r9op|n#NXlKgIbh|8ILusXr-A=a! zS2iX!e!O5bnwx0iQ2NNHSZ@wC1V*JQH>60IKrj!Nayqw=T_ndR@Ip=rg z^dsLdANxKj1b8l*-9Cu&94`RR#}STm!l!S%+`(J~{OsjZ#Kn;u7X=ntl^y$TvsSN^ zq4HL<)t-vOl4?bB`AjBiC~JAev`nZqfK5{iT+T5&JIg|Odyhu`Z*rN9_-E2;MtLr2 zC<#kR!IdZUA4tApUKqq2AdIlYlb@Msbm{5{#B+vnOV#scG)0pDi}2GTX$=^~k>up? z@^be#uP-(ttSfT> z#cH@P9^M&e)Q~#L6i3c%$4?*ex*y|rv`4cG505<`E>J5|EtkuM!0$g8z*hmQ%M=M=2~{9Fu@8QoMU z6y=^V2fQFbR=?#K1q_Cg>G6qXQ!Q23DAi>ss9H)d7|N1s;3P<-QqIIFV>!3FMI)gl zmt7VBqHjGf9!cU5WE5@5S_Tx8$&Zt7dwGsDt`|BY7XucW`}I0ql6(7=_FkI>k>i17 zL68MtH5=?^g{}r|5(jLAO4?NxV1@-8qe$It*e$vqrOM9se!Bt$uwv?3bV;!&H7*CVlEb32>nx zNpPGL@?`69Y)*v6{@qfgMTvo7zf~viy=Dh6r7=52=gLdY0I3vt@@(| zGu6s=*{C$_c5TmY9q4q9EvVbOwT3$&KZzA@k~fR#$PJqH##QJ4sBSFlCy$Hs-M@+_ d3^Px<+dnWS`K%;+^&t7SG|2?Jzm~q+`4=PMfGGd~ delta 1255 zcma)6&u<$=6!zFcO{|c*ZPLarg{PHlVu=kqv%B{03Z?Onb-dW#HS2X9t8Sduc5$fd zn7Eb-B}C%Jfr>B};DW@BQxmy9AkkL*3kdNCfP|2^AR!?n4rTl+(1-)0mEJdRMsMEt zz4!Ll`<}-ic|I;J0O51j-{FZsBp{+D%9mW)h z6dXHm6+k4%kVF))^14|962XwjS_Pd!SsXj_KqLY=>&nn6M#0vz zT*`$ihkv-12_xp{cHTCCC<-uZVj$7T6h)*dlF1ZF5qP~|nLPUiureKAAb3)6n%tzb z5{7o~_Kn6a{bh4!fhYvHAXAXY3KNc5qR?B_m%VHhIgMkL6X>JrD)Q35swu?Lx3(@L gZ~v>U0Ya;^dgDiA(|Ao~JoaiA(S`nJweMJSON.;31 9030 +(FILECREATED "13-May-2024 22:37:13" {WMEDLEY}JSON.;36 9198 :EDIT-BY rmk - :CHANGES-TO (FNS JSON-STRING JSON-GET JSON-VALUE JSON-ARRAY JSON-OBJECT JSON-AVPAIR JSON-NUMBER - JSON-ATOM JSSKIP JSON-SKIP JSON-PARSE) - (VARS JSONCOMS) - (MACROS JSBIN JSPEEK JSBINC JSPEEKC) + :CHANGES-TO (FNS JSON-GET) - :PREVIOUS-DATE "30-Apr-2024 00:54:21" {WMEDLEY}JSON.;9) + :PREVIOUS-DATE "13-May-2024 19:23:02" {WMEDLEY}JSON.;33) (PRETTYCOMPRINT JSONCOMS) @@ -180,11 +177,14 @@ NIL]) (JSON-GET - [LAMBDA (OBJECT ATTRIBUTE) (* ; "Edited 30-Apr-2024 14:26 by rmk") + [LAMBDA (OBJECT ATTRIBUTES) (* ; "Edited 13-May-2024 22:35 by rmk") + (* ; "Edited 30-Apr-2024 14:26 by rmk") - (* ;; "Returns the value of ATTRIBUTE in OBJECT") + (* ;; "Returns the value at the end of a chain of ATTRIBUTES in OBJECT") - (CADR (ASSOC ATTRIBUTE OBJECT]) + (for A (OBJ _ OBJECT) inside ATTRIBUTES do (if (EQ 'OBJECT (CAR (LISTP OBJ))) + then [SETQ OBJ (CADR (ASSOC A (CDR OBJ] + else (RETURN NIL)) finally (RETURN OBJ]) ) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -201,7 +201,7 @@ ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (778 8671 (JSON-PARSE 788 . 1134) (JSON-VALUE 1136 . 1505) (JSON-SKIP 1507 . 1781) ( -JSON-STRING 1783 . 2581) (JSON-ARRAY 2583 . 3721) (JSON-OBJECT 3723 . 5180) (JSON-AVPAIR 5182 . 5624) -(JSON-NUMBER 5626 . 7140) (JSON-ATOM 7142 . 8449) (JSON-GET 8451 . 8669))))) + (FILEMAP (NIL (559 8839 (JSON-PARSE 569 . 915) (JSON-VALUE 917 . 1286) (JSON-SKIP 1288 . 1562) ( +JSON-STRING 1564 . 2362) (JSON-ARRAY 2364 . 3502) (JSON-OBJECT 3504 . 4961) (JSON-AVPAIR 4963 . 5405) +(JSON-NUMBER 5407 . 6921) (JSON-ATOM 6923 . 8230) (JSON-GET 8232 . 8837))))) STOP diff --git a/lispusers/JSON.LCOM b/lispusers/JSON.LCOM index 34793e69b9ee605475fd4642d82bce32e82d725b..1b0cc52b72e9f20644ba81aad56a2d6fa9b52b5e 100644 GIT binary patch delta 355 zcmdlkb4GeXxQL;#u5V(cu91O}iGq=lm9e>%q4C6QT}d-d1ui8NNdqfWBP&zOi5sQk z-CaWzGV>Ia+(LbP6p$6^>FFscq$HN4reM)+Y-M1gq{*e>=IP_=9OUX4;_9M+Y6aB( z$$E^kY-S3UhL#qS0~u8{f!1j%SOo;RhI#sj2J5;2b)srCw6rn;nr;Nr$Y{Jdo@obH zeSm_If}=u!f`Nj+lb3?0f}w(ANJx;UQ)q~5Fpvutc6A0C%%H{0z`*3-C@93_xs}C3 zAcc9+u8d~JU7k!kJ(wBO8Gzu!me*b$OkzxoJ2u>7@bmQH(lD|B84J?Sr2#}hw}pg6 VI{W(u1bO;}D0l_?PmbZe4FIvHS8@OV delta 357 zcmX>jyIa+(LbP6p+>F>FFscq$HN4reHU~LP?WL!_Cvj)j7!3F~rqH0mT-W z6DH4Llw~tiurx3>nC!=>Dh0LCE7;#p*WEQl0n7+<^a*vHY{{!KIgVFCJJ{PZK!FP^ z0cL_(0ggezu9^xOVL%$J$=TmGSab3`UR5;(tAHTaFi-!`U|koWL(pAoU}b7zWn>6+ zhzz6U=3R_Cxb!>~3>6$hfPQxh1*-Q{Fi`M!@^WovoJ^=vGa99KY