(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP" BASE 10)
(FILECREATED "27-Oct-87 01:35:36" "{FireFS:CS:Univ Rochester}<koomen>LispUsers>Lyric>DOC-OBJECTS.;7" 48056
changes to%: (VARS DOC-OBJECTSCOMS)
(FNS DOCOBJ-INCLUDE-BEFOREHARDCOPYFN DOCOBJ-INCLUDE-GETFN DOCOBJ-INCLUDE-EDIT
DOCOBJ-INCLUDE-EDIT-WINDOWP)
previous date%: "23-Oct-87 16:34:17"
"{FireFS:CS:Univ Rochester}<koomen>LispUsers>Lyric>DOC-OBJECTS.;5")
(* "
Copyright (c) 1986, 1987 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-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}<TEDIT>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 NIL (* ; "Edited 15-Oct-87 22:57 by Koomen")
(* ;; "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 TEXTOBJ *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)
(for FRM in *DOCOBJ-FORMS* do (APPLY (CAR FRM)
(CDR FRM))) repeatwhile *DOCOBJ-FORMS*])
(DOCOBJ-AFTERHARDCOPYFN
[LAMBDA NIL (* ; "Edited 15-Oct-87 22:57 by Koomen")
(* ;; "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 TEXTOBJ *DOCOBJ-FORMS*))
(LET ((TEXTSTREAM (TEXTSTREAM TEXTOBJ))
(*DOCOBJ-FORMS*))
(do (SETQ *DOCOBJ-FORMS*)
(TEDIT.MAPPIECES TEXTOBJ (FUNCTION DOCOBJ-INVOKE-IMAGEOBJFN)
'AFTERHARDCOPYFN)
(for FRM in *DOCOBJ-FORMS* do (APPLY (CAR FRM)
(CDR FRM))) repeatwhile *DOCOBJ-FORMS*)
(if (TEXTPROP TEXTSTREAM 'DOCOBJ-VIRGINP)
then (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?) (* Koomen " 4-Feb-87 16:12")
(DECLARE (GLOBALVARS DOCOBJ-HRULE-BLANK-PAD DOCOBJ-HRULE-RULE-PAD
LASTMOUSEX LASTMOUSEY))
(if (NULL DOCOBJ-HRULE-RULE-PAD)
then (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)
))
(if FIRST?
then (MOVEW DOCOBJ-HRULE-RULE-PAD LASTMOUSEX LASTMOUSEY)
(MOVEW DOCOBJ-HRULE-BLANK-PAD LASTMOUSEX LASTMOUSEY))
(NUMBERPAD.READ (if RULE?
then DOCOBJ-HRULE-RULE-PAD
else DOCOBJ-HRULE-BLANK-PAD])
(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 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 ← (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 23-Oct-87 14:15 by Koomen")
(DECLARE (SPECVARS TEXTSTREAM))
(if (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM)
then
(* ;; "Just record current position, let endmarker do the rest")
(IMAGEOBJPROP IMAGEOBJ 'INCLSTARTPOS (ADD1 CH#))
else
(* ;; "Hit an end marker")
(PROG (HEADOBJ STARTPOS)
(SETQ HEADOBJ (IMAGEOBJPROP IMAGEOBJ 'INCLIMAGEOBJ))
(SETQ STARTPOS (IMAGEOBJPROP HEADOBJ 'INCLSTARTPOS))
(IMAGEOBJPROP HEADOBJ 'INCLUDEDP NIL)
(push *DOCOBJ-FORMS* (LIST (FUNCTION TEDIT.DELETE)
TEXTSTREAM STARTPOS (ADD1 (IDIFFERENCE CH# STARTPOS])
(DOCOBJ-INCLUDE-BEFOREHARDCOPYFN
[LAMBDA (IMAGEOBJ CH#) (* ; "Edited 27-Oct-87 01:35 by Koomen")
(DECLARE (SPECVARS *DOCOBJ-FORMS* TEXTOBJ))
(LET [(INCLOBJ (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM]
(if [AND INCLOBJ (fetch (INCLOBJ ENABLEDP) of INCLOBJ)
(NOT (IMAGEOBJPROP IMAGEOBJ 'INCLUDEDP]
then
(* ;; "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))
(if WINDOWS
then (TEDIT.PROMPTPRINT TEXTSTREAM "Including " T)
(TEDIT.PROMPTPRINT TEXTSTREAM INCLFILE)
(TEDIT.PROMPTPRINT TEXTSTREAM "...")
else (PROMPTPRINT "[TEdit hardcopy: including " INCLFILE
"...]"))
(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))
(TEDIT.INCLUDE TEXTSTREAM (MKATOM INCLFILE))
(TEDIT.INSERT.OBJECT ENDOBJ TEXTSTREAM)
(IMAGEOBJPROP ENDOBJ 'INCLIMAGEOBJ IMAGEOBJ)
(IMAGEOBJPROP IMAGEOBJ 'INCLUDEDP T)
(if WINDOWS
then (TEDIT.PROMPTPRINT TEXTSTREAM " done.")
else (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-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))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (9751 19347 (DOCOBJ-ACQUIRE-OBJECT 9761 . 10635) (DOCOBJ-INIT 10637 . 11265) (
DOCOBJ-TEDIT-MENU-ENTRY 11267 . 11689) (DOCOBJ-GET-LOOKS 11691 . 14426) (DOCOBJ-REGISTER-OBJECT 14428
. 15082) (DOCOBJ-STRING-IMAGEBOX 15084 . 16032) (DOCOBJ-WAIT-MOUSE 16034 . 16494) (
DOCOBJ-INVOKE-IMAGEOBJFN 16496 . 17280) (DOCOBJ-BEFOREHARDCOPYFN 17282 . 18469) (
DOCOBJ-AFTERHARDCOPYFN 18471 . 19345)) (19377 19644 (DOCOBJ-ACQUIRE-EVALED-OBJECT 19387 . 19642)) (
19844 19986 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 19854 . 19984)) (20324 25120 (DOCOBJ-EDIT-TIMESTAMP 20334
. 20863) (DOCOBJ-MAKE-TIMESTAMP 20865 . 21276) (DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 21278 . 22348) (
DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 22350 . 22881) (DOCOBJ-TIMESTAMP-COPYFN 22883 . 23208) (
DOCOBJ-TIMESTAMP-DISPLAYFN 23210 . 23503) (DOCOBJ-TIMESTAMP-GETFN 23505 . 23745) (
DOCOBJ-TIMESTAMP-IMAGEBOXFN 23747 . 24103) (DOCOBJ-TIMESTAMP-PREPRINTFN 24105 . 24336) (
DOCOBJ-TIMESTAMP-PUTFN 24338 . 24707) (DOCOBJ-TIMESTAMP-TO-STRING 24709 . 25118)) (25414 29721 (
DOCOBJ-MAKE-FILESTAMP 25424 . 25765) (DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 25767 . 26809) (
DOCOBJ-FILESTAMP-COPYFN 26811 . 27126) (DOCOBJ-FILESTAMP-DISPLAYFN 27128 . 27416) (
DOCOBJ-FILESTAMP-GETFN 27418 . 27771) (DOCOBJ-FILESTAMP-IMAGEBOXFN 27773 . 28111) (
DOCOBJ-FILESTAMP-GET-FULLNAME 28113 . 28731) (DOCOBJ-FILESTAMP-NEW-FULLNAME 28733 . 29206) (
DOCOBJ-FILESTAMP-PREPRINTFN 29208 . 29417) (DOCOBJ-FILESTAMP-PUTFN 29419 . 29719)) (30043 32543 (
DOCOBJ-MAKE-HRULE 30053 . 30467) (DOCOBJ-EDIT-HRULE 30469 . 30941) (DOCOBJ-HRULE-INIT 30943 . 31275) (
DOCOBJ-HRULE-GET-WIDTH 31277 . 32091) (DOCOBJ-HRULE-BUTTONEVENTINFN 32093 . 32541)) (32922 40114 (
DOCOBJ-MAKE-INCLUDE 32932 . 33333) (DOCOBJ-MAKE-INCLUDE-IMAGEFNS 33335 . 34340) (
DOCOBJ-INCLUDE-CREATE-OBJ 34342 . 35131) (DOCOBJ-INCLUDE-EDIT 35133 . 38475) (
DOCOBJ-INCLUDE-EDIT-WINDOWP 38477 . 39339) (DOCOBJ-INCLUDE-RESET-OBJ 39341 . 40112)) (40115 47456 (
DOCOBJ-INCLUDE-AFTERHARDCOPYFN 40125 . 41000) (DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 41002 . 43798) (
DOCOBJ-INCLUDE-BUTTONEVENTINFN 43800 . 44334) (DOCOBJ-INCLUDE-COPYFN 44336 . 44554) (
DOCOBJ-INCLUDE-DISPLAYFN 44556 . 45288) (DOCOBJ-INCLUDE-GETFN 45290 . 46013) (
DOCOBJ-INCLUDE-IMAGEBOXFN 46015 . 47024) (DOCOBJ-INCLUDE-PREPRINTFN 47026 . 47245) (
DOCOBJ-INCLUDE-PUTFN 47247 . 47454)))))
STOP