(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP" BASE 10) (FILECREATED " 9-May-2018 11:09:43"  {DSK}kaplan>Local>medley3.5>lispcore>lispusers>DOC-OBJECTS.;7 50515 changes to%: (FNS DOCOBJ-INCLUDE-EDIT DOCOBJ-INCLUDE-BEFOREHARDCOPYFN) previous date%: " 9-May-2018 10:35:47" {DSK}kaplan>Local>medley3.5>lispcore>lispusers>DOC-OBJECTS.;4) (* ; " Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights reserved. ") (PRETTYCOMPRINT DOC-OBJECTSCOMS) (RPAQQ DOC-OBJECTSCOMS [ (* ;;; "This TEdit subsystem implements an extensible facility originally intended to provide bibliography and citation capabilities. The TEdit function GET.OBJ.FROM.USER, the one triggered by typing ^O, calls the function PROMPTFOREVALED which is redefined by this subsystem to be equivalent to the function DocObj-Acquire-Object. This function inserts IMAGEOBJects into the current TEdit, and is driven by the variables DocObjectsMenu and DocObjectsMenuCommands (analogous to BackgroundMenu and BackgroundMenuCommands). Each menu entry contains a form that, when EVAL'd, creates and returns a particular kind of IMAGEOBJ. Note that this form is EVAL'd under the function DocObj-Acquire-Object, which runs under the function GET.OBJ.FROM.USER, which gets TEXTSTREAM and TEXTOBJ as arguments. They can be (and are) used freely to record state or other desired info. The image objects supplied by this subsystem are 'Eval`d Form' (i.e., the original behavior of ^O), 'Screen Snap' (equivalent to right-buttoning in the background while holding the SHIFT key down), etc.") (FILES (SYSLOAD) TEDIT IMAGEOBJ) (VARS (DocObjectsMenu NIL) (DocObjectsConfirmEditMenu NIL)) [INITVARS (DocObjectsMenuCommands NIL) (DocObjectsMenuFont (FONTCREATE '(MODERN 12 BOLD] (COMS (* ;; "The hook into GET.OBJ.FROM.USER") (FNS DOCOBJ-ACQUIRE-OBJECT DOCOBJ-INIT DOCOBJ-TEDIT-MENU-ENTRY DOCOBJ-GET-LOOKS DOCOBJ-REGISTER-OBJECT DOCOBJ-STRING-IMAGEBOX DOCOBJ-WAIT-MOUSE DOCOBJ-INVOKE-IMAGEOBJFN DOCOBJ-BEFOREHARDCOPYFN DOCOBJ-AFTERHARDCOPYFN)) [COMS (* ;; "Eval'd Form") (FNS DOCOBJ-ACQUIRE-EVALED-OBJECT) (ADDVARS (DocObjectsMenuCommands ("Eval'd Form" (DOCOBJ-ACQUIRE-EVALED-OBJECT) "Insert the value of a form to be typed in"] [COMS (* ;; "Screen Snap") (FNS DOCOBJ-ACQUIRE-SNAPPED-OBJECT) (ADDVARS (DocObjectsMenuCommands ("Screen Snap" (DOCOBJ-ACQUIRE-SNAPPED-OBJECT) "Insert a snap from the screen"] [COMS (* ;; "Time Stamp") (DECLARE%: DONTCOPY (RECORDS DOCOBJ-TIMESTAMP)) (FILES (SYSLOAD) DATEFORMAT-EDITOR) (FNS DOCOBJ-EDIT-TIMESTAMP DOCOBJ-MAKE-TIMESTAMP DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS DOCOBJ-TIMESTAMP-BUTTONEVENTINFN DOCOBJ-TIMESTAMP-COPYFN DOCOBJ-TIMESTAMP-DISPLAYFN DOCOBJ-TIMESTAMP-GETFN DOCOBJ-TIMESTAMP-IMAGEBOXFN DOCOBJ-TIMESTAMP-PREPRINTFN DOCOBJ-TIMESTAMP-PUTFN DOCOBJ-TIMESTAMP-TO-STRING) (INITVARS (DocObjectsTimeStampFormat) (DOCOBJ-TIMESTAMP-IMAGEFNS (DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS))) (ADDVARS (DocObjectsMenuCommands ("Time Stamp" (DOCOBJ-MAKE-TIMESTAMP) "Date & time this document is PUT"] [COMS (* ;; "File Stamp") (FNS DOCOBJ-MAKE-FILESTAMP DOCOBJ-MAKE-FILESTAMP-IMAGEFNS DOCOBJ-FILESTAMP-COPYFN DOCOBJ-FILESTAMP-DISPLAYFN DOCOBJ-FILESTAMP-GETFN DOCOBJ-FILESTAMP-IMAGEBOXFN DOCOBJ-FILESTAMP-GET-FULLNAME DOCOBJ-FILESTAMP-NEW-FULLNAME DOCOBJ-FILESTAMP-PREPRINTFN DOCOBJ-FILESTAMP-PUTFN) (INITVARS (DOCOBJ-FILESTAMP-IMAGEFNS (DOCOBJ-MAKE-FILESTAMP-IMAGEFNS))) (ADDVARS (DocObjectsMenuCommands ("File Stamp" (DOCOBJ-MAKE-FILESTAMP) "Name of file to which this document was last PUT." ] (COMS (* ;; "Horizontal Rule") (FILES (SYSLOAD) HRULE READNUMBER) (FNS DOCOBJ-MAKE-HRULE DOCOBJ-EDIT-HRULE DOCOBJ-HRULE-INIT DOCOBJ-HRULE-GET-WIDTH DOCOBJ-HRULE-BUTTONEVENTINFN) (VARS (DOCOBJ-HRULE-RULE-PAD) (DOCOBJ-HRULE-BLANK-PAD)) (ADDVARS (DocObjectsMenuCommands ("Horizontal Rule" (DOCOBJ-MAKE-HRULE) "One or more horizontal rules"))) (P (DOCOBJ-HRULE-INIT))) [COMS (* ;; "INCLUDE") (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS INCLOBJ)) (FNS DOCOBJ-MAKE-INCLUDE DOCOBJ-MAKE-INCLUDE-IMAGEFNS DOCOBJ-INCLUDE-CREATE-OBJ DOCOBJ-INCLUDE-EDIT DOCOBJ-INCLUDE-EDIT-WINDOWP DOCOBJ-INCLUDE-RESET-OBJ) (FNS DOCOBJ-INCLUDE-AFTERHARDCOPYFN DOCOBJ-INCLUDE-BEFOREHARDCOPYFN DOCOBJ-INCLUDE-CLEANUPFN DOCOBJ-INCLUDE-BUTTONEVENTINFN DOCOBJ-INCLUDE-COPYFN DOCOBJ-INCLUDE-DISPLAYFN DOCOBJ-INCLUDE-GETFN DOCOBJ-INCLUDE-IMAGEBOXFN DOCOBJ-INCLUDE-PREPRINTFN DOCOBJ-INCLUDE-PUTFN) (INITVARS (DOCOBJ-INCLUDE-EDITMENU) (DOCOBJ-INCLUDE-IMAGEFNS (DOCOBJ-MAKE-INCLUDE-IMAGEFNS))) (ADDVARS (DocObjectsMenuCommands ("Include" (DOCOBJ-MAKE-INCLUDE) "Include another document right here when hardcopying" ] (DECLARE%: DONTEVAL@LOAD DOCOPY (P (DOCOBJ-INIT))) (DECLARE%: EVAL@LOAD DONTCOPY (COMS (PROP FILETYPE DOC-OBJECTS) (PROP MAKEFILE-ENVIRONMENT DOC-OBJECTS]) (* ;;; "This TEdit subsystem implements an extensible facility originally intended to provide bibliography and citation capabilities. The TEdit function GET.OBJ.FROM.USER, the one triggered by typing ^O, calls the function PROMPTFOREVALED which is redefined by this subsystem to be equivalent to the function DocObj-Acquire-Object. This function inserts IMAGEOBJects into the current TEdit, and is driven by the variables DocObjectsMenu and DocObjectsMenuCommands (analogous to BackgroundMenu and BackgroundMenuCommands). Each menu entry contains a form that, when EVAL'd, creates and returns a particular kind of IMAGEOBJ. Note that this form is EVAL'd under the function DocObj-Acquire-Object, which runs under the function GET.OBJ.FROM.USER, which gets TEXTSTREAM and TEXTOBJ as arguments. They can be (and are) used freely to record state or other desired info. The image objects supplied by this subsystem are 'Eval`d Form' (i.e., the original behavior of ^O), 'Screen Snap' (equivalent to right-buttoning in the background while holding the SHIFT key down), etc." ) (FILESLOAD (SYSLOAD) TEDIT IMAGEOBJ) (RPAQQ DocObjectsMenu NIL) (RPAQQ DocObjectsConfirmEditMenu NIL) (RPAQ? DocObjectsMenuCommands NIL) (RPAQ? DocObjectsMenuFont (FONTCREATE '(MODERN 12 BOLD))) (* ;; "The hook into GET.OBJ.FROM.USER") (DEFINEQ (DOCOBJ-ACQUIRE-OBJECT [LAMBDA NIL (* ; "Edited 15-Oct-87 16:27 by Koomen") (* ;;; "This function is invoked by TEdit's GET.OBJ.FROM.USER (cf. the Library file IMAGEOBJ) after (CHANGENAME (QUOTE GET.OBJ.FROM.USER) (QUOTE PROMPTFOREVALED) (QUOTE DOCOBJ-ACQUIRE-OBJECT))") (* ;;; "When adding more items to the DocObjectsMenuCommands, do (SETQ DocObjectsMenu)") (DECLARE (GLOBALVARS DocObjectsMenu DocObjectsMenuCommands DocObjectsMenuFont)) (if (NOT (type? MENU DocObjectsMenu)) then (SETQ DocObjectsMenu (create MENU TITLE _ "Select object type: " CENTERFLG _ T ITEMS _ DocObjectsMenuCommands MENUFONT _ DocObjectsMenuFont))) (MENU DocObjectsMenu]) (DOCOBJ-INIT [LAMBDA NIL (* ;  "Edited 8-Oct-87 21:32 by Koomen") (* ;;; "This function changes the behavior of standard TEdit such that ^O will invoke the DocObjects system; an entry to invoke the DocObjects system is also added to TEdit's middle button menu.") (DECLARE (GLOBALVARS TEDIT.DEFAULT.MENU)) (CHANGENAME 'GET.OBJ.FROM.USER 'PROMPTFOREVALED ' DOCOBJ-ACQUIRE-OBJECT) (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Object (FUNCTION DOCOBJ-TEDIT-MENU-ENTRY) "Insert a Document Object"]) (DOCOBJ-TEDIT-MENU-ENTRY [LAMBDA (TEXTSTREAM) (* ;  "Edited 8-Oct-87 21:31 by Koomen") (* ;;; "This is the entry point into the DocObjects system from TEdit's middle button menu. GET.OBJ.FROM.USER used to call PROMPTFOREVALED but DocObjects changes this into a call to DOCOBJ-ACQUIRE-OBJECT.") (GET.OBJ.FROM.USER TEXTSTREAM (TEXTOBJ TEXTSTREAM]) (DOCOBJ-GET-LOOKS [LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* Koomen " 4-Feb-87 23:37") (* * Adapted from {ERIS}TEDITLOOKS.;30 dated  "15-Oct-85 16:51:10" to return looks itself, rather  than a proplist.)  (* jds "10-Jul-85 16:02") (* Return a PLIST of  character looks) (PROG ((TEXTOBJ (TEXTOBJ TEXTOBJ)) LOOKS FONT NLOOKS) [COND ((type? CHARLOOKS CH#ORCHARLOOKS) (* He handed us a  CHARLOOKS. Unparse it for  him.) (SETQ LOOKS CH#ORCHARLOOKS)) ((ZEROP (fetch TEXTLEN of TEXTOBJ)) (* There's no text in the document.  Use the extant caret looks.) (SETQ LOOKS (fetch CARETLOOKS of TEXTOBJ))) [(FIXP CH#ORCHARLOOKS) (* He gave us a CH# to geth the looks of.  Grab it.) (SETQ LOOKS (fetch PLOOKS of (\CHTOPC (IMIN (fetch TEXTLEN of TEXTOBJ) CH#ORCHARLOOKS) (fetch PCTB of TEXTOBJ] [(type? SELECTION CH#ORCHARLOOKS) (* Get the looks of the  selected text) (SETQ LOOKS (fetch PLOOKS of (\CHTOPC (IMIN (fetch TEXTLEN of TEXTOBJ) (fetch (SELECTION CH#) of CH#ORCHARLOOKS)) (fetch PCTB of TEXTOBJ] ((NULL CH#ORCHARLOOKS) (* Get the looks of the  selected text) (SETQ LOOKS (fetch PLOOKS of (\CHTOPC (IMIN (fetch TEXTLEN of TEXTOBJ) (fetch (SELECTION CH#) of (fetch SEL of TEXTOBJ))) (fetch PCTB of TEXTOBJ] (RETURN LOOKS) (* * Now break the looks apart into a PROPLIST) (SETQ NLOOKS (\TEDIT.UNPARSE.CHARLOOKS.LIST LOOKS)) (RETURN NLOOKS]) (DOCOBJ-REGISTER-OBJECT [LAMBDA (OBJECT) (* ; "Edited 23-Oct-87 14:48 by Koomen") (* ;; "The following ensures that all DocObjects get a chance to do whatever they want to before and after hardcopying. Each DocObject can associate a BEFOREHARDCOPYFN and/or an AFTERHARDCOPYFN with the ImageObj representing the DocObject") (DECLARE (SPECVARS TEXTOBJ)) (if OBJECT then (TEXTPROP TEXTOBJ 'BEFOREHARDCOPYFN (FUNCTION DOCOBJ-BEFOREHARDCOPYFN)) (TEXTPROP TEXTOBJ 'AFTERHARDCOPYFN (FUNCTION DOCOBJ-AFTERHARDCOPYFN)) OBJECT]) (DOCOBJ-STRING-IMAGEBOX [LAMBDA (STRING IMAGESTREAM) (* Koomen " 9-Feb-87 17:22") (DECLARE (SPECVARS CHNO TEXTOBJ)) (PROG (LOOKS CLOFFSET FONT DEVICE HEIGHT DESCENT) (SETQ LOOKS (DOCOBJ-GET-LOOKS TEXTOBJ CHNO)) (SETQ CLOFFSET (fetch (CHARLOOKS CLOFFSET) of LOOKS)) (SETQ FONT (fetch (CHARLOOKS CLFONT) of LOOKS)) (if (NEQ (FONTPROP FONT 'DEVICE) (SETQ DEVICE (IMAGESTREAMTYPE IMAGESTREAM))) then (SETQ FONT (FONTCOPY FONT 'DEVICE DEVICE))) (SETQ HEIGHT (FONTHEIGHT FONT)) (SETQ DESCENT (FONTPROP FONT 'DESCENT)) (RETURN (create IMAGEBOX XSIZE _ (STRINGWIDTH STRING FONT) YSIZE _ (IPLUS HEIGHT (IABS CLOFFSET)) YDESC _ (IDIFFERENCE DESCENT CLOFFSET) XKERN _ 0]) (DOCOBJ-WAIT-MOUSE [LAMBDA (STREAM) (* ;  "Edited 8-Oct-87 23:46 by Koomen") (while (NOT (MOUSESTATE UP)) bind (REGION _ (DSPCLIPPINGREGION NIL STREAM)) do (if (NOT (INSIDEP REGION (LASTMOUSEX STREAM) (LASTMOUSEY STREAM))) then (RETURN NIL)) finally (RETURN T]) (DOCOBJ-INVOKE-IMAGEOBJFN [LAMBDA (CH# PIECE PC# IMAGEOBJFNNAME) (* ; "Edited 15-Oct-87 23:35 by Koomen") (* ;; "If PIECE is an IMAGEOBJ, invoke the function associated with the ImageObj property IMAGEOBJFNNAME on the IMAGEOBJ and the character position where the IMAGEOBJ is located. ") (PROG (IMAGEOBJ IMAGEOBJFN) (if (NOT (type? PIECE PIECE)) then (RETURN)) (SETQ IMAGEOBJ (fetch POBJ of PIECE)) (if (NOT (IMAGEOBJP IMAGEOBJ)) then (RETURN)) (SETQ IMAGEOBJFN (IMAGEOBJPROP IMAGEOBJ IMAGEOBJFNNAME)) (if (AND IMAGEOBJFN (DEFINEDP IMAGEOBJFN)) then (APPLY* IMAGEOBJFN IMAGEOBJ CH# PIECE PC#]) (DOCOBJ-BEFOREHARDCOPYFN [LAMBDA (TEXTSTREAM TEXTOBJ) (* ;  "Edited 25-May-93 13:07 by sybalsky:mv:envos") (* ;; "Bug in TEDIT.FORMAT.HARDCOPY!!! This function is called with the arguments TEXTSTREAM and TEXTOBJ, but TEXTSTREAM is undefined!") (* ;; "*DOCOBJ-FORMS* is used to enable insertion and deletion of pieces. DocObjects can postpone insertion or deletion by added appropriate forms to *DOCOBJ-FORMS*. Can't do it while under TEDIT.MAPPIECES as the pointers get screwed up. ") (DECLARE (SPECVARS *DOCOBJ-FORMS*)) (LET ((TEXTSTREAM (TEXTSTREAM TEXTOBJ)) (*DOCOBJ-FORMS*)) (TEXTPROP TEXTSTREAM 'DOCOBJ-VIRGINP (NOT (TEDIT.STREAMCHANGEDP TEXTSTREAM))) (* ;; "After hardcopy, TEXTSTREAM is reset if this flag is T") (do (SETQ *DOCOBJ-FORMS*) (TEDIT.MAPPIECES TEXTOBJ (FUNCTION DOCOBJ-INVOKE-IMAGEOBJFN) 'BEFOREHARDCOPYFN) [WITHOUT-UPDATES TEXTOBJ (FETCH (TEXTOBJ SCRATCHSEL) OF TEXTOBJ) (for FRM in *DOCOBJ-FORMS* do (APPLY (CAR FRM) (CDR FRM] repeatwhile *DOCOBJ-FORMS*]) (DOCOBJ-AFTERHARDCOPYFN [LAMBDA (TEXTSTREAM TEXTOBJ) (* ;  "Edited 25-May-93 13:08 by sybalsky:mv:envos") (* ;; "Bug in TEDIT.FORMAT.HARDCOPY!!! This function is called with the arguments TEXTSTREAM and TEXTOBJ, but TEXTSTREAM is undefined, and TEXTOBJ is NIL!") (DECLARE (SPECVARS *DOCOBJ-FORMS*)) (LET ((*DOCOBJ-FORMS*)) (do (SETQ *DOCOBJ-FORMS*) (TEDIT.MAPPIECES TEXTOBJ (FUNCTION DOCOBJ-INVOKE-IMAGEOBJFN) 'AFTERHARDCOPYFN) [WITHOUT-UPDATES TEXTOBJ (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ) (for FRM in *DOCOBJ-FORMS* do (APPLY (CAR FRM) (CDR FRM] repeatwhile *DOCOBJ-FORMS*) (COND ((TEXTPROP TEXTSTREAM 'DOCOBJ-VIRGINP) (TEDIT.STREAMCHANGEDP TEXTSTREAM T]) ) (* ;; "Eval'd Form") (DEFINEQ (DOCOBJ-ACQUIRE-EVALED-OBJECT [LAMBDA NIL (* Koomen "30-Sep-86 02:08") (* * This is the original function called under  GET.OBJ.FROM.USER * *) (PROMPTFOREVALED "Form to eval: "]) ) (ADDTOVAR DocObjectsMenuCommands ("Eval'd Form" (DOCOBJ-ACQUIRE-EVALED-OBJECT) "Insert the value of a form to be typed in")) (* ;; "Screen Snap") (DEFINEQ (DOCOBJ-ACQUIRE-SNAPPED-OBJECT [LAMBDA NIL (* Koomen "26-Sep-86 16:55") (GETREGION]) ) (ADDTOVAR DocObjectsMenuCommands ("Screen Snap" (DOCOBJ-ACQUIRE-SNAPPED-OBJECT) "Insert a snap from the screen")) (* ;; "Time Stamp") (DECLARE%: DONTCOPY (DECLARE%: EVAL@COMPILE (RECORD DOCOBJ-TIMESTAMP (IDATE DATESTR FORMAT)) ) ) (FILESLOAD (SYSLOAD) DATEFORMAT-EDITOR) (DEFINEQ (DOCOBJ-EDIT-TIMESTAMP [LAMBDA (TIMESTAMP) (* Koomen " 4-Feb-87 14:08") (PROG [(FORMAT (EDIT-DATEFORMAT (fetch (DOCOBJ-TIMESTAMP FORMAT) of TIMESTAMP] (if FORMAT then (replace (DOCOBJ-TIMESTAMP FORMAT) of TIMESTAMP with FORMAT) (replace (DOCOBJ-TIMESTAMP DATESTR) of TIMESTAMP with NIL) (RETURN TIMESTAMP]) (DOCOBJ-MAKE-TIMESTAMP [LAMBDA NIL (* Koomen " 4-Feb-87 13:54") (DECLARE (GLOBALVARS DOCOBJ-TIMESTAMP-IMAGEFNS DocObjectsTimeStampFormat)) (IMAGEOBJCREATE (create DOCOBJ-TIMESTAMP IDATE _ (IDATE) FORMAT _ DocObjectsTimeStampFormat) DOCOBJ-TIMESTAMP-IMAGEFNS]) (DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS [LAMBDA NIL (* ;  "Edited 8-Oct-87 22:53 by Koomen") (LET ((DISPLAYFN (FUNCTION DOCOBJ-TIMESTAMP-DISPLAYFN)) (IMAGEBOXFN (FUNCTION DOCOBJ-TIMESTAMP-IMAGEBOXFN)) (PUTFN (FUNCTION DOCOBJ-TIMESTAMP-PUTFN)) (GETFN (FUNCTION DOCOBJ-TIMESTAMP-GETFN)) (COPYFN (FUNCTION DOCOBJ-TIMESTAMP-COPYFN)) (BUTTONEVENTINFN (FUNCTION DOCOBJ-TIMESTAMP-BUTTONEVENTINFN)) (COPYBUTTONEVENTINFN (FUNCTION NILL)) (WHENMOVEDFN (FUNCTION NILL)) (WHENINSERTEDFN (FUNCTION NILL)) (WHENDELETEDFN (FUNCTION NILL)) (WHENCOPIEDFN (FUNCTION NILL)) (WHENOPERATEDONFN (FUNCTION NILL)) (PREPRINTFN (FUNCTION DOCOBJ-TIMESTAMP-PREPRINTFN))) (IMAGEFNSCREATE DISPLAYFN IMAGEBOXFN PUTFN GETFN COPYFN BUTTONEVENTINFN COPYBUTTONEVENTINFN WHENMOVEDFN WHENINSERTEDFN WHENDELETEDFN WHENCOPIEDFN WHENOPERATEDONFN PREPRINTFN]) (DOCOBJ-TIMESTAMP-BUTTONEVENTINFN [LAMBDA (IMAGEOBJ WINDOWSTREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON) (* ;  "Edited 8-Oct-87 23:43 by Koomen") (if (AND (EQ BUTTON 'MIDDLE) (DOCOBJ-WAIT-MOUSE WINDOWSTREAM)) then (ALLOW.BUTTON.EVENTS) (if (DOCOBJ-EDIT-TIMESTAMP (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM)) then 'CHANGED]) (DOCOBJ-TIMESTAMP-COPYFN [LAMBDA (IMAGEOBJ SOURCEHOSTSTREAM TARGETHOSTSTREAM) (* Koomen "31-Jan-87 00:30") (DECLARE (GLOBALVARS DOCOBJ-TIMESTAMP-IMAGEFNS)) (IMAGEOBJCREATE (COPYALL (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM)) DOCOBJ-TIMESTAMP-IMAGEFNS]) (DOCOBJ-TIMESTAMP-DISPLAYFN [LAMBDA (IMAGEOBJ IMAGESTREAM IMAGESTREAMTYPE HOSTSTREAM) (* Koomen " 4-Feb-87 14:11") (PRINTOUT IMAGESTREAM (DOCOBJ-TIMESTAMP-TO-STRING (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM]) (DOCOBJ-TIMESTAMP-GETFN [LAMBDA (FILESTREAM) (* Koomen "31-Jan-87 00:19") (DECLARE (GLOBALVARS DOCOBJ-TIMESTAMP-IMAGEFNS)) (IMAGEOBJCREATE (READ FILESTREAM) DOCOBJ-TIMESTAMP-IMAGEFNS]) (DOCOBJ-TIMESTAMP-IMAGEBOXFN [LAMBDA (IMAGEOBJ IMAGESTREAM CURRENTX RIGHTMARGIN) (* Koomen " 9-Feb-87 17:13") (LET* ((TIMESTAMP (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM)) (TIMESTRING (DOCOBJ-TIMESTAMP-TO-STRING TIMESTAMP))) (DOCOBJ-STRING-IMAGEBOX TIMESTRING IMAGESTREAM]) (DOCOBJ-TIMESTAMP-PREPRINTFN [LAMBDA (IMAGEOBJ) (* ;  "Edited 8-Oct-87 22:29 by Koomen") (DOCOBJ-TIMESTAMP-TO-STRING (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM]) (DOCOBJ-TIMESTAMP-PUTFN [LAMBDA (IMAGEOBJ FILESTREAM) (* Koomen " 4-Feb-87 14:08") (PROG [(TIMESTAMP (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM] (replace (DOCOBJ-TIMESTAMP IDATE) of TIMESTAMP with (IDATE)) (replace (DOCOBJ-TIMESTAMP DATESTR) of TIMESTAMP with NIL) (PRINT TIMESTAMP FILESTREAM]) (DOCOBJ-TIMESTAMP-TO-STRING [LAMBDA (TIMESTAMP) (* Koomen " 4-Feb-87 14:12") (OR (STRINGP (fetch (DOCOBJ-TIMESTAMP DATESTR) of TIMESTAMP)) (replace (DOCOBJ-TIMESTAMP DATESTR) of TIMESTAMP with (GDATE (fetch (DOCOBJ-TIMESTAMP IDATE) of TIMESTAMP) (fetch (DOCOBJ-TIMESTAMP FORMAT) of TIMESTAMP]) ) (RPAQ? DocObjectsTimeStampFormat ) (RPAQ? DOCOBJ-TIMESTAMP-IMAGEFNS (DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS)) (ADDTOVAR DocObjectsMenuCommands ("Time Stamp" (DOCOBJ-MAKE-TIMESTAMP) "Date & time this document is PUT")) (* ;; "File Stamp") (DEFINEQ (DOCOBJ-MAKE-FILESTAMP [LAMBDA NIL (* ;  "Edited 8-Oct-87 22:55 by Koomen") (DECLARE (SPECVARS TEXTOBJ) (GLOBALVARS DOCOBJ-FILESTAMP-IMAGEFNS)) (IMAGEOBJCREATE (DOCOBJ-FILESTAMP-NEW-FULLNAME TEXTOBJ) DOCOBJ-FILESTAMP-IMAGEFNS]) (DOCOBJ-MAKE-FILESTAMP-IMAGEFNS [LAMBDA NIL (* ;  "Edited 8-Oct-87 22:54 by Koomen") (LET ((DISPLAYFN (FUNCTION DOCOBJ-FILESTAMP-DISPLAYFN)) (IMAGEBOXFN (FUNCTION DOCOBJ-FILESTAMP-IMAGEBOXFN)) (PUTFN (FUNCTION DOCOBJ-FILESTAMP-PUTFN)) (GETFN (FUNCTION DOCOBJ-FILESTAMP-GETFN)) (COPYFN (FUNCTION DOCOBJ-FILESTAMP-COPYFN)) (BUTTONEVENTINFN (FUNCTION NILL)) (COPYBUTTONEVENTINFN (FUNCTION NILL)) (WHENMOVEDFN (FUNCTION NILL)) (WHENINSERTEDFN (FUNCTION NILL)) (WHENDELETEDFN (FUNCTION NILL)) (WHENCOPIEDFN (FUNCTION NILL)) (WHENOPERATEDONFN (FUNCTION NILL)) (PREPRINTFN (FUNCTION DOCOBJ-FILESTAMP-PREPRINTFN))) (IMAGEFNSCREATE DISPLAYFN IMAGEBOXFN PUTFN GETFN COPYFN BUTTONEVENTINFN COPYBUTTONEVENTINFN WHENMOVEDFN WHENINSERTEDFN WHENDELETEDFN WHENCOPIEDFN WHENOPERATEDONFN PREPRINTFN]) (DOCOBJ-FILESTAMP-COPYFN [LAMBDA (IMAGEOBJ SOURCEHOSTSTREAM TARGETHOSTSTREAM) (* Koomen "31-Jan-87 04:10") (DECLARE (GLOBALVARS DOCOBJ-FILESTAMP-IMAGEFNS)) (IMAGEOBJCREATE (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM) DOCOBJ-FILESTAMP-IMAGEFNS]) (DOCOBJ-FILESTAMP-DISPLAYFN [LAMBDA (IMAGEOBJ IMAGESTREAM IMAGESTREAMTYPE HOSTSTREAM) (* ;  "Edited 8-Oct-87 22:56 by Koomen") (PRINTOUT IMAGESTREAM (DOCOBJ-FILESTAMP-GET-FULLNAME IMAGEOBJ]) (DOCOBJ-FILESTAMP-GETFN [LAMBDA (FILESTREAM) (* ;  "Edited 8-Oct-87 22:58 by Koomen") (DECLARE (GLOBALVARS DOCOBJ-FILESTAMP-IMAGEFNS)) (LET ((FULLNAME (READ FILESTREAM))) (IMAGEOBJCREATE (AND FULLNAME (MKSTRING FULLNAME)) DOCOBJ-FILESTAMP-IMAGEFNS]) (DOCOBJ-FILESTAMP-IMAGEBOXFN [LAMBDA (IMAGEOBJ IMAGESTREAM CURRENTX RIGHTMARGIN) (* ;  "Edited 8-Oct-87 22:59 by Koomen") (LET ((FULLNAME (DOCOBJ-FILESTAMP-GET-FULLNAME IMAGEOBJ))) (DOCOBJ-STRING-IMAGEBOX FULLNAME IMAGESTREAM]) (DOCOBJ-FILESTAMP-GET-FULLNAME [LAMBDA (IMAGEOBJ NODEFAULTFLG) (* ;  "Edited 8-Oct-87 22:59 by Koomen") (PROG [(FULLNAME (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM] (RETURN (OR (if FULLNAME then (if (LITATOM FULLNAME) then (MKSTRING FULLNAME) elseif (STRINGP FULLNAME) then (COPYALL FULLNAME))) (if (NOT NODEFAULTFLG) then "-- not yet filed --"]) (DOCOBJ-FILESTAMP-NEW-FULLNAME [LAMBDA (TEXTOBJ) (* ;  "Edited 8-Oct-87 22:52 by Koomen") (PROG ((FULLNAME (FULLNAME TEXTOBJ))) (RETURN (if FULLNAME then (if (LITATOM FULLNAME) then (MKSTRING FULLNAME) elseif (STRINGP FULLNAME) then (COPYALL FULLNAME]) (DOCOBJ-FILESTAMP-PREPRINTFN [LAMBDA (IMAGEOBJ) (* ;  "Edited 8-Oct-87 22:56 by Koomen") (DOCOBJ-FILESTAMP-GET-FULLNAME IMAGEOBJ T]) (DOCOBJ-FILESTAMP-PUTFN [LAMBDA (IMAGEOBJ FILESTREAM) (* ;  "Edited 8-Oct-87 22:39 by Koomen") (PROG [(FULLNAME (MKSTRING (FULLNAME FILESTREAM] (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM FULLNAME) (PRINT FULLNAME FILESTREAM]) ) (RPAQ? DOCOBJ-FILESTAMP-IMAGEFNS (DOCOBJ-MAKE-FILESTAMP-IMAGEFNS)) (ADDTOVAR DocObjectsMenuCommands ("File Stamp" (DOCOBJ-MAKE-FILESTAMP) "Name of file to which this document was last PUT.")) (* ;; "Horizontal Rule") (FILESLOAD (SYSLOAD) HRULE READNUMBER) (DEFINEQ (DOCOBJ-MAKE-HRULE [LAMBDA NIL (* Koomen " 4-Feb-87 16:12") (HRULE.CREATE (bind WIDTH for I from 1 while (AND (SETQ WIDTH (DOCOBJ-HRULE-GET-WIDTH (ODDP I) (EQ I 1))) (GREATERP WIDTH 0)) collect WIDTH]) (DOCOBJ-EDIT-HRULE [LAMBDA (IMAGEOBJ) (* Koomen " 4-Feb-87 15:45") (PROG [NEWWIDTH (OLDWIDTH (MKLIST (IMAGEOBJPROP IMAGEOBJ 'RULE.WIDTH] (SETQ NEWWIDTH (COPYALL OLDWIDTH)) (if (AND (NLSETQ (EDITE NEWWIDTH)) (NOT (EQUAL NEWWIDTH OLDWIDTH))) then (IMAGEOBJPROP IMAGEOBJ 'RULE.WIDTH NEWWIDTH) (RETURN IMAGEOBJ]) (DOCOBJ-HRULE-INIT [LAMBDA NIL (* Koomen " 4-Feb-87 16:13") (* * provide HRULE editing * *) (DECLARE (GLOBALVARS HRULE.IMAGEFNS)) (replace (IMAGEFNS BUTTONEVENTINFN) of HRULE.IMAGEFNS with (FUNCTION DOCOBJ-HRULE-BUTTONEVENTINFN)) NIL]) (DOCOBJ-HRULE-GET-WIDTH [LAMBDA (RULE? FIRST?) (* ;  "Edited 24-May-93 23:35 by sybalsky:mv:envos") (DECLARE (GLOBALVARS DOCOBJ-HRULE-BLANK-PAD DOCOBJ-HRULE-RULE-PAD LASTMOUSEX LASTMOUSEY)) [COND ((NULL DOCOBJ-HRULE-RULE-PAD) (SETQ DOCOBJ-HRULE-RULE-PAD (CREATE.NUMBERPAD.READER "Rule width: " NIL NIL NIL T T)) (SETQ DOCOBJ-HRULE-BLANK-PAD (CREATE.NUMBERPAD.READER "Blank space: " NIL NIL NIL T T] (COND (FIRST? (MOVEW DOCOBJ-HRULE-RULE-PAD LASTMOUSEX LASTMOUSEY) (MOVEW DOCOBJ-HRULE-BLANK-PAD LASTMOUSEX LASTMOUSEY))) (NUMBERPAD.READ (COND (RULE? DOCOBJ-HRULE-RULE-PAD) (T DOCOBJ-HRULE-BLANK-PAD)) T]) (DOCOBJ-HRULE-BUTTONEVENTINFN [LAMBDA (IMAGEOBJ WINDOWSTREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON) (* ;  "Edited 8-Oct-87 23:43 by Koomen") (if (AND (EQ BUTTON 'MIDDLE) (DOCOBJ-WAIT-MOUSE WINDOWSTREAM)) then (ALLOW.BUTTON.EVENTS) (if (DOCOBJ-EDIT-HRULE IMAGEOBJ) then 'CHANGED]) ) (RPAQQ DOCOBJ-HRULE-RULE-PAD NIL) (RPAQQ DOCOBJ-HRULE-BLANK-PAD NIL) (ADDTOVAR DocObjectsMenuCommands ("Horizontal Rule" (DOCOBJ-MAKE-HRULE) "One or more horizontal rules")) (DOCOBJ-HRULE-INIT) (* ;; "INCLUDE") (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE (RECORD INCLOBJ (FILENAME ENABLEDP)) ) ) (DEFINEQ (DOCOBJ-MAKE-INCLUDE [LAMBDA NIL (* ; "Edited 15-Oct-87 14:54 by Koomen") (DECLARE (SPECVARS TEXTOBJ)) (PROG ((SUBFILE (TEDIT.GETINPUT TEXTOBJ "Enter file name: "))) (if SUBFILE then (RETURN (DOCOBJ-INCLUDE-CREATE-OBJ SUBFILE)) else (TEDIT.PROMPTPRINT TEXTOBJ "... aborted."]) (DOCOBJ-MAKE-INCLUDE-IMAGEFNS [LAMBDA NIL (* ; "Edited 23-Oct-87 00:20 by Koomen") (LET ((DISPLAYFN (FUNCTION DOCOBJ-INCLUDE-DISPLAYFN)) (IMAGEBOXFN (FUNCTION DOCOBJ-INCLUDE-IMAGEBOXFN)) (PUTFN (FUNCTION DOCOBJ-INCLUDE-PUTFN)) (GETFN (FUNCTION DOCOBJ-INCLUDE-GETFN)) (COPYFN (FUNCTION DOCOBJ-INCLUDE-COPYFN)) (BUTTONEVENTINFN (FUNCTION DOCOBJ-INCLUDE-BUTTONEVENTINFN)) (COPYBUTTONEVENTINFN (FUNCTION NILL)) (WHENMOVEDFN (FUNCTION NILL)) (WHENINSERTEDFN (FUNCTION NILL)) (WHENDELETEDFN (FUNCTION NILL)) (WHENCOPIEDFN (FUNCTION NILL)) (WHENOPERATEDONFN (FUNCTION NILL)) (PREPRINTFN (FUNCTION DOCOBJ-INCLUDE-PREPRINTFN))) (IMAGEFNSCREATE DISPLAYFN IMAGEBOXFN PUTFN GETFN COPYFN BUTTONEVENTINFN COPYBUTTONEVENTINFN WHENMOVEDFN WHENINSERTEDFN WHENDELETEDFN WHENCOPIEDFN WHENOPERATEDONFN PREPRINTFN]) (DOCOBJ-INCLUDE-CREATE-OBJ [LAMBDA (INCLOBJ) (* ; "Edited 23-Oct-87 14:06 by Koomen") (DECLARE (GLOBALVARS DOCOBJ-INCLUDE-IMAGEFNS)) (PROG (IMAGEOBJ) [if INCLOBJ then (if (NLISTP INCLOBJ) then (* ;; "Just a file name") (SETQ INCLOBJ (create INCLOBJ FILENAME _ (MKSTRING INCLOBJ) ENABLEDP _ T] (SETQ IMAGEOBJ (IMAGEOBJCREATE INCLOBJ DOCOBJ-INCLUDE-IMAGEFNS)) (DOCOBJ-INCLUDE-RESET-OBJ IMAGEOBJ) (DOCOBJ-REGISTER-OBJECT IMAGEOBJ) (RETURN IMAGEOBJ]) (DOCOBJ-INCLUDE-EDIT [LAMBDA (INCLOBJ) (* ; "Edited 9-May-2018 11:09 by rmk:") (* ; "Edited 9-May-2018 10:35 by rmk:") (* ;  "Edited 26-Oct-87 19:57 by Koomen") (DECLARE (SPECVARS TEXTOBJ)) (SELECTQ [MENU (OR DOCOBJ-INCLUDE-EDITMENU (SETQ DOCOBJ-INCLUDE-EDITMENU (create MENU TITLE _ "Edit Include" ITEMS _ '(("New File" 'NEW.FILE "Include a different file") ("Edit File" 'EDIT.FILE "Edit the included file") ("Enable" 'ENABLE "Include the file during hardcopy" ) ("Disable" 'DISABLE "Do not include the file during hardcopy" )) CENTERFLG _ T MENUOFFSET _ '(-1 . 30) CHANGEOFFSETFLG _ 'Y] (NEW.FILE (LET [(NEWNAME (TEDIT.GETINPUT TEXTOBJ "Enter new file name: " (fetch (INCLOBJ FILENAME) of INCLOBJ] (if [AND NEWNAME (SETQ NEWNAME (MKSTRING NEWNAME)) (NOT (EQUAL NEWNAME (fetch (INCLOBJ FILENAME) of INCLOBJ] then (replace (INCLOBJ FILENAME) of INCLOBJ with NEWNAME) T))) (EDIT.FILE (for W in (OPENWINDOWS) bind [FULLNAME _ (OR [FINDFILE (fetch (INCLOBJ FILENAME) of INCLOBJ ) T (CONS (PACKFILENAME.STRING 'HOST (FILENAMEFIELD (FETCH TXTFILE OF TEXTOBJ) 'HOST) 'DIRECTORY (FILENAMEFIELD (FETCH TXTFILE OF TEXTOBJ) 'DIRECTORY] (INFILEP (fetch (INCLOBJ FILENAME) of INCLOBJ] first (if (NULL FULLNAME) then (TEDIT.PROMPTPRINT TEXTOBJ "Can't find " T) (TEDIT.PROMPTPRINT TEXTOBJ (fetch (INCLOBJ FILENAME) of INCLOBJ)) (RETURN)) when (SETQ W (DOCOBJ-INCLUDE-EDIT-WINDOWP FULLNAME W)) do (TOTOPW W) (GIVE.TTY.PROCESS W) (RETURN) finally (TEDIT (MKATOM FULLNAME)))) (ENABLE (if (NOT (fetch (INCLOBJ ENABLEDP) of INCLOBJ)) then (replace (INCLOBJ ENABLEDP) of INCLOBJ with T) T)) (DISABLE (if (fetch (INCLOBJ ENABLEDP) of INCLOBJ) then (replace (INCLOBJ ENABLEDP) of INCLOBJ with NIL) T)) NIL]) (DOCOBJ-INCLUDE-EDIT-WINDOWP [LAMBDA (FILENAME WINDOW) (* ; "Edited 26-Oct-87 19:53 by Koomen") (if (WINDOWP WINDOW) then (OR (LET (TEXTOBJ TXTFILE) (if (AND (SETQ TEXTOBJ (WINDOWPROP WINDOW 'TEXTOBJ)) (type? TEXTOBJ TEXTOBJ) (SETQ TXTFILE (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) (STREAMP TXTFILE) (SETQ TXTFILE (FULLNAME TXTFILE)) (OR (STRINGP TXTFILE) (LITATOM TXTFILE)) (STRING-EQUAL FILENAME TXTFILE)) then WINDOW)) (DOCOBJ-INCLUDE-EDIT-WINDOWP FILENAME (WINDOWPROP WINDOW 'ICONFOR]) (DOCOBJ-INCLUDE-RESET-OBJ [LAMBDA (IMAGEOBJ) (* ; "Edited 23-Oct-87 14:09 by Koomen") (DECLARE (GLOBALVARS DOCOBJ-INCLUDE-IMAGEFNS)) (PROG (INCLOBJ FNAME) (if (SETQ INCLOBJ (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM)) then (SETQ FNAME (fetch (INCLOBJ FILENAME) of INCLOBJ)) (IMAGEOBJPROP IMAGEOBJ 'INCLDISPLAYSTRING (CONCAT "@Include[" FNAME "]")) (IMAGEOBJPROP IMAGEOBJ 'DONTINCLDISPLAYSTRING (CONCAT "@DoNotInclude[" FNAME "]")) ) (IMAGEOBJPROP IMAGEOBJ 'BEFOREHARDCOPYFN (FUNCTION DOCOBJ-INCLUDE-BEFOREHARDCOPYFN)) (IMAGEOBJPROP IMAGEOBJ 'AFTERHARDCOPYFN (FUNCTION DOCOBJ-INCLUDE-AFTERHARDCOPYFN]) ) (DEFINEQ (DOCOBJ-INCLUDE-AFTERHARDCOPYFN [LAMBDA (IMAGEOBJ CH#) (* ;  "Edited 3-Jun-93 12:42 by sybalsky:mv:envos") (DECLARE (SPECVARS TEXTSTREAM)) (COND ((IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM) (* ;; "Just record current position, let endmarker do the rest") (IMAGEOBJPROP IMAGEOBJ 'INCLSTARTPOS (ADD1 CH#))) (T (* ;; "Hit an end marker") (PROG (HEADOBJ STARTPOS) (SETQ HEADOBJ (IMAGEOBJPROP IMAGEOBJ 'INCLIMAGEOBJ)) (SETQ STARTPOS (IMAGEOBJPROP HEADOBJ 'INCLSTARTPOS)) (IMAGEOBJPROP HEADOBJ 'INCLUDEDP NIL) (push *DOCOBJ-FORMS* `(DOCOBJ-INCLUDE-CLEANUPFN ,TEXTSTREAM ,STARTPOS ,(ADD1 (IDIFFERENCE CH# STARTPOS]) (DOCOBJ-INCLUDE-BEFOREHARDCOPYFN [LAMBDA (IMAGEOBJ CH#) (* ; "Edited 9-May-2018 11:08 by rmk:") (* ; "Edited 9-May-2018 09:50 by rmk:") (* ; "Edited 9-May-2018 09:20 by rmk:") (* ;  "Edited 1-Jun-93 10:56 by sybalsky:mv:envos") (DECLARE (SPECVARS *DOCOBJ-FORMS* TEXTOBJ)) (* ;; "RMK: Changed to default to file in same directory as the including file. ") (LET [(INCLOBJ (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM] (COND ([AND INCLOBJ (fetch (INCLOBJ ENABLEDP) of INCLOBJ) (NOT (IMAGEOBJPROP IMAGEOBJ 'INCLUDEDP] (* ;; "We're under MAP.PIECES -- dangerous to insert here, so postpone") (push *DOCOBJ-FORMS* (LIST [FUNCTION (LAMBDA (STARTPOS INCLFILE IMAGEOBJ ENDOBJ WINDOWS) (DECLARE (SPECVARS TEXTSTREAM)) (COND (WINDOWS (TEDIT.PROMPTPRINT TEXTSTREAM "Including " T) (TEDIT.PROMPTPRINT TEXTSTREAM INCLFILE) (TEDIT.PROMPTPRINT TEXTSTREAM "...")) (T (PROMPTPRINT "[TEdit hardcopy: including " INCLFILE "...]"))) (WITHOUT-UPDATES (TEXTOBJ TEXTSTREAM) (fetch (TEXTOBJ SCRATCHSEL) of (TEXTOBJ TEXTSTREAM)) (TEDIT.SETSEL TEXTSTREAM STARTPOS 0 'RIGHT) (* ;; "Force paragraph boundary, so that the first paragraph of the included document doesn't inherit the paralooks of the paragraph containing the @Include.") (TEDIT.INSERT TEXTSTREAM " ") (TEDIT.PARALOOKS TEXTSTREAM '(NEWPAGEAFTER NIL NEWPAGEBEFORE NIL LINELEADING 0 POSTPARALEADING 0 PARALEADING 0)) (* ;;  "For space efficiency, tell TEdit to assume that the file will exist as long as we need it.") (TEDIT.INCLUDE TEXTSTREAM (OR [FINDFILE INCLFILE T (CONS (PACKFILENAME.STRING 'HOST (FILENAMEFIELD (FETCH TXTFILE OF (TEXTOBJ TEXTSTREAM )) 'HOST) 'DIRECTORY (FILENAMEFIELD (FETCH TXTFILE OF (TEXTOBJ TEXTSTREAM )) 'DIRECTORY] INCLFILE) NIL NIL T) (TEDIT.INSERT.OBJECT ENDOBJ TEXTSTREAM) (IMAGEOBJPROP ENDOBJ 'INCLIMAGEOBJ IMAGEOBJ) (IMAGEOBJPROP IMAGEOBJ 'INCLUDEDP T)) (COND (WINDOWS (TEDIT.PROMPTPRINT TEXTSTREAM " done.")) (T (PROMPTPRINT "[TEdit hardcopy: including " INCLFILE "... done.]"] (ADD1 CH#) (fetch (INCLOBJ FILENAME) of INCLOBJ) IMAGEOBJ (DOCOBJ-INCLUDE-CREATE-OBJ) (fetch (TEXTOBJ \WINDOW) of TEXTOBJ]) (DOCOBJ-INCLUDE-CLEANUPFN [LAMBDA (TEXTSTREAM STARTPOS LEN) (* ;  "Edited 3-Jun-93 12:43 by sybalsky:mv:envos") (* ;; "Do the cleanup of removing an included file's pieces (and closing it) after hardcopying with inclusions.") (LET* ((SEL (TEDIT.SETSEL TEXTSTREAM STARTPOS LEN)) (PCS (TEDIT.SELECTED.PIECES (TEXTOBJ TEXTSTREAM) SEL))) (for PC in PCS when (AND (fetch (PIECE PFILE) of PC) (OPENP (fetch (PIECE PFILE) of PC))) do (CLOSEF (fetch (PIECE PFILE) of PC))) (TEDIT.DELETE TEXTSTREAM STARTPOS LEN) (BLOCK]) (DOCOBJ-INCLUDE-BUTTONEVENTINFN [LAMBDA (IMAGEOBJ WINDOWSTREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON) (* ; "Edited 23-Oct-87 00:46 by Koomen") (if (AND (EQ BUTTON 'MIDDLE) (DOCOBJ-WAIT-MOUSE WINDOWSTREAM)) then (ALLOW.BUTTON.EVENTS) (if (DOCOBJ-INCLUDE-EDIT (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM)) then (DOCOBJ-INCLUDE-RESET-OBJ IMAGEOBJ) 'CHANGED]) (DOCOBJ-INCLUDE-COPYFN [LAMBDA (IMAGEOBJ SOURCEHOSTSTREAM TARGETHOSTSTREAM) (* ; "Edited 23-Oct-87 00:13 by Koomen") (DOCOBJ-INCLUDE-CREATE-OBJ (COPYALL (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM]) (DOCOBJ-INCLUDE-DISPLAYFN [LAMBDA (IMAGEOBJ IMAGESTREAM IMAGESTREAMTYPE HOSTSTREAM) (* ; "Edited 23-Oct-87 14:42 by Koomen") (PROG [(INCLOBJ (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM] (if [AND INCLOBJ (OR (EQ IMAGESTREAMTYPE 'DISPLAY) (NOT (fetch (INCLOBJ ENABLEDP) of INCLOBJ] then (printout IMAGESTREAM (IMAGEOBJPROP IMAGEOBJ (if (fetch (INCLOBJ ENABLEDP) of INCLOBJ) then 'INCLDISPLAYSTRING else 'DONTINCLDISPLAYSTRING]) (DOCOBJ-INCLUDE-GETFN [LAMBDA (FILESTREAM) (* ; "Edited 26-Oct-87 22:00 by Koomen") (LET ((INCLOBJ (READ FILESTREAM))) (if (NLISTP INCLOBJ) then (* ;; "Version 1: Just filename as string") (* ;; "Version 2: List whose CAR is filename") (SETQ INCLOBJ (create INCLOBJ FILENAME _ INCLOBJ))) (if (NLISTP (CDR INCLOBJ)) then (* ;; "Version 3: List whose CADR is ENABLEDP flag") (NCONC1 INCLOBJ T)) (DOCOBJ-INCLUDE-CREATE-OBJ INCLOBJ]) (DOCOBJ-INCLUDE-IMAGEBOXFN [LAMBDA (IMAGEOBJ IMAGESTREAM CURRENTX RIGHTMARGIN) (* ; "Edited 23-Oct-87 14:41 by Koomen") (OR (LET [(INCLOBJ (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM] (if [AND INCLOBJ (OR (EQ (IMAGESTREAMTYPE IMAGESTREAM) 'DISPLAY) (NOT (fetch (INCLOBJ ENABLEDP) of INCLOBJ] then (DOCOBJ-STRING-IMAGEBOX (IMAGEOBJPROP IMAGEOBJ (if (fetch (INCLOBJ ENABLEDP) of INCLOBJ) then 'INCLDISPLAYSTRING else 'DONTINCLDISPLAYSTRING)) IMAGESTREAM))) (create IMAGEBOX XSIZE _ 0 YSIZE _ 0 YDESC _ 0 XKERN _ 0]) (DOCOBJ-INCLUDE-PREPRINTFN [LAMBDA (IMAGEOBJ) (* ; "Edited 23-Oct-87 14:19 by Koomen") (fetch (INCLOBJ FILENAME) of (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM]) (DOCOBJ-INCLUDE-PUTFN [LAMBDA (IMAGEOBJ FILESTREAM) (* ; "Edited 15-Oct-87 17:17 by Koomen") (PRINT (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM) FILESTREAM]) ) (RPAQ? DOCOBJ-INCLUDE-EDITMENU ) (RPAQ? DOCOBJ-INCLUDE-IMAGEFNS (DOCOBJ-MAKE-INCLUDE-IMAGEFNS)) (ADDTOVAR DocObjectsMenuCommands ("Include" (DOCOBJ-MAKE-INCLUDE) "Include another document right here when hardcopying")) (DECLARE%: DONTEVAL@LOAD DOCOPY (DOCOBJ-INIT) ) (DECLARE%: EVAL@LOAD DONTCOPY (PUTPROPS DOC-OBJECTS FILETYPE :TCOMPL) (PUTPROPS DOC-OBJECTS MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10)) ) (PUTPROPS DOC-OBJECTS COPYRIGHT ("Johannes A. G. M. Koomen" 1986 1987 1993 2018)) (DECLARE%: DONTCOPY (FILEMAP (NIL (7690 17683 (DOCOBJ-ACQUIRE-OBJECT 7700 . 8574) (DOCOBJ-INIT 8576 . 9204) ( DOCOBJ-TEDIT-MENU-ENTRY 9206 . 9628) (DOCOBJ-GET-LOOKS 9630 . 12365) (DOCOBJ-REGISTER-OBJECT 12367 . 13021) (DOCOBJ-STRING-IMAGEBOX 13023 . 13971) (DOCOBJ-WAIT-MOUSE 13973 . 14433) ( DOCOBJ-INVOKE-IMAGEOBJFN 14435 . 15219) (DOCOBJ-BEFOREHARDCOPYFN 15221 . 16614) ( DOCOBJ-AFTERHARDCOPYFN 16616 . 17681)) (17713 17980 (DOCOBJ-ACQUIRE-EVALED-OBJECT 17723 . 17978)) ( 18184 18326 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 18194 . 18324)) (18669 23465 (DOCOBJ-EDIT-TIMESTAMP 18679 . 19208) (DOCOBJ-MAKE-TIMESTAMP 19210 . 19621) (DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 19623 . 20693) ( DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 20695 . 21226) (DOCOBJ-TIMESTAMP-COPYFN 21228 . 21553) ( DOCOBJ-TIMESTAMP-DISPLAYFN 21555 . 21848) (DOCOBJ-TIMESTAMP-GETFN 21850 . 22090) ( DOCOBJ-TIMESTAMP-IMAGEBOXFN 22092 . 22448) (DOCOBJ-TIMESTAMP-PREPRINTFN 22450 . 22681) ( DOCOBJ-TIMESTAMP-PUTFN 22683 . 23052) (DOCOBJ-TIMESTAMP-TO-STRING 23054 . 23463)) (23763 28070 ( DOCOBJ-MAKE-FILESTAMP 23773 . 24114) (DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 24116 . 25158) ( DOCOBJ-FILESTAMP-COPYFN 25160 . 25475) (DOCOBJ-FILESTAMP-DISPLAYFN 25477 . 25765) ( DOCOBJ-FILESTAMP-GETFN 25767 . 26120) (DOCOBJ-FILESTAMP-IMAGEBOXFN 26122 . 26460) ( DOCOBJ-FILESTAMP-GET-FULLNAME 26462 . 27080) (DOCOBJ-FILESTAMP-NEW-FULLNAME 27082 . 27555) ( DOCOBJ-FILESTAMP-PREPRINTFN 27557 . 27766) (DOCOBJ-FILESTAMP-PUTFN 27768 . 28068)) (28397 30894 ( DOCOBJ-MAKE-HRULE 28407 . 28821) (DOCOBJ-EDIT-HRULE 28823 . 29295) (DOCOBJ-HRULE-INIT 29297 . 29629) ( DOCOBJ-HRULE-GET-WIDTH 29631 . 30442) (DOCOBJ-HRULE-BUTTONEVENTINFN 30444 . 30892)) (31282 39731 ( DOCOBJ-MAKE-INCLUDE 31292 . 31693) (DOCOBJ-MAKE-INCLUDE-IMAGEFNS 31695 . 32700) ( DOCOBJ-INCLUDE-CREATE-OBJ 32702 . 33491) (DOCOBJ-INCLUDE-EDIT 33493 . 38092) ( DOCOBJ-INCLUDE-EDIT-WINDOWP 38094 . 38956) (DOCOBJ-INCLUDE-RESET-OBJ 38958 . 39729)) (39732 49830 ( DOCOBJ-INCLUDE-AFTERHARDCOPYFN 39742 . 40626) (DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 40628 . 45403) ( DOCOBJ-INCLUDE-CLEANUPFN 45405 . 46172) (DOCOBJ-INCLUDE-BUTTONEVENTINFN 46174 . 46708) ( DOCOBJ-INCLUDE-COPYFN 46710 . 46928) (DOCOBJ-INCLUDE-DISPLAYFN 46930 . 47662) (DOCOBJ-INCLUDE-GETFN 47664 . 48387) (DOCOBJ-INCLUDE-IMAGEBOXFN 48389 . 49398) (DOCOBJ-INCLUDE-PREPRINTFN 49400 . 49619) ( DOCOBJ-INCLUDE-PUTFN 49621 . 49828))))) STOP