Compare commits
16 Commits
medley-231
...
medley-231
| Author | SHA1 | Date | |
|---|---|---|---|
|
b2f750e549 | ||
|
8cf17ce950 | ||
|
008aff1d25 | ||
|
|
214cfb8674 | ||
|
|
2e7b88d0cc | ||
|
|
14fbff63cf | ||
|
|
bec32f475a | ||
|
6e845d747f | ||
|
|
459aeef74a | ||
|
|
19ceac6515 | ||
|
|
914604a6eb | ||
|
|
05f3ad19eb | ||
|
|
c62c183ae4 | ||
|
|
328d3f53cd | ||
|
|
5b90251210 | ||
|
|
713f2388c7 |
@@ -1,20 +1,22 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED " 3-Aug-2023 18:40:12" |{DSK}<home>frank>il>medley>gmedley>internal>MEDLEY-UTILS.;6| 10695
|
||||
(FILECREATED "16-Nov-2023 21:59:19" |{DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;2| 18962
|
||||
|
||||
:EDIT-BY "frank"
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (FNS MAKE-FULLER-DB MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)
|
||||
:CHANGES-TO (VARS OKLIBRARY OKLISPUSERS)
|
||||
|
||||
:PREVIOUS-DATE " 1-Aug-2023 22:43:13"
|
||||
|{DSK}<home>frank>il>medley>gmedley>internal>MEDLEY-UTILS.;5|)
|
||||
:PREVIOUS-DATE " 4-Nov-2023 15:23:16" |{DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;1|)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
|
||||
|
||||
(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)))
|
||||
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)
|
||||
(FNS BADFILE HCFILES PRETTYFILES)
|
||||
(INITVARS (HCFILES)
|
||||
(BADFILES))))
|
||||
(DEFINEQ
|
||||
|
||||
(GATHER-INFO
|
||||
@@ -137,12 +139,15 @@
|
||||
(POSTSCRIPTSTREAM CHATTERMINAL DMCHAT CHAT PRESS READNUMBER EDITBITMAP IMAGEOBJ TEDIT HRULE
|
||||
TABLEBROWSER FILEBROWSER GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MSCOMMON
|
||||
MASTERSCOPE UNIXCOMM UNIXPRINT UNICODE HASH CLIPBOARD UNIXCHAT VT100KP VTCHAT SKETCH
|
||||
SKETCHBMELT SCALEBITMAP SKETCHOBJ SKETCHEDIT SKETCHELEMENTS SKETCHOPS MATMULT SAMEDIR))
|
||||
SKETCHBMELT SCALEBITMAP SKETCHOBJ SKETCHEDIT SKETCHELEMENTS SKETCHOPS MATMULT SAMEDIR
|
||||
REMOTEVMEM ETHERRECORDS UNIXUTILS CHATDECLS BROWSER))
|
||||
|
||||
(RPAQQ OKLISPUSERS (THINFILES ISO8859IO DINFO HELPSYS MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE
|
||||
BACKGROUND-YIELD OBJECTWINDOW REGIONMANAGER COMPARETEXT EXAMINEDEFS
|
||||
COMPARESOURCES COMPAREDIRECTORIES PSEUDOHOSTS DATEFORMAT-EDITOR DOC-OBJECTS
|
||||
EQUATIONS BICLOCK FILEWATCH LIFE IDLEHAX GITFNS TMAX IMTOOLS))
|
||||
(RPAQQ OKLISPUSERS
|
||||
(THINFILES ISO8859IO DINFO HELPSYS MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE
|
||||
BACKGROUND-YIELD OBJECTWINDOW REGIONMANAGER COMPARETEXT EXAMINEDEFS COMPARESOURCES
|
||||
COMPAREDIRECTORIES PSEUDOHOSTS DATEFORMAT-EDITOR DOC-OBJECTS EQUATIONS BICLOCK
|
||||
FILEWATCH LIFE IDLEHAX GITFNS TMAX IMTOOLS EQUATIONFORMS UNBOXEDOPS TILED-SEDIT
|
||||
IDLEDEMO WDWHACKS BUTTONS PICK PAGEHOLD UNIXYCD))
|
||||
|
||||
(RPAQQ OKINTERNAL (MEDLEY-UTILS))
|
||||
(DEFINEQ
|
||||
@@ -176,8 +181,167 @@
|
||||
(RENAMEFILE HASHFILE (OR WHEREISFILE "whereis.hash"))
|
||||
(DRIBBLE))))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(BADFILE
|
||||
(LAMBDA NIL (* \; "Edited 20-Oct-2022 15:40 by lmm")
|
||||
(* \; "Edited 22-Jun-2022 09:40 by larry")
|
||||
(|pushnew| BADFILES *FILE*)
|
||||
(LET ((STR (OPENSTREAM "BADFILES.TXT" 'APPEND)))
|
||||
(SETFILEPTR STR -1)
|
||||
(PRINT *FILE* STR)
|
||||
(CLOSEF STR))
|
||||
(RETFROM (OR (STKPOS 'PRETTYFILES)
|
||||
'HCFILES))))
|
||||
|
||||
(HCFILES
|
||||
(LAMBDA (*FILE* DEST REDOFLG TOPDIRLEN)
|
||||
(DECLARE (SPECVARS *FILE*)
|
||||
(GLOBALVARS BADFILE)) (* \; "Edited 4-Nov-2023 11:14 by lmm")
|
||||
(* \; "Edited 20-Oct-2022 16:11 by lmm")
|
||||
(* \; "Edited 9-Aug-2022 20:44 by lmm")
|
||||
(|if| (NULL *FILE*)
|
||||
|then| (SETQ *FILE* MEDLEYDIR))
|
||||
(COND
|
||||
((LISTP *FILE*)
|
||||
(FOR X IN *FILE* DO (HCFILES X DEST REDOFLG TOPDIRLEN)))
|
||||
((DIRECTORYNAMEP *FILE*)
|
||||
|
||||
(* |;;| "canonicalize")
|
||||
|
||||
(SETQ *FILE* (DIRECTORYNAME *FILE*))
|
||||
(OR TOPDIRLEN (SETQ TOPDIRLEN (CL:LENGTH (FILENAMEFIELD.STRING *FILE* '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")
|
||||
|do| (|for| X |in| (DIRECTORY (CONCAT *FILE* "*." EXT ";*"))
|
||||
|do| (HCFILES X DEST REDOFLG TOPDIRLEN)))
|
||||
|
||||
(* |;;| " then deal with subdirs ")
|
||||
|
||||
(|for| X |in| (DIRECTORY (CONCAT *FILE* "*"))
|
||||
|when| (|for| SKIP |in| '(">." ">dinfo>") |always| (NOT (STRPOS SKIP (L-CASE X))))
|
||||
|when| (DIRECTORYNAMEP X) |do| (HCFILES X DEST REDOFLG TOPDIRLEN)))
|
||||
((SETQ *FILE* (INFILEP *FILE*))
|
||||
(LET* ((TF (UNPACKFILENAME.STRING *FILE*))
|
||||
(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 *FILE* "-> " PSFILE T)
|
||||
(CLOSEF (OPENTEXTSTREAM *FILE*))
|
||||
|elseif| (MEMBER *FILE* BADFILES)
|
||||
|then| (PRINTOUT T "Skipping " *FILE* " on BADFILES")
|
||||
|else| (PRINTOUT T "Converting " *FILE* " to " PSFILE "...")
|
||||
(TEDIT.FORMAT.HARDCOPY (SETQ TEXTSTREAM (OPENTEXTSTREAM *FILE*))
|
||||
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)))))
|
||||
|
||||
(PRETTYFILES
|
||||
(LAMBDA (*FILE* DEST REDOFLG TOPDIRLEN)
|
||||
(DECLARE (SPECVARS *FILE*)
|
||||
(GLOBALVARS BADFILES)) (* \; "Edited 20-Oct-2022 16:12 by lmm")
|
||||
(* \; "Edited 9-Aug-2022 20:44 by lmm")
|
||||
(|if| (NULL *FILE*)
|
||||
|then| (SETQ *FILE* MEDLEYDIR))
|
||||
(COND
|
||||
((DIRECTORYNAMEP *FILE*)
|
||||
|
||||
(* |;;| "canonicalize")
|
||||
|
||||
(SETQ *FILE* (DIRECTORYNAME *FILE*))
|
||||
(OR TOPDIRLEN (SETQ TOPDIRLEN (CL:LENGTH (FILENAMEFIELD.STRING *FILE* '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; ignore files with extensions for now\"*.LISP\" \"*.ILISP\"")
|
||||
|
||||
(|for| PAT |in| '("*.;") |do| (|for| X |in| (DIRECTORY (CONCAT *FILE* PAT))
|
||||
WHEN (NOT (DIRECTORYNAMEP X)) WHEN (INFILEP X)
|
||||
WHEN (CAR (OR (NLSETQ (LISPSOURCEFILEP X))
|
||||
(PROGN (PRINTOUT T "LISPSOURCEFILEP error" X)
|
||||
NIL)))
|
||||
|do| (PRETTYFILES X DEST REDOFLG TOPDIRLEN)))
|
||||
|
||||
(* |;;| " then deal with subdirs ")
|
||||
|
||||
(|for| X |in| (DIRECTORY (CONCAT *FILE* "*"))
|
||||
|when| (|for| SKIP IN '("clos" "cltl2" "rooms>" ".>")
|
||||
|always| (NOT (STRPOS SKIP (L-CASE X)))) |when| (DIRECTORYNAMEP X)
|
||||
|do| (PRETTYFILES X DEST REDOFLG TOPDIRLEN)))
|
||||
((AND (SETQ *FILE* (INFILEP *FILE*))
|
||||
(LISPSOURCEFILEP *FILE*))
|
||||
(LET* ((TF (UNPACKFILENAME.STRING *FILE*))
|
||||
(NAME (LISTGET TF 'NAME))
|
||||
(DIR (LISTGET TF 'DIRECTORY))
|
||||
(PSFILE (PACKFILENAME.STRING
|
||||
'EXTENSION "ps" 'NAME
|
||||
(|if| (EQ DEST T)
|
||||
|then| (* \; "with the source file")
|
||||
(CONCAT NAME ".pfi")
|
||||
|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))))
|
||||
(|if| (AND (NOT REDOFLG)
|
||||
(INFILEP PSFILE))
|
||||
|then| (* \; " do nothing")
|
||||
(PRINTOUT T PSFILE " already there" T)
|
||||
|elseif| (MEMBER *FILE* BADFILES)
|
||||
|then| (PRINTOUT T "Skipping " *FILE* " on BADFILES")
|
||||
|else| (PRINTOUT T "Converting " *FILE* " to " PSFILE "...")
|
||||
(CL:WITH-OPEN-STREAM (STR (OPENPOSTSCRIPTSTREAM PSFILE))
|
||||
(PRETTYFILEINDEX *FILE* NIL STR))
|
||||
(|printout| T " DONE" T))))
|
||||
(T (PRINTOUT T "no such file " T)))))
|
||||
)
|
||||
|
||||
(RPAQ? HCFILES )
|
||||
|
||||
(RPAQ? BADFILES )
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (679 7642 (GATHER-INFO 689 . 6217) (MAKE-FULLER-DB 6219 . 6997) (MEDLEY-FIX-LINKS 6999
|
||||
. 7396) (MEDLEY-FIX-DATES 7398 . 7640)) (8681 10672 (MAKE-EXPORTS-ALL 8691 . 9752) (MAKE-WHEREIS-HASH
|
||||
9754 . 10670)))))
|
||||
(FILEMAP (NIL (781 7744 (GATHER-INFO 791 . 6319) (MAKE-FULLER-DB 6321 . 7099) (MEDLEY-FIX-LINKS 7101
|
||||
. 7498) (MEDLEY-FIX-DATES 7500 . 7742)) (8923 10914 (MAKE-EXPORTS-ALL 8933 . 9994) (MAKE-WHEREIS-HASH
|
||||
9996 . 10912)) (10915 18894 (BADFILE 10925 . 11393) (HCFILES 11395 . 15280) (PRETTYFILES 15282 .
|
||||
18892)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 1-Oct-2023 20:53:05" {WMEDLEY}<library>PDFSTREAM.;54 13917
|
||||
(FILECREATED " 9-Oct-2023 00:42:25" {DSK}<home>frank>il>medley>gmedley>library>PDFSTREAM.;2 14029
|
||||
|
||||
:EDIT-BY rmk
|
||||
:CHANGES-TO (FNS SEE-PDF OPEN-PDF-STREAM PS-TO-PDF PDFCONVERTER)
|
||||
(VARS PDFSTREAMCOMS)
|
||||
|
||||
:CHANGES-TO (FNS SEE-PDF)
|
||||
|
||||
:PREVIOUS-DATE " 1-Oct-2023 15:29:33" {WMEDLEY}<library>PDFSTREAM.;53)
|
||||
:PREVIOUS-DATE " 1-Oct-2023 20:53:05" {DSK}<home>frank>il>medley>gmedley>library>PDFSTREAM.;1
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PDFSTREAMCOMS)
|
||||
@@ -39,12 +39,13 @@
|
||||
|
||||
(* ;; "Implementation of PDF streams")
|
||||
|
||||
(INITVARS (PDFCONVERTER 'ps2pdf))
|
||||
(INITVARS (PDFCONVERTER NIL))
|
||||
(* ; "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)))
|
||||
(FNS SEE-PDF)
|
||||
(FNS PDFCONVERTER)))
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
POSTSCRIPTSTREAM)
|
||||
@@ -132,7 +133,7 @@
|
||||
(* ;; "Implementation of PDF streams")
|
||||
|
||||
|
||||
(RPAQ? PDFCONVERTER 'ps2pdf)
|
||||
(RPAQ? PDFCONVERTER NIL)
|
||||
|
||||
|
||||
|
||||
@@ -166,9 +167,9 @@
|
||||
(* ;; "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"))
|
||||
else (CL:UNLESS (ASSOC (PDFCONVERTER)
|
||||
PDF-CONVERTER-TEMPLATES)
|
||||
(ERROR "A specified POSTSCRIPT-to-PDF converter cannot be found"))
|
||||
(SETQ FILE (OR (AND (NEQ FILE T)
|
||||
(OUTFILEP FILE))
|
||||
(ERROR "PDF target file not found" FILE)))
|
||||
@@ -216,6 +217,9 @@
|
||||
(SETQ PSFILE (FULLNAME (TRUEFILENAME PSFILE)))
|
||||
(CL:UNLESS (INFILEP PSFILE)
|
||||
(ERROR "NO PS FILE TO CONVERT"))
|
||||
(CL:UNLESS (ASSOC (PDFCONVERTER)
|
||||
PDF-CONVERTER-TEMPLATES)
|
||||
(ERROR "A specified POSTSCRIPT-to-PDF converter cannot be found"))
|
||||
(SETQ PDFFILE (if PDFFILE
|
||||
then (TRUEFILENAME PDFFILE)
|
||||
else (PACKFILENAME 'EXTENSION 'pdf 'BODY PSFILE)))
|
||||
@@ -237,10 +241,7 @@
|
||||
(ERRORFILE \, (SLASHIT (TRUEFILENAME
|
||||
ERRORFILE)
|
||||
NIL T)))
|
||||
(ASSOC (OR PDFCONVERTER
|
||||
(MKATOM (UNIX-GETENV
|
||||
"MEDLEY-PDFCONVERTER"
|
||||
)))
|
||||
(ASSOC (PDFCONVERTER)
|
||||
PDF-CONVERTER-TEMPLATES]
|
||||
|
||||
(* ;; "Now use Medley names")
|
||||
@@ -263,14 +264,21 @@
|
||||
[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.")
|
||||
(* ;; "Use the ShellOpener for this machine to open the PDF file outside of Medley")
|
||||
|
||||
(ShellCommand (CONCAT "open -a Preview " (UNIX-FILE-NAME (PACKFILENAME 'BODY PDFFILE 'EXTENSION
|
||||
'PDF)
|
||||
'INPUT])
|
||||
(ShellOpen (PACKFILENAME 'BODY PDFFILE 'EXTENSION 'PDF])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(PDFCONVERTER
|
||||
[LAMBDA NIL
|
||||
(SETQ PDFCONVERTER (OR PDFCONVERTER (MKATOM (UNIX-GETENV "MEDLEY-PDFCONVERTER"))
|
||||
(CAR (for TEMPLATE in PDF-CONVERTER-TEMPLATES
|
||||
thereis (ShellWhich (CAR TEMPLATE])
|
||||
)
|
||||
(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)))))
|
||||
(FILEMAP (NIL (3208 5822 (PDFFILEP 3218 . 4132) (PDF.HARDCOPYW 4134 . 4732) (PDF.TEXT 4734 . 5451) (
|
||||
PDF.TEDIT 5453 . 5820)) (6262 13322 (OPEN-PDF-STREAM 6272 . 8408) (CLOSE-PDF-STREAM 8410 . 9697) (
|
||||
PS-TO-PDF 9699 . 13320)) (13323 13721 (SEE-PDF 13333 . 13719)) (13722 14006 (PDFCONVERTER 13732 .
|
||||
14004)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 8-Oct-2023 15:06:52" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;15 14696
|
||||
(FILECREATED "13-Nov-2023 12:57:10" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;26 16663
|
||||
|
||||
:CHANGES-TO (FNS ShellOpen UNIX-FILE-NAME ShellBrowser ShellBrowse ShellOpener)
|
||||
(VARS UNIXUTILSCOMS)
|
||||
:CHANGES-TO (FNS ShellBrowser)
|
||||
|
||||
:PREVIOUS-DATE " 8-Oct-2023 02:35:47" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;14
|
||||
:PREVIOUS-DATE "11-Nov-2023 09:06:39" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;25
|
||||
)
|
||||
|
||||
|
||||
@@ -19,6 +18,8 @@
|
||||
(INITVARS (ShellBrowser)
|
||||
(ShellOpener))
|
||||
(FUNCTIONS ShellCommand ShellWhich)
|
||||
(ADDVARS (MEDLEY-INIT-VARS (ShellBrowser)
|
||||
(ShellOpener)))
|
||||
(FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME)
|
||||
(PROPS (UNIXUTILS FILETYPE))))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
@@ -54,6 +55,9 @@
|
||||
NIL)
|
||||
(T (SETFILEPTR S 0)
|
||||
(RSTRING S])
|
||||
|
||||
(ADDTOVAR MEDLEY-INIT-VARS (ShellBrowser)
|
||||
(ShellOpener))
|
||||
(DEFINEQ
|
||||
|
||||
(ShellBrowser
|
||||
@@ -76,7 +80,7 @@
|
||||
then
|
||||
(* ;; " Systems with git installed")
|
||||
|
||||
CMDPATH
|
||||
(CONCAT CMDPATH " web--browse")
|
||||
elseif (SETQ CMDPATH (ShellWhich "lynx"))
|
||||
then
|
||||
(* ;; " Systems with lynx installed")
|
||||
@@ -155,6 +159,7 @@
|
||||
|
||||
(* ;; " Returns T is all goes well; returns an error string if all does not go well")
|
||||
|
||||
(RANDSET T)
|
||||
(SETQ FilenameOrURL (MKSTRING FilenameOrURL))
|
||||
(if (OR (EQ (STRPOS "http://" (L-CASE FilenameOrURL))
|
||||
1)
|
||||
@@ -172,13 +177,42 @@
|
||||
T)
|
||||
else (CONCAT "Unable to find a browser to open: " FilenameOrURL)))
|
||||
else
|
||||
(LET ((OPENER (ShellOpener))
|
||||
(UNIXFILE (UNIX-FILE-NAME FilenameOrURL 'INPUT T)))
|
||||
(if (NOT UNIXFILE)
|
||||
then (CONCAT "File not found: " FilenameOrURL)
|
||||
elseif (NOT (STREQUAL OPENER "true"))
|
||||
then (CL:WITH-OPEN-STREAM
|
||||
(SHELLSTREAM (OPENSTREAM (CONCAT "{CORE}SHELLOUT" (RAND))
|
||||
(LET*
|
||||
((OPENER (ShellOpener))
|
||||
(FULLNAME (FULLNAME FilenameOrURL)))
|
||||
(if (NOT FULLNAME)
|
||||
then (CONCAT "File not found: " FilenameOrURL)
|
||||
elseif (STREQUAL OPENER "true")
|
||||
then (CONCAT "Unable to find a file opener to open: " FilenameOrURL)
|
||||
else (LET* ((VERSION.SPECIFIED (FILENAMEFIELD FilenameOrURL 'VERSION))
|
||||
(UNPACKED (UNPACKFILENAME.STRING FULLNAME))
|
||||
(NEWNAME (CONCAT (LISTGET UNPACKED 'NAME)
|
||||
"~"
|
||||
(LISTGET UNPACKED 'VERSION)
|
||||
"~"))
|
||||
(EXTENSION (LISTGET UNPACKED 'EXTENSION))
|
||||
[UNVERSIONED (LET (FN (UNPACKED (COPY UNPACKED)))
|
||||
(LISTPUT UNPACKED 'VERSION NIL)
|
||||
(LISTPUT UNPACKED 'HOST NIL)
|
||||
(SETQ FN (PACKFILENAME.STRING UNPACKED))
|
||||
(if (STREQUAL (SUBSTRING FN -1)
|
||||
".")
|
||||
then (SETQ FN (SUBSTRING UNIXFILE 1 -2)))
|
||||
(SETQ FN (SLASHIT FN]
|
||||
(UNVERSIONED.EXISTS (INFILEP (CONCAT "{UNIX}" UNVERSIONED)))
|
||||
(TMPDIR (CONCAT "/tmp/" (RAND 1000 9999)))
|
||||
(TARGETFILE.LISP (PACKFILENAME.STRING 'HOST "{UNIX}" 'DIRECTORY TMPDIR
|
||||
'NAME NEWNAME 'EXTENSION EXTENSION))
|
||||
(TARGETFILE.UNIX (SLASHIT (PACKFILENAME.STRING 'HOST NIL 'DIRECTORY TMPDIR
|
||||
'NAME NEWNAME 'EXTENSION EXTENSION)))
|
||||
(UNIXFILE NIL))
|
||||
(DECLARE (SPECVARS UNIXFILE))
|
||||
(if (OR VERSION.SPECIFIED (NOT UNVERSIONED.EXISTS))
|
||||
then (COPYFILE FULLNAME TARGETFILE.LISP)
|
||||
(SETQ UNIXFILE TARGETFILE.UNIX)
|
||||
else (SETQ UNIXFILE UNVERSIONED))
|
||||
(CL:WITH-OPEN-STREAM
|
||||
(SHELLSTREAM (OPENSTREAM (CONCAT "{CORE}SHELLOUT" (RAND 1000 9999))
|
||||
'BOTH))
|
||||
(ShellCommand (CONCAT OPENER " '" UNIXFILE "'"
|
||||
" >>/tmp/ShellOpener-warnings-$$.txt")
|
||||
@@ -197,8 +231,7 @@
|
||||
(CL:LOOP (PRINTCCODE (READCCODE SHELLSTREAM)
|
||||
STRINGSTREAM))
|
||||
OUT))
|
||||
OUTSTRING)))
|
||||
else (CONCAT "Unable to find a file opener to open: " FilenameOrURL])
|
||||
OUTSTRING])
|
||||
|
||||
(PROCESS-COMMAND
|
||||
[LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk")
|
||||
@@ -221,8 +254,8 @@
|
||||
|
||||
(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 SLASHED (CONCATCODES (for I C from DIRPOS while (SETQ C (NTHCHARCODE X I))
|
||||
collect (SELCHARQ C
|
||||
((< >)
|
||||
(SETQ LASTDIRPOS I)
|
||||
(CHARCODE /))
|
||||
@@ -285,7 +318,7 @@
|
||||
|
||||
(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1144 1517 (ShellCommand 1144 . 1517)) (1519 1916 (ShellWhich 1519 . 1916)) (1917 14618
|
||||
(ShellBrowser 1927 . 3675) (ShellBrowse 3677 . 4362) (ShellOpener 4364 . 6052) (ShellOpen 6054 . 9357)
|
||||
(PROCESS-COMMAND 9359 . 9972) (SLASHIT 9974 . 12016) (UNIX-FILE-NAME 12018 . 14616)))))
|
||||
(FILEMAP (NIL (1146 1519 (ShellCommand 1146 . 1519)) (1521 1918 (ShellWhich 1521 . 1918)) (2008 16585
|
||||
(ShellBrowser 2018 . 3790) (ShellBrowse 3792 . 4477) (ShellOpener 4479 . 6167) (ShellOpen 6169 . 11324
|
||||
) (PROCESS-COMMAND 11326 . 11939) (SLASHIT 11941 . 13983) (UNIX-FILE-NAME 13985 . 16583)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because one or more lines are too long
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 3-Oct-2022 12:03:37"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;252 128695
|
||||
(FILECREATED "29-Sep-2023 17:25:57" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;257 130870
|
||||
|
||||
:CHANGES-TO (FNS CDFILES)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "14-Aug-2022 12:13:45"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;250)
|
||||
:CHANGES-TO (FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS)
|
||||
|
||||
:PREVIOUS-DATE "28-Sep-2023 23:20:57" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;256)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -16,7 +16,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
|
||||
|
||||
(RPAQQ COMPAREDIRECTORIESCOMS
|
||||
(
|
||||
[
|
||||
(* ;; "Compare the contents of two directories.")
|
||||
|
||||
(FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS COMPAREDIRECTORIES.CANDIDATES
|
||||
@@ -25,7 +25,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(FNS CDFILES CDFILES.MATCH CDFILES.PATS)
|
||||
(FNS CDPRINT CDPRINT.HEADER CDPRINT.LINE CDPRINT.MAXWIDTHS CDPRINT.COLHEADERS CDPRINT.COLUMNS
|
||||
CDTEDIT)
|
||||
(FNS CDMAP CDENTRY CDSUBSET CDMERGE CDMERGE.COMMON)
|
||||
(FNS CDMAP CDENTRY CDSUBSET CDMERGE CDMERGE.COMMON CD.SORT)
|
||||
(FNS BINCOMP EOLTYPE EOLTYPE.SHOW)
|
||||
(RECORDS CDMAXNCHARS CDVALUE CDENTRY CDINFO)
|
||||
|
||||
@@ -56,7 +56,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
CDBROWSER-COPY CDBROWSER-DELETE-FILE CD-SWAPDIRS)
|
||||
(VARS CDTABLEBROWSER.MENUITEMS)
|
||||
(FILES (SYSLOAD)
|
||||
COMPARESOURCES COMPARETEXT))))
|
||||
COMPARESOURCES COMPARETEXT)
|
||||
(P (MOVD? 'NILL 'TEDIT.FILEDATE])
|
||||
|
||||
|
||||
|
||||
@@ -66,7 +67,9 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
|
||||
(COMPAREDIRECTORIES
|
||||
[LAMBDA (DIR1 DIR2 SELECT INCLUDEDFILES EXCLUDEDFILES USEDIRECTORYDATE OUTPUTFILE ALLVERSIONS
|
||||
FIXDIRECTORYDATES) (* ; "Edited 29-Mar-2022 11:50 by rmk")
|
||||
FIXDIRECTORYDATES) (* ; "Edited 29-Sep-2023 17:25 by rmk")
|
||||
(* ; "Edited 5-Apr-2023 10:12 by rmk")
|
||||
(* ; "Edited 29-Mar-2022 11:50 by rmk")
|
||||
(* ; "Edited 23-Feb-2022 21:10 by rmk")
|
||||
(* ; "Edited 4-Jan-2022 12:09 by rmk")
|
||||
(* ; "Edited 31-Oct-2021 11:01 by rmk:")
|
||||
@@ -120,7 +123,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(CDPRINT.HEADER DIR1 DIR2 SELECT DATE T)
|
||||
(PRINTOUT T " ... ")
|
||||
(SETQ INFOS1 (COMPAREDIRECTORIES.INFOS DIR1 INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH1
|
||||
USEDIRECTORYDATE))
|
||||
USEDIRECTORYDATE (MEMB 'AUTHOR SELECT)))
|
||||
(SETQ INFOS2 (COMPAREDIRECTORIES.INFOS DIR2 INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH2
|
||||
USEDIRECTORYDATE))
|
||||
|
||||
@@ -138,7 +141,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
|
||||
(SETQ CDENTRIES (SORT (CDENTRIES.SELECT (COMPAREDIRECTORIES.CANDIDATES INFOS1 INFOS2)
|
||||
SELECT)
|
||||
T))
|
||||
(FUNCTION CD.SORT)))
|
||||
(PRINTOUT T (LENGTH CDENTRIES)
|
||||
" entries" T)
|
||||
(REPLACE CDENTRIES OF CDVALUE WITH CDENTRIES)
|
||||
@@ -148,7 +151,9 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(RETURN (CDPRINT CDVALUE OUTPUTFILE NIL (MEMB 'AUTHOR SELECT])
|
||||
|
||||
(COMPAREDIRECTORIES.INFOS
|
||||
[LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH USEDIRECTORYDATE)
|
||||
[LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH USEDIRECTORYDATE INCLUDEAUTHOR)
|
||||
|
||||
(* ;; "Edited 29-Sep-2023 17:25 by rmk")
|
||||
|
||||
(* ;; "Edited 22-May-2022 14:17 by rmk")
|
||||
|
||||
@@ -176,7 +181,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
ELSE (SETFILEINFO STREAM 'CREATIONDATE LDATE)
|
||||
LDATE)))
|
||||
LENGTH _ (GETFILEINFO STREAM 'LENGTH)
|
||||
AUTHOR _ (GETFILEINFO STREAM 'AUTHOR)
|
||||
AUTHOR _ (AND INCLUDEAUTHOR (GETFILEINFO STREAM 'AUTHOR))
|
||||
TYPE _ TYPE
|
||||
EOL _ (EOLTYPE STREAM)))
|
||||
(CLOSEF? STREAM))
|
||||
@@ -322,7 +327,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
CDE])
|
||||
|
||||
(COMPAREDIRECTORIES.INFOS.TYPE
|
||||
[LAMBDA (FILE) (* ; "Edited 22-May-2022 14:27 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 28-Sep-2023 23:09 by rmk")
|
||||
(* ; "Edited 22-May-2022 14:27 by rmk")
|
||||
(* ; "Edited 25-Apr-2022 09:02 by rmk")
|
||||
(* ; "Edited 4-Jan-2022 13:10 by rmk")
|
||||
(* ; "Edited 12-Dec-2021 22:50 by rmk")
|
||||
@@ -330,9 +336,11 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(CL:MULTIPLE-VALUE-SETQ (TYPE DATE)
|
||||
(LISPFILETYPE FILE))
|
||||
(CL:UNLESS TYPE
|
||||
(SETQ TYPE (IF (PRINTFILETYPE FILE)
|
||||
ELSEIF (MEMB (FILENAMEFIELD FILE 'EXTENSION)
|
||||
'(TXT TEXT SH MD C))
|
||||
(SETQ TYPE (IF (SETQ DATE (TEDIT.FILEDATE FILE))
|
||||
THEN 'TEDIT
|
||||
ELSEIF (PRINTFILETYPE FILE)
|
||||
ELSE (MEMB (FILENAMEFIELD FILE 'EXTENSION)
|
||||
'(TXT TEXT SH MD C))
|
||||
THEN 'TEXT
|
||||
ELSE 'OTHER)))
|
||||
(CL:VALUES TYPE DATE])
|
||||
@@ -388,7 +396,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(DEFINEQ
|
||||
|
||||
(CDFILES
|
||||
[LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 3-Oct-2022 12:03 by rmk")
|
||||
[LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 17-Jun-2023 23:04 by rmk")
|
||||
(* ; "Edited 3-Oct-2022 12:03 by rmk")
|
||||
(* ; "Edited 25-Apr-2022 08:42 by rmk")
|
||||
(* ; "Edited 5-Mar-2022 15:05 by rmk")
|
||||
(* ; "Edited 16-Oct-2020 13:42 by rmk:")
|
||||
@@ -457,7 +466,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
|
||||
(* ;; "We enumerate all the files, checking to see that")
|
||||
|
||||
(FOR FULLNAME NAME EXT SUBDIR UNPACK THISDEPTH (STARTPOS _ (ADD1 (NCHARS DIR)))
|
||||
(FOR FULLNAME NAME EXT SUBDIR UNPACK THISDEPTH (STARTPOS _ (IPLUS 2 (NCHARS DIR)))
|
||||
IN (DIRECTORY ENUMPAT `(DEPTH ,DEPTH COLLECT)
|
||||
NIL
|
||||
(CL:IF ALLVERSIONS
|
||||
@@ -509,7 +518,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(ILEQ THISDEPTH (CADDDR P])
|
||||
|
||||
(CDFILES.PATS
|
||||
[LAMBDA (PATTERNS) (* ; "Edited 23-Dec-2021 17:02 by rmk")
|
||||
[LAMBDA (PATTERNS) (* ; "Edited 17-Jun-2023 23:36 by rmk")
|
||||
(* ; "Edited 23-Dec-2021 17:02 by rmk")
|
||||
|
||||
(* ;; "Returns (NAME EXT SUBDIR DEPTH) items where NAME or EXT may be the wildcard *, SD is the subdirectory (if any) and DEPTH is the number of / or > in the subdirectory")
|
||||
|
||||
@@ -519,38 +529,47 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
|
||||
(* * NIL 1)
|
||||
)
|
||||
ELSE (FOR P N E SD D UNPACK INSIDE PATTERNS
|
||||
JOIN (SETQ UNPACK (UNPACKFILENAME P))
|
||||
(SETQ SD (LISTGET UNPACK 'SUBDIRECTORY))
|
||||
ELSE (FOR P N E SD DEPTH UNPACK INSIDE PATTERNS
|
||||
JOIN (SETQ UNPACK (UNPACKFILENAME.STRING P)) (* ;
|
||||
"String so we can tell the difference between x and x.")
|
||||
[SETQ SD (MKATOM (LISTGET UNPACK 'SUBDIRECTORY]
|
||||
|
||||
(* ;; "Count the subdirectory depth")
|
||||
|
||||
[SETQ D (IF (EQ SD '*)
|
||||
THEN MAX.SMALLP
|
||||
ELSE (FOR I (CNT _ 1) FROM 1 DO (SELCHARQ (NTHCHARCODE SD I)
|
||||
((/ >)
|
||||
(ADD CNT 1))
|
||||
(NIL (RETURN CNT))
|
||||
NIL]
|
||||
[SETQ DEPTH (IF (EQ SD '*)
|
||||
THEN MAX.SMALLP
|
||||
ELSE (FOR I (CNT _ 1) FROM 1 DO (SELCHARQ (NTHCHARCODE SD I)
|
||||
((/ >)
|
||||
(ADD CNT 1))
|
||||
(NIL (RETURN CNT))
|
||||
NIL]
|
||||
(SETQ N (LISTGET UNPACK 'NAME))
|
||||
(SETQ N (if (NULL N)
|
||||
then '*
|
||||
elseif (NEQ 0 (NCHARS N))
|
||||
then (MKATOM N)))
|
||||
(SETQ E (LISTGET UNPACK 'EXTENSION))
|
||||
(IF [OR (AND (STRING.EQUAL N 'COM)
|
||||
(SETQ E (if (NULL E)
|
||||
then '*
|
||||
elseif (NEQ 0 (NCHARS E))
|
||||
then (MKATOM E)))
|
||||
(if [OR (AND (STRING.EQUAL N 'COM)
|
||||
(NULL E))
|
||||
(AND (STRING.EQUAL E 'COM)
|
||||
(MEMB N ' (* NIL)]
|
||||
THEN (FOR CE IN *COMPILED-EXTENSIONS* COLLECT (LIST '* CE SD D))
|
||||
THEN (FOR CE IN *COMPILED-EXTENSIONS* COLLECT (LIST '* CE SD DEPTH))
|
||||
ELSE (CONS (IF N
|
||||
THEN (LIST N E SD D)
|
||||
THEN (LIST N E SD DEPTH)
|
||||
ELSEIF E
|
||||
THEN
|
||||
|
||||
(* ;; "This is the case .XXX, which presumably identifies a dotted file. If this is supposed to be all files with extension XXX, it shoud be specified as *.XXX, the case above. So we move .E into the N field.")
|
||||
|
||||
(LIST (PACK* '%. E)
|
||||
NIL SD D)
|
||||
NIL SD DEPTH)
|
||||
ELSE `
|
||||
|
||||
(* * (\, SD) (\, D))
|
||||
(* * (\, SD) (\, DEPTH))
|
||||
])
|
||||
)
|
||||
(DEFINEQ
|
||||
@@ -881,7 +900,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
WHEN (APPLY* FN CDE) COLLECT CDE])
|
||||
|
||||
(CDMERGE
|
||||
[LAMBDA (CDVALUES) (* ; "Edited 24-Jan-2022 17:01 by rmk")
|
||||
[LAMBDA (CDVALUES) (* ; "Edited 5-Apr-2023 10:10 by rmk")
|
||||
(* ; "Edited 24-Jan-2022 17:01 by rmk")
|
||||
|
||||
(* ;; "This merges a collection of CDVALUES on different directories into a single CDVALUE with the union of the CDENTRIES, provided that they have the same selection criteria. The merged directories will be the minimal common prefix of all of the entries on each side, and the residual of the directory will be packed onto all the names.")
|
||||
|
||||
@@ -919,8 +939,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
"Merge the CDENTRIES with matchnames pulled back so that subdirectories show up")
|
||||
|
||||
(SETQ MERGEDENTRIES
|
||||
(SORT [FOR CDV NC1 _ (ADD1 (NCHARS DIR1))
|
||||
NC2 _ (ADD1 (NCHARS DIR2)) IN (CDR CDS)
|
||||
(SORT [FOR CDV (NC1 _ (ADD1 (NCHARS DIR1)))
|
||||
(NC2 _ (ADD1 (NCHARS DIR2))) IN (CDR CDS)
|
||||
JOIN (FOR CDE IN (FETCH CDENTRIES OF CDV)
|
||||
COLLECT (CREATE CDENTRY
|
||||
USING CDE MATCHNAME _
|
||||
@@ -933,7 +953,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
OF (FETCH INFO2
|
||||
OF CDE))
|
||||
NC2]
|
||||
T))
|
||||
(FUNCTION CD.SORT)))
|
||||
(CD.UPDATEWIDTHS (CREATE CDVALUE
|
||||
CDDIR1 _ DIR1
|
||||
CDDIR2 _ DIR2
|
||||
@@ -962,6 +982,19 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(L-CASECODE CY] DO (RETURN (CL:IF (EQ I 1)
|
||||
""
|
||||
(SUBSTRING DIRX 1 LASTDIRPOS))])
|
||||
|
||||
(CD.SORT
|
||||
[LAMBDA (ENTRY1 ENTRY2) (* ; "Edited 5-Apr-2023 10:15 by rmk")
|
||||
|
||||
(* ;; "Groups same file with different extensions together. FOO and FOO.LCOM together, even if FOO-FUM exists (hyphen comes before period).")
|
||||
|
||||
(LET ((M1 (FETCH MATCHNAME OF ENTRY1))
|
||||
(M2 (FETCH MATCHNAME OF ENTRY2))
|
||||
ORDER)
|
||||
(CL:IF [EQ 'EQUAL (SETQ ORDER (ALPHORDER (PACKFILENAME 'EXTENSION NIL 'BODY M1)
|
||||
(PACKFILENAME 'EXTENSION NIL 'BODY M2]
|
||||
(ALPHORDER M1 M2)
|
||||
ORDER)])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -2154,28 +2187,30 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
COMPARESOURCES COMPARETEXT)
|
||||
|
||||
(MOVD? 'NILL 'TEDIT.FILEDATE)
|
||||
(PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998
|
||||
2018 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2624 22181 (COMPAREDIRECTORIES 2634 . 7467) (COMPAREDIRECTORIES.INFOS 7469 . 10343) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 10345 . 13730) (CDENTRIES.SELECT 13732 . 18507) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 18509 . 19415) (MATCHNAME 19417 . 20097) (CD.INSURECDVALUE 20099 . 21713
|
||||
) (CD.UPDATEWIDTHS 21715 . 22179)) (22182 32000 (CDFILES 22192 . 28094) (CDFILES.MATCH 28096 . 29721)
|
||||
(CDFILES.PATS 29723 . 31998)) (32001 49822 (CDPRINT 32011 . 34528) (CDPRINT.HEADER 34530 . 35427) (
|
||||
CDPRINT.LINE 35429 . 38661) (CDPRINT.MAXWIDTHS 38663 . 42778) (CDPRINT.COLHEADERS 42780 . 44065) (
|
||||
CDPRINT.COLUMNS 44067 . 49187) (CDTEDIT 49189 . 49820)) (49823 58192 (CDMAP 49833 . 51265) (CDENTRY
|
||||
51267 . 51576) (CDSUBSET 51578 . 53017) (CDMERGE 53019 . 56873) (CDMERGE.COMMON 56875 . 58190)) (58193
|
||||
65731 (BINCOMP 58203 . 62492) (EOLTYPE 62494 . 65056) (EOLTYPE.SHOW 65058 . 65729)) (66259 78786 (
|
||||
FIND-UNCOMPILED-FILES 66269 . 69912) (FIND-UNSOURCED-FILES 69914 . 72298) (FIND-SOURCE-FILES 72300 .
|
||||
74038) (FIND-COMPILED-FILES 74040 . 75917) (FIND-UNLOADED-FILES 75919 . 76772) (FIND-LOADED-FILES
|
||||
76774 . 77202) (FIND-MULTICOMPILED-FILES 77204 . 78784)) (78787 87218 (CREATED-AS 78797 . 83594) (
|
||||
SOURCE-FOR-COMPILED-P 83596 . 86523) (COMPILE-SOURCE-DATE-DIFF 86525 . 87216)) (87219 97525 (
|
||||
FIX-DIRECTORY-DATES 87229 . 90222) (FIX-EQUIV-DATES 90224 . 91749) (COPY-COMPARED-FILES 91751 . 93572)
|
||||
(COPY-MISSING-FILES 93574 . 95731) (COMPILED-ON-SAME-SOURCE 95733 . 97523)) (97719 105557 (CDBROWSER
|
||||
97729 . 101656) (CDBROWSER.STRINGS 101658 . 105555)) (105719 107455 (CD.TABLEITEM 105729 . 105949) (
|
||||
CD.TABLEITEM.PRINTFN 105951 . 106150) (CD.TABLEITEM.COPYFN 106152 . 107210) (
|
||||
CDTABLEBROWSER.HEADING.REPAINTFN 107212 . 107453)) (107456 128111 (CDTABLEBROWSER.WHENSELECTEDFN
|
||||
107466 . 107934) (CD.COMMANDSELECTEDFN 107936 . 113037) (CD-MENUFN 113039 . 117350) (CD-COMPARE-FILES
|
||||
117352 . 120704) (CDBROWSER-COPY 120706 . 124375) (CDBROWSER-DELETE-FILE 124377 . 127590) (CD-SWAPDIRS
|
||||
127592 . 128109)))))
|
||||
(FILEMAP (NIL (2651 22769 (COMPAREDIRECTORIES 2661 . 7751) (COMPAREDIRECTORIES.INFOS 7753 . 10711) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 10713 . 14098) (CDENTRIES.SELECT 14100 . 18875) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 18877 . 20003) (MATCHNAME 20005 . 20685) (CD.INSURECDVALUE 20687 . 22301
|
||||
) (CD.UPDATEWIDTHS 22303 . 22767)) (22770 33392 (CDFILES 22780 . 28794) (CDFILES.MATCH 28796 . 30421)
|
||||
(CDFILES.PATS 30423 . 33390)) (33393 51214 (CDPRINT 33403 . 35920) (CDPRINT.HEADER 35922 . 36819) (
|
||||
CDPRINT.LINE 36821 . 40053) (CDPRINT.MAXWIDTHS 40055 . 44170) (CDPRINT.COLHEADERS 44172 . 45457) (
|
||||
CDPRINT.COLUMNS 45459 . 50579) (CDTEDIT 50581 . 51212)) (51215 60336 (CDMAP 51225 . 52657) (CDENTRY
|
||||
52659 . 52968) (CDSUBSET 52970 . 54409) (CDMERGE 54411 . 58395) (CDMERGE.COMMON 58397 . 59712) (
|
||||
CD.SORT 59714 . 60334)) (60337 67875 (BINCOMP 60347 . 64636) (EOLTYPE 64638 . 67200) (EOLTYPE.SHOW
|
||||
67202 . 67873)) (68403 80930 (FIND-UNCOMPILED-FILES 68413 . 72056) (FIND-UNSOURCED-FILES 72058 . 74442
|
||||
) (FIND-SOURCE-FILES 74444 . 76182) (FIND-COMPILED-FILES 76184 . 78061) (FIND-UNLOADED-FILES 78063 .
|
||||
78916) (FIND-LOADED-FILES 78918 . 79346) (FIND-MULTICOMPILED-FILES 79348 . 80928)) (80931 89362 (
|
||||
CREATED-AS 80941 . 85738) (SOURCE-FOR-COMPILED-P 85740 . 88667) (COMPILE-SOURCE-DATE-DIFF 88669 .
|
||||
89360)) (89363 99669 (FIX-DIRECTORY-DATES 89373 . 92366) (FIX-EQUIV-DATES 92368 . 93893) (
|
||||
COPY-COMPARED-FILES 93895 . 95716) (COPY-MISSING-FILES 95718 . 97875) (COMPILED-ON-SAME-SOURCE 97877
|
||||
. 99667)) (99863 107701 (CDBROWSER 99873 . 103800) (CDBROWSER.STRINGS 103802 . 107699)) (107863
|
||||
109599 (CD.TABLEITEM 107873 . 108093) (CD.TABLEITEM.PRINTFN 108095 . 108294) (CD.TABLEITEM.COPYFN
|
||||
108296 . 109354) (CDTABLEBROWSER.HEADING.REPAINTFN 109356 . 109597)) (109600 130255 (
|
||||
CDTABLEBROWSER.WHENSELECTEDFN 109610 . 110078) (CD.COMMANDSELECTEDFN 110080 . 115181) (CD-MENUFN
|
||||
115183 . 119494) (CD-COMPARE-FILES 119496 . 122848) (CDBROWSER-COPY 122850 . 126519) (
|
||||
CDBROWSER-DELETE-FILE 126521 . 129734) (CD-SWAPDIRS 129736 . 130253)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "22-May-2022 18:46:01"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>COMPARESOURCES.;128 39655
|
||||
(FILECREATED "17-Jun-2023 15:22:40" {WMEDLEY}<lispusers>COMPARESOURCES.;131 39663
|
||||
|
||||
:CHANGES-TO (FNS COMPARESOURCES CSBROWSER \CS.EXAMINE)
|
||||
(VARS COMPARESOURCESCOMS)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "12-May-2022 10:17:13"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>COMPARESOURCES.;123)
|
||||
:CHANGES-TO (FNS CSBROWSER \CS.COMPARE.MASTERS)
|
||||
|
||||
:PREVIOUS-DATE "22-May-2022 18:46:01" {WMEDLEY}<lispusers>COMPARESOURCES.;128)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -141,25 +140,26 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
'SAME])
|
||||
|
||||
(\CS.COMPARE.MASTERS
|
||||
[LAMBDA (BODYX BODYY DW?) (* ; "Edited 25-Feb-2022 18:02 by rmk")
|
||||
[LAMBDA (BODY1 BODY2 DW?) (* ; "Edited 17-Jun-2023 15:19 by rmk")
|
||||
(* ; "Edited 25-Feb-2022 18:02 by rmk")
|
||||
(* ; "Edited 18-Jan-2022 22:00 by rmk")
|
||||
(* ; "Edited 19-Dec-2021 21:05 by rmk")
|
||||
(* ; "Edited 5-Sep-2020 19:01 by rmk:")
|
||||
(* ; "Edited 15-Apr-88 14:41 by bvm")
|
||||
(DECLARE (USEDFREE DIFFERENCES COMPARESTREAM))
|
||||
(LET (YTHING XTHING PRED DIFS TMP)
|
||||
(SETQ BODYX (CL:REMOVE-IF (FUNCTION EDITDATE?)
|
||||
BODYX)) (* ;
|
||||
(LET (THING2 THING1 PRED DIFS TMP)
|
||||
(SETQ BODY1 (CL:REMOVE-IF (FUNCTION EDITDATE?)
|
||||
BODY1)) (* ;
|
||||
"We don't care about editdate comments")
|
||||
(SETQ BODYY (CL:REMOVE-IF (FUNCTION EDITDATE?)
|
||||
BODYY))
|
||||
(SETQ BODYX (\CS.FIXFNS BODYX))
|
||||
(SETQ BODYY (\CS.FIXFNS BODYY))
|
||||
(CL:WHEN (AND (SETQ XTHING (ASSOC 'DEFINE-FILE-INFO BODYX))
|
||||
(SETQ YTHING (ASSOC 'DEFINE-FILE-INFO BODYY))
|
||||
(\CS.COMPARE.DEFINE-FILE-INFO XTHING YTHING))
|
||||
(SETQ BODYX (REMOVE XTHING BODYX))
|
||||
(SETQ BODYY (REMOVE YTHING BODYY)))
|
||||
(SETQ BODY2 (CL:REMOVE-IF (FUNCTION EDITDATE?)
|
||||
BODY2))
|
||||
(SETQ BODY1 (\CS.FIXFNS BODY1))
|
||||
(SETQ BODY2 (\CS.FIXFNS BODY2))
|
||||
(CL:WHEN (AND (SETQ THING1 (ASSOC 'DEFINE-FILE-INFO BODY1))
|
||||
(SETQ THING2 (ASSOC 'DEFINE-FILE-INFO BODY2))
|
||||
(\CS.COMPARE.DEFINE-FILE-INFO THING1 THING2))
|
||||
(SETQ BODY1 (REMOVE THING1 BODY1))
|
||||
(SETQ BODY2 (REMOVE THING2 BODY2)))
|
||||
|
||||
(* ;; "These are for commonlispy definers")
|
||||
|
||||
@@ -168,18 +168,18 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
do
|
||||
(* ;; "handle definer based things")
|
||||
|
||||
(for DEFFER in DEFFERS WHEN [AND (SETQ XTHING (for X in BODYX collect X
|
||||
(for DEFFER in DEFFERS WHEN [AND (SETQ THING1 (for X in BODY1 collect X
|
||||
when (EQ (CAR X)
|
||||
DEFFER)))
|
||||
(SETQ YTHING (for X in BODYY collect X
|
||||
(SETQ THING2 (for X in BODY2 collect X
|
||||
when (EQ (CAR X)
|
||||
DEFFER]
|
||||
do
|
||||
(* ;; "Take out all of the THINGS we are about to do. ")
|
||||
|
||||
(SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING :TEST (FUNCTION EQUALALL)))
|
||||
(SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING :TEST (FUNCTION EQUALALL)))
|
||||
(CL:WHEN (SETQ DIFS (\CS.COMPARE.TYPES XTHING YTHING
|
||||
(SETQ BODY1 (CL:SET-DIFFERENCE BODY1 THING1 :TEST (FUNCTION EQUALALL)))
|
||||
(SETQ BODY2 (CL:SET-DIFFERENCE BODY2 THING2 :TEST (FUNCTION EQUALALL)))
|
||||
(CL:WHEN (SETQ DIFS (\CS.COMPARE.TYPES THING1 THING2
|
||||
(CONCAT (OR (CL:DOCUMENTATION TYPE 'DEFINE-TYPES)
|
||||
TYPE)
|
||||
" defined by " DEFFER)
|
||||
@@ -194,11 +194,11 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
(* ;; "These are for other filepkage types, as registered in COMPARESOURCETYPES")
|
||||
|
||||
[for TYPE in COMPARESOURCETYPES EACHTIME (SETQ PRED (fetch (CSTYPE PREDFN) of TYPE))
|
||||
WHEN [AND (SETQ XTHING (for X in BODYX collect X when (CL:FUNCALL PRED X)))
|
||||
(SETQ YTHING (for X in BODYY collect X when (CL:FUNCALL PRED X]
|
||||
do (SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING :TEST (FUNCTION EQUALALL)))
|
||||
(SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING :TEST (FUNCTION EQUALALL)))
|
||||
(CL:WHEN [SETQ DIFS (\CS.COMPARE.TYPES XTHING YTHING (OR (fetch (CSTYPE TITLE)
|
||||
WHEN [AND (SETQ THING1 (for X in BODY1 collect X when (CL:FUNCALL PRED X)))
|
||||
(SETQ THING2 (for X in BODY2 collect X when (CL:FUNCALL PRED X]
|
||||
do (SETQ BODY1 (CL:SET-DIFFERENCE BODY1 THING1 :TEST (FUNCTION EQUALALL)))
|
||||
(SETQ BODY2 (CL:SET-DIFFERENCE BODY2 THING2 :TEST (FUNCTION EQUALALL)))
|
||||
(CL:WHEN [SETQ DIFS (\CS.COMPARE.TYPES THING1 THING2 (OR (fetch (CSTYPE TITLE)
|
||||
of TYPE)
|
||||
(MKSTRING (fetch (CSTYPE
|
||||
FPKGTYPE)
|
||||
@@ -211,23 +211,23 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
((SETQ TMP (ASSOC TYPE DIFFERENCES))
|
||||
(NCONC TMP DIFS))
|
||||
(T (push DIFFERENCES (CONS TYPE DIFS])]
|
||||
(SETQ BODYY (CL:SET-DIFFERENCE BODYY (PROG1 BODYX
|
||||
(SETQ BODYX (CL:SET-DIFFERENCE
|
||||
BODYX BODYY :TEST
|
||||
(SETQ BODY2 (CL:SET-DIFFERENCE BODY2 (PROG1 BODY1
|
||||
(SETQ BODY1 (CL:SET-DIFFERENCE
|
||||
BODY1 BODY2 :TEST
|
||||
(FUNCTION EQUALALL))))
|
||||
:TEST
|
||||
(FUNCTION EQUALALL)))
|
||||
(COND
|
||||
((OR BODYX BODYY)
|
||||
((OR BODY1 BODY2)
|
||||
(printout CONTEXTSTREAM T "---Expressions:" T)
|
||||
(LET ((COMMENTX 0)
|
||||
(COMMENTY 0)) (* ; "Remove comments")
|
||||
[SETQ BODYX (for X in BODYX collect X unless (COND
|
||||
[SETQ BODY1 (for X in BODY1 collect X unless (COND
|
||||
((EQ (CAR X)
|
||||
COMMENTFLG)
|
||||
(add COMMENTX 1)
|
||||
T]
|
||||
[SETQ BODYY (for Y in BODYY collect Y unless (COND
|
||||
[SETQ BODY2 (for Y in BODY2 collect Y unless (COND
|
||||
((EQ (CAR Y)
|
||||
COMMENTFLG)
|
||||
(add COMMENTY 1)
|
||||
@@ -238,14 +238,14 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
(printout CONTEXTSTREAM .I1 COMMENTX " comments -> " .I1 COMMENTY " comments."
|
||||
T T)))
|
||||
[COND
|
||||
[BODYX (COND
|
||||
(BODYY (COMPARELISTS BODYX BODYY COMPARESTREAM)
|
||||
(\CS.EXAMINE BODYX BODYY NIL 'Expression))
|
||||
[BODY1 (COND
|
||||
(BODY2 (COMPARELISTS BODY1 BODY2 COMPARESTREAM)
|
||||
(\CS.EXAMINE BODY1 BODY2 NIL 'Expression))
|
||||
(T (printout COMPARESTREAM "These are not on File 2:" T)
|
||||
(FOR X IN BODYX DO (LVLPRINT X COMPARESTREAM 2 3)
|
||||
(FOR X IN BODY1 DO (LVLPRINT X COMPARESTREAM 2 3)
|
||||
(\CS.EXAMINE X NIL T NIL 'Expression]
|
||||
(BODYY (printout COMPARESTREAM "These are not on File 1:" T)
|
||||
(FOR Y IN BODYY DO (LVLPRINT Y COMPARESTREAM 2 3)
|
||||
(BODY2 (printout COMPARESTREAM "These are not on File 1:" T)
|
||||
(FOR Y IN BODY2 DO (LVLPRINT Y COMPARESTREAM 2 3)
|
||||
(\CS.EXAMINE NIL Y T NIL 'Expression]
|
||||
(OR (ASSOC 'Other DIFFERENCES)
|
||||
(push DIFFERENCES (LIST 'Other '--])
|
||||
@@ -622,7 +622,9 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(CSBROWSER
|
||||
[LAMBDA (FILEX FILEY DW? LABEL1 LABEL2 REGION IGNORECOMMENTS TITLE)
|
||||
[LAMBDA (FILE1 FILE2 DW? LABEL1 LABEL2 REGION IGNORECOMMENTS TITLE)
|
||||
|
||||
(* ;; "Edited 17-Jun-2023 15:21 by rmk")
|
||||
|
||||
(* ;; "Edited 22-May-2022 18:42 by rmk")
|
||||
|
||||
@@ -637,28 +639,29 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
(* ;; "Don't use the INFILEP value, because that might screw with capitalization that the caller prefers. If the file can be found that way, then lower functions will find it.")
|
||||
|
||||
(DECLARE (SPECVARS LABEL1 LABEL2))
|
||||
(SETQ FILEX (OR (STREAMP FILEX)
|
||||
(INFILEP FILEX)
|
||||
(FINDFILE FILEX NIL DIRECTORIES)
|
||||
(ERROR "FILE NOT FOUND" FILEX)))
|
||||
(SETQ FILEY (OR (STREAMP FILEY)
|
||||
(INFILEP FILEY)
|
||||
(FINDFILE FILEY NIL DIRECTORIES)
|
||||
(ERROR "FILE NOT FOUND" FILEY)))
|
||||
(CL:UNLESS (LISPSOURCEFILEP FILEX)
|
||||
(ERROR FILEX " is not a Medley source file"))
|
||||
(CL:UNLESS (LISPSOURCEFILEP FILEY)
|
||||
(ERROR FILEX " is not a Medley source file"))
|
||||
(SETQ FILE1 (OR (STREAMP FILE1)
|
||||
(INFILEP FILE1)
|
||||
(FINDFILE FILE1 NIL DIRECTORIES)
|
||||
(ERROR "FILE NOT FOUND" FILE1)))
|
||||
(SETQ FILE2 (OR (STREAMP FILE2)
|
||||
(INFILEP FILE2)
|
||||
(FINDFILE FILE2 NIL DIRECTORIES)
|
||||
(ERROR "FILE NOT FOUND" FILE2)))
|
||||
(CL:UNLESS (LISPSOURCEFILEP FILE1)
|
||||
(ERROR FILE1 " is not a Medley source file"))
|
||||
(CL:UNLESS LABEL1
|
||||
(SETQ LABEL1 (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY FILE1)))
|
||||
(CL:UNLESS LABEL2
|
||||
(SETQ LABEL2 (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY FILE2)))
|
||||
(CL:UNLESS (LISPSOURCEFILEP FILE2)
|
||||
(ERROR FILE1 " is not a Medley source file"))
|
||||
(CL:UNLESS TITLE
|
||||
[SETQ TITLE (CONCAT "COMPARESOURCES of " (OR LABEL1 (PACKFILENAME 'HOST NIL 'DIRECTORY NIL
|
||||
'BODY FILEX))
|
||||
" and "
|
||||
(OR LABEL2 (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY FILEY])
|
||||
(SETQ TITLE (CONCAT "COMPARESOURCES of " LABEL1 " and " LABEL2)))
|
||||
(LET [(WINDOW (OBJ.CREATEW 'VERTICAL REGION TITLE NIL T (FONTPROP DEFAULTFONT 'HEIGHT]
|
||||
(WINDOWPROP WINDOW 'UNDERSCONTRUCTION T)
|
||||
(GETPROMPTWINDOW WINDOW T)
|
||||
(WINDOWPROP WINDOW 'UNDERSCONTRUCTION NIL)
|
||||
(COMPARESOURCES FILEX FILEY '(T 2WINDOWS)
|
||||
(COMPARESOURCES FILE1 FILE2 '(T 2WINDOWS)
|
||||
DW? WINDOW IGNORECOMMENTS LABEL1 LABEL2)
|
||||
(OPENW WINDOW)
|
||||
WINDOW])
|
||||
@@ -679,16 +682,16 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS COMPARESOURCES COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 2018 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1864 25616 (COMPARESOURCES 1874 . 8001) (\CS.COMPARE.MASTERS 8003 . 15415) (
|
||||
\CS.COMPARE.TYPES 15417 . 18683) (\CS.EXAMINE 18685 . 21863) (\CS.FIXFNS 21865 . 23367) (
|
||||
\CS.SORT.DECLARES 23369 . 23712) (\CS.SORT.DECLARE1 23714 . 25134) (\CS.FILTER.GARBAGE 25136 . 25614))
|
||||
(25617 30153 (\CS.ISFNFORM 25627 . 25895) (\CS.COMPARE.FNS 25897 . 26139) (\CS.FNSID 26141 . 26285) (
|
||||
\CS.ISVARFORM 26287 . 26392) (\CS.COMPARE.VARS 26394 . 27056) (\CS.ISMACROFORM 27058 . 27196) (
|
||||
\CS.ISRECFORM 27198 . 27526) (\CS.REC.NAME 27528 . 27847) (\CS.ISCOURIERFORM 27849 . 27949) (
|
||||
\CS.ISTEMPLATEFORM 27951 . 28049) (\CS.COMPARE.TEMPLATES 28051 . 28416) (\CS.ISPROPFORM 28418 . 28573)
|
||||
(\CS.PROP.NAME 28575 . 28720) (\CS.COMPARE.PROPS 28722 . 28879) (\CS.ISADDVARFORM 28881 . 28974) (
|
||||
\CS.COMPARE.ADDVARS 28976 . 29141) (\CS.ISFPKGCOMFORM 29143 . 29350) (\CS.COMPARE.FPKGCOMS 29352 .
|
||||
29559) (\CS.COMPARE.DEFINE-FILE-INFO 29561 . 30151)) (30154 36218 (CSOBJ.CREATE 30164 . 30577) (
|
||||
CSOBJ.DISPLAYFN 30579 . 31332) (CSOBJ.IMAGEBOXFN 31334 . 33495) (CSOBJ.BUTTONEVENTINFN 33497 . 35968)
|
||||
(CSOBJ.COPYBUTTONEVENTINFN 35970 . 36216)) (37099 39228 (CSBROWSER 37109 . 39226)))))
|
||||
(FILEMAP (NIL (1751 25612 (COMPARESOURCES 1761 . 7888) (\CS.COMPARE.MASTERS 7890 . 15411) (
|
||||
\CS.COMPARE.TYPES 15413 . 18679) (\CS.EXAMINE 18681 . 21859) (\CS.FIXFNS 21861 . 23363) (
|
||||
\CS.SORT.DECLARES 23365 . 23708) (\CS.SORT.DECLARE1 23710 . 25130) (\CS.FILTER.GARBAGE 25132 . 25610))
|
||||
(25613 30149 (\CS.ISFNFORM 25623 . 25891) (\CS.COMPARE.FNS 25893 . 26135) (\CS.FNSID 26137 . 26281) (
|
||||
\CS.ISVARFORM 26283 . 26388) (\CS.COMPARE.VARS 26390 . 27052) (\CS.ISMACROFORM 27054 . 27192) (
|
||||
\CS.ISRECFORM 27194 . 27522) (\CS.REC.NAME 27524 . 27843) (\CS.ISCOURIERFORM 27845 . 27945) (
|
||||
\CS.ISTEMPLATEFORM 27947 . 28045) (\CS.COMPARE.TEMPLATES 28047 . 28412) (\CS.ISPROPFORM 28414 . 28569)
|
||||
(\CS.PROP.NAME 28571 . 28716) (\CS.COMPARE.PROPS 28718 . 28875) (\CS.ISADDVARFORM 28877 . 28970) (
|
||||
\CS.COMPARE.ADDVARS 28972 . 29137) (\CS.ISFPKGCOMFORM 29139 . 29346) (\CS.COMPARE.FPKGCOMS 29348 .
|
||||
29555) (\CS.COMPARE.DEFINE-FILE-INFO 29557 . 30147)) (30150 36214 (CSOBJ.CREATE 30160 . 30573) (
|
||||
CSOBJ.DISPLAYFN 30575 . 31328) (CSOBJ.IMAGEBOXFN 31330 . 33491) (CSOBJ.BUTTONEVENTINFN 33493 . 35964)
|
||||
(CSOBJ.COPYBUTTONEVENTINFN 35966 . 36212)) (37095 39236 (CSBROWSER 37105 . 39234)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Jul-2022 11:05:08"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>EXAMINEDEFS.;40 12957
|
||||
(FILECREATED "13-Oct-2023 11:18:04" {WMEDLEY}<lispusers>EXAMINEDEFS.;48 14244
|
||||
|
||||
:CHANGES-TO (FNS EXAMINEDEFS)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "24-Jun-2022 18:52:03"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>EXAMINEDEFS.;39)
|
||||
:CHANGES-TO (FNS EXAMINEDEFS TEDITDEF)
|
||||
|
||||
:PREVIOUS-DATE "19-Jul-2023 13:59:26" {WMEDLEY}<lispusers>EXAMINEDEFS.;44)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT EXAMINEDEFSCOMS)
|
||||
@@ -19,49 +19,66 @@
|
||||
(DEFINEQ
|
||||
|
||||
(EXAMINEDEFS
|
||||
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 9-Jul-2022 11:04 by rmk")
|
||||
(* ; "Edited 24-Jun-2022 18:51 by rmk")
|
||||
(* ; "Edited 23-Jun-2022 17:58 by rmk")
|
||||
(* ; "Edited 25-Feb-2022 15:01 by rmk")
|
||||
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 13-Oct-2023 11:11 by rmk")
|
||||
(* ; "Edited 18-May-2023 22:35 by rmk")
|
||||
(* ; "Edited 21-Apr-2023 14:42 by rmk")
|
||||
|
||||
(* ;; "This provides for side-by-side examination of separate but presumably related expressions. The (LISTP) expressions can be provided directly as SOURCE1 and SOURCE2 or, if NAME is given the copies of the definitions of NAME as TYPE on the two sources are examined.")
|
||||
(* ;; "This provides for side-by-side examination of separate but presumably related expressions. The (LISTP) expressions can be provided directly as the definitions SOURCE1 and SOURCE2 or, if NAME is given the copies of the definitions of NAME as TYPE on the two sources are examined. If both SOURCE1 and SOURCE2 are NIL, then SOURCE1 is the existing file defintions, NIL is the existing in-memory definition")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Examination is in side-by-side attached SEDIT windows if SEDIT is the EDITMODE. You can use SEDIT operations to zoom in on the location of any changes, deleting common stuff for example. But you are always working on a copy, so that changes are safe and ephemeral. This is an examination, not an edit.")
|
||||
|
||||
(CL:UNLESS NAME
|
||||
(CL:UNLESS (LISTP SOURCE1)
|
||||
(ERROR SOURCE1 " cannot be examined"))
|
||||
(CL:UNLESS (LISTP SOURCE2)
|
||||
(ERROR SOURCE2 " cannot be examined")))
|
||||
(CL:UNLESS TYPE
|
||||
(SETQ TYPE 'FNS))
|
||||
(if NAME
|
||||
then (CL:UNLESS [OR SOURCE1 SOURCE2 (SETQ SOURCE2 (CAR (WHEREIS NAME
|
||||
(OR TYPE '(FNS FUNCTIONS))
|
||||
T]
|
||||
(ERROR (CONCAT "Can't find " NAME " definitions to examine")))
|
||||
else (CL:UNLESS (LISTP SOURCE1)
|
||||
(ERROR SOURCE1 " cannot be examined"))
|
||||
(CL:UNLESS (LISTP SOURCE2)
|
||||
(ERROR SOURCE2 " cannot be examined")))
|
||||
|
||||
(* ;; "TITLE1 and TITLE2 are optional strings that will be used to construct the titles of the SEDIT windows. We would like to know where GETDEF got the definition so we can use that, but there isn't an interface that provides that information (extended WHEREIS?)")
|
||||
|
||||
(LET (DEF1 DEF2)
|
||||
(SETQ DEF1 (IF (LISTP SOURCE1)
|
||||
THEN
|
||||
(* ;; "Copy to simulate READONLY")
|
||||
(* ;; "")
|
||||
|
||||
(SETQ DEF1 (COPY SOURCE1))
|
||||
ELSEIF (GETDEF NAME TYPE SOURCE1)
|
||||
ELSE (ERROR NAME " not found on " SOURCE1)))
|
||||
(SETQ DEF2 (IF (LISTP SOURCE2)
|
||||
THEN (COPY SOURCE2)
|
||||
ELSEIF (GETDEF NAME TYPE SOURCE2)
|
||||
ELSE (ERROR NAME " not found on " SOURCE2)))
|
||||
(* ;; "If SOURCE1 and SOURCE2 are both NIL, SOURCE1 defaults to the current (in memory) definition, SOURCE2 defaults to the definition on the current file.")
|
||||
|
||||
(LET (DEF1 DEF2)
|
||||
(if (SETQ DEF1 (LISTP SOURCE1))
|
||||
elseif TYPE
|
||||
then (NEQ (SETQ DEF1 (GETDEF NAME TYPE SOURCE1 'NOERROR))
|
||||
(FILEPKGTYPE TYPE 'NULLDEF))
|
||||
elseif (NEQ (SETQ DEF1 (GETDEF NAME (SETQ TYPE 'FNS)
|
||||
SOURCE1
|
||||
'NOERROR))
|
||||
(FILEPKGTYPE TYPE 'NULLDEF))
|
||||
elseif (NEQ (SETQ DEF1 (GETDEF NAME (SETQ TYPE 'FUNCTIONS)
|
||||
SOURCE1
|
||||
'NOERROR))
|
||||
(FILEPKGTYPE TYPE 'NULLDEF))
|
||||
else (ERROR NAME (CONCAT "not found on " SOURCE1)))
|
||||
(if (SETQ DEF2 (LISTP SOURCE2))
|
||||
elseif (NEQ (SETQ DEF2 (GETDEF NAME TYPE SOURCE2 'NOERROR))
|
||||
(FILEPKGTYPE TYPE 'NULLDEF))
|
||||
else (ERROR NAME (CONCAT "not found on " SOURCE2)))
|
||||
(CL:UNLESS TITLE1
|
||||
(SETQ TITLE1 (CL:IF (AND SOURCE1 (ILEQ (COUNT SOURCE1)
|
||||
5))
|
||||
SOURCE1
|
||||
"File 1")))
|
||||
(SETQ TITLE1 (OR (AND (OR (LISTP SOURCE1)
|
||||
(NULL SOURCE1))
|
||||
'Current)
|
||||
(AND (MEMB (U-CASE SOURCE1)
|
||||
'(PROP SAVED))
|
||||
'Saved)
|
||||
(FINDFILE SOURCE1)
|
||||
SOURCE1)))
|
||||
(CL:UNLESS TITLE2
|
||||
(SETQ TITLE2 (CL:IF (AND SOURCE2 (ILEQ (COUNT SOURCE2)
|
||||
5))
|
||||
SOURCE2
|
||||
"File 2")))
|
||||
(SETQ TITLE2 (OR (AND (OR (LISTP SOURCE2)
|
||||
(NULL SOURCE2))
|
||||
'Current)
|
||||
(AND (MEMB (U-CASE SOURCE2)
|
||||
'(PROP SAVED))
|
||||
'Saved)
|
||||
(FINDFILE SOURCE2)
|
||||
SOURCE2)))
|
||||
(SELECTQ (EDITMODE)
|
||||
(SEDIT:SEDIT
|
||||
(* ;;
|
||||
@@ -80,7 +97,9 @@
|
||||
"Crude suggestions for height, width, position. Suggest shorter window for smaller structures")
|
||||
|
||||
(SELECTQ EXAMINEWITH
|
||||
(SEDIT (CL:UNLESS (REGIONP REGION)
|
||||
(SEDIT (SETQ DEF1 (COPY DEF1)) (* ; "Copy to simulate read-only")
|
||||
(SETQ DEF2 (COPY DEF2))
|
||||
(CL:UNLESS (REGIONP REGION)
|
||||
(SETQ REGION (GETREGION)))
|
||||
[LET (R1 R2 HALFWIDTH W1 W2)
|
||||
(SETQ HALFWIDTH (IQUOTIENT (FETCH (REGION WIDTH)
|
||||
@@ -139,15 +158,14 @@
|
||||
(CONCAT "Compare sources of " NAME
|
||||
" as " TYPE)
|
||||
TEXTWIDTH TEXTHEIGHT))
|
||||
(WINDOWPROP CTWINDOW 'EXAMINEDEFS
|
||||
(LIST NAME TYPE SOURCE1 SOURCE2 TITLE1
|
||||
TITLE2)))])
|
||||
(WINDOWPROP CTWINDOW 'EXAMINEDEFS KEY))])
|
||||
(SHOULDNT)))
|
||||
(PROGN (EDITE DEF1)
|
||||
(EDITE DEF2])
|
||||
|
||||
(EXAMINEFILES
|
||||
[LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 1-Feb-2022 23:15 by rmk")
|
||||
[LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 19-Jul-2023 13:48 by rmk")
|
||||
(* ; "Edited 1-Feb-2022 23:15 by rmk")
|
||||
(* ; "Edited 25-Jan-2022 10:08 by rmk")
|
||||
(* ; "Edited 2-Jan-2022 23:15 by rmk")
|
||||
(* ; "Edited 30-Dec-2021 21:49 by rmk")
|
||||
@@ -156,23 +174,26 @@
|
||||
|
||||
(CL:UNLESS REGION
|
||||
(SETQ REGION (GETREGION)))
|
||||
(LIST (AND FILE1 (TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1)
|
||||
REGION
|
||||
'RIGHT
|
||||
'TOP
|
||||
`(,REGION 0.5)
|
||||
(FETCH (REGION TOP) OF REGION))
|
||||
NIL TITLE1))
|
||||
(AND FILE2 (TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1)
|
||||
REGION
|
||||
'LEFT
|
||||
'TOP
|
||||
`(,REGION 0.5)
|
||||
(FETCH (REGION TOP) OF REGION))
|
||||
NIL TITLE2])
|
||||
(LIST (AND (INFILEP FILE1)
|
||||
(TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1)
|
||||
REGION
|
||||
'RIGHT
|
||||
'TOP
|
||||
`(,REGION 0.5)
|
||||
(FETCH (REGION TOP) OF REGION))
|
||||
NIL TITLE1))
|
||||
(AND (INFILEP FILE2)
|
||||
(TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1)
|
||||
REGION
|
||||
'LEFT
|
||||
'TOP
|
||||
`(,REGION 0.5)
|
||||
(FETCH (REGION TOP) OF REGION))
|
||||
NIL TITLE2])
|
||||
|
||||
(TEDITDEF
|
||||
[LAMBDA (NAME DEF TYPE READERENVIRONMENT WIDTH) (* ; "Edited 23-Jun-2022 17:27 by rmk")
|
||||
[LAMBDA (NAME DEF TYPE READERENVIRONMENT WIDTH) (* ; "Edited 13-Oct-2023 00:23 by rmk")
|
||||
(* ; "Edited 23-Jun-2022 17:27 by rmk")
|
||||
(* ; "Edited 28-Jan-2022 23:36 by rmk")
|
||||
(* ; "Edited 12-Jan-2022 17:27 by rmk")
|
||||
(LET ((TSTREAM (OPENTEXTSTREAM)))
|
||||
@@ -182,11 +203,14 @@
|
||||
TSTREAM))
|
||||
TSTREAM))
|
||||
(SELECTQ (CAR DEF)
|
||||
([LAMBDA NLAMBDA OPENLAMBDA]
|
||||
(PRINTOUT TSTREAM .FONT BOLDFONT .P2 NAME T .FONT DEFAULTFONT 2)
|
||||
(PRINTDEF DEF 2 T NIL NIL TSTREAM))
|
||||
(DEFINEQ (SETQ DEF (CADR DEF))
|
||||
(PRINTOUT TSTREAM .FONT BOLDFONT .P2 NAME T .FONT DEFAULTFONT 2)
|
||||
(PRINTDEF (CADR DEF)
|
||||
2 T NIL NIL TSTREAM))
|
||||
((DEFMACRO DEFUN) (* ; "Has args after name")
|
||||
((DEFMACRO DEFUN DEFMACRO CL:DEFUN) (* ; "Has args after name")
|
||||
(PRINTOUT TSTREAM "(" .P2 (CAR DEF)
|
||||
" " .FONT BOLDFONT .P2 (CADR DEF)
|
||||
.FONT DEFAULTFONT " " .P2 (CADDR DEF)
|
||||
@@ -216,6 +240,6 @@
|
||||
(FILESLOAD (SYSLOAD)
|
||||
COMPARETEXT)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (671 12815 (EXAMINEDEFS 681 . 9537) (EXAMINEFILES 9539 . 10934) (TEDITDEF 10936 . 12813)
|
||||
))))
|
||||
(FILEMAP (NIL (618 14102 (EXAMINEDEFS 628 . 10448) (EXAMINEFILES 10450 . 11932) (TEDITDEF 11934 .
|
||||
14100)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "16-Jun-2023 14:38:33" {DSK}<home>larry>il>medley>lispusers>HELPSYS.;11 87625
|
||||
(FILECREATED "11-Nov-2023 09:31:38" {DSK}<home>larry>il>medley>lispusers>HELPSYS.;2 87772
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (VARS HELPSYSCOMS)
|
||||
(FNS CLHS.LOOKUP)
|
||||
|
||||
:PREVIOUS-DATE "13-Jan-2023 10:46:39" {DSK}<home>larry>il>medley>lispusers>HELPSYS.;10)
|
||||
:PREVIOUS-DATE "16-Jun-2023 14:38:33" {DSK}<home>larry>il>medley>lispusers>HELPSYS.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT HELPSYSCOMS)
|
||||
@@ -28,7 +29,7 @@
|
||||
|
||||
(COMS (FNS CLHS.INDEX CLHS.LOOKUP CLHS.OPENER REPO.LOOKUP)
|
||||
(VARS CLHS.INDEX)
|
||||
[INITVARS (CLHS.ROOT.URL "http://clhs.lisp.se/")
|
||||
[INITVARS (CLHS.ROOT.URL "https://interlisp.org/clhs/")
|
||||
(CLHS.INDEX)
|
||||
(CLHS.OPENER)
|
||||
(HELPSYS.REPO.TYPES '(FNS FUNCTIONS VARS VARIABLES]
|
||||
@@ -94,8 +95,7 @@
|
||||
DINFO HASH)
|
||||
)
|
||||
|
||||
(DEFCOMMAND "man" (ENTRY)
|
||||
"Lookup ENTRY in the IRM."
|
||||
(DEFCOMMAND "man" (ENTRY) "Lookup ENTRY in the IRM."
|
||||
(GENERIC.MAN.LOOKUP ENTRY))
|
||||
(DEFINEQ
|
||||
|
||||
@@ -266,9 +266,10 @@
|
||||
else (LIST (SUBSTRING LINE POSLINK (CL:1- POSENDLINK])
|
||||
|
||||
(CLHS.LOOKUP
|
||||
[LAMBDA (ENTRY PHASES) (* ; "Edited 12-Oct-2022 18:32 by FGH")
|
||||
[LAMBDA (ENTRY PHASES) (* ; "Edited 11-Nov-2023 09:11 by lmm")
|
||||
(* ; "Edited 12-Oct-2022 18:32 by FGH")
|
||||
(* ; "Edited 24-Aug-2022 17:08 by larry")
|
||||
(LET [(OPENER (CLHS.OPENER))
|
||||
(LET [(OPENER (ShellBrowser))
|
||||
(URL NIL)
|
||||
POS
|
||||
(ENTRY (L-CASE (MKSTRING ENTRY]
|
||||
@@ -1329,7 +1330,7 @@
|
||||
("yes-or-no-p" "f_y_or_n.htm" "yes-or-no-p")
|
||||
("zerop" "f_zerop.htm" "zerop")))
|
||||
|
||||
(RPAQ? CLHS.ROOT.URL "http://clhs.lisp.se/")
|
||||
(RPAQ? CLHS.ROOT.URL "https://interlisp.org/clhs/")
|
||||
|
||||
(RPAQ? CLHS.INDEX )
|
||||
|
||||
@@ -1700,14 +1701,14 @@
|
||||
|
||||
(PUTPROPS HELPSYS FILETYPE :FAKE-COMPILE-FILE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4609 10342 (HELPSYS 4619 . 6460) (IRM.LOOKUP 6462 . 8100) (GENERIC.MAN.LOOKUP 8102 .
|
||||
9771) (IRM.SMART.LOOKUP 9773 . 9929) (IRM.RESET 9931 . 10340)) (10599 17546 (CLHS.INDEX 10609 . 13307)
|
||||
(CLHS.LOOKUP 13309 . 15209) (CLHS.OPENER 15211 . 16534) (REPO.LOOKUP 16536 . 17544)) (70634 72152 (
|
||||
IRM.GET.DINFOGRAPH 70644 . 71519) (IRM.DISPLAY.REF 71521 . 72150)) (72154 72516 (IRM.LOAD-GRAPH 72154
|
||||
. 72516)) (72841 78345 (IRM.DISPLAY.CREF 72851 . 74565) (IRM.CREF.BOX 74567 . 75394) (IRM.PUT.CREF
|
||||
75396 . 75621) (IRM.GET.CREF 75623 . 75994) (IRM.CREF.BUTTONEVENTFN 75996 . 78343)) (78900 87206 (
|
||||
\IRM.GET.REF 78910 . 80241) (\IRM.SMART.REF 80243 . 82170) (\IRM.CHOOSE.REF 82172 . 83423) (
|
||||
\IRM.WILD.REF 83425 . 84680) (\IRM.WILDCARD 84682 . 85048) (\IRM.WILD.MATCH 85050 . 86280) (
|
||||
\IRM.GET.HASHFILE 86282 . 86745) (\IRM.GET.KEYWORDS 86747 . 87204)) (87343 87499 (\IRM.AROUND-EXIT
|
||||
87343 . 87499)))))
|
||||
(FILEMAP (NIL (4643 10376 (HELPSYS 4653 . 6494) (IRM.LOOKUP 6496 . 8134) (GENERIC.MAN.LOOKUP 8136 .
|
||||
9805) (IRM.SMART.LOOKUP 9807 . 9963) (IRM.RESET 9965 . 10374)) (10633 17686 (CLHS.INDEX 10643 . 13341)
|
||||
(CLHS.LOOKUP 13343 . 15349) (CLHS.OPENER 15351 . 16674) (REPO.LOOKUP 16676 . 17684)) (70781 72299 (
|
||||
IRM.GET.DINFOGRAPH 70791 . 71666) (IRM.DISPLAY.REF 71668 . 72297)) (72301 72663 (IRM.LOAD-GRAPH 72301
|
||||
. 72663)) (72988 78492 (IRM.DISPLAY.CREF 72998 . 74712) (IRM.CREF.BOX 74714 . 75541) (IRM.PUT.CREF
|
||||
75543 . 75768) (IRM.GET.CREF 75770 . 76141) (IRM.CREF.BUTTONEVENTFN 76143 . 78490)) (79047 87353 (
|
||||
\IRM.GET.REF 79057 . 80388) (\IRM.SMART.REF 80390 . 82317) (\IRM.CHOOSE.REF 82319 . 83570) (
|
||||
\IRM.WILD.REF 83572 . 84827) (\IRM.WILDCARD 84829 . 85195) (\IRM.WILD.MATCH 85197 . 86427) (
|
||||
\IRM.GET.HASHFILE 86429 . 86892) (\IRM.GET.KEYWORDS 86894 . 87351)) (87490 87646 (\IRM.AROUND-EXIT
|
||||
87490 . 87646)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Oct-2022 21:45:29"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>MODERNIZE.;43 30755
|
||||
(FILECREATED "29-Oct-2023 10:56:48" {WMEDLEY}<lispusers>MODERNIZE.;48 30909
|
||||
|
||||
:CHANGES-TO (FNS MODERNWINDOW)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE " 5-Mar-2022 23:20:21"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>MODERNIZE.;40)
|
||||
:CHANGES-TO (FNS NEARESTCORNER)
|
||||
|
||||
:PREVIOUS-DATE "29-Jul-2023 10:48:55" {WMEDLEY}<lispusers>MODERNIZE.;47)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MODERNIZECOMS)
|
||||
@@ -30,7 +30,7 @@
|
||||
|
||||
(* ;; "Add some Meta commands")
|
||||
|
||||
(FNS TEDIT.MODERNIZE \MODERNIZED.TEDIT.BUTTONEVENTFN TEDIT.SELECTALL)
|
||||
(FNS TEDIT.MODERNIZE \MODERNIZED.TEDIT.BUTTONEVENTFN)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P
|
||||
(* ;; "Tedit")
|
||||
|
||||
@@ -325,21 +325,47 @@
|
||||
(IGREATERP LASTMOUSEX (IPLUS LEFT (TIMES WIDTH (DIFFERENCE 1 TITLEPROPORTION])
|
||||
|
||||
(NEARESTCORNER
|
||||
[LAMBDA (REGION) (* ; "Edited 14-Feb-2021 21:46 by rmk:")
|
||||
[LAMBDA (REGION) (* ; "Edited 29-Oct-2023 10:56 by rmk")
|
||||
(* ; "Edited 29-Jul-2023 10:32 by rmk")
|
||||
(* ; "Edited 14-Feb-2021 21:46 by rmk:")
|
||||
|
||||
(* ;;
|
||||
"Moves the cursor to the corner of REGION that is closest to the current LASTMOUSEX AND LASTMOUSEY")
|
||||
(* ;; "Moves the cursor to the corner of REGION that is closest to the current LASTMOUSEX and LASTMOUSEY, provided that that corner is on-screen.")
|
||||
|
||||
(\CURSORPOSITION (CL:IF (ILESSP (IDIFFERENCE LASTMOUSEX (FETCH LEFT OF REGION))
|
||||
(IDIFFERENCE (FETCH RIGHT OF REGION)
|
||||
LASTMOUSEX))
|
||||
(FETCH LEFT OF REGION)
|
||||
(FETCH RIGHT OF REGION))
|
||||
(CL:IF (ILESSP (IDIFFERENCE LASTMOUSEY (FETCH BOTTOM OF REGION))
|
||||
(IDIFFERENCE (FETCH TOP OF REGION)
|
||||
LASTMOUSEY))
|
||||
(FETCH BOTTOM OF REGION)
|
||||
(FETCH TOP OF REGION))])
|
||||
(LET ((LEFT (FETCH (REGION LEFT) OF REGION))
|
||||
(RIGHT (FETCH (REGION RIGHT) OF REGION))
|
||||
(TOP (FETCH (REGION TOP) OF REGION))
|
||||
(BOTTOM (FETCH (REGION BOTTOM) OF REGION))
|
||||
X Y)
|
||||
|
||||
(* ;; "If the nearest corner is offscreen, pick the other one.")
|
||||
|
||||
(SETQ X (if (OR (ILESSP LEFT 0)
|
||||
(IGEQ LEFT SCREENWIDTH))
|
||||
then
|
||||
(* ;; "LEFT is offscreen")
|
||||
|
||||
RIGHT
|
||||
elseif (ILESSP (IDIFFERENCE LASTMOUSEX LEFT)
|
||||
(IDIFFERENCE RIGHT LASTMOUSEX))
|
||||
then
|
||||
(* ;; "Closer to LEFT")
|
||||
|
||||
LEFT
|
||||
else RIGHT))
|
||||
(SETQ Y (if (OR (ILESSP TOP 0)
|
||||
(IGEQ TOP SCREENHEIGHT))
|
||||
then
|
||||
(* ;; "TOP is offscreen")
|
||||
|
||||
BOTTOM
|
||||
elseif (ILESSP (IDIFFERENCE LASTMOUSEY BOTTOM)
|
||||
(IDIFFERENCE TOP LASTMOUSEY))
|
||||
then
|
||||
(* ;; "Closer to BOTTOM")
|
||||
|
||||
BOTTOM
|
||||
else TOP))
|
||||
(\CURSORPOSITION X Y])
|
||||
|
||||
(INCORNER.REGION
|
||||
[LAMBDA (CORNERREGION TOPMARGIN) (* ; "Edited 13-Oct-2021 15:04 by rmk:")
|
||||
@@ -470,50 +496,25 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.MODERNIZE
|
||||
[LAMBDA NIL (* ; "Edited 11-Oct-2021 15:02 by rmk:")
|
||||
[LAMBDA NIL (* ; "Edited 14-Jun-2023 16:56 by rmk")
|
||||
(* ; "Edited 11-Oct-2021 15:02 by rmk:")
|
||||
(MODERNWINDOW.SETUP (FUNCTION \TEDIT.BUTTONEVENTFN)
|
||||
(FUNCTION \MODERNIZED.TEDIT.BUTTONEVENTFN))
|
||||
(CL:WHEN (GETD '\TEDIT.BUTTONEVENTFN)
|
||||
|
||||
(* ;; "All")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,a")
|
||||
(FUNCTION TEDIT.SELECTALL)
|
||||
TEDIT.READTABLE)
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,A")
|
||||
(FUNCTION TEDIT.SELECTALL)
|
||||
TEDIT.READTABLE)
|
||||
|
||||
(* ;; "Quit")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,q")
|
||||
(FUNCTION TEDIT.QUIT)
|
||||
TEDIT.READTABLE)
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,Q")
|
||||
(FUNCTION TEDIT.QUIT)
|
||||
TEDIT.READTABLE))])
|
||||
(FUNCTION \MODERNIZED.TEDIT.BUTTONEVENTFN])
|
||||
|
||||
(\MODERNIZED.TEDIT.BUTTONEVENTFN
|
||||
[LAMBDA (W STREAM) (* ; "Edited 13-Oct-2021 21:43 by rmk:")
|
||||
[LAMBDA (W STREAM) (* ; "Edited 29-Jul-2023 10:48 by rmk")
|
||||
(* ; "Edited 13-Oct-2021 21:43 by rmk:")
|
||||
|
||||
(* ;; "If a TEDIT window has been split, we have to make sure that movement happens only for clicks at the top of the main window and at the bottom of the bottom-most split window. Clicks near the split lines must be ignored. Essentially, the %"region%" of the Tedit window is the union of the regions of all of its split-panes.")
|
||||
|
||||
(* ;; "We pass the pain that received the click, because that's what the original \TEDIT.BUTTONEVENTFN needs to see, if we decide not to shape or move.")
|
||||
(* ;; "We pass the pane that received the click, because that's what the original \TEDIT.BUTTONEVENTFN needs to see, if we decide not to shape or move.")
|
||||
|
||||
(MODERNWINDOW.BUTTONEVENTFN W (FUNCTION MODERN-ORIG-\TEDIT.BUTTONEVENTFN)
|
||||
NIL NIL [APPLY (FUNCTION UNIONREGIONS)
|
||||
(bind PANE _ (CENTRALWINDOW W) collect (WINDOWPROP PANE
|
||||
'REGION)
|
||||
(bind PANE _ (CENTRALWINDOW W) collect (WINDOWPROP PANE 'REGION)
|
||||
repeatwhile (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN]
|
||||
(WINDOWPROP (CENTRALWINDOW W)
|
||||
'TITLE])
|
||||
|
||||
(TEDIT.SELECTALL
|
||||
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 3-May-2020 17:29 by rmk:")
|
||||
(LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS]
|
||||
(CL:WHEN TEXTSTREAM
|
||||
(TEDIT.SETSEL TEXTSTREAM 0 (ADD1 (fetch TEXTLEN of (TEXTOBJ TEXTSTREAM)))
|
||||
'LEFT))])
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
@@ -614,12 +615,11 @@
|
||||
(ADDTOVAR LAMA MODERN-ADD-EXEC)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5125 11487 (MODERNWINDOW 5135 . 6675) (MODERNWINDOW.SETUP 6677 . 9626) (UNMODERNWINDOW
|
||||
9628 . 10022) (MODERNWINDOW.UNSETUP 10024 . 10836) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10838 . 11485))
|
||||
(11552 21714 (MODERNWINDOW.BUTTONEVENTFN 11562 . 18589) (NEARTOP 18591 . 19519) (NEARESTCORNER 19521
|
||||
. 20400) (INCORNER.REGION 20402 . 21712)) (21772 24244 (MODERN-ADD-EXEC 21782 . 22213) (MODERN-SNAPW
|
||||
22215 . 22758) (TOTOPW.MODERNIZE 22760 . 23188) (MODERN-MENUBUTTONFN 23190 . 24242)) (24245 26674 (
|
||||
\MODERNIZED.FREEMENU.BUTTONEVENTFN 24255 . 24902) (MODERNIZED.TB.BUTTONEVENTFN 24904 . 26672)) (26715
|
||||
28994 (TEDIT.MODERNIZE 26725 . 27539) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27541 . 28663) (TEDIT.SELECTALL
|
||||
28665 . 28992)))))
|
||||
(FILEMAP (NIL (5048 11410 (MODERNWINDOW 5058 . 6598) (MODERNWINDOW.SETUP 6600 . 9549) (UNMODERNWINDOW
|
||||
9551 . 9945) (MODERNWINDOW.UNSETUP 9947 . 10759) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10761 . 11408)) (
|
||||
11475 22625 (MODERNWINDOW.BUTTONEVENTFN 11485 . 18512) (NEARTOP 18514 . 19442) (NEARESTCORNER 19444 .
|
||||
21311) (INCORNER.REGION 21313 . 22623)) (22683 25155 (MODERN-ADD-EXEC 22693 . 23124) (MODERN-SNAPW
|
||||
23126 . 23669) (TOTOPW.MODERNIZE 23671 . 24099) (MODERN-MENUBUTTONFN 24101 . 25153)) (25156 27585 (
|
||||
\MODERNIZED.FREEMENU.BUTTONEVENTFN 25166 . 25813) (MODERNIZED.TB.BUTTONEVENTFN 25815 . 27583)) (27626
|
||||
29148 (TEDIT.MODERNIZE 27636 . 27989) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27991 . 29146)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,10 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "10-Oct-2023 22:19:05" {WMEDLEY}<lispusers>REGIONMANAGER.;129 40525
|
||||
(FILECREATED " 2-Nov-2023 23:48:28" {WMEDLEY}<lispusers>REGIONMANAGER.;133 41064
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "10-Oct-2023 22:17:47" {MEDLEY}<lispusers>REGIONMANAGER.;9)
|
||||
:CHANGES-TO (FNS RM-CREATEW)
|
||||
|
||||
:PREVIOUS-DATE "10-Oct-2023 22:19:05" {WMEDLEY}<lispusers>REGIONMANAGER.;129)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT REGIONMANAGERCOMS)
|
||||
@@ -138,7 +140,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(RM-CREATEW
|
||||
[LAMBDA (REGION TITLE BORDERSIZE NOOPENFLG PROPS) (* ; "Edited 24-Sep-2023 20:38 by rmk")
|
||||
[LAMBDA (REGION TITLE BORDERSIZE NOOPENFLG PROPS) (* ; "Edited 2-Nov-2023 23:48 by rmk")
|
||||
(* ; "Edited 24-Sep-2023 20:38 by rmk")
|
||||
(* ; "Edited 14-Sep-2023 22:23 by rmk")
|
||||
(* ; "Edited 1-Jan-2022 23:12 by rmk")
|
||||
(* ; "Edited 29-Dec-2021 19:25 by rmk")
|
||||
@@ -147,16 +150,22 @@
|
||||
|
||||
(* ;; "We have to bracket the original window creation because the we have to mark that the window uses that region, to put it back in the pool when the window is closed.")
|
||||
|
||||
(LET [WINDOW (REGION-TYPE (if (AND (LITATOM REGION)
|
||||
REGION)
|
||||
then (PROG1 REGION (SETQ REGION NIL))
|
||||
else (LISTGET PROPS 'REGION-TYPE]
|
||||
(* ;; "NOTE: putting the region as the REGION--TYPE property may only be needed for old TEDIT compatibility")
|
||||
|
||||
(* ;; "We have REGION-TYPE, but maybe also a region that already has a source. Maybe we should make sure that the source is of that type?")
|
||||
(LET [WINDOW REGION-TYPE (RTPROP (LISTGET PROPS 'REGION-TYPE]
|
||||
(SETQ REGION-TYPE (if (AND (LITATOM REGION)
|
||||
REGION)
|
||||
then (PROG1 REGION (SETQ REGION NIL))
|
||||
elseif (LITATOM RTPROP)
|
||||
then RTPROP))
|
||||
(CL:UNLESS (OR (REGIONP REGION)
|
||||
(SCREENREGIONP REGION))
|
||||
(SETQ REGION (OR (REGIONP RTPROP)
|
||||
(SCREENREGIONP RTPROP))))
|
||||
|
||||
(* ;; "Note: REGION can also be a screenregion, that falls through.")
|
||||
(* ;; "We have REGION-TYPE, but maybe also a region that already has a source. Maybe we should make sure that the source is of that type? REGION can also be a screenregion, that falls through.")
|
||||
|
||||
(CL:WHEN REGION-TYPE
|
||||
(CL:WHEN (AND REGION-TYPE (NULL REGION))
|
||||
(SETQ REGION (GRAB-TYPED-REGION REGION-TYPE)))
|
||||
(SETQ WINDOW (CREATEW.ORIG REGION TITLE BORDERSIZE NOOPENFLG PROPS))
|
||||
(CL:WHEN REGION-TYPE (REGISTER-TYPED-REGION REGION REGION-TYPE WINDOW))
|
||||
@@ -721,11 +730,11 @@
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1573 6691 (SET-TYPED-REGIONS 1583 . 3758) (GRAB-TYPED-REGION 3760 . 4786) (
|
||||
REGISTER-TYPED-REGION 4788 . 6085) (REGION-TYPE 6087 . 6689)) (6692 14098 (RM-CREATEW 6702 . 8325) (
|
||||
RM-CLOSEW 8327 . 11345) (RM-GETREGION 11347 . 13496) (CLOSE-TYPED-W 13498 . 14096)) (14741 22220 (
|
||||
RELCREATEREGION 14751 . 19374) (RELGETREGION 19376 . 21983) (RELCREATEPOSITION 21985 . 22218)) (22221
|
||||
29025 (\RELCREATEREGION.REF 22231 . 25982) (\RELCREATEREGION.SIZE 25984 . 29023)) (29078 38420 (
|
||||
RM-ATTACHWINDOW 29088 . 38418)) (38421 40155 (CLOSEWITH 38431 . 38958) (CLOSEWITH.DOIT 38960 . 39240)
|
||||
(MOVEWITH 39242 . 39765) (MOVEWITH.DOIT 39767 . 40153)))))
|
||||
(FILEMAP (NIL (1612 6730 (SET-TYPED-REGIONS 1622 . 3797) (GRAB-TYPED-REGION 3799 . 4825) (
|
||||
REGISTER-TYPED-REGION 4827 . 6124) (REGION-TYPE 6126 . 6728)) (6731 14637 (RM-CREATEW 6741 . 8864) (
|
||||
RM-CLOSEW 8866 . 11884) (RM-GETREGION 11886 . 14035) (CLOSE-TYPED-W 14037 . 14635)) (15280 22759 (
|
||||
RELCREATEREGION 15290 . 19913) (RELGETREGION 19915 . 22522) (RELCREATEPOSITION 22524 . 22757)) (22760
|
||||
29564 (\RELCREATEREGION.REF 22770 . 26521) (\RELCREATEREGION.SIZE 26523 . 29562)) (29617 38959 (
|
||||
RM-ATTACHWINDOW 29627 . 38957)) (38960 40694 (CLOSEWITH 38970 . 39497) (CLOSEWITH.DOIT 39499 . 39779)
|
||||
(MOVEWITH 39781 . 40304) (MOVEWITH.DOIT 40306 . 40692)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -32,9 +32,9 @@ Relative regions
|
||||
Two functions are provided to make it easy to create regions relative and oriented with respect to a specified reference point. These may be useful for constructing an application that includes a constellation of windows arranged in a particular relative way.
|
||||
(RELCREATEREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY ONSCREEN) [Function]
|
||||
RELCREATEREGION creates a region of dimensions WIDTH and HEIGHT. One of its corners is identified by CORNERX and CORNERY and that corner will be aligned with a reference screen-point determined by REFX and REFY. If ONSCREEN, the WIDTH or HEIGHT will be adjusted with respect to that alignment so that the resulting region is entirely within the screen.
|
||||
WIDTH and HEIGHT can be given as absolute (natural) numbers) or specified relative to the WIDTH and HEIGHT of another region or of the screen. The possibilities are interpreted as follows:
|
||||
WIDTH and HEIGHT can be given as absolute (natural) numbers or specified relative to the WIDTH and HEIGHT of another region or of the screen. The possibilities are interpreted as follows:
|
||||
natural number: the number of screen points
|
||||
list of the form (anchor fraction adjustment), where anchor is a region, window, or an atom SCREEN or TTY. The corres-ponding dimension of the anchor is mutiplied by fraction and adjustment is added to the result. For example, specifying (<window> .5 -1) results in a WIDTH that is one point smaller than half the width of window's region. Fraction and adjustment default to 1 and 0 respectively.
|
||||
list of the form (anchor fraction adjustment), where anchor is a region, window, or an atom SCREEN or TTY. The corresponding dimension of the anchor is mutiplied by fraction and adjustment is added to the result. For example, specifying (<window> .5 -1) results in a WIDTH that is one point smaller than half the width of window's region. Fraction and adjustment default to 1 and 0 respectively.
|
||||
region/window/SCREEN/TTY: equivalent to (region/window/SCREEN/TTY 1 0).
|
||||
CORNERX can be LEFT, RIGHT, or NIL=LEFT, CORNERY can be BOTTOM, TOP, or NIL=BOTTOM. If LEFT/TOP are specified, for example, the region will be displayed down and to the right of the reference point. If RIGHT/BOTTOM, then up and to the left.
|
||||
The reference-point arguments REFX and REFY are interpreted as follows:
|
||||
@@ -55,7 +55,7 @@ Each of these applications is constructed by anticipating the subregions that th
|
||||
An alternative approach is to construct the central window first, giving it the entire constellation region, and then to have ATTACHWINDOW reshape that window to accomodate the satellite windows as they are attached in sequence. This leads to the same final configuration, but there is no need for separate calculations to pre-adjust the region of the central window.
|
||||
REGIONMANAGER provides an overlay veneer for ATTACHWINDOW that implements this strategy. If the new argument TAKEFROMCENTRAL is true, then the region of the WINDOWTOATTACH will be substracted from the region of the existing central window according to the EDGE parameter of the attachment.
|
||||
(ATTACHWINDOW WINDOWTOATTACH MAINWINDOW EDGE POSITIONONEDGE WINDOWCOMACTION TAKEFROMCENTRAL) [Function]
|
||||
This behavior is also triggered if the UNDERCONSTRUCTION property of the central window is true. Thus, a constellation can be set up by creating all of the satellites and the central window, marking the central window as under construction, and then doing the sequence of attachments. The property can be reset to NIL when the construction is complete, so the central window does not shrink if other other attachments (e.g. expanded menus) by later user actions.
|
||||
This behavior is also triggered if the UNDERCONSTRUCTION property of the central window is true. Thus, a constellation can be set up by creating all of the satellites and the central window, marking the central window as under construction, and then doing the sequence of attachments. The property can be reset to NIL when the construction is complete, so the central window does not shrink if other windows are attached (e.g. expanded menus) by later user actions.
|
||||
|
||||
A somewhat weaker form of a constellation is a collection of windows that are not attached around a central window but stand in a parent-child relationship at least with respect to closing and moving. A parent windows spawns children that respond independently to ordinary window commands (move, shape, close). But the children close when the parent closes, and the children move when the parent moves so that they continue to appear in the same relative positions. These primitives allow the construction of a tree of windows that are dependent in this way.
|
||||
(CLOSEWITH CHILDREN PARENT [Function]
|
||||
@@ -73,9 +73,9 @@ If NEWPOS is the new position of PARENT, moves each of the move-children so that
|
||||
TIMESROMAN $
HRULE.GETFN
HRULE.GETFN HRULE.GETFN HRULE.GETFN HRULE.GETFN
|
||||
D È „ • ‘ } / ¯ [ <01> C × <00> T Û
Á 1
|
||||
|
||||
; 3 o ) Ä
ž
’
4 n © o 2 V @ 1 % !
A & M m J S - f =
|
||||
; 3 o ) Ä
ž
’
4 n © o 2 V @ 1 % !
A & M m I S - f <
|
||||
3 E
|
||||
"
|
||||
|
||||
l / 3
|
||||
t 2 C ƒ " O = , l ¬ ) 9 ™ ¤ Ç
S ~ æ - 4 ! U h ' — 2 & µ $ " & (
) M DATE:fï1¶ 2Șzº
|
||||
t 2 C ƒ " O = , l ¬ ) 9 ™ ¤ Ç
S ~ æ - 4 ! U h ' š 2 & µ $ " & (
) M DATE:fû+Ë 2ɘzº
|
||||
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Jun-2022 22:50:45"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>COMPARETEXT.;124 48226
|
||||
(FILECREATED "18-Oct-2023 17:45:46" {WMEDLEY}<lispusers>COMPARETEXT.;131 48661
|
||||
|
||||
:CHANGES-TO (FNS IMCOMPARE.LEFTBUTTONFN COMPARETEXT.TEXTOBJ COMPARETEXT IMCOMPARE.CHUNKS
|
||||
IMCOMPARE.DISPLAYGRAPH COMPARETEXT.WINDOW)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "20-May-2022 16:35:56"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>COMPARETEXT.;118)
|
||||
:CHANGES-TO (FNS IMCOMPARE.COLLECT.HASH.CHUNKS IMCOMPARE.HASH)
|
||||
|
||||
:PREVIOUS-DATE " 2-Nov-2022 10:08:52" {WMEDLEY}<lispusers>COMPARETEXT.;130)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -17,7 +16,7 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
(PRETTYCOMPRINT COMPARETEXTCOMS)
|
||||
|
||||
(RPAQQ COMPARETEXTCOMS
|
||||
((FNS COMPARETEXT COMPARETEXT.WINDOW COMPARETEXT.TEXTOBJ COMPARETEXT.SETSEL CHUNKNODELABEL
|
||||
((FNS COMPARETEXT COMPARETEXT.WINDOW COMPARETEXT.TSTREAM COMPARETEXT.SETSEL CHUNKNODELABEL
|
||||
IMCOMPARE.BOXNODE IMCOMPARE.CHUNKS IMCOMPARE.COLLECT.HASH.CHUNKS IMCOMPARE.DISPLAYGRAPH
|
||||
IMCOMPARE.HASH IMCOMPARE.MERGE.CONNECTED.CHUNKS IMCOMPARE.MERGE.UNCONNECTED.CHUNKS
|
||||
IMCOMPARE.SHOW.DIST IMCOMPARE.UPDATE.SYMBOL.TABLE)
|
||||
@@ -119,23 +118,25 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
(GETPROMPTWINDOW WINDOW)
|
||||
WINDOW])
|
||||
|
||||
(COMPARETEXT.TEXTOBJ
|
||||
[LAMBDA (NODE WINDOW INCOL1) (* ; "Edited 23-Jun-2022 17:20 by rmk")
|
||||
(COMPARETEXT.TSTREAM
|
||||
[LAMBDA (NODE WINDOW INCOL1) (* ; "Edited 2-Nov-2022 00:11 by rmk")
|
||||
(* ; "Edited 23-Jun-2022 17:20 by rmk")
|
||||
(* ; "Edited 18-Feb-2022 17:05 by rmk")
|
||||
(* ; "Edited 30-Jan-2022 09:03 by rmk")
|
||||
(* ; "Edited 28-Jan-2022 22:37 by rmk")
|
||||
|
||||
(* ;; "Returns the text object for the chunk column in the graphwindow WINDOW, on the left if INCOL1. If the windows are automatic, they are lined up under the middle of WINDOW.")
|
||||
(* ;; "Returns the text stream for the chunk column in the graphwindow WINDOW, on the left if INCOL1. If the windows are automatic, they are lined up under the middle of WINDOW.")
|
||||
|
||||
(DECLARE (USEDFREE COMPARETEXT.AUTOTEDIT))
|
||||
(LET (TEXTOBJ TSTREAM TWINDOW REGION REGIONARGS TEXTWIDTH TEXTHEIGHT (GRAPH (WINDOWPROP
|
||||
WINDOW
|
||||
'GRAPH))
|
||||
(NODEID (FETCH (GRAPHNODE NODEID) OF NODE)))
|
||||
(CL:UNLESS [AND [SETQ TEXTOBJ (WINDOWPROP WINDOW (CL:IF INCOL1
|
||||
'COL1TEXTOBJ
|
||||
'COL2TEXTOBJ)]
|
||||
(OPENWP (WFROMDS (TEXTSTREAM TEXTOBJ]
|
||||
(LET [TWINDOW REGION REGIONARGS TEXTWIDTH TEXTHEIGHT (GRAPH (WINDOWPROP WINDOW 'GRAPH))
|
||||
(NODEID (FETCH (GRAPHNODE NODEID) OF NODE))
|
||||
(TSTREAM (WINDOWPROP WINDOW (CL:IF INCOL1
|
||||
'COL1TSTREAM
|
||||
'COL2TSTREAM)]
|
||||
(CL:UNLESS (AND TSTREAM (OPENWP (WFROMDS TSTREAM)))
|
||||
|
||||
(* ;; "First time, we have the graph but we don't yet have the TEDIT stream and window")
|
||||
|
||||
(SETQ TEXTWIDTH (OR (GRAPHERPROP GRAPH 'TEXTWIDTH)
|
||||
700))
|
||||
(SETQ TEXTHEIGHT (OR (GRAPHERPROP GRAPH 'TEXTHEIGHT)
|
||||
@@ -152,39 +153,40 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
(SETQ REGION (CL:IF COMPARETEXT.AUTOTEDIT
|
||||
(RELCREATEREGION REGIONARGS)
|
||||
(RELGETREGION REGIONARGS)))
|
||||
|
||||
(* ;; "If the CAR is a FIXP, this is a chunk node. Otherwise, it is one of the two file-name column headers.")
|
||||
|
||||
[SETQ TSTREAM (TEXTSTREAM (TEDIT (CL:IF (FIXP (CAR NODEID))
|
||||
(FETCH (IMCOMPARE.CHUNK FILENAME) of NODEID)
|
||||
NODEID)
|
||||
REGION NIL `(READONLY T LEAVETTY T]
|
||||
(SETQ TWINDOW (WFROMDS TSTREAM))
|
||||
(SETQ TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(WINDOWPROP WINDOW (CL:IF INCOL1
|
||||
'COL1TEXTOBJ
|
||||
'COL2TEXTOBJ)
|
||||
TEXTOBJ)
|
||||
'COL1TSTREAM
|
||||
'COL2TSTREAM)
|
||||
TSTREAM)
|
||||
[WINDOWPROP TWINDOW 'TITLE (CL:IF INCOL1
|
||||
(CADR (GRAPHERPROP GRAPH 'FILELABELS))
|
||||
(CADDR (GRAPHERPROP GRAPH 'FILELABELS)))]
|
||||
(MOVEWITH TWINDOW WINDOW)
|
||||
(CLOSEWITH TWINDOW WINDOW))
|
||||
TEXTOBJ])
|
||||
TSTREAM])
|
||||
|
||||
(COMPARETEXT.SETSEL
|
||||
[LAMBDA (TEXTOBJ NODE) (* ; "Edited 25-Dec-2021 10:52 by rmk")
|
||||
|
||||
(* ;; "25 so that we normalize with a little bit of context")
|
||||
|
||||
[LAMBDA (TSTREAM NODE) (* ; "Edited 2-Nov-2022 10:07 by rmk")
|
||||
(* ; "Edited 25-Dec-2021 10:52 by rmk")
|
||||
(LET* ((CHUNK (FETCH (GRAPHNODE NODEID) OF NODE))
|
||||
(FILEPTR (fetch (IMCOMPARE.CHUNK FILEPTR) of CHUNK)))
|
||||
(TEDIT.SETSEL TEXTOBJ (IMAX 1 (IDIFFERENCE FILEPTR 25))
|
||||
|
||||
(* ;; "The first selection just makes sure that at least 25 characters before the chunk will be on the screen. The second causes only the characters of the actual chunk to be underlined and shown. ")
|
||||
|
||||
(TEDIT.SETSEL TSTREAM (IMAX 1 (IDIFFERENCE FILEPTR 25))
|
||||
0
|
||||
'LEFT)
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ)
|
||||
(TEDIT.SETSEL TEXTOBJ FILEPTR (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK)
|
||||
(TEDIT.NORMALIZECARET TSTREAM)
|
||||
(TEDIT.SETSEL TSTREAM FILEPTR (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK)
|
||||
'LEFT)
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ)
|
||||
(AND NIL (TTY.PROCESS (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))
|
||||
'PROCESS])
|
||||
(TEDIT.NORMALIZECARET TSTREAM])
|
||||
|
||||
(CHUNKNODELABEL
|
||||
[LAMBDA (CHUNK MIN.LENGTH EXTENDER) (* ; "Edited 25-Dec-2021 11:56 by rmk")
|
||||
@@ -293,7 +295,8 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
TITLE TEXTWIDTH TEXTHEIGHT])
|
||||
|
||||
(IMCOMPARE.COLLECT.HASH.CHUNKS
|
||||
[LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 20-Jan-2022 23:09 by rmk")
|
||||
[LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 18-Oct-2023 17:45 by rmk")
|
||||
(* ; "Edited 20-Jan-2022 23:09 by rmk")
|
||||
(* ; "Edited 24-Dec-2021 22:30 by rmk")
|
||||
(* ; "Edited 13-Dec-2021 16:32 by rmk")
|
||||
(* ; "Edited 23-Dec-98 16:54 by rmk:")
|
||||
@@ -305,7 +308,8 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
|
||||
(RESETLST
|
||||
(BIND (FILENAME _ (fetch (IMCOMPARE.CHUNK FILENAME) of CHUNK))
|
||||
STREAM ENDPOS FIRST [RESETSAVE (SETQ STREAM (OPENSTREAM FILENAME 'INPUT 'OLD))
|
||||
STREAM ENDPOS FIRST [RESETSAVE [SETQ STREAM (OPENSTREAM FILENAME 'INPUT 'OLD
|
||||
'((ENDOFSTREAMOP NILL]
|
||||
'(PROGN (CLOSEF? OLDVALUE]
|
||||
(CL:WHEN (\TEDIT.FORMATTEDP1 STREAM)
|
||||
(* ;
|
||||
@@ -457,9 +461,10 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
T NIL])
|
||||
|
||||
(IMCOMPARE.HASH
|
||||
[LAMBDA (STREAM HASH.TYPE ENDPOS) (* ; "Edited 19-Dec-2021 09:07 by rmk")
|
||||
(* ; "Edited 15-Dec-2021 15:58 by rmk")
|
||||
(* ; "Edited 13-Dec-2021 16:35 by rmk")
|
||||
[LAMBDA (STREAM HASH.TYPE ENDPOS) (* ; "Edited 18-Oct-2023 17:44 by rmk")
|
||||
(* ; "Edited 19-Dec-2021 09:07 by rmk")
|
||||
(* ; "Edited 15-Dec-2021 15:58 by rmk")
|
||||
(* ; "Edited 13-Dec-2021 16:35 by rmk")
|
||||
(* ; "Edited 23-Dec-98 16:58 by rmk:")
|
||||
|
||||
(* ;; "IMCOMPARE.HASH automatically stops before reading char number EOF.PTR.")
|
||||
@@ -483,7 +488,8 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
"Paragraph chunks end with two consecutive EOL's.")
|
||||
(BIND EOLSEEN WHILE (IGREATERP NBYTES 0)
|
||||
DO (SELCHARQ (SETQ C (\INCCODE.EOLC STREAM NIL 'NBYTES NBYTES))
|
||||
(EOL (CL:WHEN EOLSEEN (RETURN))
|
||||
((EOL NIL)
|
||||
(CL:WHEN EOLSEEN (RETURN))
|
||||
(SETQ EOLSEEN T) (* ; "Skip the NIL SETQ below")
|
||||
(GO $$ITERATE))
|
||||
((SPACE TAB))
|
||||
@@ -635,6 +641,8 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
(IMCOMPARE.LEFTBUTTONFN
|
||||
[LAMBDA (NODE WINDOW)
|
||||
|
||||
(* ;; "Edited 1-Nov-2022 22:29 by rmk")
|
||||
|
||||
(* ;; "Edited 23-Jun-2022 22:50 by rmk: Turn off previous selection before turning on new one")
|
||||
|
||||
(* ;; "Edited 25-Dec-2021 23:29 by rmk")
|
||||
@@ -647,14 +655,14 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
(LET ([INCOL1 (EQ (GRAPHERPROP (WINDOWPROP WINDOW 'GRAPH)
|
||||
'COL1X)
|
||||
(FETCH (POSITION XCOORD) OF (FETCH (GRAPHNODE NODEPOSITION) OF NODE]
|
||||
TEXTOBJ)
|
||||
TSTREAM)
|
||||
|
||||
(* ;; "Turn off any previous selection")
|
||||
|
||||
(CL:WHEN (SETQ TEXTOBJ (WINDOWPROP WINDOW 'COL1TEXTOBJ))
|
||||
(TEDIT.SHOWSEL (TEXTSTREAM TEXTOBJ)))
|
||||
(CL:WHEN (SETQ TEXTOBJ (WINDOWPROP WINDOW 'COL2TEXTOBJ))
|
||||
(TEDIT.SHOWSEL (TEXTSTREAM TEXTOBJ)))
|
||||
(CL:WHEN (SETQ TSTREAM (WINDOWPROP WINDOW 'COL1TSTREAM))
|
||||
(TEDIT.SHOWSEL TSTREAM))
|
||||
(CL:WHEN (SETQ TSTREAM (WINDOWPROP WINDOW 'COL2TSTREAM))
|
||||
(TEDIT.SHOWSEL TSTREAM))
|
||||
(IF (FIXP (CAR (fetch (GRAPHNODE NODEID) of NODE)))
|
||||
THEN (IMCOMPARE.BOXNODE WINDOW NODE (FOR N (YPOS _ (FETCH YCOORD
|
||||
OF (FETCH NODEPOSITION
|
||||
@@ -669,17 +677,17 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
(* ;;
|
||||
"We won't match the other label node because it has a unique ypos")
|
||||
|
||||
(COMPARETEXT.SETSEL (COMPARETEXT.TEXTOBJ
|
||||
(COMPARETEXT.SETSEL (COMPARETEXT.TSTREAM
|
||||
N WINDOW (NOT INCOL1)
|
||||
)
|
||||
N)
|
||||
(RETURN N)))
|
||||
(COMPARETEXT.SETSEL (COMPARETEXT.TEXTOBJ NODE WINDOW INCOL1)
|
||||
(COMPARETEXT.SETSEL (COMPARETEXT.TSTREAM NODE WINDOW INCOL1)
|
||||
NODE)
|
||||
ELSE
|
||||
(* ;; "The column header, set up the file window with no selection.")
|
||||
|
||||
(COMPARETEXT.TEXTOBJ NODE WINDOW INCOL1))))])
|
||||
(COMPARETEXT.TSTREAM NODE WINDOW INCOL1))))])
|
||||
|
||||
(IMCOMPARE.MIDDLEBUTTONFN
|
||||
[LAMBDA (NODE WINDOW) (* ; "Edited 27-Dec-2021 11:59 by rmk")
|
||||
@@ -776,12 +784,12 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1473 40549 (COMPARETEXT 1483 . 3123) (COMPARETEXT.WINDOW 3125 . 6923) (
|
||||
COMPARETEXT.TEXTOBJ 6925 . 10067) (COMPARETEXT.SETSEL 10069 . 10859) (CHUNKNODELABEL 10861 . 11982) (
|
||||
IMCOMPARE.BOXNODE 11984 . 12960) (IMCOMPARE.CHUNKS 12962 . 17570) (IMCOMPARE.COLLECT.HASH.CHUNKS 17572
|
||||
. 20489) (IMCOMPARE.DISPLAYGRAPH 20491 . 28570) (IMCOMPARE.HASH 28572 . 32759) (
|
||||
IMCOMPARE.MERGE.CONNECTED.CHUNKS 32761 . 36257) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 36259 . 38214) (
|
||||
IMCOMPARE.SHOW.DIST 38216 . 38662) (IMCOMPARE.UPDATE.SYMBOL.TABLE 38664 . 40547)) (40550 47004 (
|
||||
IMCOMPARE.LEFTBUTTONFN 40560 . 43434) (IMCOMPARE.MIDDLEBUTTONFN 43436 . 46552) (IMCOMPARE.COPYBUTTONFN
|
||||
46554 . 47002)) (47057 47748 (TAIL1 47067 . 47421) (TAIL2 47423 . 47746)))))
|
||||
(FILEMAP (NIL (1318 40954 (COMPARETEXT 1328 . 2968) (COMPARETEXT.WINDOW 2970 . 6768) (
|
||||
COMPARETEXT.TSTREAM 6770 . 9991) (COMPARETEXT.SETSEL 9993 . 10898) (CHUNKNODELABEL 10900 . 12021) (
|
||||
IMCOMPARE.BOXNODE 12023 . 12999) (IMCOMPARE.CHUNKS 13001 . 17609) (IMCOMPARE.COLLECT.HASH.CHUNKS 17611
|
||||
. 20723) (IMCOMPARE.DISPLAYGRAPH 20725 . 28804) (IMCOMPARE.HASH 28806 . 33164) (
|
||||
IMCOMPARE.MERGE.CONNECTED.CHUNKS 33166 . 36662) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 36664 . 38619) (
|
||||
IMCOMPARE.SHOW.DIST 38621 . 39067) (IMCOMPARE.UPDATE.SYMBOL.TABLE 39069 . 40952)) (40955 47439 (
|
||||
IMCOMPARE.LEFTBUTTONFN 40965 . 43869) (IMCOMPARE.MIDDLEBUTTONFN 43871 . 46987) (IMCOMPARE.COPYBUTTONFN
|
||||
46989 . 47437)) (47492 48183 (TAIL1 47502 . 47856) (TAIL2 47858 . 48181)))))
|
||||
STOP
|
||||
|
||||
@@ -163,6 +163,10 @@ if [ -z "$geometry" ] ; then
|
||||
screensize="-sc 1440x900"
|
||||
fi
|
||||
|
||||
if [ -z "${LDEKBDTYPE}" ]; then
|
||||
export LDEKBDTYPE="X"
|
||||
fi
|
||||
|
||||
if ! command -v "$prog" > /dev/null 2>&1; then
|
||||
# if lde is already on path, don't reset it
|
||||
# otherwise check for MAIKODIR
|
||||
|
||||
@@ -23,6 +23,14 @@ if [ ! -e ${NOTECARDSDIR} ]; then
|
||||
fi
|
||||
fi
|
||||
|
||||
if [ -z "${NOTECARDSDIR}" ]; then
|
||||
echo "Error: Cannot find the Notecards directory"
|
||||
echo "It should be located at ${MEDLEYDIR}/../notecards or"
|
||||
echo "${MEDLEYDIR}/../../notecards. But its not."
|
||||
echo "Exiting"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
cat >"${cmfile}" <<"EOF"
|
||||
"
|
||||
|
||||
|
||||
32
sources/ADIR
32
sources/ADIR
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "14-Sep-2023 23:20:17" {WMEDLEY}<sources>ADIR.;30 67297
|
||||
(FILECREATED "13-Nov-2023 20:28:57" {WMEDLEY}<sources>ADIR.;31 67473
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \COPYSYS)
|
||||
:CHANGES-TO (FNS UNPACKFILENAME.STRING)
|
||||
|
||||
:PREVIOUS-DATE "14-Sep-2023 22:56:19" {WMEDLEY}<sources>ADIR.;29)
|
||||
:PREVIOUS-DATE "14-Sep-2023 23:20:17" {WMEDLEY}<sources>ADIR.;30)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT ADIRCOMS)
|
||||
@@ -317,7 +317,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(UNPACKFILENAME.STRING
|
||||
[LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 28-Apr-2022 11:40 by rmk")
|
||||
[LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 13-Nov-2023 20:28 by rmk")
|
||||
(* ; "Edited 28-Apr-2022 11:40 by rmk")
|
||||
(* ; "Edited 24-Apr-2022 14:11 by rmk")
|
||||
|
||||
(* ;; "")
|
||||
@@ -514,7 +515,8 @@
|
||||
(CL:UNLESS (EQ NAMESTART $$OFFSET) (* ;
|
||||
"Allow . in first NAME position : .git")
|
||||
(SETQ NAMEEND (SUB1 $$OFFSET))
|
||||
(SETQ EXTENSIONSTART $$OFFSET)))
|
||||
(SETQ EXTENSIONSTART $$OFFSET)
|
||||
(SETQ EXTENSIONEND NIL)))
|
||||
(; (CL:WHEN VERSIONSTART (* ; "What about x;1;2")
|
||||
|
||||
(* ;; "This gives old behavior is NAME=x, VERSION=1;2")
|
||||
@@ -1250,14 +1252,14 @@
|
||||
(ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3106 15763 (DELFILE 3116 . 3277) (FULLNAME 3279 . 3646) (INFILE 3648 . 3907) (INFILEP
|
||||
3909 . 4044) (IOFILE 4046 . 4297) (OPENFILE 4299 . 4602) (OPENSTREAM 4604 . 8944) (OUTFILE 8946 . 9208
|
||||
) (OUTFILEP 9210 . 9346) (RENAMEFILE 9348 . 9654) (SIMPLE.FINDFILE 9656 . 10066) (VMEMSIZE 10068 .
|
||||
10235) (\COPYSYS 10237 . 14482) (\FLUSHVM 14484 . 15556) (\LOGOUT0 15558 . 15761)) (16221 38126 (
|
||||
UNPACKFILENAME.STRING 16231 . 35505) (\UPF.DIRECTORY 35507 . 38124)) (39654 42326 (UNPACKFILENAME
|
||||
39664 . 39850) (LASTCHPOS 39852 . 40546) (FILENAMEFIELD 40548 . 41033) (FILENAMEFIELD.STRING 41035 .
|
||||
41614) (PACKFILENAME 41616 . 41959) (PACKFILENAME.STRING 41961 . 42324)) (56796 57709 (
|
||||
FILEDIRCASEARRAY 56806 . 57707)) (57876 65056 (LOGOUT 57886 . 58803) (MAKESYS 58805 . 60434) (SYSOUT
|
||||
60436 . 61988) (SAVEVM 61990 . 62790) (HERALD 62792 . 62952) (INTERPRET.REM.CM 62954 . 64679) (
|
||||
\USEREVENT 64681 . 65054)) (65238 66965 (USERNAME 65248 . 66204) (SETUSERNAME 66206 . 66963)))))
|
||||
(FILEMAP (NIL (3119 15776 (DELFILE 3129 . 3290) (FULLNAME 3292 . 3659) (INFILE 3661 . 3920) (INFILEP
|
||||
3922 . 4057) (IOFILE 4059 . 4310) (OPENFILE 4312 . 4615) (OPENSTREAM 4617 . 8957) (OUTFILE 8959 . 9221
|
||||
) (OUTFILEP 9223 . 9359) (RENAMEFILE 9361 . 9667) (SIMPLE.FINDFILE 9669 . 10079) (VMEMSIZE 10081 .
|
||||
10248) (\COPYSYS 10250 . 14495) (\FLUSHVM 14497 . 15569) (\LOGOUT0 15571 . 15774)) (16234 38302 (
|
||||
UNPACKFILENAME.STRING 16244 . 35681) (\UPF.DIRECTORY 35683 . 38300)) (39830 42502 (UNPACKFILENAME
|
||||
39840 . 40026) (LASTCHPOS 40028 . 40722) (FILENAMEFIELD 40724 . 41209) (FILENAMEFIELD.STRING 41211 .
|
||||
41790) (PACKFILENAME 41792 . 42135) (PACKFILENAME.STRING 42137 . 42500)) (56972 57885 (
|
||||
FILEDIRCASEARRAY 56982 . 57883)) (58052 65232 (LOGOUT 58062 . 58979) (MAKESYS 58981 . 60610) (SYSOUT
|
||||
60612 . 62164) (SAVEVM 62166 . 62966) (HERALD 62968 . 63128) (INTERPRET.REM.CM 63130 . 64855) (
|
||||
\USEREVENT 64857 . 65230)) (65414 67141 (USERNAME 65424 . 66380) (SETUSERNAME 66382 . 67139)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,18 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 1-Mar-2023 07:49:03" {DSK}<home>larry>il>medley>sources>ADISPLAY.;2 245335
|
||||
(FILECREATED " 2-Nov-2023 23:35:15" {WMEDLEY}<sources>ADISPLAY.;12 245350
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \DRAWLINE.DISPLAY)
|
||||
:CHANGES-TO (VARS ADISPLAYCOMS)
|
||||
(FNS SCREENREGIONP)
|
||||
|
||||
:PREVIOUS-DATE "28-Feb-2023 06:37:11" {DSK}<home>larry>il>medley>sources>ADISPLAY.;1)
|
||||
:PREVIOUS-DATE " 1-Mar-2023 07:49:03" {WMEDLEY}<sources>ADISPLAY.;11)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT ADISPLAYCOMS)
|
||||
|
||||
(RPAQQ ADISPLAYCOMS
|
||||
@@ -23,6 +20,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
|
||||
(COMS (* ; "Interlisp-D dependent stuff.")
|
||||
(EXPORT (RECORDS REGION BITMAP BITMAPWORD POSITION CURSOR MOUSEEVENT SCREENREGION
|
||||
SCREENPOSITION))
|
||||
(FNS SCREENREGIONP)
|
||||
(SYSRECORDS PILOTBBT \DISPLAYDATA)
|
||||
(CONSTANTS (BITSPERINTEGER 32))
|
||||
(FNS \BBTCURVEPT)
|
||||
@@ -207,6 +205,13 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(SCREENREGIONP
|
||||
[LAMBDA (X) (* ; "Edited 2-Nov-2023 23:34 by rmk")
|
||||
(CL:WHEN (type? SCREENREGION X)
|
||||
X])
|
||||
)
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE PILOTBBT ((PBTDESTLO WORD)
|
||||
@@ -4431,43 +4436,41 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
|
||||
|
||||
(ADDTOVAR LAMA UNIONREGIONS INTERSECTREGIONS)
|
||||
)
|
||||
(PUTPROPS ADISPLAY COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991
|
||||
1993 1994 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (12060 19421 (\BBTCURVEPT 12070 . 19419)) (19422 29238 (CREATETEXTUREFROMBITMAP 19432 .
|
||||
21362) (PRINTBITMAP 21364 . 22715) (PRINT-BITMAPS-NICELY 22717 . 26568) (PRINTCURSOR 26570 . 27603) (
|
||||
\WRITEBITMAP 27605 . 29236)) (29281 31829 (\GETINTEGERPART 29291 . 30836) (\CONVERTTOFRACTION 30838 .
|
||||
31827)) (31966 32838 (CURSORP 31976 . 32195) (CURSORBITMAP 32197 . 32243) (CreateCursorBitMap 32245 .
|
||||
32836)) (37200 46243 (CARET 37210 . 38970) (\CARET.CREATE 38972 . 39150) (\CARET.DOWN 39152 . 40504) (
|
||||
\CARET.FLASH? 40506 . 42320) (\CARET.SHOW 42322 . 42891) (CARETRATE 42893 . 43551) (\CARET.FLASH.AGAIN
|
||||
43553 . 44719) (\CARET.FLASH.MULTIPLE 44721 . 45244) (\CARET.FLASH 45246 . 46241)) (46244 51316 (
|
||||
\MEDW.CARET.SHOW 46254 . 51314)) (51680 53515 (\AREAVISIBLE? 51690 . 52614) (\REGIONOVERLAPAREAP 52616
|
||||
. 53161) (\AREAINREGIONP 53163 . 53513)) (53564 66040 (CREATEREGION 53574 . 53910) (REGIONP 53912 .
|
||||
54058) (INTERSECTREGIONS 54060 . 56830) (UNIONREGIONS 56832 . 58983) (REGIONSINTERSECTP 58985 . 59593)
|
||||
(SUBREGIONP 59595 . 60240) (EXTENDREGION 60242 . 62399) (EXTENDREGIONBOTTOM 62401 . 63043) (
|
||||
EXTENDREGIONLEFT 63045 . 63664) (EXTENDREGIONRIGHT 63666 . 64219) (EXTENDREGIONTOP 64221 . 64762) (
|
||||
INSIDEP 64764 . 65532) (STRINGREGION 65534 . 66038)) (66285 71559 (\BRUSHBITMAP 66295 . 68012) (
|
||||
\GETBRUSH 68014 . 68325) (\GETBRUSHBBT 68327 . 70355) (\InitCurveBrushes 70357 . 71423) (
|
||||
\BrushFromWidth 71425 . 71557)) (71560 74627 (\MAKEBRUSH.DIAGONAL 71570 . 71850) (
|
||||
\MAKEBRUSH.HORIZONTAL 71852 . 72246) (\MAKEBRUSH.VERTICAL 72248 . 72560) (\MAKEBRUSH.SQUARE 72562 .
|
||||
72839) (\MAKEBRUSH.ROUND 72841 . 74625)) (74628 75793 (INSTALLBRUSH 74638 . 75791)) (76194 87596 (
|
||||
\DRAWLINE.DISPLAY 76204 . 86311) (RELMOVETO 86313 . 86700) (MOVETOUPPERLEFT 86702 . 87594)) (87597
|
||||
111082 (\CLIPANDDRAWLINE 87607 . 94053) (\CLIPANDDRAWLINE1 94055 . 105803) (\CLIPCODE 105805 . 107179)
|
||||
(\LEASTPTAT 107181 . 107779) (\GREATESTPTAT 107781 . 108409) (\DRAWLINE1 108411 . 109527) (
|
||||
\DRAWLINE.UFN 109529 . 111080)) (115612 161659 (\DRAWCIRCLE.DISPLAY 115622 . 124435) (\DRAWARC.DISPLAY
|
||||
124437 . 124727) (\DRAWARC.GENERIC 124729 . 125482) (\COMPUTE.ARC.POINTS 125484 . 127749) (
|
||||
\DRAWELLIPSE.DISPLAY 127751 . 143420) (\DRAWCURVE.DISPLAY 143422 . 145711) (\DRAWPOINT.DISPLAY 145713
|
||||
. 146909) (\DRAWPOLYGON.DISPLAY 146911 . 150439) (\LINEWITHBRUSH 150441 . 161657)) (161660 193352 (
|
||||
LOADPOLY 161670 . 162230) (PARAMETRICSPLINE 162232 . 172429) (\CURVE 172431 . 178033) (\CURVE2 178035
|
||||
. 189366) (\CURVEEND 189368 . 189850) (\CURVESLOPE 189852 . 192335) (\CURVESTART 192337 . 192661) (
|
||||
\FDIFS/FROM/DERIVS 192663 . 193350)) (205881 220217 (\FILLCIRCLE.DISPLAY 205891 . 216639) (\LINEBLT
|
||||
216641 . 220215)) (220261 222261 (SCREENBITMAP 220271 . 220748) (BITMAPP 220750 . 220984) (
|
||||
BITMAPHEIGHT 220986 . 221362) (BITSPERPIXEL 221364 . 222259)) (222902 223895 (DSPFILL 222912 . 223595)
|
||||
(INVERTW 223597 . 223893)) (223896 227539 (\DSPCOLOR.DISPLAY 223906 . 225203) (\DSPBACKCOLOR.DISPLAY
|
||||
225205 . 226584) (DSPEOLFN 226586 . 227537)) (227972 232626 (DSPCLEOL 227982 . 228858) (DSPRUBOUTCHAR
|
||||
228860 . 229292) (\DSPMOVELR 229294 . 232624)) (232756 233874 (\CURSOR.DEFPRINT 232766 . 233872)) (
|
||||
234286 242860 (TEXTUREOFCOLOR 234296 . 235558) (\PRIMARYTEXTURE 235560 . 236142) (\LEVELTEXTURE 236144
|
||||
. 236645) (INSURE.B&W.TEXTURE 236647 . 238042) (INSURE.RGB.COLOR 238044 . 239472) (\LOOKUPCOLORNAME
|
||||
239474 . 239744) (RGBP 239746 . 240511) (HLSP 240513 . 240888) (HLSTORGB 240890 . 242030) (\HLSVALUEFN
|
||||
242032 . 242858)))))
|
||||
(FILEMAP (NIL (10558 10752 (SCREENREGIONP 10568 . 10750)) (12196 19557 (\BBTCURVEPT 12206 . 19555)) (
|
||||
19558 29374 (CREATETEXTUREFROMBITMAP 19568 . 21498) (PRINTBITMAP 21500 . 22851) (PRINT-BITMAPS-NICELY
|
||||
22853 . 26704) (PRINTCURSOR 26706 . 27739) (\WRITEBITMAP 27741 . 29372)) (29417 31965 (\GETINTEGERPART
|
||||
29427 . 30972) (\CONVERTTOFRACTION 30974 . 31963)) (32102 32974 (CURSORP 32112 . 32331) (CURSORBITMAP
|
||||
32333 . 32379) (CreateCursorBitMap 32381 . 32972)) (37336 46379 (CARET 37346 . 39106) (\CARET.CREATE
|
||||
39108 . 39286) (\CARET.DOWN 39288 . 40640) (\CARET.FLASH? 40642 . 42456) (\CARET.SHOW 42458 . 43027) (
|
||||
CARETRATE 43029 . 43687) (\CARET.FLASH.AGAIN 43689 . 44855) (\CARET.FLASH.MULTIPLE 44857 . 45380) (
|
||||
\CARET.FLASH 45382 . 46377)) (46380 51452 (\MEDW.CARET.SHOW 46390 . 51450)) (51816 53651 (
|
||||
\AREAVISIBLE? 51826 . 52750) (\REGIONOVERLAPAREAP 52752 . 53297) (\AREAINREGIONP 53299 . 53649)) (
|
||||
53700 66176 (CREATEREGION 53710 . 54046) (REGIONP 54048 . 54194) (INTERSECTREGIONS 54196 . 56966) (
|
||||
UNIONREGIONS 56968 . 59119) (REGIONSINTERSECTP 59121 . 59729) (SUBREGIONP 59731 . 60376) (EXTENDREGION
|
||||
60378 . 62535) (EXTENDREGIONBOTTOM 62537 . 63179) (EXTENDREGIONLEFT 63181 . 63800) (EXTENDREGIONRIGHT
|
||||
63802 . 64355) (EXTENDREGIONTOP 64357 . 64898) (INSIDEP 64900 . 65668) (STRINGREGION 65670 . 66174))
|
||||
(66421 71695 (\BRUSHBITMAP 66431 . 68148) (\GETBRUSH 68150 . 68461) (\GETBRUSHBBT 68463 . 70491) (
|
||||
\InitCurveBrushes 70493 . 71559) (\BrushFromWidth 71561 . 71693)) (71696 74763 (\MAKEBRUSH.DIAGONAL
|
||||
71706 . 71986) (\MAKEBRUSH.HORIZONTAL 71988 . 72382) (\MAKEBRUSH.VERTICAL 72384 . 72696) (
|
||||
\MAKEBRUSH.SQUARE 72698 . 72975) (\MAKEBRUSH.ROUND 72977 . 74761)) (74764 75929 (INSTALLBRUSH 74774 .
|
||||
75927)) (76330 87732 (\DRAWLINE.DISPLAY 76340 . 86447) (RELMOVETO 86449 . 86836) (MOVETOUPPERLEFT
|
||||
86838 . 87730)) (87733 111218 (\CLIPANDDRAWLINE 87743 . 94189) (\CLIPANDDRAWLINE1 94191 . 105939) (
|
||||
\CLIPCODE 105941 . 107315) (\LEASTPTAT 107317 . 107915) (\GREATESTPTAT 107917 . 108545) (\DRAWLINE1
|
||||
108547 . 109663) (\DRAWLINE.UFN 109665 . 111216)) (115748 161795 (\DRAWCIRCLE.DISPLAY 115758 . 124571)
|
||||
(\DRAWARC.DISPLAY 124573 . 124863) (\DRAWARC.GENERIC 124865 . 125618) (\COMPUTE.ARC.POINTS 125620 .
|
||||
127885) (\DRAWELLIPSE.DISPLAY 127887 . 143556) (\DRAWCURVE.DISPLAY 143558 . 145847) (
|
||||
\DRAWPOINT.DISPLAY 145849 . 147045) (\DRAWPOLYGON.DISPLAY 147047 . 150575) (\LINEWITHBRUSH 150577 .
|
||||
161793)) (161796 193488 (LOADPOLY 161806 . 162366) (PARAMETRICSPLINE 162368 . 172565) (\CURVE 172567
|
||||
. 178169) (\CURVE2 178171 . 189502) (\CURVEEND 189504 . 189986) (\CURVESLOPE 189988 . 192471) (
|
||||
\CURVESTART 192473 . 192797) (\FDIFS/FROM/DERIVS 192799 . 193486)) (206017 220353 (\FILLCIRCLE.DISPLAY
|
||||
206027 . 216775) (\LINEBLT 216777 . 220351)) (220397 222397 (SCREENBITMAP 220407 . 220884) (BITMAPP
|
||||
220886 . 221120) (BITMAPHEIGHT 221122 . 221498) (BITSPERPIXEL 221500 . 222395)) (223038 224031 (
|
||||
DSPFILL 223048 . 223731) (INVERTW 223733 . 224029)) (224032 227675 (\DSPCOLOR.DISPLAY 224042 . 225339)
|
||||
(\DSPBACKCOLOR.DISPLAY 225341 . 226720) (DSPEOLFN 226722 . 227673)) (228108 232762 (DSPCLEOL 228118
|
||||
. 228994) (DSPRUBOUTCHAR 228996 . 229428) (\DSPMOVELR 229430 . 232760)) (232892 234010 (
|
||||
\CURSOR.DEFPRINT 232902 . 234008)) (234422 242996 (TEXTUREOFCOLOR 234432 . 235694) (\PRIMARYTEXTURE
|
||||
235696 . 236278) (\LEVELTEXTURE 236280 . 236781) (INSURE.B&W.TEXTURE 236783 . 238178) (
|
||||
INSURE.RGB.COLOR 238180 . 239608) (\LOOKUPCOLORNAME 239610 . 239880) (RGBP 239882 . 240647) (HLSP
|
||||
240649 . 241024) (HLSTORGB 241026 . 242166) (\HLSVALUEFN 242168 . 242994)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
BIN
sources/UFS.LCOM
BIN
sources/UFS.LCOM
Binary file not shown.
Binary file not shown.
Reference in New Issue
Block a user