From b90bf65be9cdcf7192b44113ee427b18797ede07 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Sun, 14 Aug 2022 13:25:17 -0700 Subject: [PATCH] Move pick to lispusers (#881) * Make PICK a Lispusers module * PICK moved to lispusers, HCFILES moved to test repo (currently new/printing) * redo PICK documentation * Update documents and projects choices * more testing and restore lost edits to TEDIT * fix some typos --- internal/MEDLEY-UTILS | 140 +++---------------------------------- internal/MEDLEY-UTILS.LCOM | Bin 10391 -> 7024 bytes lispusers/PICK | 87 +++++++++++++++++++++++ lispusers/PICK.LCOM | Bin 0 -> 2009 bytes lispusers/PICK.TEDIT | Bin 0 -> 3506 bytes 5 files changed, 96 insertions(+), 131 deletions(-) create mode 100644 lispusers/PICK create mode 100644 lispusers/PICK.LCOM create mode 100644 lispusers/PICK.TEDIT diff --git a/internal/MEDLEY-UTILS b/internal/MEDLEY-UTILS index 0e8988d7..0ed86233 100644 --- a/internal/MEDLEY-UTILS +++ b/internal/MEDLEY-UTILS @@ -1,25 +1,17 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "17-Jul-2022 12:44:56" |{DSK}larry>medley>internal>MEDLEY-UTILS.;9| 15959 +(FILECREATED " 4-Aug-2022 09:50:04" |{DSK}larry>medley>internal>MEDLEY-UTILS.;2| 10212 - :CHANGES-TO (FNS HCFILES) + :CHANGES-TO (VARS MEDLEY-UTILSCOMS) - :PREVIOUS-DATE "16-Jul-2022 22:08:34" |{DSK}larry>medley>internal>MEDLEY-UTILS.;8|) + :PREVIOUS-DATE "17-Jul-2022 12:44:56" |{DSK}larry>medley>internal>MEDLEY-UTILS.;1|) (PRETTYCOMPRINT MEDLEY-UTILSCOMS) -(RPAQQ MEDLEY-UTILSCOMS - ((FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES PICK) - (VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL) - (FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH) - - (* |;;| "hardcopy files") - - (FNS HCFILES BADFILE) - (INITVARS (HCFILES) - (BADFILES)) - (COMMANDS "pick"))) +(RPAQQ MEDLEY-UTILSCOMS ((FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES) + (VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL) + (FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH))) (DEFINEQ (GATHER-INFO @@ -130,24 +122,6 @@ (MEDLEY-FIX-DATES (LAMBDA (DIRS) (* \; "Edited 28-Jan-2021 12:15 by larry") (|for| X |in| (OR DIRS MEDLEY-FIX-DIRS) |join| (FIX-DIRECTORY-DATES (MEDLEYDIR (PRINT X T)))))) - -(PICK - (LAMBDA (TYPE CHOICES) (* \; "Edited 25-Jun-2022 16:58 by larry") - (SELECTQ (MKATOM (U-CASE (MKSTRING TYPE))) - (NIL (PICK (PICK 'ONEOF '(FILE ISSUE PROJECT)))) - (ISSUE (LET ((ISSUE (PICK 'ONEOF (OR CHOICES (GIT-COMMAND - "gh issue list -L 5000 -R interlisp/medley | sed 's/\\([0-9]*\\).*/\\1/'" - )))) - (STR (OPENTEXTSTREAM))) - (|for| S |in| (GIT-COMMAND (CL:FORMAT NIL "gh issue view ~a" ISSUE)) - |do| (CL:FORMAT STR "~a~&" S) - |finally| (TEDIT STR NIL NIL `(READONLY T TITLE ,(CL:FORMAT NIL "Issue #~a" - ISSUE)))))) - (DIR (PICK 'ONEOF '(LISPUSERS LIBRARY DOCTOOLS SOURCES INTERNAL))) - (FILE (PICK 'ONEOF (DIRECTORY (MEDLEYDIR (PICK 'DIR))))) - (PROJECT (PICK 'ONEOF '(CLOS ROOMS LOOPS NOTECARDS ONLINE TEST GITBOOK COMMUNITY ENVOS))) - (ONEOF (CAR (NTH CHOICES (RAND 1 (LENGTH CHOICES))))) - (HELP TYPE "Unknown type")))) ) (RPAQQ MEDLEY-FIX-DIRS ("sources" "library" "lispusers" "internal" "greetfiles" "doctools")) @@ -195,104 +169,8 @@ (RENAMEFILE HASHFILE (MEDLEYDIR "tmp" "whereis.hash" T)) (DRIBBLE)))) ) - - - -(* |;;| "hardcopy files") - -(DEFINEQ - -(HCFILES - (LAMBDA (TFILE DEST REDOFLG TOPDIRLEN) (* \; "Edited 17-Jul-2022 12:44 by larry") - (* \; "Edited 21-Jun-2022 22:59 by larry") - (* \; "Edited 31-May-2022 09:31 by larry") - (* \; "Edited 20-Feb-2022 12:16 by larry") - (* \; "Edited 21-Aug-2021 20:56 by larry") - (DECLARE (SPECVARS TFILE)) - (|if| (NULL TFILE) - |then| (SETQ TFILE MEDLEYDIR)) - (COND - ((DIRECTORYNAMEP TFILE) - - (* |;;| "canonicalize") - - (SETQ TFILE (DIRECTORYNAME TFILE)) - (OR TOPDIRLEN (SETQ TOPDIRLEN (CL:LENGTH (FILENAMEFIELD.STRING TFILE 'DIRECTORY)))) - (CL:UNLESS DEST - (|ShellCommand| (CONCAT "mkdir -p " (UNIX-GETENV "MEDLEYDIR") - "/tmp/psfiles/")) - (SETQ DEST (MEDLEYDIR "tmp/psfiles" NIL T T))) - - (* |;;| "first deal with files in this directory") - - (FOR EXT IN '("TED*" "SKETCH" "T*XT") - DO (|for| X |in| (DIRECTORY (CONCAT TFILE "*." EXT ";*")) - |do| (HCFILES X DEST REDOFLG TOPDIRLEN))) - - (* |;;| " then deal with subdirs ") - - (|for| X |in| (DIRECTORY (CONCAT TFILE "*")) - |when| (|for| SKIP |in| '(">." ">dinfo>") |always| (NOT (STRPOS SKIP (L-CASE X)))) - |when| (DIRECTORYNAMEP X) |do| (HCFILES X DEST REDOFLG TOPDIRLEN))) - ((SETQ TFILE (INFILEP TFILE)) - (LET* ((TF (UNPACKFILENAME.STRING TFILE)) - (NAME (LISTGET TF 'NAME)) - (DIR (LISTGET TF 'DIRECTORY)) - (PSFILE (PACKFILENAME.STRING - 'EXTENSION - (|if| (EQ REDOFLG 'IP) - |then| "IP" - |else| "PS") - 'NAME - (|if| (EQ DEST T) - |then| (* \; "with the tedit file") - NAME - |else| (CONCAT (PACK (SUBST '- '> (UNPACK (SUBSTRING DIR (IPLUS 2 TOPDIRLEN - ) - -1)))) - "-" NAME)) - 'HOST - (LISTGET TF 'HOST) - 'DIRECTORY - (|if| (EQ DEST T) - |then| DIR - |else| DEST))) - (TEXTSTREAM)) - (|if| (AND (NOT REDOFLG) - (INFILEP PSFILE)) - |then| (* \; " do nothing") - (PRINTOUT T PSFILE " already there" T) - |elseif| (EQ REDOFLG 'TEST) - |then| (PRINTOUT T TFILE "-> " PSFILE T) - (CLOSEF (OPENTEXTSTREAM TFILE)) - ELSEIF (MEMBER TFILE BADFILES) - THEN (PRINTOUT T "Skipping " TFILE " on BADFILES") - |else| (PRINTOUT T "Converting " TFILE " to " PSFILE "...") - (TEDIT.FORMAT.HARDCOPY (SETQ TEXTSTREAM (OPENTEXTSTREAM TFILE)) - PSFILE T NIL NIL NIL (|if| (EQ REDOFLG 'IP) - |then| 'INTERPRESS - |else| 'POSTSCRIPT)) - (|printout| T " DONE" T) - (CLOSEF? TEXTSTREAM)))) - (T (PRINTOUT T "no such file " T))))) - -(BADFILE - (LAMBDA NIL (* \; "Edited 22-Jun-2022 09:40 by larry") - (PUSHNEW BADFILES TFILE) - (LET ((STR (OPENSTREAM "BADFILES.TXT" 'APPEND))) - (SETFILEPTR STR -1) - (PRINT TFILE STR) - (CLOSEF STR)) - (RETFROM 'HCFILES))) -) - -(RPAQ? HCFILES ) - -(RPAQ? BADFILES ) - -(DEFCOMMAND "pick" (FIRST . REST) (PICK FIRST REST)) (DECLARE\: DONTCOPY - (FILEMAP (NIL (727 8702 (GATHER-INFO 737 . 6147) (MAKE-FULLER-DB 6149 . 6839) (MEDLEY-FIX-LINKS 6841 - . 7238) (MEDLEY-FIX-DATES 7240 . 7482) (PICK 7484 . 8700)) (9741 11534 (MAKE-EXPORTS-ALL 9751 . 10710 -) (MAKE-WHEREIS-HASH 10712 . 11532)) (11569 15829 (HCFILES 11579 . 15514) (BADFILE 15516 . 15827))))) + (FILEMAP (NIL (600 7357 (GATHER-INFO 610 . 6020) (MAKE-FULLER-DB 6022 . 6712) (MEDLEY-FIX-LINKS 6714 + . 7111) (MEDLEY-FIX-DATES 7113 . 7355)) (8396 10189 (MAKE-EXPORTS-ALL 8406 . 9365) (MAKE-WHEREIS-HASH + 9367 . 10187))))) STOP diff --git a/internal/MEDLEY-UTILS.LCOM b/internal/MEDLEY-UTILS.LCOM index f1fdba30b9558bd1a72347ec8136dc9d18236011..96e6eb745f249b8088e0658aa636fbcaac88522a 100644 GIT binary patch delta 301 zcmbOp_`z&KpooHru48Gsu91O}k%EDxm8pT1fyu;FCn=*EE=>g`6j^gC6ALR7gNX;F z>ud7zOENO^(rXlIGV^K_xRky1J)Px$qHTk!4%H~5V)yyn@o<3XvO3G6q delta 3715 zcmZu!&2Jmm5hrQq!%SjGwi6?+4})zRlPW0fH$MzGS}m92TFc$_?#i`N1+8QxzEv@;*pMEsz z+8x((Vmcm;k4fsRdmhb-E-o%gbll%M8uX8;`~zBaMXHu7OotsgR^qgA)GLPQEyI-P z>A#9{w|Pv8(KMP=ZrNSSUv=VI5>Tb%$CMdTrB)a@cimt;uC<}>70cC@+-Pa~(|;DV zV&nOI>1UVH(6!g7)ozq4A!!s-ND9SCgnyabI9_+i1;_3Nu8n)T;3gZPQ>CJOzECJF zUnt-=9ZuhWz!-aMD6?U>T{_z?ocyED`7fRwopHiCeVfZ%NGFnSGHSk59P)+kTWrb| z&(EK`eeSg44uy^pS1>CzyoTS~Onx|5{Kn<`*ZBUk+og|A{+yrvt~i^obF;pF*-rDt zpNK`Se0m>FWwP(*qTko^zyD^}d(V1k@jd+Vd??N>^Aq`Gu29irg}ROxlGD%&J+Zz;}WUsd{rl$rMJxZCnS|E9_>Z$|hD*Ca5&)#BzWXI6&-G z%qEvolqMx^!qyac$+6mj?`@D_WOBNhy;7tt-w6vyZJH#lj~|ZrJ{!}~zs_VhmlTk7p1~26MH|^Q=;F2)- z`?hDMJyVvsL|PEu7vg96zB6%C;RJE%<)6RDeejHClnNz<8P41ceU>f%@DW@v6$guh zet8Aw5BvSxef*xE^YNWG*dv_PEi4SK2NwmPg!X6nz_{qqMBo< zf*VgOw*vgluGU1EoYe4!LdWrNu(M|11Rr6f5(sAz(+-%aV8p`tbE{n zW@9S4och#1tcsh4N)l?T@1Q2ipm{fKz;hBE?O`zR8YFvf{ORD}Xf%GnIOsSe+8a*_ z2w3Qar1;@ze_x2`4QQ&}f|!n=Nwl?dFi5xhkLhSQI2fQ{YV3fTL>jBsVGIJ#R&qo1 z5T;Dhc#jSr-5=5?qn!b^D@~ay(k-<4(yjhz{K?)e32lO@leEAJKF+$y2y|@H0)!M9 z4TOX)4NNIsa}v7?B251E!`qo__?LTJoTvyp>UDl8XEg+i3}?_B@t&b9kl5#(6MVHTyZyZe%p zXHi%DcRAKw=0X$LQ&7{BPK2(|kaJkUvtWsb_k!jCs|*A1VS$Iruts#7h%+wm(@E|$ z$qKR9X7R@ZmhwhmF}asKeeG&`kvE}Ls@%1rxJ*xfeYL+$<;nsb-@J(ru;JE0|Nh?o zV;-GDL}K>aDE9!kE}A-~fhv>lrb>QP73*2A9Fw#^y8lpm{^IKKxsNJQXx;fR&vRHP l=97KpO55q=UAEZBTCWHhvk3RZ2^90TUGO-kTJ~M9{C_fKG~ECI diff --git a/lispusers/PICK b/lispusers/PICK new file mode 100644 index 00000000..cb3afd62 --- /dev/null +++ b/lispusers/PICK @@ -0,0 +1,87 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "11-Aug-2022 17:53:58" {DSK}larry>medley>lispusers>PICK.;3 4261 + + :CHANGES-TO (VARS PICKCOMS) + (FNS PICK) + + :PREVIOUS-DATE "10-Aug-2022 16:57:49" {DSK}larry>medley>lispusers>PICK.;1) + + +(PRETTYCOMPRINT PICKCOMS) + +(RPAQQ PICKCOMS ((COMMANDS "pick") + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOP) + GITFNS)) + (FILES GITFNS) + (FNS PICK))) + +(DEFCOMMAND "pick" (FIRST . REST) (PICK FIRST REST)) +(DECLARE%: EVAL@COMPILE DONTCOPY + +(FILESLOAD (LOADCOP) + GITFNS) +) + +(FILESLOAD GITFNS) +(DEFINEQ + +(PICK + [LAMBDA (TYPE CHOICES) (* ; "Edited 11-Aug-2022 17:15 by lmm") + (* ; "Edited 10-Aug-2022 16:57 by lmm") + (SELECTQ (MKATOM (U-CASE (MKSTRING TYPE))) + (ONEOF (* ; + "PICK ONEOF A1 A2 A3 ... - just choose from choices listed") + [CAR (NTH CHOICES (RAND 1 (LENGTH CHOICES]) + (NIL (* ; + "pick -- choose an issue, a file, a project") + [PICK (PICK 'ONEOF '(FILE ISSUE PROJECT]) + (ISSUE (* ; + "pick issue [number] -- display an issue; if none given, choose one at random") + (LET ([ISSUE (PICK 'ONEOF (OR CHOICES (GIT-COMMAND + "gh issue list -L 5000 -R interlisp/medley | sed 's/\([0-9]*\).*/\1/'" + ] + (STR (OPENTEXTSTREAM)) + (COMMENTS T) + (TITLE)) + (for S in (GIT-COMMAND (CL:FORMAT NIL "gh issue view -R interlisp/medley ~d" + ISSUE)) do (CL:FORMAT STR "~a~&" S) + finally + + (* ;; + "this TEDIT call is wrong -- it takes the keyboard and the promptwindow prompt is wrong") + + [TEDIT STR NIL NIL `(READONLY T TITLE ,(SETQ TITLE (CL:FORMAT NIL + "Issue #~d" + ISSUE] + + (* ;; "if there are comments (or always) show comments too -- the -w switch doesn't work online -- no browser") + + (IF COMMENTS + THEN (GIT-COMMAND (CL:FORMAT NIL + "gh issue view -R interlisp/medley ~a -w" + ISSUE))) + (RETURN TITLE)))) + (DIR + (* ;; "pick a directory to choose files from") + + (PICK 'ONEOF '(LISPUSERS LIBRARY DOCTOOLS SOURCES INTERNAL))) + (FILE + (* ;; " pick a file from a (randomly chosen) directory") + + [LIST 'FILE (PICK 'ONEOF (DIRECTORY (OR (MEDLEYDIR (OR (CAR CHOICES) + (PICK 'DIR)) + NIL T) + (FETCH (GIT-PROJECT CLONEPATH) + OF (CDR (ASSOC (CAR CHOICES) + GIT-PROJECTS]) + (PROJECT + (* ;; "pick PROJECT will choose some repo to work on") + + [PICK 'ONEOF (PICK 'ONEOF (LIST (MAPCAR GIT-PROJECTS #'CAR) + '(CLOS ROOMS ONLINE WEBSITE COMMUNITY ENVOS]) + (HELP TYPE "Unknown type"]) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (735 4238 (PICK 745 . 4236))))) +STOP diff --git a/lispusers/PICK.LCOM b/lispusers/PICK.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..7ef1f4ea21f8e15c34ddba42200a5035763f23c9 GIT binary patch literal 2009 zcma)7-A?016egfbT`$@VyDKiX5;}6*U1uc+|HMvks|aIHz>DKCwgZip3IT~o#7_`` zBGi_P-u5l_1qxKT=tY%>=?m-=v^_I+NVZz3_`>#_pYQz4nQtVQ)VzSmHP0uq7t|;$ zgtoJ8uM!ZwAR&?O#i0lb5wYFGUh)4UUa?~Ws!|XHi6J;>mJk<2Rh8|F16flv4b-w_ zn3h@*K@#_S$EV$+b_;qZAi|Gsy#DjIo!)V~dbE3Xc2zxYw~pFZ)uV3z^rGKB>sLe1 zSucL07eM$J(y(;hDwRaoJ8R!#?ss-i4%+>%EnsfY#SpcI@55v=#bQx}*6ul`@JUEh zEc{O?x@BM~4^ACQnyG^2tl7aTiRFZXv}s2%2rNg3*5d+5wIJpx7r+W5vgy%AEW6l9 z?4vT#N7FLOR%z+s!PNqf0+w45q!3K_%7+jPz-XXD;w8A9A!vYU)Jc#qu?le#;a34K zjvE9#lsIeDb4ZN;3M9>tKn+_8t6n095q(RX1Z&8>f1I0|UVb!%&-m3kVCxTe^Y)?5 zr2<>?S1#ZB{R^({-ODFt}}?rRw*ouzyG zk1$eJxiU>TH<;x=9JABqP=lv-ZfkyiI(>5EaxkSlxBhUq!N0Ao`LXw$CImMNt=u7f z^7P40en_7U9?^W~<<5&=X#UmCv*Gm2;4k{(8BZFac!zm*w}1DRxs;3YQ&LGaV2$`V z083_iPV|xvj&H@y`U>^sS|e~0j|QNtdZt$@;Cd16GmV;{RVq*?u1}gM!C^ zK~>Uu9K|!WG^>&ZL9zyV86uVj;`=06MF}>czHTR!VL(H67>zLz0(-$KQh=^kz_BCH zbp>cZXbqhaG@WOXk;`F=ti&F&2kS;7 z@RBBwV3Xn@)vzdu5qcvgNI|~064|(=F2${-ehe{fMEsyL;ty=UAb_TnLA>6*ekFoh zF+n`&K)2t&Xu}WP_9e&>vg~>Lj1l%?O5Sk23-Tpe8%ubDaMLfZTe#NL2YI(d0dO+M zfe`x~WFHJgQ9c>)C+H)azwR$?OYanU>H9a^h2opVZFTXr2u2y%m2FGPX4(D~u%Ae@ zNz%j?g}CDh9~WH2sEI;*W8+=`l9WwV4B}~b|4>B2c8TNL5y6{=Y})=ZLt#O1KNE+B z%`|3=y{5K{f&v?BB>4j4dNf4#&jb_P&yvE+I184=V)jv-KoQ3!PSBm-Y^jV((1|0m LNTVo1;Q7M8z0%|i literal 0 HcmV?d00001 diff --git a/lispusers/PICK.TEDIT b/lispusers/PICK.TEDIT new file mode 100644 index 0000000000000000000000000000000000000000..99c5f3a12e88645e3a186cb612d0602a5ca70d17 GIT binary patch literal 3506 zcmeHJ&vV*V5Ej_^0WQ-^I_*p^TlZk8lc7NHkGRuGW%+>>3yDg?iJQqmh6gA?5+jMG z^we|yr2Yl@v%32vu#7!E^pI0DAicNyeY@Y=eNWKiqZwaT`nq;rYgKFQYOPtVi5Wht zC(C0nyf|J$&rAF;N4A|?wp_(d5a;i0%DgY48Qy-P*V5Rb=gOSMewn}+#`kOhf1@(Hp z@3V2+E= z*&K_2Uvx}4gkFF(!$JoMWD)!%S@2aNF9b0M)Pprh<}+`J=mHX2&no^HmeFDX6aP;v z^_9@0hQE-e|5s9tCn$zHl&!TXWynrEw$6PRr zJd*uFv=X10A`xYVGO@vNQW2H*ve?)RS}#cqLB>Vn-W~a|g34m-c@!_R5cwXsR+by! zXNdVcDr_W>$8i+o8<-w_+j_|~*HH>$!YJiKFCHa%K-yGmTNW`{T;&=_ghbbtZ0L>) zvfNj@3{2es9QB#)=zlOUcuJ?KV;Q=on;i>e)mBe*4R&|&qk!Y8wyT?6;{FIt1>^=a z;Go%p!{;rW$%46xYO982ojV}^K2T3VW2Vb&cB+7OrrNp38Bl7?*8467(#;Fq(NA#W zTb&L#%)ll0QHU$%SOXUg>@@R|-evz(mB_ zhbK!l9XwZHv+lr9ZEy^$&(^b7Oz)n#&||0iphv=(y~;drm@SG!#dF+Cl#3$;t7iA` zsNOCc7N&XFhGz%RIy%CKlHuhurk-LkvvTDV_mV^mOcNbsLhex;4%=k!E4hVvo5ne*d=IHWk&2xA5*0ah>7(?qbc8Y`X}i2tblovtp~qymQ-NTnopzylhHTMj9sZ|BU$ z|AqA~!+*A=JLTjNRz!M!ULrMHWY3mfmdJ3QgzK{9+E+x1BFa%*%q|+&Wg$ncXrO($ zw`mXwNX3m{RP28?p-;#_P?Ai+Zcu1Khg0PLng(PM5W?<|Wu=v@VobO1$@3V$Ldptq xD?S-21ihu8X!wB;#TX}>hMzVKzit`^n+9#uAkJhl%P*UVtgF)2g~a~;_dmV0!G8b% literal 0 HcmV?d00001