From 995c6de04eb00560ccbd78073f22fe55b2c7641b Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Mon, 2 Oct 2023 12:39:25 -0700 Subject: [PATCH] PDFSTREAM: First implementation (#1260) * PDFSTREAM: first implementation Makes PS file, then applies separate utility (if available) to convert PS to PDF * POSTSCRIPTSTREAM: Adds extra field to postscript data for PDFSTREAM filename * HARDCOPY: fixes printer menu * PDFSTREAM: define PDF fonts as POSTSCRIPT fonts * PDFSTREAM: fix convert template * PDFSTREAM: Fix logic around closing the postscript sub-stream * PDF Stream: slight generalization * PDFSTREAM uses AFTERCLOSE streamprop so doesn't require change to POSTSCRIPTSTREAM * UNIXUTILS: moved PROCESS-COMMAND and SLASHIT from GITFNS and PSEUDOHOST resp. PROCESS-COMMAND executes a command in process-stream, like ShellCommand, but returns a completion code and not what happens in the shell. SLASHIT is an approximation (doesn't deal with versions) of converting a Medley file name to its Unix equivalent, to use in commands * GITFNS: PROCESS-COMMAND moved to UNIXUTILS, cleanups from previous (unexamined) PR The other PR will be cleaned out * PSEUDOHOSTS: Moved SLASHIT to UNIXUTILS, also includes minor change in previous (unexamined) PR, to be removed * PDFSTREAM: wrapped FULLNAME around TRUEFILENAME * Restore POSTSCRIPTSTREAM * UNIXUTILS: Added UNIX-FILE-NAME Produces a Unix filename corresponding to a Medley file name (slashes, version number). For use in ShellCommand an PROCESS-COMMAND. * PDF-STREAM: added SEE-PDF A little stub that (on a mac) does a shell command to open Preview on the Unix-named file corresponding to a medley name (Also added back some key functions that got lost in a bad edit) * Pick up master changes --------- Co-authored-by: Larry Masinter --- library/PDFSTREAM | 276 +++++++++++++++++++++++++++++++ library/PDFSTREAM.LCOM | Bin 0 -> 5191 bytes lispusers/GITFNS | 324 ++++++++++++++++++++++--------------- lispusers/GITFNS.LCOM | Bin 48971 -> 49899 bytes lispusers/PSEUDOHOSTS | 97 +++++------ lispusers/PSEUDOHOSTS.LCOM | Bin 8570 -> 8250 bytes sources/HARDCOPY | 141 +++++++++------- sources/HARDCOPY.LCOM | Bin 47158 -> 47249 bytes 8 files changed, 591 insertions(+), 247 deletions(-) create mode 100644 library/PDFSTREAM create mode 100644 library/PDFSTREAM.LCOM diff --git a/library/PDFSTREAM b/library/PDFSTREAM new file mode 100644 index 00000000..1534669e --- /dev/null +++ b/library/PDFSTREAM @@ -0,0 +1,276 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED " 1-Oct-2023 20:53:05" {WMEDLEY}PDFSTREAM.;54 13917 + + :EDIT-BY rmk + + :CHANGES-TO (FNS SEE-PDF) + + :PREVIOUS-DATE " 1-Oct-2023 15:29:33" {WMEDLEY}PDFSTREAM.;53) + + +(PRETTYCOMPRINT PDFSTREAMCOMS) + +(RPAQQ PDFSTREAMCOMS + ((FILES (SYSLOAD) + POSTSCRIPTSTREAM) + [COMS (* ; "Hook into hardcopy interface") + [ADDVARS [PRINTERTYPES ((PDF) + (CANPRINT (PDF)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND POSTSCRIPTSEND) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION + ROTATION TITLE] + [PRINTFILETYPES (PDF (TEST PDFFILEP) + (EXTENSION (PDF)) + (CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT] + (IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM) + (FONTCREATE POSTSCRIPT.FONTCREATE) + (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) + (CREATECHARSET \CREATECHARSET.PSC] + (VARS (DEFAULTPRINTERTYPE 'PDF)) + (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) + (P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT] + + (* ;; "") + + + (* ;; "Implementation of PDF streams") + + (INITVARS (PDFCONVERTER 'ps2pdf)) + (* ; "Mac with ghostscript?") + (ALISTS (PDF-CONVERTER-TEMPLATES ps2pdf pstopdf)) + (GLOBALVARS PDFCONVERTER PDF-CONVERTER-TEMPLATES) + (FNS OPEN-PDF-STREAM CLOSE-PDF-STREAM PS-TO-PDF) + (FNS SEE-PDF))) + +(FILESLOAD (SYSLOAD) + POSTSCRIPTSTREAM) + + + +(* ; "Hook into hardcopy interface") + + +(ADDTOVAR PRINTERTYPES ((PDF) + (CANPRINT (PDF)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND POSTSCRIPTSEND) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))) + +(ADDTOVAR PRINTFILETYPES (PDF (TEST PDFFILEP) + (EXTENSION (PDF)) + (CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT)))) + +(ADDTOVAR IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM) + (FONTCREATE POSTSCRIPT.FONTCREATE) + (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) + (CREATECHARSET \CREATECHARSET.PSC))) + +(RPAQQ DEFAULTPRINTERTYPE PDF) +(DEFINEQ + +(PDFFILEP + [LAMBDA (FILE) (* ; "Edited 23-Jun-2023 14:43 by rmk") + (* ; "Edited 5-Mar-93 21:40 by rmk:") + (* ; "Edited 14-Jan-93 10:56 by jds") + (OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION) + '("PDF") + :TEST + (FUNCTION STRING-EQUAL)) + (CL:WHEN (STREAMP FILE) + (SETFILEPTR FILE 0) + (PROG1 (AND (EQ (BIN FILE) + (CHARCODE %%)) + (EQ (BIN FILE) + (CHARCODE P)) + (EQ (BIN FILE) + (CHARCODE D)) + (EQ (BIN FILE) + (CHARCODE F))) + (SETFILEPTR FILE 0)))]) + +(PDF.HARDCOPYW + [LAMBDA (PDFFILE BITMAP SCALEFACTOR REGION Landscape? TITLE) + (* ; "Edited 24-Jul-2023 10:37 by rmk") + (* ; "Edited 23-Jun-2023 13:28 by rmk") + (* ; "Edited 6-Mar-2023 22:43 by rmk") + (LET ((PSTTMP (PACKFILENAME 'EXTENSION 'TMPPS 'BODY PDFFILE))) + (PS-TO-PDF (POSTSCRIPT.HARDCOPYW PSTTMP BITMAP SCALEFACTOR REGION Landscape? TITLE) + PDFFILE]) + +(PDF.TEXT + [LAMBDA (FILE PDFFILE FONTS HEADING TABS) (* ; "Edited 1-Oct-2023 15:24 by rmk") + (* ; "Edited 23-Jun-2023 13:23 by rmk") + (* ; "Edited 7-Mar-2023 08:39 by rmk") + (TEXTTOIMAGEFILE FILE PDFFILE 'PDF FONTS HEADING TABS `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION + ROTATION ,(NOT (NOT + POSTSCRIPT.TEXTFILE.LANDSCAPE + ]) + +(PDF.TEDIT + [LAMBDA (FILE PDFFILE) (* ; "Edited 23-Jun-2023 13:22 by rmk") + (* ; "Edited 7-Mar-2023 08:39 by rmk") + (LET ((TSTREAM (OPENTEXTSTREAM FILE))) + (TEDIT.FORMAT.HARDCOPY FILE PDFFILE T NIL NIL NIL 'PDF) + (CLOSEF TSTREAM]) +) + +(FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT) + + + +(* ;; "") + + + + +(* ;; "Implementation of PDF streams") + + +(RPAQ? PDFCONVERTER 'ps2pdf) + + + +(* ; "Mac with ghostscript?") + + +(ADDTOVAR PDF-CONVERTER-TEMPLATES (ps2pdf " " PSFILE " " PDFFILE " 2> " ERRORFILE) + (pstopdf " " PSFILE " -o " PDFFILE " 2> " ERRORFILE)) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS PDFCONVERTER PDF-CONVERTER-TEMPLATES) +) +(DEFINEQ + +(OPEN-PDF-STREAM + [LAMBDA (FILE OPTIONS) (* ; "Edited 23-Sep-2023 15:38 by rmk") + (* ; "Edited 22-Sep-2023 11:04 by rmk") + (* ; "Edited 24-Jun-2023 14:49 by rmk") + + (* ;; "Open a temporary PS file, but set it up so that at closing it gets converted to PDF using an operating-system utility (if available), and then gets renamed to the original intended filename.") + + (* ;; "We have to stash the original filename someplace. We could put it in the tmp filename and then parse it out, but then we would have to worry about how unix filenames might parse against our {, }, etc. ") + + (* ;; + "Simplest thing for now is to just add an extra field at the end of the \POSTSCRIPTDATA record.") + + (* ;; "") + + (if [AND NIL (EQ 'LPT (FILENAMEFIELD FILE 'HOST] + then + (* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting. But then we would alo have to lie and give it a PDF extension so it thinks that we are heading to a PDF printer.") + + (OPENPOSTSCRIPTSTREAM FILE OPTIONS) + else (CL:UNLESS (OR (ASSOC (OR PDFCONVERTER (MKATOM (UNIX-GETENV "MEDLEY-PDFCONVERTER"))) + PDF-CONVERTER-TEMPLATES)) + (ERROR "POSTSCRIPT-to-PDF converter is not specified")) + (SETQ FILE (OR (AND (NEQ FILE T) + (OUTFILEP FILE)) + (ERROR "PDF target file not found" FILE))) + (LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE) + "-" + (RAND) + ".ps") + OPTIONS))) + (STREAMPROP PSSTREAM 'AFTERCLOSE (CONS (FUNCTION CLOSE-PDF-STREAM))) + (STREAMPROP PSSTREAM 'PDFTARGETINFO FILE) + PSSTREAM]) + +(CLOSE-PDF-STREAM + [LAMBDA (PSSTREAM) (* ; "Edited 22-Sep-2023 11:18 by rmk") + (* ; "Edited 24-Jul-2023 10:37 by rmk") + (* ; "Edited 17-Jul-2023 22:32 by rmk") + (* ; "Edited 24-Jun-2023 13:57 by rmk") + + (* ;; "PSSTREAM is a postscript (maybe in tmp) rendition of what is intended to end up as a pdf. If we are going directly to a printer, we can probably just pass it along without worrying about conversion. In fact, in that case we probably should not have bothered even setting up the PDF stream.") + + (* ;; "But for a file we execute the PDFCONVERTER as a shell command to make a pdf, and then we rename it to the intended filename") + + (STREAMPROP PSSTREAM 'AFTERCLOSE NIL) (* ; + "Maybe just remove only CLOSE-PDF-STREAMfrom the list?") + (LET ((TARGETINFO (STREAMPROP PSSTREAM 'PDFTARGETINFO NIL))) + (CL:IF TARGETINFO + (RENAMEFILE (PS-TO-PDF PSSTREAM) + TARGETINFO) + PSSTREAM)]) + +(PS-TO-PDF + [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 1-Oct-2023 15:18 by rmk") + (* ; "Edited 23-Sep-2023 22:54 by rmk") + (* ; "Edited 23-Jul-2023 22:30 by rmk") + (* ; "Edited 24-Jun-2023 15:01 by rmk") + (* ; "Edited 16-Jul-2022 13:06 by rmk") + (* ; "Edited 8-Jul-2022 10:20 by rmk") + (* ; "Edited 7-May-2022 22:40 by rmk") + (* ; "Edited 7-Oct-2021 11:15 by rmk:") + + (* ;; "PSFILE is the name of a closed PS file on a DSK/UNIX device. This function uses the PDFCONVERTER utility to convert that to a parallel pdf file, which is then renamed to PDFFILE. ") + + (* ;; "DONTDELETE is just for debugging, keeps the /tmp/ files") + + (SETQ PSFILE (FULLNAME (TRUEFILENAME PSFILE))) + (CL:UNLESS (INFILEP PSFILE) + (ERROR "NO PS FILE TO CONVERT")) + (SETQ PDFFILE (if PDFFILE + then (TRUEFILENAME PDFFILE) + else (PACKFILENAME 'EXTENSION 'pdf 'BODY PSFILE))) + (LET ((ERRORFILE (PACKFILENAME 'EXTENSION 'error 'BODY PSFILE)) + COMPLETIONCODE) + + (* ;; "PROCESS-COMMAND is currently from GITFNS. Not sure whether ShellCommand in UNIXUTILS is appropriate.") + + (* ;; + "We have to map the filenames down to Unix conventions: (not pseudohost or host, slashes, etc.") + + [SETQ COMPLETIONCODE (PROCESS-COMMAND (CONCATLIST (SUBLIS + `((PSFILE \, (SLASHIT (TRUEFILENAME + PSFILE) + NIL T)) + (PDFFILE \, (SLASHIT (TRUEFILENAME + PDFFILE) + NIL T)) + (ERRORFILE \, (SLASHIT (TRUEFILENAME + ERRORFILE) + NIL T))) + (ASSOC (OR PDFCONVERTER + (MKATOM (UNIX-GETENV + "MEDLEY-PDFCONVERTER" + ))) + PDF-CONVERTER-TEMPLATES] + + (* ;; "Now use Medley names") + + (CLOSEF? PSFILE) + (CL:UNLESS DONTDELETE (DELFILE PSFILE)) + (CLOSEF? ERRORFILE) + (CL:WHEN (INFILEP ERRORFILE) + (CL:WHEN (IGREATERP (PROG1 (GETFILEINFO ERRORFILE 'LENGTH) + (CL:UNLESS DONTDELETE (DELFILE ERRORFILE))) + 0) + (ERROR "Cannot create PDF file for " PDFFILE))) + (CL:WHEN (IGREATERP COMPLETIONCODE 0) + (ERROR "Cannot create PDF file for " PDFFILE)) + PDFFILE]) +) +(DEFINEQ + +(SEE-PDF + [LAMBDA (PDFFILE) (* ; "Edited 1-Oct-2023 20:47 by rmk") + (* ; "Edited 26-Sep-2023 16:52 by rmk") + + (* ;; "Good for Mac, not sure about Windows etc.") + + (ShellCommand (CONCAT "open -a Preview " (UNIX-FILE-NAME (PACKFILENAME 'BODY PDFFILE 'EXTENSION + 'PDF) + 'INPUT]) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (3078 5692 (PDFFILEP 3088 . 4002) (PDF.HARDCOPYW 4004 . 4602) (PDF.TEXT 4604 . 5321) ( +PDF.TEDIT 5323 . 5690)) (6136 13355 (OPEN-PDF-STREAM 6146 . 8324) (CLOSE-PDF-STREAM 8326 . 9613) ( +PS-TO-PDF 9615 . 13353)) (13356 13894 (SEE-PDF 13366 . 13892))))) +STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..12da811e8efa8c3c6eefca52341c9e2ffa8b2f75 GIT binary patch literal 5191 zcmds5&u`o28J1IY-Lz$B4jYCXiWdZeNh_#|lw`^3P>T{Nn3HitM{>WUy_^yH@0oQ7spXB|f2tWwB$EMuzTB z*1B0WYh+g2jas|f(5R$M=9i1vMKY!N6&8K@$-uEa=j5y3Ud&FHHw0=pl@IAl=y zuu(5lapxf8pj~UUO;e-OWs;qg{9&x)A1T_zVplj zt^9*L_#TVNs2vzhYCE)jJtUVcXH-mx`2aw0wUsZ{I_qm89yY6qe7#Pvs!ZX;~F zQ8VBv{H=XolxpQ7yyoBs)V5p2l1o+MZkY;kp-|ZCJj1h40xcjQs`3e8N ze82Nt7Io<2(apT3fjh$iS`a>)u zqk$TNyINVit{hvT-SdN!Pn7EcTo0l+9t7lKYwX6TSC{JKjjyJw$#{_*qFbZTIl_Tx zniTac&*@ve*bmV+sO!c9i??S%)b|R7A8msst&W85!Cv9GV|9DBbN?L=oYbSmGyqlixs|pR$wZH~9Y$ z|CG<{ZI#%n*mnmwM@mmJntKt?^F+n7hBiVTIGp0pkFA&!0msvnAXauCq1ZSJ9Boq@ ztFpS&H5jfTQTJ3aBQqUqc0Qeo-OAEqDRbCcGf{RXLEc65RjT4cT(x2EuiQ=mVf<-Y&9y0pNzi&scJF}a= zDQ{lgmtj?2rwYYCMk;Q%?!V20mQ*3vrZ_K;^M^m>DK*kjZA8MT)i+QL{eTP;co6mt zq+2y44BI@W-W@ck=MQ^UOf4i18Kq{OT%oXilbkRFmg)!Oj}$==2tf^+1`R&8Vt+u! zKDfYrsvkK(_Y)4U+2Z)dR)`_FhYWyS@{|v?0TQwLxRzvwOsN+g);w`SjOwv72t05p zg9pcD6L{pbL7KYlcx`4F z?w!}1%<3r@4X&afQVBq=kS9Eduov!c0Q8;K9nKr^&!O@ zn^jDGpE8!-fMAKY93qbsWqtQ+^?R)jQ_p`qQh1at-LKW)_49B4B4}4IzILB~`{!KW zdRLD9=3l=ql*}gRD;x>q@^uO{WI$_daA?+=gfL6kP4j?&E^Z6LOrQ`AbOSO0EX9h4 zpypb($6&AvTON|p0!Bl>=R^@8HyAMTjaDrs0|>>Kj3zGsQ5S7MytzfYnTI?09`eDn zqGPbT0W9r!VSpvFN!$#(lT}bux)YY|%(YNOIdwq|Sex&|dqqP=D{~uOvsRSw?H-51 zHcco8XLuAJ!!KOvVEhcXIi@ihfMyQT;L&ET*o~?%n`8hKq>7u6JGtwdRZ5o2`I7c? zQiqT}nT4|` zhol|P=bzz=WIdi^l^j+9qq`pei-i`@9-jmo1ToC^h1b9rPjE z)N4d@s>tVG#1c)7iiF8Y2)vaAviefZ2V*;mB}Ea@))UM1ud&V)lvA$ z3-L)rzuW0nf~cnqRaq{kk~^1eDm@?-9 zD$2%JWzWeUoV7F2qO3xZqDr|ErB&42%f&@M>lwb$=VxpJt=3?f%N4J4hi;r! zY@YK{Cl)Icge87R{SU?y`eL>|r)TH$)p|8q&KB!Kt%!3hzAw1$-@vNsBwDQ2b2*Vp zN1orcJb5=ZWlYQl-o?xK>p_WQd0VZ&Cbu&60;}?$=lI4{XlI~*7vhU0#60$48Lmh9 zqsjjXif=pi--dJUeg7M{-dqxQpc+-l^#ii_kAbO9J>Db{u^g;(1id1 literal 0 HcmV?d00001 diff --git a/lispusers/GITFNS b/lispusers/GITFNS index 0dbc6b1b..af78e808 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "30-Mar-2023 09:08:48" {WMEDLEY}GITFNS.;469 119763 +(FILECREATED "23-Sep-2023 13:02:15" {WMEDLEY}GITFNS.;483 124031 - :CHANGES-TO (FNS GIT-MAKE-PROJECT) + :EDIT-BY rmk - :PREVIOUS-DATE "11-Mar-2023 23:12:35" {WMEDLEY}GITFNS.;468) + :CHANGES-TO (FNS CDGITDIR) + + :PREVIOUS-DATE "22-Sep-2023 12:08:14" {WMEDLEY}GITFNS.;482) (PRETTYCOMPRINT GITFNSCOMS) @@ -47,6 +49,7 @@ (INITVARS (GIT-MERGE-COMPARES T) (GIT-CDBROWSER-SEPARATE-DIRECTIONS T)) (COMMANDS gwc bbc prc cob b? cdg cdw) + (FNS PRC-COMMAND) (* ;; "") @@ -65,7 +68,7 @@ (FNS GIT-COMMIT GIT-PUSH GIT-PULL GIT-APPROVAL GIT-GET-FILE GIT-FILE-EXISTS? GIT-REMOTE-UPDATE GIT-REMOTE-ADD GIT-FILE-DATE GIT-FILE-HISTORY GIT-PRINT-FILE-HISTORY - GIT-FETCH) + GIT-FETCH GIT-PR-BRANCHES) (* ;; "Differences") @@ -77,8 +80,8 @@ (* ;; "Branches") (FNS GIT-BRANCH-NUM GIT-CHECKOUT GIT-WHICH-BRANCH GIT-MAKE-BRANCH GIT-BRANCHES - GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-PRC-MENU GIT-PULL-REQUESTS GIT-SHORT-BRANCH-NAME - GIT-LONG-NAME) + GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-BRANCH-MENU GIT-PULL-REQUESTS + GIT-SHORT-BRANCH-NAME GIT-LONG-NAME GIT-PRC-BRANCHES) (* ;; "My branches") @@ -98,7 +101,7 @@ (FNS GIT-GET-DIFFERENT-FILES GIT-BRANCHES-COMPARE-DIRECTORIES GIT-WORKING-COMPARE-DIRECTORIES GIT-COMPARE-WORKTREE GITCDOBJBUTTONFN GIT-CD-LABELFN GIT-CD-MENUFN - GIT-WORKING-COMPARE-FILES GIT-BRANCHES-COMPARE-FILES) + GIT-WORKING-COMPARE-FILES GIT-BRANCHES-COMPARE-FILES GIT-PR-COMPARE) (INITVARS (FROMGITN 0)) (* ;; "") @@ -106,8 +109,8 @@ (* ;; "Utilities") - (FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE PROCESS-COMMAND - GIT-RESULT-TO-LINES STRIPLOCAL) + (FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE GIT-RESULT-TO-LINES + STRIPLOCAL) (PROPS (GITFNS FILETYPE)))) @@ -314,7 +317,8 @@ PROJECT))]) (GIT-PUT-PROJECT-FIELD - [LAMBDA (PROJECT FIELD NEWVALUE) (* ; "Edited 11-Mar-2023 23:00 by rmk") + [LAMBDA (PROJECT FIELD NEWVALUE) (* ; "Edited 10-Jun-2023 21:48 by rmk") + (* ; "Edited 11-Mar-2023 23:00 by rmk") (* ; "Edited 7-Jul-2022 11:25 by rmk") (* ; "Edited 13-May-2022 10:40 by rmk") (* ; "Edited 9-May-2022 20:02 by rmk") @@ -322,24 +326,17 @@ (* ;; "Replaces the value of a project field with NEWVALUE. The project record is DONTCOPY, to avoid potential name conflicts, so this provides a functional interface. One use: augment EXCLUSIONS with a list of temporary debug and testing files that you don't want to see in the various file listings") - (CL:WHEN (SETQ PROJECT (IF (TYPE? GIT-PROJECT PROJECT) - THEN PROJECT - ELSEIF (CDR (ASSOC (OR (U-CASE PROJECT) - GIT-DEFAULT-PROJECT) - GIT-PROJECTS)) - ELSEIF NOERROR - THEN NIL - ELSE (ERROR "NOT A GIT-PROJECT" PROJECT))) - (SELECTQ FIELD - (PROJECTNAME (REPLACE PROJECTNAME OF PROJECT WITH NEWVALUE)) - (WHOST (REPLACE WHOST OF PROJECT WITH NEWVALUE)) - (GITHOST (REPLACE GITHOST OF PROJECT WITH NEWVALUE)) - (EXCLUSIONS (REPLACE EXCLUSIONS OF PROJECT WITH NEWVALUE)) - (DEFAULTSUBDIRS - (REPLACE DEFAULTSUBDIRS OF PROJECT WITH NEWVALUE)) - (CLONEPATH (REPLACE CLONEPATH OF PROJECT WITH NEWVALUE)) - (MAINBRANCH (REPLACE MAINBRANCH OF PROJECT WITH NEWVALUE)) - PROJECT))]) + (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + (SELECTQ FIELD + (PROJECTNAME (REPLACE PROJECTNAME OF PROJECT WITH NEWVALUE)) + (WHOST (REPLACE WHOST OF PROJECT WITH NEWVALUE)) + (GITHOST (REPLACE GITHOST OF PROJECT WITH NEWVALUE)) + (EXCLUSIONS (REPLACE EXCLUSIONS OF PROJECT WITH NEWVALUE)) + (DEFAULTSUBDIRS + (REPLACE DEFAULTSUBDIRS OF PROJECT WITH NEWVALUE)) + (CLONEPATH (REPLACE CLONEPATH OF PROJECT WITH NEWVALUE)) + (MAINBRANCH (REPLACE MAINBRANCH OF PROJECT WITH NEWVALUE)) + PROJECT]) (GIT-PROJECT-PATH [LAMBDA (PROJECTNAME PROJECTPATH) (* ; "Edited 8-May-2022 15:10 by rmk") @@ -478,29 +475,7 @@ (* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment") - (LET ((RB REMOTEBRANCH) - (DR DRAFTS) - (PRS)) - (IF PROJECT - THEN (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) - ELSEIF (GIT-GET-PROJECT RB NIL T) - THEN (SETQ PROJECT RB) - (SETQ RB NIL) - ELSEIF (GIT-GET-PROJECT DRAFTS NIL T) - THEN (SETQ PROJECT DRAFTS) - (SETQ DRFTS NIL)) - (CL:WHEN (MEMB (U-CASE RB) - '(DRAFT DRAFTS)) - (SETQ RB NIL) - (SETQ DR T)) - (GIT-FETCH PROJECT) - (SETQ PRS (GIT-PULL-REQUESTS T DR PROJECT)) - (IF PRS - THEN (CL:WHEN (OR RB (SETQ RB (GIT-PICK-BRANCH (GIT-PRC-MENU DR PROJECT PRS) - "Pull requests"))) - (GIT-BRANCHES-COMPARE-DIRECTORIES (GIT-MAINBRANCH PROJECT) - RB NIL PROJECT)) - ELSE "No open pull requests"))) + (PRC-COMMAND REMOTEBRANCH DRAFTS PROJECT)) (DEFCOMMAND cob (BRANCH NEXTTITLESTRING PROJECT) @@ -553,6 +528,46 @@ (SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'WHOST) (OR SUBDIR ""))) T)) +(DEFINEQ + +(PRC-COMMAND + [LAMBDA (REMOTEBRANCH DRAFTS PROJECT) (* ; "Edited 28-Jul-2023 09:03 by rmk") + (LET (PRS PRMENU) + (IF PROJECT + THEN (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + ELSEIF (GIT-GET-PROJECT REMOTEBRANCH NIL T) + THEN (SETQ PROJECT REMOTEBRANCH) + (SETQ REMOTEBRANCH NIL) + ELSEIF (GIT-GET-PROJECT DRAFTS NIL T) + THEN (SETQ PROJECT DRAFTS) + (SETQ DRAFTS NIL)) + (CL:WHEN (MEMB (U-CASE REMOTEBRANCH) + '(DRAFT DRAFTS)) + (SETQ REMOTEBRANCH NIL) + (SETQ DRAFTS T)) + (GIT-FETCH PROJECT) + (SETQ PRS (GIT-PULL-REQUESTS T DRAFTS PROJECT)) + (CL:WHEN (AND REMOTEBRANCH (NEQ REMOTEBRANCH 'PinMenu)) + (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 + finally (CL:WHEN $$VAL (SETQ PRS $$VAL)) + (SETQ REMOTEBRANCH NIL))) + (IF PRS + THEN (CL:UNLESS REMOTEBRANCH + (SETQ PRS (GIT-PRC-BRANCHES DRAFTS PROJECT PRS)) + (SETQ PRMENU (GIT-BRANCH-MENU PRS (CONCAT (LENGTH PRS) + " pull requests") + NIL)) + (SETQ REMOTEBRANCH (MENU PRMENU))) + (if (EQ 'PinMenu REMOTEBRANCH) + then (ADDMENU (GIT-BRANCH-MENU PRS (CONCAT (LENGTH PRS) + " pull requests"))) + elseif REMOTEBRANCH + then (GIT-PR-COMPARE REMOTEBRANCH PROJECT)) + ELSE "No open pull requests"]) +) @@ -1004,6 +1019,35 @@ (GIT-FETCH [LAMBDA (PROJECT) (* ; "Edited 8-Jul-2022 10:32 by rmk") (GIT-COMMAND "git fetch" T NIL PROJECT]) + +(GIT-PR-BRANCHES + [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 PRNAME (SUPERSETS _ (CAR RELATIONS)) + (EQUALS _ (CADR RELATIONS)) IN PRS + 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 PRNAME) + (CONCAT " " (FETCH PRDESCRIPTION OF PR) + " #" + (FETCH PRNUMBER OF PR] + T)))]) ) @@ -1321,41 +1365,24 @@ THEN (ERROR "Unknown branch" BRANCH]) (GIT-PICK-BRANCH - [LAMBDA (BRANCHES TITLE) (* ; "Edited 18-May-2022 13:44 by rmk") - (CL:WHEN (MKLIST BRANCHES) - (MENU (CREATE MENU - TITLE _ (OR TITLE 'Branches) - ITEMS _ BRANCHES - MENUFONT _ DEFAULTFONT)))]) + [LAMBDA (BRANCHES TITLE) (* ; "Edited 6-Jul-2023 22:31 by rmk") + (* ; "Edited 30-Jun-2023 16:58 by rmk") + (* ; "Edited 18-May-2022 13:44 by rmk") + (MENU (GIT-BRANCH-MENU BRANCHES (OR TITLE (CONCAT (LENGTH BRANCHES) + " branches"]) -(GIT-PRC-MENU - [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 PRNAME (SUPERSETS _ (CAR RELATIONS)) - (EQUALS _ (CADR RELATIONS)) IN PRS - 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 PRNAME) - (CONCAT " " (FETCH PRDESCRIPTION OF PR) - " #" - (FETCH PRNUMBER OF PR] - T)))]) +(GIT-BRANCH-MENU + [LAMBDA (BRANCHES TITLE PIN?) (* ; "Edited 6-Jul-2023 22:31 by rmk") + (* ; "Edited 30-Jun-2023 16:58 by rmk") + (* ; "Edited 18-May-2022 13:44 by rmk") + (CL:WHEN (SETQ BRANCHES (MKLIST BRANCHES)) + (CL:WHEN PIN? + [SETQ BRANCHES (APPEND BRANCHES '((" Pin menu" 'PinMenu]) + (CREATE MENU + TITLE _ (OR TITLE (CONCAT (LENGTH BRANCHES) + " branches")) + ITEMS _ BRANCHES + MENUFONT _ DEFAULTFONT))]) (GIT-PULL-REQUESTS [LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 8-Aug-2022 13:12 by rmk") @@ -1402,6 +1429,35 @@ (* ;; "Allows short-hand reference to branch: rmk40 will return rmk40--xyz") (FIND B IN (GIT-BRANCHES WHERE PROJECT EXCLUDEMERGED) SUCHTHAT (STRPOS BRANCH B]) + +(GIT-PRC-BRANCHES + [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 PRNAME (SUPERSETS _ (CAR RELATIONS)) + (EQUALS _ (CADR RELATIONS)) IN PRS + 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 PRNAME) + (CONCAT " " (FETCH PRDESCRIPTION OF PR) + " #" + (FETCH PRNUMBER OF PR] + T)))]) ) @@ -1664,7 +1720,8 @@ (LIST DIR1 DIR2 MAPPINGS))]) (GIT-BRANCHES-COMPARE-DIRECTORIES - [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 12-Sep-2022 14:41 by rmk") + [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 10-Jun-2023 17:28 by rmk") + (* ; "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") @@ -1683,10 +1740,11 @@ (SETQ MAPPINGS (CADDR DIRS)) (IF DIRS THEN (TERPRI T) - (SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS) + [SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS) (CADR DIRS) '(> < ~= -* *-) - '*>*.*)) + '*>*.* + (GIT-GET-PROJECT PROJECT 'EXCLUSIONS] (* ;; "We know that both sides come from Unix/unversioned, even if they have been copied into versioned FROMGIT, so we make a pass to remove the misleading versions.") @@ -1754,6 +1812,10 @@ (GIT-WORKING-COMPARE-DIRECTORIES [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT) + (* ;; "Edited 17-Jun-2023 22:54 by rmk") + + (* ;; "Edited 10-Jun-2023 21:32 by rmk") + (* ;; "Edited 20-Jul-2022 21:18 by rmk") (* ;; "Edited 25-Jun-2022 21:37 by rmk") @@ -1793,7 +1855,13 @@ (GITSUBDIR SUBDIR T PROJECT) (OR SELECT '(> < ~= -* *-)) NIL - (FETCH EXCLUSIONS OF PROJECT) + (for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS) + collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E + 'DIRECTORY) + 1 NIL T T FILEDIRCASEARRAY)) + (CL:IF DPOS + (SUBSTRING E (ADD1 DPOS)) + E)) NIL NIL NIL FIXDIRECTORYDATES)) [FOR CDE IN (FETCH CDENTRIES OF CDVAL) DO (CL:WHEN (FETCH INFO1 OF CDE) @@ -2067,6 +2135,11 @@ " " FILE) (CONCAT (GIT-SHORT-BRANCH-NAME BRANCH2) " " FILE]) + +(GIT-PR-COMPARE + [LAMBDA (RB PROJECT) (* ; "Edited 6-Jul-2023 22:22 by rmk") + (GIT-BRANCHES-COMPARE-DIRECTORIES (GIT-MAINBRANCH PROJECT) + RB NIL PROJECT]) ) (RPAQ? FROMGITN 0) @@ -2083,11 +2156,13 @@ (DEFINEQ (CDGITDIR - [LAMBDA (PROJECT) (* ; "Edited 8-Jul-2022 10:34 by rmk") + [LAMBDA (PROJECT) (* ; "Edited 23-Sep-2023 13:01 by rmk") + (* ; "Edited 8-Jul-2022 10:34 by rmk") (* ; "Edited 7-Jul-2022 09:36 by rmk") (* ; "Edited 7-May-2022 22:41 by rmk") (* ; "Edited 2-Nov-2021 21:12 by rmk:") - (CONCAT "cd " [SLASHIT (STRIPHOST (TRUEFILENAME (FETCH GITHOST OF PROJECT] + (CONCAT "cd " (SLASHIT (TRUEFILENAME (FETCH GITHOST OF PROJECT)) + NIL T) " && "]) (GIT-COMMAND @@ -2198,16 +2273,6 @@ (ERROR (CONCAT "Command failed: " CMD))) NIL]) -(PROCESS-COMMAND - [LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk") - - (* ;; "This sets up an asynchronous process and waits until it returns with an exit code. Typically 0 means success.") - - (CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM CMD)) - (BIND CODE WHILE (EQ T (SETQ CODE (OR (SUBRCALL UNIX-HANDLECOMM 7 (fetch (STREAM F1) - of PS)) - 0))) DO (BLOCK) FINALLY (RETURN CODE]) - (GIT-RESULT-TO-LINES [LAMBDA (FILE ALL) (* ; "Edited 16-Jul-2022 22:21 by rmk") @@ -2234,32 +2299,33 @@ (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3979 20805 (GIT-CLONEP 3989 . 5252) (GIT-INIT 5254 . 5884) (GIT-MAKE-PROJECT 5886 . -13487) (GIT-GET-PROJECT 13489 . 15414) (GIT-PUT-PROJECT-FIELD 15416 . 17433) (GIT-PROJECT-PATH 17435 - . 18479) (FIND-ANCESTOR-DIRECTORY 18481 . 18830) (GIT-FIND-CLONE 18832 . 19913) (GIT-MAINBRANCH 19915 - . 20310) (GIT-MAINBRANCH? 20312 . 20803)) (27232 30020 (ALLSUBDIRS 27242 . 28528) (MEDLEYSUBDIRS -28530 . 29223) (GITSUBDIRS 29225 . 30018)) (30021 34811 (TOGIT 30031 . 31437) (FROMGIT 31439 . 32420) -(GIT-DELETE-FILE 32422 . 33268) (MYMEDLEY-DELETE-FILES 33270 . 34809)) (34812 37815 (MYMEDLEYSUBDIR -34822 . 35278) (GITSUBDIR 35280 . 35723) (STRIPDIR 35725 . 36096) (STRIPHOST 36098 . 36338) (STRIPNAME - 36340 . 37093) (STRIPWHERE 37095 . 37813)) (37816 39718 (GFILE4MFILE 37826 . 38189) (MFILE4GFILE -38191 . 38760) (GIT-REPO-FILENAME 38762 . 39716)) (39767 49589 (GIT-COMMIT 39777 . 40603) (GIT-PUSH -40605 . 41249) (GIT-PULL 41251 . 41863) (GIT-APPROVAL 41865 . 42214) (GIT-GET-FILE 42216 . 44181) ( -GIT-FILE-EXISTS? 44183 . 44457) (GIT-REMOTE-UPDATE 44459 . 45183) (GIT-REMOTE-ADD 45185 . 45492) ( -GIT-FILE-DATE 45494 . 46425) (GIT-FILE-HISTORY 46427 . 48361) (GIT-PRINT-FILE-HISTORY 48363 . 49413) ( -GIT-FETCH 49415 . 49587)) (49619 60212 (GIT-BRANCH-DIFF 49629 . 55969) (GIT-COMMIT-DIFFS 55971 . 56524 -) (GIT-BRANCH-RELATIONS 56526 . 60210)) (60257 72489 (GIT-BRANCH-NUM 60267 . 60840) (GIT-CHECKOUT -60842 . 61901) (GIT-WHICH-BRANCH 61903 . 62201) (GIT-MAKE-BRANCH 62203 . 64416) (GIT-BRANCHES 64418 . -66686) (GIT-BRANCH-EXISTS? 66688 . 67392) (GIT-PICK-BRANCH 67394 . 67722) (GIT-PRC-MENU 67724 . 69727) - (GIT-PULL-REQUESTS 69729 . 71875) (GIT-SHORT-BRANCH-NAME 71877 . 72168) (GIT-LONG-NAME 72170 . 72487) -) (72519 75854 (GIT-MY-CURRENT-BRANCH 72529 . 72899) (GIT-MY-BRANCHP 72901 . 73406) ( -GIT-MY-NEXT-BRANCH 73408 . 73902) (GIT-MY-BRANCHES 73904 . 75852)) (75900 79852 (GIT-ADD-WORKTREE -75910 . 77394) (GIT-REMOVE-WORKTREE 77396 . 78326) (GIT-LIST-WORKTREES 78328 . 79132) (WORKTREEDIR -79134 . 79850)) (79900 111109 (GIT-GET-DIFFERENT-FILES 79910 . 86334) ( -GIT-BRANCHES-COMPARE-DIRECTORIES 86336 . 92493) (GIT-WORKING-COMPARE-DIRECTORIES 92495 . 97321) ( -GIT-COMPARE-WORKTREE 97323 . 101301) (GITCDOBJBUTTONFN 101303 . 105793) (GIT-CD-LABELFN 105795 . -106877) (GIT-CD-MENUFN 106879 . 109319) (GIT-WORKING-COMPARE-FILES 109321 . 109941) ( -GIT-BRANCHES-COMPARE-FILES 109943 . 111107)) (111179 119696 (CDGITDIR 111189 . 111749) (GIT-COMMAND -111751 . 113309) (GITORIGIN 113311 . 114008) (GIT-INITIALS 114010 . 114314) (GIT-COMMAND-TO-FILE -114316 . 117805) (PROCESS-COMMAND 117807 . 118420) (GIT-RESULT-TO-LINES 118422 . 119029) (STRIPLOCAL -119031 . 119694))))) + (FILEMAP (NIL (4053 20503 (GIT-CLONEP 4063 . 5326) (GIT-INIT 5328 . 5958) (GIT-MAKE-PROJECT 5960 . +13561) (GIT-GET-PROJECT 13563 . 15488) (GIT-PUT-PROJECT-FIELD 15490 . 17131) (GIT-PROJECT-PATH 17133 + . 18177) (FIND-ANCESTOR-DIRECTORY 18179 . 18528) (GIT-FIND-CLONE 18530 . 19611) (GIT-MAINBRANCH 19613 + . 20008) (GIT-MAINBRANCH? 20010 . 20501)) (25911 28038 (PRC-COMMAND 25921 . 28036)) (28094 30882 ( +ALLSUBDIRS 28104 . 29390) (MEDLEYSUBDIRS 29392 . 30085) (GITSUBDIRS 30087 . 30880)) (30883 35673 ( +TOGIT 30893 . 32299) (FROMGIT 32301 . 33282) (GIT-DELETE-FILE 33284 . 34130) (MYMEDLEY-DELETE-FILES +34132 . 35671)) (35674 38677 (MYMEDLEYSUBDIR 35684 . 36140) (GITSUBDIR 36142 . 36585) (STRIPDIR 36587 + . 36958) (STRIPHOST 36960 . 37200) (STRIPNAME 37202 . 37955) (STRIPWHERE 37957 . 38675)) (38678 40580 + (GFILE4MFILE 38688 . 39051) (MFILE4GFILE 39053 . 39622) (GIT-REPO-FILENAME 39624 . 40578)) (40629 +52459 (GIT-COMMIT 40639 . 41465) (GIT-PUSH 41467 . 42111) (GIT-PULL 42113 . 42725) (GIT-APPROVAL 42727 + . 43076) (GIT-GET-FILE 43078 . 45043) (GIT-FILE-EXISTS? 45045 . 45319) (GIT-REMOTE-UPDATE 45321 . +46045) (GIT-REMOTE-ADD 46047 . 46354) (GIT-FILE-DATE 46356 . 47287) (GIT-FILE-HISTORY 47289 . 49223) ( +GIT-PRINT-FILE-HISTORY 49225 . 50275) (GIT-FETCH 50277 . 50449) (GIT-PR-BRANCHES 50451 . 52457)) ( +52489 63082 (GIT-BRANCH-DIFF 52499 . 58839) (GIT-COMMIT-DIFFS 58841 . 59394) (GIT-BRANCH-RELATIONS +59396 . 63080)) (63127 76230 (GIT-BRANCH-NUM 63137 . 63710) (GIT-CHECKOUT 63712 . 64771) ( +GIT-WHICH-BRANCH 64773 . 65071) (GIT-MAKE-BRANCH 65073 . 67286) (GIT-BRANCHES 67288 . 69556) ( +GIT-BRANCH-EXISTS? 69558 . 70262) (GIT-PICK-BRANCH 70264 . 70754) (GIT-BRANCH-MENU 70756 . 71459) ( +GIT-PULL-REQUESTS 71461 . 73607) (GIT-SHORT-BRANCH-NAME 73609 . 73900) (GIT-LONG-NAME 73902 . 74219) ( +GIT-PRC-BRANCHES 74221 . 76228)) (76260 79595 (GIT-MY-CURRENT-BRANCH 76270 . 76640) (GIT-MY-BRANCHP +76642 . 77147) (GIT-MY-NEXT-BRANCH 77149 . 77643) (GIT-MY-BRANCHES 77645 . 79593)) (79641 83593 ( +GIT-ADD-WORKTREE 79651 . 81135) (GIT-REMOVE-WORKTREE 81137 . 82067) (GIT-LIST-WORKTREES 82069 . 82873) + (WORKTREEDIR 82875 . 83591)) (83641 115865 (GIT-GET-DIFFERENT-FILES 83651 . 90075) ( +GIT-BRANCHES-COMPARE-DIRECTORIES 90077 . 96422) (GIT-WORKING-COMPARE-DIRECTORIES 96424 . 101848) ( +GIT-COMPARE-WORKTREE 101850 . 105828) (GITCDOBJBUTTONFN 105830 . 110320) (GIT-CD-LABELFN 110322 . +111404) (GIT-CD-MENUFN 111406 . 113846) (GIT-WORKING-COMPARE-FILES 113848 . 114468) ( +GIT-BRANCHES-COMPARE-FILES 114470 . 115634) (GIT-PR-COMPARE 115636 . 115863)) (115935 123964 (CDGITDIR + 115945 . 116632) (GIT-COMMAND 116634 . 118192) (GITORIGIN 118194 . 118891) (GIT-INITIALS 118893 . +119197) (GIT-COMMAND-TO-FILE 119199 . 122688) (GIT-RESULT-TO-LINES 122690 . 123297) (STRIPLOCAL 123299 + . 123962))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index 70a03829d00b118f34c2abc5a07bf8e489c6c231..2cd16571189cb902aa72f57dcb5414f1d7517575 100644 GIT binary patch delta 3805 zcmaJ^TWlN073D5v8>TH=54v^~S-zrel@v^7ALK5{1PYhrQlvz3X+Er|P0dOsZ3?pW zw9^C$z&7Y3{U{oBk*0=|6n26ph$UAFL)2($Z-IXFqaOkKKnwJvD3GEk@?)bY8nl4Z zJF`oXa)R<>cjnIA*}0E%?&WVDupfWR{_>Pl5WR)!l2_ma5qL4o31L34Hvd>XD0;x* z+OdjD{;-l3-LA<8m=R_XDYCKi+MyFxr(maG?NhLe37Q96b z+>S)Huze#BgmZcIOiC*iym34nT!PSHvJmEiXxG~F$Jn6I_%)L~SoeVK+culc9@&de z+pJBgTp)vcKQt+e}%c z$L7|rzu}zWc?mK~DjUr!*;o=nGQ`qaR?R8JB*;OCs|lr)E*45r3_<}U9@M8|=~5x3 zp)33W!005kLJ@=zOwj@Fhg@EpP-Dfcl2Ot9jjMfYyXv`o%p21(86_Ksa6IU6=Rm@Z zkOLlH88utNA&0{Pq(EpLfny%xc_mRKVh-|ZMk}h;RTCfsi7j3%rW8~qpI4?mz#QJg z*zCQ)M4N{qwYh!7!|xrcM`pW>+N^DJ$n<@evDvR!tFJ0_jWx`;ED{X|dAy1W#@sAx zM5)r85~Zg-6={}|H@0j)jWj(vMf`pR4P*ky7!Qy8cvk#6kW~UNjLXrY6DMyFu{Il z^Ou>CUu=F7sk{;;pQzh<=-n{tg3OVqd2@LZkerfN0rMUT#e7aHfFSU#Aumgy#N#wJ zyv$Q2)Ae3cCP@&}vN5Fyd_aP5^K&BnS%h%!FFRT$N<}QYH!k8A@J~0^m27$5mn;O+u2GXzf97r;Hc% z<%Rw_kEiA47Bba^E5Q3P9nCT3EC^`3E4v7bOVtHfx^nR%a?|pa>gwfH7w`xI*Jp%+ z@L8cGfSYEomBSv7LrJGwSZV~0>>b{RVQ87$C>FoTHpW7!0YVjkVPhjov+w_;3`W!P zw%~6&yXEUp%he&v(H=)Ol}76jqb`_TnOQhjtF9tNl62^dY`B{sl;SXzeG>HLf=60r z5mu3k{msf+ZD7{+el_}fq@C^vl&|7_ZO8DwoiNhhFO1bO=>kIQE*K&!Q}D`9E4iGS zjSJ}Vpxojbl08W^9ZzHl0magJ3}q%)1W|w&y6j}NIGt0Ezd+*Tmpd&1J_K&J3+NA{ z370Umu0C*|E+K7f$JgU&{PqmjwV!a(4&Up)yV=)petDzExw@ORb;V5d?v6C=FK#hO z{SWgm9slDT6;3jfEJMwwsEyGl#d7y9{qn^d^$)0|HZWk}u7y6)q+rV% zA_6ZKkLI`RjV&P%XzdZOI;G7_7dRP;D!K-v#1YMmf>atLAt#vDKe^o9&tpv^ zq3uY0{raVkDghBHbLY=jSE>u=s;eN1!HzisCb&(%LP!A9Ljnjv$r|%GHt8T1_okJo zn#NEO#I(kINYd}D57!lr!@Kbq#g3xE%L0s!jrvAO{6r}TZm#3=s~(ggY#x^J0dU8# zIha|gLZMpqpocgN{dsH_5R!sFh!grF69UDVg~~yE2_ga+Tn;2QLI3XJ8!-t?{9(Bf z0#Hm9)0h~jgDyOyq{$EokXAb~=1@%5F|p!=9*K`ZpI*Afi6%W|)cm;GBGLjR07LX} zQ6f@7A6|Zh6-E8E`4e6C(omOPS^oGiGiFRZabt^-GBm61^m5&iEoMMJzarM#Db;(r zUmLVHo!U?z)__pp*&=0gKT+l^KH#FQU+u5pB1K;acb@g%e>AqYK57jdPfY+jok(FWAoJ( z_p|oqhnll|z{ocDX$NWpXTP%b;6K`dk+WM5=vjxfQJq~C>I2#-d(-|Mrpy_duQ}A8 zITtZZ7#S0l`Fm(TOAXkveQN)S<}3S++Dn>`!MEmP%RYl*Cqw~}lxps;zpW1rx5j~cm+~y7FnPoQ5_UoskszDkDmF3O#3EtyLWza0AWyhVd*>D|pgh3Ijp?ub zVJ9nNpoo`nTjQ? zN(wr6Gk(mBoZ0eG?c9zoPJj94ai8_6b_w=?dlVjj99)^_I+_!3lbbvA4{x5-|8-M2 zjQ{6wPJE2Lsdq}tPZsm43VLQe&N%e7b*H{{>4<)JeOUi=eV1-u8vMaVOrQAvqx#v6 vfrBmctj1S=cH=lIUE6T!cQ<4l?YecWaq`w%d%8P3h2PFK2OGZINB8^>tE;Ty delta 3325 zcmZu!YitzP72cU8HY{L_G1y%Q93~FkbyzZwo!Ljy#IrNA_Tt^0WoC@yCc!oAg56M? zcuQV_xT38ZrBVvIRfzyK6{<=}RAhUx)TW}_O0B92Rh6o!s#LWSN~EfaTG3xs`Xlt* zJ3DJb>L0Un&bf0Q-#y>C*B^f~eEU=W{CKY-CQ4KD30agC5HndZolT}MyzscKW#SMK z|AgzOuso7!oQ&ieI5E)MZL69e-_G_SG0P3`wB zxI`DUbiR*EzQSL{R18b6Kp?rl8# zR3S?86WgNC@?3}?3SS$lE_>6_o0Tuo()Z{qohQh5CZ0Olvw_N(RXPnNt2~COsF@%b zRg73gGhfC4n2&?qQL1<#Cm}aKHG6EjRtHIiGwZ^1r8iNr9yx;!;%rANj*+11#-$_Q z;2YI14z44=Ioi_@r+(7id!mC6tut8Yqa8yl;d4veljPqozR`DkhABt6QJ!PF#z5Re zuFPNMeoLON_fIMcZC2YU3>V6vAcRG$Jd7AAVg?K|=h)+}<$$av!LZAQPLoxFHL{d} zB10Ucj0&EG1re4rq5?4k2|YDm1GiR-W5sC@;5ZVzE`Y3PD6l^&h$u|WR`Dt0 zE(#z-K$b-E!RhbIBKXY(2t)?Ff>*TYYZ}2htQYC4x@HC9Ym$|hZm8&n5!iBut%QO7 zp*xmK$*5wfu9p}uS!U6iKp4==m~Ya^jh6@3@&D})lRv%uabM`e=D2uuDfE{T+x=Tx z#mz%Yp(gqBE6NNd7&l$58k?DIvUgFfa$C7Bdsmg`mbdYoy^H6#8Ak5@CJMOx9sj4= zR&V3OE4S_5$*yL3Wux6S9X;~=(!DXeYu}Njdu8fwi@lrt;Z=E|*M{&)_*>lMK+_gh zc5f>klbe1^HV;-`xO;Vp<5@>8h3Vk`9A|Z zOP>j?O7=DF0efFzbUGSkJ_{#88`FHz3PqTT@ZUy|{eH-{mSo-uM<`!ci*HhTsE!t=q zB_N81eZ0ybO_N%uLSd>km7WGw!*1|trK+jGM>3rXxRh-3u2{gal$51ly^>PE#fBIu zc&v@b%56!ODC-(q&uripQrPutd8c778*`^#eH5NdfTpBrhvP3M-RgJ^XJf!b4QIdu zjMKzb#;KW9(7f}klvh`w-vQoo2DLgKKrlrW8vx8wx zRY=$CdtD8uj36LDGLp)tUIf%+2BqK+tx0NaaZzQ&q+CRuN{Q*0G&6ew6-h~JoO}Hr zJC7SCR)ixTvSvCGD}WeOi)Y*bwu?U|@r>bEgRMSTtI>v{)13m=8i%XffYf$9r%=HY zgnZ$0luI|Bx%{7vortDkxh^?*Ini0cc!q6~x32A4kf6eN4LGc{6owZ$KE!S94xQ{g z)IsC?uJ`O|ekJ_nXR0%I-)^p_s^;QH{s}XEY+ZApgQKaW;knXb)*f;Oaz)!1MPMbI zJ|5m8O6>e-r9j6?NiUmpI?6kI1o9LCnup})K@MDzQxB~7SK`3(m*D7P-%#+3l8Ko= z#v^b;8%XN<;4E%~QOx3D>ss_+3v$B|_<&b`MyudocIZus!jx#Ija!)2bGGAw-;&I_ zwgOrjxzp$+Z(Z+bOkew?gLv{xe1#qIM^eNcW+$b$l=BPJ*<@x0X##@LOzc- zCGy=xm#N1`3dTsHbyOG^|{%)5O3Y!$Up1- zNNouKY(Yf8+`ftR zBesN&WNUCYf7tm%(efY`b8--Itdi|ne$5!zbij1lb~9xqrV~ z;{YAuZU~jrI5OvJFP^T|zgic_;`^T;VJWS--?F?61ib}+Ao~F0e=g-Ym^)RQg;V$W MiZ_1$^WB~Q1DwlL7ytkO diff --git a/lispusers/PSEUDOHOSTS b/lispusers/PSEUDOHOSTS index 981afb63..ad69e0ed 100644 --- a/lispusers/PSEUDOHOSTS +++ b/lispusers/PSEUDOHOSTS @@ -1,14 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Jul-2023 09:17:48" {WMEDLEY}PSEUDOHOSTS.;153 27674 +(FILECREATED "22-Sep-2023 15:29:50" {WMEDLEY}PSEUDOHOSTS.;158 26638 :EDIT-BY rmk - :CHANGES-TO (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE) - (MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL) + :CHANGES-TO (FNS PSEUDOHOST SLASHIT CONTRACT.PH) (VARS PSEUDOHOSTSCOMS) - :PREVIOUS-DATE "18-Jul-2023 13:12:35" {WMEDLEY}PSEUDOHOSTS.;152) + :PREVIOUS-DATE "26-Jul-2023 12:34:37" {WMEDLEY}PSEUDOHOSTS.;155) (PRETTYCOMPRINT PSEUDOHOSTSCOMS) @@ -21,7 +20,7 @@ (* ;; "Internals") - (FNS EXPAND.PH CONTRACT.PH SLASHIT UNSLASHIT GETHOSTINFO.PH) + (FNS EXPAND.PH CONTRACT.PH UNSLASHIT GETHOSTINFO.PH) (FNS OPENFILE.PH GETFILENAME.PH DIRECTORYNAMEP.PH CLOSEFILE.PH REOPENFILE.PH DELETEFILE.PH OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH) @@ -42,6 +41,8 @@ (PSEUDOHOST [LAMBDA (HOST PREFIX) + (* ;; "Edited 22-Sep-2023 15:29 by rmk") + (* ;; "Edited 25-Jun-2022 17:00 by rmk") (* ;; "Edited 24-Feb-2022 23:56 by rmk: Expand prefix so that it is rooted in a real host and not a previously defined pseudohost.") @@ -81,7 +82,7 @@ (SELECTQ TARGETHOST ((DSK CORE) (SETQ PREFIX (UNSLASHIT PREFIX))) - (UNIX (SETQ PREFIX (SLASHIT PREFIX))) + (UNIX (SETQ PREFIX (SLASHIT PREFIX))) NIL) (SETQ TARGETDEVICE (OR (\GETDEVICEFROMHOSTNAME TARGETHOST) (ERROR "UNKNOWN TARGET HOST" TARGETHOST))) @@ -153,26 +154,32 @@ (FETCH (FDEV DEVICENAME) OF (FETCH (PHDEVICE TARGETDEV) OF (\GETDEVICEFROMNAME HOST))))]) (TRUEFILENAME - [LAMBDA (FILE) (* ; "Edited 26-Jan-2022 23:33 by rmk") + [LAMBDA (FILE) (* ; "Edited 26-Jul-2023 07:53 by rmk") + (* ; "Edited 26-Jan-2022 23:33 by rmk") (* ; "Edited 25-Jan-2022 08:47 by rmk") - (LET (FILENAME DEVICE) - (IF (STREAMP FILE) - THEN (SETQ FILENAME (FETCH (STREAM FULLFILENAME) OF FILE)) - (SETQ DEVICE (FETCH (STREAM DEVICE) OF FILE)) - ELSE (SETQ FILENAME (\ADD.CONNECTED.DIR FILE)) - (SETQ DEVICE (\GETDEVICEFROMNAME FILENAME))) - (CL:IF (TYPE? PHDEVICE DEVICE) - (EXPAND.PH FILENAME DEVICE) - FILENAME)]) + (if (LISTP FILE) + then (for F in FILE collect (TRUEFILENAME F)) + else (LET (FILENAME DEVICE) + (IF (STREAMP FILE) + THEN (SETQ FILENAME (FETCH (STREAM FULLFILENAME) OF FILE)) + (SETQ DEVICE (FETCH (STREAM DEVICE) OF FILE)) + ELSE (SETQ FILENAME (\ADD.CONNECTED.DIR FILE)) + (SETQ DEVICE (\GETDEVICEFROMNAME FILENAME))) + (CL:IF (TYPE? PHDEVICE DEVICE) + (EXPAND.PH FILENAME DEVICE) + FILENAME)]) (PSEUDOFILENAME - [LAMBDA (FILE) (* ; "Edited 29-Jan-2022 23:08 by rmk") + [LAMBDA (FILE) (* ; "Edited 26-Jul-2023 12:34 by rmk") + (* ; "Edited 29-Jan-2022 23:08 by rmk") (* ; "Edited 28-Jan-2022 09:06 by rmk") - (FOR D PN (FILENAME _ (IF (STREAMP FILE) - THEN (FETCH (STREAM FULLFILENAME) OF FILE) - ELSE (\ADD.CONNECTED.DIR FILE))) IN \FILEDEVICES - WHEN (TYPE? PHDEVICE D) UNLESS (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D))) - DO (RETURN PN) FINALLY (RETURN FILENAME]) + (if (LISTP FILE) + then (for F in FILE collect (PSEUDOFILENAME F)) + else (FOR D PN (FILENAME _ (IF (STREAMP FILE) + THEN (FETCH (STREAM FULLFILENAME) OF FILE) + ELSE (\ADD.CONNECTED.DIR FILE))) IN \FILEDEVICES + WHEN (TYPE? PHDEVICE D) UNLESS (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D))) + DO (RETURN PN) FINALLY (RETURN FILENAME]) ) @@ -209,6 +216,8 @@ (CONTRACT.PH [LAMBDA (NAME PHDEV) + (* ;; "Edited 22-Sep-2023 14:30 by rmk") + (* ;; "Edited 30-Jan-2022 00:20 by rmk: the smallest pseudoname for NAME. If the NAME was constructed by expanding, then") (* ;; "Finds the smallest pseudoname for NAME. The PHDEV is used only to find its targetdev, that's where we scan for matching prefixes. This is so we can find the lowest matching pseudohost in the target's prefix map. If the hosts are defined as {DSK}...{H1}...{H2}, DSK knows the prefixes that lead to H1 and H2, picks the longest matching prefix and replaces it by the corresponding host.") @@ -234,7 +243,7 @@ (SETQ CONNECTOR (CADDR PM)) [SETQ SUFFIX (CONCAT CONNECTOR (IF (EQ CONNECTOR '/) - THEN (SLASHIT SUFFIX) + THEN (SLASHIT SUFFIX) ELSE (UNSLASHIT SUFFIX]) (RETURN (PACK* '{ (CADR PM) "}" @@ -244,31 +253,6 @@ (RETURN NAME)))]) -(SLASHIT - [LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:08 by rmk") - (* ; "Edited 3-Jan-2022 11:44 by rmk") - (* ; "Edited 22-Dec-2021 20:18 by rmk") - (* ; "Edited 2-Nov-2021 22:54 by rmk:") - (LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X) - 0] - [SETQ SLASHED (CONCATCODES (FOR I C FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I)) - COLLECT (SELCHARQ C - ((< >) - (SETQ LASTDIRPOS I) - (CHARCODE /)) - (/ (SETQ LASTDIRPOS I) - C) - C] - (CL:WHEN (AND LCASEDIRS LASTDIRPOS) - (SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS))) - (SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS)) - (OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS)) - "")))) - (CL:IF (EQ DIRPOS 1) - SLASHED - (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS)) - SLASHED))]) - (UNSLASHIT [LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:09 by rmk") (* ; "Edited 22-Dec-2021 20:18 by rmk") @@ -527,13 +511,12 @@ EXPORTS.ALL) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1397 9433 (PSEUDOHOST 1407 . 6966) (PSEUDOHOSTP 6968 . 7481) (PSEUDOHOSTS 7483 . 7844) -(TARGETHOST 7846 . 8120) (TRUEFILENAME 8122 . 8809) (PSEUDOFILENAME 8811 . 9431)) (9461 17000 ( -EXPAND.PH 9471 . 10724) (CONTRACT.PH 10726 . 13391) (SLASHIT 13393 . 14961) (UNSLASHIT 14963 . 16709) -(GETHOSTINFO.PH 16711 . 16998)) (17001 25021 (OPENFILE.PH 17011 . 18084) (GETFILENAME.PH 18086 . 18375 -) (DIRECTORYNAMEP.PH 18377 . 19001) (CLOSEFILE.PH 19003 . 19470) (REOPENFILE.PH 19472 . 20037) ( -DELETEFILE.PH 20039 . 20323) (OPENP.PH 20325 . 20620) (UNREGISTERFILE.PH 20622 . 21164) ( -REGISTERFILE.PH 21166 . 21700) (GENERATEFILES.PH 21702 . 22746) (GETFILEINFO.PH 22748 . 23050) ( -SETFILEINFO.PH 23052 . 23251) (NEXTFILEFN.PH 23253 . 23799) (FILEINFOFN.PH 23801 . 24076) ( -RENAMEFILE.PH 24078 . 25019))))) + (FILEMAP (NIL (1315 9921 (PSEUDOHOST 1325 . 6930) (PSEUDOHOSTP 6932 . 7445) (PSEUDOHOSTS 7447 . 7808) +(TARGETHOST 7810 . 8084) (TRUEFILENAME 8086 . 9048) (PSEUDOFILENAME 9050 . 9919)) (9949 15964 ( +EXPAND.PH 9959 . 11212) (CONTRACT.PH 11214 . 13925) (UNSLASHIT 13927 . 15673) (GETHOSTINFO.PH 15675 . +15962)) (15965 23985 (OPENFILE.PH 15975 . 17048) (GETFILENAME.PH 17050 . 17339) (DIRECTORYNAMEP.PH +17341 . 17965) (CLOSEFILE.PH 17967 . 18434) (REOPENFILE.PH 18436 . 19001) (DELETEFILE.PH 19003 . 19287 +) (OPENP.PH 19289 . 19584) (UNREGISTERFILE.PH 19586 . 20128) (REGISTERFILE.PH 20130 . 20664) ( +GENERATEFILES.PH 20666 . 21710) (GETFILEINFO.PH 21712 . 22014) (SETFILEINFO.PH 22016 . 22215) ( +NEXTFILEFN.PH 22217 . 22763) (FILEINFOFN.PH 22765 . 23040) (RENAMEFILE.PH 23042 . 23983))))) STOP diff --git a/lispusers/PSEUDOHOSTS.LCOM b/lispusers/PSEUDOHOSTS.LCOM index 1560bf8fc0806e974871bbd164b002cb48e9fd20..2a4c82ce9a98ba9aabd8e65b586f9979219cb67d 100644 GIT binary patch delta 859 zcma))O=#0#7{`;=*_!D{p>#60^)WDM4=ruJ`f)K?^0v)PlhCA_Xq`-3a5%M8MPXp^ z?8Wg4-b6hLLRl$(;LX!+UOapEw3{FveA5r;V1hY>=gt3l-sk!K^ZZ`@tUTX{@_fo| zwNreC7a%JY`9e|3?A?~S`6Mvh5iwg7#A2qv!HrJq=Dj=Z?VVN=T94bE`zu9oTvXTX zitT!^eHXY=-85mkI-O2)(A;`JN{+iWD|1OEQ8G-V)sX5TJqAacPbS-43FU#8Wg(9@ z=|!$&xznv(Q*|qb2byhpHC6M{P6dCb6EV_KPOUxM8DsK3iICgdU7@9ZA@DBTl|V=9 zhK9fa5&SVMwdx-PD1iZ);in`}TPG=sR)YInL$RUOFYz^m2KWP0Lfo`(|Q0y#TQ0*S}3XSr4m z9E;G&pp&=sFJQu+hlYRO$Q+kA&uBSqXmbR_r>)vWdS*NHF-@vWb`C^E89S_$q!BUn0?qcp0bflST4UuI>>#C_} XcGV%)0D~K#;2zE5_Yfn=U*W@Fa?8^R delta 887 zcmZvb%WD%+6vk(gV&n9|1f!IaHpgg70!^BEQX$HnI06fQ zqX*gr;Io;mh-c_99*k%w8K;aUR9m;pZqk)YW5}J9O}tIVdj6s31c~Dt^bGz^pP~6( zzwdcqg98;!8VUjjQs5C-auI>i+Qfl6@1rO>2z359MV=R-{4wwSG4QGtF!!68N+W-% znH3-E2IJMSI!ndU89)_Bw$!AfgP4M8!q}Xu;YB9k6GVKqBLq1pyF`A`Azp|X&`1gJ z>DD1|8T_;(Dhc3Ngp~)Ctla;^pn(X}o{;8*vL~U9rf3%rb@pWZx___DVCl;(&PPUd zya75@e^Ov|UuEY96%$85u`RbGE3QY(^B&%*%pp7>*Tmz5-Th9(-&Z!}vTnE_sW~R* zKo%52ClDJwQk-CO;q3rL`IbFP@{M_W{+kP5gQtCZP;SR}*f2eXAG3*}bMt$L! zV4+H5uUU-}w||Ug@aKqtKlKZ}48&BVm~sh`zX6dum{;tgL%IQnBY9Fd9T~)TBQO5| Dc^uyj diff --git a/sources/HARDCOPY b/sources/HARDCOPY index f252f932..09eaff6e 100644 --- a/sources/HARDCOPY +++ b/sources/HARDCOPY @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "18-Oct-2022 18:47:42" {DSK}larry>ilisp>medley>sources>HARDCOPY.;2 103854 +(FILECREATED "22-Jun-2023 17:31:38" {WMEDLEY}HARDCOPY.;11 104907 - :CHANGES-TO (FNS HARDCOPYIMAGEW.TOPRINTER) + :EDIT-BY rmk - :PREVIOUS-DATE "20-Jul-2022 17:14:14" {DSK}larry>ilisp>medley>sources>HARDCOPY.;1) + :CHANGES-TO (FNS MakeMenuOfPrinters) + + :PREVIOUS-DATE " 3-Mar-2023 23:49:09" {WMEDLEY}HARDCOPY.;10) (* ; " @@ -46,7 +48,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (INITVARS (TEXTDEFAULTTABS (LIST 20320)) (TEXTDEFAULTPAGEREGION (CREATEREGION 2794 1905 18415 24765))) (* ; - "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches") + "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches. NOT USED ANYWHERE") (GLOBALVARS TEXTDEFAULTTABS TEXTDEFAULTPAGEREGION) (FNS TEXTTOIMAGEFILE COPY.TEXT.TO.IMAGE)) (COMS (FNS \BLTSHADE.GENERICPRINTER) @@ -62,7 +64,9 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. \HDCPYDSPPRINTCHAR \SLOWHDCPYBLTCHAR \CHANGECHARSET.HDCPYDISPLAY) [DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (CONSTANTS (MICASPERPT (FQUOTIENT 2540 72)) (IHALFMICASPERPT 17) - (IMICASPERPT 35] + (IMICASPERPT 35) + (DEFAULTTAB 36] + (* ; "screen-points: 1/2 inch") (DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (FUNCTIONS \MICASTOPTS))) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\HDCPYDISPLAYINIT] [COMS (* ; @@ -168,20 +172,24 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (DEFINEQ (MakeMenuOfPrinters - [LAMBDA (MENUTITLE) (* ; "Edited 29-May-93 14:18 by rmk:") - (* ; "Edited 11-Jul-90 13:35 by jds") + [LAMBDA (MENUTITLE) (* ; "Edited 22-Jun-2023 17:30 by rmk") + (* ; "Edited 29-May-93 14:18 by rmk:") + (* ; "Edited 11-Jul-90 13:35 by jds") (DECLARE (GLOBALVARS DEFAULTPRINTINGHOST)) (CREATE MENU ITEMS _ (APPEND (FOR P INSIDE DEFAULTPRINTINGHOST COLLECT (LIST (COND - ((LISTP P) - (IF (CADDR P) - THEN (CONCAT (CADR P) - " " - (CADDR P)) - ELSE (CADR P))) - (T P)) - (KWOTE P))) + ((LISTP P) + (IF (CADDR P) + THEN (CONCAT (CADR P) + " " + (CADDR P)) + ELSE (CADR P))) + (T (CL:IF (OR (NULL P) + (ZEROP (NCHARS P))) + "(Default printer)" + P))) + (KWOTE P))) (LIST (LIST "Other..." (KWOTE 'OTHER) "You will be prompted for a printer"))) TITLE _ MENUTITLE @@ -686,7 +694,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. -(* ; "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches") +(* ; "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches. NOT USED ANYWHERE") (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -729,7 +737,8 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (CLOSEF IMAGESTREAM])]) (COPY.TEXT.TO.IMAGE - [LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 20-Jul-2022 17:14 by rmk") + [LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 3-Mar-2023 23:46 by rmk") + (* ; "Edited 20-Jul-2022 17:14 by rmk") (* ; "Edited 8-Oct-2021 22:23 by rmk:") (* ; "Edited 10-Apr-95 21:23 by rmk:") @@ -741,7 +750,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (FONTARRAY (FONTMAPARRAY FONTS)) (MAXFONT (ARRAYSIZE FONTARRAY)) (INSTRM (GETSTREAM INFILE 'INPUT)) - DEFAULTTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP] + DEFTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP] (* ;;  "RMK: EOS function changed to NILL from ZERO. 0 in low-order bits is OK in UNICODE, when we switch") @@ -775,17 +784,19 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (\OUTCHAR IMAGESTREAM (CHARCODE ^T)) (RETURN)) - (* ;; "TEXTDEFAULTTABS is a hack, since it depends on the units of the stream. Should really be a property of the stream or imagetype, or defined in terms of standard scale") + (* ;; "DEFAULTTAB is now a constant defined here as 36 = 1/2 inch. Maybe that should be scaled by the stream's scale factor vis a vis points, not related to the current font. If you are tabbing for alignment, you wouldn't want it to be ragged based on what font one line is in compare to another. TEXTDEFAULTTAB is a hack that should be removed.") [SETQ FC (IF TABS THEN (OR (CAR (NTH TABS FC)) (ERROR "Undefined absolute tab number" FC)) - ELSE (TIMES FC (OR DEFAULTTAB - (SETQ DEFAULTTAB - (TIMES 8 (CHARWIDTH (CHARCODE SPACE) - (FONTCREATE (ELT FONTARRAY 1) - NIL NIL NIL IMAGESTREAM] + ELSE (TIMES FC (OR DEFTAB (SETQ DEFTAB + (TIMES 8 + (CHARWIDTH (CHARCODE SPACE) + (FONTCREATE (ELT FONTARRAY + 1) + NIL NIL NIL + IMAGESTREAM] (DSPXPOSITION FC IMAGESTREAM)) (NIL (\OUTCHAR IMAGESTREAM (CHARCODE ^F)) (* ; "EOS after ^F") @@ -912,15 +923,23 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (RPAQQ IMICASPERPT 35) +(RPAQQ DEFAULTTAB 36) + (CONSTANTS (MICASPERPT (FQUOTIENT 2540 72)) (IHALFMICASPERPT 17) - (IMICASPERPT 35)) + (IMICASPERPT 35) + (DEFAULTTAB 36)) ) (* "END EXPORTED DEFINITIONS") ) + + + +(* ; "screen-points: 1/2 inch") + (DECLARE%: DONTCOPY DOEVAL@COMPILE (* "FOLLOWING DEFINITIONS EXPORTED") (DEFMACRO \MICASTOPTS (MICAS) @@ -1083,40 +1102,40 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (PUTPROPS HARDCOPY COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1999 2018 2021 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6168 10934 (HARDCOPY.SOMEHOW 6178 . 7536) (HARDCOPYIMAGEW 7538 . 7690) ( -HARDCOPYIMAGEW.TOFILE 7692 . 8000) (HARDCOPYIMAGEW.TOPRINTER 8002 . 9249) (HARDCOPYREGION.TOFILE 9251 - . 9549) (HARDCOPYREGION.TOPRINTER 9551 . 10173) (COPY.WINDOW.TO.BITMAP 10175 . 10932)) (11006 21556 ( -MakeMenuOfPrinters 11016 . 12241) (PRINTERS.WHENSELECTEDFN 12243 . 13985) (MakeMenuOfImageTypes 13987 - . 14505) (GetNewPrinterFromUser 14507 . 14935) (PopUpWindowAndGetAtom 14937 . 16322) ( -PopUpWindowAndGetList 16324 . 17890) (NewPrinter 17892 . 18840) (GetPrinterName 18842 . 19122) ( -GetImageFile 19124 . 21411) (FetchDefaultPrinter 21413 . 21554)) (21591 22129 ( -ExtensionForPrintFileType 21601 . 21794) (PRINTFILETYPE.FROM.EXTENSION 21796 . 22127)) (22184 38568 ( -DEFAULTPRINTER 22194 . 22354) (CAN.PRINT.DIRECTLY 22356 . 22512) (CONVERT.FILE.TO.TYPE.FOR.PRINTER -22514 . 23558) (EMPRESS 23560 . 23873) (HARDCOPYW 23875 . 26835) (LISTFILES1 26837 . 27010) ( -PRINTER.BITMAPFILE 27012 . 27259) (PRINTER.BITMAPSCALE 27261 . 27526) (PRINTER.SCRATCH.FILE 27528 . -27651) (PRINTERPROP 27653 . 27836) (PRINTERSTATUS 27838 . 28027) (PRINTERTYPE 28029 . 30338) ( -PRINTERNAME 30340 . 30642) (PRINTFILEPROP 30644 . 30835) (PRINTFILETYPE 30837 . 32781) ( -\EXPECTED.FILE.TYPE 32783 . 33565) (SEND.FILE.TO.PRINTER 33567 . 38566)) (38569 43551 (PRINTERDEVICE -38579 . 43549)) (44366 52124 (TEXTTOIMAGEFILE 44376 . 46566) (COPY.TEXT.TO.IMAGE 46568 . 52122)) ( -52125 53260 (\BLTSHADE.GENERICPRINTER 52135 . 53258)) (53388 72140 (MAKEHARDCOPYSTREAM 53398 . 54402) -(UNMAKEHARDCOPYSTREAM 54404 . 55088) (HARDCOPYSTREAMTYPE 55090 . 55369) (\CHARWIDTH.HDCPYDISPLAY 55371 - . 55802) (\DSPFONT.HDCPYDISPLAY 55804 . 57209) (\DSPRIGHTMARGIN.HDCPYDISPLAY 57211 . 57788) ( -\DSPXPOSITION.HDCPYDISPLAY 57790 . 58051) (\DSPYPOSITION.HDCPYDISPLAY 58053 . 58314) ( -\STRINGWIDTH.HDCPYDISPLAY 58316 . 58823) (\STRINGWIDTH.HCPYDISPLAYAUX 58825 . 61157) (\HDCPYBLTCHAR -61159 . 63694) (\HDCPYDISPLAY.FIX.XPOS 63696 . 64116) (\HDCPYDISPLAY.FIX.YPOS 64118 . 64538) ( -\HDCPYDISPLAYINIT 64540 . 65317) (\HDCPYDSPPRINTCHAR 65319 . 67479) (\SLOWHDCPYBLTCHAR 67481 . 70984) -(\CHANGECHARSET.HDCPYDISPLAY 70986 . 72138)) (72550 72691 (\MICASTOPTS 72550 . 72691)) (72862 103159 ( -MAKEHARDCOPYMODESTREAM 72872 . 74781) (UNMAKEHARDCOPYMODESTREAM 74783 . 75861) (\BLTSHADE.HCPYMODE -75863 . 76310) (\BITBLT.HCPYMODE 76312 . 76934) (\BRUSHCONVERT.HCPYMODE 76936 . 77173) ( -\CHANGECHARSET.HCPYMODE 77175 . 78942) (\DASHINGCONVERT.HCPYMODE 78944 . 79207) (\CHARWIDTH.HCPYMODE -79209 . 79496) (\DRAWLINE.HCPYMODE 79498 . 79810) (\DRAWCURVE.HCPYMODE 79812 . 80241) ( -\DRAWCIRCLE.HCPYMODE 80243 . 80638) (\DRAWELLIPSE.HCPYMODE 80640 . 81152) (\DSPFONT.HCPYMODE 81154 . -82310) (\DSPLEFTMARGIN.HCPYMODE 82312 . 82896) (\DSPLINEFEED.HCPYMODE 82898 . 83308) ( -\DSPRIGHTMARGIN.HCPYMODE 83310 . 83939) (\DSPSPACEFACTOR.HCPYMODE 83941 . 84462) ( -\DSPXPOSITION.HCPYMODE 84464 . 85045) (\DSPYPOSITION.HCPYMODE 85047 . 85452) (\MOVETO.HCPYMODE 85454 - . 85606) (\FONTCREATE.HCPYMODE.PRESS 85608 . 86620) (\CREATECHARSET.HCPYMODE.PRESS 86622 . 87593) ( -\FONTCREATE.HCPYMODE.INTERPRESS 87595 . 88629) (\CREATECHARSET.HCPYMODE.INTERPRESS 88631 . 89619) ( -\STRINGWIDTH.HCPYMODE 89621 . 90055) (\HCPYMODEBLTCHAR 90057 . 93026) (\HCPYMODEDISPLAYINIT 93028 . -95959) (\HCPYMODEDSPPRINTCHAR 95961 . 98142) (\SLOWHCPYMODEBLTCHAR 98144 . 101658) (\SFFixY.HCPYMODE -101660 . 103157))))) + (FILEMAP (NIL (6322 11088 (HARDCOPY.SOMEHOW 6332 . 7690) (HARDCOPYIMAGEW 7692 . 7844) ( +HARDCOPYIMAGEW.TOFILE 7846 . 8154) (HARDCOPYIMAGEW.TOPRINTER 8156 . 9403) (HARDCOPYREGION.TOFILE 9405 + . 9703) (HARDCOPYREGION.TOPRINTER 9705 . 10327) (COPY.WINDOW.TO.BITMAP 10329 . 11086)) (11160 22017 ( +MakeMenuOfPrinters 11170 . 12702) (PRINTERS.WHENSELECTEDFN 12704 . 14446) (MakeMenuOfImageTypes 14448 + . 14966) (GetNewPrinterFromUser 14968 . 15396) (PopUpWindowAndGetAtom 15398 . 16783) ( +PopUpWindowAndGetList 16785 . 18351) (NewPrinter 18353 . 19301) (GetPrinterName 19303 . 19583) ( +GetImageFile 19585 . 21872) (FetchDefaultPrinter 21874 . 22015)) (22052 22590 ( +ExtensionForPrintFileType 22062 . 22255) (PRINTFILETYPE.FROM.EXTENSION 22257 . 22588)) (22645 39029 ( +DEFAULTPRINTER 22655 . 22815) (CAN.PRINT.DIRECTLY 22817 . 22973) (CONVERT.FILE.TO.TYPE.FOR.PRINTER +22975 . 24019) (EMPRESS 24021 . 24334) (HARDCOPYW 24336 . 27296) (LISTFILES1 27298 . 27471) ( +PRINTER.BITMAPFILE 27473 . 27720) (PRINTER.BITMAPSCALE 27722 . 27987) (PRINTER.SCRATCH.FILE 27989 . +28112) (PRINTERPROP 28114 . 28297) (PRINTERSTATUS 28299 . 28488) (PRINTERTYPE 28490 . 30799) ( +PRINTERNAME 30801 . 31103) (PRINTFILEPROP 31105 . 31296) (PRINTFILETYPE 31298 . 33242) ( +\EXPECTED.FILE.TYPE 33244 . 34026) (SEND.FILE.TO.PRINTER 34028 . 39027)) (39030 44012 (PRINTERDEVICE +39040 . 44010)) (44847 53086 (TEXTTOIMAGEFILE 44857 . 47047) (COPY.TEXT.TO.IMAGE 47049 . 53084)) ( +53087 54222 (\BLTSHADE.GENERICPRINTER 53097 . 54220)) (54350 73102 (MAKEHARDCOPYSTREAM 54360 . 55364) +(UNMAKEHARDCOPYSTREAM 55366 . 56050) (HARDCOPYSTREAMTYPE 56052 . 56331) (\CHARWIDTH.HDCPYDISPLAY 56333 + . 56764) (\DSPFONT.HDCPYDISPLAY 56766 . 58171) (\DSPRIGHTMARGIN.HDCPYDISPLAY 58173 . 58750) ( +\DSPXPOSITION.HDCPYDISPLAY 58752 . 59013) (\DSPYPOSITION.HDCPYDISPLAY 59015 . 59276) ( +\STRINGWIDTH.HDCPYDISPLAY 59278 . 59785) (\STRINGWIDTH.HCPYDISPLAYAUX 59787 . 62119) (\HDCPYBLTCHAR +62121 . 64656) (\HDCPYDISPLAY.FIX.XPOS 64658 . 65078) (\HDCPYDISPLAY.FIX.YPOS 65080 . 65500) ( +\HDCPYDISPLAYINIT 65502 . 66279) (\HDCPYDSPPRINTCHAR 66281 . 68441) (\SLOWHDCPYBLTCHAR 68443 . 71946) +(\CHANGECHARSET.HDCPYDISPLAY 71948 . 73100)) (73603 73744 (\MICASTOPTS 73603 . 73744)) (73915 104212 ( +MAKEHARDCOPYMODESTREAM 73925 . 75834) (UNMAKEHARDCOPYMODESTREAM 75836 . 76914) (\BLTSHADE.HCPYMODE +76916 . 77363) (\BITBLT.HCPYMODE 77365 . 77987) (\BRUSHCONVERT.HCPYMODE 77989 . 78226) ( +\CHANGECHARSET.HCPYMODE 78228 . 79995) (\DASHINGCONVERT.HCPYMODE 79997 . 80260) (\CHARWIDTH.HCPYMODE +80262 . 80549) (\DRAWLINE.HCPYMODE 80551 . 80863) (\DRAWCURVE.HCPYMODE 80865 . 81294) ( +\DRAWCIRCLE.HCPYMODE 81296 . 81691) (\DRAWELLIPSE.HCPYMODE 81693 . 82205) (\DSPFONT.HCPYMODE 82207 . +83363) (\DSPLEFTMARGIN.HCPYMODE 83365 . 83949) (\DSPLINEFEED.HCPYMODE 83951 . 84361) ( +\DSPRIGHTMARGIN.HCPYMODE 84363 . 84992) (\DSPSPACEFACTOR.HCPYMODE 84994 . 85515) ( +\DSPXPOSITION.HCPYMODE 85517 . 86098) (\DSPYPOSITION.HCPYMODE 86100 . 86505) (\MOVETO.HCPYMODE 86507 + . 86659) (\FONTCREATE.HCPYMODE.PRESS 86661 . 87673) (\CREATECHARSET.HCPYMODE.PRESS 87675 . 88646) ( +\FONTCREATE.HCPYMODE.INTERPRESS 88648 . 89682) (\CREATECHARSET.HCPYMODE.INTERPRESS 89684 . 90672) ( +\STRINGWIDTH.HCPYMODE 90674 . 91108) (\HCPYMODEBLTCHAR 91110 . 94079) (\HCPYMODEDISPLAYINIT 94081 . +97012) (\HCPYMODEDSPPRINTCHAR 97014 . 99195) (\SLOWHCPYMODEBLTCHAR 99197 . 102711) (\SFFixY.HCPYMODE +102713 . 104210))))) STOP diff --git a/sources/HARDCOPY.LCOM b/sources/HARDCOPY.LCOM index fa59fbbe6feefd39fadfdeb781be606d9a11ef7a..ace4369d8e170d5b702c796e511ecb2f70613252 100644 GIT binary patch delta 739 zcmaiy&rcIU6vx}CfGm(`EGi|jFB=0}k}W&4{XrKcEZr>ywm;|(Nr@&l?JCvMl5IH= z17}Z~G4bxj#7MGqg+#q@_o5g73S;nKyou9#P!khgCiCXyz4?6S&CJmWdio7LS=%MD zxV+sEi9}?OBn1;i4)Y-JmFDJFt!`GK*#I7P)>67==%q(DTFq^%Vz%azYEFx1vZdfG z#sT1XLjG`wtb}63qCPr{rV*Z@byVrPPbkBj z!+XA;zx1Ww<#OM3G4uE4i>rNfYPhxQ>0GNK@noFM>})IU^lw+ z;KY$reV)Tf!>GRTR%<7(R$KZBiUC(8*fFn^z$CCqUE)O^?)33uqNh+9pj+fo4VG+|$=vcXfY ZeVx%}>>&N{YK-pLeh%yeI4Ch z!}UV^1A;vLLR^D16|4e+T*Ey5LxXi)fR0g6GBVKhD$Rigrn!}&2@okMaN%)`7}nr3 zoV=Z}fyvl>vL#b8h?>Xb52QA~XZp$^e2$fYfiZyr2;{+}pd-uV@7%?KDa@PX_wV;f zVPaz3B+SH^4^rU+t=}=9540h%=d+Pv+!pU^XRUM$2lBE-ej4I~%<467hlcTaymuE|+z1KBjR6s#4vHXmGD%`{nQ ftMKH84Z@SBY|xwhd5g^CyBlPgL6UzrOkoEAp$5dg