(FILECREATED "11-Feb-87 11:11:52" {FIREFS:CS:UNIV% ROCHESTER}<KOOMEN>LISP>DOC-OBJECTS.;19 25201
changes to: (VARS DOC-OBJECTSCOMS)
(FNS DOCOBJ-STRING-IMAGEBOX DOCOBJ-TIMESTAMP-IMAGEBOXFN
DOCOBJ-FILESTAMP-IMAGEBOXFN DOCOBJ-INCLUDE-IMAGEBOXFN)
previous date: " 7-Feb-87 15:36:31" {FIREFS:CS:UNIV% ROCHESTER}<KOOMEN>LISP>DOC-OBJECTS.;17)
(* 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))
[INITVARS (DocObjectsMenuCommands)
(DocObjectsMenuFont (FONTCREATE (QUOTE (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-STRING-IMAGEBOX))
[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" *)
(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-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-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 (* HRULE *)
(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 *)
(FNS DOCOBJ-MAKE-INCLUDE DOCOBJ-MAKE-INCLUDE-IMAGEFNS
DOCOBJ-INCLUDE-DISPLAYFN DOCOBJ-INCLUDE-IMAGEBOXFN)
(VARS (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])
(* * 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)
(RPAQ? DocObjectsMenuCommands )
(RPAQ? DocObjectsMenuFont (FONTCREATE (QUOTE (MODERN 12 BOLD))))
(* The hook into GET.OBJ.FROM.USER *)
(DEFINEQ
(DOCOBJ-ACQUIRE-OBJECT
[LAMBDA NIL (* Koomen "30-Sep-86 02:10")
(* * 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 (* Koomen "31-Jan-87 02:05")
(* * 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 (QUOTE GET.OBJ.FROM.USER)
(QUOTE PROMPTFOREVALED)
(QUOTE DOCOBJ-ACQUIRE-OBJECT))
(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU (QUOTE (Object (FUNCTION DOCOBJ-TEDIT-MENU-ENTRY)
"Insert a Document Object"])
(DOCOBJ-TEDIT-MENU-ENTRY
[LAMBDA (TEXTSTREAM) (* Koomen "28-Jan-87 16:28")
(* * 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-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 (QUOTE DEVICE))
(SETQ DEVICE (IMAGESTREAMTYPE IMAGESTREAM)))
then (SETQ FONT (FONTCOPY FONT (QUOTE DEVICE)
DEVICE)))
(SETQ HEIGHT (FONTHEIGHT FONT))
(SETQ DESCENT (FONTPROP FONT (QUOTE DESCENT)))
(RETURN (create IMAGEBOX
XSIZE ← (STRINGWIDTH STRING FONT)
YSIZE ← (IPLUS HEIGHT (IABS CLOFFSET))
YDESC ← (IDIFFERENCE DESCENT CLOFFSET)
XKERN ← 0])
)
(* "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: 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 (* Koomen "31-Jan-87 00:35")
(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 NILL)))
(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)
(* Koomen " 4-Feb-87 14:05")
(if (EQ BUTTON (QUOTE MIDDLE))
then (ALLOW.BUTTON.EVENTS)
(if (DOCOBJ-EDIT-TIMESTAMP (IMAGEOBJPROP IMAGEOBJ (QUOTE OBJECTDATUM)))
then (QUOTE CHANGED])
(DOCOBJ-TIMESTAMP-COPYFN
[LAMBDA (IMAGEOBJ SOURCEHOSTSTREAM TARGETHOSTSTREAM) (* Koomen "31-Jan-87 00:30")
(DECLARE (GLOBALVARS DOCOBJ-TIMESTAMP-IMAGEFNS))
(IMAGEOBJCREATE (COPYALL (IMAGEOBJPROP IMAGEOBJ (QUOTE 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 (QUOTE 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 (QUOTE OBJECTDATUM)))
(TIMESTRING (DOCOBJ-TIMESTAMP-TO-STRING TIMESTAMP)))
(DOCOBJ-STRING-IMAGEBOX TIMESTRING IMAGESTREAM])
(DOCOBJ-TIMESTAMP-PUTFN
[LAMBDA (IMAGEOBJ FILESTREAM) (* Koomen " 4-Feb-87 14:08")
(PROG [(TIMESTAMP (IMAGEOBJPROP IMAGEOBJ (QUOTE 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 (* Koomen "31-Jan-87 04:16")
(DECLARE (SPECVARS TEXTOBJ)
(GLOBALVARS DOCOBJ-FILESTAMP-IMAGEFNS))
(IMAGEOBJCREATE (DOCOBJ-FILESTAMP-GET-FULLNAME TEXTOBJ)
DOCOBJ-FILESTAMP-IMAGEFNS])
(DOCOBJ-MAKE-FILESTAMP-IMAGEFNS
[LAMBDA NIL (* Koomen "31-Jan-87 03:39")
(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 NILL)))
(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 (QUOTE OBJECTDATUM))
DOCOBJ-FILESTAMP-IMAGEFNS])
(DOCOBJ-FILESTAMP-DISPLAYFN
[LAMBDA (IMAGEOBJ IMAGESTREAM IMAGESTREAMTYPE HOSTSTREAM)
(* Koomen " 4-Feb-87 14:28")
(PRINTOUT IMAGESTREAM (IMAGEOBJPROP IMAGEOBJ (QUOTE OBJECTDATUM])
(DOCOBJ-FILESTAMP-GETFN
[LAMBDA (FILESTREAM) (* Koomen "31-Jan-87 03:38")
(DECLARE (GLOBALVARS DOCOBJ-FILESTAMP-IMAGEFNS))
(IMAGEOBJCREATE (READ FILESTREAM)
DOCOBJ-FILESTAMP-IMAGEFNS])
(DOCOBJ-FILESTAMP-IMAGEBOXFN
[LAMBDA (IMAGEOBJ IMAGESTREAM CURRENTX RIGHTMARGIN) (* Koomen " 9-Feb-87 17:14")
(LET [(FILESTAMP (IMAGEOBJPROP IMAGEOBJ (QUOTE OBJECTDATUM]
(DOCOBJ-STRING-IMAGEBOX FILESTAMP IMAGESTREAM])
(DOCOBJ-FILESTAMP-GET-FULLNAME
[LAMBDA (TEXTOBJ) (* Koomen " 4-Feb-87 14:28")
(PROG ((FULLNAME (FULLNAME TEXTOBJ)))
(RETURN (MKSTRING (if (AND FULLNAME (OR (LITATOM FULLNAME)
(STRINGP FULLNAME)))
then (COPYALL FULLNAME)
else "-- not yet filed --"])
(DOCOBJ-FILESTAMP-PUTFN
[LAMBDA (IMAGEOBJ FILESTREAM) (* Koomen "31-Jan-87 03:55")
(PROG ((FULLNAME (FULLNAME FILESTREAM)))
(IMAGEOBJPROP IMAGEOBJ (QUOTE 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."))
(* HRULE *)
(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 (QUOTE RULE.WIDTH]
(SETQ NEWWIDTH (COPYALL OLDWIDTH))
(if (AND (NLSETQ (EDITE NEWWIDTH))
(NOT (EQUAL NEWWIDTH OLDWIDTH)))
then (IMAGEOBJPROP IMAGEOBJ (QUOTE 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)
(* Koomen " 4-Feb-87 15:45")
(if (EQ BUTTON (QUOTE MIDDLE))
then (ALLOW.BUTTON.EVENTS)
(if (DOCOBJ-EDIT-HRULE IMAGEOBJ)
then (QUOTE 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 *)
(DEFINEQ
(DOCOBJ-MAKE-INCLUDE
[LAMBDA NIL (* Koomen " 5-Feb-87 12:11")
(DECLARE (GLOBALVARS DOCOBJ-INCLUDE-IMAGEFNS))
(LET ((PROMPT.STR "Enter file name: ")
(CANDIDATE.STR)
(GENERATE?LIST.FN)
(ECHO.CHANNEL PROMPTWINDOW)
(DONTECHOTYPEIN.FLG)
(URGENCY.OPTION)
(TERMINCHARS.LST)
(KEYBD.CHANNEL))
(LET [(SUBFILE (U-CASE (PROMPTFORWORD PROMPT.STR CANDIDATE.STR GENERATE?LIST.FN
ECHO.CHANNEL DONTECHOTYPEIN.FLG URGENCY.OPTION
TERMINCHARS.LST KEYBD.CHANNEL]
(if SUBFILE
then (IMAGEOBJCREATE SUBFILE DOCOBJ-INCLUDE-IMAGEFNS])
(DOCOBJ-MAKE-INCLUDE-IMAGEFNS
[LAMBDA NIL (* Koomen " 5-Feb-87 11:56")
(LET ((DISPLAYFN (FUNCTION DOCOBJ-INCLUDE-DISPLAYFN))
(IMAGEBOXFN (FUNCTION DOCOBJ-INCLUDE-IMAGEBOXFN))
(PUTFN (OR (FUNCTION NILL)
(FUNCTION DOCOBJ-TIMESTAMP-PUTFN)))
(GETFN (OR (FUNCTION NILL)
(FUNCTION DOCOBJ-TIMESTAMP-GETFN)))
(COPYFN (OR (FUNCTION NILL)
(FUNCTION DOCOBJ-TIMESTAMP-COPYFN)))
(BUTTONEVENTINFN (OR (FUNCTION NILL)
(FUNCTION DOCOBJ-TIMESTAMP-BUTTONEVENTINFN)))
(COPYBUTTONEVENTINFN (FUNCTION NILL))
(WHENMOVEDFN (FUNCTION NILL))
(WHENINSERTEDFN (FUNCTION NILL))
(WHENDELETEDFN (FUNCTION NILL))
(WHENCOPIEDFN (FUNCTION NILL))
(WHENOPERATEDONFN (FUNCTION NILL))
(PREPRINTFN (FUNCTION NILL)))
(IMAGEFNSCREATE DISPLAYFN IMAGEBOXFN PUTFN GETFN COPYFN BUTTONEVENTINFN
COPYBUTTONEVENTINFN WHENMOVEDFN WHENINSERTEDFN WHENDELETEDFN WHENCOPIEDFN
WHENOPERATEDONFN PREPRINTFN])
(DOCOBJ-INCLUDE-DISPLAYFN
[LAMBDA (IMAGEOBJ IMAGESTREAM IMAGESTREAMTYPE HOSTSTREAM)
(* Koomen " 5-Feb-87 12:22")
(PROG [(SUBFILE (IMAGEOBJPROP IMAGEOBJ (QUOTE OBJECTDATUM]
(if (EQ IMAGESTREAMTYPE (QUOTE DISPLAY))
then (printout IMAGESTREAM "@INCLUDE[" SUBFILE "]")
else
(* * DON'T KNOW WHAT TO DO HERE YET! * *)
])
(DOCOBJ-INCLUDE-IMAGEBOXFN
[LAMBDA (IMAGEOBJ IMAGESTREAM CURRENTX RIGHTMARGIN) (* Koomen " 9-Feb-87 17:16")
(LET [(SUBFILE (IMAGEOBJPROP IMAGEOBJ (QUOTE OBJECTDATUM]
(if (EQ (IMAGESTREAMTYPE IMAGESTREAM)
(QUOTE DISPLAY))
then (LET ((INCLSTR (CONCAT "@INCLUDE[" SUBFILE "]")))
(DOCOBJ-STRING-IMAGEBOX INCLSTR IMAGESTREAM))
else (create IMAGEBOX
XSIZE ← 0
YSIZE ← 0
YDESC ← 0
XKERN ← 0])
)
(RPAQ DOCOBJ-INCLUDE-IMAGEFNS (DOCOBJ-MAKE-INCLUDE-IMAGEFNS))
(* ADDVARS (DocObjectsMenuCommands ("Include" (DOCOBJ-MAKE-INCLUDE)
"Include another document right here when hardcopying")))
(DECLARE: DONTEVAL@LOAD DOCOPY
(DOCOBJ-INIT)
)
(PUTPROPS DOC-OBJECTS COPYRIGHT ("Johannes A. G. M. Koomen" 1986 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5923 10822 (DOCOBJ-ACQUIRE-OBJECT 5933 . 6752) (DOCOBJ-INIT 6754 . 7403) (
DOCOBJ-TEDIT-MENU-ENTRY 7405 . 7821) (DOCOBJ-GET-LOOKS 7823 . 9886) (DOCOBJ-STRING-IMAGEBOX 9888 .
10820)) (10851 11122 (DOCOBJ-ACQUIRE-EVALED-OBJECT 10861 . 11120)) (11289 11450 (
DOCOBJ-ACQUIRE-SNAPPED-OBJECT 11299 . 11448)) (11733 15946 (DOCOBJ-EDIT-TIMESTAMP 11743 . 12179) (
DOCOBJ-MAKE-TIMESTAMP 12181 . 12549) (DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 12551 . 13502) (
DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 13504 . 13928) (DOCOBJ-TIMESTAMP-COPYFN 13930 . 14239) (
DOCOBJ-TIMESTAMP-DISPLAYFN 14241 . 14537) (DOCOBJ-TIMESTAMP-GETFN 14539 . 14803) (
DOCOBJ-TIMESTAMP-IMAGEBOXFN 14805 . 15130) (DOCOBJ-TIMESTAMP-PUTFN 15132 . 15527) (
DOCOBJ-TIMESTAMP-TO-STRING 15529 . 15944)) (16206 19234 (DOCOBJ-MAKE-FILESTAMP 16216 . 16532) (
DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 16534 . 17457) (DOCOBJ-FILESTAMP-COPYFN 17459 . 17754) (
DOCOBJ-FILESTAMP-DISPLAYFN 17756 . 18019) (DOCOBJ-FILESTAMP-GETFN 18021 . 18285) (
DOCOBJ-FILESTAMP-IMAGEBOXFN 18287 . 18546) (DOCOBJ-FILESTAMP-GET-FULLNAME 18548 . 18941) (
DOCOBJ-FILESTAMP-PUTFN 18943 . 19232)) (19507 21863 (DOCOBJ-MAKE-HRULE 19517 . 19886) (
DOCOBJ-EDIT-HRULE 19888 . 20363) (DOCOBJ-HRULE-INIT 20365 . 20724) (DOCOBJ-HRULE-GET-WIDTH 20726 .
21486) (DOCOBJ-HRULE-BUTTONEVENTINFN 21488 . 21861)) (22107 24857 (DOCOBJ-MAKE-INCLUDE 22117 . 22779)
(DOCOBJ-MAKE-INCLUDE-IMAGEFNS 22781 . 23868) (DOCOBJ-INCLUDE-DISPLAYFN 23870 . 24322) (
DOCOBJ-INCLUDE-IMAGEBOXFN 24324 . 24855)))))
STOP