From 2dcfac535063c74f2c1e5a3d611ced733417e642 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Wed, 22 Dec 2021 20:56:57 -0800 Subject: [PATCH 1/2] Rmk12: Lispusers packages of general utility, but especially for git compare (#634) * TEXTOFD: Property OBJECTBYTE returned instead of image objects This allows COMPARETEXT to work on TEDIT files * ATBL: Default reader environment uses *DEFAULT-EXTERNALFORMAT* instead of :XCCS constant * CMLEXEC: Fix FILETYPE property It had CL:COMPILE-FILE, but the directory had LCOMs. Changed to :FAKE-COMPILE-FILE. * FILEIO: single place for EOL specification Now only in SETFILEINFO, not separately in \DO.PARAMS.AT.OPEN * WINDOWOBJ: COPYINSERT now uniformly allows lists of objects It was incomplete. * COMPARETEXT: Now works for TEDIT files * EXAMINEDEFS: side-by-side attached SEDIT windows for comparing alternative definitions * OBJECTWINDOW: container for arbitrary image objects --- library/TEXTOFD | 688 +++++++++------- library/TEXTOFD.LCOM | Bin 38810 -> 39128 bytes lispusers/COMPARETEXT.LCOM | Bin 9013 -> 9124 bytes lispusers/EXAMINEDEFS | 120 +++ lispusers/EXAMINEDEFS.LCOM | Bin 0 -> 2236 bytes lispusers/EXAMINEDEFS.TEDIT | Bin 0 -> 4371 bytes lispusers/OBJECTWINDOW | 1496 ++++++++++++++++++++++++++++++++++ lispusers/OBJECTWINDOW.LCOM | Bin 0 -> 25686 bytes lispusers/OBJECTWINDOW.TEDIT | Bin 0 -> 5918 bytes lispusers/comparetext | 166 ++-- sources/ATBL | 299 +++---- sources/ATBL.LCOM | Bin 35276 -> 35256 bytes sources/CMLEXEC | 556 +++++++------ sources/CMLEXEC.LCOM | Bin 47308 -> 47349 bytes sources/FILEIO | 178 ++-- sources/FILEIO.LCOM | Bin 45528 -> 45531 bytes sources/WINDOWOBJ | 148 ++-- sources/WINDOWOBJ.LCOM | Bin 10717 -> 10802 bytes 18 files changed, 2668 insertions(+), 983 deletions(-) create mode 100644 lispusers/EXAMINEDEFS create mode 100644 lispusers/EXAMINEDEFS.LCOM create mode 100644 lispusers/EXAMINEDEFS.TEDIT create mode 100644 lispusers/OBJECTWINDOW create mode 100644 lispusers/OBJECTWINDOW.LCOM create mode 100644 lispusers/OBJECTWINDOW.TEDIT diff --git a/library/TEXTOFD b/library/TEXTOFD index b32fdd96..12667cea 100644 --- a/library/TEXTOFD +++ b/library/TEXTOFD @@ -1,12 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "12-Oct-2021 15:38:41"  -{DSK}kaplan>Local>medley3.5>git-medley>library>TEXTOFD.;4 176302 +(FILECREATED "22-Dec-2021 10:29:27" {DSK}kaplan>Local>medley3.5>my-medley>library>TEXTOFD.;12 182752 - changes to%: (FNS \TEDITOUTCCODEFN) + :CHANGES-TO (FNS \TEXTBIN \TEXTPEEKBIN) - previous date%: " 7-Oct-2021 08:41:13" -{DSK}kaplan>Local>medley3.5>git-medley>library>TEXTOFD.;3) + :PREVIOUS-DATE "22-Dec-2021 10:01:53" +{DSK}kaplan>Local>medley3.5>my-medley>library>TEXTOFD.;11) (* ; " @@ -31,7 +30,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (FNS \CHTOPC \CHTOPCNO \CLEARPCTB \CREATEPIECEORSTREAM \DELETEPIECE \FINDPIECE \INSERTPIECE \MAKEPCTB \SPLITPIECE \INSERT.FIRST.PIECE)) (COMS (* ; - "Generic-IO type operations support") + "Generic-IO type operations support") (FNS \TEXTCLOSEF \TEXTCLOSEF-SUBTREE \TEXTDSPFONT \TEXTEOFP \TEXTGETEOFPTR \TEXTGETFILEPTR \TEXTOPENF \TEXTOPENF-SUBTREE \TEXTOUTCHARFN \TEXTBACKFILEPTR \TEXTBOUT \TEDITOUTCCODEFN \TEXTSETEOF \TEXTSETFILEPTR \TEXTDSPXPOSITION @@ -1913,214 +1912,248 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (DEFINEQ (\TEXTBIN - [LAMBDA (STREAM) (* ; "Edited 28-Mar-94 15:33 by jds") + [LAMBDA (STREAM) + + (* ;; "Edited 22-Dec-2021 10:29 by rmk: Return value of OBJECTCHAR property for image objecdts") + + (* ;; "Edited 28-Mar-94 15:33 by jds") (* ;;; "Do BIN slow case for a text stream") (* ; - "NB that PEEKBIN and BACKFILEPTR need to track changes in this code") + "NB that PEEKBIN and BACKFILEPTR need to track changes in this code") (DECLARE (LOCALVARS . T)) - (PROG (CH FILE STR PF PS PC PO NPC OPC SUBSTREAM) - (COND - [(ILESSP (fetch (STREAM COFFSET) of STREAM) - (fetch (STREAM CBUFSIZE) of STREAM)) + (LET (BYTE) (* ; + "RMK: Capture all return values for any special imageobject coercion") + [SETQ BYTE (PROG (CH FILE STR PF PS PC PO NPC OPC SUBSTREAM) + (COND + [(ILESSP (fetch (STREAM COFFSET) of STREAM) + (fetch (STREAM CBUFSIZE) of STREAM)) (* ; - "Simple case -- just do the usual BIN") - (COND - [(SETQ PO (fetch (PIECE POBJ) of (fetch (TEXTSTREAM PIECE) of STREAM - ))) + "Simple case -- just do the usual BIN") + (COND + [(SETQ PO (fetch (PIECE POBJ) of (fetch (TEXTSTREAM PIECE) + of STREAM))) (* ; "Handle objects specially") - (COND - ((SETQ SUBSTREAM (IMAGEOBJPROP PO 'SUBSTREAM)) + (COND + ((SETQ SUBSTREAM (IMAGEOBJPROP PO 'SUBSTREAM)) (* ; - "If this object has a substream in it, go to that substream") - (add (fetch (STREAM COFFSET) of STREAM) - 1) - (RETURN (\BIN SUBSTREAM))) - (T - (* ;; "Otherwise, just return the object as BIN's result, and make sure we'll go to the next page next time.") + "If this object has a substream in it, go to that substream") + (add (fetch (STREAM COFFSET) of STREAM) + 1) + (RETURN (\BIN SUBSTREAM))) + (T + (* ;; "Otherwise, just return the object as BIN's result, and make sure we'll go to the next page next time.") - (replace (STREAM COFFSET) of STREAM with (fetch (STREAM - CBUFSIZE) - of STREAM)) - (replace (TEXTSTREAM CHARSLEFT) of STREAM with 0) - (RETURN PO] - [(fetch (TEXTSTREAM FATSTREAMP) of STREAM) + (replace (STREAM COFFSET) of STREAM + with (fetch (STREAM CBUFSIZE) of STREAM)) + (replace (TEXTSTREAM CHARSLEFT) of STREAM with 0) + (RETURN PO] + [(fetch (TEXTSTREAM FATSTREAMP) of STREAM) (* ; - "This is a 16 bit BIN. grab 2 bytes.") + "This is a 16 bit BIN. grab 2 bytes.") (* ; - "WHAT HAPPENS IF THE SECOND BYTE IS ON ANOTHER PAGE??") - (RETURN (LOGOR (UNFOLD (\PAGEDBIN STREAM) - 256) - (COND - ((ILESSP (fetch (STREAM COFFSET) of STREAM) - (fetch (STREAM CBUFSIZE) of STREAM)) + "WHAT HAPPENS IF THE SECOND BYTE IS ON ANOTHER PAGE??") + (RETURN (LOGOR (UNFOLD (\PAGEDBIN STREAM) + 256) + (COND + ((ILESSP (fetch (STREAM COFFSET) of STREAM) + (fetch (STREAM CBUFSIZE) of STREAM)) (* ; - "This pair of characters doesn't straddle a file page bound. Just grab the next char.") - (\PAGEDBIN STREAM)) - (T (* ; - "Need to move to the next page on the backing file. Doing so also grabs the next character.") - (\TEDIT.TEXTBIN.NEW.PAGE STREAM T] - (T (RETURN (\PAGEDBIN STREAM] - (T (* ; - "We've either hit a page bound in a file, or a piece bound.") - (RETURN (COND - [(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM)) + "This pair of characters doesn't straddle a file page bound. Just grab the next char.") + (\PAGEDBIN STREAM)) + (T (* ; + "Need to move to the next page on the backing file. Doing so also grabs the next character.") + (\TEDIT.TEXTBIN.NEW.PAGE STREAM T] + (T (RETURN (\PAGEDBIN STREAM] + (T (* ; + "We've either hit a page bound in a file, or a piece bound.") + (RETURN (COND + [(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM)) (* ; "Time for a new piece.") - [repeatwhile (AND PC (ZEROP (fetch (PIECE PLEN) of PC))) - do (* ; - "Skip over any zero-length pieces at the end of the file.") - (SETQ OPC (fetch (TEXTSTREAM PIECE) of STREAM)) - (SETQ PC (replace (TEXTSTREAM PIECE) of STREAM - with (AND OPC (fetch (PIECE NEXTPIECE) - of OPC] - (replace (STREAM BINABLE) of STREAM with T) - (replace (TEXTSTREAM FATSTREAMP) of STREAM with NIL) + [repeatwhile (AND PC (ZEROP (fetch (PIECE PLEN) + of PC))) + do (* ; + "Skip over any zero-length pieces at the end of the file.") + (SETQ OPC (fetch (TEXTSTREAM PIECE) of STREAM)) + (SETQ PC (replace (TEXTSTREAM PIECE) of STREAM + with (AND OPC (fetch (PIECE NEXTPIECE) + of OPC] + (replace (STREAM BINABLE) of STREAM with T) + (replace (TEXTSTREAM FATSTREAMP) of STREAM with NIL) (* ; - "Move to the next piece in the chain") - (COND - [PC (* ; - "There IS a next piece to move to.") - (AND (fetch (TEXTSTREAM LOOKSUPDATEFN) of STREAM) - (SETQ NPC (APPLY* (fetch (TEXTSTREAM LOOKSUPDATEFN) - of STREAM) - STREAM PC)) - (replace (TEXTSTREAM PIECE) of STREAM - with (SETQ PC NPC))) + "Move to the next piece in the chain") + (COND + [PC (* ; "There IS a next piece to move to.") + (AND (fetch (TEXTSTREAM LOOKSUPDATEFN) + of STREAM) + (SETQ NPC (APPLY* (fetch (TEXTSTREAM + LOOKSUPDATEFN + ) + of STREAM) + STREAM PC)) + (replace (TEXTSTREAM PIECE) of STREAM + with (SETQ PC NPC))) (* ; - "Take care of any piece-change uproar. uproar -- which may include picking a new piece to go to.") - [COND - (NPC (* ; - "If we got an NPC, this was taken care of by the LOOKSUPDATEFN") - ) - ([AND (SETQ PO (fetch (PIECE POBJ) of PC)) - (SETQ SUBSTREAM (IMAGEOBJPROP PO 'SUBSTREAM] - (\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ) - of SUBSTREAM)) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM - with (fetch (TEXTSTREAM CURRENTPARALOOKS) - of SUBSTREAM)) - (replace (TEXTSTREAM CURRENTLOOKS) of STREAM - with (fetch (TEXTSTREAM CURRENTLOOKS) of - SUBSTREAM - ))) - [(NEQ (fetch (PIECE PPARALOOKS) of OPC) - (fetch (PIECE PPARALOOKS) of PC)) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM - with (\TEDIT.APPLY.PARASTYLES (fetch (PIECE - PPARALOOKS - ) - of PC) - PC - (fetch (TEXTSTREAM TEXTOBJ) - of STREAM))) - (replace (TEXTSTREAM CURRENTLOOKS) of STREAM - with (\TEDIT.APPLY.STYLES (fetch (PIECE PLOOKS) - of PC) - PC - (fetch (TEXTSTREAM TEXTOBJ) - of STREAM] - ((NOT (EQCLOOKS (fetch (PIECE PLOOKS) of PC) - (fetch (PIECE PLOOKS) of OPC))) - (replace (TEXTSTREAM CURRENTLOOKS) of STREAM - with (\TEDIT.APPLY.STYLES (fetch (PIECE PLOOKS) - of PC) - PC - (fetch (TEXTSTREAM TEXTOBJ) - of STREAM] - (COND - ((SETQ PS (fetch (PIECE PSTR) of PC)) + "Take care of any piece-change uproar. uproar -- which may include picking a new piece to go to.") + [COND + (NPC (* ; + "If we got an NPC, this was taken care of by the LOOKSUPDATEFN") + ) + ([AND (SETQ PO (fetch (PIECE POBJ) of PC)) + (SETQ SUBSTREAM (IMAGEOBJPROP + PO + 'SUBSTREAM] + (\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ) + of SUBSTREAM)) + (replace (TEXTSTREAM CURRENTPARALOOKS) + of STREAM with (fetch (TEXTSTREAM + CURRENTPARALOOKS + ) of SUBSTREAM + )) + (replace (TEXTSTREAM CURRENTLOOKS) + of STREAM with (fetch (TEXTSTREAM + CURRENTLOOKS) + of SUBSTREAM))) + [(NEQ (fetch (PIECE PPARALOOKS) of OPC) + (fetch (PIECE PPARALOOKS) of PC)) + (replace (TEXTSTREAM CURRENTPARALOOKS) + of STREAM with (\TEDIT.APPLY.PARASTYLES + (fetch (PIECE PPARALOOKS) + of PC) + PC + (fetch (TEXTSTREAM TEXTOBJ) + of STREAM))) + (replace (TEXTSTREAM CURRENTLOOKS) + of STREAM with (\TEDIT.APPLY.STYLES + (fetch (PIECE PLOOKS) + of PC) + PC + (fetch (TEXTSTREAM TEXTOBJ) + of STREAM] + ((NOT (EQCLOOKS (fetch (PIECE PLOOKS) + of PC) + (fetch (PIECE PLOOKS) of OPC))) + (replace (TEXTSTREAM CURRENTLOOKS) + of STREAM with (\TEDIT.APPLY.STYLES + (fetch (PIECE PLOOKS) + of PC) + PC + (fetch (TEXTSTREAM TEXTOBJ) + of STREAM] + (COND + ((SETQ PS (fetch (PIECE PSTR) of PC)) (* ; "This piece lives in a string.") - (\TEDIT.TEXTBIN.STRINGSETUP 0 (fetch (PIECE PLEN) - of PC) - STREAM PS) + (\TEDIT.TEXTBIN.STRINGSETUP + 0 + (fetch (PIECE PLEN) of PC) + STREAM PS) (* ;; "Set the stream up so that it will use PS for BINs, starting at offset 0 (the front of the piece), and will run for as many chars as there are in the piece.") (* ; - "Then actually grab the next character to hand back to the caller.") - (\BIN STREAM)) - ((SETQ PF (fetch (PIECE PFILE) of PC)) + "Then actually grab the next character to hand back to the caller.") + (\BIN STREAM)) + ((SETQ PF (fetch (PIECE PFILE) of PC)) (* ; "This piece lives on a file.") - (\TEDIT.TEXTBIN.FILESETUP PC 0 (fetch (PIECE PLEN) - of PC) - STREAM PF (fetch (PIECE PFATP) of PC) - 'PEEKBIN) - (\BIN STREAM)) - [(SETQ PO (fetch (PIECE POBJ) of PC)) - (replace (STREAM BINABLE) of STREAM with NIL) - (COND - (SUBSTREAM (* ; - "There is a stream below this one, to feed chars upward.") - (\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ) - of SUBSTREAM)) - (freplace (STREAM COFFSET) of STREAM - with 0) - (freplace (TEXTSTREAM CHARSLEFT) of STREAM - with (fetch (PIECE PLEN) of PC)) - (freplace (STREAM CBUFSIZE) of STREAM - with (fetch (PIECE PLEN) of PC)) - (freplace (STREAM CPAGE) of STREAM - with 0) - (freplace (TEXTSTREAM PCSTARTCH) of STREAM - with 0) - (freplace (TEXTSTREAM PCSTARTPG) of STREAM - with 0) - (replace (TEXTSTREAM CURRENTPARALOOKS) - of STREAM with (fetch (TEXTSTREAM - - CURRENTPARALOOKS - ) of - SUBSTREAM)) - (replace (TEXTSTREAM CURRENTLOOKS) of STREAM - with (fetch (TEXTSTREAM CURRENTLOOKS) - of SUBSTREAM)) - (RETURN (\BIN SUBSTREAM))) - (T (replace (TEXTSTREAM CHARSLEFT) of STREAM - with 0) - (RETURN PO] - (T (ERROR "CAN'T GET TO NEXT PIECE"] - (T (* ; - "There are no more pieces. Punt gracefully") - (COND - ((fetch (STREAM ENDOFSTREAMOP) of STREAM) + (\TEDIT.TEXTBIN.FILESETUP PC 0 + (fetch (PIECE PLEN) of PC) + STREAM PF (fetch (PIECE PFATP) + of PC) + 'PEEKBIN) + (\BIN STREAM)) + [(SETQ PO (fetch (PIECE POBJ) of PC)) + (replace (STREAM BINABLE) of STREAM + with NIL) + (COND + (SUBSTREAM (* ; - "If there's an EOF handler, call it & return the result") - (RETURN (APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM - ) - STREAM))) - (T (* ; "Otherwise, return NIL") - (RETURN NIL] - [(SETQ PO (fetch (PIECE POBJ) of (fetch (TEXTSTREAM PIECE) - of STREAM))) + "There is a stream below this one, to feed chars upward.") + (\SETUPGETCH 1 (fetch (TEXTSTREAM + TEXTOBJ) + of SUBSTREAM)) + (freplace (STREAM COFFSET) + of STREAM with 0) + (freplace (TEXTSTREAM CHARSLEFT) + of STREAM + with (fetch (PIECE PLEN) + of PC)) + (freplace (STREAM CBUFSIZE) + of STREAM + with (fetch (PIECE PLEN) + of PC)) + (freplace (STREAM CPAGE) + of STREAM with 0) + (freplace (TEXTSTREAM PCSTARTCH) + of STREAM with 0) + (freplace (TEXTSTREAM PCSTARTPG) + of STREAM with 0) + (replace (TEXTSTREAM + CURRENTPARALOOKS) + of STREAM + with (fetch (TEXTSTREAM + CURRENTPARALOOKS + ) of SUBSTREAM + )) + (replace (TEXTSTREAM CURRENTLOOKS) + of STREAM + with (fetch (TEXTSTREAM + CURRENTLOOKS) + of SUBSTREAM)) + (RETURN (\BIN SUBSTREAM))) + (T (replace (TEXTSTREAM CHARSLEFT) + of STREAM with 0) + (RETURN PO] + (T (ERROR "CAN'T GET TO NEXT PIECE"] + (T (* ; + "There are no more pieces. Punt gracefully") + (COND + ((fetch (STREAM ENDOFSTREAMOP) of STREAM) + (* ; + "If there's an EOF handler, call it & return the result") + (RETURN (APPLY* (fetch (STREAM ENDOFSTREAMOP) + of STREAM) + STREAM))) + (T (* ; "Otherwise, return NIL") + (RETURN NIL] + [(SETQ PO (fetch (PIECE POBJ) of (fetch (TEXTSTREAM PIECE) + of STREAM))) (* ; "This is an object") - (replace (STREAM BINABLE) of STREAM with NIL) - (COND - (SUBSTREAM (* ; - "There is a stream below this one, to feed chars upward.") - (\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ) of - SUBSTREAM)) - (freplace (STREAM COFFSET) of STREAM with 1) - (freplace (TEXTSTREAM CHARSLEFT) of STREAM with - 0) - (freplace (STREAM CBUFSIZE) of STREAM - with (fetch (PIECE PLEN) of PC)) - (freplace (STREAM CPAGE) of STREAM with 0) - (freplace (TEXTSTREAM PCSTARTCH) of STREAM with - 1) - (freplace (TEXTSTREAM PCSTARTPG) of STREAM with - 0) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM - with (fetch (TEXTSTREAM CURRENTPARALOOKS) - of SUBSTREAM)) - (replace (TEXTSTREAM CURRENTLOOKS) of STREAM - with (fetch (TEXTSTREAM CURRENTLOOKS) of - SUBSTREAM - )) - (RETURN (\BIN SUBSTREAM))) - (T (replace (TEXTSTREAM CHARSLEFT) of STREAM with 0) - (RETURN PO] - (T (* ; - "Need to move to the next page in a file.") - (RETURN (\TEDIT.TEXTBIN.NEW.PAGE STREAM]) + (replace (STREAM BINABLE) of STREAM with NIL) + (COND + (SUBSTREAM (* ; + "There is a stream below this one, to feed chars upward.") + (\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ) + of SUBSTREAM)) + (freplace (STREAM COFFSET) of STREAM + with 1) + (freplace (TEXTSTREAM CHARSLEFT) of STREAM + with 0) + (freplace (STREAM CBUFSIZE) of STREAM + with (fetch (PIECE PLEN) of PC)) + (freplace (STREAM CPAGE) of STREAM with 0) + (freplace (TEXTSTREAM PCSTARTCH) of STREAM + with 1) + (freplace (TEXTSTREAM PCSTARTPG) of STREAM + with 0) + (replace (TEXTSTREAM CURRENTPARALOOKS) + of STREAM with (fetch (TEXTSTREAM + CURRENTPARALOOKS + ) of SUBSTREAM) + ) + (replace (TEXTSTREAM CURRENTLOOKS) of STREAM + with (fetch (TEXTSTREAM CURRENTLOOKS) + of SUBSTREAM)) + (RETURN (\BIN SUBSTREAM))) + (T (replace (TEXTSTREAM CHARSLEFT) of STREAM + with 0) + (RETURN PO] + (T (* ; + "Need to move to the next page in a file.") + (RETURN (\TEDIT.TEXTBIN.NEW.PAGE STREAM] + (IF (IMAGEOBJP BYTE) + THEN (OR (GETTEXTPROP (FETCH (TEXTSTREAM TEXTOBJ) OF STREAM) + 'OBJECTBYTE) + BYTE) + ELSE BYTE]) (\TEDIT.TEXTBIN.STRINGSETUP [LAMBDA (CHOFFSET CHARSLEFT STREAM PS) (* ; "Edited 31-May-91 14:21 by jds") @@ -2353,123 +2386,144 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (DEFINEQ (\TEXTPEEKBIN - [LAMBDA (STREAM NOERRORFLG) (* ; "Edited 28-Mar-94 15:34 by jds") + [LAMBDA (STREAM NOERRORFLG) + + (* ;; "Edited 22-Dec-2021 10:29 by rmk: Return OBJECTCHAR for image objects, if present") + + (* ;; "Edited 28-Mar-94 15:34 by jds") (* ; "DO PEEKBIN for a text stream") - (PROG (CH FILE STR PF PS PC PO SUBSTREAM) - (SETQ PC (fetch (TEXTSTREAM PIECE) of STREAM)) - (COND - [(ILESSP (fetch (STREAM COFFSET) of STREAM) - (fetch (STREAM CBUFSIZE) of STREAM)) + (LET (BYTE) (* ; + "BYTE to capture all returns for imageobject coercion") + [SETQ BYTE (PROG (CH FILE STR PF PS PC PO SUBSTREAM) + (SETQ PC (fetch (TEXTSTREAM PIECE) of STREAM)) + (COND + [(ILESSP (fetch (STREAM COFFSET) of STREAM) + (fetch (STREAM CBUFSIZE) of STREAM)) (* ; - "Simple case -- just do the usual PEEKBIN") - (COND - ((AND PC (fetch (PIECE POBJ) of PC)) - (RETURN (fetch (PIECE POBJ) of PC))) - [(fetch (TEXTSTREAM FATSTREAMP) of STREAM) - (* ; - "This is a 16 bit PEEKBIN. Grab two chars...") - (RETURN (COND - [(\EOFP STREAM) + "Simple case -- just do the usual PEEKBIN") (COND - (NOERRORFLG NIL) - (T (\PEEKBIN STREAM] - ((ILESSP (fetch (STREAM COFFSET) of STREAM) - (SUB1 (fetch (STREAM CBUFSIZE) of STREAM))) + ((AND PC (SETQ PO (fetch (PIECE POBJ) of PC))) + (RETURN PO)) + [(fetch (TEXTSTREAM FATSTREAMP) of STREAM) (* ; - "We're sure of staying on the same page. Just grab the characters") - (PROG1 (LOGOR (UNFOLD (\PAGEDBIN STREAM) - 256) - (\PAGEDPEEKBIN STREAM NOERRORFLG)) - (\PAGEDBACKFILEPTR STREAM))) - (T (SETQ PS (fetch (STREAM F1) of STREAM)) - (replace (STREAM COFFSET) of PS with (fetch - (STREAM COFFSET) - of STREAM)) - (PROG1 (LOGOR (UNFOLD (\PAGEDBIN PS) - 256) - (\PAGEDPEEKBIN PS NOERRORFLG)) - (\PAGEDBACKFILEPTR PS] - (T (RETURN (\PAGEDPEEKBIN STREAM NOERRORFLG] - [PC (* ; - "We've either hit a page bound in a file, or a piece bound.") - (RETURN (COND - [(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM)) + "This is a 16 bit PEEKBIN. Grab two chars...") + (RETURN (COND + [(\EOFP STREAM) + (COND + (NOERRORFLG NIL) + (T (\PEEKBIN STREAM] + ((ILESSP (fetch (STREAM COFFSET) of STREAM) + (SUB1 (fetch (STREAM CBUFSIZE) of STREAM))) + (* ; + "We're sure of staying on the same page. Just grab the characters") + (PROG1 (LOGOR (UNFOLD (\PAGEDBIN STREAM) + 256) + (\PAGEDPEEKBIN STREAM NOERRORFLG)) + (\PAGEDBACKFILEPTR STREAM))) + (T (SETQ PS (fetch (STREAM F1) of STREAM)) + (replace (STREAM COFFSET) of PS + with (fetch (STREAM COFFSET) of STREAM)) + (PROG1 (LOGOR (UNFOLD (\PAGEDBIN PS) + 256) + (\PAGEDPEEKBIN PS NOERRORFLG)) + (\PAGEDBACKFILEPTR PS] + (T (RETURN (\PAGEDPEEKBIN STREAM NOERRORFLG] + [PC (* ; + "We've either hit a page bound in a file, or a piece bound.") + (RETURN (COND + [(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM)) (* ; "Time for a new piece.") - (SETQ PC (replace (TEXTSTREAM PIECE) of STREAM - with (fetch (PIECE NEXTPIECE) of PC))) + (SETQ PC (replace (TEXTSTREAM PIECE) of STREAM + with (fetch (PIECE NEXTPIECE) of PC))) (* ; - "Move to the next piece in the chain") - (COND - [PC (replace (TEXTSTREAM CURRENTLOOKS) of STREAM - with (\TEDIT.APPLY.STYLES (fetch (PIECE PLOOKS) - of PC) - PC - (fetch (TEXTSTREAM TEXTOBJ) of STREAM) - )) - (COND - [(SETQ PO (fetch (PIECE POBJ) of PC)) - (replace (STREAM BINABLE) of STREAM with NIL) - (freplace (STREAM CBUFSIZE) of STREAM - with (fetch (PIECE PLEN) of PC)) - (freplace (STREAM COFFSET) of STREAM with 0) - (COND - (SUBSTREAM (* ; - "There is a stream below this one, to feed chars upward.") - (\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ) - of SUBSTREAM)) - (freplace (TEXTSTREAM CHARSLEFT) of STREAM - with (fetch (PIECE PLEN) of PC)) - (freplace (STREAM CPAGE) of STREAM - with 0) - (freplace (TEXTSTREAM PCSTARTCH) of STREAM - with 0) - (freplace (TEXTSTREAM PCSTARTPG) of STREAM - with 0) - (replace (TEXTSTREAM CURRENTPARALOOKS) - of STREAM with (fetch (TEXTSTREAM - + "Move to the next piece in the chain") + (COND + [PC (replace (TEXTSTREAM CURRENTLOOKS) of STREAM + with (\TEDIT.APPLY.STYLES (fetch (PIECE PLOOKS + ) + of PC) + PC + (fetch (TEXTSTREAM TEXTOBJ) + of STREAM))) + (COND + [(SETQ PO (fetch (PIECE POBJ) of PC)) + (replace (STREAM BINABLE) of STREAM + with NIL) + (freplace (STREAM CBUFSIZE) of STREAM + with (fetch (PIECE PLEN) of PC)) + (freplace (STREAM COFFSET) of STREAM + with 0) + (COND + (SUBSTREAM + (* ; + "There is a stream below this one, to feed chars upward.") + (\SETUPGETCH 1 (fetch (TEXTSTREAM + TEXTOBJ) + of SUBSTREAM)) + (freplace (TEXTSTREAM CHARSLEFT) + of STREAM + with (fetch (PIECE PLEN) + of PC)) + (freplace (STREAM CPAGE) + of STREAM with 0) + (freplace (TEXTSTREAM PCSTARTCH) + of STREAM with 0) + (freplace (TEXTSTREAM PCSTARTPG) + of STREAM with 0) + (replace (TEXTSTREAM + CURRENTPARALOOKS) + of STREAM + with (fetch (TEXTSTREAM CURRENTPARALOOKS ) - of SUBSTREAM)) - (replace (TEXTSTREAM CURRENTLOOKS) of - STREAM - with (fetch (TEXTSTREAM CURRENTLOOKS) - of SUBSTREAM)) - (RETURN (\BIN SUBSTREAM))) - (T (replace (TEXTSTREAM CHARSLEFT) of STREAM - with 0) - (RETURN PO] - ((SETQ PS (fetch (PIECE PSTR) of PC)) + of SUBSTREAM)) + (replace (TEXTSTREAM CURRENTLOOKS) + of STREAM + with (fetch (TEXTSTREAM + CURRENTLOOKS) + of SUBSTREAM)) + (RETURN (\BIN SUBSTREAM))) + (T (replace (TEXTSTREAM CHARSLEFT) + of STREAM with 0) + (RETURN PO] + ((SETQ PS (fetch (PIECE PSTR) of PC)) (* ; "This piece lives in a string.") - (\TEDIT.TEXTBIN.STRINGSETUP 0 (fetch (PIECE PLEN) - of PC) - STREAM PS) + (\TEDIT.TEXTBIN.STRINGSETUP + 0 + (fetch (PIECE PLEN) of PC) + STREAM PS) (* ;; "Set the stream up so that it will use PS for BINs, starting at offset 0 (the front of the piece), and will run for as many chars as there are in the piece.") - (\PEEKBIN STREAM NOERRORFLG)) - ((SETQ PF (fetch (PIECE PFILE) of PC)) + (\PEEKBIN STREAM NOERRORFLG)) + ((SETQ PF (fetch (PIECE PFILE) of PC)) (* ; "This piece lives on a file.") - (\TEDIT.TEXTBIN.FILESETUP PC 0 (fetch (PIECE PLEN) - of PC) - STREAM PF (fetch (PIECE PFATP) of PC) - 'PEEKBIN NOERRORFLG)) - (T (ERROR "CAN'T GET TO NEXT PIECE"] - (NOERRORFLG (* ; - "There are no more pieces. Punt gracefully") - (RETURN NIL)) - (T (* ; "He wants it the hard way.") - (APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM) - STREAM] - (T (* ; - "Need to move to the next page in a file.") - (RETURN (\TEDIT.PEEKBIN.NEW.PAGE STREAM NOERRORFLG] - (NOERRORFLG (* ; - "There are no more pieces. Punt gracefully") - (RETURN NIL)) - (T (* ; "He wants it the hard way.") - (APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM) - STREAM]) + (\TEDIT.TEXTBIN.FILESETUP PC 0 + (fetch (PIECE PLEN) of PC) + STREAM PF (fetch (PIECE PFATP) + of PC) + 'PEEKBIN NOERRORFLG)) + (T (ERROR "CAN'T GET TO NEXT PIECE"] + (NOERRORFLG (* ; + "There are no more pieces. Punt gracefully") + (RETURN NIL)) + (T (* ; "He wants it the hard way.") + (APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM) + STREAM] + (T (* ; + "Need to move to the next page in a file.") + (RETURN (\TEDIT.PEEKBIN.NEW.PAGE STREAM NOERRORFLG] + (NOERRORFLG (* ; + "There are no more pieces. Punt gracefully") + (RETURN NIL)) + (T (* ; "He wants it the hard way.") + (APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM) + STREAM] + (IF (IMAGEOBJP BYTE) + THEN (OR (GETTEXTPROP (FETCH (TEXTSTREAM TEXTOBJ) OF STREAM) + 'OBJECTBYTE) + BYTE) + ELSE BYTE]) (\TEDIT.PEEKBIN.NEW.PAGE [LAMBDA (STREAM NOERRORFLG) (* ; "Edited 11-Jun-99 15:11 by rmk:") @@ -2667,25 +2721,25 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (PUTPROPS TEXTOFD COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991 1993 1994 1995 1999 2000 2001 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2989 53114 (COPYTEXTSTREAM 2999 . 6121) (OPENTEXTSTREAM 6123 . 21000) (REOPENTEXTSTREAM - 21002 . 21424) (TEDIT.STREAMCHANGEDP 21426 . 21724) (TEXTSTREAMP 21726 . 22040) (TXTFILE 22042 . -22487) (\DELETECH 22489 . 33745) (\SETUPGETCH 33747 . 41026) (\TEDIT.REOPEN.STREAM 41028 . 42878) ( -\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 42880 . 45318) (\TEXTINIT 45320 . 51007) (\TEXTMARK 51009 . 51757) ( -\TEXTTTYBOUT 51759 . 53112)) (53115 78547 (\INSERTCH 53125 . 76851) (\INSERTCR 76853 . 78545)) (78613 -98929 (\CHTOPC 78623 . 79812) (\CHTOPCNO 79814 . 81076) (\CLEARPCTB 81078 . 81874) ( -\CREATEPIECEORSTREAM 81876 . 84850) (\DELETEPIECE 84852 . 85765) (\FINDPIECE 85767 . 86133) ( -\INSERTPIECE 86135 . 89145) (\MAKEPCTB 89147 . 91062) (\SPLITPIECE 91064 . 98023) (\INSERT.FIRST.PIECE - 98025 . 98927)) (98981 123219 (\TEXTCLOSEF 98991 . 100218) (\TEXTCLOSEF-SUBTREE 100220 . 100926) ( -\TEXTDSPFONT 100928 . 101920) (\TEXTEOFP 101922 . 103281) (\TEXTGETEOFPTR 103283 . 103493) ( -\TEXTGETFILEPTR 103495 . 105558) (\TEXTOPENF 105560 . 106390) (\TEXTOPENF-SUBTREE 106392 . 107193) ( -\TEXTOUTCHARFN 107195 . 107543) (\TEXTBACKFILEPTR 107545 . 113446) (\TEXTBOUT 113448 . 116796) ( -\TEDITOUTCCODEFN 116798 . 118064) (\TEXTSETEOF 118066 . 118575) (\TEXTSETFILEPTR 118577 . 119802) ( -\TEXTDSPXPOSITION 119804 . 120661) (\TEXTDSPYPOSITION 120663 . 121208) (\TEXTLEFTMARGIN 121210 . -121693) (\TEXTRIGHTMARGIN 121695 . 122631) (\TEXTDSPCHARWIDTH 122633 . 122871) (\TEXTDSPSTRINGWIDTH -122873 . 123113) (\TEXTDSPLINEFEED 123115 . 123217)) (123220 156964 (\TEXTBIN 123230 . 140016) ( -\TEDIT.TEXTBIN.STRINGSETUP 140018 . 145731) (\TEDIT.TEXTBIN.FILESETUP 145733 . 152119) ( -\TEDIT.TEXTBIN.NEW.PAGE 152121 . 156962)) (156965 170373 (\TEXTPEEKBIN 156975 . 166114) ( -\TEDIT.PEEKBIN.NEW.PAGE 166116 . 170371)) (170411 175629 (CGETTEXTPROP 170421 . 170897) (CTEXTPROP -170899 . 173243) (GETTEXTPROP 173245 . 173840) (PUTTEXTPROP 173842 . 175167) (TEXTPROP 175169 . 175627 + (FILEMAP (NIL (2992 53117 (COPYTEXTSTREAM 3002 . 6124) (OPENTEXTSTREAM 6126 . 21003) (REOPENTEXTSTREAM + 21005 . 21427) (TEDIT.STREAMCHANGEDP 21429 . 21727) (TEXTSTREAMP 21729 . 22043) (TXTFILE 22045 . +22490) (\DELETECH 22492 . 33748) (\SETUPGETCH 33750 . 41029) (\TEDIT.REOPEN.STREAM 41031 . 42881) ( +\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 42883 . 45321) (\TEXTINIT 45323 . 51010) (\TEXTMARK 51012 . 51760) ( +\TEXTTTYBOUT 51762 . 53115)) (53118 78550 (\INSERTCH 53128 . 76854) (\INSERTCR 76856 . 78548)) (78616 +98932 (\CHTOPC 78626 . 79815) (\CHTOPCNO 79817 . 81079) (\CLEARPCTB 81081 . 81877) ( +\CREATEPIECEORSTREAM 81879 . 84853) (\DELETEPIECE 84855 . 85768) (\FINDPIECE 85770 . 86136) ( +\INSERTPIECE 86138 . 89148) (\MAKEPCTB 89150 . 91065) (\SPLITPIECE 91067 . 98026) (\INSERT.FIRST.PIECE + 98028 . 98930)) (98984 123222 (\TEXTCLOSEF 98994 . 100221) (\TEXTCLOSEF-SUBTREE 100223 . 100929) ( +\TEXTDSPFONT 100931 . 101923) (\TEXTEOFP 101925 . 103284) (\TEXTGETEOFPTR 103286 . 103496) ( +\TEXTGETFILEPTR 103498 . 105561) (\TEXTOPENF 105563 . 106393) (\TEXTOPENF-SUBTREE 106395 . 107196) ( +\TEXTOUTCHARFN 107198 . 107546) (\TEXTBACKFILEPTR 107548 . 113449) (\TEXTBOUT 113451 . 116799) ( +\TEDITOUTCCODEFN 116801 . 118067) (\TEXTSETEOF 118069 . 118578) (\TEXTSETFILEPTR 118580 . 119805) ( +\TEXTDSPXPOSITION 119807 . 120664) (\TEXTDSPYPOSITION 120666 . 121211) (\TEXTLEFTMARGIN 121213 . +121696) (\TEXTRIGHTMARGIN 121698 . 122634) (\TEXTDSPCHARWIDTH 122636 . 122874) (\TEXTDSPSTRINGWIDTH +122876 . 123116) (\TEXTDSPLINEFEED 123118 . 123220)) (123223 161060 (\TEXTBIN 123233 . 144112) ( +\TEDIT.TEXTBIN.STRINGSETUP 144114 . 149827) (\TEDIT.TEXTBIN.FILESETUP 149829 . 156215) ( +\TEDIT.TEXTBIN.NEW.PAGE 156217 . 161058)) (161061 176823 (\TEXTPEEKBIN 161071 . 172564) ( +\TEDIT.PEEKBIN.NEW.PAGE 172566 . 176821)) (176861 182079 (CGETTEXTPROP 176871 . 177347) (CTEXTPROP +177349 . 179693) (GETTEXTPROP 179695 . 180290) (PUTTEXTPROP 180292 . 181617) (TEXTPROP 181619 . 182077 ))))) STOP diff --git a/library/TEXTOFD.LCOM b/library/TEXTOFD.LCOM index 3ff752612aa9fd8ad760542cf7b70510d71aabd1..288e39b863e87f4d7d9e086fd7ea30b5972216af 100644 GIT binary patch delta 4180 zcma)9-ESOM6`$Qr0vOj>FO%(JyWz4{$wy^(?%X?HrVq1Oj}ym^XX{-zO^H}&9ntJI zB(xv}DwwEMRPjXJDIisBCUNX4_p5>ks+d_2^kDDo@t2lKkrzb<><%yz< zOB<`JXwcI9{CpK{e*N2^evk*ZdTQ+C?9%dTP+t#ftzZ#V4~W&NqOBjyifAul6OCcl zbSx7s)X&w{&IZl7R)|h6tu+sh>=asPtOrjmha1hgMR4*79|neWw_g5|@Q}xNcRp`l z^ABBoNYiqYUpqW`W86QY!M_hQ@tgbj{&u4MjDPLVq?`K_?b06hH~Gg@?`HhY_34M7 z^gqKicN*VdKV$5_cBMBRe|Y_KQCLAqp~sC#!*{ek7dv{nAC{8B8~)W)>z_&CwbWEn zh=kwrrOv%K676@(hYNd!R}$@)Vm*szJ1MLRb9cwIeprEp`EFQAV~qAIspY=k9rEgj zMV`ZvJGs8!(I-Si-8)~9vE4Z?qPxZs%c9N$8 z2Oiu0q26O73-3dUFXW@uqZ4htcZ_d_db0w)C0<`U%N!E^cy_*godv=l;N#+EPXG2%DgEB> zUN}0jBMN})+~)7K^z`Ots@JRZ{U`VpRkEAhE1WB8CowiGbT(+Qe%M$K8_--`ik2_b z&IaL`^X${HP`vg1%5iL%E(+Gy!*%4k4!Yb7S{n_}te-6<*BXu0OY_avrPZK`9E?%$WPLRZSDMHs?vM=|dzo7nh;7heD~;NEO<1DTK$n-E z3D`LT0ZQ4lVf~ST$gm3w4M=8@^>^&xG?xe)WZ0R92aeg`Sn5D?2Z#&=Uz+qJj8a_>P!wi7$42Z1Qrw}z*N|s>Y7<(A>z3z4 z(vt;Ozyq-Wkzrewqi)%P8xY4-k`|PpSThxv6fhpPLOoR<)Ro~ztRUGfQ>a}L7R~aa z)K#md1eGfAiKj}7xJsX7`UG$hRtd!;0TDt`BzH|`bT`X|WK~Px0SFZnu8F5@I?9U) zsK|XVFGa8=j$*ZsUAR77Jf5tKF{Sa=_w*<$5}fIH0EfChM_oTWX5lGwuP%jT9+d*L zAFcq88eT3yTdmjDPPAD6Lok1>1@XJL$8uxwt+lQDtqDKyYL?(9EnoPx5t|D^un=^~1~L$9AThf2Nc5`-P0LR<4o%(?bJ_k( zTNgvX$cXk{sPD~-em@1Q^>ZPQ@s|F?WbPrq8%|A>dS9&djwN}MuTQkgy}yR#BtOgP zAjwa0MP@#w&JS|kzkhrm2Dv}nDo07~U&5~5E~OUaX<)#xloH85!cvV7a$=#Mf1>!7FO6`w_9Oj-MBjOLrzEc`H@iPfu@5}biU2B>%&{)p)SmcVFbnjp#|xU zFt{(b_{_(`uJpe12}Vzys-uj|*?1UnKMyAG|C_%P?H9rpn|{lQ_G9TxYnOV*JMs%A zn39-a0Kr)x`JJxZ%fr|>7wUs&i=iGjUa3SoWMCjTQIiAI{^|Gp?g~r-dhJ~S+3ENF zE{uo$=V1`wz?UVMqf>zG(4ir~wgzVa+i(Q&TVBorrk^TW!~>2Le>PbJGv0StHyRuZ z2)yQl<^U5YM=`cV;>TW{I?s-#oGXo*2FwSXg=_T{_Kq5@b!0*(8a{`Is2f`}{?V() zBA8Extl>0XH3y`&dGyc=Y~b1fez!A9w=*WQv1-beo3Wz>%q?gD#s(qL2o9w5Yr&tZ zLIM!EL?L3)xG3N*MIcfsTBD>#scK@BN)}NhlJPz@IUhtYnoyi^1JDxpO)@$nj!KAt zL$ME|n}~v#N{KZ;-m-}yna~907K^6Bz!Xyp^KWKMfU~BJGgid_n6Q9F+-#!43J1W6 tM+ML^ zd}n`KiQjt=|LnaaRtMa3O9QH+VubZU%^D>5R>f$#Fu&yQjqi3zKT0+5U}cby6gs;& zdv4*S(*j56f&d0l_2Uttlj$Xb*?_9)r`1t=}^<3t&$XL|9*SAS%SYG zCH9Oxd%ClhA;^ZToo}uSG)yw|(c5tlIy53pix3O*)=Ao=R?^)+LTr?$3D%gLTqS3Xhg<<_S=${V#` z+>WhHcioOqLG1@BRS80=lpz%QK9}4x3Ngi)a^}jGs@LB@nNF^zM=!?Ri;tOIsN>st>Xgh#@<#1iohD8nWz_ENL1~lH>cg4MmG1qvKFh46YbB9jd%d@W7YoA==vySd@Rdl z|EtA>7cmA6Bi*4UH#JQ4dVL`2GH(}d@&#Q}{y$xFR;q6s(KXDE;0ss?0;=o&17CNt z>>rr!T1{8nt{n;9>ftv-xurg=D2o5r)!jX|PLMM(;Z7h+!)U7LlqL&DoKp5EGA;kX z{=H46rusYX^fZ}@>YrKK=^3VqoOiN0*BvV&L(%GFbjv^^`OFc=Jv>^Na0^H`L1{Pw z4`vF5-0_2j%tWSGI-YZih+q&NKH&s>8nMJ#4bGb!!G?jR3ZQi8@W}WU7|M3wxo6w; zrYtk!0>`44{-(=!cJaGWv72{H}B$xu$J z)g*#d)i@1vnqli)y#Y0&B8DY=HVmB;b?%)3elq6`f<1B88Zv_nFvuBkV`2YLSo7GhZ38iAtJ zRT&Xol!Ry^exgS4Yc@}>2CAtKnju&H&vY0RIdP)QGZ zS%r3BjH)G4p+Y>=4K=c@LOXC)EP7p4cXlPAD>5l=bi4_u^Z+~BPz-$7>ZCpkW!(ufWUDV zh>-CtJfQ1~@PJAT!y`-uJTVGZC^#r6d(SrI&S5ssv@r}%@wiSyGVam42no~dHe8L?B{xy6RNMs33EQN? z7hntQuQdZMiWTaGV8}Hz?ogZ#JCvK?8zL-d<1%wYnyT(8bC=RNiux>59;3%kR{Qc1 z(-S{ba%Y!^RDc8uiChncfzCiOlN}4% zzEGM#*a9dGp;Pd|j2B>vg75o3qzLB`Qku&70B$@Sz&^VJbk(CVq?=-{1;d%k>o76+ zbQUKVZInhV4q628kOjHGssu8BB*zn){be{(($7C@U5;%fN z7^u{W&!FhCzjdQ6))w?uEphX4 F`@e`=Vl@B& diff --git a/lispusers/COMPARETEXT.LCOM b/lispusers/COMPARETEXT.LCOM index d2088fb8aab3f281d52ecca0e3ecf193bbe29732..d4839ced329292e5e866b38674ce4c688fd81631 100644 GIT binary patch delta 1521 zcmZux&u<%55Z>J+ZR3Dsw`o#bs3$HUn<|#~mmM1wdEGNaFfth zp$8BW>4_6aL=SO62o-UwAR#7)7F9m?g5X4vD)AQ}!G$AY-rIoEP|Mn#H*a=k-uHd; z_8MO|KUo-8lxcJ2>aR!t?0uqsn5&brkxpeJ1WE*YAfrB{;g+dm(%eU~m#M6?`Wb=t! z!*)nLAVx$?$Ue2b_nW7cBB&Lus6(}G8E%t=(~$?ch8seHZfDMn9c<@~sdPRMRX-pX zY_A>2!iwgWhV- z!bLibhD{#~r8i&M%N^reJoHUw#-ZFCW$OVCFrOV^i=>c~%Vn@z`^^^WR@ZO;X{q(MXiKd?d8Rlv84OsQq4JLp8zBbccG2?Bb3SO&d<5zM(@yQa4QvNrRC zgYFK$C~0c{(eQ>O8vXgBe~F+2aZTR~!3PaOtZTH;ECM6KHClu&kDlJVb3_oNnj}eL z>h%%pE!IDOj4^A8A8z-I6Ccv*b-R3X6#9W6;oG z5sw}?Mr%yi#41;Wy+mBWPGTe0sX^_BxxLZ(UV8D~&g1!)@9+GAh^iVQc<6=gE}{ETKZ}sL=3& zmJy-t%b=+IlNdzQa-|4}VKcG-IW^o4ln`vs0S!~n&XIaF+d(bLGvGNUk_xu#x1&7$ zEpe`YD?yLZ@e?_5sDJ*1D@wg?|Ko8(M9H&$IahIg)?XpchF%r8iuSAepwPchp4;5v z>~+8TPPi+kQlixrRlvoEgPOt7URzCNM=ZwfWlItl(GoAUIGIb`UAsHC{@kzk*6cs; z*tgeKIgigU+G8@Dx%vOOu$&+~JTCGS4-53miIL4@s~4+c4jD`1pXW$+)!H9lSUm8v z_?6^C!ly%p(DK@j=|(sQWt;;9d^#iuS*eI%aUQwG`3^E(f+*?~a0Kck#7UBoCEE?# z0a=ju2Lb_%adR1Oj=f0g?B0S(W#5nb2#EtTCHnisO^vObw>zMs?5c(947%Q6vw@;`;k?V>ZGcv5%6%@Vym*X<8S-q_3o^9o&D18II)``MC%AA4owt5 zD(b;V+(1YTD{)02?gXqHtI(e4jUyl~oVbF7dPKY#2a=$yto55WZ{E!N&41t5ode_1 z%2iU$>+AROMWsl9D9uW(S*q-fS0<#CgA6GjPZmkDjFTh-^4;C_d)x2qY;3I$Vg13* z?z=aeU^$xS_-a54j-~51ZTA@ST*HNp`;akuwhbqf6$*t64BvVW6P&e4EpsC$XAR4y zT0m7sb&NXeoDVw+DM6`LE>@wbnX22NVV-%AT~>n-C5Bz}r_-ZNYxUT-Bz$dcxbepqhg;W& z_octKJ{P|I%mG{ySwvPg%gE-0OHAl5oacipu`HQ1$ca19%$~ax0;!jwLs>vOmgfSg z)q&B#4=gkZ)?vAL=amL%HadAxK#F1kCvUlihl)5ot~Y=Nffqov1_lz~flyV@jv(>! z0%?Fv-3~LM@vjxVk+>1BR;C{%cH>fa`uxIk35pnxajHYX2Lja9eJ?~)fe_ECI??61 zmnMS?u~@tnkH;m!O1uPz%e>@PT*5i&ClQb=oj1`j<728;SA^V+9muADwRGjNeK6;Y z(rc^xzd5(o_J56KtGsM4qy`{>WAU15XhOLGVL%x_q|X9CCZ12-+1XH+1jn`xxXkr? z3>|=VXR~bJQ{>xcs59!>n&&Q4mvQi_JILj7a^xiQ)2H&Mm*f)gFMV)|gg zmEziH`omRKLgWIg4<$^eTdcs77QA+sY78kALEP>UXapEFuHBwI61aw6eH;5k6(CyD zc$0(S1lP>CG(bzbV+$aw!|&XowRQdH$7AQuFP#s^n*y)EcDOVX*pk&f!->1ZV$bF! z5%a7d{`OP$NFRz|iz^&|BGZWLvaHOC077cO*r0$)(`bm=BnqrqZrBUx>|26Hw4F-L z*SSb})gfgewV_syc2d{oQE;c+rAG99DpMgRRp0jduBTIeMa3HM#Y8FMvOYt2P%oi4 z4F=WXH1*>2BGsv8W52@QMVD2(#hV3JvuHaZWNlB?xi1HuK=n-;H9F2vi~JHYHT6Tf5tA6lKC-t>W1YvLHTU49odWhe*maj BTeJWG diff --git a/lispusers/EXAMINEDEFS b/lispusers/EXAMINEDEFS new file mode 100644 index 00000000..cfea6c5c --- /dev/null +++ b/lispusers/EXAMINEDEFS @@ -0,0 +1,120 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "20-Dec-2021 11:06:33"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;7 6367 + + :CHANGES-TO (FNS EXAMINEDEFS) + + :PREVIOUS-DATE "19-Dec-2021 22:45:48" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;5) + + +(PRETTYCOMPRINT EXAMINEDEFSCOMS) + +(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEDEFS-REGION) + (INITVARS (EXAMINEDEFS-PROCESS-LIST)))) +(DEFINEQ + +(EXAMINEDEFS + [LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 20-Dec-2021 11:06 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.") + + (* ;; "") + + (* ;; "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"))) + + (* ;; "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))) + (CL:UNLESS TITLE1 + (SETQ TITLE1 (OR SOURCE1 "File 1"))) + (CL:UNLESS TITLE2 + (SETQ TITLE2 (OR SOURCE2 "File 2"))) + (SELECTQ (EDITMODE) + (SEDIT:SEDIT + (* ;; + "A kludge to eliminate dangling SEDIT processes from previous examinations") + + [SETQ EXAMINEDEFS-PROCESS-LIST + (FOR PAIR IN EXAMINEDEFS-PROCESS-LIST + COLLECT (IF (OPENWP (CAR PAIR)) + THEN PAIR + ELSE (DEL.PROCESS (CDR PAIR)) + (GO $$ITERATE] + + (* ;; "Set it up for new side-by-side regions that are forgotten when the window is closed. Their shape is usually not that useful for regular edits.") + + (* ;; + "Crude suggestions for height, width, position. Suggest shorter window for smaller structures") + + (CL:UNLESS (REGIONP REGION) + (SETQ REGION (GETREGION))) + (LET (W1 W2 HALFWIDTH) + (SETQ HALFWIDTH (IQUOTIENT (FETCH (REGION WIDTH) OF REGION) + 2)) + [SETQ W1 + (SEDIT:GET-WINDOW (SEDIT:SEDIT DEF1 + `(:NAME ,(CONCAT NAME " from " TITLE1) + :REGION + ,(CREATE REGION + USING REGION WIDTH _ HALFWIDTH) + :DONT-KEEP-WINDOW-REGION T] + [SETQ W2 + (SEDIT:GET-WINDOW + (SEDIT:SEDIT DEF2 + `(:NAME ,(CONCAT NAME " from " TITLE2) + :REGION + ,(CREATE REGION USING REGION LEFT _ + (IPLUS (FETCH (REGION LEFT) + OF REGION) + HALFWIDTH) + WIDTH _ HALFWIDTH) + :DONT-KEEP-WINDOW-REGION T] + + (* ;; + "So we can kill the processes on the next call, if they still exist after the windows are closed.") + + [PUSH EXAMINEDEFS-PROCESS-LIST (CONS W1 (WINDOWPROP W1 'PROCESS)) + (CONS W2 (WINDOWPROP W2 'PROCESS] + (ATTACHWINDOW W2 W1 'RIGHT 'JUSTIFY) + (MODERNWINDOW W2))) + (PROGN (EDITE DEF1) + (EDITE DEF2]) + +(EXAMINEDEFS-REGION + [LAMBDA (WIDTH HEIGHT) (* ; "Edited 10-Dec-2021 10:15 by rmk") + + (* ;; "Prompts for a WIDTH-HEIGHT region with the top-left corner positioned at the initial cursor but the cursor then moved to the bottom-right for size adjustments. Thus the default behavior is that the upper left corner is fixed.") + + (GETMOUSESTATE) + (LET* ((LEFT LASTMOUSEX) + (RIGHT (IPLUS LEFT WIDTH)) + (TOP LASTMOUSEY) + (BOTTOM (IDIFFERENCE TOP HEIGHT))) + (\CURSORPOSITION RIGHT BOTTOM) + (GETREGION NIL NIL (CREATEREGION LEFT BOTTOM WIDTH HEIGHT) + NIL NIL (LIST LEFT TOP RIGHT BOTTOM]) +) + +(RPAQ? EXAMINEDEFS-PROCESS-LIST ) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (513 6305 (EXAMINEDEFS 523 . 5601) (EXAMINEDEFS-REGION 5603 . 6303))))) +STOP diff --git a/lispusers/EXAMINEDEFS.LCOM b/lispusers/EXAMINEDEFS.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..80023d0e56f75b3d7c8044528298d512e5aa87f7 GIT binary patch literal 2236 zcmb_e-EZ4e6i-sL4>PK^>I3S-bg%#=LXPa~I3EU;IQDhp#<4xyS=v!C(j;RQX;ZbE zv>h(;lmxd+ijbOlS|YqU&?d`T3l4&pjV0TGVzt zD%p-pCC9UUxEUB`$Jn4CI$lge*NFlVZidvbVx#3=Vz-Qlf+Cj$p~y6t2#cu&B9SF) zJd}t`6i^ghuIj2PLQxz}_Ye0b;}J{`Km_4yE9!jnN$+@kbiDr6;BYcHSa+wx!DM}Z zJerIjt7UC{|FM*8)+c+%hYvZFZW0eNadAJ!tS{)WWO($%OZ>h575b1>8*>U*E;K)IU7{fY7KO=ZFn0rl42il^W5sO)_1A|Zok zbSc=Fg4v6eg3vc<6iJx8aS8H23HjXB=8w=?c-org@DbQ@W-dH6Guvgzw-!zpzCFo@ zO{4WTgPbllIUw0>nThzLreV&BlijxUq;-0g<9Dx}(I@6?Bb;4h%D!aFKi{3?-|w$3 z8&@{DvfSUDmEo#=oyorEu-zMH%kp)*P{>aTf81SZ^Uo4DEN+!E?7Usb`zr`5AcfBw zKHN4V`1!cbyNgan0nIA#SDwG7jwOF_#I^laUh|hO$o}fu+HloJDL28F8|)zd5=STN z$@!mrcXIw~{_{L1e|XpX#XVi@-e24K>}<1e=j8lF_rslMFT4U5Kl`iA-wt1wa>a_; z0BSjy+Z9!vQAEQ$a?9yegW9NoA5gC!fLd3<^n-0sYg$TF8_@MF8hU-lv;01&RRTsF z8)kdPP%E(Gcu_B;GY(NNa}-QS=7+vPV`&DH>nW3qfK-`H&op8n745%xQjzEJvOL2p zSn8-bEefTor1gQdL+bq4>_xF- zV{9}6p|jCOH)}HJsZpY-p!1p{vUb5$>h+YXVEmI1@D+6eX*8gyTfP@d9ZG{VE>fxx z%a3Rc?DhAKru+CJ=-28O(yIk?9d34vw9%>1^5fX=VizM2`vGrjNfcRMbEzHk z_SB|4vaCVzu2_Pc@m4NZ;068#E0N`VuHAgT{N4iJ-7$Xu+3E1Ay+3Mqng%Z;BsZPT zeOA!#Twxz!DPZ3InmvP z$`k!b{DShY`1VLgQF@zp;IW#qE_?R!?YFzsCQ<76Zl~ansU81)1 zO|r$QHR#s}*Uz0*=yCX8v-I5{&|u~7?!pgUUaZ$AtCYehV+G09>o4PfKn@a0(s<>i zs~C`zd2|($ALc~3u>=82A1f~#gA6yNQ{kX$6irgs2O)|8W=WI4$tMvwSd%w*!wa~A zd+9?bF6a&dn!A@0a4B$;6lh7#X3|T+mr0341>96uCy_~l1W~1QPA*|B^}SW##-++o zb>XfjsFe>lG53Z7mWR!A$syLrb3=miDnauA97hWR8Ca?TxTzAlSfM?pG+C<_C=ith zZ&a*VQF1hnt|J=MrNB>8)dySEy_3oS`$#H*@~3Xw~(ykNSr4kEx=#?d8bvqyf)-zx9ilj>|Ypk#G{QgI_G61bwd zA60c#;qu_&N1Lm%Rlu|zpt~>9> zXf{;i>Y(h&O;gvKtE57B0cUWvrUg9j0XiTp@xoBNAW9G@x{%O_iN_@I;s~^2?B!D8 z7N)_vQE`B!rN*D9V6kB1ymeZG-q5r~R^t(N6HFj{A)SQEuujh$wJ(%5hDr&8)>nP#Md76k zeHnU^X8AUf;XqR?mS}V?0Mdw6*^A~u+PX8cxXeWso37@}=W4l>aXpZ;6kNq29B@EY z1&U(-0^3qR%P3JBr>1ccAr$?RjWS2h1bL`nT^L~Wa$nf%5C;zDI#8ox@U>O#S|f+5 z)uDMRsBd)%Z$n{^te*sRWtsv~XVA3$a>fn zH0X4&-*rXH83KZ%zK8a}fk3pgRYrQSPaT|v-E-;<+QRPB;IXi~I2$t+$F?4c!8kJ? z_n}d&iKj!eKf)=&qdxAMHjTOioJsoYiE0(<;fNde7?`ki z?wMexL>MSJI6kCrkEnTaf=4aWtey$84H`3|@(*>c+2ej63oL@|$srvd9@4#L+13$H z9c8Gh29^6qba?NGj`sI6_cd6)Q(2+^zKrk7NY(e#NP0B?$7!t9)Rue8xNRKr+s1R_ z1Ac66;I{D`_cvZQZMNUarokQ&=TkhkH@DvC-!K}+GvnFD3Gls(Hap$k1fDluKkzD$ zsB7yc`W@b-^4-taDQ$h3_ABn&!1$$6ajc#g*@K?hH@?ZVHVxwo;||Uj{9|NxjXQ_EBMdEz9+=@+uh{Y$~RhErW}voZM3K4P)ob9(P3pf9QAmTEXB& zHhY!Q#%sc;w)oG6TpooltJ9{z&rQHC<19nCW+Y2a8N3bl*BWy7DXw%fEGRf**C+|9 zic4#-;O>h8MM&1lnaK`o6t)~f*|S9TKYyvTS)yKUNIr&CS@19_KgyhMg`}`z1qSdv zeo9vbS83ss1N_M=Y^;PVIo1;8mnHvb3HxAyO6S!P3k;uYqr&k-OSGH6Sit^@rYUs4 z)4BzSg_daRBFQ4;Ct5{u#EuKH3er!tj&@VT)`G8CgN+M!dgU{{V(|+jE6}MIz7-i1 Q#A<7PBG_$Vod5CnzZm?!3jhEB literal 0 HcmV?d00001 diff --git a/lispusers/OBJECTWINDOW b/lispusers/OBJECTWINDOW new file mode 100644 index 00000000..778e55fe --- /dev/null +++ b/lispusers/OBJECTWINDOW @@ -0,0 +1,1496 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "21-Dec-2021 18:20:31"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>OBJECTWINDOW.;4 94660 + + :CHANGES-TO (FNS OBJ.CREATEW OBJ.ADDMANYTOW OBJ.INSERTOBJECTS) + + :PREVIOUS-DATE "16-Dec-2021 23:33:24" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>OBJECTWINDOW.;3) + + +(PRETTYCOMPRINT OBJECTWINDOWCOMS) + +(RPAQQ OBJECTWINDOWCOMS + [(DECLARE%: DOEVAL@LOAD DONTCOPY (RECORDS OBJ)) + + +(* ;;; "User callable functions") + + (FNS OBJ.ADDMANYTOW OBJ.ADDTOW OBJ.CLEARW OBJ.CREATEW OBJ.DELFROMW OBJ.FIND.REGION + OBJ.INSERTOBJECTS OBJ.MAP.OBJECTS OBJ.OBJECTS OBJ.REPLACE OBJWINDOWP) + + +(* ;;; "Routines called by user routines") + + (FNS OBJ.APPLY.USER.FN OBJ.BUTTONEVENTFN OBJ.BUTTONEVENTINFN OBJ.CLEAR.EXTENT + OBJ.COMPUTE.IMAGEBOX OBJ.COMPUTE.REGION OBJ.COPYBUTTONEVENTFN OBJ.DELFROMW.HORIZONTAL + OBJ.DELFROMW.VERTICAL OBJ.DRAW.OBJECT OBJ.END.OF.OBJECT OBJ.FIND.OBJECT + OBJ.FIND.REGION.HORIZONTAL OBJ.FIND.REGION.VERTICAL OBJ.FLIP.OBJECT OBJ.HARDCOPYFN + OBJ.INDEX.OBJECT OBJ.INSTANTIATE OBJ.MOVETO.LAST.INSTANTIATED.OBJECT + OBJ.RECOMPUTE.EXTENT OBJ.REPAINTFN OBJ.REPLACE.HORIZONTAL OBJ.REPLACE.VERTICAL + OBJ.RESHAPEFN OBJ.SCROLLFN OBJ.SCROLLFN.HORIZONTAL OBJ.SCROLLFN.VERTICAL) + (P (AND (GETD 'MODERNWINDOW.SETUP) + (MODERNWINDOW.SETUP (FUNCTION OBJ.BUTTONEVENTINFN]) +(DECLARE%: DOEVAL@LOAD DONTCOPY +(DECLARE%: EVAL@COMPILE + +(RECORD OBJ (OBJECT REGION YDESC XKERN INSTANTIATED) + [ACCESSFNS ((ASCENT (IDIFFERENCE (fetch (REGION HEIGHT) of (fetch (OBJ REGION) + of DATUM)) + (fetch (OBJ YDESC) of DATUM]) +) +) + + + +(* ;;; "User callable functions") + +(DEFINEQ + +(OBJ.ADDMANYTOW + [LAMBDA (WINDOW OBJECTS) (* ; "Edited 21-Dec-2021 18:20 by rmk") + (* ; "Edited 3-Aug-93 09:30 by rmk:") + (* bbb " 7-Jan-86 16:15") + +(* ;;; "For the moment this is just like calling OBJ.ADDTOW for each object in OBJECTS") + + (FOR OBJECT INSIDE OBJECTS DO (OBJ.ADDTOW WINDOW OBJECT]) + +(OBJ.ADDTOW + [LAMBDA (WINDOW OBJECT) (* ; "Edited 3-Aug-93 09:30 by rmk:") + (* bbb "19-Dec-85 11:37") + +(* ;;; "OBJECT is added to the property value OBJECTS of WINDOW at the current position in WINDOW The objects in OBJECT are ordered by their leading edge. The window is redrawn if necessary.") + + (LET* + ((WINDOWTYPE (WINDOWPROP WINDOW 'WINDOWTYPE)) + (OBJECTS (WINDOWPROP WINDOW 'OBJECTS)) + (ADDED.OBJECT (CREATE OBJ + OBJECT _ OBJECT + INSTANTIATED _ NIL)) + [POINT.MOVED (OR (NEQ (DSPXPOSITION NIL WINDOW) + (WINDOWPROP WINDOW 'OLDXPOSITION)) + (NEQ (DSPYPOSITION NIL WINDOW) + (WINDOWPROP WINDOW 'OLDYPOSITION] + [POINT.BEFORE.END.OF.CLIPPING.REGION (IF (EQ WINDOWTYPE 'HORIZONTAL) + THEN (ILESSP (DSPXPOSITION NIL WINDOW) + (FETCH (REGION RIGHT) + OF (DSPCLIPPINGREGION NIL WINDOW))) + ELSE (IGREATERP (DSPYPOSITION NIL WINDOW) + (FETCH (REGION BOTTOM) + OF (DSPCLIPPINGREGION NIL WINDOW] + (LASTOBJECTS)) + (COND + ((AND (NULL OBJECTS) + (NOT POINT.MOVED)) + + (* ;; "When the window was created the x and y positions were unspecified. Now we will resolve them if the user hasn't for us.") + + (OBJ.COMPUTE.IMAGEBOX WINDOW ADDED.OBJECT) + (DSPXPOSITION 0 WINDOW) + (DSPYPOSITION (IDIFFERENCE (FETCH (REGION TOP) OF (DSPCLIPPINGREGION NIL WINDOW)) + (FETCH (OBJ ASCENT) OF ADDED.OBJECT)) + WINDOW) + (OBJ.COMPUTE.REGION WINDOW ADDED.OBJECT)) + ((OR POINT.BEFORE.END.OF.CLIPPING.REGION POINT.MOVED) + (OBJ.COMPUTE.IMAGEBOX WINDOW ADDED.OBJECT) + (IF (EQ WINDOWTYPE 'VERTICAL) + THEN (RELMOVETO 0 (IMINUS (FETCH (OBJ ASCENT) OF ADDED.OBJECT)) + WINDOW)) + (OBJ.COMPUTE.REGION WINDOW ADDED.OBJECT))) (* ; + "Insert the new object in the list which is in order of leading edge") + (IF (NULL OBJECTS) + THEN (WINDOWPROP WINDOW 'OBJECTS (LIST ADDED.OBJECT)) + ELSEIF [OR [AND (EQ WINDOWTYPE 'HORIZONTAL) + (ILESSP (DSPXPOSITION NIL WINDOW) + (FETCH (REGION LEFT) OF (FETCH (OBJ REGION) OF (CAR OBJECTS] + (AND (EQ WINDOWTYPE 'VERTICAL) + (IGREATERP (DSPYPOSITION NIL WINDOW) + (FETCH (REGION TOP) OF (FETCH (OBJ REGION) OF (CAR OBJECTS] + THEN (ATTACH ADDED.OBJECT OBJECTS) + ELSEIF POINT.MOVED + THEN (BIND SECOND.OBJECT FOR OBJECTTAIL ON OBJECTS + DO (SETQ SECOND.OBJECT (CADR OBJECTTAIL)) + (IF SECOND.OBJECT + THEN (OBJ.INSTANTIATE WINDOW SECOND.OBJECT (CAR OBJECTTAIL)) + (IF (EQ WINDOWTYPE 'HORIZONTAL) + THEN (IF (IGREATERP (DSPXPOSITION NIL WINDOW) + (FETCH (REGION LEFT) OF (FETCH (OBJ REGION) + OF ADDED.OBJECT))) + THEN (RPLACD OBJECTTAIL (CONS ADDED.OBJECT (CDR OBJECTTAIL) + )) + (RETURN)) + ELSE (IF (ILESSP (DSPYPOSITION NIL WINDOW) + (FETCH (REGION BOTTOM) OF (FETCH (OBJ REGION) + OF ADDED.OBJECT))) + THEN (RPLACD OBJECTTAIL (CONS ADDED.OBJECT (CDR OBJECTTAIL))) + (RETURN))) + ELSE (RPLACD OBJECTTAIL (LIST ADDED.OBJECT)) + (RETURN)) (* ; "At the end")) + ELSE (SETQ LASTOBJECTS (LAST OBJECTS)) + (IF POINT.BEFORE.END.OF.CLIPPING.REGION + THEN (OBJ.INSTANTIATE WINDOW ADDED.OBJECT (CAR LASTOBJECTS))) + (RPLACD LASTOBJECTS (LIST ADDED.OBJECT))) + + (* ;; "Remember the old x and y, draw the object then reposition the x or y to be ready for adding the next object.") + + (OBJ.RECOMPUTE.EXTENT WINDOW) + (IF (AND (FETCH (OBJ INSTANTIATED) OF ADDED.OBJECT) + (REGIONSINTERSECTP (DSPCLIPPINGREGION NIL WINDOW) + (FETCH (OBJ REGION) OF ADDED.OBJECT))) + THEN (OBJ.DRAW.OBJECT WINDOW ADDED.OBJECT)) + (OBJ.MOVETO.LAST.INSTANTIATED.OBJECT WINDOW (WINDOWPROP WINDOW 'OBJECTS)) + (* ; + "Finally move the point to after the last instantiated object.") + (WINDOWPROP WINDOW 'OLDXPOSITION (DSPXPOSITION NIL WINDOW)) + (WINDOWPROP WINDOW 'OLDYPOSITION (DSPYPOSITION NIL WINDOW)) + OBJECT]) + +(OBJ.CLEARW + [LAMBDA (WINDOW) (* rmk%: "17-Feb-88 10:19") + (* bbb "13-May-86 15:15") + (if (WINDOWPROP WINDOW 'OBJECTS NIL) + then + + (* Don't clear it if there aren't any objects. + Stops a NOOPEN window from popping up when it's created.) + + (CLEARW WINDOW)) + (if (EQ (WINDOWPROP WINDOW 'WINDOWTYPE) + 'VERTICAL) + then (WYOFFSET (SUB1 (WINDOWPROP WINDOW 'HEIGHT)) + WINDOW) (* In vertical windows the top of the + window has Y = 0)) + (OBJ.CLEAR.EXTENT WINDOW) + (DSPXPOSITION MIN.FIXP WINDOW) + + (* Changed the x and y position to min and max FIXP from min and max INTEGER) + + (DSPYPOSITION MAX.FIXP WINDOW) + (DSPRIGHTMARGIN 65535 WINDOW) + (WINDOWPROP WINDOW 'OLDXPOSITION (DSPXPOSITION NIL WINDOW)) + (WINDOWPROP WINDOW 'OLDYPOSITION (DSPYPOSITION NIL WINDOW)) + WINDOW]) + +(OBJ.CREATEW + [LAMBDA (WINDOWTYPE REGION TITLE BORDERSIZE NOOPENFLG SEPDIST BOXFN DISPLAYFN BUTTONINFN HARDCOPYFN + HCPYHEADING) (* ; "Edited 21-Dec-2021 17:19 by rmk") + (* ; "Edited 16-Dec-2021 23:32 by rmk") + (* ; "Edited 26-Nov-96 14:31 by rmk:") + (* bbb " 9-May-86 16:59") + (CL:UNLESS (MEMB WINDOWTYPE '(HORIZONTAL VERTICAL)) + (\ILLEGAL.ARG WINDOWTYPE)) + (LET (WINDOW) + (SETQ WINDOW (CREATEW REGION TITLE BORDERSIZE NOOPENFLG)) + (WINDOWPROP WINDOW 'WINDOWTYPE WINDOWTYPE) + (OBJ.CLEARW WINDOW) + (WINDOWPROP WINDOW 'SCROLLFN (FUNCTION OBJ.SCROLLFN)) + (WINDOWPROP WINDOW 'REPAINTFN (FUNCTION OBJ.REPAINTFN)) + (WINDOWPROP WINDOW 'RESHAPEFN (FUNCTION OBJ.RESHAPEFN)) + (WINDOWPROP WINDOW 'COPYBUTTONEVENTFN (FUNCTION OBJ.COPYBUTTONEVENTFN)) + (WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION OBJ.BUTTONEVENTFN)) + (WINDOWPROP WINDOW 'SEPARATIONDISTANCE (OR SEPDIST 0)) + (WINDOWPROP WINDOW 'BOXFN BOXFN) + (WINDOWPROP WINDOW 'DISPLAYFN DISPLAYFN) + (WINDOWPROP WINDOW 'BUTTONINFN BUTTONINFN) + [WINDOWPROP WINDOW 'HARDCOPYFN (LIST (OR HARDCOPYFN (FUNCTION OBJ.HARDCOPYFN)) + (OR HCPYHEADING 'TITLE] + (* ; + "Limit the scrolling to the extent depending on the window type") + [WINDOWPROP WINDOW 'SCROLLEXTENTUSE (if (EQ WINDOWTYPE 'HORIZONTAL) + then '(LIMIT . T) + else '(T . LIMIT] + WINDOW]) + +(OBJ.DELFROMW + [LAMBDA (WINDOW OBJECT) (* ; "Edited 3-Aug-93 09:28 by rmk:") + (* bbb "19-Dec-85 17:13") + (IF (EQ (WINDOWPROP WINDOW 'WINDOWTYPE) + 'HORIZONTAL) + THEN (OBJ.DELFROMW.HORIZONTAL WINDOW OBJECT) + ELSE (OBJ.DELFROMW.VERTICAL WINDOW OBJECT]) + +(OBJ.FIND.REGION + [LAMBDA (WINDOW SEARCHOBJECT) (* bbb "11-Dec-85 10:01") + + (* The object SEARCHOBJECT is searched for and its region is returned. + This may involve instantiating objects.) + + (IF (EQ (WINDOWPROP WINDOW 'WINDOWTYPE) + 'HORIZONTAL) + THEN (OBJ.FIND.REGION.HORIZONTAL WINDOW SEARCHOBJECT) + ELSE (OBJ.FIND.REGION.VERTICAL WINDOW SEARCHOBJECT]) + +(OBJ.INSERTOBJECTS + [LAMBDA (WINDOW NEWOBJECTS OLDOBJECT WHERE) (* ; "Edited 21-Dec-2021 18:19 by rmk") + (* ; "Edited 12-Aug-93 23:01 by rmk:") + (* bbb "19-Dec-85 11:37") + + (* ;; + "NEWOBJECTS are inserted in WINDOW at position WHERE (BEFORE or AFTER) with respect to OLDOBJECT.") + + (SETQ NEWOBJECTS (MKLIST NEWOBJECTS)) + (LET* [(WINDOWTYPE (WINDOWPROP WINDOW 'WINDOWTYPE)) + (OBJECTS (WINDOWPROP WINDOW 'OBJECTS)) + (PREVTAIL) + (OLDOBJTAIL (AND OLDOBJECT + (IF (IMAGEOBJP OLDOBJECT) + THEN (FOR OTAIL ON OBJECTS + DO (IF (EQ OLDOBJECT (FETCH (OBJ OBJECT) OF (CAR OTAIL))) + THEN (RETURN OTAIL) + ELSE (SETQ PREVTAIL OTAIL))) + ELSE (MEMB OLDOBJECT OBJECTS] + (IF (AND OLDOBJTAIL WHERE) + THEN (SELECTQ WHERE + (BEFORE (CL:UNLESS PREVTAIL (* ; "If this is the earliest item, insert it at the beginning of the the clipping region. Vertical case needs to be thought out.") + (DSPXPOSITION (FETCH (REGION LEFT) OF (DSPCLIPPINGREGION NIL + WINDOW)) + WINDOW)) + (FOR O IN OLDOBJTAIL DO (REPLACE INSTANTIATED OF O WITH NIL)) + (FOR O IN NEWOBJECTS DO (ATTACH (CREATE OBJ + OBJECT _ O) + OLDOBJTAIL)) + (FOR F (PREV _ (CAR PREVTAIL)) IN (OR (CDR PREVTAIL) + OBJECTS) + DO (OBJ.INSTANTIATE WINDOW F PREV) + (SETQ PREV F))) + (AFTER (FOR O IN (CDR OLDOBJTAIL) DO (REPLACE INSTANTIATED OF O WITH NIL)) + (FOR O (FOLLOWINGOBJECTS _ (CDR OLDOBJTAIL)) + (PREV _ (CAR OLDOBJTAIL)) + (OTAIL _ OLDOBJTAIL) IN NEWOBJECTS + DO (SETQ O (CREATE OBJ + OBJECT _ O)) + (SETQ OTAIL (PUSH (CDR OTAIL) + O)) + (OBJ.INSTANTIATE WINDOW O PREV) + (SETQ PREV O) FINALLY + + (* ;; + "Check logic in OBJ.DELFROMW. Maybe we don't have to instantiate beyond the visible region") + + (FOR F IN FOLLOWINGOBJECTS + DO (OBJ.INSTANTIATE WINDOW F PREV) + (SETQ PREV F)))) + (REPLACE (* ; + "Left is left of object being replaced. Might need to do something different for vertical case.") + (DSPXPOSITION (FETCH (REGION LEFT) OF (FETCH (OBJ REGION) + OF (CAR OLDOBJTAIL))) + WINDOW) + (FOR O IN (CDR OLDOBJTAIL) + DO (REPLACE INSTANTIATED OF O WITH NIL)) + (RPLACA OLDOBJTAIL (CREATE OBJ + OBJECT _ (CAR NEWOBJECTS))) + (OBJ.INSTANTIATE WINDOW (CAR OLDOBJTAIL)) + (FOR O (FOLLOWINGOBJECTS _ (CDR OLDOBJTAIL)) + (PREV _ (CAR OLDOBJTAIL)) + (OTAIL _ OLDOBJTAIL) IN (CDR NEWOBJECTS) + DO (SETQ O (CREATE OBJ + OBJECT _ O)) + (SETQ OTAIL (PUSH (CDR OTAIL) + O)) + (OBJ.INSTANTIATE WINDOW O PREV) + (SETQ PREV O) FINALLY + + (* ;; + "Check logic in OBJ.DELFROMW. Maybe we don't have to instantiate beyond the visible region") + + (FOR F IN FOLLOWINGOBJECTS + DO (OBJ.INSTANTIATE WINDOW F PREV) + (SETQ PREV F)))) + (SHOULDNT)) + (OBJ.RECOMPUTE.EXTENT WINDOW) + (REDISPLAYW WINDOW (DSPCLIPPINGREGION NIL WINDOW)) + ELSE (OBJ.ADDMANYTOW WINDOW NEWOBJECTS)) + NEWOBJECTS]) + +(OBJ.MAP.OBJECTS + [LAMBDA (WINDOW MAPFN) (* bbb "19-Dec-85 14:39") + + (* MAPFN is called with the object field of each OBJ in WINDOW If the MAPFN + returns non-NIL then this value replaces the object) + + (for OBJECT in (WINDOWPROP WINDOW 'OBJECTS) bind FN.RESULT + do (SETQ FN.RESULT (APPLY* MAPFN (fetch (OBJ OBJECT) of OBJECT))) + (if FN.RESULT + then (OBJ.REPLACE WINDOW (fetch (OBJ OBJECT) of OBJECT) + FN.RESULT T))) + (REDISPLAYW WINDOW (DSPCLIPPINGREGION NIL WINDOW) + T]) + +(OBJ.OBJECTS + [LAMBDA (WINDOW) (* bbb "11-Dec-85 10:42") + + (* * The list of objects is returned) + + (for OBJECT in (WINDOWPROP WINDOW 'OBJECTS) collect (fetch (OBJ OBJECT) of OBJECT]) + +(OBJ.REPLACE + [LAMBDA (WINDOW OLD.OBJECT NEW.OBJECT DONT.REDISPLAY.FLG) (* ; "Edited 27-Jul-93 17:11 by rmk:") + (* bbb "19-Dec-85 14:56") + +(* ;;; "Replaces new object with old object and adjusts the region of all objects to its left") + + (IF (EQ (WINDOWPROP WINDOW 'WINDOWTYPE) + 'HORIZONTAL) + THEN (OBJ.REPLACE.HORIZONTAL WINDOW OLD.OBJECT NEW.OBJECT DONT.REDISPLAY.FLG) + ELSE (OBJ.REPLACE.VERTICAL WINDOW OLD.OBJECT NEW.OBJECT DONT.REDISPLAY.FLG]) + +(OBJWINDOWP + [LAMBDA (WINDOW) (* ; "Edited 4-May-99 16:27 by rmk:") + (* ; "Edited 4-May-99 16:26 by rmk:") + (AND (WINDOWP WINDOW) + (EQ 'OBJ.COPYBUTTONEVENTFN (WINDOWPROP WINDOW 'COPYBUTTONEVENTFN)) + (MEMB (WINDOWPROP WINDOW 'WINDOWTYPE) + '(HORIZONTAL VERTICAL)) + WINDOW]) +) + + + +(* ;;; "Routines called by user routines") + +(DEFINEQ + +(OBJ.APPLY.USER.FN + [LAMBDA (USER.FN OBJECT WINDOW REG) (* jtm%: " 3-Nov-87 17:08") + (* ; "Edited 28-Jul-93 17:39 by rmk:") + +(* ;;; "Sets up the coordinate system and calls the user function (eg. a BUTTONEVENTINFN or a COPYEVENTFN)") + + (LET* ((WINDOWDISPLAYSTREAM (GETSTREAM WINDOW)) + (RELX (LASTMOUSEX WINDOW)) + (RELY (LASTMOUSEY WINDOW)) + [OBJORIG (OR (IMAGEOBJPROP OBJECT 'OBJECTORIGIN) + (CONSTANT (CREATEPOSITION 0 0] + WINDOWDELTAX WINDOWDELTAY WINDOWCLIPPING.REGION RESULT) + + (* ;; "(IMAGEBOX (APPLY* (IMAGEOBJPROP OBJECT (QUOTE IMAGEBOXFN)) OBJECT WINDOW)) (REG (create REGION LEFT _ (IDIFFERENCE (DSPXPOSITION NIL DS) (fetch (IMAGEBOX XKERN) of IMAGEBOX)) BOTTOM _ (IDIFFERENCE (DSPYPOSITION NIL DS) (fetch (IMAGEBOX YDESC) of IMAGEBOX)) WIDTH _ (fetch (IMAGEBOX XSIZE) of IMAGEBOX) HEIGHT _ (fetch (IMAGEBOX YSIZE) of IMAGEBOX)))") + + (SETQ WINDOWDELTAX (IDIFFERENCE (OR (IMINUS (fetch (POSITION XCOORD) of OBJORIG)) + 0) + (fetch (REGION LEFT) of REG))) + (SETQ WINDOWDELTAY (IDIFFERENCE (OR (IMINUS (fetch (POSITION YCOORD) of OBJORIG)) + 0) + (fetch (REGION BOTTOM) of REG))) + (RESETLST + (RESETSAVE (WXOFFSET (IMINUS WINDOWDELTAX) + WINDOWDISPLAYSTREAM) + (LIST (FUNCTION WXOFFSET) + WINDOWDELTAX WINDOWDISPLAYSTREAM)) + (RESETSAVE (WYOFFSET (IMINUS WINDOWDELTAY) + WINDOWDISPLAYSTREAM) + (LIST (FUNCTION WYOFFSET) + WINDOWDELTAY WINDOWDISPLAYSTREAM)) + (SETQ WINDOWCLIPPING.REGION (DSPCLIPPINGREGION NIL WINDOWDISPLAYSTREAM)) + (RESETSAVE (DSPCLIPPINGREGION (INTERSECTREGIONS + WINDOWCLIPPING.REGION + (create REGION + LEFT _ (OR (IMINUS (fetch (POSITION XCOORD) + of OBJORIG)) + 0) + BOTTOM _ (OR (IMINUS (fetch (POSITION YCOORD) + of OBJORIG)) + 0) + WIDTH _ (fetch (REGION WIDTH) of REG) + HEIGHT _ (fetch (REGION HEIGHT) of REG))) + WINDOWDISPLAYSTREAM) + (LIST (FUNCTION DSPCLIPPINGREGION) + WINDOWCLIPPING.REGION WINDOWDISPLAYSTREAM)) + [ERSETQ (SETQ RESULT (APPLY* USER.FN OBJECT WINDOW '? RELX RELY WINDOW '? '?] + RESULT)]) + +(OBJ.BUTTONEVENTFN + [LAMBDA (WINDOW STREAM) (* bbb "11-Dec-85 10:23") + (OBJ.BUTTONEVENTINFN WINDOW STREAM]) + +(OBJ.BUTTONEVENTINFN + [LAMBDA (WINDOW STREAM) (* jtm%: " 3-Nov-87 17:09") + (* ; "Edited 28-Jul-93 17:40 by rmk:") + +(* ;;; "Determines which object the button was clicked in and calls its BUTTONEVENTINFN. If CHANGED is returned then the region for that object will be redrawn.") + + (TOTOPW WINDOW) + (PROG ((CLIPPING.REGION (DSPCLIPPINGREGION NIL WINDOW)) + (MOUSEX (LASTMOUSEX WINDOW)) + (MOUSEY (LASTMOUSEY WINDOW)) + (WINDOWXPOS (DSPXPOSITION NIL WINDOW)) + (WINDOWYPOS (DSPYPOSITION NIL WINDOW)) + RESULT OBJ REG) + BUTTONDOWN + [IF (SETQ OBJ (OBJ.FIND.OBJECT WINDOW MOUSEX MOUSEY)) + THEN (SETQ REG (FETCH (OBJ REGION) OF OBJ)) + (MOVETO (IPLUS (FETCH (OBJ XKERN) OF OBJ) + (FETCH (REGION LEFT) OF REG)) + (IPLUS (FETCH (OBJ YDESC) OF OBJ) + (FETCH (REGION BOTTOM) OF REG)) + WINDOW) + (SETQ RESULT (OBJ.APPLY.USER.FN (IMAGEOBJPROP (FETCH (OBJ OBJECT) OF OBJ) + 'BUTTONEVENTINFN) + (FETCH (OBJ OBJECT) OF OBJ) + WINDOW REG)) + (MOVETO WINDOWXPOS WINDOWYPOS WINDOW) + (SELECTQ RESULT + (CHANGED (REDISPLAYW WINDOW (FETCH (OBJ REGION) OF OBJ) + T)) + (ALLCHANGED (REDISPLAYW WINDOW)) + (IF (EQ (CAR (LISTP RESULT)) + '*DOFORM*) + THEN + (* ;; "Function supplies a form to operate on window, but only after all transformations have been undone.") + + (EVAL (CADR RESULT] + (GETMOUSESTATE) + (IF [AND (LASTMOUSESTATE (OR LEFT MIDDLE)) + (INSIDEP CLIPPING.REGION (SETQ MOUSEX (LASTMOUSEX WINDOW)) + (SETQ MOUSEY (LASTMOUSEY WINDOW] + THEN (GO BUTTONDOWN]) + +(OBJ.CLEAR.EXTENT + [LAMBDA (WINDOW) (* bbb " 9-Dec-85 16:33") + (WINDOWPROP WINDOW 'EXTENT + (create REGION + LEFT _ -1 + BOTTOM _ -1 + WIDTH _ -1 + HEIGHT _ -1]) + +(OBJ.COMPUTE.IMAGEBOX + [LAMBDA (WINDOW OBJECT) (* ; "Edited 3-Aug-93 17:46 by rmk:") + (* bbb "10-Dec-85 11:33") + (LET* [BOXFN.RESULT (IMAGEBOX (IF (IMAGEOBJP (FETCH (OBJ OBJECT) OF OBJECT)) + THEN (APPLY* (IMAGEOBJPROP (FETCH (OBJ OBJECT) OF OBJECT) + 'IMAGEBOXFN) + (FETCH (OBJ OBJECT) OF OBJECT) + WINDOW) + ELSE (SETQ BOXFN.RESULT (APPLY* (WINDOWPROP WINDOW 'BOXFN) + (FETCH (OBJ OBJECT) OF OBJECT) + WINDOW)) + + (* ;; "If the result of applying the boxfn for the window with the object returns an image object then replace the object with this image object and compute this new image object's imagebox") + + (IF (IMAGEOBJP BOXFN.RESULT) + THEN (REPLACE (OBJ OBJECT) OF OBJECT WITH BOXFN.RESULT) + (APPLY* (IMAGEOBJPROP (FETCH (OBJ OBJECT) + OF OBJECT) + 'IMAGEBOXFN) + (FETCH (OBJ OBJECT) OF OBJECT) + WINDOW) + ELSE BOXFN.RESULT] + (REPLACE (OBJ REGION) OF OBJECT WITH (CREATE REGION + WIDTH _ (FETCH (IMAGEBOX XSIZE) OF IMAGEBOX) + HEIGHT _ (FETCH (IMAGEBOX YSIZE) OF IMAGEBOX))) + (REPLACE (OBJ YDESC) OF OBJECT WITH (FETCH (IMAGEBOX YDESC) OF IMAGEBOX)) + (REPLACE (OBJ XKERN) OF OBJECT WITH (FETCH (IMAGEBOX XKERN) OF IMAGEBOX]) + +(OBJ.COMPUTE.REGION + [LAMBDA (WINDOW OBJECT) (* bbb "11-Dec-85 14:29") + (replace (REGION LEFT) of (fetch (OBJ REGION) of OBJECT) with (DSPXPOSITION NIL WINDOW)) + [replace (REGION BOTTOM) of (fetch (OBJ REGION) of OBJECT) + with (ADD1 (IDIFFERENCE (DSPYPOSITION NIL WINDOW) + (fetch (OBJ YDESC) of OBJECT] + (replace INSTANTIATED of OBJECT with T]) + +(OBJ.COPYBUTTONEVENTFN + [LAMBDA (WINDOW) (* jtm%: " 3-Nov-87 17:12") + (* rmk%: "16-May-86 14:48") + + (* Tracks the mouse, while the button is down objects are inverted and when the + button is released either the user's COPYBUTTONEVENTFN is called or else a + COPYINSERT is performed.) + + (PROG ((CLIPPING.REGION (DSPCLIPPINGREGION NIL WINDOW)) + BUTTON OLDPOS NOW NEAR COPYBUTTONEVENTINFN NOW.IMAGEOBJ OLDX OLDY) + (* note which button is down.) + (TOTOPW WINDOW) + (COND + ((LASTMOUSESTATE LEFT) + (SETQ BUTTON 'LEFT)) + ((LASTMOUSESTATE MIDDLE) + (SETQ BUTTON 'MIDDLE)) + (T (* no button down, not interested.) + (RETURN))) (* get the region of this window.) + (SETQ NEAR (OBJ.FIND.OBJECT WINDOW (LASTMOUSEX WINDOW) + (LASTMOUSEY WINDOW))) + FLIP + (if NOW + then (OBJ.FLIP.OBJECT NOW WINDOW)) + (if NEAR + then (OBJ.FLIP.OBJECT NEAR WINDOW)) + (SETQ NOW NEAR) + LP (* wait for a button up or move out of + region) + (GETMOUSESTATE) + (COND + ((NOT (LASTMOUSESTATE (OR LEFT MIDDLE))) (* button up, process it.) + (if NOW + then (OBJ.FLIP.OBJECT NOW WINDOW) + (SETQ NOW.IMAGEOBJ (fetch (OBJ OBJECT) of NOW)) + (* NOW node has been selected.) + (SETQ COPYBUTTONEVENTINFN (IMAGEOBJPROP NOW.IMAGEOBJ 'COPYBUTTONEVENTINFN)) + [RETURN (if COPYBUTTONEVENTINFN + then (SETQ OLDX (DSPXPOSITION NIL WINDOW)) + (SETQ OLDY (DSPYPOSITION NIL WINDOW)) + (MOVETO (IPLUS (fetch (OBJ XKERN) of NOW) + (fetch (REGION LEFT) + of (fetch (OBJ REGION) of NOW))) + (IPLUS (fetch (OBJ YDESC) of NOW) + (fetch (REGION BOTTOM) + of (fetch (OBJ REGION) of NOW))) + WINDOW) + (OBJ.APPLY.USER.FN COPYBUTTONEVENTINFN NOW.IMAGEOBJ WINDOW + (fetch (OBJ REGION) of NOW)) + (MOVETO OLDX OLDY WINDOW) + else (COPYINSERT (APPLY* (IMAGEOBJPROP NOW.IMAGEOBJ 'COPYFN) + NOW.IMAGEOBJ] + else (RETURN))) + ((NOT (INSIDEP CLIPPING.REGION (LASTMOUSEX WINDOW) + (LASTMOUSEY WINDOW))) (* outside of region, return) + (if NOW + then (OBJ.FLIP.OBJECT NOW WINDOW)) + (RETURN)) + ([EQ NOW (SETQ NEAR (OBJ.FIND.OBJECT WINDOW (LASTMOUSEX WINDOW) + (LASTMOUSEY WINDOW] + (GO LP)) + (T (GO FLIP]) + +(OBJ.DELFROMW.HORIZONTAL + [LAMBDA (HWINDOW OBJECT) (* ; "Edited 12-Aug-93 23:01 by rmk:") + (* bbb " 7-Jan-86 16:54") + +(* ;;; "The object is deleted from HWINDOW, close up the display by readjusting the lefts of all the following objects--and then redisplay from the left of the deleted object to the right of the clipping region") + + (LET* + ((CLIPPING.REGION (DSPCLIPPINGREGION NIL HWINDOW)) + (CLIP.LEFT (FETCH (REGION LEFT) OF CLIPPING.REGION)) + (CLIP.RIGHT (FETCH (REGION RIGHT) OF CLIPPING.REGION)) + (CLIP.WIDTH (FETCH (REGION WIDTH) OF CLIPPING.REGION)) + (OBJECTS (WINDOWPROP HWINDOW 'OBJECTS)) + DELETED.OBJECT REGION.OF.DELETED.OBJECT LEFT.OF.DELETED.OBJECT RIGHT.OF.DELETED.OBJECT + WIDTH.OF.DELETED.OBJECT OBJECTS.FOLLOWING WIDTH.OF.OBJECTS.FOLLOWING VISIBLE.WIDTH + SCREEN.REDISPLAYED) + [COND + ((NULL OBJECTS) + (ERROR "Object not found " OBJECT)) + ((EQ OBJECT (FETCH (OBJ OBJECT) OF (CAR OBJECTS))) + (SETQ DELETED.OBJECT (CAR OBJECTS)) + (WINDOWPROP HWINDOW 'OBJECTS (CDR OBJECTS)) + (SETQ OBJECTS.FOLLOWING (CDR OBJECTS)) + (DSPXPOSITION 0 HWINDOW)) + (T (FOR OBJECTTAIL ON OBJECTS WHEN (EQ OBJECT (FETCH (OBJ OBJECT) OF (CADR OBJECTTAIL))) + DO (SETQ DELETED.OBJECT (CADR OBJECTTAIL)) + (IF (FETCH (OBJ INSTANTIATED) OF DELETED.OBJECT) + THEN (DSPXPOSITION (OBJ.END.OF.OBJECT HWINDOW (CAR OBJECTTAIL)) + HWINDOW)) + (RPLACD OBJECTTAIL (CDDR OBJECTTAIL)) + (SETQ OBJECTS.FOLLOWING (CDR OBJECTTAIL)) + (RETURN) FINALLY (ERROR "Object not found " OBJECT] + [IF (FETCH (OBJ INSTANTIATED) OF DELETED.OBJECT) + THEN + (SETQ REGION.OF.DELETED.OBJECT (FETCH (OBJ REGION) OF DELETED.OBJECT)) + (SETQ LEFT.OF.DELETED.OBJECT (FETCH (REGION LEFT) OF REGION.OF.DELETED.OBJECT)) + (SETQ RIGHT.OF.DELETED.OBJECT (FETCH (REGION RIGHT) OF REGION.OF.DELETED.OBJECT)) + (SETQ WIDTH.OF.DELETED.OBJECT (FETCH (REGION WIDTH) OF REGION.OF.DELETED.OBJECT)) + (* ; + "If the deleted object was instantiated we will have to alter other objects regions") + (FOR OBJECT IN OBJECTS.FOLLOWING WHEN (OR (FETCH (OBJ INSTANTIATED) OF OBJECT) + (ILESSP (DSPXPOSITION NIL HWINDOW) + CLIP.RIGHT)) + DO (IF (FETCH (OBJ INSTANTIATED) OF OBJECT) + THEN (REPLACE (REGION LEFT) OF (FETCH (OBJ REGION) OF OBJECT) + WITH (IDIFFERENCE (FETCH (REGION LEFT) OF (FETCH (OBJ REGION) OF OBJECT)) + WIDTH.OF.DELETED.OBJECT)) + ELSE (OBJ.INSTANTIATE HWINDOW OBJECT)) + (DSPXPOSITION (OBJ.END.OF.OBJECT HWINDOW OBJECT) + HWINDOW)) + (IF (ILESSP (OBJ.END.OF.OBJECT HWINDOW DELETED.OBJECT) + CLIP.LEFT) + THEN (* ; + "Object entirely to the left of clipping region so don't adjust clipping region") + (WXOFFSET WIDTH.OF.DELETED.OBJECT HWINDOW) + (OBJ.RECOMPUTE.EXTENT HWINDOW) + ELSE + + (* ;; "Move to the left the objects following and if these can't fill the clipping region move the object before back (if there is an object before)") + + (SETQ VISIBLE.WIDTH (ADD1 (IDIFFERENCE CLIP.RIGHT LEFT.OF.DELETED.OBJECT))) + [SETQ WIDTH.OF.OBJECTS.FOLLOWING (FOR OBJECT IN OBJECTS.FOLLOWING + UNTIL (GREATERP $$VAL VISIBLE.WIDTH) + SUM (FETCH (REGION WIDTH) OF (FETCH (OBJ REGION) + OF OBJECT] + (IF (ILESSP LEFT.OF.DELETED.OBJECT CLIP.LEFT) + THEN (* ; + "Object is partially to the left of the clipping region.") + (WXOFFSET (IDIFFERENCE (FETCH (REGION LEFT) OF (FETCH (OBJ REGION) + OF (CAR OBJECTS.FOLLOWING))) + CLIP.LEFT) + HWINDOW) + (OBJ.RECOMPUTE.EXTENT HWINDOW) + (SETQ CLIPPING.REGION (DSPCLIPPINGREGION NIL HWINDOW)) + (REDISPLAYW HWINDOW CLIPPING.REGION T) + ELSE (IF (ILESSP WIDTH.OF.OBJECTS.FOLLOWING VISIBLE.WIDTH) + THEN (WXOFFSET (IDIFFERENCE WIDTH.OF.DELETED.OBJECT WIDTH.OF.OBJECTS.FOLLOWING) + HWINDOW) + (OBJ.RECOMPUTE.EXTENT HWINDOW) + (SETQ CLIPPING.REGION (DSPCLIPPINGREGION NIL HWINDOW)) + (REDISPLAYW HWINDOW CLIPPING.REGION T) + ELSE (OBJ.RECOMPUTE.EXTENT HWINDOW) + (SETQ CLIPPING.REGION (DSPCLIPPINGREGION NIL HWINDOW)) + (IF (REGIONSINTERSECTP REGION.OF.DELETED.OBJECT CLIPPING.REGION) + THEN (REDISPLAYW HWINDOW (CREATE REGION + USING CLIPPING.REGION WIDTH _ + (ADD1 (IDIFFERENCE (FETCH (REGION + RIGHT) + OF + CLIPPING.REGION + ) + LEFT.OF.DELETED.OBJECT)) + LEFT _ LEFT.OF.DELETED.OBJECT) + T] + (IF (NULL (WINDOWPROP HWINDOW 'OBJECTS)) + THEN (OBJ.CLEARW HWINDOW)) + OBJECT]) + +(OBJ.DELFROMW.VERTICAL + [LAMBDA (VWINDOW OBJECT) (* ; "Edited 3-Aug-93 09:28 by rmk:") + (* bbb "20-Dec-85 14:25") + +(* ;;; "The object is deleted from HWINDOW, close up the display by readjusting the tops of all the following objects--and then redisplay from the top of the deleted object to the bottom of the clipping region") + + (LET* + ((CLIPPING.REGION (DSPCLIPPINGREGION NIL VWINDOW)) + (CLIP.TOP (FETCH (REGION TOP) OF CLIPPING.REGION)) + (CLIP.HEIGHT (FETCH (REGION HEIGHT) OF CLIPPING.REGION)) + (OBJECTS (WINDOWPROP VWINDOW 'OBJECTS)) + DELETED.OBJECT REGION.OF.DELETED.OBJECT TOP.OF.DELETED.OBJECT HEIGHT.OF.DELETED.OBJECT + OBJECTS.FOLLOWING SCREEN.REDISPLAYED) + [COND + ((NULL OBJECTS) + (ERROR "Object not found " OBJECT)) + ((EQ OBJECT (FETCH (OBJ OBJECT) OF (CAR OBJECTS))) + (SETQ DELETED.OBJECT (CAR OBJECTS)) + (WINDOWPROP VWINDOW 'OBJECTS (CDR OBJECTS)) + (SETQ OBJECTS.FOLLOWING (CDR OBJECTS)) + (DSPYPOSITION 0 VWINDOW)) + (T (FOR OBJECTTAIL ON OBJECTS WHEN (EQ OBJECT (FETCH (OBJ OBJECT) OF (CADR OBJECTTAIL))) + DO (SETQ DELETED.OBJECT (CADR OBJECTTAIL)) + (IF (FETCH (OBJ INSTANTIATED) OF DELETED.OBJECT) + THEN (DSPYPOSITION (OBJ.END.OF.OBJECT VWINDOW (CAR OBJECTTAIL)) + VWINDOW)) + (RPLACD OBJECTTAIL (CDDR OBJECTTAIL)) + (SETQ OBJECTS.FOLLOWING (CDR OBJECTTAIL)) + (RETURN) FINALLY (ERROR "Object not found " OBJECT] + [IF (FETCH (OBJ INSTANTIATED) OF DELETED.OBJECT) + THEN (SETQ REGION.OF.DELETED.OBJECT (FETCH (OBJ REGION) OF DELETED.OBJECT)) + (SETQ TOP.OF.DELETED.OBJECT (FETCH (REGION TOP) OF REGION.OF.DELETED.OBJECT)) + (SETQ HEIGHT.OF.DELETED.OBJECT (FETCH (REGION HEIGHT) OF REGION.OF.DELETED.OBJECT)) + (* ; + "If the deleted object was instantiated we will have to alter other objects regions") + (BIND (CLIP.BOTTOM _ (FETCH (REGION BOTTOM) OF CLIPPING.REGION)) FOR OBJECT + IN OBJECTS.FOLLOWING UNTIL (AND (ILEQ (DSPYPOSITION NIL VWINDOW) + CLIP.BOTTOM) + (NOT (FETCH (OBJ INSTANTIATED) OF OBJECT))) + WHEN (OR (FETCH (OBJ INSTANTIATED) OF OBJECT) + (IGREATERP (DSPYPOSITION NIL VWINDOW) + CLIP.BOTTOM)) + DO (IF (FETCH (OBJ INSTANTIATED) OF OBJECT) + THEN (REPLACE (REGION BOTTOM) OF (FETCH (OBJ REGION) OF OBJECT) + WITH (IPLUS (FETCH (REGION BOTTOM) OF (FETCH (OBJ REGION) + OF OBJECT)) + HEIGHT.OF.DELETED.OBJECT)) + ELSE (OBJ.INSTANTIATE VWINDOW OBJECT)) + (DSPYPOSITION (OBJ.END.OF.OBJECT VWINDOW OBJECT) + VWINDOW)) + (IF (IGREATERP (OBJ.END.OF.OBJECT VWINDOW DELETED.OBJECT) + CLIP.TOP) + THEN (* ; + "Object entirely to the top of clipping region so don't adjust clipping region") + (WYOFFSET (IMINUS HEIGHT.OF.DELETED.OBJECT) + VWINDOW) + (OBJ.RECOMPUTE.EXTENT VWINDOW) + ELSE (IF (IGREATERP TOP.OF.DELETED.OBJECT CLIP.TOP) + THEN (* ; + "Object is partially in clipping region") + (IF (NOT OBJECTS.FOLLOWING) + THEN + + (* ;; "This is the very last object that we deleted. We don't allow the user to scroll past the end of the window so scroll back at most one screen") + + (IF (IGREATERP CLIP.TOP CLIP.HEIGHT) + THEN (* ; + "WYOFFSET (PLUS EXISTING.OFFSET (IMINUS CLIP.TOP)) VWINDOW") + ELSE (* ; + "WYOFFSET (PLUS EXISTING.OFFSET (IMINUS CLIP.HEIGHT)) VWINDOW") + ) + (OBJ.RECOMPUTE.EXTENT VWINDOW) + (SETQ CLIPPING.REGION (DSPCLIPPINGREGION NIL VWINDOW)) + (REDISPLAYW VWINDOW CLIPPING.REGION T) + (SETQ SCREEN.REDISPLAYED T) + ELSE (WYOFFSET (IDIFFERENCE CLIP.TOP TOP.OF.DELETED.OBJECT) + VWINDOW) + + (* ;; "Adjust the amount we're looking at by the amount of the deleted object that wasn't in the clipping region") +)) + (IF (NOT SCREEN.REDISPLAYED) + THEN (OBJ.RECOMPUTE.EXTENT VWINDOW) + (SETQ CLIPPING.REGION (DSPCLIPPINGREGION NIL VWINDOW)) + (IF (REGIONSINTERSECTP REGION.OF.DELETED.OBJECT CLIPPING.REGION) + THEN (REDISPLAYW VWINDOW [CREATE REGION + USING CLIPPING.REGION HEIGHT _ + (ADD1 (IDIFFERENCE + TOP.OF.DELETED.OBJECT + (FETCH (REGION BOTTOM) + OF CLIPPING.REGION] + T] + (IF (NULL (WINDOWPROP VWINDOW 'OBJECTS)) + THEN (OBJ.CLEARW VWINDOW)) + OBJECT]) + +(OBJ.DRAW.OBJECT + [LAMBDA (WINDOW OBJECT) (* ; "Edited 25-Nov-96 21:16 by rmk:") + (* bbb "12-Dec-85 12:29") + (PROG ((OLDX (DSPXPOSITION NIL WINDOW)) + (OLDY (DSPYPOSITION NIL WINDOW))) + (MOVETO (PLUS (FETCH (OBJ XKERN) OF OBJECT) + (FETCH (REGION LEFT) OF (FETCH (OBJ REGION) OF OBJECT))) + (PLUS (FETCH (REGION BOTTOM) OF (FETCH (OBJ REGION) OF OBJECT)) + (FETCH (OBJ YDESC) OF OBJECT)) + WINDOW) + (IF (IMAGEOBJP (FETCH (OBJ OBJECT) OF OBJECT)) + THEN (APPLY* (IMAGEOBJPROP (FETCH (OBJ OBJECT) OF OBJECT) + 'DISPLAYFN) + (FETCH (OBJ OBJECT) OF OBJECT) + (GETSTREAM WINDOW)) + ELSE (APPLY* (WINDOWPROP WINDOW 'DISPLAYFN) + (FETCH (OBJ OBJECT) OF OBJECT) + (GETSTREAM WINDOW))) + (IF (EQ (WINDOWPROP WINDOW 'WINDOWTYPE) + 'HORIZONTAL) + THEN (MOVETO (OBJ.END.OF.OBJECT WINDOW OBJECT) + OLDY WINDOW) + ELSE (MOVETO OLDX (OBJ.END.OF.OBJECT WINDOW OBJECT) + WINDOW]) + +(OBJ.END.OF.OBJECT + [LAMBDA (WINDOW OBJECT FLIPVERTICAL) (* ; "Edited 25-Nov-96 21:16 by rmk:") + (* bbb "16-Dec-85 16:21") + + (* ;; "Returns negative values for vertical window if FLIPVERTICAL. This helps to unify horizontal and vertical calculations, compensating for the fact that vertical positions are measured bottom-up, horizontal are measured left-right, and we want to draw objects left-right but top-down.") + + (IF (EQ (WINDOWPROP WINDOW 'WINDOWTYPE) + 'HORIZONTAL) + THEN (PLUS (FETCH (REGION LEFT) OF (FETCH (OBJ REGION) OF OBJECT)) + (FETCH (REGION WIDTH) OF (FETCH (OBJ REGION) OF OBJECT)) + (WINDOWPROP WINDOW 'SEPARATIONDISTANCE)) + ELSEIF FLIPVERTICAL + THEN (DIFFERENCE (WINDOWPROP WINDOW 'SEPARATIONDISTANCE) + (FETCH (REGION BOTTOM) OF (FETCH (OBJ REGION) OF OBJECT))) + ELSE (DIFFERENCE (FETCH (REGION BOTTOM) OF (FETCH (OBJ REGION) OF OBJECT)) + (WINDOWPROP WINDOW 'SEPARATIONDISTANCE]) + +(OBJ.FIND.OBJECT + [LAMBDA (WINDOW MOUSEX MOUSEY) (* bbb "19-Dec-85 14:34") + (LET [(OBJECT (if (EQ (WINDOWPROP WINDOW 'WINDOWTYPE) + 'HORIZONTAL) + then (for OBJECT in (WINDOWPROP WINDOW 'OBJECTS) + thereis (AND (ILEQ (fetch (REGION LEFT) of (fetch (OBJ REGION) + of OBJECT)) + MOUSEX) + (IGEQ (fetch (REGION RIGHT) of (fetch (OBJ REGION) + of OBJECT)) + MOUSEX)) repeatuntil (IGREATERP (OBJ.END.OF.OBJECT + WINDOW OBJECT) + MOUSEX)) + else (for OBJECT in (WINDOWPROP WINDOW 'OBJECTS) + thereis (AND (IGEQ (fetch (REGION TOP) of (fetch (OBJ REGION) + of OBJECT)) + MOUSEY) + (ILEQ (fetch (REGION BOTTOM) of (fetch (OBJ REGION) + of OBJECT)) + MOUSEY)) repeatuntil (ILESSP (OBJ.END.OF.OBJECT WINDOW + OBJECT) + MOUSEY] + OBJECT]) + +(OBJ.FIND.REGION.HORIZONTAL + [LAMBDA (HWINDOW SEARCHOBJECT) (* bbb "11-Dec-85 10:52") + + (* The object SEARCHOBJECT is searched for and its region is returned. + This may involve instantiating objects.) + + (LET ((OLDX (DSPXPOSITION NIL HWINDOW)) + FOUND) + (DSPXPOSITION [fetch (REGION LEFT) of (fetch (OBJ REGION) of (CAR (WINDOWPROP HWINDOW + 'OBJECTS] + HWINDOW) + (for OBJECT in (WINDOWPROP HWINDOW 'OBJECTS) + do (if (NOT (fetch (OBJ INSTANTIATED) of OBJECT)) + then (if (EQ SEARCHOBJECT (fetch (OBJ OBJECT) of OBJECT)) + then (SETQ FOUND T)) + (OBJ.COMPUTE.IMAGEBOX HWINDOW OBJECT) + (OBJ.COMPUTE.REGION HWINDOW OBJECT) + (SETQ OLDX (OBJ.END.OF.OBJECT HWINDOW OBJECT)) + (DSPXPOSITION OLDX HWINDOW) + else (DSPXPOSITION (OBJ.END.OF.OBJECT HWINDOW OBJECT) + HWINDOW)) repeatuntil (OR (EQ SEARCHOBJECT (fetch (OBJ OBJECT) + of OBJECT)) + FOUND) + finally (DSPXPOSITION OLDX HWINDOW) + (WINDOWPROP HWINDOW 'OLDXPOSITION (DSPXPOSITION NIL HWINDOW)) + (WINDOWPROP HWINDOW 'OLDYPOSITION (DSPYPOSITION NIL HWINDOW)) + (if (OR (EQ SEARCHOBJECT (fetch (OBJ OBJECT) of OBJECT)) + FOUND) + then (RETURN (fetch (OBJ REGION) of OBJECT]) + +(OBJ.FIND.REGION.VERTICAL + [LAMBDA (VWINDOW SEARCHOBJECT) (* bbb "12-Dec-85 14:07") + + (* The object SEARCHOBJECT is searched for and its region is returned. + This may involve instantiating objects.) + + (LET ((OLDY (DSPYPOSITION NIL VWINDOW)) + FOUND) + (DSPYPOSITION [fetch (REGION TOP) of (fetch (OBJ REGION) of (CAR (WINDOWPROP VWINDOW + 'OBJECTS] + VWINDOW) + (for OBJECT in (WINDOWPROP VWINDOW 'OBJECTS) + do (if (NOT (fetch (OBJ INSTANTIATED) of OBJECT)) + then (if (EQ SEARCHOBJECT (fetch (OBJ OBJECT) of OBJECT)) + then (SETQ FOUND T)) + (OBJ.COMPUTE.IMAGEBOX VWINDOW OBJECT) + (RELMOVETO 0 (IMINUS (fetch (OBJ ASCENT) of OBJECT)) + VWINDOW) + (OBJ.COMPUTE.REGION VWINDOW OBJECT) + (SETQ OLDY (OBJ.END.OF.OBJECT VWINDOW OBJECT)) + (DSPYPOSITION OLDY VWINDOW) + else (DSPYPOSITION (OBJ.END.OF.OBJECT VWINDOW OBJECT) + VWINDOW)) repeatuntil (OR (EQ SEARCHOBJECT (fetch (OBJ OBJECT) + of OBJECT)) + FOUND) + finally (DSPYPOSITION OLDY VWINDOW) + (WINDOWPROP VWINDOW 'OLDXPOSITION (DSPXPOSITION NIL VWINDOW)) + (WINDOWPROP VWINDOW 'OLDYPOSITION (DSPYPOSITION NIL VWINDOW)) + (if (OR (EQ SEARCHOBJECT (fetch (OBJ OBJECT) of OBJECT)) + FOUND) + then (RETURN (fetch (OBJ REGION) of OBJECT]) + +(OBJ.FLIP.OBJECT + [LAMBDA (OBJECT WINDOW) (* bbb "11-Dec-85 10:46") + (LET ((REGION (fetch (OBJ REGION) of OBJECT))) + (BLTSHADE BLACKSHADE WINDOW (fetch (REGION LEFT) of REGION) + (fetch (REGION BOTTOM) of REGION) + (fetch (REGION WIDTH) of REGION) + (fetch (REGION HEIGHT) of REGION) + 'INVERT + (DSPCLIPPINGREGION NIL WINDOW]) + +(OBJ.HARDCOPYFN + [LAMBDA (WINDOW STREAM) (* ; "Edited 27-Nov-96 10:33 by rmk:") + + (* ;; "First make sure that everything is instantiated") + + (FOR OBJECT BOX TOP (FIRSTTIME _ T) + [SEPDISTANCE _ (TIMES (DSPSCALE NIL STREAM) + (WINDOWPROP WINDOW 'SEPARATIONDISTANCE] + (LMARG _ (DSPLEFTMARGIN NIL STREAM)) + (RMARG _ (DSPRIGHTMARGIN NIL STREAM)) + (BMARG _ (DSPBOTTOMMARGIN NIL STREAM)) + (WINDOWTYPE _ (WINDOWPROP WINDOW 'WINDOWTYPE)) IN (WINDOWPROP WINDOW 'OBJECTS) + DO + (* ;; "First make sure that OBJECT is instantiated, as if we had scrolled over it") + + (OBJ.INSTANTIATE WINDOW OBJECT) + (SETQ OBJECT (FETCH (OBJ OBJECT) OF OBJECT)) + + (* ;; "Then compute the imagebox for this particular stream") + + (SETQ BOX (APPLY* (IMAGEOBJPROP OBJECT 'IMAGEBOXFN) + OBJECT STREAM)) + + (* ;; "Finally display the thing") + + (IF FIRSTTIME + THEN (SETQ FIRSTTIME NIL) + ELSEIF (IF (EQ WINDOWTYPE 'HORIZONTAL) + THEN (GREATERP (+ (DSPXPOSITION NIL STREAM) + (FETCH XSIZE OF BOX)) + RMARG) + ELSE (LESSP (- (DSPYPOSITION NIL STREAM) + (FETCH YSIZE OF BOX)) + BMARG)) + THEN (* ; "Won't fit, go to new page") + (DSPNEWPAGE STREAM)) + (SETQ TOP (DSPYPOSITION NIL STREAM)) + (APPLY* (IMAGEOBJPROP OBJECT 'DISPLAYFN) + OBJECT STREAM) + (CL:IF (EQ WINDOWTYPE 'HORIZONTAL) + (MOVETO (+ (DSPXPOSITION NIL STREAM) + SEPDISTANCE) + TOP STREAM) + (MOVETO LMARG (- (DSPYPOSITION NIL STREAM) + SEPDISTANCE) + STREAM))]) + +(OBJ.INDEX.OBJECT + [LAMBDA (WINDOW XORYDELTA) (* bbb "12-Dec-85 16:46") + (LET* [(OBJECTS (WINDOWPROP WINDOW 'OBJECTS)) + (NOBJECTS (FLENGTH OBJECTS)) + (OBJPOS (FTIMES NOBJECTS XORYDELTA)) + (OBJNUM (FIX OBJPOS)) + (OBJREG (OBJ.FIND.REGION WINDOW (fetch (OBJ OBJECT) + of (CAR (NTH OBJECTS (IMIN NOBJECTS (ADD1 OBJNUM] + + (* Note%: although we do the check for the case where XORYDELTA = 1.0 we won't + actually be able to scroll off the end of the object until we can add the window + property about extent use in scrolling. This property is in Jazz but we may put + it into Intermezzo LFG.) + + (if (EQ (WINDOWPROP WINDOW 'WINDOWTYPE) + 'HORIZONTAL) + then (IPLUS (fetch (REGION LEFT) of OBJREG) + (FTIMES (if (FEQP XORYDELTA 1.0) + then 1.0 + else (FDIFFERENCE OBJPOS OBJNUM)) + (fetch (REGION WIDTH) of OBJREG))) + else (IDIFFERENCE (fetch (REGION TOP) of OBJREG) + (FTIMES (if (FEQP XORYDELTA 1.0) + then 1.0 + else (FDIFFERENCE OBJPOS OBJNUM)) + (fetch (REGION HEIGHT) of OBJREG]) + +(OBJ.INSTANTIATE + [LAMBDA (WINDOW OBJECT PREVOBJECT) (* ; "Edited 25-Nov-96 20:53 by rmk:") + (* bbb "19-Dec-85 11:46") + (LET [(WINDOWTYPE (WINDOWPROP WINDOW 'WINDOWTYPE] + (if (NOT (fetch (OBJ INSTANTIATED) of OBJECT)) + then (OBJ.COMPUTE.IMAGEBOX WINDOW OBJECT) + (if PREVOBJECT + then (if (EQ WINDOWTYPE 'HORIZONTAL) + then (DSPXPOSITION (OBJ.END.OF.OBJECT WINDOW PREVOBJECT) + WINDOW) + else (DSPYPOSITION (OBJ.END.OF.OBJECT WINDOW PREVOBJECT) + WINDOW))) + (if (EQ WINDOWTYPE 'VERTICAL) + then (RELMOVETO 0 (IMINUS (fetch (OBJ ASCENT) of OBJECT)) + WINDOW)) + (OBJ.COMPUTE.REGION WINDOW OBJECT)) + (if (EQ WINDOWTYPE 'HORIZONTAL) + then (DSPXPOSITION (OBJ.END.OF.OBJECT WINDOW OBJECT) + WINDOW) + else (DSPYPOSITION (OBJ.END.OF.OBJECT WINDOW OBJECT) + WINDOW]) + +(OBJ.MOVETO.LAST.INSTANTIATED.OBJECT + [LAMBDA (WINDOW OBJECTS) (* bbb "19-Dec-85 13:58") + (for OBJECTTAIL on OBJECTS unless (AND (CADR OBJECTTAIL) + (fetch (OBJ INSTANTIATED) of (CADR OBJECTTAIL))) + bind NEW.XORY do (SETQ NEW.XORY (OBJ.END.OF.OBJECT WINDOW (CAR OBJECTTAIL))) + (if (EQ (WINDOWPROP WINDOW 'WINDOWTYPE) + 'HORIZONTAL) + then (DSPXPOSITION NEW.XORY WINDOW) + else (DSPYPOSITION NEW.XORY WINDOW)) + (RETURN]) + +(OBJ.RECOMPUTE.EXTENT + [LAMBDA (WINDOW) (* ; "Edited 3-May-94 10:34 by rmk:") + (* bbb "10-Dec-85 11:20") + + (* ;; "Fakes up the EXTENT property so that the thumb-scrolling scale will be in terms of number of objects, not their actual widths. This gives reasonable behavior, even if we haven't instantiated all the objects, hence don't know how wide they are. And of course, a scale in terms of true widths wouldn't help the user, because HE has no idea until he's seen them all!") + + (PROG ((CLIPREG (DSPCLIPPINGREGION NIL WINDOW)) + [HORIZONTAL (EQ 'HORIZONTAL (WINDOWPROP WINDOW 'WINDOWTYPE] + (OBJECTS (WINDOWPROP WINDOW 'OBJECTS)) + CLIPSTART CLIPEND NOBJECTS NUMBER.IN.CLIPPING.REGION NUMBER.PRIOR.TO.CLIPPING.REGION + LAST.OBJ.FRACT STARTTAIL REGIONSIZE) + (CL:UNLESS OBJECTS + (OBJ.CLEAR.EXTENT WINDOW) + (RETURN)) + [IF HORIZONTAL + THEN (SETQ CLIPSTART (FETCH (REGION LEFT) OF CLIPREG)) + (SETQ CLIPEND (FETCH (REGION RIGHT) OF CLIPREG)) + ELSE + (* ;; "Flip vertical coordinates to compenstate for the fact that ypositions are measured top-down. OBJ.END.OF.OBJ will also return negative values in the vertical case. But we still have to compensate below when looking at object regions.") + + (SETQ CLIPSTART (MINUS (FETCH (REGION TOP) OF CLIPREG))) + (SETQ CLIPEND (MINUS (FETCH (REGION BOTTOM) OF CLIPREG] + (SETQ NOBJECTS (LENGTH OBJECTS)) + + (* ;; "NUMBER.TO.LEFT.OF.CLIPPING.REGION are the ones that won't be shown. STARTTAIL has the first possibly visible one. Switches on HORIZONTAL because Y positions go from bottom up but we are mapping top to left.") + + [SETQ NUMBER.PRIOR.TO.CLIPPING.REGION + (FOR OTAIL OREG ON OBJECTS EACHTIME (SETQ OREG (FETCH (OBJ REGION) OF (CAR OTAIL))) + UNTIL (IGEQ (OBJ.END.OF.OBJECT WINDOW (CAR OTAIL) + T) + CLIPSTART) SUM 1 + FINALLY (IF OTAIL + THEN (SETQ STARTTAIL OTAIL) + ELSE + (* ;; + "It seems like everything is prior to the clipping region, so declare that the last one isn't") + + (SETQ STARTTAIL (LAST OBJECTS)) + (SETQ OREG (FETCH (OBJ REGION) OF (CAR STARTTAIL))) + (ADD $$VAL -1)) + + (* ;; "LAST.OBJ.FRACT is the fraction of the last object that will NOT be seen.") + + (SETQ LAST.OBJ.FRACT (IF OREG + THEN (CL:IF HORIZONTAL + (FQUOTIENT (IDIFFERENCE CLIPSTART + (FETCH (REGION LEFT) + OF OREG)) + (FETCH (REGION WIDTH) OF OREG)) + (FQUOTIENT (IDIFFERENCE + CLIPSTART + (MINUS (FETCH (REGION TOP) + OF OREG))) + (FETCH (REGION HEIGHT) OF OREG))) + ELSE 0.0)) + (RETURN (FPLUS $$VAL LAST.OBJ.FRACT] + + (* ;; "SETQ NUMBER.IN.CLIPPING.REGION (FPLUS (FDIFFERENCE 1.0 LEFTFRACT) (if (ILESSP (fetch (REGION RIGHT) of (fetch (OBJ REGION) of (CAR LEFTTAIL))) CLIPRIGHT) then (for OBJECT in (CDR LEFTTAIL) until (IGEQ (fetch (REGION RIGHT) of (fetch (OBJ REGION) of OBJECT)) CLIPRIGHT) sum 1 finally (if OBJECT then (RETURN (FPLUS $$VAL (FQUOTIENT (IDIFFERENCE CLIPRIGHT (fetch (REGION LEFT) of (fetch (OBJ REGION) of OBJECT))) (fetch (REGION WIDTH) of (fetch (OBJ REGION) of OBJECT))))))) else 0.0))") + + (* ;; "NUMBER.IN.CLIPPING.REGION are the ones that will be seen") + + [SETQ NUMBER.IN.CLIPPING.REGION + (IF (ILESSP (OBJ.END.OF.OBJECT WINDOW (CAR STARTTAIL) + T) + CLIPEND) + THEN + + (* ;; "All of starting object is visible, so there may be more") + + [FPLUS + (FDIFFERENCE 1.0 LAST.OBJ.FRACT) + (FOR OBJECT OREG IN (CDR STARTTAIL) WHILE (FETCH INSTANTIATED OF OBJECT) + UNTIL (IGEQ (OBJ.END.OF.OBJECT WINDOW OBJECT T) + CLIPEND) SUM 1 + FINALLY + + (* ;; "Add on the fact of the last object that is visible") + + (CL:WHEN OBJECT + (SETQ OREG (FETCH (OBJ REGION) OF OBJECT)) + [RETURN (FPLUS $$VAL (CL:IF HORIZONTAL + (FQUOTIENT (IDIFFERENCE CLIPEND + (FETCH (REGION LEFT) + OF OREG)) + (FETCH (REGION WIDTH) OF OREG)) + (FQUOTIENT (IDIFFERENCE + CLIPEND + (MINUS (FETCH (REGION TOP) + OF OREG))) + (FETCH (REGION HEIGHT) OF OREG)))])] + ELSE + (* ;; "Starting object ends in clipping region") + + (CL:IF HORIZONTAL + [FQUOTIENT [IDIFFERENCE CLIPEND (FETCH (REGION LEFT) OF (FETCH (OBJ REGION) + OF (CAR STARTTAIL] + (FETCH (REGION WIDTH) OF (FETCH (OBJ REGION) OF (CAR STARTTAIL] + [FQUOTIENT [IDIFFERENCE CLIPEND (MINUS (FETCH (REGION TOP) + OF (FETCH (OBJ REGION) + OF (CAR STARTTAIL] + (FETCH (REGION HEIGHT) OF (FETCH (OBJ REGION) OF (CAR STARTTAIL])] + + (* ;; "REGIONSIZE is computed by first calculating the total width (in points) if each object were as wide as the clipping region, and dividing that by the number that will actually appear. Thus, it estimates how big a fictional clippring region would have to be if the actual region were to contain one average-size object.") + + (SETQ REGIONSIZE (FIX (FQUOTIENT (FTIMES NOBJECTS (CL:IF HORIZONTAL + (FETCH (REGION WIDTH) OF CLIPREG) + (FETCH (REGION HEIGHT) OF CLIPREG))) + NUMBER.IN.CLIPPING.REGION))) + + (* ;; "We now compute the start of the extent (left or bottom) by positioning so that the right number of items will (fictionally) be prior to CLIPSTART.") + + (WINDOWPROP WINDOW 'EXTENT (CL:IF HORIZONTAL + (CREATE REGION + WIDTH _ REGIONSIZE + LEFT _ (IDIFFERENCE CLIPSTART (TIMES REGIONSIZE + (FQUOTIENT + + NUMBER.PRIOR.TO.CLIPPING.REGION + NOBJECTS))) + BOTTOM _ -1 + HEIGHT _ -1) + (CREATE REGION + WIDTH _ -1 + LEFT _ -1 + BOTTOM _ (IDIFFERENCE + [IDIFFERENCE CLIPSTART + (MINUS (TIMES REGIONSIZE + (FQUOTIENT + NUMBER.PRIOR.TO.CLIPPING.REGION + NOBJECTS] + REGIONSIZE) + HEIGHT _ REGIONSIZE))]) + +(OBJ.REPAINTFN + [LAMBDA (WINDOW REGION) (* bbb "22-Aug-86 17:21") + + (* * Go through and figure out what objects intersect with this region and redraw + them) + + (LET ((OLDX (DSPXPOSITION NIL WINDOW)) + (OLDY (DSPYPOSITION NIL WINDOW)) + (WINDOWTYPE (WINDOWPROP WINDOW 'WINDOWTYPE)) + FIRST.OBJECT) + [if (WINDOWPROP WINDOW 'OBJECTS) + then (* Old code (SETQ FIRST.OBJECT + (CAR (WINDOWPROP WINDOW + (QUOTE OBJECTS)))) (MOVETO + (fetch (REGION LEFT) of + (fetch (OBJ REGION) of FIRST.OBJECT)) + (PLUS (fetch (REGION BOTTOM) of + (fetch (OBJ REGION) of FIRST.OBJECT)) + (fetch (OBJ YDESC) of FIRST.OBJECT)) + WINDOW)) + (OBJ.MOVETO.LAST.INSTANTIATED.OBJECT WINDOW (WINDOWPROP WINDOW 'OBJECTS] + (bind IMAGEBOX for OBJECT in (WINDOWPROP WINDOW 'OBJECTS) + do [if (NOT (fetch INSTANTIATED of OBJECT)) + then (OBJ.COMPUTE.IMAGEBOX WINDOW OBJECT) + (if (EQ WINDOWTYPE 'VERTICAL) + then (RELMOVETO 0 (IMINUS (fetch (OBJ ASCENT) of OBJECT)) + WINDOW)) + (OBJ.COMPUTE.REGION WINDOW OBJECT) + (if (EQ WINDOWTYPE 'HORIZONTAL) + then (SETQ OLDX (OBJ.END.OF.OBJECT WINDOW OBJECT)) + else (SETQ OLDY (OBJ.END.OF.OBJECT WINDOW OBJECT] + (if (REGIONSINTERSECTP (fetch (OBJ REGION) of OBJECT) + REGION) + then (OBJ.DRAW.OBJECT WINDOW OBJECT)) + (if [OR (AND (EQ WINDOWTYPE 'HORIZONTAL) + (IGEQ (OBJ.END.OF.OBJECT WINDOW OBJECT) + (fetch (REGION RIGHT) of REGION))) + (AND (EQ WINDOWTYPE 'VERTICAL) + (ILEQ (OBJ.END.OF.OBJECT WINDOW OBJECT) + (fetch (REGION BOTTOM) of REGION] + then (RETURN) + else (MOVETO OLDX OLDY WINDOW))) + (MOVETO OLDX OLDY WINDOW) + (WINDOWPROP WINDOW 'OLDXPOSITION (DSPXPOSITION NIL WINDOW)) + (WINDOWPROP WINDOW 'OLDYPOSITION (DSPYPOSITION NIL WINDOW]) + +(OBJ.REPLACE.HORIZONTAL + [LAMBDA (HWINDOW OLD.OBJECT NEW.OBJECT DONT.REDISPLAY.FLG) (* ; "Edited 27-Jul-93 17:11 by rmk:") + (* bbb "19-Dec-85 16:40") + +(* ;;; "Replaces new object with old object and adjusts the region of all objects to its left") + + (LET* ((CLIPPING.REGION (DSPCLIPPINGREGION NIL HWINDOW)) + (CLIP.LEFT (FETCH (REGION LEFT) OF CLIPPING.REGION)) + (CLIP.RIGHT (FETCH (REGION RIGHT) OF CLIPPING.REGION)) + (OBJECTS (WINDOWPROP HWINDOW 'OBJECTS)) + OBJECTS.TAIL OBJ OLD.REGION NEW.REGION WIDTH.CHANGE WIDTH.SHOWING LEFT.OF.OLD.OBJECT + END.OF.OLD.OBJECT) + (FOR OBJECT ON OBJECTS WHEN (EQ OLD.OBJECT (FETCH (OBJ OBJECT) OF (CAR OBJECT))) + DO (REPLACE (OBJ OBJECT) OF (CAR OBJECT) WITH NEW.OBJECT) + (SETQ OBJ (CAR OBJECT)) + (SETQ END.OF.OLD.OBJECT (IF (FETCH (OBJ INSTANTIATED) OF OBJ) + THEN (OBJ.END.OF.OBJECT HWINDOW OBJ))) + (SETQ OLD.REGION (FETCH (OBJ REGION) OF (CAR OBJECT))) + (SETQ OBJECTS.TAIL (CDR OBJECT)) + (RETURN) FINALLY (ERROR "Object not found " OLD.OBJECT)) + + (* ;; "Clear the screen starting at the replaced object, if necessary compute the new region and change the region of all following objects (if they're instantiated) and redraw those that are on the screen.") + + [IF (FETCH (OBJ INSTANTIATED) OF OBJ) + THEN (SETQ LEFT.OF.OLD.OBJECT (FETCH (REGION LEFT) OF OLD.REGION)) + (DSPXPOSITION LEFT.OF.OLD.OBJECT HWINDOW) + (REPLACE (OBJ INSTANTIATED) OF OBJ WITH NIL) + (OBJ.INSTANTIATE HWINDOW OBJ) + (SETQ NEW.REGION (FETCH (OBJ REGION) OF OBJ)) + (DSPXPOSITION (OBJ.END.OF.OBJECT HWINDOW OBJ) + HWINDOW) + (SETQ WIDTH.CHANGE (IDIFFERENCE (FETCH (REGION WIDTH) OF NEW.REGION) + (FETCH (REGION WIDTH) OF OLD.REGION] + (FOR OBJECT IN OBJECTS.TAIL WHEN (OR (FETCH (OBJ INSTANTIATED) OF OBJECT) + (ILESSP (DSPXPOSITION NIL HWINDOW) + CLIP.RIGHT)) + DO (IF (FETCH (OBJ INSTANTIATED) OF OBJECT) + THEN (REPLACE (REGION LEFT) OF (FETCH (OBJ REGION) OF OBJECT) + WITH (IPLUS (FETCH (REGION LEFT) OF (FETCH (OBJ REGION) OF OBJECT)) + WIDTH.CHANGE)) + ELSE (OBJ.INSTANTIATE HWINDOW OBJECT)) + (DSPXPOSITION (OBJ.END.OF.OBJECT HWINDOW OBJECT) + HWINDOW)) + (IF (AND (NULL DONT.REDISPLAY.FLG) + (FETCH (OBJ INSTANTIATED) OF OBJ)) + THEN (IF (ILESSP END.OF.OLD.OBJECT CLIP.LEFT) + THEN + (* ;; "Object is entirely to the left of the clipping region, adjust the clipping region but visually leave everything the same") + + (WXOFFSET (IMINUS WIDTH.CHANGE) + HWINDOW) + (OBJ.RECOMPUTE.EXTENT HWINDOW) + ELSEIF (ILESSP LEFT.OF.OLD.OBJECT CLIP.LEFT) + THEN + (* ;; "Old object is partially in the clipping region. In the case where the new object has a smaller area than the amount of the old object that is showing we align the new object at the left edge of the clipping region. Otherwise we will see the same amount of the new object as the old object") + + (SETQ WIDTH.SHOWING (ADD1 (IDIFFERENCE (FETCH (REGION RIGHT) OF + OLD.REGION + ) + CLIP.LEFT))) + (IF (ILESSP (FETCH (REGION WIDTH) OF NEW.REGION) + WIDTH.SHOWING) + THEN (WXOFFSET (IDIFFERENCE CLIP.LEFT LEFT.OF.OLD.OBJECT) + HWINDOW) + (OBJ.RECOMPUTE.EXTENT HWINDOW) + (SETQ CLIPPING.REGION (DSPCLIPPINGREGION NIL HWINDOW)) + (REDISPLAYW HWINDOW CLIPPING.REGION T) + ELSE (WXOFFSET (IMINUS WIDTH.CHANGE) + HWINDOW) + (OBJ.RECOMPUTE.EXTENT HWINDOW) + (SETQ CLIPPING.REGION (DSPCLIPPINGREGION NIL HWINDOW)) + (REDISPLAYW HWINDOW (CREATE REGION USING CLIPPING.REGION WIDTH _ + WIDTH.SHOWING) + T)) + ELSE (OBJ.RECOMPUTE.EXTENT HWINDOW) + (SETQ CLIPPING.REGION (DSPCLIPPINGREGION NIL HWINDOW)) + (IF (REGIONSINTERSECTP NEW.REGION CLIPPING.REGION) + THEN (REDISPLAYW HWINDOW [CREATE REGION + USING CLIPPING.REGION LEFT _ + (FETCH (REGION LEFT) OF NEW.REGION) + WIDTH _ + (ADD1 (IDIFFERENCE + (FETCH (REGION RIGHT) + OF CLIPPING.REGION) + (FETCH (REGION LEFT) + OF NEW.REGION] + T]) + +(OBJ.REPLACE.VERTICAL + [LAMBDA (VWINDOW OLD.OBJECT NEW.OBJECT DONT.REDISPLAY.FLG) (* bbb "19-Dec-85 16:45") + + (* * Replaces new object with old object and adjusts the region of all objects to + its top) + + (LET* ((CLIPPING.REGION (DSPCLIPPINGREGION NIL VWINDOW)) + (CLIP.TOP (fetch (REGION TOP) of CLIPPING.REGION)) + (CLIP.BOTTOM (fetch (REGION BOTTOM) of CLIPPING.REGION)) + (OBJECTS (WINDOWPROP VWINDOW 'OBJECTS)) + OBJECTS.TAIL OBJ OLD.REGION NEW.REGION HEIGHT.CHANGE HEIGHT.SHOWING TOP.OF.OLD.OBJECT + END.OF.OLD.OBJECT) + (for OBJECT on OBJECTS when (EQ OLD.OBJECT (fetch (OBJ OBJECT) of (CAR OBJECT))) + do (replace (OBJ OBJECT) of (CAR OBJECT) with NEW.OBJECT) + (SETQ OBJ (CAR OBJECT)) + (SETQ END.OF.OLD.OBJECT (if (fetch (OBJ INSTANTIATED) of OBJ) + then (OBJ.END.OF.OBJECT VWINDOW OBJ))) + (SETQ OLD.REGION (fetch (OBJ REGION) of (CAR OBJECT))) + (SETQ OBJECTS.TAIL (CDR OBJECT)) + (RETURN) finally (ERROR "Object not found " OLD.OBJECT)) + + (* Clear the screen starting at the replaced object, if necessary compute the new + region and change the region of all following objects + (if they're instantiated) and redraw those that are on the screen.) + + [if (fetch (OBJ INSTANTIATED) of OBJ) + then (SETQ TOP.OF.OLD.OBJECT (fetch (REGION TOP) of OLD.REGION)) + (DSPYPOSITION TOP.OF.OLD.OBJECT VWINDOW) + (replace (OBJ INSTANTIATED) of OBJ with NIL) + (OBJ.INSTANTIATE VWINDOW OBJ) + (SETQ NEW.REGION (fetch (OBJ REGION) of OBJ)) + (DSPYPOSITION (OBJ.END.OF.OBJECT VWINDOW OBJ) + VWINDOW) + (SETQ HEIGHT.CHANGE (IDIFFERENCE (fetch (REGION HEIGHT) of NEW.REGION) + (fetch (REGION HEIGHT) of OLD.REGION] + (for OBJECT in OBJECTS.TAIL when (OR (fetch (OBJ INSTANTIATED) of OBJECT) + (IGREATERP (DSPYPOSITION NIL VWINDOW) + CLIP.BOTTOM)) + do (if (fetch (OBJ INSTANTIATED) of OBJECT) + then (replace (REGION BOTTOM) of (fetch (OBJ REGION) of OBJECT) + with (IDIFFERENCE (fetch (REGION BOTTOM) of (fetch (OBJ REGION) + of OBJECT)) + HEIGHT.CHANGE)) + else (OBJ.INSTANTIATE VWINDOW OBJECT)) + (DSPYPOSITION (OBJ.END.OF.OBJECT VWINDOW OBJECT) + VWINDOW)) + (if (AND (NULL DONT.REDISPLAY.FLG) + (fetch (OBJ INSTANTIATED) of OBJ)) + then (if (IGREATERP END.OF.OLD.OBJECT CLIP.TOP) + then + + (* Object is entirely to the top of the clipping region, adjust the clipping + region but visually leave everything the same) + + (WYOFFSET HEIGHT.CHANGE VWINDOW) + (OBJ.RECOMPUTE.EXTENT VWINDOW) + elseif (IGREATERP TOP.OF.OLD.OBJECT CLIP.TOP) + then + + (* Old object is partially in the clipping region. + In the case where the new object has a smaller area than the amount of the old + object that is showing we align the new object at the top edge of the clipping + region. Otherwise we will see the same amount of the new object as the old object) + + [SETQ HEIGHT.SHOWING (ADD1 (IDIFFERENCE CLIP.TOP (fetch (REGION BOTTOM) + of OLD.REGION] + (if (ILESSP (fetch (REGION HEIGHT) of NEW.REGION) + HEIGHT.SHOWING) + then (WYOFFSET (IDIFFERENCE TOP.OF.OLD.OBJECT CLIP.TOP) + VWINDOW) + (OBJ.RECOMPUTE.EXTENT VWINDOW) + (SETQ CLIPPING.REGION (DSPCLIPPINGREGION NIL VWINDOW)) + (REDISPLAYW VWINDOW CLIPPING.REGION T) + else (WYOFFSET HEIGHT.CHANGE VWINDOW) + (OBJ.RECOMPUTE.EXTENT VWINDOW) + (SETQ CLIPPING.REGION (DSPCLIPPINGREGION NIL VWINDOW)) + (REDISPLAYW VWINDOW (create REGION using CLIPPING.REGION BOTTOM _ + (fetch (REGION BOTTOM) + of NEW.REGION) + HEIGHT _ HEIGHT.SHOWING) + T)) + else (OBJ.RECOMPUTE.EXTENT VWINDOW) + (SETQ CLIPPING.REGION (DSPCLIPPINGREGION NIL VWINDOW)) + (if (REGIONSINTERSECTP NEW.REGION CLIPPING.REGION) + then (REDISPLAYW VWINDOW (create REGION + using CLIPPING.REGION BOTTOM _ + (fetch (REGION BOTTOM) of + CLIPPING.REGION + ) + HEIGHT _ (IDIFFERENCE + (fetch (REGION TOP) + of NEW.REGION) + (fetch (REGION BOTTOM) + of CLIPPING.REGION))) + T]) + +(OBJ.RESHAPEFN + [LAMBDA (WINDOW OLDIMAGE IMAGEREGION OLDSCREENREGION) (* ; "Edited 28-Apr-95 16:12 by rmk:") + (* bbb "13-May-86 15:18") + (WINDOWPROP WINDOW 'EXTENT NIL) + + (* ;; "The extent of an OBJ window is funny and confuses the RESHAPEBYREPAINTFN. So we eliminated it first, then recompute it.") + + (RESHAPEBYREPAINTFN WINDOW OLDIMAGE IMAGEREGION OLDSCREENREGION) + (DSPRIGHTMARGIN 65535 WINDOW) + (OBJ.RECOMPUTE.EXTENT WINDOW]) + +(OBJ.SCROLLFN + [LAMBDA (WINDOW XDELTA YDELTA CONTINUOUSFLG) (* ; "Edited 21-Mar-95 16:00 by rmk:") + (* bbb "11-Dec-85 10:49") + (IF (WINDOWPROP WINDOW 'OBJECTS) + THEN (IF (EQ (WINDOWPROP WINDOW 'WINDOWTYPE) + 'HORIZONTAL) + THEN (OBJ.SCROLLFN.HORIZONTAL WINDOW XDELTA YDELTA CONTINUOUSFLG) + ELSE (OBJ.SCROLLFN.VERTICAL WINDOW XDELTA YDELTA CONTINUOUSFLG]) + +(OBJ.SCROLLFN.HORIZONTAL + [LAMBDA (HWINDOW XDELTA YDELTA CONTINUOUSFLG) (* ; "Edited 21-Mar-95 16:00 by rmk:") + (* bbb "14-May-86 17:00") + (LET* [(OBJECTS (WINDOWPROP HWINDOW 'OBJECTS)) + (REGIONOFFIRST (FETCH (OBJ REGION) OF (CAR OBJECTS))) + (LEFTOFFIRST (FETCH (REGION LEFT) OF (FETCH (OBJ REGION) OF (CAR OBJECTS] + (IF (NOT (FLOATP YDELTA)) + THEN (* ; + "Disallow thumb scrolling in the vertical direction because the extent isn't defined") + [IF (FLOATP XDELTA) + THEN (SETQ XDELTA (IDIFFERENCE (FETCH (REGION LEFT) OF (DSPCLIPPINGREGION + NIL HWINDOW)) + (OBJ.INDEX.OBJECT HWINDOW XDELTA] + + (* ;; "Make sure that all objects that will be shown are instantiated, so we can compute a valid true region") + + (FOR OBJECT PREV (NEWCLIPRIGHT _ (IDIFFERENCE (FETCH (REGION RIGHT) + OF (DSPCLIPPINGREGION NIL HWINDOW + )) + XDELTA)) IN OBJECTS + DO (OBJ.INSTANTIATE HWINDOW OBJECT PREV) + (IF (IGREATERP (OBJ.END.OF.OBJECT HWINDOW OBJECT) + NEWCLIPRIGHT) + THEN (RETURN)) + (SETQ PREV OBJECT)) + (OBJ.MOVETO.LAST.INSTANTIATED.OBJECT HWINDOW OBJECTS) + + (* ;; "We don't want to be limited by the fako extent during actual scrolling. The fako extent is reset below, and its only purpose is to influence what shows up in the scroll bar. The true 'right' is the right of the last instantiated object") + + (WINDOWPROP HWINDOW 'EXTENT + (CREATE REGION + SMASHING (WINDOWPROP HWINDOW 'EXTENT) + LEFT _ LEFTOFFIRST WIDTH _ + (IDIFFERENCE [ADD1 (FOR OBJECT PREV IN OBJECTS + WHILE (FETCH (OBJ INSTANTIATED) OF OBJECT) + DO (SETQ PREV OBJECT) + FINALLY (RETURN (FETCH (REGION RIGHT) + OF (FETCH (OBJ REGION) + OF PREV] + LEFTOFFIRST))) + (SCROLLBYREPAINTFN HWINDOW XDELTA YDELTA CONTINUOUSFLG) + (OBJ.RECOMPUTE.EXTENT HWINDOW]) + +(OBJ.SCROLLFN.VERTICAL + [LAMBDA (VWINDOW XDELTA YDELTA CONTINUOUSFLG) (* ; "Edited 21-Mar-95 15:58 by rmk:") + (* bbb "14-May-86 17:03") + (LET* + ((OBJECTS (WINDOWPROP VWINDOW 'OBJECTS)) + (CLIPPING.REGION (DSPCLIPPINGREGION NIL VWINDOW)) + [TOPOFFIRST (FETCH (REGION TOP) OF (FETCH (OBJ REGION) OF (CAR OBJECTS] + FAKO.HEIGHT) + (IF (NOT (FLOATP XDELTA)) + THEN (* ; + "Disallow thumb scrolling in the x direction") + [IF (FLOATP YDELTA) + THEN (SETQ YDELTA (IDIFFERENCE (FETCH (REGION TOP) OF CLIPPING.REGION) + (OBJ.INDEX.OBJECT VWINDOW YDELTA] + + (* ;; "Make sure that all objects that will be shown are instantiated, so we can compute a valid true region") + + (FOR OBJECT PREV (NEWCLIPBOTTOM _ (IDIFFERENCE (FETCH (REGION BOTTOM) OF + CLIPPING.REGION + ) + YDELTA)) IN OBJECTS + DO (OBJ.INSTANTIATE VWINDOW OBJECT PREV) + (IF (ILESSP (OBJ.END.OF.OBJECT VWINDOW OBJECT) + NEWCLIPBOTTOM) + THEN (RETURN)) + (SETQ PREV OBJECT)) + + (* ;; "We don't want to be limited by the fako extent during actual scrolling. The fako extent is reset below, and its only purpose is to influence what shows up in the scroll bar. The true 'bottom' is the bottom of the last instantiated object") + (* ; + "If we are looking at everything we should not scroll!") + (OBJ.MOVETO.LAST.INSTANTIATED.OBJECT VWINDOW OBJECTS) + (IF [OR (AND (EQ YDELTA 0) + (NEQ XDELTA 0)) + (FOR OBJECT IN OBJECTS + THEREIS (NOT (AND (FETCH (OBJ INSTANTIATED) OF OBJECT) + (ILEQ (FETCH (REGION TOP) OF (FETCH (OBJ REGION) + OF OBJECT)) + (FETCH (REGION TOP) OF CLIPPING.REGION)) + (IGEQ (FETCH (REGION BOTTOM) OF (FETCH (OBJ REGION) + OF OBJECT)) + (FETCH (REGION BOTTOM) OF CLIPPING.REGION] + THEN [SETQ FAKO.HEIGHT (ADD1 (IDIFFERENCE + TOPOFFIRST + (FOR OBJECT PREV IN OBJECTS + WHILE (FETCH (OBJ INSTANTIATED) OF OBJECT) + DO (SETQ PREV OBJECT) + FINALLY (RETURN (FETCH (REGION BOTTOM) + OF (FETCH (OBJ REGION) + OF PREV] + (WINDOWPROP VWINDOW 'EXTENT (CREATE REGION SMASHING (WINDOWPROP VWINDOW + 'EXTENT) + BOTTOM _ + (ADD1 (DIFFERENCE TOPOFFIRST + FAKO.HEIGHT)) + HEIGHT _ FAKO.HEIGHT)) + (SCROLLBYREPAINTFN VWINDOW XDELTA YDELTA CONTINUOUSFLG) + (OBJ.RECOMPUTE.EXTENT VWINDOW]) +) + +(AND (GETD 'MODERNWINDOW.SETUP) + (MODERNWINDOW.SETUP (FUNCTION OBJ.BUTTONEVENTINFN))) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (1959 19677 (OBJ.ADDMANYTOW 1969 . 2461) (OBJ.ADDTOW 2463 . 8184) (OBJ.CLEARW 8186 . +9312) (OBJ.CREATEW 9314 . 11231) (OBJ.DELFROMW 11233 . 11645) (OBJ.FIND.REGION 11647 . 12112) ( +OBJ.INSERTOBJECTS 12114 . 17722) (OBJ.MAP.OBJECTS 17724 . 18381) (OBJ.OBJECTS 18383 . 18655) ( +OBJ.REPLACE 18657 . 19236) (OBJWINDOWP 19238 . 19675)) (19729 94546 (OBJ.APPLY.USER.FN 19739 . 22971) +(OBJ.BUTTONEVENTFN 22973 . 23135) (OBJ.BUTTONEVENTINFN 23137 . 25477) (OBJ.CLEAR.EXTENT 25479 . 25775) + (OBJ.COMPUTE.IMAGEBOX 25777 . 28122) (OBJ.COMPUTE.REGION 28124 . 28615) (OBJ.COPYBUTTONEVENTFN 28617 + . 32412) (OBJ.DELFROMW.HORIZONTAL 32414 . 39179) (OBJ.DELFROMW.VERTICAL 39181 . 45808) ( +OBJ.DRAW.OBJECT 45810 . 47241) (OBJ.END.OF.OBJECT 47243 . 48444) (OBJ.FIND.OBJECT 48446 . 50323) ( +OBJ.FIND.REGION.HORIZONTAL 50325 . 52166) (OBJ.FIND.REGION.VERTICAL 52168 . 54130) (OBJ.FLIP.OBJECT +54132 . 54628) (OBJ.HARDCOPYFN 54630 . 56745) (OBJ.INDEX.OBJECT 56747 . 58275) (OBJ.INSTANTIATE 58277 + . 59582) (OBJ.MOVETO.LAST.INSTANTIATED.OBJECT 59584 . 60270) (OBJ.RECOMPUTE.EXTENT 60272 . 69818) ( +OBJ.REPAINTFN 69820 . 72780) (OBJ.REPLACE.HORIZONTAL 72782 . 79298) (OBJ.REPLACE.VERTICAL 79300 . +85926) (OBJ.RESHAPEFN 85928 . 86467) (OBJ.SCROLLFN 86469 . 87004) (OBJ.SCROLLFN.HORIZONTAL 87006 . +90166) (OBJ.SCROLLFN.VERTICAL 90168 . 94544))))) +STOP diff --git a/lispusers/OBJECTWINDOW.LCOM b/lispusers/OBJECTWINDOW.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..f55dcce57cc21bfd5e6e14bce3e4e4361796dd2e GIT binary patch literal 25686 zcmcJ2eQ+G-dEf1V`l4*`4n$xGrjaE~F(6~Y*uBFS<;b_d9e4{YZcldy0+2|ZC4n{w zetGoK+HKQVP8!8^G9J3Ftk|*aC~Z1Plg!~r%t)5(`_q$TGVOFkm-wq`Go4!2A0@`q zPG>qQ`g@-DeRtozJxH>nXok4mci(+KpXc{{zN^tfao#HzPtALN@swAd53J#eJGbbb zDOw|5xn8XLUac}>4Ofe9q3+K59mTV5t!UZfCk`GQr55H;tzIlxBaVHlaN(&_&bVV+ z_Vj6I{B$-qVvUYGb?wUMFJ8W|Ze6=-jaUc&X`#0G>z`VF=EBp@JbdYi&tHDx>cjrE zr=Ga{@RbYemoI!VJ2vs~l`ozWHxFOF_{`^@6V`}5qxF|N zJ&`@_WYPYUPhSXoyzqt3KmE*ur!BlZ<`xP|Zh5U9tnjTEwz&4nwPLj{dZ_W!+2wjY zC>PHb%XKVJ*}8buIyf@F?E9A9>)6=Xh_(L2vzS}A(M*q=c<&{$Kd>dSW^$90W*wy2>(lL6iP-Eie=L-V81OdysY7R+!6$E!b%OBsg&tvGDd0rd+GI_S6rotQn9A2N&sFNn=Q@<)#6x@-kl$t^Sw&NE1wyw7SDJ=8ShQXdP~7s@JPj)urS%8 z)=^IOQ^P|wz4}_EsLeb!ant<}CZ7KsO_FDtv3vBp%w6urI{q7?|9-HM=Q>)2I~#Yl zKhm{0W87WhX7Akmn5-aw)(p=yjoVlDZojkpHPNDcVj8=d%)S1NUn}1@onI0wzbR_8 zWtB%wW5JZKFPR2iF5%zKj;Pig3wmEEw`}#c971bwb3I=BewuMxRr7Bg7L!`q7~&^e zssC777sGG$tG<21G>mt4ZyZytJ}3u84<0j(MK!S9-(T{1^joQ~lv|sA=IH%FU!%Wg z`>w;yFPKJSptX<>27-P=j6$u`M`d#usj=G{3;LIWesk!7cJr^rs7iK zi~&#TE^w2if?}wNtYe)i%HEcNwxUOShTkq!-IcJWZCiqSYAlPun01V8JWCxb{*vsK zo1W(Pt6<(GOa^?oS_foXxv5Ehpbf>!0UK$2R?cza^UTih#G_edrx}0rnONCe&T{K@ zcdle*G3?kvIWxKVvN(ywb+DFswegN_rpLQ%?qtUzO-yyEl$-2W zxLlV?z~Th$K(bCuVwe1aMz6Un6-3jYaF{wlK{YE2S}6rp@6n)KcYQ01nVp5u_vUcp zOlS3H&Lr;@zvejEsNRgDSDQkuSoco6cR}3T%7m0#1nd~OkU?{P(XC1u6ccSP022(! zwamdU3M^=gGG=p$bOTz^C5fmKIj#}32pG~XukP)MvLq^WDFIH{S-S%SY=<{3T6f#- zgc5tagQI4c+^XK0Qhmv-p7F}obVnmt%^0#wO3I~0Qfv(pT3HL`=W9i9@k~S%3?|tw zR02KJlFJNOiNPJV!KNM3chCl##Rv#IUnyLp&i5!=TOS7PA2Mn)4r{j!UwYh45x-4xW&LN;CB{kU?B=x9~u1(MzQL+tI z*C?5VR!GSw>B%(mcZq+4agb3O#&%y9?1Tbh88pxhlxuXOSBm{0{t@BCNBBqL$ z0^6y2wOA{;l_Hv)CdsUBq&`u_c%YTw=@jvdx`Adv?}|miL&*B@8VZuIStRybPIkr` zty^Q3?=5-t6S&V>qkN4r+)r4e+F~ovIU&%aQ1s`k!BQwSG&@Nl32dW}gDZ6tf$9Iw zH}fv@a9aJQMxm9_z*Vbbsy9n6a`-?S(LU1Hp3rGTN61j%!Rb&?mJwTCggiCi`&{_F#pOU!6ib|e^M9%dYg75V`IO6w84MOHNxPFnNeoB%X&MogLv zKcEV~2>pfbuq*0CFt~gXZ6{xx=J&$ZA&c-n7{o82aoGlV9!+~&}_kumOCifmtD&mG3o|FLLp_beMG~|A&J=e&<^^{Mql$sG{oL~a3p+oq%lAPeCzO5>QClG*RO1)UShLVO*B3b-_<%sN4~*J z*LF=g!o$HZjnImZ@OV2owjLZ0j)@T-!w8QDBXWet8zb#t*lY}o5%%YU(eT-5V?>Pb zU))QwUh0nQ7#x!| zLS`(v6=_`8LZGtd%OvWS{W{@|Y=AXE)P@Ap**x{Bp13&495qWl+kJ->5nNlPX z%(xCqUt2efSH10fN*hCuK3_Wi8hG!2F0hf)b?KSBXk|kYrZz(M2B!qfNvx!#`!S(t zJA|0Zp}`(ZKlFseR`yrGQU^4k6cF(HdFa->eh}5_3c^}A2jmbm5f?B2AjF%XqKY7w z*oY@EVnY}KH%}!-esf4GimZm4J$WoLIG8yB8c~AINmwQe6**V1{-BwNwxKjJvnJIz zaC@QHJT#3o3jB$g8PNO`$J3$}#Hv_fKcB_q}9Fq4;1o)h)40L6M(S39MU}5POU?ag0*NLfM*{^NPs2xRM0Y+NL^fhV3^R)D!c$SOSlo$ z>Pp{0ZaQ+lpsAHr;fMh(*?{+u#vs}>y4Hz;+#$&Uz`Ydtbo5pQyvJq}@+0q8u?~|E z5vmIIk%>wt5{}rws$4CRCxqfPa)&7-BWOg;Pf-sAXEf?r!&^DMU=;<-$V@%N2+XTQ z{LIpkLLDb!a=Z|ok;g@}&w^G6E|#o2_)PWZ8swt5{%wyx?un4V-12Jqm*q zNJDGvl^MBn*627)<8f&M$IbT0jueOy6IL`wGqQFCe`xQMCoL8h?0BZ=jfm$AcAp!- z?*#6p?xZM$yrE1VVu#5Gja$c(%RofJmqbMHxpc${*%0nBfw!+URx7Ck8;(UJzw5Rz0mv-Vq9ba0e*sB z<2Ekvi;$mi>b1)P{Fu$MjMWQ88IQ~Nq`=R&WY0`IoISH zFf?GhdxatpVltx5HEU`nx&x)MlEPaiP)0h^*pVPvH`@^{0hGl|1UOMb+6O0y5VE8K z*!W2-oUrOaJ*Xg5J?fys$wELP?<54bW4XRB0{aE{5N53K8tm6ewUZhLif54m%ieJ1 zPfzO19|65c%l*n8qR1?ZgnEzd8IOApF-+_i`v7q%@H!D`;y#Gx*{i3F4pxf0_^xx(V1-Y=Ej za7{+Zbr|zf&F^&mNC+z0<18^^_K{z-Q-C}iM z2J%zk+suVdPT36?qnZWp=_z|MJ1sLK)N)E09HN~jJj5^{EJm?+ri*C_&jBW6nDQEP zGj=ZB<~f=dd4fpN0RcuqoVeK>L&bzbt#A>#6v8J!G}z{dyWwII0f&__wGJql=v2o! zdO?!4496cTWa$n3f{*=zKuudxG)lWcWn|(Rqd+7z-^}&<1hBO~gM~<~Up@fX`{OoC z$ltvrAnqSjKdlTrEfh`dU@&G8hc!J{UB-)HNT|0k-lCQ=LK-{=jH$)Mvnif`*GFVSQ}$KYhlnzFcEh`k`3wDx zRI_kW4r^*-JPewHxaF1aj!l{?4bfZ$&E`os$`uw<${I4&j1n+`QmWt_r_0whk(Rms zVgJurP>G05yZMh?AO7;zh;RHr)bmZot+sDA`r9hwsu}p1%%R{&W4Na^?ZTx?@0_IH z^AK#N@!fndEd0e1YJ%Z)(|mxPzx`iBz2=X!UJr}hqgS?!^H9_tX9dw9&5%Y7|2bU( zor3;MCKFga+eZ(}q$Cd+PoD|;WFG>mwv3M$jS=*Qm;OSfXDy)Ocre0+-@&gz|BRq- zXYhr5Fv8j<9M$4Njo309R`VMRK`-PPJncdMW~Q${IM%am2gm#1YWITP-PRm3wa}6m z&xlanzM3y>rM_%5M%%&h^3_Aw>^9g$`N2?0i?-y zvl2}c?`Egqn~_cgD+}!j??$ORSqaoKu~MQ{Rt9w;QB;bVMY&e7SDnz?+%Y)^dRy3| zBV(WO4k$KVtX6|6Y>1A86dQ3{+LQPT@WaPCM3BzSW3!c)&$SFb&5efHXOSCNNoP1xOvg?1i_gfP%61p>@;xx_#@ zxKIfMX9MIwF9~QD52aLqyQP~@2*(`5{VAD2(-n=8G!Q_s=z{NLV($y$$hPYQaphqZ zRyU7dX6}Trjjk}6ZW?6_wa+TlHhy|YLv15P98D}NK-=W&?`!;3=&j_^_GnxB?{>A{K_JBlf{GKDQAk-d+qxOJ6?E$p%wP2tFwaJDt4WRbN zVB(zTWLq)j9}=DuiU(;-CDYd%4EAgvXnxFS98t&^4DH@H6&w*TedEFQ;k<~Vdb_PB zHvwXCNKbt~IKrL%dkKJez2(TV@8Z`m`43zPw+YdYC`1<*3eg7gM1PNOEir zs-TX#9Gy#`E*u$2D9lMrOF&@`ig4%zB^cE@fGOCesVpTQVyKCxvS5Go9O=Ya;2716 z!&X)XlVU&$)jRg8Bhz3Losg9fj@OadFYyi>bP#JSfvnLG-wj!#S|13qA~jC}UF`!# zRxO2DVXCr@AajQTaxW=uQsug0O{n z*<5HoprI0ZKjZ_rK$0n>FG>HX_d-ctiC)MbM_Fph))FGAgN$q>3@3@phBQes4m=wu zlz|=SD#;p9N}?KYV#O>sSeoHIMf1XO#mOu#jv*&0>=6rzlEp!Xi1?5NF;|#-HUWR0 zx(ThQI9W>vjAM~;7z)w-cD4pTgnl@Kt@=ByA=*~jRoc?X(tk5O+v?ZudEalP`9~|h zMc%1y$OIEKxu)qAq>u5Yo^mq z03ycZC73a8NQmfZG&&@i#zx!KzCeC&tWvieBjKY88wT=`+}HEs;p!p@7M}Wv43WrV z6onY{T+0w5C0QxynmX8Ut3bpanf2PoYl8;CAtR9e+e#lJhZ;ZkYEdKly<_ijg z5}lTc_>F0JVVJ^%R@~lP$5Wy`3LxM>nk8SOJ z7PJR?h;6@(^y4m62IptDQt2&-pDm)qY6Pa0poApoN{RM(C#7}jfp8ngNm2L|B6^tY z(Dh(|C-F=8W+Q!We^LzVfD{SdbW((|A0tJ9vw6jYg|Q#7c9Y$ACD&%3-rf{r)VTD|Ter-#Iz?!v}|2TY(a!pV)^ zNXdb>GU#hP5)=VCx#HDP2<+mJ3qU5&}BWg zEh~}hQEwPow%qUlv|QQXw`J9ZH-o;fEUKGZuHaJ$>#e;<5EcP+OD1su*D*FEM|})H z=`2I2hfw_jWLcCWX^`EtWx z@u3iqP6aR72{tMpBQS8&?0$Hoz_n&Mx? zr|1@93O@pEb&3tqR%?$Epy()q*doTF@G=VOrmh2kbrl~#4C|LPyj5wTwr5+%e1d*j-!Jp|j+!5Y%W$6Vw7=RJHFY`Bh zq7vrh*(N~-0!#Nl3oc1RBuNunf>)IXmOadoIbDl0>jEXByOe&u#s;2geA`>+jRkRh zvW>iR-a6eWD_HWI3t}68TmEjO&E^kNqn!&p5l@2Xp63CFUt$-4kKj0MVW4b9gdfWM zgdVElKuhZ?VHx?Mf&o69d zM$$NeGYk`;hgFk(;TOV=H zFEH{4>9=q;2&3!|MtZhC8XRvu8XU)15t=;awX%LNik?QBpEerDg;T!uw;29$;Sr~1 z{zGsK!#~zW^YIqzj3!+;&W!#~Ym#v43Igc}e_ zh+d;Yx_$fcCGUFadDeb^T7G-;c0>B8yw)IM7K81@pg-tcdi%#aSN4LzD|^j>D|=WI zQHI6nr}F+NkBt0^IpmtgEsCrNKy_fLLkId3h)1VsDK#QI3L3Z1XOI#hM4mL%V<~T4 zPu{>UpOmVs_$gii?ZRdNBj>=`GFB=~dsZ+2@fyJ+J0iyXmIII`Vd zN)(U>goN_1WG}NB>+ebzB2J5%$8%w<;{qt6{LEs!adta#571K@(DFxTvctN}g(Fhr zZZe?qAKi7FIeNF>vps&eJlm&HW@S~~|mwo4?Y`wFKRH(9S>}A=8i%-~~cuGwL85QTY_8z2csW8#V zk>T<OQlMJ%l)o?KClw6()m#ocmbr91W#0wU7+RD0N+dacXbUwsYo^mLm^oR#U!p0#grd1 zQxG=@l@$l>FP$$D-_viQDuq?)IA6@s02qlm8bl@>bGznq5Xu0TLUc!Lsfm0(^47(} z8s=IN3p371v2R<7&Z1LesDeB_SaB3A$G9RePzh8xJ&EqgG{QLzPN@YI_*Gy zi=3*S?F)zJzP@FAj^8&ZZ{9fPts_ead7&@0H-of{ObbON?FK_4`)bITMViu(Ou@Q& zpX`ZF1rI^S{xBFKz*)u5)?VIdP(~Iy@5qrF=ECn#Di{4Tf;30ehb1xx;zEu7h}k%@ zwO0xHcU#Yt!;~$LGN$@?YC#`VhmU&@&f*oRT#1`i6>(2@PD*YEDo}hq=wqdT{%9FZ z>3Ca6gyJ#cupm4^q^faTp5PewGBi&`u{KCan85ivEe@Uoz$7s=hm=SFLR?H+If={( zeLDy7ueUkg#ao9wCgEgFyiJk$Fn@@?5v4Vig@{NFBrCoo)GbU8z73O~I=_~a#nh8B zz=4mLN_8{ap_ru}vvBCE1E{1RL>Lpc%=}GE$%b4B$6@2$SYtLcnPg*fdGul6d`9d= zfUrnMAdIgPp`HwgnXaROEKKoyBYV>+VBqJIEL zjk2sn*46%5O1~hah7lAqr9*0$d?rIToI6nUdKXk(z*(O%7*`~O{=E1q-_;TJ2}W3C zn^L2Uu+?C|BY=GoN%D*%zZkk!7+t4Bbp3Oc@U%b)O9EWKOTcRKAHXZ8puQ`-)`EUy zEM4-j2qCZ%C=#;b(YqsSd^#Gg(y1$;p#<0Wg{xtNg5D)~7aIbs-RX|2@dPH05+xFt zgj*?rt0F-v0V6r&MrvS~gR+tY!yHshLX*VXSwzOebRznwgVt0Q0F`Wt(6)P1xN?j!uT-pi>C3aoF<1q#cbR zg}!qf;=5_lFfcs{tlf0*eSkI8>eM5TkPfJTw*DfLD2;j;TMyk|X` zi(=+x>Nt{Lk&2Ux{M+mqsKF_r8s*@pJgR1JY4Pk@;@q#YFf?PBuq160}W*W6mX;(*ersUs6-FS(5D*S-ws4(K@Z6=ZPhc+-&=wf zjq?=HioZX57g+#*=ib%R`XvdfhV<(1JZZK|vg|SX@T&`Qr2qOB;bs39}ztA+wfs#LCHuV z2ie0wod6TGJ_@>n4xt{(u-ML%2ihfiG7GXlMCsq3RAfK9dFLDM=AG8zl041x@J1h> z4gW7ee`({5$9lG(ZvGR>6sONu4J&FFiQK^ua^GI1V@LQ77LvJ}e-a+`X?-%Dn-d?_ z?w`SJjd@V%JG(CiBip}svH36IOK(_Pd%s~wjyVsP94e8LB|mo>ai`)+;!yaU2X5hz zEAuEb6PPL(cvqf!V-Z&OgTzl+Sdv}&DT`#&BtOwtnd1CJ+0tLNaWugAveDHgxui~sspvZx0Bk<8@IrNK$pVjU{l;H%f3d-meh3(xQb@P7h$ z@{87UG@qwsd2AN?cZRrW?d(2O6Y5wi;e(*!^ZhhQb!?w%DMxS^%GC=c5s0GB4_#8J zS{%(Sd5}8~AB3pM)wSeyx{nhymFP!`!+S9dt&hZBM0yavM5m5$LD)?9T8b3i#;9Ht zM5n-bmEMbe=%s}9AqrJ2M&8la))E6x_#H%Lr8Co=k~%zob)z?=R|;njYN}YHZn<#K z8imSNutpzQ#`l)sZ^zeq`2$QiRF4lJEmw$ZlBHmiGXw1c!kr9x0`$Lrk$=mRYs+00U;N>cGUMIUJC$YLUq z3Q5^;-dmvgC;bck1^HQ>IX6+JoC}c06(H$w&Ro9vX676Y`E)o)j?6ChH|nOW@O_{fbBp$os!f5Nv8nII89dTh15q^ zOGr|gP}- z*J->cx(%dri%lX^phY^a?zU2)th>E{*%7<=wArdWfvkFTIbsm7GspKJaw3<(sUP%N z5ISEl@O*#7yn%ZLAsh9bFv87O0}pUHa_vi8osOf(_Z$zGZRB~!=N|*b>OZk(xUQS% z8Z577k(!B@JYOd1CW-87kzB`RhQ;52?dXbs&VtD4*)9=u?g!2nz8BdpR-3{|#^U^1 z^e43o%2rg|c+pk)c4WexO2)EGo3zPn6&D3!!g?qkX({OzRLhRmaaDU_`LSlY!Eckr z05Ba&SV1Tz0u`4v-^&BM&NK9Xo!lE#~5d(8kUCD zxWnix1kj*XmrXNL&7=Es(~ylQUvt2`rJ^{K?v0jo)V2Hl$iL8f@+49ID(>v*v{1(k z03KpA&=TM6%OzZ#vw+pJbwqCzP_e#F=f#R{18gx9rwgKJ-JZ+rKyzIW+gtEBm*@3OQY2RkO>9AD?iQha<_-dX zsC_8{>Mm8D*kCzdV!KXZmS@XtUjf4tug5e|h`OuHFn_)5;}O&im^vQ2cyQK(1sw0s z3Ensr7lM7)I+N}5AbqFOyYo7eI6pgy>khF7r=6z z;~hvXoAYa`rNIN)WU^i*$dEXrHf~g~p*>PugqkT74ZK?|lURZCU z&X3n7hmZFW&-Z>lqg_NIKKEF9N++8-F|DV;=D3vFJANM{@9$b~Hfej8(%u7MejdX&Fs{Hy3xYuZ_ir*6U1#vL>G}nDAUgq{0hgvqyXTcU$G4B>zAvJF%F^CRvl3p|R%fnRZu0XHqln%w!v;j5~u@ zbR<0)9mAQaE}=I>P)>&58i?O(RTIF3)Ws1sCYLp1V`FxVq~=BR#ZE5*HW?ZogqJOe z$=U??iv}*zC&#srACbz=kfxHxouS?gcg>xkirg8(^;8OD+W8elB%kyke(JzQNcu4a l{3|K{fK?5RXgvyJdQhVg4NUGtBvPRkpr%ZUp@BbN#n4JIs literal 0 HcmV?d00001 diff --git a/lispusers/comparetext b/lispusers/comparetext index 6abc40a2..c30a95ef 100644 --- a/lispusers/comparetext +++ b/lispusers/comparetext @@ -1,14 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "16-Dec-2021 10:57:35"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;13 37426 +(FILECREATED "22-Dec-2021 10:37:46"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;20 39405 - :CHANGES-TO (VARS COMPARETEXTCOMS) - (FNS IMCOMPARE.MIDDLEBUTTONFN IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH - IMCOMPARE.FIND.TEDIT.TEXT.OBJECT) + :CHANGES-TO (FNS IMCOMPARE.COLLECT.HASH.CHUNKS COMPARETEXT) + (RECORDS IMCOMPARE.CHUNK) - :PREVIOUS-DATE "15-Dec-2021 17:00:06" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;9) + :PREVIOUS-DATE "19-Dec-2021 12:45:35" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;19) (* ; " @@ -18,9 +17,7 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. (PRETTYCOMPRINT COMPARETEXTCOMS) (RPAQQ COMPARETEXTCOMS - ((DECLARE%: EVAL@COMPILE (FILES (LOADCOMP) - GRAPHER)) - (FNS COMPARETEXT IMCOMPARE.BOXNODE IMCOMPARE.CHUNKS IMCOMPARE.COLLECT.HASH.CHUNKS + ((FNS COMPARETEXT IMCOMPARE.BOXNODE IMCOMPARE.CHUNKS IMCOMPARE.COLLECT.HASH.CHUNKS IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH IMCOMPARE.FIND.TEDIT.TEXT.OBJECT IMCOMPARE.HASH IMCOMPARE.LEFTBUTTONFN IMCOMPARE.LENGTHEN.ATOM IMCOMPARE.MERGE.CONNECTED.CHUNKS IMCOMPARE.MERGE.UNCONNECTED.CHUNKS IMCOMPARE.MIDDLEBUTTONFN IMCOMPARE.SHOW.DIST @@ -29,16 +26,15 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. (INITVARS (IMCOMPARE.LAST.NODE NIL) (IMCOMPARE.LAST.GRAPH.WINDOW NIL)) (RECORDS IMCOMPARE.CHUNK IMCOMPARE.SYMB) - (FILES GRAPHER))) -(DECLARE%: EVAL@COMPILE - -(FILESLOAD (LOADCOMP) - GRAPHER) -) + (FILES (SYSLOAD) + GRAPHER) + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) + GRAPHER)))) (DEFINEQ (COMPARETEXT [LAMBDA (NEWFILENAME OLDFILENAME HASH.TYPE GRAPH.REGION FILELABELS) + (* ; "Edited 22-Dec-2021 10:35 by rmk") (* ; "Edited 15-Dec-2021 16:23 by rmk") (* ; "Edited 13-Dec-2021 12:21 by rmk") (* ; "Edited 8-Nov-2021 08:44 by rmk:") @@ -56,12 +52,10 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. (ERROR "Can't find both files" (LIST NEWFILENAME OLDFILENAME))) (IMCOMPARE.CHUNKS (create IMCOMPARE.CHUNK FILENAME _ NEWFILE - FILEPTR _ 0 - CHUNKLENGTH _ (GETFILEINFO NEWFILE 'LENGTH)) + FILEPTR _ 0) (create IMCOMPARE.CHUNK FILENAME _ OLDFILE - FILEPTR _ 0 - CHUNKLENGTH _ (GETFILEINFO OLDFILE 'LENGTH)) + FILEPTR _ 0) HASH.TYPE (if (EQ GRAPH.REGION T) then (create REGION @@ -89,6 +83,7 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. (IMCOMPARE.CHUNKS [LAMBDA (NEWFILE.SPEC.CHUNK OLDFILE.SPEC.CHUNK HASH.TYPE GRAPH.REGION FILELABELS) + (* ; "Edited 18-Dec-2021 13:21 by rmk") (* ; "Edited 15-Dec-2021 16:28 by rmk") (* ; "Edited 13-Dec-2021 12:32 by rmk") (* rmk%: " 8-Sep-84 00:06") @@ -143,32 +138,45 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. (* ;; "The file comparison is complete. Format and display the file difference graph") - (IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH NEWFILE.SPEC.CHUNK OLDFILE.CHUNK.LIST HASH.TYPE + (IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH NEWFILE.SPEC.CHUNK OLDFILE.SPEC.CHUNK HASH.TYPE GRAPH.REGION NEWFILE.CHUNK.LIST OLDFILE.CHUNK.LIST FILELABELS]) (IMCOMPARE.COLLECT.HASH.CHUNKS - [LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 15-Dec-2021 15:40 by rmk") + [LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 22-Dec-2021 10:37 by rmk") (* ; "Edited 13-Dec-2021 16:32 by rmk") (* ; "Edited 23-Dec-98 16:54 by rmk:") (* mjs " 8-Jan-84 20:57") -(* ;;; "returns a list of the chunks inside CHUNK as hashed of type HASH.TYPE. Presumably CHUNK is is higher on the ranking PARA > LINE >. WORD. The initial CHUNK covers the whole file, middle-mouse refinement-chunks cover only subsections.") +(* ;;; "Returns a list of the chunks inside CHUNK as hashed of type HASH.TYPE. Presumably CHUNK is is higher on the ranking PARA > LINE >. WORD. The initial CHUNK covers the whole file, middle-mouse refinement-chunks cover only subsections.") - (BIND [STREAM _ (OPENSTREAM (fetch (IMCOMPARE.CHUNK FILENAME) of CHUNK) - 'INPUT - 'OLD - '((TYPE TEXT) - (EOLCONVENTION ANY] - (ENDPOS _ (IPLUS (fetch (IMCOMPARE.CHUNK FILEPTR) of CHUNK) - (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK))) - (FILENAME _ (fetch (IMCOMPARE.CHUNK FILENAME) of CHUNK)) - FIRST (SETFILEPTR STREAM (fetch (IMCOMPARE.CHUNK FILEPTR) of CHUNK)) - WHILE (SETQ CHUNK (IMCOMPARE.HASH STREAM HASH.TYPE ENDPOS FILENAME)) COLLECT CHUNK - FINALLY (CLOSEF STREAM]) + (* ;; "It is overkill to open raw text streams as TEDIT stream. So we open, test for TEDIT and if so, close and reoopen. TEDIT may not yet honor external formats other than XCCS for rawtext files.") + + (BIND (FILENAME _ (fetch (IMCOMPARE.CHUNK FILENAME) of CHUNK)) + STREAM ENDPOS FIRST (SETQ STREAM (OPENSTREAM FILENAME 'INPUT 'OLD)) + (CL:WHEN (\TEDIT.FORMATTEDP1 STREAM) + (CLOSEF STREAM) (* ; + "The OBJECTCHAR is produced in place of image objects") + [SETQ STREAM (OPENTEXTSTREAM FILENAME NIL NIL NIL + `(OBJECTBYTE ,(CHARCODE NULL]) + (SETFILEINFO STREAM 'EOL 'ANY) + (CL:UNLESS (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK) + + (* ;; + "For TEDIT files, the character length isn't known until after text-opening") + + (REPLACE (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK + WITH (GETFILEINFO STREAM 'LENGTH))) + (SETFILEPTR STREAM (fetch (IMCOMPARE.CHUNK FILEPTR) of CHUNK)) + (SETQ ENDPOS (IPLUS (fetch (IMCOMPARE.CHUNK FILEPTR) of CHUNK) + (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK))) + WHILE (SETQ CHUNK (IMCOMPARE.HASH STREAM HASH.TYPE ENDPOS)) + COLLECT (REPLACE FILENAME OF CHUNK WITH FILENAME) + CHUNK FINALLY (CLOSEF STREAM]) (IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH [LAMBDA (NEWFILE.SPEC.CHUNK OLDFILE.SPEC.CHUNK HASH.TYPE GRAPH.REGION NEWFILE.CHUNK.LIST - OLDFILE.CHUNK.LIST FILELABELS) (* ; "Edited 16-Dec-2021 10:48 by rmk") + OLDFILE.CHUNK.LIST FILELABELS) (* ; "Edited 18-Dec-2021 13:16 by rmk") + (* ; "Edited 16-Dec-2021 10:48 by rmk") (* ; "Edited 13-Dec-2021 12:19 by rmk") (* mjs "11-Jul-85 09:10") @@ -297,7 +305,8 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. unless (TEDIT.STREAMCHANGEDP POSS.TOBJ) do (RETURN POSS.TOBJ]) (IMCOMPARE.HASH - [LAMBDA (STREAM HASH.TYPE ENDPOS FULLNAME) (* ; "Edited 15-Dec-2021 15:58 by rmk") + [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") (* ; "Edited 23-Dec-98 16:58 by rmk:") @@ -359,35 +368,44 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. HASHVALUE _ HASHNUM FILEPTR _ STARTPOS CHUNKLENGTH _ (IDIFFERENCE (GETFILEPTR STREAM) - STARTPOS) - FILENAME _ FULLNAME))]) + STARTPOS)))]) (IMCOMPARE.LEFTBUTTONFN - [LAMBDA (GNODE WINDOW) (* mjs " 2-Apr-85 14:21") + [LAMBDA (GNODE WINDOW) (* ; "Edited 18-Dec-2021 13:02 by rmk") + (* mjs " 2-Apr-85 14:21") (if GNODE - then (IMCOMPARE.BOXNODE GNODE WINDOW) - (PROG ((NODEID (fetch (GRAPHNODE NODEID) of GNODE)) - (FILEPTR 1) - (CHUNKLENGTH 0) - (TEDIT.TEXT.OBJECT NIL) - FILE) - (SETQ FILE (fetch (IMCOMPARE.CHUNK FILENAME) of NODEID)) - (SETQ FILEPTR (fetch (IMCOMPARE.CHUNK FILEPTR) of NODEID)) - (SETQ CHUNKLENGTH (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of NODEID)) - (SETQ TEDIT.TEXT.OBJECT (IMCOMPARE.FIND.TEDIT.TEXT.OBJECT FILE)) - (if TEDIT.TEXT.OBJECT - then (TEDIT.SETSEL TEDIT.TEXT.OBJECT (IMAX 1 (IDIFFERENCE FILEPTR 25)) - 0 - 'LEFT) - (TEDIT.NORMALIZECARET TEDIT.TEXT.OBJECT) - (TEDIT.SETSEL TEDIT.TEXT.OBJECT FILEPTR CHUNKLENGTH 'LEFT) - (TEDIT.NORMALIZECARET TEDIT.TEXT.OBJECT) - (TTY.PROCESS (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of - - TEDIT.TEXT.OBJECT - )) - 'PROCESS)) - else (TEDIT FILE NIL NIL (LIST 'SEL (LIST FILEPTR CHUNKLENGTH]) + then (LET ((NODEID (fetch (GRAPHNODE NODEID) of GNODE))) + (IF (FIXP (CAR NODEID)) + THEN (IMCOMPARE.BOXNODE GNODE WINDOW) + [LET ((FILEPTR 1) + (CHUNKLENGTH 0) + (TEDIT.TEXT.OBJECT NIL) + FILE) + (SETQ FILE (fetch (IMCOMPARE.CHUNK FILENAME) of NODEID)) + (SETQ FILEPTR (fetch (IMCOMPARE.CHUNK FILEPTR) of NODEID)) + (SETQ CHUNKLENGTH (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of NODEID)) + (SETQ TEDIT.TEXT.OBJECT (IMCOMPARE.FIND.TEDIT.TEXT.OBJECT FILE)) + (if TEDIT.TEXT.OBJECT + then (TEDIT.SETSEL TEDIT.TEXT.OBJECT (IMAX 1 (IDIFFERENCE FILEPTR + 25)) + 0 + 'LEFT) + (TEDIT.NORMALIZECARET TEDIT.TEXT.OBJECT) + (TEDIT.SETSEL TEDIT.TEXT.OBJECT FILEPTR CHUNKLENGTH + 'LEFT) + (TEDIT.NORMALIZECARET TEDIT.TEXT.OBJECT) + (TTY.PROCESS (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) + of TEDIT.TEXT.OBJECT)) + 'PROCESS)) + else (TEDIT FILE NIL NIL (LIST 'SEL (LIST FILEPTR CHUNKLENGTH] + ELSEIF (AND (LITATOM NODEID) + (INFILEP NODEID)) + THEN + (* ;; + "A file name as a column header, do TEDIT on the whole file, no selection") + + (TEDIT-SEE NODEID) + ELSE (SHOULDNT]) (IMCOMPARE.LENGTHEN.ATOM [LAMBDA (X MIN.LENGTH EXTENDER) (* ; "Edited 13-Dec-2021 21:18 by rmk") @@ -561,19 +579,25 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. (DECLARE%: EVAL@COMPILE (RECORD IMCOMPARE.CHUNK (HASHVALUE FILEPTR CHUNKLENGTH FILENAME . OTHERCHUNK) - FILEPTR _ 1 CHUNKLENGTH _ 0) + FILEPTR _ 1) (RECORD IMCOMPARE.SYMB (NEWCOUNT OLDCOUNT . OLDPTR)) ) -(FILESLOAD GRAPHER) +(FILESLOAD (SYSLOAD) + GRAPHER) +(DECLARE%: EVAL@COMPILE DONTCOPY + +(FILESLOAD (LOADCOMP) + GRAPHER) +) (PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1433 36973 (COMPARETEXT 1443 . 3693) (IMCOMPARE.BOXNODE 3695 . 4211) (IMCOMPARE.CHUNKS -4213 . 8626) (IMCOMPARE.COLLECT.HASH.CHUNKS 8628 . 10026) (IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH -10028 . 19004) (IMCOMPARE.FIND.TEDIT.TEXT.OBJECT 19006 . 19780) (IMCOMPARE.HASH 19782 . 23904) ( -IMCOMPARE.LEFTBUTTONFN 23906 . 25642) (IMCOMPARE.LENGTHEN.ATOM 25644 . 26346) ( -IMCOMPARE.MERGE.CONNECTED.CHUNKS 26348 . 29844) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 29846 . 31801) ( -IMCOMPARE.MIDDLEBUTTONFN 31803 . 34638) (IMCOMPARE.SHOW.DIST 34640 . 35086) ( -IMCOMPARE.UPDATE.SYMBOL.TABLE 35088 . 36971))))) + (FILEMAP (NIL (1334 38876 (COMPARETEXT 1344 . 3554) (IMCOMPARE.BOXNODE 3556 . 4072) (IMCOMPARE.CHUNKS +4074 . 8592) (IMCOMPARE.COLLECT.HASH.CHUNKS 8594 . 11053) (IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH +11055 . 20136) (IMCOMPARE.FIND.TEDIT.TEXT.OBJECT 20138 . 20912) (IMCOMPARE.HASH 20914 . 25101) ( +IMCOMPARE.LEFTBUTTONFN 25103 . 27545) (IMCOMPARE.LENGTHEN.ATOM 27547 . 28249) ( +IMCOMPARE.MERGE.CONNECTED.CHUNKS 28251 . 31747) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 31749 . 33704) ( +IMCOMPARE.MIDDLEBUTTONFN 33706 . 36541) (IMCOMPARE.SHOW.DIST 36543 . 36989) ( +IMCOMPARE.UPDATE.SYMBOL.TABLE 36991 . 38874))))) STOP diff --git a/sources/ATBL b/sources/ATBL index c07ba4f1..123c79e6 100644 --- a/sources/ATBL +++ b/sources/ATBL @@ -1,11 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "24-Oct-2021 21:53:59" {DSK}kaplan>Local>medley3.5>git-medley>sources>ATBL.;28 92451 +(FILECREATED "19-Dec-2021 14:09:43" {DSK}kaplan>Local>medley3.5>my-medley>sources>ATBL.;31 91882 - changes to%: (FNS MAKE-READER-ENVIRONMENT) + :CHANGES-TO (FNS EQUAL-READER-ENVIRONMENT) - previous date%: "24-Oct-2021 20:14:01" -{DSK}kaplan>Local>medley3.5>git-medley>sources>ATBL.;27) + :PREVIOUS-DATE "24-Oct-2021 21:53:59" +{DSK}kaplan>Local>medley3.5>my-medley>sources>ATBL.;29) (* ; " @@ -16,7 +16,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (RPAQQ ATBLCOMS [(COMS (* ; - "Common features of read and terminal tables") + "Common features of read and terminal tables") (DECLARE%: DONTCOPY (EXPORT (MACROS \SYNCODE \SETSYNCODE) (RECORDS CHARTABLE)) (CONSTANTS \NSCHARHASHKEYS \NSCHARHASHOVERFLOW) @@ -39,9 +39,9 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. \SETMACROSYNTAX \SETREADSYNTAX \READTABLEP.DEFPRINT) (PROP ARGNAMES READTABLEPROP) (DECLARE%: EVAL@COMPILE DONTCOPY (* ; - "READCLASSTOKENS Generates READCLASSES and some interesting SELECTQ's") + "READCLASSTOKENS Generates READCLASSES and some interesting SELECTQ's") (* ; - "OTHER must be zero because of initialization.") + "OTHER must be zero because of initialization.") [VARS READCLASSTOKENS (READCLASSES (MAPCAR READCLASSTOKENS (FUNCTION (LAMBDA (PAIR) @@ -50,7 +50,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (CADR PAIR] (MACROS \COMPUTED.FORM) (* ; - "This macro ought to be official somehow") + "This macro ought to be official somehow") (RECORDS CONTEXTS ESCAPES WAKEUPS) (EXPORT (MACROS \GETREADMACRODEF \GTREADTABLE \GTREADTABLE1) (CONSTANTS MACROBIT BREAKBIT STOPATOMBIT ESCAPEBIT INNERESCAPEBIT) @@ -66,7 +66,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (FNS \ATBLSET) (INITRECORDS READER-ENVIRONMENT) (* ; - "Definition is on CMLREAD, need it here to initialize *OLD-INTERLISP-READ-ENVIRONMENT*") + "Definition is on CMLREAD, need it here to initialize *OLD-INTERLISP-READ-ENVIRONMENT*") (FNS MAKE-READER-ENVIRONMENT EQUAL-READER-ENVIRONMENT SET-READER-ENVIRONMENT) (INITVARS (*LISP-PACKAGE*) (*INTERLISP-PACKAGE*) @@ -85,30 +85,27 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (PUTPROPS \SYNCODE DMACRO [OPENLAMBDA (TABLE CHAR) - (CHECK (type? CHARTABLE TABLE)) - (* ; - "0 is either NONE.TC, REAL.CCE, or OTHER.RC") - (COND - ((IGREATERP CHAR \MAXTHINCHAR) - (OR (AND (fetch (CHARTABLE NSCHARHASH) of TABLE) - (GETHASH CHAR (fetch (CHARTABLE NSCHARHASH) - of TABLE))) - 0)) - (T (\GETBASEBYTE TABLE CHAR]) + (CHECK (type? CHARTABLE TABLE)) (* ; + "0 is either NONE.TC, REAL.CCE, or OTHER.RC") + (COND + ((IGREATERP CHAR \MAXTHINCHAR) + (OR (AND (fetch (CHARTABLE NSCHARHASH) of TABLE) + (GETHASH CHAR (fetch (CHARTABLE NSCHARHASH) of TABLE))) + 0)) + (T (\GETBASEBYTE TABLE CHAR]) (PUTPROPS \SETSYNCODE DMACRO [LAMBDA (TABLE CHAR CODE) - (CHECK (type? CHARTABLE TABLE)) - (* ; - "0 is REAL.CCE, NONE.TC, OTHER.RC") - (COND - ((ILEQ CHAR \MAXTHINCHAR) - (\PUTBASEBYTE TABLE CHAR CODE)) - (T (\SETFATSYNCODE TABLE CHAR CODE]) + (CHECK (type? CHARTABLE TABLE)) + (* ; "0 is REAL.CCE, NONE.TC, OTHER.RC") + (COND + ((ILEQ CHAR \MAXTHINCHAR) + (\PUTBASEBYTE TABLE CHAR CODE)) + (T (\SETFATSYNCODE TABLE CHAR CODE]) ) (DECLARE%: EVAL@COMPILE (DATATYPE CHARTABLE ((CHARSET0 256 BYTE) - (NSCHARHASH FULLPOINTER))) + (NSCHARHASH FULLPOINTER))) ) (/DECLAREDATATYPE 'CHARTABLE @@ -402,11 +399,11 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (DECLARE%: EVAL@COMPILE -(PUTPROPS \CREATENSCHARHASH MACRO (ARGS (* ; - "added size argument for creation of \ORIGTERMTABLE during initialization.") - (LIST 'HASHARRAY (OR (CAR ARGS) - '\NSCHARHASHKEYS) - '\NSCHARHASHOVERFLOW))) +(PUTPROPS \CREATENSCHARHASH MACRO (ARGS (* ; + "added size argument for creation of \ORIGTERMTABLE during initialization.") + (LIST 'HASHARRAY (OR (CAR ARGS) + '\NSCHARHASHKEYS) + '\NSCHARHASHOVERFLOW))) ) ) (DEFINEQ @@ -924,8 +921,8 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (CONSTANTS REAL.CCE IGNORE.CCE SIMULATE.CCE INDICATE.CCE) ) -(RPAQQ TERMCLASSES (NONE.TC EOL.TC CHARDELETE.TC WORDDELETE.TC WORDSEPR.TC LINEDELETE.TC - RETYPE.TC CTRLV.TC)) +(RPAQQ TERMCLASSES (NONE.TC EOL.TC CHARDELETE.TC WORDDELETE.TC WORDSEPR.TC LINEDELETE.TC RETYPE.TC + CTRLV.TC)) (DECLARE%: EVAL@COMPILE (RPAQQ NONE.TC 0) @@ -950,14 +947,14 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (DECLARE%: EVAL@COMPILE (ACCESSFNS TERMCODE ((CCECHO (LOGAND DATUM 24)) - (TERMCLASS (LOGAND DATUM 7))) (* ; - "We assume that values are appropriately shifted") - (CREATE (LOGOR CCECHO TERMCLASS))) + (TERMCLASS (LOGAND DATUM 7))) (* ; + "We assume that values are appropriately shifted") + (CREATE (LOGOR CCECHO TERMCLASS))) -(DATATYPE TERMTABLEP (TERMSA RAISEFLG DELCHARECHO LINEDELETE 1STCHDEL NTHCHDEL POSTCHDEL - EMPTYCHDEL (CONTROLFLG FLAG) - (ECHOFLG FLAG)) - TERMSA _ (create CHARTABLE)) +(DATATYPE TERMTABLEP (TERMSA RAISEFLG DELCHARECHO LINEDELETE 1STCHDEL NTHCHDEL POSTCHDEL EMPTYCHDEL + (CONTROLFLG FLAG) + (ECHOFLG FLAG)) + TERMSA _ (create CHARTABLE)) ) (/DECLAREDATATYPE 'TERMTABLEP '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG @@ -1440,9 +1437,9 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (PACKAGEDELIM (LOGOR ESCAPEBIT INNERESCAPEBIT 1)))) (RPAQ READCLASSES [MAPCAR READCLASSTOKENS (FUNCTION (LAMBDA (PAIR) - (LIST (PACK* (CAR PAIR) - ".RC") - (CADR PAIR]) + (LIST (PACK* (CAR PAIR) + ".RC") + (CADR PAIR]) (DECLARE%: EVAL@COMPILE @@ -1452,60 +1449,60 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (DECLARE%: EVAL@COMPILE (ACCESSFNS CONTEXTS ((KEY (SELECTC DATUM - (ALWAYS.RMC 'ALWAYS) - (FIRST.RMC 'FIRST) - (ALONE.RMC 'ALONE) - NIL)) - (VAL (SELECTQ DATUM - (ALWAYS ALWAYS.RMC) - (FIRST FIRST.RMC) - (ALONE ALONE.RMC) - NIL)))) + (ALWAYS.RMC 'ALWAYS) + (FIRST.RMC 'FIRST) + (ALONE.RMC 'ALONE) + NIL)) + (VAL (SELECTQ DATUM + (ALWAYS ALWAYS.RMC) + (FIRST FIRST.RMC) + (ALONE ALONE.RMC) + NIL)))) (ACCESSFNS ESCAPES ((KEY (SELECTC DATUM - (ESC.RME 'ESCQUOTE) - (NOESC.RME 'NOESCQUOTE) - NIL)) - (VAL (SELECTQ DATUM - ((ESCQUOTE ESC) - ESC.RME) - ((NOESCQUOTE NOESC) - NOESC.RME) - NIL)))) + (ESC.RME 'ESCQUOTE) + (NOESC.RME 'NOESCQUOTE) + NIL)) + (VAL (SELECTQ DATUM + ((ESCQUOTE ESC) + ESC.RME) + ((NOESCQUOTE NOESC) + NOESC.RME) + NIL)))) (ACCESSFNS WAKEUPS ((KEY (SELECTC DATUM - (IMMEDIATE.RMW 'IMMEDIATE) - (NONIMMEDIATE.RMW - 'NONIMMEDIATE) - NIL)) - (VAL (SELECTQ DATUM - ((IMMEDIATE IMMED WAKEUP) - IMMEDIATE.RMW) - ((NONIMMEDIATE NONIMMED NOWAKEUP) - NONIMMEDIATE.RMW) - NIL)))) + (IMMEDIATE.RMW 'IMMEDIATE) + (NONIMMEDIATE.RMW + 'NONIMMEDIATE) + NIL)) + (VAL (SELECTQ DATUM + ((IMMEDIATE IMMED WAKEUP) + IMMEDIATE.RMW) + ((NONIMMEDIATE NONIMMED NOWAKEUP) + NONIMMEDIATE.RMW) + NIL)))) ) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (PUTPROPS \GETREADMACRODEF MACRO ((C TBL) - (GETHASH C (fetch READMACRODEFS of TBL)))) + (GETHASH C (fetch READMACRODEFS of TBL)))) (PUTPROPS \GTREADTABLE MACRO [ARGS (COND - [(LITATOM (CAR ARGS)) - (SUBPAIR '(X . FLG) - ARGS - '(SELECTQ X - ((NIL T) - (\DTEST *READTABLE* 'READTABLEP)) - (\GTREADTABLE1 X . FLG] - (T 'IGNOREMACRO]) + [(LITATOM (CAR ARGS)) + (SUBPAIR '(X . FLG) + ARGS + '(SELECTQ X + ((NIL T) + (\DTEST *READTABLE* 'READTABLEP)) + (\GTREADTABLE1 X . FLG] + (T 'IGNOREMACRO]) (PUTPROPS \GTREADTABLE1 DMACRO [ARGS (COND - [(NULL (CDR ARGS)) - (LIST '\DTEST (CAR ARGS) - ''READTABLEP] - (T 'IGNOREMACRO]) + [(NULL (CDR ARGS)) + (LIST '\DTEST (CAR ARGS) + ''READTABLEP] + (T 'IGNOREMACRO]) ) (DECLARE%: EVAL@COMPILE @@ -1524,7 +1521,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. ) (RPAQQ READCODEMASKS ((CONTEXTMASK (LOGOR MACROBIT STOPATOMBIT BREAKBIT 1)) - (WAKEUPMASK (LOGOR MACROBIT 2)))) + (WAKEUPMASK (LOGOR MACROBIT 2)))) (DECLARE%: EVAL@COMPILE (RPAQ CONTEXTMASK (LOGOR MACROBIT STOPATOMBIT BREAKBIT 1)) @@ -1537,8 +1534,8 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. ) (RPAQQ READMACROCONTEXTS ((ALWAYS.RMC (LOGOR MACROBIT STOPATOMBIT BREAKBIT 0)) - (FIRST.RMC (LOGOR MACROBIT 0)) - (ALONE.RMC (LOGOR MACROBIT 1)))) + (FIRST.RMC (LOGOR MACROBIT 0)) + (ALONE.RMC (LOGOR MACROBIT 1)))) (DECLARE%: EVAL@COMPILE (RPAQ ALWAYS.RMC (LOGOR MACROBIT STOPATOMBIT BREAKBIT 0)) @@ -1604,7 +1601,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. ) (RPAQQ READMACROWAKEUPS ((IMMEDIATE.RMW (LOGOR MACROBIT 2)) - (NONIMMEDIATE.RMW (LOGOR MACROBIT 0)))) + (NONIMMEDIATE.RMW (LOGOR MACROBIT 0)))) (DECLARE%: EVAL@COMPILE (RPAQ IMMEDIATE.RMW (LOGOR MACROBIT 2)) @@ -1617,7 +1614,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. ) (RPAQQ READMACROESCAPES ((ESC.RME ESCAPEBIT) - (NOESC.RME 0))) + (NOESC.RME 0))) (DECLARE%: EVAL@COMPILE (RPAQ ESC.RME ESCAPEBIT) @@ -1631,46 +1628,46 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (DECLARE%: EVAL@COMPILE (ACCESSFNS READCODE ((ESCAPE (LOGAND DATUM ESCAPEBIT)) - (ESCQUOTE (BITTEST DATUM ESCAPEBIT)) - (STOPATOM (BITTEST DATUM STOPATOMBIT)) - (INNERESCQUOTE (BITTEST DATUM (LOGOR STOPATOMBIT INNERESCAPEBIT))) - (MACROCONTEXT (LOGAND DATUM CONTEXTMASK)) - (MACROP (BITTEST DATUM MACROBIT)) - (WAKEUP (LOGAND DATUM WAKEUPMASK)) - (BREAK (BITTEST DATUM BREAKBIT)))) + (ESCQUOTE (BITTEST DATUM ESCAPEBIT)) + (STOPATOM (BITTEST DATUM STOPATOMBIT)) + (INNERESCQUOTE (BITTEST DATUM (LOGOR STOPATOMBIT INNERESCAPEBIT))) + (MACROCONTEXT (LOGAND DATUM CONTEXTMASK)) + (MACROP (BITTEST DATUM MACROBIT)) + (WAKEUP (LOGAND DATUM WAKEUPMASK)) + (BREAK (BITTEST DATUM BREAKBIT)))) (RECORD READMACRODEF (MACROTYPE . MACROFN)) -(DATATYPE READTABLEP ((READSA POINTER) (* ; - "A CHARTABLE defining syntax of each char") - (READMACRODEFS POINTER) (* ; - "A hash table associating macro chars with macro definitions") - (READMACROFLG FLAG) (* ; - "True if read macros are enabled (turned off by Interlisp's crufty READMACROS function)") - (ESCAPEFLG FLAG) (* ; "True if the char(s) with escape syntax are enabled (turned off by Interlisp's crufty ESCAPE function)") - (COMMONLISP FLAG) (* ; - "True if table is a Common Lisp read table and hence must obey Common Lisp syntax rules") - (NUMBERBASE BITS 5) (* ; "Not used") - (CASEINSENSITIVE FLAG) (* ; - "If true, unescaped lowercase chars are converted to uppercase in symbols") - (COMMONNUMSYNTAX FLAG) (* ; "True if number notation includes Common Lisp numbers: rationals as a/b, and the dfls exponent markers") - (USESILPACKAGE FLAG) (* ; - "If true, IL:READ ignores *PACKAGE* and reads in the IL package") - (NIL 5 FLAG) - (DISPATCHMACRODEFS POINTER) (* ; - "An a-list of dispatching macro char and its dispatch definitions") - (HASHMACROCHAR BYTE) (* ; - "The character code used in this read table for the # dispatch macro") - (ESCAPECHAR BYTE) (* ; - "The character code used in this read table for single escape") - (MULTESCAPECHAR BYTE) (* ; - "The character code used in this read table for multiple escape") - (PACKAGECHAR BYTE) (* ; - "The character code used in this read table for package delimiter") - (READTBLNAME POINTER) (* ; - "The canonical 'name' of this read table") - ) - READSA _ (create CHARTABLE)) +(DATATYPE READTABLEP ((READSA POINTER) (* ; + "A CHARTABLE defining syntax of each char") + (READMACRODEFS POINTER) (* ; + "A hash table associating macro chars with macro definitions") + (READMACROFLG FLAG) (* ; + "True if read macros are enabled (turned off by Interlisp's crufty READMACROS function)") + (ESCAPEFLG FLAG) (* ; "True if the char(s) with escape syntax are enabled (turned off by Interlisp's crufty ESCAPE function)") + (COMMONLISP FLAG) (* ; + "True if table is a Common Lisp read table and hence must obey Common Lisp syntax rules") + (NUMBERBASE BITS 5) (* ; "Not used") + (CASEINSENSITIVE FLAG) (* ; + "If true, unescaped lowercase chars are converted to uppercase in symbols") + (COMMONNUMSYNTAX FLAG) (* ; "True if number notation includes Common Lisp numbers: rationals as a/b, and the dfls exponent markers") + (USESILPACKAGE FLAG) (* ; + "If true, IL:READ ignores *PACKAGE* and reads in the IL package") + (NIL 5 FLAG) + (DISPATCHMACRODEFS POINTER) (* ; + "An a-list of dispatching macro char and its dispatch definitions") + (HASHMACROCHAR BYTE) (* ; + "The character code used in this read table for the # dispatch macro") + (ESCAPECHAR BYTE) (* ; + "The character code used in this read table for single escape") + (MULTESCAPECHAR BYTE) (* ; + "The character code used in this read table for multiple escape") + (PACKAGECHAR BYTE) (* ; + "The character code used in this read table for package delimiter") + (READTBLNAME POINTER) (* ; + "The canonical 'name' of this read table") + ) + READSA _ (create CHARTABLE)) ) (/DECLAREDATATYPE 'READTABLEP @@ -1870,8 +1867,12 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. REREADTABLEFORM _ READTABLEFORM]) (EQUAL-READER-ENVIRONMENT - [LAMBDA (ENV1 ENV2) (* ; "Edited 16-Aug-2021 23:43 by rmk:") - (* ; ":XCCS is the prehistoric value") + [LAMBDA (ENV1 ENV2) + + (* ;; "Edited 19-Dec-2021 14:09 by rmk: Replace constant :XCCS with *DEFAULT-EXTERNALFORMAT*") + + (* ;; "Edited 19-Dec-2021 14:01 by rmk") + (AND (EQ (fetch (READER-ENVIRONMENT REREADTABLE) of ENV1) (fetch (READER-ENVIRONMENT REREADTABLE) of ENV2)) (EQ (fetch (READER-ENVIRONMENT REPACKAGE) of ENV1) @@ -1879,9 +1880,9 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (EQ (fetch (READER-ENVIRONMENT REBASE) of ENV1) (fetch (READER-ENVIRONMENT REBASE) of ENV2)) (EQ (OR (fetch (READER-ENVIRONMENT REFORMAT) of ENV1) - :XCCS) + *DEFAULT-EXTERNALFORMAT*) (OR (fetch (READER-ENVIRONMENT REFORMAT) of ENV2) - :XCCS)) + *DEFAULT-EXTERNALFORMAT*)) (EQUAL (fetch (READER-ENVIRONMENT REPACKAGEFORM) of ENV1) (fetch (READER-ENVIRONMENT REPACKAGEFORM) of ENV2)) (EQUAL (fetch (READER-ENVIRONMENT REREADTABLEFORM) of ENV1) @@ -1924,22 +1925,22 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (PUTPROPS ATBL COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1993 2018 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (18046 29198 (GETSYNTAX 18056 . 22887) (SETSYNTAX 22889 . 23962) (SYNTAXP 23964 . 26461) - (\COPYSYNTAX 26463 . 27180) (\GETCHARCODE 27182 . 27470) (\SETFATSYNCODE 27472 . 28763) ( -\MAPCHARTABLE 28765 . 29196)) (29231 44197 (CONTROL 29241 . 29493) (COPYTERMTABLE 29495 . 29862) ( -DELETECONTROL 29864 . 32505) (GETDELETECONTROL 32507 . 33469) (ECHOCHAR 33471 . 34912) (ECHOCONTROL -34914 . 35371) (ECHOMODE 35373 . 35619) (GETECHOMODE 35621 . 35785) (GETCONTROL 35787 . 35953) ( -GETTERMTABLE 35955 . 36022) (RAISE 36024 . 36450) (GETRAISE 36452 . 36614) (RESETTERMTABLE 36616 . -37700) (SETTERMTABLE 37702 . 37936) (TERMTABLEP 37938 . 38099) (\GETTERMSYNTAX 38101 . 38372) ( -\GTTERMTABLE 38374 . 38710) (\ORIGTERMTABLE 38712 . 42322) (\SETTERMSYNTAX 42324 . 42959) ( -\TERMCLASSTOCODE 42961 . 43390) (\TERMCODETOCLASS 43392 . 43779) (\LITCHECK 43781 . 44195)) (46727 -70551 (COPYREADTABLE 46737 . 46935) (FIND-READTABLE 46937 . 47084) (IN-READTABLE 47086 . 47246) ( -ESCAPE 47248 . 47501) (GETBRK 47503 . 47641) (GETREADTABLE 47643 . 47779) (GETSEPR 47781 . 47919) ( -READMACROS 47921 . 48184) (READTABLEP 48186 . 48349) (READTABLEPROP 48351 . 53509) (RESETREADTABLE -53511 . 57758) (SETBRK 57760 . 59370) (SETREADTABLE 59372 . 59560) (SETSEPR 59562 . 61104) ( -\GETREADSYNTAX 61106 . 63796) (\GTREADTABLE 63798 . 64023) (\GTREADTABLE1 64025 . 64281) ( -\ORIGREADTABLE 64283 . 66191) (\READCLASSTOCODE 66193 . 66644) (\SETMACROSYNTAX 66646 . 68441) ( -\SETREADSYNTAX 68443 . 69504) (\READTABLEP.DEFPRINT 69506 . 70549)) (83643 88096 (\ATBLSET 83653 . -88094)) (88543 91975 (MAKE-READER-ENVIRONMENT 88553 . 90231) (EQUAL-READER-ENVIRONMENT 90233 . 91377) -(SET-READER-ENVIRONMENT 91379 . 91973))))) + (FILEMAP (NIL (17750 28902 (GETSYNTAX 17760 . 22591) (SETSYNTAX 22593 . 23666) (SYNTAXP 23668 . 26165) + (\COPYSYNTAX 26167 . 26884) (\GETCHARCODE 26886 . 27174) (\SETFATSYNCODE 27176 . 28467) ( +\MAPCHARTABLE 28469 . 28900)) (28935 43901 (CONTROL 28945 . 29197) (COPYTERMTABLE 29199 . 29566) ( +DELETECONTROL 29568 . 32209) (GETDELETECONTROL 32211 . 33173) (ECHOCHAR 33175 . 34616) (ECHOCONTROL +34618 . 35075) (ECHOMODE 35077 . 35323) (GETECHOMODE 35325 . 35489) (GETCONTROL 35491 . 35657) ( +GETTERMTABLE 35659 . 35726) (RAISE 35728 . 36154) (GETRAISE 36156 . 36318) (RESETTERMTABLE 36320 . +37404) (SETTERMTABLE 37406 . 37640) (TERMTABLEP 37642 . 37803) (\GETTERMSYNTAX 37805 . 38076) ( +\GTTERMTABLE 38078 . 38414) (\ORIGTERMTABLE 38416 . 42026) (\SETTERMSYNTAX 42028 . 42663) ( +\TERMCLASSTOCODE 42665 . 43094) (\TERMCODETOCLASS 43096 . 43483) (\LITCHECK 43485 . 43899)) (46412 +70236 (COPYREADTABLE 46422 . 46620) (FIND-READTABLE 46622 . 46769) (IN-READTABLE 46771 . 46931) ( +ESCAPE 46933 . 47186) (GETBRK 47188 . 47326) (GETREADTABLE 47328 . 47464) (GETSEPR 47466 . 47604) ( +READMACROS 47606 . 47869) (READTABLEP 47871 . 48034) (READTABLEPROP 48036 . 53194) (RESETREADTABLE +53196 . 57443) (SETBRK 57445 . 59055) (SETREADTABLE 59057 . 59245) (SETSEPR 59247 . 60789) ( +\GETREADSYNTAX 60791 . 63481) (\GTREADTABLE 63483 . 63708) (\GTREADTABLE1 63710 . 63966) ( +\ORIGREADTABLE 63968 . 65876) (\READCLASSTOCODE 65878 . 66329) (\SETMACROSYNTAX 66331 . 68126) ( +\SETREADSYNTAX 68128 . 69189) (\READTABLEP.DEFPRINT 69191 . 70234)) (83068 87521 (\ATBLSET 83078 . +87519)) (87968 91406 (MAKE-READER-ENVIRONMENT 87978 . 89656) (EQUAL-READER-ENVIRONMENT 89658 . 90808) +(SET-READER-ENVIRONMENT 90810 . 91404))))) STOP diff --git a/sources/ATBL.LCOM b/sources/ATBL.LCOM index af3880ede3d6805cb0b1337fdd3d79c8cecb6c52..d01f73acfb642e6b89bc99350ca3dff5bd0f37dc 100644 GIT binary patch delta 291 zcmX>znQ6ylrU~I9hL*Z6smZ!V21bSoh9*`9mR2Ul6SK{jaw{jxGl|t38)_;jp{Oyk zGB&m{G*ePYDoRbx&n?KzNlj7UO3p~kOHVCUwNl8-FUiQvOIOIuQ&4gX_3=?a)~%_f3vtRE0WF%GgkW%hJ%o!bri& z*~8J#-8EP@#9u+f%`bTJnMO%XO$DofAlEQY|IlDv7od>}N=7ES{>dc}4;vX;nHpP} XS}G}UO-^7`hL|bNXt~*(X=*zFi?~V? delta 310 zcmdlnnd!`ArU~Jb&ohcm%r)^&&n(f+O-;#3t+Xr7FD*(=Ew*zEaq`i#HnPxEP%<*n z^-nI*H8LHdj(eDoRbx&n?KzNlj7UO3p~kOHVCUwNjY8uu;M#GfzRu zE!4+H0a>e_o}Q9IN@596Jr*NPjFmLGG~7IWT%Chl9Yb7QCZA=LnC#D}Y>LNm3S5>( zCZ>i8Q0o;+@_{bUaPtcWIYV4aQ=y0qJP!82%11m!lD+5C%1ul?9(zq=$ K->l3uwH*MpWm~xb diff --git a/sources/CMLEXEC b/sources/CMLEXEC index 69fd45ed..58857f64 100644 --- a/sources/CMLEXEC +++ b/sources/CMLEXEC @@ -1,10 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 8-Oct-2021 10:51:35"  -{DSK}kaplan>Local>medley3.5>git-medley>sources>CMLEXEC.;2 92464 +(FILECREATED "19-Dec-2021 09:48:29" {DSK}kaplan>Local>medley3.5>my-medley>sources>CMLEXEC.;5 91886 - previous date%: "21-Jan-93 11:16:01" -{DSK}kaplan>Local>medley3.5>git-medley>sources>CMLEXEC.;1) + :CHANGES-TO (VARS CMLEXECCOMS) + + :PREVIOUS-DATE " 8-Oct-2021 10:51:35" +{DSK}kaplan>Local>medley3.5>my-medley>sources>CMLEXEC.;3) (* ; " @@ -18,7 +19,7 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (XCL:PROFILES "EXEC") (STRUCTURES COMMAND-ENTRY EXEC-EVENT-ID EXEC-EVENT HISTORY) (* ; - "These are public except for command-entry.") + "These are public except for command-entry.") (FUNCTIONS XCL::EXEC-CLOSEFN XCL::EXEC-SHRINKFN XCL::SETUP-EXEC-WINDOW XCL::EXEC-TITLE-FUNCTION FIX-FORM XCL::GET-PROCESS-PROFILE XCL::SAVE-CURRENT-EXEC-PROFILE XCL::SETF-GET-PROCESS-PROFILE XCL:SET-EXEC-TYPE @@ -29,7 +30,7 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (FUNCTIONS CIRCLAR-COPYER) (FNS COPY-CIRCLE) (* ; - "CIRCLAR-COPYER and COPY-CIRCLE are the solution for AR#11172") + "CIRCLAR-COPYER and COPY-CIRCLE are the solution for AR#11172") (FNS EXEC-READ DIR) (VARIABLES *PER-EXEC-VARIABLES* CL:* CL:** CL:*** + CL:++ CL:+++ - / CL:// CL:/// *CURRENT-EVENT* *EXEC-ID* XCL:*EXEC-PROMPT* XCL:*EVAL-FUNCTION* *NOT-YET-EVALUATED* @@ -64,10 +65,10 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (FILESLOAD CMLUNDO PROFILE) (XCL:DEFPROFILE "EXEC" (XCL:*DEBUGGER-PROMPT* "") - (XCL:*EXEC-PROMPT* "") - (*READTABLE* "XCL") - (*PACKAGE* "XCL") - (XCL:*EVAL-FUNCTION* 'CL:EVAL)) + (XCL:*EXEC-PROMPT* "") + (*READTABLE* "XCL") + (*PACKAGE* "XCL") + (XCL:*EVAL-FUNCTION* 'CL:EVAL)) (CL:DEFSTRUCT (COMMAND-ENTRY (:TYPE LIST)) ARGUMENTS @@ -148,39 +149,37 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (T (PRINT-EVENT-PROMPT *CURRENT-EVENT*) (DSPFONT INPUTFONT T) (CURSOR T) (* ; - "make sure can edit (in case cursor smashed somehow?)") + "make sure can edit (in case cursor smashed somehow?)") (CL:WHEN NIL (* ; "Old expression") (TTYIN "" NIL NIL 'LISPXREAD NIL NIL BUFFER-EXPR-FROM-BELOW *READTABLE*)) (EXEC-READ-LINE (LET ((%#RPARS NIL) - (FONTCHANGEFLG NIL) - (*PRINT-ESCAPE* T) - (*PRINT-RADIX* (NOT (= *READ-BASE* 10))) - (*PRINT-BASE* *READ-BASE*) - (*PRINT-LEVEL* NIL) - (*PRINT-LENGTH* NIL) - (*PRINT-GENSYM* ':REREAD) - (*PRINT-ARRAY* T) - (*PRINT-STRUCTURE* T)) - (DECLARE (CL:SPECIAL %#RPARS FONTCHANGEFLG) + (FONTCHANGEFLG NIL) + (*PRINT-ESCAPE* T) + (*PRINT-RADIX* (NOT (= *READ-BASE* 10))) + (*PRINT-BASE* *READ-BASE*) + (*PRINT-LEVEL* NIL) + (*PRINT-LENGTH* NIL) + (*PRINT-GENSYM* ':REREAD) + (*PRINT-ARRAY* T) + (*PRINT-STRUCTURE* T)) + (DECLARE (CL:SPECIAL %#RPARS FONTCHANGEFLG) (* ; - "others are already globally special ") - ) - (CL:WITH-OUTPUT-TO-STRING - (STR) - (FOR X ON INPUT - DO (IF CIRCLE-FLAG - THEN (* ; - "Edited by TT (31-May-1990) CL:PRIN1 can print circlar") - (CL:PRIN1 (CAR X) - STR) - ELSEIF (LISTP (CAR X)) - THEN (PRINTDEF (CAR X) - (POSITION STR) - NIL NIL NIL STR) - ELSE (PRIN2 (CAR X) - STR)) - (AND (CDR X) - (PRIN1 " " STR]) + "others are already globally special ")) + (CL:WITH-OUTPUT-TO-STRING (STR) + (FOR X ON INPUT + DO (IF CIRCLE-FLAG + THEN (* ; + "Edited by TT (31-May-1990) CL:PRIN1 can print circlar") + (CL:PRIN1 (CAR X) + STR) + ELSEIF (LISTP (CAR X)) + THEN (PRINTDEF (CAR X) + (POSITION STR) + NIL NIL NIL STR) + ELSE (PRIN2 (CAR X) + STR)) + (AND (CDR X) + (PRIN1 " " STR]) (CL:DEFUN XCL::GET-PROCESS-PROFILE (&OPTIONAL (XCL::PROCESS (THIS.PROCESS))) (PROCESSPROP XCL::PROCESS 'PROFILE)) @@ -192,7 +191,7 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (XCL:SAVE-PROFILE XCL::PROFILE)))) (CL:DEFUN XCL::SETF-GET-PROCESS-PROFILE (&OPTIONAL (XCL::PROCESS (THIS.PROCESS)) - (XCL::PROFILE XCL:*PROFILE*)) + (XCL::PROFILE XCL:*PROFILE*)) (CL:SETQ XCL::PROFILE (XCL::PROFILIZE XCL::PROFILE)) (PROCESSPROP XCL::PROCESS 'PROFILE XCL::PROFILE) XCL::PROFILE) @@ -215,7 +214,7 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. "Start up an exec function in the proper profile, setting the default window title properly." (XCL:WITH-PROFILE (XCL:COPY-PROFILE XCL::PROFILE) (XCL::EXEC-TITLE-FUNCTION T (PROCESS-EXEC-ID (THIS.PROCESS) - XCL::ID)) + XCL::ID)) (CL:FUNCALL XCL::EXEC-FUNCTION))) (CL:DEFSETF XCL::GET-PROCESS-PROFILE XCL::SETF-GET-PROCESS-PROFILE) @@ -226,13 +225,13 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. STR (RETRYFLAG NIL) (* ; "A really gross hack for RETRY to always break. It exists because: users can setq HELPFLAG anywhere (can't bind it in DO-EVENTand set it in RETRY), RETRY operates on commands (can't wrap the form with a binding of HELPFLAG).") ) - (DECLARE (CL:SPECIAL RETRYFLAG)) (* ; - "RETRY command sets this variable if it wants to be sure to break.") + (DECLARE (CL:SPECIAL RETRYFLAG)) (* ; + "RETRY command sets this variable if it wants to be sure to break.") (DSPFONT PRINTOUTFONT T) (SETQ INPUT ORIGINAL-INPUT) RETRY - (SETQ TODO (COPY-CIRCLE INPUT)) (* ; -"Break EQ link between input and evaluated form (todo), so that in-place mods don't affect history.") + (SETQ TODO (COPY-CIRCLE INPUT)) (* ; + "Break EQ link between input and evaluated form (todo), so that in-place mods don't affect history.") [COND [[AND (OR (STRINGP (CAR INPUT)) (CL:SYMBOLP (CAR INPUT))) @@ -260,14 +259,13 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (CL:WHEN *CURRENT-EVENT* (CL:SETF (EXEC-EVENT-INPUT *CURRENT-EVENT*) INPUT) (* ; - " Overwrite the original input with the newly generated one.") + " Overwrite the original input with the newly generated one.") (CL:SETF (EXEC-EVENT-PROPS *CURRENT-EVENT*) - (LIST* '*HISTORY* ORIGINAL-INPUT (EXEC-EVENT-PROPS *CURRENT-EVENT* - )))) + (LIST* '*HISTORY* ORIGINAL-INPUT (EXEC-EVENT-PROPS *CURRENT-EVENT*)))) (GO RETRY) (* ; " could have generated a command") ) ((NIL :EVAL) (* ; - " normal kind of command, just apply") + " normal kind of command, just apply") [SETQ TODO `((CL:FUNCALL ',(COMMAND-ENTRY-FUNCTION COM) ',INPUT ',ENVIRONMENT] @@ -284,11 +282,11 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (CL:WHEN *EXEC-MAKE-UNDOABLE-P* [if (CDR TODO) then (SETQ TODO (CONS (OR (CDR (ASSOC (CAR TODO) - LISPXFNS)) - (CAR TODO)) - (CDR TODO))) + LISPXFNS)) + (CAR TODO)) + (CDR TODO))) else (SETQ TODO (LIST (XCL::MAKE-UNDOABLE (CAR TODO) - NIL])] + NIL])] (AND ADD-TO-SPELLING-LIST (HISTORY-ADD-TO-SPELLING-LISTS TODO)) (SETQ LISPXHIST *CURRENT-EVENT*) (DSPFONT PRINTOUTFONT T) @@ -301,8 +299,7 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. [SETQ VALUES (CL:MULTIPLE-VALUE-LIST (CL:IF RETRYFLAG (LET ((HELPFLAG 'BREAK!)) - (DECLARE (CL:SPECIAL HELPFLAG - )) + (DECLARE (CL:SPECIAL HELPFLAG)) (CL:FUNCALL FUNCTION TODO ENVIRONMENT)) (CL:FUNCALL FUNCTION TODO ENVIRONMENT)) @@ -319,69 +316,66 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (for X in VALUES do (EXEC-PRINT X)) VALUES)))) -(CL:DEFUN EXEC (&KEY XCL::TOP-LEVEL-P (* ; - "True of top level execs. Used for event number restarting and profile caching.") - (XCL::WINDOW (WFROMDS (TTYDISPLAYSTREAM))) +(CL:DEFUN EXEC (&KEY XCL::TOP-LEVEL-P (* ; + "True of top level execs. Used for event number restarting and profile caching.") + (XCL::WINDOW (WFROMDS (TTYDISPLAYSTREAM))) (* ; "Window for this exec, if any.") - (XCL::TITLE NIL XCL::TITLE-SUPPLIED)(* ; - "If given, specific title for this window.") - ((:COMMAND-TABLES *THIS-EXEC-COMMANDS*) - (LIST *EXEC-COMMAND-TABLE*)) (* ; - "List of hash tables to look up commands in.") - XCL::ENVIRONMENT (* ; - "Lexical environment to evaluate things in, default NIL.") - XCL::PROMPT (* ; - "Special prompt to use (optional).") - ((:FUNCTION XCL::FN) - 'EVAL-INPUT) (* ; "Function for processing input.") - XCL::PROFILE (* ; - "Optional profile, sets the exec's bindings.") - XCL::ID (* ; "A handle on the exec.") - &ALLOW-OTHER-KEYS (* ; "To catch obsolete calls") - &AUX - (*EXEC-ID* (PROCESS-EXEC-ID (THIS.PROCESS) - XCL::ID)) - (XCL::PROFILE-CACHE (XCL::GET-PROCESS-PROFILE (THIS.PROCESS))) + (XCL::TITLE NIL XCL::TITLE-SUPPLIED) (* ; + "If given, specific title for this window.") + ((:COMMAND-TABLES *THIS-EXEC-COMMANDS*) + (LIST *EXEC-COMMAND-TABLE*)) (* ; + "List of hash tables to look up commands in.") + XCL::ENVIRONMENT (* ; + "Lexical environment to evaluate things in, default NIL.") + XCL::PROMPT (* ; "Special prompt to use (optional).") + ((:FUNCTION XCL::FN) + 'EVAL-INPUT) (* ; "Function for processing input.") + XCL::PROFILE (* ; + "Optional profile, sets the exec's bindings.") + XCL::ID (* ; "A handle on the exec.") + &ALLOW-OTHER-KEYS (* ; "To catch obsolete calls") + &AUX + (*EXEC-ID* (PROCESS-EXEC-ID (THIS.PROCESS) + XCL::ID)) + (XCL::PROFILE-CACHE (XCL::GET-PROCESS-PROFILE (THIS.PROCESS))) (* ; - "The exec's cached profile (if entering from a hardreset).") - ) + "The exec's cached profile (if entering from a hardreset).") + ) [CL:PROGV (MAPCAR *PER-EXEC-VARIABLES* (FUNCTION CAR)) [MAPCAR *PER-EXEC-VARIABLES* (FUNCTION (LAMBDA (XCL::X) (EVAL (CADR XCL::X] (CL:WHEN (OR (NULL XCL::TOP-LEVEL-P) (NULL XCL::PROFILE-CACHE)) (* ; "If not hardresetting...") - (CL:WHEN XCL::PROFILE (* ; - "then initialize the profile vars.") + (CL:WHEN XCL::PROFILE (* ; "then initialize the profile vars.") (XCL:RESTORE-PROFILE XCL::PROFILE)) (CL:WHEN XCL::PROMPT (* ; - "If a special prompt was provided (as from the debugger)...") + "If a special prompt was provided (as from the debugger)...") (CL:SETQ XCL:*EXEC-PROMPT* XCL::PROMPT) (* ; "...use it.") )) (CL:WHEN XCL::TOP-LEVEL-P (CL:IF (NULL XCL::PROFILE-CACHE) (* ; - "This was a new entry into top level exec.") + "This was a new entry into top level exec.") (CL:SETF (XCL::GET-PROCESS-PROFILE (THIS.PROCESS)) (XCL:SAVE-PROFILE (XCL:COPY-PROFILE "EXEC"))) (* ; - "...make a fresh cache and save bindings into it.") - (XCL:RESTORE-PROFILE XCL::PROFILE-CACHE) (* ; - "...otherwise it was a HARDRESET.") + "...make a fresh cache and save bindings into it.") + (XCL:RESTORE-PROFILE XCL::PROFILE-CACHE) (* ; "...otherwise it was a HARDRESET.") )) (CL:WHEN XCL::WINDOW (COND ((NOT XCL::TITLE-SUPPLIED) (* ; - "If no title was supplied, set it to the default.") + "If no title was supplied, set it to the default.") (XCL::EXEC-TITLE-FUNCTION XCL::WINDOW *EXEC-ID*)) (XCL::TITLE (* ; - "If a non-nil title was supplied, set the title to it.") + "If a non-nil title was supplied, set the title to it.") (WINDOWPROP XCL::WINDOW 'TITLE XCL::TITLE))) (TTYDISPLAYSTREAM (DECODE/WINDOW/OR/DISPLAYSTREAM XCL::WINDOW))) (LET [(*CURRENT-EVENT* NIL) (* ; - "the event being processed. Used by some commands") + "the event being processed. Used by some commands") (XCL::OLD-DS (CL:IF XCL::WINDOW (TTYDISPLAYSTREAM (DECODE/WINDOW/OR/DISPLAYSTREAM XCL::WINDOW)))] (CL:LOOP (CL:FORMAT T "~&~%%") (* ; - "newlines to notice that this is a new instance of the exec") + "newlines to notice that this is a new instance of the exec") (PROG1 [ERSETQ (CL:LOOP (* ; "loop until errors out") (CL:SETQ *CURRENT-EVENT* (GET-NEXT-HISTORY-EVENT LISPXHISTORY *EXEC-ID* @@ -397,25 +391,24 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (DECLARE (CL:SPECIAL LISPXHIST HELPCLOCK)) (CL:UNLESS (CL:EQUAL XCL::ORIGINAL-INPUT '(NIL)) - (DO-EVENT XCL::ORIGINAL-INPUT - XCL::ENVIRONMENT XCL::FN) + (DO-EVENT XCL::ORIGINAL-INPUT XCL::ENVIRONMENT + XCL::FN) (CL:WHEN XCL::TOP-LEVEL-P (* ; "Used to determine whether to cache the settings of the profile back into the process (for retrieval in case of hardreset).") (XCL::SAVE-CURRENT-EXEC-PROFILE)))] (CL:WHEN XCL::WINDOW (TTYDISPLAYSTREAM XCL::OLD-DS)))]) (CL:DEFUN EXEC-EVAL (FORM &OPTIONAL ENVIRONMENT &KEY (PROMPT ">") - (ID "eval/") - ((:TYPE *CURRENT-EXEC-TYPE*) - 'COMMON-LISP)) (* ; "Edited by JDS 16-Aug-90 12:55.") + (ID "eval/") + ((:TYPE *CURRENT-EXEC-TYPE*) + 'COMMON-LISP)) (* ; "Edited by JDS 16-Aug-90 12:55.") (LET ((*CURRENT-EVENT* (GET-NEXT-HISTORY-EVENT LISPXHISTORY ID PROMPT T)) (LISPXHIST LISPXHIST) (HELPCLOCK 0) VALUES) (DECLARE (CL:SPECIAL *CURRENT-EVENT* LISPXHIST HELPCLOCK)) - (SETQ VALUES (CL:MULTIPLE-VALUE-LIST (EVAL-INPUT (CL:SETF (EXEC-EVENT-INPUT - *CURRENT-EVENT*) - (LIST FORM)) + (SETQ VALUES (CL:MULTIPLE-VALUE-LIST (EVAL-INPUT (CL:SETF (EXEC-EVENT-INPUT *CURRENT-EVENT*) + (LIST FORM)) ENVIRONMENT))) (SETQ IT (CAR VALUES)) (COND @@ -455,8 +448,8 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. `(EXEC-VALUE-OF ',EVENT-SPEC)) (CL:DEFUN ADD-EXEC (&KEY (XCL::PROFILE XCL:*PROFILE*) - XCL::REGION XCL::TTY (EXEC 'EXEC) - XCL::ID &ALLOW-OTHER-KEYS) + XCL::REGION XCL::TTY (EXEC 'EXEC) + XCL::ID &ALLOW-OTHER-KEYS) (LET* [(XCL::WINDOW (XCL::SETUP-EXEC-WINDOW (CREATEW XCL::REGION "Exec"))) (XCL::HANDLE (ADD.PROCESS `[PROGN (TTYDISPLAYSTREAM ',XCL::WINDOW) @@ -465,7 +458,7 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. ',XCL::WINDOW) ,(CASE EXEC (EXEC `(EXEC :TOP-LEVEL-P T :PROFILE ',XCL::PROFILE :ID - ',XCL::ID)) + ',XCL::ID)) (T `(XCL::ENTER-EXEC-FUNCTION ',EXEC ',XCL::PROFILE ',XCL::ID)))] 'NAME @@ -483,21 +476,21 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. ((AND (READP T) (SYNTAXP (PEEKCCODE T T) 'EOL)) (* ; - "Avoid picking up end of line as a NIL.") + "Avoid picking up end of line as a NIL.") (READC T))) (SETQ LINE (LIST (EXEC-READ BUFFER-STRING))) TOP (COND ((LISTP (CAR LINE)) (* ; - "If we got a list, return right away--it's a standard EVAL form of input") + "If we got a list, return right away--it's a standard EVAL form of input") (GO OUT))) LP (SETQ SPACEFLG NIL) (* ; "to distinguish between") (* ; "FOO (A B)") (* ; "FOO(A B)") (* ; - "the latter has no space and returns right away") + "the latter has no space and returns right away") LP1 (COND ((NOT (READP T)) (* ; - "nothing more in line buffer, so must have consumed last thing on the line") + "nothing more in line buffer, so must have consumed last thing on the line") (GO OUT)) ((NULL (SETQ CHRCODE (PEEKCCODE T T))) (* ; "PEEKCCODE can return NIL when stream is at EOF. However, we already checked for READP before getting here.") (GO OUT)) @@ -510,7 +503,7 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (SHOULDNT)) (AND (NULL (CDR LINE)) (SETQ LINE (NCONC1 LINE NIL))) (* ; - " A %")%" is treated as NIL if it is the second thing on the line when EXEC-READ-LINE is called") + " A %")%" is treated as NIL if it is the second thing on the line when EXEC-READ-LINE is called") (GO OUT)) ((EQ CHRCODE (CHARCODE SPACE)) (SETQ SPACEFLG T) @@ -523,7 +516,7 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (SYNTAXP CHRCODE 'RIGHTBRACKET *READTABLE*))) (GO LP)) ((NOT SPACEFLG) (* ; - "A list terminates the line if it is the second element on the line, not preceded by a space.") + "A list terminates the line if it is the second element on the line, not preceded by a space.") (* ;; "[JDS 1/12/88: This used to test (AND (NOT SPACEFLG) (READP T)), and loop if there were more input pending. This seems wrong, because when you type it should throw the carriage at once, and not depend on how fast you're typing. Further, when there's type-ahead, it's often followed by a SPACE, to prevent output pausing. With the old test here, that would hang up a final eval-quote form without executing it.]") @@ -533,7 +526,7 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. OUT (RETURN (COND ((AND (LISTP LINE) CTRLUFLG) (* ; - "Edit interrupt during reading--forces structure editor use.") + "Edit interrupt during reading--forces structure editor use.") (SETQ CTRLUFLG NIL) (LET ((*EDIT-INPUT-WITH-TTYIN* NIL)) (FIX-FORM LINE))) @@ -553,7 +546,7 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (SETQ COM (GETHASH STR TABLE))) TABLE)))) -(CL:DEFUN CIRCLAR-COPYER (INPUT) (* ; "Edited by TT 31-May-1990") +(CL:DEFUN CIRCLAR-COPYER (INPUT) (* ; "Edited by TT 31-May-1990") (PROG (SCANBUF REST VAL NEW BODY ID AUX (CIRCLAR-FLAG NIL)) (COND ((NLISTP INPUT) @@ -580,9 +573,9 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (SETQ CIRCLAR-FLAG T) (RPLACD NEW (CDR ID))) (T [push REST (SETQ AUX (CONS (CADR NEW) - (CDDR NEW] + (CDDR NEW] (push SCANBUF (CONS (CDR NEW) - AUX)) + AUX)) (RPLACD NEW AUX))) (COND ((NLISTP (CAR NEW))) @@ -591,9 +584,9 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (SETQ CIRCLAR-FLAG T) (RPLACA NEW (CDR ID))) (T [push REST (SETQ AUX (CONS (CAAR NEW) - (CDAR NEW] + (CDAR NEW] (push SCANBUF (CONS (CAR NEW) - AUX)) + AUX)) (RPLACA NEW AUX] (GO LP))) (DEFINEQ @@ -727,10 +720,10 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. "List of command hash-tables for the current executive") (DEFGLOBALVAR *EXEC-COMMAND-TABLE* (HASHARRAY 30 NIL 'STRING-EQUAL-HASHBITS 'STRING-EQUAL) - "hash-table for top level exec commands") + "hash-table for top level exec commands") (DEFGLOBALVAR *DEBUGGER-COMMAND-TABLE* (HASHARRAY 20 NIL 'STRING-EQUAL-HASHBITS 'STRING-EQUAL) - "string-equal hash-table for debugger commands") + "string-equal hash-table for debugger commands") (CL:DEFVAR *CURRENT-EXEC-TYPE* NIL "Rebound under Exec; if NIL, means use default") @@ -1337,7 +1330,7 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. "Start an old-style LISPX window"]) (ADDTOVAR SYSTEMINITVARS (LISPXHISTORY NIL 0 100 100) - (GREETHIST)) + (GREETHIST)) @@ -1347,24 +1340,23 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (DEF-DEFINE-TYPE COMMANDS "Exec Commands") (DEFDEFINER (DEFCOMMAND [:NAME (CL:LAMBDA (WHOLE) - (LET ((NAME (CL:SECOND WHOLE))) - (CL:IF (CL:CONSP NAME) - (CAR NAME) - NAME)]) COMMANDS (NAME ARGUMENTS &ENVIRONMENT ENV - &BODY BODY) + (LET ((NAME (CL:SECOND WHOLE))) + (CL:IF (CL:CONSP NAME) + (CAR NAME) + NAME)]) COMMANDS (NAME ARGUMENTS &ENVIRONMENT ENV + &BODY BODY) [LET ((COMMAND-LEVEL '*EXEC-COMMAND-TABLE*) (COMMAND-TYPE :EVAL) (PREFIX "exec-")) [if (LISTP NAME) then (SETQ NAME (PROG1 (CAR NAME) - [for X in (CDR NAME) - do (CL:ECASE X - ((:QUIET :HISTORY :INPUT :EVAL :MACRO) (SETQ - COMMAND-TYPE - X)) - ((:DEBUGGER :BREAK) - (SETQ COMMAND-LEVEL '*DEBUGGER-COMMAND-TABLE*) - (SETQ PREFIX "break-")))])] + [for X in (CDR NAME) do (CL:ECASE X + ((:QUIET :HISTORY :INPUT :EVAL :MACRO) + (SETQ COMMAND-TYPE X)) + ((:DEBUGGER :BREAK) + (SETQ COMMAND-LEVEL + '*DEBUGGER-COMMAND-TABLE*) + (SETQ PREFIX "break-")))])] (LET* ((CMACRONAME (PACK* PREFIX NAME)) (STRINGNAME (STRING NAME))) (CL:MULTIPLE-VALUE-BIND (PARSED-BODY PARSED-DECLARATIONS PARSED-DOCSTRING) @@ -1397,32 +1389,32 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (CL:FORMAT T " ~20Tto apply function to the arguments given~&~%%or one of:") (FOR X ON (REVERSE *THIS-EXEC-COMMANDS*) DO (LET (COMS) - [MAPHASH (CAR X) - #'(CL:LAMBDA (VAL KEY) - (AND [NOT (SOME (CDR X) - #'(CL:LAMBDA (TAB) - (GETHASH KEY TAB] - (PUSH COMS (LIST KEY VAL] - (CL:MAPC #'[CL:LAMBDA (COM) - (CL:FORMAT T "~&") - (DSPFONT INPUTFONT T) - (CL:FORMAT T "~A " (CAR COM)) - (DSPFONT COMMENTFONT T) - (PRINT-ARGLIST (COMMAND-ENTRY-ARGUMENTS (CADR COM))) - (DSPFONT DEFAULTFONT T) - (LET [(DOC (CL:DOCUMENTATION (CAR COM) - 'COMMANDS] - (CL:WHEN DOC - (TAB 20 1 T) - (CL:FORMAT T "~A" DOC))] - (CL:SORT COMS #'CL:STRING< :KEY #'CAR]) + [MAPHASH (CAR X) + #'(CL:LAMBDA (VAL KEY) + (AND [NOT (SOME (CDR X) + #'(CL:LAMBDA (TAB) + (GETHASH KEY TAB] + (PUSH COMS (LIST KEY VAL] + (CL:MAPC #'[CL:LAMBDA (COM) + (CL:FORMAT T "~&") + (DSPFONT INPUTFONT T) + (CL:FORMAT T "~A " (CAR COM)) + (DSPFONT COMMENTFONT T) + (PRINT-ARGLIST (COMMAND-ENTRY-ARGUMENTS (CADR COM))) + (DSPFONT DEFAULTFONT T) + (LET [(DOC (CL:DOCUMENTATION (CAR COM) + 'COMMANDS] + (CL:WHEN DOC + (TAB 20 1 T) + (CL:FORMAT T "~A" DOC))] + (CL:SORT COMS #'CL:STRING< :KEY #'CAR]) (CL:VALUES)) (DEFCOMMAND ("??" :QUIET) (&REST EVENT-SPECS) "Show events specified EVENT-SPECS (or all events)" (IF (AND EVENT-SPECS (EQ (CAR EVENT-SPECS) - ':INPUT)) + ':INPUT)) THEN (PRINT-HISTORY LISPXHISTORY (CDR EVENT-SPECS) - T) + T) ELSE (PRINT-HISTORY LISPXHISTORY EVENT-SPECS)) (CL:VALUES)) @@ -1435,21 +1427,19 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (DEFCOMMAND ("DIR" :EVAL) (&OPTIONAL PATHNAME &REST KEYWORDS) "Show directory listing for PATHNAME" [DODIR (CONS PATHNAME (MAPCAR KEYWORDS (FUNCTION (LAMBDA (CL:KEYWORD) (IF (CL:SYMBOLP CL:KEYWORD) - THEN (CL:INTERN (CL:SYMBOL-NAME - CL:KEYWORD) - "INTERLISP") + THEN (CL:INTERN (CL:SYMBOL-NAME CL:KEYWORD) + "INTERLISP") ELSE CL:KEYWORD]) (DEFCOMMAND "DO-EVENTS" (&REST INPUTS &ENVIRONMENT ENV) "Execute the multiple events in INPUTS, using the environment ENV for all evaluations." [LET ((OUTER-EVENT (AND *CURRENT-EVENT* (COPY-EXEC-EVENT *CURRENT-EVENT*))) (* ; - "DO-EVENT smashes *CURRENT-EVENT*, so we copy and save it.") + "DO-EVENT smashes *CURRENT-EVENT*, so we copy and save it.") ) (CL:WHEN OUTER-EVENT (CL:SETF (EXEC-EVENT-INPUT OUTER-EVENT) - (CONS 'DO-EVENTS INPUTS)) (* ; - "Each of these is fixed up below.") + (CONS 'DO-EVENTS INPUTS)) (* ; "Each of these is fixed up below.") ) (ERSETQ (CL:MAPL #'[CL:LAMBDA (INPUT) (LET ([TODO (CL:IF (EQ (CAR (LISTP (CAR INPUT))) @@ -1460,32 +1450,32 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (CL:WHEN ADDSPELLFLG (HISTORY-ADD-TO-SPELLING-LISTS TODO)) (SETQ VALUES (DO-EVENT TODO ENV)) (* ; - "If it exists, *CURRENT-EVENT* gets smashed here.") + "If it exists, *CURRENT-EVENT* gets smashed here.") (CL:WHEN OUTER-EVENT (* ; "If there is an outer event...") (* ;; - "Fix the outer event's list of inputs with the expanded input.") + "Fix the outer event's list of inputs with the expanded input.") (RPLACA INPUT (CAR (EXEC-EVENT-INPUT *CURRENT-EVENT*))) (CL:WHEN VALUES (* ; - "If the last sub-event generated some values...") + "If the last sub-event generated some values...") (* ;; - "Add the new values to the outer event's values.") + "Add the new values to the outer event's values.") - [LET [(OLD-VALUES (CL:GETF (EXEC-EVENT-PROPS - OUTER-EVENT) + [LET [(OLD-VALUES (CL:GETF (EXEC-EVENT-PROPS + OUTER-EVENT) 'LISPXVALUES] (CL:IF OLD-VALUES (NCONC OLD-VALUES VALUES) (CL:SETF (EXEC-EVENT-PROPS OUTER-EVENT) (LIST* 'LISPXVALUES VALUES - (EXEC-EVENT-PROPS - OUTER-EVENT))))]))] + (EXEC-EVENT-PROPS OUTER-EVENT)) + ))]))] INPUTS)) (CL:WHEN *CURRENT-EVENT* (* ; "If there was a current event...") (* ; - "Smash saved values back from OUTER-EVENT.") + "Smash saved values back from OUTER-EVENT.") (CL:SETF (EXEC-EVENT-INPUT *CURRENT-EVENT*) (EXEC-EVENT-INPUT OUTER-EVENT)) (CL:SETF (EXEC-EVENT-ID *CURRENT-EVENT*) @@ -1496,19 +1486,18 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (EXEC-EVENT-PROPS OUTER-EVENT)))] (SETQ *CURRENT-EVENT* NIL) (* ; "Keeps the DO-EVENT which is evaluating us from setting the event's results to (the result of evaluating) the NIL we return. This is alright since *CURRENT-EVENT* is already pointed to by the history list.") (CL:VALUES) (* ; - "We've evaluated all the subforms directly with DO-EVENT so we don't return a form to EVAL.") + "We've evaluated all the subforms directly with DO-EVENT so we don't return a form to EVAL.") ) (DEFCOMMAND ("FIX" :HISTORY) (&REST EVENT-SPEC) "Edit input for specified events" - [APPLY 'FIX-FORM (CL:MULTIPLE-VALUE-LIST (CIRCLAR-COPYER (EVENTS-INPUT - (FIND-HISTORY-EVENTS - (OR EVENT-SPEC '(-1)) - LISPXHISTORY]) + [APPLY 'FIX-FORM (CL:MULTIPLE-VALUE-LIST (CIRCLAR-COPYER (EVENTS-INPUT (FIND-HISTORY-EVENTS + (OR EVENT-SPEC + '(-1)) + LISPXHISTORY]) (DEFCOMMAND "FORGET" (&REST EVENT-SPEC) "Erase UNDO information (for specified events)." (FOR EVENT IN (FIND-HISTORY-EVENTS (OR EVENT-SPEC '(-1)) - LISPXHISTORY) DO (UNDOLISPX2 EVENT T) - FINALLY (CL:FORMAT T "Forgotten.~&")) + LISPXHISTORY) DO (UNDOLISPX2 EVENT T) FINALLY (CL:FORMAT T "Forgotten.~&")) (CL:VALUES)) (DEFCOMMAND "NAME" (COMMAND-NAME &OPTIONAL ARGUMENT-LIST &REST EVENT-SPEC) @@ -1517,8 +1506,7 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (CL:PUSH ARGUMENT-LIST EVENT-SPEC) (SETQ ARGUMENT-LIST NIL)) [LET [(EVENTS (FIND-HISTORY-EVENTS EVENT-SPEC LISPXHISTORY)) - (ARGNAMES (FOR I FROM 1 AS X IN ARGUMENT-LIST - COLLECT (PACK* 'ARG I] + (ARGNAMES (FOR I FROM 1 AS X IN ARGUMENT-LIST COLLECT (PACK* 'ARG I] (CL:EVAL `(DEFCOMMAND (,COMMAND-NAME :HISTORY) ,ARGNAMES [SUBPAIR ',ARGNAMES (LIST ,@ARGNAMES) ',(SUBPAIR ARGUMENT-LIST ARGNAMES (EVENTS-INPUT EVENTS) @@ -1536,7 +1524,7 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (DEFCOMMAND ("REDO" :HISTORY) (&REST EVENT-SPEC) "Re-execute specified event(s)" (EVENTS-INPUT (FIND-HISTORY-EVENTS (OR EVENT-SPEC '(-1)) - LISPXHISTORY))) + LISPXHISTORY))) (DEFCOMMAND ("REMEMBER" :EVAL) (&REST EVENT-SPEC) "Tell Manager to remember type-in from specified event(s)" @@ -1549,40 +1537,37 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (DEFCOMMAND "UNDO" (&REST EVENT-SPEC) "Undo side effects associated with the specified event (or last undoable one)" [FOR EVENT IN (FIND-HISTORY-EVENTS (OR EVENT-SPEC '(-1)) - LISPXHISTORY) DO (LET ((INPUT (CAR (EXEC-EVENT-INPUT EVENT))) - (RESULT (UNDOLISPX2 EVENT))) - (CL:IF (LISTP INPUT) - (SETQ INPUT (CAR INPUT))) - (COND - ((NULL RESULT) - (CL:FORMAT T - "No undo info saved for ~A.~&" - INPUT)) - ((EQ RESULT 'already) - (CL:FORMAT T "~A already undone.~&" - INPUT)) - (T (CL:FORMAT T "~A undone.~&" INPUT] + LISPXHISTORY) DO (LET ((INPUT (CAR (EXEC-EVENT-INPUT EVENT))) + (RESULT (UNDOLISPX2 EVENT))) + (CL:IF (LISTP INPUT) + (SETQ INPUT (CAR INPUT))) + (COND + ((NULL RESULT) + (CL:FORMAT T "No undo info saved for ~A.~&" INPUT)) + ((EQ RESULT 'already) + (CL:FORMAT T "~A already undone.~&" INPUT)) + (T (CL:FORMAT T "~A undone.~&" INPUT] (CL:VALUES)) (DEFCOMMAND ("USE" :HISTORY) (&REST LINE) "USE [FOR ] [IN ]" (* ;; -"this code stolen from LISPXUSE in HIST and edited. The structure is still pretty incomprehensible") + "this code stolen from LISPXUSE in HIST and edited. The structure is still pretty incomprehensible") [PROG (EVENT-SPECS EXPR ARGS VARS (STATE 'VARS) LST TEM USE-ARGS GENLST) LP [COND ([OR (NULL LST) (NULL (CDR LINE)) - (NULL (CASE-EQUALP (CAR LINE) (* ; - "look for one of the special keywords") + (NULL (CASE-EQUALP (CAR LINE) (* ; + "look for one of the special keywords") (FOR (COND - ((EQ STATE 'VARS) - (SETQ VARS (NCONC1 VARS LST)) - (SETQ TEM (APPEND LST TEM)) - (SETQ STATE 'ARGS) - (SETQ LST NIL) - T))) + ((EQ STATE 'VARS) + (SETQ VARS (NCONC1 VARS LST)) + (SETQ TEM (APPEND LST TEM)) + (SETQ STATE 'ARGS) + (SETQ LST NIL) + T))) (AND (COND ((EQ STATE 'EXPR) NIL) @@ -1590,30 +1575,30 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. ((EQ STATE 'ARGS) (SETQ ARGS (NCONC1 ARGS LST))) ((EQ STATE 'VARS)(* ; - "E.g. user types USE A AND B following previous USE command.") + "E.g. user types USE A AND B following previous USE command.") (SETQ VARS (NCONC1 VARS LST] (SETQ STATE 'VARS) (SETQ LST NIL) T))) (IN (COND - ((AND (EQ STATE 'VARS) - (NULL ARGS)) - (SETQ VARS (NCONC1 VARS LST)) - (SETQ TEM (APPEND LST TEM)) - (SETQ STATE 'EXPR) - (SETQ LST NIL) - T) - ((EQ STATE 'ARGS) - (SETQ ARGS (NCONC1 ARGS LST)) - (SETQ STATE 'EXPR) - (SETQ LST NIL) - T] + ((AND (EQ STATE 'VARS) + (NULL ARGS)) + (SETQ VARS (NCONC1 VARS LST)) + (SETQ TEM (APPEND LST TEM)) + (SETQ STATE 'EXPR) + (SETQ LST NIL) + T) + ((EQ STATE 'ARGS) + (SETQ ARGS (NCONC1 ARGS LST)) + (SETQ STATE 'EXPR) + (SETQ LST NIL) + T] (SETQ LST (NCONC1 LST (COND (NIL (MEMBER (CAR LINE) TEM) (* ;; - "This enables USE A B FOR B A, USE A FOR B AND B FOR A, or USE A FOR B AND B C FOR A") + "This enables USE A B FOR B A, USE A FOR B AND B FOR A, or USE A FOR B AND B C FOR A") (LET ((TEMP (CONCAT "temp string"))) (CL:PUSH (CONS (CAR LINE) @@ -1639,7 +1624,7 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (SETQ EXPR (MAPCAR (FIND-HISTORY-EVENTS EXPR LISPXHISTORY) (FUNCTION EXEC-EVENT-INPUT))) (* ; - "EXPR is now a list of event inputs") + "EXPR is now a list of event inputs") (* ;; "at this point, VARS is a list of list of old things, the extra list corresponding to the clauses of an AND, e.g. ") @@ -1651,60 +1636,68 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (IF (NULL ARGS) THEN [SETQ EXPR (FOR X IN EXPR - JOIN (FOR VAR IN VARS - COLLECT (IF (CL:CONSP (CAR X)) - THEN (CONS (CONS (CAR VAR) - (CDAR X)) - (CDR X)) - ELSE (CONS (CAR VAR) - (CDR X] + JOIN (FOR VAR IN VARS + COLLECT (IF (CL:CONSP (CAR X)) + THEN (CONS (CONS (CAR VAR) + (CDAR X)) + (CDR X)) + ELSE (CONS (CAR VAR) + (CDR X] ELSE (WHILE ARGS DO (SETQ EXPR (LISPXUSE1 (POP VARS) - (POP ARGS) - EXPR)) - FINALLY (COND - (VARS (ERROR '"use what??" "" T))) - [MAPC GENLST (FUNCTION (LAMBDA (X) - (LISPXSUBST (CAR X) - (CDR X) - EXPR T] + (POP ARGS) + EXPR)) FINALLY (COND + (VARS (ERROR '"use what??" "" T))) + [MAPC GENLST (FUNCTION (LAMBDA (X) + (LISPXSUBST + (CAR X) + (CDR X) + EXPR T] - (* ;; "samples:") + (* ;; "samples:") - (* ;; " USE A B C D FOR X Y means substitute A for X and B for Y and then do it again with C for X and D for Y") + (* ;; " USE A B C D FOR X Y means substitute A for X and B for Y and then do it again with C for X and D for Y") - (* ;; " Equivalent to USE A C FOR X AND B D FOR Y") + (* ;; + " Equivalent to USE A C FOR X AND B D FOR Y") - (* ;; " USE A B C FOR D AND X Y Z FOR W means 3 operations:") + (* ;; + " USE A B C FOR D AND X Y Z FOR W means 3 operations:") - (* ;; " A for D and X for W in the first") + (* ;; + " A for D and X for W in the first") - (* ;; " B for D and Y for W in the second") + (* ;; + " B for D and Y for W in the second") - (* ;; " C for D and Z for W in the third") + (* ;; + " C for D and Z for W in the third") - (* ;; "USE A B C FOR D AND X FOR Y means 3 operations:") + (* ;; + "USE A B C FOR D AND X FOR Y means 3 operations:") - (* ;; " A for D and X for Y in first") + (* ;; " A for D and X for Y in first") - (* ;; " B for D and X for Y in second, etc.") + (* ;; + " B for D and X for Y in second, etc.") - (* ;; "USE A B C FOR D AND X Y FOR Z causes error") + (* ;; + "USE A B C FOR D AND X Y FOR Z causes error") - (* ;; "") + (* ;; "") - (* ;; " USE A B FOR B A will work correctly, but USE A FOR B AND B FOR A will result in all B's being changed to A's.") + (* ;; " USE A B FOR B A will work correctly, but USE A FOR B AND B FOR A will result in all B's being changed to A's.") - (* ;; "") + (* ;; "") - (* ;; "The general rule is substitution proceeds from left to right with each %%'AND' handled separately. Whenever the number of variables exceeds the number of expressions available, the expressions multiply.") + (* ;; "The general rule is substitution proceeds from left to right with each %%'AND' handled separately. Whenever the number of variables exceeds the number of expressions available, the expressions multiply.") - )) + )) (RETURN (COND [(CDR EXPR) (CONS 'DO-EVENTS (for X in EXPR collect (COND - ((CDR X) - (CONS 'EVENT X)) - (T (CAR X] + ((CDR X) + (CONS 'EVENT X)) + (T (CAR X] (T (CAR EXPR]) (DEFCOMMAND "PP" (&OPTIONAL (NAME LASTWORD) @@ -1714,25 +1707,22 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (* ;; "returned from if no definitions found") (for TYPE in [OR TYPES [TYPESOF NAME NIL NIL '? (FUNCTION (LAMBDA (TYPE) - (NEQ (GET TYPE - 'EDITDEF) - 'NILL] - (TYPESOF [SETQ NAME (OR (FIXSPELL NAME NIL USERWORDS NIL NIL - [FUNCTION (LAMBDA (WORD) - (TYPESOF - WORD NIL - '(FIELDS FILES) - 'CURRENT] - NIL NIL NIL 'MUSTAPPROVE) - (PROGN (CL:FORMAT *TERMINAL-IO* - "No definitions found for ~S." - NAME) - (RETURN NIL] - NIL NIL '? (FUNCTION (LAMBDA (TYPE) - (NEQ (GET TYPE 'EDITDEF) - 'NILL] + (NEQ (GET TYPE 'EDITDEF) + 'NILL] + (TYPESOF [SETQ NAME (OR (FIXSPELL NAME NIL USERWORDS NIL NIL + [FUNCTION (LAMBDA (WORD) + (TYPESOF WORD NIL + '(FIELDS FILES) + 'CURRENT] + NIL NIL NIL 'MUSTAPPROVE) + (PROGN (CL:FORMAT *TERMINAL-IO* + "No definitions found for ~S." NAME) + (RETURN NIL] + NIL NIL '? (FUNCTION (LAMBDA (TYPE) + (NEQ (GET TYPE 'EDITDEF) + 'NILL] do (CL:FORMAT *TERMINAL-IO* "~A definition for ~S:~%%" TYPE NAME) - (SHOWDEF NAME TYPE))) + (SHOWDEF NAME TYPE))) (CL:VALUES)) @@ -1740,7 +1730,7 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (* ;; "Arrange to use the correct compiler") -(PUTPROPS CMLEXEC FILETYPE CL:COMPILE-FILE) +(PUTPROPS CMLEXEC FILETYPE :FAKE-COMPILE-FILE) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA DIR) @@ -1751,22 +1741,22 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. ) (PUTPROPS CMLEXEC COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991 1993 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3978 4383 (XCL::EXEC-CLOSEFN 3978 . 4383)) (4385 4721 (XCL::EXEC-SHRINKFN 4385 . 4721)) - (4723 4963 (XCL::SETUP-EXEC-WINDOW 4723 . 4963)) (4965 5211 (XCL::EXEC-TITLE-FUNCTION 4965 . 5211)) ( -5213 8519 (FIX-FORM 5213 . 8519)) (8521 8641 (XCL::GET-PROCESS-PROFILE 8521 . 8641)) (8643 8924 ( -XCL::SAVE-CURRENT-EXEC-PROFILE 8643 . 8924)) (8926 9216 (XCL::SETF-GET-PROCESS-PROFILE 8926 . 9216)) ( -9218 9785 (XCL:SET-EXEC-TYPE 9218 . 9785)) (9787 9869 (XCL:SET-DEFAULT-EXEC-TYPE 9787 . 9869)) (9871 -10282 (XCL::ENTER-EXEC-FUNCTION 9871 . 10282)) (10357 16750 (DO-EVENT 10357 . 16750)) (16752 23543 ( -EXEC 16752 . 23543)) (23545 24886 (EXEC-EVAL 23545 . 24886)) (24888 25619 (PRINT-ALL-DOCUMENTATION -24888 . 25619)) (25621 26063 (PRINT-DOCUMENTATION 25621 . 26063)) (26146 27230 (ADD-EXEC 26146 . 27230 -)) (27232 30828 (EXEC-READ-LINE 27232 . 30828)) (30899 31385 (FIND-EXEC-COMMAND 30899 . 31385)) (31387 - 33285 (CIRCLAR-COPYER 31387 . 33285)) (33286 34240 (COPY-CIRCLE 33296 . 34238)) (34318 37623 ( -EXEC-READ 34328 . 37489) (DIR 37491 . 37621)) (39885 67019 (DO-APPLY-EVENT 39895 . 40457) ( -DO-HISTORY-SEARCH 40459 . 41916) (EVAL-INPUT 41918 . 47347) (EVENTS-INPUT 47349 . 48727) (EXEC-PRIN1 -48729 . 48905) (EXEC-VALUE-OF 48907 . 49246) (GET-NEXT-HISTORY-EVENT 49248 . 50743) ( -HISTORY-ADD-TO-SPELLING-LISTS 50745 . 51733) (HISTORY-NTH 51735 . 52485) (PRINT-HISTORY 52487 . 53108) - (FIND-HISTORY-EVENTS 53110 . 58171) (PRINT-EVENT 58173 . 62394) (PRINT-EVENT-PROMPT 62396 . 63600) ( -PROCESS-EXEC-ID 63602 . 64547) (SEARCH-FOR-EVENT-NUMBER 64549 . 65177) (\PICK.EVALQT 65179 . 65690) ( -LISPXREPRINT 65692 . 67017)) (68199 68298 (EXEC-PRINT 68199 . 68298)) (68300 68565 (EXEC-FORMAT 68300 - . 68565))))) + (FILEMAP (NIL (4002 4407 (XCL::EXEC-CLOSEFN 4002 . 4407)) (4409 4745 (XCL::EXEC-SHRINKFN 4409 . 4745)) + (4747 4987 (XCL::SETUP-EXEC-WINDOW 4747 . 4987)) (4989 5235 (XCL::EXEC-TITLE-FUNCTION 4989 . 5235)) ( +5237 8404 (FIX-FORM 5237 . 8404)) (8406 8526 (XCL::GET-PROCESS-PROFILE 8406 . 8526)) (8528 8809 ( +XCL::SAVE-CURRENT-EXEC-PROFILE 8528 . 8809)) (8811 9097 (XCL::SETF-GET-PROCESS-PROFILE 8811 . 9097)) ( +9099 9666 (XCL:SET-EXEC-TYPE 9099 . 9666)) (9668 9750 (XCL:SET-DEFAULT-EXEC-TYPE 9668 . 9750)) (9752 +10159 (XCL::ENTER-EXEC-FUNCTION 9752 . 10159)) (10234 16465 (DO-EVENT 10234 . 16465)) (16467 23064 ( +EXEC 16467 . 23064)) (23066 24317 (EXEC-EVAL 23066 . 24317)) (24319 25050 (PRINT-ALL-DOCUMENTATION +24319 . 25050)) (25052 25494 (PRINT-DOCUMENTATION 25052 . 25494)) (25577 26652 (ADD-EXEC 25577 . 26652 +)) (26654 30264 (EXEC-READ-LINE 26654 . 30264)) (30335 30821 (FIND-EXEC-COMMAND 30335 . 30821)) (30823 + 32709 (CIRCLAR-COPYER 30823 . 32709)) (32710 33664 (COPY-CIRCLE 32720 . 33662)) (33742 37047 ( +EXEC-READ 33752 . 36913) (DIR 36915 . 37045)) (39301 66435 (DO-APPLY-EVENT 39311 . 39873) ( +DO-HISTORY-SEARCH 39875 . 41332) (EVAL-INPUT 41334 . 46763) (EVENTS-INPUT 46765 . 48143) (EXEC-PRIN1 +48145 . 48321) (EXEC-VALUE-OF 48323 . 48662) (GET-NEXT-HISTORY-EVENT 48664 . 50159) ( +HISTORY-ADD-TO-SPELLING-LISTS 50161 . 51149) (HISTORY-NTH 51151 . 51901) (PRINT-HISTORY 51903 . 52524) + (FIND-HISTORY-EVENTS 52526 . 57587) (PRINT-EVENT 57589 . 61810) (PRINT-EVENT-PROMPT 61812 . 63016) ( +PROCESS-EXEC-ID 63018 . 63963) (SEARCH-FOR-EVENT-NUMBER 63965 . 64593) (\PICK.EVALQT 64595 . 65106) ( +LISPXREPRINT 65108 . 66433)) (67615 67714 (EXEC-PRINT 67615 . 67714)) (67716 67981 (EXEC-FORMAT 67716 + . 67981))))) STOP diff --git a/sources/CMLEXEC.LCOM b/sources/CMLEXEC.LCOM index 7e909f983f92d093bdc52c3c13e23db88ab30b67..cac3ebca18193d30d6abbe03cf16a04b41c6337e 100644 GIT binary patch delta 1241 zcmaJ>O>fjj7+&utIjmZViVF23hZiTJ*%gjFGyZNxuy)7T)Vp>(_HNQsPT)aU#6idv4_^Zru6zTsmxUor$1g80%P_d~{c!NVJeJ(3FD(=Vt%SQN zZ)4PdL{eLZ8{>u5x5w9 z3O@e)`b|Hm7x09CqOxQf5Vix)L&Js+ejrkjCMrz+-fBvxnQ21|2DmD-R784#OcRk- zB5Tqb{ZXqiOPjp-?$QixbI;Af)Qh?)ct9w`NzhHB?DZE0JvYpF5zqkXetjmtxjmZQ zDAeS0J1f$u+}pW@?jP+ep8RJZz0~=jT03~|PR#yC`G-GP`;0=-1WLh8K%*M8MZ6YA zB1nU%3mP%NOStgEpv!^Tv{)_`vBGPBu?a7A0Yk@c>}9$MDNk?}n5IqBF!L47J}^S2 z6)=^6h}{+!KyA!YDT|tKsHBDpthSxlm2 zy$L2@1>-Em76EE$AU9;7I*#M(V*%rz$7gWPa1H=tA>&1}aBa>-q}lmTdsnbQ^vUBr z^#`j}v52@PaiFbG-hz`zQu|U>=9N_|J)BS5;L8Shp3> z4d`Sdb>ldRdK@%sI)=hKShY;>q#q@1k(0xZB{T0F&R0z}-#UCU=XmbtT*>?Qw*Li7 Ct3=!Y delta 1247 zcmaJ=OK;Oy6t0tY6A1wVp=v17!L&>h$&v5FPb!L)T#r3+V#{_Cs#%pLg@`_&FAAec zVTHsB>II8g&w>RKny6()8fkt2@IzQ4QL%(;cdEJ?2`}zF=iYPA`Mz^LAABmj|5SM1 zIS;zzFKkFy#t4vXD#)bx#a(shc7H=!?sb=X53jGUZmuo#*00wZ9=pkE)oZv6V*Z^h zn^-XwDnd!D`HjH!m}K*%D?)z-M7!mAkdLoct0HvgH+tRw=TS`=iRF?wohGP-%!*n4 zWYi%_q9m3u<$M<=lnhK&3isA}Tm99|^{nQU2_i<)&+{viK>#5Wr6rRO!qrRPONNH0 z3)`2ARHn(ZE1$Fd$>dMzK72R%r&Xkg4j(W6ICc(fpy0Ss9L1qrhLOgoki5P-I}tk* zb1xmYG{V0#&Y6*E4TD#AZM$5W9*!?ngv%7m5P%AnO!+VZP*Mx&+@hIf3>TK)6pIuq z!wdK4M{gVz;S~{vw&k^$?Kk7pB~WL!)$-z_0}4UtHeb?FO4OyHkS*X3(3W; zS>cD|m#yE0iR8=H$+blL66<^g63gGyV?&mq0HWfPZ;3)7W+A@?LQy^qp+{+UfXI3t0XB4q z0;|R%z`B+ZM1a*3D6yhJ%`@~*jE6l8q|G>wOKQccq5^bj?xe3Dxd)$QP7IH zC^#tuVp#;N@O|*>AcDbfgR9&p+y{U`Bm&YEerIumsvyqr-|b%V$HQA(B1c7JaHDV*6`ei1^|w>lYrA*4w^LbW%c-%{+_T&}?WDgyE&P-0 z?wbVjRy%%&tBPw)&Nb1{Af5|Yw;zif JK=Syn&2O9kaplan>Local>medley3.5>my-medley>sources>FILEIO.;102 160392 +(FILECREATED "19-Dec-2021 09:31:06" {DSK}kaplan>Local>medley3.5>my-medley>sources>FILEIO.;103 160528 - :CHANGES-TO (FNS \DO.PARAMS.AT.OPEN) + :CHANGES-TO (FNS \DO.PARAMS.AT.OPEN SETFILEINFO) - :PREVIOUS-DATE "13-Dec-2021 15:20:15" -{DSK}kaplan>Local>medley3.5>my-medley>sources>FILEIO.;101) + :PREVIOUS-DATE "14-Dec-2021 16:10:18" +{DSK}kaplan>Local>medley3.5>my-medley>sources>FILEIO.;102) (* ; " @@ -1412,7 +1412,8 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. (GO RETRY]) (\DO.PARAMS.AT.OPEN - [LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 14-Dec-2021 16:10 by rmk") + [LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 19-Dec-2021 09:30 by rmk") + (* ; "Edited 14-Dec-2021 16:10 by rmk") (* ; "Edited 13-Dec-2021 15:20 by rmk") (* ; "Edited 29-Jun-2021 17:07 by rmk:") (* ; "Edited 5-Oct-92 13:45 by jds") @@ -1426,33 +1427,22 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. (DECLARE (USEDFREE STREAM-AFTER-OPEN-FNS)) (\EXTERNALFORMAT STREAM :DEFAULT) - (for X ATTR VAL in PARAMETERS - do (COND - [(LISTP X) - (SETQ ATTR (CAR X)) - (SETQ VAL (CAR (LISTP (CDR X] - (T (SETQ ATTR X) - (SETQ VAL T))) - (SELECTQ ATTR - (BUFFERS (SETFILEINFO STREAM 'BUFFERS VAL)) - (ENDOFSTREAMOP (SETFILEINFO STREAM 'ENDOFSTREAMOP VAL)) - (CHARSET (CHARSET STREAM VAL)) - ((FORMAT EXTERNALFORMAT) - (\EXTERNALFORMAT STREAM VAL)) - (CONVHANKAKU (CONVHANKAKU STREAM VAL)) - ((EOL EOLCONVENTION EOLC) - (replace EOLCONVENTION of STREAM with (SELECTQ VAL - (CR CR.EOLC) - (LF LF.EOLC) - (CRLF CRLF.EOLC) - (ANY (CL:WHEN (\GETSTREAM STREAM - 'OUTPUT T) - (ERROR - "EOL convention ANY not allowed for output streams" - STREAM)) - ANY.EOLC) - (\ILLEGAL.ARG VAL)))) - NIL)) + (for X ATTR VAL in PARAMETERS do (COND + [(LISTP X) + (SETQ ATTR (CAR X)) + (SETQ VAL (CAR (LISTP (CDR X] + (T (SETQ ATTR X) + (SETQ VAL T))) + (SELECTQ ATTR + (BUFFERS (SETFILEINFO STREAM 'BUFFERS VAL)) + (ENDOFSTREAMOP (SETFILEINFO STREAM 'ENDOFSTREAMOP VAL)) + (CHARSET (CHARSET STREAM VAL)) + ((FORMAT EXTERNALFORMAT) + (\EXTERNALFORMAT STREAM VAL)) + (CONVHANKAKU (CONVHANKAKU STREAM VAL)) + ((EOL EOLCONVENTION EOLC) + (SETFILEINFO STREAM 'EOL VAL)) + NIL)) (FOR FN IN STREAM-AFTER-OPEN-FNS DO (APPLY* FN STREAM ACCESS PARAMETERS]) (\RENAMEFILE @@ -2433,26 +2423,32 @@ update the map") STREAM]) (SETFILEINFO - [LAMBDA (FILE ATTRIB VALUE) (* ; "Edited 29-Jun-2021 17:05 by rmk:") - (* ; "Edited 11-Dec-95 11:08 by ") - (* ; "Edited 27-Mar-89 15:33 by bvm") + [LAMBDA (FILE ATTRIB VALUE) (* ; "Edited 19-Dec-2021 09:30 by rmk") + (* ; "Edited 29-Jun-2021 17:05 by rmk:") + (* ; "Edited 11-Dec-95 11:08 by ") + (* ; "Edited 27-Mar-89 15:33 by bvm") (LET (FULLNAME DEV) (COND - [(type? STREAM FILE) (* ; - "FILE is open, so strip off attributes that can be set from the stream.") + [(type? STREAM FILE) (* ; + "FILE is open, so strip off attributes that can be set from the stream.") (SELECTQ ATTRIB - ((ACCESS BYTESIZE OPENBYTESIZE) (* ; - "These can't be changed for an open file") + ((ACCESS BYTESIZE OPENBYTESIZE) (* ; + "These can't be changed for an open file") NIL) (EOL (replace EOLCONVENTION of FILE with (SELECTQ VALUE - (CR CR.EOLC) - (CRLF CRLF.EOLC) - (LF LF.EOLC) - (ANY ANY.EOLC) - (\ILLEGAL.ARG VALUE))) + (CR CR.EOLC) + (CRLF CRLF.EOLC) + (LF LF.EOLC) + (ANY (CL:WHEN (\GETSTREAM FILE + 'OUTPUT T) + (ERROR + "EOL convention ANY is not allowed for output streams" + FILE)) + ANY.EOLC) + (\ILLEGAL.ARG VALUE))) VALUE) ((FORMAT EXTERNALFORMAT) - (\EXTERNALFORMAT FILE VALUE) + (\EXTERNALFORMAT FILE VALUE) VALUE) (ENDOFSTREAMOP (replace ENDOFSTREAMOP of FILE with VALUE)) (BUFFERS (replace MAXBUFFERS of FILE with (IMAX 1 (FIX VALUE)))) @@ -2461,18 +2457,18 @@ update the map") FILE ATTRIB VALUE DEV) (SELECTQ ATTRIB (LENGTH - (* ;; "Let device at this attribute first. Probably should not have this generic op, since we don't know how to do this for all devices") + (* ;; "Let device at this attribute first. Probably should not have this generic op, since we don't know how to do this for all devices") [\SETEOFPTR FILE (COND - ((type? BYTEPTR VALUE) - VALUE) - (T (\ILLEGAL.ARG VALUE]) + ((type? BYTEPTR VALUE) + VALUE) + (T (\ILLEGAL.ARG VALUE]) (SIZE (\SETEOFPTR FILE (UNFOLD VALUE BYTESPERPAGE))) NIL] - [(AND [SETQ DEV (\GETDEVICEFROMNAME (SETQ FULLNAME (\ADD.CONNECTED.DIR - (\CONVERT-PATHNAME FILE] + [(AND [SETQ DEV (\GETDEVICEFROMNAME (SETQ FULLNAME (\ADD.CONNECTED.DIR (\CONVERT-PATHNAME + FILE] (SETQ FULLNAME (FDEVOP 'GETFILENAME DEV FULLNAME 'OLD DEV))) - (* ; "Name of existing file. It's possible we should have the device do recognition instead, but then we have the confusion of file not found recovery in the wrong place.") + (* ; "Name of existing file. It's possible we should have the device do recognition instead, but then we have the confusion of file not found recovery in the wrong place.") (SELECTQ ATTRIB ((ACCESS OPENBYTESIZE EOLCONVENTION) NIL) @@ -2480,9 +2476,9 @@ update the map") (COND ((EQ ATTRIB 'LENGTH) (\SETCLOSEDFILELENGTH FULLNAME (COND - ((type? BYTEPTR VALUE) - VALUE) - (T (\ILLEGAL.ARG VALUE] + ((type? BYTEPTR VALUE) + VALUE) + (T (\ILLEGAL.ARG VALUE] (T (LISPERROR "FILE NOT FOUND" FILE]) (SETFILEPTR @@ -3093,40 +3089,40 @@ update the map") (PUTPROPS FILEIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1999 2020 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (26864 30342 (STREAMPROP 26874 . 27308) (GETSTREAMPROP 27310 . 27779) (PUTSTREAMPROP -27781 . 30190) (STREAMP 30192 . 30340)) (30385 32904 (\DEFPRINT.BY.NAME 30395 . 31547) ( -\STREAM.DEFPRINT 31549 . 32597) (\FDEV.DEFPRINT 32599 . 32902)) (33162 38203 (\GETACCESS 33172 . 33626 -) (\SETACCESS 33628 . 38201)) (58356 64325 (\DEFINEDEVICE 58366 . 60682) (\GETDEVICEFROMNAME 60684 . -61157) (\GETDEVICEFROMHOSTNAME 61159 . 62203) (\REMOVEDEVICE 62205 . 63328) (\REMOVEDEVICE.NAMES 63330 - . 64323)) (64365 89011 (\CLOSEFILE 64375 . 65200) (\DELETEFILE 65202 . 65496) (\DEVICEEVENT 65498 . -67268) (\GENERATEFILES 67270 . 67748) (\GENERATENEXTFILE 67750 . 68401) (\GENERATEFILEINFO 68403 . -68864) (\GETFILENAME 68866 . 69255) (\GENERIC.OUTFILEP 69257 . 69727) (\OPENFILE 69729 . 72307) ( -\DO.PARAMS.AT.OPEN 72309 . 74848) (\RENAMEFILE 74850 . 75274) (\REVALIDATEFILE 75276 . 77878) ( -\PAGED.REVALIDATEFILELST 77880 . 79438) (\PAGED.REVALIDATEFILES 79440 . 81159) (\PAGED.REVALIDATEFILE -81161 . 83444) (\BUFFERED.REVALIDATEFILE 83446 . 85732) (\BUFFERED.REVALIDATEFILELST 85734 . 86918) ( -\PRINT-REVALIDATION-RESULT 86920 . 87335) (\TRUNCATEFILE 87337 . 87728) (\FILE-CONFLICT 87730 . 89009) -) (89047 93710 (\GENERATENOFILES 89057 . 91153) (\NULLFILEGENERATOR 91155 . 91399) (\NOFILESNEXTFILEFN - 91401 . 93392) (\NOFILESINFOFN 93394 . 93708)) (93829 95737 (\FILE.NOT.OPEN 93839 . 94352) ( -\FILE.WONT.OPEN 94354 . 94682) (\ILLEGAL.DEVICEOP 94684 . 94966) (\IS.NOT.RANDACCESSP 94968 . 95414) ( -\STREAM.NOT.OPEN 95416 . 95735)) (95872 98170 (\FDEVINSTANCE 95882 . 98168)) (99372 106746 (CNDIR -99382 . 100687) (DIRECTORYNAME 100689 . 104872) (DIRECTORYNAMEP 104874 . 105490) (HOSTNAMEP 105492 . -106299) (\ADD.CONNECTED.DIR 106301 . 106744)) (106791 134178 (\BACKFILEPTR 106801 . 106989) ( -\BACKPEEKBIN 106991 . 107352) (\BACKBIN 107354 . 107705) (BIN 107707 . 107924) (\BIN 107926 . 108203) -(\BINS 108205 . 108491) (BOUT 108493 . 108855) (\BOUT 108857 . 109172) (\BOUTS 109174 . 109485) ( -COPYBYTES 109487 . 112819) (COPYCHARS 112821 . 116487) (COPYFILE 116489 . 117286) (\COPYOPENFILE -117288 . 120361) (\INFER.FILE.TYPE 120363 . 121317) (EOFP 121319 . 121616) (FORCEOUTPUT 121618 . -121865) (\FLUSH.OPEN.STREAMS 121867 . 122223) (CHARSET 122225 . 123889) (ACCESS-CHARSET 123891 . -124108) (GETEOFPTR 124110 . 124360) (GETFILEINFO 124362 . 127555) (\TYPE.FROM.FILETYPE 127557 . 128027 -) (\FILETYPE.FROM.TYPE 128029 . 128208) (GETFILEPTR 128210 . 128462) (SETFILEINFO 128464 . 132077) ( -SETFILEPTR 132079 . 133798) (BOUT16 133800 . 133985) (BIN16 133987 . 134176)) (134281 139486 ( -\GENERIC.BINS 134291 . 134571) (\GENERIC.BOUTS 134573 . 134838) (\GENERIC.RENAMEFILE 134840 . 136671) -(\GENERIC.OPENP 136673 . 137988) (\GENERIC.READP 137990 . 139031) (\GENERIC.CHARSET 139033 . 139484)) -(139487 139826 (\MAP-OPEN-STREAMS 139497 . 139824)) (141610 143690 (\EOF.ACTION 141620 . 141871) ( -\EOSERROR 141873 . 142066) (\GETEOFPTR 142068 . 142250) (\INCFILEPTR 142252 . 142602) (\PEEKBIN 142604 - . 142795) (\SETCLOSEDFILELENGTH 142797 . 143131) (\SETEOFPTR 143133 . 143321) (\SETFILEPTR 143323 . -143688)) (143691 144233 (\FIXPOUT 143701 . 144001) (\FIXPIN 144003 . 144231)) (144234 144800 (\BOUTEOL - 144244 . 144798)) (147696 157560 (\BUFFERED.BIN 147706 . 148558) (\BUFFERED.PEEKBIN 148560 . 149342) -(\BUFFERED.BOUT 149344 . 150204) (\BUFFERED.BINS 150206 . 153891) (\BUFFERED.BOUTS 153893 . 155694) ( -\BUFFERED.COPYBYTES 155696 . 157558)) (157589 159941 (\NULLDEVICE 157599 . 159617) (\NULL.OPENFILE -159619 . 159939))))) + (FILEMAP (NIL (26876 30354 (STREAMPROP 26886 . 27320) (GETSTREAMPROP 27322 . 27791) (PUTSTREAMPROP +27793 . 30202) (STREAMP 30204 . 30352)) (30397 32916 (\DEFPRINT.BY.NAME 30407 . 31559) ( +\STREAM.DEFPRINT 31561 . 32609) (\FDEV.DEFPRINT 32611 . 32914)) (33174 38215 (\GETACCESS 33184 . 33638 +) (\SETACCESS 33640 . 38213)) (58368 64337 (\DEFINEDEVICE 58378 . 60694) (\GETDEVICEFROMNAME 60696 . +61169) (\GETDEVICEFROMHOSTNAME 61171 . 62215) (\REMOVEDEVICE 62217 . 63340) (\REMOVEDEVICE.NAMES 63342 + . 64335)) (64377 88654 (\CLOSEFILE 64387 . 65212) (\DELETEFILE 65214 . 65508) (\DEVICEEVENT 65510 . +67280) (\GENERATEFILES 67282 . 67760) (\GENERATENEXTFILE 67762 . 68413) (\GENERATEFILEINFO 68415 . +68876) (\GETFILENAME 68878 . 69267) (\GENERIC.OUTFILEP 69269 . 69739) (\OPENFILE 69741 . 72319) ( +\DO.PARAMS.AT.OPEN 72321 . 74491) (\RENAMEFILE 74493 . 74917) (\REVALIDATEFILE 74919 . 77521) ( +\PAGED.REVALIDATEFILELST 77523 . 79081) (\PAGED.REVALIDATEFILES 79083 . 80802) (\PAGED.REVALIDATEFILE +80804 . 83087) (\BUFFERED.REVALIDATEFILE 83089 . 85375) (\BUFFERED.REVALIDATEFILELST 85377 . 86561) ( +\PRINT-REVALIDATION-RESULT 86563 . 86978) (\TRUNCATEFILE 86980 . 87371) (\FILE-CONFLICT 87373 . 88652) +) (88690 93353 (\GENERATENOFILES 88700 . 90796) (\NULLFILEGENERATOR 90798 . 91042) (\NOFILESNEXTFILEFN + 91044 . 93035) (\NOFILESINFOFN 93037 . 93351)) (93472 95380 (\FILE.NOT.OPEN 93482 . 93995) ( +\FILE.WONT.OPEN 93997 . 94325) (\ILLEGAL.DEVICEOP 94327 . 94609) (\IS.NOT.RANDACCESSP 94611 . 95057) ( +\STREAM.NOT.OPEN 95059 . 95378)) (95515 97813 (\FDEVINSTANCE 95525 . 97811)) (99015 106389 (CNDIR +99025 . 100330) (DIRECTORYNAME 100332 . 104515) (DIRECTORYNAMEP 104517 . 105133) (HOSTNAMEP 105135 . +105942) (\ADD.CONNECTED.DIR 105944 . 106387)) (106434 134314 (\BACKFILEPTR 106444 . 106632) ( +\BACKPEEKBIN 106634 . 106995) (\BACKBIN 106997 . 107348) (BIN 107350 . 107567) (\BIN 107569 . 107846) +(\BINS 107848 . 108134) (BOUT 108136 . 108498) (\BOUT 108500 . 108815) (\BOUTS 108817 . 109128) ( +COPYBYTES 109130 . 112462) (COPYCHARS 112464 . 116130) (COPYFILE 116132 . 116929) (\COPYOPENFILE +116931 . 120004) (\INFER.FILE.TYPE 120006 . 120960) (EOFP 120962 . 121259) (FORCEOUTPUT 121261 . +121508) (\FLUSH.OPEN.STREAMS 121510 . 121866) (CHARSET 121868 . 123532) (ACCESS-CHARSET 123534 . +123751) (GETEOFPTR 123753 . 124003) (GETFILEINFO 124005 . 127198) (\TYPE.FROM.FILETYPE 127200 . 127670 +) (\FILETYPE.FROM.TYPE 127672 . 127851) (GETFILEPTR 127853 . 128105) (SETFILEINFO 128107 . 132213) ( +SETFILEPTR 132215 . 133934) (BOUT16 133936 . 134121) (BIN16 134123 . 134312)) (134417 139622 ( +\GENERIC.BINS 134427 . 134707) (\GENERIC.BOUTS 134709 . 134974) (\GENERIC.RENAMEFILE 134976 . 136807) +(\GENERIC.OPENP 136809 . 138124) (\GENERIC.READP 138126 . 139167) (\GENERIC.CHARSET 139169 . 139620)) +(139623 139962 (\MAP-OPEN-STREAMS 139633 . 139960)) (141746 143826 (\EOF.ACTION 141756 . 142007) ( +\EOSERROR 142009 . 142202) (\GETEOFPTR 142204 . 142386) (\INCFILEPTR 142388 . 142738) (\PEEKBIN 142740 + . 142931) (\SETCLOSEDFILELENGTH 142933 . 143267) (\SETEOFPTR 143269 . 143457) (\SETFILEPTR 143459 . +143824)) (143827 144369 (\FIXPOUT 143837 . 144137) (\FIXPIN 144139 . 144367)) (144370 144936 (\BOUTEOL + 144380 . 144934)) (147832 157696 (\BUFFERED.BIN 147842 . 148694) (\BUFFERED.PEEKBIN 148696 . 149478) +(\BUFFERED.BOUT 149480 . 150340) (\BUFFERED.BINS 150342 . 154027) (\BUFFERED.BOUTS 154029 . 155830) ( +\BUFFERED.COPYBYTES 155832 . 157694)) (157725 160077 (\NULLDEVICE 157735 . 159753) (\NULL.OPENFILE +159755 . 160075))))) STOP diff --git a/sources/FILEIO.LCOM b/sources/FILEIO.LCOM index 826ac790df55895c71c0c2dca03f3e3bc72ba04c..422549371b53a6834c8083fa09d1c0a1bd4f5bd4 100644 GIT binary patch delta 262 zcmccdnCbRorU?8Zu4RtkCfB^jA{=?a;73QBIFK0XS_y7lz*loV1DOMqIi znQEb=$)(}u>Er4gY|_|W{AaIN(z%dFxqn(D{vW_8JHSbOkT{WVx$o48UoVl w>F4IJsbCcl$sK#jgjO`t&EI-NJ$~7 zC^b1hw;(eoHAR6dwW6S?Sk+1)#>HPRz%j_tH(1XxM9)9K)lVTaPeI8o)W=7`(0DQ< zqqqg8VHQf7TpDhkKCaF|u8twDElde>lispcore>sources>WINDOWOBJ.;3 27891 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (RECORDS IMAGEOBJ IMAGEFNS IMAGEBOX) +(FILECREATED "20-Dec-2021 23:47:45" {DSK}kaplan>Local>medley3.5>my-medley>sources>WINDOWOBJ.;5 27781 - previous date%: " 5-Jan-93 09:53:15" {DSK}lde>lispcore>sources>WINDOWOBJ.;2) + :CHANGES-TO (FNS COPYINSERT) + + :PREVIOUS-DATE "18-Dec-2021 20:09:33" +{DSK}kaplan>Local>medley3.5>my-medley>sources>WINDOWOBJ.;3) (* ; " -Copyright (c) 1986, 1987, 1990, 1991, 1993 by Venue & Xerox Corporation. All rights reserved. +Copyright (c) 1986-1987, 1990-1991, 1993 by Venue & Xerox Corporation. ") (PRETTYCOMPRINT WINDOWOBJCOMS) -(RPAQQ WINDOWOBJCOMS [(COMS (* ; - "Image object support - here so that DEDIT can use it without needing TEDIT to be loaded.") - (RECORDS IMAGEOBJ IMAGEFNS IMAGEBOX) - (FNS COPYINSERT IMAGEBOX IMAGEFNSCREATE IMAGEFNSP IMAGEOBJCREATE - IMAGEOBJP IMAGEOBJPROP \IMAGEUSERPROP HPRINT.IMAGEOBJ - COPYIMAGEOBJ READIMAGEOBJ WRITEIMAGEOBJ) - (ADDVARS (HPRINTMACROS (IMAGEOBJ . WRITEIMAGEOBJ))) - (GLOBALVARS (IMAGEOBJTYPES NIL) - (IMAGEOBJGETFNS NIL))) - (COMS (* ; - "For encapsulating unknown-type IMAGEOBJs.") - (FNS ENCAPSULATEDOBJ.BUTTONEVENTINFN ENCAPSULATEDOBJ.PUTFN - ENCAPSULATEDOBJ.DISPLAYFN ENCAPSULATEDOBJ.IMAGEBOXFN - ENCAPSULATEDIMAGEFNS) - (INITVARS ENCAPSULATEDIMAGEFNS) - (GLOBALVARS ENCAPSULATEDIMAGEFNS)) - (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS - (ADDVARS (NLAMA) - (NLAML) - (LAMA IMAGEOBJPROP]) +(RPAQQ WINDOWOBJCOMS + [(COMS (* ; + "Image object support - here so that DEDIT can use it without needing TEDIT to be loaded.") + (RECORDS IMAGEOBJ IMAGEFNS IMAGEBOX) + (FNS COPYINSERT IMAGEBOX IMAGEFNSCREATE IMAGEFNSP IMAGEOBJCREATE IMAGEOBJP IMAGEOBJPROP + \IMAGEUSERPROP HPRINT.IMAGEOBJ COPYIMAGEOBJ READIMAGEOBJ WRITEIMAGEOBJ) + (ADDVARS (HPRINTMACROS (IMAGEOBJ . WRITEIMAGEOBJ))) + (GLOBALVARS (IMAGEOBJTYPES NIL) + (IMAGEOBJGETFNS NIL))) + (COMS (* ; + "For encapsulating unknown-type IMAGEOBJs.") + (FNS ENCAPSULATEDOBJ.BUTTONEVENTINFN ENCAPSULATEDOBJ.PUTFN ENCAPSULATEDOBJ.DISPLAYFN + ENCAPSULATEDOBJ.IMAGEBOXFN ENCAPSULATEDIMAGEFNS) + (INITVARS ENCAPSULATEDIMAGEFNS) + (GLOBALVARS ENCAPSULATEDIMAGEFNS)) + (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) + (NLAML) + (LAMA IMAGEOBJPROP]) @@ -40,35 +40,35 @@ Copyright (c) 1986, 1987, 1990, 1991, 1993 by Venue & Xerox Corporation. All ri (DECLARE%: EVAL@COMPILE (DATATYPE IMAGEOBJ (OBJECTDATUM IMAGEOBJPLIST IMAGEOBJFNS) - (SYSTEM)) + (SYSTEM)) -(DATATYPE IMAGEFNS (DISPLAYFN (* ; - "FN called to display the object's image") - IMAGEBOXFN (* ; "To tell how big it is") - PUTFN (* ; "To write it onto a file") - GETFN (* ; "To read it back from the file") - COPYFN (* ; "To make a copy of the object") - BUTTONEVENTINFN (* ; - "Called when the mouse goes down over the object") - COPYBUTTONEVENTINFN (* ; - "Called when the MIDDLE mouse button goes down over the object") - WHENMOVEDFN (* ; - "Called when the object is moved within a document or other environment") - WHENINSERTEDFN (* ; - "Called when the object is inserted into a context") - WHENDELETEDFN (* ; - "Called when the object is removed from a context") - WHENCOPIEDFN (* ; - "Called when the object is copied within a context") - WHENOPERATEDONFN (* ; - "Called when something interesting happens to the object") - PREPRINTFN IMAGECLASSNAME (* ; - "LITATOM unique name by which this kind of IMAGEOBJ is to be known to the world.") - ) - (SYSTEM)) +(DATATYPE IMAGEFNS (DISPLAYFN (* ; + "FN called to display the object's image") + IMAGEBOXFN (* ; "To tell how big it is") + PUTFN (* ; "To write it onto a file") + GETFN (* ; "To read it back from the file") + COPYFN (* ; "To make a copy of the object") + BUTTONEVENTINFN (* ; + "Called when the mouse goes down over the object") + COPYBUTTONEVENTINFN (* ; + "Called when the MIDDLE mouse button goes down over the object") + WHENMOVEDFN (* ; + "Called when the object is moved within a document or other environment") + WHENINSERTEDFN (* ; + "Called when the object is inserted into a context") + WHENDELETEDFN (* ; + "Called when the object is removed from a context") + WHENCOPIEDFN (* ; + "Called when the object is copied within a context") + WHENOPERATEDONFN (* ; + "Called when something interesting happens to the object") + PREPRINTFN IMAGECLASSNAME (* ; + "LITATOM unique name by which this kind of IMAGEOBJ is to be known to the world.") + ) + (SYSTEM)) (RECORD IMAGEBOX (XSIZE YSIZE YDESC XKERN) - (SYSTEM)) + (SYSTEM)) ) (/DECLAREDATATYPE 'IMAGEOBJ '(POINTER POINTER POINTER) @@ -98,7 +98,11 @@ Copyright (c) 1986, 1987, 1990, 1991, 1993 by Venue & Xerox Corporation. All ri (DEFINEQ (COPYINSERT - [LAMBDA (IMAGEOBJ) (* ; "Edited 17-Sep-90 13:19 by jds") + [LAMBDA (IMAGEOBJ) + + (* ;; "Edited 20-Dec-2021 23:47 by rmk: IMAGEOBJ can now also be a list of objects in the COPYINSERTFN case") + + (* ;; "Edited 17-Sep-90 13:19 by jds") (* ;;; "inserts IMAGEOBJ into the window that currently has the tty. If this window has a COPYINSERTFN property, that is called, otherwise BKSYSBUF is called.") @@ -106,22 +110,22 @@ Copyright (c) 1986, 1987, 1990, 1991, 1993 by Venue & Xerox Corporation. All ri INSERTFN) (COND ((SETQ INSERTFN (WINDOWPROP TTYW 'COPYINSERTFN)) - (APPLY* INSERTFN IMAGEOBJ TTYW)) + (for IMOBJ inside IMAGEOBJ do (APPLY* INSERTFN IMOBJ TTYW))) (T (* ; - "IMAGEOBJ can be a list of things too.") + "IMAGEOBJ can be a list of things too.") (for IMOBJ inside IMAGEOBJ do (BKSYSBUF (OR (COND - [(IMAGEOBJP IMOBJ) - (COND - ((SETQ INSERTFN (IMAGEOBJPROP IMOBJ 'PREPRINTFN)) - (APPLY* INSERTFN IMOBJ)) - (T (IMAGEOBJPROP IMOBJ 'OBJECTDATUM] - (T IMOBJ)) - "") - T - (PROCESS.EVAL (TTY.PROCESS) - '(GETREADTABLE) - T]) + [(IMAGEOBJP IMOBJ) + (COND + ((SETQ INSERTFN (IMAGEOBJPROP IMOBJ 'PREPRINTFN)) + (APPLY* INSERTFN IMOBJ)) + (T (IMAGEOBJPROP IMOBJ 'OBJECTDATUM] + (T IMOBJ)) + "") + T + (PROCESS.EVAL (TTY.PROCESS) + '(GETREADTABLE) + T]) (IMAGEBOX [LAMBDA (OBJ STREAM MODE) (* jds " 8-Feb-84 10:48") @@ -527,11 +531,11 @@ Either delete this image object or load its support files." IMAGEOBJ) ) (PUTPROPS WINDOWOBJ COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1991 1993)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5088 21106 (COPYINSERT 5098 . 6542) (IMAGEBOX 6544 . 6724) (IMAGEFNSCREATE 6726 . 7921) - (IMAGEFNSP 7923 . 8164) (IMAGEOBJCREATE 8166 . 8711) (IMAGEOBJP 8713 . 8954) (IMAGEOBJPROP 8956 . -14848) (\IMAGEUSERPROP 14850 . 15444) (HPRINT.IMAGEOBJ 15446 . 16035) (COPYIMAGEOBJ 16037 . 16780) ( -READIMAGEOBJ 16782 . 19752) (WRITEIMAGEOBJ 19754 . 21104)) (21320 27527 ( -ENCAPSULATEDOBJ.BUTTONEVENTINFN 21330 . 22466) (ENCAPSULATEDOBJ.PUTFN 22468 . 23583) ( -ENCAPSULATEDOBJ.DISPLAYFN 23585 . 25198) (ENCAPSULATEDOBJ.IMAGEBOXFN 25200 . 26088) ( -ENCAPSULATEDIMAGEFNS 26090 . 27525))))) + (FILEMAP (NIL (4895 20996 (COPYINSERT 4905 . 6432) (IMAGEBOX 6434 . 6614) (IMAGEFNSCREATE 6616 . 7811) + (IMAGEFNSP 7813 . 8054) (IMAGEOBJCREATE 8056 . 8601) (IMAGEOBJP 8603 . 8844) (IMAGEOBJPROP 8846 . +14738) (\IMAGEUSERPROP 14740 . 15334) (HPRINT.IMAGEOBJ 15336 . 15925) (COPYIMAGEOBJ 15927 . 16670) ( +READIMAGEOBJ 16672 . 19642) (WRITEIMAGEOBJ 19644 . 20994)) (21210 27417 ( +ENCAPSULATEDOBJ.BUTTONEVENTINFN 21220 . 22356) (ENCAPSULATEDOBJ.PUTFN 22358 . 23473) ( +ENCAPSULATEDOBJ.DISPLAYFN 23475 . 25088) (ENCAPSULATEDOBJ.IMAGEBOXFN 25090 . 25978) ( +ENCAPSULATEDIMAGEFNS 25980 . 27415))))) STOP diff --git a/sources/WINDOWOBJ.LCOM b/sources/WINDOWOBJ.LCOM index f6164d86f7087d94ab344a5d5288f484b1c5d2a8..353cf8d8c665f69f9a6ad41aa80e62a4a553b2a9 100644 GIT binary patch delta 1156 zcmb7?O>7fa5XZ9)4($Sgd|)Ynobd)byP`JUwT+z>by$1fCNJ5n&F(r%kV-MOX(0{{ z2}lG~ao~V*g5=R2t2Ueq5fMnh0deBW38|_OoIo77_Ul4tL)17@d&uSY=FPnSdo%Oq zm2=;Xh&nN-MWO~ZNt9Yf0fI#>KdKE85UAx6+oVoWSnTMT%4rS(IWF5hvHJMhEDFH;G(wLq(Td!52aUKNVuj^NCn0J3Sx$v|%r}?rSLt1bJZNZaJx@5~`9A;Phfz+FV!ue+t`r9l$H;bVdd>Kdf0p#EH5E z5Dm*|N?8K6Xp?bTC^=Cb+lnb>HY!)*YJ5OVVC7rtVs@@^X|}>%a_yZ7iErwUs%Loi zI~Q+T-qzB>ea61<38DL;V;vo>BMB>7c;UjqV zN8i5VsWjw9ok=HGGC)o#P_zqq;y5ufu3^uUGPv$!Y~2a6as=oY&Ql>bg1#b-P{j#&X2JdttUBt_3*X@j^o)Q{~+=&|4rmV+m{%4 z-j?xm{L;>4^xWC`5P4$P3i@}n|K`Kx-JUY)R%z!4PoD0c!p)s-@HVt_KYP8`Q~VI9 zp!@H@Ax{zMxzUQt-2>-5VNbB+oo)1nkc+)F@?+1bMyhH1chqiA)@{k+JZ8_VdB~Cu=Dj zT{DdJz^!l`t!LpA$ODnDkXIr}*h+iWwh}AW_i@g`U d*kMW8&Wmvp delta 1040 zcmZ{iOH30{6ozRFB~b?h6nqrnaB1mGNSk@I(2ljWj{yfuTRT%DDu&WlDbx;9G$F+3 zg7}E9n7c7CVd2iiL?ek?HpYb;W8%Vu=uQ)3+`IHlL5wEO;=BKubIv{g+&eGzPa4Z6 zl~FaVct_Qg;#Je58R*R^v7{c0rxYM+T32!@Rm+lx?Oo?MhBeC)SfDFOAmXrhyioIo zf*?q8ARtRY0xT&S7Z)nkatVwY5MWl4+VQL5Ql&m0F(F3gO7$hfsMaIZq7I+3< zu`Ky`dfnoD#$_FWnh_{lE~ze8qgHCszS1QKkdcz5(2?T!6;X`sjl7+y|f&6Dq zhsZIBOmWAWaaI5nwy#|)3jnGyB-}qR<){o+cs{{XIACRbQ3;?iOO!1 z4Q#x4+QbTyAL7TgNiCiq1wjl!HkU~#n&wkZ#!?{g5~vfgF(nfp$3zx_{=ef9flk>} zH=dm!1mUc%Px`hu0K9SRQWAPHrspSMBt+lZoQJ{xR~0tmR0-HIMc?_QI6QF?2;N9z zc06-x>l@pf7cI>CYV&Q2g`sWsC^Bt-fc$Jff{C8iU<(HMJx`F~b|>v*9;15Byujpi z+olzlaC-rp*Vj6Jn0wrH%wzD=0cNn);iUfVSE#;s7x8sw-;mj{a^R*77u%sZv$58j zH)~(_^&`Lbm60hpk6edo{dAmlVie;#=`w3hdc&3)v4ciA)6ps?wlZuk8#@uD1=3}Q Pw3_139G7olP%^&&fJGK5 From 5fadc6c0831f459e2289a0860b34bc45ab82a8f3 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Wed, 22 Dec 2021 20:57:56 -0800 Subject: [PATCH 2/2] move obsolete lispusers (#635) --- {lispusers => obsolete/lispusers}/BIGGER-FONT | 0 {lispusers => obsolete/lispusers}/BIGGER-FONT.LCOM | 0 {lispusers => obsolete/lispusers}/FONTDECLS | 0 {lispusers => obsolete/lispusers}/PSCFONT-FIX-FILENAME | 0 {lispusers => obsolete/lispusers}/SINGLEFILEINDEX | 0 5 files changed, 0 insertions(+), 0 deletions(-) rename {lispusers => obsolete/lispusers}/BIGGER-FONT (100%) rename {lispusers => obsolete/lispusers}/BIGGER-FONT.LCOM (100%) rename {lispusers => obsolete/lispusers}/FONTDECLS (100%) rename {lispusers => obsolete/lispusers}/PSCFONT-FIX-FILENAME (100%) rename {lispusers => obsolete/lispusers}/SINGLEFILEINDEX (100%) diff --git a/lispusers/BIGGER-FONT b/obsolete/lispusers/BIGGER-FONT similarity index 100% rename from lispusers/BIGGER-FONT rename to obsolete/lispusers/BIGGER-FONT diff --git a/lispusers/BIGGER-FONT.LCOM b/obsolete/lispusers/BIGGER-FONT.LCOM similarity index 100% rename from lispusers/BIGGER-FONT.LCOM rename to obsolete/lispusers/BIGGER-FONT.LCOM diff --git a/lispusers/FONTDECLS b/obsolete/lispusers/FONTDECLS similarity index 100% rename from lispusers/FONTDECLS rename to obsolete/lispusers/FONTDECLS diff --git a/lispusers/PSCFONT-FIX-FILENAME b/obsolete/lispusers/PSCFONT-FIX-FILENAME similarity index 100% rename from lispusers/PSCFONT-FIX-FILENAME rename to obsolete/lispusers/PSCFONT-FIX-FILENAME diff --git a/lispusers/SINGLEFILEINDEX b/obsolete/lispusers/SINGLEFILEINDEX similarity index 100% rename from lispusers/SINGLEFILEINDEX rename to obsolete/lispusers/SINGLEFILEINDEX