github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-05-07 00:18:09 +00:00
Code Issues Projects Releases Wiki Activity

test out changes to diagnose issue 2067

Browse Source
This commit is contained in:
Larry Masinter
2026-05-03 20:38:26 -07:00
parent c16e3b4a55
commit 3269169f48
6 changed files with 253 additions and 231 deletions
Download Patch File Download Diff File Expand all files Collapse all files

48
internal/MEDLEY-UTILS
View File

@@ -1,16 +1,12 @@
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
(FILECREATED "16-Apr-2026 22:42:51" {DSK}<home>matt>Interlisp>medley>internal>MEDLEY-UTILS.;2 30564
(FILECREATED " 3-May-2026 13:56:51" {MEDLEY}<INTERNAL>MEDLEY-UTILS.;2 30138
:EDIT-BY "mth"
:EDIT-BY "lmm"
:CHANGES-TO (FNS HCFILES MAKE-EXPORTS-ALL MAKE-INDEX-HTMLS)
(FUNCTIONS REPORT-AND-GO)
(VARS MEDLEY-UTILSCOMS HC-SKIP-EXTENSIONS)
(ADVICE TEDIT.PROMPTPRINT)
:CHANGES-TO (FNS HCFILES)
:PREVIOUS-DATE "16-Apr-2026 22:27:40" {DSK}<home>matt>Interlisp>medley>internal>MEDLEY-UTILS.;1
)
:PREVIOUS-DATE "16-Apr-2026 22:42:51" {MEDLEY}<INTERNAL>MEDLEY-UTILS.;1)
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
@@ -215,7 +211,8 @@
(DEFINEQ
(HCFILES
[LAMBDA (BASE REDO SUBSETS) (* ; "Edited 16-Apr-2026 22:42 by mth")
[LAMBDA (BASE REDO SUBSETS) (* ; "Edited 3-May-2026 13:56 by lmm")
(* ; "Edited 16-Apr-2026 22:42 by mth")
(* ; "Edited 30-Jun-2024 08:27 by lmm")
(* ; "Edited 23-Apr-2024 23:15 by lmm")
(* ; "Edited 22-Apr-2024 13:22 by lmm")
@@ -293,12 +290,9 @@
(if (EQ REDO 'TEST)
then (CL:FORMAT T "Testing open ~a..." SRCPATH)
(CLOSEF? (OPENTEXTSTREAM SRCPATH))
else (REPORT-AND-GO (CL:WITH-OPEN-STREAM (S (OPENTEXTSTREAM
SRCPATH))
(TEDIT.FORMAT.HARDCOPY S DEST T NIL NIL
NIL 'PDF))
else (REPORT-AND-GO (TEDIT.TO.IMAGEFILE SRCPATH DEST 'PDF)
(CL:FORMAT NIL
"~~%%~S TEDIT.FORMAT.HARDCOPY of ~A -- Condition: ~~A"
"~~%%~S TEDIT.TO.IMAGEFILE of ~A -- Condition: ~~A"
'FAIL SRCPATH)))
(PRIN3 " DONE" T)
(TERPRI T)
@@ -520,13 +514,13 @@
)
(DEFMACRO REPORT-AND-GO (FORM REPORT-FORMAT) (* ; "Edited 16-Apr-2026 16:02 by mth")
`[CL:MULTIPLE-VALUE-BIND (FORM-RESULT ERROR-CONDITION)
(IGNORE-ERRORS (CL:VALUES ,FORM)) (* ; "Only the first value")
(COND
(ERROR-CONDITION (PRIN3 (CL:FORMAT NIL ,REPORT-FORMAT ERROR-CONDITION)
T)
NIL)
(T (LIST FORM-RESULT])
`(CL:MULTIPLE-VALUE-BIND (FORM-RESULT ERROR-CONDITION)
(IGNORE-ERRORS (CL:VALUES ,FORM)) (* ; "Only the first value")
(COND
(ERROR-CONDITION (PRIN3 (CL:FORMAT NIL ,REPORT-FORMAT ERROR-CONDITION)
T)
NIL)
(T (LIST FORM-RESULT)))))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
@@ -536,10 +530,10 @@
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1289 8223 (GATHER-INFO 1299 . 6681) (MAKE-FULLER-DB 6683 . 7592) (MEDLEY-FIX-LINKS 7594
. 7987) (MEDLEY-FIX-DATES 7989 . 8221)) (9795 12371 (MAKE-EXPORTS-ALL 9805 . 10652) (
MAKE-WHEREIS-HASH 10654 . 11843) (MAKE-WHEREIS-LOOPS 11845 . 12369)) (12372 24990 (HCFILES 12382 .
19514) (MAKE-INDEX-HTMLS 19516 . 24988)) (25324 29936 (RECOMPILE-ONE 25334 . 27231) (RECMPL 27233 .
27836) (COMPILE-SETUP 27838 . 28462) (REMAKEFILES 28464 . 29934)) (29938 30408 (REPORT-AND-GO 29938 .
30408)))))
(FILEMAP (NIL (1056 7990 (GATHER-INFO 1066 . 6448) (MAKE-FULLER-DB 6450 . 7359) (MEDLEY-FIX-LINKS 7361
. 7754) (MEDLEY-FIX-DATES 7756 . 7988)) (9562 12138 (MAKE-EXPORTS-ALL 9572 . 10419) (
MAKE-WHEREIS-HASH 10421 . 11610) (MAKE-WHEREIS-LOOPS 11612 . 12136)) (12139 24586 (HCFILES 12149 .
19110) (MAKE-INDEX-HTMLS 19112 . 24584)) (24920 29532 (RECOMPILE-ONE 24930 . 26827) (RECMPL 26829 .
27432) (COMPILE-SETUP 27434 . 28058) (REMAKEFILES 28060 . 29530)) (29534 29982 (REPORT-AND-GO 29534 .
29982)))))
STOP

BIN
internal/MEDLEY-UTILS.DFASL
View File

Binary file not shown.

125
lispusers/DATEFORMAT-EDITOR
View File

@@ -1,18 +1,43 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP" BASE 10)
(FILECREATED "19-May-89 17:52:44" {ERINYES}<LISPUSERS>MEDLEY>DATEFORMAT-EDITOR.;1 13443
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
changes to%: (VARS DATEFORMAT-EDITORCOMS)
(FILECREATED " 3-May-2026 10:44:14" {MEDLEY}<lispusers>DATEFORMAT-EDITOR.;2 14047
previous date%: "16-Sep-88 12:50:52" {PHYLUM}<LISP>MEDLEY>LISPUSERS>DATEFORMAT-EDITOR.;1)
:EDIT-BY "lmm"
:CHANGES-TO (VARS DATEFORMAT-EDITORCOMS)
:PREVIOUS-DATE "19-May-89 17:52:44" {MEDLEY}<lispusers>DATEFORMAT-EDITOR.;1)
(* "
Copyright (c) 1987, 1988, 1989 by Johannes A. G. M. Koomen. All rights reserved.
")
(PRETTYCOMPRINT DATEFORMAT-EDITORCOMS)
(RPAQQ DATEFORMAT-EDITORCOMS ((* ;;; "This system provides a facility for editing date formats as described in section 12.5 of the Interlisp-D manual, Koto version. User entry point is the function EDIT-DATEFORMAT. Editing is accomplished using a FREEMENU. Items displayed in this menu are stored on DATEFORMAT-EDITOR-ITEMS. Call (GET-DATEFORMAT-EDITOR T) after changing this variable. Input to EDIT-DATEFORMAT is either NIL or a value returned by the DATEFORMAT function. Output is either NIL -- in case editing was aborted -- or another value as returned from the DATEFORMAT function.") (* ;;; "Interface") (FNS EDIT-DATEFORMAT GET-DATEFORMAT-EDITOR) (INITVARS (EDIT-DATEFORMAT-DEFAULT (DATEFORMAT))) (* ;;; "Support") (FILES (SYSLOAD) FREEMENU) (FNS DATEFORMAT-EDITOR-STATUS DATEFORMAT-EDITOR-GET-STATE DATEFORMAT-EDITOR-PUT-STATE DATEFORMAT-EDITOR-SHOW-STATE DATEFORMAT-EDITOR-ABORTFN DATEFORMAT-EDITOR-CLOSEFN DATEFORMAT-EDITOR-GETDFLTFN DATEFORMAT-EDITOR-PUTDFLTFN DATEFORMAT-EDITOR-QUITFN DATEFORMAT-EDITOR-SHOWFN) (VARS $$DATEFORMAT-EDITOR-ITEMS) (INITVARS (DATEFORMAT-EDITOR-ITEMS (COPY $$DATEFORMAT-EDITOR-ITEMS))) (DECLARE%: DONTEVAL@LOAD DOCOPY (VARS ($$DATEFORMAT-EDITOR (GET-DATEFORMAT-EDITOR)) ($$DATEFORMAT-EDITOR-IDATE (IDATE " 1-Jan-88 23:56:41"))) (P (COND ((NOT (GETD (QUOTE \OUTDATE-STRING))) (* ; "Get DATE extensions") (FILESLOAD (SYSLOAD) DATEPATCH))))) (PROP MAKEFILE-ENVIRONMENT DATEFORMAT-EDITOR)))
(RPAQQ DATEFORMAT-EDITORCOMS
(
(* ;;; "This system provides a facility for editing date formats as described in section 12.5 of the Interlisp-D manual, Koto version. User entry point is the function EDIT-DATEFORMAT. Editing is accomplished using a FREEMENU. Items displayed in this menu are stored on DATEFORMAT-EDITOR-ITEMS. Call (GET-DATEFORMAT-EDITOR T) after changing this variable. Input to EDIT-DATEFORMAT is either NIL or a value returned by the DATEFORMAT function. Output is either NIL -- in case editing was aborted -- or another value as returned from the DATEFORMAT function.")
(* ;;; "Interface")
(FNS EDIT-DATEFORMAT GET-DATEFORMAT-EDITOR)
(INITVARS (EDIT-DATEFORMAT-DEFAULT (DATEFORMAT)))
(* ;;; "Support")
(FILES FREEMENU)
(FNS DATEFORMAT-EDITOR-STATUS DATEFORMAT-EDITOR-GET-STATE DATEFORMAT-EDITOR-PUT-STATE
DATEFORMAT-EDITOR-SHOW-STATE DATEFORMAT-EDITOR-ABORTFN DATEFORMAT-EDITOR-CLOSEFN
DATEFORMAT-EDITOR-GETDFLTFN DATEFORMAT-EDITOR-PUTDFLTFN DATEFORMAT-EDITOR-QUITFN
DATEFORMAT-EDITOR-SHOWFN)
(VARS $$DATEFORMAT-EDITOR-ITEMS)
(INITVARS (DATEFORMAT-EDITOR-ITEMS (COPY $$DATEFORMAT-EDITOR-ITEMS)))
[DECLARE%: DONTEVAL@LOAD DOCOPY (VARS ($$DATEFORMAT-EDITOR (GET-DATEFORMAT-EDITOR))
($$DATEFORMAT-EDITOR-IDATE (IDATE
" 1-Jan-1988 23:56:41"
]
(PROP MAKEFILE-ENVIRONMENT DATEFORMAT-EDITOR)))
@@ -36,14 +61,14 @@ Copyright (c) 1987, 1988, 1989 by Johannes A. G. M. Koomen. All rights reserved
)
)
(RPAQ? EDIT-DATEFORMAT-DEFAULT (DATEFORMAT))
(RPAQ? EDIT-DATEFORMAT-DEFAULT (DATEFORMAT))
(* ;;; "Support")
(FILESLOAD (SYSLOAD) FREEMENU)
(FILESLOAD FREEMENU)
(DEFINEQ
(DATEFORMAT-EDITOR-STATUS
@@ -87,26 +112,76 @@ Copyright (c) 1987, 1988, 1989 by Johannes A. G. M. Koomen. All rights reserved
)
)
(RPAQQ $$DATEFORMAT-EDITOR-ITEMS (((TYPE MOMENTARY LABEL "Quit" FONT (GACHA 10 BOLD) SELECTEDFN DATEFORMAT-EDITOR-QUITFN MESSAGE "Stop editing, return current settings") (TYPE DISPLAY LABEL "") (TYPE MOMENTARY LABEL "Abort" FONT (GACHA 10 BOLD) SELECTEDFN DATEFORMAT-EDITOR-ABORTFN MESSAGE "Stop editing, ignore changes, return NIL") (TYPE DISPLAY LABEL " Default:") (TYPE MOMENTARY LABEL "Get" FONT (GACHA 10 BOLD) SELECTEDFN DATEFORMAT-EDITOR-GETDFLTFN MESSAGE "Use default settings") (TYPE MOMENTARY LABEL "Put" FONT (GACHA 10 BOLD) SELECTEDFN DATEFORMAT-EDITOR-PUTDFLTFN MESSAGE "Save settings as default") (TYPE DISPLAY LABEL "")) ((TYPE DISPLAY LABEL "")) ((TYPE DISPLAY LABEL "DATE: " FONT (GACHA 10 BOLD))) ((TYPE DISPLAY LABEL " Format: " FONT (GACHA 10 BOLD)) (TYPE NWAY COLLECTION DATE ID DATE-NORMAL LABEL "dd-mon-yy" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN) (TYPE NWAY COLLECTION DATE ID DATE-SLASHES LABEL "dd/mon/yy" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN) (TYPE NWAY COLLECTION DATE ID DATE-NONE LABEL "none" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)) ((TYPE DISPLAY LABEL " ") (TYPE NWAY COLLECTION DATE ID DATE-SPACES LABEL "dd mon yy" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN) (TYPE NWAY COLLECTION DATE ID DATE-LEADING LABEL "mon dd, yy" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)) ((TYPE DISPLAY LABEL " Year: " FONT (GACHA 10 BOLD)) (TYPE NWAY COLLECTION YEAR ID YEAR-LONG LABEL "long" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN) (TYPE NWAY COLLECTION YEAR ID YEAR-SHORT LABEL "short" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)) ((TYPE DISPLAY LABEL " Month: " FONT (GACHA 10 BOLD)) (TYPE NWAY COLLECTION MONTH ID MONTH-LONG LABEL "long" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN) (TYPE NWAY COLLECTION MONTH ID MONTH-SHORT LABEL "short" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN) (TYPE NWAY COLLECTION MONTH ID MONTH-NUMERIC LABEL "numeric" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)) ((TYPE DISPLAY LABEL " Weekday:" FONT (GACHA 10 BOLD)) (TYPE NWAY COLLECTION DAY ID DAY-LONG LABEL "long" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN) (TYPE NWAY COLLECTION DAY ID DAY-SHORT LABEL "short" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN) (TYPE NWAY COLLECTION DAY ID DAY-NONE LABEL "none" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)) ((TYPE DISPLAY LABEL " Spaces: " FONT (GACHA 10 BOLD)) (TYPE NWAY COLLECTION LEADER ID LEADER-YES LABEL "yes" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN) (TYPE NWAY COLLECTION LEADER ID LEADER-NO LABEL "no" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)) ((TYPE DISPLAY LABEL "")) ((TYPE DISPLAY LABEL "TIME:" FONT (GACHA 10 BOLD))) ((TYPE DISPLAY LABEL " Format: " FONT (GACHA 10 BOLD)) (TYPE NWAY COLLECTION TIME ID TIME-SECS LABEL "hh:mm:ss" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN) (TYPE NWAY COLLECTION TIME ID TIME-MINS LABEL "hh:mm" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN) (TYPE NWAY COLLECTION TIME ID TIME-NONE LABEL "none" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)) ((TYPE DISPLAY LABEL " Time Zone:" FONT (GACHA 10 BOLD)) (TYPE NWAY COLLECTION TIMEZONE ID TIMEZONE-YES LABEL "yes" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN) (TYPE NWAY COLLECTION TIMEZONE ID TIMEZONE-NO LABEL "no" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN))))
(RPAQQ $$DATEFORMAT-EDITOR-ITEMS
(((TYPE MOMENTARY LABEL "Quit" FONT (GACHA 10 BOLD)
SELECTEDFN DATEFORMAT-EDITOR-QUITFN MESSAGE "Stop editing, return current settings")
(TYPE DISPLAY LABEL "")
(TYPE MOMENTARY LABEL "Abort" FONT (GACHA 10 BOLD)
SELECTEDFN DATEFORMAT-EDITOR-ABORTFN MESSAGE
"Stop editing, ignore changes, return NIL")
(TYPE DISPLAY LABEL " Default:")
(TYPE MOMENTARY LABEL "Get" FONT (GACHA 10 BOLD)
SELECTEDFN DATEFORMAT-EDITOR-GETDFLTFN MESSAGE "Use default settings")
(TYPE MOMENTARY LABEL "Put" FONT (GACHA 10 BOLD)
SELECTEDFN DATEFORMAT-EDITOR-PUTDFLTFN MESSAGE "Save settings as default")
(TYPE DISPLAY LABEL ""))
((TYPE DISPLAY LABEL ""))
((TYPE DISPLAY LABEL "DATE: " FONT (GACHA 10 BOLD)))
((TYPE DISPLAY LABEL " Format: " FONT (GACHA 10 BOLD))
(TYPE NWAY COLLECTION DATE ID DATE-NORMAL LABEL "dd-mon-yyyy" SELECTEDFN
DATEFORMAT-EDITOR-SHOWFN)
(TYPE NWAY COLLECTION DATE ID DATE-SLASHES LABEL "dd/mon/yyyy" SELECTEDFN
DATEFORMAT-EDITOR-SHOWFN)
(TYPE NWAY COLLECTION DATE ID DATE-NONE LABEL "none" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN))
((TYPE DISPLAY LABEL " ")
(TYPE NWAY COLLECTION DATE ID DATE-SPACES LABEL "dd mon yyyy" SELECTEDFN
DATEFORMAT-EDITOR-SHOWFN)
(TYPE NWAY COLLECTION DATE ID DATE-LEADING LABEL "mon dd, yyyy??" SELECTEDFN
DATEFORMAT-EDITOR-SHOWFN))
((TYPE DISPLAY LABEL " Year: " FONT (GACHA 10 BOLD))
(TYPE NWAY COLLECTION YEAR ID YEAR-LONG LABEL "long" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)
(TYPE NWAY COLLECTION YEAR ID YEAR-SHORT LABEL "short" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN))
((TYPE DISPLAY LABEL " Month: " FONT (GACHA 10 BOLD))
(TYPE NWAY COLLECTION MONTH ID MONTH-LONG LABEL "long" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)
(TYPE NWAY COLLECTION MONTH ID MONTH-SHORT LABEL "short" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN
)
(TYPE NWAY COLLECTION MONTH ID MONTH-NUMERIC LABEL "numeric" SELECTEDFN
DATEFORMAT-EDITOR-SHOWFN))
((TYPE DISPLAY LABEL " Weekday:" FONT (GACHA 10 BOLD))
(TYPE NWAY COLLECTION DAY ID DAY-LONG LABEL "long" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)
(TYPE NWAY COLLECTION DAY ID DAY-SHORT LABEL "short" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)
(TYPE NWAY COLLECTION DAY ID DAY-NONE LABEL "none" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN))
((TYPE DISPLAY LABEL " Spaces: " FONT (GACHA 10 BOLD))
(TYPE NWAY COLLECTION LEADER ID LEADER-YES LABEL "yes" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)
(TYPE NWAY COLLECTION LEADER ID LEADER-NO LABEL "no" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN))
((TYPE DISPLAY LABEL ""))
((TYPE DISPLAY LABEL "TIME:" FONT (GACHA 10 BOLD)))
((TYPE DISPLAY LABEL " Format: " FONT (GACHA 10 BOLD))
(TYPE NWAY COLLECTION TIME ID TIME-SECS LABEL "hh:mm:ss" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN
)
(TYPE NWAY COLLECTION TIME ID TIME-MINS LABEL "hh:mm" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)
(TYPE NWAY COLLECTION TIME ID TIME-NONE LABEL "none" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN))
((TYPE DISPLAY LABEL " Time Zone:" FONT (GACHA 10 BOLD))
(TYPE NWAY COLLECTION TIMEZONE ID TIMEZONE-YES LABEL "yes" SELECTEDFN
DATEFORMAT-EDITOR-SHOWFN)
(TYPE NWAY COLLECTION TIMEZONE ID TIMEZONE-NO LABEL "no" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN
))))
(RPAQ? DATEFORMAT-EDITOR-ITEMS (COPY $$DATEFORMAT-EDITOR-ITEMS))
(RPAQ? DATEFORMAT-EDITOR-ITEMS (COPY $$DATEFORMAT-EDITOR-ITEMS))
(DECLARE%: DONTEVAL@LOAD DOCOPY
(RPAQ $$DATEFORMAT-EDITOR (GET-DATEFORMAT-EDITOR))
(RPAQ $$DATEFORMAT-EDITOR (GET-DATEFORMAT-EDITOR))
(RPAQ $$DATEFORMAT-EDITOR-IDATE (IDATE " 1-Jan-88 23:56:41"))
(COND ((NOT (GETD (QUOTE \OUTDATE-STRING))) (* ; "Get DATE extensions") (FILESLOAD (SYSLOAD) DATEPATCH)))
(RPAQ $$DATEFORMAT-EDITOR-IDATE (IDATE " 1-Jan-1988 23:56:41"))
)
(PUTPROPS DATEFORMAT-EDITOR MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10))
(PUTPROPS DATEFORMAT-EDITOR COPYRIGHT ("Johannes A. G. M. Koomen" 1987 1988 1989))
(PUTPROPS DATEFORMAT-EDITOR MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE
10))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2483 4408 (EDIT-DATEFORMAT 2493 . 3520) (GET-DATEFORMAT-EDITOR 3522 . 4406)) (4513 9803
(DATEFORMAT-EDITOR-STATUS 4523 . 4743) (DATEFORMAT-EDITOR-GET-STATE 4745 . 6551) (
DATEFORMAT-EDITOR-PUT-STATE 6553 . 8363) (DATEFORMAT-EDITOR-SHOW-STATE 8365 . 8616) (
DATEFORMAT-EDITOR-ABORTFN 8618 . 8758) (DATEFORMAT-EDITOR-CLOSEFN 8760 . 8949) (
DATEFORMAT-EDITOR-GETDFLTFN 8951 . 9218) (DATEFORMAT-EDITOR-PUTDFLTFN 9220 . 9456) (
DATEFORMAT-EDITOR-QUITFN 9458 . 9596) (DATEFORMAT-EDITOR-SHOWFN 9598 . 9801)))))
(FILEMAP (NIL (2634 4559 (EDIT-DATEFORMAT 2644 . 3671) (GET-DATEFORMAT-EDITOR 3673 . 4557)) (4658 9948
(DATEFORMAT-EDITOR-STATUS 4668 . 4888) (DATEFORMAT-EDITOR-GET-STATE 4890 . 6696) (
DATEFORMAT-EDITOR-PUT-STATE 6698 . 8508) (DATEFORMAT-EDITOR-SHOW-STATE 8510 . 8761) (
DATEFORMAT-EDITOR-ABORTFN 8763 . 8903) (DATEFORMAT-EDITOR-CLOSEFN 8905 . 9094) (
DATEFORMAT-EDITOR-GETDFLTFN 9096 . 9363) (DATEFORMAT-EDITOR-PUTDFLTFN 9365 . 9601) (
DATEFORMAT-EDITOR-QUITFN 9603 . 9741) (DATEFORMAT-EDITOR-SHOWFN 9743 . 9946)))))
STOP

BIN
lispusers/DATEFORMAT-EDITOR.LCOM
View File

Binary file not shown.

311
lispusers/DOC-OBJECTS
View File

@@ -1,12 +1,31 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
(FILECREATED " 9-Dec-2024 21:07:13" {WMEDLEY}<lispusers>DOC-OBJECTS.;58 52672
(FILECREATED " 3-May-2026 10:44:14" {MEDLEY}<lispusers>DOC-OBJECTS.;2 53774
:EDIT-BY rmk
:EDIT-BY "lmm"
:CHANGES-TO (FNS DOCOBJ-STRING-IMAGEBOX)
:CHANGES-TO (VARS DOC-OBJECTSCOMS)
(FNS DOCOBJ-ACQUIRE-OBJECT DOCOBJ-INIT DOCOBJ-TEDIT-MENU-ENTRY DOCOBJ-GET-LOOKS
DOCOBJ-REGISTER-OBJECT DOCOBJ-STRING-IMAGEBOX DOCOBJ-WAIT-MOUSE
DOCOBJ-BEFOREHARDCOPYFN DOCOBJ-AFTERHARDCOPYFN DOCOBJ-ACQUIRE-EVALED-OBJECT
DOCOBJ-ACQUIRE-SNAPPED-OBJECT 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 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 DOCOBJ-MAKE-HRULE
DOCOBJ-EDIT-HRULE DOCOBJ-HRULE-INIT DOCOBJ-HRULE-GET-WIDTH
DOCOBJ-HRULE-BUTTONEVENTINFN DOCOBJ-MAKE-INCLUDE DOCOBJ-MAKE-INCLUDE-IMAGEFNS
DOCOBJ-INCLUDE-CREATE-OBJ DOCOBJ-INCLUDE-EDIT DOCOBJ-INCLUDE-EDIT-WINDOWP
DOCOBJ-INCLUDE-RESET-OBJ 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)
:PREVIOUS-DATE " 8-Dec-2024 15:49:01" {WMEDLEY}<lispusers>DOC-OBJECTS.;57)
:PREVIOUS-DATE " 9-Dec-2024 21:07:13" {MEDLEY}<lispusers>DOC-OBJECTS.;1)
(PRETTYCOMPRINT DOC-OBJECTSCOMS)
@@ -16,8 +35,7 @@
(* ;;; "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)
(FILES TEDIT IMAGEOBJ)
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL))
(VARS (DocObjectsMenu NIL)
(DocObjectsConfirmEditMenu NIL))
@@ -45,8 +63,7 @@
(* ;; "Time Stamp")
(DECLARE%: DONTCOPY (RECORDS DOCOBJ-TIMESTAMP))
(FILES (SYSLOAD)
DATEFORMAT-EDITOR)
(FILES 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
@@ -70,8 +87,7 @@
(COMS
(* ;; "Horizontal Rule")
(FILES (SYSLOAD)
HRULE READNUMBER)
(FILES HRULE READNUMBER)
(FNS DOCOBJ-MAKE-HRULE DOCOBJ-EDIT-HRULE DOCOBJ-HRULE-INIT DOCOBJ-HRULE-GET-WIDTH
DOCOBJ-HRULE-BUTTONEVENTINFN)
(VARS (DOCOBJ-HRULE-RULE-PAD)
@@ -107,8 +123,7 @@
)
(FILESLOAD (SYSLOAD)
TEDIT IMAGEOBJ)
(FILESLOAD TEDIT IMAGEOBJ)
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD TEDIT-EXPORTS.ALL)
@@ -146,21 +161,17 @@
(MENU DocObjectsMenu])
(DOCOBJ-INIT
[LAMBDA NIL (* ;
 "Edited 8-Oct-87 21:32 by Koomen")
[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"])
(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")
[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.")
@@ -201,8 +212,8 @@
(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")
(* ;; "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
@@ -230,11 +241,8 @@
XKERN _ 0])
(DOCOBJ-WAIT-MOUSE
[LAMBDA (STREAM) (* ;
 "Edited 8-Oct-87 23:46 by Koomen")
(while (NOT (MOUSESTATE UP)) bind (REGION _ (DSPCLIPPINGREGION
NIL STREAM))
[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])
@@ -346,10 +354,9 @@
(DEFINEQ
(DOCOBJ-ACQUIRE-EVALED-OBJECT
[LAMBDA NIL (* Koomen "30-Sep-86 02:08")
(* * This is the original function called under
 GET.OBJ.FROM.USER * *)
[LAMBDA NIL (* Koomen "30-Sep-86 02:08")
(* * This is the original function called under GET.OBJ.FROM.USER * *)
(PROMPTFOREVALED "Form to eval: "])
)
@@ -364,7 +371,7 @@
(DEFINEQ
(DOCOBJ-ACQUIRE-SNAPPED-OBJECT
[LAMBDA NIL (* Koomen "26-Sep-86 16:55")
[LAMBDA NIL (* Koomen "26-Sep-86 16:55")
(GETREGION])
)
@@ -382,34 +389,27 @@
)
)
(FILESLOAD (SYSLOAD)
DATEFORMAT-EDITOR)
(FILESLOAD DATEFORMAT-EDITOR)
(DEFINEQ
(DOCOBJ-EDIT-TIMESTAMP
[LAMBDA (TIMESTAMP) (* Koomen " 4-Feb-87 14:08")
(PROG [(FORMAT (EDIT-DATEFORMAT (fetch (DOCOBJ-TIMESTAMP FORMAT)
of 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)
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))
[LAMBDA NIL (* Koomen " 4-Feb-87 13:54")
(DECLARE (GLOBALVARS DOCOBJ-TIMESTAMP-IMAGEFNS DocObjectsTimeStampFormat))
(IMAGEOBJCREATE (create DOCOBJ-TIMESTAMP
IDATE _ (IDATE)
FORMAT _ DocObjectsTimeStampFormat)
IDATE _ (IDATE)
FORMAT _ DocObjectsTimeStampFormat)
DOCOBJ-TIMESTAMP-IMAGEFNS])
(DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS
[LAMBDA NIL (* ;
 "Edited 8-Oct-87 22:53 by Koomen")
[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))
@@ -423,68 +423,58 @@
(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])
(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")
[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))
(if (DOCOBJ-EDIT-TIMESTAMP (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM))
then 'CHANGED])
(DOCOBJ-TIMESTAMP-COPYFN
[LAMBDA (IMAGEOBJ SOURCEHOSTSTREAM TARGETHOSTSTREAM)
(* Koomen "31-Jan-87 00:30")
[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])
[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")
[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")
[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")
[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")
[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")
[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])
(replace (DOCOBJ-TIMESTAMP DATESTR) of TIMESTAMP with (GDATE (fetch (DOCOBJ-TIMESTAMP IDATE)
of TIMESTAMP)
(fetch (DOCOBJ-TIMESTAMP FORMAT)
of TIMESTAMP])
)
(RPAQ? DocObjectsTimeStampFormat )
@@ -501,18 +491,14 @@
(DEFINEQ
(DOCOBJ-MAKE-FILESTAMP
[LAMBDA NIL (* ;
 "Edited 8-Oct-87 22:55 by Koomen")
[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")
[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))
@@ -526,46 +512,33 @@
(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])
(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")
[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")
[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")
[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")
[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")
[LAMBDA (IMAGEOBJ NODEFAULTFLG) (* ; "Edited 8-Oct-87 22:59 by Koomen")
(PROG [(FULLNAME (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM]
(RETURN (OR (if FULLNAME
then (if (LITATOM FULLNAME)
@@ -576,9 +549,7 @@
then "-- not yet filed --"])
(DOCOBJ-FILESTAMP-NEW-FULLNAME
[LAMBDA (TEXTOBJ) (* ;
 "Edited 8-Oct-87 22:52 by Koomen")
[LAMBDA (TEXTOBJ) (* ; "Edited 8-Oct-87 22:52 by Koomen")
(PROG ((FULLNAME (FULLNAME TEXTOBJ)))
(RETURN (if FULLNAME
then (if (LITATOM FULLNAME)
@@ -587,15 +558,11 @@
then (COPYALL FULLNAME])
(DOCOBJ-FILESTAMP-PREPRINTFN
[LAMBDA (IMAGEOBJ) (* ;
 "Edited 8-Oct-87 22:56 by Koomen")
[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")
[LAMBDA (IMAGEOBJ FILESTREAM) (* ; "Edited 8-Oct-87 22:39 by Koomen")
(PROG [(FULLNAME (MKSTRING (FULLNAME FILESTREAM]
(IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM FULLNAME)
(PRINT FULLNAME FILESTREAM])
@@ -611,22 +578,19 @@
(* ;; "Horizontal Rule")
(FILESLOAD (SYSLOAD)
HRULE READNUMBER)
(FILESLOAD 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])
[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]
[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)))
@@ -634,18 +598,18 @@
(RETURN IMAGEOBJ])
(DOCOBJ-HRULE-INIT
[LAMBDA NIL (* Koomen " 4-Feb-87 16:13")
(* * provide HRULE editing * *)
[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))
(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")
[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)
@@ -660,10 +624,8 @@
T])
(DOCOBJ-HRULE-BUTTONEVENTINFN
[LAMBDA (IMAGEOBJ WINDOWSTREAM SELECTION RELX RELY WINDOW HOSTSTREAM
BUTTON) (* ;
 "Edited 8-Oct-87 23:43 by Koomen")
[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)
@@ -696,7 +658,6 @@
(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
@@ -705,7 +666,6 @@
(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))
@@ -719,7 +679,7 @@
(WHENCOPIEDFN (FUNCTION NILL))
(WHENOPERATEDONFN (FUNCTION NILL))
(PREPRINTFN (FUNCTION DOCOBJ-INCLUDE-PREPRINTFN)))
(IMAGEFNSCREATE DISPLAYFN IMAGEBOXFN PUTFN GETFN COPYFN BUTTONEVENTINFN COPYBUTTONEVENTINFN
(IMAGEFNSCREATE DISPLAYFN IMAGEBOXFN PUTFN GETFN COPYFN BUTTONEVENTINFN COPYBUTTONEVENTINFN
WHENMOVEDFN WHENINSERTEDFN WHENDELETEDFN WHENCOPIEDFN WHENOPERATEDONFN PREPRINTFN])
(DOCOBJ-INCLUDE-CREATE-OBJ
@@ -912,7 +872,6 @@
(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
@@ -927,28 +886,24 @@
(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")
(* ;; "Version 1: Just filename as string")
(* ;; "Version 2: List whose CAR is filename")
(SETQ INCLOBJ (create INCLOBJ
FILENAME _ INCLOBJ)))
FILENAME _ INCLOBJ)))
(if (NLISTP (CDR INCLOBJ))
then
(* ;; "Version 3: List whose CADR is ENABLEDP flag")
(* ;; "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)
@@ -959,19 +914,17 @@
else 'DONTINCLDISPLAYSTRING))
IMAGESTREAM)))
(create IMAGEBOX
XSIZE _ 0
YSIZE _ 0
YDESC _ 0
XKERN _ 0])
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])
)
@@ -993,29 +946,29 @@
(PUTPROPS DOC-OBJECTS MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10))
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (7640 21328 (DOCOBJ-ACQUIRE-OBJECT 7650 . 8651) (DOCOBJ-INIT 8653 . 9281) (
DOCOBJ-TEDIT-MENU-ENTRY 9283 . 9705) (DOCOBJ-GET-LOOKS 9707 . 12167) (DOCOBJ-REGISTER-OBJECT 12169 .
12823) (DOCOBJ-STRING-IMAGEBOX 12825 . 13881) (DOCOBJ-WAIT-MOUSE 13883 . 14343) (
DOCOBJ-BEFOREHARDCOPYFN 14345 . 19815) (DOCOBJ-AFTERHARDCOPYFN 19817 . 21326)) (21358 21625 (
DOCOBJ-ACQUIRE-EVALED-OBJECT 21368 . 21623)) (21825 21967 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 21835 . 21965
)) (22306 27102 (DOCOBJ-EDIT-TIMESTAMP 22316 . 22845) (DOCOBJ-MAKE-TIMESTAMP 22847 . 23258) (
DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 23260 . 24330) (DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 24332 . 24863) (
DOCOBJ-TIMESTAMP-COPYFN 24865 . 25190) (DOCOBJ-TIMESTAMP-DISPLAYFN 25192 . 25485) (
DOCOBJ-TIMESTAMP-GETFN 25487 . 25727) (DOCOBJ-TIMESTAMP-IMAGEBOXFN 25729 . 26085) (
DOCOBJ-TIMESTAMP-PREPRINTFN 26087 . 26318) (DOCOBJ-TIMESTAMP-PUTFN 26320 . 26689) (
DOCOBJ-TIMESTAMP-TO-STRING 26691 . 27100)) (27396 31703 (DOCOBJ-MAKE-FILESTAMP 27406 . 27747) (
DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 27749 . 28791) (DOCOBJ-FILESTAMP-COPYFN 28793 . 29108) (
DOCOBJ-FILESTAMP-DISPLAYFN 29110 . 29398) (DOCOBJ-FILESTAMP-GETFN 29400 . 29753) (
DOCOBJ-FILESTAMP-IMAGEBOXFN 29755 . 30093) (DOCOBJ-FILESTAMP-GET-FULLNAME 30095 . 30713) (
DOCOBJ-FILESTAMP-NEW-FULLNAME 30715 . 31188) (DOCOBJ-FILESTAMP-PREPRINTFN 31190 . 31399) (
DOCOBJ-FILESTAMP-PUTFN 31401 . 31701)) (32026 34523 (DOCOBJ-MAKE-HRULE 32036 . 32450) (
DOCOBJ-EDIT-HRULE 32452 . 32924) (DOCOBJ-HRULE-INIT 32926 . 33258) (DOCOBJ-HRULE-GET-WIDTH 33260 .
34071) (DOCOBJ-HRULE-BUTTONEVENTINFN 34073 . 34521)) (34942 43284 (DOCOBJ-MAKE-INCLUDE 34952 . 35353)
(DOCOBJ-MAKE-INCLUDE-IMAGEFNS 35355 . 36360) (DOCOBJ-INCLUDE-CREATE-OBJ 36362 . 37130) (
DOCOBJ-INCLUDE-EDIT 37132 . 41401) (DOCOBJ-INCLUDE-EDIT-WINDOWP 41403 . 42259) (
DOCOBJ-INCLUDE-RESET-OBJ 42261 . 43282)) (43285 52131 (DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 43295 . 46789)
(DOCOBJ-INCLUDE-CLEANUPFN 46791 . 48310) (DOCOBJ-INCLUDE-BUTTONEVENTINFN 48312 . 48989) (
DOCOBJ-INCLUDE-COPYFN 48991 . 49209) (DOCOBJ-INCLUDE-DISPLAYFN 49211 . 49963) (DOCOBJ-INCLUDE-GETFN
49965 . 50688) (DOCOBJ-INCLUDE-IMAGEBOXFN 50690 . 51699) (DOCOBJ-INCLUDE-PREPRINTFN 51701 . 51920) (
DOCOBJ-INCLUDE-PUTFN 51922 . 52129)))))
(FILEMAP (NIL (9262 22844 (DOCOBJ-ACQUIRE-OBJECT 9272 . 10273) (DOCOBJ-INIT 10275 . 10897) (
DOCOBJ-TEDIT-MENU-ENTRY 10899 . 11306) (DOCOBJ-GET-LOOKS 11308 . 13768) (DOCOBJ-REGISTER-OBJECT 13770
. 14408) (DOCOBJ-STRING-IMAGEBOX 14410 . 15466) (DOCOBJ-WAIT-MOUSE 15468 . 15859) (
DOCOBJ-BEFOREHARDCOPYFN 15861 . 21331) (DOCOBJ-AFTERHARDCOPYFN 21333 . 22842)) (22874 23139 (
DOCOBJ-ACQUIRE-EVALED-OBJECT 22884 . 23137)) (23339 23496 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 23349 . 23494
)) (23818 28482 (DOCOBJ-EDIT-TIMESTAMP 23828 . 24289) (DOCOBJ-MAKE-TIMESTAMP 24291 . 24688) (
DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 24690 . 25709) (DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 25711 . 26186) (
DOCOBJ-TIMESTAMP-COPYFN 26188 . 26473) (DOCOBJ-TIMESTAMP-DISPLAYFN 26475 . 26696) (
DOCOBJ-TIMESTAMP-GETFN 26698 . 26953) (DOCOBJ-TIMESTAMP-IMAGEBOXFN 26955 . 27272) (
DOCOBJ-TIMESTAMP-PREPRINTFN 27274 . 27489) (DOCOBJ-TIMESTAMP-PUTFN 27491 . 27875) (
DOCOBJ-TIMESTAMP-TO-STRING 27877 . 28480)) (28776 32750 (DOCOBJ-MAKE-FILESTAMP 28786 . 29111) (
DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 29113 . 30104) (DOCOBJ-FILESTAMP-COPYFN 30106 . 30381) (
DOCOBJ-FILESTAMP-DISPLAYFN 30383 . 30595) (DOCOBJ-FILESTAMP-GETFN 30597 . 30934) (
DOCOBJ-FILESTAMP-IMAGEBOXFN 30936 . 31204) (DOCOBJ-FILESTAMP-GET-FULLNAME 31206 . 31808) (
DOCOBJ-FILESTAMP-NEW-FULLNAME 31810 . 32267) (DOCOBJ-FILESTAMP-PREPRINTFN 32269 . 32462) (
DOCOBJ-FILESTAMP-PUTFN 32464 . 32748)) (33056 35661 (DOCOBJ-MAKE-HRULE 33066 . 33540) (
DOCOBJ-EDIT-HRULE 33542 . 33984) (DOCOBJ-HRULE-INIT 33986 . 34386) (DOCOBJ-HRULE-GET-WIDTH 34388 .
35218) (DOCOBJ-HRULE-BUTTONEVENTINFN 35220 . 35659)) (36080 44419 (DOCOBJ-MAKE-INCLUDE 36090 . 36490)
(DOCOBJ-MAKE-INCLUDE-IMAGEFNS 36492 . 37495) (DOCOBJ-INCLUDE-CREATE-OBJ 37497 . 38265) (
DOCOBJ-INCLUDE-EDIT 38267 . 42536) (DOCOBJ-INCLUDE-EDIT-WINDOWP 42538 . 43394) (
DOCOBJ-INCLUDE-RESET-OBJ 43396 . 44417)) (44420 53233 (DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 44430 . 47924)
(DOCOBJ-INCLUDE-CLEANUPFN 47926 . 49445) (DOCOBJ-INCLUDE-BUTTONEVENTINFN 49447 . 50124) (
DOCOBJ-INCLUDE-COPYFN 50126 . 50343) (DOCOBJ-INCLUDE-DISPLAYFN 50345 . 51097) (DOCOBJ-INCLUDE-GETFN
51099 . 51809) (DOCOBJ-INCLUDE-IMAGEBOXFN 51811 . 52803) (DOCOBJ-INCLUDE-PREPRINTFN 52805 . 53023) (
DOCOBJ-INCLUDE-PUTFN 53025 . 53231)))))
STOP

BIN
lispusers/DOC-OBJECTS.LCOM
View File

Binary file not shown.