From 2c328448e0000ca052e8b76bee0f01f4848df54d Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Mon, 23 Feb 2026 22:32:27 -0800 Subject: [PATCH] Files with non-ascii characters converted to UTF-8, for basic testing --- library/sketch/SKETCH | 4682 +++++++++++----------- library/sketch/SKETCH.LCOM | Bin 161936 -> 163633 bytes library/virtualkeyboards/KEYBOARDCONFIGS | 88 +- library/virtualkeyboards/XKEYBOARDS | Bin 17108 -> 16990 bytes sources/CLISP | 270 +- sources/CLISP.DFASL | Bin 0 -> 36706 bytes sources/CLISP.LCOM | 3 - sources/DWIMIFY | 2438 ++++++----- sources/DWIMIFY.LCOM | Bin 78259 -> 78375 bytes 9 files changed, 3935 insertions(+), 3546 deletions(-) create mode 100644 sources/CLISP.DFASL delete mode 100644 sources/CLISP.LCOM diff --git a/library/sketch/SKETCH b/library/sketch/SKETCH index 9feb5bf9..2935c983 100644 --- a/library/sketch/SKETCH +++ b/library/sketch/SKETCH @@ -1,13 +1,10 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT UTF-8) -(FILECREATED "24-Dec-2025 14:48:39" {WMEDLEY}SKETCH>SKETCH.;16 491600 +(FILECREATED "19-Feb-2026 22:27:48" {WMEDLEY}sketch>SKETCH.;17 509947 :EDIT-BY rmk - :CHANGES-TO (VARS SKETCHCOMS) - (FNS SK.INCLUDE.FILE SK.GET.IMAGEOBJ.FROM.FILE SKETCH.PUT SKETCH.FLUSH.EXISTING) - - :PREVIOUS-DATE "30-Nov-2025 10:10:57" {WMEDLEY}SKETCH>SKETCH.;11) + :PREVIOUS-DATE "24-Dec-2025 14:48:39" {WMEDLEY}sketch>SKETCH.;16) (PRETTYCOMPRINT SKETCHCOMS) @@ -285,7 +282,7 @@ (T "")) " then type 'RETURN'. -To abort loading the new version of Sketch, type '^'."]) +To abort loading the new version of Sketch, type '↑'."]) ) ) (DECLARE%: FIRST DOCOPY DONTEVAL@LOAD @@ -300,18 +297,17 @@ To abort loading the new version of Sketch, type '^'."]) (DEFINEQ (SKETCH.FROM.A.FILE - [LAMBDA NIL (* rrb "24-Jun-86 11:40") - - (* reads a file name from the user and calls sketch on it.) - + [LAMBDA NIL (* rrb "24-Jun-86 11:40") + (* reads a file name from the user and + calls sketch on it.) (PROG ((NAME (PopUpWindowAndGetAtom "Sketch file name: "))) (RETURN (AND NAME (SKETCH NAME]) (SK.PUT.ON.FILE [LAMBDA (SKETCHW) (* ; "Edited 6-Apr-87 18:18 by rrb") (* saves a sketch on a Tedit file.) - - (* also changes the name of the sketch to be the same as the name of the file.) + + (* also changes the name of the sketch to be the same as the name of the file.) (PROG ((SKETCH (INSURE.SKETCH (SKETCH.FROM.VIEWER SKETCHW))) NOWNAME NEWNAME TEXTSTREAM) @@ -321,10 +317,8 @@ To abort loading the new version of Sketch, type '^'."]) (RETURN NIL)) (SETQ NEWNAME (SKETCH.PUT NEWNAME SKETCH SKETCHW)) [COND - ((AND NEWNAME (NEQ NOWNAME NEWNAME)) - - (* change the name of the sketch to be the same as the file name.) - + ((AND NEWNAME (NEQ NOWNAME NEWNAME)) (* change the name of the sketch to be + the same as the file name.) (replace (SKETCH SKETCHNAME) of SKETCH with NEWNAME) (* change the titles of the viewers  onto this sketch.) @@ -461,15 +455,14 @@ To abort loading the new version of Sketch, type '^'."]) (RETURN (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM]) (SK.GET.FROM.FILE - [LAMBDA (SKETCHW) (* rrb " 1-Oct-86 18:24") - - (* retrieves a sketch from a file clobbering any existing sketch.) - + [LAMBDA (SKETCHW) (* rrb " 1-Oct-86 18:24") + (* retrieves a sketch from a file + clobbering any existing sketch.) (COND ((SK.CONFIRM.DESTRUCTION SKETCHW "Press LEFT to delete current elements before GET.") - - (* put the delete on the history list so that it can be undone. - This leaves the gotten file there as well but seems better than nothing.) + + (* put the delete on the history list so that it can be undone. + This leaves the gotten file there as well but seems better than nothing.) (SK.DELETE.ELEMENT2 (fetch (SKETCH SKETCHELTS) of (INSURE.SKETCH SKETCHW)) SKETCHW) @@ -479,21 +472,19 @@ To abort loading the new version of Sketch, type '^'."]) (T (STATUSPRINT SKETCHW "GET aborted. The INCLUDE subcommand to GET doesn't delete."]) (SKETCH.GET - [LAMBDA (FILENAME VIEWER) (* rrb "29-Jan-86 11:21") + [LAMBDA (FILENAME VIEWER) (* rrb "29-Jan-86 11:21") (* reads a sketch from a file.) (fetch (SKETCHIMAGEOBJ SKIO.SKETCH) of (SK.GET.IMAGEOBJ.FROM.FILE FILENAME VIEWER]) ) (DEFINEQ (SKETCH - [LAMBDA (SKETCH WINDOW) (* rrb "17-Sep-86 10:21") + [LAMBDA (SKETCH WINDOW) (* rrb "17-Sep-86 10:21") (* opens a sketch window onto the  sketch SKETCH) (COND - [(AND SKETCH (LITATOM SKETCH)) - - (* assume its a filename Get the region and scale from the file.) - + [(AND SKETCH (LITATOM SKETCH)) (* assume its a filename Get the + region and scale from the file.) (PROG ((SKIMAGEOBJ (SK.GET.IMAGEOBJ.FROM.FILE SKETCH)) SCREENREG READSKETCH) (SETQ SCREENREG (SK.SCALE.REGION (fetch (SKETCHIMAGEOBJ SKIO.REGION) of SKIMAGEOBJ) @@ -517,14 +508,145 @@ To abort loading the new version of Sketch, type '^'."]) NIL NIL T T]) (SKETCHW.CREATE -(LAMBDA (SKETCH SKETCHREGION SCREENREGION TITLE INITIALSCALE BRINGUPMENU INITIALGRID) (* ; "Edited 25-Apr-88 15:18 by drc:") (* ;;; "creates a sketch window and returns it.") (PROG (W SCALE SKPROC SKETCHSTRUCTURE) (SETQ SKETCHSTRUCTURE (SK.CHECK.SKETCH.VERSION (COND ((NULL SKETCH) (SKETCH.CREATE NIL)) ((LITATOM SKETCH) (* ; "treat it like a file name") (SKETCH.GET SKETCH)) ((type? SKETCH SKETCH) SKETCH) ((type? IMAGEOBJ SKETCH) (* ; "pull things out of the image object.") (SETQ SKPROC (IMAGEOBJPROP SKETCH (QUOTE OBJECTDATUM))) (OR (REGIONP SKETCHREGION) (SETQ SKETCHREGION (fetch (SKETCHIMAGEOBJ SKIO.REGION) of SKPROC))) (OR (NUMBERP INITIALSCALE) (SETQ INITIALSCALE (fetch (SKETCHIMAGEOBJ SKIO.SCALE) of SKPROC))) (OR (NUMBERP INITIALGRID) (SETQ INITIALGRID (fetch (SKETCHIMAGEOBJ SKIO.GRID) of SKPROC))) (fetch (SKETCHIMAGEOBJ SKIO.SKETCH) of SKPROC)) ((AND (LITATOM (CAR SKETCH)) (for ELT in (CDR SKETCH) always (GLOBALELEMENTP ELT))) (* ; "old form, probably written out by notecards, update to new form.") (PROG (X) (SETQ X (SKIO.UPDATE.FROM.OLD.FORM SKETCH)) (* ; "smash sketch so this won't have to happen every time.") (RPLACA SKETCH (CAR X)) (RPLACD SKETCH (CDR X)) (RETURN X))) (T (\ILLEGAL.ARG SKETCH))))) (SETQ W (COND ((WINDOWP SCREENREGION) (AND TITLE (WINDOWPROP SCREENREGION (QUOTE TITLE) TITLE)) SCREENREGION) (T (CREATEW (COND ((REGIONP SCREENREGION)) (T (CREATEREGION LASTMOUSEX LASTMOUSEY 20 20))) (OR TITLE (SK.WINDOW.TITLE SKETCHSTRUCTURE)) NIL T)))) (SK.SET.UP.MENUS W (NOT (OPENWP SCREENREGION)) BRINGUPMENU) (COND ((OR (REGIONP SCREENREGION) (WINDOWP SCREENREGION)) (* ; "user gave a region, don't interact") NIL) (T (* ; "let prompting for reshape show room for both menu and window.") (SHAPEW W))) (* ;; "set the right margin so that text will never run into it. This can be removed when character positions are kept in points so \DSPPRINTCHAR doesn't have to look at the right margin.") (DSPRIGHTMARGIN 64000 W) (WINDOWPROP W (QUOTE SKETCH) SKETCHSTRUCTURE) (WINDOWPROP W (QUOTE SCALE) (SETQ SCALE (COND ((NUMBERP INITIALSCALE)) ((REGIONP SKETCHREGION) (* ; "determine the scale and offsets so that the given region of the sketch fits into the given window.") (FQUOTIENT (fetch (REGION HEIGHT) of SKETCHREGION) (fetch (REGION HEIGHT) of (DSPCLIPPINGREGION NIL W)))) ((NULL SKETCHREGION) INITIAL.SCALE) (T (\ILLEGAL.ARG SKETCHREGION))))) (* ; "check to make sure a context exists on the sketch because before July 1985 it didn't exist.") (WINDOWPROP W (QUOTE SKETCHCONTEXT) (OR (GETSKETCHPROP SKETCHSTRUCTURE (QUOTE SKETCHCONTEXT)) (PUTSKETCHPROP SKETCHSTRUCTURE (QUOTE SKETCHCONTEXT) (CREATE.DEFAULT.SKETCH.CONTEXT)))) (COND ((REGIONP SKETCHREGION) (* ; "if given a region, translate to it.") (WXOFFSET (IMINUS (FIX (QUOTIENT (fetch (REGION LEFT) of SKETCHREGION) SCALE))) W) (WYOFFSET (IMINUS (FIX (QUOTIENT (fetch (REGION BOTTOM) of SKETCHREGION) SCALE))) W))) (SK.UPDATE.REGION.VIEWED W) (* ; "calculate the sketch region being viewed before mapping the sketch into it.") (MAP.SKETCHSPEC.INTO.VIEWER SKETCHSTRUCTURE W) (SK.CREATE.HOTSPOT.CACHE W) (WINDOWPROP W (QUOTE GRIDFACTOR) (COND ((NUMBERP INITIALGRID) (LEASTPOWEROF2GT INITIALGRID)) (T (SK.DEFAULT.GRIDFACTOR W)))) (WINDOWPROP W (QUOTE USEGRID) (COND (INITIALGRID T))) (WINDOWPROP W (QUOTE BUTTONEVENTFN) (FUNCTION WB.BUTTON.HANDLER)) (WINDOWPROP W (QUOTE COPYBUTTONEVENTFN) (FUNCTION SK.COPY.BUTTONEVENTFN)) (WINDOWPROP W (QUOTE COPYINSERTFN) (FUNCTION SK.COPY.INSERTFN)) (WINDOWPROP W (QUOTE RIGHTBUTTONFN) (FUNCTION WB.BUTTON.HANDLER)) (WINDOWPROP W (QUOTE CURSOROUTFN) (FUNCTION SKETCHW.OUTFN)) (WINDOWPROP W (QUOTE REPAINTFN) (FUNCTION SKETCHW.REPAINTFN)) (WINDOWADDPROP W (QUOTE RESHAPEFN) (FUNCTION SKETCHW.RESHAPEFN)) (WINDOWADDPROP W (QUOTE SHRINKFN) (FUNCTION SK.RETURN.TTY)) (WINDOWPROP W (QUOTE ICONFN) (FUNCTION SK.SHRINK.ICONCREATE)) (WINDOWADDPROP W (QUOTE EXPANDFN) (FUNCTION SK.TAKE.TTY)) (WINDOWPROP W (QUOTE SCROLLFN) (FUNCTION SKETCHW.SCROLLFN)) (WINDOWPROP W (QUOTE HARDCOPYFN) (FUNCTION SKETCHW.HARDCOPYFN)) (* ; "I'm not sure why this ever gets called but it did once so to be sure, turn it off.") (WINDOWPROP W (QUOTE PAGEFULLFN) (FUNCTION NILL)) (WINDOWPROP W (QUOTE PROCESS) (SETQ SKPROC (ADD.PROCESS (LIST (FUNCTION WB.EDITOR) (KWOTE W)) (QUOTE RESTARTABLE) T (QUOTE TTYENTRYFN) (QUOTE SK.TTYENTRYFN) (QUOTE TTYEXITFN) (QUOTE SK.TTYEXITFN)))) (WINDOWPROP W (QUOTE SCROLLEXTENTUSE) T) (WINDOWADDPROP W (QUOTE CLOSEFN) (FUNCTION SKETCHW.CLOSEFN) T) (OPENW W) (ADD.SKETCH.VIEWER SKETCHSTRUCTURE W) (SKETCHW.REPAINTFN W) (RETURN W))) -) + [LAMBDA (SKETCH SKETCHREGION SCREENREGION TITLE INITIALSCALE BRINGUPMENU INITIALGRID) + (* ; "Edited 25-Apr-88 15:18 by drc:") + +(* ;;; "creates a sketch window and returns it.") + + (PROG (W SCALE SKPROC SKETCHSTRUCTURE) + [SETQ SKETCHSTRUCTURE (SK.CHECK.SKETCH.VERSION (COND + ((NULL SKETCH) + (SKETCH.CREATE NIL)) + ((LITATOM SKETCH) + (* ; "treat it like a file name") + (SKETCH.GET SKETCH)) + ((type? SKETCH SKETCH) + SKETCH) + ((type? IMAGEOBJ SKETCH) + (* ; + "pull things out of the image object.") + (SETQ SKPROC (IMAGEOBJPROP SKETCH + 'OBJECTDATUM)) + (OR (REGIONP SKETCHREGION) + (SETQ SKETCHREGION + (fetch (SKETCHIMAGEOBJ SKIO.REGION) + of SKPROC))) + (OR (NUMBERP INITIALSCALE) + (SETQ INITIALSCALE + (fetch (SKETCHIMAGEOBJ SKIO.SCALE) + of SKPROC))) + (OR (NUMBERP INITIALGRID) + (SETQ INITIALGRID + (fetch (SKETCHIMAGEOBJ SKIO.GRID) + of SKPROC))) + (fetch (SKETCHIMAGEOBJ SKIO.SKETCH) + of SKPROC)) + ((AND (LITATOM (CAR SKETCH)) + (for ELT in (CDR SKETCH) + always (GLOBALELEMENTP ELT))) + (* ; + "old form, probably written out by notecards, update to new form.") + (PROG (X) + (SETQ X (SKIO.UPDATE.FROM.OLD.FORM + SKETCH)) + (* ; + "smash sketch so this won't have to happen every time.") + (RPLACA SKETCH (CAR X)) + (RPLACD SKETCH (CDR X)) + (RETURN X))) + (T (\ILLEGAL.ARG SKETCH] + [SETQ W (COND + ((WINDOWP SCREENREGION) + (AND TITLE (WINDOWPROP SCREENREGION 'TITLE TITLE)) + SCREENREGION) + (T (CREATEW (COND + ((REGIONP SCREENREGION)) + (T (CREATEREGION LASTMOUSEX LASTMOUSEY 20 20))) + (OR TITLE (SK.WINDOW.TITLE SKETCHSTRUCTURE)) + NIL T] + (SK.SET.UP.MENUS W (NOT (OPENWP SCREENREGION)) + BRINGUPMENU) + (COND + ((OR (REGIONP SCREENREGION) + (WINDOWP SCREENREGION)) (* ; + "user gave a region, don't interact") + NIL) + (T (* ; + "let prompting for reshape show room for both menu and window.") + (SHAPEW W))) + + (* ;; "set the right margin so that text will never run into it. This can be removed when character positions are kept in points so \DSPPRINTCHAR doesn't have to look at the right margin.") + + (DSPRIGHTMARGIN 64000 W) + (WINDOWPROP W 'SKETCH SKETCHSTRUCTURE) + [WINDOWPROP W 'SCALE (SETQ SCALE (COND + ((NUMBERP INITIALSCALE)) + [(REGIONP SKETCHREGION) + (* ; + "determine the scale and offsets so that the given region of the sketch fits into the given window.") + (FQUOTIENT (fetch (REGION HEIGHT) of SKETCHREGION) + (fetch (REGION HEIGHT) of (DSPCLIPPINGREGION + NIL W] + ((NULL SKETCHREGION) + INITIAL.SCALE) + (T (\ILLEGAL.ARG SKETCHREGION] + (* ; + "check to make sure a context exists on the sketch because before July 1985 it didn't exist.") + [WINDOWPROP W 'SKETCHCONTEXT (OR (GETSKETCHPROP SKETCHSTRUCTURE 'SKETCHCONTEXT) + (PUTSKETCHPROP SKETCHSTRUCTURE 'SKETCHCONTEXT ( + CREATE.DEFAULT.SKETCH.CONTEXT + ] + (COND + ((REGIONP SKETCHREGION) (* ; + "if given a region, translate to it.") + (WXOFFSET (IMINUS (FIX (QUOTIENT (fetch (REGION LEFT) of SKETCHREGION) + SCALE))) + W) + (WYOFFSET (IMINUS (FIX (QUOTIENT (fetch (REGION BOTTOM) of SKETCHREGION) + SCALE))) + W))) + (SK.UPDATE.REGION.VIEWED W) (* ; + "calculate the sketch region being viewed before mapping the sketch into it.") + (MAP.SKETCHSPEC.INTO.VIEWER SKETCHSTRUCTURE W) + (SK.CREATE.HOTSPOT.CACHE W) + [WINDOWPROP W 'GRIDFACTOR (COND + ((NUMBERP INITIALGRID) + (LEASTPOWEROF2GT INITIALGRID)) + (T (SK.DEFAULT.GRIDFACTOR W] + (WINDOWPROP W 'USEGRID (COND + (INITIALGRID T))) + (WINDOWPROP W 'BUTTONEVENTFN (FUNCTION WB.BUTTON.HANDLER)) + (WINDOWPROP W 'COPYBUTTONEVENTFN (FUNCTION SK.COPY.BUTTONEVENTFN)) + (WINDOWPROP W 'COPYINSERTFN (FUNCTION SK.COPY.INSERTFN)) + (WINDOWPROP W 'RIGHTBUTTONFN (FUNCTION WB.BUTTON.HANDLER)) + (WINDOWPROP W 'CURSOROUTFN (FUNCTION SKETCHW.OUTFN)) + (WINDOWPROP W 'REPAINTFN (FUNCTION SKETCHW.REPAINTFN)) + (WINDOWADDPROP W 'RESHAPEFN (FUNCTION SKETCHW.RESHAPEFN)) + (WINDOWADDPROP W 'SHRINKFN (FUNCTION SK.RETURN.TTY)) + (WINDOWPROP W 'ICONFN (FUNCTION SK.SHRINK.ICONCREATE)) + (WINDOWADDPROP W 'EXPANDFN (FUNCTION SK.TAKE.TTY)) + (WINDOWPROP W 'SCROLLFN (FUNCTION SKETCHW.SCROLLFN)) + (WINDOWPROP W 'HARDCOPYFN (FUNCTION SKETCHW.HARDCOPYFN)) + (* ; + "I'm not sure why this ever gets called but it did once so to be sure, turn it off.") + (WINDOWPROP W 'PAGEFULLFN (FUNCTION NILL)) + [WINDOWPROP W 'PROCESS (SETQ SKPROC (ADD.PROCESS (LIST (FUNCTION WB.EDITOR) + (KWOTE W)) + 'RESTARTABLE T 'TTYENTRYFN 'SK.TTYENTRYFN + 'TTYEXITFN + 'SK.TTYEXITFN] + (WINDOWPROP W 'SCROLLEXTENTUSE T) + (WINDOWADDPROP W 'CLOSEFN (FUNCTION SKETCHW.CLOSEFN) + T) + (OPENW W) + (ADD.SKETCH.VIEWER SKETCHSTRUCTURE W) + (SKETCHW.REPAINTFN W) + (RETURN W]) (SKETCH.RESET - [LAMBDA (SKETCH) (* rrb "11-Dec-85 11:24") - - (* resets a sketch structure and all of the viewers onto it.) - + [LAMBDA (SKETCH) (* rrb "11-Dec-85 11:24") + (* resets a sketch structure and all + of the viewers onto it.) (PROG ((SKSTRUC (INSURE.SKETCH SKETCH))) (* delete all sketch elements) (replace (SKETCH SKETCHTCELL) of SKSTRUC with (CONS)) (for VIEWER in (ALL.SKETCH.VIEWERS SKSTRUC) do (SKED.CLEAR.SELECTION VIEWER) @@ -541,19 +663,18 @@ To abort loading the new version of Sketch, type '^'."]) (WINDOWPROP VIEWER 'SKETCHCHANGED NIL]) (SKETCHW.FIG.CHANGED - [LAMBDA (W) (* rrb "29-Nov-84 17:59") - - (* W is a sketch window that is being reshaped. - Mark this fact in case it came out of a document.) + [LAMBDA (W) (* rrb "29-Nov-84 17:59") + + (* W is a sketch window that is being reshaped. + Mark this fact in case it came out of a document.) (OR (WINDOWPROP W 'SKETCHCHANGED) (WINDOWPROP W 'SKETCHCHANGED 'OLD]) (SK.WINDOW.TITLE - [LAMBDA (SKETCH) (* rrb " 7-May-85 14:00") - - (* returns the window title of a window onto a sketch.) - + [LAMBDA (SKETCH) (* rrb " 7-May-85 14:00") + (* returns the window title of a + window onto a sketch.) (COND ((fetch (SKETCH SKETCHNAME) of SKETCH) (CONCAT "Viewer onto " (fetch (SKETCH SKETCHNAME) of SKETCH))) @@ -561,23 +682,22 @@ To abort loading the new version of Sketch, type '^'."]) (EDITSLIDE [LAMBDA (SKETCH LANDSCAPE) (* ; "Edited 20-Feb-87 10:44 by rrb") - - (* creates a sketch in a window the size of a screen.) - + (* creates a sketch in a window the + size of a screen.) (SKETCHW.CREATE SKETCH NIL (COND (LANDSCAPE (GETBOXREGION 780 612)) (T (GETBOXREGION 612 770))) NIL NIL T 16.0]) (EDITSKETCH - [LAMBDA (SLIDENAME) (* rrb "14-Nov-84 17:15") + [LAMBDA (SLIDENAME) (* rrb "14-Nov-84 17:15") (* edits a named sketch) (SKETCHW.CREATE (SETQ SLIDENAME (OR SLIDENAME (GENSYM "SLIDE"))) NIL NIL NIL NIL T 16.0) SLIDENAME]) (ADD.SKETCH.TO.VIEWER - [LAMBDA (SKETCHTOADD VIEWER ABOUTDEFAULTS?) (* rrb "20-Mar-86 15:55") + [LAMBDA (SKETCHTOADD VIEWER ABOUTDEFAULTS?) (* rrb "20-Mar-86 15:55") (* adds the element in SKETCHTOADD to  the sketch TOSKETCH) (PROG ([ADDSKETCH (COND @@ -594,12 +714,12 @@ To abort loading the new version of Sketch, type '^'."]) (COND ((OR (NULL ABOUTDEFAULTS?) (MENU (create MENU - ITEMS _ '((Yes T "Will use the defaults of the retrieved sketch." + ITEMS ← '((Yes T "Will use the defaults of the retrieved sketch." ) (No NIL "Will not change the defaults.")) - CENTERFLG _ T - TITLE _ "Use the defaults from the retrieved sketch?" - MENUCOLUMNS _ 2))) + CENTERFLG ← T + TITLE ← "Use the defaults from the retrieved sketch?" + MENUCOLUMNS ← 2))) (PUTSKETCHPROP TOSKETCH 'SKETCHCONTEXT DEFAULTS) (WINDOWPROP VIEWER 'SKETCHCONTEXT DEFAULTS] (SK.ADD.ELEMENTS.TO.SKETCH (fetch (SKETCH SKETCHELTS) of ADDSKETCH) @@ -614,12 +734,12 @@ To abort loading the new version of Sketch, type '^'."]) (PUTSKETCHPROP TOSKETCH SKPROP (GETSKETCHPROP ADDSKETCH SKPROP]) (SK.ADD.ELEMENTS.TO.SKETCH - [LAMBDA (ELTS SKW) (* rrb "10-Mar-86 16:50") + [LAMBDA (ELTS SKW) (* rrb "10-Mar-86 16:50") (* adds a list of elements to a sketch) (for ELT in ELTS do - - (* clear the priority so that they get a priority based on their position in - the new sketch.) + + (* clear the priority so that they get a priority based on their position in the + new sketch.) (SK.SET.ELEMENT.PRIORITY ELT NIL) (SK.ADD.ELEMENT ELT SKW]) @@ -630,7 +750,7 @@ To abort loading the new version of Sketch, type '^'."]) (* ; "allows the user to set a default") (* allows the user to set a default) (\CURSOR.IN.MIDDLE.MENU (create MENU - ITEMS _ '[(Line SKETCH.SET.BRUSH.SIZE + ITEMS ← '[(Line SKETCH.SET.BRUSH.SIZE "Sets the characteristics of the default brush." (SUBITEMS (Size SKETCH.SET.BRUSH.SIZE "Sets the size of the default brush" @@ -708,16 +828,16 @@ To abort loading the new version of Sketch, type '^'."]) ("All figures" SK.SET.FEEDBACK.ALWAYS "Most elements are shown while they are being entered. This will be slow for arcs and curves."] - CENTERFLG _ T - WHENSELECTEDFN _ (FUNCTION SK.POPUP.SELECTIONFN) - MENUFONT _ (FONTPROP (FONTCREATE BOLDFONT) + CENTERFLG ← T + WHENSELECTEDFN ← (FUNCTION SK.POPUP.SELECTIONFN) + MENUFONT ← (FONTPROP (FONTCREATE BOLDFONT) 'SPEC]) (SK.POPUP.SELECTIONFN - [LAMBDA (ITEM MENU) (* rrb " 3-Sep-85 14:27") - - (* * calls the function appropriate for the item selected from the command menu - associated with a figure window.) + [LAMBDA (ITEM MENU) (* rrb " 3-Sep-85 14:27") + + (* * calls the function appropriate for the item selected from the command menu + associated with a figure window.) (* uses SKW freely from enclosing call  to MENU.) (CLOSEPROMPTWINDOW SKW) @@ -725,16 +845,16 @@ This will be slow for arcs and curves."] SKW]) (GETSKETCHWREGION - [LAMBDA (SKETCHWINDOW) (* rrb "11-Jul-86 15:48") + [LAMBDA (SKETCHWINDOW) (* rrb "11-Jul-86 15:48") (UNSCALE.REGION (GETWREGION SKETCHWINDOW) (VIEWER.SCALE SKETCHWINDOW]) (SK.ADD.ELEMENT - [LAMBDA (GELT SKETCHW DONTCLEARCURSOR GROUPFLG DONTCALLWHENADDEDFN) + [LAMBDA (GELT SKETCHW DONTCLEARCURSOR GROUPFLG DONTCALLWHENADDEDFN) (* rrb "30-Aug-86 15:08") - - (* adds a new element to a sketch window and handles propagation to all other - figure windows) + + (* adds a new element to a sketch window and handles propagation to all other + figure windows) (COND (GELT (PROG ([GELTTOADD (COND @@ -755,24 +875,24 @@ This will be slow for arcs and curves."] (RETURN ADDEDELT]) (SK.ADD.PRIORITY.ELEMENT.TO.SKETCH - [LAMBDA (SKETCH ELEMENT PRIORITY) (* rrb "10-Mar-86 18:48") - - (* * adds an element to a sketch at its place according to PRIORITY.) + [LAMBDA (SKETCH ELEMENT PRIORITY) (* rrb "10-Mar-86 18:48") + + (* * adds an element to a sketch at its place according to PRIORITY.) (PROG ((SKELTSCELL (fetch (SKETCH SKETCHTCELL) of SKETCH))) (RETURN (COND ([OR (NULL (CAR SKELTSCELL)) (NOT (LESSP PRIORITY (SK.ELEMENT.PRIORITY (CADR SKELTSCELL] - - (* special cases of no elements or this element being greater than any others. - This means the other part of the COND doesn't have to worry about the TCONC - format.) + + (* special cases of no elements or this element being greater than any others. + This means the other part of the COND doesn't have to worry about the TCONC + format.) (TCONC SKELTSCELL ELEMENT)) [(LESSP PRIORITY (SK.ELEMENT.PRIORITY (CAAR SKELTSCELL))) - - (* special check for first element. This allows the others to be handled by - replacing the tail of the element before.) + + (* special check for first element. This allows the others to be handled by + replacing the tail of the element before.) (RPLACA SKELTSCELL (CONS ELEMENT (CAR SKELTSCELL] (T (for SKELTTAIL on (CAR SKELTSCELL) when (LESSP PRIORITY (SK.ELEMENT.PRIORITY @@ -781,41 +901,40 @@ This will be slow for arcs and curves."] (RETURN ELEMENT]) (SK.ELTS.BY.PRIORITY - [LAMBDA (GELTA GELTB) (* rrb "10-Mar-86 17:57") - - (* * sort function for sketch global elements that sorts by priority.) + [LAMBDA (GELTA GELTB) (* rrb "10-Mar-86 17:57") + + (* * sort function for sketch global elements that sorts by priority.) (ILESSP (SK.ELEMENT.PRIORITY GELTA) (SK.ELEMENT.PRIORITY GELTB]) (SK.ORDER.ELEMENTS - [LAMBDA (GSKETCHELEMENTS) (* rrb "10-Mar-86 16:30") - - (* * puts a list of sketch global elements in order by priority.) + [LAMBDA (GSKETCHELEMENTS) (* rrb "10-Mar-86 16:30") + + (* * puts a list of sketch global elements in order by priority.) (SORT GSKETCHELEMENTS (FUNCTION SK.ELTS.BY.PRIORITY]) (SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH - [LAMBDA (LOCALSKETCHELTS LOCALELEMENT) (* rrb "26-Mar-86 10:21") - - (* * adds an element to a sketch at its place according to PRIORITY.) + [LAMBDA (LOCALSKETCHELTS LOCALELEMENT) (* rrb "26-Mar-86 10:21") + + (* * adds an element to a sketch at its place according to PRIORITY.) (PROG [(PRIORITY (SK.ELEMENT.PRIORITY (fetch (SCREENELT GLOBALPART) of LOCALELEMENT] (RETURN (COND ([OR (NULL (CDAR LOCALSKETCHELTS)) (NOT (LESSP PRIORITY (SK.ELEMENT.PRIORITY (fetch (SCREENELT GLOBALPART) of (CADR LOCALSKETCHELTS] - - (* special cases of no elements in which case the local elements has only a - name or this element being greater than any others. - This means the other part of the COND doesn't have to worry about the TCONC - format.) + + (* special cases of no elements in which case the local elements has only a name + or this element being greater than any others. + This means the other part of the COND doesn't have to worry about the TCONC + format.) (TCONC LOCALSKETCHELTS LOCALELEMENT)) - (T - - (* the first element of LOCALSKETCHELTS is the name of the sketch.) - + (T (* the first element of + LOCALSKETCHELTS is the name of the + sketch.) (for SKELTTAIL on (CAR LOCALSKETCHELTS) when [LESSP PRIORITY (SK.ELEMENT.PRIORITY (fetch (SCREENELT GLOBALPART) of (CADR SKELTTAIL] @@ -823,21 +942,20 @@ This will be slow for arcs and curves."] (RETURN LOCALELEMENT]) (SK.ADD.ELEMENTS - [LAMBDA (ELEMENTS SKW) (* rrb "10-Mar-86 17:57") - - (* adds a list of global elements to a viewer but doesn't make an entry on the - history list.) - - (* sorts the elements so that their relative priority remains the same.) + [LAMBDA (ELEMENTS SKW) (* rrb "10-Mar-86 17:57") + (* adds a list of global elements to a viewer but doesn't make an entry on the + history list.) + (* sorts the elements so that their + relative priority remains the same.) (for ELT in (SK.ORDER.ELEMENTS ELEMENTS) do (SK.SET.ELEMENT.PRIORITY ELT NIL) (SK.ADD.ELEMENT ELT SKW]) (SK.CHECK.WHENADDEDFN - [LAMBDA (VIEWER GELT) (* rrb "19-Oct-85 17:36") - - (* checks if the sketch has a when added fn and if so, calls it and interprets - the result. Returns a list of the elements that should be deleted.) + [LAMBDA (VIEWER GELT) (* rrb "19-Oct-85 17:36") + + (* checks if the sketch has a when added fn and if so, calls it and interprets + the result. Returns a list of the elements that should be deleted.) (PROG ((SKETCH (INSURE.SKETCH VIEWER)) ADDFN RESULT) @@ -853,34 +971,32 @@ This will be slow for arcs and curves."] (T (RETURN GELT]) (SK.APPLY.MENU.COMMAND - [LAMBDA (COMMAND SKETCHW) (* rrb " 3-Jan-85 13:17") - - (* calls the function appropriate for the item selected from the command menu - associated with a figure window.) - - (* This is a separate function so it can be called by both pop up and fixed - menu operations.) + [LAMBDA (COMMAND SKETCHW) (* rrb " 3-Jan-85 13:17") + + (* calls the function appropriate for the item selected from the command menu + associated with a figure window.) + + (* This is a separate function so it can be called by both pop up and fixed menu + operations.) (COND ((NULL COMMAND) NIL) - ((type? SKETCHTYPE COMMAND) - - (* if the selected item is an element type, add an instance.) - + ((type? SKETCHTYPE COMMAND) (* if the selected item is an element + type, add an instance.) (SKETCHW.ADD.INSTANCE COMMAND SKETCHW)) [(LISTP COMMAND) (* EVAL it) (EVAL (APPEND COMMAND (CONS (KWOTE SKETCHW] (T (APPLY* COMMAND SKETCHW]) (SK.DELETE.ELEMENT1 - [LAMBDA (OLDGELT SKETCHW GROUPFLG) (* rrb "19-Oct-85 17:09") - - (* deletes an element to a sketch window and handles propagation to all other - figure windows) - - (* GROUPFLG indicates that this is part of a group operation and hence display - and image object deleted fns don't need to be called.) + [LAMBDA (OLDGELT SKETCHW GROUPFLG) (* rrb "19-Oct-85 17:09") + + (* deletes an element to a sketch window and handles propagation to all other + figure windows) + + (* GROUPFLG indicates that this is part of a group operation and hence display + and image object deleted fns don't need to be called.) (PROG ((SKETCH (SKETCH.FROM.VIEWER SKETCHW)) LOCALELT) (* delete the element to the sketch.) @@ -898,10 +1014,9 @@ This will be slow for arcs and curves."] (RETURN OLDGELT]) (SK.MARK.DIRTY - [LAMBDA (SKETCH) (* rrb " 1-Oct-86 18:15") - - (* marks a sketch as having been changed. - Puts a flag on its viewers.) + [LAMBDA (SKETCH) (* rrb " 1-Oct-86 18:15") + (* marks a sketch as having been + changed. Puts a flag on its viewers.) (* checks first because this is faster  than always putting.) (for SKW in (ALL.SKETCH.VIEWERS SKETCH) do (OR (EQ (WINDOWPROP SKW 'SKETCHCHANGED) @@ -909,18 +1024,15 @@ This will be slow for arcs and curves."] (WINDOWPROP SKW 'SKETCHCHANGED T]) (SK.MARK.UNDIRTY - [LAMBDA (SKETCH) (* rrb "29-Nov-84 18:03") - - (* marks a sketch as having been changed. - Puts a flag on its viewers.) - + [LAMBDA (SKETCH) (* rrb "29-Nov-84 18:03") + (* marks a sketch as having been + changed. Puts a flag on its viewers.) (for SKW in (ALL.SKETCH.VIEWERS SKETCH) do (WINDOWPROP SKW 'SKETCHCHANGED 'OLD]) (SK.MENU.AND.RETURN.FIELD - [LAMBDA (ELEMENTTYPE) (* rrb "11-May-84 16:03") - - (* returns a field list of the field to be changed.) - + [LAMBDA (ELEMENTTYPE) (* rrb "11-May-84 16:03") + (* returns a field list of the field + to be changed.) (PROG ((ITEMS (CHANGEABLEFIELDITEMS ELEMENTTYPE))) (RETURN (COND ((NULL ITEMS) @@ -928,20 +1040,20 @@ This will be slow for arcs and curves."] [(NULL (CDR ITEMS)) (EVAL (CADR (CAR ITEMS] (T (MENU (create MENU - ITEMS _ ITEMS - CENTERFLG _ T - TITLE _ "Choose which property to change"]) + ITEMS ← ITEMS + CENTERFLG ← T + TITLE ← "Choose which property to change"]) (SKETCH.SET.BRUSH.SHAPE - [LAMBDA (W) (* rrb "11-Dec-84 15:31") + [LAMBDA (W) (* rrb "11-Dec-84 15:31") (* Sets the shape of the current brush) (PROG [(NEWSHAPE (PAINTW.READBRUSHSHAPE)) (NOWBRUSH (fetch (SKETCHCONTEXT SKETCHBRUSH) of (WINDOWPROP W 'SKETCHCONTEXT] (RETURN (AND NEWSHAPE (replace (SKETCHCONTEXT SKETCHBRUSH) of (WINDOWPROP W 'SKETCHCONTEXT) - with (create BRUSH using NOWBRUSH BRUSHSHAPE _ NEWSHAPE]) + with (create BRUSH using NOWBRUSH BRUSHSHAPE ← NEWSHAPE]) (SKETCH.SET.BRUSH.SIZE - [LAMBDA (W) (* rrb "12-Jan-85 10:13") + [LAMBDA (W) (* rrb "12-Jan-85 10:13") (* sets the size of the current brush) (SK.SET.DEFAULT.BRUSH.SIZE [READBRUSHSIZE (fetch (BRUSH BRUSHSIZE) of (fetch (SKETCHCONTEXT SKETCHBRUSH) @@ -949,10 +1061,10 @@ This will be slow for arcs and curves."] W]) (SKETCHW.CLOSEFN - [LAMBDA (SKW) (* rrb " 1-Oct-86 17:44") - - (* close function for a viewer. Removes itself from the list of viewers.) - + [LAMBDA (SKW) (* rrb " 1-Oct-86 17:44") + (* close function for a viewer. + Removes itself from the list of + viewers.) (PROG (PROCINFO) [COND [(SETQ PROCINFO (WINDOWPROP SKW 'DOCUMENTINFO)) (* this window came from a tedit @@ -966,9 +1078,9 @@ This will be slow for arcs and curves."] (COND ([OR (TTY.PROCESSP (THIS.PROCESS)) (TTY.PROCESSP (WINDOWPROP SKW 'PROCESS] - - (* if this process or the sketch process has the tty, give it back to the Tedit - that this window came from.) + + (* if this process or the sketch process has the tty, give it back to the Tedit + that this window came from.) (AND [PROCESSP (SETQ PROCINFO (WINDOWPROP (fetch (SKETCHDOCUMENTINFO FROMTEDITWINDOW) @@ -984,11 +1096,11 @@ This will be slow for arcs and curves."] (WINDOWADDPROP SKW 'OPENFN 'SKETCHW.REOPENFN]) (SK.CONFIRM.DESTRUCTION - [LAMBDA (VIEWER MSG) (* rrb " 1-Oct-86 17:37") - - (* some destructive operation is about to take place, if the viewer is dirty, - confirm that this is what is intended. If so, return T. - If not, NIL.) + [LAMBDA (VIEWER MSG) (* rrb " 1-Oct-86 17:37") + + (* some destructive operation is about to take place, if the viewer is dirty, + confirm that this is what is intended. If so, return T. + If not, NIL.) (COND ((OR (WINDOWPROP VIEWER 'DONTQUERYCHANGES) @@ -1007,45 +1119,43 @@ This will be slow for arcs and curves."] (T NIL]) (SKETCHW.OUTFN - [LAMBDA (SKW) (* rrb "24-Jan-85 10:06") - - (* the cursor is leaving the window, updates any structures that may be spread - out for efficiency.) + [LAMBDA (SKW) (* rrb "24-Jan-85 10:06") + + (* the cursor is leaving the window, updates any structures that may be spread + out for efficiency.) NIL]) (SKETCHW.REOPENFN - [LAMBDA (SKW) (* rrb " 7-Feb-84 11:31") - - (* reopenfn for viewers. Adds it back onto the list of global viewers.) - + [LAMBDA (SKW) (* rrb " 7-Feb-84 11:31") + (* reopenfn for viewers. + Adds it back onto the list of global + viewers.) (ADD.SKETCH.VIEWER (WINDOWPROP SKW 'SKETCH) SKW) (WINDOWPROP SKW 'PROCESS (ADD.PROCESS (LIST (FUNCTION WB.EDITOR) (KWOTE SKW]) (MAKE.LOCAL.SKETCH - [LAMBDA (SKETCH SKETCHREGION SCALE STREAM EVERYTHINGFLG) (* rrb "22-Apr-85 16:45") - - (* * calculate the local parts for the region of the sketch at a given scale. - EVERYTHINGFLG provides a way to override the inside check. - This is necessary because the inside check works on local elements. - When the inside check is change to work on global elements, this can be - removed.) + [LAMBDA (SKETCH SKETCHREGION SCALE STREAM EVERYTHINGFLG) (* rrb "22-Apr-85 16:45") + + (* * calculate the local parts for the region of the sketch at a given scale. + EVERYTHINGFLG provides a way to override the inside check. + This is necessary because the inside check works on local elements. + When the inside check is change to work on global elements, this can be removed.) (for SKELT in (fetch (SKETCH SKETCHELTS) of (INSURE.SKETCH SKETCH)) when (OR EVERYTHINGFLG (SK.INSIDE.REGION SKELT SKETCHREGION)) collect (SK.LOCAL.FROM.GLOBAL SKELT STREAM SCALE]) (MAP.SKETCHSPEC.INTO.VIEWER - [LAMBDA (SKETCH SKW) (* rrb "12-May-85 17:02") - - (* creates the local parts of a sketch and puts it onto the viewer.) - + [LAMBDA (SKETCH SKW) (* rrb "12-May-85 17:02") + (* creates the local parts of a sketch + and puts it onto the viewer.) (PROG ((SKREGION (WINDOWPROP SKW 'REGION.VIEWED)) SPECS) - - (* local specs are kept as a TCONC cell so that additions to the end are fast.) + + (* local specs are kept as a TCONC cell so that additions to the end are fast.) (RETURN (WINDOWPROP SKW 'SKETCHSPECS (CONS [SETQ SPECS (CONS (fetch (SKETCH SKETCHNAME) of SKETCH) @@ -1058,29 +1168,27 @@ This will be slow for arcs and curves."] (LAST SPECS]) (SKETCHW.REPAINTFN - [LAMBDA (W REG STOPIFMOUSEDOWN NEWGRIDFLG) (* rrb "21-Feb-86 10:38") + [LAMBDA (W REG STOPIFMOUSEDOWN NEWGRIDFLG) (* rrb "21-Feb-86 10:38") (* redisplays the sketch in a window) (* for now ignore the region.) - - (* if STOPIFMOUSEDOWN is T, it displays some but stops if the button left or - middle button is still down and returns STOPPED) + + (* if STOPIFMOUSEDOWN is T, it displays some but stops if the button left or + middle button is still down and returns STOPPED) (DSPOPERATION 'PAINT W) - (DSPRIGHTMARGIN 65000 W) - - (* I don't know exactly how scrolling ever gets turned on but it has.) - + (DSPRIGHTMARGIN 65000 W) (* I don't know exactly how scrolling + ever gets turned on but it has.) (DSPSCROLL 'OFF W) (PROG1 (SKETCHW.REPAINTFN1 W REG (AND STOPIFMOUSEDOWN (SETUPTIMER AUTOZOOM.REPAINT.TIME)) NEWGRIDFLG) (SKED.SELECTION.FEEDBACK W]) (SKETCHW.REPAINTFN1 - [LAMBDA (SKW REGION TIMER NEWGRIDFLG) (* rrb "11-Jul-86 15:51") - - (* Draws all of the local elements in the sketch window SKW. - internal function to SKETCHW.REPAINTFN This entry is provided so that - SK.DRAWFIGURE.IF can RETFROM it if the timer has expired and a button is down.) + [LAMBDA (SKW REGION TIMER NEWGRIDFLG) (* rrb "11-Jul-86 15:51") + + (* Draws all of the local elements in the sketch window SKW. + internal function to SKETCHW.REPAINTFN This entry is provided so that + SK.DRAWFIGURE.IF can RETFROM it if the timer has expired and a button is down.) (MAPSKETCHSPECS (LOCALSPECS.FROM.VIEWER SKW) (COND @@ -1094,25 +1202,25 @@ This will be slow for arcs and curves."] (SK.DISPLAY.GRID.POINTS SKW NEWGRIDFLG]) (SK.DRAWFIGURE.IF - [LAMBDA (SCREENELT STREAM REGION SCALE) (* rrb "22-Jan-85 11:34") - - (* draws an element of a sketch in a window. - If the free variable TIMER has expired and a button is down, it RETFROMs the - repainting function.) + [LAMBDA (SCREENELT STREAM REGION SCALE) (* rrb "22-Jan-85 11:34") + + (* draws an element of a sketch in a window. + If the free variable TIMER has expired and a button is down, it RETFROMs the + repainting function.) (PROG1 (SK.DRAWFIGURE SCREENELT STREAM REGION SCALE) - (AND TIMER (MOUSESTATE (OR LEFT MIDDLE)) - (TIMEREXPIRED? TIMER) - (RETFROM 'SKETCHW.REPAINTFN1 'STOPPED]) + (AND TIMER (MOUSESTATE (OR LEFT MIDDLE)) + (TIMEREXPIRED? TIMER) + (RETFROM 'SKETCHW.REPAINTFN1 'STOPPED)))]) (SKETCHW.SCROLLFN - [LAMBDA (SKW XDELTA YDELTA CONTINUOUSFLG) (* rrb "11-Jul-86 15:51") - - (* scroll function for a sketch window. It must check to see which elements - need to get added and deleted from the ones currently viewed as a result of the - scrolling. Also if an element gets added, the clipping region must be expanded - because part of the display of the object may be in the already visible part of - the window.) + [LAMBDA (SKW XDELTA YDELTA CONTINUOUSFLG) (* rrb "11-Jul-86 15:51") + + (* scroll function for a sketch window. It must check to see which elements need + to get added and deleted from the ones currently viewed as a result of the + scrolling. Also if an element gets added, the clipping region must be expanded + because part of the display of the object may be in the already visible part of + the window.) (PROG ([SKETCH (fetch (SKETCH SKETCHELTS) of (INSURE.SKETCH (SKETCH.FROM.VIEWER SKW] (NOWREG (DSPCLIPPINGREGION NIL SKW)) @@ -1148,22 +1256,20 @@ This will be slow for arcs and curves."] (fetch (REGION WIDTH) of NOWREG) (fetch (REGION HEIGHT) of NOWREG))) (SETQ SCALE (VIEWER.SCALE SKW] - - (* update the current image to contain the things that will be there after the - scroll, then scroll.) + + (* update the current image to contain the things that will be there after the + scroll, then scroll.) [for GELT in SKETCH do (SETQ INNEW? (SK.INSIDE.REGION GELT NEWREGION)) (COND [(SETQ LOCALELT (SK.LOCAL.ELT.FROM.GLOBALPART GELT SKW)) - - (* if it is not supposed to be in the new region, remove it.) - + (* if it is not supposed to be in the + new region, remove it.) (OR INNEW? (COND ((REGIONSINTERSECTP NEWLOCALREGION (SK.ITEM.REGION LOCALELT)) - - (* part of image may overlap the part of sketch that is still showing) - + (* part of image may overlap the part + of sketch that is still showing) (SK.ERASE.AND.DELETE.ITEM LOCALELT SKW)) (T (SK.DELETE.ITEM LOCALELT SKW] (INNEW? (* just came in) @@ -1174,11 +1280,11 @@ This will be slow for arcs and curves."] (for GELT in NEWONES do (SKETCH.ADD.AND.DISPLAY1 GELT SKW SCALE]) (SKETCHW.RESHAPEFN - [LAMBDA (SKW OLDIMAGE IMAGEREGION OLDSCREENREGION) (* rrb "11-Jul-86 15:51") - - (* reshape function for a sketch window. - It must check to see which elements need to get added and deleted from the ones - currently viewed as a result of the reshaping.) + [LAMBDA (SKW OLDIMAGE IMAGEREGION OLDSCREENREGION) (* rrb "11-Jul-86 15:51") + + (* reshape function for a sketch window. It must check to see which elements need + to get added and deleted from the ones currently viewed as a result of the + reshaping.) (PROG ([SKETCH (fetch (SKETCH SKETCHELTS) of (INSURE.SKETCH (SKETCH.FROM.VIEWER SKW] (NOWREG (DSPCLIPPINGREGION NIL SKW)) @@ -1188,22 +1294,20 @@ This will be slow for arcs and curves."] (RESHAPEBYREPAINTFN SKW OLDIMAGE IMAGEREGION OLDSCREENREGION) [SETQ NEWREGION (UNSCALE.REGION (SETQ NEWLOCALREGION (DSPCLIPPINGREGION NIL SKW)) (SETQ SCALE (VIEWER.SCALE SKW] - - (* update the current image to contain the things that will be there after the - scroll, then scroll.) + + (* update the current image to contain the things that will be there after the + scroll, then scroll.) [for GELT in SKETCH do (SETQ INNEW? (SK.INSIDE.REGION GELT NEWREGION)) (COND [(SETQ LOCALELT (SK.LOCAL.ELT.FROM.GLOBALPART GELT SKW)) - - (* if it is not supposed to be in the new region, remove it.) - + (* if it is not supposed to be in the + new region, remove it.) (OR INNEW? (COND ((REGIONSINTERSECTP NEWLOCALREGION (SK.ITEM.REGION LOCALELT)) - - (* part of image may overlap the part of sketch that is still showing) - + (* part of image may overlap the part + of sketch that is still showing) (SK.ERASE.AND.DELETE.ITEM LOCALELT SKW)) (T (SK.DELETE.ITEM LOCALELT SKW] (INNEW? (* just came in) @@ -1213,11 +1317,11 @@ This will be slow for arcs and curves."] (for GELT in NEWONES do (SKETCH.ADD.AND.DISPLAY1 GELT SKW SCALE]) (SK.UPDATE.EVENT.SELECTION - [LAMBDA (HOTSPOTCACHE X1 Y1 X2 Y2 SCALE WINDOW COPYMODE DELETEMODE) + [LAMBDA (HOTSPOTCACHE X1 Y1 X2 Y2 SCALE WINDOW COPYMODE DELETEMODE) (* rrb "31-Jan-85 11:35") - - (* * internal function to SK.COPY.BUTTONEVENTFN that determines the elements - within the given bounds and selects or deselects them.) + + (* * internal function to SK.COPY.BUTTONEVENTFN that determines the elements + within the given bounds and selects or deselects them.) (PROG (SELITEMS) (RETURN (COND @@ -1243,12 +1347,12 @@ This will be slow for arcs and curves."] DELETEMODE]) (LIGHTGRAYWINDOW - [LAMBDA (WINDOW) (* rrb "28-Jun-84 10:27") + [LAMBDA (WINDOW) (* rrb "28-Jun-84 10:27") (DSPFILL NIL 1 'INVERT WINDOW) WINDOW]) (SK.ADD.SPACES - [LAMBDA (STRLST) (* rrb "19-Jul-85 15:11") + [LAMBDA (STRLST) (* rrb "19-Jul-85 15:11") (* adds eols between the elements of  STRLST) (for STR in STRLST join (COND @@ -1262,15 +1366,15 @@ This will be slow for arcs and curves."] "]) (SK.SKETCH.MENU - [LAMBDA (SKW) (* rrb "12-Sep-85 11:50") + [LAMBDA (SKW) (* rrb "12-Sep-85 11:50") (* brings up the normal sketch command  menu.) (SK.MIDDLE.TITLEFN SKW T]) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN - [LAMBDA (GELT SKETCHW) (* rrb "19-Oct-85 17:10") - - (* check to see if a when deleted function needs to be applied and applies it.) + [LAMBDA (GELT SKETCHW) (* rrb "19-Oct-85 17:10") + + (* check to see if a when deleted function needs to be applied and applies it.) (SELECTQ (fetch (GLOBALPART GTYPE) of GELT) (SKIMAGEOBJ (* deleting an image object apply @@ -1282,7 +1386,7 @@ This will be slow for arcs and curves."] NIL]) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN - [LAMBDA (GELT SKETCHW) (* rrb "30-Jul-85 15:35") + [LAMBDA (GELT SKETCHW) (* rrb "30-Jul-85 15:35") (* applies the when deleted function  for an image object.) (PROG (IMAGEOBJ FN) @@ -1292,21 +1396,20 @@ This will be slow for arcs and curves."] INDIVIDUALGLOBALPART) of GELT))) 'WHENDELETEDFN)) - (NEQ FN 'NILL)) - - (* documentation calls for passing text streams as well but there aren't any.) - + (NEQ FN 'NILL)) (* documentation calls for passing + text streams as well but there aren't + any.) (APPLY* FN IMAGEOBJ SKETCHW]) (SK.RETURN.TTY - [LAMBDA (W) (* rrb "29-Aug-85 11:09") + [LAMBDA (W) (* rrb "29-Aug-85 11:09") (* gives up the tty when the window is  shrunken.) (AND (TTY.PROCESSP (WINDOWPROP W 'PROCESS)) (TTY.PROCESS T]) (SK.TAKE.TTY - [LAMBDA (W) (* rrb "29-Aug-85 11:10") + [LAMBDA (W) (* rrb "29-Aug-85 11:10") (* takes the tty when the window is  expanded) (TTY.PROCESS (WINDOWPROP W 'PROCESS]) @@ -1322,11 +1425,11 @@ This will be slow for arcs and curves."] [LAMBDA (ITEMS TITLE) (* ; "Edited 6-Nov-2025 22:36 by rmk") (* rrb "14-Jul-86 13:43") (create MENU - ITEMS _ ITEMS - CENTERFLG _ T - WHENSELECTEDFN _ (FUNCTION SKETCHW.SELECTIONFN) - MENUFONT _ (FONTCREATE BOLDFONT) - TITLE _ TITLE]) + ITEMS ← ITEMS + CENTERFLG ← T + WHENSELECTEDFN ← (FUNCTION SKETCHW.SELECTIONFN) + MENUFONT ← (FONTCREATE BOLDFONT) + TITLE ← TITLE]) (SKETCH.COMMANDMENU.ITEMS [LAMBDA (ADDFIXITEM ELEMENTTYPES VIEWER) (* rrb "24-Sep-86 18:11") @@ -1587,34 +1690,35 @@ This will be slow for arcs and curves."] '((inspect INSPECT.SKETCH "Calls the Inspector on the figure data structures."]) (CREATE.SKETCHW.COMMANDMENU - [LAMBDA (MENUTITLE ADDFIXITEM ELEMENTTYPES VIEWER) (* rrb " 6-May-86 15:22") + [LAMBDA (MENUTITLE ADDFIXITEM ELEMENTTYPES VIEWER) (* rrb " 6-May-86 15:22") (* returns the control menu for a  figure window.) (SKETCH.COMMANDMENU (SKETCH.COMMANDMENU.ITEMS ADDFIXITEM ELEMENTTYPES VIEWER) MENUTITLE]) (SKETCHW.SELECTIONFN - [LAMBDA (ITEM MENU) (* rrb "31-Jan-86 11:34") - - (* calls the function appropriate for the item selected from the command menu - associated with a figure window.) + [LAMBDA (ITEM MENU) (* rrb "31-Jan-86 11:34") + + (* calls the function appropriate for the item selected from the command menu + associated with a figure window.) (PROG [(SKW (WINDOWPROP (WFROMMENU MENU) 'MAINWINDOW] - (RETURN (RESETLST (COND - ((OBTAIN.MONITORLOCK (SKETCH.MONITORLOCK SKW) - T T) (* clear the prompt window if there is + (RETURN (RESETLST + (COND + ((OBTAIN.MONITORLOCK (SKETCH.MONITORLOCK SKW) + T T) (* clear the prompt window if there is  one.) - (CLOSEPROMPTWINDOW SKW) (* reset the line being drawn if there + (CLOSEPROMPTWINDOW SKW) (* reset the line being drawn if there  is one.) - (RESET.LINE.BEING.INPUT SKW) - (SK.APPLY.MENU.COMMAND (CADR ITEM) - SKW)) - (T (STATUSPRINT SKW " -" "Sketch operation in progress. Please wait."]) + (RESET.LINE.BEING.INPUT SKW) + (SK.APPLY.MENU.COMMAND (CADR ITEM) + SKW)) + (T (STATUSPRINT SKW " +" "Sketch operation in progress. Please wait."))))]) (SKETCH.MONITORLOCK - [LAMBDA (VIEWER) (* rrb "31-Jan-86 10:20") + [LAMBDA (VIEWER) (* rrb "31-Jan-86 10:20") (* returns the monitorlock for a  sketch) (OR (WINDOWPROP VIEWER 'MONITORLOCK) @@ -1623,10 +1727,9 @@ This will be slow for arcs and curves."] (RETURN LOCK]) (SK.EVAL.AS.PROCESS - [LAMBDA (FORM VIEWER) (* rrb "31-Jan-86 11:23") - - (* evals a form that grabs the sketch lock on its viewer in a process.) - + [LAMBDA (FORM VIEWER) (* rrb "31-Jan-86 11:23") + (* evals a form that grabs the sketch + lock on its viewer in a process.) (COND ((THIS.PROCESS) (ADD.PROCESS (LIST 'SK.EVAL.WITH.LOCK (KWOTE FORM) @@ -1638,20 +1741,18 @@ This will be slow for arcs and curves."] (\EVAL FORM]) (SK.EVAL.WITH.LOCK - [LAMBDA (FORM VIEWER) (* rrb "31-Jan-86 11:22") - - (* evals FORM in a context where it has the lock on VIEWER) - + [LAMBDA (FORM VIEWER) (* rrb "31-Jan-86 11:22") + (* evals FORM in a context where it + has the lock on VIEWER) (WITH.MONITOR (SKETCH.MONITORLOCK VIEWER) (EVAL FORM]) ) (DEFINEQ (SK.FIX.MENU - [LAMBDA (SKETCHW DONTOPENFLG) (* rrb "23-Sep-86 17:59") - - (* attaches the menu on the right side of the viewer.) - + [LAMBDA (SKETCHW DONTOPENFLG) (* rrb "23-Sep-86 17:59") + (* attaches the menu on the right side + of the viewer.) (PROG (MENUW) (OR (SETQ MENUW (SK.INSURE.HAS.MENU SKETCHW)) (RETURN)) (* clear the popup menu cache.) @@ -1669,20 +1770,18 @@ This will be slow for arcs and curves."] (OR DONTOPENFLG (OPENW MENUW]) (SK.SET.UP.MENUS - [LAMBDA (SKETCHW DONTOPENFLG MENUSPEC) (* rrb "23-Sep-86 17:59") + [LAMBDA (SKETCHW DONTOPENFLG MENUSPEC) (* rrb "23-Sep-86 17:59") (* attached the sketch menu to the  window.) (PROG (FIXEDMENUW POPUPMENUW FIXIT?) (COND - ((NULL MENUSPEC) - - (* mark window so both menus will come up if needed.) - + ((NULL MENUSPEC) (* mark window so both menus will come + up if needed.) (SETQ FIXEDMENUW (SETQ POPUPMENUW T))) ((type? MENU MENUSPEC) - - (* put the given menu as the fixed one and establish the standard one as the - SKETCHPOPUPMENU) + + (* put the given menu as the fixed one and establish the standard one as the + SKETCHPOPUPMENU) (SETQ FIXEDMENUW (MENUWINDOW MENUSPEC T)) (SETQ POPUPMENUW T) @@ -1714,21 +1813,19 @@ This will be slow for arcs and curves."] (AND FIXIT? (SK.FIX.MENU SKETCHW DONTOPENFLG]) (SK.INSURE.HAS.MENU - [LAMBDA (SKETCHW) (* rrb "23-Sep-86 17:59") + [LAMBDA (SKETCHW) (* rrb "23-Sep-86 17:59") (* makes sure a sketch window has a  menu.) (PROG [(FIXEDMENU (WINDOWPROP SKETCHW 'SKETCHFIXEDMENU] [COND ((EQ (WINDOWPROP SKETCHW 'SKETCHFIXEDMENU) - T) - - (* no fixed menu yet but wants standard one, create it) - + T) (* no fixed menu yet but wants + standard one, create it) (WINDOWPROP SKETCHW 'SKETCHFIXEDMENU (SETQ FIXEDMENU (SK.CREATE.STANDARD.MENU SKETCHW] (RETURN FIXEDMENU]) (SK.CREATE.STANDARD.MENU - [LAMBDA (VIEWER) (* rrb "23-Sep-86 17:52") + [LAMBDA (VIEWER) (* rrb "23-Sep-86 17:52") (* creates the standard sketch viewer  fixed menu window.) (RESETFORM (CURSOR WAITINGCURSOR) @@ -1736,49 +1833,44 @@ This will be slow for arcs and curves."] T]) (SK.ADD.ITEM.TO.MENU - [LAMBDA (OLDMENU NEWITEM) (* rrb "23-Sep-86 09:53") - - (* returns a menu that is like OLDMENU but has one additional item NEWITEM) - - (* clober enough fields to get the menu to redraw itself correctly.) - - (create MENU using OLDMENU ITEMS _ (APPEND (fetch (MENU ITEMS) of OLDMENU) + [LAMBDA (OLDMENU NEWITEM) (* rrb "23-Sep-86 09:53") + (* returns a menu that is like OLDMENU + but has one additional item NEWITEM) + (* clober enough fields to get the + menu to redraw itself correctly.) + (create MENU using OLDMENU ITEMS ← (APPEND (fetch (MENU ITEMS) of OLDMENU) (LIST NEWITEM)) - MENUCOLUMNS _ NIL MENUROWS _ NIL IMAGE _ NIL MENUGRID _ + MENUCOLUMNS ← NIL MENUROWS ← NIL IMAGE ← NIL MENUGRID ← (create REGION - LEFT _ 0 - BOTTOM _ 0]) + LEFT ← 0 + BOTTOM ← 0]) (SK.GET.VIEWER.POPUP.MENU - [LAMBDA (SKETCHW) (* rrb "24-Sep-86 10:31") - - (* gets the popup menu for a viewer. If the sketch menu is open, it creates a - standard one. If the sketch menu isn't open, it adds the fix menu item to it - and pops it up. It is cleared each time the menu is fixed.) + [LAMBDA (SKETCHW) (* rrb "24-Sep-86 10:31") + + (* gets the popup menu for a viewer. If the sketch menu is open, it creates a + standard one. If the sketch menu isn't open, it adds the fix menu item to it and + pops it up. It is cleared each time the menu is fixed.) (OR (WINDOWPROP SKETCHW 'SKETCHPOPUPMENUCACHE) (PROG [(SKETCHMENU (WINDOWPROP SKETCHW 'SKETCHFIXEDMENU] [COND [(OR (NULL SKETCHMENU) (OPENWP SKETCHMENU)) - - (* window doesn't want a fixed menu or its fixed menu is already open, check - for a popup one) + + (* window doesn't want a fixed menu or its fixed menu is already open, check for + a popup one) (COND ((EQ (SETQ SKETCHMENU (WINDOWPROP SKETCHW 'SKETCHPOPUPMENU)) T) (WINDOWPROP SKETCHW 'SKETCHPOPUPMENU (SETQ SKETCHMENU (SK.CREATE.STANDARD.MENU SKETCHW] - (T - - (* use the fixed menu with an item added to fix the menu.) - + (T (* use the fixed menu with an item + added to fix the menu.) [COND - ((EQ SKETCHMENU T) - - (* no fixed menu yet but wants standard one, create it) - + ((EQ SKETCHMENU T) (* no fixed menu yet but wants + standard one, create it) (WINDOWPROP SKETCHW 'SKETCHFIXEDMENU (SETQ SKETCHMENU (  SK.CREATE.STANDARD.MENU SKETCHW] @@ -1792,10 +1884,10 @@ This will be slow for arcs and curves."] (RETURN SKETCHMENU]) (SK.CLEAR.POPUP.MENU - [LAMBDA (MENUW) (* rrb "24-Sep-86 10:34") - - (* clears the cache of pop up window so that the fixed menu will be used if the - user middle buttons.) + [LAMBDA (MENUW) (* rrb "24-Sep-86 10:34") + + (* clears the cache of pop up window so that the fixed menu will be used if the + user middle buttons.) (PROG NIL (WINDOWPROP (OR (MAINWINDOW MENUW) @@ -1810,9 +1902,9 @@ This will be slow for arcs and curves."] (DEFINEQ (SKETCH.CREATE - [LAMBDA ARGS (* rrb " 6-Nov-85 11:16") + [LAMBDA ARGS (* rrb " 6-Nov-85 11:16") (PROG [(SKETCH (create SKETCH - SKETCHNAME _ (AND (GREATERP ARGS 0) + SKETCHNAME ← (AND (GREATERP ARGS 0) (ARG ARGS 1] (PUTSKETCHPROP SKETCH 'SKETCHCONTEXT (CREATE.DEFAULT.SKETCH.CONTEXT)) (PUTSKETCHPROP SKETCH 'VERSION SKETCH.VERSION) (* pick out the props that are @@ -1824,7 +1916,7 @@ This will be slow for arcs and curves."] (RETURN SKETCH]) (GETSKETCHPROP - [LAMBDA (SKETCH PROPERTY) (* rrb " 3-Mar-86 14:37") + [LAMBDA (SKETCH PROPERTY) (* rrb " 3-Mar-86 14:37") (* retrieves the property of a sketch) (PROG ((SKETCH (INSURE.SKETCH SKETCH)) SKETCHCONTEXT) @@ -1862,11 +1954,11 @@ This will be slow for arcs and curves."] PROPERTY]) (PUTSKETCHPROP - [LAMBDA (SKETCH PROPERTY VALUE) (* rrb " 3-Mar-86 13:58") - - (* stores a property on a sketch Returns VALUE. - Knows about the form of a sketch and does value checking - (or should.)) + [LAMBDA (SKETCH PROPERTY VALUE) (* rrb " 3-Mar-86 13:58") + + (* stores a property on a sketch Returns VALUE. + Knows about the form of a sketch and does value checking + (or should.)) (PROG ((SKETCH (INSURE.SKETCH SKETCH)) SKETCHCONTEXT PLIST) @@ -1877,13 +1969,13 @@ This will be slow for arcs and curves."] (BRUSH (replace (SKETCHCONTEXT SKETCHBRUSH) of SKETCHCONTEXT with VALUE)) (SHAPE (replace (SKETCHCONTEXT SKETCHBRUSH) of SKETCHCONTEXT with (create BRUSH using (fetch (SKETCHCONTEXT SKETCHBRUSH) of SKETCHCONTEXT) - BRUSHSHAPE _ VALUE))) + BRUSHSHAPE ← VALUE))) (SIZE (replace (SKETCHCONTEXT SKETCHBRUSH) of SKETCHCONTEXT with (create BRUSH using (fetch (SKETCHCONTEXT SKETCHBRUSH) of SKETCHCONTEXT) - BRUSHSIZE _ VALUE))) + BRUSHSIZE ← VALUE))) (COLOR (replace (SKETCHCONTEXT SKETCHBRUSH) of SKETCHCONTEXT with (create BRUSH using (fetch (SKETCHCONTEXT SKETCHBRUSH) of SKETCHCONTEXT) - BRUSHCOLOR _ VALUE))) + BRUSHCOLOR ← VALUE))) (FONT (replace (SKETCHCONTEXT SKETCHFONT) of SKETCHCONTEXT with VALUE)) (TEXTALIGNMENT (replace (SKETCHCONTEXT SKETCHTEXTALIGNMENT) of SKETCHCONTEXT with VALUE)) @@ -1896,13 +1988,13 @@ This will be slow for arcs and curves."] (TEXTURE (replace (SKETCHCONTEXT SKETCHFILLING) of SKETCHCONTEXT with (create SKFILLING using (fetch (SKETCHCONTEXT SKETCHFILLING) of SKETCHCONTEXT) - FILLING.TEXTURE _ VALUE))) + FILLING.TEXTURE ← VALUE))) ((BACKCOLOR FILLINGCOLOR) (replace (SKETCHCONTEXT SKETCHFILLING) of SKETCHCONTEXT with (create SKFILLING using (fetch (SKETCHCONTEXT SKETCHFILLING) of SKETCHCONTEXT ) - FILLING.COLOR _ VALUE))) + FILLING.COLOR ← VALUE))) (LINEMODE (replace (SKETCHCONTEXT SKETCHLINEMODE) of SKETCHCONTEXT with VALUE)) (ARCDIRECTION (replace (SKETCHCONTEXT SKETCHARCDIRECTION) of SKETCHCONTEXT with VALUE)) (MOVEMODE (replace (SKETCHCONTEXT SKETCHMOVEMODE) of SKETCHCONTEXT with VALUE)) @@ -1914,23 +2006,23 @@ This will be slow for arcs and curves."] (RETURN VALUE]) (CREATE.DEFAULT.SKETCH.CONTEXT - [LAMBDA NIL (* rrb "23-Sep-86 10:40") + [LAMBDA NIL (* rrb "23-Sep-86 10:40") (* returns a default sketch context) (create SKETCHCONTEXT - SKETCHBRUSH _ SK.DEFAULT.BRUSH - SKETCHFONT _ [OR SK.DEFAULT.FONT (SK.FONT.LIST (DEFAULTFONT 'DISPLAY] - SKETCHTEXTALIGNMENT _ SK.DEFAULT.TEXT.ALIGNMENT - SKETCHARROWHEAD _ (create ARROWHEAD - ARROWTYPE _ SK.DEFAULT.ARROW.TYPE - ARROWANGLE _ SK.DEFAULT.ARROW.ANGLE - ARROWLENGTH _ SK.DEFAULT.ARROW.LENGTH) - SKETCHDASHING _ SK.DEFAULT.DASHING - SKETCHUSEARROWHEAD _ NIL - SKETCHTEXTBOXALIGNMENT _ SK.DEFAULT.TEXTBOX.ALIGNMENT - SKETCHFILLING _ (SK.CREATE.DEFAULT.FILLING) - SKETCHLINEMODE _ T - SKETCHINPUTSCALE _ 1 - SKETCHDRAWINGMODE _ SK.DEFAULT.OPERATION]) + SKETCHBRUSH ← SK.DEFAULT.BRUSH + SKETCHFONT ← [OR SK.DEFAULT.FONT (SK.FONT.LIST (DEFAULTFONT 'DISPLAY] + SKETCHTEXTALIGNMENT ← SK.DEFAULT.TEXT.ALIGNMENT + SKETCHARROWHEAD ← (create ARROWHEAD + ARROWTYPE ← SK.DEFAULT.ARROW.TYPE + ARROWANGLE ← SK.DEFAULT.ARROW.ANGLE + ARROWLENGTH ← SK.DEFAULT.ARROW.LENGTH) + SKETCHDASHING ← SK.DEFAULT.DASHING + SKETCHUSEARROWHEAD ← NIL + SKETCHTEXTBOXALIGNMENT ← SK.DEFAULT.TEXTBOX.ALIGNMENT + SKETCHFILLING ← (SK.CREATE.DEFAULT.FILLING) + SKETCHLINEMODE ← T + SKETCHINPUTSCALE ← 1 + SKETCHDRAWINGMODE ← SK.DEFAULT.OPERATION]) ) (PUTPROPS SKETCH.CREATE ARGNAMES (NIL (NAME . DEFAULTS&VALUES) . U)) @@ -1942,15 +2034,15 @@ This will be slow for arcs and curves."] (DEFINEQ (SK.COPY.BUTTONEVENTFN - [LAMBDA (WINDOW) (* rrb "11-Jul-86 15:51") - - (* * handles the button event when a copy key and/or the delete is held down. - allows the user to select a group of the sketch elements from the sketch - WINDOW. This is very similar to SK.SELECT.MULTIPLE.ITEMS) - - (* the selection protocol is left to add, right to delete. - Multiple clicking in the same place upscales for both select and deselect. - Sweeping will select or deselect all of the items in the swept out area.) + [LAMBDA (WINDOW) (* rrb "11-Jul-86 15:51") + + (* * handles the button event when a copy key and/or the delete is held down. + allows the user to select a group of the sketch elements from the sketch WINDOW. + This is very similar to SK.SELECT.MULTIPLE.ITEMS) + + (* the selection protocol is left to add, right to delete. + Multiple clicking in the same place upscales for both select and deselect. + Sweeping will select or deselect all of the items in the swept out area.) (COND ([AND (TTY.PROCESSP (WINDOWPROP WINDOW 'PROCESS)) @@ -1980,10 +2072,8 @@ This will be slow for arcs and curves."] (T 'COPYSELECT] (DELETEMODE 'DELETE) (T (* keys aren't still down.) - (RETURN] - - (* create the cache for the elements that allow the current operation.) - + (RETURN] (* create the cache for the elements + that allow the current operation.) (SETQ HOTSPOTCACHE (SK.HOTSPOT.CACHE.FOR.OPERATION WINDOW OPERATION)) (COND ((NOT (SK.HAS.SOME.HOTSPOTS HOTSPOTCACHE)) (* no items don't do anything.) @@ -2003,39 +2093,33 @@ This will be slow for arcs and curves."] ((AND (LASTMOUSESTATE UP) (SK.BUTTONEVENT.OVERP COPYMODE DELETEMODE)) (SK.TAKE.MARKS.DOWN WINDOW HOTSPOTCACHE) - (RETURN))) - - (* MIDDLEONLYFLG is used to note case of picking characters out of a sketch.) - + (RETURN))) (* MIDDLEONLYFLG is used to note case + of picking characters out of a sketch.) (SETQ MIDDLEONLYFLG (LASTMOUSESTATE (ONLY MIDDLE))) SELECTLP (GETMOUSESTATE) (COND - ((SK.BUTTONEVENT.OVERP COPYMODE DELETEMODE) - - (* user let up copy key. Put sketch into input buffer.) - + ((SK.BUTTONEVENT.OVERP COPYMODE DELETEMODE) (* user let up copy key. + Put sketch into input buffer.) (SETQ RETURNVAL (WINDOWPROP WINDOW 'SKETCH.SELECTIONS)) (GO EXIT)) ([AND (LASTMOUSESTATE (NOT UP)) (OR (NOT (INSIDEP (WINDOWPROP WINDOW 'REGION) LASTMOUSEX LASTMOUSEY)) (NOT (SK.BUTTONEVENT.SAME.KEYS COPYMODE DELETEMODE] - - (* if a button is down, and either the keystate is different from entry or the - cursor is out of the window, stop this event.) + + (* if a button is down, and either the keystate is different from entry or the + cursor is out of the window, stop this event.) (SETQ RETURNVAL NIL) - (GO EXIT))) - - (* cursor is still inside or buttons are up, leave sketch selected.) - + (GO EXIT))) (* cursor is still inside or buttons + are up, leave sketch selected.) (SETQ NEWY (LASTMOUSEY WINDOW)) (SETQ NEWX (LASTMOUSEX WINDOW)) (COND ((NEQ PREVMOUSEBUTTONS LASTMOUSEBUTTONS) - - (* a button has gone up or down, mark this as the origin of a new box to sweep.) + + (* a button has gone up or down, mark this as the origin of a new box to sweep.) (SETQ ORIGX NEWX) (SETQ ORIGY NEWY) @@ -2053,10 +2137,9 @@ This will be slow for arcs and curves."] (for SELITEM in (LOCALSPECS.FROM.VIEWER WINDOW) do (SK.ADD.SELECTION SELITEM WINDOW (SK.BUTTONEVENT.MARK COPYMODE DELETEMODE] - (T - - (* thing selected is a the whole sketch, clear everything and start over.) - + (T (* thing selected is a the whole + sketch, clear everything and start + over.) (for SELITEM in (LOCALSPECS.FROM.VIEWER WINDOW) do (SK.REMOVE.SELECTION SELITEM WINDOW (SK.BUTTONEVENT.MARK COPYMODE DELETEMODE))) @@ -2065,16 +2148,16 @@ This will be slow for arcs and curves."] (SETQ PREVMOUSEBUTTONS) (GO STARTOVERLP] [(LASTMOUSESTATE (NOT UP)) - - (* add or delete the element if any that the point is in. - This uses a different method which takes into account the size of the selection - knots which the area sweep doesn't.) + + (* add or delete the element if any that the point is in. + This uses a different method which takes into account the size of the selection + knots which the area sweep doesn't.) (COND ((SETQ NOW (IN.SKETCH.ELT? HOTSPOTCACHE (create POSITION - XCOORD _ NEWX - YCOORD _ NEWY))) + XCOORD ← NEWX + YCOORD ← NEWY))) (COND ([OR (AND (LASTMOUSESTATE (ONLY LEFT)) (NOT (SETQ MIDDLEONLYFLG))) @@ -2093,17 +2176,13 @@ This will be slow for arcs and curves."] ((OR (IGREATERP (IABS (IDIFFERENCE ORIGX NEWX)) SK.NO.MOVE.DISTANCE) (IGREATERP (IABS (IDIFFERENCE ORIGY NEWY)) - SK.NO.MOVE.DISTANCE)) - - (* make the first pick move further so that it is easier to multiple click.) - - (SETQ MOVEDMUCHFLG T))) - - (* cursor has moved more than the minimum amount since last noticed.) - - (* add or delete any with in the swept out area.) - - (SK.UPDATE.EVENT.SELECTION HOTSPOTCACHE ORIGX ORIGY NEWX NEWY SCALE WINDOW COPYMODE + SK.NO.MOVE.DISTANCE)) (* make the first pick move further so + that it is easier to multiple click.) + (SETQ MOVEDMUCHFLG T))) (* cursor has moved more than the + minimum amount since last noticed.) + (* add or delete any with in the swept + out area.) + (SK.UPDATE.EVENT.SELECTION HOTSPOTCACHE ORIGX ORIGY NEWX NEWY SCALE WINDOW COPYMODE DELETEMODE))) (SETQ OLDX NEWX) (SETQ OLDY NEWY) @@ -2115,11 +2194,9 @@ This will be slow for arcs and curves."] (SK.BUTTONEVENT.MARK COPYMODE DELETEMODE))) (SK.TAKE.MARKS.DOWN WINDOW HOTSPOTCACHE) - (CLOSEPROMPTWINDOW WINDOW) - - (* if middle was the only button used to select, return only the text - characters.) - + (CLOSEPROMPTWINDOW WINDOW) (* if middle was the only button used + to select, return only the text + characters.) (RETURN (AND RETURNVAL (COND [(TTY.PROCESSP (WINDOWPROP WINDOW 'PROCESS)) (* the results will be going to this @@ -2133,7 +2210,7 @@ This will be slow for arcs and curves."] (MIDDLEONLYFLG (* if middle only, just get the  characters.) - (COPYINSERT (SK.BUILD.IMAGEOBJ RETURNVAL + (COPYINSERT (SK.BUILD.IMAGEOBJ RETURNVAL WINDOW T))) (T (SK.COPY.ELEMENTS RETURNVAL WINDOW] (DELETEMODE (* delete them) @@ -2142,10 +2219,9 @@ This will be slow for arcs and curves."] MIDDLEONLYFLG]) (SK.BUTTONEVENT.MARK - [LAMBDA (COPYFLG DELETEFLG) (* rrb "29-Dec-84 19:02") - - (* returns the mark that should be put on the points when they are selected.) - + [LAMBDA (COPYFLG DELETEFLG) (* rrb "29-Dec-84 19:02") + (* returns the mark that should be put + on the points when they are selected.) (COND (DELETEFLG (COND (COPYFLG MOVESELECTIONMARK) @@ -2153,60 +2229,53 @@ This will be slow for arcs and curves."] (T COPYSELECTIONMARK]) (SK.BUILD.IMAGEOBJ - [LAMBDA (SCRELTS SKW CHARSONLYFLG) (* ; "Edited 20-Jun-92 15:28 by rmk:") - (* builds an imageobj from the list - of screen elements.) + [LAMBDA (SCRELTS SKW CHARSONLYFLG) (* ; "Edited 20-Jun-92 15:28 by rmk:") + (* builds an imageobj from the list of + screen elements.) (COND [CHARSONLYFLG (* return only the text characters.) (PROG ((TEXTELTS (bind GELT for LOCALSKELT in SCRELTS - join (SELECTQ (fetch (GLOBALPART GTYPE) of (SETQ GELT - (fetch (SCREENELT - GLOBALPART) - of LOCALSKELT))) - (TEXT (LIST (LIST (fetch (TEXT LOCATIONLATLON) - of (SETQ GELT (fetch (GLOBALPART + join (SELECTQ (fetch (GLOBALPART GTYPE) of (SETQ GELT (fetch (SCREENELT GLOBALPART + ) of + LOCALSKELT + ))) + (TEXT (LIST (LIST (fetch (TEXT LOCATIONLATLON) + of (SETQ GELT (fetch (GLOBALPART + INDIVIDUALGLOBALPART) + of GELT))) + GELT))) + (TEXTBOX (LIST (LIST (SK.TEXTBOX.TEXT.POSITION (SETQ GELT + (fetch (GLOBALPART INDIVIDUALGLOBALPART - ) - of GELT))) - GELT))) - (TEXTBOX (LIST (LIST (SK.TEXTBOX.TEXT.POSITION (SETQ GELT - (fetch - (GLOBALPART - INDIVIDUALGLOBALPART - ) - of GELT))) - GELT))) - (SKIMAGEOBJ (* grab the imageobj too.) - (LIST (LIST (create - POSITION - XCOORD _ [fetch (REGION LEFT) - of - (fetch (SKIMAGEOBJ - SKIMOBJ.GLOBALREGION - ) - of (SETQ GELT - (fetch - (GLOBALPART - INDIVIDUALGLOBALPART - ) - of GELT] - YCOORD _ (fetch (REGION BOTTOM) - of (fetch (SKIMAGEOBJ - - SKIMOBJ.GLOBALREGION - ) + ) of GELT))) - GELT))) - NIL))) + GELT))) + (SKIMAGEOBJ (* grab the imageobj too.) + (LIST (LIST (create POSITION + XCOORD ← + [fetch (REGION LEFT) + of (fetch (SKIMAGEOBJ + SKIMOBJ.GLOBALREGION) + of (SETQ GELT (fetch (GLOBALPART + + INDIVIDUALGLOBALPART + ) + of GELT] + YCOORD ← (fetch (REGION BOTTOM) + of (fetch (SKIMAGEOBJ + SKIMOBJ.GLOBALREGION + ) + of GELT))) + GELT))) + NIL))) CHARSLST) (* sort according to top from the - left.) + left.) [SORT TEXTELTS (FUNCTION (LAMBDA (A B) (COND - [(GREATERP (fetch (POSITION YCOORD) - of (SETQ A (CAR A))) - (fetch (POSITION YCOORD) - of (SETQ B (CAR B] + [(GREATERP (fetch (POSITION YCOORD) of (SETQ A + (CAR A))) + (fetch (POSITION YCOORD) of (SETQ B (CAR B] ((EQUAL (fetch (POSITION YCOORD) of A) (fetch (POSITION YCOORD) of B)) (LESSP (fetch (POSITION XCOORD) of A) @@ -2214,78 +2283,68 @@ This will be slow for arcs and curves."] (RETURN (COND ((EQUAL [CAR (LAST (SETQ CHARSLST (for TEXTELT in TEXTELTS - join (* collect relevant parts.) - (COND - [(EQ 'SKIMAGEOBJ (fetch ( - INDIVIDUALGLOBALPART - GTYPE) - of (CADR TEXTELT))) + join (* collect relevant parts.) + (COND + [(EQ 'SKIMAGEOBJ (fetch (INDIVIDUALGLOBALPART + GTYPE) + of (CADR TEXTELT))) (* copy image object so that copyfn is called. - This also copies the part of the image object that are sketch relevent - unnecessarily but it keeps copyfn call in one place.) + This also copies the part of the image object that are sketch relevent + unnecessarily but it keeps copyfn call in one place.) - (LIST (COPY.IMAGE.OBJECT - (fetch (SKIMAGEOBJ SKIMAGEOBJ) - of (CADR TEXTELT] - (T (SK.ADD.SPACES (fetch - (TEXT + (LIST (COPY.IMAGE.OBJECT (fetch (SKIMAGEOBJ + SKIMAGEOBJ) + of (CADR TEXTELT + ] + (T (SK.ADD.SPACES (fetch (TEXT LISTOFCHARACTERS - ) - of (CADR - TEXTELT - ] + ) + of (CADR TEXTELT] " -") (* strip off the trailing EOL that - was added.) +") (* strip off the trailing EOL that was + added.) (BUTLAST CHARSLST)) (T CHARSLST] [(AND (NOT (CDR SCRELTS)) - (EQ (fetch (GLOBALPART GTYPE) of (fetch (SCREENELT GLOBALPART) - of (CAR SCRELTS))) + (EQ (fetch (GLOBALPART GTYPE) of (fetch (SCREENELT GLOBALPART) of (CAR SCRELTS))) 'SKIMAGEOBJ)) (* ;; "RMK: singelton imageobject. Return an unencapsulated copy of it. Don't need to worry about sketch transformations that might have applied, since they don't affect imageobjects.") - (COPY.IMAGE.OBJECT (fetch (SKIMAGEOBJ SKIMAGEOBJ) of (FETCH (GLOBALPART - INDIVIDUALGLOBALPART - ) - OF (fetch - (SCREENELT GLOBALPART - ) - of (CAR SCRELTS - ] + (COPY.IMAGE.OBJECT (fetch (SKIMAGEOBJ SKIMAGEOBJ) of (FETCH (GLOBALPART INDIVIDUALGLOBALPART) + OF (fetch (SCREENELT GLOBALPART) + of (CAR SCRELTS] (T - (* return a sketch image object. The sketch is translated to bring its lower - left coordinate to 0,0 so that when it is put in a document it is in a - canonical place. Maybe don't need to do this anymore.) + (* return a sketch image object. The sketch is translated to bring its lower left + coordinate to 0,0 so that when it is put in a document it is in a canonical + place. Maybe don't need to do this anymore.) (SKETCH.IMAGEOBJ [create SKETCH using (INSURE.SKETCH SKW) - SKETCHNAME _ NIL SKETCHELTS _ + SKETCHNAME ← NIL SKETCHELTS ← (SK.SORT.GELTS.BY.PRIORITY (bind GELT for LOCALSKELT in SCRELTS collect (COND - ((EQ (fetch (GLOBALPART GTYPE) - of (SETQ GELT (fetch - (SCREENELT - GLOBALPART) - of LOCALSKELT - ))) - 'SKIMAGEOBJ) + ((EQ (fetch (GLOBALPART GTYPE) + of (SETQ GELT (fetch (SCREENELT GLOBALPART + ) of + LOCALSKELT + ))) + 'SKIMAGEOBJ) (* apply copy fn) - (SK.COPY.IMAGEOBJ GELT)) - (T (COPY GELT] + (SK.COPY.IMAGEOBJ GELT)) + (T (COPY GELT] (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS SCRELTS (VIEWER.SCALE SKW)) (VIEWER.SCALE SKW) (SK.GRIDFACTOR SKW]) (SK.BUTTONEVENT.OVERP - [LAMBDA (COPYMODE DELETEMODE) (* rrb " 1-Feb-85 18:39") - - (* determines if this button event is over by looking at the keys that are held - down. COPYMODE and DELETEMODE indicate the keystate at the entry point.) + [LAMBDA (COPYMODE DELETEMODE) (* rrb " 1-Feb-85 18:39") + + (* determines if this button event is over by looking at the keys that are held + down. COPYMODE and DELETEMODE indicate the keystate at the entry point.) (COND [DELETEMODE (AND (NOT (OR (.DELETEKEYDOWNP.) @@ -2296,21 +2355,19 @@ This will be slow for arcs and curves."] (COPYMODE (NULL (.COPYKEYDOWNP.]) (SK.BUTTONEVENT.SAME.KEYS - [LAMBDA (COPYMODE DELETEMODE) (* rrb " 1-Feb-85 18:39") - - (* determines if the same keys are held down now as were held down at the - start. If not, the event will be stopped. - COPYMODE and DELETEMODE indicate the keystate at the entry point.) + [LAMBDA (COPYMODE DELETEMODE) (* rrb " 1-Feb-85 18:39") + + (* determines if the same keys are held down now as were held down at the start. + If not, the event will be stopped. COPYMODE and DELETEMODE indicate the keystate + at the entry point.) (COND [DELETEMODE (AND (OR (.DELETEKEYDOWNP.) (.MOVEKEYDOWNP.)) (EQ COPYMODE (OR (.COPYKEYDOWNP.) (.MOVEKEYDOWNP.] - (COPYMODE - - (* if we are not in delete mode, ignore the state of the delete key.) - + (COPYMODE (* if we are not in delete mode, + ignore the state of the delete key.) (.COPYKEYDOWNP.]) ) (DECLARE%: EVAL@COMPILE @@ -2328,18 +2385,17 @@ This will be slow for arcs and curves."] (DEFINEQ (SK.SEL.AND.CHANGE - [LAMBDA (W) (* rrb "10-Dec-85 17:07") - - (* allows the user to select some elements and changes them.) - + [LAMBDA (W) (* rrb "10-Dec-85 17:07") + (* allows the user to select some + elements and changes them.) (SK.CHANGE.THING (SK.SELECT.MULTIPLE.ITEMS W T NIL 'CHANGE) W]) (SK.CHECK.WHENCHANGEDFN - [LAMBDA (VIEWER GELT PROPERTY NEWVALUE OLDVALUE) (* rrb " 3-Jan-86 18:36") - - (* checks if the sketch has a whenchange fn and if so, calls it and interprets - the result. Returns NIL if the change shouldn't be made.) + [LAMBDA (VIEWER GELT PROPERTY NEWVALUE OLDVALUE) (* rrb " 3-Jan-86 18:36") + + (* checks if the sketch has a whenchange fn and if so, calls it and interprets + the result. Returns NIL if the change shouldn't be made.) (PROG ((SKETCH (INSURE.SKETCH VIEWER)) RESULT WHENCHANGEDFN) @@ -2353,10 +2409,10 @@ This will be slow for arcs and curves."] (T (RETURN GELT]) (SK.CHECK.PRECHANGEFN - [LAMBDA (VIEWER SCRELT CHANGESPEC) (* rrb "27-Jun-86 15:51") - - (* checks if the sketch has a prechange fn and if so, calls it and interprets - the result. Returns NIL if the change shouldn't be made.) + [LAMBDA (VIEWER SCRELT CHANGESPEC) (* rrb "27-Jun-86 15:51") + + (* checks if the sketch has a prechange fn and if so, calls it and interprets the + result. Returns NIL if the change shouldn't be made.) (PROG ((SKETCH (INSURE.SKETCH VIEWER)) PRECHANGEFN) @@ -2366,14 +2422,15 @@ This will be slow for arcs and curves."] CHANGESPEC]) (SK.CHANGE.ELT - [LAMBDA (W) (* rrb "31-Jan-86 10:46") + [LAMBDA (W) (* rrb "31-Jan-86 10:46") (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.CHANGE (KWOTE W)) W]) (SK.CHANGE.THING - [LAMBDA (ELTSTOCHANGE W) (* rrb " 6-Jan-85 19:23") - - (* ELTSTOCHANGE is a sketch element that was selected for a CHANGE operation.) + [LAMBDA (ELTSTOCHANGE W) (* rrb " 6-Jan-85 19:23") + (* ELTSTOCHANGE is a sketch element + that was selected for a CHANGE + operation.) (* Change according to the first one  on the list) (PROG (FIRSTTYPE READCHANGEFN) (* find the first thing that has a @@ -2389,15 +2446,15 @@ This will be slow for arcs and curves."] ELTSTOCHANGE W]) (SKETCH.CHANGE.ELEMENTS - [LAMBDA (ELEMENTS CHANGESPECS SKETCHTOUPDATE ADDHISTORY?) (* rrb " 2-Oct-86 16:38") - - (* Changes the elements ELEMENTS according to the change specifications - CHANGESPECs. If SKETCHTOUPDATE is a viewer or a sketch. - it will be updated. If ADDHISTORY is non-NIL, the changes will be added to the - history list of SKETCHTOUPDATE which should be a viewer. - CHANGESPECs can be a list of the line, brush, text or arc properties, e.g. - ((TEXT BOLD) (SIZE LARGER) (DASHING (3 1 2 1))%. - The changes will be applied to any elements for which they make sense.)) + [LAMBDA (ELEMENTS CHANGESPECS SKETCHTOUPDATE ADDHISTORY?) (* rrb " 2-Oct-86 16:38") + + (* Changes the elements ELEMENTS according to the change specifications + CHANGESPECs. If SKETCHTOUPDATE is a viewer or a sketch. + it will be updated. If ADDHISTORY is non-NIL, the changes will be added to the + history list of SKETCHTOUPDATE which should be a viewer. + CHANGESPECs can be a list of the line, brush, text or arc properties, e.g. + ((TEXT BOLD) (SIZE LARGER) (DASHING (3 1 2 1))%. + The changes will be applied to any elements for which they make sense.)) (PROG ((VIEWER (SK.VIEWER.FROM.SKETCH.ARG SKETCHTOUPDATE)) RESULT) @@ -2408,10 +2465,10 @@ This will be slow for arcs and curves."] VIEWER NIL NIL (NULL ADDHISTORY?]) (SK.APPLY.SINGLE.CHANGEFN - [LAMBDA (GELEMENT CHANGEFN CHANGESPEC VIEWER) (* rrb " 2-Oct-86 10:49") - - (* applies a single change to an element. - It returns a change structure that contains the old and new elements.) + [LAMBDA (GELEMENT CHANGEFN CHANGESPEC VIEWER) (* rrb " 2-Oct-86 10:49") + + (* applies a single change to an element. + It returns a change structure that contains the old and new elements.) (COND ((EQ (fetch (GLOBALPART GTYPE) of GELEMENT) @@ -2420,10 +2477,10 @@ This will be slow for arcs and curves."] (T (APPLY* CHANGEFN GELEMENT CHANGESPEC VIEWER]) (SK.DO.CHANGESPECS - [LAMBDA (ELEMENT CHANGESPECS VIEWER) (* rrb " 2-Oct-86 16:31") - - (* returns a change structure that is the combined effects of applying all - CHANGESPECS to ELEMENT.) + [LAMBDA (ELEMENT CHANGESPECS VIEWER) (* rrb " 2-Oct-86 16:31") + + (* returns a change structure that is the combined effects of applying all + CHANGESPECS to ELEMENT.) (* for now, pretty kludgy) (PROG (NEWELEMENT) (COND @@ -2436,22 +2493,21 @@ This will be slow for arcs and curves."] NEWELT) of NEWELEMENT )) (T - - (* before one of the change specs applies, use the original element.) - + (* before one of the change specs + applies, use the original element.) ELEMENT)) CHANGESPEC VIEWER) NEWELEMENT))) (RETURN (AND NEWELEMENT (create SKHISTORYCHANGESPEC - OLDELT _ ELEMENT - NEWELT _ (fetch (SKHISTORYCHANGESPEC NEWELT) of NEWELEMENT) - PROPERTY _ CHANGESPECS]) + OLDELT ← ELEMENT + NEWELT ← (fetch (SKHISTORYCHANGESPEC NEWELT) of NEWELEMENT) + PROPERTY ← CHANGESPECS]) (SK.VIEWER.FROM.SKETCH.ARG - [LAMBDA (SKETCH) (* rrb " 2-Oct-86 10:57") - - (* returns the viewer that changes should be reflected in when SKETCH is passed - in as a sketch argument.) + [LAMBDA (SKETCH) (* rrb " 2-Oct-86 10:57") + + (* returns the viewer that changes should be reflected in when SKETCH is passed + in as a sketch argument.) (COND ((NULL SKETCH) @@ -2461,7 +2517,7 @@ This will be slow for arcs and curves."] (CAR (ALL.SKETCH.VIEWERS SKETCH]) (SK.DO.CHANGESPEC1 - [LAMBDA (ELEMENT CHANGESPEC VIEWER) (* rrb "23-Oct-86 14:21") + [LAMBDA (ELEMENT CHANGESPEC VIEWER) (* rrb "23-Oct-86 14:21") (* applies a single change spec to a  single element.) (PROG (CHANGEASPECTFN (CHANGEHOW (CADR CHANGESPEC))) @@ -2476,10 +2532,9 @@ This will be slow for arcs and curves."] ((TEXT NEWFONT SETSIZE SAME FAMILY&SIZE) (SETQ CHANGEHOW CHANGESPEC) (FUNCTION SK.CHANGE.TEXT)) - (ADDPOINT - - (* handle this specially because it shouldn't go inside of a group element.) - + (ADDPOINT (* handle this specially because it + shouldn't go inside of a group + element.) (RETURN (SK.ADD.KNOT.TO.ELEMENT ELEMENT CHANGEHOW))) (BRUSHCOLOR (FUNCTION SK.CHANGE.BRUSH.COLOR)) (FILLINGCOLOR (FUNCTION SK.CHANGE.FILLING.COLOR)) @@ -2489,26 +2544,26 @@ This will be slow for arcs and curves."] (RETURN (SK.APPLY.SINGLE.CHANGEFN ELEMENT CHANGEASPECTFN CHANGEHOW VIEWER]) (SK.CHANGEFN - [LAMBDA (ELEMENTTYPE) (* rrb " 8-Jan-86 17:15") - - (* returns the changefn for an element. The only one that isnt - SK.ELEMENTS.CHANGEFN is image objects.) + [LAMBDA (ELEMENTTYPE) (* rrb " 8-Jan-86 17:15") + + (* returns the changefn for an element. The only one that isnt + SK.ELEMENTS.CHANGEFN is image objects.) (* the changefn should return a list  of SKHISTORYCHANGESPEC instances.) (OR (fetch (SKETCHTYPE CHANGEFN) of (GETPROP ELEMENTTYPE 'SKETCHTYPE)) (FUNCTION SK.DEFAULT.CHANGEFN]) (SK.READCHANGEFN - [LAMBDA (ELEMENTTYPE) (* rrb " 6-Jan-85 18:29") - - (* used to be (OR & (FUNCTION SK.DEFAULT.CHANGEFN)) If this really isn't - necessary, clean out SK.DEFAULT.CHANGEFN and all the things only it calls. - If it is necessary, update it to include a readchangefn.) + [LAMBDA (ELEMENTTYPE) (* rrb " 6-Jan-85 18:29") + + (* used to be (OR & (FUNCTION SK.DEFAULT.CHANGEFN)) If this really isn't + necessary, clean out SK.DEFAULT.CHANGEFN and all the things only it calls. + If it is necessary, update it to include a readchangefn.) (fetch (SKETCHTYPE READCHANGEFN) of (GETPROP ELEMENTTYPE 'SKETCHTYPE]) (SK.DEFAULT.CHANGEFN - [LAMBDA (SCRNELT W FIELD) (* rrb "14-May-84 15:57") + [LAMBDA (SCRNELT W FIELD) (* rrb "14-May-84 15:57") (PROG ([FIELD (OR FIELD (SK.MENU.AND.RETURN.FIELD (fetch (SCREENELT GTYPE) of SCRNELT] (INDVELT (fetch (SCREENELT INDIVIDUALGLOBALPART) of SCRNELT)) (NOSETVALUE "str") @@ -2525,10 +2580,9 @@ This will be slow for arcs and curves."] (RECLOOK (fetch (SCREENELT GTYPE) of SCRNELT)) 'FETCH)) [COND - ((LISTP FIELD) - - (* cadr is queryfunction which can do special input and return value checking.) - + ((LISTP FIELD) (* cadr is queryfunction which can do + special input and return value + checking.) (SETQ NEWPROPVALUE (APPLY* (CADR FIELD) SCRNELT FIELD W NOSETVALUE))) (T (* have NIL returned be no change.) @@ -2550,34 +2604,33 @@ This will be slow for arcs and curves."] (RETURN (fetch (SCREENELT GLOBALPART) of SCRNELT]) (CHANGEABLEFIELDITEMS - [LAMBDA (ELEMENTTYPE) (* rrb "11-May-84 15:49") - - (* returns the list of fields that element type allows to change. - Each field should be of the form (FIELDNAMELABEL - (QUOTE (FIELDNAME QUERYFN)) "helpstring") - - QUERYFN should be a function of four args%: the screen element being changed, - the "field" returned from this function, the window the sketch is being - displayed in, and a value to be returned if no change should be made.) + [LAMBDA (ELEMENTTYPE) (* rrb "11-May-84 15:49") + + (* returns the list of fields that element type allows to change. + Each field should be of the form (FIELDNAMELABEL + (QUOTE (FIELDNAME QUERYFN)) "helpstring") - + QUERYFN should be a function of four args%: the screen element being changed, the "field" + returned from this function, the window the sketch is being displayed in, and a + value to be returned if no change should be made.) (GETPROP ELEMENTTYPE 'CHANGEABLEFIELDITEMS]) (SK.APPLY.CHANGE.COMMAND - [LAMBDA (CHANGEFN COMMAND SCRELTS SKW) (* rrb "24-Sep-86 16:23") - - (* applies a change command to the relevant elements in SCRELTS.) - + [LAMBDA (CHANGEFN COMMAND SCRELTS SKW) (* rrb "24-Sep-86 16:23") + (* applies a change command to the + relevant elements in SCRELTS.) (AND COMMAND (SK.DO.AND.RECORD.CHANGES (bind ELTCHANGE for SCRELT in SCRELTS - when (SETQ ELTCHANGE (SK.APPLY.CHANGE.COMMAND1 CHANGEFN + when (SETQ ELTCHANGE (SK.APPLY.CHANGE.COMMAND1 CHANGEFN COMMAND SCRELT SKW)) collect ELTCHANGE) SKW]) (SK.DO.AND.RECORD.CHANGES - [LAMBDA (LSTOFCHANGESPECS VIEWER DONTUPDATEPRIORITYFLG DONTDISPLAYFLG DONTHISTORYFLG) + [LAMBDA (LSTOFCHANGESPECS VIEWER DONTUPDATEPRIORITYFLG DONTDISPLAYFLG DONTHISTORYFLG) (* rrb " 2-Oct-86 16:22") - - (* accepts a list of change specs and actually updates the sketch, viewer and - history list.) + + (* accepts a list of change specs and actually updates the sketch, viewer and + history list.) (COND (LSTOFCHANGESPECS [SETQ LSTOFCHANGESPEC (COND @@ -2587,9 +2640,9 @@ This will be slow for arcs and curves."] (SORT.CHANGESPECS.BY.NEW.PRIORITY LSTOFCHANGESPECS)) (T - - (* order so that new priorities are assigned in the same relative order as the - old ones.) + + (* order so that new priorities are assigned in the same relative order as the + old ones.) (SORT.CHANGESPECS.BY.OLD.PRIORITY LSTOFCHANGESPECS] @@ -2598,10 +2651,10 @@ This will be slow for arcs and curves."] T]) (SK.APPLY.CHANGE.COMMAND1 - [LAMBDA (CHANGEFN COMMAND SCRELT VIEWER) (* rrb "27-Jun-86 15:48") - - (* applies a change command to a single screen element. - Does the prechangefn and whenchangefn checks.) + [LAMBDA (CHANGEFN COMMAND SCRELT VIEWER) (* rrb "27-Jun-86 15:48") + + (* applies a change command to a single screen element. + Does the prechangefn and whenchangefn checks.) (PROG (FNRESULT CHANGES) (COND @@ -2611,9 +2664,9 @@ This will be slow for arcs and curves."] ((LISTP FNRESULT) (* result was a different change  specification.) (SETQ COMMAND FNRESULT))) - - (* code was written to take a list but since prechangefn can change things at - the elements level, every element is done individually.) + + (* code was written to take a list but since prechangefn can change things at the + elements level, every element is done individually.) (OR (SETQ CHANGES (APPLY* CHANGEFN (LIST SCRELT) VIEWER COMMAND)) @@ -2627,7 +2680,7 @@ This will be slow for arcs and curves."] CHANGES]) (SK.ELEMENTS.CHANGEFN - [LAMBDA (SCRELTS SKW HOW) (* rrb " 2-Oct-86 16:18") + [LAMBDA (SCRELTS SKW HOW) (* rrb " 2-Oct-86 16:18") (* changefn for many sketch elements.) (PROG (CHANGEASPECTFN (CHANGEHOW (CADR HOW))) (OR (SETQ CHANGEASPECTFN (SELECTQ (CAR HOW) @@ -2641,10 +2694,8 @@ This will be slow for arcs and curves."] ((TEXT NEWFONT SETSIZE SAME FAMILY&SIZE) (SETQ CHANGEHOW HOW) (FUNCTION SK.CHANGE.TEXT)) - (ADDPOINT - - (* handle this specially because it only works on the first element.) - + (ADDPOINT (* handle this specially because it + only works on the first element.) (RETURN (LIST (SK.ADD.KNOT.TO.ELEMENT (fetch (SCREENELT GLOBALPART) of (CAR SCRELTS)) @@ -2660,10 +2711,10 @@ This will be slow for arcs and curves."] CHANGEASPECTFN CHANGEHOW SKW]) (READ.POINT.TO.ADD - [LAMBDA (SCRELT SKVIEWER) (* rrb "20-May-86 10:52") - - (* asks where a point should be added and where it should be. - Return a list (AfterPt NewPt)) + [LAMBDA (SCRELT SKVIEWER) (* rrb "20-May-86 10:52") + + (* asks where a point should be added and where it should be. + Return a list (AfterPt NewPt)) (PROG (AFTERPT NEWPT) (STATUSPRINT SKVIEWER "Select the point that the new point should follow.") @@ -2678,20 +2729,18 @@ This will be slow for arcs and curves."] (SK.MAP.INPUT.PT.TO.GLOBAL NEWPT SKVIEWER]) (GLOBAL.KNOT.FROM.LOCAL - [LAMBDA (LOCALKNOT SCRELT) (* rrb "20-Nov-85 11:05") - - (* returns the global knot that corresponds to a local one.) - + [LAMBDA (LOCALKNOT SCRELT) (* rrb "20-Nov-85 11:05") + (* returns the global knot that + corresponds to a local one.) (for LKNOT in (fetch (SCREENELT HOTSPOTS) of SCRELT) as GKNOT in (GETSKETCHELEMENTPROP (fetch (SCREENELT GLOBALPART) of SCRELT) 'DATA) when (EQUAL LKNOT LOCALKNOT) do (RETURN GKNOT]) (SK.ADD.KNOT.TO.ELEMENT - [LAMBDA (GELTWITHKNOTS PTS) (* rrb "16-Jan-86 12:23") - - (* adds a point to a knot element. The point - (CADR PTS) is added after (CAR PTS)) - + [LAMBDA (GELTWITHKNOTS PTS) (* rrb "16-Jan-86 12:23") + (* adds a point to a knot element. + The point (CADR PTS) is added after + (CAR PTS)) (PROG ((OLDKNOTS (GETSKETCHELEMENTPROP GELTWITHKNOTS 'DATA)) NEWKNOTS) [SETQ NEWKNOTS (for KNOT in OLDKNOTS join (COND @@ -2699,37 +2748,37 @@ This will be slow for arcs and curves."] (LIST KNOT (CADR PTS))) (T (LIST KNOT] (RETURN (create SKHISTORYCHANGESPEC - NEWELT _ (SK.CHANGE.ELEMENT.KNOTS GELTWITHKNOTS NEWKNOTS) - OLDELT _ GELTWITHKNOTS - PROPERTY _ 'DATA - NEWVALUE _ NEWKNOTS - OLDVALUE _ OLDKNOTS]) + NEWELT ← (SK.CHANGE.ELEMENT.KNOTS GELTWITHKNOTS NEWKNOTS) + OLDELT ← GELTWITHKNOTS + PROPERTY ← 'DATA + NEWVALUE ← NEWKNOTS + OLDVALUE ← OLDKNOTS]) (SK.GROUP.CHANGEFN - [LAMBDA (GROUPELT CHANGEASPECTFN CHANGEHOW SKW) (* rrb "10-Jan-86 12:15") - - (* maps a change function through all the elements of a group and returns a - change spec event if it takes on any of them.) + [LAMBDA (GROUPELT CHANGEASPECTFN CHANGEHOW SKW) (* rrb "10-Jan-86 12:15") + + (* maps a change function through all the elements of a group and returns a + change spec event if it takes on any of them.) (PROG (NEWELT) (SETQ NEWELT (SK.GROUP.CHANGEFN1 GROUPELT CHANGEASPECTFN CHANGEHOW SKW)) (OR NEWELT (RETURN)) (RETURN (create SKHISTORYCHANGESPEC - NEWELT _ NEWELT - OLDELT _ GROUPELT - PROPERTY _ 'DATA - NEWVALUE _ (fetch (GROUP LISTOFGLOBALELTS) of (fetch (GLOBALPART + NEWELT ← NEWELT + OLDELT ← GROUPELT + PROPERTY ← 'DATA + NEWVALUE ← (fetch (GROUP LISTOFGLOBALELTS) of (fetch (GLOBALPART INDIVIDUALGLOBALPART ) of NEWELT)) - OLDVALUE _ (fetch (GROUP LISTOFGLOBALELTS) of (fetch (GLOBALPART + OLDVALUE ← (fetch (GROUP LISTOFGLOBALELTS) of (fetch (GLOBALPART INDIVIDUALGLOBALPART ) of GROUPELT]) (SK.GROUP.CHANGEFN1 - [LAMBDA (GROUPELT CHANGEASPECTFN CHANGEHOW SKW) (* rrb "27-Jun-86 16:19") - - (* maps a change function through all the elements of a group and returns a new - element if it takes on any of them.) + [LAMBDA (GROUPELT CHANGEASPECTFN CHANGEHOW SKW) (* rrb "27-Jun-86 16:19") + + (* maps a change function through all the elements of a group and returns a new + element if it takes on any of them.) (PROG ((OLDSUBELTS (fetch (GROUP LISTOFGLOBALELTS) of (fetch (GLOBALPART INDIVIDUALGLOBALPART) of GROUPELT))) @@ -2740,14 +2789,14 @@ This will be slow for arcs and curves."] ((EQ (fetch (GLOBALPART GTYPE) of SUBELT) 'GROUP) (* handle a group by propagating it) - (SK.GROUP.CHANGEFN1 SUBELT CHANGEASPECTFN + (SK.GROUP.CHANGEFN1 SUBELT CHANGEASPECTFN CHANGEHOW SKW)) (T - - (* individual change functions return a change spec event, pull the new element - out of it. This throws aways a lot of information about what was changed but I - don't know any good way to save it so that it can be passed on undoing so don't - save it.) + + (* individual change functions return a change spec event, pull the new element + out of it. This throws aways a lot of information about what was changed but I + don't know any good way to save it so that it can be passed on undoing so don't + save it.) (fetch (SKHISTORYCHANGESPEC NEWELT) of (APPLY* CHANGEASPECTFN SUBELT @@ -2756,23 +2805,21 @@ This will be slow for arcs and curves."] NEWELT] (OR CHANGEDFLG (RETURN)) [SETQ NEWSUBELTS (for OLDSUBELT in OLDSUBELTS as NEWSUBELT in NEWSUBELTS - collect - - (* copy any unchanged elements so that user programs don't have to worry about - them.) - + collect (* copy any unchanged elements so that + user programs don't have to worry + about them.) (OR NEWSUBELT (SK.COPY.GLOBAL.ELEMENT OLDSUBELT] (RETURN (SK.UPDATE.GROUP.AFTER.CHANGE (create GLOBALPART - COMMONGLOBALPART _ (fetch (GLOBALPART + COMMONGLOBALPART ← (fetch (GLOBALPART COMMONGLOBALPART ) of GROUPELT) - INDIVIDUALGLOBALPART _ + INDIVIDUALGLOBALPART ← (create GROUP using (fetch (GLOBALPART INDIVIDUALGLOBALPART ) of GROUPELT) - LISTOFGLOBALELTS _ + LISTOFGLOBALELTS ← NEWSUBELTS]) ) (DECLARE%: DONTCOPY @@ -2789,20 +2836,16 @@ This will be slow for arcs and curves."] (DEFINEQ (ADD.ELEMENT.TO.SKETCH - [LAMBDA (GELT SKETCH) (* rrb "23-Jun-87 13:29") + [LAMBDA (GELT SKETCH) (* rrb "23-Jun-87 13:29") (* changes the global sketch) (PROG [(REALSKETCH (INSURE.SKETCH SKETCH)) (ELTPRI (\GETSKETCHELEMENTPROP1 GELT 'PRI] [COND ((EQ (fetch (GLOBALPART GTYPE) of GELT) - 'SKIMAGEOBJ) - - (* call the wheninsertedfn for this imageobj if there is one.) - - (PROG ((IMOBJ (fetch (SKIMAGEOBJ SKIMAGEOBJ) of (fetch (GLOBALPART - INDIVIDUALGLOBALPART - ) - of GELT))) + 'SKIMAGEOBJ) (* call the wheninsertedfn for this + imageobj if there is one.) + (PROG ((IMOBJ (fetch (SKIMAGEOBJ SKIMAGEOBJ) of (fetch (GLOBALPART INDIVIDUALGLOBALPART + ) of GELT))) DATUM) (COND ((AND (SETQ DATUM (IMAGEOBJPROP IMOBJ 'WHENINSERTEDFN)) @@ -2811,10 +2854,8 @@ This will be slow for arcs and curves."] NIL SKETCH))) (RETURN] (COND - ((NULL ELTPRI) - - (* give the element a priority and put it at the end) - + ((NULL ELTPRI) (* give the element a priority and put + it at the end) (SK.SET.ELEMENT.PRIORITY GELT (SK.POP.NEXT.PRIORITY REALSKETCH)) (TCONC (fetch (SKETCH SKETCHTCELL) of REALSKETCH) GELT)) @@ -2822,7 +2863,7 @@ This will be slow for arcs and curves."] (SK.MARK.DIRTY REALSKETCH]) (ADD.SKETCH.VIEWER - [LAMBDA (SKETCH VIEWER) (* rrb " 8-APR-83 17:56") + [LAMBDA (SKETCH VIEWER) (* rrb " 8-APR-83 17:56") (* adds VIEWER as a viewer of SKETCH.) (PROG (VIEWERS) (COND @@ -2834,7 +2875,7 @@ This will be slow for arcs and curves."] ALL.SKETCHES]) (REMOVE.SKETCH.VIEWER - [LAMBDA (SKETCH VIEWER) (* rrb "26-Apr-85 16:56") + [LAMBDA (SKETCH VIEWER) (* rrb "26-Apr-85 16:56") (* removes VIEWER as a viewer of  SKETCH.) (PROG (VIEWERS) @@ -2845,10 +2886,9 @@ This will be slow for arcs and curves."] (SETQ ALL.SKETCHES (REMOVE VIEWERS ALL.SKETCHES]) (ALL.SKETCH.VIEWERS - [LAMBDA (SKETCH) (* rrb " 8-APR-83 14:20") - - (* returns the list of all active viewers of a sketch) - + [LAMBDA (SKETCH) (* rrb " 8-APR-83 14:20") + (* returns the list of all active + viewers of a sketch) (CDR (VIEWER.BUCKET SKETCH]) (SKETCH.ALL.VIEWERS @@ -2857,65 +2897,58 @@ This will be slow for arcs and curves."] (ALL.SKETCH.VIEWERS (INSURE.SKETCH SKETCH]) (VIEWER.BUCKET - [LAMBDA (SKETCH) (* rrb " 8-APR-83 14:20") + [LAMBDA (SKETCH) (* rrb " 8-APR-83 14:20") (FASSOC SKETCH ALL.SKETCHES]) (ELT.INSIDE.REGION? - [LAMBDA (GLOBALPART WORLDREG) (* rrb " 4-AUG-83 14:51") - - (* determines if any part of an element is inside the region WORLDREG) - + [LAMBDA (GLOBALPART WORLDREG) (* rrb " 4-AUG-83 14:51") + (* determines if any part of an + element is inside the region WORLDREG) (APPLY* (SK.INSIDEFN (fetch (GLOBALPART GTYPE) of GLOBALPART)) GLOBALPART WORLDREG]) (ELT.INSIDE.SKWP - [LAMBDA (GLOBALPART SKETCHW) (* rrb "25-Nov-85 17:46") - - (* determines if a global element is in the world region of a map window.) - + [LAMBDA (GLOBALPART SKETCHW) (* rrb "25-Nov-85 17:46") + (* determines if a global element is + in the world region of a map window.) (ELT.INSIDE.REGION? GLOBALPART (SKETCH.REGION.VIEWED SKETCHW]) (SCALE.FROM.SKW - [LAMBDA (WINDOW) (* rrb "11-MAR-83 11:52") + [LAMBDA (WINDOW) (* rrb "11-MAR-83 11:52") (* gets the scale of a sketch window.) (WINDOWPROP WINDOW 'SCALE]) (SK.ADDELT.TO.WINDOW - [LAMBDA (PELT SKETCHW) (* rrb "10-Mar-86 14:56") - - (* adds a picture element to a sketch window. - Returns the element that was added.) - + [LAMBDA (PELT SKETCHW) (* rrb "10-Mar-86 14:56") + (* adds a picture element to a sketch + window. Returns the element that was + added.) (COND (PELT (SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH (WINDOWPROP SKETCHW 'SKETCHSPECS) PELT) [PROG ((CACHE (SK.HOTSPOT.CACHE SKETCHW))) (COND - (CACHE - - (* if there is a cache, adding an element will change it) - + (CACHE (* if there is a cache, adding an + element will change it) (SK.ADD.HOTSPOTS.TO.CACHE1 PELT CACHE)) - (T - - (* if this is the first, must set the window property too.) - + (T (* if this is the first, must set the + window property too.) (SK.SET.HOTSPOT.CACHE SKETCHW (SK.ADD.HOTSPOTS.TO.CACHE1 PELT CACHE] PELT]) (SK.CALC.REGION.VIEWED - [LAMBDA (WINDOW SCALE) (* rrb "29-APR-83 08:37") + [LAMBDA (WINDOW SCALE) (* rrb "29-APR-83 08:37") (* returns the region of the sketch  visible in window.) (UNSCALE.REGION (DSPCLIPPINGREGION NIL WINDOW) SCALE]) (SK.DRAWFIGURE - [LAMBDA (SCREENELT STREAM REGION SCALE) (* rrb "30-Aug-84 14:31") - - (* draws an element of a sketch in a window. - Makes sure the scale of the current drawing is with in the limits of the - element. Returns SCREENELT) + [LAMBDA (SCREENELT STREAM REGION SCALE) (* rrb "30-Aug-84 14:31") + + (* draws an element of a sketch in a window. + Makes sure the scale of the current drawing is with in the limits of the element. + Returns SCREENELT) (PROG (GLOBALPART) [COND @@ -2933,20 +2966,20 @@ This will be slow for arcs and curves."] (RETURN SCREENELT]) (SK.DRAWFIGURE1 - [LAMBDA (ELT SKW REGION) (* rrb "14-Sep-84 16:59") + [LAMBDA (ELT SKW REGION) (* rrb "14-Sep-84 16:59") (* displays a sketch element in a  window) (APPLY* (SK.DRAWFN (fetch (SCREENELT GTYPE) of ELT)) ELT SKW REGION]) (SK.LOCAL.FROM.GLOBAL - [LAMBDA (GELT SKSTREAM SCALE) (* rrb "11-Jul-86 15:56") - - (* returns the element instance of the global element GELT expanded into the - window SKW.) - - (* SKSTREAM can be deleted from call once TEXT.EXPANDFN no longer needs to - distinquish INTERPRESS stream from windows.) + [LAMBDA (GELT SKSTREAM SCALE) (* rrb "11-Jul-86 15:56") + (* returns the element instance of the + global element GELT expanded into the + window SKW.) + + (* SKSTREAM can be deleted from call once TEXT.EXPANDFN no longer needs to + distinquish INTERPRESS stream from windows.) (PROG ((SCRELT (APPLY* (SK.EXPANDFN (fetch (GLOBALPART GTYPE) of GELT)) GELT @@ -2962,10 +2995,10 @@ This will be slow for arcs and curves."] (RETURN SCRELT]) (SKETCH.REGION.VIEWED - [LAMBDA (VIEWER NEWREGION) (* rrb "23-Apr-87 12:20") - - (* returns the region in sketch coordinates of the area visible in SKETCHW.) - + [LAMBDA (VIEWER NEWREGION) (* rrb "23-Apr-87 12:20") + (* returns the region in sketch + coordinates of the area visible in + SKETCHW.) (COND [(IMAGEOBJP VIEWER) (* it is a sketch image object) (PROG ([SK? (LISTP (IMAGEOBJPROP VIEWER 'OBJECTDATUM] @@ -2973,62 +3006,57 @@ This will be slow for arcs and curves."] (COND [(type? SKETCH (FETCH (SKETCHIMAGEOBJ SKIO.SKETCH) OF SK?)) (RETURN (PROG1 (fetch (SKETCHIMAGEOBJ SKIO.REGION) of SK?) - (COND - (NEWREGION (COND - ((REGIONP NEWREGION) - (replace (SKETCHIMAGEOBJ SKIO.REGION) - of SK? with NEWREGION)) - ((SETQ NEWVIEW (SKETCH.VIEW.FROM.NAME NEWREGION - VIEWER)) - (replace (SKETCHIMAGEOBJ SKIO.REGION) - of SK? with NEWVIEW)) - ((EQ NEWREGION 'HOME) - - (* change scale to 1.0 and set lower left of region viewed to - (0,0)%.) - - NIL) - (T - - (* HOME and named views aren't supported for image object sketches.) - - (\ILLEGAL.ARG NEWREGION] + [COND + (NEWREGION (COND + ((REGIONP NEWREGION) + (replace (SKETCHIMAGEOBJ SKIO.REGION) of SK? + with NEWREGION)) + ((SETQ NEWVIEW (SKETCH.VIEW.FROM.NAME NEWREGION VIEWER + )) + (replace (SKETCHIMAGEOBJ SKIO.REGION) of SK? + with NEWVIEW)) + ((EQ NEWREGION 'HOME) + (* change scale to 1.0 and set lower + left of region viewed to + (0,0)%.) + NIL) + (T (* HOME and named views aren't + supported for image object sketches.) + (\ILLEGAL.ARG NEWREGION])] (T (ERROR "not a sketch image object" VIEWER] [(WINDOWP VIEWER) (PROG1 (WINDOWPROP VIEWER 'REGION.VIEWED) - (COND - (NEWREGION (PROG (NEWVIEW) - (RETURN (COND - ((REGIONP NEWREGION) - (SKETCH.GLOBAL.REGION.ZOOM VIEWER NEWREGION)) - ((EQ NEWREGION 'HOME) - (SKETCH.HOME VIEWER)) - ((SETQ NEWVIEW (SKETCH.VIEW.FROM.NAME NEWREGION - VIEWER)) - (SK.MOVE.TO.VIEW VIEWER NEWVIEW)) - (T (\ILLEGAL.ARG NEWREGION] + [COND + (NEWREGION (PROG (NEWVIEW) + (RETURN (COND + ((REGIONP NEWREGION) + (SKETCH.GLOBAL.REGION.ZOOM VIEWER NEWREGION)) + ((EQ NEWREGION 'HOME) + (SKETCH.HOME VIEWER)) + ((SETQ NEWVIEW (SKETCH.VIEW.FROM.NAME NEWREGION VIEWER)) + (SK.MOVE.TO.VIEW VIEWER NEWVIEW)) + (T (\ILLEGAL.ARG NEWREGION])] (T (\ILLEGAL.ARG VIEWER]) (SKETCH.VIEW.FROM.NAME - [LAMBDA (VIEWNAME SKETCHW) (* rrb "25-Nov-85 17:55") - - (* returns the view structure for a view given its name.) - + [LAMBDA (VIEWNAME SKETCHW) (* rrb "25-Nov-85 17:55") + (* returns the view structure for a + view given its name.) (for SAVEDVIEW in (GETSKETCHPROP (INSURE.SKETCH SKETCHW) 'VIEWS) when (EQUAL VIEWNAME (fetch (SKETCHVIEW VIEWNAME) of SAVEDVIEW)) do (RETURN SAVEDVIEW]) (SK.UPDATE.REGION.VIEWED - [LAMBDA (SKW) (* rrb "11-Jul-86 15:51") + [LAMBDA (SKW) (* rrb "11-Jul-86 15:51") (* updates the REGION.VIEWED property  of a window.) (WINDOWPROP SKW 'REGION.VIEWED (SK.CALC.REGION.VIEWED SKW (VIEWER.SCALE SKW]) (SKETCH.ADD.AND.DISPLAY - [LAMBDA (GELT SKETCHW DONTCLEARCURSOR) (* rrb "14-Nov-84 17:12") - - (* adds a new element to a sketch window and handles propagation to all other - figure windows) + [LAMBDA (GELT SKETCHW DONTCLEARCURSOR) (* rrb "14-Nov-84 17:12") + + (* adds a new element to a sketch window and handles propagation to all other + figure windows) (COND (GELT (SK.ADD.HISTEVENT 'ADD (LIST GELT) @@ -3036,10 +3064,9 @@ This will be slow for arcs and curves."] (SK.ADD.ELEMENT GELT SKETCHW DONTCLEARCURSOR]) (SKETCH.ADD.AND.DISPLAY1 - [LAMBDA (GELT SKETCHW SCALE NODISPLAYFLG) (* rrb "11-Jul-86 15:51") - - (* displays a sketch element and adds it to the window.) - + [LAMBDA (GELT SKETCHW SCALE NODISPLAYFLG) (* rrb "11-Jul-86 15:51") + (* displays a sketch element and adds + it to the window.) (COND (GELT (COND (NODISPLAYFLG (SK.ADD.ITEM GELT SKETCHW)) @@ -3047,19 +3074,18 @@ This will be slow for arcs and curves."] SKETCHW NIL (OR SCALE (VIEWER.SCALE SKETCHW]) (SK.ADD.ITEM - [LAMBDA (GELT SKETCHW) (* rrb "10-APR-83 13:38") - - (* adds a global element to a window. Returns the local element that was - actually added.) + [LAMBDA (GELT SKETCHW) (* rrb "10-APR-83 13:38") + + (* adds a global element to a window. Returns the local element that was actually + added.) (SK.ADDELT.TO.WINDOW (SK.LOCAL.FROM.GLOBAL GELT SKETCHW) SKETCHW]) (SKETCHW.ADD.INSTANCE - [LAMBDA (TYPE SKW) (* rrb "14-Nov-84 17:08") - - (* reads an instance of type TYPE from the user and displays it in SKW.) - + [LAMBDA (TYPE SKW) (* rrb "14-Nov-84 17:08") + (* reads an instance of type TYPE from + the user and displays it in SKW.) (PROG ((ELT (SK.INPUT TYPE SKW))) (AND ELT (SKETCH.ADD.AND.DISPLAY ELT SKW)) (RETURN ELT]) @@ -3072,14 +3098,14 @@ This will be slow for arcs and curves."] (DEFINEQ (SK.SEL.AND.DELETE - [LAMBDA (W) (* rrb "10-Dec-85 17:08") + [LAMBDA (W) (* rrb "10-Dec-85 17:08") (* lets the user select elements and  deletes them) (SK.DELETE.ELEMENT (SK.SELECT.MULTIPLE.ITEMS W T NIL 'DELETE) W]) (SK.ERASE.AND.DELETE.ITEM - [LAMBDA (SELELT SKW NODISPLAYFLG) (* rrb "30-Jul-85 15:36") + [LAMBDA (SELELT SKW NODISPLAYFLG) (* rrb "30-Jul-85 15:36") (* removes a sketch element from a  viewer.) (COND @@ -3087,11 +3113,11 @@ This will be slow for arcs and curves."] (SK.DELETE.ITEM SELELT SKW]) (REMOVE.ELEMENT.FROM.SKETCH - [LAMBDA (GELT SKETCH INSIDEGROUPFLG) (* rrb "26-Sep-86 13:24") - - (* changes the global sketch Returns the element or the group element - containing the element if the element was found in the sketch. - If INSIDEGROUPFLG is T, it will go inside of groups.) + [LAMBDA (GELT SKETCH INSIDEGROUPFLG) (* rrb "26-Sep-86 13:24") + + (* changes the global sketch Returns the element or the group element containing + the element if the element was found in the sketch. + If INSIDEGROUPFLG is T, it will go inside of groups.) (PROG ((SKETCHDATA (INSURE.SKETCH SKETCH))) (COND @@ -3108,10 +3134,10 @@ This will be slow for arcs and curves."] (T (RETURN NIL]) (SK.DELETE.ELEMENT - [LAMBDA (ELTSTODEL SKETCHW ELTSFORHISTORY) (* rrb "30-Dec-85 16:19") - - (* deletes a list of element to a sketch window and handles propagation to all - other figure windows) + [LAMBDA (ELTSTODEL SKETCHW ELTSFORHISTORY) (* rrb "30-Dec-85 16:19") + + (* deletes a list of element to a sketch window and handles propagation to all + other figure windows) (SKED.CLEAR.SELECTION SKETCHW) (AND ELTSTODEL (SK.DELETE.ELEMENT2 (for SCRELT in ELTSTODEL collect (fetch (SCREENELT GLOBALPART) @@ -3119,10 +3145,10 @@ This will be slow for arcs and curves."] SKETCHW ELTSFORHISTORY]) (SK.DELETE.ELEMENT2 - [LAMBDA (GELTSTODEL SKETCHW ELTSFORHISTORY) (* rrb "30-Dec-85 16:18") - - (* deletes a list of global elements and adds it to the history list depending - upon ELTSFORHISTORY) + [LAMBDA (GELTSTODEL SKETCHW ELTSFORHISTORY) (* rrb "30-Dec-85 16:18") + + (* deletes a list of global elements and adds it to the history list depending + upon ELTSFORHISTORY) (PROG (DELETEDELTS) (SETQ DELETEDELTS (SK.CHECK.WHENDELETEDFN SKETCHW GELTSTODEL)) @@ -3134,15 +3160,14 @@ This will be slow for arcs and curves."] (RETURN DELETEDELTS]) (SK.DELETE.KNOT - [LAMBDA (W) (* rrb "31-Jan-86 10:47") - - (* lets the user select a knot in a curve or wire and deletes it.) - + [LAMBDA (W) (* rrb "31-Jan-86 10:47") + (* lets the user select a knot in a + curve or wire and deletes it.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.DELETE.KNOT (KWOTE W)) W]) (SK.SEL.AND.DELETE.KNOT - [LAMBDA (W) (* rrb "10-Dec-85 17:03") + [LAMBDA (W) (* rrb "10-Dec-85 17:03") (* lets the user select a knot and  deletes it.) (PROG [(KNOTELTS (SUBSET (LOCALSPECS.FROM.VIEWER W) @@ -3160,7 +3185,7 @@ This will be slow for arcs and curves."] KNOTELTS W]) (SK.DELETE.ELEMENT.KNOT - [LAMBDA (LOCALKNOT SCRELTS SKW) (* rrb " 9-Jan-86 19:45") + [LAMBDA (LOCALKNOT SCRELTS SKW) (* rrb " 9-Jan-86 19:45") (* deletes a knot from a curve or wire  element.) (SKED.CLEAR.SELECTION SKW) @@ -3196,11 +3221,11 @@ This will be slow for arcs and curves."]  screen) (SK.UPDATE.ELEMENTS (SETQ CHANGES (CONS (create SKHISTORYCHANGESPEC - NEWELT _ NEWELT - OLDELT _ GLOBALPART - PROPERTY _ 'DATA - NEWVALUE _ NEWKNOTS - OLDVALUE _ GLOBALKNOTS))) + NEWELT ← NEWELT + OLDELT ← GLOBALPART + PROPERTY ← 'DATA + NEWVALUE ← NEWKNOTS + OLDVALUE ← GLOBALKNOTS))) SKW) (SK.ADD.HISTEVENT 'CHANGE CHANGES SKW] (T (* delete the whole element.) @@ -3208,11 +3233,11 @@ This will be slow for arcs and curves."] SKW]) (SK.CHECK.WHENDELETEDFN - [LAMBDA (VIEWER GELTS) (* rrb "30-Dec-85 16:15") - - (* checks if the sketch has a when deleted fn and if so, creates the list of - global elements and interprets the result. - Returns a list of the elements that should be deleted.) + [LAMBDA (VIEWER GELTS) (* rrb "30-Dec-85 16:15") + + (* checks if the sketch has a when deleted fn and if so, creates the list of + global elements and interprets the result. + Returns a list of the elements that should be deleted.) (PROG ((SKETCH (INSURE.SKETCH VIEWER)) RESULT DELETEFN) @@ -3228,10 +3253,9 @@ This will be slow for arcs and curves."] (T (RETURN GELTS]) (SK.CHECK.PREEDITFN - [LAMBDA (VIEWER OLDELT) (* rrb " 9-Dec-85 11:52") - - (* checks if the sketch has a preedit fn and if so, calls it) - + [LAMBDA (VIEWER OLDELT) (* rrb " 9-Dec-85 11:52") + (* checks if the sketch has a preedit + fn and if so, calls it) (PROG ((SKETCH (INSURE.SKETCH VIEWER)) PREEDITFN) (COND @@ -3241,20 +3265,20 @@ This will be slow for arcs and curves."] 'DON'T]) (SK.CHECK.END.INITIAL.EDIT - [LAMBDA (VIEWER NEWELT) (* rrb "15-Jan-86 15:20") - - (* called when the edit of a newly created text element is ended. - Calls the when changed fn.) + [LAMBDA (VIEWER NEWELT) (* rrb "15-Jan-86 15:20") + + (* called when the edit of a newly created text element is ended. + Calls the when changed fn.) (SK.CHECK.WHENCHANGEDFN VIEWER NEWELT 'DATA NIL (fetch (TEXT LISTOFCHARACTERS) of (fetch (GLOBALPART INDIVIDUALGLOBALPART) of NEWELT]) (SK.CHECK.WHENPOINTDELETEDFN - [LAMBDA (VIEWER SCRELT CONTROLPOINT) (* rrb " 3-Jan-86 15:32") - - (* checks if the sketch has a prechange fn and if so, calls it and interprets - the result. Returns NIL if the point should not be deleted.) + [LAMBDA (VIEWER SCRELT CONTROLPOINT) (* rrb " 3-Jan-86 15:32") + + (* checks if the sketch has a prechange fn and if so, calls it and interprets the + result. Returns NIL if the point should not be deleted.) (PROG ((SKETCH (INSURE.SKETCH VIEWER)) RESULT PRECHANGEFN) @@ -3269,21 +3293,21 @@ This will be slow for arcs and curves."] (T (RETURN SCRELT]) (SK.ERASE.ELT - [LAMBDA (ELT WINDOW REGION) (* rrb "30-Aug-86 15:08") + [LAMBDA (ELT WINDOW REGION) (* rrb "30-Aug-86 15:08") (* erases a sketch element) (DSPOPERATION 'ERASE WINDOW) (SK.DRAWFIGURE ELT WINDOW REGION (VIEWER.SCALE WINDOW)) (DSPOPERATION 'PAINT WINDOW]) (SK.DELETE.ELT - [LAMBDA (W) (* rrb "31-Jan-86 10:48") + [LAMBDA (W) (* rrb "31-Jan-86 10:48") (* lets the user select an element and  deletes it.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.DELETE (KWOTE W)) W]) (SK.DELETE.ITEM - [LAMBDA (ELT SKETCHW) (* rrb "12-May-85 18:10") + [LAMBDA (ELT SKETCHW) (* rrb "12-May-85 18:10") (* deletes an element from a window) (COND (ELT (DELFROMTCONC (WINDOWPROP SKETCHW 'SKETCHSPECS) @@ -3292,10 +3316,10 @@ This will be slow for arcs and curves."] ELT]) (DELFROMTCONC - [LAMBDA (TCONCCELL ELEMENT) (* rrb "26-Sep-86 13:24") - - (* deletes an element from a TCONC cell list. - Returns T if the element was deleted, NIL if it wasn't a member.) + [LAMBDA (TCONCCELL ELEMENT) (* rrb "26-Sep-86 13:24") + + (* deletes an element from a TCONC cell list. + Returns T if the element was deleted, NIL if it wasn't a member.) (COND ((EQ ELEMENT (CAAR TCONCCELL)) (* first element) @@ -3307,10 +3331,8 @@ This will be slow for arcs and curves."] (T (* remove first element.) (RPLACA TCONCCELL (CDAR TCONCCELL] T) - ((EQ ELEMENT (CADR TCONCCELL)) - - (* elt to delete is the last one on the list, do special case.) - + ((EQ ELEMENT (CADR TCONCCELL)) (* elt to delete is the last one on + the list, do special case.) (for TAIL on (CAR TCONCCELL) when (EQ (CDR TAIL) (CDR TCONCCELL)) do (* update the TCONC last entry) @@ -3331,24 +3353,24 @@ This will be slow for arcs and curves."] (DEFINEQ (SK.COPY.ELT - [LAMBDA (W) (* rrb "31-Jan-86 10:49") + [LAMBDA (W) (* rrb "31-Jan-86 10:49") (* lets the user select an element and  copies it.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.COPY (KWOTE W)) W]) (SK.SEL.AND.COPY - [LAMBDA (W) (* rrb "10-Dec-85 17:08") + [LAMBDA (W) (* rrb "10-Dec-85 17:08") (* lets the user select elements and  copies them.) (SK.COPY.ELEMENTS (SK.SELECT.MULTIPLE.ITEMS W T NIL 'COPY) W]) (SK.COPY.ELEMENTS - [LAMBDA (SCRELTS SKW) (* rrb " 1-Oct-86 19:12") - - (* create a bitmap of the thing being moved and get its new position. - Then translate all the pieces.) + [LAMBDA (SCRELTS SKW) (* rrb " 1-Oct-86 19:12") + + (* create a bitmap of the thing being moved and get its new position. + Then translate all the pieces.) (AND SCRELTS (PROG (FIGINFO FIRSTHOTSPOT GHOTSPOT LOWLFT NEWGPOS DELTAPOS NEWELTS COPYFN SKETCH COPYARGS COPYPLACEDYETFLG) (* call PRECOPYFN.) @@ -3360,12 +3382,12 @@ This will be slow for arcs and curves."] [COND ((EQ DELTAPOS 'DON'T) (RETURN)) - ((POSITIONP DELTAPOS) - - (* PRECOPYFN returned a position, don't bother to check for multiple copies.) - - (* value returned is the delta by which to move the point. - Set up new position) + ((POSITIONP DELTAPOS) (* PRECOPYFN returned a position, + don't bother to check for multiple + copies.) + + (* value returned is the delta by which to move the point. + Set up new position) (RETURN (SK.ADD.COPY.OF.ELEMENTS SKW SCRELTS (OR COPYARGS (SETQ COPYARGS ( @@ -3378,9 +3400,9 @@ This will be slow for arcs and curves."] (SETQ GHOTSPOT (GETSKETCHELEMENTPROP (fetch (SCREENELT GLOBALPART) of (CAR SCRELTS)) 'POSITION)) - - (* move the image by the first hotspot of the first element chosen. - This will align the image on the grid correctly.) + + (* move the image by the first hotspot of the first element chosen. + This will align the image on the grid correctly.) PLACECOPYLP (COND @@ -3402,19 +3424,18 @@ This will be slow for arcs and curves."] ] SKW)) (CLOSEPROMPTWINDOW SKW)) - (COPYPLACEDYETFLG - - (* already one copy down, close prompt window so user knows copy mode is over.) - + (COPYPLACEDYETFLG (* already one copy down, close prompt + window so user knows copy mode is + over.) (CLOSEPROMPTWINDOW SKW) (RETURN NIL)) (T (STATUSPRINT SKW "Position was outside the window. Copy not placed.") (RETURN NIL))) [SETQ DELTAPOS (create POSITION - XCOORD _ (DIFFERENCE (fetch (POSITION XCOORD) + XCOORD ← (DIFFERENCE (fetch (POSITION XCOORD) of NEWGPOS) (fetch (POSITION XCOORD) of GHOTSPOT)) - YCOORD _ (DIFFERENCE (fetch (POSITION YCOORD) + YCOORD ← (DIFFERENCE (fetch (POSITION YCOORD) of NEWGPOS) (fetch (POSITION YCOORD) of GHOTSPOT] (SK.ADD.COPY.OF.ELEMENTS SKW SCRELTS (OR COPYARGS (SETQ COPYARGS ( @@ -3428,10 +3449,10 @@ This will be slow for arcs and curves."] (T (CLOSEPROMPTWINDOW SKW]) (SK.ADD.COPY.OF.ELEMENTS - [LAMBDA (VIEWER SCRELEMENTS GLOBALELEMENTS NEWPOSDELTA) (* rrb " 1-Oct-86 19:13") - - (* internal function for copying elements. - Adds a copy of SCRELEMENTS moved by NEWPOSDELTA to VIEWER and calls the copyfn.) + [LAMBDA (VIEWER SCRELEMENTS GLOBALELEMENTS NEWPOSDELTA) (* rrb " 1-Oct-86 19:13") + + (* internal function for copying elements. + Adds a copy of SCRELEMENTS moved by NEWPOSDELTA to VIEWER and calls the copyfn.) (PROG (SKETCH NEWELTS COPYFN X) (AND (SETQ COPYFN (GETSKETCHPROP (SETQ SKETCH (INSURE.SKETCH VIEWER)) @@ -3440,11 +3461,8 @@ This will be slow for arcs and curves."] (COND ((EQ X 'DON'T) (RETURN)) - ((POSITIONP X) - - (* value returned is the position to put the copy. - Set up new position) - + ((POSITIONP X) (* value returned is the position to + put the copy. Set up new position) (SETQ NEWPOSDELTA X))) [SETQ NEWELTS (SK.SORT.GELTS.BY.PRIORITY (COND ((AND (LISTP X) @@ -3461,35 +3479,32 @@ This will be slow for arcs and curves."] (SK.ADD.HISTEVENT 'COPY NEWELTS VIEWER]) (SK.GLOBAL.FROM.LOCAL.ELEMENTS - [LAMBDA (SCRELTS) - - (* returns the global elements from a list of screen elements) - + [LAMBDA (SCRELTS) (* returns the global elements from a + list of screen elements) (for SCRELT in SCRELTS collect (fetch (SCREENELT GLOBALPART) of SCRELT]) (SK.COPY.ITEM - [LAMBDA (SELELT GLOBALDELTAPOS W) (* rrb "24-Jun-87 15:12") - - (* SELELT is a sketch element that was selected for a copy operation. - GLOBALDELTAPOS is the amount the new item is to be offset from the old.) + [LAMBDA (SELELT GLOBALDELTAPOS W) (* rrb "24-Jun-87 15:12") + + (* SELELT is a sketch element that was selected for a copy operation. + GLOBALDELTAPOS is the amount the new item is to be offset from the old.) (PROG ((OLDGLOBAL (fetch (SCREENELT GLOBALPART) of SELELT))) [COND ((EQ (fetch (GLOBALPART GTYPE) of OLDGLOBAL) 'SKIMAGEOBJ) - - (* copying an image obj. Don't call its when copied fn. - was changed to call the WHENINSERTEDFN instead when it acutally gets - inserted.) + + (* copying an image obj. Don't call its when copied fn. + was changed to call the WHENINSERTEDFN instead when it acutally gets inserted.) (SETQ OLDGLOBAL (SK.COPY.IMAGEOBJ OLDGLOBAL W] (RETURN (SK.TRANSLATE.GLOBALPART OLDGLOBAL GLOBALDELTAPOS]) (SK.INSERT.SKETCH - [LAMBDA (W SKETCH REGION SCALE) (* rrb "30-Sep-86 18:29") - - (* * inserts the sketch SKETCH into the sketch window W. - Called by the copy insert function for sketch windows.) + [LAMBDA (W SKETCH REGION SCALE) (* rrb "30-Sep-86 18:29") + + (* * inserts the sketch SKETCH into the sketch window W. + Called by the copy insert function for sketch windows.) (AND SKETCH (PROG (LOCALSCRELTS FIGINFO FIRSTHOTSPOT LOWLFT NEWPOS WINDOWSCALE NEWELTS) (* map inserted elements into new @@ -3498,7 +3513,7 @@ This will be slow for arcs and curves."] ([NOT (EQUAL SCALE (SETQ WINDOWSCALE (VIEWER.SCALE W] (* change the scale of the sketch and  the region.) - [SETQ SKETCH (create SKETCH using SKETCH SKETCHELTS _ + [SETQ SKETCH (create SKETCH using SKETCH SKETCHELTS ← (SK.TRANSFORM.GLOBAL.ELEMENTS (fetch (SKETCH SKETCHELTS) of SKETCH) (FUNCTION @@ -3510,9 +3525,9 @@ This will be slow for arcs and curves."] (SETQ FIGINFO (SK.FIGUREIMAGE LOCALSCRELTS REGION)) [SETQ FIRSTHOTSPOT (CAR (fetch (SCREENELT HOTSPOTS) of (CAR LOCALSCRELTS] (SETQ LOWLFT (fetch (SKFIGUREIMAGE SKFIGURE.LOWERLEFT) of FIGINFO)) - - (* move the image by the first hotspot of the first element chosen. - This will align the image on the grid correctly.) + + (* move the image by the first hotspot of the first element chosen. + This will align the image on the grid correctly.) (COND ([SETQ NEWPOS (fetch (INPUTPT INPUT.POSITION) @@ -3534,11 +3549,11 @@ This will be slow for arcs and curves."] (SETQ NEWELTS (MAPCOLLECTSKETCHSPECS LOCALSCRELTS (FUNCTION SK.COPY.ITEM) (SK.MAP.FROM.WINDOW.TO.NEAREST.GRID (create POSITION - XCOORD _ (IDIFFERENCE (fetch (POSITION XCOORD) + XCOORD ← (IDIFFERENCE (fetch (POSITION XCOORD) of NEWPOS) (fetch (POSITION XCOORD) of FIRSTHOTSPOT)) - YCOORD _ (IDIFFERENCE (fetch (POSITION YCOORD) + YCOORD ← (IDIFFERENCE (fetch (POSITION YCOORD) of NEWPOS) (fetch (POSITION YCOORD) of FIRSTHOTSPOT))) @@ -3556,37 +3571,35 @@ This will be slow for arcs and curves."] (DEFINEQ (SK.MOVE.ELT - [LAMBDA (W) (* rrb "31-Jan-86 10:49") - - (* lets the user select one or more elements and move them.) - + [LAMBDA (W) (* rrb "31-Jan-86 10:49") + (* lets the user select one or more + elements and move them.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.MOVE (KWOTE W)) W]) (SK.MOVE.ELT.OR.PT - [LAMBDA (W) (* rrb "31-Jan-86 10:49") - - (* lets the user select one or more elements and move them.) - + [LAMBDA (W) (* rrb "31-Jan-86 10:49") + (* lets the user select one or more + elements and move them.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.MOVE (KWOTE W) T) W]) (SK.APPLY.DEFAULT.MOVE - [LAMBDA (W) (* rrb " 2-Jun-85 12:52") - - (* applies the default move mode which can be either points, elements or both.) - + [LAMBDA (W) (* rrb " 2-Jun-85 12:52") + (* applies the default move mode which + can be either points, elements or + both.) (SELECTQ (fetch (SKETCHCONTEXT SKETCHMOVEMODE) of (WINDOWPROP W 'SKETCHCONTEXT)) (POINTS (SK.MOVE.POINTS W)) (ELEMENTS (SK.MOVE.ELT W)) (SK.MOVE.ELT.OR.PT W]) (SK.SEL.AND.MOVE - [LAMBDA (W PTFLG) (* rrb "10-Dec-85 17:06") - - (* lets the user select either a control point or one or more elements and move - them.) + [LAMBDA (W PTFLG) (* rrb "10-Dec-85 17:06") + + (* lets the user select either a control point or one or more elements and move + them.) (SK.MOVE.ELEMENTS [COND ((EQ PTFLG 'ONLY) @@ -3597,7 +3610,7 @@ This will be slow for arcs and curves."] W]) (SK.MOVE.ELEMENTS - [LAMBDA (SCRELTS SKW) (* rrb "11-Jul-86 15:51") + [LAMBDA (SCRELTS SKW) (* rrb "11-Jul-86 15:51") (SKED.CLEAR.SELECTION SKW) (COND ((NULL SCRELTS)) @@ -3616,16 +3629,14 @@ This will be slow for arcs and curves."] GLOBALPART) of SCRELT) 'MOVE)) do (RETURN SCRELT] - - (* only protected elements at this point, shouldn't happen but don't cause an - error.) - + (* only protected elements at this + point, shouldn't happen but don't + cause an error.) (RETURN NIL))) [COND ([NULL (SETQ OTHERHOTSPOTS (REMOVE SCRELTS (fetch (SCREENELT HOTSPOTS) of SKETCHELT] - - (* only one control point, move it with the move element function.) - + (* only one control point, move it + with the move element function.) (RETURN (SK.MOVE.ELEMENTS (LIST SKETCHELT) SKW] (* call sketch premovefn if given.) [AND (SETQ MOVEFN (GETSKETCHPROP (SETQ SKETCH (INSURE.SKETCH SKW)) @@ -3636,9 +3647,9 @@ This will be slow for arcs and curves."] ((EQ GDELTAPOS 'DON'T) (RETURN)) ((POSITIONP GDELTAPOS) - - (* value returned is the delta by which to move the point. - Set up new position) + + (* value returned is the delta by which to move the point. + Set up new position) NIL) (T (* read new position from the user) @@ -3653,12 +3664,12 @@ This will be slow for arcs and curves."]  selected point moves.) (SETQ GDELTAPOS (SK.MAP.FROM.WINDOW.TO.NEAREST.GRID (create POSITION - XCOORD _ (IDIFFERENCE (fetch (POSITION XCOORD) + XCOORD ← (IDIFFERENCE (fetch (POSITION XCOORD) of (fetch (INPUTPT INPUT.POSITION) of NEWPOS)) (fetch (POSITION XCOORD) of SCRELTS)) - YCOORD _ (IDIFFERENCE (fetch (POSITION YCOORD) + YCOORD ← (IDIFFERENCE (fetch (POSITION YCOORD) of (fetch (INPUTPT INPUT.POSITION) of NEWPOS)) @@ -3672,14 +3683,17 @@ This will be slow for arcs and curves."] ((EQ X 'DON'T) (RETURN)) ((POSITIONP X) - - (* value returned is the delta by which to move the point. - Set up new position) + + (* value returned is the delta by which to move the point. + Set up new position) (SETQ GDELTAPOS X))) (RETURN (SK.MOVE.THING SKETCHELT SCRELTS GDELTAPOS SKW] - (T (* create a bitmap of the thing being moved and get its new position. - Then translate all the pieces.) + (T + + (* create a bitmap of the thing being moved and get its new position. + Then translate all the pieces.) + (PROG (FIGINFO FIRSTHOTSPOT NEWPOS LOWLFT IMAGEPOSX IMAGEPOSY IMAGEBM DELTAPOS CHANGES MOVEFN X GDELTAPOS) [AND (SETQ MOVEFN (GETSKETCHPROP (INSURE.SKETCH SKW) @@ -3689,9 +3703,9 @@ This will be slow for arcs and curves."] ((EQ GDELTAPOS 'DON'T) (RETURN)) ((POSITIONP GDELTAPOS) - - (* value returned is the delta by which to move the point. - Set up new position) + + (* value returned is the delta by which to move the point. + Set up new position) NIL) (T (* read new position from the user) @@ -3699,9 +3713,9 @@ This will be slow for arcs and curves."] [SETQ FIRSTHOTSPOT (CAR (fetch (SCREENELT HOTSPOTS) of (CAR SCRELTS] (SETQ IMAGEBM (fetch (SKFIGUREIMAGE SKFIGURE.BITMAP) of FIGINFO)) (SETQ LOWLFT (fetch (SKFIGUREIMAGE SKFIGURE.LOWERLEFT) of FIGINFO)) - - (* move the image by the first hotspot of the first element chosen. - This will align the image on the grid correctly.) + + (* move the image by the first hotspot of the first element chosen. + This will align the image on the grid correctly.) (SETQ IMAGEPOSX (fetch (POSITION XCOORD) of LOWLFT)) (SETQ IMAGEPOSY (fetch (POSITION YCOORD) of LOWLFT)) @@ -3728,19 +3742,19 @@ This will be slow for arcs and curves."] (SK.SHOW.FIG.FROM.INFO IMAGEBM IMAGEPOSX IMAGEPOSY 'PAINT SKW) (STATUSPRINT SKW "Position was outside the window, copy not placed.") (RETURN NIL))) - - (* GET.BITMAP.POSITION returns the position that the cursor was in which is the - position of the first hotspot.) + + (* GET.BITMAP.POSITION returns the position that the cursor was in which is the + position of the first hotspot.) (* calculate the delta that the  selected point moves.) (SETQ GDELTAPOS (SK.MAP.FROM.WINDOW.TO.NEAREST.GRID [SETQ DELTAPOS (create POSITION - XCOORD _ (IDIFFERENCE + XCOORD ← (IDIFFERENCE (fetch (POSITION XCOORD) of NEWPOS) (fetch (POSITION XCOORD) of FIRSTHOTSPOT)) - YCOORD _ (IDIFFERENCE + YCOORD ← (IDIFFERENCE (fetch (POSITION YCOORD) of NEWPOS) (fetch (POSITION YCOORD) @@ -3749,24 +3763,24 @@ This will be slow for arcs and curves."] (SKETCH.MOVE.ELEMENTS (for ELT in SCRELTS collect (fetch (SCREENELT GLOBALPART) of ELT)) GDELTAPOS SKW T) - - (* I started noticing cases where the image was a point off on some lines and - where the texture alignment was off so I removed this - (COND ((AND DELTAPOS (NOT (POSITIONP X))) - (* If the user was asked for a new position and the movefn didn't change it, - redraw the image in case any of it was erased by the calls to SK.TRANSLATE.ITEM) - (SK.SHOW.FIG.FROM.INFO IMAGEBM (IPLUS IMAGEPOSX - (fetch (POSITION XCOORD) of DELTAPOS)) (IPLUS IMAGEPOSY - (fetch (POSITION YCOORD) of DELTAPOS)) (QUOTE PAINT) SKW)))) + + (* I started noticing cases where the image was a point off on some lines and + where the texture alignment was off so I removed this + (COND ((AND DELTAPOS (NOT (POSITIONP X))) + (* If the user was asked for a new position and the movefn didn't change it, + redraw the image in case any of it was erased by the calls to SK.TRANSLATE.ITEM) + (SK.SHOW.FIG.FROM.INFO IMAGEBM (IPLUS IMAGEPOSX + (fetch (POSITION XCOORD) of DELTAPOS)) (IPLUS IMAGEPOSY + (fetch (POSITION YCOORD) of DELTAPOS)) (QUOTE PAINT) SKW)))) (CLOSEPROMPTWINDOW SKW]) (SKETCH.MOVE.ELEMENTS - [LAMBDA (ELEMENTS DELTA SKETCHTOUPDATE ADDHISTORY?) (* rrb " 2-Oct-86 11:09") - - (* moves the elements ELEMENTS by the amount of position DELTA - (XCOORD gives x amount, YCOORD gives y delta) and updates the viewers on - SKETCHTOUPDATE if it is given.) + [LAMBDA (ELEMENTS DELTA SKETCHTOUPDATE ADDHISTORY?) (* rrb " 2-Oct-86 11:09") + + (* moves the elements ELEMENTS by the amount of position DELTA + (XCOORD gives x amount, YCOORD gives y delta) and updates the viewers on + SKETCHTOUPDATE if it is given.) (PROG (X MOVEFN NEWGLOBALS SKETCH GDELTAPOS VIEWER) (OR (POSITIONP DELTA) @@ -3775,9 +3789,9 @@ This will be slow for arcs and curves."] (SETQ VIEWER (SK.VIEWER.FROM.SKETCH.ARG SKETCHTOUPDATE))) (COND [[AND SKETCH (SETQ MOVEFN (GETSKETCHPROP SKETCH 'WHENMOVEDFN] - - (* call the WHENMOVEDFN if any Pass the thing the user passed in if you can't - find a viewer.) + + (* call the WHENMOVEDFN if any Pass the thing the user passed in if you can't + find a viewer.) (COND ((EQ (SETQ X (APPLY* MOVEFN VIEWER (for ELT in ELEMENTS @@ -3786,9 +3800,9 @@ This will be slow for arcs and curves."] 'DON'T) (RETURN)) ((POSITIONP X) - - (* value returned is the delta by which to move the point. - Set up new position) + + (* value returned is the delta by which to move the point. + Set up new position) (SETQ GDELTAPOS X)) (T (SETQ GDELTAPOS DELTA] @@ -3803,11 +3817,11 @@ This will be slow for arcs and curves."] (RETURN NEWGLOBALS]) (SKETCH.COPY.ELEMENTS - [LAMBDA (ELEMENTS SKETCHTOUPDATE DELTA ADDHISTORY?) (* rrb "15-Dec-86 15:58") - - (* copies the elements ELEMENTS moving them by the amount of position DELTA - (XCOORD gives x amount, YCOORD gives y delta) and updates the viewers on - SKETCHTOUPDATE if it is given.) + [LAMBDA (ELEMENTS SKETCHTOUPDATE DELTA ADDHISTORY?) (* rrb "15-Dec-86 15:58") + + (* copies the elements ELEMENTS moving them by the amount of position DELTA + (XCOORD gives x amount, YCOORD gives y delta) and updates the viewers on + SKETCHTOUPDATE if it is given.) (PROG (X COPYFN NEWGLOBALS SKETCH GDELTAPOS VIEWER) (COND @@ -3819,18 +3833,18 @@ This will be slow for arcs and curves."] (SETQ VIEWER (SK.VIEWER.FROM.SKETCH.ARG SKETCHTOUPDATE))) (COND [[AND SKETCH (SETQ COPYFN (GETSKETCHPROP SKETCH 'WHENCOPIEDFN] - - (* call the WHENCOPIEFN if any Pass the thing the user passed in if you can't - find a viewer.) + + (* call the WHENCOPIEFN if any Pass the thing the user passed in if you can't + find a viewer.) (COND ((EQ (SETQ X (APPLY* COPYFN VIEWER ELEMENTS DELTA)) 'DON'T) (RETURN)) ((POSITIONP X) - - (* value returned is the delta by which to move the point. - Set up new position) + + (* value returned is the delta by which to move the point. + Set up new position) (SETQ GDELTAPOS X)) (T (SETQ GDELTAPOS DELTA] @@ -3846,24 +3860,24 @@ This will be slow for arcs and curves."] (RETURN NEWGLOBALS]) (\SKETCH.COPY.ELEMENT - [LAMBDA (GLOBALELEMENT GLOBALDELTAPOS W) (* rrb "24-Jun-87 15:05") - - (* SELELT is a sketch element that was selected for a copy operation. - GLOBALDELTAPOS is the amount the new item is to be offset from the old.) + [LAMBDA (GLOBALELEMENT GLOBALDELTAPOS W) (* rrb "24-Jun-87 15:05") + + (* SELELT is a sketch element that was selected for a copy operation. + GLOBALDELTAPOS is the amount the new item is to be offset from the old.) (COND ((EQ (fetch (GLOBALPART GTYPE) of GLOBALELEMENT) 'SKIMAGEOBJ) (* copying an image obj. - Calls its when copied fn.) + Calls its when copied fn.) (SK.TRANSLATE.GLOBALPART (SK.COPY.IMAGEOBJ GLOBALELEMENT W) GLOBALDELTAPOS)) (T (SK.TRANSLATE.GLOBALPART GLOBALELEMENT GLOBALDELTAPOS]) (SK.TRANSLATE.ELEMENT - [LAMBDA (GELT GLOBALDELTAPOS W) (* rrb "25-Sep-86 15:16") - - (* * GELT is a sketch element to be moved. - GLOBALDELTAPOS is the amount the item is to be translated.) + [LAMBDA (GELT GLOBALDELTAPOS W) (* rrb "25-Sep-86 15:16") + + (* * GELT is a sketch element to be moved. + GLOBALDELTAPOS is the amount the item is to be translated.) (PROG (NEWGLOBAL) (COND @@ -3877,31 +3891,31 @@ This will be slow for arcs and curves."] T]) (SK.MAKE.ELEMENT.MOVE.ARG - [LAMBDA (SCRELT SELPOS) (* rrb " 5-Nov-85 14:35") - - (* makes an argument structure that is suitable to be passed to the sketch - movefn. This is a list whose CAR is a list of the numbers of the control points - being moved and whose CDR is the global sketch element.) + [LAMBDA (SCRELT SELPOS) (* rrb " 5-Nov-85 14:35") + + (* makes an argument structure that is suitable to be passed to the sketch + movefn. This is a list whose CAR is a list of the numbers of the control points + being moved and whose CDR is the global sketch element.) (CONS (CONS (for I from 1 as PT in (fetch (SCREENELT HOTSPOTS) of SCRELT) when (EQUAL PT SELPOS) do (RETURN I))) (fetch (SCREENELT GLOBALPART) of SCRELT]) (SK.MAKE.ELEMENTS.MOVE.ARG - [LAMBDA (SCRELTS) (* rrb " 5-Nov-85 14:34") - - (* makes an argument structure that is suitable to be passed to the sketch - movefn. This is a list whose CAR is a list of the numbers of the control points - being moved which is in this case T and whose CDR is the global sketch element.) + [LAMBDA (SCRELTS) (* rrb " 5-Nov-85 14:34") + + (* makes an argument structure that is suitable to be passed to the sketch + movefn. This is a list whose CAR is a list of the numbers of the control points + being moved which is in this case T and whose CDR is the global sketch element.) (CONS T (for SCRELT in SCRELTS collect (fetch (SCREENELT GLOBALPART) of SCRELT]) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG - [LAMBDA (SCRELTS SELPTS) (* rrb "21-Jan-86 17:38") - - (* makes an argument structure that is suitable to be passed to the sketch - movefn. This is a list of lists each of whose CAR is a list of the numbers of - the control points being moved and whose CDR is the global sketch element.) + [LAMBDA (SCRELTS SELPTS) (* rrb "21-Jan-86 17:38") + + (* makes an argument structure that is suitable to be passed to the sketch + movefn. This is a list of lists each of whose CAR is a list of the numbers of the + control points being moved and whose CDR is the global sketch element.) (for SCRELT in SCRELTS collect (CONS (bind NOTALL for I from 1 as PT in (fetch (SCREENELT HOTSPOTS) of SCRELT) @@ -3913,13 +3927,13 @@ This will be slow for arcs and curves."] (fetch (SCREENELT GLOBALPART) of SCRELT]) (SK.SHOW.FIG.FROM.INFO - [LAMBDA (IMAGEBM XOFFSET YOFFSET OPERATION WINDOW) (* rrb "14-Nov-84 14:20") + [LAMBDA (IMAGEBM XOFFSET YOFFSET OPERATION WINDOW) (* rrb "14-Nov-84 14:20") (* puts a bitmap onto the sketch  window.) (BITBLT IMAGEBM 0 0 WINDOW XOFFSET YOFFSET NIL NIL 'INPUT OPERATION]) (SK.MOVE.THING - [LAMBDA (SKETCHELT LOCALPT GDELTAPOS SKW) (* rrb "27-Jun-86 14:04") + [LAMBDA (SKETCHELT LOCALPT GDELTAPOS SKW) (* rrb "27-Jun-86 14:04") (* moves a control point in a sketch  element.) (PROG (OLDGLOBAL NEWGLOBAL) (* calculate the delta that the @@ -3933,26 +3947,26 @@ This will be slow for arcs and curves."] (RETURN NEWGLOBAL]) (UPDATE.ELEMENT.IN.SKETCH - [LAMBDA (OLDGELT NEWGELT SKETCH SKW DONTUPDATEPRIORITYFLG) (* rrb "26-Sep-86 13:35") + [LAMBDA (OLDGELT NEWGELT SKETCH SKW DONTUPDATEPRIORITYFLG) (* rrb "26-Sep-86 13:35") (* changes the global sketch) - - (* returns NIL if the old global sketch element is not found in SKETCH. - This can happen if things are undone out of order.) + + (* returns NIL if the old global sketch element is not found in SKETCH. + This can happen if things are undone out of order.) (PROG ((SKETCHSTRUCTURE (INSURE.SKETCH SKETCH)) SKETCHELEMENTS) - - (* if old and new are the same, the change was done destructively; - otherwise clobber the new one in.) + + (* if old and new are the same, the change was done destructively; + otherwise clobber the new one in.) [COND ((EQ OLDGELT NEWGELT)) ((OR (NULL DONTUPDATEPRIORITYFLG) (EQ (SK.ELEMENT.PRIORITY OLDGELT) (SK.ELEMENT.PRIORITY NEWGELT))) - - (* same priorities so just clobber the old elements place in the list with the - new one.) + + (* same priorities so just clobber the old elements place in the list with the + new one.) (OR (for GELTTAIL on (fetch (SKETCH SKETCHELTS) of SKETCHSTRUCTURE) when (EQ (CAR GELTTAIL) @@ -3964,9 +3978,9 @@ This will be slow for arcs and curves."] (RETURN T)) (RETURN))) (T - - (* priority has changed so order of this element in the list may need to be - changed.) + + (* priority has changed so order of this element in the list may need to be + changed.) (REMOVE.ELEMENT.FROM.SKETCH OLDGELT SKETCHSTRUCTURE) (SK.ADD.PRIORITY.ELEMENT.TO.SKETCH SKETCHSTRUCTURE NEWGELT (SK.ELEMENT.PRIORITY @@ -3975,19 +3989,19 @@ This will be slow for arcs and curves."] (RETURN T]) (SK.UPDATE.ELEMENT - [LAMBDA (OLDGLOBAL NEWGLOBAL SKETCHW REDRAWIFSAMEFLG DONTUPDATEPRIORITYFLG DONTDISPLAYFLG) + [LAMBDA (OLDGLOBAL NEWGLOBAL SKETCHW REDRAWIFSAMEFLG DONTUPDATEPRIORITYFLG DONTDISPLAYFLG) (* rrb "24-Sep-86 17:32") - - (* replaces an old element with a new one. - The global part of the old one may be the same as the new global part. - This also handles propagation to other windows that have the same figure - displayed.) + + (* replaces an old element with a new one. + The global part of the old one may be the same as the new global part. + This also handles propagation to other windows that have the same figure + displayed.) (PROG ((SKETCH (SKETCH.FROM.VIEWER SKETCHW)) UPDATEDELT) - - (* update the element in the sketch first. - If this returns NIL, the element was not found in the sketch.) + + (* update the element in the sketch first. + If this returns NIL, the element was not found in the sketch.) (OR (UPDATE.ELEMENT.IN.SKETCH OLDGLOBAL NEWGLOBAL SKETCH SKETCHW DONTUPDATEPRIORITYFLG) (RETURN NIL)) (* do the window that the interaction @@ -3996,19 +4010,19 @@ This will be slow for arcs and curves."] DONTDISPLAYFLG)) (* propagate to other windows.) (for SKW in (ALL.SKETCH.VIEWERS SKETCH) when (NEQ SKW SKETCHW) do - - (* the position may have changed which means that it may have moved in or out - of a viewer.) + + (* the position may have changed which means that it may have moved in or out of + a viewer.) (SK.UPDATE.ELEMENT1 OLDGLOBAL NEWGLOBAL SKW REDRAWIFSAMEFLG DONTDISPLAYFLG)) (RETURN UPDATEDELT]) (SK.UPDATE.ELEMENTS - [LAMBDA (CHANGEEVENTS WINDOW DONTUPDATEPRIORITYFLG DONTDISPLAYFLG) + [LAMBDA (CHANGEEVENTS WINDOW DONTUPDATEPRIORITYFLG DONTDISPLAYFLG) (* rrb "24-Sep-86 17:32") - - (* replaces the global parts of a list of change events and handles updating - the screen.) + + (* replaces the global parts of a list of change events and handles updating the + screen.) (for CHANGEEVENT in CHANGEEVENTS do (SK.UPDATE.ELEMENT (fetch (SKHISTORYCHANGESPEC OLDELT) of CHANGEEVENT) @@ -4016,32 +4030,29 @@ This will be slow for arcs and curves."] WINDOW NIL DONTUPDATEPRIORITYFLG DONTDISPLAYFLG]) (SK.UPDATE.ELEMENT1 - [LAMBDA (OLDGELT NEWGELT SKETCHW REDRAWIFSAME DONTDISPLAYFLG) + [LAMBDA (OLDGELT NEWGELT SKETCHW REDRAWIFSAME DONTDISPLAYFLG) (* rrb "24-Sep-86 17:32") - - (* determines what action is needed wrt the viewer SKETCHW when the element - OLDGELT is updated to NEWGELT. This works only in the given window.) + + (* determines what action is needed wrt the viewer SKETCHW when the element + OLDGELT is updated to NEWGELT. This works only in the given window.) (PROG (LOCALELT UPDATEFN NEWLOCAL) (COND [(SETQ LOCALELT (SK.LOCAL.ELT.FROM.GLOBALPART OLDGELT SKETCHW)) (COND - (DONTDISPLAYFLG - - (* just do the update in the datastructure, don't change the display) - + (DONTDISPLAYFLG (* just do the update in the + datastructure, don't change the + display) (SK.DELETE.ITEM LOCALELT SKETCHW) (RETURN (SK.ADD.ITEM NEWGELT SKETCHW))) ((EQ (SKETCH.ELEMENT.TYPE OLDGELT) - 'SKIMAGEOBJ) - - (* handle imageobject case specially because changes are often in internal - structure) - + 'SKIMAGEOBJ) (* handle imageobject case specially + because changes are often in internal + structure) (SK.DELETE.ITEM LOCALELT SKETCHW) - - (* erase the old image region because often the internal parts of the image - object have been clobbered making it impossible to erase by redrawing) + + (* erase the old image region because often the internal parts of the image + object have been clobbered making it impossible to erase by redrawing) (DSPFILL (fetch (LOCALSKIMAGEOBJ SKIMOBJLOCALREGION) of (fetch (SCREENELT LOCALPART ) @@ -4052,36 +4063,35 @@ This will be slow for arcs and curves."] [[AND (EQUAL OLDGELT NEWGELT) (NOT (MEMB (fetch (GLOBALPART GTYPE) of OLDGELT) '(TEXT TEXTBOX] - - (* text and textbox are special because interactive editing reuses the same - element after the first character but they need to use updatefns for speed.) - - (* replacing something by something else that is identical. - Check here because add will not add something that is already there and - updatefn may call add first.) + + (* text and textbox are special because interactive editing reuses the same + element after the first character but they need to use updatefns for speed.) + + (* replacing something by something else that is identical. + Check here because add will not add something that is already there and updatefn + may call add first.) (COND (REDRAWIFSAME - - (* this entry is used from the WB.BUTTON.HANDLER and deals with image objects - which we have no control over whether they give us something new or not.) + + (* this entry is used from the WB.BUTTON.HANDLER and deals with image objects + which we have no control over whether they give us something new or not.) (SK.ERASE.AND.DELETE.ITEM LOCALELT SKETCHW)) (T (SK.DELETE.ITEM LOCALELT SKETCHW) (RETURN (SK.ADD.ITEM NEWGELT SKETCHW] ((AND (SETQ UPDATEFN (SK.UPDATEFN (fetch (GLOBALPART GTYPE) of NEWGELT))) (SETQ NEWLOCAL (APPLY* UPDATEFN LOCALELT NEWGELT SKETCHW))) - - (* if the old one is visible and the element has an updatefn, use it to update - the display. Then delete the old one. The updatefn should have added the new - one.) + + (* if the old one is visible and the element has an updatefn, use it to update + the display. Then delete the old one. The updatefn should have added the new one.) (SK.DELETE.ITEM LOCALELT SKETCHW) (RETURN NEWLOCAL)) (T - - (* if this type doesn't have a updatefn or it returned NIL, do the erase and - redraw method.) + + (* if this type doesn't have a updatefn or it returned NIL, do the erase and + redraw method.) (SK.ERASE.AND.DELETE.ITEM LOCALELT SKETCHW] ((NOT (MEMB NEWGELT (SKETCH.ELEMENTS.OF.SKETCH SKETCHW))) @@ -4093,7 +4103,7 @@ This will be slow for arcs and curves."] (SKETCH.ADD.AND.DISPLAY1 NEWGELT SKETCHW]) (SK.MOVE.ELEMENT.POINT - [LAMBDA (W) (* rrb "31-Jan-86 10:50") + [LAMBDA (W) (* rrb "31-Jan-86 10:50") (* lets the user select an element and  move it.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.MOVE (KWOTE W) @@ -4108,23 +4118,22 @@ This will be slow for arcs and curves."] (DEFINEQ (SK.MOVE.POINTS - [LAMBDA (W) (* rrb "31-Jan-86 10:50") - - (* lets the user select a collection of points and move them.) - + [LAMBDA (W) (* rrb "31-Jan-86 10:50") + (* lets the user select a collection + of points and move them.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.MOVE.POINTS (KWOTE W)) W]) (SK.SEL.AND.MOVE.POINTS - [LAMBDA (W) (* rrb "17-Oct-85 11:11") - - (* * lets the user select a collection of control point and moves them.) + [LAMBDA (W) (* rrb "17-Oct-85 11:11") + + (* * lets the user select a collection of control point and moves them.) (SK.DO.MOVE.ELEMENT.POINTS (SK.SELECT.MULTIPLE.POINTS W) W]) (SK.DO.MOVE.ELEMENT.POINTS - [LAMBDA (SCRPTS SKW) (* rrb "30-Sep-86 18:33") + [LAMBDA (SCRPTS SKW) (* rrb "30-Sep-86 18:33") (* moves a collection of points) (SKED.CLEAR.SELECTION SKW) (AND SCRPTS @@ -4140,16 +4149,16 @@ This will be slow for arcs and curves."] ((EQ GDELTAPOS 'DON'T) (RETURN)) ((POSITIONP GDELTAPOS) - - (* value returned is the delta by which to move the point. - Set up new position) + + (* value returned is the delta by which to move the point. + Set up new position) NIL) (T (* read new position from the user) - - (* create a bitmap of all of the elements that have any point being moved and - get its new position. Use only the region that contains the points. - points plus a boarder to catch the lines of a box as large as the region.) + + (* create a bitmap of all of the elements that have any point being moved and get + its new position. Use only the region that contains the points. + points plus a boarder to catch the lines of a box as large as the region.) (SETQ NONMOVEDHOTSPOTS (SK.HOTSPOTS.NOT.ON.LIST SCRPTS SCRELTS)) [SETQ ONEPTELTS (SUBSET SCRELTS (FUNCTION (LAMBDA (ELT) @@ -4162,9 +4171,9 @@ This will be slow for arcs and curves."] (SETQ FIGINFO (SK.FIGUREIMAGE SCRELTS NIL (INCREASEREGION (COND (ONEPTELTS - - (* include the regions of any elements that only have one control point. - This picks up text and groups whose image is much larger than the point.) + + (* include the regions of any elements that only have one control point. + This picks up text and groups whose image is much larger than the point.) (SK.UNIONREGIONS (REGION.CONTAINING.PTS @@ -4178,9 +4187,9 @@ This will be slow for arcs and curves."] (SETQ FIRSTHOTSPOT (CAR SCRPTS)) (SETQ LOWLFT (fetch (SKFIGUREIMAGE SKFIGURE.LOWERLEFT) of FIGINFO)) (SETQ IMAGEBM (fetch (SKFIGUREIMAGE SKFIGURE.BITMAP) of FIGINFO)) - - (* move the image by the first hotspot of the first element chosen. - This will align the image on the grid correctly.) + + (* move the image by the first hotspot of the first element chosen. + This will align the image on the grid correctly.) (SETQ IMAGEPOSX (fetch (POSITION XCOORD) of LOWLFT)) (SETQ IMAGEPOSY (fetch (POSITION YCOORD) of LOWLFT)) @@ -4211,18 +4220,18 @@ This will be slow for arcs and curves."] (for PT in NONMOVEDHOTSPOTS do (MARKPOINT PT SKW OTHERCONTROLPOINTMARK)) (STATUSPRINT SKW "Position was outside the window, copy not placed.") (RETURN NIL))) - - (* GET.BITMAP.POSITION returns the position that the cursor was in which is the - position of the first hotspot.) + + (* GET.BITMAP.POSITION returns the position that the cursor was in which is the + position of the first hotspot.) (for PT in NONMOVEDHOTSPOTS do (MARKPOINT PT SKW OTHERCONTROLPOINTMARK)) (SETQ GDELTAPOS (SK.MAP.FROM.WINDOW.TO.NEAREST.GRID (create POSITION - XCOORD _ (IDIFFERENCE (fetch (POSITION XCOORD) + XCOORD ← (IDIFFERENCE (fetch (POSITION XCOORD) of NEWPOS) (fetch (POSITION XCOORD) of FIRSTHOTSPOT )) - YCOORD _ (IDIFFERENCE (fetch (POSITION YCOORD) + YCOORD ← (IDIFFERENCE (fetch (POSITION YCOORD) of NEWPOS) (fetch (POSITION YCOORD) of FIRSTHOTSPOT ))) @@ -4236,9 +4245,9 @@ This will be slow for arcs and curves."] ((EQ X 'DON'T) (RETURN)) ((POSITIONP X) - - (* value returned is the delta by which to move the point. - Set up new position) + + (* value returned is the delta by which to move the point. + Set up new position) (SETQ GDELTAPOS X))) (SETQ NEWGLOBALS (MAPCOLLECTSKETCHSPECS SCRELTS (FUNCTION SK.MOVE.ITEM.POINTS) @@ -4250,32 +4259,28 @@ This will be slow for arcs and curves."] (CLOSEPROMPTWINDOW SKW]) (SK.MOVE.ITEM.POINTS - [LAMBDA (SELELT GLOBALDELTAPOS W LOCALPTS) (* rrb "11-Jul-85 13:44") - - (* SELELT is a sketch element at least one of whose points was selected for a - translate operation. GLOBALDELTAPOS is the amount the item is to be translated. - LOCALPTS is the list of points that was selected. - This function moves any of those that belong to SELELT and return the new - global. If all of SELELT points are on LOCALPTS this is a SK.TRANSLATE.ITEM.) + [LAMBDA (SELELT GLOBALDELTAPOS W LOCALPTS) (* rrb "11-Jul-85 13:44") + + (* SELELT is a sketch element at least one of whose points was selected for a + translate operation. GLOBALDELTAPOS is the amount the item is to be translated. + LOCALPTS is the list of points that was selected. + This function moves any of those that belong to SELELT and return the new global. + If all of SELELT points are on LOCALPTS this is a SK.TRANSLATE.ITEM.) (PROG ((ELTHOTSPOTS (fetch (LOCALPART HOTSPOTS) of (fetch (SCREENELT LOCALPART) of SELELT))) - MOVEDPTS NEWGLOBAL OLDGLOBAL NEWSCREENELT) - - (* this shouldn't happen but don't cause an error if it does.) - + MOVEDPTS NEWGLOBAL OLDGLOBAL NEWSCREENELT) (* this shouldn't happen but don't + cause an error if it does.) (OR (SETQ MOVEDPTS (INTERSECTION ELTHOTSPOTS LOCALPTS)) (RETURN)) - - (* map the difference point onto a grid location that would have the same - screen distance but will leave things on a power of two.) + + (* map the difference point onto a grid location that would have the same screen + distance but will leave things on a power of two.) (SETQ OLDGLOBAL (fetch (SCREENELT GLOBALPART) of SELELT)) (COND ((EQ (LENGTH MOVEDPTS) - (LENGTH ELTHOTSPOTS)) - - (* all of its hot spots have been moved, just translate it) - + (LENGTH ELTHOTSPOTS)) (* all of its hot spots have been + moved, just translate it) (OR (SETQ NEWGLOBAL (SK.TRANSLATE.GLOBALPART OLDGLOBAL GLOBALDELTAPOS W)) (RETURN NIL))) ((SETQ NEWGLOBAL (SK.TRANSLATE.POINTS MOVEDPTS GLOBALDELTAPOS SELELT W))) @@ -4284,13 +4289,13 @@ This will be slow for arcs and curves."] (RETURN NEWGLOBAL]) (SK.TRANSLATEPTSFN - [LAMBDA (ELEMENTTYPE) (* rrb " 5-May-85 16:25") + [LAMBDA (ELEMENTTYPE) (* rrb " 5-May-85 16:25") (* goes from an element type name to  its EXPANDFN) (fetch (SKETCHTYPE TRANSLATEPTSFN) of (GETPROP ELEMENTTYPE 'SKETCHTYPE]) (SK.TRANSLATE.POINTS - [LAMBDA (SELPTS GLOBALDELTA SKETCHELT W) (* rrb " 6-May-86 11:01") + [LAMBDA (SELPTS GLOBALDELTA SKETCHELT W) (* rrb " 6-May-86 11:01") (* moves the selected points by a  global amount.) (AND SKETCHELT (PROG ((NEWGLOBAL (APPLY* (SK.TRANSLATEPTSFN (fetch (SCREENELT GTYPE) of SKETCHELT @@ -4302,9 +4307,9 @@ This will be slow for arcs and curves."] (RETURN NEWGLOBAL]) (SK.SELECT.MULTIPLE.POINTS - [LAMBDA (SKW) (* rrb "10-Dec-85 16:41") - - (* * allows the user to select a collection of control points.) + [LAMBDA (SKW) (* rrb "10-Dec-85 16:41") + + (* * allows the user to select a collection of control points.) (PROG ((INTERIOR (DSPCLIPPINGREGION NIL SKW)) SELECTABLEITEMS HOTSPOTCACHE NOW OLDX ORIGX NEWX NEWY OLDY ORIGY SELPTS PREVMOUSEBUTTONS @@ -4320,55 +4325,50 @@ This will be slow for arcs and curves."] (COND ((INSIDEP INTERIOR (LASTMOUSEX SKW) (LASTMOUSEY SKW))) - (T - - (* first press was outside of the window, don't select anything.) - + (T (* first press was outside of the + window, don't select anything.) (SK.TAKE.MARKS.DOWN SKW HOTSPOTCACHE) (RETURN))) SELECTLP (COND ((MOUSESTATE UP) (GO SHIFTDOWNLP))) - - (* this label provides an entry for the code that tests if the shift key is - down.) + + (* this label provides an entry for the code that tests if the shift key is down.) SELAFTERTEST (SETQ NEWY (LASTMOUSEY SKW)) (SETQ NEWX (LASTMOUSEX SKW)) [COND [(NOT MOUSEINSIDE?) - - (* mouse is outside, don't do anything other than wait for it to come back in. - If the user has let up all buttons, the branch to SELECTEXIT will have been - taken.) + + (* mouse is outside, don't do anything other than wait for it to come back in. + If the user has let up all buttons, the branch to SELECTEXIT will have been + taken.) (COND ((INSIDEP INTERIOR NEWX NEWY) (SETQ MOUSEINSIDE? T) (* restore the saved selected items.) (for ELT in SELPTS do (SK.ADD.PT.SELECTION ELT SKW] ((NOT (INSIDEP INTERIOR NEWX NEWY)) - - (* mouse just went outside, remove selections but save them in case mouse comes - back in.) + + (* mouse just went outside, remove selections but save them in case mouse comes + back in.) (SETQ MOUSEINSIDE? NIL) (SETQ SELPTS (WINDOWPROP SKW 'SKETCH.SELECTIONS)) (for ELT in SELPTS do (SK.REMOVE.PT.SELECTION ELT SKW))) [(NEQ PREVMOUSEBUTTONS LASTMOUSEBUTTONS) - - (* another button has gone down, mark this as the origin of a new box to sweep.) + + (* another button has gone down, mark this as the origin of a new box to sweep.) (SETQ PREVMOUSEBUTTONS LASTMOUSEBUTTONS) (SETQ ORIGX (LASTMOUSEX SKW)) - (SETQ ORIGY (LASTMOUSEY SKW)) - - (* add or delete the element that the button press occurred on if any.) - + (SETQ ORIGY (LASTMOUSEY SKW)) (* add or delete the element that the + button press occurred on if any.) (AND (SETQ NOW (IN.SKETCH.ELT? HOTSPOTCACHE (create POSITION - XCOORD _ NEWX - YCOORD _ NEWY) + XCOORD ← NEWX + YCOORD ← NEWY) T)) (COND ((LASTMOUSESTATE (ONLY LEFT)) (* add selection.) @@ -4380,10 +4380,8 @@ This will be slow for arcs and curves."] (SETQ SELPTS (SK.CONTROL.POINTS.IN.REGION HOTSPOTCACHE (MIN ORIGX NEWX) (MIN ORIGY NEWY) (MAX ORIGX NEWX) - (MAX ORIGY NEWY] - - (* add or delete any with in the swept out area.) - + (MAX ORIGY NEWY] (* add or delete any with in the swept + out area.) (COND ((LASTMOUSESTATE (ONLY LEFT)) (* left only selects.) (for SELPT in SELPTS do (SK.ADD.PT.SELECTION SELPT SKW))) @@ -4394,18 +4392,14 @@ This will be slow for arcs and curves."] (GO SELECTLP) SHIFTDOWNLP (COND - ((MOUSESTATE (NOT UP)) - - (* button went down again, initialize the button state and click position.) - + ((MOUSESTATE (NOT UP)) (* button went down again, initialize + the button state and click position.) (SETQ PREVMOUSEBUTTONS NIL) (GO SELAFTERTEST)) ((.SHIFTKEYDOWNP.) [COND - [(NOT MOUSEINSIDE?) - - (* mouse is outside%: if it comes back in, mark the selections.) - + [(NOT MOUSEINSIDE?) (* mouse is outside%: if it comes back + in, mark the selections.) (COND ((INSIDEP INTERIOR (LASTMOUSEX SKW) (LASTMOUSEY SKW)) @@ -4424,9 +4418,9 @@ This will be slow for arcs and curves."] (RETURN SELPTS]) (SK.CONTROL.POINTS.IN.REGION - [LAMBDA (HOTSPOTCACHE LEFT BOTTOM RIGHT TOP) (* rrb " 6-May-85 16:22") - - (* * returns a list of the control points that are within LOCALREGION) + [LAMBDA (HOTSPOTCACHE LEFT BOTTOM RIGHT TOP) (* rrb " 6-May-85 16:22") + + (* * returns a list of the control points that are within LOCALREGION) (PROG ((RLEFT (DIFFERENCE LEFT SK.POINT.WIDTH)) (RBOTTOM (DIFFERENCE BOTTOM SK.POINT.WIDTH)) @@ -4444,17 +4438,15 @@ This will be slow for arcs and curves."] do (COND ((ILESSP (CAR XBUCKET) RLEFT) (* stop when X gets too small.) - (RETURN))) - - (* collect the points if there are any elements cached there.) - + (RETURN))) (* collect the points if there are any + elements cached there.) (AND (CDR XBUCKET) (SETQ ELTS (SK.ADD.POINT ELTS (CAR XBUCKET) (CAR YBUCKET] (RETURN ELTS]) (SK.ADD.PT.SELECTION - [LAMBDA (PT WINDOW MARKBM) (* rrb " 9-May-85 10:18") + [LAMBDA (PT WINDOW MARKBM) (* rrb " 9-May-85 10:18") (* adds an item to the selection list  of WINDOW.) (COND @@ -4463,22 +4455,21 @@ This will be slow for arcs and curves."] (WINDOWADDPROP WINDOW 'SKETCH.SELECTIONS PT]) (SK.REMOVE.PT.SELECTION - [LAMBDA (PT WINDOW MARKBM) (* rrb " 9-May-85 10:22") + [LAMBDA (PT WINDOW MARKBM) (* rrb " 9-May-85 10:22") (* removes an item from the selection  list of WINDOW.) (COND ((MEMBER PT (WINDOWPROP WINDOW 'SKETCH.SELECTIONS)) (MARKPOINT PT WINDOW MARKBM) - - (* used to call WINDOWDELPROP but it has a bug that it only removes EQ things.) + + (* used to call WINDOWDELPROP but it has a bug that it only removes EQ things.) (WINDOWPROP WINDOW 'SKETCH.SELECTIONS (REMOVE PT (WINDOWPROP WINDOW 'SKETCH.SELECTIONS]) (SK.ADD.POINT - [LAMBDA (PTLST X Y) (* rrb " 6-May-85 16:22") - - (* add the point X Y to PTLST unless it is already a member.) - + [LAMBDA (PTLST X Y) (* rrb " 6-May-85 16:22") + (* add the point X Y to PTLST unless + it is already a member.) (COND ((for PT in PTLST thereis (AND (EQ (fetch (POSITION XCOORD) of PT) X) @@ -4486,27 +4477,25 @@ This will be slow for arcs and curves."] Y))) PTLST) (T (CONS (create POSITION - XCOORD _ X - YCOORD _ Y) + XCOORD ← X + YCOORD ← Y) PTLST]) (SK.ELTS.CONTAINING.PTS - [LAMBDA (PTLST SKW) (* rrb " 4-May-85 15:38") - - (* returns the list of elements that have any points on PTLST.) - - (bind (HOTSPOTCACHE _ (SK.HOTSPOT.CACHE SKW)) + [LAMBDA (PTLST SKW) (* rrb " 4-May-85 15:38") + (* returns the list of elements that + have any points on PTLST.) + (bind (HOTSPOTCACHE ← (SK.HOTSPOT.CACHE SKW)) ELTS for POS in PTLST do (SETQ ELTS (UNION (SK.ELTS.FROM.HOTSPOT POS HOTSPOTCACHE) ELTS)) finally - - (* reverse them so the first selected pt has its element first.) - + (* reverse them so the first selected + pt has its element first.) (RETURN (REVERSE ELTS]) (SK.HOTSPOTS.NOT.ON.LIST - [LAMBDA (PTLST ELTS) (* rrb "19-Jul-85 13:18") - - (* returns a list of the hot spots on any of ELTS that aren't on PTLST.) + [LAMBDA (PTLST ELTS) (* rrb "19-Jul-85 13:18") + + (* returns a list of the hot spots on any of ELTS that aren't on PTLST.) (bind OTHERHOTSPOTS for ELT in ELTS do [for HOTSPOT in (fetch (SCREENELT HOTSPOTS) of ELT) do (OR (MEMBER HOTSPOT PTLST) @@ -4522,9 +4511,9 @@ This will be slow for arcs and curves."] (DEFINEQ (SK.SET.MOVE.MODE - [LAMBDA (SKW NEWMODE) (* rrb " 2-Jun-85 12:52") - - (* * reads a value of move command mode and makes it the default) + [LAMBDA (SKW NEWMODE) (* rrb " 2-Jun-85 12:52") + + (* * reads a value of move command mode and makes it the default) (PROG [(LOCALNEWMODE (OR NEWMODE (READMOVEMODE] (RETURN (AND LOCALNEWMODE (replace (SKETCHCONTEXT SKETCHMOVEMODE) @@ -4535,31 +4524,30 @@ This will be slow for arcs and curves."] NIL]) (SK.SET.MOVE.MODE.POINTS - [LAMBDA (SKW) (* rrb " 2-Jun-85 12:47") + [LAMBDA (SKW) (* rrb " 2-Jun-85 12:47") (* sets the default to move mode to  points.) (SK.SET.MOVE.MODE SKW 'POINTS]) (SK.SET.MOVE.MODE.ELEMENTS - [LAMBDA (SKW) (* rrb " 2-Jun-85 12:48") + [LAMBDA (SKW) (* rrb " 2-Jun-85 12:48") (* sets the default to move mode to  elements) (SK.SET.MOVE.MODE SKW 'ELEMENTS]) (SK.SET.MOVE.MODE.COMBINED - [LAMBDA (SKW) (* rrb " 2-Jun-85 12:49") + [LAMBDA (SKW) (* rrb " 2-Jun-85 12:49") (* sets the default to move mode to  combined move.) (SK.SET.MOVE.MODE SKW 'COMBINED]) (READMOVEMODE - [LAMBDA (MENUTITLE) (* rrb " 6-Nov-85 09:54") - - (* interacts to get whether move mode should be points, elements or both.) - + [LAMBDA (MENUTITLE) (* rrb " 6-Nov-85 09:54") + (* interacts to get whether move mode + should be points, elements or both.) (\CURSOR.IN.MIDDLE.MENU (create MENU - TITLE _ (OR MENUTITLE "Top level MOVE command should apply to?") - ITEMS _ '((Points 'POINTS + TITLE ← (OR MENUTITLE "Top level MOVE command should apply to?") + ITEMS ← '((Points 'POINTS "Top level MOVE command will be the same as MOVE POINTS command." ) (Elements 'ELEMENTS @@ -4568,84 +4556,75 @@ This will be slow for arcs and curves."] (Combined 'COMBINED "MOVE command will move points if a single point is clicked; elements otherwise" )) - CENTERFLG _ T]) + CENTERFLG ← T]) ) (DEFINEQ (SK.ALIGN.POINTS - [LAMBDA (W) (* rrb "31-Jan-86 10:50") - - (* lets the user select a collection of points and aligns them.) - + [LAMBDA (W) (* rrb "31-Jan-86 10:50") + (* lets the user select a collection + of points and aligns them.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.MOVE.POINTS (KWOTE W)) W]) (SK.SEL.AND.ALIGN.POINTS - [LAMBDA (ALIGNHOW W) (* rrb "22-Jan-86 14:57") - - (* * lets the user select a collection of control point and aligns them.) + [LAMBDA (ALIGNHOW W) (* rrb "22-Jan-86 14:57") + + (* * lets the user select a collection of control point and aligns them.) (SK.DO.ALIGN.POINTS (SK.SELECT.MULTIPLE.POINTS W) ALIGNHOW W]) (SK.ALIGN.POINTS.LEFT - [LAMBDA (W) (* rrb "31-Jan-86 10:51") - - (* lets the user select a collection of points and aligns them.) - + [LAMBDA (W) (* rrb "31-Jan-86 10:51") + (* lets the user select a collection + of points and aligns them.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.ALIGN.POINTS ''LEFT (KWOTE W)) W]) (SK.ALIGN.POINTS.RIGHT - [LAMBDA (W) (* rrb "31-Jan-86 10:51") - - (* lets the user select a collection of points and aligns them.) - + [LAMBDA (W) (* rrb "31-Jan-86 10:51") + (* lets the user select a collection + of points and aligns them.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.ALIGN.POINTS ''RIGHT (KWOTE W)) W]) (SK.ALIGN.POINTS.TOP - [LAMBDA (W) (* rrb "31-Jan-86 10:57") - - (* lets the user select a collection of points and aligns them.) - + [LAMBDA (W) (* rrb "31-Jan-86 10:57") + (* lets the user select a collection + of points and aligns them.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.ALIGN.POINTS ''TOP (KWOTE W)) W]) (SK.ALIGN.POINTS.BOTTOM - [LAMBDA (W) (* rrb "31-Jan-86 10:58") - - (* lets the user select a collection of points and aligns them.) - + [LAMBDA (W) (* rrb "31-Jan-86 10:58") + (* lets the user select a collection + of points and aligns them.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.ALIGN.POINTS ''BOTTOM (KWOTE W)) W]) (SK.EVEN.SPACE.POINTS.IN.X - [LAMBDA (W) (* rrb "31-Jan-86 10:58") - - (* lets the user select a collection of points and spaces them evenly in X) - + [LAMBDA (W) (* rrb "31-Jan-86 10:58") + (* lets the user select a collection + of points and spaces them evenly in X) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.ALIGN.POINTS ''EVENX (KWOTE W)) W]) (SK.EVEN.SPACE.POINTS.IN.Y - [LAMBDA (W) (* rrb "31-Jan-86 10:58") - - (* lets the user select a collection of points and spaces them evenly in Y) - + [LAMBDA (W) (* rrb "31-Jan-86 10:58") + (* lets the user select a collection + of points and spaces them evenly in Y) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.ALIGN.POINTS ''EVENY (KWOTE W)) W]) (SK.DO.ALIGN.POINTS - [LAMBDA (SCRPTS ALIGNHOW SKW) (* rrb "12-Sep-86 18:28") - - (* * aligns a collection of points according to ALIGNHOW which can be LEFT - RIGHT TOP BOTTOM EVENX or EVENY) + [LAMBDA (SCRPTS ALIGNHOW SKW) (* rrb "12-Sep-86 18:28") - (SKED.CLEAR.SELECTION SKW) - - (* if there isn't at least two points, don't do anything.) + (* * aligns a collection of points according to ALIGNHOW which can be LEFT RIGHT + TOP BOTTOM EVENX or EVENY) + (SKED.CLEAR.SELECTION SKW) (* if there isn't at least two points, + don't do anything.) (AND (CDR SCRPTS) (PROG ((SELECTEDPTSTRUC (SK.GET.SELECTED.ELEMENT.STRUCTURE SCRPTS SKW)) MOSTSELBUCK LEASTSELBUCK DIMENSION LEAST MOST PREMOVEFN X NEWGLOBALS) @@ -4659,10 +4638,8 @@ This will be slow for arcs and curves."] 'DON'T) (RETURN)) (SETQ MOSTSELBUCK (CAR SELECTEDPTSTRUC)) - (SETQ LEASTSELBUCK (CAR SELECTEDPTSTRUC)) - - (* find the dimension of interest and do some error checking.) - + (SETQ LEASTSELBUCK (CAR SELECTEDPTSTRUC)) (* find the dimension of interest and + do some error checking.) (SETQ DIMENSION (SELECTQ ALIGNHOW ((LEFT RIGHT) 'HORIZONTAL) @@ -4789,22 +4766,22 @@ This will be slow for arcs and curves."] N]) (SK.GET.SELECTED.ELEMENT.STRUCTURE - [LAMBDA (SELPTS SKW) (* rrb "22-Jan-86 14:58") - - (* returns a list of the points and elements that each selected point on SELPTS - corresponds to. Returns a list of lists of the form - (SELPT (GPT1 GELT1) |...| (GPTn GELTn))) + [LAMBDA (SELPTS SKW) (* rrb "22-Jan-86 14:58") - (bind (HOTSPOTCACHE _ (SK.HOTSPOT.CACHE SKW)) for POS in SELPTS + (* returns a list of the points and elements that each selected point on SELPTS + corresponds to. Returns a list of lists of the form + (SELPT (GPT1 GELT1) |...| (GPTn GELTn))) + + (bind (HOTSPOTCACHE ← (SK.HOTSPOT.CACHE SKW)) for POS in SELPTS collect (CONS POS (for ELT in (SK.ELTS.FROM.HOTSPOT POS HOTSPOTCACHE) collect (LIST (SK.CORRESPONDING.CONTROL.PT POS ELT) ELT]) (SK.CORRESPONDING.CONTROL.PT - [LAMBDA (SELPT SCRELEMENT) (* rrb "22-Jan-86 14:59") - - (* returns the global control point of an element that corresponds to the - screen point SELPT.) + [LAMBDA (SELPT SCRELEMENT) (* rrb "22-Jan-86 14:59") + + (* returns the global control point of an element that corresponds to the screen + point SELPT.) (for I from 1 as PT in (fetch (SCREENELT HOTSPOTS) of SCRELEMENT) when (EQUAL PT SELPT) do (RETURN (OR (SK.NTH.CONTROL.POINT (fetch (SCREENELT GLOBALPART) of SCRELEMENT) @@ -4812,28 +4789,27 @@ This will be slow for arcs and curves."] (SHOULDNT]) (SK.CONTROL.POINT.NUMBER - [LAMBDA (SELPT SCRELT) (* rrb "22-Jan-86 10:54") - - (* returns the control point number that SELPT is on the element SCRELT) - + [LAMBDA (SELPT SCRELT) (* rrb "22-Jan-86 10:54") + (* returns the control point number + that SELPT is on the element SCRELT) (for I from 1 as HOTPT in (fetch (SCREENELT HOTSPOTS) of SCRELT) when (EQUAL SELPT HOTPT) do (RETURN I]) (SK.DO.ALIGN.SETVALUE - [LAMBDA (SELBUCKET VALUE DIMENSION VIEWER) (* rrb "22-Jan-86 17:23") + [LAMBDA (SELBUCKET VALUE DIMENSION VIEWER) (* rrb "22-Jan-86 17:23") (* performs the alignment of a  selection bucket structure.) - (bind (SELPT _ (CAR SELBUCKET)) - (MOVEFN _ (GETSKETCHPROP (INSURE.SKETCH VIEWER) + (bind (SELPT ← (CAR SELBUCKET)) + (MOVEFN ← (GETSKETCHPROP (INSURE.SKETCH VIEWER) 'WHENMOVEDFN)) GDELTA X for GELTSTRUC in (CDR SELBUCKET) when (PROG NIL - - (* calculate the amount that this global element point should be moved and - apply move fn) + + (* calculate the amount that this global element point should be moved and apply + move fn) (* don't move it if it moves 0.0) [SETQ GDELTA (create POSITION - XCOORD _ (COND + XCOORD ← (COND ((EQ DIMENSION 'HORIZONTAL) (COND ([ZEROP (SETQ X (DIFFERENCE VALUE @@ -4842,7 +4818,7 @@ This will be slow for arcs and curves."] (RETURN)) (T X))) (T 0)) - YCOORD _ (COND + YCOORD ← (COND ((EQ DIMENSION 'VERTICAL) (COND ([ZEROP (SETQ X (DIFFERENCE VALUE @@ -4863,15 +4839,15 @@ This will be slow for arcs and curves."] ((EQ X 'DON'T) (* if DON'T, don't move this guy.) (RETURN NIL)) ((POSITIONP X) - - (* value returned is the delta by which to move the point. - Set up new position) + + (* value returned is the delta by which to move the point. + Set up new position) (SETQ GDELTA X))) (RETURN T)) join - - (* build the history structure here because this is where the old screen - element is known.) + + (* build the history structure here because this is where the old screen element + is known.) (AND (SETQ X (SK.MOVE.ITEM.POINTS (CADR GELTSTRUC) GDELTA VIEWER (LIST SELPT))) @@ -4887,26 +4863,25 @@ This will be slow for arcs and curves."] (DEFINEQ (SKETCH.CREATE.GROUP - [LAMBDA (LISTOFSKETCHELEMENTS CONTROLPOINT) (* rrb " 4-Dec-85 21:38") + [LAMBDA (LISTOFSKETCHELEMENTS CONTROLPOINT) (* rrb " 4-Dec-85 21:38") (* creates a sketch group element.) (SK.CREATE.GROUP1 LISTOFSKETCHELEMENTS (OR (POSITIONP CONTROLPOINT) (REGION.CENTER (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS LISTOFSKETCHELEMENTS]) (SK.CREATE.GROUP1 - [LAMBDA (GELTS CONTROLPT) (* rrb " 4-Dec-85 21:38") + [LAMBDA (GELTS CONTROLPT) (* rrb " 4-Dec-85 21:38") (* creates a group element.) (SK.UPDATE.GROUP.AFTER.CHANGE (create GLOBALPART - INDIVIDUALGLOBALPART _ + INDIVIDUALGLOBALPART ← (create GROUP - LISTOFGLOBALELTS _ GELTS - GROUPCONTROLPOINT _ CONTROLPT]) + LISTOFGLOBALELTS ← GELTS + GROUPCONTROLPOINT ← CONTROLPT]) (SK.UPDATE.GROUP.AFTER.CHANGE - [LAMBDA (GROUPELT) (* rrb " 4-Dec-85 21:38") - - (* updates the dependent field of a group element after a change.) - + [LAMBDA (GROUPELT) (* rrb " 4-Dec-85 21:38") + (* updates the dependent field of a + group element after a change.) (PROG ((INDGROUPELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of GROUPELT)) GROUPREGION) (SETQ GROUPREGION (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS (fetch (GROUP LISTOFGLOBALELTS) @@ -4917,26 +4892,25 @@ This will be slow for arcs and curves."] (RETURN GROUPELT]) (SK.GROUP.ELTS - [LAMBDA (W) (* rrb "31-Jan-86 10:58") - - (* lets the user select a collection elements and groups them.) - + [LAMBDA (W) (* rrb "31-Jan-86 10:58") + (* lets the user select a collection + elements and groups them.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.GROUP (KWOTE W)) W]) (SK.SEL.AND.GROUP - [LAMBDA (W) (* rrb "10-Dec-85 17:08") + [LAMBDA (W) (* rrb "10-Dec-85 17:08") (* lets the user select elements and  groups them.) (SK.GROUP.ELEMENTS (SK.SELECT.MULTIPLE.ITEMS W T NIL 'GROUP) W]) (SK.GROUP.ELEMENTS - [LAMBDA (SCRELTS SKW) (* rrb "11-Jul-86 15:51") - - (* groups the collection of elements SCRELTS. - Does this by creating a group element, adding it and deleting the individual - elements.) + [LAMBDA (SCRELTS SKW) (* rrb "11-Jul-86 15:51") + + (* groups the collection of elements SCRELTS. + Does this by creating a group element, adding it and deleting the individual + elements.) (SKED.CLEAR.SELECTION SKW) (AND SCRELTS (PROG (GROUPELT LOCALGROUPELT) (* call the group fn if there is one.) @@ -4948,10 +4922,9 @@ This will be slow for arcs and curves."]  SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS SCRELTS (VIEWER.SCALE SKW))) - SKW))) - - (* do grouping. This might return NIL if the when grouped function says not to.) - + SKW))) (* do grouping. This might return NIL + if the when grouped function says not + to.) (OR (SK.DO.GROUP GROUPELT SKW) (RETURN)) (* record it on the history list.) (SK.ADD.HISTEVENT 'GROUP (LIST (LIST GROUPELT)) @@ -4959,15 +4932,14 @@ This will be slow for arcs and curves."] (RETURN GROUPELT]) (SK.UNGROUP.ELT - [LAMBDA (W) (* rrb "31-Jan-86 10:58") - - (* lets the user select a collection elements and groups them.) - + [LAMBDA (W) (* rrb "31-Jan-86 10:58") + (* lets the user select a collection + elements and groups them.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.UNGROUP (KWOTE W)) W]) (SK.SEL.AND.UNGROUP - [LAMBDA (W) (* rrb "10-Dec-85 18:03") + [LAMBDA (W) (* rrb "10-Dec-85 18:03") (* lets the user select elements and  groups them.) (PROG NIL @@ -4990,26 +4962,24 @@ This will be slow for arcs and curves."] W]) (SK.UNGROUP.ELEMENT - [LAMBDA (SCRELTS SKW) (* rrb "15-Jan-86 16:12") + [LAMBDA (SCRELTS SKW) (* rrb "15-Jan-86 16:12") (* ungroups the first group element in  SCRELTS.) (PROG ((GROUPELTS (for ELT in SCRELTS when (EQ (fetch (SCREENELT GTYPE) of ELT) 'GROUP) collect (fetch (SCREENELT GLOBALPART) of ELT))) X) - (OR GROUPELTS (RETURN)) - - (* do the ungrouping. this may return NIL if the ungroup fn says don't.) - + (OR GROUPELTS (RETURN)) (* do the ungrouping. + this may return NIL if the ungroup fn + says don't.) (SETQ X (for GROUPELT in GROUPELTS when (SK.DO.UNGROUP GROUPELT SKW) collect (LIST GROUPELT))) (AND X (SK.ADD.HISTEVENT 'UNGROUP X SKW]) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS - [LAMBDA (SCRELTS SCALE) (* rrb "30-Sep-86 18:33") - - (* returns the global region occuppied by a list of local elements.) - + [LAMBDA (SCRELTS SCALE) (* rrb "30-Sep-86 18:33") + (* returns the global region occuppied + by a list of local elements.) (PROG (GROUPREGION) [for SCRELT in SCRELTS do (SETQ GROUPREGION (COND (GROUPREGION @@ -5021,10 +4991,9 @@ This will be slow for arcs and curves."] (RETURN (UNSCALE.REGION GROUPREGION SCALE]) (SK.LOCAL.REGION.OF.LOCAL.ELEMENTS - [LAMBDA (SCRELTS SCALE) (* rrb "30-Sep-86 18:33") - - (* returns the local region occupied by a list of local elements.) - + [LAMBDA (SCRELTS SCALE) (* rrb "30-Sep-86 18:33") + (* returns the local region occupied + by a list of local elements.) (bind GROUPREGION for SCRELT in SCRELTS do [SETQ GROUPREGION (COND (GROUPREGION (* first time because UNIONREGIONS @@ -5036,16 +5005,15 @@ This will be slow for arcs and curves."] finally (RETURN GROUPREGION]) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS - [LAMBDA (GELTS) (* rrb "30-Sep-86 17:35") - - (* returns the global region occuppied by a list of global elements.) - + [LAMBDA (GELTS) (* rrb "30-Sep-86 17:35") + (* returns the global region occuppied + by a list of global elements.) (COND [(LESSP (LENGTH GELTS) 50) - - (* for smallish numbers of elements, only do the cons to create the args to - SK.UNIONREGIONS.) + + (* for smallish numbers of elements, only do the cons to create the args to + SK.UNIONREGIONS.) (APPLY (FUNCTION SK.UNIONREGIONS) (for GELT in GELTS collect (SK.ELEMENT.GLOBAL.REGION GELT] @@ -5061,10 +5029,10 @@ This will be slow for arcs and curves."] (RETURN GROUPREGION]) (SK.UNIONREGIONS - [LAMBDA REGIONS (* rrb "30-Sep-86 18:14") - - (* returns the smallest region that encloses all of REGIONS Is different from - UNIONREGIONS because it works in floating pt) + [LAMBDA REGIONS (* rrb "30-Sep-86 18:14") + + (* returns the smallest region that encloses all of REGIONS Is different from + UNIONREGIONS because it works in floating pt) (COND ((EQ 0 REGIONS) @@ -5095,19 +5063,19 @@ This will be slow for arcs and curves."] TP) (SETQ TP X] (RETURN (create REGION - LEFT _ LFT - BOTTOM _ BTTM - WIDTH _ (DIFFERENCE RGHT LFT) - HEIGHT _ (DIFFERENCE TP BTTM]) + LEFT ← LFT + BOTTOM ← BTTM + WIDTH ← (DIFFERENCE RGHT LFT) + HEIGHT ← (DIFFERENCE TP BTTM]) (SKETCH.REGION.OF.SKETCH - [LAMBDA (SKETCH) (* rrb "23-Oct-85 11:17") + [LAMBDA (SKETCH) (* rrb "23-Oct-85 11:17") (* returns the global region of a  sketch.) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS (fetch (SKETCH SKETCHELTS) of (INSURE.SKETCH SKETCH]) (SK.FLASHREGION - [LAMBDA (REGION WINDOW TEXTURE) (* rrb "30-Jul-85 15:47") + [LAMBDA (REGION WINDOW TEXTURE) (* rrb "30-Jul-85 15:47") (* flashes a region) (DSPFILL REGION TEXTURE 'INVERT WINDOW) (DISMISS 400) @@ -5116,7 +5084,7 @@ This will be slow for arcs and curves."] (DEFINEQ (INIT.GROUP.ELEMENT - [LAMBDA NIL (* rrb "18-Oct-85 17:15") + [LAMBDA NIL (* rrb "18-Oct-85 17:15") (* initializes the text box element.) (COND ((NOT (SKETCH.ELEMENT.TYPEP 'GROUP)) @@ -5136,81 +5104,78 @@ This will be slow for arcs and curves."] (FUNCTION GROUP.GLOBALREGIONFN]) (GROUP.DRAWFN - [LAMBDA (GROUPELT WINDOW REGION OPERATION) (* rrb "10-Dec-85 12:38") + [LAMBDA (GROUPELT WINDOW REGION OPERATION) (* rrb "10-Dec-85 12:38") (* draws a group element.) (for ELT in (fetch (LOCALGROUP LOCALELEMENTS) of (fetch (SCREENELT LOCALPART) of GROUPELT)) do (APPLY* (SK.DRAWFN (fetch (SCREENELT GTYPE) of ELT)) ELT WINDOW REGION OPERATION]) (GROUP.EXPANDFN - [LAMBDA (GROUPELT SCALE STREAM) (* rrb "30-Dec-85 17:30") - - (* creates a local group screen element from a global group element) - + [LAMBDA (GROUPELT SCALE STREAM) (* rrb "30-Dec-85 17:30") + (* creates a local group screen + element from a global group element) (PROG ((GROUPINDVELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of GROUPELT)) LOCALREGION) (SETQ LOCALREGION (SCALE.REGION.OUT (fetch (GROUP GROUPREGION) of GROUPINDVELT) SCALE)) (* put the position in the center.) (RETURN (create SCREENELT - LOCALPART _ (create LOCALGROUP - GROUPPOSITION _ (SK.SCALE.POSITION.INTO.VIEWER + LOCALPART ← (create LOCALGROUP + GROUPPOSITION ← (SK.SCALE.POSITION.INTO.VIEWER (fetch (GROUP GROUPCONTROLPOINT) of GROUPINDVELT) SCALE) - LOCALGROUPREGION _ LOCALREGION - LOCALELEMENTS _ (for ELEMENT + LOCALGROUPREGION ← LOCALREGION + LOCALELEMENTS ← (for ELEMENT in (fetch (GROUP LISTOFGLOBALELTS) of GROUPINDVELT) - collect (SK.LOCAL.FROM.GLOBAL ELEMENT + collect (SK.LOCAL.FROM.GLOBAL ELEMENT STREAM SCALE))) - GLOBALPART _ GROUPELT]) + GLOBALPART ← GROUPELT]) (GROUP.INSIDEFN - [LAMBDA (GROUPELT WREG) (* rrb "10-Jan-85 10:37") - - (* determines if the global group element GROUPELT is inside of WREG.) - + [LAMBDA (GROUPELT WREG) (* rrb "10-Jan-85 10:37") + (* determines if the global group + element GROUPELT is inside of WREG.) (REGIONSINTERSECTP (fetch (GROUP GROUPREGION) of (fetch (GLOBALPART INDIVIDUALGLOBALPART) of GROUPELT)) WREG]) (GROUP.REGIONFN - [LAMBDA (GROUPSCRELT) (* rrb "10-Dec-85 12:38") + [LAMBDA (GROUPSCRELT) (* rrb "10-Dec-85 12:38") (* returns the region occuppied by a  group) (fetch (LOCALGROUP LOCALGROUPREGION) of (fetch (SCREENELT LOCALPART) of GROUPSCRELT]) (GROUP.GLOBALREGIONFN - [LAMBDA (GGROUPELT) (* rrb "18-Oct-85 17:13") - - (* returns the global region occupied by a global group element.) - + [LAMBDA (GGROUPELT) (* rrb "18-Oct-85 17:13") + (* returns the global region occupied + by a global group element.) (fetch (GROUP GROUPREGION) of (fetch (GLOBALPART INDIVIDUALGLOBALPART) of GGROUPELT]) (GROUP.TRANSLATEFN - [LAMBDA (SKELT DELTAPOS) (* rrb "28-Apr-85 18:43") - - (* * returns a group element which has been translated by DELTAPOS) + [LAMBDA (SKELT DELTAPOS) (* rrb "28-Apr-85 18:43") + + (* * returns a group element which has been translated by DELTAPOS) (PROG ((GGROUPELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of SKELT)) NEWREG) (SETQ NEWREG (REL.MOVE.REGION (fetch (GROUP GROUPREGION) of GGROUPELT) (fetch (POSITION XCOORD) of DELTAPOS) (fetch (POSITION YCOORD) of DELTAPOS))) - - (* makes a copy of the common global part because it includes the scales which - may change for one of the instances.) + + (* makes a copy of the common global part because it includes the scales which + may change for one of the instances.) (RETURN (create GLOBALPART - COMMONGLOBALPART _ (APPEND (fetch (GLOBALPART COMMONGLOBALPART) of SKELT)) - INDIVIDUALGLOBALPART _ (create GROUP - GROUPREGION _ NEWREG - LISTOFGLOBALELTS _ + COMMONGLOBALPART ← (APPEND (fetch (GLOBALPART COMMONGLOBALPART) of SKELT)) + INDIVIDUALGLOBALPART ← (create GROUP + GROUPREGION ← NEWREG + LISTOFGLOBALELTS ← (for SUBELT in (fetch (GROUP LISTOFGLOBALELTS) of GGROUPELT) collect (SK.TRANSLATE.GLOBALPART SUBELT DELTAPOS T)) - GROUPCONTROLPOINT _ (PTPLUS + GROUPCONTROLPOINT ← (PTPLUS (fetch (GROUP GROUPCONTROLPOINT ) @@ -5218,15 +5183,13 @@ This will be slow for arcs and curves."] DELTAPOS]) (GROUP.TRANSFORMFN - [LAMBDA (GELT TRANSFORMFN TRANSFORMDATA SCALEFACTOR) (* rrb " 2-Jun-85 13:10") - - (* * returns a group element which has been transformed by TRANSFORMFN) + [LAMBDA (GELT TRANSFORMFN TRANSFORMDATA SCALEFACTOR) (* rrb " 2-Jun-85 13:10") + + (* * returns a group element which has been transformed by TRANSFORMFN) (COND - [(EQ TRANSFORMFN (FUNCTION SK.PUT.ON.GRID)) - - (* if putting things on a grid, move only the control point.) - + [(EQ TRANSFORMFN (FUNCTION SK.PUT.ON.GRID)) (* if putting things on a grid, move + only the control point.) (PROG ((GGROUPELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of GELT)) NOWPOS) (SETQ NOWPOS (fetch (GROUP GROUPCONTROLPOINT) of GGROUPELT)) @@ -5235,34 +5198,34 @@ This will be slow for arcs and curves."] NOWPOS] (T (PROG ((GGROUPELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of GELT)) NEWREG) - - (* this transforms the old region to get the new one. - This is not as good as recalculating the new one from the transformed elements. - The latter is hard because the region function only works on local elements and - here we have only global ones.) + + (* this transforms the old region to get the new one. + This is not as good as recalculating the new one from the transformed elements. + The latter is hard because the region function only works on local elements and + here we have only global ones.) (SETQ NEWREG (SK.TRANSFORM.REGION (fetch (GROUP GROUPREGION) of GGROUPELT) TRANSFORMFN TRANSFORMDATA)) - - (* the control point could also profitably be put on a grid point but no other - elements points are so done and it would be hard.) + + (* the control point could also profitably be put on a grid point but no other + elements points are so done and it would be hard.) (RETURN (BOX.SET.SCALES NEWREG (create GLOBALPART - COMMONGLOBALPART _ (fetch (GLOBALPART + COMMONGLOBALPART ← (fetch (GLOBALPART COMMONGLOBALPART ) of GELT) - INDIVIDUALGLOBALPART _ + INDIVIDUALGLOBALPART ← (create GROUP - GROUPREGION _ NEWREG - LISTOFGLOBALELTS _ + GROUPREGION ← NEWREG + LISTOFGLOBALELTS ← (for SUBELT in (fetch (GROUP LISTOFGLOBALELTS) of GGROUPELT) - collect (SK.TRANSFORM.ELEMENT SUBELT + collect (SK.TRANSFORM.ELEMENT SUBELT TRANSFORMFN TRANSFORMDATA SCALEFACTOR)) - GROUPCONTROLPOINT _ + GROUPCONTROLPOINT ← (SK.TRANSFORM.POINT (fetch (GROUP GROUPCONTROLPOINT ) @@ -5270,20 +5233,20 @@ This will be slow for arcs and curves."] TRANSFORMFN TRANSFORMDATA]) (GROUP.READCHANGEFN - [LAMBDA (SKW SCRNELTS) (* rrb "14-May-86 19:38") + [LAMBDA (SKW SCRNELTS) (* rrb "14-May-86 19:38") (* reads how the user wants to change  a textbox.) (PROG (ASPECT HOW) (SETQ HOW (SELECTQ (SETQ ASPECT (\CURSOR.IN.MIDDLE.MENU (create MENU - TITLE _ "Change which part?" - ITEMS _ [APPEND (COND + TITLE ← "Change which part?" + ITEMS ← [APPEND (COND [(SKETCHINCOLORP) '(("Brush color" 'BRUSHCOLOR "changes the color of any lines or text in the group." ) - ("Filling color" ' - FILLINGCOLOR + ("Filling color" + 'FILLINGCOLOR "changes the filling color of any boxes or text boxes in the group." ] (T NIL)) @@ -5305,7 +5268,7 @@ This will be slow for arcs and curves."] (Text 'TEXT "allows changing the properties of the text." ] - CENTERFLG _ T))) + CENTERFLG ← T))) (TEXT (* handle TEXT specially because it  has several different cases.) (AND (SETQ HOW (TEXT.READCHANGEFN SKW SCRNELTS T)) @@ -5323,13 +5286,13 @@ This will be slow for arcs and curves."] (DEFINEQ (REGION.CENTER - [LAMBDA (REGION) (* rrb "11-Jan-85 18:22") + [LAMBDA (REGION) (* rrb "11-Jan-85 18:22") (* returns the center of a region) (create POSITION - XCOORD _ (PLUS (fetch (REGION LEFT) of REGION) + XCOORD ← (PLUS (fetch (REGION LEFT) of REGION) (QUOTIENT (fetch (REGION WIDTH) of REGION) 2)) - YCOORD _ (PLUS (fetch (REGION BOTTOM) of REGION) + YCOORD ← (PLUS (fetch (REGION BOTTOM) of REGION) (QUOTIENT (fetch (REGION HEIGHT) of REGION) 2]) @@ -5350,18 +5313,16 @@ This will be slow for arcs and curves."] (DEFINEQ (SK.MOVE.GROUP.CONTROL.PT - [LAMBDA (W) (* rrb "31-Jan-86 10:59") - - (* lets the user move the control point of a group.) - + [LAMBDA (W) (* rrb "31-Jan-86 10:59") + (* lets the user move the control + point of a group.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.MOVE.CONTROL.PT (KWOTE W)) W]) (SK.SEL.AND.MOVE.CONTROL.PT - [LAMBDA (W) (* rrb "23-Jan-86 18:11") - - (* lets the user select a groups and move its control point.) - + [LAMBDA (W) (* rrb "23-Jan-86 18:11") + (* lets the user select a groups and + move its control point.) (PROG NIL (RETURN (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT [SK.SELECT.ITEM W T (COND @@ -5380,10 +5341,9 @@ This will be slow for arcs and curves."] W]) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT - [LAMBDA (SCRGROUPELT SKW) (* rrb "27-Jun-86 15:34") - - (* reads a new location of the control point for a group element.) - + [LAMBDA (SCRGROUPELT SKW) (* rrb "27-Jun-86 15:34") + (* reads a new location of the control + point for a group element.) (PROG ((GELT (fetch (SCREENELT GLOBALPART) of SCRGROUPELT)) (INDVGELT (fetch (SCREENELT INDIVIDUALGLOBALPART) of SCRGROUPELT)) OLDPOS NEWPOS NEWGROUPELT LOCALELT) @@ -5406,19 +5366,18 @@ This will be slow for arcs and curves."] of LOCALELT)) SKW GRAYSHADE) (SK.ADD.HISTEVENT 'CHANGE (LIST (create SKHISTORYCHANGESPEC - NEWELT _ NEWGROUPELT - OLDELT _ GELT - PROPERTY _ 'POSITION - NEWVALUE _ NEWPOS - OLDVALUE _ OLDPOS)) + NEWELT ← NEWGROUPELT + OLDELT ← GELT + PROPERTY ← 'POSITION + NEWVALUE ← NEWPOS + OLDVALUE ← OLDPOS)) SKW) (RETURN NEWGROUPELT]) (SK.READ.NEW.GROUP.CONTROL.PT - [LAMBDA (VIEWER LOCALGROUPREGION) (* rrb "14-Jul-86 13:51") - - (* reads where the user wants the new control point to be.) - + [LAMBDA (VIEWER LOCALGROUPREGION) (* rrb "14-Jul-86 13:51") + (* reads where the user wants the new + control point to be.) (PROG (PT) (* outline the group) (SK.DRAWBOX (fetch (REGION LEFT) of LOCALGROUPREGION) (fetch (REGION BOTTOM) of LOCALGROUPREGION) @@ -5453,7 +5412,7 @@ This will be slow for arcs and curves."] (DEFINEQ (SK.DO.GROUP - [LAMBDA (GROUPELT SKW) (* rrb "30-Sep-86 17:38") + [LAMBDA (GROUPELT SKW) (* rrb "30-Sep-86 17:38") (* does a group event.  Used to undo UNGROUP too.) (PROG (LOCALELT OKEDGELTS) @@ -5466,17 +5425,15 @@ This will be slow for arcs and curves."] with (SK.ORDER.ELEMENTS OKEDGELTS)) (SK.UPDATE.GROUP.AFTER.CHANGE GROUPELT) (for GELT in OKEDGELTS do (SK.DELETE.ELEMENT1 GELT SKW T)) - (SETQ LOCALELT (SK.ADD.ELEMENT GROUPELT SKW T T T)) - - (* flash the grouped area to let user know something happened.) - + (SETQ LOCALELT (SK.ADD.ELEMENT GROUPELT SKW T T T))(* flash the grouped area to let user + know something happened.) (SK.FLASHREGION (fetch (LOCALGROUP LOCALGROUPREGION) of (fetch (SCREENELT LOCALPART) of LOCALELT)) SKW GRAYSHADE) (RETURN LOCALELT]) (SK.CHECK.WHENGROUPEDFN - [LAMBDA (VIEWER ELEMENTS) (* rrb "15-Jan-86 16:07") + [LAMBDA (VIEWER ELEMENTS) (* rrb "15-Jan-86 16:07") (* checks the when grouped fn of a  sketch viewer.) (PROG (GROUPFN X) @@ -5491,7 +5448,7 @@ This will be slow for arcs and curves."] (T ELEMENTS]) (SK.DO.UNGROUP - [LAMBDA (GROUPELT SKW) (* rrb "11-Jul-86 15:51") + [LAMBDA (GROUPELT SKW) (* rrb "11-Jul-86 15:51") (* does a ungroup event.  Used to undo GROUP too.) (PROG NIL @@ -5510,7 +5467,7 @@ This will be slow for arcs and curves."] (RETURN GROUPELT]) (SK.CHECK.WHENUNGROUPEDFN - [LAMBDA (VIEWER GROUPELT) (* rrb "15-Jan-86 16:19") + [LAMBDA (VIEWER GROUPELT) (* rrb "15-Jan-86 16:19") (* checks the when ungrouped fn of a  sketch viewer.) (PROG (UNGROUPFN) @@ -5520,14 +5477,14 @@ This will be slow for arcs and curves."] 'DON'T]) (SK.GROUP.UNDO - [LAMBDA (EVENTARGS SKW) (* rrb "15-Jan-86 16:12") + [LAMBDA (EVENTARGS SKW) (* rrb "15-Jan-86 16:12") (* undoes a group event) (for GRP in EVENTARGS do (SK.DO.UNGROUP (CAR GRP) SKW)) T]) (SK.UNGROUP.UNDO - [LAMBDA (EVENTARGS SKW) (* rrb "15-Jan-86 15:47") + [LAMBDA (EVENTARGS SKW) (* rrb "15-Jan-86 15:47") (* undoes a ungroup event) (for GRP in EVENTARGS do (SK.DO.GROUP (CAR GRP) SKW)) @@ -5545,22 +5502,21 @@ This will be slow for arcs and curves."] (DEFINEQ (SK.FREEZE.ELTS - [LAMBDA (W) (* rrb "31-Jan-86 10:59") - - (* lets the user select a collection elements and freezes them.) - + [LAMBDA (W) (* rrb "31-Jan-86 10:59") + (* lets the user select a collection + elements and freezes them.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.FREEZE (KWOTE W)) W]) (SK.SEL.AND.FREEZE - [LAMBDA (W) (* rrb "11-Dec-85 15:30") + [LAMBDA (W) (* rrb "11-Dec-85 15:30") (* lets the user select elements and  freezes them.) (SK.FREEZE.ELEMENTS (SK.SELECT.MULTIPLE.ITEMS W T NIL 'FROZEN) W]) (SK.FREEZE.ELEMENTS - [LAMBDA (SCRELTS SKW) (* rrb "11-Dec-85 15:30") + [LAMBDA (SCRELTS SKW) (* rrb "11-Dec-85 15:30") (* freezes the collection of elements  SCRELTS.) (PROG (GELTS GELT) @@ -5570,15 +5526,14 @@ This will be slow for arcs and curves."] (SK.ADD.HISTEVENT 'FREEZE GELTS SKW]) (SK.UNFREEZE.ELT - [LAMBDA (W) (* rrb "31-Jan-86 10:59") - - (* lets the user select a collection elements and unfreezes them.) - + [LAMBDA (W) (* rrb "31-Jan-86 10:59") + (* lets the user select a collection + elements and unfreezes them.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.UNFREEZE (KWOTE W)) W]) (SK.SEL.AND.UNFREEZE - [LAMBDA (W) (* rrb "12-Dec-85 12:25") + [LAMBDA (W) (* rrb "12-Dec-85 12:25") (* lets the user select elements and  freezes them.) (PROG NIL @@ -5600,7 +5555,7 @@ This will be slow for arcs and curves."] W]) (SK.UNFREEZE.ELEMENTS - [LAMBDA (SCRELTS SKW) (* rrb "11-Dec-85 15:30") + [LAMBDA (SCRELTS SKW) (* rrb "11-Dec-85 15:30") (* unfreezes the collection of  elements SCRELTS.) (PROG (GELTS GELT) @@ -5610,24 +5565,24 @@ This will be slow for arcs and curves."] (SK.ADD.HISTEVENT 'UNFREEZE GELTS SKW]) (SK.FREEZE.UNDO - [LAMBDA (EVENTARGS SKW) (* rrb "11-Dec-85 15:28") + [LAMBDA (EVENTARGS SKW) (* rrb "11-Dec-85 15:28") (* undoes a freeze event) (SK.DO.UNFREEZE EVENTARGS SKW]) (SK.UNFREEZE.UNDO - [LAMBDA (EVENTARGS SKW) (* rrb "11-Dec-85 15:28") + [LAMBDA (EVENTARGS SKW) (* rrb "11-Dec-85 15:28") (* undoes a unfreeze event) (SK.DO.FREEZE EVENTARGS SKW]) (SK.DO.FREEZE - [LAMBDA (GELTS SKW) (* rrb "11-Dec-85 15:27") + [LAMBDA (GELTS SKW) (* rrb "11-Dec-85 15:27") (* does a freeze event.  Used to undo UNFREEZE too.) (for GELT in GELTS do (ADDSKETCHELEMENTPROP GELT 'PROTECTION 'FROZEN)) GELTS]) (SK.DO.UNFREEZE - [LAMBDA (GELTS SKW) (* rrb "11-Dec-85 15:27") + [LAMBDA (GELTS SKW) (* rrb "11-Dec-85 15:27") (* does a unfreeze event.  Used to undo FREEZE too.) (for GELT in GELTS do (REMOVESKETCHELEMENTPROP GELT 'PROTECTION 'FROZEN)) @@ -5645,36 +5600,36 @@ This will be slow for arcs and curves."] (DEFINEQ (SKETCH.ELEMENTS.OF.SKETCH - [LAMBDA (SKETCH) (* rrb " 2-Aug-85 16:21") - - (* Returns the list of elements that are in SKETCH. - SKETCH can be either a SKETCH structure, a sketch window - (sometimes called a viewer) or a SKETCH stream - (obtained via (OPENIMAGESTREAM (QUOTE name) - (QUOTE SKETCH))%. If SKETCH is not a sketch, a sketch window or a sketch - stream, it returns NIL. This can be used with sketch streams to determine the - elements created by a call to a display function or series of functions by - looking at the list differences; new elements are always added at the end.)) + [LAMBDA (SKETCH) (* rrb " 2-Aug-85 16:21") + + (* Returns the list of elements that are in SKETCH. + SKETCH can be either a SKETCH structure, a sketch window + (sometimes called a viewer) or a SKETCH stream + (obtained via (OPENIMAGESTREAM (QUOTE name) + (QUOTE SKETCH))%. If SKETCH is not a sketch, a sketch window or a sketch stream, + it returns NIL. This can be used with sketch streams to determine the elements + created by a call to a display function or series of functions by looking at the + list differences; new elements are always added at the end.)) (fetch (SKETCH SKETCHELTS) of (INSURE.SKETCH SKETCH T]) (SKETCH.LIST.OF.ELEMENTS - [LAMBDA (SKETCH PREDICATE INSIDEGROUPSFLG) (* rrb "14-Aug-85 16:26") - - (* Returns a list of the sketch elements in SKETCH that satisfy PREDICATE. - If INSIDEGROUPSFLG is T, elements that are members of a group will be - considered too. Otherwise only top level objects are considered. - Note%: PREDICATE will be applied to GROUP elements even when INSIDEGROUPSFLG is - T.) + [LAMBDA (SKETCH PREDICATE INSIDEGROUPSFLG) (* rrb "14-Aug-85 16:26") + + (* Returns a list of the sketch elements in SKETCH that satisfy PREDICATE. + If INSIDEGROUPSFLG is T, elements that are members of a group will be considered + too. Otherwise only top level objects are considered. + Note%: PREDICATE will be applied to GROUP elements even when INSIDEGROUPSFLG is + T.) (* FOR NOW, IGNORE INSIDEGROUPSFLG) (for ELT in (SKETCH.ELEMENTS.OF.SKETCH SKETCH) when (APPLY* PREDICATE ELT) collect ELT]) (SKETCH.ADD.ELEMENT - [LAMBDA (ELEMENT SKETCH NODISPLAYFLG) (* rrb "30-Aug-86 15:09") - - (* Adds an element to a sketch. If NODISPLAYFLG is NIL, any windows currently - displaying SKETCH will be updated to reflect ELEMENT's addition. - If NODISPLAYFLG is T, the displays won't be updated.) + [LAMBDA (ELEMENT SKETCH NODISPLAYFLG) (* rrb "30-Aug-86 15:09") + + (* Adds an element to a sketch. If NODISPLAYFLG is NIL, any windows currently + displaying SKETCH will be updated to reflect ELEMENT's addition. + If NODISPLAYFLG is T, the displays won't be updated.) (PROG [(SKSTRUC (COND ((NULL SKETCH) @@ -5691,14 +5646,14 @@ This will be slow for arcs and curves."] (RETURN SKSTRUC]) (SKETCH.DELETE.ELEMENT - [LAMBDA (ELEMENT SKETCH INSIDEGROUPSFLG NODISPLAYFLG) (* rrb "19-Oct-85 17:09") - - (* Deletes an element from a sketch. If INSIDEGROUPSFLG is T, the element will - be deleted even if it is inside a group. - Otherwise it will be deleted only if it is on the top level. - If NODISPLAYFLG is NIL, any windows currently displaying SKETCH will be updated - to reflect ELEMENT's deletion. If NODISPLAYFLG is T, the displays won't be - updated. It returns ELEMENT if ELEMENT was deleted.) + [LAMBDA (ELEMENT SKETCH INSIDEGROUPSFLG NODISPLAYFLG) (* rrb "19-Oct-85 17:09") + + (* Deletes an element from a sketch. If INSIDEGROUPSFLG is T, the element will be + deleted even if it is inside a group. Otherwise it will be deleted only if it is + on the top level. If NODISPLAYFLG is NIL, any windows currently displaying SKETCH + will be updated to reflect ELEMENT's deletion. + If NODISPLAYFLG is T, the displays won't be updated. + It returns ELEMENT if ELEMENT was deleted.) (PROG ((SKSTRUC (INSURE.SKETCH SKETCH)) LOCALELT OLDGELT) (* delete the element to the sketch.) @@ -5717,10 +5672,9 @@ This will be slow for arcs and curves."] (RETURN OLDGELT]) (DELFROMGROUPELT - [LAMBDA (ELTTODEL GROUPELT) (* rrb " 2-Aug-85 17:03") - - (* if ELTTODEL is a member of GROUPELT, this deletes it.) - + [LAMBDA (ELTTODEL GROUPELT) (* rrb " 2-Aug-85 17:03") + (* if ELTTODEL is a member of + GROUPELT, this deletes it.) (AND (EQ (fetch (GLOBALPART GTYPE) of GROUPELT) 'GROUP) (PROG ((INDVGROUPELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of GROUPELT)) @@ -5733,17 +5687,17 @@ This will be slow for arcs and curves."] (T (RETURN (for ELT in SUBELTS thereis (DELFROMGROUPELT ELTTODEL ELT]) (SKETCH.ELEMENT.TYPE - [LAMBDA (ELEMENT) (* rrb "14-Aug-85 16:35") + [LAMBDA (ELEMENT) (* rrb "14-Aug-85 16:35") (* returns the type of a global sketch  element) (fetch (GLOBALPART GTYPE) of ELEMENT]) (SKETCH.ELEMENT.CHANGED - [LAMBDA (SKETCH ELEMENT SKETCHWINDOW) (* rrb " 4-Feb-86 15:04") - - (* If ELEMENT is an element of SKETCH, its local part is recalculated. - This is normally used to notify sketch that an image object element has - changed. Note%: this replaces the element with another one.) + [LAMBDA (SKETCH ELEMENT SKETCHWINDOW) (* rrb " 4-Feb-86 15:04") + + (* If ELEMENT is an element of SKETCH, its local part is recalculated. + This is normally used to notify sketch that an image object element has changed. + Note%: this replaces the element with another one.) (PROG ((SKETCH (INSURE.SKETCH SKETCH)) OLDREG) @@ -5763,10 +5717,9 @@ This will be slow for arcs and curves."] (RETURN ELEMENT]) (SK.ELEMENT.CHANGED1 - [LAMBDA (SKIMAGEOBJELT OLDREGION SKETCHW) (* rrb "21-Aug-85 15:54") - - (* updates the display of an image object element in a window.) - + [LAMBDA (SKIMAGEOBJELT OLDREGION SKETCHW) (* rrb "21-Aug-85 15:54") + (* updates the display of an image + object element in a window.) (PROG (LOCALELT) (COND ((SETQ LOCALELT (SK.LOCAL.ELT.FROM.GLOBALPART SKIMAGEOBJELT SKETCHW)) @@ -5778,10 +5731,10 @@ This will be slow for arcs and curves."] (RETURN (SKETCH.ADD.AND.DISPLAY1 SKIMAGEOBJELT SKETCHW]) (SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT - [LAMBDA (SKIMOBJELT VIEWER) (* rrb " 4-Feb-86 15:04") - - (* updates the fields to reflect changes in the size of the image object.) - + [LAMBDA (SKIMOBJELT VIEWER) (* rrb " 4-Feb-86 15:04") + (* updates the fields to reflect + changes in the size of the image + object.) (PROG ((INDVSKIMOBJELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of SKIMOBJELT)) IMOBJSIZE REGION SCALE) (SETQ IMOBJSIZE (IMAGEBOXSIZE (fetch (SKIMAGEOBJ SKIMAGEOBJ) of INDVSKIMOBJELT) @@ -5796,11 +5749,11 @@ This will be slow for arcs and curves."] (TIMES (fetch (IMAGEBOX YSIZE) of IMOBJSIZE) SCALE))) (replace (SKIMAGEOBJ SKIMOBJ.OFFSETPOS) of INDVSKIMOBJELT with (create POSITION - XCOORD _ + XCOORD ← (fetch (IMAGEBOX XKERN) of IMOBJSIZE) - YCOORD _ + YCOORD ← (fetch (IMAGEBOX YDESC) of IMOBJSIZE))) @@ -5814,10 +5767,9 @@ This will be slow for arcs and curves."] (DEFINEQ (INSURE.SKETCH - [LAMBDA (SK NOERRORFLG) (* rrb " 3-Oct-86 15:16") - - (* returns the SKETCH structure from a window, sketch stream, or a structure.) - + [LAMBDA (SK NOERRORFLG) (* rrb " 3-Oct-86 15:16") + (* returns the SKETCH structure from a + window, sketch stream, or a structure.) (SK.CHECK.SKETCH.VERSION (COND ((type? SKETCH SK) SK) @@ -5833,7 +5785,7 @@ This will be slow for arcs and curves."] 'SKETCH)) (T (AND (NULL NOERRORFLG) (ERROR - "sketch stream window doesn't have SKETCH property" + "sketch stream window doesn't have SKETCH property" SK] [(type? IMAGEOBJ SK) (PROG [(SK? (fetch (SKETCHIMAGEOBJ SKIO.SKETCH) @@ -5846,14 +5798,12 @@ This will be slow for arcs and curves."] ((AND (LISTP SK) (LITATOM (CAR SK)) (for ELT in (CDR SK) always (GLOBALELEMENTP ELT))) - - (* old form, probably written out by notecards, update to new form.) - + (* old form, probably written out by + notecards, update to new form.) (PROG (X) (SETQ X (SKIO.UPDATE.FROM.OLD.FORM SK)) - - (* smash sketch so this won't have to happen every time.) - + (* smash sketch so this won't have to + happen every time.) (RPLACA SK (CAR X)) (RPLACD SK (CDR X)) (RETURN X))) @@ -5861,16 +5811,16 @@ This will be slow for arcs and curves."] (ERROR SK "not a SKETCH"]) (LOCALSPECS.FROM.VIEWER - [LAMBDA (SKW) (* rrb "12-May-85 16:46") + [LAMBDA (SKW) (* rrb "12-May-85 16:46") (* returns the sketch specification  displayed in the window SKW.) (CDAR (WINDOWPROP SKW 'SKETCHSPECS]) (SK.LOCAL.ELT.FROM.GLOBALPART - [LAMBDA (GLOBALPART SKW) (* rrb "18-MAR-83 13:09") - - (* returns the local element from SKW that has global part GLOBALPART - - NIL if there isn't one.) + [LAMBDA (GLOBALPART SKW) (* rrb "18-MAR-83 13:09") + + (* returns the local element from SKW that has global part GLOBALPART - + NIL if there isn't one.) (for ELT in (LOCALSPECS.FROM.VIEWER SKW) when (EQ (fetch (SCREENELT GLOBALPART) of ELT) GLOBALPART) do (RETURN ELT]) @@ -5881,36 +5831,33 @@ This will be slow for arcs and curves."] (WINDOWPROP SKETCHW 'SKETCH]) (INSPECT.SKETCH - [LAMBDA (SKW) (* rrb "18-Apr-84 14:44") - - (* calls the inspector on the sketch specs of a sketch window.) - + [LAMBDA (SKW) (* rrb "18-Apr-84 14:44") + (* calls the inspector on the sketch + specs of a sketch window.) (PROG ((SPECS (LOCALSPECS.FROM.VIEWER SKW))) (COND (SPECS (INSPECT/TOP/LEVEL/LIST SPECS]) (ELT.INSIDE.SKETCHWP - [LAMBDA (GELT SKW) (* rrb " 8-APR-83 13:18") - - (* determines if a global element is in the region of a viewer) - + [LAMBDA (GELT SKW) (* rrb " 8-APR-83 13:18") + (* determines if a global element is + in the region of a viewer) (SK.INSIDE.REGION GELT (WINDOWPROP SKW 'REGION.VIEWED]) (SK.INSIDE.REGION - [LAMBDA (GELT REGION) (* rrb "31-Aug-84 10:15") - - (* determines if the element GELT is inside of the global region REGION) - + [LAMBDA (GELT REGION) (* rrb "31-Aug-84 10:15") + (* determines if the element GELT is + inside of the global region REGION) (APPLY* (SK.INSIDEFN (fetch (GLOBALPART GTYPE) of GELT)) GELT REGION]) ) (DEFINEQ (MAPSKETCHSPECS - [LAMBDA (SKSPECS SPECFN DATUM DATUM2 DATUM3) (* rrb "10-Sep-84 14:58") - - (* walks through a sketch specification list and applies SPECFN to each of the - individual elements.) + [LAMBDA (SKSPECS SPECFN DATUM DATUM2 DATUM3) (* rrb "10-Sep-84 14:58") + + (* walks through a sketch specification list and applies SPECFN to each of the + individual elements.) (AND SKSPECS (COND ((SCREENELEMENTP SKSPECS) @@ -5920,10 +5867,10 @@ This will be slow for arcs and curves."] (T (ERROR "unknown figure specification" SKSPECS]) (MAPCOLLECTSKETCHSPECS - [LAMBDA (SKSPECS SPECFN DATUM DATUM2 DATUM3 DATUM4) (* rrb "26-Apr-85 09:29") - - (* walks through a sketch specification list and applies SPECFN to each of the - individual (elements returning a list of the results.)) + [LAMBDA (SKSPECS SPECFN DATUM DATUM2 DATUM3 DATUM4) (* rrb "26-Apr-85 09:29") + + (* walks through a sketch specification list and applies SPECFN to each of the + individual (elements returning a list of the results.)) (AND SKSPECS (COND ((SCREENELEMENTP SKSPECS) @@ -5934,10 +5881,10 @@ This will be slow for arcs and curves."] (T (ERROR "unknown figure specification" SKSPECS]) (MAPSKETCHSPECSUNTIL - [LAMBDA (SKETCHSPECS SPECFN DATUM DATUM2) (* rrb " 4-AUG-83 15:22") - - (* walks through a sketch specification list and applies SPECFN to each of the - individual elements.) + [LAMBDA (SKETCHSPECS SPECFN DATUM DATUM2) (* rrb " 4-AUG-83 15:22") + + (* walks through a sketch specification list and applies SPECFN to each of the + individual elements.) (AND SKETCHSPECS (COND ((SKETCH.ELEMENT.NAMEP (fetch (SCREENELT GTYPE) of SKETCHSPECS)) @@ -5949,10 +5896,10 @@ This will be slow for arcs and curves."] (T (ERROR "unknown figure specification" SKETCHSPECS]) (MAPGLOBALSKETCHSPECS - [LAMBDA (SKSPECS SPECFN DATUM DATUM2 DATUM3) (* rrb "19-Feb-85 17:52") - - (* walks through a list of global sketch elements and applies SPECFN to each of - the individual elements.) + [LAMBDA (SKSPECS SPECFN DATUM DATUM2 DATUM3) (* rrb "19-Feb-85 17:52") + + (* walks through a list of global sketch elements and applies SPECFN to each of + the individual elements.) (AND SKSPECS (COND ((GLOBALELEMENTP SKSPECS) @@ -5963,11 +5910,11 @@ This will be slow for arcs and curves."] (T (ERROR "unknown global sketch element" SKSPECS]) (MAPGLOBALSKETCHELEMENTS - [LAMBDA (SKSPECS SPECFN DATUM DATUM2 DATUM3) (* rrb "24-Apr-85 15:02") - - (* walks through a list of global sketch elements and applies SPECFN to each of - the individual elements. Differes from MAPGLOBALSKETCHSPECS in that it know - about and gets inside of GROUP elements.) + [LAMBDA (SKSPECS SPECFN DATUM DATUM2 DATUM3) (* rrb "24-Apr-85 15:02") + + (* walks through a list of global sketch elements and applies SPECFN to each of + the individual elements. Differes from MAPGLOBALSKETCHSPECS in that it know about + and gets inside of GROUP elements.) (AND SKSPECS (COND [(GLOBALELEMENTP SKSPECS) @@ -5993,69 +5940,66 @@ This will be slow for arcs and curves."] (DEFINEQ (SK.ADD.SELECTION - [LAMBDA (ITEM/POS WINDOW MARKBM FIRSTFLG) (* rrb " 9-May-85 10:42") + [LAMBDA (ITEM/POS WINDOW MARKBM FIRSTFLG) (* rrb " 9-May-85 10:42") (* adds an item to the selection list  of WINDOW.) (COND ([NOT (MEMBER ITEM/POS (WINDOWPROP WINDOW 'SKETCH.SELECTIONS] - - (* must turning off the element's selection before adding it to the window - selections because the display of the selection check to see if the points are - already selected in another element.) + + (* must turning off the element's selection before adding it to the window + selections because the display of the selection check to see if the points are + already selected in another element.) (SK.SELECT.ELT ITEM/POS WINDOW MARKBM) (WINDOWADDPROP WINDOW 'SKETCH.SELECTIONS ITEM/POS FIRSTFLG]) (SK.COPY.INSERTFN - [LAMBDA (IMAGEOBJ SKW) (* rrb "23-Jun-87 13:25") - - (* * the function that gets called to insert a copy-selection into a sketch - window. Knows how to insert sketches, everything else is text.) + [LAMBDA (IMAGEOBJ SKW) (* rrb "23-Jun-87 13:25") + + (* * the function that gets called to insert a copy-selection into a sketch + window. Knows how to insert sketches, everything else is text.) (PROG (IMAGEOBJYET SELECTION EXTENDSELECTION) - - (* bind the selection so that if the user has to place an image obj, it is - restored before the characters are unBYSYSBUFed) + + (* bind the selection so that if the user has to place an image obj, it is + restored before the characters are unBYSYSBUFed) [bind DATUM for IMOBJ inside IMAGEOBJ do (COND - ((STRINGP IMOBJ) - (BKSYSBUF IMOBJ)) - ((EQ (fetch (IMAGEOBJ IMAGEOBJFNS) of IMOBJ) - SKETCHIMAGEFNS) (* this is a sketch imageobj) - [COND - ((NULL IMAGEOBJYET) (* save SELECTION and - EXTENDSELECTION so they can be - restored) - (SETQ IMAGEOBJYET T) - (SETQ SELECTION (WINDOWPROP SKW 'SELECTION)) - (SETQ EXTENDSELECTION (WINDOWPROP SKW 'EXTENDSELECTION] - (SETQ DATUM (IMAGEOBJPROP IMOBJ 'OBJECTDATUM)) - (OR (SK.INSERT.SKETCH SKW (fetch (SKETCHIMAGEOBJ SKIO.SKETCH) - of DATUM) - (fetch (SKETCHIMAGEOBJ SKIO.REGION) of DATUM) - (fetch (SKETCHIMAGEOBJ SKIO.SCALE) of DATUM)) - (RETURN))) - (T (* insert the image object whatever - it is) - [COND - ((NULL IMAGEOBJYET) (* save SELECTION and - EXTENDSELECTION so they can be - restored) - (SETQ IMAGEOBJYET T) - (SETQ SELECTION (WINDOWPROP SKW 'SELECTION)) - (SETQ EXTENDSELECTION (WINDOWPROP SKW 'EXTENDSELECTION] - (* if the user placed it outside, - just return) - (OR (SK.INSERT.SKETCH SKW [SKETCH.CREATE 'DUMMYNAME 'ELEMENTS - (LIST (SETQ DATUM ( - SK.ELEMENT.FROM.IMAGEOBJ - IMOBJ SKW] - (fetch (SKIMAGEOBJ SKIMOBJ.GLOBALREGION) - of (fetch (GLOBALPART INDIVIDUALGLOBALPART) - of DATUM)) - (VIEWER.SCALE SKW)) - (RETURN] + ((STRINGP IMOBJ) + (BKSYSBUF IMOBJ)) + ((EQ (fetch (IMAGEOBJ IMAGEOBJFNS) of IMOBJ) + SKETCHIMAGEFNS) (* this is a sketch imageobj) + [COND + ((NULL IMAGEOBJYET) (* save SELECTION and EXTENDSELECTION + so they can be restored) + (SETQ IMAGEOBJYET T) + (SETQ SELECTION (WINDOWPROP SKW 'SELECTION)) + (SETQ EXTENDSELECTION (WINDOWPROP SKW 'EXTENDSELECTION] + (SETQ DATUM (IMAGEOBJPROP IMOBJ 'OBJECTDATUM)) + (OR (SK.INSERT.SKETCH SKW (fetch (SKETCHIMAGEOBJ SKIO.SKETCH) of DATUM) + (fetch (SKETCHIMAGEOBJ SKIO.REGION) of DATUM) + (fetch (SKETCHIMAGEOBJ SKIO.SCALE) of DATUM)) + (RETURN))) + (T (* insert the image object whatever it + is) + [COND + ((NULL IMAGEOBJYET) (* save SELECTION and EXTENDSELECTION + so they can be restored) + (SETQ IMAGEOBJYET T) + (SETQ SELECTION (WINDOWPROP SKW 'SELECTION)) + (SETQ EXTENDSELECTION (WINDOWPROP SKW 'EXTENDSELECTION] + (* if the user placed it outside, just + return) + (OR (SK.INSERT.SKETCH SKW [SKETCH.CREATE 'DUMMYNAME 'ELEMENTS + (LIST (SETQ DATUM (SK.ELEMENT.FROM.IMAGEOBJ + IMOBJ SKW] + (fetch (SKIMAGEOBJ SKIMOBJ.GLOBALREGION) of (fetch (GLOBALPART + + INDIVIDUALGLOBALPART + ) of DATUM)) + (VIEWER.SCALE SKW)) + (RETURN] (COND (IMAGEOBJYET (* restore the selection) (WINDOWPROP SKW 'SELECTION SELECTION) @@ -6063,9 +6007,9 @@ This will be slow for arcs and curves."] (SKED.SELECTION.FEEDBACK SKW]) (SCREENELEMENTP - [LAMBDA (ELT?) (* rrb "26-Sep-86 14:53") - - (* * returns ELT? if it is a screen element.) + [LAMBDA (ELT?) (* rrb "26-Sep-86 14:53") + + (* * returns ELT? if it is a screen element.) (PROG (X) (RETURN (AND (LISTP ELT?) @@ -6075,10 +6019,10 @@ This will be slow for arcs and curves."] ELT?]) (SK.ITEM.REGION - [LAMBDA (SCRELT) (* rrb "24-Jan-85 17:46") - - (* SCRELT is a sketch element This function returns the region it occupies.) - + [LAMBDA (SCRELT) (* rrb "24-Jan-85 17:46") + (* SCRELT is a sketch element This + function returns the region it + occupies.) (PROG [(REGIONFN (SK.REGIONFN (fetch (SCREENELT GTYPE) of SCRELT] (RETURN (COND ((OR (NULL REGIONFN) @@ -6087,11 +6031,10 @@ This will be slow for arcs and curves."] ((APPLY* REGIONFN SCRELT]) (SK.ELEMENT.GLOBAL.REGION - [LAMBDA (GELT) (* rrb "18-Oct-85 10:30") - - (* GELT is a global sketch element This function returns the global region it - occupies.) - + [LAMBDA (GELT) (* rrb "18-Oct-85 10:30") + (* GELT is a global sketch element + This function returns the global + region it occupies.) (PROG [(REGIONFN (SK.GLOBAL.REGIONFN (fetch (GLOBALPART GTYPE) of GELT] (RETURN (COND ((OR (NULL REGIONFN) @@ -6100,15 +6043,15 @@ This will be slow for arcs and curves."] ((APPLY* REGIONFN GELT]) (SK.LOCAL.ITEMS.IN.REGION - [LAMBDA (HOTSPOTCACHE LEFT BOTTOM RIGHT TOP) (* rrb "31-Jan-85 11:38") - - (* * returns a list of the LOCALITEMS that are within LOCALREGION) - - (* changed to take a hotspot cache instead of a list of local items. - OLD ARGS were (HOTSPOTCACHE LOCALREGION SCALE) OLD CODE - (PROG ((SKREGION (UNSCALE.REGION LOCALREGION SCALE))) - (RETURN (for SCRELT in LOCALITEMS when (SK.INSIDE.REGION - (fetch (SCREENELT GLOBALPART) of SCRELT) SKREGION) collect SCRELT)))) + [LAMBDA (HOTSPOTCACHE LEFT BOTTOM RIGHT TOP) (* rrb "31-Jan-85 11:38") + + (* * returns a list of the LOCALITEMS that are within LOCALREGION) + + (* changed to take a hotspot cache instead of a list of local items. + OLD ARGS were (HOTSPOTCACHE LOCALREGION SCALE) OLD CODE + (PROG ((SKREGION (UNSCALE.REGION LOCALREGION SCALE))) + (RETURN (for SCRELT in LOCALITEMS when (SK.INSIDE.REGION + (fetch (SCREENELT GLOBALPART) of SCRELT) SKREGION) collect SCRELT)))) (PROG ((RLEFT (DIFFERENCE LEFT SK.POINT.WIDTH)) (RBOTTOM (DIFFERENCE BOTTOM SK.POINT.WIDTH)) @@ -6133,48 +6076,48 @@ This will be slow for arcs and curves."] (RETURN ELTS]) (SK.REGIONFN - [LAMBDA (ELEMENTTYPE) (* rrb " 5-Sep-84 16:06") - - (* * access fn for getting the function that returns the region of an item from - its type.) + [LAMBDA (ELEMENTTYPE) (* rrb " 5-Sep-84 16:06") + + (* * access fn for getting the function that returns the region of an item from + its type.) (fetch (SKETCHTYPE REGIONFN) of (GETPROP ELEMENTTYPE 'SKETCHTYPE]) (SK.GLOBAL.REGIONFN - [LAMBDA (ELEMENTTYPE) (* rrb "18-Oct-85 10:30") - - (* * access fn for getting the function that returns the global region of a - global sketch element from its type.) + [LAMBDA (ELEMENTTYPE) (* rrb "18-Oct-85 10:30") + + (* * access fn for getting the function that returns the global region of a + global sketch element from its type.) (fetch (SKETCHTYPE GLOBALREGIONFN) of (GETPROP ELEMENTTYPE 'SKETCHTYPE]) (SK.REMOVE.SELECTION - [LAMBDA (ITEM/POS WINDOW MARKBM) (* rrb " 9-May-85 10:31") + [LAMBDA (ITEM/POS WINDOW MARKBM) (* rrb " 9-May-85 10:31") (* removes an item from the selection  list of WINDOW.) (COND ((MEMBER ITEM/POS (WINDOWPROP WINDOW 'SKETCH.SELECTIONS)) - - (* must remove element from window selections before turning off its selection - because the display of the selection check to see if the points are still - selected in another element.) + + (* must remove element from window selections before turning off its selection + because the display of the selection check to see if the points are still + selected in another element.) (WINDOWDELPROP WINDOW 'SKETCH.SELECTIONS ITEM/POS) (SK.DESELECT.ELT ITEM/POS WINDOW MARKBM]) (SK.SELECT.MULTIPLE.ITEMS - [LAMBDA (WINDOW ITEMFLG SELITEMS OPERATION) (* rrb "10-Dec-85 17:34") - - (* * selects allows the user to select a group of the sketch elements from the - sketch WINDOW. If ITEMFLG is NIL, the user is allows to select control points - as well as complete items and the returned value may be the position of a - control point. If SELITEMS is given it is used as the items to be marked and - selected from. Keeps control and probably shouldn't) - - (* the selection protocol is left to add, right to delete. - Multiple clicking in the same place upscales for both select and deselect. - Sweeping will select or deselect all of the items in the swept out area. - Also it keeps control as long as a shift key is down.) + [LAMBDA (WINDOW ITEMFLG SELITEMS OPERATION) (* rrb "10-Dec-85 17:34") + + (* * selects allows the user to select a group of the sketch elements from the + sketch WINDOW. If ITEMFLG is NIL, the user is allows to select control points as + well as complete items and the returned value may be the position of a control + point. If SELITEMS is given it is used as the items to be marked and selected + from. Keeps control and probably shouldn't) + + (* the selection protocol is left to add, right to delete. + Multiple clicking in the same place upscales for both select and deselect. + Sweeping will select or deselect all of the items in the swept out area. + Also it keeps control as long as a shift key is down.) (PROG ((INTERIOR (DSPCLIPPINGREGION NIL WINDOW)) SELECTABLEITEMS HOTSPOTCACHE TIMER NOW OLDX ORIGX NEWX NEWY OLDY ORIGY OUTOFFIRSTPICK @@ -6195,45 +6138,42 @@ This will be slow for arcs and curves."] ((INSIDEP INTERIOR (LASTMOUSEX WINDOW) (LASTMOUSEY WINDOW)) (SETQ MOUSEINSIDE? T)) - (T - - (* first press was outside of the window, don't select anything.) - + (T (* first press was outside of the + window, don't select anything.) (SK.TAKE.MARKS.DOWN WINDOW HOTSPOTCACHE) (RETURN))) SELECTLP (COND ((MOUSESTATE UP) (GO SELECTEXIT))) - - (* this label provides an entry for the code that tests if the shift key is - down.) + + (* this label provides an entry for the code that tests if the shift key is down.) SELAFTERTEST (SETQ NEWY (LASTMOUSEY WINDOW)) (SETQ NEWX (LASTMOUSEX WINDOW)) [COND [(NOT MOUSEINSIDE?) - - (* mouse is outside, don't do anything other than wait for it to come back in. - If the user has let up all buttons, the branch to SELECTEXIT will have been - taken.) + + (* mouse is outside, don't do anything other than wait for it to come back in. + If the user has let up all buttons, the branch to SELECTEXIT will have been + taken.) (COND ((INSIDEP INTERIOR NEWX NEWY) (SETQ MOUSEINSIDE? T) (* restore the saved selected items.) (for ELT in SELITEMS do (SK.ADD.SELECTION ELT WINDOW] ((NOT (INSIDEP INTERIOR NEWX NEWY)) - - (* mouse just went outside, remove selections but save them in case mouse comes - back in.) + + (* mouse just went outside, remove selections but save them in case mouse comes + back in.) (SETQ MOUSEINSIDE? NIL) (SETQ SELITEMS (WINDOWPROP WINDOW 'SKETCH.SELECTIONS)) (for ELT in SELITEMS do (SK.REMOVE.SELECTION ELT WINDOW))) [(NEQ PREVMOUSEBUTTONS LASTMOUSEBUTTONS) - - (* another button has gone down, mark this as the origin of a new box to sweep.) + + (* another button has gone down, mark this as the origin of a new box to sweep.) (SETQ PREVMOUSEBUTTONS LASTMOUSEBUTTONS) (SETQ ORIGX (LASTMOUSEX WINDOW)) @@ -6242,13 +6182,11 @@ This will be slow for arcs and curves."] ((NULL ITEMFLG) (* clear any selections that are of  single points.) (for SEL in (WINDOWPROP WINDOW 'SKETCH.SELECTIONS) when (POSITIONP SEL) - do (SK.REMOVE.SELECTION SEL WINDOW] - - (* add or delete the element that the button press occurred on if any.) - + do (SK.REMOVE.SELECTION SEL WINDOW] (* add or delete the element that the + button press occurred on if any.) (AND [SETQ NOW (IN.SKETCH.ELT? HOTSPOTCACHE (create POSITION - XCOORD _ NEWX - YCOORD _ NEWY) + XCOORD ← NEWX + YCOORD ← NEWY) (AND (NULL ITEMFLG) (LASTMOUSESTATE (ONLY LEFT)) (NULL (WINDOWPROP WINDOW 'SKETCH.SELECTIONS] @@ -6263,25 +6201,21 @@ This will be slow for arcs and curves."] ((OR (IGREATERP (IABS (IDIFFERENCE ORIGX NEWX)) SK.NO.MOVE.DISTANCE) (IGREATERP (IABS (IDIFFERENCE ORIGY NEWY)) - SK.NO.MOVE.DISTANCE)) - - (* make the first pick move further so that it is easier to multiple click.) - - (SETQ OUTOFFIRSTPICK T))) - - (* cursor has moved more than the minimum amount since last noticed.) - - (* add or delete any with in the swept out area.) - + SK.NO.MOVE.DISTANCE)) (* make the first pick move further so + that it is easier to multiple click.) + (SETQ OUTOFFIRSTPICK T))) (* cursor has moved more than the + minimum amount since last noticed.) + (* add or delete any with in the swept + out area.) (COND ([AND (LASTMOUSESTATE (NOT UP)) (SETQ SELITEMS (SK.LOCAL.ITEMS.IN.REGION HOTSPOTCACHE (MIN ORIGX NEWX) (MIN ORIGY NEWY) (MAX ORIGX NEWX) (MAX ORIGY NEWY] - - (* if selecting multiple things, it must be whole items. - Update NOW to be an item if it isn't already.) + + (* if selecting multiple things, it must be whole items. + Update NOW to be an item if it isn't already.) [COND ((POSITIONP NOW) @@ -6317,9 +6251,9 @@ This will be slow for arcs and curves."] (SK.ADD.SELECTION (SETQ NOW (IN.SKETCH.ELT? HOTSPOTCACHE NOW)) WINDOW)) ((SCREENELEMENTP NOW) - - (* thing now selected is an item, select all selectable items keeping the first - one selected on the front.) + + (* thing now selected is an item, select all selectable items keeping the first + one selected on the front.) (for SELITEM in (SETQ NOW (CONS NOW (REMOVE NOW SELECTABLEITEMS))) do (SK.ADD.SELECTION SELITEM WINDOW] @@ -6327,23 +6261,19 @@ This will be slow for arcs and curves."] (GO CLICKLP))) SHIFTDOWNLP (COND - ((MOUSESTATE (NOT UP)) - - (* button went down again, initialize the button state and click position.) - + ((MOUSESTATE (NOT UP)) (* button went down again, initialize + the button state and click position.) (SETQ PREVMOUSEBUTTONS NIL) (SETQ OUTOFFIRSTPICK NIL) (GO SELAFTERTEST)) ((.SHIFTKEYDOWNP.) - - (* flip selection marks because if cursor is outside when shift key is let up, - nothing is selected.) + + (* flip selection marks because if cursor is outside when shift key is let up, + nothing is selected.) [COND - [(NOT MOUSEINSIDE?) - - (* mouse is outside%: if it comes back in, mark the selections.) - + [(NOT MOUSEINSIDE?) (* mouse is outside%: if it comes back + in, mark the selections.) (COND ((INSIDEP INTERIOR (LASTMOUSEX WINDOW) (LASTMOUSEY WINDOW)) @@ -6358,24 +6288,19 @@ This will be slow for arcs and curves."] (GO SHIFTDOWNLP))) (SETQ SELITEMS (WINDOWPROP WINDOW 'SKETCH.SELECTIONS)) (COND - (MOUSEINSIDE? - - (* unmark and remove the selected items from the window property list.) - + (MOUSEINSIDE? (* unmark and remove the selected + items from the window property list.) (for SEL in SELITEMS do (SK.REMOVE.SELECTION SEL WINDOW))) - (T - - (* they have already been unmarked, just remove them from the window.) - + (T (* they have already been unmarked, + just remove them from the window.) (WINDOWPROP WINDOW 'SKETCH.SELECTIONS NIL))) (SK.TAKE.MARKS.DOWN WINDOW HOTSPOTCACHE) (RETURN SELITEMS]) (SKETCH.GET.ELEMENTS - [LAMBDA (VIEWER SINGLEELEMENTFLG WHICHONES) (* rrb "17-Dec-85 15:35") - - (* hilites the selection points and lets the user select one or more.) - + [LAMBDA (VIEWER SINGLEELEMENTFLG WHICHONES) (* rrb "17-Dec-85 15:35") + (* hilites the selection points and + lets the user select one or more.) (PROG [[SELECTABLEITEMS (COND ((LISTP WHICHONES) (for ELT in WHICHONES collect (COND @@ -6395,53 +6320,49 @@ This will be slow for arcs and curves."] collect (fetch (SCREENELT GLOBALPART) of SCRELT]) (SK.PUT.MARKS.UP - [LAMBDA (SKETCHW HOTSPOTCACHE) (* rrb "29-Jan-85 17:40") - - (* makes sure the selection points are up in a window.) - + [LAMBDA (SKETCHW HOTSPOTCACHE) (* rrb "29-Jan-85 17:40") + (* makes sure the selection points are + up in a window.) (COND ((NULL (WINDOWPROP SKETCHW 'MARKS.UP)) (SK.SHOWMARKS SKETCHW HOTSPOTCACHE) (WINDOWPROP SKETCHW 'MARKS.UP T]) (SK.TAKE.MARKS.DOWN - [LAMBDA (SKETCHW HOTSPOTCACHE) (* rrb "29-Jan-85 17:41") - - (* makes sure the selection points are down in a window.) - + [LAMBDA (SKETCHW HOTSPOTCACHE) (* rrb "29-Jan-85 17:41") + (* makes sure the selection points are + down in a window.) (COND ((WINDOWPROP SKETCHW 'MARKS.UP) (SK.SHOWMARKS SKETCHW HOTSPOTCACHE) (WINDOWPROP SKETCHW 'MARKS.UP NIL]) (SK.TRANSLATE.GLOBALPART - [LAMBDA (GLOBALELT DELTAPOS RETURNELTIFCANTFLG) (* rrb "19-May-86 14:52") - - (* GLOBALELT is a sketch element that was selected for a translate operation. - DELTAPOS is the amount the item is to be translated.) + [LAMBDA (GLOBALELT DELTAPOS RETURNELTIFCANTFLG) (* rrb "19-May-86 14:52") + + (* GLOBALELT is a sketch element that was selected for a translate operation. + DELTAPOS is the amount the item is to be translated.) (PROG ((TRANSLATEFN (SK.TRANSLATEFN (fetch (GLOBALPART GTYPE) of GLOBALELT))) NEWGLOBAL OLDGLOBAL ACTIVEREGION) (RETURN (COND ((OR (NULL TRANSLATEFN) - (EQ TRANSLATEFN 'NILL)) - - (* if can't translate, return the same thing. - This is probably an error condition.) - + (EQ TRANSLATEFN 'NILL)) (* if can't translate, return the same + thing. This is probably an error + condition.) GLOBALELT) ((SETQ NEWGLOBAL (APPLY* TRANSLATEFN GLOBALELT DELTAPOS)) - - (* copy the property list so that undoing works and because this code is used - to make copies too.) + + (* copy the property list so that undoing works and because this code is used to + make copies too.) (SK.COPY.ELEMENT.PROPERTY.LIST NEWGLOBAL) [COND ([AND (SETQ ACTIVEREGION (GETSKETCHELEMENTPROP NEWGLOBAL 'ACTIVEREGION)) (EQUAL ACTIVEREGION (GETSKETCHELEMENTPROP GLOBALELT 'ACTIVEREGION] - - (* update the ACTIVEREGION if the element has one and it is the same in the new - element.) + + (* update the ACTIVEREGION if the element has one and it is the same in the new + element.) (PUTSKETCHELEMENTPROP NEWGLOBAL 'ACTIVEREGION (REL.MOVE.REGION ACTIVEREGION @@ -6450,17 +6371,15 @@ This will be slow for arcs and curves."] (fetch (POSITION YCOORD) of DELTAPOS] NEWGLOBAL) - (RETURNELTIFCANTFLG - - (* in the case of translating a whole sketch, need to return something.) - + (RETURNELTIFCANTFLG (* in the case of translating a whole + sketch, need to return something.) GLOBALELT]) (SK.TRANSLATE.ITEM - [LAMBDA (SELELT GLOBALDELTAPOS W) (* rrb "21-Jan-85 18:35") - - (* SELELT is a sketch element that was selected for a translate operation. - GLOBALDELTAPOS is the amount the item is to be translated.) + [LAMBDA (SELELT GLOBALDELTAPOS W) (* rrb "21-Jan-85 18:35") + + (* SELELT is a sketch element that was selected for a translate operation. + GLOBALDELTAPOS is the amount the item is to be translated.) (PROG (NEWGLOBAL OLDGLOBAL) (COND @@ -6473,19 +6392,19 @@ This will be slow for arcs and curves."] (RETURN NEWGLOBAL]) (SK.TRANSLATEFN - [LAMBDA (ELEMENTTYPE) (* rrb " 4-Sep-84 17:01") + [LAMBDA (ELEMENTTYPE) (* rrb " 4-Sep-84 17:01") (fetch (SKETCHTYPE TRANSLATEFN) of (GETPROP ELEMENTTYPE 'SKETCHTYPE]) (TRANSLATE.SKETCH - [LAMBDA (SKETCH NEWXORG NEWYORG) (* rrb " 9-Jul-85 12:36") - - (* * translates all the elements in a sketch to make the new {0, 0} be NEWXORG - NEWYORG) + [LAMBDA (SKETCH NEWXORG NEWYORG) (* rrb " 9-Jul-85 12:36") + + (* * translates all the elements in a sketch to make the new {0, 0} be NEWXORG + NEWYORG) (PROG [(DELTAPOS (create POSITION - XCOORD _ (MINUS NEWXORG) - YCOORD _ (MINUS NEWYORG] - (RETURN (create SKETCH using SKETCH SKETCHELTS _ (for GELT in (fetch (SKETCH SKETCHELTS) + XCOORD ← (MINUS NEWXORG) + YCOORD ← (MINUS NEWYORG] + (RETURN (create SKETCH using SKETCH SKETCHELTS ← (for GELT in (fetch (SKETCH SKETCHELTS) of SKETCH) collect (SK.TRANSLATE.GLOBALPART GELT DELTAPOS T]) @@ -6511,7 +6430,7 @@ This will be slow for arcs and curves."] (DEFINEQ (SK.INPUT.SCALE - [LAMBDA (SKW) (* rrb " 4-Sep-85 15:35") + [LAMBDA (SKW) (* rrb " 4-Sep-85 15:35") (* returns the scale that input should  be) (PROG [(SK (WINDOWPROP SKW 'SKETCHCONTEXT] @@ -6521,19 +6440,16 @@ This will be slow for arcs and curves."] (RETURN NIL))) (RETURN (COND ((fetch (SKETCHCONTEXT SKETCHINPUTSCALE) of SK)) - (T - - (* early form of sketch that doesn't have an input scale.) - + (T (* early form of sketch that doesn't + have an input scale.) (SK.UPDATE.SKETCHCONTEXT SK) (replace (SKETCHCONTEXT SKETCHINPUTSCALE) of SK with 1.0) 1.0]) (SK.UPDATE.SKETCHCONTEXT - [LAMBDA (SKETCHCONTEXT) (* rrb " 4-Sep-85 14:55") - - (* updates an instance of a sketch context to have enough fields.) - + [LAMBDA (SKETCHCONTEXT) (* rrb " 4-Sep-85 14:55") + (* updates an instance of a sketch + context to have enough fields.) (PROG ((NEWSK (CREATE.DEFAULT.SKETCH.CONTEXT))) [COND ((GREATERP (DIFFERENCE (LENGTH NEWSK) @@ -6543,7 +6459,7 @@ This will be slow for arcs and curves."] (RETURN SKETCHCONTEXT]) (SK.SET.INPUT.SCALE - [LAMBDA (W) (* rrb "19-Aug-86 11:52") + [LAMBDA (W) (* rrb "19-Aug-86 11:52") (* sets the size of the  (input scale)) (SK.SET.INPUT.SCALE.VALUE (RNUMBER (CONCAT "Input scale is now " (SK.INPUT.SCALE W) @@ -6554,15 +6470,14 @@ This will be slow for arcs and curves."] W]) (SK.SET.INPUT.SCALE.CURRENT - [LAMBDA (W) (* rrb "11-Jul-86 15:51") - - (* sets the size of the input scale to the scale of the current window.) - + [LAMBDA (W) (* rrb "11-Jul-86 15:51") + (* sets the size of the input scale to + the scale of the current window.) (SK.SET.INPUT.SCALE.VALUE (VIEWER.SCALE W) W]) (SK.SET.INPUT.SCALE.VALUE - [LAMBDA (NEWINPUTSCALE SKW) (* rrb "14-May-86 19:29") + [LAMBDA (NEWINPUTSCALE SKW) (* rrb "14-May-86 19:29") (* sets the input scale to  NEWINPUTSCALE) (AND (NUMBERP NEWINPUTSCALE) @@ -6578,14 +6493,14 @@ This will be slow for arcs and curves."] (DEFINEQ (SK.SET.FEEDBACK.MODE - [LAMBDA (VALUE) (* rrb "19-Nov-85 13:25") - - (* sets the control on how much feedback to give the user as they are entering - new figure elements.) + [LAMBDA (VALUE) (* rrb "19-Nov-85 13:25") + + (* sets the control on how much feedback to give the user as they are entering + new figure elements.) [OR (MEMB VALUE '(POINTS T ALWAYS)) (SETQ VALUE (\CURSOR.IN.MIDDLE.MENU (create MENU - ITEMS _ '(("Points only" 'POINTS + ITEMS ← '(("Points only" 'POINTS "Only the control points will be shown when entering elements." ) ("Fast figures" T @@ -6594,7 +6509,7 @@ This will be slow for arcs and curves."] ("All figures" 'ALWAYS "Most elements are shown while they are being entered. This will be slow for arcs and curves.")) - CENTERFLG _ T] + CENTERFLG ← T] (AND VALUE (SETQ SKETCH.VERBOSE.FEEDBACK (SELECTQ VALUE (POINTS NIL) VALUE]) @@ -6604,10 +6519,8 @@ This will be slow for arcs and curves.")) (SK.SET.FEEDBACK.MODE 'POINTS]) (SK.SET.FEEDBACK.VERBOSE - [LAMBDA NIL - - (* sets the feedback to provide images on elements that are fast.) - + [LAMBDA NIL (* sets the feedback to provide images + on elements that are fast.) (SK.SET.FEEDBACK.MODE T]) (SK.SET.FEEDBACK.ALWAYS @@ -6635,8 +6548,34 @@ This will be slow for arcs and curves.")) (fetch (SKETCH SKETCHNAME) of (INSURE.SKETCH SKW]) (SK.SHRINK.ICONCREATE -(LAMBDA (W OLD-ICON POSITION) (* ; "Edited 25-Apr-88 15:44 by drc:") (* ;;; "Create the icon that represents this window.") (LET ((ICONTITLE (WINDOWPROP W (QUOTE SKETCH.ICON.TITLE))) (TITLE (SKETCH.TITLE W)) (ICON (OR OLD-ICON (WINDOWPROP W (QUOTE ICON))))) (COND (ICON (CL:UNLESS (OR (EQUAL ICONTITLE TITLE) (NOT ICONTITLE)) (* ;; "if we built this and the title is the same, or he has already put an icon on this, then we don't need to update it.") (SETQ ICONTITLE (OR TITLE "")) (WINDOWPROP W (QUOTE SKETCH.ICON.TITLE) ICONTITLE) (ICONTITLE ICONTITLE NIL NIL ICON)) ICON) (T (* ;; "make a new icon. Give it a title of '' so it can be distinguished from an ICON that the user supplied without an ICONTITLE.") (SETQ ICONTITLE (OR TITLE "")) (WINDOWPROP W (QUOTE SKETCH.ICON.TITLE) ICONTITLE) (TITLEDICONW SKETCH.TITLED.ICON.TEMPLATE ICONTITLE (COND ((NEQ TEDIT.ICON.FONT (QUOTE NOBIND)) TEDIT.ICON.FONT) (T (DEFAULTFONT (QUOTE DISPLAY)))) POSITION T NIL (QUOTE FILE)))))) -) + [LAMBDA (W OLD-ICON POSITION) (* ; "Edited 25-Apr-88 15:44 by drc:") + +(* ;;; "Create the icon that represents this window.") + + (LET [(ICONTITLE (WINDOWPROP W 'SKETCH.ICON.TITLE)) + (TITLE (SKETCH.TITLE W)) + (ICON (OR OLD-ICON (WINDOWPROP W 'ICON] + (COND + (ICON (CL:UNLESS (OR (EQUAL ICONTITLE TITLE) + (NOT ICONTITLE)) + + (* ;; "if we built this and the title is the same, or he has already put an icon on this, then we don't need to update it.") + + (SETQ ICONTITLE (OR TITLE "")) + (WINDOWPROP W 'SKETCH.ICON.TITLE ICONTITLE) + (ICONTITLE ICONTITLE NIL NIL ICON)) + ICON) + (T + (* ;; "make a new icon. Give it a title of '' so it can be distinguished from an ICON that the user supplied without an ICONTITLE.") + + (SETQ ICONTITLE (OR TITLE "")) + (WINDOWPROP W 'SKETCH.ICON.TITLE ICONTITLE) + (TITLEDICONW SKETCH.TITLED.ICON.TEMPLATE ICONTITLE [COND + ((NEQ TEDIT.ICON.FONT + 'NOBIND) + TEDIT.ICON.FONT) + (T (DEFAULTFONT 'DISPLAY] + POSITION T NIL 'FILE]) ) (READVARS-FROM-STRINGS '(SKETCH.TITLED.ICON.TEMPLATE) @@ -6840,15 +6779,15 @@ This will be slow for arcs and curves.")) (DEFINEQ (READBRUSHSHAPE - [LAMBDA NIL (* rrb " 6-Nov-85 09:57") + [LAMBDA NIL (* rrb " 6-Nov-85 09:57") (* reads a brush shape from the user.) (\CURSOR.IN.MIDDLE.MENU (create MENU - CENTERFLG _ T - TITLE _ "pick a shape" - ITEMS _ '(ROUND SQUARE VERTICAL HORIZONTAL DIAGONAL]) + CENTERFLG ← T + TITLE ← "pick a shape" + ITEMS ← '(ROUND SQUARE VERTICAL HORIZONTAL DIAGONAL]) (READ.FUNCTION - [LAMBDA (PRMPT W) (* rrb "11-May-84 15:41") + [LAMBDA (PRMPT W) (* rrb "11-May-84 15:41") (PROG ((PROMPTWIN (GETPROMPTWINDOW W 3)) OLDTTYDS LST) (SETQ OLDTTYDS (TTYDISPLAYSTREAM PROMPTWIN)) @@ -6861,7 +6800,7 @@ This will be slow for arcs and curves.")) (RETURN (CAR LST]) (READBRUSHSIZE - [LAMBDA (NOWSIZE) (* rrb "19-May-86 15:44") + [LAMBDA (NOWSIZE) (* rrb "19-May-86 15:44") (PROG ((N (RNUMBER (COND (NOWSIZE (CONCAT "Current size is " NOWSIZE ". Enter new brush size.")) (T "Enter new brush size.")) @@ -6872,7 +6811,7 @@ This will be slow for arcs and curves.")) (N (ABS N]) (READANGLE - [LAMBDA NIL (* rrb "14-May-86 19:29") + [LAMBDA NIL (* rrb "14-May-86 19:29") (* interacts to get an angle from the  user.) (PROG ((NEWVALUE (RNUMBER "Enter arc angle in degrees." NIL NIL NIL T NIL T))) @@ -6882,38 +6821,37 @@ This will be slow for arcs and curves.")) (T NEWVALUE]) (READARCDIRECTION - [LAMBDA (MENUTITLE) (* rrb " 6-Nov-85 09:53") - - (* interacts to get whether an arc should go clockwise or counterclockwise) - + [LAMBDA (MENUTITLE) (* rrb " 6-Nov-85 09:53") + (* interacts to get whether an arc + should go clockwise or + counterclockwise) (\CURSOR.IN.MIDDLE.MENU (create MENU - TITLE _ (OR MENUTITLE "Which way should the arc go?") - ITEMS _ '(("Clockwise" 'CLOCKWISE + TITLE ← (OR MENUTITLE "Which way should the arc go?") + ITEMS ← '(("Clockwise" 'CLOCKWISE "The arc will be drawn clockwise from the first point to the second point." ) ("Counterclockwise" 'COUNTERCLOCKWISE "The arc will be drawn counterclockwise from the first point to the second point." )) - CENTERFLG _ T]) + CENTERFLG ← T]) ) (DEFINEQ (SK.CHANGE.DASHING - [LAMBDA (ELTWITHLINE DASHING SKW) (* rrb " 9-Jan-86 16:58") - - (* changes the line dashing of ELTWITHLINE if it has one) - - (* knows about the various types of sketch elements and shouldn't.) - + [LAMBDA (ELTWITHLINE DASHING SKW) (* rrb " 9-Jan-86 16:58") + (* changes the line dashing of + ELTWITHLINE if it has one) + (* knows about the various types of + sketch elements and shouldn't.) (PROG (SIZE GLINELT TYPE NEWDASHING NOWDASHING NEWELT) (COND ((MEMB (SETQ TYPE (fetch (GLOBALPART GTYPE) of ELTWITHLINE)) '(WIRE BOX CLOSEDWIRE CLOSEDCURVE OPENCURVE CIRCLE ELLIPSE TEXTBOX ARC)) (* only works for things of wire type.) (SETQ GLINELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of ELTWITHLINE)) - - (* the dashing may be stored in different places for the element types.) - + (* the dashing may be stored in + different places for the element + types.) [SETQ NEWDASHING (COND ((EQ DASHING 'NONE) (* no dashing is marked with NIL) NIL) @@ -6931,39 +6869,37 @@ This will be slow for arcs and curves.")) (ELLIPSE (fetch (ELLIPSE DASHING) of GLINELT)) (SHOULDNT))) (COND - ((EQUAL NEWDASHING NOWDASHING) - - (* if dashing isn't changing, don't bother creating a new one and repainting.) - + ((EQUAL NEWDASHING NOWDASHING) (* if dashing isn't changing, don't + bother creating a new one and + repainting.) (RETURN))) (SETQ NEWELT (SELECTQ TYPE - (WIRE (create WIRE using GLINELT OPENWIREDASHING _ NEWDASHING)) - (BOX (create BOX using GLINELT BOXDASHING _ NEWDASHING)) - (ARC (create ARC using GLINELT ARCDASHING _ NEWDASHING)) - (TEXTBOX (create TEXTBOX using GLINELT TEXTBOXDASHING _ NEWDASHING)) - (CLOSEDWIRE (create CLOSEDWIRE using GLINELT CLOSEDWIREDASHING _ + (WIRE (create WIRE using GLINELT OPENWIREDASHING ← NEWDASHING)) + (BOX (create BOX using GLINELT BOXDASHING ← NEWDASHING)) + (ARC (create ARC using GLINELT ARCDASHING ← NEWDASHING)) + (TEXTBOX (create TEXTBOX using GLINELT TEXTBOXDASHING ← NEWDASHING)) + (CLOSEDWIRE (create CLOSEDWIRE using GLINELT CLOSEDWIREDASHING ← NEWDASHING)) - (CLOSEDCURVE (create CLOSEDCURVE using GLINELT DASHING _ NEWDASHING)) - (OPENCURVE (create OPENCURVE using GLINELT DASHING _ NEWDASHING)) - (CIRCLE (create CIRCLE using GLINELT DASHING _ NEWDASHING)) - (ELLIPSE (create ELLIPSE using GLINELT DASHING _ NEWDASHING)) + (CLOSEDCURVE (create CLOSEDCURVE using GLINELT DASHING ← NEWDASHING)) + (OPENCURVE (create OPENCURVE using GLINELT DASHING ← NEWDASHING)) + (CIRCLE (create CIRCLE using GLINELT DASHING ← NEWDASHING)) + (ELLIPSE (create ELLIPSE using GLINELT DASHING ← NEWDASHING)) (SHOULDNT))) (RETURN (create SKHISTORYCHANGESPEC - NEWELT _ (create GLOBALPART - COMMONGLOBALPART _ (fetch (GLOBALPART COMMONGLOBALPART) + NEWELT ← (create GLOBALPART + COMMONGLOBALPART ← (fetch (GLOBALPART COMMONGLOBALPART) of ELTWITHLINE) - INDIVIDUALGLOBALPART _ NEWELT) - OLDELT _ ELTWITHLINE - PROPERTY _ 'DASHING - NEWVALUE _ NEWDASHING - OLDVALUE _ NOWDASHING]) + INDIVIDUALGLOBALPART ← NEWELT) + OLDELT ← ELTWITHLINE + PROPERTY ← 'DASHING + NEWVALUE ← NEWDASHING + OLDVALUE ← NOWDASHING]) (READ.AND.SAVE.NEW.DASHING - [LAMBDA NIL (* rrb " 6-Nov-85 09:57") - - (* reads a new dashing, confirms it with the user and adds it to - SK.DASHING.PATTERNS) - + [LAMBDA NIL (* rrb " 6-Nov-85 09:57") + (* reads a new dashing, confirms it + with the user and adds it to + SK.DASHING.PATTERNS) (PROG (DASHING BM) LP (COND ((NULL (SETQ DASHING (READ.NEW.DASHING))) (* user aborted) @@ -6971,15 +6907,15 @@ This will be slow for arcs and curves.")) (SETQ BM (SK.DASHING.LABEL DASHING)) CONFIRM (SELECTQ (\CURSOR.IN.MIDDLE.MENU (create MENU - ITEMS _ (LIST (LIST BM T + ITEMS ← (LIST (LIST BM T "Will use this as the dashing pattern." ) '(Yes T "Will accept this pattern.") '(No 'NO "Will ask you for another dashing pattern." )) - CENTERFLG _ T - TITLE _ "Is this pattern OK?")) + CENTERFLG ← T + TITLE ← "Is this pattern OK?")) (NO (GO LP)) (T (* add dashing to global list and  return it.) @@ -6991,15 +6927,15 @@ This will be slow for arcs and curves.")) (GO CONFIRM]) (READ.NEW.DASHING - [LAMBDA NIL (* rrb "14-May-86 19:30") + [LAMBDA NIL (* rrb "14-May-86 19:30") (* reads a value of dashing from the  user.) (PROMPTPRINT "You will be prompted for a series of numbers which specify the number of points ON and OFF. Enter 0 to end the dashing pattern. Enter 'Abort' to leave the dashing unchanged.") - (bind VAL DASHLST OFF? (ORIGPOS _ (create POSITION - XCOORD _ LASTMOUSEX - YCOORD _ LASTMOUSEY)) + (bind VAL DASHLST OFF? (ORIGPOS ← (create POSITION + XCOORD ← LASTMOUSEX + YCOORD ← LASTMOUSEY)) until (OR (EQ (SETQ VAL (RNUMBER (CONCAT "Enter the number of points " (COND (OFF? 'OFF) (T 'ON)) @@ -7017,16 +6953,16 @@ Enter 'Abort' to leave the dashing unchanged.") (READ.DASHING.CHANGE [LAMBDA NIL - (DECLARE (GLOBALVARS SK.DASHING.PATTERNS)) (* rrb " 6-Nov-85 09:57") - - (* gets a description of how to change the arrow heads of a wire or curve.) + (DECLARE (GLOBALVARS SK.DASHING.PATTERNS)) (* rrb " 6-Nov-85 09:57") + + (* gets a description of how to change the arrow heads of a wire or curve.) (PROG (DASHING) (SELECTQ [SETQ DASHING (\CURSOR.IN.MIDDLE.MENU (create MENU - CENTERFLG _ T - TITLE _ "New dashing pattern?" - ITEMS _ (APPEND (for DASHPAT in SK.DASHING.PATTERNS + CENTERFLG ← T + TITLE ← "New dashing pattern?" + ITEMS ← (APPEND (for DASHPAT in SK.DASHING.PATTERNS collect (LIST (CAR DASHPAT) (KWOTE (CADR DASHPAT)) @@ -7040,10 +6976,9 @@ Enter 'Abort' to leave the dashing unchanged.") (RETURN DASHING]) (SK.CACHE.DASHING - [LAMBDA (DASHING BITMAP) (* rrb " 3-May-85 14:33") - - (* adds a dashing and its bitmap label to the global cache.) - + [LAMBDA (DASHING BITMAP) (* rrb " 3-May-85 14:33") + (* adds a dashing and its bitmap label + to the global cache.) (OR (for DASH in SK.DASHING.PATTERNS when (EQUAL (CADR DASH) DASHING) do (RETURN T)) (COND @@ -7057,7 +6992,7 @@ Enter 'Abort' to leave the dashing unchanged.") DASHING]) (SK.DASHING.LABEL - [LAMBDA (DASHING) (* rrb " 3-May-85 14:32") + [LAMBDA (DASHING) (* rrb " 3-May-85 14:32") (* creates a bitmap label which shows  a dashing pattern.) (PROG (DS BM) @@ -7068,38 +7003,37 @@ Enter 'Abort' to leave the dashing unchanged.") (DEFINEQ (READ.FILLING.CHANGE - [LAMBDA NIL (* rrb " 6-Nov-85 09:58") + [LAMBDA NIL (* rrb " 6-Nov-85 09:58") (* reads a shade for the filling  texture.) (PROG (FILLING) (SELECTQ (SETQ FILLING (\CURSOR.IN.MIDDLE.MENU (create MENU - CENTERFLG _ T - TITLE _ "New filling?" - ITEMS _ [APPEND (for FILLPAT in SK.FILLING.PATTERNS + CENTERFLG ← T + TITLE ← "New filling?" + ITEMS ← [APPEND (for FILLPAT in SK.FILLING.PATTERNS collect (LIST (CAR FILLPAT) (KWOTE (CADR FILLPAT)) "changes filling to this pattern" )) - '(("4x4 shade" '|4X4| + '(("4x4 shade" '4X4 "Allows creation of a 4 bits by 4 bits shade" ) - ("16x16 shade" '|16X16| + ("16x16 shade" '16X16 "Allows creation of a 16 bits by 16 bits shade" ) ("No filling" 'NONE "no filling will be used."] - MENUBORDERSIZE _ 1))) - (|4X4| (RETURN (READ.AND.SAVE.NEW.FILLING))) - (|16X16| (RETURN (READ.AND.SAVE.NEW.FILLING T))) + MENUBORDERSIZE ← 1))) + (4X4 (RETURN (READ.AND.SAVE.NEW.FILLING))) + (16X16 (RETURN (READ.AND.SAVE.NEW.FILLING T))) (RETURN FILLING]) (SK.CACHE.FILLING - [LAMBDA (FILLING) (* rrb " 8-Jun-85 14:58") - - (* adds a dashing and its bitmap label to the global cache.) - + [LAMBDA (FILLING) (* rrb " 8-Jun-85 14:58") + (* adds a dashing and its bitmap label + to the global cache.) (OR (for FILL in SK.FILLING.PATTERNS when (EQUAL (CADR FILL) FILLING) do (RETURN T)) (COND @@ -7110,11 +7044,10 @@ Enter 'Abort' to leave the dashing unchanged.") 'ADDED]) (READ.AND.SAVE.NEW.FILLING - [LAMBDA (16X16FLG) (* rrb " 8-Jun-85 14:58") - - (* reads a new filling, confirms it with the user and adds it to - SK.FILLING.PATTERNS) - + [LAMBDA (16X16FLG) (* rrb " 8-Jun-85 14:58") + (* reads a new filling, confirms it + with the user and adds it to + SK.FILLING.PATTERNS) (PROG (FILLING) (COND ([NULL (SETQ FILLING (EDITSHADE (COND @@ -7125,10 +7058,9 @@ Enter 'Abort' to leave the dashing unchanged.") (RETURN FILLING]) (SK.FILLING.LABEL - [LAMBDA (FILLING) (* rrb " 8-Jun-85 12:08") - - (* creates a bitmap label which fills it with the texture FILLING.) - + [LAMBDA (FILLING) (* rrb " 8-Jun-85 12:08") + (* creates a bitmap label which fills + it with the texture FILLING.) (PROG [(BM (BITMAPCREATE (PLUS 8 (STRINGWIDTH "16x16 shade" MENUFONT)) (FONTPROP MENUFONT 'HEIGHT] (BLTSHADE FILLING BM) @@ -7160,21 +7092,20 @@ Enter 'Abort' to leave the dashing unchanged.") (DEFINEQ (SK.GETGLOBALPOSITION - [LAMBDA (W CURSOR) (* rrb "20-May-86 10:56") - - (* gets a position from the user and returns the global value of it.) - + [LAMBDA (W CURSOR) (* rrb "20-May-86 10:56") + (* gets a position from the user and + returns the global value of it.) (SK.MAP.INPUT.PT.TO.GLOBAL (SK.READ.POINT.WITH.FEEDBACK W CURSOR) W]) (SKETCH.TRACK.ELEMENTS - [LAMBDA (ELEMENTS VIEWER CONSTRAINTFN HOTSPOT PROMPTMSG CONSTRAINTDATA FEEDBACKFN NOINITIALERASEFLG - NOFINALPAINTFLG) (* rrb "22-Jul-86 14:41") - - (* gets a point from the user by displaying an image of ELEMENTS. - It calls CONSTRAINTFN everytime the cursor moves to allow user constraints on - where the image is displayed. All positions and elements are in sketch - coordinates.) + [LAMBDA (ELEMENTS VIEWER CONSTRAINTFN HOTSPOT PROMPTMSG CONSTRAINTDATA FEEDBACKFN NOINITIALERASEFLG + NOFINALPAINTFLG) (* rrb "22-Jul-86 14:41") + + (* gets a point from the user by displaying an image of ELEMENTS. + It calls CONSTRAINTFN everytime the cursor moves to allow user constraints on + where the image is displayed. All positions and elements are in sketch + coordinates.) (PROG (SCRELTS FIGINFO FIRSTHOTSPOT GLOBALHOTSPOT NEWPOS LOWLFT IMAGEPOSX IMAGEPOSY IMAGEBM DELTAPOS NEWGLOBALS SKETCH GDELTAPOS) @@ -7218,10 +7149,10 @@ Enter 'Abort' to leave the dashing unchanged.") (RETURN (AND NEWPOS (PTDIFFERENCE NEWPOS GLOBALHOTSPOT]) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS - [LAMBDA (MOVEELTLST) (* rrb "13-Dec-85 11:54") - - (* returns from a list of sketch elements that are being moved, the ones that - will be completely moved) + [LAMBDA (MOVEELTLST) (* rrb "13-Dec-85 11:54") + + (* returns from a list of sketch elements that are being moved, the ones that + will be completely moved) (COND ((EQ (CAR MOVEELTLST) @@ -7234,32 +7165,32 @@ Enter 'Abort' to leave the dashing unchanged.") T) collect (CDR X]) (MAP.SKETCH.ELEMENTS.INTO.VIEWER - [LAMBDA (ELEMENTS VIEWER) (* rrb "12-Dec-85 12:25") + [LAMBDA (ELEMENTS VIEWER) (* rrb "12-Dec-85 12:25") (* maps a list of elements into a  viewer) (for SKELT in ELEMENTS collect (SK.LOCAL.FROM.GLOBAL SKELT VIEWER]) (MAP.GLOBAL.POSITION.INTO.VIEWER - [LAMBDA (GPOS VIEWER) (* rrb "11-Jul-86 15:54") + [LAMBDA (GPOS VIEWER) (* rrb "11-Jul-86 15:54") (* maps a sketch coordinate into a  viewer coordinate.) (SK.SCALE.POSITION.INTO.VIEWER GPOS (VIEWER.SCALE VIEWER]) (SKETCH.TO.VIEWER.POSITION - [LAMBDA (POSITION VIEWERSCALE) (* rrb "11-Jul-86 15:54") - - (* Transforms a position from sketch coordinates into viewer coordinates. - VIEWERSCALE can be a scale or a viewer.) + [LAMBDA (POSITION VIEWERSCALE) (* rrb "11-Jul-86 15:54") + + (* Transforms a position from sketch coordinates into viewer coordinates. + VIEWERSCALE can be a scale or a viewer.) (SK.SCALE.POSITION.INTO.VIEWER POSITION (SK.INSURE.SCALE VIEWERSCALE]) (SKETCH.TRACK.IMAGE - [LAMBDA (WINDOW BITMAP OPERATION MSG XOFFSET YOFFSET CONSTRAINTFN CONSTRAINTDATA FEEDBACKFN) + [LAMBDA (WINDOW BITMAP OPERATION MSG XOFFSET YOFFSET CONSTRAINTFN CONSTRAINTDATA FEEDBACKFN) (* rrb "11-Jun-86 13:44") - - (* gets a position by tracking with a and calling a user provided constraint - function. The spec returns is actually (ONGRID? position) so that caller can - tell whether it was placed on grid or not.) + + (* gets a position by tracking with a and calling a user provided constraint + function. The spec returns is actually (ONGRID? position) so that caller can tell + whether it was placed on grid or not.) (PROG (WIDTH HEIGHT) (SETQ WIDTH (BITMAPWIDTH BITMAP)) @@ -7271,15 +7202,14 @@ Enter 'Abort' to leave the dashing unchanged.") XOFFSET YOFFSET CONSTRAINTFN CONSTRAINTDATA FEEDBACKFN]) (SK.TRACK.IMAGE1 - [LAMBDA (W BITMAP BUFFER.BITMAP WIDTH HEIGHT OPERATION XOFFSET YOFFSET CONSTRAINTFN CONSTRAINTDATA - FEEDBACKFN) (* rrb "11-Jun-86 13:59") - - (* tracks BITMAP until a button goes down and comes up. - It calls CONSTRAINTFN to determine the position at which to display the image. - Returns a point in global space that the image was placed.) - - (* there is other code in BIGFONT that is probably better for this.) + [LAMBDA (W BITMAP BUFFER.BITMAP WIDTH HEIGHT OPERATION XOFFSET YOFFSET CONSTRAINTFN CONSTRAINTDATA + FEEDBACKFN) (* rrb "11-Jun-86 13:59") + (* tracks BITMAP until a button goes down and comes up. + It calls CONSTRAINTFN to determine the position at which to display the image. + Returns a point in global space that the image was placed.) + (* there is other code in BIGFONT that + is probably better for this.) (PROG (READPT) (SETQ READPT (SK.TRACK.BITMAP1 W BITMAP BUFFER.BITMAP WIDTH HEIGHT OPERATION XOFFSET YOFFSET CONSTRAINTFN CONSTRAINTDATA FEEDBACKFN)) @@ -7293,20 +7223,20 @@ Enter 'Abort' to leave the dashing unchanged.") (create POSITION]) (MAP.VIEWER.XY.INTO.GLOBAL - [LAMBDA (X Y VIEWER ONGRID? SCRATCHPT) (* rrb "11-Jul-86 15:52") - - (* maps from an x y pair in a window to the corresponding global position. - ONGRID? is T if the X Y should be interpreted as being on the grid. - SCRATCHPT is a scratch position that should be clobbered with the result.) + [LAMBDA (X Y VIEWER ONGRID? SCRATCHPT) (* rrb "11-Jul-86 15:52") + + (* maps from an x y pair in a window to the corresponding global position. + ONGRID? is T if the X Y should be interpreted as being on the grid. + SCRATCHPT is a scratch position that should be clobbered with the result.) (PROG ((SCALE (VIEWER.SCALE VIEWER)) GRID) [COND (ONGRID? (SETQ GRID (SK.GRIDFACTOR VIEWER))) (T - - (* map the point onto a grid location that would have the same screen position - as the given point.) + + (* map the point onto a grid location that would have the same screen position as + the given point.) (SETQ GRID (GREATESTPOWEROF2LT SCALE] (RETURN (SK.SET.POSITION (NEAREST.ON.GRID (TIMES X SCALE) @@ -7316,43 +7246,42 @@ Enter 'Abort' to leave the dashing unchanged.") SCRATCHPT]) (SK.SET.POSITION - [LAMBDA (X Y POSITION) (* rrb "21-May-86 16:09") - - (* sets the x and y coordinate fields of a position.) - + [LAMBDA (X Y POSITION) (* rrb "21-May-86 16:09") + (* sets the x and y coordinate fields + of a position.) (replace (POSITION XCOORD) of POSITION with X) (replace (POSITION YCOORD) of POSITION with Y) POSITION]) (MAP.VIEWER.PT.INTO.GLOBAL - [LAMBDA (PT VIEWER ONGRID?) (* rrb "11-Jul-86 15:52") - - (* maps from an PT in a window to the corresponding global position. - ONGRID? is T if the PT should be interpreted as being on the grid.) + [LAMBDA (PT VIEWER ONGRID?) (* rrb "11-Jul-86 15:52") + + (* maps from an PT in a window to the corresponding global position. + ONGRID? is T if the PT should be interpreted as being on the grid.) (PROG ((SCALE (VIEWER.SCALE VIEWER)) GRID) [COND (ONGRID? (SETQ GRID (SK.GRIDFACTOR VIEWER))) (T - - (* map the point onto a grid location that would have the same screen position - as the given point.) + + (* map the point onto a grid location that would have the same screen position as + the given point.) (SETQ GRID (GREATESTPOWEROF2LT SCALE] (RETURN (create POSITION - XCOORD _ (NEAREST.ON.GRID (TIMES (fetch (POSITION XCOORD) of PT) + XCOORD ← (NEAREST.ON.GRID (TIMES (fetch (POSITION XCOORD) of PT) SCALE) GRID) - YCOORD _ (NEAREST.ON.GRID (TIMES (fetch (POSITION YCOORD) of PT) + YCOORD ← (NEAREST.ON.GRID (TIMES (fetch (POSITION YCOORD) of PT) SCALE) GRID]) (VIEWER.TO.SKETCH.POSITION - [LAMBDA (POSITION VIEWERSCALE) (* rrb "11-Jul-86 15:56") - - (* Transforms a position from viewer coordinates into sketch coordinates. - VIEWERSCALE can be a scale or a viewer.) + [LAMBDA (POSITION VIEWERSCALE) (* rrb "11-Jul-86 15:56") + + (* Transforms a position from viewer coordinates into sketch coordinates. + VIEWERSCALE can be a scale or a viewer.) (SK.UNSCALE.POSITION.FROM.VIEWER POSITION (COND ((NUMBERP VIEWERSCALE)) @@ -7361,7 +7290,7 @@ Enter 'Abort' to leave the dashing unchanged.") (T (\ILLEGAL.ARG VIEWERSCALE]) (SK.INSURE.SCALE - [LAMBDA (VIEWERSCALE) (* rrb "11-Jul-86 15:52") + [LAMBDA (VIEWERSCALE) (* rrb "11-Jul-86 15:52") (COND ((NUMBERP VIEWERSCALE)) ((WINDOWP VIEWERSCALE) @@ -7369,10 +7298,10 @@ Enter 'Abort' to leave the dashing unchanged.") (T (\ILLEGAL.ARG VIEWERSCALE]) (SKETCH.TO.VIEWER.REGION - [LAMBDA (REGION VIEWERSCALE) (* rrb " 6-Jun-86 14:05") - - (* Transforms a region from sketch coordinates into viewer coordinates. - VIEWERSCALE can be a scale or a viewer.) + [LAMBDA (REGION VIEWERSCALE) (* rrb " 6-Jun-86 14:05") + + (* Transforms a region from sketch coordinates into viewer coordinates. + VIEWERSCALE can be a scale or a viewer.) (PROG ((SCALE (SK.INSURE.SCALE VIEWERSCALE))) (RETURN (CREATEREGION (QUOTIENT (fetch (REGION LEFT) of REGION) @@ -7385,175 +7314,169 @@ Enter 'Abort' to leave the dashing unchanged.") SCALE]) (VIEWER.TO.SKETCH.REGION - [LAMBDA (REGION VIEWERSCALE) (* rrb " 6-Jun-86 14:05") - - (* Transforms a region from viewer coordinates into sketch coordinates. - VIEWERSCALE can be a scale or a viewer.) + [LAMBDA (REGION VIEWERSCALE) (* rrb " 6-Jun-86 14:05") + + (* Transforms a region from viewer coordinates into sketch coordinates. + VIEWERSCALE can be a scale or a viewer.) (UNSCALE.REGION REGION (SK.INSURE.SCALE VIEWERSCALE]) (SK.READ.POINT.WITH.FEEDBACK - [LAMBDA (WINDOW CURSOR FEEDBACKFN FEEDBACKFNDATA BUTTONFOREXISTINGPTS CONSTRAINTFN NUMBERPADTOOFLG) + [LAMBDA (WINDOW CURSOR FEEDBACKFN FEEDBACKFNDATA BUTTONFOREXISTINGPTS CONSTRAINTFN NUMBERPADTOOFLG) (* rrb "11-Jul-86 15:52") - - (* internal function that reads a point from the user. - Each time the cursor moves, a feedback fn is called passing it the new X, new - Y, WINDOW and FEEDBACKDATA It is expected to XOR something on the screen that - tells the user something.) - (RESETLST (RESETSAVE (CURSOR (OR CURSOR CROSSHAIRS))) - (RESETSAVE NIL (LIST 'DSPOPERATION (DSPOPERATION 'INVERT WINDOW) - WINDOW)) - (PROG ((USEGRID (WINDOWPROP WINDOW 'USEGRID)) - (GRID (SK.GRIDFACTOR WINDOW)) - (SCALE (VIEWER.SCALE WINDOW)) - (HOTSPOTCACHE (SK.HOTSPOT.CACHE WINDOW)) - (SCRATCHPT (AND CONSTRAINTFN (create POSITION))) - XSCREEN YSCREEN XGRID YGRID NEWX NEWY MOUSEDOWN LASTBUTTONSTATE ONGRID? NEARPOS - CONSTRAINTPT POSITIONPAD) - (OR FEEDBACKFN (SETQ FEEDBACKFN 'SHOWSKETCHXY)) - [COND - (NUMBERPADTOOFLG - - (* IT WOULD BE NICER TO PUT THE POSITION READER OVERTOP OF THE MENU BUT THIS - ROUTINE IS CALLED SEVERAL TIMES BY SEVERAL OF THE POINT READERS AND IT FLIPS UP - AND DOWN SO STILL NEEDS MORE WORK TO GET RIGHT - (* detach the window menu so that it doesn't come to top over the position - reader.) (AND (OPENWP (SETQ MENUW (SK.INSURE.HAS.MENU WINDOW))) - (RESETSAVE (DETACHWINDOW MENUW) (LIST (QUOTE SK.FIX.MENU) WINDOW)))) + (* internal function that reads a point from the user. + Each time the cursor moves, a feedback fn is called passing it the new X, new Y, + WINDOW and FEEDBACKDATA It is expected to XOR something on the screen that tells + the user something.) - (RESETSAVE NIL (LIST 'CLOSEW (SETQ POSITIONPAD ( - SK.POSITION.PAD.FROM.VIEWER - WINDOW] - (RETURN (PROG1 (until [PROGN (GETMOUSESTATE) - (COND - [(AND POSITIONPAD (INSIDEP (WINDOWPROP POSITIONPAD - 'REGION) - LASTMOUSEX LASTMOUSEY)) - (COND - ((AND XGRID (INSIDEP WINDOW XGRID YGRID)) + (RESETLST + (RESETSAVE (CURSOR (OR CURSOR CROSSHAIRS))) + (RESETSAVE NIL (LIST 'DSPOPERATION (DSPOPERATION 'INVERT WINDOW) + WINDOW)) + [PROG ((USEGRID (WINDOWPROP WINDOW 'USEGRID)) + (GRID (SK.GRIDFACTOR WINDOW)) + (SCALE (VIEWER.SCALE WINDOW)) + (HOTSPOTCACHE (SK.HOTSPOT.CACHE WINDOW)) + (SCRATCHPT (AND CONSTRAINTFN (create POSITION))) + XSCREEN YSCREEN XGRID YGRID NEWX NEWY MOUSEDOWN LASTBUTTONSTATE ONGRID? NEARPOS + CONSTRAINTPT POSITIONPAD) + (OR FEEDBACKFN (SETQ FEEDBACKFN 'SHOWSKETCHXY)) + [COND + (NUMBERPADTOOFLG + + (* IT WOULD BE NICER TO PUT THE POSITION READER OVERTOP OF THE MENU BUT THIS + ROUTINE IS CALLED SEVERAL TIMES BY SEVERAL OF THE POINT READERS AND IT FLIPS UP + AND DOWN SO STILL NEEDS MORE WORK TO GET RIGHT + (* detach the window menu so that it doesn't come to top over the position + reader.) (AND (OPENWP (SETQ MENUW (SK.INSURE.HAS.MENU WINDOW))) + (RESETSAVE (DETACHWINDOW MENUW) (LIST (QUOTE SK.FIX.MENU) WINDOW)))) + + (RESETSAVE NIL (LIST 'CLOSEW (SETQ POSITIONPAD (SK.POSITION.PAD.FROM.VIEWER + WINDOW] + (RETURN (PROG1 (until [PROGN (GETMOUSESTATE) + (COND + [(AND POSITIONPAD (INSIDEP (WINDOWPROP POSITIONPAD + 'REGION) + LASTMOUSEX LASTMOUSEY)) + (COND + ((AND XGRID (INSIDEP WINDOW XGRID YGRID)) (* leaving the window, turn off the  last feedback.) - (APPLY* FEEDBACKFN XGRID YGRID WINDOW - FEEDBACKFNDATA) - (SETQ XGRID))) - - (* invoke position reader If it returns a position, return it.) + (APPLY* FEEDBACKFN XGRID YGRID WINDOW + FEEDBACKFNDATA) + (SETQ XGRID))) + (* invoke position reader If it + returns a position, return it.) + (AND (SETQ YSCREEN (SK.READ.POSITION.PAD.HANDLER + POSITIONPAD WINDOW FEEDBACKFN + FEEDBACKFNDATA CONSTRAINTFN)) + (COND + [(EQ YSCREEN 'ABORT) + (COND + ((EQ NUMBERPADTOOFLG 'MULTIPLE) - (AND (SETQ YSCREEN (SK.READ.POSITION.PAD.HANDLER - POSITIONPAD WINDOW FEEDBACKFN - FEEDBACKFNDATA CONSTRAINTFN)) - (COND - [(EQ YSCREEN 'ABORT) - (COND - ((EQ NUMBERPADTOOFLG 'MULTIPLE) - - (* if NUMBERPADTOOFLG is MULTIPLE, this is a context in which multiple values - are being read and the only way to abort is to error. - Note%: this leaves stuff on the screen.) + (* if NUMBERPADTOOFLG is MULTIPLE, this is a context in which multiple values are + being read and the only way to abort is to error. + Note%: this leaves stuff on the screen.) - (ERROR!)) - (T (RETURN NIL] - ((EQ YSCREEN 'STOP) - (RETURN NIL)) - (T (RETURN YSCREEN] - (MOUSEDOWN (LASTMOUSESTATE UP)) - ((LASTMOUSESTATE (OR LEFT MIDDLE RIGHT)) - (COND - ((INSIDEP (WINDOWPROP WINDOW 'REGION) - LASTMOUSEX LASTMOUSEY) - (SETQ MOUSEDOWN T) - NIL) - (T (RETURN] - do (SETQ NEWX (LASTMOUSEX WINDOW)) - (SETQ NEWY (LASTMOUSEY WINDOW)) - [COND - ((OR (NEQ NEWX XSCREEN) - (NEQ NEWY YSCREEN) - (NEQ LASTBUTTONSTATE LASTMOUSEBUTTONS)) - - (* cursor changed position or a button went down, check if grid pt moved.) - - (SKETCHW.UPDATE.LOCATORS WINDOW) - (SETQ XSCREEN NEWX) - (SETQ YSCREEN NEWY) - (SETQ LASTBUTTONSTATE LASTMOUSEBUTTONS) - [COND - ((AND HOTSPOTCACHE (SELECTQ BUTTONFOREXISTINGPTS - (MIDDLE (LASTMOUSESTATE MIDDLE)) - (LEFT (LASTMOUSESTATE LEFT)) - NIL) - (SETQ NEARPOS (NEAREST.HOT.SPOT HOTSPOTCACHE NEWX - NEWY))) + (ERROR!)) + (T (RETURN NIL] + ((EQ YSCREEN 'STOP) + (RETURN NIL)) + (T (RETURN YSCREEN] + (MOUSEDOWN (LASTMOUSESTATE UP)) + ((LASTMOUSESTATE (OR LEFT MIDDLE RIGHT)) + (COND + ((INSIDEP (WINDOWPROP WINDOW 'REGION) + LASTMOUSEX LASTMOUSEY) + (SETQ MOUSEDOWN T) + NIL) + (T (RETURN] + do (SETQ NEWX (LASTMOUSEX WINDOW)) + (SETQ NEWY (LASTMOUSEY WINDOW)) + [COND + ((OR (NEQ NEWX XSCREEN) + (NEQ NEWY YSCREEN) + (NEQ LASTBUTTONSTATE LASTMOUSEBUTTONS)) + (* cursor changed position or a button + went down, check if grid pt moved.) + (SKETCHW.UPDATE.LOCATORS WINDOW) + (SETQ XSCREEN NEWX) + (SETQ YSCREEN NEWY) + (SETQ LASTBUTTONSTATE LASTMOUSEBUTTONS) + [COND + ((AND HOTSPOTCACHE (SELECTQ BUTTONFOREXISTINGPTS + (MIDDLE (LASTMOUSESTATE MIDDLE)) + (LEFT (LASTMOUSESTATE LEFT)) + NIL) + (SETQ NEARPOS (NEAREST.HOT.SPOT HOTSPOTCACHE NEWX + NEWY))) (* on middle, pick the closest point) - (SETQ NEWX (fetch (POSITION XCOORD) of NEARPOS)) - (SETQ NEWY (fetch (POSITION YCOORD) of NEARPOS)) - (SETQ ONGRID? NIL)) - ((SETQ ONGRID? (COND - ((LASTMOUSESTATE RIGHT) + (SETQ NEWX (fetch (POSITION XCOORD) of NEARPOS)) + (SETQ NEWY (fetch (POSITION YCOORD) of NEARPOS)) + (SETQ ONGRID? NIL)) + ((SETQ ONGRID? (COND + ((LASTMOUSESTATE RIGHT) (* if right is down, flip sense of  using grid) - (NOT USEGRID)) - (T + (NOT USEGRID)) + (T (* otherwise use the grid if told to.) - USEGRID))) - (SETQ NEWX (MAP.WINDOW.ONTO.GRID NEWX SCALE GRID)) - (SETQ NEWY (MAP.WINDOW.ONTO.GRID NEWY SCALE GRID] - (PROGN [COND - ([AND CONSTRAINTFN - (POSITIONP (SETQ CONSTRAINTPT - (APPLY* CONSTRAINTFN - ( - MAP.VIEWER.XY.INTO.GLOBAL - NEWX NEWY VIEWER - ONGRID? SCRATCHPT) - W FEEDBACKFNDATA] - (SETQ NEWX (FIXR (QUOTIENT (fetch (POSITION - XCOORD) - of CONSTRAINTPT) - SCALE))) - (SETQ NEWY (FIXR (QUOTIENT (fetch (POSITION - YCOORD) - of CONSTRAINTPT) - SCALE] - (COND - ((OR (NEQ XGRID NEWX) - (NEQ YGRID NEWY)) - - (* grid point has changed too. Call the feedback function if the point is in - the window. If it is outside, don't show anything.) + USEGRID))) + (SETQ NEWX (MAP.WINDOW.ONTO.GRID NEWX SCALE GRID)) + (SETQ NEWY (MAP.WINDOW.ONTO.GRID NEWY SCALE GRID] + (PROGN [COND + ([AND CONSTRAINTFN + (POSITIONP (SETQ CONSTRAINTPT + (APPLY* CONSTRAINTFN + (MAP.VIEWER.XY.INTO.GLOBAL + NEWX NEWY VIEWER ONGRID? + SCRATCHPT) + W FEEDBACKFNDATA] + (SETQ NEWX (FIXR (QUOTIENT (fetch (POSITION XCOORD) + of CONSTRAINTPT) + SCALE))) + (SETQ NEWY (FIXR (QUOTIENT (fetch (POSITION YCOORD) + of CONSTRAINTPT) + SCALE] + (COND + ((OR (NEQ XGRID NEWX) + (NEQ YGRID NEWY)) - (AND XGRID (INSIDEP WINDOW XGRID YGRID) - (APPLY* FEEDBACKFN XGRID YGRID WINDOW - FEEDBACKFNDATA)) - (AND (INSIDEP WINDOW (SETQ XGRID NEWX) - (SETQ YGRID NEWY)) - (APPLY* FEEDBACKFN XGRID YGRID WINDOW - FEEDBACKFNDATA] - finally (RETURN (COND - ((AND XGRID (INSIDEP WINDOW XGRID YGRID)) - - (* if the cursor was outside the window when let up, return NIL) + (* grid point has changed too. Call the feedback function if the point is in the + window. If it is outside, don't show anything.) + (AND XGRID (INSIDEP WINDOW XGRID YGRID) (APPLY* FEEDBACKFN XGRID YGRID WINDOW - FEEDBACKFNDATA) - (create INPUTPT - INPUT.ONGRID? _ ONGRID? - INPUT.POSITION _ - (create POSITION - XCOORD _ XGRID - YCOORD _ YGRID]) + FEEDBACKFNDATA)) + (AND (INSIDEP WINDOW (SETQ XGRID NEWX) + (SETQ YGRID NEWY)) + (APPLY* FEEDBACKFN XGRID YGRID WINDOW + FEEDBACKFNDATA] + finally (RETURN (COND + ((AND XGRID (INSIDEP WINDOW XGRID YGRID)) + (* if the cursor was outside the + window when let up, return NIL) + (APPLY* FEEDBACKFN XGRID YGRID WINDOW + FEEDBACKFNDATA) + (create INPUTPT + INPUT.ONGRID? ← ONGRID? + INPUT.POSITION ← + (create POSITION + XCOORD ← XGRID + YCOORD ← YGRID])]) (SKETCH.GET.POSITION - [LAMBDA (VIEWER CURSOR FEEDBACKFN FEEDBACKFNDATA CONSTRAINTFN) + [LAMBDA (VIEWER CURSOR FEEDBACKFN FEEDBACKFNDATA CONSTRAINTFN) (* rrb "21-May-86 16:51") (* user available version of  SK.READ.POINT.WITH.FEEDBACK.) - - (* reads a point from the user. Each time the cursor moves, a feedback fn is - called passing it the new X, new Y, VIEWER and FEEDBACKDATA It is expected to - XOR something on the screen that tells the user something. - CONSTRAINTFN is called to constrain the read point.) + + (* reads a point from the user. Each time the cursor moves, a feedback fn is + called passing it the new X, new Y, VIEWER and FEEDBACKDATA It is expected to XOR + something on the screen that tells the user something. + CONSTRAINTFN is called to constrain the read point.) (PROG (READPT) (SETQ READPT (SK.READ.POINT.WITH.FEEDBACK VIEWER CURSOR FEEDBACKFN FEEDBACKFNDATA @@ -7574,10 +7497,10 @@ Enter 'Abort' to leave the dashing unchanged.") (create POSITION]) (\CLOBBER.POSITION - [LAMBDA (X Y OLDPT) (* rrb " 4-Apr-86 13:34") - - (* returns a position with values x and y. - Clobbers OLDPT if it is a POSITION.) + [LAMBDA (X Y OLDPT) (* rrb " 4-Apr-86 13:34") + + (* returns a position with values x and y. + Clobbers OLDPT if it is a POSITION.) (COND ((POSITIONP OLDPT) @@ -7587,7 +7510,7 @@ Enter 'Abort' to leave the dashing unchanged.") (T (CREATEPOSITION X Y]) (NEAREST.HOT.SPOT - [LAMBDA (CACHE X Y) (* rrb "31-Jul-85 10:14") + [LAMBDA (CACHE X Y) (* rrb "31-Jul-85 10:14") (* returns the nearest hot spot to X Y) (PROG ((BESTMEASURE 10000) BESTX BESTY YDIF THISDIF) @@ -7606,13 +7529,12 @@ Enter 'Abort' to leave the dashing unchanged.") (SETQ BESTX (CAR XBUCKET)) (SETQ BESTY (CAR YBUCKET] (RETURN (AND BESTX (create POSITION - XCOORD _ BESTX - YCOORD _ BESTY]) + XCOORD ← BESTX + YCOORD ← BESTY]) (GETWREGION - [LAMBDA (W NEWREGIONFN NEWREGIONFNDATA MINWIDTH MINHEIGHT) - (* ; "Edited 12-Jun-90 13:25 by mitani") - (* gets a region from a window) + [LAMBDA (W NEWREGIONFN NEWREGIONFNDATA MINWIDTH MINHEIGHT)(* ; "Edited 12-Jun-90 13:25 by mitani") + (* gets a region from a window) (PROG ((REG (GETREGION MINWIDTH MINHEIGHT NIL NEWREGIONFN NEWREGIONFNDATA))) (RETURN (CREATEREGION (IDIFFERENCE (fetch (REGION LEFT) of REG) (DSPXOFFSET NIL W)) @@ -7622,11 +7544,10 @@ Enter 'Abort' to leave the dashing unchanged.") (fetch (REGION HEIGHT) of REG]) (GET.BITMAP.POSITION - [LAMBDA (WINDOW BITMAP OPERATION MSG XOFFSET YOFFSET) (* rrb "11-Jul-85 11:00") - - (* gets a position by tracking with a bitmap The spec returns is actually - (ONGRID? position) so that caller can tell whether it was placed on grid or - not.) + [LAMBDA (WINDOW BITMAP OPERATION MSG XOFFSET YOFFSET) (* rrb "11-Jul-85 11:00") + + (* gets a position by tracking with a bitmap The spec returns is actually + (ONGRID? position) so that caller can tell whether it was placed on grid or not.) (PROG (BUFFER.BITMAP WIDTH HEIGHT) (SETQ WIDTH (BITMAPWIDTH BITMAP)) @@ -7639,16 +7560,15 @@ Enter 'Abort' to leave the dashing unchanged.") XOFFSET YOFFSET]) (SK.TRACK.BITMAP1 - [LAMBDA (W BITMAP BUFFER.BITMAP WIDTH HEIGHT OPERATION XOFFSET YOFFSET CONSTRAINTFN CONSTRAINTDATA - FEEDBACKFN) (* rrb "11-Jul-86 15:52") - - (* tracks BITMAP until a button goes down and comes up. - It calls CONSTRAINTFN to determine the position at which to display the image. - Returns a list of (ongrid? position) so that caller can know whether the point - chosen was on a grid or not.) - - (* there is other code in BIGFONT that might be better for this.) + [LAMBDA (W BITMAP BUFFER.BITMAP WIDTH HEIGHT OPERATION XOFFSET YOFFSET CONSTRAINTFN CONSTRAINTDATA + FEEDBACKFN) (* rrb "11-Jul-86 15:52") + (* tracks BITMAP until a button goes down and comes up. + It calls CONSTRAINTFN to determine the position at which to display the image. + Returns a list of (ongrid? position) so that caller can know whether the point + chosen was on a grid or not.) + (* there is other code in BIGFONT that + might be better for this.) (PROG [DOWN LEFT BOTTOM NEW.LEFT NEW.BOTTOM GRID.LEFT GRID.BOTTOM ONGRID? NEARPOS CONSTRAINTPT (DSP (WINDOWPROP W 'DSP)) (USEGRID (WINDOWPROP W 'USEGRID)) @@ -7735,19 +7655,18 @@ Enter 'Abort' to leave the dashing unchanged.") (BITBLT BUFFER.BITMAP 0 0 W (IPLUS GRID.LEFT XOFFSET) (IPLUS GRID.BOTTOM YOFFSET) WIDTH HEIGHT 'INPUT 'REPLACE] - - (* return the position if any part of the bitmap is visible.) - + (* return the position if any part of + the bitmap is visible.) (RETURN (AND (REGIONSINTERSECTP (DSPCLIPPINGREGION NIL DSP) (CREATEREGION (IPLUS LEFT XOFFSET) (IPLUS BOTTOM YOFFSET) WIDTH HEIGHT)) (create INPUTPT - INPUT.ONGRID? _ ONGRID? - INPUT.POSITION _ + INPUT.ONGRID? ← ONGRID? + INPUT.POSITION ← (create POSITION - XCOORD _ GRID.LEFT - YCOORD _ GRID.BOTTOM]) + XCOORD ← GRID.LEFT + YCOORD ← GRID.BOTTOM]) ) (DECLARE%: EVAL@COMPILE @@ -7773,10 +7692,10 @@ Enter 'Abort' to leave the dashing unchanged.") (DEFINEQ (SK.BRING.UP.POSITION.PAD - [LAMBDA (VIEWER MSG OPENFLG) (* rrb "10-Jun-86 15:26") - - (* * brings up a position reading number pad associated with VIEWER. - Puts it over the menu if it is up.) + [LAMBDA (VIEWER MSG OPENFLG) (* rrb "10-Jun-86 15:26") + + (* * brings up a position reading number pad associated with VIEWER. + Puts it over the menu if it is up.) (RESETFORM (RADIX 10) (PROG ((NUMBER/READER/MAXDIGITS 8) @@ -7793,16 +7712,16 @@ Enter 'Abort' to leave the dashing unchanged.") (SETQ XNUMBERPAD (\POSITION.READER.NUMBERPAD DIGITFONT TOTALSWIDTH)) (SETQ YNUMBERPAD (\POSITION.READER.NUMBERPAD DIGITFONT TOTALSWIDTH)) (SETQ COMMANDPAD (create MENU - ITEMS _ '(abort enter quit) - CENTERFLG _ T - MENUFONT _ DIGITFONT - WHENHELDFN _ (FUNCTION POSITIONPAD.HELDFN) - WHENSELECTEDFN _ (FUNCTION POSITION.PAD.READER.HANDLER) - MENUBORDERSIZE _ 1 - MENUOUTLINESIZE _ 2 - ITEMHEIGHT _ (PLUS 6 TOTALSHEIGHT))) - - (* leave room for three lines and the number at the top) + ITEMS ← '(abort enter quit) + CENTERFLG ← T + MENUFONT ← DIGITFONT + WHENHELDFN ← (FUNCTION POSITIONPAD.HELDFN) + WHENSELECTEDFN ← (FUNCTION POSITION.PAD.READER.HANDLER) + MENUBORDERSIZE ← 1 + MENUOUTLINESIZE ← 2 + ITEMHEIGHT ← (PLUS 6 TOTALSHEIGHT))) + (* leave room for three lines and the + number at the top) (* use the numberpad's width so things  look better.) (SETQ TOTALSWIDTH (fetch (MENU IMAGEWIDTH) of XNUMBERPAD)) @@ -7812,9 +7731,9 @@ Enter 'Abort' to leave the dashing unchanged.") MARGIN)) (SETQ WINHEIGHT (IPLUS (COND [MSG - - (* if there is a msg, leave room for it at the top. - In any case, leave room for the labels X and Y.) + + (* if there is a msg, leave room for it at the top. + In any case, leave room for the labels X and Y.) (ITIMES (LENGTH (SETQ MSGLINES (BREAK.MSG.INTO.LINES MSG MSGFONT WINWIDTH) @@ -7834,10 +7753,8 @@ Enter 'Abort' to leave the dashing unchanged.") (MOVEW WIN (SK.PAD.READER.POSITION VIEWER WIN)) (WINDOWADDPROP WIN 'REPAINTFN (FUNCTION SK.POSITION.READER.REPAINTFN)) [COND - (MSG - - (* save msg on the window so repaintfn can get at it) - + (MSG (* save msg on the window so repaintfn + can get at it) (WINDOWPROP WIN 'MESSAGE MSGLINES) (WINDOWPROP WIN 'MESSAGEFONT MSGFONT) (* note where the message begins.) @@ -7845,9 +7762,9 @@ Enter 'Abort' to leave the dashing unchanged.") (WINDOWPROP WIN 'MESSAGEBOTTOM (DSPYPOSITION NIL WIN] (WINDOWPROP WIN 'DIGITFONT DIGITFONT) (OPENW WIN) - - (* window is opened because of bug in ADDMENU that it doesn't work unless - window is open.) + + (* window is opened because of bug in ADDMENU that it doesn't work unless window + is open.) (\POSITION.PAD.ADD.DIGIT.MENU WIN MARGIN MARGIN 'X XNUMBERPAD TOTALSWIDTH TOTALSHEIGHT NUMBER/READER/MAXDIGITS) @@ -7856,9 +7773,9 @@ Enter 'Abort' to leave the dashing unchanged.") 'Y YNUMBERPAD TOTALSWIDTH TOTALSHEIGHT NUMBER/READER/MAXDIGITS) (REDISPLAYW WIN NIL T) [ADDMENU COMMANDPAD WIN (create POSITION - XCOORD _ (PLUS MARGIN (TIMES 2 (PLUS MARGIN + XCOORD ← (PLUS MARGIN (TIMES 2 (PLUS MARGIN TOTALSWIDTH))) - YCOORD _ (PLUS MARGIN + YCOORD ← (PLUS MARGIN (QUOTIENT (DIFFERENCE (fetch (MENU IMAGEHEIGHT) of XNUMBERPAD) @@ -7869,10 +7786,10 @@ Enter 'Abort' to leave the dashing unchanged.") (RETURN WIN]) (SK.PAD.READER.POSITION - [LAMBDA (VIEWER READERWINDOW) (* rrb "10-Jun-86 12:24") - - (* returns the lower left corner where a position reading pad should be placed - for the sketch viewer VIEWER.) + [LAMBDA (VIEWER READERWINDOW) (* rrb "10-Jun-86 12:24") + + (* returns the lower left corner where a position reading pad should be placed + for the sketch viewer VIEWER.) (PROG ((VIEWERREGION (WINDOWPROP VIEWER 'REGION)) (READERREGION (WINDOWPROP READERWINDOW 'REGION)) @@ -7884,30 +7801,28 @@ Enter 'Abort' to leave the dashing unchanged.") [(OR (GREATERP VLFT PWID) (GREATERP VLFT VBTM) (GREATERP PWID (fetch (REGION WIDTH) of VIEWERREGION))) - - (* the position reader will fit to the left, or there is more room on the left, - or the position pad reader is wider than the viewer.) + + (* the position reader will fit to the left, or there is more room on the left, + or the position pad reader is wider than the viewer.) (create POSITION - XCOORD _ (DIFFERENCE (MAX 10 VLFT) + XCOORD ← (DIFFERENCE (MAX 10 VLFT) PWID) - YCOORD _ (DIFFERENCE (fetch (REGION PTOP) of VIEWERREGION) + YCOORD ← (DIFFERENCE (fetch (REGION PTOP) of VIEWERREGION) (fetch (REGION HEIGHT) of READERREGION] (T (* more room on the bottom) (create POSITION - XCOORD _ (MAX 10 VLFT) - YCOORD _ (DIFFERENCE VBTM (fetch (REGION HEIGHT) of READERREGION]) + XCOORD ← (MAX 10 VLFT) + YCOORD ← (DIFFERENCE VBTM (fetch (REGION HEIGHT) of READERREGION]) (SK.POSITION.READER.REPAINTFN - [LAMBDA (POSITIONPAD) (* rrb "11-Jun-86 13:28") + [LAMBDA (POSITIONPAD) (* rrb "11-Jun-86 13:28") (* repaints a position pad reader) (PROG ((MSGLINES (WINDOWPROP POSITIONPAD 'MESSAGE)) NUMBERMENU TOTALREGION) [COND - (MSGLINES - - (* if there is a msg, print it at the top.) - + (MSGLINES (* if there is a msg, print it at the + top.) (DSPFONT (WINDOWPROP POSITIONPAD 'MESSAGEFONT) POSITIONPAD) (MOVETO 0 (WINDOWPROP POSITIONPAD 'MESSAGEBOTTOM) @@ -7915,11 +7830,9 @@ Enter 'Abort' to leave the dashing unchanged.") (for LINE in MSGLINES do (PRIN3 LINE POSITIONPAD) (TERPRI POSITIONPAD] (DSPFONT (WINDOWPROP POSITIONPAD 'DIGITFONT) - POSITIONPAD) - - (* the actual displaying of the menus is done by the repaintfn supplied by - ADDMENU) - + POSITIONPAD) (* the actual displaying of the menus + is done by the repaintfn supplied by + ADDMENU) (for LABEL in '(X Y) do (SETQ NUMBERMENU (WINDOWPROP POSITIONPAD LABEL)) (SETQ TOTALREGION (GETMENUPROP NUMBERMENU 'TOTALREG)) (\READNUMBER.OUTLINEREGION TOTALREGION POSITIONPAD 2) @@ -7931,18 +7844,15 @@ Enter 'Abort' to leave the dashing unchanged.") (DISPLAY.POSITION.READER.TOTAL NUMBERMENU]) (SK.POSITION.PAD.FROM.VIEWER - [LAMBDA (VIEWER) (* rrb "11-Jun-86 14:17") - - (* cache the position pad because it takes a while to create. - Opens it too.) - + [LAMBDA (VIEWER) (* rrb "11-Jun-86 14:17") + (* cache the position pad because it + takes a while to create. + Opens it too.) (PROG (PAD) (COND ((SETQ PAD (WINDOWPROP VIEWER 'POSITION.PAD)) - (WINDOWPROP PAD 'FINISHEDFLG NIL) - - (* move the pad in case the window has moved or been reshaped.) - + (WINDOWPROP PAD 'FINISHEDFLG NIL) (* move the pad in case the window has + moved or been reshaped.) (MOVEW PAD (SK.PAD.READER.POSITION VIEWER PAD)) (OPENW PAD) (* initialize some values) (SK.INIT.POSITION.NUMBER.PAD.MENU (WINDOWPROP PAD 'X)) @@ -7952,24 +7862,24 @@ Enter 'Abort' to leave the dashing unchanged.")  require font search) (RESETFORM (CURSOR WAITINGCURSOR) (SETQ PAD (SK.BRING.UP.POSITION.PAD VIEWER - "Select the location of the desired position in the window or enter its X and Y coordinates here." + "Select the location of the desired position in the window or enter its X and Y coordinates here." T))) (WINDOWPROP VIEWER 'POSITION.PAD PAD) (RETURN PAD]) (SK.INIT.POSITION.NUMBER.PAD.MENU - [LAMBDA (MNU) (* rrb "21-May-86 15:29") + [LAMBDA (MNU) (* rrb "21-May-86 15:29") (* reinitializes a numberpad reader) (PUTMENUPROP MNU 'TOTAL 0) (PUTMENUPROP MNU 'DECIMALPOWER NIL) (DISPLAY.POSITION.READER.TOTAL MNU]) (SK.READ.POSITION.PAD.HANDLER - [LAMBDA (POSITIONPAD VIEWER FEEDBACKFN FEEDBACKFNDATA CONSTRAINTFN) + [LAMBDA (POSITIONPAD VIEWER FEEDBACKFN FEEDBACKFNDATA CONSTRAINTFN) (* rrb "11-Jul-86 15:54") - - (* tracks the cursor while it is in the position pad and sets variables for - SK.READ.POINT.WITH.FEEDBACK and returned T if it succeeded) + + (* tracks the cursor while it is in the position pad and sets variables for + SK.READ.POINT.WITH.FEEDBACK and returned T if it succeeded) (* uses many variable freely from  SK.READ.POINT.WITH.FEEDBACK) (PROG (NEWX NEWY CONSTRX CONSTRY PREVX PREVY FINISHVAL (SCALE (VIEWER.SCALE VIEWER))) @@ -7992,9 +7902,9 @@ Enter 'Abort' to leave the dashing unchanged.") (NEQ NEWY PREVY)) (* user entered a new number) (SETQ PREVX NEWX) (SETQ PREVY NEWY) - - (* this code is differerent from the code in SK.READ.POINT.WITH.FEEDBACK in - that is works in sketch coordinates.) + + (* this code is differerent from the code in SK.READ.POINT.WITH.FEEDBACK in that + is works in sketch coordinates.) [COND ([AND CONSTRAINTFN (POSITIONP (SETQ CONSTRAINTPT @@ -8007,10 +7917,10 @@ Enter 'Abort' to leave the dashing unchanged.") (COND ((OR (NEQ CONSTRX NEWX) (NEQ CONSTRY NEWY)) - - (* grid point has changed too. Update the position numberpads and Call the - feedback function if the point is in the window. - If it is outside, don't show anything.) + + (* grid point has changed too. Update the position numberpads and Call the + feedback function if the point is in the window. + If it is outside, don't show anything.) (PUTMENUPROP (WINDOWPROP POSITIONPAD 'X) 'TOTAL NEWX) @@ -8025,39 +7935,36 @@ Enter 'Abort' to leave the dashing unchanged.") (QUOTIENT (SETQ CONSTRY NEWY) SCALE) VIEWER FEEDBACKFNDATA] - finally - - (* remove the closefn so that it doesn't get run on the way out.) - + finally (* remove the closefn so that it + doesn't get run on the way out.) (WINDOWDELPROP POSITIONPAD 'CLOSEFN (FUNCTION \NUMBERPAD.READER.CLOSEFN)) (AND CONSTRX (APPLY* FEEDBACKFN CONSTRX CONSTRY VIEWER FEEDBACKFNDATA)) (RETURN (COND ((MEMB FINISHVAL '(STOP ABORT)) - - (* means the numberpad reader was closed. - If the number pad includes the ABORT command, do what it would do, otherwise - the program is not expecting NIL so cause an error.) + + (* means the numberpad reader was closed. + If the number pad includes the ABORT command, do what it would do, otherwise the + program is not expecting NIL so cause an error.) (RETURN FINISHVAL)) (FINISHVAL (AND CONSTRX (SETQ FINISHVAL (create POSITION - XCOORD _ CONSTRX - YCOORD _ CONSTRY)) + XCOORD ← CONSTRX + YCOORD ← CONSTRY)) (create INPUTPT - INPUT.ONGRID? _ 'GLOBAL - INPUT.POSITION _ ( + INPUT.ONGRID? ← 'GLOBAL + INPUT.POSITION ← ( SK.SCALE.POSITION.INTO.VIEWER FINISHVAL SCALE) - INPUT.GLOBALPOSITION _ FINISHVAL))) + INPUT.GLOBALPOSITION ← FINISHVAL))) (T (* mouse left the window, return) NIL]) (DISPLAY.POSITION.READER.TOTAL - [LAMBDA (MNU) (* rrb "19-May-86 17:09") - - (* displays the number total in the box in the window.) - + [LAMBDA (MNU) (* rrb "19-May-86 17:09") + (* displays the number total in the + box in the window.) (PROG ((TOTALREG (GETMENUPROP MNU 'TOTALREG)) (DECIMALPLACES (GETMENUPROP MNU 'DECIMALPOWER)) (WIN (WFROMMENU MNU))) @@ -8067,9 +7974,9 @@ Enter 'Abort' to leave the dashing unchanged.") (CENTERPRINTINREGION [COND [DECIMALPLACES - - (* printing a decimal number must check to make sure the correct number of - decimal places print.) + + (* printing a decimal number must check to make sure the correct number of + decimal places print.) (PROG ([TOTSTR (MKSTRING (GETMENUPROP MNU 'TOTAL] DECPOS NAFTERDEC NCHARS) @@ -8095,15 +8002,14 @@ Enter 'Abort' to leave the dashing unchanged.") TOTALREG WIN]) (POSITION.PAD.READER.HANDLER - [LAMBDA (DIGIT MNU) (* rrb "10-Jun-86 15:50") - - (* handles a key stroke or menu digit selection for a number pad reader.) - + [LAMBDA (DIGIT MNU) (* rrb "10-Jun-86 15:50") + (* handles a key stroke or menu digit + selection for a number pad reader.) (PROG (TOTAL POWER OPERATION TOPOFSTACK (WIN (WFROMMENU MNU))) (SETQ TOTAL (GETMENUPROP MNU 'TOTAL)) [PUTMENUPROP MNU 'TOTAL (SELECTQ DIGIT - (( bs) + ((_ bs) (COND ((NULL (GETMENUPROP MNU 'DIGITYET)) (* bs was the first key) @@ -8119,43 +8025,41 @@ Enter 'Abort' to leave the dashing unchanged.") (T (PUTMENUPROP MNU 'DECIMALPOWER (SETQ POWER (SUB1 POWER))) (* dirty but effective.) (PROG ((TOTSTR (MKSTRING TOTAL))) - - (* SUBSTRING will be NIL if the total has a trailing zero.) - + (* SUBSTRING will be NIL if the total + has a trailing zero.) (RETURN (MKATOM (OR (SUBSTRING TOTSTR 1 (PLUS (STRPOS "." TOTSTR) (SUB1 POWER))) TOTSTR] (T (* no decimal point) (IQUOTIENT TOTAL 10)))) - ( (* +/- sign) + (± (* +/- sign) (MINUS TOTAL)) - (( - + =) (* operation sign) + ((÷ × - + =) (* operation sign) [COND ((NULL (GETMENUPROP MNU 'DIGITYET)) - - (* last thing hit was an operation, just save this one.) - + (* last thing hit was an operation, + just save this one.) (PUTMENUPROP MNU 'OPERATION (COND ((EQ DIGIT '=) NIL) (T DIGIT))) (RETURN)) ((SETQ OPERATION (GETMENUPROP MNU 'OPERATION)) - - (* perform the operation that is stored between the top of stack and the - current total) + + (* perform the operation that is stored between the top of stack and the current + total) (COND [(SETQ TOPOFSTACK (GETMENUPROP MNU 'TOPOFSTACK)) (* a previous value exists) (SETQ TOTAL (SELECTQ OPERATION - ( (* divide, check for 0 divisor) + (÷ (* divide, check for 0 divisor) (COND ((ZEROP TOTAL) (PROMPTPRINT "Can't divide by zero")) (T (QUOTIENT TOPOFSTACK TOTAL)))) - ( (* times) + (× (* times) (TIMES TOPOFSTACK TOTAL)) (- (* minus) (DIFFERENCE TOPOFSTACK TOTAL)) @@ -8203,9 +8107,8 @@ Enter 'Abort' to leave the dashing unchanged.") [(NUMBERP DIGIT) (COND ((NULL (GETMENUPROP MNU 'DIGITYET)) - - (* first key hit after an operation, note this and clear the total.) - + (* first key hit after an operation, + note this and clear the total.) (PUTMENUPROP MNU 'DIGITYET T) (SETQ TOTAL 0))) (COND @@ -8216,7 +8119,7 @@ Enter 'Abort' to leave the dashing unchanged.") [(SETQ POWER (GETMENUPROP MNU 'DECIMALPOWER)) (* have read decimal pt) (PUTMENUPROP MNU 'DECIMALPOWER (ADD1 POWER)) - (SETQ POWER (bind (N _ 1.0) for I from 1 to POWER + (SETQ POWER (bind (N ← 1.0) for I from 1 to POWER do (SETQ N (FTIMES N 0.1)) finally (RETURN N))) (COND ((GEQ TOTAL 0) @@ -8232,7 +8135,7 @@ Enter 'Abort' to leave the dashing unchanged.") (DISPLAY.POSITION.READER.TOTAL MNU]) (POSITIONPAD.HELDFN - [LAMBDA (ITEM MENU BUTTON) (* rrb "10-Jun-86 15:29") + [LAMBDA (ITEM MENU BUTTON) (* rrb "10-Jun-86 15:29") (* prints the help information for a  numberpad.) (PROMPTPRINT (SELECTQ ITEM @@ -8243,61 +8146,59 @@ Enter 'Abort' to leave the dashing unchanged.") "performs the previously specified operation between the memory and the current total") (+ "Will read another number to be added to the current total") (- "Will read another number to be subtracted to the current total") - ( "Will read another number to be multiplied by the current total") - ( "Will read another number and divides the current total by it") + (× "Will read another number to be multiplied by the current total") + (÷ "Will read another number and divides the current total by it") (quit "Will stop prompting you for points.") (abort "will abort this sketch operation.") - ( " will change the sign of the total") + (± " will change the sign of the total") (%. "will enter a decimal point.") - ((bs ) + ((bs _) "Will erase the last digit entered.") (% "doesn't do anything.") "Will put this digit on the right of the total."]) (\POSITION.PAD.ADD.DIGIT.MENU - [LAMBDA (WIN LEFT MARGIN LABEL MENU TOTALSWIDTH TOTALSHEIGHT NUMBER/READER/MAXDIGITS) + [LAMBDA (WIN LEFT MARGIN LABEL MENU TOTALSWIDTH TOTALSHEIGHT NUMBER/READER/MAXDIGITS) (* rrb "10-Jun-86 12:06") - - (* * adds a menu which is a number pad menu to WIN, allocates the total region - for it.) + + (* * adds a menu which is a number pad menu to WIN, allocates the total region + for it.) (PROG (TOTALREGION) (ADDMENU MENU WIN (create POSITION - XCOORD _ LEFT - YCOORD _ MARGIN)) + XCOORD ← LEFT + YCOORD ← MARGIN)) (PUTMENUPROP MENU 'TOTALREG (SETQ TOTALREGION (create REGION - LEFT _ LEFT - BOTTOM _ (PLUS (fetch (MENU + LEFT ← LEFT + BOTTOM ← (PLUS (fetch (MENU IMAGEHEIGHT ) of MENU) MARGIN MARGIN) - WIDTH _ TOTALSWIDTH - HEIGHT _ TOTALSHEIGHT))) + WIDTH ← TOTALSWIDTH + HEIGHT ← TOTALSHEIGHT))) (PUTMENUPROP MENU 'TOTAL 0) (PUTMENUPROP MENU 'MAXDIGITS NUMBER/READER/MAXDIGITS) - - (* put link to the menu so the window can eventually get the values.) - + (* put link to the menu so the window + can eventually get the values.) (WINDOWPROP WIN LABEL MENU) (RETURN WIN]) (\POSITION.READER.NUMBERPAD - [LAMBDA (DIGITFONT WIDTH) (* rrb "10-Jun-86 15:33") - - (* returns a menu which is a numberpad suitable for a position reader.) - + [LAMBDA (DIGITFONT WIDTH) (* rrb "10-Jun-86 15:33") + (* returns a menu which is a numberpad + suitable for a position reader.) (create MENU - ITEMS _ - '( ce C 1 2 3 4 5 6 - 7 8 9 + 0 %. =) - MENUCOLUMNS _ 4 - CENTERFLG _ T - MENUFONT _ DIGITFONT - WHENHELDFN _ (FUNCTION POSITIONPAD.HELDFN) - WHENSELECTEDFN _ (FUNCTION POSITION.PAD.READER.HANDLER) - MENUOUTLINESIZE _ 2 - ITEMHEIGHT _ (IPLUS 2 (FONTPROP DIGITFONT 'HEIGHT)) - ITEMWIDTH _ (AND WIDTH (QUOTIENT (DIFFERENCE WIDTH 8) + ITEMS ← + '(_ ce C ÷ 1 2 3 × 4 5 6 - 7 8 9 + ± 0 %. =) + MENUCOLUMNS ← 4 + CENTERFLG ← T + MENUFONT ← DIGITFONT + WHENHELDFN ← (FUNCTION POSITIONPAD.HELDFN) + WHENSELECTEDFN ← (FUNCTION POSITION.PAD.READER.HANDLER) + MENUOUTLINESIZE ← 2 + ITEMHEIGHT ← (IPLUS 2 (FONTPROP DIGITFONT 'HEIGHT)) + ITEMWIDTH ← (AND WIDTH (QUOTIENT (DIFFERENCE WIDTH 8) 4]) ) @@ -8403,13 +8304,13 @@ Enter 'Abort' to leave the dashing unchanged.") (DEFINEQ (SK.DRAWFN - [LAMBDA (ELEMENTTYPE) (* rrb "17-MAR-83 22:28") + [LAMBDA (ELEMENTTYPE) (* rrb "17-MAR-83 22:28") (* goes from an element type name to  its DRAWFN) (fetch (SKETCHTYPE DRAWFN) of (GETPROP ELEMENTTYPE 'SKETCHTYPE]) (SK.TRANSFORMFN - [LAMBDA (ELEMENTTYPE) (* rrb " 7-Feb-85 12:08") + [LAMBDA (ELEMENTTYPE) (* rrb " 7-Feb-85 12:08") (* goes from an element type name to  its TRANSFORMFN) (fetch (SKETCHTYPE TRANSFORMFN) of (GETPROP ELEMENTTYPE 'SKETCHTYPE]) @@ -8420,37 +8321,35 @@ Enter 'Abort' to leave the dashing unchanged.") (fetch (SKETCHTYPE EXPANDFN) of (GETPROP ELEMENTTYPE 'SKETCHTYPE]) (SK.INPUT - [LAMBDA (ELEMENTTYPE SKETCHW) (* rrb "11-MAR-83 09:54") + [LAMBDA (ELEMENTTYPE SKETCHW) (* rrb "11-MAR-83 09:54") (* applies an element types input  function to a window.) (APPLY* (fetch (SKETCHTYPE INPUTFN) of ELEMENTTYPE) SKETCHW]) (SK.INSIDEFN - [LAMBDA (ELEMENTTYPE) (* rrb " 4-Oct-86 11:02") - - (* goes from an element type name to its inside predicate) - + [LAMBDA (ELEMENTTYPE) (* rrb " 4-Oct-86 11:02") + (* goes from an element type name to + its inside predicate) (PROG (SKTYPE) LP (COND ([NULL (SETQ SKTYPE (GETPROP ELEMENTTYPE 'SKETCHTYPE] - - (* unknown sketch type and this is the first place where such is encountered.) - + (* unknown sketch type and this is the + first place where such is encountered.) (ERROR ELEMENTTYPE "Unknown sketch type. If you can load the file containing it, do so and type 'RETURN'. -Otherwise, type '^'.") +Otherwise, type '↑'.") (GO LP))) (RETURN (fetch (SKETCHTYPE INSIDEFN) of SKTYPE]) (SK.UPDATEFN - [LAMBDA (ELEMENTTYPE) (* rrb "21-Dec-84 11:28") - - (* goes from an element type name to its updatefn The update function is called - when an element in a window has changed. - It will get args of the old local screen element, the new global element and - the window. If it can update the display more efficiently than erasing and - redrawing, it should and return the new local sketch element.) + [LAMBDA (ELEMENTTYPE) (* rrb "21-Dec-84 11:28") + + (* goes from an element type name to its updatefn The update function is called + when an element in a window has changed. It will get args of the old local screen + element, the new global element and the window. + If it can update the display more efficiently than erasing and redrawing, it + should and return the new local sketch element.) (fetch (SKETCHTYPE UPDATEFN) of (GETPROP ELEMENTTYPE 'SKETCHTYPE]) ) @@ -8639,11 +8538,11 @@ Otherwise, type '^'.") (DEFINEQ (SK.CHECK.SKETCH.VERSION - [LAMBDA (SKETCH) (* ; - "Edited 21-Oct-92 18:40 by sybalsky:mv:envos") + [LAMBDA (SKETCH) (* ; + "Edited 21-Oct-92 18:40 by sybalsky:mv:envos") (* ;; - "makes sure the sketch is the correct version. If not, it tries to update it. Returns SKETCH.") + "makes sure the sketch is the correct version. If not, it tries to update it. Returns SKETCH.") (COND ((EQ (LISTGET (fetch (SKETCH SKETCHPROPS) of SKETCH) @@ -8653,46 +8552,43 @@ Otherwise, type '^'.") (T (SK.INSURE.RECORD.LENGTH (fetch (SKETCH SKETCHELTS) of SKETCH)) (* ;; - "this is basically a PUTSKETCHPROP expanded in line to avoid coersions which can cause loops.") + "this is basically a PUTSKETCHPROP expanded in line to avoid coersions which can cause loops.") [PROG (PLIST) (SETQ PLIST (fetch (SKETCH SKETCHPROPS) of SKETCH)) (COND ((SETQ PLIST (fetch (SKETCH SKETCHPROPS) of SKETCH)) (LISTPUT PLIST 'VERSION SKETCH.VERSION)) - (T (replace (SKETCH SKETCHPROPS) of SKETCH with - (LIST 'VERSION - SKETCH.VERSION] + (T (replace (SKETCH SKETCHPROPS) of SKETCH with (LIST 'VERSION SKETCH.VERSION] SKETCH]) (SK.INSURE.RECORD.LENGTH - [LAMBDA (SKETCHELTS) (* ; - "Edited 21-Oct-92 18:35 by sybalsky:mv:envos") + [LAMBDA (SKETCHELTS) (* ; + "Edited 21-Oct-92 18:35 by sybalsky:mv:envos") (* ;; "makes sure the elements have the proper number of fields.") (bind INDPART TYPE NFIELDS for ELT in SKETCHELTS do (SETQ INDPART (fetch (GLOBALPART INDIVIDUALGLOBALPART) of ELT)) - (SETQ TYPE (fetch (INDIVIDUALGLOBALPART GTYPE) of INDPART)) - (COND - ([OR (SETQ NFIELDS (SK.RECORD.LENGTH TYPE)) - (AND (RECLOOK TYPE) - (SETQ SKETCH.RECORD.LENGTHS - (NCONC1 SKETCH.RECORD.LENGTHS (LIST TYPE - (SETQ NFIELDS - (LENGTH (EVAL (LIST 'CREATE TYPE] - (SK.INSURE.HAS.LENGTH INDPART NFIELDS TYPE))) + (SETQ TYPE (fetch (INDIVIDUALGLOBALPART GTYPE) of INDPART)) + (COND + ([OR (SETQ NFIELDS (SK.RECORD.LENGTH TYPE)) + (AND (RECLOOK TYPE) + (SETQ SKETCH.RECORD.LENGTHS (NCONC1 SKETCH.RECORD.LENGTHS + (LIST TYPE + (SETQ NFIELDS + (LENGTH (EVAL (LIST 'CREATE TYPE] + (SK.INSURE.HAS.LENGTH INDPART NFIELDS TYPE))) - (* ;; "if it's not a record, either it's an unknown sketch element type or its declaration wasn't copied to the compiled file. In either case, assume it has the correct number of fields.") + (* ;; "if it's not a record, either it's an unknown sketch element type or its declaration wasn't copied to the compiled file. In either case, assume it has the correct number of fields.") - (COND - ((EQ TYPE 'GROUP) (* ; - "recurse thru the subelements too.") - (SK.INSURE.RECORD.LENGTH (fetch (GROUP LISTOFGLOBALELTS) of INDPART]) + (COND + ((EQ TYPE 'GROUP) (* ; "recurse thru the subelements too.") + (SK.INSURE.RECORD.LENGTH (fetch (GROUP LISTOFGLOBALELTS) of INDPART]) (SK.INSURE.HAS.LENGTH - [LAMBDA (LIST N TYPE) (* ; - "Edited 21-Oct-92 18:36 by sybalsky:mv:envos") + [LAMBDA (LIST N TYPE) (* ; + "Edited 21-Oct-92 18:36 by sybalsky:mv:envos") (* ;; "makes sure LIST is at least N long. If not, it creates a record of type TYPE and nconcs the enough fields from the end to make it be N long.") @@ -8705,14 +8601,14 @@ Otherwise, type '^'.") (for I from (ADD1 (LENGTH LIST)) to N collect NIL]) (SK.RECORD.LENGTH - [LAMBDA (SKETCHRECORDTYPE) (* rrb "20-Mar-86 14:11") + [LAMBDA (SKETCHRECORDTYPE) (* rrb "20-Mar-86 14:11") (CADR (ASSOC SKETCHRECORDTYPE SKETCH.RECORD.LENGTHS]) (SK.SET.RECORD.LENGTHS - [LAMBDA NIL (* rrb "18-Oct-85 15:35") - - (* sets up a variable that contains the lengths of the sketch element records.) - + [LAMBDA NIL (* rrb "18-Oct-85 15:35") + (* sets up a variable that contains + the lengths of the sketch element + records.) (SETQ SKETCH.RECORD.LENGTHS (SK.SET.RECORD.LENGTHS.MACRO]) ) (DECLARE%: EVAL@COMPILE @@ -8736,19 +8632,17 @@ Otherwise, type '^'.") (DEFINEQ (SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER - [LAMBDA NIL (* ; "Edited 12-Feb-88 16:49 by rrb") - - (* adds sketch as an option to the file browser edit command.) - + [LAMBDA NIL (* ; "Edited 12-Feb-88 16:49 by rrb") + (* adds sketch as an option to the + file browser edit command.) (AND (BOUNDP 'FB.MENU.ITEMS) (PROG [(PTRX (for MITEM in FB.MENU.ITEMS when (STRING-EQUAL (CAR MITEM) - "Edit") - do (RETURN MITEM] + "Edit") do (RETURN MITEM] (SETQ PTRX (ASSOC 'SUBITEMS PTRX)) (for SUBI in PTRX when (STRING-EQUAL (CAR SUBI) - "Sketch") do (RETURN) - finally (NCONC1 PTRX (LIST '"Sketch" '(FB.EDITCOMMAND SKETCH) - "Calls the Sketch editor on selected files"]) + "Sketch") do (RETURN) + finally (NCONC1 PTRX (LIST '"Sketch" '(FB.EDITCOMMAND SKETCH) + "Calls the Sketch editor on selected files"]) ) (SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER) @@ -8761,151 +8655,151 @@ Otherwise, type '^'.") (ADDTOVAR LAMA SK.UNIONREGIONS SKETCH.CREATE) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (18222 20092 (SKETCH.FLUSH.EXISTING 18232 . 20090)) (20202 31352 (SKETCH.FROM.A.FILE -20212 . 20527) (SK.PUT.ON.FILE 20529 . 21981) (SKETCH.PUT 21983 . 24626) (SK.OUTPUT.FILE.NAME 24628 . -25113) (SK.INCLUDE.FILE 25115 . 27981) (SK.GET.IMAGEOBJ.FROM.FILE 27983 . 30146) (SK.GET.FROM.FILE -30148 . 31041) (SKETCH.GET 31043 . 31350)) (31353 83865 (SKETCH 31363 . 33468) (SKETCHW.CREATE 33470 - . 38044) (SKETCH.RESET 38046 . 39568) (SKETCHW.FIG.CHANGED 39570 . 39910) (SK.WINDOW.TITLE 39912 . -40299) (EDITSLIDE 40301 . 40707) (EDITSKETCH 40709 . 41033) (ADD.SKETCH.TO.VIEWER 41035 . 43621) ( -SK.ADD.ELEMENTS.TO.SKETCH 43623 . 44137) (SKETCH.SET.A.DEFAULT 44139 . 51690) (SK.POPUP.SELECTIONFN -51692 . 52234) (GETSKETCHWREGION 52236 . 52442) (SK.ADD.ELEMENT 52444 . 54023) ( -SK.ADD.PRIORITY.ELEMENT.TO.SKETCH 54025 . 55419) (SK.ELTS.BY.PRIORITY 55421 . 55717) ( -SK.ORDER.ELEMENTS 55719 . 55986) (SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH 55988 . 57482) ( -SK.ADD.ELEMENTS 57484 . 58008) (SK.CHECK.WHENADDEDFN 58010 . 58740) (SK.APPLY.MENU.COMMAND 58742 . -59540) (SK.DELETE.ELEMENT1 59542 . 61120) (SK.MARK.DIRTY 61122 . 61788) (SK.MARK.UNDIRTY 61790 . 62121 -) (SK.MENU.AND.RETURN.FIELD 62123 . 62788) (SKETCH.SET.BRUSH.SHAPE 62790 . 63375) ( -SKETCH.SET.BRUSH.SIZE 63377 . 63883) (SKETCHW.CLOSEFN 63885 . 65676) (SK.CONFIRM.DESTRUCTION 65678 . -66677) (SKETCHW.OUTFN 66679 . 66943) (SKETCHW.REOPENFN 66945 . 67357) (MAKE.LOCAL.SKETCH 67359 . 68089 -) (MAP.SKETCHSPEC.INTO.VIEWER 68091 . 69301) (SKETCHW.REPAINTFN 69303 . 70131) (SKETCHW.REPAINTFN1 -70133 . 71072) (SK.DRAWFIGURE.IF 71074 . 71596) (SKETCHW.SCROLLFN 71598 . 75791) (SKETCHW.RESHAPEFN -75793 . 78051) (SK.UPDATE.EVENT.SELECTION 78053 . 80108) (LIGHTGRAYWINDOW 80110 . 80273) ( -SK.ADD.SPACES 80275 . 81021) (SK.SKETCH.MENU 81023 . 81345) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN 81347 . -82199) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 82201 . 83161) (SK.RETURN.TTY 83163 . 83531) (SK.TAKE.TTY -83533 . 83863)) (83919 107334 (SKETCH.COMMANDMENU 83929 . 84353) (SKETCH.COMMANDMENU.ITEMS 84355 . -104438) (CREATE.SKETCHW.COMMANDMENU 104440 . 104860) (SKETCHW.SELECTIONFN 104862 . 105965) ( -SKETCH.MONITORLOCK 105967 . 106438) (SK.EVAL.AS.PROCESS 106440 . 107053) (SK.EVAL.WITH.LOCK 107055 . -107332)) (107335 115139 (SK.FIX.MENU 107345 . 108439) (SK.SET.UP.MENUS 108441 . 110742) ( -SK.INSURE.HAS.MENU 110744 . 111406) (SK.CREATE.STANDARD.MENU 111408 . 111853) (SK.ADD.ITEM.TO.MENU -111855 . 112530) (SK.GET.VIEWER.POPUP.MENU 112532 . 114733) (SK.CLEAR.POPUP.MENU 114735 . 115137)) ( -115195 124017 (SKETCH.CREATE 115205 . 115991) (GETSKETCHPROP 115993 . 119050) (PUTSKETCHPROP 119052 . -122984) (CREATE.DEFAULT.SKETCH.CONTEXT 122986 . 124015)) (124183 147079 (SK.COPY.BUTTONEVENTFN 124193 - . 135421) (SK.BUTTONEVENT.MARK 135423 . 135806) (SK.BUILD.IMAGEOBJ 135808 . 145723) ( -SK.BUTTONEVENT.OVERP 145725 . 146348) (SK.BUTTONEVENT.SAME.KEYS 146350 . 147077)) (147358 173173 ( -SK.SEL.AND.CHANGE 147368 . 147660) (SK.CHECK.WHENCHANGEDFN 147662 . 148368) (SK.CHECK.PRECHANGEFN -148370 . 148971) (SK.CHANGE.ELT 148973 . 149165) (SK.CHANGE.THING 149167 . 150418) ( -SKETCH.CHANGE.ELEMENTS 150420 . 151603) (SK.APPLY.SINGLE.CHANGEFN 151605 . 152178) (SK.DO.CHANGESPECS -152180 . 153839) (SK.VIEWER.FROM.SKETCH.ARG 153841 . 154283) (SK.DO.CHANGESPEC1 154285 . 156160) ( -SK.CHANGEFN 156162 . 156742) (SK.READCHANGEFN 156744 . 157203) (SK.DEFAULT.CHANGEFN 157205 . 159677) ( -CHANGEABLEFIELDITEMS 159679 . 160326) (SK.APPLY.CHANGE.COMMAND 160328 . 160945) ( -SK.DO.AND.RECORD.CHANGES 160947 . 162344) (SK.APPLY.CHANGE.COMMAND1 162346 . 163834) ( -SK.ELEMENTS.CHANGEFN 163836 . 166160) (READ.POINT.TO.ADD 166162 . 167106) (GLOBAL.KNOT.FROM.LOCAL -167108 . 167568) (SK.ADD.KNOT.TO.ELEMENT 167570 . 168514) (SK.GROUP.CHANGEFN 168516 . 169728) ( -SK.GROUP.CHANGEFN1 169730 . 173171)) (173340 187073 (ADD.ELEMENT.TO.SKETCH 173350 . 175056) ( -ADD.SKETCH.VIEWER 175058 . 175726) (REMOVE.SKETCH.VIEWER 175728 . 176341) (ALL.SKETCH.VIEWERS 176343 - . 176583) (SKETCH.ALL.VIEWERS 176585 . 176845) (VIEWER.BUCKET 176847 . 176998) (ELT.INSIDE.REGION? -177000 . 177327) (ELT.INSIDE.SKWP 177329 . 177620) (SCALE.FROM.SKW 177622 . 177872) ( -SK.ADDELT.TO.WINDOW 177874 . 178734) (SK.CALC.REGION.VIEWED 178736 . 179114) (SK.DRAWFIGURE 179116 . -180405) (SK.DRAWFIGURE1 180407 . 180791) (SK.LOCAL.FROM.GLOBAL 180793 . 182028) (SKETCH.REGION.VIEWED -182030 . 184717) (SKETCH.VIEW.FROM.NAME 184719 . 185149) (SK.UPDATE.REGION.VIEWED 185151 . 185543) ( -SKETCH.ADD.AND.DISPLAY 185545 . 185953) (SKETCH.ADD.AND.DISPLAY1 185955 . 186393) (SK.ADD.ITEM 186395 - . 186727) (SKETCHW.ADD.INSTANCE 186729 . 187071)) (187114 200302 (SK.SEL.AND.DELETE 187124 . 187512) -(SK.ERASE.AND.DELETE.ITEM 187514 . 187933) (REMOVE.ELEMENT.FROM.SKETCH 187935 . 189046) ( -SK.DELETE.ELEMENT 189048 . 189606) (SK.DELETE.ELEMENT2 189608 . 190269) (SK.DELETE.KNOT 190271 . -190562) (SK.SEL.AND.DELETE.KNOT 190564 . 191689) (SK.DELETE.ELEMENT.KNOT 191691 . 194898) ( -SK.CHECK.WHENDELETEDFN 194900 . 195680) (SK.CHECK.PREEDITFN 195682 . 196166) ( -SK.CHECK.END.INITIAL.EDIT 196168 . 196702) (SK.CHECK.WHENPOINTDELETEDFN 196704 . 197500) (SK.ERASE.ELT - 197502 . 197838) (SK.DELETE.ELT 197840 . 198215) (SK.DELETE.ITEM 198217 . 198625) (DELFROMTCONC -198627 . 200300)) (200341 214175 (SK.COPY.ELT 200351 . 200721) (SK.SEL.AND.COPY 200723 . 201106) ( -SK.COPY.ELEMENTS 201108 . 206736) (SK.ADD.COPY.OF.ELEMENTS 206738 . 208505) ( -SK.GLOBAL.FROM.LOCAL.ELEMENTS 208507 . 208747) (SK.COPY.ITEM 208749 . 209546) (SK.INSERT.SKETCH 209548 - . 214173)) (214215 244236 (SK.MOVE.ELT 214225 . 214500) (SK.MOVE.ELT.OR.PT 214502 . 214815) ( -SK.APPLY.DEFAULT.MOVE 214817 . 215251) (SK.SEL.AND.MOVE 215253 . 215800) (SK.MOVE.ELEMENTS 215802 . -226674) (SKETCH.MOVE.ELEMENTS 226676 . 228607) (SKETCH.COPY.ELEMENTS 228609 . 230656) ( -\SKETCH.COPY.ELEMENT 230658 . 231383) (SK.TRANSLATE.ELEMENT 231385 . 231868) (SK.COPY.GLOBAL.ELEMENT -231870 . 232081) (SK.MAKE.ELEMENT.MOVE.ARG 232083 . 232703) (SK.MAKE.ELEMENTS.MOVE.ARG 232705 . 233227 -) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 233229 . 234298) (SK.SHOW.FIG.FROM.INFO 234300 . 234668) ( -SK.MOVE.THING 234670 . 235576) (UPDATE.ELEMENT.IN.SKETCH 235578 . 237633) (SK.UPDATE.ELEMENT 237635 . -239194) (SK.UPDATE.ELEMENTS 239196 . 239915) (SK.UPDATE.ELEMENT1 239917 . 243817) ( -SK.MOVE.ELEMENT.POINT 243819 . 244234)) (244299 266588 (SK.MOVE.POINTS 244309 . 244596) ( -SK.SEL.AND.MOVE.POINTS 244598 . 244903) (SK.DO.MOVE.ELEMENT.POINTS 244905 . 253562) ( -SK.MOVE.ITEM.POINTS 253564 . 255235) (SK.TRANSLATEPTSFN 255237 . 255621) (SK.TRANSLATE.POINTS 255623 - . 256524) (SK.SELECT.MULTIPLE.POINTS 256526 . 262166) (SK.CONTROL.POINTS.IN.REGION 262168 . 263589) ( -SK.ADD.PT.SELECTION 263591 . 264055) (SK.REMOVE.PT.SELECTION 264057 . 264674) (SK.ADD.POINT 264676 . -265299) (SK.ELTS.CONTAINING.PTS 265301 . 265926) (SK.HOTSPOTS.NOT.ON.LIST 265928 . 266586)) (266746 -269542 (SK.SET.MOVE.MODE 266756 . 267427) (SK.SET.MOVE.MODE.POINTS 267429 . 267768) ( -SK.SET.MOVE.MODE.ELEMENTS 267770 . 268114) (SK.SET.MOVE.MODE.COMBINED 268116 . 268466) (READMOVEMODE -268468 . 269540)) (269543 288298 (SK.ALIGN.POINTS 269553 . 269843) (SK.SEL.AND.ALIGN.POINTS 269845 . -270154) (SK.ALIGN.POINTS.LEFT 270156 . 270459) (SK.ALIGN.POINTS.RIGHT 270461 . 270766) ( -SK.ALIGN.POINTS.TOP 270768 . 271069) (SK.ALIGN.POINTS.BOTTOM 271071 . 271378) ( -SK.EVEN.SPACE.POINTS.IN.X 271380 . 271700) (SK.EVEN.SPACE.POINTS.IN.Y 271702 . 272022) ( -SK.DO.ALIGN.POINTS 272024 . 282646) (SK.NTH.CONTROL.POINT 282648 . 283109) ( -SK.GET.SELECTED.ELEMENT.STRUCTURE 283111 . 283777) (SK.CORRESPONDING.CONTROL.PT 283779 . 284333) ( -SK.CONTROL.POINT.NUMBER 284335 . 284705) (SK.DO.ALIGN.SETVALUE 284707 . 288296)) (288362 301794 ( -SKETCH.CREATE.GROUP 288372 . 288861) (SK.CREATE.GROUP1 288863 . 289410) (SK.UPDATE.GROUP.AFTER.CHANGE -289412 . 290201) (SK.GROUP.ELTS 290203 . 290484) (SK.SEL.AND.GROUP 290486 . 290872) (SK.GROUP.ELEMENTS - 290874 . 292523) (SK.UNGROUP.ELT 292525 . 292809) (SK.SEL.AND.UNGROUP 292811 . 294480) ( -SK.UNGROUP.ELEMENT 294482 . 295418) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 295420 . 296342) ( -SK.LOCAL.REGION.OF.LOCAL.ELEMENTS 296344 . 297355) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 297357 . -298697) (SK.UNIONREGIONS 298699 . 301065) (SKETCH.REGION.OF.SKETCH 301067 . 301483) (SK.FLASHREGION -301485 . 301792)) (301795 315266 (INIT.GROUP.ELEMENT 301805 . 302677) (GROUP.DRAWFN 302679 . 303129) ( -GROUP.EXPANDFN 303131 . 304694) (GROUP.INSIDEFN 304696 . 305105) (GROUP.REGIONFN 305107 . 305502) ( -GROUP.GLOBALREGIONFN 305504 . 305822) (GROUP.TRANSLATEFN 305824 . 307856) (GROUP.TRANSFORMFN 307858 . -311338) (GROUP.READCHANGEFN 311340 . 315264)) (315267 316275 (REGION.CENTER 315277 . 315878) ( -REMOVE.LAST 315880 . 316273)) (316328 321435 (SK.MOVE.GROUP.CONTROL.PT 316338 . 316629) ( -SK.SEL.AND.MOVE.CONTROL.PT 316631 . 318035) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT 318037 . 320110) ( -SK.READ.NEW.GROUP.CONTROL.PT 320112 . 321433)) (321694 326318 (SK.DO.GROUP 321704 . 323156) ( -SK.CHECK.WHENGROUPEDFN 323158 . 323868) (SK.DO.UNGROUP 323870 . 325075) (SK.CHECK.WHENUNGROUPEDFN -325077 . 325664) (SK.GROUP.UNDO 325666 . 325989) (SK.UNGROUP.UNDO 325991 . 326316)) (326559 331481 ( -SK.FREEZE.ELTS 326569 . 326853) (SK.SEL.AND.FREEZE 326855 . 327245) (SK.FREEZE.ELEMENTS 327247 . -327798) (SK.UNFREEZE.ELT 327800 . 328089) (SK.SEL.AND.UNFREEZE 328091 . 329627) (SK.UNFREEZE.ELEMENTS -329629 . 330188) (SK.FREEZE.UNDO 330190 . 330435) (SK.UNFREEZE.UNDO 330437 . 330684) (SK.DO.FREEZE -330686 . 331079) (SK.DO.UNFREEZE 331081 . 331479)) (331711 341521 (SKETCH.ELEMENTS.OF.SKETCH 331721 . -332556) (SKETCH.LIST.OF.ELEMENTS 332558 . 333276) (SKETCH.ADD.ELEMENT 333278 . 334353) ( -SKETCH.DELETE.ELEMENT 334355 . 336087) (DELFROMGROUPELT 336089 . 336889) (SKETCH.ELEMENT.TYPE 336891 - . 337240) (SKETCH.ELEMENT.CHANGED 337242 . 338810) (SK.ELEMENT.CHANGED1 338812 . 339463) ( -SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 339465 . 341519)) (341575 346187 (INSURE.SKETCH 341585 . 344200) - (LOCALSPECS.FROM.VIEWER 344202 . 344562) (SK.LOCAL.ELT.FROM.GLOBALPART 344564 . 345032) ( -SKETCH.FROM.VIEWER 345034 . 345268) (INSPECT.SKETCH 345270 . 345595) (ELT.INSIDE.SKETCHWP 345597 . -345870) (SK.INSIDE.REGION 345872 . 346185)) (346188 350518 (MAPSKETCHSPECS 346198 . 346819) ( -MAPCOLLECTSKETCHSPECS 346821 . 347570) (MAPSKETCHSPECSUNTIL 347572 . 348380) (MAPGLOBALSKETCHSPECS -348382 . 349083) (MAPGLOBALSKETCHELEMENTS 349085 . 350516)) (350580 376472 (SK.ADD.SELECTION 350590 . -351330) (SK.COPY.INSERTFN 351332 . 354963) (SCREENELEMENTP 354965 . 355438) (SK.ITEM.REGION 355440 . -355927) (SK.ELEMENT.GLOBAL.REGION 355929 . 356457) (SK.LOCAL.ITEMS.IN.REGION 356459 . 358438) ( -SK.REGIONFN 358440 . 358762) (SK.GLOBAL.REGIONFN 358764 . 359122) (SK.REMOVE.SELECTION 359124 . 359852 -) (SK.SELECT.MULTIPLE.ITEMS 359854 . 370296) (SKETCH.GET.ELEMENTS 370298 . 371721) (SK.PUT.MARKS.UP -371723 . 372062) (SK.TAKE.MARKS.DOWN 372064 . 372403) (SK.TRANSLATE.GLOBALPART 372405 . 374532) ( -SK.TRANSLATE.ITEM 374534 . 375461) (SK.TRANSLATEFN 375463 . 375659) (TRANSLATE.SKETCH 375661 . 376470) -) (376738 379645 (SK.INPUT.SCALE 376748 . 377595) (SK.UPDATE.SKETCHCONTEXT 377597 . 378194) ( -SK.SET.INPUT.SCALE 378196 . 378845) (SK.SET.INPUT.SCALE.CURRENT 378847 . 379138) ( -SK.SET.INPUT.SCALE.VALUE 379140 . 379643)) (379696 381608 (SK.SET.FEEDBACK.MODE 379706 . 381012) ( -SK.SET.FEEDBACK.POINT 381014 . 381182) (SK.SET.FEEDBACK.VERBOSE 381184 . 381353) ( -SK.SET.FEEDBACK.ALWAYS 381355 . 381606)) (381759 383137 (SKETCH.TITLE 381769 . 382133) ( -SK.SHRINK.ICONCREATE 382135 . 383135)) (388827 391641 (READBRUSHSHAPE 388837 . 389296) (READ.FUNCTION -389298 . 389813) (READBRUSHSIZE 389815 . 390273) (READANGLE 390275 . 390767) (READARCDIRECTION 390769 - . 391639)) (391642 402053 (SK.CHANGE.DASHING 391652 . 395600) (READ.AND.SAVE.NEW.DASHING 395602 . -397370) (READ.NEW.DASHING 397372 . 399112) (READ.DASHING.CHANGE 399114 . 400589) (SK.CACHE.DASHING -400591 . 401593) (SK.DASHING.LABEL 401595 . 402051)) (402054 405759 (READ.FILLING.CHANGE 402064 . -404045) (SK.CACHE.FILLING 404047 . 404765) (READ.AND.SAVE.NEW.FILLING 404767 . 405365) ( -SK.FILLING.LABEL 405367 . 405757)) (406143 442396 (SK.GETGLOBALPOSITION 406153 . 406458) ( -SKETCH.TRACK.ELEMENTS 406460 . 409980) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS 409982 . 410541) ( -MAP.SKETCH.ELEMENTS.INTO.VIEWER 410543 . 410935) (MAP.GLOBAL.POSITION.INTO.VIEWER 410937 . 411317) ( -SKETCH.TO.VIEWER.POSITION 411319 . 411678) (SKETCH.TRACK.IMAGE 411680 . 412534) (SK.TRACK.IMAGE1 -412536 . 413948) (MAP.VIEWER.XY.INTO.GLOBAL 413950 . 414944) (SK.SET.POSITION 414946 . 415282) ( -MAP.VIEWER.PT.INTO.GLOBAL 415284 . 416390) (VIEWER.TO.SKETCH.POSITION 416392 . 417027) ( -SK.INSURE.SCALE 417029 . 417289) (SKETCH.TO.VIEWER.REGION 417291 . 418097) (VIEWER.TO.SKETCH.REGION -418099 . 418437) (SK.READ.POINT.WITH.FEEDBACK 418439 . 429442) (SKETCH.GET.POSITION 429444 . 431324) ( -\CLOBBER.POSITION 431326 . 431774) (NEAREST.HOT.SPOT 431776 . 433304) (GETWREGION 433306 . 434067) ( -GET.BITMAP.POSITION 434069 . 434853) (SK.TRACK.BITMAP1 434855 . 442394)) (442965 473851 ( -SK.BRING.UP.POSITION.PAD 442975 . 448835) (SK.PAD.READER.POSITION 448837 . 450486) ( -SK.POSITION.READER.REPAINTFN 450488 . 452272) (SK.POSITION.PAD.FROM.VIEWER 452274 . 453616) ( -SK.INIT.POSITION.NUMBER.PAD.MENU 453618 . 453968) (SK.READ.POSITION.PAD.HANDLER 453970 . 459702) ( -DISPLAY.POSITION.READER.TOTAL 459704 . 462002) (POSITION.PAD.READER.HANDLER 462004 . 470047) ( -POSITIONPAD.HELDFN 470049 . 471533) (\POSITION.PAD.ADD.DIGIT.MENU 471535 . 473114) ( -\POSITION.READER.NUMBERPAD 473116 . 473849)) (475477 478155 (SK.DRAWFN 475487 . 475853) ( -SK.TRANSFORMFN 475855 . 476236) (SK.EXPANDFN 476238 . 476515) (SK.INPUT 476517 . 476898) (SK.INSIDEFN -476900 . 477540) (SK.UPDATEFN 477542 . 478153)) (483320 485476 (UPDATE-SKETCH 483330 . 484443) ( -EDIT-SKETCH 484445 . 485474)) (486077 490022 (SK.CHECK.SKETCH.VERSION 486087 . 487327) ( -SK.INSURE.RECORD.LENGTH 487329 . 488812) (SK.INSURE.HAS.LENGTH 488814 . 489552) (SK.RECORD.LENGTH -489554 . 489728) (SK.SET.RECORD.LENGTHS 489730 . 490020)) (490485 491372 ( -SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER 490495 . 491370))))) + (FILEMAP (NIL (18101 19973 (SKETCH.FLUSH.EXISTING 18111 . 19971)) (20083 31463 (SKETCH.FROM.A.FILE +20093 . 20509) (SK.PUT.ON.FILE 20511 . 22007) (SKETCH.PUT 22009 . 24652) (SK.OUTPUT.FILE.NAME 24654 . +25139) (SK.INCLUDE.FILE 25141 . 28007) (SK.GET.IMAGEOBJ.FROM.FILE 28009 . 30172) (SK.GET.FROM.FILE +30174 . 31156) (SKETCH.GET 31158 . 31461)) (31464 90453 (SKETCH 31474 . 33642) (SKETCHW.CREATE 33644 + . 43169) (SKETCH.RESET 43171 . 44794) (SKETCHW.FIG.CHANGED 44796 . 45120) (SK.WINDOW.TITLE 45122 . +45610) (EDITSLIDE 45612 . 46123) (EDITSKETCH 46125 . 46445) (ADD.SKETCH.TO.VIEWER 46447 . 49037) ( +SK.ADD.ELEMENTS.TO.SKETCH 49039 . 49537) (SKETCH.SET.A.DEFAULT 49539 . 57098) (SK.POPUP.SELECTIONFN +57100 . 57626) (GETSKETCHWREGION 57628 . 57830) (SK.ADD.ELEMENT 57832 . 59395) ( +SK.ADD.PRIORITY.ELEMENT.TO.SKETCH 59397 . 60751) (SK.ELTS.BY.PRIORITY 60753 . 61034) ( +SK.ORDER.ELEMENTS 61036 . 61288) (SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH 61290 . 62901) ( +SK.ADD.ELEMENTS 62903 . 63516) (SK.CHECK.WHENADDEDFN 63518 . 64232) (SK.APPLY.MENU.COMMAND 64234 . +65074) (SK.DELETE.ELEMENT1 65076 . 66626) (SK.MARK.DIRTY 66628 . 67382) (SK.MARK.UNDIRTY 67384 . 67802 +) (SK.MENU.AND.RETURN.FIELD 67804 . 68576) (SKETCH.SET.BRUSH.SHAPE 68578 . 69161) ( +SKETCH.SET.BRUSH.SIZE 69163 . 69665) (SKETCHW.CLOSEFN 69667 . 71612) (SK.CONFIRM.DESTRUCTION 71614 . +72596) (SKETCHW.OUTFN 72598 . 72846) (SKETCHW.REOPENFN 72848 . 73426) (MAKE.LOCAL.SKETCH 73428 . 74125 +) (MAP.SKETCHSPEC.INTO.VIEWER 74127 . 75427) (SKETCHW.REPAINTFN 75429 . 76317) (SKETCHW.REPAINTFN1 +76319 . 77241) (SK.DRAWFIGURE.IF 77243 . 77742) (SKETCHW.SCROLLFN 77744 . 82116) (SKETCHW.RESHAPEFN +82118 . 84558) (SK.UPDATE.EVENT.SELECTION 84560 . 86599) (LIGHTGRAYWINDOW 86601 . 86760) ( +SK.ADD.SPACES 86762 . 87504) (SK.SKETCH.MENU 87506 . 87824) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN 87826 . +88663) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 88665 . 89757) (SK.RETURN.TTY 89759 . 90123) (SK.TAKE.TTY +90125 . 90451)) (90507 114106 (SKETCH.COMMANDMENU 90517 . 90951) (SKETCH.COMMANDMENU.ITEMS 90953 . +111036) (CREATE.SKETCHW.COMMANDMENU 111038 . 111454) (SKETCHW.SELECTIONFN 111456 . 112539) ( +SKETCH.MONITORLOCK 112541 . 113008) (SK.EVAL.AS.PROCESS 113010 . 113724) (SK.EVAL.WITH.LOCK 113726 . +114104)) (114107 122470 (SK.FIX.MENU 114117 . 115312) (SK.SET.UP.MENUS 115314 . 117674) ( +SK.INSURE.HAS.MENU 117676 . 118418) (SK.CREATE.STANDARD.MENU 118420 . 118861) (SK.ADD.ITEM.TO.MENU +118863 . 119759) (SK.GET.VIEWER.POPUP.MENU 119761 . 122080) (SK.CLEAR.POPUP.MENU 122082 . 122468)) ( +122526 131359 (SKETCH.CREATE 122536 . 123320) (GETSKETCHPROP 123322 . 126375) (PUTSKETCHPROP 126377 . +130302) (CREATE.DEFAULT.SKETCH.CONTEXT 130304 . 131357)) (131525 153881 (SK.COPY.BUTTONEVENTFN 131535 + . 143424) (SK.BUTTONEVENT.MARK 143426 . 143910) (SK.BUILD.IMAGEOBJ 143912 . 152471) ( +SK.BUTTONEVENT.OVERP 152473 . 153080) (SK.BUTTONEVENT.SAME.KEYS 153082 . 153879)) (154160 180880 ( +SK.SEL.AND.CHANGE 154170 . 154563) (SK.CHECK.WHENCHANGEDFN 154565 . 155255) (SK.CHECK.PRECHANGEFN +155257 . 155842) (SK.CHANGE.ELT 155844 . 156032) (SK.CHANGE.THING 156034 . 157453) ( +SKETCH.CHANGE.ELEMENTS 157455 . 158617) (SK.APPLY.SINGLE.CHANGEFN 158619 . 159176) (SK.DO.CHANGESPECS +159178 . 160932) (SK.VIEWER.FROM.SKETCH.ARG 160934 . 161360) (SK.DO.CHANGESPEC1 161362 . 163354) ( +SK.CHANGEFN 163356 . 163920) (SK.READCHANGEFN 163922 . 164364) (SK.DEFAULT.CHANGEFN 164366 . 166977) ( +CHANGEABLEFIELDITEMS 166979 . 167606) (SK.APPLY.CHANGE.COMMAND 167608 . 168325) ( +SK.DO.AND.RECORD.CHANGES 168327 . 169696) (SK.APPLY.CHANGE.COMMAND1 169698 . 171158) ( +SK.ELEMENTS.CHANGEFN 171160 . 173535) (READ.POINT.TO.ADD 173537 . 174465) (GLOBAL.KNOT.FROM.LOCAL +174467 . 175028) (SK.ADD.KNOT.TO.ELEMENT 175030 . 176135) (SK.GROUP.CHANGEFN 176137 . 177343) ( +SK.GROUP.CHANGEFN1 177345 . 180878)) (181047 195989 (ADD.ELEMENT.TO.SKETCH 181057 . 182747) ( +ADD.SKETCH.VIEWER 182749 . 183413) (REMOVE.SKETCH.VIEWER 183415 . 184024) (ALL.SKETCH.VIEWERS 184026 + . 184367) (SKETCH.ALL.VIEWERS 184369 . 184629) (VIEWER.BUCKET 184631 . 184778) (ELT.INSIDE.REGION? +184780 . 185208) (ELT.INSIDE.SKWP 185210 . 185602) (SCALE.FROM.SKW 185604 . 185850) ( +SK.ADDELT.TO.WINDOW 185852 . 187019) (SK.CALC.REGION.VIEWED 187021 . 187395) (SK.DRAWFIGURE 187397 . +188668) (SK.DRAWFIGURE1 188670 . 189050) (SK.LOCAL.FROM.GLOBAL 189052 . 190428) (SKETCH.REGION.VIEWED +190430 . 193366) (SKETCH.VIEW.FROM.NAME 193368 . 193899) (SK.UPDATE.REGION.VIEWED 193901 . 194289) ( +SKETCH.ADD.AND.DISPLAY 194291 . 194683) (SKETCH.ADD.AND.DISPLAY1 194685 . 195224) (SK.ADD.ITEM 195226 + . 195542) (SKETCHW.ADD.INSTANCE 195544 . 195987)) (196030 209355 (SK.SEL.AND.DELETE 196040 . 196424) +(SK.ERASE.AND.DELETE.ITEM 196426 . 196841) (REMOVE.ELEMENT.FROM.SKETCH 196843 . 197937) ( +SK.DELETE.ELEMENT 197939 . 198481) (SK.DELETE.ELEMENT2 198483 . 199128) (SK.DELETE.KNOT 199130 . +199522) (SK.SEL.AND.DELETE.KNOT 199524 . 200645) (SK.DELETE.ELEMENT.KNOT 200647 . 203860) ( +SK.CHECK.WHENDELETEDFN 203862 . 204625) (SK.CHECK.PREEDITFN 204627 . 205212) ( +SK.CHECK.END.INITIAL.EDIT 205214 . 205732) (SK.CHECK.WHENPOINTDELETEDFN 205734 . 206514) (SK.ERASE.ELT + 206516 . 206848) (SK.DELETE.ELT 206850 . 207221) (SK.DELETE.ITEM 207223 . 207627) (DELFROMTCONC +207629 . 209353)) (209394 223511 (SK.COPY.ELT 209404 . 209770) (SK.SEL.AND.COPY 209772 . 210151) ( +SK.COPY.ELEMENTS 210153 . 215995) (SK.ADD.COPY.OF.ELEMENTS 215997 . 217811) ( +SK.GLOBAL.FROM.LOCAL.ELEMENTS 217813 . 218138) (SK.COPY.ITEM 218140 . 218904) (SK.INSERT.SKETCH 218906 + . 223509)) (223551 253998 (SK.MOVE.ELT 223561 . 223937) (SK.MOVE.ELT.OR.PT 223939 . 224353) ( +SK.APPLY.DEFAULT.MOVE 224355 . 224956) (SK.SEL.AND.MOVE 224958 . 225489) (SK.MOVE.ELEMENTS 225491 . +236561) (SKETCH.MOVE.ELEMENTS 236563 . 238453) (SKETCH.COPY.ELEMENTS 238455 . 240461) ( +\SKETCH.COPY.ELEMENT 240463 . 241180) (SK.TRANSLATE.ELEMENT 241182 . 241649) (SK.COPY.GLOBAL.ELEMENT +241651 . 241862) (SK.MAKE.ELEMENT.MOVE.ARG 241864 . 242467) (SK.MAKE.ELEMENTS.MOVE.ARG 242469 . 242974 +) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 242976 . 244028) (SK.SHOW.FIG.FROM.INFO 244030 . 244394) ( +SK.MOVE.THING 244396 . 245298) (UPDATE.ELEMENT.IN.SKETCH 245300 . 247303) (SK.UPDATE.ELEMENT 247305 . +248822) (SK.UPDATE.ELEMENTS 248824 . 249527) (SK.UPDATE.ELEMENT1 249529 . 253583) ( +SK.MOVE.ELEMENT.POINT 253585 . 253996)) (254061 277032 (SK.MOVE.POINTS 254071 . 254459) ( +SK.SEL.AND.MOVE.POINTS 254461 . 254751) (SK.DO.MOVE.ELEMENT.POINTS 254753 . 263337) ( +SK.MOVE.ITEM.POINTS 263339 . 265094) (SK.TRANSLATEPTSFN 265096 . 265476) (SK.TRANSLATE.POINTS 265478 + . 266375) (SK.SELECT.MULTIPLE.POINTS 266377 . 272279) (SK.CONTROL.POINTS.IN.REGION 272281 . 273754) ( +SK.ADD.PT.SELECTION 273756 . 274216) (SK.REMOVE.PT.SELECTION 274218 . 274820) (SK.ADD.POINT 274822 . +275550) (SK.ELTS.CONTAINING.PTS 275552 . 276385) (SK.HOTSPOTS.NOT.ON.LIST 276387 . 277030)) (277190 +280066 (SK.SET.MOVE.MODE 277200 . 277856) (SK.SET.MOVE.MODE.POINTS 277858 . 278193) ( +SK.SET.MOVE.MODE.ELEMENTS 278195 . 278535) (SK.SET.MOVE.MODE.COMBINED 278537 . 278883) (READMOVEMODE +278885 . 280064)) (280067 299658 (SK.ALIGN.POINTS 280077 . 280468) (SK.SEL.AND.ALIGN.POINTS 280470 . +280764) (SK.ALIGN.POINTS.LEFT 280766 . 281170) (SK.ALIGN.POINTS.RIGHT 281172 . 281578) ( +SK.ALIGN.POINTS.TOP 281580 . 281982) (SK.ALIGN.POINTS.BOTTOM 281984 . 282392) ( +SK.EVEN.SPACE.POINTS.IN.X 282394 . 282815) (SK.EVEN.SPACE.POINTS.IN.Y 282817 . 283238) ( +SK.DO.ALIGN.POINTS 283240 . 293968) (SK.NTH.CONTROL.POINT 293970 . 294431) ( +SK.GET.SELECTED.ELEMENT.STRUCTURE 294433 . 295084) (SK.CORRESPONDING.CONTROL.PT 295086 . 295624) ( +SK.CONTROL.POINT.NUMBER 295626 . 296097) (SK.DO.ALIGN.SETVALUE 296099 . 299656)) (299722 313949 ( +SKETCH.CREATE.GROUP 299732 . 300217) (SK.CREATE.GROUP1 300219 . 300768) (SK.UPDATE.GROUP.AFTER.CHANGE +300770 . 301660) (SK.GROUP.ELTS 301662 . 302044) (SK.SEL.AND.GROUP 302046 . 302428) (SK.GROUP.ELEMENTS + 302430 . 304174) (SK.UNGROUP.ELT 304176 . 304561) (SK.SEL.AND.UNGROUP 304563 . 306228) ( +SK.UNGROUP.ELEMENT 306230 . 307298) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 307300 . 308323) ( +SK.LOCAL.REGION.OF.LOCAL.ELEMENTS 308325 . 309437) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 309439 . +310868) (SK.UNIONREGIONS 310870 . 313228) (SKETCH.REGION.OF.SKETCH 313230 . 313642) (SK.FLASHREGION +313644 . 313947)) (313950 327728 (INIT.GROUP.ELEMENT 313960 . 314828) (GROUP.DRAWFN 314830 . 315276) ( +GROUP.EXPANDFN 315278 . 316951) (GROUP.INSIDEFN 316953 . 317463) (GROUP.REGIONFN 317465 . 317856) ( +GROUP.GLOBALREGIONFN 317858 . 318277) (GROUP.TRANSLATEFN 318279 . 320294) (GROUP.TRANSFORMFN 320296 . +323798) (GROUP.READCHANGEFN 323800 . 327726)) (327729 328737 (REGION.CENTER 327739 . 328340) ( +REMOVE.LAST 328342 . 328735)) (328790 334311 (SK.MOVE.GROUP.CONTROL.PT 328800 . 329192) ( +SK.SEL.AND.MOVE.CONTROL.PT 329194 . 330699) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT 330701 . 332885) ( +SK.READ.NEW.GROUP.CONTROL.PT 332887 . 334309)) (334570 339213 (SK.DO.GROUP 334580 . 336071) ( +SK.CHECK.WHENGROUPEDFN 336073 . 336779) (SK.DO.UNGROUP 336781 . 337982) (SK.CHECK.WHENUNGROUPEDFN +337984 . 338567) (SK.GROUP.UNDO 338569 . 338888) (SK.UNGROUP.UNDO 338890 . 339211)) (339454 344546 ( +SK.FREEZE.ELTS 339464 . 339849) (SK.SEL.AND.FREEZE 339851 . 340237) (SK.FREEZE.ELEMENTS 340239 . +340786) (SK.UNFREEZE.ELT 340788 . 341178) (SK.SEL.AND.UNFREEZE 341180 . 342712) (SK.UNFREEZE.ELEMENTS +342714 . 343269) (SK.FREEZE.UNDO 343271 . 343512) (SK.UNFREEZE.UNDO 343514 . 343757) (SK.DO.FREEZE +343759 . 344148) (SK.DO.UNFREEZE 344150 . 344544)) (344776 354859 (SKETCH.ELEMENTS.OF.SKETCH 344786 . +345599) (SKETCH.LIST.OF.ELEMENTS 345601 . 346300) (SKETCH.ADD.ELEMENT 346302 . 347360) ( +SKETCH.DELETE.ELEMENT 347362 . 349074) (DELFROMGROUPELT 349076 . 349977) (SKETCH.ELEMENT.TYPE 349979 + . 350324) (SKETCH.ELEMENT.CHANGED 350326 . 351876) (SK.ELEMENT.CHANGED1 351878 . 352630) ( +SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 352632 . 354857)) (354913 360118 (INSURE.SKETCH 354923 . 357848) + (LOCALSPECS.FROM.VIEWER 357850 . 358206) (SK.LOCAL.ELT.FROM.GLOBALPART 358208 . 358660) ( +SKETCH.FROM.VIEWER 358662 . 358896) (INSPECT.SKETCH 358898 . 359324) (ELT.INSIDE.SKETCHWP 359326 . +359700) (SK.INSIDE.REGION 359702 . 360116)) (360119 364368 (MAPSKETCHSPECS 360129 . 360734) ( +MAPCOLLECTSKETCHSPECS 360736 . 361469) (MAPSKETCHSPECSUNTIL 361471 . 362263) (MAPGLOBALSKETCHSPECS +362265 . 362950) (MAPGLOBALSKETCHELEMENTS 362952 . 364366)) (364430 391257 (SK.ADD.SELECTION 364440 . +365163) (SK.COPY.INSERTFN 365165 . 368588) (SCREENELEMENTP 368590 . 369048) (SK.ITEM.REGION 369050 . +369704) (SK.ELEMENT.GLOBAL.REGION 369706 . 370386) (SK.LOCAL.ITEMS.IN.REGION 370388 . 372337) ( +SK.REGIONFN 372339 . 372645) (SK.GLOBAL.REGIONFN 372647 . 372989) (SK.REMOVE.SELECTION 372991 . 373702 +) (SK.SELECT.MULTIPLE.ITEMS 373704 . 384678) (SKETCH.GET.ELEMENTS 384680 . 386204) (SK.PUT.MARKS.UP +386206 . 386646) (SK.TAKE.MARKS.DOWN 386648 . 387088) (SK.TRANSLATE.GLOBALPART 387090 . 389347) ( +SK.TRANSLATE.ITEM 389349 . 390260) (SK.TRANSLATEFN 390262 . 390454) (TRANSLATE.SKETCH 390456 . 391255) +) (391523 394700 (SK.INPUT.SCALE 391533 . 392456) (SK.UPDATE.SKETCHCONTEXT 392458 . 393156) ( +SK.SET.INPUT.SCALE 393158 . 393803) (SK.SET.INPUT.SCALE.CURRENT 393805 . 394197) ( +SK.SET.INPUT.SCALE.VALUE 394199 . 394698)) (394751 396742 (SK.SET.FEEDBACK.MODE 394761 . 396055) ( +SK.SET.FEEDBACK.POINT 396057 . 396225) (SK.SET.FEEDBACK.VERBOSE 396227 . 396487) ( +SK.SET.FEEDBACK.ALWAYS 396489 . 396740)) (396893 398834 (SKETCH.TITLE 396903 . 397267) ( +SK.SHRINK.ICONCREATE 397269 . 398832)) (404524 407501 (READBRUSHSHAPE 404534 . 404995) (READ.FUNCTION +404997 . 405508) (READBRUSHSIZE 405510 . 405964) (READANGLE 405966 . 406454) (READARCDIRECTION 406456 + . 407499)) (407502 418694 (SK.CHANGE.DASHING 407512 . 411993) (READ.AND.SAVE.NEW.DASHING 411995 . +413921) (READ.NEW.DASHING 413923 . 415665) (READ.DASHING.CHANGE 415667 . 417133) (SK.CACHE.DASHING +417135 . 418238) (SK.DASHING.LABEL 418240 . 418692)) (418695 422750 (READ.FILLING.CHANGE 418705 . +420682) (SK.CACHE.FILLING 420684 . 421503) (READ.AND.SAVE.NEW.FILLING 421505 . 422255) ( +SK.FILLING.LABEL 422257 . 422748)) (423134 459191 (SK.GETGLOBALPOSITION 423144 . 423550) ( +SKETCH.TRACK.ELEMENTS 423552 . 427053) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS 427055 . 427598) ( +MAP.SKETCH.ELEMENTS.INTO.VIEWER 427600 . 427988) (MAP.GLOBAL.POSITION.INTO.VIEWER 427990 . 428366) ( +SKETCH.TO.VIEWER.POSITION 428368 . 428711) (SKETCH.TRACK.IMAGE 428713 . 429550) (SK.TRACK.IMAGE1 +429552 . 431051) (MAP.VIEWER.XY.INTO.GLOBAL 431053 . 432018) (SK.SET.POSITION 432020 . 432457) ( +MAP.VIEWER.PT.INTO.GLOBAL 432459 . 433541) (VIEWER.TO.SKETCH.POSITION 433543 . 434162) ( +SK.INSURE.SCALE 434164 . 434420) (SKETCH.TO.VIEWER.REGION 434422 . 435212) (VIEWER.TO.SKETCH.REGION +435214 . 435536) (SK.READ.POINT.WITH.FEEDBACK 435538 . 446164) (SKETCH.GET.POSITION 446166 . 448028) ( +\CLOBBER.POSITION 448030 . 448462) (NEAREST.HOT.SPOT 448464 . 449992) (GETWREGION 449994 . 450694) ( +GET.BITMAP.POSITION 450696 . 451449) (SK.TRACK.BITMAP1 451451 . 459189)) (459760 491951 ( +SK.BRING.UP.POSITION.PAD 459770 . 465795) (SK.PAD.READER.POSITION 465797 . 467426) ( +SK.POSITION.READER.REPAINTFN 467428 . 469415) (SK.POSITION.PAD.FROM.VIEWER 469417 . 470967) ( +SK.INIT.POSITION.NUMBER.PAD.MENU 470969 . 471315) (SK.READ.POSITION.PAD.HANDLER 471317 . 477080) ( +DISPLAY.POSITION.READER.TOTAL 477082 . 479469) (POSITION.PAD.READER.HANDLER 479471 . 487925) ( +POSITIONPAD.HELDFN 487927 . 489410) (\POSITION.PAD.ADD.DIGIT.MENU 489412 . 491092) ( +\POSITION.READER.NUMBERPAD 491094 . 491949)) (493577 496432 (SK.DRAWFN 493587 . 493949) ( +SK.TRANSFORMFN 493951 . 494328) (SK.EXPANDFN 494330 . 494607) (SK.INPUT 494609 . 494986) (SK.INSIDEFN +494988 . 495836) (SK.UPDATEFN 495838 . 496430)) (501597 503753 (UPDATE-SKETCH 501607 . 502720) ( +EDIT-SKETCH 502722 . 503751)) (504354 508314 (SK.CHECK.SKETCH.VERSION 504364 . 505476) ( +SK.INSURE.RECORD.LENGTH 505478 . 506922) (SK.INSURE.HAS.LENGTH 506924 . 507681) (SK.RECORD.LENGTH +507683 . 507853) (SK.SET.RECORD.LENGTHS 507855 . 508312)) (508777 509719 ( +SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER 508787 . 509717))))) STOP diff --git a/library/sketch/SKETCH.LCOM b/library/sketch/SKETCH.LCOM index 0b292838d992fb2fb03b3b32a91378abb85f2888..15cf7aa25e3bdbd4e979ccf59bb6af9c4f0fcd1c 100644 GIT binary patch delta 18538 zcmcJ1d0`U0PO_G7hyqK8~f=d8dg6xY+T{ei1 zl#45ibw?x_ajGamX|>jB-RfFJv6i+L4eqrHzt6qz&Agc;-&%j)e)Gq?clUGeJ@?#m zKIgn_J2|NH)Szv(Ho2%)X=d zfv87ZZ1n;gLEd;IktZ(V(Ge2RK`u8iSs z&2^lG$IJ5csO|MWwkd+3Zj zu`F!cI4N7Ln6V9cFU`o&R`MS+_K?0d<5MtHLuJ#fGIf5HtRAXdgNmlA(b}4}R9#V& zQfjfvimygCyFeD_{_6Tlf1RgBBdDk92Xx2xlbiYs5D!t(Q z7Rl!tbRPP;;RKR@@td^LeC2mYeyBJ^GCZ_!I)iD!0^o{52k*2U4xp zuhkoV?vhy7>c(>$Vu|o;=UzYqXAh*LWcA7OGu0Q*9~f>rKZPcrk%Yfzle%P|{^nb# zy-4l(`S}ND9vC{SJ%8?__0pWq(@EjWFPKe}t!5l(!6(7iMvrVYac<_@Es_>@LNfef z+urdpGFbWqDI?6T8Akd^e&FX$vC+IBQ~l=WpJ6*b{zb92teMx|i{um67NvnR%={P& z5zW`|qiZ`*bk%i@TFsZPdjxD}Hp?yEV0~GG;`auXCT&S>zy8q?DWy(1;4LrL3nn-F zTfBaay~As^-p<)_SjR6k9=M}p8&99DR%l(XQ=dZ8aid#H7TuJizHrkS>b4uNj?GFf zy6Ld`vrN01v3&>X?%l4R%)=9;yzsH@5Ay!D?YJ7hIX8RpJOAc+=*(=r;pS{@%%eA_ z@;V>iGEGaLeQOue;bXUD(;58iG&ZZ|TQkDxcg%;}3a{HWltevt@NOzpckg}(Ioka>5$m5e6WeX0p$L9@t8h8S0U?j}4(&%Zb40;tmFEhyv-kKVpNAdewYkhUd zGP`BJ(!yU{Y+eUtg`9GeC)nKNpIynj1~cou1$fFXHz>0`H4V+x^?Gxg453!n$_s^b z5pNdR?`aWlX8tyZmzqRH{_5sZh`+exdLvxrH{WlWR2$=lp3D2 z%hgI_t4Mfd6ZYRlGrh~t z{P4}kmd!l=_(5O&tfxM_sHfwi4a!dw*TNJU6U)8Br%(vhN}bbvW29@Ke&ej$(uTpZu#NO`Wq?q?|1Bg z^#>1=z$OoWAE}}KIpsiqwEka^${8{Jv+VSW{D!Wv38e4zZx<}Le}wkP6pvr{`IM5i zMB9Y!3S~kHx=3nE6WlE3yF=>-Woe?UyJ8iuB7Pcf_unKsx=#H5l>F-4y9+LybWu;( zrA!)_d|=`{UKb~5Sx;MO_gOsA-QXAfbd3k+;7=s>pDPCJdO2G7Y;?Hxw0XQ1x@apy zw>3)Hz~miDnfk`v@)EsrIJ3R2xI3=5PI_1)x-GX`f64AvN<>He*k&l%ZJFIlZd(Cz zFY4*~kx~@CSQ*>3roC-!cXYVr1A5fnCNbym0wqn!R&w*Tl^@$RJ6abM+z1M~ zGL_P<&?u3+P%LFvUbiwfVWj<9@p1{`DV*J_a8r9*kv6TilKu0QqMgccCA+7qO37Dp zd)j;UJC#f&`^`2>_eF~3%bfp%f^&Z?@S`5VE1fh7ubu=_*{>R@9XX z!ZT3?#4D*FXQ-G@Hx_p|U)=oe&hL)#Whqq36NnW{7u{cdgSwUChwHVqd{&dmUF8j3 z6a71s;tIYnO-X4DU4=^N9Y`+~8z2Tt(~FbR{12zZ-tnT8##KrxH9M>haT|F30jOcP zqO4}Mn6wcFF+@$+Jnn)YdChTZK>Xk~ZXc&lc+ldHo}CT4r0Z34LH z99B6P>s7lhyiA+%OWbTFk79t24|J^t!%Yhc|m1OO&RWF zPqnzz%~qSBzi)L5ChYZ>>4q+>kQuVs;>xe>bB?PHm}0M`H`z?aL`)iK!OB@4v95tKCd$WhR-PTxTx68o? zOLjZ0yll1`1J!vn+5$nC)v_D9ckdi97Rs6fu;IW`E+<#r%U~$$!$FyMIZbj<2`Y^( zvdfNjy_K?)U3N2jtc>K43%YXxH#yzCXXJEQ<=I|Oi>Ik9AXFeH_T;=-o>qTlg9lvG z+)(9dk{xbKKbbajKbc^;=#U}7!44>BiK}RL_A`Xt($5e!XFo&Opd9w0(CS8}&S6%E zV9mfVkFTuKUn9<#Y;~Afw@u1TwpyKhCqfoCwzBs`Emn8mOtY(>0nJvhbnoUaTi-lu zKT`nXsMkMOcs^Itv9vKR)lLHBfYlMlt41z>h<@stT>a$Y1i^~T^q6t1`?fLL`^|+` z-nXuav+lkOCk{s(QTzbe?M8JRFjIfc-Rxu;WvNd+m>shAGgCKodrfl6Zj&Zo@dA4R za#42SwCRN|*cV(C*Cdea0-N!q>;iX*x=yPr`U39av%uzPC(8lI3EhNX%E}HG*etP> zi}hfWPli12Rb&SviO#uLPHbg|!6*o@V=ohnYz~Lq6sY&s24$NguFDc}%xy3ueR?S- zoY>Ur6sCWOi`+&9XFecXv1&SOqQM<7yJAabae;>uW@7==BxYj)uOt?kU1p7Bv$OZO zW~(Vmve{ynLx~L`c65rJ;P1rY9NGd|;^xVx3FBCHxy`Vt7cF0O;d&XrD;BL>zm5Za z#j*7scHdW*JmU%WK`cweyn=mF}U#i%{qZJhLkQ*DKspr3dvpFv_Fu1Fyitq?VdMHZJ!8_xo*0!5)XA#AY% z;nC!t1tKl6p&3$HACTWyy$W&Pivi6Lory(IqV)R#S5smUP{it7F4lXAK>^#bib+zg zx+XF@BxOV;#F`(>p5f&`yoo!p$$ugt#Nm0RBC+B3oIHN;{u5Lr)DI~2e=ip}b(&NN z{nv1t|354w^l#)Ngn|t>O7DXu+xpXxxf<7}rZ^$J&#yQe(aca(!xm>Enj6g&XQ5B# z|4t~_T$()!UkK(FN;uj!=ulD3#oFiGLqbJ`LLVi{3T;CZ3UD(d9z+WaT_J=lTuEvi+E`bU}%o`;INzRMXL-~82s@1~}d!dT*-713k(@Z*_= zPfz{R6W5`FTXWB7Ltc95ftZ%V=1-RL)tc_bv7B&M_iY@(SDyTh2Gy&%M-+_Qe#EMg zxbuh){;&6Qr2>%-5Bc?(+$EX$G#sO<{prO+Qe<#Z@w)YExwqq-G5H0roTmG;&g(dCM5Q=b3VN|4L#1#LqJInH=?;XJ5wRL0s1;{&Bir&hooMoYa%g z>7<4qdwvxs+HPkRgD6+R_;r6+46^q9VarhN<${m7QX946#lK;pxr|2^pm?KX`b> zV(=@*vcey~^ep9JZ~z0En+pbmc+pn;#aH%nAIMdI)LnC(f82^>GSCjheuzdtT)<>YFECo&PaUqh8NVrZ^aF4jU4}* zg_H?TpRU>m8a>r|H=(yy7%e}4>pmlK*V}VriSU_!k_bL2s1lU`WZ)O{)WO%Ht=q_V zywjgahT^M%VO@*kaLwfOQBpn4O+GM8psxZLOKMM}+u~bW1h~>H>gsp%(xYy?vU;V#1I)>x-tuli zDi<+=R*nP-Ok|`PHk<}xanJ>tO8f{e-dRotEU{=a=pUY@CZ$Q0j}}&A$6r~ zI)V-aW4N7Ki2$&;3sE?Ws%8Si0^>9{V7XvlsT+?LvUC%C#RrbA;{0n8h={%)J?G@A zv)*eLZs&yF#agqCd6caleeW{ZA5Iw%Su8hKz2f~nvHeoV99w22b{xCJNMwJoOh_C} zk*LS{GD~Q0;$y$H>V4@UB>brJEtT-um!W900Jrt`fmSHqN2?%wNt2 zheI~0Q;!ePnBIImJG|g{D&g3HkD`ZJz3Q(kQ1jIBoUrt_?Obf!{Lxsg!I6*l$vF5f ztzT?ue@^0#f7}djGo*tUoL7RJc8xBB|Yb`YZ( z^jePZ)9%!R`TPhy97yj;P2ZoVW`DMe+SSNsrM*2|K*qTjph##SN)h+b*X4AqqTgzt)v@138h3Cs}x6lhJfZh zy*sdUx0$*Xi`IcfbT9!OOgP?F*4;L#TPaga$|TW22wumFdiHdlzHlj=7oDe$Bw;iA z(^~*;^igKGEfbGMa_pfm3T@%{e{Yq=0)&bq$ZF@8naLKDNuBq_$UL*NUliNnP!D}x zKo0ifLdwnp)-Bh1=QM$hqAx%N=I^2GOdM|XS?jF>GA_ayfS{`BfsAC>9_oW%=1NXG zA7>aKm_{Yw<*0QdP(Yp+(x6riRso0(v18+~FM862I=F!2;X-e*LJvvQOsv3sbhX8b z`zEo_!cj0?r$M)gg=WFflQ~D5fqX>?lkFD$xIl(+wF0aujtjsZ7YhxdQR=y0=8#Pt z{GA(@>4RVH=9iiBwSL{t|DuR(JBJ3U_kC@R2?h1fU*C%J01|qIdxX`09^uEj<=Yi- z|H~GeTN~k{Z}X9R#&^@t6fr%@Z1wzuL2*_zEkZr~-GcaJ^(h`N^Z6+~N@e8f+mL+x zbgnqRZ1owG9scs->h01G{hzRGHkEW9CckvTG~_EH|a@e#HG?b;@OZn{N z2r}4(eLRBlBAx=enD5xZLa}3S74jY9Mfs6}BD(VoBo3F*^>`>_#J2r>4Ef^b`0iNp zqcEmuFyh88iV|m)s@nLjN}Q0h^uJVw376b!_s%$$%WrR*mYXiKQKu>7IYwz_u* z|GBi~!j_pPQbA$%Qhp6+lwl@uba$TmhBc0-OzG60+1Bxt-O{`Gi8$S@P3wWXh>e+7 z%oOiRCd^gt?}1G0?T~W1txTRwxyeqalRfz*Wsyry+blet8G+9|ih zW1Y@{@fzoPXq9c;wA8&nHh4!9{b<~*jgI^^nlcC`))&`ex3cReQx3Sgm;2KK{WeB>E25zsMiOolcpv%hNM<{G{}eXE z3{x>WZ8%H&rHcDD``KyWcF~r&t>ebzwtI9_=g6?gqw8Vsy&Se8!9xj7MnHGEkI~{5 zE=I{>G#0pqy_cdT(_%(O!%bEf=oPIOf0skjnes(xm^qbL+8#uAhW@n>5qKxG> z=pHdrqn)$ayB5-7LD^s{ooh(GjuOgYTdZ`yku|b}a+zYIpBq{4+h`X$ z-()9U3*LEkE_>Qe4%|UpTi_lc?Y`webdU=aGPo0ekI zFyLPLB$FMULPK#K18UW8As`4r9_XC9A)AHEDVSK5-&nD#h~h)gHg2qnDb$`=Z+Lt? zxVU+(qf=;EVl9~CMsHOLLLD0T&>J@9vpc5#+o5?x1iw>JHeOii>r3 zHPnK?PNQ;TF_4wZs-~0Sn2KzgPH6+N%4#)Def2D>#zzRn^WEUBc9uK9&G1gqC zRKSYrXtUArZC-TzWE};JtQV^&D`Kvv$M`M%53e|a==@{@Wir>yc=r1HOj^%X7aVXN z_N%c?-*UX|D;={K^Ioq(3pzW~@J}T4*-tD7{pytHGD3QDdT14m-uEe-ruk-85 zM$V9CzmXqFRcHXgio-$G^ZA{xS76H)(P-vtq*RQ$TY*lqvXMT_$ABiIwkukj$FBE; zM{_kdVyuSJM2BN3lxMONE-5WCB|t+37$ihlvmdIzCav{TGCxQs&eXpnU_;$d3s*Li z0rId{n`yIVN^2q4hzgC1y=JRtQzxRy;TB~Z=28}$(n2s@S;`#jbqcGSL)XM;io7w0 z2F7jjhpiNh6|%~?X@bA5Q&7u^Ghg*nD+5(W4Tnw&Ra-l zMZE1W2v9U@DVgxNaw%z1+L6doh$aXUtZZFVWow|mvPQG`*>@KazDi(^FVpAE-d;wh zQ4^|0ubNLT$C(+pf__{KB4Z$g7S66SVJx7X-L-<|8>^7IGCpMlS$(i96(MwHHfy;zv|s%wongDJNpOoaRRR z+Dnly%ebtN5%br^Z-Dw@SvGj#)Gyi&tv{tP$Ug8>`W7f9P{F7Ge&T1M;DetLKD043 zn#l9l(B*u6>aV3+wX5LxwecsT@j6<-?O&7O(O|ec^4Oc#Q40zHfW%xK>U%ADtmS(8 zGTm4)U3F%=b0rhIek(XX-eNqomEg;WGa)-}#@%+7g+?;@8XC-&Z=E34_C&xFMCd8=o&RCj%a6^Dl1IRtiB2JEivI6`R!s;Af#Qylo$#~iKb zZkyh%RA?Pkhz?xnz;(QBYIj?Cw=z|ku9U|*V2ig?K|$J50Fzb1PR2CjY{|}3UkGco z=G4)4REaY^7YyjP`mYkI0O{&)Uq$P)0i?VL{2}33IdLx&o=9^s~QAnaXCd? zXfpf)?BryasTOr(OD=2;b<~X+W*!O}Zy3c}Q3yr@tZ3-?JlfNxcHEy4GMiz3Mr|TM zZgJW^8ku4K#0&!-!PZ|)pxK0ws6NK2JKomf5mJVE<%R~MCqn^GD_|TLJGyo12Ktd` zf4Xs8I6pRd<}`YnJT)^A{}wZ{jeuJoP1WQPK2{gBuYmaEQCI$X7-&CHvMz@`19MLZ z#dX=WMQ(K=xHSqtqCHIQ*bHFxV}w`|_9Cv?=meZ_za&n;3H0eaAi>qMOdKB&dzj-u z#2ofLF=*IfWovd&Mz#YB+KVoSNsB{Hx5IEX=(4-4>d}_`VRjyC5;gF_9z4D|*`~K~ z^B@(Yjg>D?@1d;#l6wtlwTVE`WUC2=U`@s-3!>6ulZKg|xTzKxsC-l~<@~y=R34Tb zV=K3qRIgpEO!1f!)yY+ zqTBI!?-N^Ng6xmR>zIIJCz|qZwgHi+0GaqB*~u5~Hp;AXb0i;MSONEs%`$4>I}qvF zH?zOMRy&hF0^DE~;jI~x)h6JFTr191pAIZ;7oW~Vi*X8wx7<4Kq**97K-9ut(qE7<;4acWU1SsPqKBaUMimqePKgg;*+1^0 ziR|qPSTv@)$?zSs_wS|-T^+de9$E=K=dFuJFz94)+G6v)w2K>S{A&iT)Wmw_isi`% za0$!z5ioxC#C_BX{VV5wKnCi5=L8mb0Kz&&z21?{LJyDyIuM+GabU&a2dLK2fl~L9 zS5&F=wLr<&l%K_WX_`^xoGPf1-FvZk7_NCAE#aSNf+dTKxu=AG=E{D*k2a&Q@ga_8 zu%A3c)gbA&55bz$H4SjTTs(a`|D2p1-%p$L>96dhMl|T|q^VlY_AV+$#^^4(1rH4! zVV`ypz7=JE33GKklJYQJIsng2zoG_C(Tk7Ld?YQ8VeG-&#J1yOMno%%Z zbCB9mckttI0;I6DkJBVPc0Nug@#uJhCgAb-6ZA_w<{uJD|CU2^Hd2k%nESH`n&2Zn z*G+ABOgv1N<8k+4s=(v;VR{;meNR%Wrk)Lcij2=iBR4-qaIvJYV@J3d$7cSTUcsa2 zH{`;j|lcwd~iQr;yS9f*0ZpYWB$s@nx6%fwmYmU-C#9k?a>~BDYZOCe3vW z{(_H73k;65yhMd@=6J>XnEdva=`*8`j#p@gks4VGJPj4{*^pOhzmfmzS1D|yLVu)n zM(UeC(hV_#=!#mL#l5eQ5xT+Bm(qyH_}A%?Gr&Xdy#t4dHf!V;MEpm=3%MdP1YZ<4 zc>?$-*7%&5?XQJ-bo+bsC#=`y?~@kH!uGvSMsxuib&URGP&4oYddWy_K-fv-(+_}2 zV1=-`!nw{@2&Z0zPDh4*NVfpFV)y=?9?nQfh5%aJ_;I`vIpY(`kcQYCMkdQXNk1FvfFn1?QtbAVG(}1&WhYM3rR>sA zscjMtQx*Sr0X+1+#?!G&s&V(x#@dgSi=7v%}W!&i^)|N1YQ0oid= zsq_j*D$O`Ur2&AMa%Gi*kNMGd&A+HHGMS_!yvvi4lnDR<^$?$BDwgpv6@S2(DK6tj z3zdr^(~>1Kue@r2RITmN&$Fb0$jbwyUvZxL#bD`S8gzuo+)sTZ!fJ;~&BKs1L!&qn zK@g8!eu~|L%&a#4A2^^j;G1heMdAfxq^C;L(2bHRRS-}V3nKHz$Z%UY2&F0lw3Sqx)zToKfz**%#iB%{FY=&+CP6_*Jnz5zIGQRhA0WzK_Kh=qEx-pGu zd>c+@NwpZ$xOEq2OVMi>Acgo?0V+B^DAEkq!8uZ*;W{Nps*Ssp`M)dB81Kd$Y4ucr zMrjwT_(ulO&@a6j{#T4#+`Mwx%2k)Hl(qk^BCr3^>P2O;ECUl3#FG;rsV|h=JkkfQ5Mlqz@LP2jN!jd| zMN)}i*A0zGyw@*N6`ZEOTHqv#zH;ZFR>5LaFdG%j+?l9Vz_*IAS8lFo zxlm5^H)#0!+c56K6vZIl>NJaqh7jsyldHVJhRQ~Kl?aK42yt&yH9q_2`k}|?^EL+X zj!KnH)nIr0i-AUuzq+{zUn22OW<;<{jh=>FYk{@K?M%HuBoQAc9QK$N{Pp5=X|8+O iHaLpA@ZA_TS{lJQd}4`Ih=;dCf=(9sRf+UQ;Qs;BHUppl delta 16567 zcmai534B!5)z5iDK%#+!>;f2DGiBR@7=gccJcWX+yPEs>1ib_s-0l3HiR}2lL+D&OP_sd(S=R zf6v=*XmvUb_h)vGS*TDk0eb=hSXtz9?1LhW9? zzO$?QLba<~Et%6?TdO8EEiW%GQP1yKkNShr)T||C=}Bzr7t_SHQ#exX9?fa7s1?3y ze{jm|Hg)Z)6>3^VRgJfPuCHlIFrb=Syp2t&Y*-bjYbsOCbLx3Uxxc=uwz=9@&Sjw= z9#yz1TC2RFIjE*ZM?I&uxv8ey*XnNy`s?SGsTB>4z7~I=xoJu@gr}C+EK}-NUlNs_ zr9!h*I9w&_l?&>8)wRC1tER8)TC%od?d4G+8nV>FJ#?*!&eI*KlS4^;cr6x-rdCwD z)6BK1*{U`)2CC)+8tYU|yw-c`e5ysfmZ@{_hAH$1=hT9?l#wZvVwz1Crr@uCZ)(@l zl#G;me{GuCsV)-Lw6ZjF*(pN{iLuEp8&qqYqS}Byr5r#XDT`Vk2>PnLjnz%E!-q}i zNpvTE(s;+>Z8(41J8Ut3WR6mdJmYO|xBsD<9rN~HxH`mZ`M0j-k6(!2n%=^sw8#|H zW%<0`(f;iNwvm{G`l+27eq+|ym#$pB zZdr-GAocvzbgZOweSc~JrH9{74bfTYX17ZX`h&H;vUIa*bz+xe|Eud)t9%2kUtOW9 z*u>$`uvKZ%#>XMTzHLB$_LDGymrmQe!rJFr=wFz3uS6}1v&#eiTrRxW? zRdn~4Z0Bis6pxu{8j{ZIFI7Jv(3n-yCer#nB`c8}URoxT&eFPQk2jP~LBUg{mu1Ml zRI5kToaGjfo;mLP!dRwVWU3HLQ?0++2ez3yMac=jIc}|j_SF-f!tW0g?#xJ6ZFbcR zNvPhY`DLK;kolJQFjxa`Q&+a|^mvy3q`iu-{H$l#Zt4o^~KfW^tXH%7p6-8 zhi{@W=HfX$X!zEgNs@1x`)8wUcX5$EwC0~EKVGBC@-hA&ku01ST{&~-9YxYH-y%!9 z=D&iZz1As`;qKZ=rZ~0m_P|jko?^F7RSLsBjSrFu`+|8Nq%6HFI6;!RJyzJ6c}=XCjPQ)Kzwx805XfGMl<)i*;y|7?hfzXjVGe5F4VY_SeaDG0C9 zcS8tf&F0n{w&m#dt*eIdkwV++GtaF8#lLM`jNiI#a*u|WZyO;5#AZldf6aQ44zId1 zmt@9;C2#{;a@?VnadwvX|3AbszZsQTnd|R8D~a~~^R@{)tfxpmvc==( zd3#OQ?lBD&iT0Ad%0P)QxfV%d4rM9ZB$>X-(ppi}S1If)@#DXD-d53cqxju0PrvG+ z(M!f*Ufh9ksiu9CqSNsCivD)B?=(zaN}qq8Ak%BE6m3MJXQAk?_pMmr!AjX#XGV-d z`&pn`9XKo1bVuMU{l|yYP_%A1yR*HpFM-$|dQ7t1p3xV58POLQEeQ4BwudqTBc2ar zv}Yr4d4KQaf!y%Lfw8@7I@`zg#X4I#q+joBSMLv~z1CRXivE~Hd-BhxObX=%$}6Kh zoSuTeEXB0%>pdxt%06YK{D9@uI-TvK_nZjF=(d|Nu+;%GADCH)A>2_L7!k-Q6ryP# z+uIVW3bt+sTfN!ft2j&Kp1*P!gxg!t7Z{6%yuE4hcf15tUTI8zMXPRnr6|xkK~Tl zEW-GcYSz~RwuE`6Y8IE9ZJeqUnLI8#YUUJroZKWRKc%L}u2V3p!h>E1D|W*J@YhE@ z7H(wDQr#}Mx@gWqA6y#MZPz&UBDc*scyrC8Z+SFdaa(vVMQ*s^gZ1Ka+jzBN7X)4F zZ3>FBqg8c!97eJYK8KT?ovLJ+oK6orY*h-%Rj1Pe_L^XiH>gg#ZGhmMHbVaX)7v7$aYUJz4g_w zp;~;fxnMWVFK=SYra}0c!zM(df4qy^$DXJmoApHQB&%jjSM22XV9MiD8q0J$^fkM) zCc9jNl(`&(Wop7)b~-VcE4!hfE z8{^Mm9V`=urBnf`!(tVC9MBRBAuc1k%^fSW!<^zeL3X0r;R*3%2yfELQEdPj7IB8> z``YB%vBAC{kON^R=UCxN56E$1`jhBb?U>x;9N2Us=Ztt~n#aQ4JVsd|tnG#X7ACY7 zq#)%Qb+@4Wu*;JuL8lDJaS!a?Ik0yCBgsTyRK_zV@ofV;7|t5E>X)rtwsgIU-&M=H z*RSIkK?zEP-vd+M*As;KdRLEEn6G-}zFhrZJ?^;u9d_)w-GmCS?A>?TiWfHFeKF%}FoWs8+Do1Nd(Wxt?BCZCv(^#~thgDeM&zKj zSZ9Am<=zv65&km9b0XolVl{=q*t>su&+{C{gHMM=7MHNlOIpZ-6D4^nG4lg*PMIk! zajGOCtor0u*p0~#lHB)zHqsF~Vpa0>7oI5%rF;;ZD;67f!d!(X$86#R z(Hr)6f`svQnfC}tf z&fNA@l&4?%e4mbLiBf7=RwyXTFge*;p6?I46H$9?Qv%F#b~d3gBrLl1Cgf7ctoi#q!kzqOjb zIUMZB2+CK$g7WqS=)UXiU#4?F3GlF2(l}v<>_)xw7A66Tn&+$XA*FWwogEM)c741> z_|ZQdqyn%4%`agkYxG4D-2XGm1-v*c{K&hTI3nSGKZ=R1e18*?KfYfq1yK9}hiSqe zM3e7+P#u?rKJLTwjKobJYGBS`z}`T;C3A0l*ltvFeYDO<^nTRGWeRE-O zh)(2bse3=k*1tV6)pk(92_s#T-p&N)(v+D=HDv0YTSNHu;x~Hr((BMW{%ku#xW&?W z>D2W7Y114TpVQF8%WH6nt(AT+=yVHoZEUZ(Cqq?pXN>1U=KvCqZ$~H z38#Ab+}glwkdy-`Ul<7Bt_UW-OmjGfHKZ!pz|I^|R0VmMb$Jzn!!(Hpm&UtGbGTyd z_4hs1E%>^s#>Lx5H%pN4|Yx@a?qxUpq#|ZfUSGxvk5ND%2Dm`*5BirMv07 zPVmL=&tf@4{@r)F1zxyPxwj#+Cry9z-w)7qeeL(=;jyDLRX_CoxEh@Mr!9tIkPPNY zh%VW<>V3WoP|co`^HTtZC%a!(n+lk1;XYP3HB{C58yav8 zEElWlwurtIbb+o$;!d$4(B$WCOM?n_GJa4)HtsdbZOg9-;qG&n7G$GdH)Ll$#n7_C z@l8I|tw30lb2Q-la&iG2#QTNM5?eT6rqOo>pAB&k1O8=aj>Lu2k3Zy*#&#*>!Gf&+ zaXZ)T{Xa#I!^|JX>b?_(<*onn#NAjJIMxT;IE3vdU&K;o-xICk8{P^xRvk&j>=uOz zk^itlGlz)_r9g|WeGBuRTLAKqWgRA3l9ch8iEwGdwhkeAVZ!zgp?i>VZYs%RmSvtn zxlBDo7qahC>2a7N4v$(S3U_dIUX= zN6|>C;LLG%QC7HUB#q<4*_ufeVn;;&m`U9{XLdGC6FKafY}&@}C|5)m3s5W7kp~+N_!nhsB{yv$0WAve=g8S!-Y3P_(kORNL6t^Ohg0U>KTR!fv@X2tGcH7{F#_l@C(3qIm?YXVQS|azrW@$X(QcO@!z~r88ifa;sP9 ziwLGhP1xM6F4~FBebPk}r6xXsDP${MG>&z;>24Ga@z5+;G}lAt82f(4bSRz!9(v5k z+FwTb?B)u($;cWrjUE7z=ckdhp4h$9m3*d5CnvP9BZ{I4&h$;!6^epPUJ$)2kOnO~ zG+jw3L!{Ykf4xr{u59=W+J+t;m_at^uD55<6nJ&GHPyY>6|k|hXcP*yS#%yAP_9Y3 z^OzT7eSH=!G5B>?QWt7Yt)g)_j}Q$I)xx#DIYF+4->anM(Q>Y)MarUn(xo}py3 z&0gZCGN&>su@=y39@o-vRUWg>j#q)_W)PYkz{PJJ?`r>S>K?2sep|s$4qhRjg{r9K z|EeX9qsduk(|Ud? z<7R*dVaSuMXQncS{r+s)V$^GIq?mo3mQeGfMp};ZJJH3CG&j*Q0!?hvgqjC~u|qVE z&1|OA1ezydvX?b$z$h` z;o`H5MRc9?nPjAkniTTFb}gbk;PJe3=}SE3oQD}qXV;xaH^zxZvfC*&Vd{z(Q!rl0 zu3AhkBlVlbG|fnzTujFyN`$@{qKph%f)3HgGfPRjSCMy@(s*vxomfVQgNkgr080nS zb)EDo9<#a#(QT})i@XNq9Z9LbcF~2XBDQJwaymmUmG(rW$W`6ag8z z2Kythh92RlT-;HVVLqb2c$g2%TT3TF0|9*lX#BJm`_j9Pu125x*U=a`j3eu)!x;Fy z^#tEs0M7zHn*&F5A-~@YHnC$01<*9}Vj3%(+AgM*kiScv(->IjlfEi@;$qqk7z{S1 zY%4cS`z0|=mzUmLpHLF{^CdKr3*(=cQYjv}mys2Z(4~~a&by2@Lr;NJQj=|$Q?0>q zFe&xO<+KVxiZJygPdrQoP8b4Mxr-)vftObuC~vN3Ph3uoY~vM_&x3mYp9bv6Sj_ZC zS0q}n&#i%qo_b}%krFv@C7m6OePVf6;WSH+xUZr|_}GqIO~rVaLIfO3to%7GjM01b8bLt4hO!x5OMeHI{%fgFPQ!@n=&QIqA}6k+`Fy#} zyB_SMvwN;5gh{gD8~9q(Gmqx7IUA?~X9VBx+!-=(G*-To#;`pb$iU24)(upTDUMZ^ zlX=k%baA{xcJv17#uni21qagvf)zUi*W8%s_q={1y(ELf*j+af@DkQ{6ZH>|M#MQ? z?7o}0*w}kF)1RaD_TM7vX+9-~eRLx<+lM#N87zGxJrk|)>PGCPbareb{fJcuye1}8 zAXMzoMj^H{H$lxO7!#4WRDH7M+%G#|yE~fa>I+ix*M>%ekEv zpa79v@dABnuz=M%=|(nsD;YQ>+p-lnVWNBTpRHp182-wUdoi0=Z=-v_0zCDPH^n?* zxGn`_W1(DtJd6k~%!7>UVn1i}&3Gsqz!O#T7kK@_puf(C$f;L~C}oJ@$YfrW%kI8| z9y1|Wh1J|i7V&cBoiy825U{ZQcTyn7D&i&XK)8m8x#$a6ly(ancNcwUDh$}!n7ipr z@iOafGLw^a-c372I`bY{_22xTZ|{Ns)7gapo!P?u;W0C!m#F(wH>msL8W7R5WXPb6 zGZNgNB|{KQ(wirH;h`r+FYJzcsnBGNhFauU`GrMuP{v|J0UD3~W>cP`xwh_6a>>EY z-cGp)$*}2rs&YaamO;#d*EpUUH-6gy?N~fU8jgWQ!bpHGjXP-$yb1_NL^Z%Ma2icO z!UE(cPO???BsvT(ry5EuLu^4j*#@^A2vO8&@W6;q_8Rb!1R}NTfN{4r_#1uIvs8}^ zdr4-_?RI15iaT!}2qI&#qh>DRL7ZhG%w#|t++z)JnA{E#meS_Ng|&f*x#8?3FziAH z@g#g6e!U#!--UpaWd2=P-HWPf16A`a2pkdAD|vVb^mj5hP8a~EW+HfF0E-TfhsU;L zI^c&HEIJU%QXVWE=>U}&Gj=P?^ha_`wrC4mQVSbGaSlH~*;%JV(%9@+K-ngn#Udgq zR4cIk_;}l38zjtpEATUY%Okm1m@*1xoE2*+zR=(qpE4%R<>b*qxgmIPQL%AIFj;JT zg~q8Qd$C$_G!7P8j0`sxl44(EY*UiUiLWD~F6UUpI7OL5NJ~=#{+HwGqRLxUgZLDe z@JDT$2ys!Y8V>|wJ9khvFhlGmH`|YQMRT&g9X#;KW)~SD3-{-_u#B(<3wCO9mIsp* z7ii4)bPty40$^}TO&7KVP+x==xdxV|@~{&dk75ZqfhV8R)B%LyluTd?gJc>Xfh736 zHtf$++FLONr?|%^d{)8vP^==T2J1r;5}FKD<`fF91P~!A4|!a5%z?kRVk8ZZJo^ys z;6})KJEQg|duk`$j*Ookjv=iVK1^GaG7fZ5enfkOR`7=RK1wn`n!W#MqFa5-V>BPd z#)0Rqr%Pv1?(jUD^VZrTz(+8duB z?r0u(f{eIzp2}kC6Eu|hpQH`A@BktyMHr{f{lhPxq#hir9tZ1K1T=PU56yr*_Rk); z-IRWty^NLj3ZJUFmug_&;6xB{Gg5YyHSlu6y;N=(IbZjZU)1x~E`VV!>v_X8BVHwP zeV88Q;2{1%4iU3eH?+?27=4S~7Dc z|9pnM5TR?MLhwIL4QO!J(=*(zie%Hc{*GCJDQ5@V}AJ15B&~Tph)ceJ+5)&;%wgdYh(8 zCVSqdkU=x>Hl4{@-l642*30iCRrnMAGF}$>@J}?8_|<5%OALjF@Qc8wh~-@xli((w z`5v5-)$h?a@#bv#`!vf)?RlR*Gg9|{Kw%@*`XL!N?(B~r(rrfBs*lL{B8eS&or)sL z$Mn=tETCsT1LQ8pDe}+y0@iuHxRb|c7>&Lrd=OxKgTczv8v`)RRC^1^-2-D^aTAv>XB_H#hyd%=*TZlLVKXu zWu$ZoiEX`ADP}_zWj!*lR22E03On>Ey4a^Ev!GkpzlJJ*Fy%#>ioGbIYTVhu7=Z!d<^B{}A;QK|0&7=1usTZ0`Ibb}v5~YiMdR#D zKV7Mk6S(F$jgH)Zy7Dw%g{`BMy)gO5r~9#7{ft5SjVA_Sv5A7Y%JubhwUo_ys_JmwWB zx8U*UcM#>b1C>Cn-N%H2$e5F-$u9BH_Q7_jInM=R&p zxIpoV;x2XRGPR0xhYxyf>RzlF2h`paeBfN&dSOPXP~qTnYfiHclzw;%ynP%#qm-j8~3ulmI~*;yZZB@0PQaN_@cQ z0FbK4Pb69Y)k@Atac_tTP-zp_66{FW7BvhD1HhR=J7JzuGzRL=Bu9@ ztWj+|UOD;-=P~+fMaWF-)u_NfQHbX9&ktg+IMQOT*gvsXZof;q+>zpMMKvlnbY*6o z6vl-}a+Xo1virtualkeyboards>KEYBOARDCONFIGS.;5 59521 +(FILECREATED "19-Feb-2026 22:32:05" {WMEDLEY}virtualkeyboards>KEYBOARDCONFIGS.;6 59604 :EDIT-BY rmk - :PREVIOUS-DATE "13-Oct-2025 12:03:23" {WMEDLEY}virtualkeyboards>KEYBOARDCONFIGS.;4) + :PREVIOUS-DATE "13-Oct-2025 13:44:47" {WMEDLEY}virtualkeyboards>KEYBOARDCONFIGS.;5) (PRETTYCOMPRINT KEYBOARDCONFIGSCOMS) @@ -57,11 +57,11 @@ (F3 (F3 ITALIC)) (F4 (F4 UCASE)) (F5 (F5 STRIKE)) - (F6 (F6 "")) + (F6 (F6 "^")) (F7 (F7 SUBSCR)) (F8 (F8 SMALL)) (F9 (F9 MARGIN)) - (F10 (F10 "")) + (F10 (F10 "_")) (F11 (F11 "")) (F12 (F12 "")) (LOCK ("CAPS" "LOCK")) @@ -115,7 +115,7 @@ (THREE (|3| %# NLS)) (FOUR (|4| $ NLS)) (FIVE (|5| %% NLS)) - (SIX (|6| ^ NLS)) + (SIX (|6| ↑ NLS)) (SEVEN (|7| & NLS)) (EIGHT (|8| * NLS)) (NINE (|9| %( NLS)))) @@ -234,7 +234,7 @@ NIL ((%" (%' %" NLS)) (+ (= + NLS)) - (- (- _ NLS)) + (- (- ← NLS)) (%: (; %: NLS)) (< (%, < NLS)) (> (%. > NLS)) @@ -255,13 +255,13 @@ (NUMERIC/ (/ /)) (NUMERIC0 (INS |0| NLS)) (NUMERIC1 (END |1| NLS)) - (NUMERIC2 ( |2| NLS)) + (NUMERIC2 (↓ |2| NLS)) (NUMERIC3 (PGDN |3| NLS)) - (NUMERIC4 ( |4| NLS)) + (NUMERIC4 (_ |4| NLS)) (NUMERIC5 (|5| |5|)) - (NUMERIC6 ( |6| NLS)) + (NUMERIC6 (→ |6| NLS)) (NUMERIC7 (HOME |7| NLS)) - (NUMERIC8 ( |8| NLS)) + (NUMERIC8 (^ |8| NLS)) (NUMERIC9 (PGUP |9| NLS)) (NUMERIC= (= =)) (RETURN (CR CR)) @@ -274,17 +274,17 @@ (F3 (ITALIC NOTITALIC NLS)) (F4 (UCASE LCASE NLS)) (F5 (STRIKEOUT NOTSTRIKEOUT NLS)) - (F6 ("" "" NLS)) + (F6 ("^" "^" NLS)) (F7 (SUBSCRIPT SUPERSCRIPT NLS)) (F8 (SMALLER LARGER NLS)) (F9 (MARGINS NOTMARGINS NLS)) - (F10 ("" "" NLS)) + (F10 ("_" "_" NLS)) (F11 (F11 NOTF11 NLS)) (F12 (F12 NOTF12 NLS))) ((%` 45 B) (~ 45 T) (|6| 2 B) - (^ 2 T) + (↑ 2 T) (%% 0 T) (|5| 0 B) ($ 1 T) @@ -523,7 +523,7 @@ (> (346 46 29 33)) (%: (362 82 29 33)) (<-%| (426 82 63 33)) - (^ (450 118 29 33)) + (↑ (450 118 29 33)) (DEL (498 154 29 33)) (R (162 118 29 33)) (T (194 118 29 33)) @@ -556,7 +556,7 @@ (LF (LF LF)) (LOCK LOCKDOWN . LOCKUP) (\ (\ %| NLS)) - (^ (_ ^ NLS)) + (↑ (← ↑ NLS)) ({ (%[ { NLS)) (} (%] } NLS))) ((BLANK-MIDDLE 30) @@ -643,8 +643,8 @@ (%: 43) (CR 44) (<-%| 44) - (_ 45) - (^ 45) + (← 45) + (↑ 45) (r 48) (R 48) (t 49) @@ -744,7 +744,7 @@ NIL ((%" (%' %" NLS)) (+ (= + NLS)) - (- (- _ NLS)) + (- (- ← NLS)) (ESC (ESC %| NLS)) (%: (; %: NLS)) (< (%, < NLS)) @@ -757,7 +757,7 @@ (~ (%` ~ NLS))) ((%` 45) (~ 45) - (^ 2) + (↑ 2) (|6| 2) (w 18) (W 18) @@ -951,7 +951,7 @@ NIL ((%" (%' %" NLS)) (+ (= + NLS)) - (- (- _ NLS)) + (- (- ← NLS)) (%: (; %: NLS)) (< (%, < NLS)) (<-%| (CR CR)) @@ -962,21 +962,21 @@ (KEYBOARD METADOWN . METAUP) (LOCK LOCKDOWN . LOCKUP) (NEXT (2,22 2,62 NLS)) - (NUMERIC* (NUMLK NLS)) + (NUMERIC* (NUMLK × NLS)) (NUMERIC+ (HELP 2,45 NLS)) (NUMERIC, (\ %, NLS)) (NUMERIC- (SCRL - NLS)) (NUMERIC. (%| 21 NLS)) - (NUMERIC/ (BREAK NLS)) + (NUMERIC/ (BREAK ÷ NLS)) (NUMERIC0 (INS |0| NLS)) (NUMERIC1 (END |1| NLS)) - (NUMERIC2 ( |2| NLS)) + (NUMERIC2 (↓ |2| NLS)) (NUMERIC3 (PGDN |3| NLS)) - (NUMERIC4 ( |4| NLS)) + (NUMERIC4 (_ |4| NLS)) (NUMERIC5 (% |5| NLS)) - (NUMERIC6 ( |6| NLS)) + (NUMERIC6 (→ |6| NLS)) (NUMERIC7 (HOME |7| NLS)) - (NUMERIC8 ( |8| NLS)) + (NUMERIC8 (^ |8| NLS)) (NUMERIC9 (PGUP |9| NLS)) (%` (%` ~ NLS)) ({ (%[ { NLS)) @@ -987,7 +987,7 @@ (|4| 1) ($ 1) (|6| 2) - (^ 2) + (↑ 2) (e 3) (E 3) (|7| 4) @@ -1233,7 +1233,7 @@ (%. (%. > NLS)) (/ (/ ? NLS)) (\ (\ %| NLS)) - (- (- _ NLS)) + (- (- ← NLS)) (%` (%` ~ NLS)) (%[ (%[ { NLS)) (%] (%] } NLS)) @@ -1249,13 +1249,13 @@ (NUMERIC/ (/ /)) (NUMERIC0 (INS |0| NLS)) (NUMERIC1 (END |1| NLS)) - (NUMERIC2 ( |2| NLS)) + (NUMERIC2 (↓ |2| NLS)) (NUMERIC3 (PGDN |3| NLS)) - (NUMERIC4 ( |4| NLS)) + (NUMERIC4 (_ |4| NLS)) (NUMERIC5 (|5| |5|)) - (NUMERIC6 ( |6| NLS)) + (NUMERIC6 (→ |6| NLS)) (NUMERIC7 (HOME |7| NLS)) - (NUMERIC8 ( |8| NLS)) + (NUMERIC8 (^ |8| NLS)) (NUMERIC9 (PGUP |9| NLS)) (NUMERICENTER (CR CR)) (RALT METADOWN . METAUP) @@ -1264,11 +1264,11 @@ (F3 (ITALIC NOTITALIC NLS)) (F4 (UCASE LCASE NLS)) (F5 (STRIKEOUT NOTSTRIKEOUT NLS)) - (F6 ("" "" NLS)) + (F6 ("^" "^" NLS)) (F7 (SUBSCRIPT SUPERSCRIPT NLS)) (F8 (SMALLER LARGER NLS)) (F9 (MARGINS NOTMARGINS NLS)) - (F10 ("" "" NLS)) + (F10 ("_" "_" NLS)) (F11 (F11 NOTF11 NLS)) (F12 (F12 NOTF12 NLS))) ((%' 28 B) @@ -1276,7 +1276,7 @@ (%, 27 B) (< 27 T) (- 10 B) - (_ 10 T) + (← 10 T) (> 42 T) (%. 42 B) (/ 12 B) @@ -1286,7 +1286,7 @@ (%# 16 T) ($ 1 T) (%% 0 T) - (^ 4 T) + (↑ 4 T) (* 53 T) (%( 22 T) (%) 8 T) @@ -1494,7 +1494,7 @@ (M (370 42 29 29)) (; (402 42 29 29)) (%: (434 42 29 29)) - (_ (466 42 29 29)) + (← (466 42 29 29)) (RSHIFT (498 42 53 29)) (LINEFEED (554 42 29 29)) (CONTROL (106 74 53 29)) @@ -1559,7 +1559,7 @@ (ONE (|1| + NLS)) (TWO (|2| %" NLS)) (THREE (|3| * NLS)) - (FOUR (|4| NLS)) + (FOUR (|4|  NLS)) (SIX (|6| & NLS)) (SEVEN (|7| / NLS)) (EIGHT (|8| %( NLS)) @@ -1567,7 +1567,7 @@ (%: (%. %: NLS)) (; (%, ; NLS)) (? (%' ? NLS)) - (AUMLAUT ( NLS)) + (AUMLAUT (  NLS)) (CAPSLOCK CTRLDOWN . CTRLUP) (CONTROL LOCKDOWN . LOCKUP) (CR (CR CR)) @@ -1591,10 +1591,10 @@ (NUMERIC8 (|8| |8|)) (NUMERIC9 (|9| |9|)) (NUMERIC= (= =)) - (OUMLAUT ( NLS)) - (UUMLAUT ( NLS)) + (OUMLAUT (  NLS)) + (UUMLAUT (  NLS)) (%[ (%] %[ NLS)) - (_ (- _ NLS)) + (← (- ← NLS)) ({ (< { NLS)) (} (> } NLS))) ((HELP 0) @@ -1658,7 +1658,7 @@ (%. 49) (%: 49) (- 50) - (_ 50) + (← 50) (RSHIFT 51) (LINEFEED 52) (CONTROL 53) diff --git a/library/virtualkeyboards/XKEYBOARDS b/library/virtualkeyboards/XKEYBOARDS index a035c92a932c372a6beeebc0152d977e2635af0a..9998bd96908f18c4df4afd36734f5396c7692bc9 100644 GIT binary patch delta 1653 zcmaKsZ%kEn7{_ZD z6+wv#c(T-V3TcX0P`H*U=;ZuluI;XHYiqp->e`#$xwhW9)$@B$w%+vS?D_nj@1B3Z z=lp&;tSt5_Lv=yOt!rs(s&0qej`q4hq{!zp6tk|rv9_kIwz|D`J8ZBj0(E;{3)rQ0 zIoNh(FgU!o+#56$u*xgSBg5lc)>)xI%j@q*MTib7LuHkA=>{0yUy3=(_pW60G+G%& zxJK1n$-W`73o*CQt=m1|j4>@`8}YZ*9WK>5CprGRzNEU7(c_Sep2GCN#*vKdwY42> zEv>cH&0v}Z8^CmC*g3qq&{GU%Vi26GIG1920t6QzF(?5`T^gSB26XW?h(46stzgb0 z%#TPgwt-m!4zBn4buk9wAS<2)Q+xyB7()%g1rYrV+X*H?e8NymFah^ImVjL)ZlfpC z1BoM)w#ZGcYal*j*FuS5^n}ROODf^#5x8R`ixgBWCZo*)L| zBZdZoD&f7xXX%O5#W~F)6 zM3m24>HG$W6CC0Nf>96$7}^NpAduljf=eI=DZrQ@0J~|IFX2`RIU!;V?~SeY~|OO;NhAYqMYJ z#KFyvJQS4ucqdqZt!p&AUc6VQ;NrT}<4l1UoBd(cnPOZinx@%ZoR4oswD`~dS;gzz z<|x51T2$ekEq~L|7?fFlD{RZToA?Z+wG#9KukY_KeSxhr`w^tUaSFV*+0 zamB&+Y>U1z+j1p)$M9E4@wDK8qB*m$Q$}4yTb_)b;5;FV^ZZp7@;K+0Gs{{qFJ0H1 zTeRXbZf>E0{h=MBF8jCu5V8S=c+B7sH&kE JJgoXd`xmKcPKf{j delta 1761 zcmaKsUrbYX6vzGbw)fH&iy&-EisV>Y`a@dQ+xC`%fx`HsC>CT4oyi8ckUh+pn9PS| zHRHi0%VMH<_G~PexHO`L2n7TrHgK*!^v@USH=%NDZ5WHTB2{m#80*~8w>`JD6n zch2|x9-d{(@3RYS{z{iiWxTDuqqVuawW+7I1$?>@?tJ6za5NG%Ku^>e@!@w8&Zx>j zuZbiR!?&uRgGBhi=@T*|29er2U9XEod@wxpBGWO%zGJtsaAyUU*)-NiR@&xbBhtzZ z+0qKTLgo|4Bb)LGT)XH^q1RcU%)m8d?h3UE_##ZiUlM90ROwz{ zn=6XF(nRiZ4R-6m3x0e=d|NLy)}hJWseD4)V@>8tMoe*!;~ zc?S4j@EA{()R(k%x2Bs#GkL%VJP;J>6C0B3&sFTg7mD&7R68OaMNZ)fjgohUJRv;t zCW=(ddMom{P+(Fp%SNnnYnV-qYU2i(3A!gKII>zx}*oE862H9iGmIYK%&oP+D zWy^lGvm1E6d_)&X(UVrb>ngeitq#pC*@HVSb)q#M|@$B&&JRhuF|j!nA*DsVA=%XlKH=PpG* zWXk8zOY#tN@R_wNs|WEPzlP`H)i@K^l`n+M<@RZtils)a_^Xc^XN3Ts{S>Q4)qi^j zb(&LtgQOGc%w{*2tX4hi=A1<~yD3I|OE<-M{!cfvFejsO>H;AU_u#6~?1C7Kexot> gR`Mgey$>=;97ySysBdOhaiF{cSCa1BSp9YTzdvk~tN;K2 diff --git a/sources/CLISP b/sources/CLISP index e0c640c0..35ec32c1 100644 --- a/sources/CLISP +++ b/sources/CLISP @@ -1,18 +1,11 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "16-May-90 12:27:02" {DSK}local>lde>lispcore>sources>CLISP.;2 45083 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT UTF-8) - changes to%: (VARS CLISPCOMS) +(FILECREATED "19-Feb-2026 12:00:55" {WMEDLEY}CLISP.;2 44501 - previous date%: "26-Nov-86 12:32:58" {DSK}local>lde>lispcore>sources>CLISP.;1) + :EDIT-BY rmk + :PREVIOUS-DATE "16-May-90 12:27:02" {WMEDLEY}CLISP.;1) -(* ; " -Copyright (c) 1982, 1983, 1984, 1985, 1986, 1990 by Venue & Xerox Corporation. All rights reserved. -The following program was created in 1982 but has not been published -within the meaning of the copyright law, is furnished under license, -and may not be used, copied and/or disclosed except in accordance -with the terms of said license. -") (PRETTYCOMPRINT CLISPCOMS) @@ -57,16 +50,16 @@ with the terms of said license. (COMS (* CLISP props) (PROP CLISPTYPE %') [E (SETQQ CLISPCHARS - (^ * / + - = _ %: %' ~ +- ~= < > @ ! )) + (↑ * / + - = ← %: %' ~ +- ~= < > @ ! _ ^)) (CLISPDEC '(STANDARD MIXED] [VARS (CLISPFLG T) - (CLISPCHARS '(^ * / + - = _ %: %' ~ +- ~= < > @ ! ] + (CLISPCHARS '(↑ * / + - = ← %: %' ~ +- ~= < > @ ! _ ^] (INITVARS (CLISPHELPFLG T) (TREATASCLISPFLG) (CLISPINFIXSPLST) (CLISPCHARRAY (MAKEBITTABLE CLISPCHARS)) - [LEFT.ARROWS.BITTABLE (MAKEBITTABLE '(_ ] - (LEFT.ARROW '_) + [LEFT.ARROWS.BITTABLE (MAKEBITTABLE '(← _] + (LEFT.ARROW '←) (CLISPISWORDSPLST) (CLISPLASTSUB (CONS)) (CHECKCARATOMFLG) @@ -74,7 +67,7 @@ with the terms of said license. (CLISPARITHCLASSLST '(INTEGER FIXED MIXED FLOATING)) (DWIMINMACROSFLG NIL)) (IFPROP (CLISPTYPE LISPFN UNARYOP CLISPCLASS CLISPCLASSDEF CLISPNEG CLISPBRACKET) - ^ * / + - = _ %: %' ~ +- ~= < > @ !) + ^ ↑ * / + - = ← _ %: %' ~ +- ~= < > @ !) (VARS DECLWORDS) (IFPROP (CLISPTYPE LISPFN UNARYOP CLISPINFIX CLISPCLASS CLISPCLASSDEF CLISPNEG BROADSCOPE) @@ -160,34 +153,14 @@ with the terms of said license. (RPAQ? RPARKEY 0) -(RPAQ? WTFIXCHCONLST '(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL - NIL NIL)) +(RPAQ? WTFIXCHCONLST '(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL + NIL)) -(RPAQ? WTFIXCHCONLST1 '(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL - NIL NIL)) +(RPAQ? WTFIXCHCONLST1 '(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL + NIL)) (ADDTOVAR EDITMACROS - (FIX9 (X N) - (BIND (E (SETQ %#1 (EDITFPAT 'X)) - T) - (IF (NOT (ATOM (%##))) - (1)) - (COMS (SPLIT89 RPARKEY N)) - (I F RPARKEY T) - (E [SETQ %#2 (ADD1 (LENGTH (CAR L] - T) - !0 MARK (LPQ [IF (OR (NULL %#1) - (NOT (EDIT4E %#1 (%## 1] - UP - (E (SETQ %#3 (LENGTH (CAR L))) - T) - (I RI 1 (MINUS %#2)) - (E (SETQ %#2 %#3) - T) - 1 !0) - __ - (DELETE NX))) - (FIX9 NIL (FIX9)) + (FIX8 NIL (FIX8)) (FIX8 (X N) (BIND (E (SETQ %#1 (EDITFPAT 'X)) T) @@ -206,14 +179,34 @@ with the terms of said license. UP (RO 1) !0))) - (FIX8 NIL (FIX8))) + (FIX9 NIL (FIX9)) + (FIX9 (X N) + (BIND (E (SETQ %#1 (EDITFPAT 'X)) + T) + (IF (NOT (ATOM (%##))) + (1)) + (COMS (SPLIT89 RPARKEY N)) + (I F RPARKEY T) + (E [SETQ %#2 (ADD1 (LENGTH (CAR L] + T) + !0 MARK (LPQ [IF (OR (NULL %#1) + (NOT (EDIT4E %#1 (%## 1] + UP + (E (SETQ %#3 (LENGTH (CAR L))) + T) + (I RI 1 (MINUS %#2)) + (E (SETQ %#2 %#3) + T) + 1 !0) + ←← + (DELETE NX)))) (ADDTOVAR DWIMUSERFORMS ) (ADDTOVAR LAMBDASPLST LAMBDA NLAMBDA) -(ADDTOVAR OKREEVALST AND OR PROGN SAVESETQ CAR CDR ADD1 SUB1 CONS LIST EQ EQUAL PRINT PRIN1 - APPEND NEQ NOT NULL) +(ADDTOVAR OKREEVALST AND OR PROGN SAVESETQ CAR CDR ADD1 SUB1 CONS LIST EQ EQUAL PRINT PRIN1 APPEND + NEQ NOT NULL) (ADDTOVAR NOFIXFNSLST ) @@ -266,6 +259,17 @@ with the terms of said license. (ADDTOVAR DWIMEQUIVLST ) (ADDTOVAR EDITMACROS + (CLISP%: NIL (BIND (E (COND ((SETQ %#1 (AND CLISPARRAY (GETHASH (%##) + CLISPARRAY))) + (SETQQ COM CLISP%:) + (EDITE %#1)) + (T (PRIN1 '"not translated. +" T))) + T))) + (NOCLISP COMS (RESETVAR CLISPTRANFLG NIL . COMS)) + (NOCLISP NIL (NOCLISP TTY%:)) + (!DW NIL (RESETVAR CLISPRETRANFLG T DW)) + (PPT NIL (RESETVAR PRETTYTRANFLG T PP)) (DW NIL (BIND (E (PROGN (SETQ %#1 (%##)) (AND (CDR L) (%## !0 (E (SETQ %#2 L) @@ -280,18 +284,7 @@ with the terms of said license. (IF (LISTP %#3) (1) NIL)) - NIL))) - (PPT NIL (RESETVAR PRETTYTRANFLG T PP)) - (!DW NIL (RESETVAR CLISPRETRANFLG T DW)) - (NOCLISP NIL (NOCLISP TTY%:)) - (NOCLISP COMS (RESETVAR CLISPTRANFLG NIL . COMS)) - (CLISP%: NIL (BIND (E (COND ((SETQ %#1 (AND CLISPARRAY (GETHASH (%##) - CLISPARRAY))) - (SETQQ COM CLISP%:) - (EDITE %#1)) - (T (PRIN1 '"not translated. -" T))) - T)))) + NIL)))) (ADDTOVAR EDITCOMSA PPT DW !DW CLISP%:) @@ -304,7 +297,7 @@ with the terms of said license. (RPAQQ CLISPFLG T) -(RPAQQ CLISPCHARS (^ * / + - = _ %: %' ~ +- ~= < > @ ! )) +(RPAQQ CLISPCHARS (↑ * / + - = ← %: %' ~ +- ~= < > @ ! _ ^)) (RPAQ? CLISPHELPFLG T) @@ -314,9 +307,9 @@ with the terms of said license. (RPAQ? CLISPCHARRAY (MAKEBITTABLE CLISPCHARS)) -(RPAQ? LEFT.ARROWS.BITTABLE (MAKEBITTABLE '(_ ))) +(RPAQ? LEFT.ARROWS.BITTABLE (MAKEBITTABLE '(← _))) -(RPAQ? LEFT.ARROW '_) +(RPAQ? LEFT.ARROW '←) (RPAQ? CLISPISWORDSPLST ) @@ -330,10 +323,10 @@ with the terms of said license. (RPAQ? DWIMINMACROSFLG NIL) -(PUTPROPS  CLISPTYPE 6) - (PUTPROPS ^ CLISPTYPE 6) +(PUTPROPS ↑ CLISPTYPE 6) + (PUTPROPS * CLISPTYPE 4) (PUTPROPS / CLISPTYPE 4) @@ -344,9 +337,9 @@ with the terms of said license. (PUTPROPS = CLISPTYPE -20) -(PUTPROPS _ CLISPTYPE (8 . -12)) +(PUTPROPS ← CLISPTYPE (8 . -12)) -(PUTPROPS  CLISPTYPE (8 . -12)) +(PUTPROPS _ CLISPTYPE (8 . -12)) (PUTPROPS %: CLISPTYPE (14 . 13)) @@ -360,10 +353,10 @@ with the terms of said license. (PUTPROPS > CLISPTYPE BRACKET) -(PUTPROPS  LISPFN EXPT) - (PUTPROPS ^ LISPFN EXPT) +(PUTPROPS ↑ LISPFN EXPT) + (PUTPROPS * LISPFN TIMES) (PUTPROPS / LISPFN QUOTIENT) @@ -374,9 +367,9 @@ with the terms of said license. (PUTPROPS = LISPFN EQ) -(PUTPROPS _ LISPFN SETQ) +(PUTPROPS ← LISPFN SETQ) -(PUTPROPS  LISPFN SETQ) +(PUTPROPS _ LISPFN SETQ) (PUTPROPS %' LISPFN QUOTE) @@ -750,7 +743,7 @@ with the terms of said license. (PUTPROPS OR CLISPINFIX or) -(PUTPROPS SETQ CLISPINFIX _) +(PUTPROPS SETQ CLISPINFIX ←) (PUTPROPS IPLUS CLISPINFIX +) @@ -780,7 +773,7 @@ with the terms of said license. (PUTPROPS GREATERP CLISPINFIX gt) -(PUTPROPS EXPT CLISPINFIX ^) +(PUTPROPS EXPT CLISPINFIX ↑) (PUTPROPS LT CLISPCLASS LT) @@ -931,7 +924,7 @@ with the terms of said license. (PUTPROPS SETA SETFN (ELT)) (DEFOPTIMIZER CLISP%  (X &REST Y) - X) + X) (PUTPROPS AND CLISPWORD T) @@ -1146,83 +1139,82 @@ with the terms of said license. (PUTPROPS while CLISPWORD (FORWORD . while)) (PUTPROPS always I.S.OPR ((COND ((NULL BODY) - (SETQ $$VAL NIL) - (GO $$OUT))) - BIND - (SETQ $$VAL T))) + (SETQ $$VAL NIL) + (GO $$OUT))) + BIND + (SETQ $$VAL T))) (PUTPROPS collect I.S.OPR ((SETQ $$VAL (NCONC1 $$VAL BODY)))) (PUTPROPS count I.S.OPR ((AND BODY (SETQ $$VAL (ADD1 $$VAL))) - BIND - ($$VAL _ 0))) + BIND + ($$VAL ← 0))) (PUTPROPS do I.S.OPR (BODY)) (PUTPROPS fcollect I.S.OPR [(= SUBPAIR '(VAR1 VAR2) - (LIST (GETDUMMYVAR T) - (GETDUMMYVAR T)) - '(PROGN (SETQ VAR1 BODY) - (COND [VAR2 (FRPLACD VAR2 (SETQ VAR2 (LIST VAR1] - (T (SETQ $$VAL (SETQ VAR2 (LIST VAR1]) + (LIST (GETDUMMYVAR T) + (GETDUMMYVAR T)) + '(PROGN (SETQ VAR1 BODY) + (COND [VAR2 (FRPLACD VAR2 (SETQ VAR2 (LIST VAR1] + (T (SETQ $$VAL (SETQ VAR2 (LIST VAR1]) (PUTPROPS inside I.S.OPR [NIL = SUBST (GETDUMMYVAR) - 'VAR - '(bind (VAR _ BODY) - eachtime - (COND ((NULL VAR) - (GO $$OUT)) - ((NLISTP VAR) - (SETQ I.V. VAR) - (SETQ VAR NIL)) - (T (SETQ I.V. (CAR VAR)) - (SETQ VAR (CDR VAR]) + 'VAR + '(bind (VAR ← BODY) + eachtime + (COND ((NULL VAR) + (GO $$OUT)) + ((NLISTP VAR) + (SETQ I.V. VAR) + (SETQ VAR NIL)) + (T (SETQ I.V. (CAR VAR)) + (SETQ VAR (CDR VAR]) (PUTPROPS join I.S.OPR ((SETQ $$VAL (NCONC $$VAL BODY)))) (PUTPROPS largest I.S.OPR [NIL = SUBST (GETDUMMYVAR) - '$$TEMP - '(BIND $$EXTREME $$TEMP DO (SETQ $$TEMP BODY) - (COND ((OR (NULL $$EXTREME) - (GREATERP $$TEMP $$EXTREME)) - (SETQ $$EXTREME $$TEMP) - (SETQ $$VAL I.V.]) + '$$TEMP + '(BIND $$EXTREME $$TEMP DO (SETQ $$TEMP BODY) + (COND ((OR (NULL $$EXTREME) + (GREATERP $$TEMP $$EXTREME)) + (SETQ $$EXTREME $$TEMP) + (SETQ $$VAL I.V.]) (PUTPROPS never I.S.OPR ((COND (BODY (SETQ $$VAL NIL) - (GO $$OUT))) - BIND - ($$VAL _ T))) + (GO $$OUT))) + BIND + ($$VAL ← T))) (PUTPROPS old I.S.OPR MODIFIER) (PUTPROPS smallest I.S.OPR [NIL = SUBST (GETDUMMYVAR) - '$$TEMP - '(BIND $$EXTREME $$TEMP DO (SETQ $$TEMP BODY) - (COND ((OR (NULL $$EXTREME) - (LESSP $$TEMP $$EXTREME)) - (SETQ $$EXTREME $$TEMP) - (SETQ $$VAL I.V.]) + '$$TEMP + '(BIND $$EXTREME $$TEMP DO (SETQ $$TEMP BODY) + (COND ((OR (NULL $$EXTREME) + (LESSP $$TEMP $$EXTREME)) + (SETQ $$EXTREME $$TEMP) + (SETQ $$VAL I.V.]) (PUTPROPS sum I.S.OPR ((SETQ $$VAL (PLUS $$VAL BODY)) - BIND - ($$VAL _ 0))) + BIND + ($$VAL ← 0))) (PUTPROPS thereis I.S.OPR [(COND (BODY (SETQ $$VAL (OR I.V. T)) - (GO $$OUT]) + (GO $$OUT]) -(ADDTOVAR I.S.OPRLST ALWAYS AS BIND BY COLLECT COUNT DECLARE DECLARE%: DO EACHTIME FCOLLECT - FINALLY FIND FIRST FOR FROM IN INSIDE ISTHERE JOIN LARGEST NEVER OLD - ON ORIGINAL REPEATUNTIL REPEATWHILE SMALLEST SUCHTHAT SUM THEREIS THRU - TO UNLESS UNTIL WHEN WHERE WHILE always as bind by collect count - declare declare%: do eachtime fcollect finally find first for from in - inside isthere join largest never old on original repeatuntil - repeatwhile smallest suchthat sum thereis thru to unless until when - where while) +(ADDTOVAR I.S.OPRLST ALWAYS AS BIND BY COLLECT COUNT DECLARE DECLARE%: DO EACHTIME FCOLLECT FINALLY + FIND FIRST FOR FROM IN INSIDE ISTHERE JOIN LARGEST NEVER OLD ON ORIGINAL + REPEATUNTIL REPEATWHILE SMALLEST SUCHTHAT SUM THEREIS THRU TO UNLESS UNTIL + WHEN WHERE WHILE always as bind by collect count declare declare%: do + eachtime fcollect finally find first for from in inside isthere join + largest never old on original repeatuntil repeatwhile smallest suchthat + sum thereis thru to unless until when where while) -(ADDTOVAR CLISPFORWORDSPLST ALWAYS AS BIND BY COLLECT COUNT DECLARE DECLARE%: DO EACHTIME - FCOLLECT FINALLY FIND FIRST FOR FROM IN INSIDE ISTHERE JOIN - LARGEST NEVER OLD ON ORIGINAL REPEATUNTIL REPEATWHILE SMALLEST - SUCHTHAT SUM THEREIS THRU TO UNLESS UNTIL WHEN WHERE WHILE) +(ADDTOVAR CLISPFORWORDSPLST ALWAYS AS BIND BY COLLECT COUNT DECLARE DECLARE%: DO EACHTIME FCOLLECT + FINALLY FIND FIRST FOR FROM IN INSIDE ISTHERE JOIN LARGEST NEVER + OLD ON ORIGINAL REPEATUNTIL REPEATWHILE SMALLEST SUCHTHAT SUM + THEREIS THRU TO UNLESS UNTIL WHEN WHERE WHILE) (RPAQQ CLISPDUMMYFORVARS ($$TEM0 $$TEM1 $$TEM2 $$TEM3 $$TEM4 $$TEM5 $$TEM6)) @@ -1241,17 +1233,18 @@ with the terms of said license. (DEFINEQ (DUMPI.S.OPRS - [NLAMBDA X (* lmm "14-Aug-84 18:34") - - (* Dump I.S.OPRS definitions. - - redefined to dump out same case as given) - + [NLAMBDA X (* lmm "14-Aug-84 18:34") + (* Dump I.S.OPRS definitions. + - + redefined to dump out same case as + given) (for Y in X collect (OR (GETDEF.I.S.OPR Y) - (PROG1 NIL (LISPXPRINT (LIST 'I.S.OPR Y 'not 'defined) - T T]) + (PROG1 NIL + (LISPXPRINT (LIST 'I.S.OPR Y 'not 'defined) + T T))]) (GETDEF.I.S.OPR - [LAMBDA (Y) (* lmm "14-Aug-84 18:34") + [LAMBDA (Y) (* lmm "14-Aug-84 18:34") (PROG (TEM BODY EVALFLG) (RETURN (CONS 'I.S.OPR @@ -1279,9 +1272,9 @@ with the terms of said license. [(CDR BODY) (COND (EVALFLG (SHOULDNT))) - - (* somehow there was an = in front of the i.s.type and not in front of the - others. this shouldnt happen) + + (* somehow there was an = in front of the i.s.type and not in front of the + others. this shouldnt happen) (LIST (KWOTE (CDR BODY] (EVALFLG '(NIL T] @@ -1298,11 +1291,11 @@ with the terms of said license. (ADDTOVAR DURATIONCLISPWORDS (TIMERUNITS timerUnits timerunits) - (USINGBOX usingBox usingbox) - (USINGTIMER usingTimer usingtimer) - (FORDURATION forDuration forduration DURING during) - (RESOURCENAME resourceName resourcename) - (UNTILDATE untilDate untildate)) + (USINGBOX usingBox usingbox) + (USINGTIMER usingTimer usingtimer) + (FORDURATION forDuration forduration DURING during) + (RESOURCENAME resourceName resourcename) + (UNTILDATE untilDate untildate)) (PUTPROPS TIMERUNITS CLISPWORD (FORWORD . timerUnits)) @@ -1477,7 +1470,6 @@ with the terms of said license. (ADDTOVAR LAMA ) ) -(PUTPROPS CLISP COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1990)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (37614 40224 (DUMPI.S.OPRS 37624 . 38032) (GETDEF.I.S.OPR 38034 . 40222))))) + (FILEMAP (NIL (36881 39751 (DUMPI.S.OPRS 36891 . 37559) (GETDEF.I.S.OPR 37561 . 39749))))) STOP diff --git a/sources/CLISP.DFASL b/sources/CLISP.DFASL new file mode 100644 index 0000000000000000000000000000000000000000..6948cd7a35f495fc8b0e2cfa5a8d1c3da23965be GIT binary patch literal 36706 zcmeHw37k~LwRhj!w|jO3HK@3?f=ZO#72IfMdYG1;?y4(RT%tyeN@6yXr{DRXe^vLTY0dJze0ksdF+aHf zy62oaRduTB+^V{DtJjAr=hmlU^}S1$c6E33#d-$^mJSZY7WekW`g;fa7InlH3q5x3 zoaRJBDlzZ8V@T~ku0EB_wM;mAN_8$Ewy3Y8ZJ?t)HhJp!#*T&Kr%al1L~QbuX_F>R zJN)qK#&|A8ZB{JbIoQ|V-nM+4M2Ja*zQMM>f%yTxaO&b;BBysYHD?5zkA0Gxct0=<;>L564tc=VSF;((waYbXx;G1 zv4P&D;xtsCD-53l@!64Kw|-8BsMfNBLkG!*^|G zzKz?HuIYaF?-8>V`;S=HBv!u4%4Ef+aT*Nuf$izK7Om0kGJQiaYuoXz4cP3%wO?C_ z#J5vWCTqbq7tr|uWUHW<$$z#b?9lLU?$Q5n1+X>!!_oeKE9Q>;??9gSc|BiPXh z{^?=fj)%k!2eQL~>~J9egB{55P&g#371g>dQ{NQN=7!eoa_HexN|rhLLry5h340QT6Cw(A?-Jf3yhQj3;d_Ly6YeA2O}LqG4PhN&6=50SV}#QPt%MT@ z#}f`Ce3Y;cVHZNBLhXMMeoJ_T@H4^>3Ev<*NZ3sHG~rsp<%Bha<%Ax>BEnokGhqhd zNWwV6euR;P8bU~+=J$lx2)`iwi12N~R|#Jve1@=za3$eF!p8|`5*8CqBD4?^glU9{ zgfWCY2*U_rh3Y>MenWVH@SlYLAUsO=GU2m?8wpnvE+L#x7$9^J77%iTCc?3VDTIRv zdl5zuq6$@iA-qla72#RJ_X&>^?k9YXa0_9Ga4BIm;VeQop^Y$`FpDsqa5&*$!oGxE z2~`S}?-71Sc$M&T!c&BA5*{Lafp8n)I>Hr%PY})_^b*<$^9X4|J>e+Ac*6dK-3YY= zN1@^mgx3kbB>b50B;gUly@WdmpCW7^TtqmJ&__6(a5CXULL=d5!X&~0gi(Z@2%bXp z&xAJ#FA|<1e3$ST;VXo@2saTn5-Nf;!YK{%C=CnO2S5e_AcCG1VunNXn+`72>7 z;bp>42|pk_L3n`hdBUv(pKuxB0>asZC4_~9IfNA92*M$R7~vy?Y6b6o!aIat6P_b% zA$*JQFyS7;?S$(I>j`TK=Mt6@ItcR#8A1bLDq#X)G+}o_9l=!y|B>(p;d#Q-gzpf( zM)(rpPQnd@s|XhpRuK9LorF^eSq1k^yz;2eq%k^h@0Q_0ZF789Vn#BrFEKz|@9z#^ z?Ym`&N@ zP)l$WLVqBC)P4Qflk$HnMulVC3^SsE^j8;vy#LhF6 z*y2xs#CJtvB-&Lys#iwdGgI*yiIizx&Jz^=nm-Z34~X!Hg7D~gcBYlPhjMrOlOT7y z$W=owk;~1Dqn$c83W>%K6zDo3Mm2Y6X3o`eTUVcHZjm>ft+_;bVSNIj#mUwnnVqU+$Pmh0eCnzaWPWAVh?;n#FN_9GuYe}S1 zlFgLA&rJVVbmzKsMp8%SB=Jd8{e2GekDDO$TBSFpm3*MT&wl>#dkVQq%_7Fgq4QPY zrEi10O3vZcazuHOHwUI29vRvY7OIy^{nHY3BnJh;M~%qo z9cLPmeGFx0L1q_2=`P4r8cNE_4Erxq+|xU#X4r2HVP?V*UNMAjEAcZ!NLh&=S{(x> z$~UYIV~b%AS{+tmv(;fGJ}m?v&6}<&oxmfhVg+kc+RU(PA<*tiFtk=!(G_Y!a4rW2 z^p)iL1E8+4)HQ~>6x8LQE|vIo>;ZUm$HQ|Xt^svFp-PO(6I(O+WFnm>Us{|4*F0<_*^xY)uHnfO z6OWl;HRM${BpVwO*+jZNQ4nws!E<6*$i$Y>MXQZ1n!&64J$YVBD#$tntk;Ak#g?FW zQe3f?Q}+u-sA}9ct15641b#$;Xk#F=%DolbZ3wF(0HRqmbOev#Zr zV=>3dyc^8V2vh1xg260r0yP_;!sK;VQc+d%g9>sX1)|Ba1^GC+HOUVy$eC6_*@7%4 zH0=1qeqtV!u|>)1M{LS)cy%ny({JX#&T8%I52zd3zowURO|z_|0x{w>%`m^ zea@uLkwYHjx{RtPn$Jowc8}oLd4Mw9MKY zE$6lX2Mx0JYRkDJz(HfIy~J|v3UJU8YtILVEz#t302H>uKu)`?hKB+gG^YzJ=c@sZ z<}_zHUkh+Fr%jggSb(EBJ=Ss_4{$W6Q-lMv%fRA9!#e;aI0!Ko7|MK5_5$TJLpd3g z5uhw21(l>#5(Tl_5XH|NE0Q&T0g=sji@yw%w?ScJ-Qu4E%CA6?fR5)XTGR3Dyi5xQ zCpFK4!*t$M!uLU#ElEbP*{w0{p9ZnVL7l5Awvuu`DDw>kO{nH`pqw0(xdjv!bgQp2 zL!hvrMvwS;`}EuDFNU7gps%`79=cWgV@(?xaLc`p1D<@Sv6Ib%3euo^?O1U z8@tD1w9PSVeqKwWLX=kj&hW+`hcuk15?_TH?VnC`_51I?{{|#~4x)C^0P!ghkvZ*C zPP7t|-vm*gI04CrK-8WTAbtTv?MwmUZ6NBSGeEo!#M#Uvvh)fPx&lOPD3nyn2V#3Mbu~yD#Kk4VdJsEHh)02VMhS5|h}yrH zkm}qYL~V`%;%*>niwqEJLDWVWAUYswyDSo`{s5vj%>eOr5Vds%h`$6;8)$&|V-U5C z28d6BsLeD$d;~-^hLzhEwd!8W(8d~waffASdkru?B@Ah-9tN%)4OeX-Dbg6AU1Z`r zV>MljXd^ny-nqATguy`g)lO`Ss8;5fe4Yola(Dwk4I$ zG$f|j7#;%7B)uLcF{&n73EVW=8>l#$Dr8owD#~e?Dv>I!2868w#6J=7FJBjx`0@IN za?#PTD-d1y2qLxw5m^T1#mMn;kx^a~8B$ z$fom!90e6 zlNWo^%a(bG#HpHSB@pW|lQ%;vm(ZD-HzR;JUqKvM6UK_8jSwvRAZjAg2sXs;ViJ*U znnh54Ipm}Afq*m{M7W6&YO@Kndf9-VNHvs8=RAp4H!&y$f-FZBqe0z9s;h2H4pq;>}xJI4PE6T;7oEMv(m`euMA3L9LNlcjB!qzbUCQ< z3{artFv>Fw*;6fNYJf8poV?}evz=2Z=QwbZmcz!Sqj!D1UwIrj?D3oYJt2Fjm7NvP zKMS0(mXir^GT`iOIcA;;zJmq7%AGA|P9P2zk1H!I=cEAVB;i#2)pAY^aInl=u~j%y z4Uy*L+ytxK8as4Z7y>WbsO)qsDAtE7erh=#0i_+_{J?U$0-P>zp0J!H0nQR|9iEcbEei7 zIcRT@i!Fz~ksP>?$O_A$A0THrIQ^ExmPpR|;B;CJTOv7VqmffA$4-`o=%BqtvX-MZ zC{92kGc7~?UVw4T(1s(m{d_~OU)QU)V~4XFO` z?GES1oMfw~anutz$E!B=WR7||XR=b3OJCtizr1i$3TJPh)iCFLEC6T8>i8XfFgW_) zaP-0A+@$ha3(lDu)>?G5mK|*coMJgc%GI{yXj^l%Ejrp(9c|0bEcO9M`-h|b$I<>J zgBQ{+RxN8$1Czzj@)XoJfqeHkBP-uQCS>qZ3HmWA`l1xHDwmL#c=BdDD>u%5a;eaF z?Tzy!XkMhJXQmP+K6CWEMr_I^6SKrbNbo>gv%gZ!FG)HY;O&bVep#=t==D{-{#vik z>-9CL+0&>Ay#|`TOmSCWjVva|4tt4h2_ueU(_Csv$A zRTm$+9h~o34ogK2mN31qTMi3A4wf*z`z(ifCFdq^?zS9eiySPXdN&)6qZJp@Wkv5A zOVm0w#C2AOR;VGa5+YjDL0TrpUSwr?~VKxOewXJ?PWIt-D%qF#H6WPadXkl`+HSA(J zv@khZ@s*ZC3zLI74*!?s{3wvGr@;BGa8Qh3GRkqK{gA7asxPHI|{4=bCAFxh1MKOxAlWQSI$SJtVlu64lg(IM))@ z%1$&2$!0@zcVWJjIMFT~P$ykI-SRgONropQw5C`sY#pps);e488kJe8*VVF=w^Y^* z&z5z*9$8derVIJ*XNESow2WIVn%(I`8+KNCwuGS0U|O%4I64qA?Vo*vwfYuxIIQ~@ zQC)lY`nmVRk%gpG`S6PaI>ERcdSf<9x({^ z>Qo~Nw`Ezg9=cLWC@c>%D4(Rf(-r$L#%)za-cj8`!;p=)2< z(&3ICt)-bpCU$$Ac%noLOO}-(lWHU!L7oyykuj=kyiuejn@memt}-g+{DGd{f!IJ_ zTTg#C4osL(x5`LXq%)ckQ6)R>nsY-};RSqUHX#YhE*5`^)~|aavJF$Tpuh|vN?c(l8~7{U+I4(Wmqf>tu?`EEJ1)&=6#am9*lucdKh}w@$=TfE=bS^0RoFo(M?BPH zr(=cgGm_mFSoi=<6ga&U93~at+JZG!ZJU~p3r$|R4NXaxAWA!<)MyI|FfUY*PeNoK zMI!a_lBi>DrM7Fz1ck$`YUNwa&$*LWrCnU>2NT(*S!3*Rc3~ks&$kmxyx>-$XL*5B3Pzx*&dSxy?8-46V zZLZSMB#zrA3{Up4P6o=(%E|t2a3rX2dC#+0sM@jfDvW(O(Rhm-4ALNPh899F-O6on zPndcUQ_N_H>-I(n^HxF?Fp_YP&j*N=ocPKZ1jfPdQf>tKdMq z`gjAYLZQ3s!y!3BVo_V3H5&t(3Gz10QB*75J)+SgE%q7S`gT&BsZyj%im4!?uJ*? z(C73zQ?H+gJJir-6duXmW&=_Mq}*%+H`>6bY~XquxYh=SY+$3<1-6&Y8}>&PjOZU# z3`+aJSkc4RjhZ$eh8r||gvD(tPSffa-YIh2Y$8-Hd)M%1RWA6W_*{wr{ScL~`Wy#ds@y8-FQd_RSJIv?$ z2Wl7>G-@pltF9WfF$IQy0HVu8$MyF|Xg6H;!)>e}^WQSZgSLGGDmhlZNzJ>>v=TCV z%VTXuYQ3(MN%qHOcg@){y&jNB z_EMQ@cZ;*@6erj&E)V0&lV#)5T-oNNV?@r8LXT_g$Mnj@LoUNTBpau+i-)+}$2G!x zRZjhLXtUY&%Vj2Y$D!Mle~Vsklyah`EVuX6|^Ib2ewv<7J53;vZ@pO&DLwaF-dr9x9XzDZC;qcfbAUfEIOk z^)E%j?nOe5ENL59)M-bpc90gjRRxw6YE~r8w@HnKZ<8z&PE`2(C@0xin4oUZ=0qPC z)+&(^syO+4Qz8wNFKO_cj{;?8Ct2*mXx$s=?C1e@boY0F4-}3WycM%3yo%(6+=NVv zyiU-D1E++6A{Vs5lP_$Fc9k+SA37GO#$!L3lh`>cqAT%XUDUz2!!}05+hqOTL0WUd z<;do41jJQP7Q=~ZlP64G3Ng2l7@<=?IXy67N(>63GJBEPjg3`QST~7ibUF!Lg>&!2-~U1J-iT-$0^Q+o*6U+>{kmS&2ZW!{@Hh1O zO}&0guTM&Kh|(IY3$)CdsS80EO|nT!qe7jAF8_i=^E%S z+zslT=B=_dC+~7+WH1Y@9PIDvIekX&*@f^z39FclRYgn{LyHRLp}26T$#6_oBQ4Qp zPObE`NTDR{wj|QXL_jnOBPvu$mg&ewqFkmmTc1eBrGms}eH}cw zN32c$FP6huV@rGc`@0s(DXzlp>+0y&(_KX-hT}|Q7&UhE4J@A)!#927VpuuNjf?Sn z#BniQ;~N)~^I+Rz;@$^hi+Xzo+QhQ4ww~om?(UBDE=HRD9TTLWEU^~rJ?8AwP#o*( zj}7+A*{}n>v96x>u0>)$iPSbAdSX4@ZA%umx5YY^wRH~)qdz9?N(ylL;1bDm|Ad(4 zE!MVpamONIn3seSvpuHGR9*y5i}iGLq2RHzx+F&fy@QK7gQ_*D_FhqqrPt23Wk_A} zWQ)Ij);rV^v4M{6?*5oQ+PW4m*EHMD>RN)Z>crB7F@T;Vi-Hww0?fYX3 zJ7Bbhy@NgN;~>z6q)*>IS=8k^wR)_-ZFxTv>Fr^)N;IhgIl4B+qiZ|PUMfwwU%D}p zWfE#-=@yc9_h83_SRTc+rbD%#)wVpA$sQy`v7daYhmf=tQ^c+g$seM3oZYr$Y4-=z z=^q=rdfK|X<>+2EltP`F3>UN5Hqg67>a&OD4rCZdF7mB>Nx6r&|XADZknZ7l)&>?zyIu`Z!(VTaWfRxz&{`se zR>Ad1$|#qD+AL)*w4Ziw3=2K@5UkLFg+)Bz!NPzq(^nSoWxScu+K3yz%#a5t!tsXL z<29-YV+mH@$AslGXQbjDC1Oz-q+)GWLh=zYL>AbzCffif%2>-~YElh&y7LCByQ&TE zAw2n*7`g;iXGAtv^Aj5vA1vd88~W{+ zmnp5;v}q|ic&@~Q9A9Y2IC(=<^i<-Mfp|6n6V{3TJd8YDwm@MlF{~k@xANG>H`yvK zBJ!0m_C?ehvKf_mS{3r}=9un!y?qK3Oc<}YWKx6i>s9X1x?Rg1&VBW|Q6GH7cj$Ua zcBkH@@+|H;r(?W&+}O~@P{nk2t}}0V2q}3-x-!zzlcn&mTURk=%$%kSPPmo~tfO|*kOw&7ZSDEMxD@4JxCXdNZrL|#=f2d9)y%~;wD03!-iH!R z>Bhm6n*Rj{@R_rzwWvD|!`*Sd-;VSB{s*7$_b+Ik|9GD-x@&bB1;4z@WcmFD8At_w zPoW=mj&KWMh;S)k zHQ_8mH-V>;d9!&pi!hyVIN@NzzJy%~RSMzv2)`q|O87b9DFRO=3-eU6Fi#~5^Hj1h zPbCZURI)HnB@6RZvM^623%66tJVKgKPdJJ&p0Gb*H$p9er;@pU&^z~a!Y>IwCOk=a zgm5q64#KAh8weK>&Li{@cq*C8Q^{POO6KxZGMA^4xjdE3<*8&YPbG7CDw*r47U$1| zHwiBio*{gf@EGAMgu4hlmCV`5yH65U5(Wup5KblJ2}#0n1fEMJ8(wj+rL#9-X97

5uI4M=tP3=KPUO{>WqfkyHGU2l*rS@<)#F zM@IdTRcPpY>9Fj32AbNRGj21UH0y4 z^vboG%^LoKUUgMI{6!7li+Hcwc+A1y9q*Us?aSYv(vOEW=)!6ERv12>niHRg$(0+| z#ZMQDlkN=67b@yADfvkp%(f!+8Clhm3av2H4`f^$h}(cKGb3GuC;O9R zcaSVy$>d0an4`$2Kv|u^g=LRLF?CNlrh3$O#!`R>;Ih zwq$9B(uvs#L=R_D(CSLNlB6@)U};TrjtPfq;O#kk__oF+3b$~8;AsH-y9Dw%JR zJuIRw*NV(kXwpg8MP3bLTLs-b3L0%qC~6>E?OwG^Mxcb)jCz>UEJ`+x6O^*Ts50U9X*b?b7QRdi|JQyY;$6uRVJ0 z)vLZ=@y^t6pI-a*s-D5q*9_h=rJSYLv-P@Muj)j+b2a>Ny`HDn6?)YV96bFJv#nd! zi27l!He9`hvSNq3h0Enyv8cDZTh`$u7+ECCSqN0LcP#3b1sw@injogOZhJ2%9c_y` zv5<@K;$rNI#au%YvL`{L5Lw*S*AInZS%Fe|U+)q@w+ruWqFp`xUF}d)A!|NZ%z(%l zy~?bR^iS{5$dMlTT_;2j_jYT(WtCf!?(OS39VtqlSa%>XhHQf@J>^ zS=*wn%6?f$#Hx|d!~KKEOob-hrIs1!>>Cu4JAi^l2YVzI=n<>glQkD49?`WI1|$(Q zt4GWVfp;U!A0C2-G_!c|yI3&xW@H*nX4$}@al9L>X1fD`Zy>{}MI=M|B9SjCygMK)j>9}29`z3hLD?Nv*(R$jx)Pz# zYe*CCmGboMHSqp;Vnt@#QODu>@%UU^yQpXgVcX>Mh*{3CUAD8x54tS zvE>(I7IUQ8w>Glol{f1u;oYrleGF`4*;UYdk=4A>YPOcuSoe!rHSmBs_gO)tcmgj0)9%<0qHC`#XqYl$HJD8%+M%`ee{w-5THHEinXnYsrt+AS3 z=B9NvYwwfhU5zX!V${U?(+1?dY;J93i2^G?7b*gQQh0Z&g-VDoOO=PEJ8mOr)s&B6 zxqM>03^U+$m1O2QMEoW$*jA6W zQCHijh4w-h#j>$+m1gckJ%deJy@PD?Vq3UflUaksTY2`#a7#B~z%2S*)&W-THY3Mq z5iW!((OUs&*&j!RpDrjwzzBXCB0E`;Tg!>)=UJW=xuu+leqZ!wD{^x=k((u<@S9dd zhg5~{Z%kg4=$#9}7p)*4lCVM`)A-OS{EQXh)2>A128evuihRoCXd4?T(OV9|$E+Y9 zb|tznJqv%uidO`1mRjxdtNg`kEqq4wZ;(gvc3Igs#0rE?a83%4C4AgR&5#g;V zml8dEFCE_53SL@H*QF4tup;#DB}K<;eAoI`?~~=U;2REitJOkRS)v7Bg1GkSut%!=qhR=m$PP6b}oy}*j-tfcq5E7rd(b5i6oI*isRARkzxT za1pGe*5Fm0_pOM|iA%M>tIGM^#?m@@E)_wma(-<^be3Hz0kXGNBlYlrZv&K4`8 z^Y&6L@T$(YtcXtVOGV&SorkT6t^|n4Ha4bLT@Jx}te`F&l3*Q#^g7@(IjY4WH?rKKwl$ zC3tM{CtH83g7le?_lYA=qJ#AfobuYA;7Fx!RmYyu^Nt{!4lwN{Nc1m_jXui77k`Q}D8keicK!)sQ_ z%NX-PwcI$kG0taIi1VGNhBiiX(?>X=5yPDk!`%_X!%a6Ohc`JR951DtR8G0Fd2>wP z6sL;si#tcjUso4@q`q_K2a{KwFzdhv*39Z0HUIu5_rA>!hg?s}=*)A&*s*iKm@#s! z;duF8uUXzhVaHBX_JGTFZ5LlI>}=Sw!>l!xACJ#QQIyC_t|Q#KZMcRJ62`8Ep>Hn6 z%TkJd$Ey+LRkfh|pjzaqXejL9)wTR{NFTalT@?;>%i_C;Rq{=#>$s%g{zoQgY^xnB=N;rf-_w_4fMCi>4nse0}HY zu9clW$zrgT)2C}#f1y4+|K=|^d!67YdI#+kD z>^y1xtW}-EM~xaDk|rXiM_bX#^X_m%s298em0t#7O-Ei}m3dMXrlzruUUeY0ie==@ z6WA1rytXPVH=%EelFD3DrZv@&&f~W`a6W|WTx=PqvVW*WwH}ACoJ1nQx&p|Ai2D&R(>25l?b-(m)*t7O8 z*p>EgD~0wfy%aaM{0ny7{BJVZ|8-qqQ|Hb{Z2u#r(z>~K2*>le{QWogR^4#n`h?2} z7ZA=SEFml;%ps%*al#RVLkKa#M+nsl@`F#hP2?TIuL;i)wh+EWc$jbx;da9H1pW-1 z!=Hh3_%m=0e+Ev@U(*!$GjKd(&1;mR$~i~Mm`E5y*n=>P5LO8NiSQf33xxk9{0HGt z!j}o3CEQ53nsA9f@_c{fz~9)zvWJVjCDix4i{Nw({zYr&P7D%sAmSY;KGbec9*-^0 zsJ$D&mw-1~uQmP=pk8IE`hfIm#FvRrjp#OWN?dFu_G3J=tRH!g>=l+B3##q6)O~~0 zPD|Y`X&-?+8+lv9fywsgo^LeYVwmprwuq%I<0PW`oq> zR(6jdHDakc-Y|NdcdZ7UZ>b^uBM{A9AQ$H?8)>(ID(59j9T}wl1XQC&jqH5S%6%j# z_jOC%HAubBP~D?~)Vr|>{GBB}SBxHd)e@f#5Pxoo%x7T^a)8RbEx8UoWks0l5|Otc@=Yu9rba6fQ7sQy zkvGbTybdj2up+cXi53;P&5FGCfm*J!A~aozmRFI`6;{Mdq_$Z&4y(u~tjNpd5_E(;%*e}?5Wtdf3qWp!zyiy0G#hE&*>;;`sN-4v?D5w0n z!mN@_qeS_0c8(eTdD+-H7ry`g{{f(T B?g{_^ literal 0 HcmV?d00001 diff --git a/sources/CLISP.LCOM b/sources/CLISP.LCOM deleted file mode 100644 index cb47bd38..00000000 --- a/sources/CLISP.LCOM +++ /dev/null @@ -1,3 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "25-Jan-98 09:32:34" ("compiled on " {DSK}sources>CLISP.;1) "30-Mar-95 20:33:04" "COMPILE-FILEd" in "Medley 14-Aug-95 ..." dated "14-Aug-95 15:27:48") (FILECREATED "16-May-90 12:27:02" {DSK}local>lde>lispcore>sources>CLISP.;2 45083 changes to%: ( VARS CLISPCOMS) previous date%: "26-Nov-86 12:32:58" {DSK}local>lde>lispcore>sources>CLISP.;1) (RPAQQ CLISPCOMS ((COMS (* ; "DWIM stuff") (INITVARS (NOFIXFNSLST0) (NOFIXVARSLST0) (NOSPELLFLG) ( LPARKEY 9) (RPARKEY 0) (WTFIXCHCONLST (QUOTE (NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL))) (WTFIXCHCONLST1 (QUOTE (NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)))) (USERMACROS FIX8 FIX9) (ADDVARS (DWIMUSERFORMS) (LAMBDASPLST LAMBDA NLAMBDA) (OKREEVALST AND OR PROGN SAVESETQ CAR CDR ADD1 SUB1 CONS LIST EQ EQUAL PRINT PRIN1 APPEND NEQ NOT NULL) (NOFIXFNSLST) (NOFIXVARSLST) (GLOBALVARS) (LOCALVARS) (SPECVARS) (NLAMA) (NLAML) (LAMA) ( LAMS)) (P (MOVD? (QUOTE NILL) (QUOTE FREEVARS))) (PROP FILEDEF BREAKDOWN CALLS CLISPRECORD SETUPHASHARRAY MAKEMATCH) (VARS (DWIMIFYFLG (QUOTE EVAL)) (COMPILEUSERFN (QUOTE COMPILEUSERFN)) ( CLISPTRANFLG (QUOTE CLISP% )) (DWIMESSGAG)) (INITVARS (DWIMCHECK#ARGSFLG T) (DWIMCHECKPROGLABELSFLG T) (%#CLISPARRAY 250) (RECORDHASHFLG T) (CLISPRETRANFLG)) (ADDVARS (DWIMEQUIVLST)) (USERMACROS DW !DW CLISP%: NOCLISP PPT)) (COMS (* CLISP props) (PROP CLISPTYPE %') (E (SETQQ CLISPCHARS (^ * / + - = _ %: %' ~ +- ~= < > @ ! )) (CLISPDEC (QUOTE (STANDARD MIXED)))) (VARS (CLISPFLG T) (CLISPCHARS (QUOTE ( ^ * / + - = _ %: %' ~ +- ~= < > @ ! )))) (INITVARS (CLISPHELPFLG T) (TREATASCLISPFLG) ( CLISPINFIXSPLST) (CLISPCHARRAY (MAKEBITTABLE CLISPCHARS)) (LEFT.ARROWS.BITTABLE (MAKEBITTABLE (QUOTE ( _ )))) (LEFT.ARROW (QUOTE _)) (CLISPISWORDSPLST) (CLISPLASTSUB (CONS)) (CHECKCARATOMFLG) ( CLISPARITHOPLST (QUOTE (+ - * / +- LT GT lt gt GEQ LEQ GE LE geq leq ge le))) (CLISPARITHCLASSLST ( QUOTE (INTEGER FIXED MIXED FLOATING))) (DWIMINMACROSFLG NIL)) (IFPROP (CLISPTYPE LISPFN UNARYOP CLISPCLASS CLISPCLASSDEF CLISPNEG CLISPBRACKET) ^ * / + - = _ %: %' ~ +- ~= < > @ !) (VARS DECLWORDS) (IFPROP (CLISPTYPE LISPFN UNARYOP CLISPINFIX CLISPCLASS CLISPCLASSDEF CLISPNEG BROADSCOPE) * (PROGN DECLWORDS)) (IFPROP (CLISPTYPE LISPFN UNARYOP CLISPINFIX CLISPCLASS CLISPCLASSDEF CLISPNEG BROADSCOPE) LT lt GT gt LE le GE ge LEQ leq GEQ geq EQ NEQ EQP EQUAL EQUALS NOT AND OR and or NOR nor MEMBER SETQ IPLUS IMINUS IDIFFERENCE ITIMES IQUOTIENT ILESSP IGREATERP FPLUS FMINUS FDIFFERENCE FTIMES FQUOTIENT FGTP PLUS MINUS DIFFERENCE TIMES QUOTIENT LESSP GREATERP EXPT -> =>) (PROP SETFN ELT SETA) (OPTIMIZERS CLISP% )) (PROP CLISPWORD AND OR and or ! !! CLISP clisp MATCH match) (COMS (* IF) (VARS CLISPIFWORDSPLST) (INITVARS (CLISPIFTRANFLG T)) (PROP CLISPWORD IF THEN ELSE ELSEIF if then else elseif)) (COMS (* I.S.OPR) (VARS (CLISPI.S.GAG)) (PROP CLISPWORD * INITISOPRS) (IFPROP I.S.OPR * ( PROGN INITISOPRS)) (ADDVARS * (LIST (CONS (QUOTE I.S.OPRLST) INITISOPRS) (CONS (QUOTE CLISPFORWORDSPLST) (SUBSET INITISOPRS (QUOTE U-CASEP))))) (VARS (CLISPDUMMYFORVARS (QUOTE ($$TEM0 $$TEM1 $$TEM2 $$TEM3 $$TEM4 $$TEM5 $$TEM6)))) (ADDVARS * (LIST (CONS (QUOTE SYSLOCALVARS) CLISPDUMMYFORVARS) (CONS (QUOTE INVISIBLEVARS) CLISPDUMMYFORVARS))) (ADDVARS (SYSLOCALVARS $$VAL $$TEM $$LST1 $$LST2 $$LST3 $$LST4 $$LST5 $$LST6 $$END $$EXTREME) (INVISIBLEVARS $$VAL $$END $$TEM $$LST1 $$LST2 $$LST3 $$LST4 $$LST5 $$LST6 $$EXTREME)) (FILEPKGCOMS I.S.OPRS) (FNS DUMPI.S.OPRS GETDEF.I.S.OPR )) (COMS (* forDuration) (ADDVARS (DURATIONCLISPWORDS (TIMERUNITS timerUnits timerunits) (USINGBOX usingBox usingbox) (USINGTIMER usingTimer usingtimer) (FORDURATION forDuration forduration DURING during) (RESOURCENAME resourceName resourcename) (UNTILDATE untilDate untildate))) (IFPROP (CLISPWORD \DURATIONTRAN) * (APPLY (QUOTE APPEND) DURATIONCLISPWORDS)) (RESOURCES \ForDurationOfBox)) (COMS (* ;; "Currently there are four possible entries for the INFO property: EVAL, BINDS, LABELS, PROGN, or a list containg any or all of these." ) (* ;; "EVAL is used to indicate that an nlambda evaluates its arguments. EVAL affects DWIMIFY and CLISPIFY: neither will touch an nlambda that does not have this property." ) (* ;; "BINDS tells clispify and dwimify that CADR of the form is a list of variables being bound, a la prog." ) (* ;; "PROGN says that only the last top level expression is being used for value. This affects the way OR's and AND's are clispified, for example." ) (* ;; "Finally, LABELS indicates that top level atoms in this expression are not being evaluated. This tells clispify not to create atoms out of lists at the top level. LABELS also implies that none of the top level expressions are being used for value." ) (* ;; "For example, FOR has info property just BINDS, (EVAL is unnecssary since FOR is not a function and its dwimifying and clispifying affected by its clispword property), whereas PROG has (BINDS EVAL LABELS), and LAMBDA has (EVAL BINDS PROGN)" ) (PROP INFO PROG PROG* RESETVARS RESETBUFS RESETLST ADV-PROG ADV-SETQ AND ARG COND ERSETQ NLSETQ OR PROG1 PROG2 PROGN RESETFORM RESETSAVE RESETVAR RPAQ RPTQ FRPTQ SAVESETQ SETN SETQ UNDONLSETQ XNLSETQ SETARG LET LET* RETURN)) (PROP FILETYPE CLISP) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA DUMPI.S.OPRS) (NLAML) (LAMA))))) (RPAQ? NOFIXFNSLST0) (RPAQ? NOFIXVARSLST0) (RPAQ? NOSPELLFLG) (RPAQ? LPARKEY 9) (RPAQ? RPARKEY 0) (RPAQ? WTFIXCHCONLST (QUOTE (NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL))) (RPAQ? WTFIXCHCONLST1 (QUOTE (NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL))) (ADDTOVAR EDITMACROS (FIX9 (X N) (BIND (E (SETQ %#1 (EDITFPAT (QUOTE X))) T) (IF (NOT (ATOM (%##))) (1 )) (COMS (SPLIT89 RPARKEY N)) (I F RPARKEY T) (E (SETQ %#2 (ADD1 (LENGTH (CAR L)))) T) !0 MARK (LPQ ( IF (OR (NULL %#1) (NOT (EDIT4E %#1 (%## 1))))) UP (E (SETQ %#3 (LENGTH (CAR L))) T) (I RI 1 (MINUS %#2 )) (E (SETQ %#2 %#3) T) 1 !0) __ (DELETE NX))) (FIX9 NIL (FIX9)) (FIX8 (X N) (BIND (E (SETQ %#1 ( EDITFPAT (QUOTE X))) T) (IF (LISTP (%##)) (1)) (COMS (SPLIT89 LPARKEY N)) (I F LPARKEY T) (1) (LI 1) ( IF (TAILP (CAR L) (CADR L)) (!0) NIL) (LPQ (IF (OR (NULL %#1) (NOT (EDIT4E %#1 (%## 1))))) UP (RO 1) !0))) (FIX8 NIL (FIX8))) (ADDTOVAR DWIMUSERFORMS) (ADDTOVAR LAMBDASPLST LAMBDA NLAMBDA) (ADDTOVAR OKREEVALST AND OR PROGN SAVESETQ CAR CDR ADD1 SUB1 CONS LIST EQ EQUAL PRINT PRIN1 APPEND NEQ NOT NULL) (ADDTOVAR NOFIXFNSLST) (ADDTOVAR NOFIXVARSLST) (ADDTOVAR GLOBALVARS) (ADDTOVAR LOCALVARS) (ADDTOVAR SPECVARS) (ADDTOVAR NLAMA) (ADDTOVAR NLAML) (ADDTOVAR LAMA) (ADDTOVAR LAMS) (MOVD? (QUOTE NILL) (QUOTE FREEVARS)) (PUTPROPS BREAKDOWN FILEDEF BRKDWN) (PUTPROPS CALLS FILEDEF MSANALYZE) (PUTPROPS CLISPRECORD FILEDEF RECORD) (PUTPROPS SETUPHASHARRAY FILEDEF (RECORD SETUPHASHARRAY)) (PUTPROPS MAKEMATCH FILEDEF MATCH) (RPAQQ DWIMIFYFLG EVAL) (RPAQQ COMPILEUSERFN COMPILEUSERFN) (RPAQQ CLISPTRANFLG CLISP% ) (RPAQQ DWIMESSGAG NIL) (RPAQ? DWIMCHECK#ARGSFLG T) (RPAQ? DWIMCHECKPROGLABELSFLG T) (RPAQ? %#CLISPARRAY 250) (RPAQ? RECORDHASHFLG T) (RPAQ? CLISPRETRANFLG) (ADDTOVAR DWIMEQUIVLST) (ADDTOVAR EDITMACROS (DW NIL (BIND (E (PROGN (SETQ %#1 (%##)) (AND (CDR L) (%## !0 (E (SETQ %#2 L) T)) ) (AND (SETQ %#3 (DWIMIFY %#1 T (OR %#2 (QUOTE (NIL))))) EDITCHANGES (RPLACA (CDR EDITCHANGES) T))) T) (IF (NLISTP %#1) ((I %: %#3) (IF (LISTP %#3) (1) NIL)) NIL))) (PPT NIL (RESETVAR PRETTYTRANFLG T PP)) (!DW NIL (RESETVAR CLISPRETRANFLG T DW)) (NOCLISP NIL (NOCLISP TTY%:)) (NOCLISP COMS (RESETVAR CLISPTRANFLG NIL . COMS)) (CLISP%: NIL (BIND (E (COND ((SETQ %#1 (AND CLISPARRAY (GETHASH (%##) CLISPARRAY))) (SETQQ COM CLISP%:) (EDITE %#1)) (T (PRIN1 (QUOTE "not translated. ") T))) T)))) (ADDTOVAR EDITCOMSA PPT DW !DW CLISP%:) (PUTPROPS %' CLISPTYPE 15) (RPAQQ CLISPFLG T) (RPAQQ CLISPCHARS (^ * / + - = _ %: %' ~ +- ~= < > @ ! )) (RPAQ? CLISPHELPFLG T) (RPAQ? TREATASCLISPFLG) (RPAQ? CLISPINFIXSPLST) (RPAQ? CLISPCHARRAY (MAKEBITTABLE CLISPCHARS)) (RPAQ? LEFT.ARROWS.BITTABLE (MAKEBITTABLE (QUOTE (_ )))) (RPAQ? LEFT.ARROW (QUOTE _)) (RPAQ? CLISPISWORDSPLST) (RPAQ? CLISPLASTSUB (CONS)) (RPAQ? CHECKCARATOMFLG) (RPAQ? CLISPARITHOPLST (QUOTE (+ - * / +- LT GT lt gt GEQ LEQ GE LE geq leq ge le))) (RPAQ? CLISPARITHCLASSLST (QUOTE (INTEGER FIXED MIXED FLOATING))) (RPAQ? DWIMINMACROSFLG NIL) (PUTPROPS CLISPTYPE 6) (PUTPROPS ^ CLISPTYPE 6) (PUTPROPS * CLISPTYPE 4) (PUTPROPS / CLISPTYPE 4) (PUTPROPS + CLISPTYPE 2) (PUTPROPS - CLISPTYPE 7) (PUTPROPS = CLISPTYPE -20) (PUTPROPS _ CLISPTYPE (8 . -12)) (PUTPROPS CLISPTYPE (8 . -12)) (PUTPROPS %: CLISPTYPE (14 . 13)) (PUTPROPS %' CLISPTYPE 15) (PUTPROPS ~ CLISPTYPE 7) (PUTPROPS +- CLISPTYPE 2) (PUTPROPS < CLISPTYPE BRACKET) (PUTPROPS > CLISPTYPE BRACKET) (PUTPROPS LISPFN EXPT) (PUTPROPS ^ LISPFN EXPT) (PUTPROPS * LISPFN TIMES) (PUTPROPS / LISPFN QUOTIENT) (PUTPROPS + LISPFN PLUS) (PUTPROPS - LISPFN MINUS) (PUTPROPS = LISPFN EQ) (PUTPROPS _ LISPFN SETQ) (PUTPROPS LISPFN SETQ) (PUTPROPS %' LISPFN QUOTE) (PUTPROPS ~ LISPFN NOT) (PUTPROPS +- LISPFN DIFFERENCE) (PUTPROPS - UNARYOP T) (PUTPROPS %' UNARYOP T) (PUTPROPS ~ UNARYOP T) (PUTPROPS < UNARYOP T) (PUTPROPS > UNARYOP T) (PUTPROPS * CLISPCLASS *) (PUTPROPS / CLISPCLASS /) (PUTPROPS + CLISPCLASS +) (PUTPROPS - CLISPCLASS -) (PUTPROPS +- CLISPCLASS +-) (PUTPROPS * CLISPCLASSDEF (ARITH ITIMES FTIMES TIMES)) (PUTPROPS / CLISPCLASSDEF (ARITH IQUOTIENT FQUOTIENT QUOTIENT)) (PUTPROPS + CLISPCLASSDEF (ARITH IPLUS FPLUS PLUS)) (PUTPROPS - CLISPCLASSDEF (ARITH IMINUS FMINUS MINUS)) (PUTPROPS +- CLISPCLASSDEF (ARITH IDIFFERENCE FDIFFERENCE DIFFERENCE)) (PUTPROPS = CLISPNEG ~=) (PUTPROPS < CLISPBRACKET (< > SEPARATOR ! DWIMIFY CLISPANGLEBRACKETS CLISPIFY SHRIEKIFY)) (PUTPROPS > CLISPBRACKET (< > SEPARATOR ! DWIMIFY CLISPANGLEBRACKETS CLISPIFY SHRIEKIFY)) (RPAQQ DECLWORDS (FLOATING FAST FFETCHFIELD FETCHFIELD REPLACEFIELD FREPLACEFIELD /REPLACEFIELD /LISTPUT /LISTPUT1 /MAPCON /MAPCONC /NCONC /NCONC1 /PUT /PUTASSOC /PUTHASH /PUTPROP /RPLACA /RPLACD /RPLNODE /RPLNODE2 /SETA ASSOC CLISPIFY FASSOC FIXED FLAST FMEMB FNTH FRPLACA FRPLACD FRPLNODE FRPLNODE2 INTEGER LAST LISTPUT LISTPUT1 MAPCON MAPCONC MEMB MIXED NCONC NCONC1 NTH PUT PUTASSOC PUTHASH PUTPROP RPLACA RPLACD RPLNODE RPLNODE2 SETA STANDARD UNDOABLE)) (PUTPROPS FMEMB CLISPTYPE -20) (PUTPROPS MEMB CLISPTYPE -20) (PUTPROPS FETCHFIELD LISPFN FETCHFIELD) (PUTPROPS REPLACEFIELD LISPFN REPLACEFIELD) (PUTPROPS FREPLACEFIELD LISPFN FREPLACEFIELD) (PUTPROPS ASSOC LISPFN ASSOC) (PUTPROPS LAST LISPFN LAST) (PUTPROPS LISTPUT LISPFN LISTPUT) (PUTPROPS LISTPUT1 LISPFN LISTPUT1) (PUTPROPS MAPCON LISPFN MAPCON) (PUTPROPS MAPCONC LISPFN MAPCONC) (PUTPROPS MEMB LISPFN MEMB) (PUTPROPS NCONC LISPFN NCONC) (PUTPROPS NCONC1 LISPFN NCONC1) (PUTPROPS NTH LISPFN NTH) (PUTPROPS PUT LISPFN PUT) (PUTPROPS PUTASSOC LISPFN PUTASSOC) (PUTPROPS PUTHASH LISPFN PUTHASH) (PUTPROPS PUTPROP LISPFN PUTPROP) (PUTPROPS RPLACA LISPFN RPLACA) (PUTPROPS RPLACD LISPFN RPLACD) (PUTPROPS RPLNODE LISPFN RPLNODE) (PUTPROPS RPLNODE2 LISPFN RPLNODE2) (PUTPROPS SETA LISPFN SETA) (PUTPROPS FLOATING CLISPCLASS (ARITH . 2)) (PUTPROPS FAST CLISPCLASS (ACCESS . 3)) (PUTPROPS FFETCHFIELD CLISPCLASS FETCHFIELD) (PUTPROPS FETCHFIELD CLISPCLASS FETCHFIELD) (PUTPROPS REPLACEFIELD CLISPCLASS REPLACEFIELD) (PUTPROPS FREPLACEFIELD CLISPCLASS REPLACEFIELD) (PUTPROPS /REPLACEFIELD CLISPCLASS REPLACEFIELD) (PUTPROPS /LISTPUT CLISPCLASS LISTPUT) (PUTPROPS /MAPCON CLISPCLASS MAPCON) (PUTPROPS /MAPCONC CLISPCLASS MAPCONC) (PUTPROPS /NCONC CLISPCLASS NCONC) (PUTPROPS /NCONC1 CLISPCLASS NCONC1) (PUTPROPS /PUT CLISPCLASS PUT) (PUTPROPS /PUTASSOC CLISPCLASS PUTASSOC) (PUTPROPS /PUTHASH CLISPCLASS PUTHASH) (PUTPROPS /PUTPROP CLISPCLASS PUTPROP) (PUTPROPS /RPLACA CLISPCLASS RPLACA) (PUTPROPS /RPLACD CLISPCLASS RPLACD) (PUTPROPS /RPLNODE CLISPCLASS RPLNODE) (PUTPROPS /RPLNODE2 CLISPCLASS RPLNODE2) (PUTPROPS /SETA CLISPCLASS SETA) (PUTPROPS ASSOC CLISPCLASS ASSOC) (PUTPROPS FASSOC CLISPCLASS ASSOC) (PUTPROPS FIXED CLISPCLASS (ARITH . 1)) (PUTPROPS FLAST CLISPCLASS LAST) (PUTPROPS FMEMB CLISPCLASS MEMB) (PUTPROPS FNTH CLISPCLASS NTH) (PUTPROPS FRPLACA CLISPCLASS RPLACA) (PUTPROPS FRPLACD CLISPCLASS RPLACD) (PUTPROPS FRPLNODE CLISPCLASS RPLNODE) (PUTPROPS FRPLNODE2 CLISPCLASS RPLNODE2) (PUTPROPS INTEGER CLISPCLASS (ARITH . 1)) (PUTPROPS LAST CLISPCLASS LAST) (PUTPROPS LISTPUT CLISPCLASS LISTPUT) (PUTPROPS LISTPUT1 CLISPCLASS LISTPUT1) (PUTPROPS MAPCON CLISPCLASS MAPCON) (PUTPROPS MAPCONC CLISPCLASS MAPCONC) (PUTPROPS MEMB CLISPCLASS MEMB) (PUTPROPS MIXED CLISPCLASS (ARITH . 3)) (PUTPROPS NCONC CLISPCLASS NCONC) (PUTPROPS NCONC1 CLISPCLASS NCONC1) (PUTPROPS NTH CLISPCLASS NTH) (PUTPROPS PUT CLISPCLASS PUT) (PUTPROPS PUTASSOC CLISPCLASS PUTASSOC) (PUTPROPS PUTHASH CLISPCLASS PUTHASH) (PUTPROPS PUTPROP CLISPCLASS PUTPROP) (PUTPROPS RPLACA CLISPCLASS RPLACA) (PUTPROPS RPLACD CLISPCLASS RPLACD) (PUTPROPS RPLNODE CLISPCLASS RPLNODE) (PUTPROPS RPLNODE2 CLISPCLASS RPLNODE2) (PUTPROPS SETA CLISPCLASS SETA) (PUTPROPS STANDARD CLISPCLASS (ACCESS . 1)) (PUTPROPS UNDOABLE CLISPCLASS (ACCESS . 2)) (PUTPROPS FETCHFIELD CLISPCLASSDEF (ACCESS FETCHFIELD NIL FFETCHFIELD)) (PUTPROPS REPLACEFIELD CLISPCLASSDEF (ACCESS REPLACEFIELD /REPLACEFIELD FREPLACEFIELD)) (PUTPROPS ASSOC CLISPCLASSDEF (ACCESS ASSOC NIL FASSOC)) (PUTPROPS LAST CLISPCLASSDEF (ACCESS LAST NIL FLAST)) (PUTPROPS LISTPUT CLISPCLASSDEF (ACCESS LISTPUT /LISTPUT)) (PUTPROPS LISTPUT1 CLISPCLASSDEF (ACCESS LISTPUT1 /LISTPUT1)) (PUTPROPS MAPCON CLISPCLASSDEF (ACCESS MAPCON /MAPCON)) (PUTPROPS MAPCONC CLISPCLASSDEF (ACCESS MAPCONC /MAPCONC)) (PUTPROPS MEMB CLISPCLASSDEF (ACCESS MEMB NIL FMEMB)) (PUTPROPS NCONC CLISPCLASSDEF (ACCESS NCONC /NCONC)) (PUTPROPS NCONC1 CLISPCLASSDEF (ACCESS NCONC1 /NCONC1)) (PUTPROPS NTH CLISPCLASSDEF (ACCESS NTH NIL FNTH)) (PUTPROPS PUT CLISPCLASSDEF (ACCESS PUT /PUT)) (PUTPROPS PUTASSOC CLISPCLASSDEF (ACCESS PUTASSOC /PUTASSOC)) (PUTPROPS PUTHASH CLISPCLASSDEF (ACCESS PUTHASH /PUTHASH)) (PUTPROPS PUTPROP CLISPCLASSDEF (ACCESS PUTPROP /PUTPROP)) (PUTPROPS RPLACA CLISPCLASSDEF (ACCESS RPLACA /RPLACA FRPLACA)) (PUTPROPS RPLACD CLISPCLASSDEF (ACCESS RPLACD /RPLACD FRPLACD)) (PUTPROPS RPLNODE CLISPCLASSDEF (ACCESS RPLNODE /RPLNODE FRPLNODE)) (PUTPROPS RPLNODE2 CLISPCLASSDEF (ACCESS RPLNODE2 /RPLNODE2 FRPLNODE2)) (PUTPROPS SETA CLISPCLASSDEF (ACCESS SETA /SETA)) (PUTPROPS FMEMB CLISPNEG ~FMEMB) (PUTPROPS MEMB CLISPNEG ~MEMB) (PUTPROPS FMEMB BROADSCOPE T) (PUTPROPS MEMB BROADSCOPE T) (PUTPROPS LT CLISPTYPE -20) (PUTPROPS lt CLISPTYPE -20) (PUTPROPS GT CLISPTYPE -20) (PUTPROPS gt CLISPTYPE -20) (PUTPROPS LE CLISPTYPE -20) (PUTPROPS le CLISPTYPE -20) (PUTPROPS GE CLISPTYPE -20) (PUTPROPS ge CLISPTYPE -20) (PUTPROPS LEQ CLISPTYPE -20) (PUTPROPS leq CLISPTYPE -20) (PUTPROPS GEQ CLISPTYPE -20) (PUTPROPS geq CLISPTYPE -20) (PUTPROPS EQ CLISPTYPE -20) (PUTPROPS NEQ CLISPTYPE -20) (PUTPROPS EQP CLISPTYPE -20) (PUTPROPS EQUAL CLISPTYPE -20) (PUTPROPS EQUALS CLISPTYPE -20) (PUTPROPS AND CLISPTYPE -25) (PUTPROPS OR CLISPTYPE -26) (PUTPROPS and CLISPTYPE -25) (PUTPROPS or CLISPTYPE -26) (PUTPROPS NOR CLISPTYPE -25) (PUTPROPS nor CLISPTYPE -25) (PUTPROPS MEMBER CLISPTYPE -20) (PUTPROPS ILESSP CLISPTYPE -20) (PUTPROPS IGREATERP CLISPTYPE -20) (PUTPROPS FGTP CLISPTYPE -20) (PUTPROPS MINUS CLISPTYPE 8) (PUTPROPS LESSP CLISPTYPE -20) (PUTPROPS GREATERP CLISPTYPE -20) (PUTPROPS -> CLISPTYPE 7) (PUTPROPS => CLISPTYPE 7) (PUTPROPS LT LISPFN LESSP) (PUTPROPS lt LISPFN LESSP) (PUTPROPS GT LISPFN GREATERP) (PUTPROPS gt LISPFN GREATERP) (PUTPROPS LE LISPFN LEQ) (PUTPROPS le LISPFN LEQ) (PUTPROPS GE LISPFN GEQ) (PUTPROPS ge LISPFN GEQ) (PUTPROPS LEQ LISPFN LEQ) (PUTPROPS leq LISPFN LEQ) (PUTPROPS GEQ LISPFN GEQ) (PUTPROPS geq LISPFN GEQ) (PUTPROPS EQUALS LISPFN EQUAL) (PUTPROPS AND LISPFN AND) (PUTPROPS OR LISPFN OR) (PUTPROPS and LISPFN AND) (PUTPROPS or LISPFN OR) (PUTPROPS NOR LISPFN AND) (PUTPROPS nor LISPFN AND) (PUTPROPS NOT UNARYOP T) (PUTPROPS MINUS UNARYOP T) (PUTPROPS LEQ CLISPINFIX le) (PUTPROPS GEQ CLISPINFIX ge) (PUTPROPS EQ CLISPINFIX =) (PUTPROPS NOT CLISPINFIX ~) (PUTPROPS AND CLISPINFIX and) (PUTPROPS OR CLISPINFIX or) (PUTPROPS SETQ CLISPINFIX _) (PUTPROPS IPLUS CLISPINFIX +) (PUTPROPS IMINUS CLISPINFIX -) (PUTPROPS IDIFFERENCE CLISPINFIX +-) (PUTPROPS ITIMES CLISPINFIX *) (PUTPROPS IQUOTIENT CLISPINFIX /) (PUTPROPS ILESSP CLISPINFIX lt) (PUTPROPS IGREATERP CLISPINFIX gt) (PUTPROPS PLUS CLISPINFIX +) (PUTPROPS MINUS CLISPINFIX -) (PUTPROPS DIFFERENCE CLISPINFIX +-) (PUTPROPS TIMES CLISPINFIX *) (PUTPROPS QUOTIENT CLISPINFIX /) (PUTPROPS LESSP CLISPINFIX lt) (PUTPROPS GREATERP CLISPINFIX gt) (PUTPROPS EXPT CLISPINFIX ^) (PUTPROPS LT CLISPCLASS LT) (PUTPROPS lt CLISPCLASS LT) (PUTPROPS GT CLISPCLASS GT) (PUTPROPS gt CLISPCLASS GT) (PUTPROPS LE CLISPCLASS LEQ) (PUTPROPS le CLISPCLASS LEQ) (PUTPROPS GE CLISPCLASS GEQ) (PUTPROPS ge CLISPCLASS GEQ) (PUTPROPS LEQ CLISPCLASS LEQ) (PUTPROPS leq CLISPCLASS LEQ) (PUTPROPS GEQ CLISPCLASS GEQ) (PUTPROPS geq CLISPCLASS GEQ) (PUTPROPS IPLUS CLISPCLASS +) (PUTPROPS IMINUS CLISPCLASS -) (PUTPROPS IDIFFERENCE CLISPCLASS +-) (PUTPROPS ITIMES CLISPCLASS *) (PUTPROPS IQUOTIENT CLISPCLASS /) (PUTPROPS ILESSP CLISPCLASS LT) (PUTPROPS IGREATERP CLISPCLASS GT) (PUTPROPS FPLUS CLISPCLASS +) (PUTPROPS FMINUS CLISPCLASS -) (PUTPROPS FDIFFERENCE CLISPCLASS +-) (PUTPROPS FTIMES CLISPCLASS *) (PUTPROPS FQUOTIENT CLISPCLASS /) (PUTPROPS FGTP CLISPCLASS GT) (PUTPROPS PLUS CLISPCLASS +) (PUTPROPS MINUS CLISPCLASS -) (PUTPROPS DIFFERENCE CLISPCLASS +-) (PUTPROPS TIMES CLISPCLASS *) (PUTPROPS QUOTIENT CLISPCLASS /) (PUTPROPS LESSP CLISPCLASS LT) (PUTPROPS GREATERP CLISPCLASS GT) (PUTPROPS LT CLISPCLASSDEF (ARITH ILESSP LESSP LESSP)) (PUTPROPS GT CLISPCLASSDEF (ARITH IGREATERP FGTP GREATERP)) (PUTPROPS LE CLISPCLASSDEF (ARITH ILEQ LEQ LEQ)) (PUTPROPS GE CLISPCLASSDEF (ARITH IGEQ GEQ GEQ)) (PUTPROPS LEQ CLISPCLASSDEF (ARITH ILEQ LEQ LEQ)) (PUTPROPS GEQ CLISPCLASSDEF (ARITH IGEQ GEQ GEQ)) (PUTPROPS LT CLISPNEG GEQ) (PUTPROPS GT CLISPNEG LEQ) (PUTPROPS EQUALS CLISPNEG ~EQUAL) (PUTPROPS MEMBER CLISPNEG ~MEMBER) (PUTPROPS LT BROADSCOPE T) (PUTPROPS lt BROADSCOPE T) (PUTPROPS GT BROADSCOPE T) (PUTPROPS gt BROADSCOPE T) (PUTPROPS LE BROADSCOPE T) (PUTPROPS le BROADSCOPE T) (PUTPROPS GE BROADSCOPE T) (PUTPROPS ge BROADSCOPE T) (PUTPROPS LEQ BROADSCOPE T) (PUTPROPS leq BROADSCOPE T) (PUTPROPS GEQ BROADSCOPE T) (PUTPROPS geq BROADSCOPE T) (PUTPROPS EQ BROADSCOPE T) (PUTPROPS NEQ BROADSCOPE T) (PUTPROPS EQP BROADSCOPE T) (PUTPROPS EQUAL BROADSCOPE T) (PUTPROPS EQUALS BROADSCOPE T) (PUTPROPS NOT BROADSCOPE T) (PUTPROPS AND BROADSCOPE T) (PUTPROPS OR BROADSCOPE T) (PUTPROPS and BROADSCOPE T) (PUTPROPS or BROADSCOPE T) (PUTPROPS NOR BROADSCOPE T) (PUTPROPS nor BROADSCOPE T) (PUTPROPS MEMBER BROADSCOPE T) (PUTPROPS ILESSP BROADSCOPE T) (PUTPROPS IGREATERP BROADSCOPE T) (PUTPROPS FGTP BROADSCOPE T) (PUTPROPS LESSP BROADSCOPE T) (PUTPROPS GREATERP BROADSCOPE T) (PUTPROPS ELT SETFN SETA) (PUTPROPS SETA SETFN (ELT)) optimize-CLISP% :D8 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) @NIL NIL () (PUTPROP (QUOTE CLISP% ) (QUOTE COMPILER:OPTIMIZER-LIST) (CL:ADJOIN (QUOTE optimize-CLISP% ) (GET ( QUOTE CLISP% ) (QUOTE COMPILER:OPTIMIZER-LIST)))) (PUTPROPS AND CLISPWORD T) (PUTPROPS OR CLISPWORD T) (PUTPROPS and CLISPWORD T) (PUTPROPS or CLISPWORD T) (PUTPROPS ! CLISPWORD T) (PUTPROPS !! CLISPWORD T) (PUTPROPS CLISP CLISPWORD (PREFIXFN . clisp)) (PUTPROPS clisp CLISPWORD (PREFIXFN . clisp)) (PUTPROPS MATCH CLISPWORD (MATCHWORD . match)) (PUTPROPS match CLISPWORD (MATCHWORD . match)) (RPAQQ CLISPIFWORDSPLST (THEN ELSE ELSEIF IF)) (RPAQ? CLISPIFTRANFLG T) (PUTPROPS IF CLISPWORD (IFWORD . if)) (PUTPROPS THEN CLISPWORD (IFWORD . then)) (PUTPROPS ELSE CLISPWORD (IFWORD . else)) (PUTPROPS ELSEIF CLISPWORD (IFWORD . elseif)) (PUTPROPS if CLISPWORD (IFWORD . if)) (PUTPROPS then CLISPWORD (IFWORD . then)) (PUTPROPS else CLISPWORD (IFWORD . else)) (PUTPROPS elseif CLISPWORD (IFWORD . elseif)) (RPAQQ CLISPI.S.GAG NIL) (RPAQQ INITISOPRS (ALWAYS AS BIND BY COLLECT COUNT DECLARE DECLARE%: DO EACHTIME FCOLLECT FINALLY FIND FIRST FOR FROM IN INSIDE ISTHERE JOIN LARGEST NEVER OLD ON ORIGINAL REPEATUNTIL REPEATWHILE SMALLEST SUCHTHAT SUM THEREIS THRU TO UNLESS UNTIL WHEN WHERE WHILE always as bind by collect count declare declare%: do eachtime fcollect finally find first for from in inside isthere join largest never old on original repeatuntil repeatwhile smallest suchthat sum thereis thru to unless until when where while) ) (PUTPROPS ALWAYS CLISPWORD (FORWORD . always)) (PUTPROPS AS CLISPWORD (FORWORD . as)) (PUTPROPS BIND CLISPWORD (FORWORD . bind)) (PUTPROPS BY CLISPWORD (FORWORD . by)) (PUTPROPS COLLECT CLISPWORD (FORWORD . collect)) (PUTPROPS COUNT CLISPWORD (FORWORD . count)) (PUTPROPS DECLARE CLISPWORD (FORWORD . declare)) (PUTPROPS DECLARE%: CLISPWORD (FORWORD declare%: DECLARE)) (PUTPROPS DO CLISPWORD (FORWORD . do)) (PUTPROPS EACHTIME CLISPWORD (FORWORD . eachtime)) (PUTPROPS FCOLLECT CLISPWORD (FORWORD . fcollect)) (PUTPROPS FINALLY CLISPWORD (FORWORD . finally)) (PUTPROPS FIND CLISPWORD (FORWORD find FOR)) (PUTPROPS FIRST CLISPWORD (FORWORD . first)) (PUTPROPS FOR CLISPWORD (FORWORD . for)) (PUTPROPS FROM CLISPWORD (FORWORD . from)) (PUTPROPS IN CLISPWORD (FORWORD . in)) (PUTPROPS INSIDE CLISPWORD (FORWORD . inside)) (PUTPROPS ISTHERE CLISPWORD (FORWORD isthere THEREIS)) (PUTPROPS JOIN CLISPWORD (FORWORD . join)) (PUTPROPS LARGEST CLISPWORD (FORWORD . largest)) (PUTPROPS NEVER CLISPWORD (FORWORD . never)) (PUTPROPS OLD CLISPWORD (FORWORD . old)) (PUTPROPS ON CLISPWORD (FORWORD . on)) (PUTPROPS ORIGINAL CLISPWORD (FORWORD . original)) (PUTPROPS REPEATUNTIL CLISPWORD (FORWORD . repeatuntil)) (PUTPROPS REPEATWHILE CLISPWORD (FORWORD . repeatwhile)) (PUTPROPS SMALLEST CLISPWORD (FORWORD . smallest)) (PUTPROPS SUCHTHAT CLISPWORD (FORWORD suchthat THEREIS)) (PUTPROPS SUM CLISPWORD (FORWORD . sum)) (PUTPROPS THEREIS CLISPWORD (FORWORD . thereis)) (PUTPROPS THRU CLISPWORD (FORWORD thru TO)) (PUTPROPS TO CLISPWORD (FORWORD . to)) (PUTPROPS UNLESS CLISPWORD (FORWORD . unless)) (PUTPROPS UNTIL CLISPWORD (FORWORD . until)) (PUTPROPS WHEN CLISPWORD (FORWORD . when)) (PUTPROPS WHERE CLISPWORD (FORWORD where WHEN)) (PUTPROPS WHILE CLISPWORD (FORWORD . while)) (PUTPROPS always CLISPWORD (FORWORD . always)) (PUTPROPS as CLISPWORD (FORWORD . as)) (PUTPROPS bind CLISPWORD (FORWORD . bind)) (PUTPROPS by CLISPWORD (FORWORD . by)) (PUTPROPS collect CLISPWORD (FORWORD . collect)) (PUTPROPS count CLISPWORD (FORWORD . count)) (PUTPROPS declare CLISPWORD (FORWORD . declare)) (PUTPROPS declare%: CLISPWORD (FORWORD declare%: DECLARE)) (PUTPROPS do CLISPWORD (FORWORD . do)) (PUTPROPS eachtime CLISPWORD (FORWORD . eachtime)) (PUTPROPS fcollect CLISPWORD (FORWORD . fcollect)) (PUTPROPS finally CLISPWORD (FORWORD . finally)) (PUTPROPS find CLISPWORD (FORWORD find FOR)) (PUTPROPS first CLISPWORD (FORWORD . first)) (PUTPROPS for CLISPWORD (FORWORD . for)) (PUTPROPS from CLISPWORD (FORWORD . from)) (PUTPROPS in CLISPWORD (FORWORD . in)) (PUTPROPS inside CLISPWORD (FORWORD . inside)) (PUTPROPS isthere CLISPWORD (FORWORD isthere thereis)) (PUTPROPS join CLISPWORD (FORWORD . join)) (PUTPROPS largest CLISPWORD (FORWORD . largest)) (PUTPROPS never CLISPWORD (FORWORD . never)) (PUTPROPS old CLISPWORD (FORWORD . old)) (PUTPROPS on CLISPWORD (FORWORD . on)) (PUTPROPS original CLISPWORD (FORWORD . original)) (PUTPROPS repeatuntil CLISPWORD (FORWORD . repeatuntil)) (PUTPROPS repeatwhile CLISPWORD (FORWORD . repeatwhile)) (PUTPROPS smallest CLISPWORD (FORWORD . smallest)) (PUTPROPS suchthat CLISPWORD (FORWORD suchthat THEREIS)) (PUTPROPS sum CLISPWORD (FORWORD . sum)) (PUTPROPS thereis CLISPWORD (FORWORD . thereis)) (PUTPROPS thru CLISPWORD (FORWORD thru TO)) (PUTPROPS to CLISPWORD (FORWORD . to)) (PUTPROPS unless CLISPWORD (FORWORD . unless)) (PUTPROPS until CLISPWORD (FORWORD . until)) (PUTPROPS when CLISPWORD (FORWORD . when)) (PUTPROPS where CLISPWORD (FORWORD where WHEN)) (PUTPROPS while CLISPWORD (FORWORD . while)) (PUTPROPS always I.S.OPR ((COND ((NULL BODY) (SETQ $$VAL NIL) (GO $$OUT))) BIND (SETQ $$VAL T))) (PUTPROPS collect I.S.OPR ((SETQ $$VAL (NCONC1 $$VAL BODY)))) (PUTPROPS count I.S.OPR ((AND BODY (SETQ $$VAL (ADD1 $$VAL))) BIND ($$VAL _ 0))) (PUTPROPS do I.S.OPR (BODY)) (PUTPROPS fcollect I.S.OPR ((= SUBPAIR (QUOTE (VAR1 VAR2)) (LIST (GETDUMMYVAR T) (GETDUMMYVAR T)) ( QUOTE (PROGN (SETQ VAR1 BODY) (COND (VAR2 (FRPLACD VAR2 (SETQ VAR2 (LIST VAR1)))) (T (SETQ $$VAL (SETQ VAR2 (LIST VAR1)))))))))) (PUTPROPS inside I.S.OPR (NIL = SUBST (GETDUMMYVAR) (QUOTE VAR) (QUOTE (bind (VAR _ BODY) eachtime ( COND ((NULL VAR) (GO $$OUT)) ((NLISTP VAR) (SETQ I.V. VAR) (SETQ VAR NIL)) (T (SETQ I.V. (CAR VAR)) ( SETQ VAR (CDR VAR)))))))) (PUTPROPS join I.S.OPR ((SETQ $$VAL (NCONC $$VAL BODY)))) (PUTPROPS largest I.S.OPR (NIL = SUBST (GETDUMMYVAR) (QUOTE $$TEMP) (QUOTE (BIND $$EXTREME $$TEMP DO ( SETQ $$TEMP BODY) (COND ((OR (NULL $$EXTREME) (GREATERP $$TEMP $$EXTREME)) (SETQ $$EXTREME $$TEMP) ( SETQ $$VAL I.V.))))))) (PUTPROPS never I.S.OPR ((COND (BODY (SETQ $$VAL NIL) (GO $$OUT))) BIND ($$VAL _ T))) (PUTPROPS old I.S.OPR MODIFIER) (PUTPROPS smallest I.S.OPR (NIL = SUBST (GETDUMMYVAR) (QUOTE $$TEMP) (QUOTE (BIND $$EXTREME $$TEMP DO (SETQ $$TEMP BODY) (COND ((OR (NULL $$EXTREME) (LESSP $$TEMP $$EXTREME)) (SETQ $$EXTREME $$TEMP) (SETQ $$VAL I.V.))))))) (PUTPROPS sum I.S.OPR ((SETQ $$VAL (PLUS $$VAL BODY)) BIND ($$VAL _ 0))) (PUTPROPS thereis I.S.OPR ((COND (BODY (SETQ $$VAL (OR I.V. T)) (GO $$OUT))))) (ADDTOVAR I.S.OPRLST ALWAYS AS BIND BY COLLECT COUNT DECLARE DECLARE%: DO EACHTIME FCOLLECT FINALLY FIND FIRST FOR FROM IN INSIDE ISTHERE JOIN LARGEST NEVER OLD ON ORIGINAL REPEATUNTIL REPEATWHILE SMALLEST SUCHTHAT SUM THEREIS THRU TO UNLESS UNTIL WHEN WHERE WHILE always as bind by collect count declare declare%: do eachtime fcollect finally find first for from in inside isthere join largest never old on original repeatuntil repeatwhile smallest suchthat sum thereis thru to unless until when where while) (ADDTOVAR CLISPFORWORDSPLST ALWAYS AS BIND BY COLLECT COUNT DECLARE DECLARE%: DO EACHTIME FCOLLECT FINALLY FIND FIRST FOR FROM IN INSIDE ISTHERE JOIN LARGEST NEVER OLD ON ORIGINAL REPEATUNTIL REPEATWHILE SMALLEST SUCHTHAT SUM THEREIS THRU TO UNLESS UNTIL WHEN WHERE WHILE) (RPAQQ CLISPDUMMYFORVARS ($$TEM0 $$TEM1 $$TEM2 $$TEM3 $$TEM4 $$TEM5 $$TEM6)) (ADDTOVAR SYSLOCALVARS $$TEM0 $$TEM1 $$TEM2 $$TEM3 $$TEM4 $$TEM5 $$TEM6) (ADDTOVAR INVISIBLEVARS $$TEM0 $$TEM1 $$TEM2 $$TEM3 $$TEM4 $$TEM5 $$TEM6) (ADDTOVAR SYSLOCALVARS $$VAL $$TEM $$LST1 $$LST2 $$LST3 $$LST4 $$LST5 $$LST6 $$END $$EXTREME) (ADDTOVAR INVISIBLEVARS $$VAL $$END $$TEM $$LST1 $$LST2 $$LST3 $$LST4 $$LST5 $$LST6 $$EXTREME) (PUTDEF (QUOTE I.S.OPRS) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO (X (DECLARE%: EVAL@COMPILE (P * ( DUMPI.S.OPRS . X)))) CONTENTS NILL) (TYPE DESCRIPTION "i.s. operators" GETDEF GETDEF.I.S.OPR WHENCHANGED (CLEARCLISPARRAY))))) DUMPI.S.OPRS :D8 (P 3 Y I 0 X) A@@7d[ dgKgghid IHhZH&J(44 LISPXPRINT 13 GETDEF.I.S.OPR) (32 defined 27 not 21 I.S.OPR) () GETDEF.I.S.OPR :D8 (P 2 EVALFLG P 1 BODY P 0 TEM I 0 Y) 4pg@dddi@3 g@h@g -XdgHdg -Ykaplan>local>medley3.5>working-medley>sources>DWIMIFY.;2 310341 +(FILECREATED "21-Feb-2026 16:14:43" {WMEDLEY}DWIMIFY.;3 309375 - :CHANGES-TO (FNS CLISPFOR0) + :EDIT-BY rmk - :PREVIOUS-DATE "16-May-90 16:21:27" -{DSK}kaplan>local>medley3.5>working-medley>sources>DWIMIFY.;1) + :CHANGES-TO (VARS DWIMIFYCOMS) + :PREVIOUS-DATE "14-Sep-2022 10:25:44" {WMEDLEY}DWIMIFY.;2) -(* ; " -Copyright (c) 1978, 1984-1986, 1990 by Venue & Xerox Corporation. -The following program was created in 1978 but has not been published -within the meaning of the copyright law, is furnished under license, -and may not be used, copied and/or disclosed except in accordance -with the terms of said license. -") (PRETTYCOMPRINT DWIMIFYCOMS) @@ -35,33 +27,36 @@ with the terms of said license. CLISPFORVARS1 CLISPFOR4 CLISPFORF/L CLISPDSUBST GETDUMMYVAR CLISPFORINITVAR) (COMS (FNS \DURATIONTRAN \CLISPKEYWORDPROCESS)) (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS DWIMUNDOCATCH)) - (BLOCKS (FORBLOCK (ENTRIES CLISPFOR) - CLISPFORVARS CLISPFOR0 CLISPFOR2 CLISPFORINITVAR CLISPDSUBST - \CLISPKEYWORDPROCESS CLISPFORF/L CLISPFOR4 CLISPFORVARS1 CLISPFOR3 CLISPFOR1 - CLISPFOR0A CLISPFOR \DURATIONTRAN - (SPECVARS UNDOSIDE LISPXHIST BODY I.S.TYPE1 I.S.TYPE TERMINATEFLG FIRSTI.V. - I.V. PROGVARS MAKEPROGFLG IVINITFLG INITVARS UNDOLST DWIMIFYING VARS - DWIMIFYCHANGE DUMMYVARS I.S.OPRSLST CLISPCONTEXT UNDOSIDE0 EXP)) - (DWIMIFYBLOCK CLBINARYMINUS? CLISPANGLEBRACKETS CLISPATOM CLISPATOM0 CLISPATOM1 - CLISPATOM1A CLISPATOM1B CLISPATOM2 CLISPATOM2A CLISPATOM2C CLISPATOM2D - CLISPATOMARE1 CLISPATOMARE2 CLISPATOMIS1 CLISPATOMIS2 CLISPBROADSCOPE - CLISPBROADSCOPE1 CLISPCAR/CDR CLISPCAR/CDR1 CLISPCAR/CDR2 CLISPIF CLISPIF0 - CLISPIF1 CLISPIF2 CLISPIF3 CLISPLOOKUP CLISPRESPELL CLRPLNODE CLUNARYMINUS? - DWIMIFY DWIMIFY0 DWIMIFY0? DWIMIFY1 DWIMIFY1? DWIMIFY1A DWIMIFY2 DWIMIFY2? - DWIMIFY2A DWIMIFYFNS DWMFY0 DWMFY1 DWMFY2 FIX89 FIX89A FIX89TYPEIN FIXAPPLY - FIXATOM FIXATOM1 FIXCONTINUE FIXCONTINUE1 FIXLAMBDA GETDUMMYVAR GETVARS - GETVARS1 RETDWIM RETDWIM1 SHRIEKER STOPSCAN? WTFIX WTFIX0 WTFIX1 - (ENTRIES WTFIX WTFIX1 DWIMIFYFNS DWIMIFY DWIMIFY0 DWIMIFY0? DWIMIFY1A - GETDUMMYVAR DWIMIFY2 DWIMIFY2? DWIMIFY1? DWIMIFY1 DWIMIFY2A CLISPLOOKUP) - (SPECVARS 89CHANGE 89FLG BRACKET BRACKETCNT ATTEMPTFLG BACKUPFLG BODY BREAKFLG - BROADSCOPE CLISPCHANGE CLISPCHANGES CLISPCONTEXT CLISPERTYPE CLTYP - CURRTAIL DWIMIFYCHANGE DWIMIFY0CHANGE DWIMIFYFLG DWIMIFYING ENDTAIL EXP - EXPR FAULTAPPLYFLG FAULTARGS FAULTFN FAULTPOS FAULTX FAULTXX FIRSTI.V. - FIXCLK FORMSFLG I.S.TYPE I.S.TYPE1 HISTENTRY I.S. I.V. INITVARS - IVINITFLG LISPFN CHARLST MAKEPROGFLG NCONC1LKUP NCONCLKUP NEGFLG NEWTAIL - NEXTAIL SUBPARENT NOFIX89 NOSAVEFLG ONEFLG ONLYSPELLFLG PARENT SIDES - TAIL TENTATIVE TERMINATEFLG TYP TYPE-IN? UNDOLST UNDOSIDE UNDOSIDE0 VAR1 - VAR2 VARS WORKFLAG UNARYFLG DEST FOR I.S.OPRSLST PROGVARS))) + (* BLOCKS + (FORBLOCK (ENTRIES CLISPFOR) + CLISPFORVARS CLISPFOR0 CLISPFOR2 CLISPFORINITVAR CLISPDSUBST \CLISPKEYWORDPROCESS + CLISPFORF/L CLISPFOR4 CLISPFORVARS1 CLISPFOR3 CLISPFOR1 CLISPFOR0A CLISPFOR + \DURATIONTRAN + (SPECVARS UNDOSIDE LISPXHIST BODY I.S.TYPE1 I.S.TYPE TERMINATEFLG FIRSTI.V. I.V. + PROGVARS MAKEPROGFLG IVINITFLG INITVARS UNDOLST DWIMIFYING VARS + DWIMIFYCHANGE DUMMYVARS I.S.OPRSLST CLISPCONTEXT UNDOSIDE0 EXP))) + (BLOCKS (DWIMIFYBLOCK CLBINARYMINUS? CLISPANGLEBRACKETS CLISPATOM CLISPATOM0 CLISPATOM1 + CLISPATOM1A CLISPATOM1B CLISPATOM2 CLISPATOM2A CLISPATOM2C CLISPATOM2D + CLISPATOMARE1 CLISPATOMARE2 CLISPATOMIS1 CLISPATOMIS2 CLISPBROADSCOPE + CLISPBROADSCOPE1 CLISPCAR/CDR CLISPCAR/CDR1 CLISPCAR/CDR2 CLISPIF CLISPIF0 + CLISPIF1 CLISPIF2 CLISPIF3 CLISPLOOKUP CLISPRESPELL CLRPLNODE CLUNARYMINUS? + DWIMIFY DWIMIFY0 DWIMIFY0? DWIMIFY1 DWIMIFY1? DWIMIFY1A DWIMIFY2 DWIMIFY2? + DWIMIFY2A DWIMIFYFNS DWMFY0 DWMFY1 DWMFY2 FIX89 FIX89A FIX89TYPEIN FIXAPPLY + FIXATOM FIXATOM1 FIXCONTINUE FIXCONTINUE1 FIXLAMBDA GETDUMMYVAR GETVARS + GETVARS1 RETDWIM RETDWIM1 SHRIEKER STOPSCAN? WTFIX WTFIX0 WTFIX1 + (ENTRIES WTFIX WTFIX1 DWIMIFYFNS DWIMIFY DWIMIFY0 DWIMIFY0? DWIMIFY1A + GETDUMMYVAR DWIMIFY2 DWIMIFY2? DWIMIFY1? DWIMIFY1 DWIMIFY2A CLISPLOOKUP + ) + (SPECVARS 89CHANGE 89FLG BRACKET BRACKETCNT ATTEMPTFLG BACKUPFLG BODY BREAKFLG + BROADSCOPE CLISPCHANGE CLISPCHANGES CLISPCONTEXT CLISPERTYPE CLTYP + CURRTAIL DWIMIFYCHANGE DWIMIFY0CHANGE DWIMIFYFLG DWIMIFYING ENDTAIL EXP + EXPR FAULTAPPLYFLG FAULTARGS FAULTFN FAULTPOS FAULTX FAULTXX FIRSTI.V. + FIXCLK FORMSFLG I.S.TYPE I.S.TYPE1 HISTENTRY I.S. I.V. INITVARS + IVINITFLG LISPFN CHARLST MAKEPROGFLG NCONC1LKUP NCONCLKUP NEGFLG + NEWTAIL NEXTAIL SUBPARENT NOFIX89 NOSAVEFLG ONEFLG ONLYSPELLFLG PARENT + SIDES TAIL TENTATIVE TERMINATEFLG TYP TYPE-IN? UNDOLST UNDOSIDE + UNDOSIDE0 VAR1 VAR2 VARS WORKFLAG UNARYFLG DEST FOR I.S.OPRSLST + PROGVARS))) (GLOBALVARS DWIMINMACROSFLG CHECKCARATOMFLG TREATASCLISPFLG CLISPHELPFLG CLISPIFTRANFLG CLISPRETRANFLG DWIMCHECKPROGLABELSFLG DWIMCHECK#ARGSFLG SHALLOWFLG PRETTYTRANFLG CLEARSTKLST LCASEFLG LAMBDASPLST DURATIONCLISPWORDS CLISPTRANFLG CLISPIFWORDSPLST @@ -79,7 +74,7 @@ with the terms of said license. (DEFINEQ (DWIMIFYFNS - [NLAMBDA FNS (* lmm "20-May-84 19:57") + [NLAMBDA FNS (* lmm "20-May-84 19:57") (PROG ((CLK (CLOCK 0)) TEM) (SETQ NOFIXFNSLST0 NOFIXFNSLST) @@ -91,8 +86,8 @@ with the terms of said license. (STKEVAL 'DWIMIFYFNS (CAR FNS) NIL 'INTERNAL)) - (T (* ; - "If (CAR FNS) is name of a file, do dwimifyfns on its functions.") + (T (* ; + "If (CAR FNS) is name of a file, do dwimifyfns on its functions.") (OR (LISTP (EVALV (CAR FNS) 'DWIMIFYFNS)) (AND (GETPROP (OR (AND DWIMFLG (MISSPELLED? (CAR FNS) @@ -107,13 +102,16 @@ with the terms of said license. (RETURN TEM]) (DWIMIFY - [LAMBDA (X QUIETFLG L) (* lmm "20-May-84 19:57") + [LAMBDA (X QUIETFLG L) (* lmm "20-May-84 19:57") (PROG (VAL) (COND ((NULL DWIMFLG) (LISPXPRIN1 "DWIM is turned off! " T) - (RETURN NIL))) (* ;; "If X is an atom and L is NIL, X is treated as the name of a function, and its entire definition is DWIMIFIED. Otherwise, X is a piece of a function, and L the edit puh down list that leads to X (i.e. L is the push-dwown list after performing a !0) L is used to compute the bound variables, as well as to determine whether X is an element or tail.") + (RETURN NIL))) + + (* ;; "If X is an atom and L is NIL, X is treated as the name of a function, and its entire definition is DWIMIFIED. Otherwise, X is a piece of a function, and L the edit puh down list that leads to X (i.e. L is the push-dwown list after performing a !0) L is used to compute the bound variables, as well as to determine whether X is an element or tail.") + (SETQ NOFIXFNSLST0 NOFIXFNSLST) (SETQ NOFIXVARSLST0 NOFIXVARSLST) (SETQ VAL (DWIMIFY0 X L)) @@ -128,23 +126,25 @@ with the terms of said license. (RETURN VAL]) (DWIMIFY0 - [LAMBDA (X Y VARS EXPR) (* lmm "27-FEB-83 10:55") - (* ;; "Some general comments: --- DWIMIFYFLG is bound in DWIMIFY0, WTFIX, and WTFIX0. It is set to T whenever WTFIX is called and given EXPR, TAIL, PARENT, etc. as arguments, i.e. from DWIMIFY1 or DWIMIFY2. Note that this may occur due to an explicit call to DWIMIFY0, or due to evaluating certain CLISP expressions, e.g. IF statements, which call DWIMIFY1 or DWIMIFY2. These two cases are distinguished by the value of DWIMIFYING. --- DWIMIFYING is bound in DWIMIFY0 (to T), and whenever DWIMIFY1 or DWIMIFY2 are called from contexts where DWIMIFYING may not be bound, e.g. from CLISPIF. In these latter cases, DWIMIFYING is bound to (AND DWIMIFYFLG DWIMIFYING). Thus DWIMIFYING is always bound when DWIMIFYFLG is bound, and is T when under a call to DWIMIFY0, otherwise NIL. Note that checking DWIMIFYING without also checking DWIMIFYFLG may cause a U.B.A. DWIMIFYING error. Similary, other state variables that are bound in DWIMIFY0 but not rebound by DWIMIFY1 or DWIMIFY2 such as CLISPCONTEXT, DWIMIFYCHANGE, etc., are assumed to be bound when DWIMIFYFLG is T, so that any call to DWIMIFY1 or DWIMIFY2 must also guarantee that these variables are bound. If the caller is not sure, it should use DWIMIFY1? and DWIMIFY2? since these do the appropriate checks. --- NOFIXFNSLST0 and NOFIXVARSLST0 are global varaales. They are initializaed to NOFIXFNSLST and NOFIXVARLST by DWIMIFY and DWIMIFYFNS, as well as CLISPIF, CLISPFOR, etc. when they enter the DWIMIFY functions, i.e. DWIMIFY1 and DWIMIFY2 for the first time. NOFIXFNSLST and NOFIXVARLST are the variable that the user can add things to. --- VARS is bound in WTFIX and in DWIMIFY0. DWIMIFY1 and DWIMIFY2 supply VARS in their call to WTFIX. Otherwise WTFIX comptes them. --- ATTEMPTFLG is bound in DWIMIFY1 and DWIMIFY2. It is used to inform DWIMIFY1 or DWIMIFY2, in the event that WTFIX was unable to make a correction, NOT to add the atom to NOFIXLST. For example, this occurs when a correction was offered to the user but rejected, e.g. U.D.F. T, and user declines the fix, T is not added to NOFIXLST.") + [LAMBDA (X Y VARS EXPR) (* lmm "27-FEB-83 10:55") + + (* ;; "Some general comments: --- DWIMIFYFLG is bound in DWIMIFY0, WTFIX, and WTFIX0. It is set to T whenever WTFIX is called and given EXPR, TAIL, PARENT, etc. as arguments, i.e. from DWIMIFY1 or DWIMIFY2. Note that this may occur due to an explicit call to DWIMIFY0, or due to evaluating certain CLISP expressions, e.g. IF statements, which call DWIMIFY1 or DWIMIFY2. These two cases are distinguished by the value of DWIMIFYING. --- DWIMIFYING is bound in DWIMIFY0 (to T), and whenever DWIMIFY1 or DWIMIFY2 are called from contexts where DWIMIFYING may not be bound, e.g. from CLISPIF. In these latter cases, DWIMIFYING is bound to (AND DWIMIFYFLG DWIMIFYING). Thus DWIMIFYING is always bound when DWIMIFYFLG is bound, and is T when under a call to DWIMIFY0, otherwise NIL. Note that checking DWIMIFYING without also checking DWIMIFYFLG may cause a U.B.A. DWIMIFYING error. Similary, other state variables that are bound in DWIMIFY0 but not rebound by DWIMIFY1 or DWIMIFY2 such as CLISPCONTEXT, DWIMIFYCHANGE, etc., are assumed to be bound when DWIMIFYFLG is T, so that any call to DWIMIFY1 or DWIMIFY2 must also guarantee that these variables are bound. If the caller is not sure, it should use DWIMIFY1? and DWIMIFY2? since these do the appropriate checks. --- NOFIXFNSLST0 and NOFIXVARSLST0 are global varaales. They are initializaed to NOFIXFNSLST and NOFIXVARLST by DWIMIFY and DWIMIFYFNS, as well as CLISPIF, CLISPFOR, etc. when they enter the DWIMIFY functions, i.e. DWIMIFY1 and DWIMIFY2 for the first time. NOFIXFNSLST and NOFIXVARLST are the variable that the user can add things to. --- VARS is bound in WTFIX and in DWIMIFY0. DWIMIFY1 and DWIMIFY2 supply VARS in their call to WTFIX. Otherwise WTFIX comptes them. --- ATTEMPTFLG is bound in DWIMIFY1 and DWIMIFY2. It is used to inform DWIMIFY1 or DWIMIFY2, in the event that WTFIX was unable to make a correction, NOT to add the atom to NOFIXLST. For example, this occurs when a correction was offered to the user but rejected, e.g. U.D.F. T, and user declines the fix, T is not added to NOFIXLST.") + (PROG (FN FAULTFN DWIMIFY0CHANGE DWIMIFYCHANGE TEM CLISPCONTEXT ONEFLG (DWIMIFYING T) (DWIMIFYFLG T) [SIDES (CDR (LISTGET1 LISPXHIST 'SIDE] TYPE-IN? (FIXSPELLDEFAULT 'n)) (RETURN (COND - [(LISTP Y) (* ; "from DW command") + [(LISTP Y) (* ; "from DW command") [COND ([LISTP (SETQ FAULTFN (EVALV 'ATM] - (SETQ FAULTFN (CAR FAULTFN] (* ; "ATM is bound in EDITE.") + (SETQ FAULTFN (CAR FAULTFN] (* ; "ATM is bound in EDITE.") (SETQ VARS (VARSBOUNDINEDITCHAIN Y)) (SETQ EXPR (OR (CAR (LAST Y)) X)) - (LISPXPUT 'RESPELLS NIL NIL LISPXHIST) (* ; - "Essentially, a new call to DW is treated as a new event.") + (LISPXPUT 'RESPELLS NIL NIL LISPXHIST) (* ; + "Essentially, a new call to DW is treated as a new event.") (COND ((TAILP X (CAR Y)) (DWIMIFY2 X (CAR Y))) @@ -169,26 +169,32 @@ with the terms of said license. X) X) (T (DWIMIFY1 X] - (Y (* ; - "called from compileuserfn or compile1a. X is the expression to be dwimified.") + (Y (* ; + "called from compileuserfn or compile1a. X is the expression to be dwimified.") (SETQ FAULTFN Y) (AND (NULL EXPR) - (SETQ EXPR X)) (* ;; "EXPR is supplied on calls from compileuserfn. it is the top level def. on calls from compile1a, x and expr are the same") + (SETQ EXPR X)) + + (* ;; "EXPR is supplied on calls from compileuserfn. it is the top level def. on calls from compile1a, x and expr are the same") + (SETQ TEM (DWIMIFY1 X)) (AND DWIMIFY0CHANGE (DWIMARKASCHANGED FAULTFN SIDES)) TEM) - ((LISTP X) (* ; - "e.g. user types in a direct call to dwimify an xpression") + ((LISTP X) (* ; + "e.g. user types in a direct call to dwimify an xpression") (SETQQ FAULTFN TYPE-IN) (SETQ EXPR X) (DWIMIFY1 X)) - (T (* ; "DWIMIFY (functon-name)") - (SETQ TEM (EXPRCHECK X)) (* ; - "If EXPRCHECK performs spelling correction, it will rset FN.") + (T (* ; "DWIMIFY (functon-name)") + (SETQ TEM (EXPRCHECK X)) (* ; + "If EXPRCHECK performs spelling correction, it will rset FN.") (SETQ FAULTFN (SETQ FN (CAR TEM))) (DWIMIFY1 (SETQ EXPR (CDR TEM))) [COND - (DWIMIFY0CHANGE (* ;; "DWIMIFY0CHANGE is only bound in DWIMIFY0. it is only reset (in RETDWIM) when DWIMIFYFLG and DWIMIFYING are both T. It is true if there was ANY change in the entire expression. DWIMIFYCHANGE on the other hand is bound wheever DWIMIFYFLG is T, and it is true if there was any change in the prticular level expression being worked on.") + (DWIMIFY0CHANGE + + (* ;; "DWIMIFY0CHANGE is only bound in DWIMIFY0. it is only reset (in RETDWIM) when DWIMIFYFLG and DWIMIFYING are both T. It is true if there was ANY change in the entire expression. DWIMIFYCHANGE on the other hand is bound wheever DWIMIFYFLG is T, and it is true if there was any change in the prticular level expression being worked on.") + (DWIMARKASCHANGED FN SIDES) (COND ([OR (NOT (FGETD FN)) @@ -199,23 +205,31 @@ with the terms of said license. (DWIMIFY0? [LAMBDA (TAIL PARENT SUBPARENT FORMSFLG ONEFLG FAULTFN CLISPCONTEXT) - (* lmm "27-MAY-82 09:54") - (* ;; "DWIMIFY0? is an external entry to DWIMIFYBLOCK It is used to dwimify an expression where the contxt may or may not be under aother call to dwimify. it is used by RECORD, MATCH etc. as well s by CLISP4 in CLISPIFY.") - (* ;; "The value of DWIMIFY0? is NOT the expression (dwiified) but T or NIL depending on whether or not there was any change, i.e. the value of dwiifychange.") + (* lmm "27-MAY-82 09:54") + + (* ;; "DWIMIFY0? is an external entry to DWIMIFYBLOCK It is used to dwimify an expression where the contxt may or may not be under aother call to dwimify. it is used by RECORD, MATCH etc. as well s by CLISP4 in CLISPIFY.") + + (* ;; "The value of DWIMIFY0? is NOT the expression (dwiified) but T or NIL depending on whether or not there was any change, i.e. the value of dwiifychange.") + (PROG NIL (SELECTQ DWIMIFYFLG - (NIL (* ;; "Under a call to WTFIX, but not under a call to DWIMIFY, e.g. from evaluating a CREATE expression in a user program.") + (NIL + (* ;; "Under a call to WTFIX, but not under a call to DWIMIFY, e.g. from evaluating a CREATE expression in a user program.") + (SETQ NOFIXFNSLST0 NOFIXFNSLST) (SETQ NOFIXVARSLST0 NOFIXVARSLST)) - ((CLISPIFY VARSBOUND) (* ;; "e.g. call from clispify or record package. WAnt it to look like we are inside of a call to dwimify. calling function has already set up VARS and EXPR.") + ((CLISPIFY VARSBOUND) + + (* ;; "e.g. call from clispify or record package. WAnt it to look like we are inside of a call to dwimify. calling function has already set up VARS and EXPR.") + (SETQ NOFIXFNSLST0 NOFIXFNSLST) (SETQ NOFIXVARSLST0 NOFIXVARSLST) [RETURN (PROG ((DWIMIFY0CHANGE T) - (DWIMIFYING T)) (* ; - "This is going to be treated as though were a caal to dwimify.") + (DWIMIFYING T)) (* ; + "This is going to be treated as though were a caal to dwimify.") (RETURN (DWMFY0]) - (EVAL (* ; - "random call to dwimify0? EVAL IS THE TOP LEVEL VALUE OF DWIMIFYFLG") + (EVAL (* ; + "random call to dwimify0? EVAL IS THE TOP LEVEL VALUE OF DWIMIFYFLG") (SETQ NOFIXFNSLST0 NOFIXFNSLST) (SETQ NOFIXVARSLST0 NOFIXVARSLST) [RETURN (PROG (DWIMIFYFLG FAULTPOS EXPR VARS) @@ -243,7 +257,9 @@ with the terms of said license. [LAMBDA (FORM CLISPCONTEXT FORMSFLG) (COND (DWIMIFYFLG (DWMFY1 FORM)) - (T (* ;; "See comment in dwimify0. DWIMIFY1? is used where caller is not sure whether state variables have been set up.") + (T + (* ;; "See comment in dwimify0. DWIMIFY1? is used where caller is not sure whether state variables have been set up.") + (PROG ((DWIMIFYING (AND DWIMIFYFLG DWIMIFYING)) (DWIMIFYFLG T) DWIMIFYCHANGE) @@ -252,7 +268,7 @@ with the terms of said license. (RETURN (DWMFY1 FORM]) (DWMFY1 - [LAMBDA (FORM) (* lmm " 3-Jan-86 21:29") + [LAMBDA (FORM) (* lmm " 3-Jan-86 21:29") (PROG ((X FORM) CARFORM TEM CLISPCHANGE 89CHANGE ATTEMPTFLG CARISOKFLG) [COND @@ -273,7 +289,10 @@ with the terms of said license. CLISPRETRANFLG (RETURN X)) (NOT (COND - [(LISTP CARFORM) (* ;; "Checks whether CAR is a function object with a remote translation. Also converts to hash array from CLISP if hash array exists. CARISOKFLG is set so dont have to recheck at LP1.") + [(LISTP CARFORM) + + (* ;; "Checks whether CAR is a function object with a remote translation. Also converts to hash array from CLISP if hash array exists. CARISOKFLG is set so dont have to recheck at LP1.") + (OR (EQ (SETQ TEM (OR (CDR (FASSOC (CAAR X) DWIMEQUIVLST)) (CAAR X))) @@ -282,37 +301,46 @@ with the terms of said license. (SETQ CARISOKFLG (AND (CHECKTRAN CARFORM) (NULL CLISPRETRANFLG] ((LITATOM CARFORM) - (CLISP-SIMPLE-FUNCTION-P CARFORM](* ; - "The AND is true if CAR of form is not recognized.") + (CLISP-SIMPLE-FUNCTION-P CARFORM](* ; + "The AND is true if CAR of form is not recognized.") (COND [(PROG (NEXTAIL) - (RETURN (WTFIX0 X X X X))) (* ; "Successful correction.") + (RETURN (WTFIX0 X X X X))) (* ; "Successful correction.") (COND ((CHECKTRAN X) (RETURN X)) [CLISPCHANGE (COND ((NEQ CLISPCHANGE 'PARTIAL) - (* ;; "The tail must be DWIMIFIED if the transformation did not affect the entire form, e.g. (FOO<...> ...)") + + (* ;; "The tail must be DWIMIFIED if the transformation did not affect the entire form, e.g. (FOO<...> ...)") + (RETURN FORM)) ((LISTP CARFORM) (GO DWIMIFYTAIL)) (T (SETQ CLISPCHANGE NIL) - (GO TOP) (* ; - "Recheck CAR of FORM, as it may still be misspelled.") + (GO TOP) (* ; + "Recheck CAR of FORM, as it may still be misspelled.") ] (89CHANGE (SETQ 89CHANGE NIL) - (GO TOP) (* ; - "Recheck CAR of FORM, as it still may be misspelled, e.g. (conss8car X)") + (GO TOP) (* ; + "Recheck CAR of FORM, as it still may be misspelled, e.g. (conss8car X)") ] ((AND CLISPCHANGE (NEQ CLISPCHANGE 'PARTIAL)) - (* ;; "This means a CLISPCHANGE failed and not to bother with dwimifying rest of form, e.g. a bad IF or FOR statement.") + + (* ;; "This means a CLISPCHANGE failed and not to bother with dwimifying rest of form, e.g. a bad IF or FOR statement.") + (RETURN FORM)) ((AND (NULL ATTEMPTFLG) - (LITATOM CARFORM)) (* ;; "ATTEMPTFLG is used to distinguish between the case where DWIM does not recognize the problem at all, and that where it did but was unable to make the correction, e.g. a malformed IF, or else the user vetoed the correction.") + (LITATOM CARFORM)) + + (* ;; "ATTEMPTFLG is used to distinguish between the case where DWIM does not recognize the problem at all, and that where it did but was unable to make the correction, e.g. a malformed IF, or else the user vetoed the correction.") + (SETQ NOFIXFNSLST0 (CONS CARFORM NOFIXFNSLST0] - (* ;; "The call to WTFIX is made before specific checks on CAR of FORM, since CAR of the FORM may be misspelled.") + + (* ;; "The call to WTFIX is made before specific checks on CAR of FORM, since CAR of the FORM may be misspelled.") + (COND - ((LISTP CARFORM) (* ; "Skip selectq") + ((LISTP CARFORM) (* ; "Skip selectq") (GO DWIMIFYTAIL))) [SELECTQ CARFORM (* ; "NIL") @@ -320,8 +348,8 @@ with the terms of said license. (FUNCTION (LAMBDA (X) (SELECTQ (CAR X) ((USEDFREE GLOBALVARS) - (* ; - "SPECVARS AND LOCALVARS WOULD PRESUMABLY BE BOUND SOMEWHERE SO NO NEED TO ADD THEM") + (* ; + "SPECVARS AND LOCALVARS WOULD PRESUMABLY BE BOUND SOMEWHERE SO NO NEED TO ADD THEM") (SETQ NOFIXVARSLST0 (UNION (LISTP (CDR X)) NOFIXVARSLST0))) NIL]) @@ -358,8 +386,8 @@ with the terms of said license. (DWIMIFY2 X X NIL T]) (FUNCTION [DWIMIFY1 (COND ((LISTP (CADR X))) - ((NULL (CDDR X)) (* ; - "Doesnt DWIMIFY for (FUCNTION FOO (X Y)) i.e. FUNARY with atomic argument.") + ((NULL (CDDR X)) (* ; + "Doesnt DWIMIFY for (FUCNTION FOO (X Y)) i.e. FUNARY with atomic argument.") (CDR X]) (RESETVAR (DWIMIFY2 (CDDR X) FORM T)) @@ -372,7 +400,7 @@ with the terms of said license. (LIST (CADR X] VARS))) (COND - ((EQMEMB 'BINDS (GETPROP CARFORM 'INFO)) (* ; "PROG EQUIVALENTS") + ((EQMEMB 'BINDS (GETPROP CARFORM 'INFO)) (* ; "PROG EQUIVALENTS") ([LAMBDA (VARS) (DWIMIFY2 (CDDR X) FORM T] @@ -389,8 +417,8 @@ with the terms of said license. (FMEMB X (CADR FORM] (CAR X] VARS))) - ((CLISPNOEVAL CARFORM) (* ; - "Don't DWIMIFY the tails of nlambdas.") + ((CLISPNOEVAL CARFORM) (* ; + "Don't DWIMIFY the tails of nlambdas.") ) (T (GO DWIMIFYTAIL] (RETURN FORM) @@ -399,13 +427,16 @@ with the terms of said license. FORM) (SETQ CARFORM (OR (CDR (FASSOC (CAR X) DWIMEQUIVLST)) - (CAR X))) (* ; - "CARFORM may have changed if DWIMIFY2 changed X") + (CAR X))) (* ; + "CARFORM may have changed if DWIMIFY2 changed X") (COND [(LISTP CARFORM) (AND (NULL CARISOKFLG) (NULL CLISPCHANGE) - (DWIMIFY1 CARFORM)) (* ;; "Note that if CAR is a list, it itself has not yet been dwimified, e.g. may be a misspelled LAMBDA. However If CLISPCHANGE is not NIL, this expression was produced by the call to WTFIX and hence is already dwimified.") + (DWIMIFY1 CARFORM)) + + (* ;; "Note that if CAR is a list, it itself has not yet been dwimified, e.g. may be a misspelled LAMBDA. However If CLISPCHANGE is not NIL, this expression was produced by the call to WTFIX and hence is already dwimified.") + (COND ((AND (NULL FORMSFLG) (NEQ (SETQ TEM (OR (CDR (FASSOC (CAAR X) @@ -429,11 +460,11 @@ with the terms of said license. (RETURN FORM]) (DWIMIFY1A - [LAMBDA (PARENT TAIL FN) (* wt%: "10-DEC-80 23:36") + [LAMBDA (PARENT TAIL FN) (* wt%: "10-DEC-80 23:36") (COND ((AND (NULL DWIMESSGAG) (OR FN (AND DWIMIFYFLG DWIMIFYING)) - (NEQ CLISPCONTEXT 'IFWORD)) (* ; "clispif handles this itself.") + (NEQ CLISPCONTEXT 'IFWORD)) (* ; "clispif handles this itself.") (AND (FIXPRINTIN (OR FN FAULTFN)) (LISPXSPACES 1 T)) (COND @@ -461,7 +492,9 @@ with the terms of said license. [LAMBDA (TAIL PARENT SUBPARENT FORMSFLG ONEFLG ONLYSPELLFLG CLISPCONTEXT) (COND (DWIMIFYFLG (DWMFY2)) - (T (* ;; "See comment in dwimify0. DWIMIFY2? is used where caller is not sure whether state variables have been set up.") + (T + (* ;; "See comment in dwimify0. DWIMIFY2? is used where caller is not sure whether state variables have been set up.") + (PROG ((DWIMIFYING (AND DWIMIFYFLG DWIMIFYING)) (DWIMIFYFLG T) DWIMIFYCHANGE) @@ -478,7 +511,7 @@ with the terms of said license. (AND (OR (EQ SUBPARENT T) (EQ PARENT TAIL)) (SETQ SUBPARENT TAIL)) - + (* ;; "Means dont ever back up beyond this point, e.g. in prog variables, if you write (PROG ((X FOO Y LT 3) .. dont want LT to gobble the x.))") (SETQ CARPARENT (OR (CDR (FASSOC (CAR PARENT) @@ -514,25 +547,24 @@ with the terms of said license.  "none of the following corrections wanted") ) ((CLISPNOTVARP X) - - (* ;; "(CAR TAIL) is not recognized as a variable. Note that when DWIMIFYING, WTFIX will be called on a variable which is used freely, but does not have a top level binding, i.e. DWIMIFYING hile the variable is bound is not sufficient, because we do not do a STKSCAN for its value, as this would be expensive. (STKSCAN is done when DWIMIFY2 is called out of an evaluation.)") + + (* ;; "(CAR TAIL) is not recognized as a variable. Note that when DWIMIFYING, WTFIX will be called on a variable which is used freely, but does not have a top level binding, i.e. DWIMIFYING hile the variable is bound is not sufficient, because we do not do a STKSCAN for its value, as this would be expensive. (STKSCAN is done when DWIMIFY2 is called out of an evaluation.)") (COND [(AND FORMSFLG (EQ TAIL PARENT) (DWIMIFY2A TAIL 'QUIET)) - - (* ;; "DWIMIFY2A calls CLISPFUNCTION? to see if (CAR TAIL) is the name of a function. If FORMSFLG is true and (CAR TAIL) is name of function, then TAIL may be one form with parenteeses removed.") + + (* ;; "DWIMIFY2A calls CLISPFUNCTION? to see if (CAR TAIL) is the name of a function. If FORMSFLG is true and (CAR TAIL) is name of function, then TAIL may be one form with parenteeses removed.") (COND ((OR (NEQ X (CAR TAIL)) (NEQ FORMSFLG 'FORWORD)) - - (* ;; "Either the user has approved the combined spelling correction and insertion of paentheses, or else we are not under an I>S> without an oerator. (E.g. FOR X IN Y WHILE ATOM PRINT X, In this cae dont want to insert parentheses.) Note that if FOO is also the name of a variable as well as a function, no harm will be done in cases like IF A THEN FOO _ X. Only possible problem is for case like IF A THEN FOO _ X Y, where FFO is both a functionand a variable. In this case, parens would be inserted, and then an error generated. HOwever, this is extremely unlikely, since in most cases it would be written as IF A THEN FOO_X Y (not to mention the added improbability of FOO being both the name of a function and a variable.)") + + (* ;; "Either the user has approved the combined spelling correction and insertion of paentheses, or else we are not under an I>S> without an oerator. (E.g. FOR X IN Y WHILE ATOM PRINT X, In this cae dont want to insert parentheses.) Note that if FOO is also the name of a variable as well as a function, no harm will be done in cases like IF A THEN FOO ← X. Only possible problem is for case like IF A THEN FOO ← X Y, where FFO is both a functionand a variable. In this case, parens would be inserted, and then an error generated. HOwever, this is extremely unlikely, since in most cases it would be written as IF A THEN FOO←X Y (not to mention the added improbability of FOO being both the name of a function and a variable.)") (GO ASK)) (T - - (* ;; "(CAR TAIL) is the name of a function, but user hasnt been consulted, and we are under a FOR with no operator, so wait.") + (* ;; "(CAR TAIL) is the name of a function, but user hasnt been consulted, and we are under a FOR with no operator, so wait.") (SETQ FNFLG T) (* ;  "Now drop through to next COND and call to WTFIX (because (CAR TAIL) may be a miispelled variable.)") @@ -545,8 +577,8 @@ with the terms of said license. (DWIMIFY2A TAIL 'QUIET) (OR (NEQ X (CAR TAIL)) (LISTP CARPARENT))) - - (* ;; "Corresponds to the case where the user left a DO out of a for statement. Already know that the first thing in TAIL is not the name of a function. However, only take action if the usr approves combined correction, (or (CAR PARENT) is a list.) since it is still possible that X is the (misspelled) name of a variable.") + + (* ;; "Corresponds to the case where the user left a DO out of a for statement. Already know that the first thing in TAIL is not the name of a function. However, only take action if the usr approves combined correction, (or (CAR PARENT) is a list.) since it is still possible that X is the (misspelled) name of a variable.") (SETQQ FORMSFLG FOR1) (GO INSERT)) @@ -556,8 +588,8 @@ with the terms of said license. (CDDR TAIL)) (AND (EQ TAIL PARENT) (SETQ NOTOKFLG T)) - - (* ;; "E.g. (LIST X FOR X IN A --) The CDDR check is because very seldom you have an iterative statement only two elements long, but lots of places where iterative words can appear in another context, e.g. OF, TO, etc. See comment below on NOTOKFLG. Note that if FORMSFLG is true and (EQ TAIL PARENT), then CLISPFUNCTION? (via DWIMIFY2A) above would have returned T.") + + (* ;; "E.g. (LIST X FOR X IN A --) The CDDR check is because very seldom you have an iterative statement only two elements long, but lots of places where iterative words can appear in another context, e.g. OF, TO, etc. See comment below on NOTOKFLG. Note that if FORMSFLG is true and (EQ TAIL PARENT), then CLISPFUNCTION? (via DWIMIFY2A) above would have returned T.") (DWIMIFY1A PARENT TAIL) (* ;  "Stop dwimifying, strong evidence that expression is screwed up.") @@ -566,8 +598,8 @@ with the terms of said license. ((AND [NULL (AND ONLYSPELLFLG (OR (EQ NOSPELLFLG T) (AND NOSPELLFLG (NULL TYPE-IN?] (WTFIX0 X TAIL PARENT SUBPARENT ONLYSPELLFLG)) - - (* ;; "If both ONLYSPELLFLG and NOSPELLFLG are true, no point in calling WTFIX. ONLYSPELLFLG is true on calls fro CLISPATOM2A.") + + (* ;; "If both ONLYSPELLFLG and NOSPELLFLG are true, no point in calling WTFIX. ONLYSPELLFLG is true on calls fro CLISPATOM2A.") (COND (89CHANGE (SETQ NOTOKFLG NIL) @@ -581,13 +613,13 @@ with the terms of said license.  "NOTOKFLG=T means first expression in TAIL was not recognized as a variable.") [COND ((AND FORMSFLG (EQ TAIL PARENT)) - - (* ;; "After DWIMIFYING the whole tail, if CAR is still an atom, we may want to insert parentheses, e.g. (FOO _ X Y) is ok, but (FOO X Y) may need to be converted to ((FOO X Y))") + + (* ;; "After DWIMIFYING the whole tail, if CAR is still an atom, we may want to insert parentheses, e.g. (FOO ← X Y) is ok, but (FOO X Y) may need to be converted to ((FOO X Y))") ) [(FGETD X) - - (* ;; "Don't add a function name to NOFIXVARSLST0 since this is tantamount to sanctiooning it as a variale.") + + (* ;; "Don't add a function name to NOFIXVARSLST0 since this is tantamount to sanctiooning it as a variale.") (COND ((AND (EQ FORMSFLG 'FORWORD) @@ -629,8 +661,8 @@ with the terms of said license. (OR (NULL NOTOKFLG) (NULL FNFLG)) (LISTP (CADR TAIL0] - - (* ;; "Corresponds to the cse where the user left out a DO. Want to check this before below as in this case dont want to stick in paens around entire form.") + + (* ;; "Corresponds to the cse where the user left out a DO. Want to check this before below as in this case dont want to stick in paens around entire form.") (GO OUT1)) ((EQ FORMSFLG T) (* ; @@ -639,15 +671,15 @@ with the terms of said license. [(CDR TAIL0) (* ; "FORMSFLG is FOR or IF") (COND ((OR NOTOKFLG (DWIMIFY2A TAIL0 'QUIET)) - - (* ;; "(CAR TAIL) is not the name of a variable, or else IS the name of a function. The reason for the call to CLISPFUNCTION? (via DWIMIFY2A) instead of checking FNFLG is that in the case that (CAR TAIL) was the name of a variable as indicated by NOTOKFLG=NIL, CLISPFUNCTION? would not have been called earlier.") + + (* ;; "(CAR TAIL) is not the name of a variable, or else IS the name of a function. The reason for the call to CLISPFUNCTION? (via DWIMIFY2A) instead of checking FNFLG is that in the case that (CAR TAIL) was the name of a variable as indicated by NOTOKFLG=NIL, CLISPFUNCTION? would not have been called earlier.") (/RPLNODE TAIL0 (CONS (CAR TAIL0) (CDR TAIL0))) (GO OUT1] ((AND NOTOKFLG FNFLG) - - (* ;; "(CAR TAIL) is not the name of a variable and is the name of a function, but nothing follows it. E.g. IF -- THEN RETURN ELSE --") + + (* ;; "(CAR TAIL) is not the name of a variable and is the name of a function, but nothing follows it. E.g. IF -- THEN RETURN ELSE --") (/RPLNODE TAIL0 (CONS (CAR TAIL0) (CDR TAIL0))) @@ -657,8 +689,8 @@ with the terms of said license. ((NULL ONEFLG) TAIL0) (NOTOKFLG - - (* ;; "In this way, the function thatcaled DWIMIFY2 can find out whether or not the atom in question is OK. NOte that if it appears on NOFIXLST, it is OK, i.e. havng been seen before, we treat it the same as a variable or what not.") + + (* ;; "In this way, the function thatcaled DWIMIFY2 can find out whether or not the atom in question is OK. NOte that if it appears on NOFIXLST, it is OK, i.e. havng been seen before, we treat it the same as a variable or what not.") NIL) ((NULL NEXTAIL) @@ -683,14 +715,14 @@ with the terms of said license. (GO DROPTHRU]) (DWIMIFY2A - [LAMBDA ($TAIL $TYP) (* wt%: 25-FEB-76 1 54) + [LAMBDA ($TAIL $TYP) (* wt%: 25-FEB-76 1 54) (CLISPFUNCTION? $TAIL $TYP [FUNCTION (LAMBDA (X Y) (SUBSTRING (RETDWIM2 Y) 2 -1] [FUNCTION (LAMBDA (X Y) (CONCAT [MKSTRING (RETDWIM2 (COND [(LISTP X) - (* ; "Run-on.") + (* ; "Run-on.") (CONS (CAR X) (CONS (CDR X) (CDR Y] @@ -699,19 +731,25 @@ with the terms of said license. $TAIL]) (CLISPANGLEBRACKETS - [LAMBDA (LST) (* wt%: "26-JUN-78 01:20") + [LAMBDA (LST) (* wt%: "26-JUN-78 01:20") (PROG [WORKFLAG (NCONCLKUP (CLISPLOOKUP 'NCONC)) (NCONC1LKUP (CLISPLOOKUP 'NCONC1] (RETURN (SHRIEKER LST]) (SHRIEKER - [LAMBDA (LOOKAT) (* ;; "Shrieker is designed to 'understand' expressions of the form (! A B !! C !! D E F), where A, B, C,... represent lists, ! indicates that the list following it is to be (non-destructively) expanded (e.g. A's elements are to be brought to the top level of the list which contains A), and !! indicates that the list following it is to be destructively expanded. Thus, if A= (H I J), B= (K L M), C= (N O P), the result of evaluating (! A !! B C) should be a list (H I J K L M C). SHRIEKER does not actually evaluate the list given to it, but rather returns a form which will have the correct evaluation. Thus, if SHRIEKER is given the (shriekified) list (! A !! B C), it will return the form (APPEND A (NCONC1 B C)). Should A,B,C have the values given above, then evaluation of this form will leave A unchanged, but B will have been destructively altered, and will now evaluate to the list (K L M (N O P)).") + [LAMBDA (LOOKAT) + + (* ;; "Shrieker is designed to 'understand' expressions of the form (! A B !! C !! D E F), where A, B, C,... represent lists, ! indicates that the list following it is to be (non-destructively) expanded (e.g. A's elements are to be brought to the top level of the list which contains A), and !! indicates that the list following it is to be destructively expanded. Thus, if A= (H I J), B= (K L M), C= (N O P), the result of evaluating (! A !! B C) should be a list (H I J K L M C). SHRIEKER does not actually evaluate the list given to it, but rather returns a form which will have the correct evaluation. Thus, if SHRIEKER is given the (shriekified) list (! A !! B C), it will return the form (APPEND A (NCONC1 B C)). Should A,B,C have the values given above, then evaluation of this form will leave A unchanged, but B will have been destructively altered, and will now evaluate to the list (K L M (N O P)).") + (PROG (CARTEST RESULTP) (COND ((OR (ATOM LOOKAT) (NLISTP LOOKAT)) (SETQ WORKFLAG NIL) - (RETURN LOOKAT))) (* ;; "As is evident from a look at the code, SHRIEKER is a fairly straightforward recursive prog; analysis of the argument, LOOKAT, is doen in effect from the tail of LOOKat to its head. I>e. given LOOKAT SHRIEKER separates it into two parts (roughly car and cdr), where one part (CARTEST) is the first element of LOOKAT that is not ! or !! , and the other part is the tail of LOOKAT below CARTEST-- LOOKAT is reset to evaluate to this tail and SHRIEKER is called recursively on the new LOOKAT, eventually returning a list structure, to which we setq RESULTP, that is the LISP equivalent of LOOKAT (which, with its !'s and !!'s is an expression in CLISP). The calling incarnation of SHRIEKER uses RESULTP and its knowledge of the shriek-sysmbol (! or ! ! or !!) immediately before CARTEST, to determine how CARTEST and RESULTP should be used to form the list structure that will be returned, possibly to higher level incarnations of SHRIEKER. into then possibly incarnations SHRIEKER.") + (RETURN LOOKAT))) + + (* ;; "As is evident from a look at the code, SHRIEKER is a fairly straightforward recursive prog; analysis of the argument, LOOKAT, is doen in effect from the tail of LOOKat to its head. I>e. given LOOKAT SHRIEKER separates it into two parts (roughly car and cdr), where one part (CARTEST) is the first element of LOOKAT that is not ! or !! , and the other part is the tail of LOOKAT below CARTEST-- LOOKAT is reset to evaluate to this tail and SHRIEKER is called recursively on the new LOOKAT, eventually returning a list structure, to which we setq RESULTP, that is the LISP equivalent of LOOKAT (which, with its !'s and !!'s is an expression in CLISP). The calling incarnation of SHRIEKER uses RESULTP and its knowledge of the shriek-sysmbol (! or ! ! or !!) immediately before CARTEST, to determine how CARTEST and RESULTP should be used to form the list structure that will be returned, possibly to higher level incarnations of SHRIEKER. into then possibly incarnations SHRIEKER.") + (SETQ CARTEST (CAR LOOKAT)) (SETQ LOOKAT (CDR LOOKAT)) [RETURN (COND @@ -723,12 +761,18 @@ with the terms of said license. (SETQ LOOKAT (CDR LOOKAT)) (COND ((EQ CARTEST '!) - (GO A1))) (* ;; "This conditional insures that SHRIEKER will understnad that the sequence ! ! means the atom !!. Control will be sent to the statement after A1, which will make sure that CARTEST is NCONCed onto RESULTP (if car of RESULTP is APPEND, CONS, NCONC1, or LIST) or will stuff CARTEST into second place in RESULTP, which is presumalby an NCONC expression-- all provided that WORKFLAG is NIL...") + (GO A1))) + + (* ;; "This conditional insures that SHRIEKER will understnad that the sequence ! ! means the atom !!. Control will be sent to the statement after A1, which will make sure that CARTEST is NCONCed onto RESULTP (if car of RESULTP is APPEND, CONS, NCONC1, or LIST) or will stuff CARTEST into second place in RESULTP, which is presumalby an NCONC expression-- all provided that WORKFLAG is NIL...") + (SETQ RESULTP (SHRIEKER LOOKAT)) - (* ; - "Here's our recursive call to SHRIEKER..") + (* ; + "Here's our recursive call to SHRIEKER..") (COND - ((NULL RESULTP) (* ;; "WORKFLAG is a flag that is passed between incarnations of SHRIEKER and is the means by which SHRIEKER is able to distinguish between user-created code and SHRIEKER-created code. If WORKFLAG eq's T then SHRIEKER knows that what has been returned as RESULTP is user-created code and should not be altered.") + ((NULL RESULTP) + + (* ;; "WORKFLAG is a flag that is passed between incarnations of SHRIEKER and is the means by which SHRIEKER is able to distinguish between user-created code and SHRIEKER-created code. If WORKFLAG eq's T then SHRIEKER knows that what has been returned as RESULTP is user-created code and should not be altered.") + (SETQQ WORKFLAG !IT) (LIST 'APPEND CARTEST)) ((ATOM RESULTP) @@ -737,7 +781,10 @@ with the terms of said license. ((NULL WORKFLAG) (SETQQ WORKFLAG APPENDING) (LIST 'APPEND CARTEST RESULTP)) - (T (* ;; "If the COND falls througn to this point then we may assume that RESULTP is SHRIEKER-created and do a SELECTQ on car of RESULTP (which should be either APPEND, NCONC, NCONC1, CONS, or LIST) to determine whether we should stuff CARTEST into RESULTP or not.") + (T + + (* ;; "If the COND falls througn to this point then we may assume that RESULTP is SHRIEKER-created and do a SELECTQ on car of RESULTP (which should be either APPEND, NCONC, NCONC1, CONS, or LIST) to determine whether we should stuff CARTEST into RESULTP or not.") + (SELECTQ WORKFLAG (APPENDING (ATTACH CARTEST (CDR RESULTP)) RESULTP) @@ -750,7 +797,10 @@ with the terms of said license. (!!IT (SETQQ WORKFLAG APPENDING) (LIST 'APPEND CARTEST (CADR RESULTP))) (LIST 'APPEND CARTEST RESULTP] - [LOOKAT (* ;; "If we arrive here then we know that SHRIEKER's arguemnt-- hte intial value of LOOKAT--is a list, the first element of which is not ! or !!. Accordingly, we attempt to CONS or LIST together CARTEST and RESULTP, depending on the nature of RESULTP and the value of WORKFLAG left by the recursive call to SHRIEKER in the statement below.") + [LOOKAT + + (* ;; "If we arrive here then we know that SHRIEKER's arguemnt-- hte intial value of LOOKAT--is a list, the first element of which is not ! or !!. Accordingly, we attempt to CONS or LIST together CARTEST and RESULTP, depending on the nature of RESULTP and the value of WORKFLAG left by the recursive call to SHRIEKER in the statement below.") + (SETQ RESULTP (SHRIEKER LOOKAT)) (COND ((NULL WORKFLAG) @@ -766,7 +816,9 @@ with the terms of said license. (SETQQ WORKFLAG CONSING) (LIST 'CONS CARTEST (CADR RESULTP))) (LIST 'CONS CARTEST RESULTP] - (T (* ;; "If we reach this point then we know that SHRIEKER was called on a singleton, i.e. the intial vlaue of LOOKAT was a list of one element, so we create the appropriate list structure around that element and setq WORKFLAG to NIL, enabling a possible parent SHRIEKER to modify our code.") + (T + (* ;; "If we reach this point then we know that SHRIEKER was called on a singleton, i.e. the intial vlaue of LOOKAT was a list of one element, so we create the appropriate list structure around that element and setq WORKFLAG to NIL, enabling a possible parent SHRIEKER to modify our code.") + (SETQQ WORKFLAG LISTING) (LIST 'LIST CARTEST] A1 (RETURN (COND @@ -806,8 +858,10 @@ with the terms of said license. (LIST NCONCLKUP CARTEST RESULTP]) (CLISPRESPELL - [LAMBDA (TL WORDS FLG) (* lmm " 4-SEP-83 23:31") - (* ;; "CLISPRESPELL essentially asks is it possible to inerpret (CAR TAIL) as one of WORDS. It first checks to make sure (CAR TAIL) isnt already something else-- e.g. a function, variable, member of NOFIXFNSLST (which is the same as being a function) etc.") + [LAMBDA (TL WORDS FLG) (* lmm " 4-SEP-83 23:31") + + (* ;; "CLISPRESPELL essentially asks is it possible to inerpret (CAR TAIL) as one of WORDS. It first checks to make sure (CAR TAIL) isnt already something else-- e.g. a function, variable, member of NOFIXFNSLST (which is the same as being a function) etc.") + (AND (NEQ NOSPELLFLG T) (OR (NOT NOSPELLFLG) TYPE-IN?) @@ -819,7 +873,7 @@ with the terms of said license. NIL WORDS FLG]) (EXPRCHECK - [LAMBDA (X) (* wt%: "14-FEB-78 00:06") + [LAMBDA (X) (* wt%: "14-FEB-78 00:06") (PROG (D) (COND ((NOT (LITATOM X)) @@ -839,30 +893,32 @@ with the terms of said license. (DEFINEQ (CLISPATOM0 - [LAMBDA (CHARLST TAIL PARENT) (* bvm%: "21-Nov-86 18:05") + [LAMBDA (CHARLST TAIL PARENT) (* bvm%: "21-Nov-86 18:05") (AND (NULL SUBPARENT) (SETQ SUBPARENT PARENT)) (PROG ((CURRTAIL TAIL) (NOFIXVARSLST1 NOFIXVARSLST0) 89FLG TEM) TOP (SELECTQ (DWIMUNDOCATCH 'CLISPATOM1 (SETQ TEM (CLISPATOM1 TAIL))) - (:RESPELL (* ; - "A misspelling was detected. Need to fix it now.") + (:RESPELL (* ; + "A misspelling was detected. Need to fix it now.") (SETQ NOFIXVARSLST0 NOFIXVARSLST1) (AND DWIMIFYFLG (SETQ CLISPCHANGE NIL)) (COND ((PROG1 (CLISPELL TAIL) - (SETQ CHARLST (DUNPACK (CAR TAIL) - WTFIXCHCONLST))) - (* ;; "MIsspelling found. Note that even if the word wasnt found, LST is reset since some tentative changes were tried, it was probably clobbered.") + (SETQ CHARLST (DUNPACK (CAR TAIL) + WTFIXCHCONLST))) + + (* ;; "MIsspelling found. Note that even if the word wasnt found, LST is reset since some tentative changes were tried, it was probably clobbered.") + (SETQ CURRTAIL TAIL) (GO TOP)))) - (NIL (* ; "error") + (NIL (* ; "error") (SETQ NOFIXVARSLST0 NOFIXVARSLST1)) (RETURN TEM)) (RETURN (COND - (89FLG (* ; - "E.G. N*8FOO -- fix the 8-9 error first.") + (89FLG (* ; + "E.G. N*8FOO -- fix the 8-9 error first.") [PROG ((FAULTX (CAR CURRTAIL))) (SETQ TEM (FIX89 FAULTX (CAR 89FLG) (LENGTH 89FLG] @@ -873,9 +929,12 @@ with the terms of said license. TAIL PARENT]) (CLISPATOM1 - [LAMBDA (TAIL) (* lmm "29-Jul-86 00:25") - (* ;;; "This function and its subfunctions handle infix operators. LST is an exploded list of characters for CAR of TAIL, which is a tail of PARENT. If LST contains an CLISP operator, or CAR of TAIL is one, CLISPATOM1 scans the rest of tail until it reaches the end of this cluster. For example, if TAIL is (... A* B + C D+E ...), the scan will stop after C. The scan separates out the operators from the operands. Note that because any operand can be a list, and hence separated from its operator, an operator can occur interior to an atom, as in A*B, at the end of an atom, as in (A* (--)), at the front of an atom, as in ((--) *A), or by itself, as in ((--) * (--)). Therefore, we permit the same options when the operand is a atomic, i.e. the user can type A*B, A* B, A *B, or A * B. Note that in the latter two cases, the first argument to the operator is not contained in TAIL, and it is necessary for CLISPATOM1 to back tail up one element using PARENT.") - (* ;; "After the scan has been completed, the form for the first operator is assembled. Since operators are always processed left to right, the first operand to this operator is always the single element preceding it (unless it is a unary operator). The right boundary, and hence the second operand, is determined by the operator, e.g. * is tighter than +, which is tighter than LS, etc. Thus ... A*B+C ... becomes ... (ITIMES A B) + C ... while ... A+B*C ... becomes ... (IPLUS A B * C) In either case, the rest of this cluster is processed from within this call to CLISPATOM1, thereby taking advantage of the fact that we know that the atoms do not contain operators, and therefore don't have to be unpacked and examined character by character.") + [LAMBDA (TAIL) (* lmm "29-Jul-86 00:25") + +(* ;;; "This function and its subfunctions handle infix operators. LST is an exploded list of characters for CAR of TAIL, which is a tail of PARENT. If LST contains an CLISP operator, or CAR of TAIL is one, CLISPATOM1 scans the rest of tail until it reaches the end of this cluster. For example, if TAIL is (... A* B + C D+E ...), the scan will stop after C. The scan separates out the operators from the operands. Note that because any operand can be a list, and hence separated from its operator, an operator can occur interior to an atom, as in A*B, at the end of an atom, as in (A* (--)), at the front of an atom, as in ((--) *A), or by itself, as in ((--) * (--)). Therefore, we permit the same options when the operand is a atomic, i.e. the user can type A*B, A* B, A *B, or A * B. Note that in the latter two cases, the first argument to the operator is not contained in TAIL, and it is necessary for CLISPATOM1 to back tail up one element using PARENT.") + + (* ;; "After the scan has been completed, the form for the first operator is assembled. Since operators are always processed left to right, the first operand to this operator is always the single element preceding it (unless it is a unary operator). The right boundary, and hence the second operand, is determined by the operator, e.g. * is tighter than +, which is tighter than LS, etc. Thus ... A*B+C ... becomes ... (ITIMES A B) + C ... while ... A+B*C ... becomes ... (IPLUS A B * C) In either case, the rest of this cluster is processed from within this call to CLISPATOM1, thereby taking advantage of the fact that we know that the atoms do not contain operators, and therefore don't have to be unpacked and examined character by character.") + (PROG ((L CHARLST) (LST0 CHARLST) CURRTAIL-1 CLTYP CLTYP1 ENDTAIL BROADSCOPE BACKUPFLG OPRFLAG NOTFLG TYP ATMS NOSAVEFLG @@ -887,15 +946,18 @@ with the terms of said license. (GO NEXT2))) TOP (SETQ ATMS NIL) LP (COND - ((NULL L) (* ; "End of an atom.") + ((NULL L) (* ; "End of an atom.") (COND - ((NULL TYP) (* ; - "If we have gone through the first atom without finding an CLISP operator, we are done.") + ((NULL TYP) (* ; + "If we have gone through the first atom without finding an CLISP operator, we are done.") (COND - ((NULL 89FLG) (* ; - "The case where there was an 8 or 9 and an operator has been handled in CL89CHECK.") + ((NULL 89FLG) (* ; + "The case where there was an 8 or 9 and an operator has been handled in CL89CHECK.") ) - (CURRTAIL (* ;; "8 and 9 errors are handled here instead of back in CLISPATOM where there is similar code, because there may be more than one 8 or 9 in the expression, and the first one may be ok, e.g. 8*X*8ADD1 Y") + (CURRTAIL + + (* ;; "8 and 9 errors are handled here instead of back in CLISPATOM where there is similar code, because there may be more than one 8 or 9 in the expression, and the first one may be ok, e.g. 8*X*8ADD1 Y") + (AND [FIX89A (CAR CURRTAIL) (CAR (LISTP 89FLG)) (IMINUS (SETQ TEM (LENGTH 89FLG] @@ -906,13 +968,19 @@ with the terms of said license. (EQ (CAR (LISTP 89FLG)) LPARKEY) (EQ (CAR (SETQ TEM (FLAST CHARLST))) - RPARKEY)) (* ;; "This corresponds to the case where an atom was typed in containing both an 8 and a 9, e.g. FILES?89 or 8EDITF9. Note that if the atom were part of a larger expression, either CAR of form, or appearing in a tail, (as indicated by CURRTAIL being non-NIL), the fix is performed by FIX89, and involves editing the expression. In the case covered here, the fix requires changing the EVAL to an apppropriate APPLY.") + RPARKEY)) + + (* ;; "This corresponds to the case where an atom was typed in containing both an 8 and a 9, e.g. FILES?89 or 8EDITF9. Note that if the atom were part of a larger expression, either CAR of form, or appearing in a tail, (as indicated by CURRTAIL being non-NIL), the fix is performed by FIX89, and involves editing the expression. In the case covered here, the fix requires changing the EVAL to an apppropriate APPLY.") + (FIX89TYPEIN (FMEMB LPARKEY (SETQ TEM (LDIFF CHARLST TEM))) TEM T))) (RETURN NIL)) - (LST0 (SETQ OPRFLAG T) (* ; - "OPRFLAG is T means the element just processed did NOT end in an operator, e.g. A+B, or just A.") - (SETQ TEM (PACK LST0)) (* ;; "Collects characters to the right of the last operator in the atom, or all the characters in the atom, if it contained no operator.") + (LST0 (SETQ OPRFLAG T) (* ; + "OPRFLAG is T means the element just processed did NOT end in an operator, e.g. A+B, or just A.") + (SETQ TEM (PACK LST0)) + + (* ;; "Collects characters to the right of the last operator in the atom, or all the characters in the atom, if it contained no operator.") + (SETQ ATMS (NCONC1 ATMS TEM)) (SETQ NOTFLG NIL))) (SETQ 89FLG NIL) @@ -927,11 +995,16 @@ with the terms of said license. (- [COND ((NULL (AND (EQ L LST0) (CLUNARYMINUS? OPRFLAG))) - (* ;; "Says minus is binary. See comments i CLUNARYMINUS?. By replacing binary minus with +- in CLISPATOM1, all the rest of the CLISP function can treat minus as unary.") + + (* ;; "Says minus is binary. See comments i CLUNARYMINUS?. By replacing binary minus with +- in CLISPATOM1, all the rest of the CLISP function can treat minus as unary.") + (FRPLACA L '+-) (SETQ CLTYP1 (GETPROP '+- 'CLISPTYPE]) (%' (AND (NEQ L LST0) - (GO LP1)) (* ;; "' is ignored interior to atoms, e.g. USER can have a function named ATOM' or a variable named A' which is not necessarily defined or bound at time of DWIMIFYing.") + (GO LP1)) + + (* ;; "' is ignored interior to atoms, e.g. USER can have a function named ATOM' or a variable named A' which is not necessarily defined or bound at time of DWIMIFYing.") + ) (COND [BRACKET (COND @@ -968,38 +1041,50 @@ with the terms of said license. LP1 (COND ((AND OPRFLAG (NULL BROADSCOPE) (ZEROP BRACKETCNT) - (EQ L CHARLST)) (* ;; "If OPRFLAG is T and the first character in LST is not an operator, no need to scan further, e.g. A*B C unless we are processing a broad scope operator, e.g. (A EQ FOO B) or unless ANGCNT is not 0, i.e. we are inside of an <> pair.") - (OR ENDTAIL (SETQ ENDTAIL CURRTAIL)) (* ;; "If ENDTAIL has not been set yet, set it. Note that ENDTAIL may already have been set, e.g. A*B+C D, in which case ENDTAIL would correspnd to the position of the +.") - (GO OUT) (* ;; "If this is the first character in an atom, then we cango to out, e.g. A+B C. HOwever, this may be the first character following a >, as in FOO_C, in which case we have to finish out the atom.") + (EQ L CHARLST)) + + (* ;; "If OPRFLAG is T and the first character in LST is not an operator, no need to scan further, e.g. A*B C unless we are processing a broad scope operator, e.g. (A EQ FOO B) or unless ANGCNT is not 0, i.e. we are inside of an <> pair.") + + (OR ENDTAIL (SETQ ENDTAIL CURRTAIL)) + + (* ;; "If ENDTAIL has not been set yet, set it. Note that ENDTAIL may already have been set, e.g. A*B+C D, in which case ENDTAIL would correspnd to the position of the +.") + + (GO OUT) + + (* ;; "If this is the first character in an atom, then we cango to out, e.g. A+B C. HOwever, this may be the first character following a >, as in FOO←C, in which case we have to finish out the atom.") + )) - (SETQ L (CDR L)) (* ; - "Peel off the current character and go on.") + (SETQ L (CDR L)) (* ; + "Peel off the current character and go on.") (GO LP) NEXT - (* ; - "We have just exhausted the lit of characters for an atm.") + (* ; + "We have just exhausted the lit of characters for an atm.") [COND - ((NULL TAIL) (* ; - "We were originally given just an atom, e.g. user types FOO_FIE.") + ((NULL TAIL) (* ; + "We were originally given just an atom, e.g. user types FOO←FIE.") (SETQ TAIL ATMS) (OR PARENT (SETQ PARENT TAIL))) ([AND TAIL (OR (CDR ATMS) (NEQ (CAR (LISTP ATMS)) - (CAR CURRTAIL] (* ;; "Splice burst version of atom into CURRTAIL, and set CURRTAIL to point to the as yet unexamined part of it. If the OR is not true, CURRTAIL would not be changd so don't bother e.g. (LIST A + B * C)") + (CAR CURRTAIL] + + (* ;; "Splice burst version of atom into CURRTAIL, and set CURRTAIL to point to the as yet unexamined part of it. If the OR is not true, CURRTAIL would not be changd so don't bother e.g. (LIST A + B * C)") + [/RPLNODE CURRTAIL (CAR (LISTP ATMS)) (NCONC (CDR ATMS) (SETQ CURRTAIL (LISTP (CDR (SETQ CURRTAIL-1 CURRTAIL] - (* ; - "CURRTAIL-1 is used for backing up, see below.") + (* ; + "CURRTAIL-1 is used for backing up, see below.") ) (T (SETQ CURRTAIL (LISTP (CDR (SETQ CURRTAIL-1 CURRTAIL] (COND - ((NULL CURRTAIL) (* ; - "We have reached the end of the faulty form.") + ((NULL CURRTAIL) (* ; + "We have reached the end of the faulty form.") (GO OUT))) NEXT1 - (* ; - "Look at the next thing in CURRTAIL.") + (* ; + "Look at the next thing in CURRTAIL.") (COND ([AND OPRFLAG DWIMIFYFLG ONEFLG (NULL BROADSCOPE) (ZEROP BRACKETCNT) @@ -1019,9 +1104,11 @@ with the terms of said license. (AND (NULL BRACKET) OPRFLAG (CLBINARYMINUS? CURRTAIL-1 CURRTAIL] - (CLISPNOTVARP (CAR CURRTAIL))) (* ;; "The OR check is to handle cases like (.. ' F/L) which I think means wquote the whole thing. NOte that this comes up in expressions like since when SHRIEKER calls DWIMIFY2, the ' and F/L have already been split apart.") - (* ; - "dont call clbinaryminus? if last thing ended in an operator. e.g. ((foo) + -2)") + (CLISPNOTVARP (CAR CURRTAIL))) + + (* ;; "The OR check is to handle cases like (.. ' F/L) which I think means wquote the whole thing. NOte that this comes up in expressions like since when SHRIEKER calls DWIMIFY2, the ' and F/L have already been split apart.") + (* ; + "dont call clbinaryminus? if last thing ended in an operator. e.g. ((foo) + -2)") (COND ([AND (SETQ CLTYP1 (GETPROP (CAR CURRTAIL) 'CLISPTYPE)) @@ -1034,7 +1121,10 @@ with the terms of said license. ((AND BRACKET (SETQ TEM (FMEMB (CADR BRACKET) (CDDR L))) (NOT (FMEMB (CAR BRACKET) - L))) (* ;; "< and > are thought of as brackets, rather than operaaors. Therefore this is necessary in order thatthings like <1 2 -1> work, i.e. --- not treated as binary in this case, also , and finally if A*B is the name of a variable Note that this doesnt quite handle all cases: where A*B is the name of a variable, will be broken apart, but then it isnt clear whats intended.") + L))) + + (* ;; "< and > are thought of as brackets, rather than operaaors. Therefore this is necessary in order thatthings like <1 2 -1> work, i.e. --- not treated as binary in this case, also , and finally if A*B is the name of a variable Note that this doesnt quite handle all cases: where A*B is the name of a variable, will be broken apart, but then it isnt clear whats intended.") + (CLRPLNODE CURRTAIL (PACK (LDIFF L TEM)) (CONS (PACK TEM) (CDR CURRTAIL))) @@ -1058,10 +1148,10 @@ with the terms of said license. (T (RETDWIM2 Y] [FUNCTION (LAMBDA (X Y) (MKSTRING (CONS X (RETDWIM2 Y] - (CAR CURRTAIL))) (* ; - "This clause checks for user typing in apply mode, e.g. X_CONS (A B)") - (SETQQ TENTATIVE CERTAINLY) (* ; - "Once you print a message, you dont want to go and try another interpretation.") + (CAR CURRTAIL))) (* ; + "This clause checks for user typing in apply mode, e.g. X←CONS (A B)") + (SETQQ TENTATIVE CERTAINLY) (* ; + "Once you print a message, you dont want to go and try another interpretation.") (/RPLNODE TEM (CONS (CAR TEM) (CAR CURRTAIL)) (CDR CURRTAIL)) @@ -1071,22 +1161,22 @@ with the terms of said license. (GO NEXT1))) (COND ((AND OPRFLAG (NULL BROADSCOPE) - (ZEROP BRACKETCNT)) (* ; "Finished. E.g. A*B (--)") + (ZEROP BRACKETCNT)) (* ; "Finished. E.g. A*B (--)") (OR ENDTAIL (SETQ ENDTAIL CURRTAIL)) (GO OUT)) ([SETQ CURRTAIL (LISTP (CDR (SETQ CURRTAIL-1 CURRTAIL] - (* ; "E.g. A* (--)") + (* ; "E.g. A* (--)") (SETQ OPRFLAG T) (SETQ NOTFLG NIL) (GO NEXT1)) (T (GO OUT))) NEXT2 - (* ; - "(CAR CURRTAIL) is an operaaor. CLTYP1 is its CLISPTYPe.") + (* ; + "(CAR CURRTAIL) is an operaaor. CLTYP1 is its CLISPTYPe.") [SELECTQ (CAR CURRTAIL) (- [COND - ((NULL (CLUNARYMINUS? OPRFLAG)) (* ; - "The minus is biary. SEe comments at earlier call to CLUNARYMINUS? in CLSPATOM1.") + ((NULL (CLUNARYMINUS? OPRFLAG)) (* ; + "The minus is biary. SEe comments at earlier call to CLUNARYMINUS? in CLSPATOM1.") (/RPLNODE CURRTAIL '+- (CDR CURRTAIL)) (SETQ CLTYP1 (GETPROP '+- 'CLISPTYPE]) ((-> =>) @@ -1114,36 +1204,42 @@ with the terms of said license. PARENT] (COND (ENDTAIL) - [(NULL TYP) (* ; "This is the first operator.") + [(NULL TYP) (* ; "This is the first operator.") (SETQ TYP (CAR CURRTAIL)) (SETQ CLTYP CLTYP1) (SETQ BROADSCOPE (GETPROP TYP 'BROADSCOPE)) (SETQ NOTFLG (EQ (SETQ TEM (GETPROP TYP 'LISPFN)) 'NOT] - (NOTFLG (* ;; "NOTFLG is true when we are processing a NOT opeator, and it immediately precedes the current operator. In this case, the scope of the NOT is the scope of the next opeator, e.g. (X ~GR FOO Y)") + (NOTFLG + + (* ;; "NOTFLG is true when we are processing a NOT opeator, and it immediately precedes the current operator. In this case, the scope of the NOT is the scope of the next opeator, e.g. (X ~GR FOO Y)") + (SETQ CLTYP CLTYP1) (SETQ BROADSCOPE (GETPROP (CAR CURRTAIL) 'BROADSCOPE)) (SETQ NOTFLG (EQ (GETPROP (CAR CURRTAIL) 'LISPFN) - 'NOT)) (* ; - "So that NOTFLG is not turned off when there are two ~'s in a row, e.g. (X ~~GR FOO Y OR Z)") + 'NOT)) (* ; + "So that NOTFLG is not turned off when there are two ~'s in a row, e.g. (X ~~GR FOO Y OR Z)") ) ((STOPSCAN? CLTYP1 CLTYP (CAR CURRTAIL) - OPRFLAG) (* ;; "This operator delimits the scope of the first operator found. Set ENDTAIL to be the first thing not within the scope of the operator. The AND is so that a unary operator will terminate the scope of a binary operator that has a right hand operand, e.g. X+Y -Z, X_Y 'Z, etc.") + OPRFLAG) + + (* ;; "This operator delimits the scope of the first operator found. Set ENDTAIL to be the first thing not within the scope of the operator. The AND is so that a unary operator will terminate the scope of a binary operator that has a right hand operand, e.g. X+Y -Z, X←Y 'Z, etc.") + (SETQ ENDTAIL CURRTAIL))) (SETQ ISFLG (EQ [CAR (LISTP (GETPROP (CAR CURRTAIL) 'CLISPCLASS] 'ISWORD)) NEXT3 [SETQ OPRFLAG (AND BRACKET (EQ (CAR CURRTAIL) - (CADR BRACKET] (* ; - "OPRFLAG is T aater > since no right hand operand is reuired.") + (CADR BRACKET] (* ; + "OPRFLAG is T aater > since no right hand operand is reuired.") (COND ([SETQ CURRTAIL (LISTP (CDR (SETQ CURRTAIL-1 CURRTAIL] (GO NEXT1))) - OUT (* ; - "We are finished scanning. Now call CLISPATOM2 to assemble the correct form.") + OUT (* ; + "We are finished scanning. Now call CLISPATOM2 to assemble the correct form.") [COND ((NEQ (CAR (LISTP TAIL)) TYP) @@ -1151,10 +1247,13 @@ with the terms of said license. ((GETPROP TYP 'UNARYOP) (GO OUT1)) ((OR (EQ PARENT TAIL) - (EQ SUBPARENT TAIL)) (* ; "E.g. (+ X) or (SETQ Y + X)") + (EQ SUBPARENT TAIL)) (* ; "E.g. (+ X) or (SETQ Y + X)") (DWIMERRORRETURN (LIST 1 TAIL PARENT] (SETQ TAIL (NLEFT (OR SUBPARENT PARENT) - 1 TAIL)) (* ;; "SUBPARENT can be used to mark that point in a list beyond which not to back up, e.g. (LAMBDA (X) FOO X LT Y)") + 1 TAIL)) + + (* ;; "SUBPARENT can be used to mark that point in a list beyond which not to back up, e.g. (LAMBDA (X) FOO X LT Y)") + (SETQ BACKUPFLG T) OUT1 (CLISPATOM2) @@ -1167,9 +1266,11 @@ with the terms of said license. 'CLISPWORD] 'FORWORD) (OR (EQ CLISPCONTEXT 'FORWORD) - (EQ CLISPCONTEXT 'FOR/BIND](* ;; "i used to have just a (NULL (AND DWIMIFYFLG ONEFLG)) but this means tht if you have a predicate in an iterative statement, e.g. when x=y+z that it doesnt dwimify completely. the above clause handles it but i dont remember why i had the original one in there.") - (* ; - "reason for the or check is so that DO doesnt get treated as an IS word when coming from an i.s.") + (EQ CLISPCONTEXT 'FOR/BIND] + + (* ;; "i used to have just a (NULL (AND DWIMIFYFLG ONEFLG)) but this means tht if you have a predicate in an iterative statement, e.g. when x=y+z that it doesnt dwimify completely. the above clause handles it but i dont remember why i had the original one in there.") + (* ; + "reason for the or check is so that DO doesnt get treated as an IS word when coming from an i.s.") (SETQ TEM (CLISPATOM1A TYP CLTYP TAIL)) (COND ((OR DWIMIFYFLG (EQ TEM PARENT)) @@ -1190,21 +1291,26 @@ with the terms of said license. TAIL) (T (CAR (LISTP TAIL] (COND - ((AND TENTATIVE (NEQ TENTATIVE 'CERTAINLY)) (* ;; "Tentative is set to CERTAINLY when we are sure the correction will be CLISP, and to avoid somebody else setting to T . IN this casse there will be no message. This occurs when a message has already been printed, e.g. in X*FOO Y , when user is asked FOO Y -> (FOO Y), the approveal of the CLISP transformation is implicit.") + ((AND TENTATIVE (NEQ TENTATIVE 'CERTAINLY)) + + (* ;; "Tentative is set to CERTAINLY when we are sure the correction will be CLISP, and to avoid somebody else setting to T . IN this casse there will be no message. This occurs when a message has already been printed, e.g. in X*FOO Y , when user is asked FOO Y -> (FOO Y), the approveal of the CLISP transformation is implicit.") + (SETQ CLISPCHANGES (LIST TEM (CLISPATOM1B) TAIL (CDR TAIL) TENTATIVE NOFIXVARSLST0)) - (* ;; "note --- (CDR TAIL) used to be endtail in above expression, however, for situations where clispatom1a munches for a while, this does not produce the right message, e.g. dwimifying .... FOO:1='ZAP ...") + + (* ;; "note --- (CDR TAIL) used to be endtail in above expression, however, for situations where clispatom1a munches for a while, this does not produce the right message, e.g. dwimifying .... FOO:1='ZAP ...") + (AND DWIMIFYFLG (SETQ CLISPCHANGE NIL)) (DWIMERRORRETURN))) (RETURN TEM) - OPR (* ; - "We have hit an operator inside of an atom.") + OPR (* ; + "We have hit an operator inside of an atom.") (COND ((NEQ L LST0) - (SETQ TEM (PACK (LDIFF LST0 L))) (* ; - "Collects characters to the right of the last operator in the atom.") + (SETQ TEM (PACK (LDIFF LST0 L))) (* ; + "Collects characters to the right of the last operator in the atom.") (COND ((AND (FLOATP TEM) (OR (EQ (CAR L) @@ -1212,7 +1318,7 @@ with the terms of said license. (EQ (CAR L) '+-)) (EQ (CAR (NLEFT LST0 1 L)) - 'E)) (* ; "E.G. X+1.0E-5*Y") + 'E)) (* ; "E.G. X+1.0E-5*Y") (AND (EQ (CAR L) '+-) (FRPLACA L '-)) @@ -1222,13 +1328,16 @@ with the terms of said license. (SETQ ATMS (NCONC1 ATMS (CAR L))) [COND (ENDTAIL) - [(NULL TYP) (* ; "First operator.") + [(NULL TYP) (* ; "First operator.") (SETQ TYP (CAR L)) (SETQ CLTYP CLTYP1) (SETQ BROADSCOPE (GETPROP TYP 'BROADSCOPE)) (SETQ NOTFLG (EQ (GETPROP TYP 'LISPFN) 'NOT] - [NOTFLG (* ;; "It is not only necessary that we are processing a NOT, but that it immediately precede the current operator.") + [NOTFLG + + (* ;; "It is not only necessary that we are processing a NOT, but that it immediately precede the current operator.") + (SETQ CLTYP CLTYP1) (SETQ BROADSCOPE (GETPROP (CAR L) 'BROADSCOPE)) @@ -1237,22 +1346,28 @@ with the terms of said license. 'NOT] ((STOPSCAN? CLTYP1 CLTYP (CAR L) (OR (NEQ L LST0) - OPRFLAG)) (* ;; "This operator delimits the scope of the first operator found. Set ENDTAIL to be the first thing not within the scope of the operator.") + OPRFLAG)) + + (* ;; "This operator delimits the scope of the first operator found. Set ENDTAIL to be the first thing not within the scope of the operator.") + (SETQ ENDTAIL (COND - ((EQ L CHARLST) (* ; - "The scope delimiting operator was the first thing in an atom, e.g. A*B +C or A*B + C.") + ((EQ L CHARLST) (* ; + "The scope delimiting operator was the first thing in an atom, e.g. A*B +C or A*B + C.") CURRTAIL) (T (FLAST ATMS] [SETQ OPRFLAG (AND BRACKET (EQ (CAR L) - (CADR BRACKET] (* ; - "OPRFLAG is T aater > since no right hand operand is reuired.") + (CADR BRACKET] (* ; + "OPRFLAG is T aater > since no right hand operand is reuired.") (COND ([AND (CDR L) CURRTAIL (OR (AND BRACKET (EQ (CAR L) (CADR BRACKET))) (EQ (CAR L) - '~] (* ;; "So that the rest of the atom will be looked at as a unit before being unpacked, e.g. ~GR, want to look up GR. Also want to look at rest of atom as a unit following >, e.g. FOO_EQUAL C. By starting over with a new atom, we also perform the OPRFLAG terminating check, as in FOO_C.") + '~] + + (* ;; "So that the rest of the atom will be looked at as a unit before being unpacked, e.g. ~GR, want to look up GR. Also want to look at rest of atom as a unit following >, e.g. FOO←EQUAL C. By starting over with a new atom, we also perform the OPRFLAG terminating check, as in FOO←C.") + (/RPLNODE CURRTAIL (CAR CURRTAIL) (CONS (PACK (CDR L)) (CDR CURRTAIL))) @@ -1261,22 +1376,25 @@ with the terms of said license. (SETQ LST0 (CDR L)) (SETQ L (AND (NEQ (CAR L) '%') - (CDR L))) (* ; - "Following a ' no operaars are recognized in the rest of the atm.") + (CDR L))) (* ; + "Following a ' no operaars are recognized in the rest of the atm.") (GO LP]) (CLRPLNODE [LAMBDA (X A D) (PROG ((L (CDR UNDOSIDE))) (COND - (NOSAVEFLG (* ; - "X is not contained in original expression, so don't bother to save") + (NOSAVEFLG (* ; + "X is not contained in original expression, so don't bother to save") (GO OUT))) LP (COND - ((EQ L (CDR UNDOSIDE0)) (* ; "X has not previously been saved") + ((EQ L (CDR UNDOSIDE0)) (* ; "X has not previously been saved") (/RPLNODE X A D) (RETURN X)) - ((NEQ X (CAAR L)) (* ;; "If X is EQ to CAR of one of the entries on UNDOOSIDE, then the contents of this node have already been saved, so it is ok to smash it.") + ((NEQ X (CAAR L)) + + (* ;; "If X is EQ to CAR of one of the entries on UNDOOSIDE, then the contents of this node have already been saved, so it is ok to smash it.") + (SETQ L (CDR L)) (GO LP))) OUT (FRPLACA X A) @@ -1284,8 +1402,10 @@ with the terms of said license. (RETURN X]) (STOPSCAN? - [LAMBDA (CLTYP2 CLTYP1 OPR OPRFLAG) (* wt%: "16-AUG-78 21:47") - (* ;; "STOPSCAN? is T if operator corresponding to CLTYPX would stop scan for operator corresponding to CLTYP, i.e. if former is of lower or same precedence as latter.") + [LAMBDA (CLTYP2 CLTYP1 OPR OPRFLAG) (* wt%: "16-AUG-78 21:47") + + (* ;; "STOPSCAN? is T if operator corresponding to CLTYPX would stop scan for operator corresponding to CLTYP, i.e. if former is of lower or same precedence as latter.") + (AND CLTYP2 CLTYP1 (PROG NIL (COND [BROADSCOPE (COND @@ -1295,18 +1415,26 @@ with the terms of said license. [(EQ CLTYP2 'BRACKET) (RETURN (COND [(EQ OPR (CAR BRACKET)) - (* ; "a left bracket") - (* ;; "e.g. for X+Y< -- stop scanning. note that for binary brackets, it never stops as is consistent with them being very tight operators, i.e. FOO_A{..} parses as FOO_ (A{..})") + (* ; "a left bracket") + + (* ;; "e.g. for X+Y< -- stop scanning. note that for binary brackets, it never stops as is consistent with them being very tight operators, i.e. FOO←A{..} parses as FOO← (A{..})") + (AND OPRFLAG (EQ BRACKETCNT 1) (GETP OPR 'UNARYOP] ((EQ CLTYP1 'BRACKET) - (* ;; "i.e. if OPR is the right bracket for BRACKET, or if OPR is some other bracket inside of scope of BRACKET.") - (* ;; "if cltyp1 is ot a bracket, then bracket is not the operator, and should really treat the whole bracketed expression as an operand and not stop the scan.") + + (* ;; "i.e. if OPR is the right bracket for BRACKET, or if OPR is some other bracket inside of scope of BRACKET.") + + (* ;; "if cltyp1 is ot a bracket, then bracket is not the operator, and should really treat the whole bracketed expression as an operand and not stop the scan.") + (ZEROP BRACKETCNT] ((NOT (ZEROP BRACKETCNT)) (RETURN NIL)) ((GETPROP OPR 'UNARYOP) - (RETURN OPRFLAG) (* ;; "If OPRFLAG is NIL, we have just seen a unary operator with no operand, so under no circumstance stop the scan. E.g. X*-Y. Note that this does NOT say do not consider next operand as possible operatr, so that X*-+Y will generate an error, not try to multiply X by (minus +). The case whee the unary operaar is ' is handled specially in CLISPATOM1 and CLISPATOM1A.") + (RETURN OPRFLAG) + + (* ;; "If OPRFLAG is NIL, we have just seen a unary operator with no operand, so under no circumstance stop the scan. E.g. X*-Y. Note that this does NOT say do not consider next operand as possible operatr, so that X*-+Y will generate an error, not try to multiply X by (minus +). The case whee the unary operaar is ' is handled specially in CLISPATOM1 and CLISPATOM1A.") + )) (RETURN (COND ([NOT (ILESSP (COND @@ -1324,13 +1452,17 @@ with the terms of said license. ((ATOM CLTYP1) CLTYP1) (T (CDR CLTYP1] - (* ;; "Not sure of this. it is an attempt to handle the A*B_C+D case. Here the initial cltyp is that of *, but since the right precedence of _ is looser than that of *, means that it should be operative.") + + (* ;; "Not sure of this. it is an attempt to handle the A*B←C+D case. Here the initial cltyp is that of *, but since the right precedence of ← is looser than that of *, means that it should be operative.") + (SETQ CLTYP CLTYP2) NIL]) (CLUNARYMINUS? - [LAMBDA (OPRFLAG) (* lmm "20-May-84 20:02") - (* ;; "True if minus is unary. This is the case when either (1) it immediately follows an operator (the (AND TYP (NULL OPRFLAG)) check) or (2) it is the first thing in a list (the (EQ CURRTAIL SUBPARENT) check) or else, car of form is a function and not a variable, and --- negates its first argument. The case where car of form is amisspeleed function is handled, because the tentatitve correction for binry minus will be tried, and then when spelling correction on function name suceeds, this will be implemeneted. then there will be another call to clispatom when its aagument is evaluated, and this time the functionis spelled right. Note that the cse where car of a form is a misspelled variable works also, even when the variabl could be confusec for a function, since the correction on the variable is tried first.") + [LAMBDA (OPRFLAG) (* lmm "20-May-84 20:02") + + (* ;; "True if minus is unary. This is the case when either (1) it immediately follows an operator (the (AND TYP (NULL OPRFLAG)) check) or (2) it is the first thing in a list (the (EQ CURRTAIL SUBPARENT) check) or else, car of form is a function and not a variable, and --- negates its first argument. The case where car of form is amisspeleed function is handled, because the tentatitve correction for binry minus will be tried, and then when spelling correction on function name suceeds, this will be implemeneted. then there will be another call to clispatom when its aagument is evaluated, and this time the functionis spelled right. Note that the cse where car of a form is a misspelled variable works also, even when the variabl could be confusec for a function, since the correction on the variable is tried first.") + (OR (AND TYP (NULL OPRFLAG)) (EQ CURRTAIL SUBPARENT) (AND (EQ CURRTAIL (CDR SUBPARENT)) @@ -1352,9 +1484,12 @@ with the terms of said license. '" " T]) (CLBINARYMINUS? - [LAMBDA ($TAIL MINUSTAIL) (* wt%: "10-OCT-78 21:22") - (* ;; "used when a negative number follows a list. we dont know if a space was typed before the --- or not, so in situation ike ((list) -2) or (x* (list) -2) we ask. warren ^Z") - (* ;; "the EQ used to check tail against subparent. i changed it because on calls to dwimify0? from record, e.g. (ADD z:1 -1), was trying to treat -1 as binary even though it shouldnt have.") + [LAMBDA ($TAIL MINUSTAIL) (* wt%: "10-OCT-78 21:22") + + (* ;; "used when a negative number follows a list. we dont know if a space was typed before the --- or not, so in situation ike ((list) -2) or (x* (list) -2) we ask. warren ↑Z") + + (* ;; "the EQ used to check tail against subparent. i changed it because on calls to dwimify0? from record, e.g. (ADD z:1 -1), was trying to treat -1 as binary even though it shouldnt have.") + (AND (EQ TAIL PARENT) [OR (LISTP (CAR TAIL)) (NUMBERP (CAR TAIL)) @@ -1379,8 +1514,10 @@ with the terms of said license. (CDR MINUSTAIL]) (CLISPATOM1A - [LAMBDA (TYP CLTYP TAIL NOSAVEFLG) (* lmm " 4-SEP-83 22:50") - (* ;;; "This function is similar to CLISPATOM1 except that elements of TAIL do not have to be unpacked. It is called from either CLISPATOM1 or CLISPATOM2 when more than one operator was encountered in a cluster. CADR of TAIL is TYP, the next operator to be processed, and CLTYP is its CLISPTYPE. CLISPATOM1A scans down TAIL looking for the right hand boundary of TYP, but does not unpack any atoms. It then calls CLISPATOM2 to assemble the form, and then if necessary repeats the process. For example, if the original cluster was A+B*C, the call to CLISPATOM2 from CLISPATOM1 would replace this with (IPLUS A B * C). CLISPATOM2 would then call CLISPATOM1A with TAIL= (B * C). Similary, if the original cluster were A*B+C, the call to CLISPATOM2 from CLISPATOM1 would replace this with (ITIMES A B) with + C having been spliced into the tail. CLISPATOM1 would then call CLISPATOM1A with TAIL= ((ITIMES A B) + C ...)") + [LAMBDA (TYP CLTYP TAIL NOSAVEFLG) (* lmm " 4-SEP-83 22:50") + +(* ;;; "This function is similar to CLISPATOM1 except that elements of TAIL do not have to be unpacked. It is called from either CLISPATOM1 or CLISPATOM2 when more than one operator was encountered in a cluster. CADR of TAIL is TYP, the next operator to be processed, and CLTYP is its CLISPTYPE. CLISPATOM1A scans down TAIL looking for the right hand boundary of TYP, but does not unpack any atoms. It then calls CLISPATOM2 to assemble the form, and then if necessary repeats the process. For example, if the original cluster was A+B*C, the call to CLISPATOM2 from CLISPATOM1 would replace this with (IPLUS A B * C). CLISPATOM2 would then call CLISPATOM1A with TAIL= (B * C). Similary, if the original cluster were A*B+C, the call to CLISPATOM2 from CLISPATOM1 would replace this with (ITIMES A B) with + C having been spliced into the tail. CLISPATOM1 would then call CLISPATOM1A with TAIL= ((ITIMES A B) + C ...)") + (PROG (ENDTAIL OPRFLAG BROADSCOPE CLTYP0 BRACKETCNT BRACKET ISFLG) TOP (SETQ ISFLG (EQ (CAR (GETPROP TYP 'CLISPCLASS)) 'ISWORD)) @@ -1389,8 +1526,8 @@ with the terms of said license. 1) (T 0))) [SETQ ENDTAIL (COND - ((EQ TYP (CAR TAIL)) (* ; - "TYP is car of TAIL for unary operatrs, CADR for binary.") + ((EQ TYP (CAR TAIL)) (* ; + "TYP is car of TAIL for unary operatrs, CADR for binary.") TAIL) (T (CDR TAIL] [COND @@ -1437,8 +1574,8 @@ with the terms of said license. (GO OUT)) [SETQ OPRFLAG (AND (EQ CLTYP0 'BRACKET) (EQ (CAR ENDTAIL) - (CADR BRACKET] (* ; - "E.g. X_ see comment in CLISPATOM1") + (CADR BRACKET] (* ; + "E.g. X← see comment in CLISPATOM1") ) ((AND OPRFLAG (ZEROP BRACKETCNT) (NULL BROADSCOPE)) @@ -1453,15 +1590,20 @@ with the terms of said license. 'CLISPWORD)) 'FORWORD) (OR (EQ CLISPCONTEXT 'FORWORD) - (EQ CLISPCONTEXT 'FOR/BIND](* ;; "E.g. A+B*C+D. The first call to CLISPATOM1A is with TAIL (B * C + D). The first call to CLISPATOM2 changes this to ((ITIMES B C) + D), and then we loop back to the top of CLISPATOM1A. The reason for the OR is so that do does not get treated as an IS WORD when coming from an i.s.") + (EQ CLISPCONTEXT 'FOR/BIND] + + (* ;; "E.g. A+B*C+D. The first call to CLISPATOM1A is with TAIL (B * C + D). The first call to CLISPATOM2 changes this to ((ITIMES B C) + D), and then we loop back to the top of CLISPATOM1A. The reason for the OR is so that do does not get treated as an IS WORD when coming from an i.s.") + (GO TOP))) - (AND TENTATIVE (SETQQ TENTATIVE PROBABLY)) (* ; - "Don't consider another interpretation if there are two or more CLISP operators in this cluster.") + (AND TENTATIVE (SETQQ TENTATIVE PROBABLY)) (* ; + "Don't consider another interpretation if there are two or more CLISP operators in this cluster.") (RETURN TAIL]) (CLISPATOM1B - [LAMBDA NIL (* wt%: 25-FEB-76 1 41) - (* ;; "Copies changes.") + [LAMBDA NIL (* wt%: 25-FEB-76 1 41) + + (* ;; "Copies changes.") + (PROG ((L UNDOSIDE) (L1 (CDR UNDOSIDE0)) LST) @@ -1475,7 +1617,7 @@ with the terms of said license. (CDAAR L))) LST))) ((EQ (CAAR L) - '/PUTHASH) (* ; "Pattern match.") + '/PUTHASH) (* ; "Pattern match.") (SETQ LST (CONS (LIST '/PUTHASH (CADAR L) (GETHASH (CADAR L) CLISPARRAY) @@ -1484,9 +1626,10 @@ with the terms of said license. (GO LP]) (CLISPATOM2 - [LAMBDA NIL (* bvm%: "21-Nov-86 11:56") - (* ;; - "Assembles LISP forms from the CLISP expressions") + [LAMBDA NIL (* bvm%: "21-Nov-86 11:56") + + (* ;; "Assembles LISP forms from the CLISP expressions") + (PROG ((PARENT PARENT) VAR1 VAR2 Z (UNARYFLG (GETPROP TYP 'UNARYOP)) (LISPFN (GETPROP TYP 'LISPFN)) @@ -1494,7 +1637,10 @@ with the terms of said license. ENDTAIL-1) (AND (NEQ TYP (CAR TAIL)) UNARYFLG - (SETQ TAIL (CDR TAIL))) (* ;; "On calls from CLISPATOM1A, TYP is always CADR of TAIL. e.g. in X+Y 'Z, on the call to CLISPATOM2 to process ', TAIL would be (IPLUS X Y) ' Z.") + (SETQ TAIL (CDR TAIL))) + + (* ;; "On calls from CLISPATOM1A, TYP is always CADR of TAIL. e.g. in X+Y 'Z, on the call to CLISPATOM2 to process ', TAIL would be (IPLUS X Y) ' Z.") + [COND ((AND (SETQ TEM (GETP (CAR ENDTAIL) 'CLISPBRACKET)) @@ -1523,42 +1669,55 @@ with the terms of said license. (AND (EQ (CAR ENDTAIL) '~) (GETPROP (CADR ENDTAIL) - 'CLISPTYPE] (* ; "X+Y~=Z is OK.") + 'CLISPTYPE] (* ; "X+Y~=Z is OK.") ) - ((AND UNARYFLG (CLISPATOM2C TAIL)) (* ; "E.G. (~FOO 'X Y) is OK.") + ((AND UNARYFLG (CLISPATOM2C TAIL)) (* ; "E.G. (~FOO 'X Y) is OK.") ) - (T (* ; "E.G. (X + Y ' Z)") + (T (* ; "E.G. (X + Y ' Z)") (DWIMERRORRETURN (LIST 2 ENDTAIL PARENT] [(AND (NULL FORMSFLG) - (EQ PARENT TAIL)) (* ;; "An missing operand error is going to be generated if something isnt done in the next COND, e.g (X*Y Z)") + (EQ PARENT TAIL)) + + (* ;; "An missing operand error is going to be generated if something isnt done in the next COND, e.g (X*Y Z)") + (COND ((AND ENDTAIL DWIMIFYFLG (EQ CLISPCONTEXT 'IFWORD) (CLISPRESPELL ENDTAIL CLISPIFWORDSPLST)) - (* ; - "Found a correction; tell CLISPIF to try again.") + (* ; + "Found a correction; tell CLISPIF to try again.") (CL:THROW 'CLISPIF0 :RESPELL)) [(AND ENDTAIL (CLISPRESPELL ENDTAIL CLISPINFIXSPLST)) - (* ;; "E.g. (X + Y LSS Z). Note that we do not try to correct spelling on infixes unless the form is otherwise going to cause an eror, e.g. in (FOO X_Y ORR --), the ORR is not checked for here. Thus in the event that the next thing on ENDTAIL is a CLISP transformation, e.g. (FOO X_Y Z_W), we do not have to do any extra work. This algorithm contains the implicit assumption that all the operatrs on CLISPINFIXSPLST (i.e. the ones we correct for) will terminate the scope of all non-broadscope operators. Otherwise, if FOO is a non-broadscope operator, and FIE would not terminate FOO, and FIE is on CLISPINFIXSPLST, the form (LIST A FOO B FIEE C) would parse as (LIST (A FOO B) FIE C), which is wrong. In this case, not only would we have to backup to CLISPATOM1 using RETEVAL as in CLIPATOMB, we would also have to check for misspelled operaaors appearng in CAR of ENDTAIL even when an error would not otherwise be generated, e.g. in (LIST X_Y Z_W) we would have to check the spelling of Z_W. Note that when the current operator is broadscope, we always perform spelling correction (via the call to DWIIFY! in CLISPTOM2B) since once parentheses are inserted, we can't distinguish e.g. (X AND Y ORR Z) from (X AND (Y ORR Z)).") + + (* ;; "E.g. (X + Y LSS Z). Note that we do not try to correct spelling on infixes unless the form is otherwise going to cause an eror, e.g. in (FOO X←Y ORR --), the ORR is not checked for here. Thus in the event that the next thing on ENDTAIL is a CLISP transformation, e.g. (FOO X←Y Z←W), we do not have to do any extra work. This algorithm contains the implicit assumption that all the operatrs on CLISPINFIXSPLST (i.e. the ones we correct for) will terminate the scope of all non-broadscope operators. Otherwise, if FOO is a non-broadscope operator, and FIE would not terminate FOO, and FIE is on CLISPINFIXSPLST, the form (LIST A FOO B FIEE C) would parse as (LIST (A FOO B) FIE C), which is wrong. In this case, not only would we have to backup to CLISPATOM1 using RETEVAL as in CLIPATOMB, we would also have to check for misspelled operaaors appearng in CAR of ENDTAIL even when an error would not otherwise be generated, e.g. in (LIST X←Y Z←W) we would have to check the spelling of Z←W. Note that when the current operator is broadscope, we always perform spelling correction (via the call to DWIIFY! in CLISPTOM2B) since once parentheses are inserted, we can't distinguish e.g. (X AND Y ORR Z) from (X AND (Y ORR Z)).") + (COND (DWIMIFYFLG (CL:THROW (COND ((LISTP CLISPCONTEXT) - (* ;; "We want to go back to the clispatom1 above this call to wtfix, e.g. consider X AND Y_T ORR Z. In this case, we are dwimifying (Y_T ORR Z) but we want to go back to higher level. Used to do this via (RETDWIM0 'CLISPATOM1 (RETDWIM0 'WTFIX)), but now we just tell WTFIX to throw again.") + + (* ;; "We want to go back to the clispatom1 above this call to wtfix, e.g. consider X AND Y←T ORR Z. In this case, we are dwimifying (Y←T ORR Z) but we want to go back to higher level. Used to do this via (RETDWIM0 'CLISPATOM1 (RETDWIM0 'WTFIX)), but now we just tell WTFIX to throw again.") + 'WTFIX) (T 'CLISPATOM1)) :RESPELL] ([CLISPATOM2C (COND (UNARYFLG TAIL) - (T (CDR TAIL] (* ; "E.G. FOO_GETP 'FIE 'EXPR") + (T (CDR TAIL] (* ; "E.G. FOO←GETP 'FIE 'EXPR") ) - (T (* ; "E.g. (LIST * X Y)") + (T (* ; "E.g. (LIST * X Y)") (DWIMERRORRETURN (LIST 2 ENDTAIL PARENT] ((CLISPATOM2C (COND (UNARYFLG TAIL) (T (CDR TAIL] (COND - ((EQ CLTYP 'BRACKET) (* ;; "Note that as currently implemented, ENDTAIL can be NIL. i.e. there is no check for whether or not matching > where actually found. This enables user to insert expressions like < where actually found. This enables user to insert expressions like <, the scope may include the entire IF statement, e.g. IF A THEN , the scope may include the entire IF statement, e.g. IF A THEN ((FOO X) AND Y)") + (CDR TAIL)) (* ; + "inserts parens in VAR1, e.g. (FOO X AND Y) -> ((FOO X) AND Y)") (SETQ BACKUPFLG T) (SETQ TAIL TEM))) (COND @@ -1661,10 +1830,13 @@ with the terms of said license. (CLISPBROADSCOPE1 TAIL PARENT BACKUPFLG] B (SETQ VAR1 (CAR TAIL)) (SELECTQ TYP - (%: (AND LISPFN (GO C)) (* ; - "means user has redefined : as a normal lisp operator") - (SETQ Z (CLISPCAR/CDR (SETQ TEM VAR2))) (* ;; "the value returned by CLISPCAR/CDR indicates whether there was more than one operator involved, and is used to set CLISPCHANGE below.") - (SETQ TEM (CLISPATOM2D NIL VAR1)) (* ; "Inserts new expressioninto TAIL.") + (%: (AND LISPFN (GO C)) (* ; + "means user has redefined : as a normal lisp operator") + (SETQ Z (CLISPCAR/CDR (SETQ TEM VAR2))) + + (* ;; "the value returned by CLISPCAR/CDR indicates whether there was more than one operator involved, and is used to set CLISPCHANGE below.") + + (SETQ TEM (CLISPATOM2D NIL VAR1)) (* ; "Inserts new expressioninto TAIL.") (COND (DWIMIFYFLG (AND CLISPCHANGE (GO OUT)) (SETQ CLISPCHANGE TEM)) @@ -1673,24 +1845,24 @@ with the terms of said license. (CLISPATOM2A (CDR VAR2) VAR2) (AND TENTATIVE Z (SETQQ TENTATIVE PROBABLY)) - (* ; - "Means there was more than one : operator.") + (* ; + "Means there was more than one : operator.") (GO OUT)) - (_ [COND + (← [COND ((NLISTP VAR1) (SETQ TEM TYP)) - (T (* ; - "_ in connection with a : operator.") + (T (* ; + "← in connection with a : operator.") [SETQ TEM (SELECTQ (CAR VAR1) (CAR 'RPLACA) (CDR 'RPLACD) ((NCONC NCONC1) (CAR VAR1)) - ((replace REPLACE) (* ; - "From record declaration assigmnent.") + ((replace REPLACE) (* ; + "From record declaration assigmnent.") (CLISPATOM2D NIL (CLISPRECORD VAR1 VAR2 T)) - (* ; - "Where the right hand operand to the _ will be DWIMIFIED, and TENTATIVE set, etc.") + (* ; + "Where the right hand operand to the ← will be DWIMIFIED, and TENTATIVE set, etc.") (GO C1)) (COND ([OR (SETQ TEM (GETPROP (CAR VAR1) @@ -1698,13 +1870,17 @@ with the terms of said license. (PROGN (DWIMIFY1? VAR1) (SETQ TEM (GETPROP (CAR VAR1) 'SETFN] - (* ;; "E.G. User converts X \ FOO to (GETP X FOO), and puts PUT on SETFN of GETP, so that X \ FOO_T becomes (PUT X FOO T)") + + (* ;; "E.G. User converts X \ FOO to (GETP X FOO), and puts PUT on SETFN of GETP, so that X \ FOO←T becomes (PUT X FOO T)") + (CLISPATOM2D NIL (CONS (CLISPLOOKUP TEM (CADR VAR1)) (APPEND (CDR VAR1) VAR2))) - (* ;; "SETFN. Must be handled this way because VAR1 may correspond to more than one operand, e.g. X \ FOO_T -> (ELT X FOO) _T and must go to (SETA X FOO T)") + + (* ;; "SETFN. Must be handled this way because VAR1 may correspond to more than one operand, e.g. X \ FOO←T -> (ELT X FOO) ←T and must go to (SETA X FOO T)") + (GO C1)) - (T (DWIMERRORRETURN '_] + (T (DWIMERRORRETURN '←] (SETQ LISPFN (GETPROP TEM 'LISPFN)) (SETQ VAR1 (CADR VAR1] (SETQ LISPFN (CLISPLOOKUP TEM VAR1 NIL LISPFN)) @@ -1712,8 +1888,8 @@ with the terms of said license. ((AND (EQ LISPFN 'SETQ) (EQ (CAR VAR2) '%') - (NULL (CDDR VAR2))) (* ; - "Last AND clause to detect FOO _ ' FIE : 2 type of operations.") + (NULL (CDDR VAR2))) (* ; + "Last AND clause to detect FOO ← ' FIE : 2 type of operations.") (SETQQ LISPFN SETQQ) (SETQ VAR2 (CDR VAR2] (COND @@ -1727,8 +1903,8 @@ with the terms of said license. LISPFN)) (COND (UNARYFLG [SETQ VAR1 (COND - ((CDR VAR2) (* ; - "E.g. NOT is a unary operator which may take more than one expression, e.g. NOT A = B") + ((CDR VAR2) (* ; + "E.g. NOT is a unary operator which may take more than one expression, e.g. NOT A = B") VAR2) ((AND TYPE-IN? (EQ LISPFN 'QUOTE) (EQ (CAR VAR2) @@ -1740,8 +1916,8 @@ with the terms of said license. (GO INSERT))) [SETQ TEM (COND ((AND VAR2 (NULL (CDR VAR2))) - (CAR VAR2] (* ; - "TEM is the right-hand argument, if it is a single item.") + (CAR VAR2] (* ; + "TEM is the right-hand argument, if it is a single item.") (COND ((SELECTQ LISPFN (EQ (COND @@ -1751,8 +1927,8 @@ with the terms of said license. (IPLUS (COND ((AND (LISTP VAR1) (EQ (CAR VAR1) - 'IPLUS)) (* ; - "Leave asis, so X+Y+1 goes to (IPLUS X Y 1) instead of (ADD1 (IPLUS X Y))") + 'IPLUS)) (* ; + "Leave asis, so X+Y+1 goes to (IPLUS X Y 1) instead of (ADD1 (IPLUS X Y))") NIL) ((EQ TEM 1) (SETQQ LISPFN ADD1)) @@ -1778,25 +1954,40 @@ with the terms of said license. (COND ((AND PARENT (ATOM PARENT)) (CLISPATOM2A TAIL TAIL) - (GO OUT))) (* ;; "Corresponds to the case where the entire expression became an atom, e.g. X~=NIL gging to X, or --- 3 going to -3.0") - (SETQ Z (CDR PARENT)) (* ;; "Z is used to find the operands for DWIMIFYING. It is now set so that CAR of it coresponds VAR1 and CADR of it coresponds CAR of VAR2.") + (GO OUT))) + + (* ;; "Corresponds to the case where the entire expression became an atom, e.g. X~=NIL gging to X, or --- 3 going to -3.0") + + (SETQ Z (CDR PARENT)) + + (* ;; "Z is used to find the operands for DWIMIFYING. It is now set so that CAR of it coresponds VAR1 and CADR of it coresponds CAR of VAR2.") + (COND ((CLISPNOEVAL LISPFN) (AND DWIMIFYFLG (SETQ CLISPCHANGE TEM)) (GO NEG)) (DWIMIFYFLG (AND CLISPCHANGE (NULL UNARYFLG) - (GO C1)) (* ;; "If CLISPCHANGE is T and this is not a UNARY operation, the first operand has already been dwimified.") + (GO C1)) + + (* ;; "If CLISPCHANGE is T and this is not a UNARY operation, the first operand has already been dwimified.") + (SETQ CLISPCHANGE TEM)) ((NOT (ATOM (CAR Z))) (GO C1))) (AND (NEQ LISPFN 'SETQ) - (CLISPATOM2A Z PARENT)) (* ;; "Dwimifies VAR1, e.g. ((A+B) *C). If CLISPCHANGE is T, VAR1 has already been processed, e.g. A*B+C, becomes ((ITIMES A A) + C), and the A and B have already been checked by the first call to CLISPATOM2. VAR1 is also dwimified when running provided it is atomic. so that if it or VAR2 is unbound, an alternate correction will be tried, e.g. mistyping a variable named FOO-1 as FOOO-1.") + (CLISPATOM2A Z PARENT)) + + (* ;; "Dwimifies VAR1, e.g. ((A+B) *C). If CLISPCHANGE is T, VAR1 has already been processed, e.g. A*B+C, becomes ((ITIMES A A) + C), and the A and B have already been checked by the first call to CLISPATOM2. VAR1 is also dwimified when running provided it is atomic. so that if it or VAR2 is unbound, an alternate correction will be tried, e.g. mistyping a variable named FOO-1 as FOOO-1.") + C1 [COND (UNARYFLG (GO C2)) ((AND (LISTP VAR1) (EQ LISPFN (CAR VAR1)) (FMEMB LISPFN '(AND OR IPLUS ITIMES FPLUS FTIMES PLUS TIMES)) - (NEQ VAR1 (CAR CLISPLASTSUB))) (* ;; "Handles nospreads, e.g. A+B+C becomes (IPLUS A B C) Note that where necessary, VAR1 has already been dwimified. The CLISPLASTSUB check is to prevent parens from beig taken out when VAR1 is the result of an IS PHRASE since this is needed later.") + (NEQ VAR1 (CAR CLISPLASTSUB))) + + (* ;; "Handles nospreads, e.g. A+B+C becomes (IPLUS A B C) Note that where necessary, VAR1 has already been dwimified. The CLISPLASTSUB check is to prevent parens from beig taken out when VAR1 is the result of an IS PHRASE since this is needed later.") + (CLRPLNODE Z (CADR VAR1) (APPEND (CDDR VAR1) VAR2] @@ -1804,33 +1995,39 @@ with the terms of said license. (COND ((OR DWIMIFYFLG (LITATOM (CAR Z))) (CLISPATOM2A Z PARENT))) - C2 (* ; - "Z is now set so that it corresponds to the right hand argument of the oprator.") + C2 (* ; + "Z is now set so that it corresponds to the right hand argument of the oprator.") (COND ([AND Z (SETQ CLTYP (GETPROP (SETQ LISPFN (CAR Z)) - 'CLISPTYPE] (* ; - "The second operand is itself an operator, e.g. a+*b.") + 'CLISPTYPE] (* ; + "The second operand is itself an operator, e.g. a+*b.") (COND ([OR (NULL (CDR Z)) - (NULL (GETPROP LISPFN 'UNARYOP] (* ; - "The GETP check is because this is not an error if the operator is unary.") + (NULL (GETPROP LISPFN 'UNARYOP] (* ; + "The GETP check is because this is not an error if the operator is unary.") (DWIMERRORRETURN 2))) - (CLISPATOM1A LISPFN CLTYP Z ENDTAIL) (* ;; "If ENDTAIL is non-nil, the LDIFF copied this portion of TAIL, so it is not necessary to do any saving.") + (CLISPATOM1A LISPFN CLTYP Z ENDTAIL) + + (* ;; "If ENDTAIL is non-nil, the LDIFF copied this portion of TAIL, so it is not necessary to do any saving.") + ) ((NULL (CDR Z))) ((SETQ CLTYP (GETPROP (SETQ LISPFN (CADR Z)) 'CLISPTYPE)) (CLISPATOM1A LISPFN CLTYP Z ENDTAIL))) NEG [COND - (NEGFLG (* ; - "An operator was negated, e.g. X ~MEMB y") + (NEGFLG (* ; + "An operator was negated, e.g. X ~MEMB y") (CLRPLNODE PARENT 'NOT (LIST (CONS (CAR PARENT) (CDR PARENT] [COND ([AND (EQ (CAR PARENT) 'NOT) (LISTP (SETQ TEM (CADR PARENT))) - (NOT (EQUAL PARENT (SETQ TEM (NEGATE TEM] (* ;; "Special stuff for negation. Done fter everything to take care of both X~=Y, and ~ (EQ X Y) in the same way.") + (NOT (EQUAL PARENT (SETQ TEM (NEGATE TEM] + + (* ;; "Special stuff for negation. Done fter everything to take care of both X~=Y, and ~ (EQ X Y) in the same way.") + [COND ((EQ PARENT (CAR TAIL)) (CLRPLNODE TAIL TEM (CDR TAIL))) @@ -1841,26 +2038,27 @@ with the terms of said license. OUT (RETURN TAIL]) (CLISPNOEVAL - [LAMBDA (FN DEFAULT) (* lmm "29-Jul-86 00:00") - (* ;; - "returns true if FN doesn't evaluate its args. If not sure, return DEFAULT") + [LAMBDA (FN DEFAULT) (* lmm "29-Jul-86 00:00") + + (* ;; "returns true if FN doesn't evaluate its args. If not sure, return DEFAULT") + (PROG (TEM) [COND ((SETQ TEM (FASSOC FN DWIMEQUIVLST)) (SETQ FN (CDR TEM] (RETURN (AND (SELECTQ (ARGTYPE FN) - ((1 3) (* ; "NLAMBDA") + ((1 3) (* ; "NLAMBDA") T) - (NIL (* ; - "udf -- see what else we know about it") + (NIL (* ; + "udf -- see what else we know about it") (OR (FMEMB FN NLAMA) (FMEMB FN NLAML) (COND ((NOT (OR (GETPROP FN 'MACRO-FN) (GETLIS FN MACROPROPS))) DEFAULT) - [DWIMINMACROSFLG (* ; - "Macros are treated as LAMBDA forms unless INFO prop says otherwise") + [DWIMINMACROSFLG (* ; + "Macros are treated as LAMBDA forms unless INFO prop says otherwise") (RETURN (EQMEMB 'NOEVAL (GETPROP FN 'INFO] (T T)))) (OR (FMEMB FN NLAMA) @@ -1868,14 +2066,21 @@ with the terms of said license. (NOT (EQMEMB 'EVAL (GETPROP FN 'INFO]) (CLISPLOOKUP - [LAMBDA (WORD $VAR1 $VAR2 $LISPFN) (* lmm "20-May-84 19:08") - (* ;; "In most cases, it is not necessary to do a full lookup. This is quick an dirty check inside of the block to avoid calling CLISPLOOKUP0 It will work whenever there are no local declarations.") + [LAMBDA (WORD $VAR1 $VAR2 $LISPFN) (* lmm "20-May-84 19:08") + + (* ;; "In most cases, it is not necessary to do a full lookup. This is quick an dirty check inside of the block to avoid calling CLISPLOOKUP0 It will work whenever there are no local declarations.") + (PROG (TEM CLASS CLASSDEF) (SETQ CLASS (GETPROP WORD 'CLISPCLASS)) - (SETQ CLASSDEF (GETPROP CLASS 'CLISPCLASSDEF)) (* ;; "used to be getprop word, but this meant GT worked differently than gt. also this new way is consistent with clispifylooup. shuld it bb (OR (getprop word) (getprop class))?") + (SETQ CLASSDEF (GETPROP CLASS 'CLISPCLASSDEF)) + + (* ;; "used to be getprop word, but this meant GT worked differently than gt. also this new way is consistent with clispifylooup. shuld it bb (OR (getprop word) (getprop class))?") + [SETQ TEM (COND ((AND CLASSDEF (SETQ TEM (GETLOCALDEC EXPR FAULTFN))) - (* ;; "must do full lookup. Note that it is not necessary to do a call to CLISPLOOKUP0 if word has a CLASS, but no CLASSDEF, e.g. FGTP, FMEMB, etc., since if these are ued as infix operators, they mean the corresponding functin regardless of declaraton. I.e. The CLASSDEF property says that this is the name of an infix operator. The CLASS property is used as a back pointer to the name of the operator/class of which this word is a member.") + + (* ;; "must do full lookup. Note that it is not necessary to do a call to CLISPLOOKUP0 if word has a CLASS, but no CLASSDEF, e.g. FGTP, FMEMB, etc., since if these are ued as infix operators, they mean the corresponding functin regardless of declaraton. I.e. The CLASSDEF property says that this is the name of an infix operator. The CLASS property is used as a back pointer to the name of the operator/class of which this word is a member.") + (CLISPLOOKUP0 WORD $VAR1 $VAR2 TEM $LISPFN CLASS CLASSDEF)) (T (SELECTQ CLASS (VALUE (RETURN (GETATOMVAL WORD))) @@ -1901,22 +2106,26 @@ with the terms of said license. (RETURN TEM]) (CLISPATOM2A - [LAMBDA (TAIL PARENT) (* lmm "21-Jun-85 16:49") + [LAMBDA (TAIL PARENT) (* lmm "21-Jun-85 16:49") (AND TAIL (NULL BROADSCOPE) (PROG ((DWIMIFYING (AND DWIMIFYFLG DWIMIFYING)) (CLISPCONTEXT (AND DWIMIFYFLG CLISPCONTEXT)) - DWIMIFYCHANGE TEM) (* ;; "If BROADSCOPE is T, everything has already been dwimified. See comments in clispatm2 and clispatom2b1") - (* ;; "CLISPATOM2A sets up state variables itself rather than calling DWIMIFY1? or DWIMIFY2? because it wants to be able to add to NOFIXVARSLST0.") + DWIMIFYCHANGE TEM) + + (* ;; "If BROADSCOPE is T, everything has already been dwimified. See comments in clispatm2 and clispatom2b1") + + (* ;; "CLISPATOM2A sets up state variables itself rather than calling DWIMIFY1? or DWIMIFY2? because it wants to be able to add to NOFIXVARSLST0.") + (COND ((NULL DWIMIFYFLG) (SETQ NOFIXFNSLST0 NOFIXFNSLST) (SETQ NOFIXVARSLST0 NOFIXVARSLST))) [SETQ TEM (COND - ((OR (AND (NEQ TYP '_) - (NEQ TYP ')) - (LISTP VAR1)) (* ; - "VAR1 is a list when the _ is a record expression.") + ((OR (AND (NEQ TYP '←) + (NEQ TYP '_)) + (LISTP VAR1)) (* ; + "VAR1 is a list when the ← is a record expression.") 'DONTKNOW) ((OR (FMEMB VAR1 VARS) (FMEMB VAR1 NOFIXVARSLST0)) @@ -1925,8 +2134,8 @@ with the terms of said license. (AND (NULL DWIMIFYING) (STKSCAN VAR1 FAULTPOS)) (GETPROP VAR1 'GLOBALVAR) - (FMEMB VAR1 GLOBALVARS)) (* ; - "Added to NOFIXVARSLST0 so will be avilable for spelling correction in the future.") + (FMEMB VAR1 GLOBALVARS)) (* ; + "Added to NOFIXVARSLST0 so will be avilable for spelling correction in the future.") (SETQ NOFIXVARSLST0 (CONS VAR1 NOFIXVARSLST0)) 'PROBABLY) ([AND (NEQ CLISPCONTEXT 'FOR/BIND) @@ -1937,14 +2146,17 @@ with the terms of said license. (OR [AND VARS (SETQ TEM (FIXSPELL VAR1 NIL VARS NIL NIL NIL NIL NIL T 'MUSTAPPROVE] (SETQ TEM (FIXSPELL VAR1 NIL SPELLINGS3 NIL NIL NIL NIL NIL T - 'MUSTAPPROVE] (* ;; "FIXSPELL is called instead of CLISPRESPELL because we dont want runon corrections, and also we have performed msot of the checks of CLISPRESPELL.") + 'MUSTAPPROVE] + + (* ;; "FIXSPELL is called instead of CLISPRESPELL because we dont want runon corrections, and also we have performed msot of the checks of CLISPRESPELL.") + (CLRPLNODE (CDR PARENT) TEM (CDDR PARENT)) 'CERTAINLY) (T (SETQ NOFIXVARSLST0 (CONS VAR1 NOFIXVARSLST0)) - (* ; - "Added to NOFIXVARSLST0 so that it will be available for spelling correction in the future.") + (* ; + "Added to NOFIXVARSLST0 so that it will be available for spelling correction in the future.") 'DONTKNOW] (RETURN (COND [(LISTP (CAR TAIL)) @@ -1955,8 +2167,8 @@ with the terms of said license. ([AND TAIL (CAR TAIL) (LITATOM (CAR TAIL)) (NOT (GETPROP (CAR TAIL) - 'CLISPTYPE] (* ; - "We already know that the atom has no operators internal to it, having scanned through it earlier.") + 'CLISPTYPE] (* ; + "We already know that the atom has no operators internal to it, having scanned through it earlier.") (SETQ CLISPCONTEXT NIL) (COND ((AND (NULL (DWIMIFY2 TAIL PARENT T NIL T 'NORUNONS)) @@ -1965,7 +2177,7 @@ with the terms of said license. (SETQ TENTATIVE TEM]) (CLISPBROADSCOPE - [LAMBDA ($TYP L CONTEXT) (* lmm "29-Jul-86 00:26") + [LAMBDA ($TYP L CONTEXT) (* lmm "29-Jul-86 00:26") (PROG ((BRACKETCNT 0) (L0 L)) LP [COND @@ -2012,7 +2224,9 @@ with the terms of said license. ((EQ CONTEXT 'IS) 'IS) (T - (* ;; "Reason for the OR is to handle things like X IS A NUMBER AND NOT LT Y. In this case would be dwimifying (NOT LT Y) but when go to dwimify (NOT) want CLISPATOMIS? to be able to se the higher context.") + + (* ;; "Reason for the OR is to handle things like X IS A NUMBER AND NOT LT Y. In this case would be dwimifying (NOT LT Y) but when go to dwimify (NOT) want CLISPATOMIS? to be able to se the higher context.") + (OR (AND DWIMIFYFLG (LISTP CLISPCONTEXT )) @@ -2026,15 +2240,19 @@ with the terms of said license. (CAR X) (CAR X) NIL NIL NIL CONTEXT)) - (T (* ;; "FLG says that the parens were inserted here, so that CONTEXT should be passed on to DWIMIFY1 in case there is a spelling error, e.g. (TAIL AND Y ORR Z) gets handled differently than (TAIL AND Y OR Z)") + (T + (* ;; "FLG says that the parens were inserted here, so that CONTEXT should be passed on to DWIMIFY1 in case there is a spelling error, e.g. (TAIL AND Y ORR Z) gets handled differently than (TAIL AND Y OR Z)") + (DWIMIFY1? (CAR X) (AND FLG CONTEXT]) (CLISPATOM2C - [LAMBDA (TAIL0) (* lmm "20-May-84 19:55") - (* ;; "Checks for the case where user leaves out arentheses in front of functon name that follows an operator, e.g. (LIST X+ADD1 Y)") - (SETQ TAIL0 (CDR TAIL0)) (* ; - "TAIL0 is as of the right hand operand.") + [LAMBDA (TAIL0) (* lmm "20-May-84 19:55") + + (* ;; "Checks for the case where user leaves out arentheses in front of functon name that follows an operator, e.g. (LIST X+ADD1 Y)") + + (SETQ TAIL0 (CDR TAIL0)) (* ; + "TAIL0 is as of the right hand operand.") (COND ([AND (NEQ TYP '%') (NEQ TYP '%:) @@ -2047,7 +2265,7 @@ with the terms of said license. [COND ((EQ (CDR Y) (CDAR Y)) - (* ; "Unary operator") + (* ; "Unary operator") (CAAR Y)) (T (CONCAT (RETDWIM2 (CAAR Y)) (COND @@ -2061,7 +2279,7 @@ with the terms of said license. (CONCAT [COND ((EQ (CDR Y) (CDAR Y)) - (* ; "Unary operator") + (* ; "Unary operator") (CAAR Y)) (T (CONCAT (RETDWIM2 (CAAR Y)) (COND @@ -2076,34 +2294,52 @@ with the terms of said license. (CDDR Y] (T (CONS X (CDDR Y] '")"] - (CONS TAIL TAIL0] (* ;; "The GETP check is for situations like (LIST X_'FOO Y) i.e. a unary operator could never take care of the rest of the list.") + (CONS TAIL TAIL0] + + (* ;; "The GETP check is for situations like (LIST X←'FOO Y) i.e. a unary operator could never take care of the rest of the list.") + (/RPLNODE TAIL0 (CONS (CAR TAIL0) (CDR TAIL0))) - (SETQ ENDTAIL NIL) (* ; - "Once you print a message, you dont want to go and try another interpretation.") + (SETQ ENDTAIL NIL) (* ; + "Once you print a message, you dont want to go and try another interpretation.") (SETQQ TENTATIVE CERTAINLY]) (CLISPATOM2D - [LAMBDA (X Y) (* ;; "Inserts new expression into TAIL. Value is T if expression was not parenthesized, PARTIAL if it was, i.e. if it corresponded to the new CAR of TAIL. If X is NIL, Y is the whole expression.") + [LAMBDA (X Y) + + (* ;; "Inserts new expression into TAIL. Value is T if expression was not parenthesized, PARTIAL if it was, i.e. if it corresponded to the new CAR of TAIL. If X is NIL, Y is the whole expression.") + (COND ((AND (NULL ENDTAIL) (NULL FORMSFLG) (OR (NULL PARENT) - (EQ PARENT TAIL))) (* ;; "This is the case in which we do not want to 'subordinate' the expression with an extra pair of parentheses. E.g. (LIST (A+B)). The ENDTAIL check is necessary because if it is not NIL, there are more expressions following the first one, e.g. (LIST (A*B+C)) and we must keep this expression separate, i.e. make (A*B+C) become ((ITIMES A A) + C)") + (EQ PARENT TAIL))) + + (* ;; "This is the case in which we do not want to 'subordinate' the expression with an extra pair of parentheses. E.g. (LIST (A+B)). The ENDTAIL check is necessary because if it is not NIL, there are more expressions following the first one, e.g. (LIST (A*B+C)) and we must keep this expression separate, i.e. make (A*B+C) become ((ITIMES A A) + C)") + (COND - ((NULL X) (* ;; "Y is the entire expression to be inserted, but we can't use it because we have to 'take out' the parentheses.") + ((NULL X) + + (* ;; "Y is the entire expression to be inserted, but we can't use it because we have to 'take out' the parentheses.") + (CLRPLNODE TAIL (CAR Y) (CDR Y)) (AND (SETQ X (GETHASH Y CLISPARRAY)) - (CLISPTRAN TAIL X)) (* ;; "Must move translation to new expression. This only occurs if the expression is enclosed in prentheses, e.g. (X: (--))") + (CLISPTRAN TAIL X)) + + (* ;; "Must move translation to new expression. This only occurs if the expression is enclosed in prentheses, e.g. (X: (--))") + (AND (EQ Y (CAR CLISPLASTSUB)) - (FRPLACA CLISPLASTSUB TAIL)) (* ;; "Y is the expression returned by CLISPATOMIS but it is not going to apear in the new expression, so must change clisplastsub to correspnd") + (FRPLACA CLISPLASTSUB TAIL)) + + (* ;; "Y is the expression returned by CLISPATOMIS but it is not going to apear in the new expression, so must change clisplastsub to correspnd") + ) (T (CLRPLNODE TAIL X Y))) (SETQ PARENT TAIL) T) - (T (* ; - "Here we must parenthesize the expression so as to subordinate it.") + (T (* ; + "Here we must parenthesize the expression so as to subordinate it.") [SETQ Y (COND ((NULL X) Y) @@ -2111,24 +2347,26 @@ with the terms of said license. (NUMBERP (CAR Y))) (MINUS (CAR Y))) (T (CONS X Y] - (CLRPLNODE TAIL Y ENDTAIL) (* ; - "ENDTAIL being all the stuff not belonging to the CLISP expression, i.e. beyond its scope.") + (CLRPLNODE TAIL Y ENDTAIL) (* ; + "ENDTAIL being all the stuff not belonging to the CLISP expression, i.e. beyond its scope.") (SETQ PARENT (CAR TAIL)) 'PARTIAL]) (CLISPCAR/CDR - [LAMBDA (LST) (* lmm "21-Jun-85 16:50") - (* ;; "Handles the : infix operatr.") + [LAMBDA (LST) (* lmm "21-Jun-85 16:50") + + (* ;; "Handles the : infix operatr.") + (PROG ([SETQFLG (OR (EQ (CAR ENDTAIL) - '_) + '←) (EQ (CAR ENDTAIL) - '] + '_] TAILFLG N TEM VAL) (SETQ VAR2 NIL) LP (SETQ TAILFLG NIL) [COND ((EQ (CAR LST) - '%:) (* ; "Tail") + '%:) (* ; "Tail") (SETQ TAILFLG T) (SETQ LST (CDR LST] (COND @@ -2136,7 +2374,7 @@ with the terms of said license. (SETQ VAR1 (LIST (COND ((NULL SETQFLG) (GO ERROR)) - (TAILFLG (* ; "X::_") + (TAILFLG (* ; "X::←") 'NCONC) (T 'NCONC1)) VAR1)) @@ -2181,12 +2419,12 @@ with the terms of said license. (GO NEG))) LP1 [COND ((AND (IGREATERP N 4) - (ILESSP N 9)) (* ; - "X:N for N greater than 8 goes to (NTH X N)") + (ILESSP N 9)) (* ; + "X:N for N greater than 8 goes to (NTH X N)") (SETQ N (IPLUS N -4)) (SETQ VAR1 (LIST 'CDDDDR VAR1)) (AND (NULL VAR2) - (SETQ VAR2 VAR1)) (* ; "VAR2 marks the TAIL where the original operand appears, so thaadwimifying will continue from there.") + (SETQ VAR2 VAR1)) (* ; "VAR2 marks the TAIL where the original operand appears, so thaadwimifying will continue from there.") (GO LP1)) ((AND SETQFLG (NULL (CDR LST))) (SETQ VAR1 (CLISPCAR/CDR1 1 (CLISPCAR/CDR1 (SUB1 N) @@ -2226,15 +2464,17 @@ with the terms of said license. (GO LP2]) (CLISPCAR/CDR1 - [LAMBDA (N X TAILFLG SETQFLG) (* lmm "20-May-84 19:56") - (* ;; "All three level car and cdr operations go back to the corresponding function, i.e. CDAAR clispifies to X:1:1::1 and goes back to CDAAR.") + [LAMBDA (N X TAILFLG SETQFLG) (* lmm "20-May-84 19:56") + + (* ;; "All three level car and cdr operations go back to the corresponding function, i.e. CDAAR clispifies to X:1:1::1 and goes back to CDAAR.") + (PROG (TEM) (COND ((ZEROP N) (RETURN X)) ((AND (NULL DWIMIFYFLG) - CHECKCARATOMFLG) (* ; - "If CHECKCARATOMFLG is T, then checks to see if the car/cdr chain goes through an atom (non-list)") + CHECKCARATOMFLG) (* ; + "If CHECKCARATOMFLG is T, then checks to see if the car/cdr chain goes through an atom (non-list)") (CLISPCAR/CDR2 N X))) [SETQ TEM (COND ([AND (NULL SETQFLG) @@ -2242,11 +2482,17 @@ with the terms of said license. (SETQ TEM (COND ((EQ N 1) (SELECTQ (CAR X) - (CAR (* ;; "The apparent incompleteness of the SELECTQ is bcause CAR of CDR would appear in CLISS as 2 and be handled directly, similarly for CDR of CDR.") + (CAR + + (* ;; "The apparent incompleteness of the SELECTQ is bcause CAR of CDR would appear in CLISS as 2 and be handled directly, similarly for CDR of CDR.") + (COND (TAILFLG 'CDAR) (T 'CAAR))) - (CAAR (* ;; "Similarly, CAR of CDAR would come in as CADR of CAR, CDR of CDAR as CDDR of CAR, so checks for CDAR and CDDR are not necessary.") + (CAAR + + (* ;; "Similarly, CAR of CDAR would come in as CADR of CAR, CDR of CDAR as CDDR of CAR, so checks for CDAR and CDDR are not necessary.") + (COND (TAILFLG 'CDAAR) (T 'CAAAR))) @@ -2256,11 +2502,14 @@ with the terms of said license. NIL)) ((AND (EQ N 2) (EQ (CAR X) - 'CAR)) (* ;; "CADR of CDR would be written as X:3, similaly CAAR of CDR, CDAR of CDR, and CDDR of CDR are all taken care of.") + 'CAR)) + + (* ;; "CADR of CDR would be written as X:3, similaly CAAR of CDR, CDAR of CDR, and CDDR of CDR are all taken care of.") + (COND (TAILFLG 'CDDAR) - (T 'CADAR] (* ; - "If SETQFLG is T, want to leave the outer CAR or CDR because gets replaced by rplaca/d later.") + (T 'CADAR] (* ; + "If SETQFLG is T, want to leave the outer CAR or CDR because gets replaced by rplaca/d later.") (FRPLACA X TEM)) [(IGREATERP N 4) (SETQ TEM (CLISPLOOKUP 'NTH VAR1)) @@ -2284,7 +2533,7 @@ with the terms of said license. (RETURN TEM]) (CLISPCAR/CDR2 - [LAMBDA (N X) (* lmm "20-May-84 19:56") + [LAMBDA (N X) (* lmm "20-May-84 19:56") (PROG ((NODE (STKEVAL FAULTPOS X))) LP [COND ((ZEROP N) @@ -2296,13 +2545,18 @@ with the terms of said license. (GO LP]) (CLISPATOMIS1 - [LAMBDA (SUBJ OBJ ALST EXP NEGATE) (* lmm "20-May-84 20:03") - (* ;; "ALST is cdr of the value returned by clispmatchup. CAR is split into the two arguments SUBJ and OBJ.") + [LAMBDA (SUBJ OBJ ALST EXP NEGATE) (* lmm "20-May-84 20:03") + + (* ;; "ALST is cdr of the value returned by clispmatchup. CAR is split into the two arguments SUBJ and OBJ.") + (SELECTQ (CAR SUBJ) ((AND OR) [CONS (CAR SUBJ) (MAPCAR (CDR SUBJ) - (FUNCTION (LAMBDA (X) (* ;; "The AND is bcause it is ok for NEGFLG to be T instead of LISTONLY on recursive calls, because (NOT (NULL X)) can go to X in this case since we have the tail to put it in.") + (FUNCTION (LAMBDA (X) + + (* ;; "The AND is bcause it is ok for NEGFLG to be T instead of LISTONLY on recursive calls, because (NOT (NULL X)) can go to X in this case since we have the tail to put it in.") + (CLISPATOMIS1 X OBJ ALST EXP (AND NEGATE T]) (PROGN (SETQ EXP (SUBLIS (CONS (CONS OBJ SUBJ) ALST) @@ -2312,9 +2566,10 @@ with the terms of said license. (T EXP]) (CLISPATOMARE1 - [LAMBDA (X FLG) (* lmm "29-Jul-86 00:27") - (* ;; - "value is an edit pushdown list (of tails) leding to the place of the last is subject.") + [LAMBDA (X FLG) (* lmm "29-Jul-86 00:27") + + (* ;; "value is an edit pushdown list (of tails) leding to the place of the last is subject.") + (PROG (L TEM) (SETQ L (CDR X)) LP (COND @@ -2333,21 +2588,24 @@ with the terms of said license. (RETURN NIL]) (CLISPATOMARE2 - [LAMBDA (L Z) (* lmm " 4-SEP-83 23:07") + [LAMBDA (L Z) (* lmm " 4-SEP-83 23:07") (PROG (X X1) [COND ((NULL (CDR L)) (COND (Z (RETURN (CAR Z))) - (T (* ; - "E.g. X AND Y IS A NUMBER ARE ATOMS.") + (T (* ; + "E.g. X AND Y IS A NUMBER ARE ATOMS.") (DWIMERRORRETURN (LIST 'PHRASE (CDR TAIL) PARENT] - (SETQ X (CAADR L)) (* ; "the parent of (CAR L)") + (SETQ X (CAADR L)) (* ; "the parent of (CAR L)") (SETQ X1 (CDAR L)) [COND ((AND DEST (EQ (CAR L) - (CDR X))) (* ;; "move inner expression out. case 1: (A OR B ARE NUMBERS AND C OR D ARE LISTS) VAR1 is (OR (AND (OR (NUMBERP A) (NUMBERP B)) C) D) but the AND is reaaly the top leveloperator. case 2: (A OR B IS A NUMBER AND C OR D ARE LISTS) VAR1 is (OR A (AND (NUMBERP B) C) D) here the OR should be the top leveloperator. The difference is that") + (CDR X))) + + (* ;; "move inner expression out. case 1: (A OR B ARE NUMBERS AND C OR D ARE LISTS) VAR1 is (OR (AND (OR (NUMBERP A) (NUMBERP B)) C) D) but the AND is reaaly the top leveloperator. case 2: (A OR B IS A NUMBER AND C OR D ARE LISTS) VAR1 is (OR A (AND (NUMBERP B) C) D) here the OR should be the top leveloperator. The difference is that") + (FRPLACA (CADR L) (CADR X))) (T (FRPLACD (CAR L] @@ -2363,8 +2621,10 @@ with the terms of said license. (T X1]) (CLISPATOMIS2 - [LAMBDA (X) (* ; "wt: 25-FEB-76 1 51") - (* ;; "Used by clispatomaRE and clispatomIis? to eliminate unnecessary nesting of ands and ors after finishing processing. (Too hard to do on the fly as we built pushdown list of tails etc.) NOte that we cant remove parens from around clisplastsub since it might be needed later in parsing. Thus X AND Y ARE NUMBERS AND GREATER THAN 3 must be left as (AND (NUMBERP X) (NUMBER Y) (AND (IGREATERP X 3) (IGREATERP Y 3)))") + [LAMBDA (X) (* ; "wt: 25-FEB-76 1 51") + + (* ;; "Used by clispatomaRE and clispatomIis? to eliminate unnecessary nesting of ands and ors after finishing processing. (Too hard to do on the fly as we built pushdown list of tails etc.) NOte that we cant remove parens from around clisplastsub since it might be needed later in parsing. Thus X AND Y ARE NUMBERS AND GREATER THAN 3 must be left as (AND (NUMBERP X) (NUMBER Y) (AND (IGREATERP X 3) (IGREATERP Y 3)))") + (PROG (($TYP (CAR X))) LP [AND (LISTP (CAR X)) (NEQ (CAR X) @@ -2388,299 +2648,335 @@ with the terms of said license. (DEFINEQ (WTFIX - [LAMBDA (FAULTX FAULTARGS FAULTAPPLYFLG) (* lmm "15-Apr-86 09:59") + [LAMBDA (FAULTX FAULTARGS FAULTAPPLYFLG) (* lmm "15-Apr-86 09:59") (PROG (FAULTPOS FAULTFN EXPR VARS TAIL PARENT SUBPARENT FORMSFLG ONLYSPELLFLG DWIMIFYFLG TEM) (RETURN (WTFIX1]) (WTFIX0 - [LAMBDA (FAULTX TAIL PARENT SUBPARENT ONLYSPELLFLG) (* ;; "Internal entry from dwimify1 and dwimify2. EXPR, FAULTFN, VARS, TAIL, and FORMSFLG already correctly bound.") + [LAMBDA (FAULTX TAIL PARENT SUBPARENT ONLYSPELLFLG) + + (* ;; "Internal entry from dwimify1 and dwimify2. EXPR, FAULTFN, VARS, TAIL, and FORMSFLG already correctly bound.") + (PROG (FAULTARGS FAULTAPPLYFLG (FAULTPOS (COND ((NULL (AND DWIMIFYFLG DWIMIFYING)) - (* ; - "Originally started out evaluting, so there is a higher faultpos.") + (* ; + "Originally started out evaluting, so there is a higher faultpos.") FAULTPOS))) (DWIMIFYFLG T)) (RETURN (WTFIX1]) (WTFIX1 - [LAMBDA NIL (* bvm%: "21-Nov-86 18:37") - (* ;; "Replaces FAULT1 when DWIM is on. on u.b.a.'s FAULTX is the atom. On u.d.f.'s involving forms, FAULTX is the form. On u.d.f.'s from APPLY, faultx is the name of the function, FAULTARGS the arguments, and FAULTAPPLYFLG is T. Also is called directly to process a form from DWIMIFY. In this case, EXPR, VARS, ..., NOSPELLFLG0 are supplied, and FINDFN is not called.") + [LAMBDA NIL (* bvm%: "21-Nov-86 18:37") + + (* ;; "Replaces FAULT1 when DWIM is on. on u.b.a.'s FAULTX is the atom. On u.d.f.'s involving forms, FAULTX is the form. On u.d.f.'s from APPLY, faultx is the name of the function, FAULTARGS the arguments, and FAULTAPPLYFLG is T. Also is called directly to process a form from DWIMIFY. In this case, EXPR, VARS, ..., NOSPELLFLG0 are supplied, and FINDFN is not called.") + (AND DWIMFLG (LET [(RESULT - (CL:CATCH - 'WTFIX - (XNLSETQ - (PROG ((NOSPELLFLG0 NOSPELLFLG) - (CLISPERTYPE) - (DWIM.GIVE.UP.TIME (OR DWIM.GIVE.UP.TIME (SETUPTIMER DWIM.GIVE.UP.INTERVAL))) - TYPE-IN? BREAKFLG FAULTXX CHARLST FAULTEM1 NEWTAIL HISTENTRY FIXCLK CLISPCHANGES - SIDES) (* ; "LIST because this used to be a XNLSETQ. I think callers only want to know whether we returned something interesting, or somebody called (RETDWIM)") - [COND - (DWIMIFYFLG (* ;; "Call from WTFIX0. Note that while this call from DWIMIFY1 or DWIMIFY2, the user may or may not have been DWIMIFYING, e.g. when IF's are encountered in evaluation, DWIMIFY1 and DWIMIFY2 are used. The variable DWIMIFYING is T if the call to DWIMIFY! or DWIMIFY2 is from an explicit call to DWIMIFY (or DWIMIFYFNS)") - (SETQ TYPE-IN? (EQ FAULTFN 'TYPE-IN)) - (* ;; "DWIMIFY is called on typein for processing FOR's and IF's. In this case, want to treat user approval the same as for type-in.") - ) - (T (SETQ FIXCLK (CLOCK 2)) (* ;; "If EXPR is given, i.e. if DWIMIFYFLG is gong to be T, the clkock is being measured at some higher caal to WTFIX or DWIMIIY.") - [SETQ FAULTPOS (STKPOS (COND - (FAULTAPPLYFLG 'FAULTAPPLY) - (T 'FAULTEVAL] - (AND (NEQ CLEARSTKLST T) - (SETQ CLEARSTKLST (CONS FAULTPOS CLEARSTKLST))) - (* ; - "In case user control-ds out of correction, this will relstk faultpos") - (SETQ FAULTFN (FINDFN (FSTKNTH -1 FAULTPOS) - T)) (* ;; "The value of FINDFN is the name of the (interpreted) function in which the error occurred. FINDFN also sets the free variable EXPR to the definition of that function. If the error occurred under a call to EVAL, the value of FINDFN is EVAL, and EXPR is set to the expression being evaluated, i.e. the argument to EVAL. If the error occurred under an APPLY, the value of FINDFN is the first argument to APPLY, and EXPR is set to the second argument to APPLY, i.e. the list of arguments. In this case, FAULTX will usually be EQ to the value returned by FINDFN, and FAULTARGS EQ to EXPR. However, WTFIX may also be called from FAULTAPPLY, and FINDFN not find an APPLY, as occurs on undefined functions called from compiled code. For this reason, FIXAPPLY always uses FAULTX and FAULTARGS, not FAULTFN and EXPR.") - (SETQ VARS (AND (SETQ FAULTEM1 (OR BREAKFLG (LISTP EXPR))) - (GETVARS FAULTEM1] - [AND (NULL TYPE-IN?) - (SETQ SIDES (CDR (LISTGET1 LISPXHIST 'SIDE] - (AND TYPE-IN? (NULL DWIMIFYFLG) - [COND - (FAULTAPPLYFLG (EQ FAULTX (CAAAAR LISPXHISTORY))) - (T (OR (EQ FAULTX (CAAAAR LISPXHISTORY)) - (EQUAL FAULTX (CAAAR LISPXHISTORY] - (SETQ HISTENTRY (CAAR LISPXHISTORY))) - [COND - ([LITATOM (SETQ FAULTXX (COND - (FAULTAPPLYFLG FAULTX) - ((NLISTP FAULTX) - FAULTX) - (T (CAR FAULTX] - (SETQ CHARLST (DUNPACK FAULTXX WTFIXCHCONLST] - (COND - ((AND (NULL FAULTAPPLYFLG) - (LITATOM FAULTX)) - (FIXATOM) - (SHOULDNT)) - (FAULTAPPLYFLG (FIXAPPLY) - (SHOULDNT)) - ([AND TYPE-IN? (EQ FAULTXX (CAAR HISTENTRY)) - (AND (NEQ NOSPELLFLG T) - (AND (SETQ FAULTEM1 (FMEMB LPARKEY CHARLST)) - (NULL (AND CLISPFLG (STRPOSL CLISPCHARRAY FAULTXX] - (* ;; "LPARKEY is the lowercase version of left prentheses, normally 8, rparkey is normally 9, but user can reset them for different terminals. The EQ distinguishes between (CONS8ADD1 3) which is handled by a call to FIX89 from CLISPATOM, and FOO8A B C ']' , which is handled by FIX89TYPEIN, since it requires changing an EVAL to an APPLY.") - (FIX89TYPEIN FAULTEM1 CHARLST)) - ((AND CLISPFLG CHARLST (LITATOM (SETQ FAULTEM1 (CADR FAULTX))) - (OR (GETPROP FAULTEM1 'CLISPTYPE) - (FMEMB (SETQ FAULTEM1 (NTHCHAR FAULTEM1 1)) - CLISPCHARS)) - [OR (NOT (GETPROP FAULTEM1 'UNARYOP)) - (AND (EQ FAULTEM1 '~) - (GETPROP (PACK (CDR (DUNPACK (CADR FAULTX) - WTFIXCHCONLST1))) - 'CLISPTYPE] - (NOT (CLISPNOTVARP (CAR FAULTX))) - (CLISPNOTVARP (CADR FAULTX))) (* ; - "So that things like (SUM + X) will work, i.e. not be interpreted as iterative statement.") - (GO NX0)) - ((NULL CHARLST) - (GO NX2))) (* ; - "Both FIXAPPLY and FIXATOM exit via RETDWIM so there is no need for a return here in WTFIX.") - TOP [SELECTQ (CAR FAULTX) - (F/L [/RPLNODE - FAULTX - 'FUNCTION - (LIST (CONS 'LAMBDA - (COND - ([AND (CDDR FAULTX) - [OR (NULL (CADR FAULTX)) - (AND (LISTP (CADR FAULTX)) - (EVERY (CADR FAULTX) - (FUNCTION (LAMBDA (X) - (AND X (NEQ X T) - (LITATOM X] - (OR (MEMB (CAADR FAULTX) - (FREEVARS (CDDR FAULTX))) - (NOT (CLISPFUNCTION? (CADR FAULTX) - 'OKVAR] - (CDR FAULTX)) - (T (CONS (LIST 'X) - (CDR FAULTX] - (GO OUT)) - (CLISP%: (ERSETQ (CLISPDEC0 FAULTX FAULTFN)) - (SETQ FAULTX T)) - (COND - [[CAR (LISTP (SETQ FAULTEM1 (GETPROP (CAR FAULTX) - 'CLISPWORD] - (RESETVARS [(LCASEFLG (AND LCASEFLG (NULL TYPE-IN?] - (SELECTQ (CAR FAULTEM1) - (FORWORD (SETQ FAULTX (OR (CLISPFOR FAULTX) - (RETDWIM)))) - (IFWORD (SETQ FAULTX (CLISPIF FAULTX)) - (SETQ HISTENTRY NIL)) - (MATCHWORD (* ; - "CAR of FAULTX either MATCH or match.") - (CLISPTRAN FAULTX (MAKEMATCH FAULTX))) - (PREFIXFN (PROG ((EXPR FAULTX)) - (SETQ FAULTEM1 (CDR FAULTX)) - [COND - ((EQ (CAR (LISTP (CAR FAULTEM1))) - 'CLISP%:) - (ERSETQ (CLISPDEC0 (CAR FAULTEM1) - FAULTFN] - [COND - ((EQ (CAR (LISTP (CAR FAULTEM1))) - COMMENTFLG) - (SETQ FAULTEM1 (CDR FAULTEM1] - [SETQ FAULTEM1 - (APPEND (COND - [(AND (NULL (CDR FAULTEM1)) - (LISTP (CAR FAULTEM1] - (T FAULTEM1] - (RESETVARS ((CLISPFLG T)) - (DWIMIFY1? FAULTEM1)) - (CLISPELL FAULTX) - (CLISPTRAN FAULTX FAULTEM1))) - (SETQ FAULTX (APPLY* (CAR FAULTEM1) - FAULTX] - (T (GO NX0] - (AND DWIMIFYFLG (SETQ CLISPCHANGE T)) - (GO OUT) - NX0 (COND - [(GETD (CAR FAULTX)) - (COND - ([NULL (PROG (TYPE-IN? (FAULTFN (CAR FAULTX))) - (RETURN (COND - ((FIXLAMBDA (GETD (CAR FAULTX))) - (* ; - "This is the case where (FOO --) is being evaluated, and the definition of FOO is bad.") - (AND FILEPKGFLG (LITATOM FAULTFN) - (MARKASCHANGED FAULTFN 'FNS)) - T] - (SETQ NOSPELLFLG0 T) - (GO NX3) (* ; "So DWIMUSERFN can be called.") - ] - ((AND (OR (GETPROP (CAR FAULTX) - 'EXPR) - (GETPROP (CAR FAULTX) - 'CODE)) - (DWIMUNSAVEDEF (CAR FAULTX))) - (SETQ FAULTFN NIL) (* ; - "So that RETDWIM won't do a MARKASCHANGED") - ) - ((SETQ FAULTEM1 (GETPROP (CAR FAULTX) - 'FILEDEF)) - (COND - ((WTFIXLOADEF FAULTEM1) - (GO OUT))) - (RETDWIM)) - (T (GO NX1))) - (GO OUT) - NX1 (COND - ((AND (CLISPNOTVARP (CAR FAULTX)) - (SETQ FAULTEM1 (CLISPATOM CHARLST FAULTX FAULTX))) - (* ; "E.g. (FOO_ATOM) OR (FOO_ form)") - (SETQ FAULTX FAULTEM1) - (GO OUT))) - NX2 (COND - ([AND CLISPFLG (SETQ FAULTEM1 (CADR FAULTX)) - (OR (LITATOM FAULTEM1) - (AND (NUMBERP FAULTEM1) - (MINUSP FAULTEM1) - (CLBINARYMINUS? FAULTX))) - (OR (GETPROP FAULTEM1 'CLISPTYPE) - (FMEMB (CAR (SETQ FAULTEM1 (DUNPACK FAULTEM1 WTFIXCHCONLST1))) - CLISPCHARS)) - (SETQ FAULTEM1 (CLISPATOM FAULTEM1 (CDR FAULTX) - FAULTX T)) - (COND - [(OR (NEQ FAULTXX (CAR FAULTX)) - (AND CLISPARRAY (GETHASH FAULTX CLISPARRAY] - (DWIMIFYFLG (SETQ CHARLST (DUNPACK FAULTXX WTFIXCHCONLST)) - (* ; "LST may have been clobbered") - (SETQ CLISPCHANGE NIL] (* ;; "E.g. (FOO _atom) or (FOO _ form). The NEQ check is necessary to handle situations like (FOOO N-1) where an CLISP transformation is performed, but it does not correct CAR of the form. (In this case, we must continue to the spelling correction part below, and set CLISPCHANGE to NIL so that DWIMIFY1 will not be confused.) Note that if FOO also happens to be the name of a function, then WTFIX will not be called and the CLISP transformation not be performed until the arguments of FOO are evaluated and cause a u.b.a. error. Then DWIM will have to back up as described in FIXATOM and FIXATOM1.") - (SETQ FAULTX FAULTEM1) - (GO OUT)) - ((AND (NULL NOSPELLFLG0) - DWIMIFYFLG - (LISTP (CADR FAULTX)) - (FIXLAMBDA FAULTX)) (* ;; "The DWIMIFYFLG check is because in normal course of events, it never makes sense for LAMBDA to appear as CAR of a FORM. However, DWIMIFY1 is called on open LAMBDA expressions.") - (GO OUT)) - ((AND (NULL NOSPELLFLG0) - (LISTP (CAR FAULTX)) - (LISTP (CADAR FAULTX)) - (FIXLAMBDA (CAR FAULTX))) (* ;; "This corresponds to the case where LAMBDA is misspelled in an open LAMBDA expression. Note that an open lambda expression only makes sense when there is a non-atomic argument list, so dont both spelling correcting if this is notthe case.") - (GO OUT))) - NX3 (COND - [[SOME DWIMUSERFORMS (FUNCTION (LAMBDA (DWIMUSERFORM) - (SETQ FAULTEM1 (EVAL DWIMUSERFORM] - (COND - (FAULTAPPLYFLG (RETDWIM FAULTPOS FAULTEM1 T FAULTARGS)) - (T (RETDWIM FAULTPOS FAULTEM1] - (NOSPELLFLG0 (GO FAIL)) - [[AND CHARLST (SETQ FAULTXX - (OR (FIXSPELL (CAR FAULTX) - NIL SPELLINGS2 NIL FAULTX NIL NIL NIL T) - (AND DWIMIFYFLG NOFIXFNSLST0 - (FIXSPELL (CAR FAULTX) - NIL NOFIXFNSLST0 NIL FAULTX NIL NIL NIL T] - (* ; - "The extra argument to FIXSPELL indicates that SPLITS re tolerated, e.g. (BREAKFOO)") - (COND - ((EQ (CAAR HISTENTRY) - (CAR FAULTX)) - (/RPLNODE HISTENTRY FAULTX (CDR HISTENTRY)) - (* ;; "Normally, RETDWIM patches the histroy entry to corresond to a list input, even if it was typed in as a line. In the special case of a pselling correction, we leave the entry as a line.") - )) - (SETQ HISTENTRY NIL) - (COND - ((NOT (FGETD FAULTXX)) (* ; - "E.g. USER misspells FOR, IF, F/L etc. These are all contained on SPELLINGS2.") - (GO TOP] - ((AND CLISPFLG DWIMIFYFLG (CDR FAULTX) - (LISTP CLISPCONTEXT) - (FIXSPELL (CAR FAULTX) - NIL CLISPISWORDSPLST NIL FAULTX NIL NIL NIL T) - (SETQ FAULTEM1 (CLISPATOM (DUNPACK (CAR FAULTX) - WTFIXCHCONLST) - TAIL PARENT)))(* ;; "E.g. X IS A NUMBER AND LESS THAN Y. CLISPATOM will call CLISPATOMIS? which will retfrom back past here or generate an error. NOte that if (CAR FAUULTX) had been spelled correctly, thiswold have happened in first call to CLISPATOM at NX1 earlir. However, we dont do the misspelled check until here because it is more likely user has misspelled the name of one of his functions.") - ) - ([AND CLISPFLG (NULL CLISPCHANGES) - (NULL CLISPERTYPE) - (SETQ FAULTEM1 (CADR FAULTX)) - (LITATOM FAULTEM1) - (SETQ FAULTEM1 (FIXSPELL FAULTEM1 NIL CLISPINFIXSPLST NIL - (OR (AND DWIMIFYFLG (LISTP CLISPCONTEXT)) - (CDR FAULTX)) - NIL NIL NIL T)) - (COND - ((AND DWIMIFYFLG (LISTP CLISPCONTEXT)) - (* ;; - "Return from the corresponding DWIMUNDOCATCH with a value telling CLISPATOM to try again.") - (CL:THROW 'CLISPATOM1 :RESPELL)) - (T (LET (CLISPERTYPE) - (SETQ FAULTEM1 (CLISPATOM FAULTEM1 (CDR FAULTX) - FAULTX T] - (SETQ FAULTX FAULTEM1)) - (T (GO FAIL))) - OUT (RETDWIM FAULTPOS FAULTX) - FAIL - (RETDWIM] + (CL:CATCH 'WTFIX + (XNLSETQ + (PROG ((NOSPELLFLG0 NOSPELLFLG) + (CLISPERTYPE) + (DWIM.GIVE.UP.TIME (OR DWIM.GIVE.UP.TIME (SETUPTIMER DWIM.GIVE.UP.INTERVAL))) + TYPE-IN? BREAKFLG FAULTXX CHARLST FAULTEM1 NEWTAIL HISTENTRY FIXCLK CLISPCHANGES + SIDES) (* ; "LIST because this used to be a XNLSETQ. I think callers only want to know whether we returned something interesting, or somebody called (RETDWIM)") + [COND + (DWIMIFYFLG + + (* ;; "Call from WTFIX0. Note that while this call from DWIMIFY1 or DWIMIFY2, the user may or may not have been DWIMIFYING, e.g. when IF's are encountered in evaluation, DWIMIFY1 and DWIMIFY2 are used. The variable DWIMIFYING is T if the call to DWIMIFY! or DWIMIFY2 is from an explicit call to DWIMIFY (or DWIMIFYFNS)") + + (SETQ TYPE-IN? (EQ FAULTFN 'TYPE-IN)) + + (* ;; "DWIMIFY is called on typein for processing FOR's and IF's. In this case, want to treat user approval the same as for type-in.") + + ) + (T (SETQ FIXCLK (CLOCK 2)) + + (* ;; "If EXPR is given, i.e. if DWIMIFYFLG is gong to be T, the clkock is being measured at some higher caal to WTFIX or DWIMIIY.") + + [SETQ FAULTPOS (STKPOS (COND + (FAULTAPPLYFLG 'FAULTAPPLY) + (T 'FAULTEVAL] + (AND (NEQ CLEARSTKLST T) + (SETQ CLEARSTKLST (CONS FAULTPOS CLEARSTKLST))) + (* ; + "In case user control-ds out of correction, this will relstk faultpos") + (SETQ FAULTFN (FINDFN (FSTKNTH -1 FAULTPOS) + T)) + + (* ;; "The value of FINDFN is the name of the (interpreted) function in which the error occurred. FINDFN also sets the free variable EXPR to the definition of that function. If the error occurred under a call to EVAL, the value of FINDFN is EVAL, and EXPR is set to the expression being evaluated, i.e. the argument to EVAL. If the error occurred under an APPLY, the value of FINDFN is the first argument to APPLY, and EXPR is set to the second argument to APPLY, i.e. the list of arguments. In this case, FAULTX will usually be EQ to the value returned by FINDFN, and FAULTARGS EQ to EXPR. However, WTFIX may also be called from FAULTAPPLY, and FINDFN not find an APPLY, as occurs on undefined functions called from compiled code. For this reason, FIXAPPLY always uses FAULTX and FAULTARGS, not FAULTFN and EXPR.") + + (SETQ VARS (AND (SETQ FAULTEM1 (OR BREAKFLG (LISTP EXPR))) + (GETVARS FAULTEM1] + [AND (NULL TYPE-IN?) + (SETQ SIDES (CDR (LISTGET1 LISPXHIST 'SIDE] + (AND TYPE-IN? (NULL DWIMIFYFLG) + [COND + (FAULTAPPLYFLG (EQ FAULTX (CAAAAR LISPXHISTORY))) + (T (OR (EQ FAULTX (CAAAAR LISPXHISTORY)) + (EQUAL FAULTX (CAAAR LISPXHISTORY] + (SETQ HISTENTRY (CAAR LISPXHISTORY))) + [COND + ([LITATOM (SETQ FAULTXX (COND + (FAULTAPPLYFLG FAULTX) + ((NLISTP FAULTX) + FAULTX) + (T (CAR FAULTX] + (SETQ CHARLST (DUNPACK FAULTXX WTFIXCHCONLST] + (COND + ((AND (NULL FAULTAPPLYFLG) + (LITATOM FAULTX)) + (FIXATOM) + (SHOULDNT)) + (FAULTAPPLYFLG (FIXAPPLY) + (SHOULDNT)) + ([AND TYPE-IN? (EQ FAULTXX (CAAR HISTENTRY)) + (AND (NEQ NOSPELLFLG T) + (AND (SETQ FAULTEM1 (FMEMB LPARKEY CHARLST)) + (NULL (AND CLISPFLG (STRPOSL CLISPCHARRAY FAULTXX] + + (* ;; "LPARKEY is the lowercase version of left prentheses, normally 8, rparkey is normally 9, but user can reset them for different terminals. The EQ distinguishes between (CONS8ADD1 3) which is handled by a call to FIX89 from CLISPATOM, and FOO8A B C ']' , which is handled by FIX89TYPEIN, since it requires changing an EVAL to an APPLY.") + + (FIX89TYPEIN FAULTEM1 CHARLST)) + ((AND CLISPFLG CHARLST (LITATOM (SETQ FAULTEM1 (CADR FAULTX))) + (OR (GETPROP FAULTEM1 'CLISPTYPE) + (FMEMB (SETQ FAULTEM1 (NTHCHAR FAULTEM1 1)) + CLISPCHARS)) + [OR (NOT (GETPROP FAULTEM1 'UNARYOP)) + (AND (EQ FAULTEM1 '~) + (GETPROP (PACK (CDR (DUNPACK (CADR FAULTX) + WTFIXCHCONLST1))) + 'CLISPTYPE] + (NOT (CLISPNOTVARP (CAR FAULTX))) + (CLISPNOTVARP (CADR FAULTX))) (* ; + "So that things like (SUM + X) will work, i.e. not be interpreted as iterative statement.") + (GO NX0)) + ((NULL CHARLST) + (GO NX2))) (* ; + "Both FIXAPPLY and FIXATOM exit via RETDWIM so there is no need for a return here in WTFIX.") + TOP [SELECTQ (CAR FAULTX) + (F/L [/RPLNODE + FAULTX + 'FUNCTION + (LIST (CONS 'LAMBDA + (COND + ([AND (CDDR FAULTX) + [OR (NULL (CADR FAULTX)) + (AND (LISTP (CADR FAULTX)) + (EVERY (CADR FAULTX) + (FUNCTION (LAMBDA (X) + (AND X (NEQ X T) + (LITATOM X] + (OR (MEMB (CAADR FAULTX) + (FREEVARS (CDDR FAULTX))) + (NOT (CLISPFUNCTION? (CADR FAULTX) + 'OKVAR] + (CDR FAULTX)) + (T (CONS (LIST 'X) + (CDR FAULTX] + (GO OUT)) + (CLISP%: (ERSETQ (CLISPDEC0 FAULTX FAULTFN)) + (SETQ FAULTX T)) + (COND + [[CAR (LISTP (SETQ FAULTEM1 (GETPROP (CAR FAULTX) + 'CLISPWORD] + (RESETVARS [(LCASEFLG (AND LCASEFLG (NULL TYPE-IN?] + (SELECTQ (CAR FAULTEM1) + (FORWORD (SETQ FAULTX (OR (CLISPFOR FAULTX) + (RETDWIM)))) + (IFWORD (SETQ FAULTX (CLISPIF FAULTX)) + (SETQ HISTENTRY NIL)) + (MATCHWORD (* ; + "CAR of FAULTX either MATCH or match.") + (CLISPTRAN FAULTX (MAKEMATCH FAULTX))) + (PREFIXFN (PROG ((EXPR FAULTX)) + (SETQ FAULTEM1 (CDR FAULTX)) + [COND + ((EQ (CAR (LISTP (CAR FAULTEM1))) + 'CLISP%:) + (ERSETQ (CLISPDEC0 (CAR FAULTEM1) + FAULTFN] + [COND + ((EQ (CAR (LISTP (CAR FAULTEM1))) + COMMENTFLG) + (SETQ FAULTEM1 (CDR FAULTEM1] + [SETQ FAULTEM1 + (APPEND (COND + [(AND (NULL (CDR FAULTEM1)) + (LISTP (CAR FAULTEM1] + (T FAULTEM1] + (RESETVARS ((CLISPFLG T)) + (DWIMIFY1? FAULTEM1)) + (CLISPELL FAULTX) + (CLISPTRAN FAULTX FAULTEM1))) + (SETQ FAULTX (APPLY* (CAR FAULTEM1) + FAULTX] + (T (GO NX0] + (AND DWIMIFYFLG (SETQ CLISPCHANGE T)) + (GO OUT) + NX0 (COND + [(GETD (CAR FAULTX)) + (COND + ([NULL (PROG (TYPE-IN? (FAULTFN (CAR FAULTX))) + (RETURN (COND + ((FIXLAMBDA (GETD (CAR FAULTX))) + (* ; + "This is the case where (FOO --) is being evaluated, and the definition of FOO is bad.") + (AND FILEPKGFLG (LITATOM FAULTFN) + (MARKASCHANGED FAULTFN 'FNS)) + T] + (SETQ NOSPELLFLG0 T) + (GO NX3) (* ; "So DWIMUSERFN can be called.") + ] + ((AND (OR (GETPROP (CAR FAULTX) + 'EXPR) + (GETPROP (CAR FAULTX) + 'CODE)) + (DWIMUNSAVEDEF (CAR FAULTX))) + (SETQ FAULTFN NIL) (* ; + "So that RETDWIM won't do a MARKASCHANGED") + ) + ((SETQ FAULTEM1 (GETPROP (CAR FAULTX) + 'FILEDEF)) + (COND + ((WTFIXLOADEF FAULTEM1) + (GO OUT))) + (RETDWIM)) + (T (GO NX1))) + (GO OUT) + NX1 (COND + ((AND (CLISPNOTVARP (CAR FAULTX)) + (SETQ FAULTEM1 (CLISPATOM CHARLST FAULTX FAULTX))) + (* ; "E.g. (FOO←ATOM) OR (FOO← form)") + (SETQ FAULTX FAULTEM1) + (GO OUT))) + NX2 (COND + ([AND CLISPFLG (SETQ FAULTEM1 (CADR FAULTX)) + (OR (LITATOM FAULTEM1) + (AND (NUMBERP FAULTEM1) + (MINUSP FAULTEM1) + (CLBINARYMINUS? FAULTX))) + (OR (GETPROP FAULTEM1 'CLISPTYPE) + (FMEMB (CAR (SETQ FAULTEM1 (DUNPACK FAULTEM1 WTFIXCHCONLST1))) + CLISPCHARS)) + (SETQ FAULTEM1 (CLISPATOM FAULTEM1 (CDR FAULTX) + FAULTX T)) + (COND + [(OR (NEQ FAULTXX (CAR FAULTX)) + (AND CLISPARRAY (GETHASH FAULTX CLISPARRAY] + (DWIMIFYFLG (SETQ CHARLST (DUNPACK FAULTXX WTFIXCHCONLST)) + (* ; "LST may have been clobbered") + (SETQ CLISPCHANGE NIL] + + (* ;; "E.g. (FOO ←atom) or (FOO ← form). The NEQ check is necessary to handle situations like (FOOO N-1) where an CLISP transformation is performed, but it does not correct CAR of the form. (In this case, we must continue to the spelling correction part below, and set CLISPCHANGE to NIL so that DWIMIFY1 will not be confused.) Note that if FOO also happens to be the name of a function, then WTFIX will not be called and the CLISP transformation not be performed until the arguments of FOO are evaluated and cause a u.b.a. error. Then DWIM will have to back up as described in FIXATOM and FIXATOM1.") + + (SETQ FAULTX FAULTEM1) + (GO OUT)) + ((AND (NULL NOSPELLFLG0) + DWIMIFYFLG + (LISTP (CADR FAULTX)) + (FIXLAMBDA FAULTX)) + + (* ;; "The DWIMIFYFLG check is because in normal course of events, it never makes sense for LAMBDA to appear as CAR of a FORM. However, DWIMIFY1 is called on open LAMBDA expressions.") + + (GO OUT)) + ((AND (NULL NOSPELLFLG0) + (LISTP (CAR FAULTX)) + (LISTP (CADAR FAULTX)) + (FIXLAMBDA (CAR FAULTX))) + + (* ;; "This corresponds to the case where LAMBDA is misspelled in an open LAMBDA expression. Note that an open lambda expression only makes sense when there is a non-atomic argument list, so dont both spelling correcting if this is notthe case.") + + (GO OUT))) + NX3 (COND + [[SOME DWIMUSERFORMS (FUNCTION (LAMBDA (DWIMUSERFORM) + (SETQ FAULTEM1 (EVAL DWIMUSERFORM] + (COND + (FAULTAPPLYFLG (RETDWIM FAULTPOS FAULTEM1 T FAULTARGS)) + (T (RETDWIM FAULTPOS FAULTEM1] + (NOSPELLFLG0 (GO FAIL)) + [[AND CHARLST (SETQ FAULTXX + (OR (FIXSPELL (CAR FAULTX) + NIL SPELLINGS2 NIL FAULTX NIL NIL NIL T) + (AND DWIMIFYFLG NOFIXFNSLST0 + (FIXSPELL (CAR FAULTX) + NIL NOFIXFNSLST0 NIL FAULTX NIL NIL NIL T] + (* ; + "The extra argument to FIXSPELL indicates that SPLITS re tolerated, e.g. (BREAKFOO)") + (COND + ((EQ (CAAR HISTENTRY) + (CAR FAULTX)) + (/RPLNODE HISTENTRY FAULTX (CDR HISTENTRY)) + + (* ;; "Normally, RETDWIM patches the histroy entry to corresond to a list input, even if it was typed in as a line. In the special case of a pselling correction, we leave the entry as a line.") + + )) + (SETQ HISTENTRY NIL) + (COND + ((NOT (FGETD FAULTXX)) (* ; + "E.g. USER misspells FOR, IF, F/L etc. These are all contained on SPELLINGS2.") + (GO TOP] + ((AND CLISPFLG DWIMIFYFLG (CDR FAULTX) + (LISTP CLISPCONTEXT) + (FIXSPELL (CAR FAULTX) + NIL CLISPISWORDSPLST NIL FAULTX NIL NIL NIL T) + (SETQ FAULTEM1 (CLISPATOM (DUNPACK (CAR FAULTX) + WTFIXCHCONLST) + TAIL PARENT))) + + (* ;; "E.g. X IS A NUMBER AND LESS THAN Y. CLISPATOM will call CLISPATOMIS? which will retfrom back past here or generate an error. NOte that if (CAR FAUULTX) had been spelled correctly, thiswold have happened in first call to CLISPATOM at NX1 earlir. However, we dont do the misspelled check until here because it is more likely user has misspelled the name of one of his functions.") + + ) + ([AND CLISPFLG (NULL CLISPCHANGES) + (NULL CLISPERTYPE) + (SETQ FAULTEM1 (CADR FAULTX)) + (LITATOM FAULTEM1) + (SETQ FAULTEM1 (FIXSPELL FAULTEM1 NIL CLISPINFIXSPLST NIL + (OR (AND DWIMIFYFLG (LISTP CLISPCONTEXT)) + (CDR FAULTX)) + NIL NIL NIL T)) + (COND + ((AND DWIMIFYFLG (LISTP CLISPCONTEXT)) + + (* ;; + "Return from the corresponding DWIMUNDOCATCH with a value telling CLISPATOM to try again.") + + (CL:THROW 'CLISPATOM1 :RESPELL)) + (T (LET (CLISPERTYPE) + (SETQ FAULTEM1 (CLISPATOM FAULTEM1 (CDR FAULTX) + FAULTX T] + (SETQ FAULTX FAULTEM1)) + (T (GO FAIL))) + OUT (RETDWIM FAULTPOS FAULTX) + FAIL + (RETDWIM))))] (SELECTQ RESULT - (:RESPELL (* ; - "from CLISPATOM2 -- wants us to throw this message back to a higher CLISPATOM") + (:RESPELL (* ; + "from CLISPATOM2 -- wants us to throw this message back to a higher CLISPATOM") (CL:THROW 'CLISPATOM1 :RESPELL)) - (PROGN (* ; - "something interesting to return, or a value from RETDWIM ") + (PROGN (* ; + "something interesting to return, or a value from RETDWIM ") RESULT]) (RETDWIM - [LAMBDA (POS X APPLYFLG ARGS) (* bvm%: "21-Nov-86 18:02") + [LAMBDA (POS X APPLYFLG ARGS) (* bvm%: "21-Nov-86 18:02") (PROG NIL [AND FIXCLK HELPCLOCK (SETQ HELPCLOCK (IPLUS HELPCLOCK (IDIFFERENCE (CLOCK 2) FIXCLK] - (* ; - "So time spent in DWIM will not count towards a break.") + (* ; + "So time spent in DWIM will not count towards a break.") TOP [COND - [(OR POS X) (* ; "Successful correction.") + [(OR POS X) (* ; "Successful correction.") (AND (EQ (CAR SIDES) 'CLISP% ) [NCONC1 (CADR SIDES) (CDR (LISTGET1 LISPXHIST 'SIDE] (LISPXPUT '*LISPXPRINT* (LIST SIDES) - T LISPXHIST)) (* ;; "Some messages were printed, and the undo informaton marked. This completes the process enabling user to undo just the effects associated with the dwim change corresponding to the message printed between (CADR of this mark) and the place where the mark appears. The use of CLISP makes the mark invisible to the editor, and also does not i nterefere with printing the event.") + T LISPXHIST)) + + (* ;; "Some messages were printed, and the undo informaton marked. This completes the process enabling user to undo just the effects associated with the dwim change corresponding to the message printed between (CADR of this mark) and the place where the mark appears. The use of CLISP makes the mark invisible to the editor, and also does not i nterefere with printing the event.") + [COND ((AND DWIMIFYFLG DWIMIFYING) (SETQ DWIMIFY0CHANGE T)) @@ -2710,7 +3006,10 @@ with the terms of said license. (EQ FAULTX (CAR TAIL)) (EQ TAIL PARENT) (STRPOSL CLISPCHARRAY (CAR TAIL)) - (DWIMIFY2A TAIL CHARLST)) (* ;; "In the event that a parenthesis was left out, and (CAR TAIL) is really the name of a function (or misspelled function), spelling correction would nothave been attempted earlier in DWIMIFY2 until seeing if this was ok CLISP, so try it now. E.g. (IF A THEN FOOX-1), where FOO is name of a function, or (IF A THEN R/PLNODE X). Note that CLISPCHANGES might be NIL in the case that the clisp transformationdidn't go throuh, e.g. missing operand.") + (DWIMIFY2A TAIL CHARLST)) + + (* ;; "In the event that a parenthesis was left out, and (CAR TAIL) is really the name of a function (or misspelled function), spelling correction would nothave been attempted earlier in DWIMIFY2 until seeing if this was ok CLISP, so try it now. E.g. (IF A THEN FOOX-1), where FOO is name of a function, or (IF A THEN R/PLNODE X). Note that CLISPCHANGES might be NIL in the case that the clisp transformationdidn't go throuh, e.g. missing operand.") + (/RPLNODE TAIL (CONS (CAR TAIL) (CDR TAIL))) (SETQ X (DWIMIFY1? (CAR TAIL))) @@ -2735,14 +3034,20 @@ with the terms of said license. (CDR X] (SETQ POS FAULTPOS) (GO TOP)) - (CLISPERTYPE (* ;; "Error messages are postponed till this point because what looks like a bad clisp expression may be interpreted correctly in a different way --- e.g. _PENP will correct to openp.") + (CLISPERTYPE + + (* ;; "Error messages are postponed till this point because what looks like a bad clisp expression may be interpreted correctly in a different way --- e.g. ←PENP will correct to openp.") + (AND DWIMIFYFLG (SETQ ATTEMPTFLG T) - (SETQ CLISPCHANGE T)) (* ;; "ATTEMPTFLG to inform DWIMMFY not to add FAUTX to NOFIXLST. CLISPCHANGE is to prevent analysing cdr of the form in the case the error occurred in CAR of the form.") + (SETQ CLISPCHANGE T)) + + (* ;; "ATTEMPTFLG to inform DWIMMFY not to add FAUTX to NOFIXLST. CLISPCHANGE is to prevent analysing cdr of the form in the case the error occurred in CAR of the form.") + (AND (OR DWIMIFYFLG (NULL TYPE-IN?)) (CLISPERROR CLISPERTYPE] (COND - (DWIMIFYFLG (* ; - "ERROR! instead of CL:THROW so that UNDONLSETQ changes are undone") + (DWIMIFYFLG (* ; + "ERROR! instead of CL:THROW so that UNDONLSETQ changes are undone") (ERROR!)) (T (RELSTK FAULTPOS) [CL:THROW 'WTFIX (AND (NULL TYPE-IN?) @@ -2750,18 +3055,20 @@ with the terms of said license. ((ATOM FAULTX) (RETDWIM2 PARENT TAIL)) (T (RETDWIM2 FAULTX NIL 2] - (* ; - "The vaue retunred by WTFIX is used on the call to OLDFAULT1 for printing out a message.") + (* ; + "The vaue retunred by WTFIX is used on the call to OLDFAULT1 for printing out a message.") ]) (DWIMERRORRETURN - [LAMBDA (ARG) (* lmm " 5-SEP-83 23:51") + [LAMBDA (ARG) (* lmm " 5-SEP-83 23:51") (AND ARG (SETQ CLISPERTYPE ARG)) (ERROR!]) (DWIMARKASCHANGED - [LAMBDA (FN $SIDES) (* rmk%: "18-FEB-83 17:07") - (* ;; "Informs the file package that FN has been changed, giving CLISP as the reason if we detect (because no messages were printed) that the only changes are because of valid clisp dwimifications. Otherwise, the reason is CHANGED") + [LAMBDA (FN $SIDES) (* rmk%: "18-FEB-83 17:07") + + (* ;; "Informs the file package that FN has been changed, giving CLISP as the reason if we detect (because no messages were printed) that the only changes are because of valid clisp dwimifications. Otherwise, the reason is CHANGED") + (AND (LITATOM FN) (PROG [(L (CDR (LISTGET1 LISPXHIST 'SIDE] LP (COND @@ -2769,8 +3076,8 @@ with the terms of said license. (EQ L $SIDES)) (RETURN))) [SELECTQ (CAAR L) - ((/PUTHASH CLISPRPLNODE *) (* ; - "For some reason (ask wt!), these aren't counted as real changes") + ((/PUTHASH CLISPRPLNODE *) (* ; + "For some reason (ask wt!), these aren't counted as real changes") NIL) (RETURN (MARKASCHANGED FN 'FNS (COND ((FASSOC 'CLISP% (LISTGET1 LISPXHIST @@ -2781,12 +3088,14 @@ with the terms of said license. (GO LP]) (RETDWIM1 - [LAMBDA (L) (* lmm "20-May-84 19:58") - (* ;; "Called when about to make a CLISP transformation for which one of the atmic operands are not bound.") + [LAMBDA (L) (* lmm "20-May-84 19:58") + + (* ;; "Called when about to make a CLISP transformation for which one of the atmic operands are not bound.") + (PROG (($TAIL (CAR L)) ($CURRTAIL (CADR L)) - FLG TEM) (* ; - "CLISPCHANGES rebound so that FIXSPELL1 will only ask for approval if dwim mode indicates.") + FLG TEM) (* ; + "CLISPCHANGES rebound so that FIXSPELL1 will only ask for approval if dwim mode indicates.") [SETQ TEM (COND ((EQ (CDR $TAIL) $CURRTAIL) @@ -2811,19 +3120,25 @@ with the terms of said license. ([OR TREATASCLISPFLG (AND (EQ (CADDR L) 'PROBABLY) (OR (AND DWIMIFYFLG DWIMIFYING) - (NULL TYPE-IN?] (* ;; "The idea here is that it does not make sense to automatcaaly go ahead and perform a transformation to typein that is then going to produce an error, e.g. user type FOO_FIE where FIE is unbound. Therefore we will always ask him for type-in? Note that he may say YES even though it will produce an error, so that he can then say  ' or -> something. --- In functons, if the operation involves more than one CLISP operator (or an assignment where the variable is one of the bound varables.) we will just tell him.") + (NULL TYPE-IN?] + + (* ;; "The idea here is that it does not make sense to automatcaaly go ahead and perform a transformation to typein that is then going to produce an error, e.g. user type FOO←FIE where FIE is unbound. Therefore we will always ask him for type-in? Note that he may say YES even though it will produce an error, so that he can then say  ' or -> something. --- In functons, if the operation involves more than one CLISP operator (or an assignment where the variable is one of the bound varables.) we will just tell him.") + (SETQQ FLG NEEDNOTAPPROVE)) (T (SETQQ FLG MUSTAPPROVE))) (COND ((COND - ((AND TREATASCLISPFLG (NULL CLISPHELPFLG)) (* ; - "dont print any message, but do treat it as clisp") + ((AND TREATASCLISPFLG (NULL CLISPHELPFLG)) (* ; + "dont print any message, but do treat it as clisp") T) - ((OR TREATASCLISPFLG CLISPHELPFLG) (* ; - "interact (ask or inform) with user if either treatasclispflg is T, or clisphelpflg is T , or both.") + ((OR TREATASCLISPFLG CLISPHELPFLG) (* ; + "interact (ask or inform) with user if either treatasclispflg is T, or clisphelpflg is T , or both.") (FIXSPELL1 TEM (COND (LCASEFLG '" as clisp") - (T (* ;; "The reason for the check is that the user may want to key on this message for an UNDO : operation, and if he is on a 33 and it is printed as a lowercase string (even though he sees it in uppercase) he wont be able to fnd it.") + (T + + (* ;; "The reason for the check is that the user may want to key on this message for an UNDO : operation, and if he is on a 33 and it is printed as a lowercase string (even though he sees it in uppercase) he wont be able to fnd it.") + '" AS CLISP")) (COND [(EQ FLG 'NEEDNOTAPPROVE) @@ -2836,19 +3151,24 @@ with the terms of said license. (T '" TREAT"] (T (SHOULDNT))) T FLG)) - ((EQ FLG 'NEEDNOTAPPROVE) (* ; "dont interact, but treat it as clisp, e.g. when transformation is a PROBABLY and we are dwimifying.") + ((EQ FLG 'NEEDNOTAPPROVE) (* ; "dont interact, but treat it as clisp, e.g. when transformation is a PROBABLY and we are dwimifying.") T)) - (SETQ NOFIXVARSLST0 (CADDDR L)) (* ;; "Since user has approved CLISP, it is ok to set NOFIXVARSLST0 to include any variabes detected during analysis of CLISP expression, e.g. if expression were A*B A and B can now be added NOFIXVARSLST0") + (SETQ NOFIXVARSLST0 (CADDDR L)) + + (* ;; "Since user has approved CLISP, it is ok to set NOFIXVARSLST0 to include any variabes detected during analysis of CLISP expression, e.g. if expression were A*B A and B can now be added NOFIXVARSLST0") + (RETURN T))) (RETURN (COND (DWIMIFYFLG (SETQ NEXTAIL (NLEFT (CAR L) 1 $CURRTAIL)) - (* ; "Tells DWIMIFY where to continue.") + (* ; "Tells DWIMIFY where to continue.") (COND ((LISTP (CAR NEXTAIL)) (SETQ NEXTAIL (NLEFT (CAR L) 2 $CURRTAIL)) - (* ;; "E.G. In A* (FOO --), this will enable (FOO --) to be processed. If the expression immediately before CURRTAIL is an atom, we have no way of knowing if it contains a CLISP operator or not, e.g. is it A + B, or A+B. If we were to back up NEXTAIL so that DWIMIFYING continued as of this atom, it might cause a loop.") + + (* ;; "E.G. In A* (FOO --), this will enable (FOO --) to be processed. If the expression immediately before CURRTAIL is an atom, we have no way of knowing if it contains a CLISP operator or not, e.g. is it A + B, or A+B. If we were to back up NEXTAIL so that DWIMIFYING continued as of this atom, it might cause a loop.") + )) NIL]) @@ -2857,20 +3177,20 @@ with the terms of said license. (PROG (TEM) (PRIN1 '= T) (COND - [(EQ X CLST) (* ; "THE 8 is the first character.") + [(EQ X CLST) (* ; "THE 8 is the first character.") (PRINT (SETQ TEM (PACK (CDR X))) T T) (RETDWIM FAULTPOS (CONS TEM (COND - ((NULL APPLYFLG)(* ; "E.g. 8FOO X Y") + ((NULL APPLYFLG)(* ; "E.g. 8FOO X Y") (CDR FAULTX)) - (FAULTARGS (* ; "E.G. 8FOO (A B)") + (FAULTARGS (* ; "E.G. 8FOO (A B)") (LIST FAULTARGS] (T [SETQ FAULTARGS (COND - ((AND APPLYFLG FAULTARGS) (* ; - "E.g. 'FOO8)' or 'FOO8A)' or 'FOO8A B]'") + ((AND APPLYFLG FAULTARGS) (* ; + "E.g. 'FOO8)' or 'FOO8A)' or 'FOO8A B]'") (LIST FAULTARGS)) - (T (* ; - "E.g. 'FOO8A B C]' (or 'FOO8 A B]')") + (T (* ; + "E.g. 'FOO8A B C]' (or 'FOO8 A B]')") (CDR FAULTX] (RETDWIM FAULTPOS (PRINT (SETQ TEM (PACK (LDIFF CLST X))) T T) @@ -2882,8 +3202,10 @@ with the terms of said license. FAULTARGS]) (FIXLAMBDA - [LAMBDA (DEF) (* lmm "20-May-84 19:57") - (* ;; "LAMBDASPLST is initialized to (LAMBDA NLAMBDA). HOwever users can add to it for 'function' handled by DWIMMUSERFN. QLISP uses this feature.") + [LAMBDA (DEF) (* lmm "20-May-84 19:57") + + (* ;; "LAMBDASPLST is initialized to (LAMBDA NLAMBDA). HOwever users can add to it for 'function' handled by DWIMMUSERFN. QLISP uses this feature.") + (AND (LITATOM (CAR DEF)) (CDDR DEF) (NOT (FMEMB (CAR DEF) @@ -2892,10 +3214,13 @@ with the terms of said license. NIL LAMBDASPLST NIL DEF NIL NIL NIL T]) (FIXAPPLY - [LAMBDA NIL (* lmm "19-MAY-84 21:44") + [LAMBDA NIL (* lmm "19-MAY-84 21:44") (PROG (X TEM) (COND - ((NEQ FAULTFN FAULTX) (* ;; "means the call came out of compiled code, e.g. user types in FOO which contains a call to a mispelled function.") + ((NEQ FAULTFN FAULTX) + + (* ;; "means the call came out of compiled code, e.g. user types in FOO which contains a call to a mispelled function.") + (SETQ TYPE-IN? NIL))) (COND ((AND (LITATOM FAULTX) @@ -2912,8 +3237,8 @@ with the terms of said license. (GETPROP FAULTX 'CODE)) (DWIMUNSAVEDEF FAULTX)) (SETQ X FAULTX) - (SETQ FAULTFN NIL) (* ; - "So that RETDWIM won't do a NEWFILE?") + (SETQ FAULTFN NIL) (* ; + "So that RETDWIM won't do a NEWFILE?") (GO OUT)) ((SETQ TEM (GETPROP FAULTX 'FILEDEF)) (COND @@ -2923,16 +3248,16 @@ with the terms of said license. (RETDWIM)) ((AND TYPE-IN? CLISPFLG (STRPOSL CLISPCHARRAY FAULTX) (SETQ X (CLISPATOM CHARLST (SETQ TEM (LIST FAULTX FAULTARGS)) - TEM T))) (* ; - "E.g. FOO_ form. FOO _form is caught by a special check in LISPX and treated as (FOO _form)") + TEM T))) (* ; + "E.g. FOO← form. FOO ←form is caught by a special check in LISPX and treated as (FOO ←form)") (RETDWIM FAULTPOS X)) ((AND TYPE-IN? (NEQ NOSPELLFLG T) (EQ FAULTXX (CAAR HISTENTRY)) (SETQ TEM (FMEMB LPARKEY CHARLST))) (FIX89TYPEIN TEM CHARLST T)) ((AND (LISTP FAULTX) - (FIXLAMBDA FAULTX)) (* ; - "LAMBDA or NLAMBDA misspelled in LAMBDA expression being applied, e.g. a functional argument.") + (FIXLAMBDA FAULTX)) (* ; + "LAMBDA or NLAMBDA misspelled in LAMBDA expression being applied, e.g. a functional argument.") (SETQ X FAULTX) (GO OUT))) NX (COND @@ -2950,7 +3275,7 @@ with the terms of said license. (RETDWIM FAULTPOS X T FAULTARGS]) (FIXATOM - [LAMBDA NIL (* bvm%: "21-Nov-86 16:38") + [LAMBDA NIL (* bvm%: "21-Nov-86 16:38") (PROG (X Y TAIL0) (COND ((NULL TAIL) @@ -2958,19 +3283,22 @@ with the terms of said license. (BLIPVAL '*FORM* X))) (RELSTK X))) (SETQ TAIL0 (AND (NEQ ONLYSPELLFLG 'NORUNONS) - TAIL)) (* ;; "ONLYSPELLFLG is NORUNONS for calls from CLISPATOM2A, i.e. when DWIMIYING one of the operands to an infix operator. IN this case it never makes sense to do a runon spelling correction, e.g. FOOX*A shouldnt correct to (ITIMES FOO X A), althouh it may correct to FOO X*A.") + TAIL)) + + (* ;; "ONLYSPELLFLG is NORUNONS for calls from CLISPATOM2A, i.e. when DWIMIYING one of the operands to an infix operator. IN this case it never makes sense to do a runon spelling correction, e.g. FOOX*A shouldnt correct to (ITIMES FOO X A), althouh it may correct to FOO X*A.") + (COND ((SETQ X (CLISPATOM CHARLST TAIL PARENT)) (GO OUT)) ([AND (CDR TAIL) (LITATOM (SETQ Y (CADR TAIL))) (FMEMB (CHCON1 Y) - (CHARCODE (_ ))) + (CHARCODE (← _))) (PROG (CLISPERTYPE) (RETURN (SETQ X (CLISPATOM (UNPACK Y) (CDR TAIL) - PARENT T] (* ; - "E.G. (LIST FOO _ 3) where FOO is unbound at the time. See comment in WTFIX.") + PARENT T] (* ; + "E.G. (LIST FOO ← 3) where FOO is unbound at the time. See comment in WTFIX.") (GO OUT)) ([AND DWIMUSERFORMS (SOME DWIMUSERFORMS (FUNCTION (LAMBDA (DWIMUSERFORM) (SETQ X (EVAL DWIMUSERFORM] @@ -2978,10 +3306,15 @@ with the terms of said license. ((OR (EQ NOSPELLFLG T) (AND NOSPELLFLG (NULL TYPE-IN?)) (GETPROP FAULTX 'GLOBALVAR) - (FMEMB FAULTX GLOBALVARS)) (* ;; "For efficiency, GLOBALVARS is a global variable itself for DWIMBLOCK. Thus FIXATOM obtains the top level value, not the one rebound by BCOMPL2. However, in the case that there are block declarations aafecting globalvars, the variables would also have been added to NOFIXVARSLST, so this is ok.") + (FMEMB FAULTX GLOBALVARS)) + + (* ;; "For efficiency, GLOBALVARS is a global variable itself for DWIMBLOCK. Thus FIXATOM obtains the top level value, not the one rebound by BCOMPL2. However, in the case that there are block declarations aafecting globalvars, the variables would also have been added to NOFIXVARSLST, so this is ok.") + (RETDWIM)) ((AND VARS (SETQ X (FIXSPELL FAULTX NIL VARS NIL TAIL0 NIL NIL NIL T))) - (* ;; "Corrects spellings using LAMBDA and PROG variables of function in which error occurred, or function that is broken.") + + (* ;; "Corrects spellings using LAMBDA and PROG variables of function in which error occurred, or function that is broken.") + ) ((SETQ X (FIXSPELL FAULTX NIL SPELLINGS3 NIL TAIL0 NIL NIL NIL T))) ((AND DWIMIFYFLG (EQ CLISPCONTEXT 'IFWORD) @@ -2991,7 +3324,7 @@ with the terms of said license. (FIXSPELL FAULTX NIL CLISPFORWORDSPLST NIL T NIL NIL NIL T)) (CL:THROW 'CLISPFOR0 :RESPELL)) [(AND DWIMIFYFLG NOFIXVARSLST0 (SETQ X - (FIXSPELL FAULTX NIL NOFIXVARSLST0 NIL TAIL0 NIL NIL NIL + (FIXSPELL FAULTX NIL NOFIXVARSLST0 NIL TAIL0 NIL NIL NIL T] ((AND DWIMIFYFLG CLISPFLG (OR (EQ CLISPCONTEXT 'IS) (AND (LISTP CLISPCONTEXT) @@ -2999,11 +3332,14 @@ with the terms of said license. (EQ TAIL PARENT))) (SETQ X (FIXSPELL FAULTX NIL CLISPISWORDSPLST NIL TAIL NIL NIL NIL T))) (COND - ((EQ CLISPCONTEXT 'IS) (* ;; "In this case, we are dwimifying the tail before processing it in clispatomis so is sufficient just to correct spelling and return.") + ((EQ CLISPCONTEXT 'IS) + + (* ;; "In this case, we are dwimifying the tail before processing it in clispatomis so is sufficient just to correct spelling and return.") + ) ((SETQ X (CLISPATOM (DUNPACK X WTFIXCHCONLST) - TAIL PARENT)) (* ; - "E.g. X IS A NUMBER OR STRNG, STRNG being misspelled. Will call CLISPATOMIS? which will retfrom.") + TAIL PARENT)) (* ; + "E.g. X IS A NUMBER OR STRNG, STRNG being misspelled. Will call CLISPATOMIS? which will retfrom.") )) (GO OUT)) ([AND CLISPFLG (NULL CLISPCHANGES) @@ -3037,18 +3373,23 @@ with the terms of said license. (T (RETDWIM))) [COND ((AND (NULL TAIL0) - (EQ FAULTX (CAR TAIL))) (* ; - "If TAIL0 is not NIL, the RPLNODE has aleady been done.") + (EQ FAULTX (CAR TAIL))) (* ; + "If TAIL0 is not NIL, the RPLNODE has aleady been done.") (/RPLNODE TAIL X (CDR TAIL] OUT [COND - ((AND NEWTAIL (NULL DWIMIFYFLG)) (* ;; "The interpreter has already made up its mind about how to handle the first operand of the CLISP expression, e.g. it has already been evaluated as an argument, or else is about to be called as a function. Therefore continuing the computation requires some fiddling around.") + ((AND NEWTAIL (NULL DWIMIFYFLG)) + + (* ;; "The interpreter has already made up its mind about how to handle the first operand of the CLISP expression, e.g. it has already been evaluated as an argument, or else is about to be called as a function. Therefore continuing the computation requires some fiddling around.") + (SETQ X (FIXATOM1] (RETDWIM FAULTPOS X]) (FIXATOM1 - [LAMBDA NIL (* lmm "20-SEP-83 23:37") - (* ;; - "Called when evaluation went too far before DWIM fixed an CLISP expression. See comment in FIXATOM") + [LAMBDA NIL (* lmm "20-SEP-83 23:37") + + (* ;; + "Called when evaluation went too far before DWIM fixed an CLISP expression. See comment in FIXATOM") + (PROG ((POS (STKNTH -1 FAULTPOS)) X OLDTAIL OLDFN) (SETQ OLDTAIL (BLIPVAL '*TAIL* POS)) @@ -3058,7 +3399,7 @@ with the terms of said license. (COND ((NEQ TAIL OLDTAIL) (GO ERROR))) - (SETBLIPVAL '*TAIL* POS NIL NEWTAIL) (* ; "Change the binding for the tai") + (SETBLIPVAL '*TAIL* POS NIL NEWTAIL) (* ; "Change the binding for the tai") (FIXCONTINUE (CADAR NEWTAIL)) (SETQ X (CAR NEWTAIL)) (GO OUT)) @@ -3066,52 +3407,76 @@ with the terms of said license. (SETQ OLDFN (BLIPVAL '*FN* POS)) [COND ([COND - ((NEQ TAIL OLDTAIL) (* ; - "E.g. (COND (ZAP _ T 3)) where ZAP is A u.b.a.") + ((NEQ TAIL OLDTAIL) (* ; + "E.g. (COND (ZAP ← T 3)) where ZAP is A u.b.a.") T) - ((LISTP NEWTAIL) (* ; "E.G. (LIST FOO X + Y)") + ((LISTP NEWTAIL) (* ; "E.G. (LIST FOO X + Y)") (NEQ OLDFN (CAR PARENT))) - [(ATOM (CADR PARENT)) (* ;; "e.g. (FOO AND T) where FOO is the name of a function as well as a variable. the check here used to be (NEQ OLDFN (CADR PARENT)). however this fails for things like (FOO : FIE) which at this point would be (fetch FIE of FOO), i.e. cant assume that car of form is now CADR") + [(ATOM (CADR PARENT)) + + (* ;; "e.g. (FOO AND T) where FOO is the name of a function as well as a variable. the check here used to be (NEQ OLDFN (CADR PARENT)). however this fails for things like (FOO : FIE) which at this point would be (fetch FIE of FOO), i.e. cant assume that car of form is now CADR") + (AND (NEQ OLDFN (CADR PARENT)) (NEQ OLDFN (CADDDR PARENT] - (T (* ;; "For infixes like EQ, AND, OR, the function that was about to be called may now be parenthesized, e.g. (FOO X EQ Y) becomes (EQ (FOO X) Y) However, it is also possible that it was not a function at all, e.g. (FOO GT 4 AND FOO LT 6)") - (NOT (FMEMB OLDFN (CADR PARENT] (* ;; "The procedure followed assumes that Y gives the binding for TAIL, and Z gives the binding for the name of the function that is about to be called. This checks to make sure that this is in fact the cas") + (T + (* ;; "For infixes like EQ, AND, OR, the function that was about to be called may now be parenthesized, e.g. (FOO X EQ Y) becomes (EQ (FOO X) Y) However, it is also possible that it was not a function at all, e.g. (FOO GT 4 AND FOO LT 6)") + + (NOT (FMEMB OLDFN (CADR PARENT] + + (* ;; "The procedure followed assumes that Y gives the binding for TAIL, and Z gives the binding for the name of the function that is about to be called. This checks to make sure that this is in fact the cas") + (GO BAD)) - ((NLISTP NEWTAIL) (* ;; "Occurs when CAR of an xpression in which a CLISP operator is used is the name of a function, e.g. (FOO + X), (FOO X AND FIE Y). Note that at this point in the evaluton, the nterpreter is evaluating the 'arguments' for that function, and plans to call it when they have all been evaluated") + ((NLISTP NEWTAIL) + + (* ;; "Occurs when CAR of an xpression in which a CLISP operator is used is the name of a function, e.g. (FOO + X), (FOO X AND FIE Y). Note that at this point in the evaluton, the nterpreter is evaluating the 'arguments' for that function, and plans to call it when they have all been evaluated") + NIL) ((OR (CDR NEWTAIL) (ZEROP (LOGAND (ARGTYPE (CAR PARENT)) - 2))) (* ;; "Either there are more arguments following the CLISP expression, or, in the case of a spread, evaluate, it doesn't matter if an extra NIL is passed. Therefore, proceed by smashing the last argument with the value of the CLISP expression, (CAR NEWTAIL), change the binding for the tail to be (CDR NEWTAIL), and RETDWIM with the next expression on TAIL, (CADR NEWTAIL) e.g. (LIST T 2 + 3 6)") + 2))) + + (* ;; "Either there are more arguments following the CLISP expression, or, in the case of a spread, evaluate, it doesn't matter if an extra NIL is passed. Therefore, proceed by smashing the last argument with the value of the CLISP expression, (CAR NEWTAIL), change the binding for the tail to be (CDR NEWTAIL), and RETDWIM with the next expression on TAIL, (CADR NEWTAIL) e.g. (LIST T 2 + 3 6)") + [SETBLIPVAL '*ARGVAL* POS NIL (STKEVAL POS (FIXLISPX/ (CAR NEWTAIL] (SETBLIPVAL '*TAIL* POS NIL (CDR NEWTAIL)) (SETQ X (CADR NEWTAIL)) (GO OUT)) - (T (* ;; "The function to be called is a nospread function, e.g. LIST, and the CLISP expression was its last argument, e.g. (LIST X (--) *2) Therefore can only continue by reevaluating the whole form") + (T + (* ;; "The function to be called is a nospread function, e.g. LIST, and the CLISP expression was its last argument, e.g. (LIST X (--) *2) Therefore can only continue by reevaluating the whole form") + (FIXCONTINUE (CADAR NEWTAIL) (AND (NULL TYPE-IN?) FAULTFN] - (SETBLIPVAL '*TAIL* POS NIL NIL) (* ; - "Makes tail of the argument list be NIL") - (SETBLIPVAL '*FN* POS NIL 'FIXATOM2) (* ; - "A nospread, evaluate function whose value is the value of its last argument") + (SETBLIPVAL '*TAIL* POS NIL NIL) (* ; + "Makes tail of the argument list be NIL") + (SETBLIPVAL '*FN* POS NIL 'FIXATOM2) (* ; + "A nospread, evaluate function whose value is the value of its last argument") (SETQ X PARENT) - (GO OUT) (* ;; "PARENT will be evaluated, and its value stored on the stack. Then since the tail of the argument list is now NIL, the interpreter figures that the evaluation of arguments is finished, and calls the function. However since Z was changed, FIXATOM2 will be called instead, and it will return as its value its last argument, which will be the value of PARENT. Voila") - BAD (* ; "Stack not in normal state") + (GO OUT) + + (* ;; "PARENT will be evaluated, and its value stored on the stack. Then since the tail of the argument list is now NIL, the interpreter figures that the evaluation of arguments is finished, and calls the function. However since Z was changed, FIXATOM2 will be called instead, and it will return as its value its last argument, which will be the value of PARENT. Voila") + + BAD (* ; "Stack not in normal state") (SELECTQ (STKNAME (SELECTQ (SYSTEMTYPE) - ((JERICHO D) (* ; "Skip over internal frames") + ((JERICHO D) (* ; "Skip over internal frames") (REALSTKNTH -1 POS T POS)) POS)) (COND (COND - ((EQ PARENT NEWTAIL) (* ;; "The CLISP transformation changed the predicate of a COND clause, e.g. (COND (FOO _ form --) --) Since the COND would ordinarily continue down that clause, it is necessary to continue by constructing an appropriate COND expression, and returning its value as the value of the entire COND") + ((EQ PARENT NEWTAIL) + + (* ;; "The CLISP transformation changed the predicate of a COND clause, e.g. (COND (FOO ← form --) --) Since the COND would ordinarily continue down that clause, it is necessary to continue by constructing an appropriate COND expression, and returning its value as the value of the entire COND") + [SETQ X (CONS 'COND (FMEMB PARENT (STKARG 1 POS] (RELSTK FAULTPOS) (SETQ FAULTPOS POS) (GO OUT)) - (T (* ;; "The CLISP transformation did not affect the predicate of a COND clause, so can continue by just evaluating PARENT E.G. (COND (T FOO _ 2))") + (T + (* ;; "The CLISP transformation did not affect the predicate of a COND clause, so can continue by just evaluating PARENT E.G. (COND (T FOO ← 2))") + (SETQ X (CAR NEWTAIL)) (GO OUT)))) - ((PROGN PROG1) (* ; - "Error in SELECTQ clause, e.g. (SELECTQ -- (-- A * B)) or error in savesetq") + ((PROGN PROG1) (* ; + "Error in SELECTQ clause, e.g. (SELECTQ -- (-- A * B)) or error in savesetq") (SETQ X (CONS (STKNAME POS) NEWTAIL)) (RELSTK FAULTPOS) @@ -3141,7 +3506,7 @@ with the terms of said license. (RETDWIM]) (FIXCONTINUE1 - [LAMBDA (X) (* True if it is ok to reevaluate X.) + [LAMBDA (X) (* True if it is ok to reevaluate X.) (OR (EQ (CAR X) 'QUOTE) (AND [OR (FMEMB (CAR X) @@ -3166,26 +3531,31 @@ with the terms of said license. (GO LP]) (CLISPATOM - [LAMBDA (CLST TAIL PARENT NOFIX89) (* lmm "20-May-84 19:46") - (* ;; "CLST is an exploded character list for CAR of TAIL, which is a tail of PARENT, although not necessarily a proper tail. ONLYSPELLFLG=T indicates that the ONLY corrections to be attempted are spelling corrections. Occurs on calls from CLISPATOM2a.") + [LAMBDA (CLST TAIL PARENT NOFIX89) (* lmm "20-May-84 19:46") + + (* ;; "CLST is an exploded character list for CAR of TAIL, which is a tail of PARENT, although not necessarily a proper tail. ONLYSPELLFLG=T indicates that the ONLY corrections to be attempted are spelling corrections. Occurs on calls from CLISPATOM2a.") + (AND (NULL ONLYSPELLFLG) (PROG (TEM) (COND [(AND (NULL CLISPCHANGES) (OR (EQ CLISPFLG T) (AND (EQ CLISPFLG 'TYPE-IN) - TYPE-IN?))) (* ;; "If CLISPCHANGES is not NIL, a CLISP correction has already been found, so don't bother to find another, e.g. in (X+Y + Z), if X and Y are not bound vriables, after ggetting (IPLUS X Y Z), this would be undone and saved, pending spelling correction on X+Y. Therefore don't do the transformation that staats with +Z.") + TYPE-IN?))) + + (* ;; "If CLISPCHANGES is not NIL, a CLISP correction has already been found, so don't bother to find another, e.g. in (X+Y + Z), if X and Y are not bound vriables, after ggetting (IPLUS X Y Z), this would be undone and saved, pending spelling correction on X+Y. Therefore don't do the transformation that staats with +Z.") + (RETURN (COND ((SETQ TEM (CLISPATOM0 CLST TAIL PARENT)) TEM) (CLISPCHANGES (SETQ CHARLST (DUNPACK FAULTXX WTFIXCHCONLST)) - (* ; - "Since DWIMIFY2, and hence WTFIX, may have been called, LST may have been clobbered.") + (* ; + "Since DWIMIFY2, and hence WTFIX, may have been called, LST may have been clobbered.") NIL] ((AND (EQ (CAR CLST) '%') - (GETPROP '%' 'CLISPTYPE)) (* ; - "So ' can be disabled when CLISP is turned off as well.") + (GETPROP '%' 'CLISPTYPE)) (* ; + "So ' can be disabled when CLISP is turned off as well.") [COND [(CDR CLST) [SETQ TEM (LIST 'QUOTE (PACK (CDR CLST] @@ -3218,29 +3588,32 @@ with the terms of said license. ((AND TYPE-IN? (EQ (CAR TEM) LPARKEY) (EQ (CAR (SETQ TEM (FLAST CLST))) - RPARKEY)) (* ;; "This corresponds to the case where an atom was typed in containing both an 8 and a 9, e.g. FILES?89 or 8EDITF9. Note that if the atom were part of a larger expression, either CAR of form, or appearing in a tail, (as indicated by TAIL being non-NIL), the fix is performed by FIX89, and involves editing the expression. In the case covered here, the fix requires changing the EVAL to an apppropriate APPLY. The case where the 8 or 9 error appears in an APPLY context, or line format, is taken care of in WTFIX.") + RPARKEY)) + + (* ;; "This corresponds to the case where an atom was typed in containing both an 8 and a 9, e.g. FILES?89 or 8EDITF9. Note that if the atom were part of a larger expression, either CAR of form, or appearing in a tail, (as indicated by TAIL being non-NIL), the fix is performed by FIX89, and involves editing the expression. In the case covered here, the fix requires changing the EVAL to an apppropriate APPLY. The case where the 8 or 9 error appears in an APPLY context, or line format, is taken care of in WTFIX.") + (FIX89TYPEIN (FMEMB LPARKEY (SETQ TEM (LDIFF CLST TEM))) TEM T]) (GETVARS - [LAMBDA (X) (* lmm "20-May-84 19:24") + [LAMBDA (X) (* lmm "20-May-84 19:24") (PROG (L POS TEM) (COND - ((EQ X T) (* ; - "context is inside of a BREAK --- Gets variables of BRKFN.") + ((EQ X T) (* ; + "context is inside of a BREAK --- Gets variables of BRKFN.") (SETQ POS (STKPOS 'BREAK1 -1 FAULTPOS)) [COND ((AND [NOT (EQ 0 (STKNARGS (SETQ TEM (FSTKNTH -1 POS] - (LITATOM (STKARGNAME 1 TEM))) (* ; - "If the first argument's name is #0 or #100, there are no genuine variables.") + (LITATOM (STKARGNAME 1 TEM))) (* ; + "If the first argument's name is #0 or #100, there are no genuine variables.") (SETQ L (VARIABLES TEM] (SETQ X (STKARG 1 POS)) (RELSTK TEM) - (RELSTK POS) (* ; - "Sets X to BRKEXP the first argument to BREAK1. Used for getting PROG variables below.") + (RELSTK POS) (* ; + "Sets X to BRKEXP the first argument to BREAK1. Used for getting PROG variables below.") ) [(EQ (CAR X) - 'LAMBDA) (* ; "Gets variables for expression X.") + 'LAMBDA) (* ; "Gets variables for expression X.") (SETQ L (APPEND (CADR X] (T (RETURN NIL))) (RETURN (NCONC L (AND (LISTP X) @@ -3252,18 +3625,24 @@ with the terms of said license. (T (CAR X]) (GETVARS1 - [LAMBDA (X) (* DD%: " 2-Dec-81 16:49") - (* ;; "Looks for a PROG.") + [LAMBDA (X) (* DD%: " 2-Dec-81 16:49") + + (* ;; "Looks for a PROG.") + (SELECTQ [CAR (SETQ X (CAR (LISTP (LAST (LISTP X] ((PROG RESETVARS) X) - ((RESETLST RESETVAR RESETFORM) + ((RESETLST + RESETVAR + RESETFORM) (GETVARS1 X)) NIL]) (FIX89 - [LAMBDA (FORM N POS) (* bvm%: "21-Nov-86 18:47") - (* ;; "Handles corrections for 8 and 9 errors. N is either 8 or 9.0 POS is optional, and if given, it is the position of the 8 or 9 in the offending atom, and also indicates that the user has already approved the correction.") + [LAMBDA (FORM N POS) (* bvm%: "21-Nov-86 18:47") + + (* ;; "Handles corrections for 8 and 9 errors. N is either 8 or 9.0 POS is optional, and if given, it is the position of the 8 or 9 in the offending atom, and also indicates that the user has already approved the correction.") + (PROG [SPLIT89FLG (C (COND ((EQ N LPARKEY) 'FIX8) @@ -3272,29 +3651,30 @@ with the terms of said license. ([OR (AND (ATOM FAULTX) (NULL TAIL)) (AND (NULL POS) - (NULL (FIX89A FAULTX N] (* ; - "pointless to attempt an 8 or 9 correction if TAIL is NIL.") - (RETURN NIL))) (* ; - "Gets user approval if necessary, i.e. if TYPE-IN? is NIL and APPROVEFLG is T.") + (NULL (FIX89A FAULTX N] (* ; + "pointless to attempt an 8 or 9 correction if TAIL is NIL.") + (RETURN NIL))) (* ; + "Gets user approval if necessary, i.e. if TYPE-IN? is NIL and APPROVEFLG is T.") (EDITE EXPR (LIST (LIST 'ORR (LIST (LIST (COND ((ATOM FORM) 'F) (T 'F=)) FORM T) (LIST C NIL POS)) - NIL))) (* ; - "Constructs command of form ((ORR ((F= FORM T) C) NIL)) C is either FIX8 or FIX9 depending on call.") + NIL))) (* ; + "Constructs command of form ((ORR ((F= FORM T) C) NIL)) C is either FIX8 or FIX9 depending on call.") (RETURN (COND - ((NULL SPLIT89FLG) (* ; "Set in SPLIT89 if successful.") + ((NULL SPLIT89FLG) (* ; "Set in SPLIT89 if successful.") (EXEC-FORMAT "couldn't~%%") NIL) (T (AND DWIMIFYFLG (SETQ 89CHANGE T)) T]) (FIXPRINTIN - [LAMBDA (FN FLG) (* wt%: 12-OCT-76 21 40) - (* ;; - "If FLG is T, printing goes on history lst.") + [LAMBDA (FN FLG) (* wt%: 12-OCT-76 21 40) + + (* ;; "If FLG is T, printing goes on history lst.") + (AND FN (NEQ FN 'TYPE-IN) (PROG ((LISPXHIST (AND FLG LISPXHIST))) (AND (NEQ (POSITION T) @@ -3305,7 +3685,10 @@ with the terms of said license. [(OR (AND DWIMIFYFLG DWIMIFYING) (NULL FAULTAPPLYFLG)) (COND - (LCASEFLG (* ;; "Done this way instead of just printing the lower case version because users may want to efer to the message to undo a dwim correction, e.g. by typing UNDO : $IN$.") + (LCASEFLG + + (* ;; "Done this way instead of just printing the lower case version because users may want to efer to the message to undo a dwim correction, e.g. by typing UNDO : $IN$.") + '"in ") (T '"IN "] (LCASEFLG '"below ") @@ -3316,7 +3699,7 @@ with the terms of said license. (RETURN FN]) (FIX89A - [LAMBDA (X N POS) (* wt%: 25-FEB-76 1 40) + [LAMBDA (X N POS) (* wt%: 25-FEB-76 1 40) [COND ((LISTP X) (SETQ X (CAR X] @@ -3337,14 +3720,20 @@ with the terms of said license. NIL]) (CLISPFUNCTION? - [LAMBDA (TL TYPE FN1 FN2 Y) (* lmm "20-May-84 18:56") - (* ;; "returns TRUE if (CAR TAIL) corresponds to the name of a function (Possibly misspelled). If TYP=NOTVAR, checks first to make sure (CAR TAIL) does not correspond to the name of a variable.") - (* ;; "FN1 and FN2 are used to compute the arguments to FIXSPELL1. FN1 is given (CAR TAIL) and Y as its arguments, FN2 (CAR TAIL) or the corrected spelling, and Y. If FN1 is supplied, FIXSPELL is called so as not to print any messages, and the interaction takes place under CLISPUNCTION? control via a direct call to FIXSPELL1. In this case, if TYP=QUIET, no message is printed at all. --- If FN1 is not suppied, FIXSPELL will take care of the interaction, if any, othrwisre there are no error messages.") + [LAMBDA (TL TYPE FN1 FN2 Y) (* lmm "20-May-84 18:56") + + (* ;; "returns TRUE if (CAR TAIL) corresponds to the name of a function (Possibly misspelled). If TYP=NOTVAR, checks first to make sure (CAR TAIL) does not correspond to the name of a variable.") + + (* ;; "FN1 and FN2 are used to compute the arguments to FIXSPELL1. FN1 is given (CAR TAIL) and Y as its arguments, FN2 (CAR TAIL) or the corrected spelling, and Y. If FN1 is supplied, FIXSPELL is called so as not to print any messages, and the interaction takes place under CLISPUNCTION? control via a direct call to FIXSPELL1. In this case, if TYP=QUIET, no message is printed at all. --- If FN1 is not suppied, FIXSPELL will take care of the interaction, if any, othrwisre there are no error messages.") + (PROG (TEM CHRLST) (COND ((NULL (LITATOM (CAR TL))) (RETURN NIL)) - ((LISTP TYPE) (* ;; "Means that we already know that (CAR TAIL) is not the name of a variable, and is also not the name of a function.") + ((LISTP TYPE) + + (* ;; "Means that we already know that (CAR TAIL) is not the name of a variable, and is also not the name of a function.") + (SETQ CHRLST TYPE) (GO SPELL)) ([AND (EQ TYPE 'NOTVAR) @@ -3394,19 +3783,24 @@ with the terms of said license. NIL T (AND (OR FN1 (LISTP TEM)) 'MUSTAPPROVE) (AND (LISTP TEM) - 'n] (* ;; "If TYP=QUIET (from DWIMIFY2), the message is printed only on spelling correction. For other calls, e.g. TYP=OKVAR, or TYP=NOTVAR, the message is printed even if no correction involved.") + 'n] + + (* ;; "If TYP=QUIET (from DWIMIFY2), the message is printed only on spelling correction. For other calls, e.g. TYP=OKVAR, or TYP=NOTVAR, the message is printed even if no correction involved.") + [AND TEM FN1 (COND - ((LISTP TEM) (* ; "Run on correction.") + ((LISTP TEM) (* ; "Run on correction.") (/RPLNODE TL (CAR TEM) (CONS (CDR TEM) (CDR TL))) (SETQ TEM (CAR TEM))) (T (/RPLNODE TL TEM (CDR TL] - (* ;; "If FN1 is NIL, TAIL would have been given to FIXSPPELL, and in this case the correction would already have been stmashed into TAIL.") + + (* ;; "If FN1 is NIL, TAIL would have been given to FIXSPPELL, and in this case the correction would already have been stmashed into TAIL.") + (CAR TL]) (CLISPNOTVARP - [LAMBDA (X) (* lmm "20-May-84 19:45") + [LAMBDA (X) (* lmm "20-May-84 19:45") (AND (NOT (BOUNDP X)) (NOT (FMEMB X VARS)) [NOT (FMEMB X (COND @@ -3421,7 +3815,7 @@ with the terms of said license. (NOT (FMEMB X (LISTP SPECVARS]) (CLISP-SIMPLE-FUNCTION-P - [LAMBDA (CARFORM) (* lmm "18-Jul-86 16:45") + [LAMBDA (CARFORM) (* lmm "18-Jul-86 16:45") (AND (OR (FGETD CARFORM) (GET CARFORM 'EXPR) (AND (NOT (GET CARFORM 'CLISPWORD)) @@ -3430,7 +3824,7 @@ with the terms of said license. T]) (CLISPELL - [LAMBDA (FORM TYPE) (* lmm "20-May-84 18:54") + [LAMBDA (FORM TYPE) (* lmm "20-May-84 18:54") (PROG (VAL TEM RESPELLTAIL) [MAPC (LISTGET1 LISPXHIST 'RESPELLS) (FUNCTION (LAMBDA (X) @@ -3452,9 +3846,12 @@ with the terms of said license. (RETURN VAL]) (FINDFN - [LAMBDA (POS FLG) (* lmm "21-May-84 00:40") - (* ;; "Used by HELPFIX and WTFIX. Locates highest interpreted form in the current chain of interpretation, sets free variable EXPR to this expression and returns the NAME of the corresponding function, or 'BREAK-EXP', 'EVAL', or 'TYPE-IN' depending on context. also sets free variable TYPE-IN? to T if the expression was typed in by the user.") - (* ;; "When called from WTFIX, (FLG is T) and sets the variable BREAKFLG to T if the expression was typed into a BREAK, (In this case, DWIM uses the lambda and/or prog variables for spelling corrections.)") + [LAMBDA (POS FLG) (* lmm "21-May-84 00:40") + + (* ;; "Used by HELPFIX and WTFIX. Locates highest interpreted form in the current chain of interpretation, sets free variable EXPR to this expression and returns the NAME of the corresponding function, or 'BREAK-EXP', 'EVAL', or 'TYPE-IN' depending on context. also sets free variable TYPE-IN? to T if the expression was typed in by the user.") + + (* ;; "When called from WTFIX, (FLG is T) and sets the variable BREAKFLG to T if the expression was typed into a BREAK, (In this case, DWIM uses the lambda and/or prog variables for spelling corrections.)") + (PROG1 [PROG (NAME TOKEN TEM) [COND ((NULL POS) @@ -3515,31 +3912,36 @@ with the terms of said license. (GO LP)) (INTERNAL (GO LP3)) (NIL 'EVAL) - (%: (* ; - "Call to EVAL comes from a BREAK (i.e. via a LISPX which was called from BREAK1.)") + (%: (* ; + "Call to EVAL comes from a BREAK (i.e. via a LISPX which was called from BREAK1.)") (AND FLG (SETQ BREAKFLG T)) (SETQ TYPE-IN? T) 'TYPE-IN) - (BREAK (* ; - "Call to EVAL from evaluation of a breakcommand.") + (BREAK (* ; + "Call to EVAL from evaluation of a breakcommand.") (AND FLG (SETQ BREAKFLG T)) 'BREAKCOMS) - (BREAK-EXP (* ; - "Call to EVAL from EVAL, OK, or GO command.") + (BREAK-EXP (* ; + "Call to EVAL from EVAL, OK, or GO command.") (COND ((NULL (EVALV 'BRKTYPE POS)) - (* ;; "Since BRKTYPE is NIL, we are in a user BREAK. Therefore, if broken function is an EXPR, want to stop searching, otherwise continue (latter can only occur when FINDFN is called as result of EDIT command since WTFIX will never be called out of compiled function.)") + + (* ;; "Since BRKTYPE is NIL, we are in a user BREAK. Therefore, if broken function is an EXPR, want to stop searching, otherwise continue (latter can only occur when FINDFN is called as result of EDIT command since WTFIX will never be called out of compiled function.)") + (SETQ TEM (STKPOS 'BREAK1 -1 POS)) (RELSTK POS) [SETQ NAME (STKNAME (SETQ POS (STKNTH -1 TEM TEM] (GO LP2)) - (T (* ;; "EVAL, OK, or GO command to non-user BREAK expression, e.g. get a non-numeric arg BREAK, fix the BRKEXP, do an EVAL, and get another error.") + (T + + (* ;; "EVAL, OK, or GO command to non-user BREAK expression, e.g. get a non-numeric arg BREAK, fix the BRKEXP, do an EVAL, and get another error.") + 'BREAK-EXP))) (COND ((LISTP TOKEN) (COND - ((NLISTP EXPR) (* ; - "permits caller to specify the tail") + ((NLISTP EXPR) (* ; + "permits caller to specify the tail") (SETQ TAIL TOKEN))) 'EVAL) (T (SETQ TYPE-IN? T) @@ -3551,7 +3953,10 @@ with the terms of said license. (GO LP)) (INTERNAL (GO LP3)) NIL) - (SETQ TYPE-IN? TOKEN) (* ;; "WTFIX would already know that this was an apply error because of FAULTAPPLYFLG. However, FINDFN is called to find out whether the expression was typed in or not.") + (SETQ TYPE-IN? TOKEN) + + (* ;; "WTFIX would already know that this was an apply error because of FAULTAPPLYFLG. However, FINDFN is called to find out whether the expression was typed in or not.") + (RETURN (COND (FLG (SETQ EXPR (STKARG 2 POS)) (STKARG 1 POS)) @@ -3559,21 +3964,21 @@ with the terms of said license. (RELSTK POS]) (DWIMUNSAVEDEF - [LAMBDA (FN FLG) (* lmm "11-DEC-81 21:23") + [LAMBDA (FN FLG) (* lmm "11-DEC-81 21:23") (LISPXPRIN2 FN T T) [AND (NULL FLG) (NULL TYPE-IN?) (NEQ (CAR SIDES) 'CLISP% ) (SETQ SIDES (LIST 'CLISP% (LIST COMMENTFLG (FLAST (LISTGET1 LISPXHIST '*LISPXPRINT*)) - SIDES] (* ; - "FLG is TRUE on calls from CLISPIFY, in which case SIDES is not relevant (or even bound)") + SIDES] (* ; + "FLG is TRUE on calls from CLISPIFY, in which case SIDES is not relevant (or even bound)") (LISPXPRIN1 '" unsaved" T) (LISPXTERPRI T) (UNSAVEDEF FN]) (CHECKTRAN - [LAMBDA (X) (* lmm "20-May-84 19:01") + [LAMBDA (X) (* lmm "20-May-84 19:01") (DECLARE (GLOBALVARS %#CLISPARRAY CLISPARRAY CLISPTRANFLG)) (OR (AND CLISPARRAY (GETHASH X CLISPARRAY)) (AND CLISPTRANFLG (EQ (CAR X) @@ -3583,9 +3988,10 @@ with the terms of said license. (DEFINEQ (CLISPIF - [LAMBDA (FORM) (* bvm%: "21-Nov-86 18:09") - (* ;; - "Translates (IF -- THEN -- ELSEIF -- THEN -- ELSE --) to equivalent COND.") + [LAMBDA (FORM) (* bvm%: "21-Nov-86 18:09") + + (* ;; "Translates (IF -- THEN -- ELSEIF -- THEN -- ELSE --) to equivalent COND.") + (COND (DWIMIFYFLG (SETQ ATTEMPTFLG T) (SETQ CLISPCHANGE T))) @@ -3601,18 +4007,23 @@ with the terms of said license. (SETQ NOFIXFNSLST0 NOFIXFNSLST) (SETQ NOFIXVARSLST0 NOFIXVARSLST))) (SELECTQ (DWIMUNDOCATCH 'CLISPIF0 (SETQ TEM (CLISPIF0 FORM))) - (:RESPELL (* ;; "A misspelled IF word was detected. We now go through respellings and make any corrections that occur in FORM. Note that more than one correction may have been involved, e.g. IF FOO XTHENN PRINT X.") + (:RESPELL + (* ;; "A misspelled IF word was detected. We now go through respellings and make any corrections that occur in FORM. Note that more than one correction may have been involved, e.g. IF FOO XTHENN PRINT X.") + (COND ((CLISPELL FORM 'IFWORD) (SETQ NOFIXFNSLST0 FNSLST0) - (SETQ NOFIXVARSLST0 VARSLST0) (* ;; "The additions made to these lists may be wrong as a result of the misspelling of the IF word, e.g. a variaae kay have appeared in a function slot.") + (SETQ NOFIXVARSLST0 VARSLST0) + + (* ;; "The additions made to these lists may be wrong as a result of the misspelling of the IF word, e.g. a variaae kay have appeared in a function slot.") + (GO LP)))) - (NIL (* ; "error")) + (NIL (* ; "error")) (RETURN TEM)) (RETDWIM]) (CLISPIF0 - [LAMBDA (FORM) (* lmm " 4-SEP-83 22:54") + [LAMBDA (FORM) (* lmm " 4-SEP-83 22:54") (PROG (X Y PRED TEM L L0 L-1 CLAUSE DWIMIFYCHANGE $SIDES) (SETQ L FORM) [AND CLISPIFTRANFLG (SETQ Y (LIST (CONS (CAR L] @@ -3620,7 +4031,10 @@ with the terms of said license. LP (SELECTQ (CAR L) ((IF if) (COND - [(EQ L (CDR L-1)) (* ;; "No IF's should be seen after the initial one except when immediately following an ELSE. In this case the two words are treated the same as ELSEIF.") + [(EQ L (CDR L-1)) + + (* ;; "No IF's should be seen after the initial one except when immediately following an ELSE. In this case the two words are treated the same as ELSEIF.") + (SETQ PRED NIL) (COND (CLISPIFTRANFLG (OR [EQ (CAR L-1) @@ -3638,7 +4052,7 @@ with the terms of said license. Y)))) ((ELSE else) (SETQ X (NCONC1 X (CLISPIF1 PRED L0 L FORM))) - (SETQ L-1 L) (* ; "To enable ELSE IF as two words.") + (SETQ L-1 L) (* ; "To enable ELSE IF as two words.") (SETQ PRED T) (AND CLISPIFTRANFLG (SETQ Y (CONS (CONS (CAR L)) Y)))) @@ -3646,7 +4060,10 @@ with the terms of said license. [SETQ PRED (COND ((EQ L0 L) (GO ERROR)) - (T (* ;; "The reason for doing the LDIFF even when L is (CDR L0) is that can't just set pred to CAR of L is becuase then couldnt distinguish no predicate from IF NIL THEN -- (Actually encountered by one user.)") + (T + + (* ;; "The reason for doing the LDIFF even when L is (CDR L0) is that can't just set pred to CAR of L is becuase then couldnt distinguish no predicate from IF NIL THEN -- (Actually encountered by one user.)") + (LDIFF L0 L] [COND (CLISPIFTRANFLG (OR (LISTP (CAR Y)) @@ -3662,7 +4079,10 @@ with the terms of said license. (AND CLISPIFTRANFLG (SETQ Y (DREVERSE Y))) (/RPLNODE FORM 'COND X) [SETQ $SIDES (CDR (LISTGET1 LISPXHIST 'SIDE] - (SETQ L (CDR FORM)) (* ;; "The COND must appear in the original definition before DWIMIFYing can be done, or else correction of 8 and 9 errors won't work. Some unnecessary work may be done by virtue of DWIMIFYING the whole IF statement, even when it is being evaluated (as opposed to being dwimified). however, in most cases, if the user employs IF, there will be other CLISP constructs in the predicates and consequents.") + (SETQ L (CDR FORM)) + + (* ;; "The COND must appear in the original definition before DWIMIFYing can be done, or else correction of 8 and 9 errors won't work. Some unnecessary work may be done by virtue of DWIMIFYING the whole IF statement, even when it is being evaluated (as opposed to being dwimified). however, in most cases, if the user employs IF, there will be other CLISP constructs in the predicates and consequents.") + LP2 (SETQ CLAUSE (CAR L)) (COND [(LISTP (CAR CLAUSE)) @@ -3692,7 +4112,10 @@ with the terms of said license. (GO LP2))) (CLISPIF2 FORM) (COND - (CLISPIFTRANFLG (* ;; "Bletcherous PROG here because fool Interlisp-D compiler can't handle MAP2CAR right when inside a BLOCKS") + (CLISPIFTRANFLG + + (* ;; "Bletcherous PROG here because fool Interlisp-D compiler can't handle MAP2CAR right when inside a BLOCKS") + (PROG ((LF (CDR FORM)) (LY Y) (FIRSTP T) @@ -3711,16 +4134,19 @@ with the terms of said license. (SETQ FIRSTP) (GO LP)) (SETQ TEM (CONS (CAR FORM) - (CDR FORM))) (* ; - "the conditional expression, which is now in the function, and is going to be smashed") + (CDR FORM))) (* ; + "the conditional expression, which is now in the function, and is going to be smashed") (RPLNODE FORM (CAR X) - (CDR X)) (* ; - "puts the clisp back in /rplnode unnecessary since this was already saved above.") + (CDR X)) (* ; + "puts the clisp back in /rplnode unnecessary since this was already saved above.") [COND ((AND (EQ (CAAR $SIDES) FORM) (EQUAL (CAAR $SIDES) - (CDAR $SIDES))) (* ;; "so function wont be marked as changed reason for EQUAL check is if it was converted to lower case, than do want to retain side informaton.") + (CDAR $SIDES))) + + (* ;; "so function wont be marked as changed reason for EQUAL check is if it was converted to lower case, than do want to retain side informaton.") + (FRPLACA (CAR $SIDES) '*] (CLISPTRAN FORM TEM))) @@ -3729,7 +4155,7 @@ with the terms of said license. (DWIMERRORRETURN (LIST 4 L FORM]) (CLISPIF1 - [LAMBDA (PRED L0 L FORM) (* lmm "26-Jul-84 05:01") + [LAMBDA (PRED L0 L FORM) (* lmm "26-Jul-84 05:01") (COND (PRED (CONS (COND ((OR (NLISTP PRED) @@ -3737,7 +4163,10 @@ with the terms of said license. PRED) (T (CAR PRED))) (LDIFF L0 L))) - ((EQ L0 L) (* ;; "Note that ELSE or ELSEIF can imediately follow a THEN by virtue of the PRED check in earlier clause.") + ((EQ L0 L) + + (* ;; "Note that ELSE or ELSEIF can imediately follow a THEN by virtue of the PRED check in earlier clause.") + (DWIMERRORRETURN (LIST 4 L FORM))) ((EQ (CDR L0) L) @@ -3745,7 +4174,7 @@ with the terms of said license. (T (LIST (LDIFF L0 L]) (CLISPIF2 - [LAMBDA (X) (* lmm "16-Sep-85 18:15") + [LAMBDA (X) (* lmm "16-Sep-85 18:15") (PROG (TEM1 TEM2 TEM3) (COND ((NEQ (CAR X) @@ -3754,21 +4183,24 @@ with the terms of said license. X) (EQ (CAR TEM1) T) - (NULL (CDDR TEM1))) (* ;; "Changes expression of X (COND -- (T (COND **))) to (COND -- **) useful for producing more aesthetic code when the 'DO' portion of a 'FOR' statement is an 'IF' Converts") + (NULL (CDDR TEM1))) + + (* ;; "Changes expression of X (COND -- (T (COND **))) to (COND -- **) useful for producing more aesthetic code when the 'DO' portion of a 'FOR' statement is an 'IF' Converts") + (/RPLNODE TEM2 (CADR X) (CDDR X))) ((AND (EQ (CAR TEM1) T) (EQ [CADR (LISTP (SETQ TEM3 (CAR (SETQ TEM2 (NLEFT X 2] X) - (NULL (CDDR TEM2))) (* ; - "Converts expression of X (COND (& (COND --)) (T **)) to (COND ((NEGATION &) **) --)") + (NULL (CDDR TEM2))) (* ; + "Converts expression of X (COND (& (COND --)) (T **)) to (COND ((NEGATION &) **) --)") (/RPLNODE TEM1 (CAR TEM3) (CDR TEM1)) (/RPLNODE TEM2 TEM1 (CDADR TEM3]) (CLISPIF3 - [LAMBDA (CLAUSE ORIGWORDPAIR FIRSTCLAUSEFLG) (* JonL "22-APR-83 19:46") + [LAMBDA (CLAUSE ORIGWORDPAIR FIRSTCLAUSEFLG) (* JonL "22-APR-83 19:46") (PROG NIL (RETURN (CONS [COND [FIRSTCLAUSEFLG (COND @@ -3798,9 +4230,10 @@ with the terms of said license. (DEFINEQ (CLISPFOR - [LAMBDA (FORM) (* bvm%: "21-Nov-86 18:10") - (* ;; - "Translates iterative statements, e.g., (for X in Y until --)") + [LAMBDA (FORM) (* bvm%: "21-Nov-86 18:10") + + (* ;; "Translates iterative statements, e.g., (for X in Y until --)") + (COND (DWIMIFYFLG (SETQ ATTEMPTFLG T) (SETQ CLISPCHANGE T))) @@ -3813,11 +4246,13 @@ with the terms of said license. (SETQ NOFIXFNSLST0 NOFIXFNSLST) (SETQ NOFIXVARSLST0 NOFIXVARSLST))) (SELECTQ (DWIMUNDOCATCH 'CLISPFOR0 (SETQ TEM (CLISPFOR0 FORM))) - (:RESPELL (* ;; "A misspelled I.S. word was detected. We now go through respellings and make any corrections that occur in FORM. Note that more than one correction may have been involved, e.g. FOR X IN YWHILLE Z FOO XTHENN PRINT X.") + (:RESPELL + (* ;; "A misspelled I.S. word was detected. We now go through respellings and make any corrections that occur in FORM. Note that more than one correction may have been involved, e.g. FOR X IN YWHILLE Z FOO XTHENN PRINT X.") + (COND ((CLISPELL FORM 'FORWORD) (GO LP)))) - (NIL (* ; "error")) + (NIL (* ; "error")) (RETURN TEM)) (RETURN]) @@ -3904,7 +4339,7 @@ with the terms of said license. [COND [(NULL (CAR I.S.OPR)) - (* ;; "The i.s.type does not define the i.s.type for the i.s. e.g. Larry's UPTO which is defined as (BIND $$MAX_BODY TO $$MAX)") + (* ;; "The i.s.type does not define the i.s.type for the i.s. e.g. Larry's UPTO which is defined as (BIND $$MAX←BODY TO $$MAX)") (COND ((NULL (CDR I.S.OPR)) @@ -4240,7 +4675,7 @@ with the terms of said license. 'SETQ) (EQ (CAR TEM) 'SETQQ)) (* ; - "IN OLD X _ .. or IN (OLD X _ ..), or IN OLD (X _ ..) or IN (OLD (X _ ..))") + "IN OLD X ← .. or IN (OLD X ← ..), or IN OLD (X ← ..) or IN (OLD (X ← ..))") (CLISPFORINITVAR (SETQ LSTVAR (CADR TEM)) (CADDR TEM))) (T (SHOULDNT 'CLISPFOR0] @@ -4424,12 +4859,17 @@ with the terms of said license. (RETURN EXP]) (CLISPFOR0A - [LAMBDA ($I.S.OPR I.S. LASTPTR) (* rmk%: " 6-Oct-84 12:11") - (* ;; "Thisfunction is called when we hit the first i.s.opr following one defined via an istype property. The problems with such operaaors is that we cannot dwiify their operands (or any operands in the i.s.) until we have scanned the entire i.s. and found aal the VARS. This requires that we obtain the definitions of each i.s.opr from its property list, since there may be BIND's in the defiition. However, we cannot substiute in the operands until after we dwimify the operands, since otherwise any errors corrected in the operands wont be seen in the original i.s. when the user prints it after it is dwimified. Furthermore, if we substitute in before we dwimify, we cant distinguish the case where the usr writes a $$VAL, thereby requiring a PROG in the translation, from that where a $$VAL is specified in the definition for the i.s.opr e.g. for COLLECT or JOIN, but nevertheless it is ok to translate to a mapping function. Therefore we insert the definition and take note of thoe things requiring substiution later. and furthermore leave in the original i.s.opr so its operand can also be dwimified.") - (DECLARE (SPECVARS LASTPTR)) (* ; - "Used freely by IS.OPRS in IDL -- Ron") + [LAMBDA ($I.S.OPR I.S. LASTPTR) (* rmk%: " 6-Oct-84 12:11") + + (* ;; "Thisfunction is called when we hit the first i.s.opr following one defined via an istype property. The problems with such operaaors is that we cannot dwiify their operands (or any operands in the i.s.) until we have scanned the entire i.s. and found aal the VARS. This requires that we obtain the definitions of each i.s.opr from its property list, since there may be BIND's in the defiition. However, we cannot substiute in the operands until after we dwimify the operands, since otherwise any errors corrected in the operands wont be seen in the original i.s. when the user prints it after it is dwimified. Furthermore, if we substitute in before we dwimify, we cant distinguish the case where the usr writes a $$VAL, thereby requiring a PROG in the translation, from that where a $$VAL is specified in the definition for the i.s.opr e.g. for COLLECT or JOIN, but nevertheless it is ok to translate to a mapping function. Therefore we insert the definition and take note of thoe things requiring substiution later. and furthermore leave in the original i.s.opr so its operand can also be dwimified.") + + (DECLARE (SPECVARS LASTPTR)) (* ; + "Used freely by IS.OPRS in IDL -- Ron") [COND - ((CDR (LISTP $I.S.OPR)) (* ;; "OTHERS. Note that an i.s.opr defned by an i.s.opr property can specify an i.s.type, OTHERS, or both.") + ((CDR (LISTP $I.S.OPR)) + + (* ;; "OTHERS. Note that an i.s.opr defned by an i.s.opr property can specify an i.s.type, OTHERS, or both.") + (SETQ I.S.OPRSLST (CONS LASTPTR I.S.OPRSLST)) (SETQ I.S. (NCONC [COPY (COND ((EQ (CADR $I.S.OPR) @@ -4440,17 +4880,20 @@ with the terms of said license. I.S.]) (CLISPFOR1 - [LAMBDA (PTRS FLG) (* wt%: "28-APR-80 16:11") + [LAMBDA (PTRS FLG) (* wt%: "28-APR-80 16:11") (PROG ((OPRTAIL (CADAR PTRS)) BODYTAIL (NXTOPRTAIL (CADDAR PTRS)) - Z TEM LSTFLG BODY) (* ;; "X is the TAIL of the iterative statement beginning with the operator, Y the tail beginning with the next opeator.") + Z TEM LSTFLG BODY) + + (* ;; "X is the TAIL of the iterative statement beginning with the operator, Y the tail beginning with the next opeator.") + (SELECTQ (CAAR PTRS) ((FOR BIND DECLARE ORIGINAL NIL) (GO OUT)) ((IN ON) (AND (NULL FLG) - (GO OUT)) (* ; "Already done.") + (GO OUT)) (* ; "Already done.") ) (AS (SETQ I.V. (CADDDR (CAR PTRS))) (GO OUT)) @@ -4470,14 +4913,16 @@ with the terms of said license. 'MODIFIER)) (CDDR OPRTAIL)) ((CDR OPRTAIL)) - (T (* ;; "special kluge to allow an i.s.opr to smash lastptr to indicate that this operator/operand is to be ignored, e.g. for handling (EVERY CHARACTER IN Z IS --)") + (T + (* ;; "special kluge to allow an i.s.opr to smash lastptr to indicate that this operator/operand is to be ignored, e.g. for handling (EVERY CHARACTER IN Z IS --)") + (GO OUT] (COND - ((EQ BODYTAIL NXTOPRTAIL) (* ; "2 FORWORDS in a row.") + ((EQ BODYTAIL NXTOPRTAIL) (* ; "2 FORWORDS in a row.") (CLISPFORERR OPRTAIL NXTOPRTAIL 'MISSING)) ((NEQ (CDR BODYTAIL) - NXTOPRTAIL) (* ; - "More than one expression between two forwords.") + NXTOPRTAIL) (* ; + "More than one expression between two forwords.") (GO BREAK))) [COND ((NLISTP (CAR BODYTAIL)) @@ -4491,7 +4936,7 @@ with the terms of said license. (NEQ (CAAR PTRS) 'TO) (SETQ Z (CLISPFUNCTION? BODYTAIL 'NOTVAR] - (* ; "E.G. DO PRINT, BY SUB1, etc.") + (* ; "E.G. DO PRINT, BY SUB1, etc.") [COND ((NULL (SETQ TEM (OR FIRSTI.V. I.V.))) (CLISPFORERR OPRTAIL NIL 'WHAT)) @@ -4499,8 +4944,8 @@ with the terms of said license. ((EQ OPRTAIL I.S.TYPE) TEM) (T (SETQ TEM I.V.))) - (CAR DUMMYVARS)) (* ; - "In the case that an i.v. was supplied, make the change permanent. For $$TEM, undo it later.") + (CAR DUMMYVARS)) (* ; + "In the case that an i.v. was supplied, make the change permanent. For $$TEM, undo it later.") (SETQ UNDOLST (CONS (CONS BODYTAIL (CONS (CAR BODYTAIL) (CDR BODYTAIL))) UNDOLST] @@ -4532,40 +4977,53 @@ with the terms of said license. (COND (NXTOPRTAIL (CLISPRPLNODE (SETQ Z (NLEFT OPRTAIL 1 NXTOPRTAIL)) (CAR Z) - NIL))) (* ; - "Breaks the list justbefore the next operator.") + NIL))) (* ; + "Breaks the list justbefore the next operator.") (CLISPRPLNODE BODYTAIL (SETQ Z (CONS (CAR BODYTAIL) (CDR BODYTAIL))) - NXTOPRTAIL) (* ;; "Puts parentheses in --- E.g. For X in FOO Y do -- becomes for X in (FOO Y) do necessary in order to call DWIMIFY. Maybe should give DWIMIFY an rgument like stoptail?") - (* ;; "Done this way instead of changing CDR X because CDR of first PTR is not EQ to the entry in the history list.") + NXTOPRTAIL) + + (* ;; "Puts parentheses in --- E.g. For X in FOO Y do -- becomes for X in (FOO Y) do necessary in order to call DWIMIFY. Maybe should give DWIMIFY an rgument like stoptail?") + + (* ;; "Done this way instead of changing CDR X because CDR of first PTR is not EQ to the entry in the history list.") + [DWIMIFY2 Z Z T (COND (I.S.TYPE 'IFWORD) - (T (* ; - "so if it sees a function in a variable position, it will insert parens, e.g. FOR X IN Y PRINT Z") + (T (* ; + "so if it sees a function in a variable position, it will insert parens, e.g. FOR X IN Y PRINT Z") 'FORWORD] A (COND - ((NULL (CDR Z)) (* ;; "Because DWIMIFY2 was called with FORMSFLG T, this came out as a list of forms, but there was only one form. E.g. X_ (FOO) became ((SETQ X (FOO))).") + ((NULL (CDR Z)) + + (* ;; "Because DWIMIFY2 was called with FORMSFLG T, this came out as a list of forms, but there was only one form. E.g. X← (FOO) became ((SETQ X (FOO))).") + (/RPLNODE Z (CAAR Z) (CDAR Z)) (GO C))) B [SELECTQ (CAAR PTRS) - ((I.S.TYPE FIRST FINALLY EACHTIME) (* ; - "More than one form permitted in operator --- means implicit progn.") + ((I.S.TYPE FIRST FINALLY EACHTIME) (* ; + "More than one form permitted in operator --- means implicit progn.") (SETQ UNDOLST (CONS (CONS OPRTAIL (CONS (CAR OPRTAIL) (CDR OPRTAIL))) UNDOLST)) - (SETQ BODY (CONS 'PROGN (APPEND Z))) (* ; - "for possible use in substituting into an i.s.opr") + (SETQ BODY (CONS 'PROGN (APPEND Z))) (* ; + "for possible use in substituting into an i.s.opr") (CLISPRPLNODE OPRTAIL (CDR BODY) - (CDR OPRTAIL)) (* ;; "Smashes the operatr itself with the body of i.s. so that when we get back to clispfor0, can distinguish the implicit progn case from others. The setting of UNDOLST is to enable restoration.") + (CDR OPRTAIL)) + + (* ;; "Smashes the operatr itself with the body of i.s. so that when we get back to clispfor0, can distinguish the implicit progn case from others. The setting of UNDOLST is to enable restoration.") + [AND (NULL LSTFLG) (CLISPRPLNODE BODYTAIL (CAR Z) (NCONC (CDR Z) - (CDR BODYTAIL] (* ; "Takes parentheses back out.") + (CDR BODYTAIL] (* ; "Takes parentheses back out.") (GO C)) (COND [(FMEMB (CAR PTRS) - I.S.OPRSLST) (* ;; "ok for a user defined opeator to have several arguments. (maybe we should phase out the errors and insertion of automatic DO??)") + I.S.OPRSLST) + + (* ;; "ok for a user defined opeator to have several arguments. (maybe we should phase out the errors and insertion of automatic DO??)") + (SETQ BODY (CONS 'PROGN (APPEND Z))) (SETQ UNDOLST (CONS (CONS OPRTAIL (CONS (CAR OPRTAIL) (CDR OPRTAIL))) @@ -4578,9 +5036,9 @@ with the terms of said license. (LSTFLG (CLISPFORERR OPRTAIL)) (I.S.TYPE (CLISPFORERR I.S.TYPE BODYTAIL)) ((EVERY (CDR Z) - (FUNCTION LISTP)) (* ; "E.g. For X in Y print Z --.") - (* ; - "This really should be taken care of in DWIMIFY2 --- I.e. (Y prinnt Z)") + (FUNCTION LISTP)) (* ; "E.g. For X in Y print Z --.") + (* ; + "This really should be taken care of in DWIMIFY2 --- I.e. (Y prinnt Z)") (/RPLNODE BODYTAIL (CAR Z) (/NCONC (CDR Z) NXTOPRTAIL)) @@ -4593,22 +5051,24 @@ with the terms of said license. (CLISPFOR4 Z)) [COND ((FMEMB (CAR PTRS) - I.S.OPRSLST) (* ; - "I.S.OPRLST is the list of those entries on forptrs defined by an I.S.OPR.") + I.S.OPRSLST) (* ; + "I.S.OPRLST is the list of those entries on forptrs defined by an I.S.OPR.") (RETURN (PROG ((END (CADDAR PTRS)) LST) [OR BODY (COND ((EQ (CAR (GETPROP (CADR (SETQ BODY (CADAR PTRS))) 'CLISPWORD)) - 'FORWORD) (* ; "modifier") + 'FORWORD) (* ; "modifier") (SETQ BODY (CADDR BODY))) (T (SETQ BODY (CADR BODY] - (* ;; "BODY is the operand to the I.S.OPR operator. END is the tail of the i.s. beginning with the next operator following it. The in between operators are the result of the expansion, and need to be dwiified, i.e. processed by clispfor1, and then have i.v. and body substituted into them.") + + (* ;; "BODY is the operand to the I.S.OPR operator. END is the tail of the i.s. beginning with the next operator following it. The in between operators are the result of the expansion, and need to be dwiified, i.e. processed by clispfor1, and then have i.v. and body substituted into them.") + (SETQ LST (CDR PTRS)) LP1 (COND ((NEQ (CADAR LST) - END) (* ; - "CADR of each entry on PTRS is the actual tail.") + END) (* ; + "CADR of each entry on PTRS is the actual tail.") (SETQ LST (CLISPFOR1 LST)) (GO LP1))) (SETQ LST (CDR PTRS)) @@ -4616,9 +5076,11 @@ with the terms of said license. ((NEQ (CADAR LST) END) (PROG ((LST1 (CADAR LST)) - (END1 (CADDAR LST))) (* ; - "The tail of the iterative statement begining with the opeator") - (* ;; "tail of iterative statement beginning with next operator the segment between tem and nxt corresponds to the body of this opeator") + (END1 (CADDAR LST))) (* ; + "The tail of the iterative statement begining with the opeator") + + (* ;; "tail of iterative statement beginning with next operator the segment between tem and nxt corresponds to the body of this opeator") + LP3 (COND ((EQ (SETQ LST1 (CDR LST1)) END1) @@ -4635,9 +5097,10 @@ with the terms of said license. OUT (RETURN (CDR PTRS]) (CLISPRPLNODE - [LAMBDA (X A D) (* wt%: 16-DEC-75 23 43) - (* ;; - "like /rplnode, except that dwimnewfile? does not count it as a change to the function") + [LAMBDA (X A D) (* wt%: 16-DEC-75 23 43) + + (* ;; "like /rplnode, except that dwimnewfile? does not count it as a change to the function") + (COND ((LISTP X) [AND LISPXHIST (UNDOSAVE (LIST 'CLISPRPLNODE X (CAR X) @@ -4647,12 +5110,15 @@ with the terms of said license. (T (ERRORX (LIST 4 X]) (CLISPFOR2 - [LAMBDA (LST FLG) (* lmm "13-Aug-84 16:42") + [LAMBDA (LST FLG) (* lmm "13-Aug-84 16:42") [MAP (SETQ LST (DREVERSE LST)) (FUNCTION (LAMBDA (X) (SELECTQ (CAAR X) (WHEN [RPLACA X (COND - (FLG (* ;; "When FLG is true, we are computing a condition forDOING it, and when FLG=NIL, for not doing it, hence difference in sign.") + (FLG + + (* ;; "When FLG is true, we are computing a condition forDOING it, and when FLG=NIL, for not doing it, hence difference in sign.") + (CADADR (CAR X))) (T (NEGATE (CADADR (CAR X]) (UNLESS [RPLACA X (COND @@ -4666,9 +5132,11 @@ with the terms of said license. LST]) (CLISPFOR3 - [LAMBDA (LST) (* wt%: 25-FEB-76 1 59) - (* ;; - "Used to process FINALLY, EACHTIME, and FIRST lists. LST is a list of form (FINALLY . tail)") + [LAMBDA (LST) (* wt%: 25-FEB-76 1 59) + + (* ;; + "Used to process FINALLY, EACHTIME, and FIRST lists. LST is a list of form (FINALLY . tail)") + (PROG (TEM) (RETURN (MAPCONC (DREVERSE LST) (FUNCTION (LAMBDA (X) @@ -4677,11 +5145,13 @@ with the terms of said license. (LIST (CADR TEM]) (CLISPFORVARS - [LAMBDA (PTRS) (* lmm "20-Jul-86 12:40") - (* ;; "Does for FOR and BIND what CLISPFOR1 does for the rest of the ptrs. LST is either a (FOR --) or (BIND --) entry from PTRS. CLISPFOR3 handles the following pathological cases. The variables may be spread out, or listed, they may involve assignments, either spread out or listed, and they may be terminated by a form or function in the case that there is no FOROPR. E.g. FOR X Y Z (PRINT X), FOR (X Y Z) PRINT X, FOR X Y _ T Z PRINTT X, FOR (X (Y_T) Z) (PRINT X) etc.") + [LAMBDA (PTRS) (* lmm "20-Jul-86 12:40") + + (* ;; "Does for FOR and BIND what CLISPFOR1 does for the rest of the ptrs. LST is either a (FOR --) or (BIND --) entry from PTRS. CLISPFOR3 handles the following pathological cases. The variables may be spread out, or listed, they may involve assignments, either spread out or listed, and they may be terminated by a form or function in the case that there is no FOROPR. E.g. FOR X Y Z (PRINT X), FOR (X Y Z) PRINT X, FOR X Y ← T Z PRINTT X, FOR (X (Y←T) Z) (PRINT X) etc.") + (PROG (TEM OLDFLG LST LST0 L1 VARLST IV (CLISPCONTEXT 'FOR/BIND)) - (* ; - "clispcontext tells CLISPATOM2 not to try spelling correction on the variable name.") + (* ; + "clispcontext tells CLISPATOM2 not to try spelling correction on the variable name.") (SETQ L1 (CADDR (CAR PTRS))) [SETQ LST0 (SETQ LST (CDR (CADAR PTRS] LP (COND @@ -4690,7 +5160,7 @@ with the terms of said license. (COND ((LITATOM (CAR LST0)) (SELECTQ (CADR LST0) - ((_ ) + ((← _) (RPLACA LST0 (LIST 'SETQ (CAR LST0) (CADDR LST0))) (RPLACD LST0 (CDDDR LST0)) @@ -4701,8 +5171,8 @@ with the terms of said license. (SETQ LST0 TEM))) [(LISTP (CAR LST0)) (SELECTQ (CAAR LST0) - ((SETQQ SAVESETQQ) (* ; - "SAVESETQ and SAVESETQQ can occur on typein if the user should happen to DW a portion of the I.s.") + ((SETQQ SAVESETQQ) (* ; + "SAVESETQ and SAVESETQQ can occur on typein if the user should happen to DW a portion of the I.s.") ) ((SETQ SAVESETQ) (DWIMIFY2 (CDDAR LST0) @@ -4710,9 +5180,9 @@ with the terms of said license. T)) (COND ((AND (OR (EQ (CADAR LST0) - '_) + '←) (EQ (CADAR LST0) - ')) + '_)) (NULL (CDDDAR LST0))) [FRPLACA LST0 (CONS 'SETQ (CONS (CAAR LST0) (CDDAR LST0] @@ -4727,22 +5197,33 @@ with the terms of said license. (SETQ X (CDR X)) (GO LX))) (CLISPFORVARS1 (CAR LST0) - (EQ L1 (CDR LST))) (* ;; "The second argument to CLISPFORVARS1 corresonds to FORMSFLG in the call to DWIMIFY2, e.g. FOR X (Y_T) want FORMSFLG to be NIL. but FOR (X_T Y) want it to be T.") + (EQ L1 (CDR LST))) + + (* ;; "The second argument to CLISPFORVARS1 corresonds to FORMSFLG in the call to DWIMIFY2, e.g. FOR X (Y←T) want FORMSFLG to be NIL. but FOR (X←T Y) want it to be T.") + (COND ((AND (LISTP (CAAR LST0)) - (NULL (CDAR LST0))) (* ;; "form was (A_form) and now is ((SETQ A form)) so remove extra parentheses inserted because formsflg was (incorrectly) T. Note that when we called clispforvars1, we donot know whether (CAR LST0) is of the form (A_B C_D) or (A _ B), i.e. one or two assignments.") + (NULL (CDAR LST0))) + + (* ;; "form was (A←form) and now is ((SETQ A form)) so remove extra parentheses inserted because formsflg was (incorrectly) T. Note that when we called clispforvars1, we donot know whether (CAR LST0) is of the form (A←B C←D) or (A ← B), i.e. one or two assignments.") + (FRPLACA LST0 (CAAR LST0] ((AND (EQ LST0 LST) - (EQ L1 (CDR LST0))) (* ; "Says this is the first argument.") + (EQ L1 (CDR LST0))) (* ; "Says this is the first argument.") (CLISPFORVARS1 (CAR LST0) T)) (I.S.TYPE (CLISPFORERR LST0 I.S.TYPE)) - (T (* ;; "Necessary because LST0 may not really correspnd to ssructure in the original statement, because of ldiff.") + (T + (* ;; "Necessary because LST0 may not really correspnd to ssructure in the original statement, because of ldiff.") + (GO ADDDO] (T (CLISPFORERR LST0))) (SETQ LST0 (CDR LST0)) (GO LP) - NX (* ;; "The area between LST and LST0 now corresponds to the (dwimified) variables. They may appears as a segment or as a list.") + NX + + (* ;; "The area between LST and LST0 now corresponds to the (dwimified) variables. They may appears as a segment or as a list.") + (SETQ LST0 (COND ([AND (EQ LST0 (CDR LST)) (LISTP (CAR LST)) @@ -4750,15 +5231,18 @@ with the terms of said license. '(SETQ SETQQ OLD old SAVESETQ SAVESETQQ] (SETQ L1 NIL) (CAR LST)) - (T LST))) (* ;; "LST0 now corresponds to the beginning of the list of variables, L1 to its end. VARLST will be used to assemble the vlue.") + (T LST))) + + (* ;; "LST0 now corresponds to the beginning of the list of variables, L1 to its end. VARLST will be used to assemble the vlue.") + LP1 [COND ((EQ LST0 L1) [COND ((AND IV (NEQ (CAAR PTRS) 'BIND) (NULL I.V.)) - (SETQ FIRSTI.V. (SETQ I.V. IV] (* ; - "IV is the first variable encountered in the variable list (may be OLD vriable)") + (SETQ FIRSTI.V. (SETQ I.V. IV] (* ; + "IV is the first variable encountered in the variable list (may be OLD vriable)") (RETURN (DREVERSE VARLST))) ((FMEMB (CAR LST0) '(OLD old)) @@ -4783,7 +5267,10 @@ with the terms of said license. ((EQ (CAAR PTRS) 'AS) (FRPLACD (CDDAR PTRS) - (LIST IV] (* ;; "Marks the i.v. for this AS. used by clispfor11 when you specify an operatand which is just a functon name.") + (LIST IV] + + (* ;; "Marks the i.v. for this AS. used by clispfor11 when you specify an operatand which is just a functon name.") + )) (COND ((NULL OLDFLG) @@ -4797,8 +5284,8 @@ with the terms of said license. (LIST 'QUOTE (CADDR TEM))) T) NIL) - (SETQ MAKEPROGFLG T) (* ; - "Says the expression must translate into an open prog.") + (SETQ MAKEPROGFLG T) (* ; + "Says the expression must translate into an open prog.") (SETQ VARS (CONS (CADR TEM) VARS)) [COND @@ -4832,7 +5319,7 @@ with the terms of said license. (GO NX]) (CLISPFORVARS1 - [LAMBDA (L FLG) (* lmm "21-Jun-85 16:59") + [LAMBDA (L FLG) (* lmm "21-Jun-85 16:59") (PROG ($TAIL) (SETQ $TAIL L) LP [COND @@ -4848,7 +5335,7 @@ with the terms of said license. (GO LP]) (CLISPFOR4 - [LAMBDA (X) (* wt%: 17-DEC-76 19 8) + [LAMBDA (X) (* wt%: 17-DEC-76 19 8) (SELECTQ (CAR X) ((GO RETURN ERROR! RETFROM RETEVAL) (SETQ TERMINATEFLG T) @@ -4857,21 +5344,24 @@ with the terms of said license. (SOME X (FUNCTION (LAMBDA (X) (COND ((EQ X '$$VAL) - (SETQ MAKEPROGFLG T) (* ; "keep on looking for RETURN or GO") + (SETQ MAKEPROGFLG T) (* ; "keep on looking for RETURN or GO") NIL) ((LISTP X) (CLISPFOR4 X]) (CLISPFORF/L - [LAMBDA (EXP VAR DECLARELST) (* lmm "29-Jul-86 00:24") - (* ;; - "Build the FUNCTIONal expression to be executed as the MAPFN for the FOR loop") + [LAMBDA (EXP VAR DECLARELST) (* lmm "29-Jul-86 00:24") + + (* ;; "Build the FUNCTIONal expression to be executed as the MAPFN for the FOR loop") + (LIST 'FUNCTION (COND - (NIL (* ;; "This originally tried to elimate the dummy variable when the FOR was a unary function, but in this case, there was still a problem --- thus this is commented out") + (NIL + (* ;; "This originally tried to elimate the dummy variable when the FOR was a unary function, but in this case, there was still a problem --- thus this is commented out") + (CAAR EXP)) - (T (* ; - "Otherwise, build a LAMBDA expression that contains all the expressions to be evaluated.") + (T (* ; + "Otherwise, build a LAMBDA expression that contains all the expressions to be evaluated.") `(LAMBDA ,VAR ,@[AND DECLARELST `((DECLARE ,@(MAPCONC (DREVERSE DECLARELST) (FUNCTION (LAMBDA (X) @@ -4880,8 +5370,11 @@ with the terms of said license. ,@EXP]) (CLISPDSUBST - [LAMBDA (X) (* wt%: "21-JAN-80 20:11") - (PROG (TEM) (* ;; "goes through X and does a dsubst of I.V. for (QUOTE I.V.) and BODY for (QUOTE BODY) in X AND all of the translations in the hasharray") + [LAMBDA (X) (* wt%: "21-JAN-80 20:11") + (PROG (TEM) + + (* ;; "goes through X and does a dsubst of I.V. for (QUOTE I.V.) and BODY for (QUOTE BODY) in X AND all of the translations in the hasharray") + [MAP X (FUNCTION (LAMBDA (X) (SELECTQ (CAR X) (BODY (FRPLACA X BODY)) @@ -4893,13 +5386,16 @@ with the terms of said license. (COND ((EQ (CAR (GETP (CAR X) 'CLISPWORD)) - 'CHANGETRAN) (* ;; "these constructs have the property that translation differs depending on expression, e.g. while (fetch foo of x) is always the same regardless of what x is, (change x y) differs depending on what x is.") + 'CHANGETRAN) + + (* ;; "these constructs have the property that translation differs depending on expression, e.g. while (fetch foo of x) is always the same regardless of what x is, (change x y) differs depending on what x is.") + (PUTHASH X NIL CLISPARRAY) (DWIMIFY1 X)) (T (CLISPDSUBST TEM]) (GETDUMMYVAR - [LAMBDA (BINDITFLG) (* lmm "28-MAY-83 18:01") + [LAMBDA (BINDITFLG) (* lmm "28-MAY-83 18:01") (PROG (VAR) [SETQ VAR (CAR (SETQ DUMMYVARS (OR (CDR DUMMYVARS) (CDR (RPLACD DUMMYVARS (LIST (GENSYM] @@ -4909,8 +5405,10 @@ with the terms of said license. (RETURN VAR]) (CLISPFORINITVAR - [LAMBDA (VAR EXP) (* wt%: "21-JAN-80 20:44") - (* ;; "this function is called when is necessary to initialize a variable to an expression outside of tje scope of anyvariables bound by i.s., i.e. in the prog binding. it generates a dummy variabe, binds it to exp, and then initializes var to that expresssin") + [LAMBDA (VAR EXP) (* wt%: "21-JAN-80 20:44") + + (* ;; "this function is called when is necessary to initialize a variable to an expression outside of tje scope of anyvariables bound by i.s., i.e. in the prog binding. it generates a dummy variabe, binds it to exp, and then initializes var to that expresssin") + (SETQ PROGVARS (CONS (LIST (GETDUMMYVAR) EXP) PROGVARS)) @@ -4919,7 +5417,7 @@ with the terms of said license. (DEFINEQ (\DURATIONTRAN - [LAMBDA (FORM) (* JonL "23-Jul-84 15:39") + [LAMBDA (FORM) (* JonL "23-Jul-84 15:39") (PROG ((BODY FORM) (OLDTIMER) (EXPANSION) @@ -4927,7 +5425,10 @@ with the terms of said license. (EXPIREDFORM '(TIMEREXPIRED? \DurationLimit . TIMERUNITSLST)) USINGTIMER USINGBOX FORDURATION RESOURCENAME UNTILDATE TIMERUNITS TIMERUNITSLST TEMP) (DECLARE (SPECVARS TIMERUNITS USINGTIMER USINGBOX FORDURATION RESOURCENAME UNTILDATE) - (GLOBALVARS DURATIONCLISPWORDS LCASEFLG)) (* ;; "DURATIONCLISPWORDS is a list of lists, each one of which has the canonical word for some CLISPWORD as second element. First element is the all-caps version, so that SPECVARS communication can take place.") + (GLOBALVARS DURATIONCLISPWORDS LCASEFLG)) + + (* ;; "DURATIONCLISPWORDS is a list of lists, each one of which has the canonical word for some CLISPWORD as second element. First element is the all-caps version, so that SPECVARS communication can take place.") + (PROG ((L DURATIONCLISPWORDS) (Z BODY)) LP (AND (NLISTP L) @@ -4946,7 +5447,7 @@ with the terms of said license. )) (SETQ USINGTIMER USINGBOX))) [COND - ((NULL TIMERUNITS) (* ; "Standard case") + ((NULL TIMERUNITS) (* ; "Standard case") NIL) (UNTILDATE (ERROR "Can't specify timerUnits for 'untilDate'" FORM)) [(SETQ TEMP (CONSTANTEXPRESSIONP TIMERUNITS)) @@ -4962,23 +5463,25 @@ with the terms of said license. ((AND FORDURATION UNTILDATE) (ERROR "Both 'untilDate' and 'forDuration' specified" FORM))) [COND - (UNTILDATE (SETQ FORDURATION UNTILDATE) (* ; - "Make the 'interval' be the thing supplied for the 'date'") + (UNTILDATE (SETQ FORDURATION UNTILDATE) (* ; + "Make the 'interval' be the thing supplied for the 'date'") (SETQ SETUPFORM '(SETUPTIMER.DATE FORDURATION OLDTIMER)) (SETQ TIMERUNITSLST '('SECONDS] (COND - ([AND (PROG1 RESOURCENAME (* ; "Comment PPLossage")) + ([AND (PROG1 RESOURCENAME (* ; "Comment PPLossage")) (NOT (\TIMER.TIMERP (EVAL (LISTGET (GETDEF RESOURCENAME 'RESOURCES NIL 'NOERROR) 'NEW] (ERROR RESOURCENAME "is not a timer RESOURCE"))) - (SETQ EXPANSION (LIST [LIST 'LAMBDA '(\DurationLimit) '(DECLARE (LOCALVARS \DurationLimit)) + (SETQ EXPANSION (LIST [LIST 'LAMBDA '(\DurationLimit) + '(DECLARE (LOCALVARS \DurationLimit)) (CONS 'until (CONS EXPIREDFORM 'BODY] SETUPFORM)) [AND (LISTP (CAR TIMERUNITSLST)) (NEQ (CAAR TIMERUNITSLST) 'QUOTE) - (SETQ EXPANSION (LIST (LIST 'LAMBDA '(\TimerUnit) '(DECLARE (LOCALVARS \TimerUnit)) + (SETQ EXPANSION (LIST (LIST 'LAMBDA '(\TimerUnit) + '(DECLARE (LOCALVARS \TimerUnit)) EXPANSION) (CAR TIMERUNITSLST))) (SETQ TIMERUNITSLST '(\TimerUnit] @@ -5004,8 +5507,10 @@ with the terms of said license. (RETURN EXPANSION]) (\CLISPKEYWORDPROCESS - [LAMBDA (FORM WORDLST) (* JonL "27-APR-83 04:39") - (* ;; "Looks for the first 'keyword' in the list FORM which is mentioned in the WORDLST -- and if one is found, the the first keyword in WORDLST is presumed to be the name of a variable to be set to the keyword's value. Returns the original list with the keyword pair non-destructively spliced out.") + [LAMBDA (FORM WORDLST) (* JonL "27-APR-83 04:39") + + (* ;; "Looks for the first 'keyword' in the list FORM which is mentioned in the WORDLST -- and if one is found, the the first keyword in WORDLST is presumed to be the name of a variable to be set to the keyword's value. Returns the original list with the keyword pair non-destructively spliced out.") + (COND ((NULL FORM) NIL) @@ -5064,14 +5569,16 @@ with the terms of said license. (RETURN UNDOTEM)))) ) ) -(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY -(BLOCK%: FORBLOCK (ENTRIES CLISPFOR) - CLISPFORVARS CLISPFOR0 CLISPFOR2 CLISPFORINITVAR CLISPDSUBST \CLISPKEYWORDPROCESS CLISPFORF/L - CLISPFOR4 CLISPFORVARS1 CLISPFOR3 CLISPFOR1 CLISPFOR0A CLISPFOR \DURATIONTRAN - (SPECVARS UNDOSIDE LISPXHIST BODY I.S.TYPE1 I.S.TYPE TERMINATEFLG FIRSTI.V. I.V. PROGVARS - MAKEPROGFLG IVINITFLG INITVARS UNDOLST DWIMIFYING VARS DWIMIFYCHANGE DUMMYVARS - I.S.OPRSLST CLISPCONTEXT UNDOSIDE0 EXP)) + + +(* BLOCKS (FORBLOCK (ENTRIES CLISPFOR) CLISPFORVARS CLISPFOR0 CLISPFOR2 CLISPFORINITVAR CLISPDSUBST +\CLISPKEYWORDPROCESS CLISPFORF/L CLISPFOR4 CLISPFORVARS1 CLISPFOR3 CLISPFOR1 CLISPFOR0A CLISPFOR +\DURATIONTRAN (SPECVARS UNDOSIDE LISPXHIST BODY I.S.TYPE1 I.S.TYPE TERMINATEFLG FIRSTI.V. I.V. +PROGVARS MAKEPROGFLG IVINITFLG INITVARS UNDOLST DWIMIFYING VARS DWIMIFYCHANGE DUMMYVARS I.S.OPRSLST +CLISPCONTEXT UNDOSIDE0 EXP))) + +(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK%: DWIMIFYBLOCK CLBINARYMINUS? CLISPANGLEBRACKETS CLISPATOM CLISPATOM0 CLISPATOM1 CLISPATOM1A CLISPATOM1B CLISPATOM2 CLISPATOM2A CLISPATOM2C CLISPATOM2D CLISPATOMARE1 CLISPATOMARE2 @@ -5118,33 +5625,32 @@ with the terms of said license. (RPAQ? DWIM.GIVE.UP.TIME ) (RPAQ? DWIM.GIVE.UP.INTERVAL 2000) -(PUTPROPS DWIMIFY COPYRIGHT ("Venue & Xerox Corporation" T 1978 1984 1985 1986 1990)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5666 53378 (DWIMIFYFNS 5676 . 7159) (DWIMIFY 7161 . 8220) (DWIMIFY0 8222 . 14599) ( -DWIMIFY0? 14601 . 16670) (DWMFY0 16672 . 17042) (DWIMIFY1 17044 . 17119) (DWIMIFY1? 17121 . 17667) ( -DWMFY1 17669 . 27351) (DWIMIFY1A 27353 . 28288) (DWIMIFY2 28290 . 28384) (DWIMIFY2? 28386 . 28959) ( -DWMFY2 28961 . 41417) (DWIMIFY2A 41419 . 42281) (CLISPANGLEBRACKETS 42283 . 42544) (SHRIEKER 42546 . -52023) (CLISPRESPELL 52025 . 52732) (EXPRCHECK 52734 . 53376)) (53379 148618 (CLISPATOM0 53389 . 55380 -) (CLISPATOM1 55382 . 81128) (CLRPLNODE 81130 . 81914) (STOPSCAN? 81916 . 85782) (CLUNARYMINUS? 85784 - . 88030) (CLBINARYMINUS? 88032 . 89969) (CLISPATOM1A 89971 . 94956) (CLISPATOM1B 94958 . 95916) ( -CLISPATOM2 95918 . 119052) (CLISPNOEVAL 119054 . 120579) (CLISPLOOKUP 120581 . 122889) (CLISPATOM2A -122891 . 126671) (CLISPBROADSCOPE 126673 . 128023) (CLISPBROADSCOPE1 128025 . 129895) (CLISPATOM2C -129897 . 133566) (CLISPATOM2D 133568 . 135840) (CLISPCAR/CDR 135842 . 140140) (CLISPCAR/CDR1 140142 . -143701) (CLISPCAR/CDR2 143703 . 144076) (CLISPATOMIS1 144078 . 145021) (CLISPATOMARE1 145023 . 145857) - (CLISPATOMARE2 145859 . 147403) (CLISPATOMIS2 147405 . 148616)) (148619 224380 (WTFIX 148629 . 148856 -) (WTFIX0 148858 . 149479) (WTFIX1 149481 . 168902) (RETDWIM 168904 . 174471) (DWIMERRORRETURN 174473 - . 174631) (DWIMARKASCHANGED 174633 . 175889) (RETDWIM1 175891 . 181400) (FIX89TYPEIN 181402 . 182856) - (FIXLAMBDA 182858 . 183371) (FIXAPPLY 183373 . 186168) (FIXATOM 186170 . 192376) (FIXATOM1 192378 . -198795) (FIXCONTINUE 198797 . 199250) (FIXCONTINUE1 199252 . 200186) (CLISPATOM 200188 . 204070) ( -GETVARS 204072 . 205599) (GETVARS1 205601 . 205972) (FIX89 205974 . 207803) (FIXPRINTIN 207805 . -209032) (FIX89A 209034 . 209782) (CLISPFUNCTION? 209784 . 214688) (CLISPNOTVARP 214690 . 215254) ( -CLISP-SIMPLE-FUNCTION-P 215256 . 215592) (CLISPELL 215594 . 216713) (FINDFN 216715 . 223491) ( -DWIMUNSAVEDEF 223493 . 224054) (CHECKTRAN 224056 . 224378)) (224381 235346 (CLISPIF 224391 . 226056) ( -CLISPIF0 226058 . 232254) (CLISPIF1 232256 . 232881) (CLISPIF2 232883 . 233992) (CLISPIF3 233994 . -235344)) (235347 298653 (CLISPFOR 235357 . 236601) (CLISPFOR0 236603 . 270380) (CLISPFOR0A 270382 . -272367) (CLISPFOR1 272369 . 283772) (CLISPRPLNODE 283774 . 284261) (CLISPFOR2 284263 . 285295) ( -CLISPFOR3 285297 . 285847) (CLISPFORVARS 285849 . 294129) (CLISPFORVARS1 294131 . 294679) (CLISPFOR4 -294681 . 295285) (CLISPFORF/L 295287 . 296422) (CLISPDSUBST 296424 . 297615) (GETDUMMYVAR 297617 . -298027) (CLISPFORINITVAR 298029 . 298651)) (298654 304767 (\DURATIONTRAN 298664 . 303526) ( -\CLISPKEYWORDPROCESS 303528 . 304765))))) + (FILEMAP (NIL (5377 52993 (DWIMIFYFNS 5387 . 6882) (DWIMIFY 6884 . 7926) (DWIMIFY0 7928 . 14337) ( +DWIMIFY0? 14339 . 16323) (DWMFY0 16325 . 16695) (DWIMIFY1 16697 . 16772) (DWIMIFY1? 16774 . 17285) ( +DWMFY1 17287 . 26957) (DWIMIFY1A 26959 . 27902) (DWIMIFY2 27904 . 27998) (DWIMIFY2? 28000 . 28538) ( +DWMFY2 28540 . 41040) (DWIMIFY2A 41042 . 41912) (CLISPANGLEBRACKETS 41914 . 42179) (SHRIEKER 42181 . +51681) (CLISPRESPELL 51683 . 52343) (EXPRCHECK 52345 . 52991)) (52994 147675 (CLISPATOM0 53004 . 54986 +) (CLISPATOM1 54988 . 80801) (CLRPLNODE 80803 . 81589) (STOPSCAN? 81591 . 85373) (CLUNARYMINUS? 85375 + . 87574) (CLBINARYMINUS? 87576 . 89416) (CLISPATOM1A 89418 . 94399) (CLISPATOM1B 94401 . 95316) ( +CLISPATOM2 95318 . 118384) (CLISPNOEVAL 118386 . 119858) (CLISPLOOKUP 119860 . 122097) (CLISPATOM2A +122099 . 125888) (CLISPBROADSCOPE 125890 . 127244) (CLISPBROADSCOPE1 127246 . 129087) (CLISPATOM2C +129089 . 132733) (CLISPATOM2D 132735 . 134952) (CLISPCAR/CDR 134954 . 139229) (CLISPCAR/CDR1 139231 . +142871) (CLISPCAR/CDR2 142873 . 143250) (CLISPATOMIS1 143252 . 144174) (CLISPATOMARE1 144176 . 144948) + (CLISPATOMARE2 144950 . 146507) (CLISPATOMIS2 146509 . 147673)) (147676 223891 (WTFIX 147686 . 147917 +) (WTFIX0 147919 . 148551) (WTFIX1 148553 . 168713) (RETDWIM 168715 . 174323) (DWIMERRORRETURN 174325 + . 174487) (DWIMARKASCHANGED 174489 . 175706) (RETDWIM1 175708 . 181222) (FIX89TYPEIN 181224 . 182706) + (FIXLAMBDA 182708 . 183174) (FIXAPPLY 183176 . 185999) (FIXATOM 186001 . 192193) (FIXATOM1 192195 . +198563) (FIXCONTINUE 198565 . 199018) (FIXCONTINUE1 199020 . 199958) (CLISPATOM 199960 . 203822) ( +GETVARS 203824 . 205383) (GETVARS1 205385 . 205735) (FIX89 205737 . 207547) (FIXPRINTIN 207549 . +208694) (FIX89A 208696 . 209448) (CLISPFUNCTION? 209450 . 214239) (CLISPNOTVARP 214241 . 214809) ( +CLISP-SIMPLE-FUNCTION-P 214811 . 215151) (CLISPELL 215153 . 216276) (FINDFN 216278 . 222986) ( +DWIMUNSAVEDEF 222988 . 223561) (CHECKTRAN 223563 . 223889)) (223892 234842 (CLISPIF 223902 . 225520) ( +CLISPIF0 225522 . 231761) (CLISPIF1 231763 . 232363) (CLISPIF2 232365 . 233484) (CLISPIF3 233486 . +234840)) (234843 297748 (CLISPFOR 234853 . 236007) (CLISPFOR0 236009 . 269796) (CLISPFOR0A 269798 . +271728) (CLISPFOR1 271730 . 283098) (CLISPRPLNODE 283100 . 283525) (CLISPFOR2 283527 . 284596) ( +CLISPFOR3 284598 . 285101) (CLISPFORVARS 285103 . 293369) (CLISPFORVARS1 293371 . 293923) (CLISPFOR4 +293925 . 294537) (CLISPFORF/L 294539 . 295592) (CLISPDSUBST 295594 . 296753) (GETDUMMYVAR 296755 . +297169) (CLISPFORINITVAR 297171 . 297746)) (297749 303924 (\DURATIONTRAN 297759 . 302730) ( +\CLISPKEYWORDPROCESS 302732 . 303922))))) STOP diff --git a/sources/DWIMIFY.LCOM b/sources/DWIMIFY.LCOM index 4ea347315d8c7e78f6629c4b7bb0c5058622bcbb..f71619db492b70ad8a3f7bf1d2a66194f426c82d 100644 GIT binary patch delta 11803 zcmai43v^V~xz3pcga9Egl8}(Ni3kahFz3uWB4#Et!wgJj4>J>zATk6JOf)1m30iH- zfK{v4YgGch56TOX}$SKF(2we_kk-tXV%oSBKM ztCzKyvmgKd|9}7cf9-!q`)$eBephl^FwL5RJl^e1vZkJ7u+80CTG|o}M*>~(fHxWN zvt~tZ3l8mTQ>==U$<7Yh)uDKrSxfW&@q<^4j1CR5@iErSKG)kF@J9muU)Vf3erRI< z(Bu|>Z@4=g>~Fuo*2+qo6>9+&M~6-6uqw@L-~RFR!7E1B4YCm+3HC%HtPrrhy}g+Y z4orc_KS3Z{n_K@MUhN%r+rQ?G`D|8?&E;Sn0e?8z=Idt@2QOzGT_JCDYar2<xk0P zMFb>9o3#(OwSmHPda1Nly~eW^V~y%CXtN!~4+@O4^e_wOyhye{@% zI_9GX>eK~0wl6P@h9jjd%*~oxS|MeX#^2eyQ2oM=ix%l~`k?mej$4;WrP^q!x;TeH zyJz3u3G1Chzca@kLU-+@4!!F=Qm0*Y>EFw+ZtBWYQt_KN+@>~s_A2^n>Ss?&d8h-| zEXBsP$uE>ki&D&CV+4BB;bs$JrF!`2LiL5i(-4Qv$=aCWW*ge{?Rk%^RBuh+1UdoLOGl;&HRCKs@OUMjU`Rds_s*58T?IK6BfRBrz-N^2SLc^aTUAe_yR~SEvKG zpR4USwjK-fiZpP0z51qlEmj$d6b@STRq{tQ+Reuo5evts-_m&=xP66o?2dsFoZb8P zgouL+@2zVrZN~YySo6V=$ty+&_QR^-Lk`+fqHKe~THP}6)5_=v>yCwg@1nL`cghbLz9m~OwJPJRBtBl&^!o>kiTL(6GZ z`eXxs?>>1RezPa9tbv#rtUH;}oNDYW>|!(m$X@X8X} zg7)ge%Sa4=`o?uS)WoAg`pdtm_toid?#c7;k8i#U*moY+m04Rc^INGF#2qXg?B#Jk zgS*vRkj?VhM!>esh6Nqu{{`6RE?&sNcb z=bxh^_``Ee_}vq#*Vyy$jHGB63fXIYKl%%aHSp45o#azLTcN%B(#u3rd-)#2T|D)( zTJ5r59wNZkUwIn854~!|@8~P_>N~H#j@C=R?!<4!Z|d>8@i%|PZ}V$0fpGek1yY^* z<=5gEd*iipbs{CNe?BJy?Z($rQUgrb>Shsdx6kio@YX&=$nAzNwY)iw#S?E{AQo$x zHZ+Tfqo(4KGl^FI6zyi=k`!#{?F9} zapXOZzW96ZJ)h%5m43KFJ^B6%`GL><^%05%*7>pE#~-d#qkp?YnDdW6Y)~sd7zUI> zj{&AqYd3%J2KniOA3dtG-S}}SocZaNMUt$0^V63skyeA5oFABeeyMZ-ePx-{A=aF} zVwtp#AnqswWa;#G%B0Oe@j;m+(`akCbg6)wK3*$LZ_Es@jOIu>hA+tV) zkClbn6YXf(os7~EYQaq<^_HDQx@ZI;0Z=>^r;coP5|Kob2H@-|0T8|=#%vxI49CTc z&CLSdu23?Z?hXLZ=E6+W8$mck$H|Zq;fvrErLUcZ#n;A=8lkVSV4QbTOJ-i;3qi#n z=!$sb0i7X#ru^NXI59-zoB>Z z@!qjo8p`%wp?^bCs&dfQdFDi>;WJUIu&!(uIH z0So$^){~7Iv}OmQgBFVfO}Ctx-7w<`MFq-l52upZ%qJ0xMa!yhl~xpIKJlqbmbjXe z#d8hZz$11r`+T-@F>#Suwp-Fx@}xGnq(oZapDW=(^^>KmR%D7ao$Blc-Z{63`;3{o zTK{l;eWvJI6CLPh2}1pFX;XC&b2Ht>!nNE)S6Az!iPeS-&)h8_LaC72zN}8#qHbNb zZppLR&fW>>{Sz7KN%iVw?P>qqQXT~1b`bWZ)?~R`YvxQeRD;gmlWOm(JwsZiD+u?2+pWInkx$L@XROou*Wa$Bu0ph3R5K2@?g^NCH} zTUM)HRJO2Tg|VeVp!WJyd*nU78lR!D7pmn0dg^|0}st;+HyzDr0{=*f(~ zU}l&4-0~Kso$neEb5%zGoNB7F6wlp?Q>o>h4|D%X9z4N)cbJC)`l)KQxjdFux%F74 z=$3A+zIXT=!T>u3mh2*73>j$+_h|>YA3z!p;`g!MVeJyWM(gJ_V!r}faHa*tdYy}G zg;nmHSvv?5Q~2QU<-!muQ+u*}@7!X(XShDK?^?cR?c&tlEEs)-?^E9|Z(qDq*8;v% z-B8ig)TwDut;czjMf*Bu+9}?wo#5NFdwEp5i$~N;E7r5%Y$GoheDFH)fuht4mX2jU z*}?s4rs5*WufAK+ECto-%GLOFR-P9T7GRNhImEhIutw{?%|jvTYXBL+8nz@ph!|KV(lqFTJmQ?xDTTWz(uH*Hox_LU!%W@}r7bGuPq*P~iCTSd@ zITXsyct17d&(5@eYABeUX)uQFG;sN{H|UyoY85ZDq{`-who#i|EcQ@_Q_o0V!{Fbj zs=Ywp_)M+gu)fZ#P1hCT)!?gowv$(rZ~Y3dPOYDj(J?_)d-XbqZ+CSU1bTmUxGpq% zUS3j=A74L6zadpxQSa-VZNOyHs#Nuy9gR-pH$tICQmeAu2d>;aG-#1*<+H1^mywv? zgXo?Y`^XeMLo3uvRx~cf1f2~2!z@rD@UF(cw8*kSzil#h}7*% zPYD)*iF}N6#wtKkd-YBN7@)*DA3<(UKx>40-XZ~E& zVsj&T5@{7(7LhvPdK>W~!rNRfg>?tIeP|*2?~bOaw4+c@M$haZoh#^A3pz-+@-xV( z@*U(z1)ahfR2cFz$aZoar^}HxQhy$|A*plVMoq~e@-gblNI(4HU=V4Z$I1MtZ3W_q z0FphYd1K&l@NP$t6V?kXOHb@|s+k&1ATPVPzIPG~n z3erz87vX$+52ck5X^x8QGP2m*ERx=>fuz5uyStxqKbwpUH3x3B*-T_<9h=oUAH9Mb z?K}i1P#7ezk#ICDGD^jb6G-&WA{K&Z7P?Ox2WH&@o(8FS3L$VuryveNW^2n&rgdsGU zYzvnH+PH!qjD{v;G!=spoT43FIqk|LaJpO!I?Cg#QP4&?P_(;|*khp+3v-klo`O{l zShTry06Lsj0?cWi?0`TE=Isz#ek=C0JHJ}o;AH!}o!bipYs{On#1^b5IM}dl^NeI0 z(3xAXxgb&6jX#-SU&zy(KiGTyA$HumDd~qOa*3hjJ4+7}Ir|AF=Hw-h-m8Kgp z{3~7>!0uMG$OogUi5AYtXu-YE&77QwROft8@(&6KnU#wn019?(TmLGgeHArmpw zPmUG5=^$j+Q3NQQvEo8RAlI(AO!gEfqLex9B4>~B5+ZfdGK%e^qeJ_r&_k(<7N7+sBotOunEcqY z6{K`jGzs-Ha3QnU#z_cPs1X6+JY)}yz{H7;h>(ysCSVJbhxSblO`#1_TZ>N`6vSc3 z9vC}l${u740=?{k2IdgCspLcjBRG8&n~Z{%?6!K?fgF&_$UHM-as1Ss3#_^?sg4n+Yh8aP6zg=~i!>U`NCjXVj( z<1i{|I2ac@FfuWTZ7UG5UQ|O(O;#M9G#eV&KRh*Za0p$5db7kPLocvsY+!WsYRo{l zdP4!w$5F7WhKI(OjG%~GVT9bbEW>dg8XFy&oJ1RCrg$KRSK6LvG91AGEMa2kilKq2 zLt|4TqZojn)FFC9X*}uDh}8hOY8Y>~OtwOh#&Rp-i?PrOL+%ZU6;?Ph6Bd?Yl=iR? z<~%sGe{^7iumG(t8!OIY-^kb?^T3uNHag^iN#=H^?d4mu*S2sKCn zj9m&sc5q8tVh1+Tvt)lP!0eD-z5`D-d1(J|dTMxJirK+fq6f9s5Z>EKqo#(3CWb~P zQH~WxVRP$cM}fzNU4AO?L4i$8S8!a&P`6U47CuyF;}av7k{-eF!9j!*iEwl)4Ay|! zMqseCJQz})0yReBWnz}$2qRs1!K7-YzCmFlP9qmpA6$D;v0YZwx7M=du%Z?mTbtYp z2W?l>>UHN=L6j|2RRzYK?X8rIdDO@{`}y#Z&CziBF9 zmsLHvuGgA#cV4{`9%hQTSE1s~!YI=ct7yRe>P)MDbzTV%XH?A*_K+bXNkpX=#=J-R%iJvqGzW|u6|cigtg9F zXLoqiN9-rlWDq;s83iYyD{j2(leP)lbR!W$z;r?V5zAai5zN5iGAjbQ%^)06z86Ks zUol&7F1gs?Kn7~Y0tfjk@hIa^>?`xc?AV%#-tKm&zjyq6I<{K6wgWGc^EWNtOT}&g zubB2=#UoOIqLRjIYg!gcO(vu*4@oa1WLSVvzuUe$X@ZD5iD6%E@hF8jxf7-#9;9^R zf-RA)!Fwc<$aR>F8u%h>jresNlgY-^`#Ne$=XhreeqI#Oi&@W|k@1=Q_F!R*~| zrs(YmG#%~Naz#c|X@6nV2+{nJdSCIm(xYm&SWd6oODku$M^JHE#LJ8477WkS=ya{U zb+9!-Xm-s=`Ucm^nXCal&kcve!? z-z|_A@7*r;bGBb?TIf#KW=Aq-tBYD(2w6GRrexVXGTqt=?)>oC1;rgKD}D;XAf+-H*nuo`yBF4@KNep8&&n% zwpgxIKm{g)Uz>1YP~ZI1GI=!YNvy>SZ7VCfxTL74SVTMVZj+HH?~#QtGhQg)WC^R9aj_;I`onoLWO$EMt4~3zzCIQ z#vweS{=O{s!h%Kufd*xRlm``EX|WVZB-)uxc+Qf-YT5d=3#vf%C#rjW7c%5R%rfFm zuAoQv@K_JB#sp%pQT%|OAmWN4WR(R=aq4Ew^~U4geufK#{`ZWcdV(^C02cAdbOHdp z0Fb!iil7JUrIu0vjtI?Q(aWcxXaATssW59)uQY+;B zBB_FA1iE81fUpqm4#ay0xv^>Y{QfjB_G8%?0<0}ydZ7eMIH+kY&KzYBnI(}OmUAkK%;$9R@=)>MQsM4H6_zqyUyL`}Rei{v$o*<-N6Um_ zHx}s+eKXB`702HUQFx#intDsBe&$8Zy2UM(?CG58Q%5gyq${N5yh#sY0WBCIvC>gm8vqBAd>YylZvfW(+W8-5Z`v*oxt{F<=0y@z% zHZp|^q|Kr7&f2t5Jj5-|VXT7l+$~gOd!V1R1oXS;`Uxi^(DuO+NaCUsg_78D70v6E z9k(R>^#c+C#G7cK7kuK&b&hQC!0|wW_r!sc+1$=_{;px8YiBqaYAXPsyNLc5SEwZ! zz8m!){fHH~KmE#zs*MSUlCl9Oqs-DBjvz1us6dqIvAL9pn zysIR;db77ta;cAa+bV6WWp_?Yt*C+7)pLC{>RIpdO3(Z$)YdW8vXNGpI3ptmN2YKW z!j-Y5MGrLw^;V23PIc0^L2{_~`IJVFxD5>&%;2IqH8gSMz-V(R-Tu|LeQlCQUDb8B zx@p78X43JbuoW|zql2OJiY$=ST;09l=;=SMmJXL#*0a+G)=DR(m94mkMR?ct1ZycZ he2M6@>4p}me_5%1X!Hl53OjwYMf&BU68gK}{{uMY{N(@u delta 11944 zcmb_idwf*You4xa5P}JLL6U)llMrwsB+R{Y=M^zzl9^$KOy-7}2_Z@y0+WzPNH77c ztvbG~+qK)}Qbw&(rCX?0>rAd$>}R)~b+@*)KB`-_t9@8seV~@K+J3rQ#r>Xh=M@tF ztA4mSkKg&7-}#;2`^@RL3)Qy@zwC)M7Z)2nKEJyw=yrzPF4`zaEuo=+OL_I+&?{-qNNmg>7dTc?YHVKMq_O!& z{kt5Engx?t5@=hO*BRLA4z+}3YV-s`xkD5;)3)AV%)P@W_k~(qU_QvUw)6~M+u|@$ z!P+JYZKCb(!)c+pco!Jg>6g2@H)Ytk!x;=w+UBws8~xO1qP^i@sG0UslSX5g90*p>44%pOhZ|Ll*FsJUZy`ZKAxyPULk zKbhLiz)vPgQGbn}6l)#b-~8PpqtTK@tUGWrse9L#)cuYWp!J%ckSN~*_;mlBYyL2v zDkp2m>G-pSL(nHXcGUC}+AlcrIwmOt1wFD`Of=-& z;SRaO+qYA@BxZZmZZ^}2u_(2R5|#ZfY8Qas9gZ6GW*ESUekv>9UCuxKV zc?3Xr)B6Y(@GMOh_7^0L-0jqnIV$jFfN{N#P{{^l5kfssI=8aEs9{6P zoVj=pC`4bP0omi*2?NFuV!)yeu-(%mR_gVI!tOvgIKTjGlv(SYY^<4G-A@OH+6} zFyoYiGp&53>d|9AZBE^n%Iq^e1+;n+fW@1gzAVx04RDlCj6{N|*aC7n#Z?fm{}#K_u(MZ&!jrItx1+_BWkT2RFC|= zkSM=CTeqTp#9&D3RE?(T4RZTTk=&uYadvfGC!e`FgJ^boLrR;SDU>^v@^@=WU4TgR zq?fK&UO!u3-NA+$WR1Mpuktx>#G`b)TSGQ01MgnE?1!n2{)6O07{Y&7zW8oytaIif z*@aD8fwm*kl#=agqr6$Imupmm-2RZU&cz}cYOW{9*U^`BUj&F|HPsuuugHAGsI=ReM(oL-TK zQ#KhQrsVn87g(pwJf%GHUR~_;0`nUUk&VgocYO+8uOZ@1o}XA?-8MsHTk?EghP%`G zhw&RC{^WUw9Mskw3+P8`Q(nDsXSCpG@^6c$Yx;-3HCD^6M{_zwOlTA91CW$bmG%!S z2j8!22+l0)j#Q=O(xmR@kvt*vPM=Nw-$T*J4kh`1b?pw0feTi`m6qn|%9OlAdEBT2^x4uk7@v! zTzNY*Y3F37lB8blQ1{850D4q*;d{D&SnZda)R4TAADBaPx>RllbQ%q*a+BDRpiwfi zpQ}`4cS_zfvsB(aVu(a|yj3ydg)G%5$wtcWM_b?^L#(tFLcYRY>Ava=l)C zSf=VJxluhSd({)NU%gk}rrdt+65>*l=jutP^1`_-_?FE!V#GY#fN$UIT7M^G+NCFQ znOrZoaRR`9!xOUSWOA{^E7!;w0FR!er}H5BnUaf_$t!0H6W1x>Fdc1c~S}I1w);wMC%1Zu2f=Gdgz`su8!30nqZxZ z$));8>C7=7iCmJx0ZMVBNz$1)N<TsGa1x=O}1d;sn~!;hNO{fMnluK%F!B22KG z!#~)vQy>@OSp_>cE<;RX`%Ljg#lA8s;u zPRZ>saMNzt$oFNNJ|cHKgcCgaVRaL>o+;SR@WSh8+i<~%7*q0QMJ}D$FME~WeHdI3 z<>F5=oE5>zgrxNRxvq3E-;_@$|MpkqbAP^XN8960z8UmGZsRkFi=!lRIb4u@IUJ0( z#qNR=P#1U?-M#YeNK{jn*W_pg&M6~^i5}xiHL}-3B@X^&Pi&H}1tMlitci^rB(g`| zU7P%52z%@z@-988Ny)sSujP%Zl{3qsh;Mdy`Ra}`j!6wEe65JGd5dU^&B&jB8Be-@hwv12|q(czejUUZ1oIqO9`qQm+0`vSf&Lodd7 zM$p&U>-3>#v*tDvnYd(j7MYBM`Z^&-q7@;3cHGK<=4G>4^i~L3HiHtaAnpR-7}jQ? z&Ei7HBr2NObvb)`-2s<~nBM`U8Ip10On8jcO0?T(m)tvmmLyU44yPY25g9-xixXL* z00#F4WrXE|BbIj-0qNcalBwNF+(~50-{BftT|RZE~VYg|s>&ze3Dx%bgmQaL%dC zuqzpkn3+5=?l6u}hfSDsI0xG;Z9*NeCaB-J{Jwyj+F<~D-R|x#Y6sV}3$a^r1jOt} z8}n_CUC7fI8;nK%qz&nAe%}hQoYRMb<@Y5~$W=GY%;;x1vdh&MbcTH~6qdM~0A_Z< ztW=i0T=9bKMda)mDG>AggvjiF7ITIGjn^7h0oi=E%mR~`xx?mIF&q{KE`jGkVjuFM z3}d$9PMVthAjWEg5Xtxpd2DL(h25Z;0e}zI=e+!rt>)GwiW8D>@iHxeuOI zL~(+VDRRQKA?&sR+=O}JRTl6yU5GH7u;Es$GTALO=4TB!Qw)d>44@DDCea>Wpf3ay z<$zZ5{ji;#Uhd|0%K@tkQbh;&;KV6m1W^KF#T*ouEVL8$&yGzPE<0>$my6kU(58Xd z;L-vp2;jEGm<`P5p1_u&Ph`cP%)FJcFI(yrttLn(FEfc2W`+5dti;1gHKGN+hSh3B z3q(yDft2tO2}*}5k0{~3P<@3Yq0AG&{t_xwJ~Sj)7)G}lT=fLy9<*RUnwq!?XZ|>S z5uzDpF*6LCm}x@k*wq7*2#b_yqM&yf^8o2GDrD4zE)Ky8UZ~H|82rJUNda{9IGJw% zRCEF*CFm^%a0jd{(yJy=@CFJC8)aNX$7-W{C&tEx_8vlqMOlDH3%A2Dn0ZYN#VJ!7 z6Pv`H167RSLd3L91``AaE{&~)XBHfGDT`Eaz$P;P+uIW z@VgKkf|>0pI80`ZQo#;)ogq$Os>Z8m@FKiO72{kGY~cEE7Rm-W%yq!o47cD1zzi8N zn9mIot+0C8DGS^k_}ecBT`>M2o{Npvl^hOs+X7QHc1{Tr16VX-h|nMxsKyCt!pv~c zxh*zZY*d7=Y>4Ag&p~;|v~bVEogoO_2ZeI+M)=GWZIU zH70-%4H#i>#**Q=LZs25y<>xu3=NpBT^bXbJ)`4M>cFLfZ4QLwgHv!VW_lf7T(0BA z-*CUL3yueD%qcFrZD^Mb%l2GLZ8keoLL0<3)`^-Ns=hXQXoAa#0(tm*2DF(;Vufv|uXab^}Bk?B?@NHC(PO;3*QV}gYE*9PMp z3i$#kKjR2_Vh&Ntu0hn5Tf>UYIhke_FKvG8!^=Fifo6mfulq@Eu`QVw@JohpMXVFZ3RA6=Mc+x)GbZ3Zc?w;k#b5p5*wle@jGkD`a-0%uf!j(C0((3kzyJv6eAby zv(Ty!mmPutYk>(x0Du6656utLH5@48!wT_Ra|VOX0cZ-<-UWFe1R?M8OQ@D}%LVbu zgM>3<42QMir@7!kAbz%i7^?7kCs4MQRpL$TLVKFy>l?{UvH8qpsYQlQ$YQiGhOHBr zOJ-c=uLI3g*I%g974RgVf1I63(N5Yn||TU3Lg^=L@I7ixE0qS_qTTX!eM8p-;GnZ5u($Vm+3lo zJ~&dg-J5<;T<1-{ZmvjqJ4T$N+WVz;wmS$vS8AhIpLkAZ#G}f5@-;#r9$}}C#hCVZ zdo`(RoDXQuQmZLR{5#9ZE^$8G{8MFKZ>?NT;!Wb`wMHs5rmcfXH=oq4K=;Q#Xs zS)?=-e|ahSN^B3%oDY=5ZpvYCT$5L`x;+4#kF3N@#fttjdT!dzi%N6~G zn#4;eu;XF&1#QQ~Q#vDyE-yH3S`8O2D&Sd@Jt}T;;sU#%lZYa+F~1EmwuvW5a5lLN z+=k%df-Sg!SsimLGFB|lcr#X^VZMm>Gf%fxL=?MX=?u&Y3!BL>s1@F1E@)o0$^tV# zXVL=Km|beY((DN&gh<)fSmuQ0tdro{y5dhSBVR{Ffg1^y5^|fzDlA#IV?!i__f;EA z5Im9%&&D_}H#Mv#$5HYgE0t(LEX#1xE%?oB)MG&qp9ynVj-v%h7SUXr+f2ggGUz3{ z6fZ0xFSpHSHxjj+S~5yucAC;2iWwo1TZi6o{ELgok>yU4$t1FmnSCVXgz8lO^>tUC z1yKI)^@|s4AnGSYi-@xEjfYZ=a z=!vMDeEYFH?D2+Gq*6J(qa;4Did@mpViMOtGbJCD>(Z~9+IwdCTV=c1tBn`6>xiL1 zt&>+jA(yeLx!N>Vn*U&upz>u&wl(M*WXMc_57y@@8em5l3Dc~RDJ9Df>h#FSR*(uCQi;SCzZ77 z2rd@S#Rye+X#tPj7OiN-Dw3>t;)cVt3W#bd(-k^|uo|dfmEu>|lT}2F-&IelA$93- zJb`PiIfa>BoZsE<0VZA8wTlJ32yr>+PQ1Re{DF4@aBC7IEhmc-@)o=|vv+L=4Y>Oe zPvNhu?P5lZ7IcSVa$gWQVNK1sfW{0h?e~SfEda>OBiHdedpccCq^g;p4u}X3xvC() zOh?JA)R2ZlAuRn916GCW@%fQ-xmija!p|CDJtihyhbQBAuOaJ+5KpZkbwrB)at&#z zFj3>KFmi&)zVXpR&8(CfUroun3hUf)q^9IpOa1z5>eJ#uOSije(M>M zfiS3(_G0isz5dcNviK49lZc4&mCcRX{MB35D6egfgC9_&7DVfGLyLB(tGCoCU%Tu$ zSUhKj!lX9xlU%)}RvB*p8R%)>a!qEp8ui632t7)ai<}+W7;Zw@=RAg?kDT?nAxmef z47UeM?F}M^&oHuDS=IG}3QV9H5~Ma(p~+1ZyUwgFF(T4p=@D{YRBw);PJSU+0oag?g7LF9+^qtb}89A~}+Katp87UalzeeG3X+ zr5ftBGL&;%g0K8>K8%&U|ogVQ-oPY&Ll?Wlu$HZbVB_O8PB zp}lMIeQxiOmADl6Yj-$2!14*CSlV_2(eDAEW=KkJH6*gdw+#E(vfetV)}>7QdHA8+bfil8-k3W}h_dX!AF=4;1DZOhYscRr)t~}Vhlj@! z2qm-@G_~$v9bhj#=;IqIUpN@c;!&4hUBhTHPNwxLFu6TDshpl1&)5Mdn5I2VQ`-T5 zWU5J{_QaHnt$*v#Z5sQ|?O&lx+E*#}9ey^8M?H9?VKFZF=yj4_TlM1`ka?D<&)#|? zTikQI8{fp@D&_R;KS%49J6iBf-cbpVr|?DR)i11~5Dg^8jg6=*;Pt~LOuJXR~7;FlgIAUjEy>Y{2v+6 zAMW`te5da<;hVU}pnQDquhII|S3B@sbDx2a)+(XX#2-)v(1h(ELk--$=7)$)h`3AC#ZK02ZCRykN(qi#$LGN>;l9U6jX zlF#I*T7K&aMV)>=H?aHrE0wRQ3R7|Xur1%W?EZe0a_-C`W!K|(FJJ()*(C~{8NqDk zRU#w&m{lL0d5*b)&p+`9r$gQFonq!MtUnMmf1&Pwx`7dzZ$DoB@i0a@o@vvT-0;lB z4C2(Y4fy`(+09tK=sAH6*`D90o$loG{@h{y^8Cw~d-f-T+H&CqCxe}OaV@^_7ca%~ zpT6j1M6Gz~4t(!_3CgJc_N6KY_0h}eTYPY^TCu)zJ%%2CWuvyq+pj#0?zevit%X*q z&-`pNvsp#IxFhYblwY31{4Kw-zzHB#fn**YpBg+e6lIe6<6ng^S^xTGzBvAB3Aq_I zzCp^UF`azyQVT7Pzhfi=C7R=4R$8RRXS$oo{}f$rL{Wsr zm7z?!g7<^o0o1a*VQ9#Xq4C2*s2T4Znw