1
0
mirror of synced 2026-05-13 18:44:00 +00:00

Compare commits

..

6 Commits

Author SHA1 Message Date
Matt Heffron
0fda50e67d Make (ARGLIST fn T) and (SMARTARGLIST fn T) a bit "smarter" (#2600)
Make (ARGLIST fn T) and (SMARTARGLIST fn T) a bit "smarter" with the atomic name of the arg for a LAMBDA nospread with a CCODEP definition.
E.g., before (ARGLIST 'FONTCOPY T) returned U; now it returns FONTSPECS as in the CCODEP. Likewise for SMARTARGLIST.
2026-05-12 23:45:23 -07:00
rmkaplan
b7714e4599 Ignore internal/fonts/** (#2608) 2026-05-12 16:03:55 -07:00
rmkaplan
32be423f55 Update WHEELSCROLL.TEDIT (#2606) 2026-05-12 16:03:24 -07:00
Frank Halasz
46df732486 Fix Issue#2603: Erroneous lock violation detection during "./loadup -db" (#2605)
Fix Issue#2603:  fix handling of the internal use only --ignore_lock command line argument to the loadup script.  Was being processed correctly in loadup but then overridden by a reset in loadup-setup.sh.  Removed the reset in loadup-setup.sh
2026-05-11 13:20:49 -07:00
Larry Masinter
01c90e4590 add BAKTRACE to HCFILES fails. Skip HC of CLTL2 (package errors) and dinfo (not really tedit). (#2598)
* add BAKTRACE to HCFILES fails. Skip HC of CLTL2 (package errors) and dinfo (not really tedit).
* IMNAME.TEDIT isn't really TEDIT it's text. rename it.
* internal/mesatypes.tedit now sources/MESATYPES.TXT move from internal to sources (loaded by sources), also move MESATYPE*
2026-05-11 12:21:24 -07:00
rmkaplan
5aa79ebb06 Rmk175 offline font construction (#2555)
* Medleyfont format updated to version 2, revised and more complete fonts deployed in fonts/medleydisplayfonts/
* Rename AFONT to ACFONT, include STRIKE formats
* FILESETS:  Add MCCSFONTS to loadup
* MCCSFONTS:  New file that isolates all of the legacy font translations previously spread in other files (MCCS)
* Medleyfont display fonts created offline using new file library/IMPORTFONTS
* LLCHAR:  Add \MAXCHARSET=65535, \MAXCHAR etc.
* git ignores internal/fonts/**

* MEDLEYDIR: Define the pseudohost {MEDLEY} whose prefix set to the current value of MEDLEYDIR whenever system restarts
* (MEDLEYDIR xxx) entries in MEDLEY-INIT-VARS removed in favor of {MEDLEY}xxx
* Add cdm command to connect to {MEDLEY} and its subdirectories
2026-05-11 12:08:05 -07:00
17 changed files with 321 additions and 292 deletions

3
.gitignore vendored
View File

@@ -49,6 +49,9 @@ internal/fonts/**
# GITFNS deleted subdirectory
deleted/**
# local font construction
internal/fonts/**
#compiled code -- leave in for now
# *.lcom

0
CLTL2/.skip Normal file
View File

0
docs/dinfo/.skip Normal file
View File

View File

@@ -1,16 +1,15 @@
(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 " 8-May-2026 10:41:23" {DSK}<Users>larry>il>MEDLEY>INTERNAL>MEDLEY-UTILS.;2 30963
: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 (ADVICE TEDIT.PROMPTPRINT)
(FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES MAKE-EXPORTS-ALL
MAKE-WHEREIS-HASH MAKE-WHEREIS-LOOPS HCFILES MAKE-INDEX-HTMLS RECOMPILE-ONE
RECMPL COMPILE-SETUP REMAKEFILES)
:PREVIOUS-DATE "16-Apr-2026 22:27:40" {DSK}<home>matt>Interlisp>medley>internal>MEDLEY-UTILS.;1
)
:PREVIOUS-DATE " 4-May-2026 19:19:00" {DSK}<Users>larry>il>MEDLEY>INTERNAL>MEDLEY-UTILS.;1)
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
@@ -215,7 +214,9 @@
(DEFINEQ
(HCFILES
[LAMBDA (BASE REDO SUBSETS) (* ; "Edited 16-Apr-2026 22:42 by mth")
[LAMBDA (BASE REDO SUBSETS) (* ; "Edited 8-May-2026 10:39 by lmm")
(* ; "Edited 4-May-2026 19:18 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 +294,14 @@
(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
(* ;; "ADDED HERE")
(SETQ NLSETQGAG NIL)
(SETQ \TEDIT.THELPFLG T)
(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)
@@ -519,12 +522,14 @@
(TERPRI])
)
(DEFMACRO REPORT-AND-GO (FORM REPORT-FORMAT) (* ; "Edited 16-Apr-2026 16:02 by mth")
(DEFMACRO REPORT-AND-GO (FORM REPORT-FORMAT) (* ; "Edited 4-May-2026 19:02 by lmm")
(* ; "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)
(ERROR-CONDITION (BAKTRACE 'BAKTRACE NIL NIL 1 T)
(PRIN3 (CL:FORMAT NIL ,REPORT-FORMAT ERROR-CONDITION)
T)
NIL)
(T (LIST FORM-RESULT])
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
@@ -536,10 +541,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 (1365 8299 (GATHER-INFO 1375 . 6757) (MAKE-FULLER-DB 6759 . 7668) (MEDLEY-FIX-LINKS 7670
. 8063) (MEDLEY-FIX-DATES 8065 . 8297)) (9871 12447 (MAKE-EXPORTS-ALL 9881 . 10728) (
MAKE-WHEREIS-HASH 10730 . 11919) (MAKE-WHEREIS-LOOPS 11921 . 12445)) (12448 25236 (HCFILES 12458 .
19760) (MAKE-INDEX-HTMLS 19762 . 25234)) (25570 30182 (RECOMPILE-ONE 25580 . 27477) (RECMPL 27479 .
28082) (COMPILE-SETUP 28084 . 28708) (REMAKEFILES 28710 . 30180)) (30184 30807 (REPORT-AND-GO 30184 .
30807)))))
STOP

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

Binary file not shown.

View File

@@ -256,8 +256,6 @@ process_maikodir() {
export LOADUP_LOCKFILE="${LOADUP_WORKDIR}"/lock
LOADUP_LOCK=""
override_lock=false
ignore_lock=false
check_run_lock() {
if [ "${ignore_lock}" = false ]

View File

@@ -1,19 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
(FILECREATED "30-Jun-2022 22:42:02" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLINTERP.;4 120990
(FILECREATED " 8-May-2026 23:51:41" {DSK}<home>matt>Interlisp>medley>sources>LLINTERP.;2 120946
:PREVIOUS-DATE "30-Jun-2022 18:04:04"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLINTERP.;3)
:EDIT-BY "mth"
:CHANGES-TO (FNS \CCODEARGLIST)
:PREVIOUS-DATE "30-Jun-2022 22:42:02" {DSK}<home>matt>Interlisp>medley>sources>LLINTERP.;1)
(* ; "
Copyright (c) 1981-1988, 1990-1992, 1994-1995 by Venue & Xerox Corporation.
The following program was created in 1981 but has not been published
within the meaning of the copyright law, is furnished under license,
and may not be used, copied and/or disclosed except in accordance
with the terms of said license.
")
(PRETTYCOMPRINT LLINTERPCOMS)
@@ -1541,7 +1535,8 @@ with the terms of said license.
(T (ERROR '"Args not available:" FN])
(\CCODEARGLIST
[LAMBDA (FNHD SMARTP) (* ; "Edited 10-May-88 12:18 by MASINTER")
[LAMBDA (FNHD SMARTP) (* ; "Edited 8-May-2026 23:44 by mth")
(* ; "Edited 10-May-88 12:18 by MASINTER")
(* ;; "Computes the arglist for raw code object FNHD. If SMARTP is true, we're allowed to return a Common Lisp arg list if we find one; otherwise, we have to comply with Interlisp arglist semantics.")
@@ -1556,53 +1551,55 @@ with the terms of said license.
(SETQ SIZE (fetch (FNHEADER NTSIZE) of FNHD))
[COND
((EQ [SETQ LOCALSIZE (- (FOLDLO (if (fetch (FNHEADER NATIVE) of FNHD)
then (- (fetch (FNHEADER STARTPC)
of FNHD)
4)
then (- (fetch (FNHEADER STARTPC) of FNHD)
4)
else (fetch (FNHEADER STARTPC) of FNHD))
BYTESPERWORD)
(SETQ ENDT (+ (fetch (FNHEADER OVERHEADWORDS) of T)
(COND
((EQ SIZE 0)
(* ;
 "No nametable, but there's a quad of zeros there anyway")
 "No nametable, but there's a quad of zeros there anyway")
WORDSPERQUAD)
(T (UNFOLD SIZE 2]
0) (* ; "Nothing extra here")
)
[(> LOCALSIZE WORDSPERCELL) (* ;
 "There is a second nametable between the first and the code.")
 "There is a second nametable between the first and the code.")
(SETQ IVARS (\CCODEIVARSCAN FNHD ENDT (FOLDLO LOCALSIZE 2]
((AND (LISTP (SETQ ENDT (\GETBASEPTR FNHD ENDT)))
(LISTP (CAR ENDT))) (* ;
 "It's exactly a pointer to debugging info, car of which is a stylized arglist")
 "It's exactly a pointer to debugging info, car of which is a stylized arglist")
(SETQ ENDT (if (AND (EQ (CAAR ENDT)
'&OPTIONAL)
(LISTGET (CDR ENDT)
:INTERLISP))
then (* ; "The &OPTIONAL, while strictly correct, is misleading, since it's technically true for ALL Interlisp functions.")
(CDAR ENDT)
'&OPTIONAL)
(LISTGET (CDR ENDT)
:INTERLISP))
then (* ; "The &OPTIONAL, while strictly correct, is misleading, since it's technically true for ALL Interlisp functions.")
(CDAR ENDT)
else (CAR ENDT)))
(RETURN (COND
(SMARTP ENDT)
(T (* ; "Note that if we got this far, function can't be a nospread (we caught this in the very first COND up above), which means there can't be any &key or &rest")
(for X in ENDT unless (EQ X '&OPTIONAL)
collect (COND
((STRINGP X) (* ;
 "Callers of ARGLIST are expecting to get something that would actually function as one")
(MKATOM X))
(T X]
(for X in ENDT unless (EQ X '&OPTIONAL) collect (COND
((STRINGP X)
(* ;
 "Callers of ARGLIST are expecting to get something that would actually function as one")
(MKATOM X))
(T X]
[COND
((< N 0) (* ;
 "Waited until now to see if there was a stored arglist, but we didn't find one--give up")
(RETURN 'U]
 "Waited until now to see if there was a stored arglist, but we didn't find one--give up")
(RETURN (COND
((AND (EQ 2 (fetch (FNHEADER ARGTYPE) of FNHD))
(SETQ IVARS (ASSOC 0 IVARS)))
(CDR IVARS))
(T 'U]
[COND
((NEQ SIZE 0) (* ; "Scan specials name table")
(SETQ IVARS (\CCODEIVARSCAN FNHD (fetch (FNHEADER OVERHEADWORDS) of T)
SIZE IVARS]
[SETQ IVARS (for I from 0 to (SUB1 N)
collect (OR (CDR (ASSOC I IVARS))
(PACK* '*ARG* I]
[SETQ IVARS (for I from 0 to (SUB1 N) collect (OR (CDR (ASSOC I IVARS))
(PACK* '*ARG* I]
(RETURN (SELECTQ (fetch (FNHEADER ARGTYPE) of FNHD)
(3 (CAR IVARS))
IVARS])
@@ -1745,33 +1742,31 @@ with the terms of said license.
(ADDTOVAR LAMA APPLY* \INTERPRETER)
)
(PUTPROPS LLINTERP COPYRIGHT ("Venue & Xerox Corporation" T 1981 1982 1983 1984 1985 1986 1987 1988
1990 1991 1992 1994 1995))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6409 23670 (\INTERPRETER 6419 . 11015) (\INTERPRETER1 11017 . 17585) (
\SETUP-COMPILED-CLOSURE-CALL 17587 . 22734) (\STKNAME 22736 . 23668)) (23699 29111 (\ENVCALL.UFN 23709
. 23841) (\SETUP-ENVIRONMENT-CALL 23843 . 29109)) (29150 34027 (EVAL 29160 . 29260) (\EVAL 29262 .
29472) (\EVALFORM 29474 . 30705) (\EVALFORMASLAMBDA 30707 . 30897) (\EVALOTHER 30899 . 31106) (APPLY
31108 . 31215) (APPLY* 31217 . 32332) (\CHECKAPPLY* 32334 . 33439) (\CKAPPLYARGS 33441 . 33784) (
DEFEVAL 33786 . 34025)) (35871 43460 (EVALV 35881 . 36090) (\EVALV1 36092 . 36247) (\EVALVAR 36249 .
36612) (BOUNDP 36614 . 36830) (SET 36832 . 37198) (\SETVAR 37200 . 37570) (SETQ 37572 . 38244) (
\STKSCAN 38246 . 41910) (\SETFVARSLOT 41912 . 43458)) (43494 56501 (PROG 43504 . 46020) (\PROG0 46022
. 49652) (\EVPROG1 49654 . 49857) (RETURN 49859 . 50400) (GO 50402 . 51217) (EVALA 51219 . 53148) (
\EVALA 53150 . 55743) (ERRORSET 55745 . 56350) (SI::ERRORSET-PRINT-FUNCTION 56352 . 56499)) (56560
69212 (LET 56570 . 58713) (LET* 58715 . 60863) (\LET0 60865 . 64525) (\LET* 64527 . 69210)) (69213
70789 (QUOTE 69223 . 69254) (AND 69256 . 69464) (OR 69466 . 69714) (PROGN 69716 . 69995) (COND 69997
. 70331) (\EVPROGN 70333 . 70546) (PROG1 70548 . 70787)) (71277 78168 (ENVEVAL 71287 . 71537) (
ENVAPPLY 71539 . 71796) (FUNCTION 71798 . 72028) (\FUNCT1 72030 . 74479) (\MAKEFUNARGFRAME 74481 .
76678) (STKEVAL 76680 . 76828) (STKAPPLY 76830 . 76999) (RETEVAL 77001 . 77605) (RETAPPLY 77607 .
78166)) (78289 85797 (BLIPVAL 78299 . 82200) (SETBLIPVAL 82202 . 84944) (BLIPSCAN 84946 . 85795)) (
85798 86493 (\REALFRAMEP 85808 . 86491)) (86869 96264 (RAIDCOMMAND 86879 . 90485) (RAIDSHOWFRAME 90487
. 90870) (RAIDSTACKCMD 90872 . 92053) (RAIDROOTFRAME 92055 . 92317) (PRINTADDRS 92319 . 92845) (
PRINTVA 92847 . 92992) (READVA 92994 . 93072) (READATOM 93074 . 93656) (READOCT 93658 . 94289) (
SHOWSTACKBLOCKS 94291 . 95537) (SHOWSTACKBLOCK1 95539 . 95690) (PRINCOPY 95692 . 95824) (NOSUCHATOM
95826 . 96262)) (96265 104893 (BACKTRACE 96275 . 96632) (\BACKTRACE 96634 . 97740) (\SCANFORNTENTRY
97742 . 99372) (\PRINTSTK 99374 . 99561) (\PRINTFRAME 99563 . 103546) (\PRINTBF 103548 . 104891)) (
107393 116737 (CCODEP 107403 . 107678) (EXPRP 107680 . 107939) (SUBRP 107941 . 107996) (FNTYP 107998
. 108758) (ARGTYPE 108760 . 109374) (NARGS 109376 . 109863) (ARGLIST 109865 . 111114) (\CCODEARGLIST
111116 . 115512) (\CCODEIVARSCAN 115514 . 116735)) (117687 119918 (CONSTANTS 117697 . 117988) (
CONSTANTEXPRESSIONP 117990 . 119916)))))
(FILEMAP (NIL (6111 23372 (\INTERPRETER 6121 . 10717) (\INTERPRETER1 10719 . 17287) (
\SETUP-COMPILED-CLOSURE-CALL 17289 . 22436) (\STKNAME 22438 . 23370)) (23401 28813 (\ENVCALL.UFN 23411
. 23543) (\SETUP-ENVIRONMENT-CALL 23545 . 28811)) (28852 33729 (EVAL 28862 . 28962) (\EVAL 28964 .
29174) (\EVALFORM 29176 . 30407) (\EVALFORMASLAMBDA 30409 . 30599) (\EVALOTHER 30601 . 30808) (APPLY
30810 . 30917) (APPLY* 30919 . 32034) (\CHECKAPPLY* 32036 . 33141) (\CKAPPLYARGS 33143 . 33486) (
DEFEVAL 33488 . 33727)) (35573 43162 (EVALV 35583 . 35792) (\EVALV1 35794 . 35949) (\EVALVAR 35951 .
36314) (BOUNDP 36316 . 36532) (SET 36534 . 36900) (\SETVAR 36902 . 37272) (SETQ 37274 . 37946) (
\STKSCAN 37948 . 41612) (\SETFVARSLOT 41614 . 43160)) (43196 56203 (PROG 43206 . 45722) (\PROG0 45724
. 49354) (\EVPROG1 49356 . 49559) (RETURN 49561 . 50102) (GO 50104 . 50919) (EVALA 50921 . 52850) (
\EVALA 52852 . 55445) (ERRORSET 55447 . 56052) (SI::ERRORSET-PRINT-FUNCTION 56054 . 56201)) (56262
68914 (LET 56272 . 58415) (LET* 58417 . 60565) (\LET0 60567 . 64227) (\LET* 64229 . 68912)) (68915
70491 (QUOTE 68925 . 68956) (AND 68958 . 69166) (OR 69168 . 69416) (PROGN 69418 . 69697) (COND 69699
. 70033) (\EVPROGN 70035 . 70248) (PROG1 70250 . 70489)) (70979 77870 (ENVEVAL 70989 . 71239) (
ENVAPPLY 71241 . 71498) (FUNCTION 71500 . 71730) (\FUNCT1 71732 . 74181) (\MAKEFUNARGFRAME 74183 .
76380) (STKEVAL 76382 . 76530) (STKAPPLY 76532 . 76701) (RETEVAL 76703 . 77307) (RETAPPLY 77309 .
77868)) (77991 85499 (BLIPVAL 78001 . 81902) (SETBLIPVAL 81904 . 84646) (BLIPSCAN 84648 . 85497)) (
85500 86195 (\REALFRAMEP 85510 . 86193)) (86571 95966 (RAIDCOMMAND 86581 . 90187) (RAIDSHOWFRAME 90189
. 90572) (RAIDSTACKCMD 90574 . 91755) (RAIDROOTFRAME 91757 . 92019) (PRINTADDRS 92021 . 92547) (
PRINTVA 92549 . 92694) (READVA 92696 . 92774) (READATOM 92776 . 93358) (READOCT 93360 . 93991) (
SHOWSTACKBLOCKS 93993 . 95239) (SHOWSTACKBLOCK1 95241 . 95392) (PRINCOPY 95394 . 95526) (NOSUCHATOM
95528 . 95964)) (95967 104595 (BACKTRACE 95977 . 96334) (\BACKTRACE 96336 . 97442) (\SCANFORNTENTRY
97444 . 99074) (\PRINTSTK 99076 . 99263) (\PRINTFRAME 99265 . 103248) (\PRINTBF 103250 . 104593)) (
107095 116821 (CCODEP 107105 . 107380) (EXPRP 107382 . 107641) (SUBRP 107643 . 107698) (FNTYP 107700
. 108460) (ARGTYPE 108462 . 109076) (NARGS 109078 . 109565) (ARGLIST 109567 . 110816) (\CCODEARGLIST
110818 . 115596) (\CCODEIVARSCAN 115598 . 116819)) (117771 120002 (CONSTANTS 117781 . 118072) (
CONSTANTEXPRESSIONP 118074 . 120000)))))
STOP

Binary file not shown.