Compare commits
6 Commits
lmm-diagno
...
lmm-hcfile
| Author | SHA1 | Date | |
|---|---|---|---|
|
fd1d6b0dd1 | ||
|
|
5f570b06be | ||
|
4de89a6e94 | ||
|
ceccadacef | ||
|
|
6159c64b84 | ||
|
|
eb6ee87170 |
0
CLTL2/.skip
Normal file
0
CLTL2/.skip
Normal file
0
docs/dinfo/.skip
Normal file
0
docs/dinfo/.skip
Normal 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.
@@ -1,16 +1,17 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "20-Feb-2024 23:45:56" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;4 18445
|
||||
(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 "19-Feb-2024 16:29:44" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;1)
|
||||
:PREVIOUS-DATE "29-Apr-2026 17:43:56" {DSK}<home>matt>Interlisp>medley>library>DATABASEFNS.;2
|
||||
)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
||||
Copyright (c) 1986, 1990-1993, 2024, 2026 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT DATABASEFNSCOMS)
|
||||
@@ -164,7 +165,9 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(DUMPDB
|
||||
[LAMBDA (FILE PROPFLG) (* ; "Edited 20-Feb-2024 23:45 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:")
|
||||
@@ -180,7 +183,7 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
||||
(LET ((SAVEDCOPYRIGHTFLG COPYRIGHTFLG)
|
||||
(SAVEDDEFAULTCOPYRIGHTOWNER DEFAULTCOPYRIGHTOWNER))
|
||||
(CL:UNWIND-PROTECT
|
||||
(PROG (DBFILE DBFN DBROOTFN FLCPR (FL (NAMEFIELD FILE))
|
||||
(PROG (DBFILE DBFN DBROOTFN FLCPR (FL (ROOTFILENAME FILE))
|
||||
(FNS (FILEFNSLST FILE)))
|
||||
(SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE))
|
||||
(SETQ DBROOTFN (ROOTFILENAME DBFN))
|
||||
@@ -230,7 +233,7 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
||||
(PRETTYDEF NIL DBFN
|
||||
`((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
|
||||
(ERROR!)))
|
||||
(E [PRINT (CAR (GETPROP ',FILE 'FILEDATES]
|
||||
(E [PRINT (CAR (GETPROP ',FL 'FILEDATES]
|
||||
(DUMPDATABASE ',FNS]
|
||||
[COND
|
||||
(PROPFLG (PRINT (FULLNAME DBFILE)
|
||||
@@ -375,9 +378,9 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
||||
|
||||
(RESETSAVE DWIMIFYCOMPFLG T)
|
||||
)
|
||||
(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993 2024))
|
||||
(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993 2024 2026))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1768 6793 (DBFILE 1778 . 3423) (DBFILE1 3425 . 4935) (DBFILE2 4937 . 6159) (LOAD 6161
|
||||
. 6391) (LOADFROM 6393 . 6581) (MAKEFILE 6583 . 6791)) (6849 17838 (DUMPDB 6859 . 11873) (LOADDB
|
||||
11875 . 16750) (MAKEDB 16752 . 17836)))))
|
||||
(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 "31-Mar-2026 10:50:22" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;287 138875
|
||||
(FILECREATED "28-Apr-2026 23:41:24" {MEDLEY}<lispusers>COMPAREDIRECTORIES.;289 139726
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS CDBROWSER-COPY)
|
||||
:CHANGES-TO (FNS CDFILES.PATS CDFILES.MATCH CDBROWSER-COPY)
|
||||
|
||||
:PREVIOUS-DATE "10-Feb-2026 21:28:55" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;286)
|
||||
:PREVIOUS-DATE "28-Apr-2026 21:38:49" {MEDLEY}<lispusers>COMPAREDIRECTORIES.;288)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
|
||||
@@ -507,32 +507,37 @@
|
||||
UNLESS (CDFILES.MATCH SUBDIR NAME EXT THISDEPTH EXCLUDES) COLLECT FULLNAME])
|
||||
|
||||
(CDFILES.MATCH
|
||||
[LAMBDA (SUBDIR NAME EXT THISDEPTH PATTERNS) (* ; "Edited 26-Jan-2022 15:33 by rmk")
|
||||
[LAMBDA (SUBDIR NAME EXT THISDEPTH PATTERNS) (* ; "Edited 28-Apr-2026 23:40 by rmk")
|
||||
(* ; "Edited 26-Jan-2022 15:33 by rmk")
|
||||
(* ; "Edited 23-Dec-2021 21:47 by rmk")
|
||||
(thereis P in PATTERNS suchthat
|
||||
|
||||
(* ;; "True if the components of the fullname match at least one of the patterns")
|
||||
(* ;; "The SUBDIR test is tricky. If the exclusion pattern was internal/fonts/**, this shows up as (* * internal/fonts 65535), it has to match internal/fonts/display/completed/. Below we test for an initial substring")
|
||||
|
||||
(THEREIS P IN PATTERNS SUCHTHAT (AND [OR (STRING.EQUAL NAME (CAR P)
|
||||
FILEDIRCASEARRAY)
|
||||
(EQ '* (CAR P))
|
||||
(AND (EQ (CHARCODE %.)
|
||||
(CHCON1 (CAR P)))
|
||||
(EQ (CHARCODE %.)
|
||||
(CHCON1 NAME))
|
||||
(OR (STRING.EQUAL NAME (SUBATOM (CAR P)
|
||||
2))
|
||||
(EQ (CHARCODE *)
|
||||
(NTHCHARCODE (CAR P)
|
||||
2]
|
||||
(OR (STRING.EQUAL EXT (CADR P))
|
||||
(EQ '* (CADR P)))
|
||||
(OR (STRING.EQUAL SUBDIR (CADDR P))
|
||||
(NULL (CADDR P))
|
||||
(EQ '* (CADDR P)))
|
||||
(ILEQ THISDEPTH (CADDDR P])
|
||||
(AND [OR (STRING.EQUAL NAME (CAR P)
|
||||
FILEDIRCASEARRAY)
|
||||
(EQ '* (CAR P))
|
||||
(AND (EQ (CHARCODE %.)
|
||||
(CHCON1 (CAR P)))
|
||||
(EQ (CHARCODE %.)
|
||||
(CHCON1 NAME))
|
||||
(OR (STRING.EQUAL NAME (SUBATOM (CAR P)
|
||||
2))
|
||||
(EQ (CHARCODE *)
|
||||
(NTHCHARCODE (CAR P)
|
||||
2]
|
||||
(OR (STRING.EQUAL EXT (CADR P))
|
||||
(EQ '* (CADR P)))
|
||||
(ILEQ THISDEPTH (CADDDR P))
|
||||
(OR (STRING.EQUAL SUBDIR (CADDR P))
|
||||
(NULL (CADDR P))
|
||||
(EQ '* (CADDR P))
|
||||
(STRPOS (CADDR P)
|
||||
SUBDIR 1 NIL T])
|
||||
|
||||
(CDFILES.PATS
|
||||
[LAMBDA (PATTERNS) (* ; "Edited 17-Jun-2023 23:36 by rmk")
|
||||
[LAMBDA (PATTERNS) (* ; "Edited 28-Apr-2026 23:01 by rmk")
|
||||
(* ; "Edited 17-Jun-2023 23:36 by rmk")
|
||||
(* ; "Edited 23-Dec-2021 17:02 by rmk")
|
||||
|
||||
(* ;; "Returns (NAME EXT SUBDIR DEPTH) items where NAME or EXT may be the wildcard *, SD is the subdirectory (if any) and DEPTH is the number of / or > in the subdirectory")
|
||||
@@ -544,15 +549,15 @@
|
||||
(* * NIL 1)
|
||||
)
|
||||
ELSE (FOR P N E SD DEPTH UNPACK INSIDE PATTERNS
|
||||
JOIN (SETQ UNPACK (UNPACKFILENAME.STRING P)) (* ;
|
||||
JOIN (SETQ UNPACK (UNPACKFILENAME P)) (* ;
|
||||
"String so we can tell the difference between x and x.")
|
||||
[SETQ SD (MKATOM (LISTGET UNPACK 'SUBDIRECTORY]
|
||||
(SETQ SD (LISTGET UNPACK 'SUBDIRECTORY))
|
||||
|
||||
(* ;; "Count the subdirectory depth")
|
||||
|
||||
[SETQ DEPTH (IF (EQ SD '*)
|
||||
THEN MAX.SMALLP
|
||||
ELSE (FOR I (CNT _ 1) FROM 1 DO (SELCHARQ (NTHCHARCODE SD I)
|
||||
[SETQ DEPTH (if (EQ SD '*)
|
||||
then MAX.SMALLP
|
||||
else (for I (CNT _ 1) from 1 do (SELCHARQ (NTHCHARCODE SD I)
|
||||
((/ >)
|
||||
(ADD CNT 1))
|
||||
(NIL (RETURN CNT))
|
||||
@@ -560,28 +565,31 @@
|
||||
(SETQ N (LISTGET UNPACK 'NAME))
|
||||
(SETQ N (if (NULL N)
|
||||
then '*
|
||||
elseif (EQ N '**)
|
||||
then (SETQ DEPTH MAX.SMALLP)
|
||||
'*
|
||||
elseif (NEQ 0 (NCHARS N))
|
||||
then (MKATOM N)))
|
||||
then N))
|
||||
(SETQ E (LISTGET UNPACK 'EXTENSION))
|
||||
(SETQ E (if (NULL E)
|
||||
then '*
|
||||
elseif (NEQ 0 (NCHARS E))
|
||||
then (MKATOM E)))
|
||||
(if [OR (AND (STRING.EQUAL N 'COM)
|
||||
then E))
|
||||
(if [OR (AND (EQ N 'COM)
|
||||
(NULL E))
|
||||
(AND (STRING.EQUAL E 'COM)
|
||||
(AND (EQ E 'COM)
|
||||
(MEMB N ' (* NIL)]
|
||||
THEN (FOR CE IN *COMPILED-EXTENSIONS* COLLECT (LIST '* CE SD DEPTH))
|
||||
ELSE (CONS (IF N
|
||||
THEN (LIST N E SD DEPTH)
|
||||
ELSEIF E
|
||||
THEN
|
||||
then (for CE in *COMPILED-EXTENSIONS* collect (LIST '* CE SD DEPTH))
|
||||
else (CONS (if N
|
||||
then (LIST N E SD DEPTH)
|
||||
elseif E
|
||||
then
|
||||
|
||||
(* ;; "This is the case .XXX, which presumably identifies a dotted file. If this is supposed to be all files with extension XXX, it shoud be specified as *.XXX, the case above. So we move .E into the N field.")
|
||||
|
||||
(LIST (PACK* '%. E)
|
||||
NIL SD DEPTH)
|
||||
ELSE `
|
||||
else `
|
||||
|
||||
(* * (\, SD) (\, DEPTH))
|
||||
])
|
||||
@@ -2146,7 +2154,8 @@
|
||||
NIL])
|
||||
|
||||
(CDBROWSER-COPY
|
||||
[LAMBDA (CDBROWSER TBITEM SOURCE UNIXDEST) (* ; "Edited 31-Mar-2026 10:49 by rmk")
|
||||
[LAMBDA (CDBROWSER TBITEM SOURCE UNIXDEST) (* ; "Edited 28-Apr-2026 18:54 by rmk")
|
||||
(* ; "Edited 31-Mar-2026 10:49 by rmk")
|
||||
(* ; "Edited 28-Oct-2025 17:39 by rmk")
|
||||
(* ; "Edited 25-Oct-2025 23:58 by rmk")
|
||||
(* ; "Edited 24-May-2022 15:49 by rmk")
|
||||
@@ -2185,7 +2194,8 @@
|
||||
(PRIN3 "No source file to copy" T)
|
||||
(RETURN NIL))
|
||||
(CL:WHEN [AND (EQ DATERELBAD (FETCH (CDENTRY DATEREL) OF CDENTRY))
|
||||
(PROGN (FLASHWINDOW T)
|
||||
(PROGN (GIVE.TTY.PROCESS T)
|
||||
(FLASHWINDOW T)
|
||||
(EQ 'N (ASKUSER NIL NIL
|
||||
"Target is newer than source. Really copy? "]
|
||||
(RETURN NIL))
|
||||
@@ -2195,6 +2205,7 @@
|
||||
))
|
||||
'VERSION))
|
||||
(PROGN (FLASHWINDOW T)
|
||||
(GIVE.TTY.PROCESS T)
|
||||
(EQ 'N (ASKUSER NIL NIL (CONCAT SOURCEFILE
|
||||
" is not the newest version. Really copy? "
|
||||
]
|
||||
@@ -2326,25 +2337,25 @@
|
||||
|
||||
(MOVD? 'NILL 'TEDIT.FILEDATE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2658 23637 (COMPAREDIRECTORIES 2668 . 8003) (COMPAREDIRECTORIES.INFOS 8005 . 11234) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 11236 . 14621) (CDENTRIES.SELECT 14623 . 19525) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 19527 . 20871) (MATCHNAME 20873 . 21553) (CD.INSURECDVALUE 21555 . 23169
|
||||
) (CD.UPDATEWIDTHS 23171 . 23635)) (23638 34343 (CDFILES 23648 . 29745) (CDFILES.MATCH 29747 . 31372)
|
||||
(CDFILES.PATS 31374 . 34341)) (34344 52362 (CDPRINT 34354 . 36871) (CDPRINT.HEADER 36873 . 37770) (
|
||||
CDPRINT.LINE 37772 . 41201) (CDPRINT.MAXWIDTHS 41203 . 45318) (CDPRINT.COLHEADERS 45320 . 46605) (
|
||||
CDPRINT.COLUMNS 46607 . 51727) (CDTEDIT 51729 . 52360)) (52363 61484 (CDMAP 52373 . 53805) (CDENTRY
|
||||
53807 . 54116) (CDSUBSET 54118 . 55557) (CDMERGE 55559 . 59543) (CDMERGE.COMMON 59545 . 60860) (
|
||||
CD.SORT 60862 . 61482)) (61485 69023 (BINCOMP 61495 . 65784) (EOLTYPE 65786 . 68348) (EOLTYPE.SHOW
|
||||
68350 . 69021)) (69551 82078 (FIND-UNCOMPILED-FILES 69561 . 73204) (FIND-UNSOURCED-FILES 73206 . 75590
|
||||
) (FIND-SOURCE-FILES 75592 . 77330) (FIND-COMPILED-FILES 77332 . 79209) (FIND-UNLOADED-FILES 79211 .
|
||||
80064) (FIND-LOADED-FILES 80066 . 80494) (FIND-MULTICOMPILED-FILES 80496 . 82076)) (82079 90510 (
|
||||
CREATED-AS 82089 . 86886) (SOURCE-FOR-COMPILED-P 86888 . 89815) (COMPILE-SOURCE-DATE-DIFF 89817 .
|
||||
90508)) (90511 101274 (FIX-DIRECTORY-DATES 90521 . 93971) (FIX-EQUIV-DATES 93973 . 95498) (
|
||||
COPY-COMPARED-FILES 95500 . 97321) (COPY-MISSING-FILES 97323 . 99480) (COMPILED-ON-SAME-SOURCE 99482
|
||||
. 101272)) (101468 109346 (CDBROWSER 101478 . 105445) (CDBROWSER.STRINGS 105447 . 109344)) (109508
|
||||
111244 (CD.TABLEITEM 109518 . 109738) (CD.TABLEITEM.PRINTFN 109740 . 109939) (CD.TABLEITEM.COPYFN
|
||||
109941 . 110999) (CDTABLEBROWSER.HEADING.REPAINTFN 111001 . 111242)) (111245 138359 (
|
||||
CDTABLEBROWSER.WHENSELECTEDFN 111255 . 111723) (CD.COMMANDSELECTEDFN 111725 . 117898) (CD-MENUFN
|
||||
117900 . 124377) (CD-COMPARE-FILES 124379 . 127906) (CDBROWSER-COPY 127908 . 133233) (
|
||||
CDBROWSER-DELETE-FILE 133235 . 137838) (CD-SWAPDIRS 137840 . 138357)))))
|
||||
(FILEMAP (NIL (2683 23662 (COMPAREDIRECTORIES 2693 . 8028) (COMPAREDIRECTORIES.INFOS 8030 . 11259) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 11261 . 14646) (CDENTRIES.SELECT 14648 . 19550) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 19552 . 20896) (MATCHNAME 20898 . 21578) (CD.INSURECDVALUE 21580 . 23194
|
||||
) (CD.UPDATEWIDTHS 23196 . 23660)) (23663 34971 (CDFILES 23673 . 29770) (CDFILES.MATCH 29772 . 31782)
|
||||
(CDFILES.PATS 31784 . 34969)) (34972 52990 (CDPRINT 34982 . 37499) (CDPRINT.HEADER 37501 . 38398) (
|
||||
CDPRINT.LINE 38400 . 41829) (CDPRINT.MAXWIDTHS 41831 . 45946) (CDPRINT.COLHEADERS 45948 . 47233) (
|
||||
CDPRINT.COLUMNS 47235 . 52355) (CDTEDIT 52357 . 52988)) (52991 62112 (CDMAP 53001 . 54433) (CDENTRY
|
||||
54435 . 54744) (CDSUBSET 54746 . 56185) (CDMERGE 56187 . 60171) (CDMERGE.COMMON 60173 . 61488) (
|
||||
CD.SORT 61490 . 62110)) (62113 69651 (BINCOMP 62123 . 66412) (EOLTYPE 66414 . 68976) (EOLTYPE.SHOW
|
||||
68978 . 69649)) (70179 82706 (FIND-UNCOMPILED-FILES 70189 . 73832) (FIND-UNSOURCED-FILES 73834 . 76218
|
||||
) (FIND-SOURCE-FILES 76220 . 77958) (FIND-COMPILED-FILES 77960 . 79837) (FIND-UNLOADED-FILES 79839 .
|
||||
80692) (FIND-LOADED-FILES 80694 . 81122) (FIND-MULTICOMPILED-FILES 81124 . 82704)) (82707 91138 (
|
||||
CREATED-AS 82717 . 87514) (SOURCE-FOR-COMPILED-P 87516 . 90443) (COMPILE-SOURCE-DATE-DIFF 90445 .
|
||||
91136)) (91139 101902 (FIX-DIRECTORY-DATES 91149 . 94599) (FIX-EQUIV-DATES 94601 . 96126) (
|
||||
COPY-COMPARED-FILES 96128 . 97949) (COPY-MISSING-FILES 97951 . 100108) (COMPILED-ON-SAME-SOURCE 100110
|
||||
. 101900)) (102096 109974 (CDBROWSER 102106 . 106073) (CDBROWSER.STRINGS 106075 . 109972)) (110136
|
||||
111872 (CD.TABLEITEM 110146 . 110366) (CD.TABLEITEM.PRINTFN 110368 . 110567) (CD.TABLEITEM.COPYFN
|
||||
110569 . 111627) (CDTABLEBROWSER.HEADING.REPAINTFN 111629 . 111870)) (111873 139210 (
|
||||
CDTABLEBROWSER.WHENSELECTEDFN 111883 . 112351) (CD.COMMANDSELECTEDFN 112353 . 118526) (CD-MENUFN
|
||||
118528 . 125005) (CD-COMPARE-FILES 125007 . 128534) (CDBROWSER-COPY 128536 . 134084) (
|
||||
CDBROWSER-DELETE-FILE 134086 . 138689) (CD-SWAPDIRS 138691 . 139208)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -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.
@@ -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.
165
lispusers/GITFNS
165
lispusers/GITFNS
@@ -1,12 +1,14 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
|
||||
|
||||
(FILECREATED "16-Mar-2026 12:05:55" {WMEDLEY}<lispusers>GITFNS.;578 134065
|
||||
(FILECREATED "29-Apr-2026 12:51:53" {MEDLEY}<lispusers>GITFNS.;592 137200
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS GIT-BRANCH-WHENSELECTEDFN PRC-COMMAND)
|
||||
:CHANGES-TO (FNS GIT-GWC-COMMAND)
|
||||
(COMMANDS gwc)
|
||||
(VARS GITFNSCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 2-Mar-2026 14:00:13" {WMEDLEY}<lispusers>GITFNS.;576)
|
||||
:PREVIOUS-DATE "29-Apr-2026 09:00:33" {MEDLEY}<lispusers>GITFNS.;588)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
@@ -51,7 +53,7 @@
|
||||
(INITVARS (GIT-MERGE-COMPARES T)
|
||||
(GIT-CDBROWSER-SEPARATE-DIRECTIONS T))
|
||||
(COMMANDS gwc bbc prc cob b? cdg cdw)
|
||||
(FNS PRC-COMMAND)
|
||||
(FNS PRC-COMMAND GIT-GWC-COMMAND)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -60,7 +62,7 @@
|
||||
|
||||
(FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS)
|
||||
(FNS TOGIT FROMGIT)
|
||||
(FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE)
|
||||
(FNS WORKINGSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE)
|
||||
(FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME)
|
||||
|
||||
(* ;; "")
|
||||
@@ -169,6 +171,9 @@
|
||||
|
||||
(GIT-MAKE-PROJECT
|
||||
[LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)
|
||||
(* ; "Edited 29-Apr-2026 09:00 by rmk")
|
||||
(* ; "Edited 17-Apr-2026 12:33 by rmk")
|
||||
(* ; "Edited 15-Apr-2026 16:33 by rmk")
|
||||
(* ; "Edited 25-Feb-2026 23:25 by rmk")
|
||||
(* ; "Edited 25-Oct-2025 16:53 by rmk")
|
||||
(* ; "Edited 22-Oct-2025 12:45 by rmk")
|
||||
@@ -275,7 +280,8 @@
|
||||
"for " PROJECTNAME]
|
||||
(SETQ PROJECT (create GIT-PROJECT
|
||||
PROJECTNAME ← PROJECTNAME
|
||||
GITHOST ← (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH)
|
||||
GITHOST ← (PACK* "{" (PSEUDOHOST (CONCAT "G" PROJECTNAME)
|
||||
CLONEPATH)
|
||||
"}")
|
||||
WHOST ← (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W"
|
||||
PROJECTNAME)
|
||||
@@ -439,18 +445,7 @@
|
||||
|
||||
(RPAQ? GIT-CDBROWSER-SEPARATE-DIRECTIONS T)
|
||||
|
||||
(DEFCOMMAND gwc (SUBDIR . OTHERS)
|
||||
|
||||
(* ;; "Compares the specified local git-medley subdirectories against my working Medley. The SUBDIRS are the arguments up to one that looks like a project")
|
||||
|
||||
(LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS)))
|
||||
PROJECT)
|
||||
(SETQ SUBDIRS (FOR STAIL ON SUBDIRS COLLECT (IF (GIT-GET-PROJECT (CAR STAIL)
|
||||
NIL T)
|
||||
THEN (SETQ PROJECT (CAR STAIL))
|
||||
(GO $$OUT))
|
||||
(CAR STAIL)))
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES SUBDIRS NIL NIL NIL T PROJECT)))
|
||||
(DEFCOMMAND gwc (SUBDIR . OTHERS) (GIT-GWC-COMMAND SUBDIR OTHERS))
|
||||
|
||||
(DEFCOMMAND bbc (BRANCH1 BRANCH2 LOCAL PROJECT)
|
||||
|
||||
@@ -616,6 +611,32 @@
|
||||
PROJECT))
|
||||
else (CONCAT "No open " (OR REMOTEBRANCH "")
|
||||
" pull requests"])
|
||||
|
||||
(GIT-GWC-COMMAND
|
||||
[LAMBDA (SUBDIR OTHERS) (* ; "Edited 29-Apr-2026 12:51 by rmk")
|
||||
|
||||
(* ;; "Compares the specified local git-medley subdirectories against my working Medley. The SUBDIRS are the arguments up to one that looks like a project, which may be followed by - and some excluded files")
|
||||
|
||||
(LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS)))
|
||||
EXCLUDEDFILES PROJECT)
|
||||
(SETQ SUBDIRS (for STAIL on SUBDIRS unless (CL:WHEN (AND (NULL PROJECT)
|
||||
(SETQ PROJECT (GIT-GET-PROJECT
|
||||
(CAR STAIL)
|
||||
NIL T)))
|
||||
(CL:UNLESS (EQ '- (CADR STAIL))
|
||||
(RETURN $$VAL))
|
||||
T) collect (CL:WHEN (EQ '- (CAR STAIL))
|
||||
(SETQ EXCLUDEDFILES
|
||||
(CDR STAIL))
|
||||
(RETURN $$VAL))
|
||||
(CAR STAIL)))
|
||||
(CL:UNLESS PROJECT
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT)))
|
||||
(if (AND (fetch GITHOST of PROJECT)
|
||||
(fetch WHOST of PROJECT))
|
||||
then (GIT-WORKING-COMPARE-DIRECTORIES SUBDIRS NIL EXCLUDEDFILES NIL T PROJECT)
|
||||
else (PRINTOUT T "gwc requires " (fetch PROJECTNAME of PROJECT)
|
||||
" to have both git and working directories" T T])
|
||||
)
|
||||
|
||||
|
||||
@@ -727,7 +748,7 @@
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(MYMEDLEYSUBDIR
|
||||
(WORKINGSUBDIR
|
||||
[LAMBDA (SUBDIR STAR PROJECT) (* ; "Edited 13-May-2022 10:40 by rmk")
|
||||
(* ; "Edited 7-May-2022 23:15 by rmk")
|
||||
(UNSLASHIT (PACK* (PACKFILENAME 'HOST (FETCH WHOST OF PROJECT)
|
||||
@@ -1398,13 +1419,12 @@
|
||||
" branches"])
|
||||
|
||||
(GIT-BRANCH-MENU
|
||||
[LAMBDA (BRANCHES TITLE PIN?) (* ; "Edited 1-May-2024 14:36 by rmk")
|
||||
[LAMBDA (BRANCHES TITLE) (* ; "Edited 18-Apr-2026 21:36 by rmk")
|
||||
(* ; "Edited 1-May-2024 14:36 by rmk")
|
||||
(* ; "Edited 6-Jul-2023 22:31 by rmk")
|
||||
(* ; "Edited 30-Jun-2023 16:58 by rmk")
|
||||
(* ; "Edited 18-May-2022 13:44 by rmk")
|
||||
(CL:WHEN (SETQ BRANCHES (MKLIST BRANCHES))
|
||||
(CL:WHEN PIN?
|
||||
[SETQ BRANCHES (APPEND BRANCHES '((" Pin menu" 'PinMenu])
|
||||
(create MENU
|
||||
TITLE ← (OR TITLE (CONCAT (LENGTH BRANCHES)
|
||||
" branches"))
|
||||
@@ -1950,6 +1970,8 @@
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES
|
||||
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
|
||||
|
||||
(* ;; "Edited 29-Apr-2026 08:46 by rmk")
|
||||
|
||||
(* ;; "Edited 28-Oct-2025 14:00 by rmk")
|
||||
|
||||
(* ;; "Edited 25-Oct-2025 23:32 by rmk")
|
||||
@@ -1960,18 +1982,12 @@
|
||||
|
||||
(* ;; "Edited 26-Sep-2023 22:41 by rmk")
|
||||
|
||||
(* ;; "Edited 17-Jun-2023 22:54 by rmk")
|
||||
|
||||
(* ;; "Edited 10-Jun-2023 21:32 by rmk")
|
||||
|
||||
(* ;; "Edited 20-Jul-2022 21:18 by rmk")
|
||||
|
||||
(* ;; "Edited 25-Jun-2022 21:37 by rmk")
|
||||
|
||||
(* ;; "Edited 17-May-2022 17:39 by rmk")
|
||||
|
||||
(* ;; "Edited 10-May-2022 10:41 by rmk")
|
||||
|
||||
(* ;;
|
||||
"Edited 29-Mar-2022 13:58 by rmk: working medley subdirectories with the current local git branch.")
|
||||
|
||||
@@ -1991,7 +2007,8 @@
|
||||
(LET ((SUBDIRSTRING (if (EQ SUBDIRS 'all)
|
||||
then (SETQ SUBDIRS (ALLSUBDIRS PROJECT))
|
||||
"ALL subdirectories"
|
||||
else SUBDIRS)))
|
||||
else SUBDIRS))
|
||||
(EXCLUSIONS))
|
||||
(for SUBDIR TITLE CDVAL (WPROJ ← (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT)
|
||||
T)))
|
||||
(NENTRIES ← 0)
|
||||
@@ -1999,11 +2016,12 @@
|
||||
first (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
|
||||
(BKSYSBUF " ") inside SUBDIRS
|
||||
collect (TERPRI T)
|
||||
(SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR SUBDIR T PROJECT)
|
||||
(SETQ CDVAL (COMPAREDIRECTORIES (WORKINGSUBDIR SUBDIR T PROJECT)
|
||||
(GITSUBDIR SUBDIR T PROJECT)
|
||||
(OR SELECT '(> < ~= -* *-))
|
||||
'(*.* *>*.* .* *>.*)
|
||||
(for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS)
|
||||
(for E DPOS in (APPEND (MKLIST EXCLUDEDFILES)
|
||||
(GIT-GET-PROJECT PROJECT 'EXCLUSIONS))
|
||||
collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E
|
||||
'DIRECTORY)
|
||||
1 NIL T T FILEDIRCASEARRAY))
|
||||
@@ -2216,7 +2234,7 @@
|
||||
(OR LABEL2 FILE2])
|
||||
|
||||
(GIT-CD-MENUFN
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 28-Oct-2025 11:50 by rmk")
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 28-Oct-2025 11:30 by rmk")
|
||||
(* ; "Edited 25-Oct-2025 23:44 by rmk")
|
||||
(* ; "Edited 21-Sep-2022 21:34 by rmk")
|
||||
(* ; "Edited 22-May-2022 19:13 by rmk")
|
||||
@@ -2225,9 +2243,32 @@
|
||||
|
||||
(* ;; "MENUITEM is of the form (display-atom <this function> . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom")
|
||||
|
||||
(DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY USERDATA PWINDOW))
|
||||
(DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY USERDATA))
|
||||
(SELECTQ (OR (CADDR MENUITEM)
|
||||
(CAR MENUITEM))
|
||||
(Delete% -> (FLASHWINDOW PWINDOW)
|
||||
(GIVE.TTY.PROCESS PWINDOW)
|
||||
(CL:WHEN [OR (EQ KEY 'MIDDLE)
|
||||
(EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete " LABEL2 " ? "]
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL T)))
|
||||
(|Delete ALL <-|
|
||||
(FLASHWINDOW PWINDOW)
|
||||
(GIVE.TTY.PROCESS PWINDOW)
|
||||
(if (NAMEFIELD LABEL1 T)
|
||||
then (CL:WHEN [OR (EQ KEY 'MIDDLE)
|
||||
(EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete ALL versions of "
|
||||
(NAMEFIELD LABEL1 T)
|
||||
" ? "]
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL T))
|
||||
else (PRINTOUT T "Nothing to delete")))
|
||||
(Delete% BOTH (FLASHWINDOW PWINDOW)
|
||||
(GIVE.TTY.PROCESS PWINDOW)
|
||||
(CL:WHEN (EQ 'Y (ASKUSER NIL 'N (CONCAT
|
||||
"Delete all Medley and git versions of "
|
||||
(NAMEFIELD LABEL1 T)
|
||||
" ? ")))
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL T)
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL T T)))
|
||||
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT (CADDDR MENUITEM)))
|
||||
(SHOULDNT])
|
||||
|
||||
@@ -2429,33 +2470,33 @@
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4197 21075 (GIT-CLONEP 4207 . 5638) (GIT-INIT 5640 . 6270) (GIT-MAKE-PROJECT 6272 .
|
||||
14129) (GIT-GET-PROJECT 14131 . 16056) (GIT-PUT-PROJECT-FIELD 16058 . 17699) (GIT-PROJECT-PATH 17701
|
||||
. 18745) (FIND-ANCESTOR-DIRECTORY 18747 . 19098) (GIT-FIND-CLONE 19100 . 20183) (GIT-MAINBRANCH 20185
|
||||
. 20580) (GIT-MAINBRANCH? 20582 . 21073)) (26538 31832 (PRC-COMMAND 26548 . 31830)) (31888 34676 (
|
||||
ALLSUBDIRS 31898 . 33184) (MEDLEYSUBDIRS 33186 . 33879) (GITSUBDIRS 33881 . 34674)) (34677 37082 (
|
||||
TOGIT 34687 . 36095) (FROMGIT 36097 . 37080)) (37083 40093 (MYMEDLEYSUBDIR 37093 . 37549) (GITSUBDIR
|
||||
37551 . 37994) (STRIPDIR 37996 . 38374) (STRIPHOST 38376 . 38616) (STRIPNAME 38618 . 39371) (
|
||||
STRIPWHERE 39373 . 40091)) (40094 42329 (GFILE4MFILE 40104 . 40800) (MFILE4GFILE 40802 . 41371) (
|
||||
GIT-REPO-FILENAME 41373 . 42327)) (42378 52635 (GIT-COMMIT 42388 . 43214) (GIT-PUSH 43216 . 43976) (
|
||||
GIT-PULL 43978 . 44730) (GIT-APPROVAL 44732 . 45081) (GIT-GET-FILE 45083 . 46998) (GIT-FILE-EXISTS?
|
||||
47000 . 47274) (GIT-REMOTE-UPDATE 47276 . 48111) (GIT-REMOTE-ADD 48113 . 48420) (GIT-FILE-DATE 48422
|
||||
. 49469) (GIT-FILE-HISTORY 49471 . 51405) (GIT-PRINT-FILE-HISTORY 51407 . 52459) (GIT-FETCH 52461 .
|
||||
52633)) (52665 64617 (GIT-BRANCH-DIFF 52675 . 59564) (GIT-COMMIT-DIFFS 59566 . 60457) (
|
||||
GIT-BRANCH-RELATIONS 60459 . 64143) (GIT-MODIFIED 64145 . 64615)) (64662 83597 (GIT-BRANCH-NUM 64672
|
||||
. 65245) (GIT-CHECKOUT 65247 . 66533) (GIT-WHICH-BRANCH 66535 . 66942) (GIT-MAKE-BRANCH 66944 . 69523
|
||||
) (GIT-BRANCHES 69525 . 72122) (GIT-BRANCH-EXISTS? 72124 . 72995) (GIT-PICK-BRANCH 72997 . 73487) (
|
||||
GIT-BRANCH-MENU 73489 . 74378) (GIT-BRANCH-WHENSELECTEDFN 74380 . 76087) (GIT-PULL-REQUESTS 76089 .
|
||||
79974) (GIT-SHORT-BRANCH-NAME 79976 . 80267) (GIT-LONG-NAME 80269 . 80586) (GIT-PRC-BRANCHES 80588 .
|
||||
83595)) (83627 88381 (GIT-MY-CURRENT-BRANCH 83637 . 84007) (GIT-MY-BRANCHP 84009 . 84627) (
|
||||
GIT-MY-NEXT-BRANCH 84629 . 86429) (GIT-MY-BRANCHES 86431 . 88379)) (88427 92511 (GIT-ADD-WORKTREE
|
||||
88437 . 90044) (GIT-REMOVE-WORKTREE 90046 . 90978) (GIT-LIST-WORKTREES 90980 . 91791) (WORKTREEDIR
|
||||
91793 . 92509)) (92559 125597 (GIT-GET-DIFFERENT-FILES 92569 . 99477) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 99479 . 107118) (GIT-WORKING-COMPARE-DIRECTORIES 107120 . 112922) (
|
||||
GIT-COMPARE-WORKTREE 112924 . 116902) (GITCDOBJBUTTONFN 116904 . 121402) (GIT-CD-LABELFN 121404 .
|
||||
122490) (GIT-CD-MENUFN 122492 . 123578) (GIT-WORKING-COMPARE-FILES 123580 . 124200) (
|
||||
GIT-BRANCHES-COMPARE-FILES 124202 . 125366) (GIT-PR-COMPARE 125368 . 125595)) (125667 133998 (CDGITDIR
|
||||
125677 . 126364) (GIT-COMMAND 126366 . 127924) (GITORIGIN 127926 . 128623) (GIT-INITIALS 128625 .
|
||||
128929) (GIT-COMMAND-TO-FILE 128931 . 132416) (GIT-RESULT-TO-LINES 132418 . 133331) (STRIPLOCAL 133333
|
||||
. 133996)))))
|
||||
(FILEMAP (NIL (4257 21537 (GIT-CLONEP 4267 . 5698) (GIT-INIT 5700 . 6330) (GIT-MAKE-PROJECT 6332 .
|
||||
14591) (GIT-GET-PROJECT 14593 . 16518) (GIT-PUT-PROJECT-FIELD 16520 . 18161) (GIT-PROJECT-PATH 18163
|
||||
. 19207) (FIND-ANCESTOR-DIRECTORY 19209 . 19560) (GIT-FIND-CLONE 19562 . 20645) (GIT-MAINBRANCH 20647
|
||||
. 21042) (GIT-MAINBRANCH? 21044 . 21535)) (26309 33483 (PRC-COMMAND 26319 . 31601) (GIT-GWC-COMMAND
|
||||
31603 . 33481)) (33539 36327 (ALLSUBDIRS 33549 . 34835) (MEDLEYSUBDIRS 34837 . 35530) (GITSUBDIRS
|
||||
35532 . 36325)) (36328 38733 (TOGIT 36338 . 37746) (FROMGIT 37748 . 38731)) (38734 41743 (
|
||||
WORKINGSUBDIR 38744 . 39199) (GITSUBDIR 39201 . 39644) (STRIPDIR 39646 . 40024) (STRIPHOST 40026 .
|
||||
40266) (STRIPNAME 40268 . 41021) (STRIPWHERE 41023 . 41741)) (41744 43979 (GFILE4MFILE 41754 . 42450)
|
||||
(MFILE4GFILE 42452 . 43021) (GIT-REPO-FILENAME 43023 . 43977)) (44028 54285 (GIT-COMMIT 44038 . 44864)
|
||||
(GIT-PUSH 44866 . 45626) (GIT-PULL 45628 . 46380) (GIT-APPROVAL 46382 . 46731) (GIT-GET-FILE 46733 .
|
||||
48648) (GIT-FILE-EXISTS? 48650 . 48924) (GIT-REMOTE-UPDATE 48926 . 49761) (GIT-REMOTE-ADD 49763 .
|
||||
50070) (GIT-FILE-DATE 50072 . 51119) (GIT-FILE-HISTORY 51121 . 53055) (GIT-PRINT-FILE-HISTORY 53057 .
|
||||
54109) (GIT-FETCH 54111 . 54283)) (54315 66267 (GIT-BRANCH-DIFF 54325 . 61214) (GIT-COMMIT-DIFFS 61216
|
||||
. 62107) (GIT-BRANCH-RELATIONS 62109 . 65793) (GIT-MODIFIED 65795 . 66265)) (66312 85259 (
|
||||
GIT-BRANCH-NUM 66322 . 66895) (GIT-CHECKOUT 66897 . 68183) (GIT-WHICH-BRANCH 68185 . 68592) (
|
||||
GIT-MAKE-BRANCH 68594 . 71173) (GIT-BRANCHES 71175 . 73772) (GIT-BRANCH-EXISTS? 73774 . 74645) (
|
||||
GIT-PICK-BRANCH 74647 . 75137) (GIT-BRANCH-MENU 75139 . 76040) (GIT-BRANCH-WHENSELECTEDFN 76042 .
|
||||
77749) (GIT-PULL-REQUESTS 77751 . 81636) (GIT-SHORT-BRANCH-NAME 81638 . 81929) (GIT-LONG-NAME 81931 .
|
||||
82248) (GIT-PRC-BRANCHES 82250 . 85257)) (85289 90043 (GIT-MY-CURRENT-BRANCH 85299 . 85669) (
|
||||
GIT-MY-BRANCHP 85671 . 86289) (GIT-MY-NEXT-BRANCH 86291 . 88091) (GIT-MY-BRANCHES 88093 . 90041)) (
|
||||
90089 94173 (GIT-ADD-WORKTREE 90099 . 91706) (GIT-REMOVE-WORKTREE 91708 . 92640) (GIT-LIST-WORKTREES
|
||||
92642 . 93453) (WORKTREEDIR 93455 . 94171)) (94221 128732 (GIT-GET-DIFFERENT-FILES 94231 . 101139) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 101141 . 108780) (GIT-WORKING-COMPARE-DIRECTORIES 108782 . 114597) (
|
||||
GIT-COMPARE-WORKTREE 114599 . 118577) (GITCDOBJBUTTONFN 118579 . 123077) (GIT-CD-LABELFN 123079 .
|
||||
124165) (GIT-CD-MENUFN 124167 . 126713) (GIT-WORKING-COMPARE-FILES 126715 . 127335) (
|
||||
GIT-BRANCHES-COMPARE-FILES 127337 . 128501) (GIT-PR-COMPARE 128503 . 128730)) (128802 137133 (CDGITDIR
|
||||
128812 . 129499) (GIT-COMMAND 129501 . 131059) (GITORIGIN 131061 . 131758) (GIT-INITIALS 131760 .
|
||||
132064) (GIT-COMMAND-TO-FILE 132066 . 135551) (GIT-RESULT-TO-LINES 135553 . 136466) (STRIPLOCAL 136468
|
||||
. 137131)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "27-Jan-2026 13:21:10" {WMEDLEY}<lispusers>HELPSYS.;21 88654
|
||||
(FILECREATED "20-Apr-2026 08:07:50" {MEDLEY}<lispusers>HELPSYS.;24 89018
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS DOCS.LOOKUP GENERIC.MAN.LOOKUP)
|
||||
(VARS HELPSYSCOMS)
|
||||
:CHANGES-TO (FNS REPO.LOOKUP)
|
||||
|
||||
:PREVIOUS-DATE " 5-May-2025 22:04:32" {WMEDLEY}<lispusers>HELPSYS.;15)
|
||||
:PREVIOUS-DATE "27-Jan-2026 13:21:10" {MEDLEY}<lispusers>HELPSYS.;21)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT HELPSYSCOMS)
|
||||
@@ -340,21 +339,27 @@
|
||||
else "git web--browse"])
|
||||
|
||||
(REPO.LOOKUP
|
||||
[LAMBDA (ENTRY TYPES) (* ; "Edited 13-Jan-2023 10:46 by lmm")
|
||||
[LAMBDA (ENTRY TYPES) (* ; "Edited 20-Apr-2026 08:06 by rmk")
|
||||
(* ; "Edited 13-Jan-2023 10:46 by lmm")
|
||||
(* ; "Edited 16-Aug-2022 16:26 by lmm")
|
||||
(for FL in (UNION (WHEREIS ENTRY (OR TYPES HELPSYS.REPO.TYPES)
|
||||
T)
|
||||
(LIST ENTRY)) bind POS FND
|
||||
(for FL POS FND TSTREAM in (UNION (WHEREIS ENTRY (OR TYPES HELPSYS.REPO.TYPES)
|
||||
T)
|
||||
(LIST ENTRY))
|
||||
when [SETQ FND (OR (FINDFILE-WITH-EXTENSIONS FL NIL '(TEDIT TXT TED))
|
||||
(AND (SETQ POS (STRPOS "-" FL))
|
||||
(FINDFILE-WITH-EXTENSIONS (SUBSTRING FL 1 (CL:1- POS))
|
||||
NIL
|
||||
'(TEDIT TXT TTY TED]
|
||||
join (CL:WITH-OPEN-FILE (STR (PATHNAME FND)
|
||||
:DIRECTION :INPUT)
|
||||
(CL:WHEN (SETQ POS (FFILEPOS ENTRY STR))
|
||||
(TEDIT-SEE STR NIL NIL (CL:FORMAT NIL "~a [~a]" FL ENTRY))
|
||||
(LIST FL))])
|
||||
collect (SETQ TSTREAM (OPENTEXTSTREAM FND))
|
||||
[TEDIT TSTREAM NIL NIL `(READONLY T LEAVETTY T FONT ,DEFAULTFONT TITLE
|
||||
,(CL:IF (EQ FL ENTRY)
|
||||
FL
|
||||
(CONCAT ENTRY " on " FL))]
|
||||
(CL:UNLESS (EQ FL ENTRY)
|
||||
(CL:WHEN (SETQ POS (TEDIT.FIND TSTREAM ENTRY))
|
||||
(TEDIT.SETSEL TSTREAM POS (NCHARS ENTRY))
|
||||
(TEDIT.NORMALIZECARET TSTREAM)))
|
||||
FL])
|
||||
)
|
||||
|
||||
(RPAQQ CLHS.INDEX
|
||||
@@ -1716,14 +1721,14 @@
|
||||
|
||||
(PUTPROPS HELPSYS FILETYPE :FAKE-COMPILE-FILE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4640 10992 (HELPSYS 4650 . 6491) (IRM.LOOKUP 6493 . 8131) (GENERIC.MAN.LOOKUP 8133 .
|
||||
10001) (IRM.SMART.LOOKUP 10003 . 10159) (IRM.RESET 10161 . 10570) (DOCS.LOOKUP 10572 . 10990)) (11249
|
||||
18568 (CLHS.INDEX 11259 . 14223) (CLHS.LOOKUP 14225 . 16231) (CLHS.OPENER 16233 . 17556) (REPO.LOOKUP
|
||||
17558 . 18566)) (71663 73181 (IRM.GET.DINFOGRAPH 71673 . 72548) (IRM.DISPLAY.REF 72550 . 73179)) (
|
||||
73183 73545 (IRM.LOAD-GRAPH 73183 . 73545)) (73870 79374 (IRM.DISPLAY.CREF 73880 . 75594) (
|
||||
IRM.CREF.BOX 75596 . 76423) (IRM.PUT.CREF 76425 . 76650) (IRM.GET.CREF 76652 . 77023) (
|
||||
IRM.CREF.BUTTONEVENTFN 77025 . 79372)) (79929 88235 (\IRM.GET.REF 79939 . 81270) (\IRM.SMART.REF 81272
|
||||
. 83199) (\IRM.CHOOSE.REF 83201 . 84452) (\IRM.WILD.REF 84454 . 85709) (\IRM.WILDCARD 85711 . 86077)
|
||||
(\IRM.WILD.MATCH 86079 . 87309) (\IRM.GET.HASHFILE 87311 . 87774) (\IRM.GET.KEYWORDS 87776 . 88233)) (
|
||||
88372 88528 (\IRM.AROUND-EXIT 88372 . 88528)))))
|
||||
(FILEMAP (NIL (4582 10934 (HELPSYS 4592 . 6433) (IRM.LOOKUP 6435 . 8073) (GENERIC.MAN.LOOKUP 8075 .
|
||||
9943) (IRM.SMART.LOOKUP 9945 . 10101) (IRM.RESET 10103 . 10512) (DOCS.LOOKUP 10514 . 10932)) (11191
|
||||
18932 (CLHS.INDEX 11201 . 14165) (CLHS.LOOKUP 14167 . 16173) (CLHS.OPENER 16175 . 17498) (REPO.LOOKUP
|
||||
17500 . 18930)) (72027 73545 (IRM.GET.DINFOGRAPH 72037 . 72912) (IRM.DISPLAY.REF 72914 . 73543)) (
|
||||
73547 73909 (IRM.LOAD-GRAPH 73547 . 73909)) (74234 79738 (IRM.DISPLAY.CREF 74244 . 75958) (
|
||||
IRM.CREF.BOX 75960 . 76787) (IRM.PUT.CREF 76789 . 77014) (IRM.GET.CREF 77016 . 77387) (
|
||||
IRM.CREF.BUTTONEVENTFN 77389 . 79736)) (80293 88599 (\IRM.GET.REF 80303 . 81634) (\IRM.SMART.REF 81636
|
||||
. 83563) (\IRM.CHOOSE.REF 83565 . 84816) (\IRM.WILD.REF 84818 . 86073) (\IRM.WILDCARD 86075 . 86441)
|
||||
(\IRM.WILD.MATCH 86443 . 87673) (\IRM.GET.HASHFILE 87675 . 88138) (\IRM.GET.KEYWORDS 88140 . 88597)) (
|
||||
88736 88892 (\IRM.AROUND-EXIT 88736 . 88892)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,10 +1,12 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
|
||||
|
||||
(FILECREATED "31-Mar-2026 09:03:25" {WMEDLEY}<sources>UNICODE-FORMATS.;4 218013
|
||||
(FILECREATED " 7-May-2026 11:08:18" {MEDLEY}<sources>UNICODE-FORMATS.;5 218405
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE " 9-Mar-2026 13:11:16" {WMEDLEY}<sources>UNICODE-FORMATS.;3)
|
||||
:CHANGES-TO (FNS SYSTEM-EXTERNALFORMAT)
|
||||
|
||||
:PREVIOUS-DATE "31-Mar-2026 09:03:25" {MEDLEY}<sources>UNICODE-FORMATS.;4)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UNICODE-FORMATSCOMS)
|
||||
@@ -1246,7 +1248,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(SYSTEM-EXTERNALFORMAT
|
||||
[LAMBDA NIL (* ; "Edited 6-Feb-2026 11:29 by rmk")
|
||||
[LAMBDA NIL (* ; "Edited 7-May-2026 11:08 by rmk")
|
||||
(* ; "Edited 6-Feb-2026 11:29 by rmk")
|
||||
(* ; "Edited 31-Jan-2026 18:51 by rmk")
|
||||
(* ; "Edited 10-Oct-2022 11:55 by lmm")
|
||||
(* ; "Edited 7-Jul-2022 10:41 by rmk")
|
||||
@@ -1254,9 +1257,13 @@
|
||||
(* ;; "Returns the name, sets the global. For now, UTF-8 or through, could be something else.")
|
||||
|
||||
(fetch (EXTERNALFORMAT NAME) of (SETQ *SYSTEM-EXTERNALFORMAT*
|
||||
(FIND-FORMAT (FOR X IN '("LC_CTYPE" "LC_ALL" "LANG")
|
||||
WHEN (STRPOS ".UTF-8" (UNIX-GETENV X))
|
||||
DO (RETURN :UTF-8) FINALLY (RETURN :THROUGH])
|
||||
(FIND-FORMAT (for X in '("LC_CTYPE" "LC_ALL" "LANG")
|
||||
when (STRPOS "UTF" (U-CASE (UNIX-GETENV X)))
|
||||
do
|
||||
(* ;;
|
||||
"Should it check separately for 8? Would anyone ever say UTF-16 ?")
|
||||
|
||||
(RETURN :UTF-8) finally (RETURN :THROUGH])
|
||||
|
||||
(MTOSYSSTRING
|
||||
[LAMBDA (MSTRING) (* ; "Edited 6-Feb-2026 00:20 by rmk")
|
||||
@@ -2756,20 +2763,20 @@
|
||||
(64994 8322) (64995 8323) (64996 8324) (64997 8325) (64998 8326) (64999 8327) (65000 8328) (65001
|
||||
8329) (65002 8331) (65003 8330) (65004 8332) (65008 (48 824)))))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3431 19523 (UTF8.OUTCHARFN 3441 . 6457) (UTF8.SLUG.OUTCHARFN 6459 . 7123) (
|
||||
UTF8.INCCODEFN 7125 . 13404) (UTF8.PEEKCCODEFN 13406 . 18539) (\UTF8.BACKCCODEFN 18541 . 19521)) (
|
||||
19524 24439 (UTF16BE.OUTCHARFN 19534 . 20553) (UTF16BE.INCCODEFN 20555 . 21897) (UTF16BE.PEEKCCODEFN
|
||||
21899 . 23243) (\UTF16BE.BACKCCODEFN 23245 . 24437)) (24440 29171 (UTF16LE.OUTCHARFN 24450 . 25566) (
|
||||
UTF16LE.INCCODEFN 25568 . 26697) (UTF16LE.PEEKCCODEFN 26699 . 27975) (\UTF16LE.BACKCCODEFN 27977 .
|
||||
29169)) (29172 32219 (READBOM 29182 . 31251) (WRITEBOM 31253 . 32217)) (32220 36251 (
|
||||
MAKE-UNICODE-FORMATS 32230 . 36249)) (36319 40813 (UTF8.BINCODE 36329 . 39017) (\UTF8.FETCHCODE 39019
|
||||
. 40811)) (40814 46437 (UTF8.VALIDATE 40824 . 43421) (NUTF8-BYTE1-BYTES 43423 . 44160) (
|
||||
NUTF8-CODE-BYTES 44162 . 45219) (NUTF8-STRING-BYTES 45221 . 46113) (N-MCHARS 46115 . 46435)) (46501
|
||||
47775 (MTOUCODE 46511 . 46680) (UTOMCODE 46682 . 46879) (MTOUCODE? 46881 . 47260) (UTOMCODE? 47262 .
|
||||
47773)) (47776 54348 (MTOUSTRING 47786 . 48369) (UTOMSTRING 48371 . 48954) (MTOUTF8STRING 48956 .
|
||||
53235) (UTF8TOMSTRING 53237 . 54346)) (54406 60114 (XTOUCODE 54416 . 54934) (UTOXCODE 54936 . 55444) (
|
||||
XTOUCODE? 55446 . 56507) (UTOXCODE? 56509 . 57592) (XTOUSTRING 57594 . 58289) (UTOXSTRING 58291 .
|
||||
59034) (XTOUTF8STRING 59036 . 60112)) (60115 65294 (MERGE-UNICODE-TRANSLATION-TABLES 60125 . 62887) (
|
||||
UNICODE.UNMAPPED 62889 . 65292)) (69033 69286 (UNICODE-INIT 69043 . 69284)) (69307 70745 (
|
||||
SYSTEM-EXTERNALFORMAT 69317 . 70261) (MTOSYSSTRING 70263 . 70456) (SYSTOMSTRING 70458 . 70743)))))
|
||||
(FILEMAP (NIL (3476 19568 (UTF8.OUTCHARFN 3486 . 6502) (UTF8.SLUG.OUTCHARFN 6504 . 7168) (
|
||||
UTF8.INCCODEFN 7170 . 13449) (UTF8.PEEKCCODEFN 13451 . 18584) (\UTF8.BACKCCODEFN 18586 . 19566)) (
|
||||
19569 24484 (UTF16BE.OUTCHARFN 19579 . 20598) (UTF16BE.INCCODEFN 20600 . 21942) (UTF16BE.PEEKCCODEFN
|
||||
21944 . 23288) (\UTF16BE.BACKCCODEFN 23290 . 24482)) (24485 29216 (UTF16LE.OUTCHARFN 24495 . 25611) (
|
||||
UTF16LE.INCCODEFN 25613 . 26742) (UTF16LE.PEEKCCODEFN 26744 . 28020) (\UTF16LE.BACKCCODEFN 28022 .
|
||||
29214)) (29217 32264 (READBOM 29227 . 31296) (WRITEBOM 31298 . 32262)) (32265 36296 (
|
||||
MAKE-UNICODE-FORMATS 32275 . 36294)) (36364 40858 (UTF8.BINCODE 36374 . 39062) (\UTF8.FETCHCODE 39064
|
||||
. 40856)) (40859 46482 (UTF8.VALIDATE 40869 . 43466) (NUTF8-BYTE1-BYTES 43468 . 44205) (
|
||||
NUTF8-CODE-BYTES 44207 . 45264) (NUTF8-STRING-BYTES 45266 . 46158) (N-MCHARS 46160 . 46480)) (46546
|
||||
47820 (MTOUCODE 46556 . 46725) (UTOMCODE 46727 . 46924) (MTOUCODE? 46926 . 47305) (UTOMCODE? 47307 .
|
||||
47818)) (47821 54393 (MTOUSTRING 47831 . 48414) (UTOMSTRING 48416 . 48999) (MTOUTF8STRING 49001 .
|
||||
53280) (UTF8TOMSTRING 53282 . 54391)) (54451 60159 (XTOUCODE 54461 . 54979) (UTOXCODE 54981 . 55489) (
|
||||
XTOUCODE? 55491 . 56552) (UTOXCODE? 56554 . 57637) (XTOUSTRING 57639 . 58334) (UTOXSTRING 58336 .
|
||||
59079) (XTOUTF8STRING 59081 . 60157)) (60160 65339 (MERGE-UNICODE-TRANSLATION-TABLES 60170 . 62932) (
|
||||
UNICODE.UNMAPPED 62934 . 65337)) (69078 69331 (UNICODE-INIT 69088 . 69329)) (69352 71137 (
|
||||
SYSTEM-EXTERNALFORMAT 69362 . 70653) (MTOSYSSTRING 70655 . 70848) (SYSTOMSTRING 70850 . 71135)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user