Compare commits
2 Commits
rmk189--In
...
rmk187--Al
| Author | SHA1 | Date | |
|---|---|---|---|
|
d441397773 | ||
|
|
f17fcef714 |
3
.gitignore
vendored
3
.gitignore
vendored
@@ -49,9 +49,6 @@ internal/fonts/**
|
||||
# GITFNS deleted subdirectory
|
||||
deleted/**
|
||||
|
||||
# local font construction
|
||||
internal/fonts/**
|
||||
|
||||
#compiled code -- leave in for now
|
||||
|
||||
# *.lcom
|
||||
|
||||
@@ -1,15 +1,19 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "12-May-2026 15:33:42" {DSK}<home>matt>Interlisp>medley>library>DATABASEFNS.;5 19557
|
||||
(FILECREATED " 2-May-2026 17:38:46" {DSK}<home>matt>Interlisp>medley>library>DATABASEFNS.;4 18684
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS DUMPDB)
|
||||
|
||||
:PREVIOUS-DATE "12-May-2026 12:45:18" {DSK}<home>matt>Interlisp>medley>library>DATABASEFNS.;4
|
||||
:PREVIOUS-DATE "29-Apr-2026 17:43:56" {DSK}<home>matt>Interlisp>medley>library>DATABASEFNS.;2
|
||||
)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1990-1993, 2024, 2026 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT DATABASEFNSCOMS)
|
||||
|
||||
(RPAQQ DATABASEFNSCOMS
|
||||
@@ -58,8 +62,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(DBFILE
|
||||
[LAMBDA (FILE ASKFLAG) (* ; "Edited 11-May-2026 14:35 by mth")
|
||||
(* ; "Edited 24-Oct-2021 16:50 by rmk:")
|
||||
[LAMBDA (FILE ASKFLAG) (* ; "Edited 24-Oct-2021 16:50 by rmk:")
|
||||
(* lmm "29-APR-81 20:27")
|
||||
|
||||
(* ;; "Finds a database file that corresponds to the contents of FILE. Looks in directory of FILE, and also in the directory that file originally came from, if it was copied. Returns NIL if no database file is found, else (fulldbfilename . filedates), where filedates identifies the name under which the file that the database corresponds to is currently known.")
|
||||
@@ -70,13 +73,13 @@
|
||||
[COND
|
||||
((NULL FILE)
|
||||
(SETQ FILE (INPUT)))
|
||||
((MEMB (U-CASE (FILENAMEFIELD FILE 'EXTENSION))
|
||||
((MEMB (FILENAMEFIELD FILE 'EXTENSION)
|
||||
*COMPILED-EXTENSIONS*) (* ;
|
||||
"Map compiled file into symbolic name")
|
||||
"Map compiled file into symbolic name")
|
||||
(SETQ FILE (PACKFILENAME 'EXTENSION NIL 'VERSION NIL 'BODY FILE]
|
||||
(LET [(FILEDATES (COND
|
||||
[(AND (NULL (FILENAMEFIELD FILE 'VERSION))
|
||||
(CAR (GETPROP (ROOTFILENAME FILE)
|
||||
(CAR (GETPROP (NAMEFIELD FILE)
|
||||
'FILEDATES]
|
||||
([SETQ FILE (COND
|
||||
(ASKFLAG (INFILEP FILE))
|
||||
@@ -162,22 +165,14 @@
|
||||
(DEFINEQ
|
||||
|
||||
(DUMPDB
|
||||
[LAMBDA (FILE PROPFLG) (* ; "Edited 12-May-2026 15:31 by mth")
|
||||
(* ; "Edited 12-May-2026 12:45 by rmk")
|
||||
(* ; "Edited 11-May-2026 14:41 by mth")
|
||||
(* ; "Edited 8-May-2026 16:18 by mth")
|
||||
(* ; "Edited 2-May-2026 17:32 by mth")
|
||||
[LAMBDA (FILE PROPFLG) (* ; "Edited 2-May-2026 17:32 by mth")
|
||||
(* ; "Edited 29-Apr-2026 17:42 by mth")
|
||||
(* ; "Edited 20-Feb-2024 23:45 by mth")
|
||||
(* ; "Edited 7-Feb-2024 18:26 by mth")
|
||||
(* ; "Edited 27-Oct-2021 10:51 by larry")
|
||||
(* ; "Edited 24-Oct-2021 16:24 by rmk:")
|
||||
|
||||
(* ;; "Dumps a Masterscope database for functions in FILE. ")
|
||||
|
||||
(* ;; "Checks the DATABASE property if PROPFLG=T which is how the MAKEFILE advice calls it. ")
|
||||
|
||||
(* ;; "A user-level call would default PROPFLG to NIL.")
|
||||
(* ;; "Dumps a Masterscope database for functions in FILE. Checks the DATABASE property if PROPFLG=T which is how the MAKEFILE advice calls it. A user-level call would default PROPFLG to NIL.")
|
||||
|
||||
(* ;; "The FILE check is because MAKEFILE returns a list when it doesn't understand the options")
|
||||
|
||||
@@ -188,73 +183,72 @@
|
||||
(LET ((SAVEDCOPYRIGHTFLG COPYRIGHTFLG)
|
||||
(SAVEDDEFAULTCOPYRIGHTOWNER DEFAULTCOPYRIGHTOWNER))
|
||||
(CL:UNWIND-PROTECT
|
||||
(PROG* (DBFILE DBFN DBROOTFN FLCPR (FL (ROOTFILENAME FILE))
|
||||
(FNS (FILEFNSLST FL)))
|
||||
(SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE))
|
||||
(SETQ DBROOTFN (ROOTFILENAME DBFN))
|
||||
(CL:UNLESS (OR (EQ COPYRIGHTFLG 'NEVER)
|
||||
(NULL DEFAULTDATABASECOPYRIGHTOWNER)
|
||||
(GETPROP DBROOTFN 'COPYRIGHT))
|
||||
(SELECTQ DEFAULTDATABASECOPYRIGHTOWNER
|
||||
((NONE NEVER)
|
||||
(* ;;
|
||||
(PROG (DBFILE DBFN DBROOTFN FLCPR (FL (ROOTFILENAME FILE))
|
||||
(FNS (FILEFNSLST FILE)))
|
||||
(SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE))
|
||||
(SETQ DBROOTFN (ROOTFILENAME DBFN))
|
||||
(CL:UNLESS (OR (EQ COPYRIGHTFLG 'NEVER)
|
||||
(NULL DEFAULTDATABASECOPYRIGHTOWNER)
|
||||
(GETPROP DBROOTFN 'COPYRIGHT))
|
||||
(SELECTQ DEFAULTDATABASECOPYRIGHTOWNER
|
||||
((NONE NEVER)
|
||||
(* ;;
|
||||
"Set the COPYRIGHT to NONE (I.e., never mention it again.)")
|
||||
|
||||
(/PUT DBROOTFN 'COPYRIGHT (LIST 'NONE)))
|
||||
(SAME
|
||||
(* ;;
|
||||
(/PUT DBROOTFN 'COPYRIGHT (LIST 'NONE)))
|
||||
(SAME
|
||||
(* ;;
|
||||
"Same as the source file. If it doesn't have one, then just normal handling")
|
||||
|
||||
(CL:WHEN (SETQ FLCPR (GETPROP FL 'COPYRIGHT))
|
||||
(/PUT DBROOTFN 'COPYRIGHT (LIST (CAR FLCPR)))))
|
||||
(DEFAULT
|
||||
(* ;; "Use the general default for copyright")
|
||||
(CL:WHEN (SETQ FLCPR (GETPROP FL 'COPYRIGHT))
|
||||
(/PUT DBROOTFN 'COPYRIGHT (LIST (CAR FLCPR)))))
|
||||
(DEFAULT
|
||||
(* ;; "Use the general default for copyright")
|
||||
|
||||
(SETQ COPYRIGHTFLG 'DEFAULT))
|
||||
(PROGN (SETQ COPYRIGHTFLG 'DEFAULT)
|
||||
(SETQ COPYRIGHTFLG 'DEFAULT))
|
||||
(PROGN (SETQ COPYRIGHTFLG 'DEFAULT)
|
||||
|
||||
(* ;;
|
||||
(* ;;
|
||||
"Hopefully, DEFAULTDATABASECOPYRIGHTOWNER is one of the COPYRIGHTOWNERS keys")
|
||||
|
||||
(SETQ DEFAULTCOPYRIGHTOWNER DEFAULTDATABASECOPYRIGHTOWNER))))
|
||||
(COND
|
||||
(FNS)
|
||||
((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE)))
|
||||
(SETQ DEFAULTCOPYRIGHTOWNER DEFAULTDATABASECOPYRIGHTOWNER))))
|
||||
(COND
|
||||
(FNS)
|
||||
((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE)))
|
||||
(* ;
|
||||
"Always dump if this is a known file")
|
||||
(SETQ PROPFLG NIL))
|
||||
(T (COND
|
||||
(PROPFLG (/REMPROP FL 'DATABASE))
|
||||
(T (printout T T FILE " has no functions." T)))
|
||||
(RETURN)))
|
||||
(CL:WHEN [OR (NULL PROPFLG)
|
||||
(EQ (GETPROP FL 'DATABASE)
|
||||
'YES)
|
||||
(EQ SAVEDBFLG 'YES)
|
||||
(AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
|
||||
(CL:WHEN MSFILETABLE
|
||||
[STORETABLE FL MSFILETABLE (CAR (GETPROP FL 'FILEDATES])
|
||||
[SETQ DBFILE
|
||||
(PRETTYDEF NIL DBFN
|
||||
`((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
|
||||
(ERROR!)))
|
||||
(E [PRINT (CAR (GETPROP ',FL 'FILEDATES]
|
||||
(DUMPDATABASE ',FNS]
|
||||
[COND
|
||||
(PROPFLG (PRINT (FULLNAME DBFILE)
|
||||
T))
|
||||
(T (/PUT FL 'DATABASEFILENAME DBFILE)
|
||||
(SETQ PROPFLG NIL))
|
||||
(T (COND
|
||||
(PROPFLG (/REMPROP FL 'DATABASE))
|
||||
(T (printout T T FILE " has no functions." T)))
|
||||
(RETURN)))
|
||||
(CL:WHEN [OR (NULL PROPFLG)
|
||||
(EQ (GETPROP FL 'DATABASE)
|
||||
'YES)
|
||||
(EQ SAVEDBFLG 'YES)
|
||||
(AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
|
||||
(CL:WHEN MSFILETABLE
|
||||
[STORETABLE FL MSFILETABLE (CAR (GETPROP FL 'FILEDATES])
|
||||
[SETQ DBFILE
|
||||
(PRETTYDEF NIL DBFN
|
||||
`((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
|
||||
(ERROR!)))
|
||||
(E [PRINT (CAR (GETPROP ',FL 'FILEDATES]
|
||||
(DUMPDATABASE ',FNS]
|
||||
[COND
|
||||
(PROPFLG (PRINT (FULLNAME DBFILE)
|
||||
T))
|
||||
(T (/PUT FL 'DATABASEFILENAME DBFILE)
|
||||
(* ;
|
||||
"Remember that we have this file valid already.")
|
||||
(/PUT FL 'DATABASE 'YES] (* ;
|
||||
(/PUT FL 'DATABASE 'YES] (* ;
|
||||
"Take future note of the database on a user call")
|
||||
(RETURN DBFILE))))
|
||||
(RETURN DBFILE))))
|
||||
(SETQ COPYRIGHTFLG SAVEDCOPYRIGHTFLG)
|
||||
(SETQ DEFAULTCOPYRIGHTOWNER SAVEDDEFAULTCOPYRIGHTOWNER)))])
|
||||
|
||||
(LOADDB
|
||||
[LAMBDA (FILE ASKFLAG) (* ; "Edited 11-May-2026 14:37 by mth")
|
||||
(* ; "Edited 24-Oct-2021 17:44 by rmk:")
|
||||
[LAMBDA (FILE ASKFLAG) (* ; "Edited 24-Oct-2021 17:44 by rmk:")
|
||||
(* ; "Edited 7-Jul-92 09:57 by rmk:")
|
||||
|
||||
(* ;; "Loads the database file corresponding to FILE, asking for confirmation only if ASKFLAG is T, which is the case from the advice on LOAD but not from usual user-level calls. Before asking, it looks around first to see whether a database file of the appropriate name really exists.")
|
||||
@@ -263,7 +257,7 @@
|
||||
(RESETLST
|
||||
[PROG* [TEM FORFILE (*READTABLE* (FIND-READTABLE "INTERLISP"))
|
||||
(*PACKAGE* (CL:FIND-PACKAGE "INTERLISP"))
|
||||
(NF (ROOTFILENAME FILE))
|
||||
(NF (NAMEFIELD FILE))
|
||||
(DBSTREAM (DBFILE FILE ASKFLAG))
|
||||
(DBFILE (FULLNAME (CAR DBSTREAM]
|
||||
(COND
|
||||
@@ -271,15 +265,14 @@
|
||||
(SETQ DBSTREAM (CAR DBSTREAM)))
|
||||
(T (COND
|
||||
((NULL ASKFLAG)
|
||||
(PRINTOUT T "no database file found for " (NAMEFIELD FILE)
|
||||
T)))
|
||||
(PRINTOUT T "no database file found for " NF T)))
|
||||
(RETURN)))
|
||||
(COND
|
||||
([COND
|
||||
[ASKFLAG (COND
|
||||
((EQ (GETPROP NF 'DATABASEFILENAME)
|
||||
DBFILE) (* ;
|
||||
"If the database for this very file has already been loaded, don't bother doing it again.")
|
||||
"If the database for this very file has already been loaded, don't bother doing it again.")
|
||||
(PRINTOUT T "Database " DBFILE " already loaded." T)
|
||||
NIL)
|
||||
(T (SELECTQ (GETPROP NF 'DATABASE)
|
||||
@@ -320,30 +313,28 @@
|
||||
(READATABASE)))
|
||||
(AND MSFILETABLE (STORETABLE NF MSFILETABLE FORFILE))
|
||||
(* ;
|
||||
"This is done whether or not there is a hashfile.")
|
||||
"This is done whether or not there is a hashfile.")
|
||||
(UPDATEFILES) (* ;
|
||||
"Mark any edited fns as needing to be reanalyzed.")
|
||||
(FOR FN IN (CDR (GETP NF 'FILE)) WHEN (OR (EXPRP FN)
|
||||
(GETP FN 'EXPR))
|
||||
DO (MSMARKCHANGED FN)))
|
||||
"Mark any edited fns as needing to be reanalyzed.")
|
||||
(FOR FN IN (CDR (GETP NF 'FILE))
|
||||
WHEN (OR (EXPRP FN)
|
||||
(GETP FN 'EXPR)) DO (MSMARKCHANGED FN)))
|
||||
(T (PRINTOUT T T DBFILE " is not a database file!" T)
|
||||
(* ; "So that value of LOADDB is NIL")
|
||||
(SETQ DBFILE NIL)))
|
||||
(/PUT NF 'DATABASEFILENAME DBFILE) (* ;
|
||||
"Remember the name of the database we just loaded.")
|
||||
"Remember the name of the database we just loaded.")
|
||||
(RETURN (FULLNAME DBFILE])])
|
||||
|
||||
(MAKEDB
|
||||
[LAMBDA (F) (* DECLARATIONS%: UNDOABLE)
|
||||
(* ; "Edited 12-May-2026 12:37 by rmk")
|
||||
(* ; "Edited 11-May-2026 14:38 by mth")
|
||||
(* rmk%: " 9-NOV-83 02:56")
|
||||
(DECLARE (GLOBALVARS SAVEDBFLG MSFILETABLE DWIMWAIT))
|
||||
(SETQ F (ROOTFILENAME F))
|
||||
|
||||
(* The extension is stripped off for purposes of the DATABASE.
|
||||
This maps compiled files into the root name, but means that we can't have
|
||||
multiple-extension files with different database status)
|
||||
(SETQ F (NAMEFIELD F))
|
||||
|
||||
(* The extension is stripped off for purposes of the DATABASE.
|
||||
This maps compiled files into the root name, but means that we can't have
|
||||
multiple-extension files with different database status)
|
||||
|
||||
(COND
|
||||
((INFILECOMS? T 'FNS (FILECOMS F))
|
||||
@@ -387,8 +378,9 @@
|
||||
|
||||
(RESETSAVE DWIMIFYCOMPFLG T)
|
||||
)
|
||||
(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993 2024 2026))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1708 6856 (DBFILE 1718 . 3486) (DBFILE1 3488 . 4998) (DBFILE2 5000 . 6222) (LOAD 6224
|
||||
. 6454) (LOADFROM 6456 . 6644) (MAKEFILE 6646 . 6854)) (6912 19035 (DUMPDB 6922 . 12674) (LOADDB
|
||||
12676 . 17747) (MAKEDB 17749 . 19033)))))
|
||||
(FILEMAP (NIL (1783 6808 (DBFILE 1793 . 3438) (DBFILE1 3440 . 4950) (DBFILE2 4952 . 6174) (LOAD 6176
|
||||
. 6406) (LOADFROM 6408 . 6596) (MAKEFILE 6598 . 6806)) (6864 18072 (DUMPDB 6874 . 12107) (LOADDB
|
||||
12109 . 16984) (MAKEDB 16986 . 18070)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "13-May-2026 12:28:06" {MEDLEY}<library>UNIXUTILS.;62 22210
|
||||
(FILECREATED "28-Apr-2026 09:59:13" {WMEDLEY}<library>UNIXUTILS.;61 22079
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS UNIX-FILE-NAME)
|
||||
:CHANGES-TO (VARS UNIXUTILSCOMS)
|
||||
|
||||
:PREVIOUS-DATE "28-Apr-2026 09:59:13" {MEDLEY}<library>UNIXUTILS.;61)
|
||||
:PREVIOUS-DATE "27-Apr-2026 11:10:07" {MEDLEY}<library>UNIXUTILS.;60)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UNIXUTILSCOMS)
|
||||
@@ -294,8 +294,7 @@
|
||||
SLASHED])
|
||||
|
||||
(UNIX-FILE-NAME
|
||||
[LAMBDA (FILE ACCESS COPY EXTENSION) (* ; "Edited 13-May-2026 12:25 by rmk")
|
||||
(* ; "Edited 31-Mar-2026 00:13 by rmk")
|
||||
[LAMBDA (FILE ACCESS COPY EXTENSION) (* ; "Edited 31-Mar-2026 00:13 by rmk")
|
||||
(* ; "Edited 29-Mar-2026 00:26 by rmk")
|
||||
(* ; "Edited 19-Jan-2026 14:05 by rmk")
|
||||
(* ; "Edited 17-Jan-2026 22:32 by rmk")
|
||||
@@ -320,7 +319,7 @@
|
||||
(NIL (SETQ ACCESS 'INPUT)
|
||||
'OLD)
|
||||
(\ILLEGAL.ARG ACCESS])
|
||||
(SLASHIT (SELECTQ (FILENAMEFIELD FILE 'HOST)
|
||||
[SLASHIT (SELECTQ (FILENAMEFIELD FILE 'HOST)
|
||||
(UNIX (CL:IF [AND EXTENSION (NEQ (L-CASE EXTENSION)
|
||||
(L-CASE (FILENAMEFIELD FILE 'EXTENSION]
|
||||
(COPYFILE FILE (PACKFILENAME 'EXTENSION EXTENSION 'BODY FILE))
|
||||
@@ -346,8 +345,7 @@
|
||||
[RESETSAVE (GETFILEPTR FILE)
|
||||
`(PROGN (SETFILEPTR ,FILE OLDVALUE])
|
||||
(COPYFILE FILE UNAME))
|
||||
UNAME)))
|
||||
NIL T))])
|
||||
UNAME)])])
|
||||
|
||||
(UNIX-TMP-FILE-NAME
|
||||
[LAMBDA (NAME EXT HOST) (* ; "Edited 17-Jan-2026 22:28 by rmk")
|
||||
@@ -386,8 +384,8 @@
|
||||
|
||||
(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1207 1580 (ShellCommand 1207 . 1580)) (1582 1979 (ShellWhich 1582 . 1979)) (2089 21826
|
||||
(ShellBrowser 2099 . 3871) (ShellBrowse 3873 . 4558) (ShellOpener 4560 . 6248) (ShellOpen 6250 . 12197
|
||||
) (PROCESS-COMMAND 12199 . 12812) (SLASHIT 12814 . 16126) (UNIX-FILE-NAME 16128 . 20145) (
|
||||
UNIX-TMP-FILE-NAME 20147 . 21824)))))
|
||||
(FILEMAP (NIL (1208 1581 (ShellCommand 1208 . 1581)) (1583 1980 (ShellWhich 1583 . 1980)) (2090 21695
|
||||
(ShellBrowser 2100 . 3872) (ShellBrowse 3874 . 4559) (ShellOpener 4561 . 6249) (ShellOpen 6251 . 12198
|
||||
) (PROCESS-COMMAND 12200 . 12813) (SLASHIT 12815 . 16127) (UNIX-FILE-NAME 16129 . 20014) (
|
||||
UNIX-TMP-FILE-NAME 20016 . 21693)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,31 +1,12 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED " 3-May-2026 10:44:14" {MEDLEY}<lispusers>DOC-OBJECTS.;2 53774
|
||||
(FILECREATED "11-May-2026 13:00:03" {MEDLEY}<lispusers>DOC-OBJECTS.;62 52842
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
:EDIT-BY rmk
|
||||
|
||||
: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 " 9-Dec-2024 21:07:13" {MEDLEY}<lispusers>DOC-OBJECTS.;1)
|
||||
:PREVIOUS-DATE " 6-Apr-2025 23:38:07" {MEDLEY}<lispusers>DOC-OBJECTS.;61)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT DOC-OBJECTSCOMS)
|
||||
@@ -161,24 +142,29 @@
|
||||
(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.")
|
||||
|
||||
(GET.OBJ.FROM.USER TEXTSTREAM (TEXTOBJ TEXTSTREAM])
|
||||
|
||||
(DOCOBJ-GET-LOOKS
|
||||
[LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 5-Apr-2024 12:20 by rmk")
|
||||
[LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 6-Apr-2025 23:36 by rmk")
|
||||
(* ; "Edited 5-Apr-2024 12:20 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 19:36 by rmk")
|
||||
(* ; "Edited 29-Oct-2022 21:30 by rmk")
|
||||
(* Koomen " 4-Feb-87 23:37")
|
||||
@@ -195,25 +181,24 @@
|
||||
then (* ;
|
||||
"There's no text in the document. Use the extant caret looks.")
|
||||
(FGETTOBJ TEXTOBJ CARETLOOKS)
|
||||
else (PLOOKS (\TEDIT.CHTOPC (if (FIXP CH#ORCHARLOOKS)
|
||||
then (* ;
|
||||
else (\TEDIT.NTHCHARLOOKS TEXTOBJ (if (FIXP CH#ORCHARLOOKS)
|
||||
then (* ;
|
||||
"He gave us a CH# to get the looks of. Grab it.")
|
||||
CH#ORCHARLOOKS
|
||||
elseif (type? SELECTION CH#ORCHARLOOKS)
|
||||
then (* ;
|
||||
CH#ORCHARLOOKS
|
||||
elseif (type? SELECTION CH#ORCHARLOOKS)
|
||||
then (* ;
|
||||
"Get the looks of the selected text")
|
||||
(GETSEL CH#ORCHARLOOKS CH#)
|
||||
elseif (NULL CH#ORCHARLOOKS)
|
||||
then (* ;
|
||||
(GETSEL CH#ORCHARLOOKS CH#)
|
||||
elseif (NULL CH#ORCHARLOOKS)
|
||||
then (* ;
|
||||
"Get the looks of the selected text")
|
||||
(GETSEL (FGETTOBJ TEXTOBJ SEL)
|
||||
CH#))
|
||||
TEXTOBJ])
|
||||
(GETSEL (FGETTOBJ TEXTOBJ SEL)
|
||||
CH#])
|
||||
|
||||
(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
|
||||
@@ -241,8 +226,11 @@
|
||||
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])
|
||||
@@ -354,9 +342,10 @@
|
||||
(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: "])
|
||||
)
|
||||
@@ -371,7 +360,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(DOCOBJ-ACQUIRE-SNAPPED-OBJECT
|
||||
[LAMBDA NIL (* Koomen "26-Sep-86 16:55")
|
||||
[LAMBDA NIL (* Koomen "26-Sep-86 16:55")
|
||||
(GETREGION])
|
||||
)
|
||||
|
||||
@@ -393,23 +382,29 @@
|
||||
(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,58 +418,68 @@
|
||||
(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 )
|
||||
@@ -491,14 +496,18 @@
|
||||
(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))
|
||||
@@ -512,33 +521,46 @@
|
||||
(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)
|
||||
@@ -549,7 +571,9 @@
|
||||
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)
|
||||
@@ -558,11 +582,15 @@
|
||||
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])
|
||||
@@ -582,15 +610,17 @@
|
||||
(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)))
|
||||
@@ -598,18 +628,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)
|
||||
@@ -624,8 +654,10 @@
|
||||
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)
|
||||
@@ -658,6 +690,7 @@
|
||||
|
||||
(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
|
||||
@@ -666,6 +699,7 @@
|
||||
|
||||
(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))
|
||||
@@ -679,7 +713,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
|
||||
@@ -700,7 +734,8 @@
|
||||
IMAGEOBJ])
|
||||
|
||||
(DOCOBJ-INCLUDE-EDIT
|
||||
[LAMBDA (INCLOBJ TSTREAM) (* ; "Edited 12-May-2024 09:03 by rmk")
|
||||
[LAMBDA (INCLOBJ TSTREAM) (* ; "Edited 26-Dec-2024 00:23 by rmk")
|
||||
(* ; "Edited 12-May-2024 09:03 by rmk")
|
||||
(* ; "Edited 9-May-2018 11:09 by rmk:")
|
||||
(* ; "Edited 9-May-2018 10:35 by rmk:")
|
||||
(* ; "Edited 26-Oct-87 19:57 by Koomen")
|
||||
@@ -727,31 +762,32 @@
|
||||
(NOT (EQUAL NEWNAME (fetch (INCLOBJ FILENAME) of INCLOBJ]
|
||||
then (replace (INCLOBJ FILENAME) of INCLOBJ with NEWNAME)
|
||||
T)))
|
||||
(EDIT.FILE (for W in (OPENWINDOWS)
|
||||
bind [FULLNAME _ (OR (FINDFILE-WITH-EXTENSIONS
|
||||
(fetch (INCLOBJ FILENAME) of INCLOBJ)
|
||||
(CONS (PACKFILENAME.STRING 'HOST (FILENAMEFIELD
|
||||
TXTFILE
|
||||
'HOST)
|
||||
'DIRECTORY
|
||||
(FILENAMEFIELD TXTFILE 'DIRECTORY))
|
||||
DIRECTORIES)
|
||||
*TEDIT-EXTENSIONS*)
|
||||
(INFILEP (fetch (INCLOBJ FILENAME) of INCLOBJ]
|
||||
first (if (NULL FULLNAME)
|
||||
then (TEDIT.PROMPTPRINT TSTREAM "Can't find " T)
|
||||
(TEDIT.PROMPTPRINT TSTREAM (fetch (INCLOBJ FILENAME)
|
||||
of INCLOBJ))
|
||||
(RETURN)) when (SETQ W (DOCOBJ-INCLUDE-EDIT-WINDOWP FULLNAME W))
|
||||
(EDIT.FILE (for W FULLNAME (TXTFILE _ TSTREAM) in (OPENWINDOWS)
|
||||
first [SETQ FULLNAME (OR (FINDFILE-WITH-EXTENSIONS
|
||||
(fetch (INCLOBJ FILENAME) of INCLOBJ)
|
||||
(CONS (PACKFILENAME.STRING 'HOST (FILENAMEFIELD
|
||||
TXTFILE
|
||||
'HOST)
|
||||
'DIRECTORY
|
||||
(FILENAMEFIELD TXTFILE 'DIRECTORY))
|
||||
DIRECTORIES)
|
||||
*TEDIT-EXTENSIONS*)
|
||||
(INFILEP (fetch (INCLOBJ FILENAME) of INCLOBJ]
|
||||
(CL:UNLESS FULLNAME
|
||||
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "Can't find " (fetch (INCLOBJ
|
||||
FILENAME)
|
||||
of INCLOBJ))
|
||||
T)
|
||||
(RETURN)) when (SETQ W (DOCOBJ-INCLUDE-EDIT-WINDOWP FULLNAME W))
|
||||
do (TOTOPW W)
|
||||
(GIVE.TTY.PROCESS W)
|
||||
(RETURN) finally (TEDIT (MKATOM FULLNAME))))
|
||||
(ENABLE (if (NOT (fetch (INCLOBJ ENABLEDP) of INCLOBJ))
|
||||
then (replace (INCLOBJ ENABLEDP) of INCLOBJ with T)
|
||||
T))
|
||||
(DISABLE (if (fetch (INCLOBJ ENABLEDP) of INCLOBJ)
|
||||
then (replace (INCLOBJ ENABLEDP) of INCLOBJ with NIL)
|
||||
T))
|
||||
(RETURN) finally (TEDIT FULLNAME)))
|
||||
(ENABLE (CL:UNLESS (fetch (INCLOBJ ENABLEDP) of INCLOBJ)
|
||||
(replace (INCLOBJ ENABLEDP) of INCLOBJ with T)
|
||||
T))
|
||||
(DISABLE (CL:WHEN (fetch (INCLOBJ ENABLEDP) of INCLOBJ)
|
||||
(replace (INCLOBJ ENABLEDP) of INCLOBJ with NIL)
|
||||
T))
|
||||
NIL])
|
||||
|
||||
(DOCOBJ-INCLUDE-EDIT-WINDOWP
|
||||
@@ -872,6 +908,7 @@
|
||||
|
||||
(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
|
||||
@@ -886,24 +923,28 @@
|
||||
|
||||
(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)
|
||||
@@ -914,17 +955,19 @@
|
||||
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])
|
||||
)
|
||||
@@ -946,29 +989,29 @@
|
||||
(PUTPROPS DOC-OBJECTS MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10))
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(FILEMAP (NIL (7528 21326 (DOCOBJ-ACQUIRE-OBJECT 7538 . 8539) (DOCOBJ-INIT 8541 . 9169) (
|
||||
DOCOBJ-TEDIT-MENU-ENTRY 9171 . 9593) (DOCOBJ-GET-LOOKS 9595 . 12165) (DOCOBJ-REGISTER-OBJECT 12167 .
|
||||
12821) (DOCOBJ-STRING-IMAGEBOX 12823 . 13879) (DOCOBJ-WAIT-MOUSE 13881 . 14341) (
|
||||
DOCOBJ-BEFOREHARDCOPYFN 14343 . 19813) (DOCOBJ-AFTERHARDCOPYFN 19815 . 21324)) (21356 21623 (
|
||||
DOCOBJ-ACQUIRE-EVALED-OBJECT 21366 . 21621)) (21823 21965 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 21833 . 21963
|
||||
)) (22287 27083 (DOCOBJ-EDIT-TIMESTAMP 22297 . 22826) (DOCOBJ-MAKE-TIMESTAMP 22828 . 23239) (
|
||||
DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 23241 . 24311) (DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 24313 . 24844) (
|
||||
DOCOBJ-TIMESTAMP-COPYFN 24846 . 25171) (DOCOBJ-TIMESTAMP-DISPLAYFN 25173 . 25466) (
|
||||
DOCOBJ-TIMESTAMP-GETFN 25468 . 25708) (DOCOBJ-TIMESTAMP-IMAGEBOXFN 25710 . 26066) (
|
||||
DOCOBJ-TIMESTAMP-PREPRINTFN 26068 . 26299) (DOCOBJ-TIMESTAMP-PUTFN 26301 . 26670) (
|
||||
DOCOBJ-TIMESTAMP-TO-STRING 26672 . 27081)) (27377 31684 (DOCOBJ-MAKE-FILESTAMP 27387 . 27728) (
|
||||
DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 27730 . 28772) (DOCOBJ-FILESTAMP-COPYFN 28774 . 29089) (
|
||||
DOCOBJ-FILESTAMP-DISPLAYFN 29091 . 29379) (DOCOBJ-FILESTAMP-GETFN 29381 . 29734) (
|
||||
DOCOBJ-FILESTAMP-IMAGEBOXFN 29736 . 30074) (DOCOBJ-FILESTAMP-GET-FULLNAME 30076 . 30694) (
|
||||
DOCOBJ-FILESTAMP-NEW-FULLNAME 30696 . 31169) (DOCOBJ-FILESTAMP-PREPRINTFN 31171 . 31380) (
|
||||
DOCOBJ-FILESTAMP-PUTFN 31382 . 31682)) (31990 34487 (DOCOBJ-MAKE-HRULE 32000 . 32414) (
|
||||
DOCOBJ-EDIT-HRULE 32416 . 32888) (DOCOBJ-HRULE-INIT 32890 . 33222) (DOCOBJ-HRULE-GET-WIDTH 33224 .
|
||||
34035) (DOCOBJ-HRULE-BUTTONEVENTINFN 34037 . 34485)) (34906 43454 (DOCOBJ-MAKE-INCLUDE 34916 . 35317)
|
||||
(DOCOBJ-MAKE-INCLUDE-IMAGEFNS 35319 . 36324) (DOCOBJ-INCLUDE-CREATE-OBJ 36326 . 37094) (
|
||||
DOCOBJ-INCLUDE-EDIT 37096 . 41571) (DOCOBJ-INCLUDE-EDIT-WINDOWP 41573 . 42429) (
|
||||
DOCOBJ-INCLUDE-RESET-OBJ 42431 . 43452)) (43455 52301 (DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 43465 . 46959)
|
||||
(DOCOBJ-INCLUDE-CLEANUPFN 46961 . 48480) (DOCOBJ-INCLUDE-BUTTONEVENTINFN 48482 . 49159) (
|
||||
DOCOBJ-INCLUDE-COPYFN 49161 . 49379) (DOCOBJ-INCLUDE-DISPLAYFN 49381 . 50133) (DOCOBJ-INCLUDE-GETFN
|
||||
50135 . 50858) (DOCOBJ-INCLUDE-IMAGEBOXFN 50860 . 51869) (DOCOBJ-INCLUDE-PREPRINTFN 51871 . 52090) (
|
||||
DOCOBJ-INCLUDE-PUTFN 52092 . 52299)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,14 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "15-May-2026 22:31:17" {MEDLEY}<lispusers>tmax>TMAX.;47 28263
|
||||
(FILECREATED "12-Aug-2025 08:27:53"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>tmax>TMAX.;46 28244
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS NGROUPMENU.ENABLED?)
|
||||
:CHANGES-TO (VARS TMAXCOMS TSP.FM.DESC)
|
||||
|
||||
:PREVIOUS-DATE "12-Aug-2025 08:27:53" {MEDLEY}<lispusers>tmax>TMAX.;46)
|
||||
:PREVIOUS-DATE "30-Mar-2025 21:51:58"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>TMAX>TMAX.;44)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TMAXCOMS)
|
||||
@@ -375,10 +377,9 @@
|
||||
(T (CLOSE.NGROUP.GRAPH TSTREAM])
|
||||
|
||||
(NGROUPMENU.ENABLED?
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 15-May-2026 22:29 by rmk")
|
||||
(* ; "Edited 21-Feb-2025 10:17 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 21-Feb-2025 10:17 by rmk")
|
||||
(* ; "Edited 29-Sep-87 11:42 by fsg")
|
||||
(FM.ITEMPROP (FM.GETITEM 'NGROUP.MENU NIL (TSP.SETUP.FMMENU TSTREAM))
|
||||
(FM.ITEMPROP (FM.GETITEM 'NGROUP.MENU NIL (TMAXPROP TSTREAM 'IMAGEOBJ.MENUW))
|
||||
'STATE])
|
||||
|
||||
(NGROUP.Text-Before.TOGGLE
|
||||
@@ -576,15 +577,15 @@
|
||||
|
||||
(TSP.FUNCTION.HOOKS)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3221 4105 (EDIT-TMAX 3231 . 4103)) (8116 16359 (TSP.DISPLAY.FMMENU 8126 . 8800) (
|
||||
TSP.SETUP.FILENAMES 8802 . 10133) (TSP.SETUP.FMMENU 10135 . 10686) (TSP.FMMENU 10688 . 11792) (
|
||||
TSP.FM.APPLY 11794 . 12382) (UPDATE.ALL 12384 . 13260) (DOWNDATE.ALL 13262 . 13889) (
|
||||
TSP.FUNCTION.HOOKS 13891 . 15321) (TSP.GETFN 15323 . 15898) (TSP.PUTFN 15900 . 16357)) (16405 20444 (
|
||||
AutoUpdate.TOGGLE 16415 . 16872) (UPDATE? 16874 . 17239) (NGROUP.Menu.TOGGLE 17241 . 17786) (
|
||||
NGROUPMENU.ENABLED? 17788 . 18235) (NGROUP.Text-Before.TOGGLE 18237 . 18708) (TEXTBEFORE.ENABLED?
|
||||
18710 . 18977) (NGROUP.Text-After.TOGGLE 18979 . 19448) (TEXTAFTER.ENABLED? 19450 . 19715) (
|
||||
Manual.Index.TOGGLE 19717 . 20177) (MANUALINDEX.ENABLED? 20179 . 20442)) (20478 26140 (GET.TSP.FONT
|
||||
20488 . 21762) (GET.TSP.FONT.FAMILY 21764 . 22384) (GET.TSP.FONT.SIZE 22386 . 22874) (
|
||||
GET.TSP.FONT.FACE 22876 . 23768) (ABBREVIATE.FONT 23770 . 25384) (TMAX.SHADEOBJ 25386 . 26138)) (26180
|
||||
27548 (TSP.LIST.OF.OBJECTS 26190 . 27546)))))
|
||||
(FILEMAP (NIL (3307 4191 (EDIT-TMAX 3317 . 4189)) (8202 16445 (TSP.DISPLAY.FMMENU 8212 . 8886) (
|
||||
TSP.SETUP.FILENAMES 8888 . 10219) (TSP.SETUP.FMMENU 10221 . 10772) (TSP.FMMENU 10774 . 11878) (
|
||||
TSP.FM.APPLY 11880 . 12468) (UPDATE.ALL 12470 . 13346) (DOWNDATE.ALL 13348 . 13975) (
|
||||
TSP.FUNCTION.HOOKS 13977 . 15407) (TSP.GETFN 15409 . 15984) (TSP.PUTFN 15986 . 16443)) (16491 20425 (
|
||||
AutoUpdate.TOGGLE 16501 . 16958) (UPDATE? 16960 . 17325) (NGROUP.Menu.TOGGLE 17327 . 17872) (
|
||||
NGROUPMENU.ENABLED? 17874 . 18216) (NGROUP.Text-Before.TOGGLE 18218 . 18689) (TEXTBEFORE.ENABLED?
|
||||
18691 . 18958) (NGROUP.Text-After.TOGGLE 18960 . 19429) (TEXTAFTER.ENABLED? 19431 . 19696) (
|
||||
Manual.Index.TOGGLE 19698 . 20158) (MANUALINDEX.ENABLED? 20160 . 20423)) (20459 26121 (GET.TSP.FONT
|
||||
20469 . 21743) (GET.TSP.FONT.FAMILY 21745 . 22365) (GET.TSP.FONT.SIZE 22367 . 22855) (
|
||||
GET.TSP.FONT.FACE 22857 . 23749) (ABBREVIATE.FONT 23751 . 25365) (TMAX.SHADEOBJ 25367 . 26119)) (26161
|
||||
27529 (TSP.LIST.OF.OBJECTS 26171 . 27527)))))
|
||||
STOP
|
||||
|
||||
@@ -1,12 +1,15 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "XCL" :BASE 10)
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED "12-Apr-2026 23:42:38" |{WMEDLEY}<lispusers>tmax>TMAX-NGRAPH.;15| 27461
|
||||
(FILECREATED "28-Feb-2025 23:52:01" |{WMEDLEY}<lispusers>tmax>TMAX-NGRAPH.;14| 27479
|
||||
|
||||
:EDIT-BY |rmk|
|
||||
|
||||
:CHANGES-TO (FNS TSP.GET.NGROUP.ARRAY)
|
||||
:CHANGES-TO (FNS NGROUP.CHARTYPE.CONVERT UPDATE.NUMBEROBJS DOWNDATE.NUMBEROBJS NGROUP.CHARTYPE
|
||||
INITIAL.NGROUP.GRAPH RESET.DEPENDENT.CLASSES GET.NCOUNTER GRAPHMENU
|
||||
CREATE.NGROUP.NODE FLATTEN.TREE.TO.STRING)
|
||||
(VARS TMAX-NGRAPHCOMS)
|
||||
|
||||
:PREVIOUS-DATE "28-Feb-2025 23:52:01" |{WMEDLEY}<lispusers>tmax>TMAX-NGRAPH.;14|)
|
||||
:PREVIOUS-DATE "23-Feb-2025 22:59:05" |{WMEDLEY}<lispusers>tmax>TMAX-NGRAPH.;11|)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TMAX-NGRAPHCOMS)
|
||||
@@ -194,13 +197,9 @@
|
||||
(CADR (GETHASH NGID (TSP.GET.NGROUP.ARRAY TSTREAM)))))
|
||||
|
||||
(TSP.GET.NGROUP.ARRAY
|
||||
(LAMBDA (TSTREAM) (* \; "Edited 12-Apr-2026 23:40 by rmk")
|
||||
(* \; "Edited 21-Feb-2025 10:17 by rmk")
|
||||
(LAMBDA (TSTREAM) (* \; "Edited 21-Feb-2025 10:17 by rmk")
|
||||
(* |ss:| "27-Jun-87 16:21")
|
||||
(OR (TMAXPROP TSTREAM 'TSP.NGROUP.ARRAY)
|
||||
(LET ((ARRAY (HASHARRAY 30)))
|
||||
(TMAXPROP TSTREAM 'TSP.NGROUP.ARRAY (HASHARRAY 30))
|
||||
ARRAY))))
|
||||
(TMAXPROP TSTREAM 'TSP.NGROUP.ARRAY)))
|
||||
|
||||
(tsp.legalid
|
||||
(lambda (prev.ngroups stream) (* |fsg| " 3-Aug-87 17:04")
|
||||
@@ -486,15 +485,15 @@
|
||||
|finally| (TMAXPROP TSTREAM 'COUNTERS NIL))))
|
||||
)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (1437 12863 (GRAPHMENU 1447 . 2728) (INITIAL.NGROUP.GRAPH 2730 . 3508) (
|
||||
NGROUP.MAKE.ROOTNODE 3510 . 3731) (TSPGRAPHREGION 3733 . 4384) (CLOSE.NGROUP.GRAPH 4386 . 4990) (
|
||||
NGROUP.GRAPH.CLOSEFN 4992 . 5649) (ADD.NGROUP.TO.MOTHER.NODE 5651 . 6156) (ADD.NODE.TO.GRAPH 6158 .
|
||||
7369) (COLLECT.HASHARRAY 7371 . 7657) (CREATE.NGROUP.NODE 7659 . 8494) (GET.FROMNODES 8496 . 8802) (
|
||||
GET.TONODES 8804 . 9391) (FIND.NODE 9393 . 9672) (TSP.GET.NGROUP.ARRAY 9674 . 10181) (TSP.LEGALID
|
||||
10183 . 11344) (LIST.ANCESTORS 11346 . 11875) (TOPLEVEL.SISTERS 11877 . 12315) (GET.NGROUP.MOTHER
|
||||
12317 . 12861)) (12910 27438 (DOWNDATE.NUMBEROBJS 12920 . 14869) (UPDATE.NUMBEROBJS 14871 . 16668) (
|
||||
RESET.DEPENDENT.CLASSES 16670 . 17245) (RESET.NCOUNTER 17247 . 18138) (GET.NCOUNTER 18140 . 19399) (
|
||||
NCOUNTER? 19401 . 21211) (FLATTEN.TREE.TO.STRING 21213 . 23111) (NGROUP.CHARTYPE 23113 . 24671) (
|
||||
NGROUP.CHARTYPE.CONVERT 24673 . 26058) (NUMBER.TO.LETTER 26060 . 27050) (REMOVE.ALL.COUNTERS 27052 .
|
||||
27436)))))
|
||||
(FILEMAP (NIL (1692 12881 (GRAPHMENU 1702 . 2983) (INITIAL.NGROUP.GRAPH 2985 . 3763) (
|
||||
NGROUP.MAKE.ROOTNODE 3765 . 3986) (TSPGRAPHREGION 3988 . 4639) (CLOSE.NGROUP.GRAPH 4641 . 5245) (
|
||||
NGROUP.GRAPH.CLOSEFN 5247 . 5904) (ADD.NGROUP.TO.MOTHER.NODE 5906 . 6411) (ADD.NODE.TO.GRAPH 6413 .
|
||||
7624) (COLLECT.HASHARRAY 7626 . 7912) (CREATE.NGROUP.NODE 7914 . 8749) (GET.FROMNODES 8751 . 9057) (
|
||||
GET.TONODES 9059 . 9646) (FIND.NODE 9648 . 9927) (TSP.GET.NGROUP.ARRAY 9929 . 10199) (TSP.LEGALID
|
||||
10201 . 11362) (LIST.ANCESTORS 11364 . 11893) (TOPLEVEL.SISTERS 11895 . 12333) (GET.NGROUP.MOTHER
|
||||
12335 . 12879)) (12928 27456 (DOWNDATE.NUMBEROBJS 12938 . 14887) (UPDATE.NUMBEROBJS 14889 . 16686) (
|
||||
RESET.DEPENDENT.CLASSES 16688 . 17263) (RESET.NCOUNTER 17265 . 18156) (GET.NCOUNTER 18158 . 19417) (
|
||||
NCOUNTER? 19419 . 21229) (FLATTEN.TREE.TO.STRING 21231 . 23129) (NGROUP.CHARTYPE 23131 . 24689) (
|
||||
NGROUP.CHARTYPE.CONVERT 24691 . 26076) (NUMBER.TO.LETTER 26078 . 27068) (REMOVE.ALL.COUNTERS 27070 .
|
||||
27454)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
121
sources/LLINTERP
121
sources/LLINTERP
@@ -1,13 +1,19 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 8-May-2026 23:51:41" {DSK}<home>matt>Interlisp>medley>sources>LLINTERP.;2 120946
|
||||
(FILECREATED "30-Jun-2022 22:42:02"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLINTERP.;4 120990
|
||||
|
||||
:EDIT-BY "mth"
|
||||
:PREVIOUS-DATE "30-Jun-2022 18:04:04"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLINTERP.;3)
|
||||
|
||||
: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)
|
||||
|
||||
@@ -1535,8 +1541,7 @@
|
||||
(T (ERROR '"Args not available:" FN])
|
||||
|
||||
(\CCODEARGLIST
|
||||
[LAMBDA (FNHD SMARTP) (* ; "Edited 8-May-2026 23:44 by mth")
|
||||
(* ; "Edited 10-May-88 12:18 by MASINTER")
|
||||
[LAMBDA (FNHD SMARTP) (* ; "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.")
|
||||
|
||||
@@ -1551,55 +1556,53 @@
|
||||
(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 (COND
|
||||
((AND (EQ 2 (fetch (FNHEADER ARGTYPE) of FNHD))
|
||||
(SETQ IVARS (ASSOC 0 IVARS)))
|
||||
(CDR IVARS))
|
||||
(T 'U]
|
||||
"Waited until now to see if there was a stored arglist, but we didn't find one--give up")
|
||||
(RETURN '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])
|
||||
@@ -1742,31 +1745,33 @@
|
||||
|
||||
(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 (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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user