Compare commits
11 Commits
fgh_fix256
...
lmm-diagno
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
9d5e83d4d2 | ||
|
|
a76ccc196a | ||
|
|
4ea799cc15 | ||
|
|
6406e1cf06 | ||
|
|
3269169f48 | ||
|
|
c16e3b4a55 | ||
|
|
285e35f2ea | ||
|
|
4e761298ea | ||
|
|
cbea9a7c9d | ||
|
|
47dd8edf60 | ||
|
|
1d2292aa62 |
@@ -1,27 +1,26 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "28-Jan-2026 11:03:17" {DSK}<Users>larry>il>medley>internal>MEDLEY-UTILS.;3 26880
|
||||
(FILECREATED " 4-May-2026 19:19:00" {MEDLEY}<INTERNAL>MEDLEY-UTILS.;9 30560
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (FNS MAKE-INDEX-HTMLS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES
|
||||
MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH MAKE-WHEREIS-LOOPS HCFILES RECOMPILE-ONE
|
||||
RECMPL COMPILE-SETUP REMAKEFILES)
|
||||
(ADVICE TEDIT.PROMPTPRINT)
|
||||
:CHANGES-TO (FNS HCFILES)
|
||||
(FUNCTIONS REPORT-AND-GO)
|
||||
|
||||
:PREVIOUS-DATE "28-Jan-2026 10:46:02" {DSK}<Users>larry>il>medley>internal>MEDLEY-UTILS.;1)
|
||||
:PREVIOUS-DATE "16-Apr-2026 22:42:51" {MEDLEY}<INTERNAL>MEDLEY-UTILS.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
|
||||
|
||||
(RPAQQ MEDLEY-UTILSCOMS
|
||||
[(FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
|
||||
(VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
|
||||
(VARS HC-SKIP-EXTENSIONS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
|
||||
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH MAKE-WHEREIS-LOOPS)
|
||||
(FNS HCFILES MAKE-INDEX-HTMLS)
|
||||
(PROP FILETYPE MEDLEY-UTILS)
|
||||
(ADVISE TEDIT.PROMPTPRINT)
|
||||
(FNS RECOMPILE-ONE RECMPL COMPILE-SETUP REMAKEFILES)
|
||||
(FUNCTIONS REPORT-AND-GO)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
@@ -140,6 +139,12 @@
|
||||
(for X in (OR DIRS MEDLEY-FIX-DIRS) join (FIX-DIRECTORY-DATES (MEDLEYDIR (PRINT X T])
|
||||
)
|
||||
|
||||
(RPAQQ HC-SKIP-EXTENSIONS
|
||||
(PDF SKIP HTML LCOM DFASL SH SYSOUT DRIBBLE IMPTR DISPLAYFONT WD WIDTHS MEDLEYDISPLAYFONT
|
||||
PSCFONT ALL DATABASE 1 MD GZ PRESS IP BITMAP EL ELC XFORMS BUGREPORTS SUITE LISTING AWK
|
||||
DINFOGRAPH HASHFILE BLTCHAR DOC DOCPOINTERS STATUS NOTEFILE ICO ISS BMP PNG PS1
|
||||
VENUESYSOUT ACE FMC HKB LGC CMD COMMAND HTM SVG XML EXE))
|
||||
|
||||
(RPAQQ MEDLEY-FIX-DIRS ("sources" "library" "lispusers" "internal" "greetfiles" "doctools"))
|
||||
|
||||
(RPAQQ OKSOURCES (RENAMEFNS VMEM READSYS CASH-FILE HASH-FILE MEDLEYDIR MAKEINIT))
|
||||
@@ -162,15 +167,18 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MAKE-EXPORTS-ALL
|
||||
[LAMBDA (OUTFILE) (* ; "Edited 3-Aug-2023 18:34 by frank")
|
||||
[LAMBDA (OUTFILE) (* ; "Edited 15-Apr-2026 16:42 by mth")
|
||||
(* ; "Edited 3-Aug-2023 18:34 by frank")
|
||||
(* ; "Edited 9-Mar-2021 16:11 by larry")
|
||||
(* "Edited May 3, 2018 by Ron Kaplan--relative to MEDLEYDIR/lispcore/. Don't know why it does the CORE/RENAME")
|
||||
(*
|
||||
"Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory.")
|
||||
(*
|
||||
"Edited July 5, 1990 by Sybalsky -- point it to Pele as the truth directory.")
|
||||
(*
|
||||
"Edited September 29, 1986 by van Melle")
|
||||
|
||||
(* ;; "Edited May 3, 2018 by Ron Kaplan--relative to MEDLEYDIR/lispcore/. Don't know why it does the CORE/RENAME")
|
||||
|
||||
(* ;; "Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory.")
|
||||
|
||||
(* ;; "Edited July 5, 1990 by Sybalsky -- point it to Pele as the truth directory.")
|
||||
|
||||
(* ;; "Edited September 29, 1986 by van Melle")
|
||||
|
||||
(CNDIR (MEDLEYDIR "sources"))
|
||||
(LOAD 'FILESETS)
|
||||
(GATHEREXPORTS EXPORTFILES (OR OUTFILE "exports.all"])
|
||||
@@ -204,7 +212,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(HCFILES
|
||||
[LAMBDA (BASE REDO SUBSETS) (* ; "Edited 30-Jun-2024 08:27 by lmm")
|
||||
[LAMBDA (BASE REDO SUBSETS) (* ; "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")
|
||||
(* ; "Edited 5-Feb-2024 12:16 by lmm")
|
||||
@@ -213,74 +223,118 @@
|
||||
|
||||
(* ;;;; "BASE is the root directory. Doesn't replace PDF files except when REDO")
|
||||
|
||||
(* ;;; " SUBSETS is some combinsyion og (:YRDY :HYML :PRETTY and INDEX")
|
||||
(* ;;; " SUBSETS is some combination of (:YRDY :HYML :PRETTY and INDEX")
|
||||
|
||||
(LET
|
||||
[[DIRLIST (LIST (OR BASE (PSEUDOFILENAME (MEDLEYDIR]
|
||||
(PHASES (OR SUBSETS '(TEDIT PRETTY INDEX HRULE]
|
||||
(FILESLOAD PDFSTREAM SKETCH)
|
||||
(FONTSET 'STANDARD)
|
||||
(while DIRLIST
|
||||
do
|
||||
(SETQ BASE (pop DIRLIST))
|
||||
(for SRCPATH in (DIRECTORY (CONCAT BASE "*.*;"))
|
||||
do (PROG* [(SRC (UNPACKFILENAME SRCPATH))
|
||||
[EXT (U-CASE (LISTGET SRC 'EXTENSION]
|
||||
(DIR (LISTGET SRC 'DIRECTORY))
|
||||
FRDY LDGP DEST (NOV (PACKFILENAME `(VERSION NIL ,@SRC]
|
||||
(CL:FORMAT T "Starting on ~a :~%%" SRCPATH)
|
||||
(CL:WHEN (DIRECTORYNAMEP SRCPATH)
|
||||
(LET* ([DIRLIST (LIST (OR BASE (PSEUDOFILENAME (MEDLEYDIR]
|
||||
[PHASES (OR SUBSETS '(TEDIT PRETTY INDEX HRULE]
|
||||
(DOTEDIT (MEMB 'TEDIT PHASES))
|
||||
(DOPRETTY (MEMB 'PRETTY PHASES)))
|
||||
(FILESLOAD PDFSTREAM SKETCH)
|
||||
(FONTSET 'STANDARD)
|
||||
(while DIRLIST
|
||||
do (SETQ BASE (pop DIRLIST))
|
||||
|
||||
(* ;; "any directory names, push them off and do them in another phase")
|
||||
(* ;; "Breadth-first processing")
|
||||
|
||||
(CL:UNLESS (OR (STRPOS ">." NOV)
|
||||
(INFILEP (CONCAT NOV ".skip")))
|
||||
(SETQ DIRLIST (NCONC1 DIRLIST SRCPATH)))
|
||||
(RETURN))
|
||||
(CL:WHEN
|
||||
(MEMB EXT
|
||||
'(PDF SKIP HTML LCOM DFASL SH SYSOUT DRIBBLE IMPTR DISPLAYFONT ALL
|
||||
DATABASE))
|
||||
(for SRCPATH in (DIRECTORY (CONCAT BASE "*.*;"))
|
||||
do (PROG* ((SRC (UNPACKFILENAME SRCPATH))
|
||||
[EXT (U-CASE (LISTGET SRC 'EXTENSION]
|
||||
(DIR (LISTGET SRC 'DIRECTORY))
|
||||
[NAME (U-CASE (LISTGET SRC 'NAME]
|
||||
[NOV (PACKFILENAME.STRING `(VERSION NIL ,@SRC]
|
||||
LSFP DEST)
|
||||
(CL:WHEN (DIRECTORYNAMEP SRCPATH)
|
||||
|
||||
(* ;; "ignore any of these extensions")
|
||||
(* ;;
|
||||
"any directory names, push them off and do them in another phase")
|
||||
|
||||
(RETURN))
|
||||
(if [NOT (OR (STRPOS "<." NOV)
|
||||
(CL:SEARCH "<LOADUPS>" NOV :TEST #'CL:CHAR-EQUAL)
|
||||
(STRPOS ">." NOV)
|
||||
(INFILEP (CONCAT NOV ".skip"]
|
||||
then (SETQ DIRLIST (NCONC1 DIRLIST SRCPATH))
|
||||
(CL:FORMAT T "~&Deferring to later ~a~%%" SRCPATH)
|
||||
else (CL:FORMAT T "~&Skipping ~a~%%" SRCPATH))
|
||||
(RETURN))
|
||||
|
||||
(* ;;
|
||||
" doesnt (yet) implement / to - translattion. .readme should show up as -.readme.")
|
||||
(* ;; "Fixup files that start with . and have no other extension")
|
||||
|
||||
(SETQ DEST (CONCAT NOV ".pdf"))
|
||||
(CL:WHEN (AND (NOT REDO)
|
||||
(INFILEP DEST))
|
||||
(CL:FORMAT T "~a already there~%%" DEST)
|
||||
(RETURN))
|
||||
(CL:WHEN (INFILEP (CONCAT DEST ".skip"))
|
||||
(PRINTOUT T "Explicit .skip " DEST T)
|
||||
(RETURN))
|
||||
(if (MEMB 'TEDIT PHASES)
|
||||
then (CL:WHEN [OR (MEMB EXT '(TEDIT TED SKETCH BRAVO))
|
||||
(CAR (NLSETQ (TEDIT.FORMATTEDFILEP SRCPATH]
|
||||
(if (EQ REDO 'TEST)
|
||||
then (CL:FORMAT T "Testing open ~a..." SRCPATH)
|
||||
(CLOSEF? (OPENTEXTSTREAM SRCPATH))
|
||||
else (OR [NLSETQ (CL:WITH-OPEN-STREAM (S (OPENTEXTSTREAM SRCPATH)
|
||||
)
|
||||
(TEDIT.FORMAT.HARDCOPY S DEST T NIL NIL
|
||||
NIL 'PDF]
|
||||
(PRINT 'FAIL T)))
|
||||
(CL:FORMAT T "DONE")))
|
||||
(CL:WHEN (AND (MEMB 'PRETTY PHASES)
|
||||
(MEMB EXT '(NIL IL))
|
||||
[SETQ LSFP (CAR (NLSETQ (LISPSOURCEFILEP SRCPATH]
|
||||
(NEQ LSFP *COMMON-LISP-READ-ENVIRONMENT*))
|
||||
(PRINTOUT T "PDF printing " " to " DEST "...")
|
||||
(OR (NLSETQ (CL:WITH-OPEN-STREAM (STR (OPEN-PDF-STREAM DEST))
|
||||
(PRETTYFILEINDEX SRCPATH NIL STR)))
|
||||
(PRINT 'FAIL T))
|
||||
(PRINTOUT T "DONE" T))])
|
||||
(CL:WHEN (AND (NULL EXT)
|
||||
(EQ (CHCON1 NAME)
|
||||
(CHARCODE %.)))
|
||||
(SETQ EXT (SUBATOM NAME 2)))
|
||||
(CL:WHEN (MEMB EXT HC-SKIP-EXTENSIONS)
|
||||
|
||||
(* ;; "ignore any of these extensions")
|
||||
|
||||
(CL:FORMAT T "~&Ignoring (on extension): ~a~%%" SRCPATH)
|
||||
(RETURN))
|
||||
|
||||
(* ;;
|
||||
" doesn't (yet) implement / to - translation. .readme should show up as -.readme.")
|
||||
|
||||
(SETQ DEST (CONCAT NOV ".pdf"))
|
||||
(CL:WHEN (AND (NOT REDO)
|
||||
(INFILEP DEST))
|
||||
(CL:FORMAT T "~a is already there~%%" DEST)
|
||||
(RETURN))
|
||||
(CL:WHEN (INFILEP (CONCAT DEST ".skip"))
|
||||
(CL:FORMAT T "Explicit .skip ~a~%%" DEST)
|
||||
(RETURN))
|
||||
(CL:FORMAT T "~&Starting on ~a:~%%" SRCPATH)
|
||||
(CL:WHEN [AND DOTEDIT (OR (MEMB EXT '(TEDIT TED SKETCH BRAVO))
|
||||
(CAR (REPORT-AND-GO (TEDIT.FORMATTEDFILEP
|
||||
SRCPATH)
|
||||
(CL:FORMAT NIL
|
||||
"~~%%~S TEDIT.FORMATTEDFILEP of ~A -- Condition: ~~A"
|
||||
'FAIL SRCPATH]
|
||||
(if (EQ REDO 'TEST)
|
||||
then (CL:FORMAT T "Testing open ~a..." SRCPATH)
|
||||
(CLOSEF? (OPENTEXTSTREAM SRCPATH))
|
||||
else
|
||||
(* ;; "ADDED HERE")
|
||||
|
||||
(SETQ NLSETQGAG T)
|
||||
(SETQ \TEDIT.THELPFLG T)
|
||||
(REPORT-AND-GO (TEDIT.TO.IMAGEFILE SRCPATH DEST 'PDF)
|
||||
(CL:FORMAT NIL
|
||||
"~~%%~S TEDIT.TO.IMAGEFILE of ~A -- Condition: ~~A"
|
||||
'FAIL SRCPATH)))
|
||||
(PRIN3 " DONE" T)
|
||||
(TERPRI T)
|
||||
(RETURN))
|
||||
(CL:WHEN (AND DOPRETTY (OR (NULL EXT)
|
||||
(EQ EXT 'IL))
|
||||
[SETQ LSFP (CAR (REPORT-AND-GO (LISPSOURCEFILEP SRCPATH)
|
||||
(CL:FORMAT NIL
|
||||
"~~%%~S LISPSOURCEFILEP of ~A -- Condition: ~~A"
|
||||
'FAIL SRCPATH]
|
||||
(NEQ LSFP *COMMON-LISP-READ-ENVIRONMENT*))
|
||||
|
||||
(* ;; "Why the check for NEQ *COMMON-LISP-READ-ENVIRONMENT* ??")
|
||||
|
||||
(PRIN3 "PDF printing " T)
|
||||
(PRIN3 SRCPATH T)
|
||||
(PRIN3 " to " T)
|
||||
(PRIN3 DEST T)
|
||||
(PRIN3 " ..." T)
|
||||
(REPORT-AND-GO (CL:WITH-OPEN-STREAM (STR (OPEN-PDF-STREAM DEST))
|
||||
(PRETTYFILEINDEX SRCPATH NIL STR))
|
||||
(CL:FORMAT NIL
|
||||
"~~%%~S PRETTYFILEINDEX of ~A -- Condition: ~~A"
|
||||
'FAIL SRCPATH))
|
||||
(PRIN3 " DONE" T)
|
||||
(TERPRI T)
|
||||
(RETURN))
|
||||
|
||||
(* ;; "Everything else")
|
||||
|
||||
(PRIN3 "No processing." T)
|
||||
(TERPRI T])
|
||||
|
||||
(MAKE-INDEX-HTMLS
|
||||
[LAMBDA (BASE TOP LEVEL ROOT.NAME) (* ; "Edited 28-Jan-2026 11:01 by lmm")
|
||||
[LAMBDA (BASE TOP LEVEL ROOT.NAME) (* ; "Edited 15-Apr-2026 16:33 by mth")
|
||||
(* ; "Edited 28-Jan-2026 11:01 by lmm")
|
||||
(* ; "Edited 27-Jan-2026 10:50 by lmm")
|
||||
(* ; "Edited 23-Jan-2026 11:59 by lmm")
|
||||
(* ; "Edited 29-Apr-2024 14:18 by lmm")
|
||||
@@ -339,8 +393,8 @@
|
||||
then 2
|
||||
else 1))
|
||||
-2)))
|
||||
(CL:UNLESS (OR (MEMB SHORTNAME '(.git))
|
||||
(MEMB SHORTNAME '(.GIT))
|
||||
(CL:UNLESS (OR (EQ SHORTNAME '.git)
|
||||
(EQ SHORTNAME '.GIT)
|
||||
[AND (STRPOS ".git" (L-CASE FULLNAME))
|
||||
(NOT (STRPOS ".github" (L-CASE FULLNAME]
|
||||
(INFILEP (CONCAT FULLNAME ".skip")))
|
||||
@@ -372,7 +426,8 @@
|
||||
|
||||
(PUTPROPS MEDLEY-UTILS FILETYPE :COMPILE-FILE)
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'TEDIT.PROMPTPRINT :BEFORE '((:LAST (PRIN1 MSG T)))
|
||||
[XCL:REINSTALL-ADVICE 'TEDIT.PROMPTPRINT :BEFORE '[(:LAST (PROGN (PRIN3 " " T)
|
||||
(PRIN3 MSG T]
|
||||
:AFTER
|
||||
'((:LAST (AND (STRPOS "GETFN" MSG)
|
||||
(HELP MSG]
|
||||
@@ -463,6 +518,17 @@
|
||||
(SETQ DIFF (COMPARESOURCES X DESTFILE NIL))
|
||||
(TERPRI])
|
||||
)
|
||||
|
||||
(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 (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
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
@@ -472,9 +538,10 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1312 8246 (GATHER-INFO 1322 . 6704) (MAKE-FULLER-DB 6706 . 7615) (MEDLEY-FIX-LINKS 7617
|
||||
. 8010) (MEDLEY-FIX-DATES 8012 . 8244)) (9425 12213 (MAKE-EXPORTS-ALL 9435 . 10494) (
|
||||
MAKE-WHEREIS-HASH 10496 . 11685) (MAKE-WHEREIS-LOOPS 11687 . 12211)) (12214 21862 (HCFILES 12224 .
|
||||
16487) (MAKE-INDEX-HTMLS 16489 . 21860)) (22112 26724 (RECOMPILE-ONE 22122 . 24019) (RECMPL 24021 .
|
||||
24624) (COMPILE-SETUP 24626 . 25250) (REMAKEFILES 25252 . 26722)))))
|
||||
(FILEMAP (NIL (1100 8034 (GATHER-INFO 1110 . 6492) (MAKE-FULLER-DB 6494 . 7403) (MEDLEY-FIX-LINKS 7405
|
||||
. 7798) (MEDLEY-FIX-DATES 7800 . 8032)) (9606 12182 (MAKE-EXPORTS-ALL 9616 . 10463) (
|
||||
MAKE-WHEREIS-HASH 10465 . 11654) (MAKE-WHEREIS-LOOPS 11656 . 12180)) (12183 24860 (HCFILES 12193 .
|
||||
19384) (MAKE-INDEX-HTMLS 19386 . 24858)) (25194 29806 (RECOMPILE-ONE 25204 . 27101) (RECMPL 27103 .
|
||||
27706) (COMPILE-SETUP 27708 . 28332) (REMAKEFILES 28334 . 29804)) (29808 30404 (REPORT-AND-GO 29808 .
|
||||
30404)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "14-Feb-2026 00:42:39" {WMEDLEY}<internal>loadups>LOADUP-FULL.;38 5967
|
||||
(FILECREATED "28-Apr-2026 10:01:06" {WMEDLEY}<internal>loadups>LOADUP-FULL.;47 5896
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS LOADUP-FULL)
|
||||
|
||||
:PREVIOUS-DATE "13-Feb-2026 00:47:52" {WMEDLEY}<internal>loadups>LOADUP-FULL.;37)
|
||||
:PREVIOUS-DATE "16-Apr-2026 09:37:27" {WMEDLEY}<internal>loadups>LOADUP-FULL.;46)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-FULLCOMS)
|
||||
@@ -16,7 +16,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(LOADFULLFONTS
|
||||
[LAMBDA NIL (* ; "Edited 20-Sep-2025 14:17 by rmk")
|
||||
[LAMBDA NIL (* ; "Edited 16-Apr-2026 09:37 by rmk")
|
||||
(* ; "Edited 20-Sep-2025 14:17 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 20:06 by rmk")
|
||||
(* ; "Edited 13-Jul-2025 11:40 by rmk")
|
||||
(* ; "Edited 30-Jun-2025 00:04 by rmk")
|
||||
@@ -27,11 +28,8 @@
|
||||
|
||||
(* ;; " Don't do Interpress. Do character set 0 and the symbol character sets 41Q, 42Q, 356Q, 357Q and extended and accented Latin 43Q and 361Q")
|
||||
|
||||
(PRINTOUT T "Loading FULL fonts..." T)
|
||||
(PRINTOUT T T "Loading FULL fonts..." T)
|
||||
(SETQ *POSTSCRIPT-FILE-TYPE* 'TEXT)
|
||||
|
||||
(* ;; "Previous code reset the coercion variables to NIL, which would have resulted in glyph-incomplete charsets. With Medley-formatted fonts, the completions have already been installed in the files and there is no need to deal with those variables.")
|
||||
|
||||
(for FAMILY in '(CLASSIC MODERN TERMINAL)
|
||||
do (PRINTOUT T " Loading " FAMILY " ")
|
||||
[for SIZE in '(8 10 12)
|
||||
@@ -47,7 +45,8 @@
|
||||
(PRINTOUT T "FULL fonts loaded" T])
|
||||
|
||||
(LOADUP-FULL
|
||||
[LAMBDA (DRIBBLEFILE) (* ; "Edited 14-Feb-2026 00:42 by rmk")
|
||||
[LAMBDA (DRIBBLEFILE) (* ; "Edited 28-Apr-2026 10:00 by rmk")
|
||||
(* ; "Edited 14-Feb-2026 00:42 by rmk")
|
||||
(* ; "Edited 5-Feb-2026 10:26 by rmk")
|
||||
(* ; "Edited 28-Dec-2025 12:06 by rmk")
|
||||
(* ; "Edited 1-Sep-2025 11:59 by rmk")
|
||||
@@ -86,8 +85,7 @@
|
||||
|
||||
(LOADUP '(CHAT INTERPRESS TEDIT HRULE TEDIT-CHAT READNUMBER EDITBITMAP FILEBROWSER THINFILES
|
||||
GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT HELPSYS
|
||||
DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE UNIXCOMM UNIXCHAT
|
||||
UNIXYCD))
|
||||
DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE UNIXCOMM UNIXCHAT))
|
||||
(LOADFULLFONTS)
|
||||
(COND
|
||||
((WINDOWP *WHO-LINE*)
|
||||
@@ -103,5 +101,5 @@
|
||||
|
||||
(FIXMETA)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (456 5929 (LOADFULLFONTS 466 . 2601) (LOADUP-FULL 2603 . 5679) (FIXMETA 5681 . 5927)))))
|
||||
(FILEMAP (NIL (456 5858 (LOADFULLFONTS 466 . 2449) (LOADUP-FULL 2451 . 5608) (FIXMETA 5610 . 5856)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "27-Apr-2026 11:10:07" {DSK}<home>frank>il>medley>library>UNIXUTILS.;7 21772
|
||||
(FILECREATED "28-Apr-2026 09:59:13" {WMEDLEY}<library>UNIXUTILS.;61 22079
|
||||
|
||||
:EDIT-BY "FGH"
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS ShellOpen SLASHIT)
|
||||
:CHANGES-TO (VARS UNIXUTILSCOMS)
|
||||
|
||||
:PREVIOUS-DATE "31-Mar-2026 00:14:19" {DSK}<home>frank>il>medley>library>UNIXUTILS.;3)
|
||||
:PREVIOUS-DATE "27-Apr-2026 11:10:07" {MEDLEY}<library>UNIXUTILS.;60)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UNIXUTILSCOMS)
|
||||
@@ -23,6 +23,7 @@
|
||||
(ShellOpener NIL RESET)))
|
||||
(FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME
|
||||
UNIX-TMP-FILE-NAME)
|
||||
(COMMANDS "cd" cdm "ls" "pwd")
|
||||
(PROPS (UNIXUTILS FILETYPE))))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -371,10 +372,20 @@
|
||||
unless (INFILEP UNAME) do (RETURN (SLASHIT (CLOSEF (OPENSTREAM UNAME 'OUTPUT 'NEW])
|
||||
)
|
||||
|
||||
(DEFCOMMAND "cd" (DIR) (/CNDIR DIR))
|
||||
|
||||
(DEFCOMMAND cdm (SUBDIR) (/CNDIR (CL:IF SUBDIR
|
||||
(CONCAT '{MEDLEY}/ SUBDIR)
|
||||
'{MEDLEY})))
|
||||
|
||||
(DEFCOMMAND "ls" (FIRST . REST) (DODIR (CONS FIRST REST)))
|
||||
|
||||
(DEFCOMMAND "pwd" NIL (DIRECTORYNAME T))
|
||||
|
||||
(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1207 1580 (ShellCommand 1207 . 1580)) (1582 1979 (ShellWhich 1582 . 1979)) (2089 21694
|
||||
(ShellBrowser 2099 . 3871) (ShellBrowse 3873 . 4558) (ShellOpener 4560 . 6248) (ShellOpen 6250 . 12197
|
||||
) (PROCESS-COMMAND 12199 . 12812) (SLASHIT 12814 . 16126) (UNIX-FILE-NAME 16128 . 20013) (
|
||||
UNIX-TMP-FILE-NAME 20015 . 21692)))))
|
||||
(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.
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.
@@ -1,24 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "12-Aug-2022 12:29:18" {DSK}<home>larry>medley>lispusers>UNIXYCD.;1 568
|
||||
|
||||
:CHANGES-TO (VARS UNIXYCDCOMS)
|
||||
|
||||
:PREVIOUS-DATE "12-Aug-2022 11:14:47" {DSK}<home>larry>medley>lispusers>UNIXYCD.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UNIXYCDCOMS)
|
||||
|
||||
(RPAQQ UNIXYCDCOMS ((COMMANDS "cd" "ls" "pwd")))
|
||||
|
||||
(DEFCOMMAND "cd" (DIR)
|
||||
(/CNDIR DIR))
|
||||
|
||||
(DEFCOMMAND "ls" (FIRST . REST)
|
||||
(DODIR (CONS FIRST REST)))
|
||||
|
||||
(DEFCOMMAND "pwd" ()
|
||||
(DIRECTORYNAME T))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
@@ -1,13 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "12-Aug-2022 12:29:30" ("compiled on " {DSK}<home>larry>medley>lispusers>UNIXYCD.;1)
|
||||
"12-Aug-2022 10:18:11" bcompl'd in "Welcome to Fuller sysout 12-Aug-2022 ..." dated
|
||||
"12-Aug-2022 10:22:21")
|
||||
(FILECREATED "12-Aug-2022 12:29:18" {DSK}<home>larry>medley>lispusers>UNIXYCD.;1 568 :CHANGES-TO (VARS
|
||||
UNIXYCDCOMS) :PREVIOUS-DATE "12-Aug-2022 11:14:47" {DSK}<home>larry>medley>lispusers>UNIXYCD.;1)
|
||||
(PRETTYCOMPRINT UNIXYCDCOMS)
|
||||
(RPAQQ UNIXYCDCOMS ((COMMANDS "cd" "ls" "pwd")))
|
||||
(DEFCOMMAND "cd" (DIR) (/CNDIR DIR))
|
||||
(DEFCOMMAND "ls" (FIRST . REST) (DODIR (CONS FIRST REST)))
|
||||
(DEFCOMMAND "pwd" NIL (DIRECTORYNAME T))
|
||||
NIL
|
||||
@@ -1,13 +0,0 @@
|
||||
UNIXYCD & .LCOM .TXT
|
||||
|
||||
|
||||
This file implements little commands:
|
||||
|
||||
cd change Lisp's current directory to home
|
||||
cd dir dir can be a path separated by / or >.
|
||||
if no "hostname" is given, it's assumed {DSK}
|
||||
ls [dir] list current directory or a directory that's given
|
||||
non-feature: ls foo only prints foo; you need to
|
||||
specify ls foo/
|
||||
pwd print working directory
|
||||
|
||||
@@ -57,7 +57,12 @@ main() {
|
||||
|
||||
# save dribble file to loadups; extract and save fails
|
||||
"${MEDLEYDIR}"/scripts/cpv ${logindir}/HCFILES.DRIBBLE "${MEDLEYDIR}"/loadups/hcfiles.dribble
|
||||
grep "IL:FAIL" < "${MEDLEYDIR}"/loadups/hcfiles.dribble > ${logindir}/fails
|
||||
if [ -f "$(command -v perl)" ] && [ -x "$(command -v perl)" ]
|
||||
then
|
||||
perl "${MEDLEYDIR}"/scripts/getFails.pl '^[^\n]*IL:FAIL' 'DONE' "${MEDLEYDIR}"/loadups/hcfiles.dribble > ${logindir}/fails
|
||||
else
|
||||
echo Unable to extract FAIL information from "${MEDLEYDIR}"/loadups/hcfiles.dribble > ${logindir}/fails
|
||||
fi
|
||||
"${MEDLEYDIR}"/scripts/cpv ${logindir}/fails "${MEDLEYDIR}"/loadups/hcfiles-fails.txt
|
||||
|
||||
# cleanup
|
||||
|
||||
31
scripts/getFails.pl
Normal file
31
scripts/getFails.pl
Normal file
@@ -0,0 +1,31 @@
|
||||
#!/usr/bin/env perl
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
die "Usage: $0 <pattern1> <pattern2> [file...]\n" unless @ARGV >= 2;
|
||||
|
||||
my $pat1 = shift;
|
||||
my $pat2 = shift;
|
||||
my $regex1line = qr/${pat1}.*?${pat2}/; # all on 1 line
|
||||
my $regexStart = qr/${pat1}/; # the line has the start pattern
|
||||
my $regexEnd = qr/${pat2}/; # the line has the end pattern
|
||||
|
||||
my $flag = 0;
|
||||
|
||||
while (<>) {
|
||||
if ($flag) { # we're in a multi-line block
|
||||
print;
|
||||
if (/$regexEnd/) { # does this line end the multi-line block?
|
||||
$flag = 0;
|
||||
print "\n"; # separator
|
||||
};
|
||||
}
|
||||
elsif (/$regex1line/) { # all on 1 line
|
||||
print;
|
||||
print "\n"; # separator
|
||||
}
|
||||
elsif (/$regexStart/) { # begin a multi-line block
|
||||
print;
|
||||
$flag = 1;
|
||||
}
|
||||
}
|
||||
116
sources/FILEIO
116
sources/FILEIO
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "21-Apr-2026 20:57:55" {DSK}<home>matt>Interlisp>medley>sources>FILEIO.;17 166496
|
||||
(FILECREATED "26-Apr-2026 23:27:40" {WMEDLEY}<sources>FILEIO.;146 165936
|
||||
|
||||
:EDIT-BY "mth"
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \DO.PARAMS.AT.OPEN)
|
||||
|
||||
:PREVIOUS-DATE "21-Apr-2026 20:24:53" {DSK}<home>matt>Interlisp>medley>sources>FILEIO.;15)
|
||||
:PREVIOUS-DATE "26-Apr-2026 21:00:55" {WMEDLEY}<sources>FILEIO.;145)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT FILEIOCOMS)
|
||||
@@ -1446,7 +1446,8 @@
|
||||
(GO RETRY])
|
||||
|
||||
(\DO.PARAMS.AT.OPEN
|
||||
[LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 21-Apr-2026 20:57 by mth")
|
||||
[LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 26-Apr-2026 23:27 by rmk")
|
||||
(* ; "Edited 21-Apr-2026 20:57 by mth")
|
||||
(* ; "Edited 20-Apr-2026 17:36 by mth")
|
||||
(* ; "Edited 25-Dec-2024 10:54 by rmk")
|
||||
(* ; "Edited 15-Jul-2024 22:29 by rmk")
|
||||
@@ -1484,40 +1485,27 @@
|
||||
(CHARSET (CHARSET STREAM VAL))
|
||||
((FORMAT EXTERNALFORMAT :EXTERNAL-FORMAT)
|
||||
(* ;;
|
||||
"Ignore the case of the non-LISTP X setting VAL to T")
|
||||
"This allows an EOL and format to be intermixed, the last ones of each are installed")
|
||||
|
||||
[if (LISTP X)
|
||||
then
|
||||
(* ;;
|
||||
"VAL can be :UTF-8, CR, (UTF:8 CR), i.e. specify either one or both")
|
||||
|
||||
(for V in (MKLIST VAL) do
|
||||
(* ;;
|
||||
"FIND-FORMAT doesn't know about :DEFAULT, so...")
|
||||
|
||||
(if (OR (EQ V :DEFAULT)
|
||||
(FIND-FORMAT V T))
|
||||
then (\EXTERNALFORMAT STREAM V)
|
||||
else (SETQ EOL V])
|
||||
(for V inside VAL do (if (MEMB V '(LF CR CRLF ANY))
|
||||
then (SETQ EOL V)
|
||||
else (\EXTERNALFORMAT STREAM V))))
|
||||
(CONVHANKAKU (CONVHANKAKU STREAM VAL))
|
||||
((EOL EOLCONVENTION EOLC)
|
||||
(SETQ EOL VAL))
|
||||
NIL) finally
|
||||
|
||||
(* ;;
|
||||
"If not specified, default EOL to ANY--SETFILEINFO checks for output streams")
|
||||
(* ;; "If EOL is not specified, default input streams to ANY. ")
|
||||
|
||||
(* ;;
|
||||
" Cannot depend on SETFILEINFO checking for ANY on output stream, because it ERRORs!")
|
||||
|
||||
(CL:WHEN (OR (NEQ (SETQ EOL (OR EOL 'ANY))
|
||||
'ANY)
|
||||
(EQ ACCESS 'INPUT))
|
||||
(CL:UNLESS (OR EOL (\GETSTREAM STREAM 'OUTPUT T))
|
||||
(SETQ EOL 'ANY))
|
||||
(CL:WHEN EOL
|
||||
(SETFILEINFO STREAM 'EOL EOL)))
|
||||
(FOR FN IN STREAM-AFTER-OPEN-FNS DO (APPLY* FN STREAM ACCESS PARAMETERS])
|
||||
(for FN in STREAM-AFTER-OPEN-FNS do (APPLY* FN STREAM ACCESS PARAMETERS])
|
||||
|
||||
(\RENAMEFILE
|
||||
[LAMBDA (OLDFILE NEWFILE) (* ; "Edited 25-Dec-2024 10:14 by rmk")
|
||||
[LAMBDA (OLDFILE NEWFILE) (* ; "Edited 25-Apr-2026 16:03 by rmk")
|
||||
(* ; "Edited 25-Dec-2024 10:14 by rmk")
|
||||
(* ; "Edited 16-Dec-2024 21:07 by rmk")
|
||||
(* hdj " 7-May-86 12:22")
|
||||
(SETQ OLDFILE (\ADD.CONNECTED.DIR OLDFILE))
|
||||
@@ -1532,7 +1520,7 @@
|
||||
NEW-DEVICE
|
||||
(TRUEFILENAME NEWFILE)))
|
||||
(CL:IF (PSEUDOHOSTP NEWFILE)
|
||||
(PSEUDOFILENAME NEWFULLNAME)
|
||||
(PSEUDOFILENAME NEWFULLNAME (FILENAMEFIELD NEWFILE 'HOST))
|
||||
NEWFULLNAME))])
|
||||
|
||||
(\REVALIDATEFILE
|
||||
@@ -3172,39 +3160,39 @@ update the map")
|
||||
(ADDTOVAR LAMA \IS.NOT.RANDACCESSP \ILLEGAL.DEVICEOP STREAMPROP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (27757 31873 (STREAMPROP 27767 . 28201) (GETSTREAMPROP 28203 . 28952) (PUTSTREAMPROP
|
||||
28954 . 31721) (STREAMP 31723 . 31871)) (31916 35295 (\DEFPRINT.BY.NAME 31926 . 33078) (
|
||||
\STREAM.DEFPRINT 33080 . 34988) (\FDEV.DEFPRINT 34990 . 35293)) (35553 40594 (\GETACCESS 35563 . 36017
|
||||
) (\SETACCESS 36019 . 40592)) (60820 66789 (\DEFINEDEVICE 60830 . 63146) (\GETDEVICEFROMNAME 63148 .
|
||||
63621) (\GETDEVICEFROMHOSTNAME 63623 . 64667) (\REMOVEDEVICE 64669 . 65792) (\REMOVEDEVICE.NAMES 65794
|
||||
. 66787)) (66829 94486 (\CLOSEFILE 66839 . 67664) (\DELETEFILE 67666 . 67960) (\DEVICEEVENT 67962 .
|
||||
69732) (\GENERATEFILES 69734 . 70681) (\GENERATENEXTFILE 70683 . 71334) (\GENERATEFILEINFO 71336 .
|
||||
71797) (\GETFILENAME 71799 . 72188) (\GENERIC.OUTFILEP 72190 . 72660) (\OPENFILE 72662 . 75240) (
|
||||
\DO.PARAMS.AT.OPEN 75242 . 79364) (\RENAMEFILE 79366 . 80322) (\REVALIDATEFILE 80324 . 82926) (
|
||||
\PAGED.REVALIDATEFILELST 82928 . 84486) (\PAGED.REVALIDATEFILES 84488 . 86207) (\PAGED.REVALIDATEFILE
|
||||
86209 . 88492) (\BUFFERED.REVALIDATEFILE 88494 . 90780) (\BUFFERED.REVALIDATEFILELST 90782 . 91966) (
|
||||
\PRINT-REVALIDATION-RESULT 91968 . 92810) (\TRUNCATEFILE 92812 . 93203) (\FILE-CONFLICT 93205 . 94484)
|
||||
) (94522 99185 (\GENERATENOFILES 94532 . 96628) (\NULLFILEGENERATOR 96630 . 96874) (\NOFILESNEXTFILEFN
|
||||
96876 . 98867) (\NOFILESINFOFN 98869 . 99183)) (99304 101212 (\FILE.NOT.OPEN 99314 . 99827) (
|
||||
\FILE.WONT.OPEN 99829 . 100157) (\ILLEGAL.DEVICEOP 100159 . 100441) (\IS.NOT.RANDACCESSP 100443 .
|
||||
100889) (\STREAM.NOT.OPEN 100891 . 101210)) (101347 103645 (\FDEVINSTANCE 101357 . 103643)) (104847
|
||||
111818 (CNDIR 104857 . 106162) (DIRECTORYNAME 106164 . 109944) (DIRECTORYNAMEP 109946 . 110562) (
|
||||
HOSTNAMEP 110564 . 111371) (\ADD.CONNECTED.DIR 111373 . 111816)) (111863 140810 (\BACKFILEPTR 111873
|
||||
. 112061) (\BACKPEEKBIN 112063 . 112424) (\BACKBIN 112426 . 112777) (BIN 112779 . 112996) (\BIN
|
||||
112998 . 113275) (\BINS 113277 . 113563) (BOUT 113565 . 113927) (\BOUT 113929 . 114244) (\BOUTS 114246
|
||||
. 114557) (COPYBYTES 114559 . 117891) (COPYCHARS 117893 . 121691) (COPYFILE 121693 . 123053) (
|
||||
\COPYOPENFILE 123055 . 126254) (\INFER.FILE.TYPE 126256 . 127210) (EOFP 127212 . 127509) (FORCEOUTPUT
|
||||
127511 . 127758) (\FLUSH.OPEN.STREAMS 127760 . 128116) (CHARSET 128118 . 129477) (ACCESS-CHARSET
|
||||
129479 . 130116) (GETEOFPTR 130118 . 130368) (GETFILEINFO 130370 . 133563) (\TYPE.FROM.FILETYPE 133565
|
||||
. 134035) (\FILETYPE.FROM.TYPE 134037 . 134216) (GETFILEPTR 134218 . 134470) (SETFILEINFO 134472 .
|
||||
138709) (SETFILEPTR 138711 . 140430) (BOUT16 140432 . 140617) (BIN16 140619 . 140808)) (140913 148093
|
||||
(\GENERIC.BINS 140923 . 141203) (\GENERIC.BOUTS 141205 . 141470) (\GENERIC.RENAMEFILE 141472 . 143720)
|
||||
(\GENERIC.OPENP 143722 . 145037) (\GENERIC.READP 145039 . 146191) (\GENERIC.CHARSET 146193 . 148091))
|
||||
(148094 148433 (\MAP-OPEN-STREAMS 148104 . 148431)) (150288 152368 (\EOF.ACTION 150298 . 150549) (
|
||||
\EOSERROR 150551 . 150744) (\GETEOFPTR 150746 . 150928) (\INCFILEPTR 150930 . 151280) (\PEEKBIN 151282
|
||||
. 151473) (\SETCLOSEDFILELENGTH 151475 . 151809) (\SETEOFPTR 151811 . 151999) (\SETFILEPTR 152001 .
|
||||
152366)) (152369 152911 (\FIXPOUT 152379 . 152679) (\FIXPIN 152681 . 152909)) (152912 153478 (\BOUTEOL
|
||||
152922 . 153476)) (156374 166238 (\BUFFERED.BIN 156384 . 157236) (\BUFFERED.PEEKBIN 157238 . 158020)
|
||||
(\BUFFERED.BOUT 158022 . 158882) (\BUFFERED.BINS 158884 . 162569) (\BUFFERED.BOUTS 162571 . 164372) (
|
||||
\BUFFERED.COPYBYTES 164374 . 166236)))))
|
||||
(FILEMAP (NIL (27711 31827 (STREAMPROP 27721 . 28155) (GETSTREAMPROP 28157 . 28906) (PUTSTREAMPROP
|
||||
28908 . 31675) (STREAMP 31677 . 31825)) (31870 35249 (\DEFPRINT.BY.NAME 31880 . 33032) (
|
||||
\STREAM.DEFPRINT 33034 . 34942) (\FDEV.DEFPRINT 34944 . 35247)) (35507 40548 (\GETACCESS 35517 . 35971
|
||||
) (\SETACCESS 35973 . 40546)) (60774 66743 (\DEFINEDEVICE 60784 . 63100) (\GETDEVICEFROMNAME 63102 .
|
||||
63575) (\GETDEVICEFROMHOSTNAME 63577 . 64621) (\REMOVEDEVICE 64623 . 65746) (\REMOVEDEVICE.NAMES 65748
|
||||
. 66741)) (66783 93926 (\CLOSEFILE 66793 . 67618) (\DELETEFILE 67620 . 67914) (\DEVICEEVENT 67916 .
|
||||
69686) (\GENERATEFILES 69688 . 70635) (\GENERATENEXTFILE 70637 . 71288) (\GENERATEFILEINFO 71290 .
|
||||
71751) (\GETFILENAME 71753 . 72142) (\GENERIC.OUTFILEP 72144 . 72614) (\OPENFILE 72616 . 75194) (
|
||||
\DO.PARAMS.AT.OPEN 75196 . 78665) (\RENAMEFILE 78667 . 79762) (\REVALIDATEFILE 79764 . 82366) (
|
||||
\PAGED.REVALIDATEFILELST 82368 . 83926) (\PAGED.REVALIDATEFILES 83928 . 85647) (\PAGED.REVALIDATEFILE
|
||||
85649 . 87932) (\BUFFERED.REVALIDATEFILE 87934 . 90220) (\BUFFERED.REVALIDATEFILELST 90222 . 91406) (
|
||||
\PRINT-REVALIDATION-RESULT 91408 . 92250) (\TRUNCATEFILE 92252 . 92643) (\FILE-CONFLICT 92645 . 93924)
|
||||
) (93962 98625 (\GENERATENOFILES 93972 . 96068) (\NULLFILEGENERATOR 96070 . 96314) (\NOFILESNEXTFILEFN
|
||||
96316 . 98307) (\NOFILESINFOFN 98309 . 98623)) (98744 100652 (\FILE.NOT.OPEN 98754 . 99267) (
|
||||
\FILE.WONT.OPEN 99269 . 99597) (\ILLEGAL.DEVICEOP 99599 . 99881) (\IS.NOT.RANDACCESSP 99883 . 100329)
|
||||
(\STREAM.NOT.OPEN 100331 . 100650)) (100787 103085 (\FDEVINSTANCE 100797 . 103083)) (104287 111258 (
|
||||
CNDIR 104297 . 105602) (DIRECTORYNAME 105604 . 109384) (DIRECTORYNAMEP 109386 . 110002) (HOSTNAMEP
|
||||
110004 . 110811) (\ADD.CONNECTED.DIR 110813 . 111256)) (111303 140250 (\BACKFILEPTR 111313 . 111501) (
|
||||
\BACKPEEKBIN 111503 . 111864) (\BACKBIN 111866 . 112217) (BIN 112219 . 112436) (\BIN 112438 . 112715)
|
||||
(\BINS 112717 . 113003) (BOUT 113005 . 113367) (\BOUT 113369 . 113684) (\BOUTS 113686 . 113997) (
|
||||
COPYBYTES 113999 . 117331) (COPYCHARS 117333 . 121131) (COPYFILE 121133 . 122493) (\COPYOPENFILE
|
||||
122495 . 125694) (\INFER.FILE.TYPE 125696 . 126650) (EOFP 126652 . 126949) (FORCEOUTPUT 126951 .
|
||||
127198) (\FLUSH.OPEN.STREAMS 127200 . 127556) (CHARSET 127558 . 128917) (ACCESS-CHARSET 128919 .
|
||||
129556) (GETEOFPTR 129558 . 129808) (GETFILEINFO 129810 . 133003) (\TYPE.FROM.FILETYPE 133005 . 133475
|
||||
) (\FILETYPE.FROM.TYPE 133477 . 133656) (GETFILEPTR 133658 . 133910) (SETFILEINFO 133912 . 138149) (
|
||||
SETFILEPTR 138151 . 139870) (BOUT16 139872 . 140057) (BIN16 140059 . 140248)) (140353 147533 (
|
||||
\GENERIC.BINS 140363 . 140643) (\GENERIC.BOUTS 140645 . 140910) (\GENERIC.RENAMEFILE 140912 . 143160)
|
||||
(\GENERIC.OPENP 143162 . 144477) (\GENERIC.READP 144479 . 145631) (\GENERIC.CHARSET 145633 . 147531))
|
||||
(147534 147873 (\MAP-OPEN-STREAMS 147544 . 147871)) (149728 151808 (\EOF.ACTION 149738 . 149989) (
|
||||
\EOSERROR 149991 . 150184) (\GETEOFPTR 150186 . 150368) (\INCFILEPTR 150370 . 150720) (\PEEKBIN 150722
|
||||
. 150913) (\SETCLOSEDFILELENGTH 150915 . 151249) (\SETEOFPTR 151251 . 151439) (\SETFILEPTR 151441 .
|
||||
151806)) (151809 152351 (\FIXPOUT 151819 . 152119) (\FIXPIN 152121 . 152349)) (152352 152918 (\BOUTEOL
|
||||
152362 . 152916)) (155814 165678 (\BUFFERED.BIN 155824 . 156676) (\BUFFERED.PEEKBIN 156678 . 157460)
|
||||
(\BUFFERED.BOUT 157462 . 158322) (\BUFFERED.BINS 158324 . 162009) (\BUFFERED.BOUTS 162011 . 163812) (
|
||||
\BUFFERED.COPYBYTES 163814 . 165676)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
323
sources/XCCS
323
sources/XCCS
@@ -1,323 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "13-Jul-2025 23:08:39" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XCCS.;10 15413
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS XCCSCOMS)
|
||||
|
||||
:PREVIOUS-DATE "25-Mar-2025 23:40:52"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XCCS.;9)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT XCCSCOMS)
|
||||
|
||||
(RPAQQ XCCSCOMS
|
||||
[(FNS \XCCSINCCODE \XCCSPEEKCCODE \XCCSOUTCHAR \XCCSBACKCCODE \XCCSFORMATBYTESTREAM
|
||||
\XCCSCHARSETFN)
|
||||
(FNS \CREATE.XCCS.EXTERNALFORMAT)
|
||||
(FNS \NSIN.24BITENCODING.ERROR)
|
||||
(FNS KANJICHARSETP CHINESECHARSETP)
|
||||
(INITVARS (*SIGNAL-24BIT-NSENCODING-ERROR*))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (CONSTANTS (\NORUNCODE 255)
|
||||
(NSCHARSETSHIFT 255))
|
||||
(MACROS \RUNCODED)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.XCCS.EXTERNALFORMAT])
|
||||
(DEFINEQ
|
||||
|
||||
(\XCCSINCCODE
|
||||
[LAMBDA (STREAM COUNTP) (* ; "Edited 8-Dec-2023 15:28 by rmk")
|
||||
(* ; "Edited 6-Aug-2021 15:57 by rmk:")
|
||||
|
||||
(* ;;; "Returns a 16 bit character code. SHIFTEDCSET is STREAM's char set left shifted 8.")
|
||||
|
||||
(* ;;; "If COUNTP is non-NIL, the variable *BYTECOUNTER* is set freely to the number of bytes read.")
|
||||
|
||||
(* ;;; "This doesn't do EOL conversion, \INCHAR does that")
|
||||
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(\DTEST STREAM 'STREAM)
|
||||
(LET (NUMBYTES (CSET (ffetch (STREAM CHARSET) of STREAM))
|
||||
(CHAR (\BIN STREAM))) (* ;
|
||||
"Error on EOF unless ENDOFSTREAMOP does something else.")
|
||||
|
||||
(* ;; " NUMBYTES tracks the number of \BINs. ")
|
||||
|
||||
(IF (EQ CHAR NSCHARSETSHIFT)
|
||||
THEN (* ;
|
||||
"Shifting character sets, toss CHAR")
|
||||
(SETQ CSET (\BIN STREAM))
|
||||
(IF (NEQ NSCHARSETSHIFT CSET)
|
||||
THEN (* ;
|
||||
"Shift to new runcode CSET: SH CS CH")
|
||||
(SETQ CHAR (\BIN STREAM))
|
||||
(SETQ NUMBYTES 3)
|
||||
(freplace (STREAM CHARSET) of STREAM with CSET)
|
||||
ELSEIF (EQ 0 (\BIN STREAM))
|
||||
THEN (* ; "SH SH CSH CS CH where CSH is 0")
|
||||
|
||||
(* ;;
|
||||
"The high-order character set byte must be 0, because we don't support obese characters (24 bit)")
|
||||
|
||||
(SETQ CSET (\BIN STREAM))
|
||||
(SETQ CHAR (\BIN STREAM)) (* ; "To align with below")
|
||||
(SETQ NUMBYTES 5)
|
||||
(freplace (STREAM CHARSET) of STREAM with \NORUNCODE)
|
||||
ELSE (\NSIN.24BITENCODING.ERROR STREAM))
|
||||
|
||||
(* ;; "The stream now knows the new character set, runcoded or not.")
|
||||
|
||||
ELSEIF (EQ CSET \NORUNCODE)
|
||||
THEN (* ; "2-bytes")
|
||||
(SETQ CSET CHAR)
|
||||
(SETQ CHAR (\BIN STREAM))
|
||||
(SETQ NUMBYTES 2)
|
||||
ELSE
|
||||
(* ;; "Runcoded CSET and CHAR")
|
||||
|
||||
(SETQ NUMBYTES 1))
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* NUMBYTES))
|
||||
(CL:WHEN CHAR (* ;
|
||||
"Typically NIL if ENDOFSTREAMOP returned NIL at EOF ")
|
||||
(LOGOR (UNFOLD CSET 256)
|
||||
CHAR))])
|
||||
|
||||
(\XCCSPEEKCCODE
|
||||
[LAMBDA (STREAM NOERROR) (* ; "Edited 8-Dec-2023 15:32 by rmk")
|
||||
(* ; "Edited 21-Jun-2021 23:44 by rmk:")
|
||||
|
||||
(* ;;
|
||||
"Modeled on \XCCSINCCODE, but peeks at the last byte in the sequence, leaves the stream unchanged")
|
||||
|
||||
(\DTEST STREAM 'STREAM)
|
||||
(LET ((CSET (ffetch (STREAM CHARSET) of STREAM))
|
||||
(CHAR (\PEEKBIN STREAM NOERROR)))
|
||||
|
||||
(* ;; "Returns a 16 bit character code. Doesn't do EOL conversion--\PEEKCCODE does that. ")
|
||||
|
||||
(* ;; "We don't change the charset in the stream, put the file ptr back the way it was.")
|
||||
|
||||
(CL:WHEN CHAR
|
||||
(IF (EQ CHAR NSCHARSETSHIFT)
|
||||
THEN (\BIN STREAM) (* ; "Read the peeked shifting byte")
|
||||
(SETQ CSET (\BIN STREAM)) (* ; "Consume the char shift byte")
|
||||
(IF (NEQ CSET NSCHARSETSHIFT)
|
||||
THEN
|
||||
(* ;;
|
||||
"Shift to new runcode CSET: SH CS CH. We have to BIN what we peeked, BIN, and peek again")
|
||||
|
||||
(SETQ CHAR (\PEEKBIN STREAM NOERROR))
|
||||
(\BACKFILEPTR STREAM)
|
||||
(\BACKFILEPTR STREAM)
|
||||
ELSEIF (EQ 0 (\BIN STREAM))
|
||||
THEN (* ; "SH SH CSH CS CH where CSH is 0")
|
||||
|
||||
(* ;;
|
||||
"Note: no eof error check on this \BIN -- an eof in the middle of a charset shift is an error")
|
||||
|
||||
(SETQ CSET (\BIN STREAM))
|
||||
(SETQ CHAR (\PEEKBIN STREAM NOERROR))
|
||||
(\BACKFILEPTR STREAM)
|
||||
(\BACKFILEPTR STREAM)
|
||||
(\BACKFILEPTR STREAM)
|
||||
(\BACKFILEPTR STREAM)
|
||||
ELSE (\NSIN.24BITENCODING.ERROR STREAM))
|
||||
ELSEIF (EQ CSET \NORUNCODE)
|
||||
THEN (* ; "2 byte runs, BIN/PEEK/BACK")
|
||||
(SETQ CSET CHAR)
|
||||
(\BIN STREAM)
|
||||
(SETQ CHAR (\PEEKBIN STREAM NOERROR)) (* ; "One BACKFILEPTR seems OK")
|
||||
(\BACKFILEPTR STREAM))
|
||||
|
||||
(* ;; "No need to back up for the runcoded case")
|
||||
|
||||
(CL:WHEN CHAR
|
||||
(LOGOR (UNFOLD CSET 256)
|
||||
CHAR)))])
|
||||
|
||||
(\XCCSOUTCHAR
|
||||
[LAMBDA (STREAM CHARCODE) (* ; "Edited 13-Aug-2021 10:24 by rmk:")
|
||||
|
||||
(* ;; "Closed function for the :XCCS external format, also called when :XCCS is the default")
|
||||
|
||||
(COND
|
||||
((EQ CHARCODE (CHARCODE EOL))
|
||||
(FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0)
|
||||
[COND
|
||||
[(NOT (\RUNCODED STREAM)) (* ;
|
||||
"Charset is a constant 0, we put out the high-order byte.")
|
||||
(\BOUT STREAM (\CHARSET (CHARCODE EOL]
|
||||
((EQ (\CHARSET (CHARCODE EOL))
|
||||
(ffetch (STREAM CHARSET) of STREAM)))
|
||||
(T (* ;
|
||||
"We are runcoded, and not in character set 0, have to shift.")
|
||||
(\BOUT STREAM NSCHARSETSHIFT)
|
||||
(\BOUT STREAM (freplace (STREAM CHARSET) of STREAM with (\CHARSET
|
||||
(CHARCODE EOL]
|
||||
|
||||
(* ;; "We are now in the right charset (0) for the first EOL byte. For CRLF, the CR is immediately followed by the LF byte, without the prefix 0 byte even if not runcoded, i.e. the 2 bytes are though of as a composite. The stream is left in CSET0 (the freplace above), read for another shift according to the next shift in a runcoded file.")
|
||||
|
||||
(\BOUTEOL STREAM))
|
||||
(T (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM)
|
||||
(IPLUS16 1 DATUM))
|
||||
(COND
|
||||
((NOT (\RUNCODED STREAM))
|
||||
(\BOUT STREAM (\CHARSET CHARCODE))
|
||||
(\BOUT STREAM (\CHAR8CODE CHARCODE)))
|
||||
((EQ (\CHARSET CHARCODE)
|
||||
(ffetch (STREAM CHARSET) of STREAM))
|
||||
(\BOUT STREAM (\CHAR8CODE CHARCODE)))
|
||||
(T (\BOUT STREAM NSCHARSETSHIFT)
|
||||
(\BOUT STREAM (freplace (STREAM CHARSET) of STREAM with (\CHARSET
|
||||
CHARCODE))
|
||||
)
|
||||
(\BOUT STREAM (\CHAR8CODE CHARCODE])
|
||||
|
||||
(\XCCSBACKCCODE
|
||||
[LAMBDA (STREAM COUNTP) (* ; "Edited 8-Dec-2023 15:34 by rmk")
|
||||
(* ; "Edited 19-Jul-2022 17:12 by rmk")
|
||||
(* ; "Edited 13-Aug-2021 14:08 by rmk:")
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(LET ((BYTE (AND (\BACKFILEPTR STREAM)
|
||||
(\PEEKBIN STREAM)))
|
||||
(CSET (fetch (STREAM CHARSET) of STREAM)))
|
||||
(CL:WHEN BYTE
|
||||
|
||||
(* ;; "The immediately preceding byte must be a character byte. If it is a byte in a runcode, then we are done, even if the byte before is part of a shift sequence.")
|
||||
|
||||
(* ;; "But if we are currently in a nonruncoded file, we have to go back one more to get the character set byte.")
|
||||
|
||||
(* ;; "If we can't back up, we are already at the beginning.")
|
||||
|
||||
(IF (EQ \NORUNCODE CSET)
|
||||
THEN (IF (\BACKFILEPTR STREAM)
|
||||
THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2))
|
||||
(LOGOR (UNFOLD (\PEEKBIN STREAM)
|
||||
256)
|
||||
BYTE)
|
||||
ELSE (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
|
||||
NIL)
|
||||
ELSE (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
|
||||
(LOGOR (UNFOLD CSET 256)
|
||||
BYTE)))])
|
||||
|
||||
(\XCCSFORMATBYTESTREAM
|
||||
[LAMBDA (STREAM BYTESTREAM) (* ; "Edited 26-Mar-2024 11:00 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 16:02 by rmk")
|
||||
(\EXTERNALFORMAT BYTESTREAM (\EXTERNALFORMAT STREAM))
|
||||
|
||||
(* ;; "This stream may be read as a continuation of STREAM (TTYIN, LAFITE?), and we want to make sure that the bytes are encoded properly. So let's assert (and possibly mark) that that's its current situation.")
|
||||
|
||||
(\XCCSCHARSETFN BYTESTREAM (fetch (STREAM CHARSET) of STREAM))
|
||||
BYTESTREAM])
|
||||
|
||||
(\XCCSCHARSETFN
|
||||
[LAMBDA (STREAM CHARSET DONTMARKSTREAM) (* ; "Edited 9-Dec-2023 11:18 by rmk")
|
||||
|
||||
(* ;; "This differs from \GENERIC.CHARSET in that it actually writes the shifting bytes into an output stream, unless DONTMARKSTREAM. It will do write the shifts, even if it just replicates the situation that is already there (presumably CHARSET = the old CHARSET). The client should test and avoid calling if useless shifts are not desired.")
|
||||
|
||||
(LET [(CSET (ffetch (STREAM CHARSET) of (\DTEST STREAM 'STREAM]
|
||||
(CL:WHEN CHARSET
|
||||
(CL:WHEN (EQ CHARSET T)
|
||||
(SETQ CHARSET \NORUNCODE))
|
||||
(CL:UNLESS (EQ CHARSET CSET)
|
||||
(freplace (STREAM CHARSET) of STREAM with CHARSET)
|
||||
(CL:UNLESS DONTMARKSTREAM
|
||||
(CL:WHEN (\IOMODEP STREAM 'OUTPUT T)
|
||||
(\BOUT STREAM NSCHARSETSHIFT)
|
||||
(if (EQ CHARSET \NORUNCODE)
|
||||
then (\BOUT STREAM \NORUNCODE)
|
||||
(\BOUT STREAM 0)
|
||||
else (\BOUT STREAM CHARSET))))))
|
||||
CSET])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\CREATE.XCCS.EXTERNALFORMAT
|
||||
[LAMBDA (NAME EOL) (* ; "Edited 7-Dec-2023 23:03 by rmk")
|
||||
(* ; "Edited 30-Jun-2022 18:08 by rmk")
|
||||
(* ; "Edited 10-Sep-2021 19:49 by rmk:")
|
||||
|
||||
(* ;;; "Create the :XCCS external format. Stream's EOL overrides the (vacuous) default here")
|
||||
|
||||
(MAKE-EXTERNALFORMAT (OR NAME :XCCS)
|
||||
(FUNCTION \XCCSINCCODE)
|
||||
(FUNCTION \XCCSPEEKCCODE)
|
||||
(FUNCTION \XCCSBACKCCODE)
|
||||
(FUNCTION \XCCSOUTCHAR)
|
||||
(FUNCTION \XCCSFORMATBYTESTREAM)
|
||||
(OR EOL 'LF)
|
||||
T NIL NIL (FUNCTION \XCCSCHARSETFN])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\NSIN.24BITENCODING.ERROR
|
||||
[LAMBDA (STREAM) (* bvm%: "12-Mar-86 15:35")
|
||||
(DECLARE (USEDFREE *SIGNAL-24BIT-NSENCODING-ERROR*))
|
||||
|
||||
(* ;;; "Called if we see the sequence shift,shift on STREAM -- means shift to 24-bit character set, which we don't support. Usually this just means we're erroneously reading a binary file as text. If this function returns, its value is taken as a character set to shift to")
|
||||
|
||||
(COND
|
||||
(*SIGNAL-24BIT-NSENCODING-ERROR* (* ;
|
||||
"Only cause error if user/reader cares")
|
||||
(ERROR "24-bit NS encoding not supported" STREAM)))
|
||||
(* ; "Return charset zero")
|
||||
0])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(KANJICHARSETP
|
||||
[LAMBDA (CHARSET) (* ; "Edited 13-Jun-2025 16:33 by rmk")
|
||||
|
||||
(* ;; "Returns CHARSET if it is a charset with MCCS Kanji characters")
|
||||
|
||||
(AND (<= 48 CHARSET 118)
|
||||
CHARSET])
|
||||
|
||||
(CHINESECHARSETP
|
||||
[LAMBDA (CHARSET) (* ; "Edited 18-Jun-2025 23:09 by rmk")
|
||||
(* ; "Edited 13-Jun-2025 16:33 by rmk")
|
||||
|
||||
(* ;; "Returns CHARSET if it is a charset with MCCS Chinese characters")
|
||||
|
||||
(AND (<= 161 CHARSET 212)
|
||||
CHARSET])
|
||||
)
|
||||
|
||||
(RPAQ? *SIGNAL-24BIT-NSENCODING-ERROR* )
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \NORUNCODE 255)
|
||||
|
||||
(RPAQQ NSCHARSETSHIFT 255)
|
||||
|
||||
|
||||
(CONSTANTS (\NORUNCODE 255)
|
||||
(NSCHARSETSHIFT 255))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \RUNCODED MACRO (OPENLAMBDA (STREAM)
|
||||
|
||||
(* ;; "returns NIL is the stream is not runcoded, that is, if the stream has 16 bit bytes explicitly represented")
|
||||
(* ;
|
||||
"note that neq is ok since charsets are known to be SMALLP's")
|
||||
(NEQ (fetch CHARSET of STREAM)
|
||||
\NORUNCODE)))
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(\CREATE.XCCS.EXTERNALFORMAT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (997 12253 (\XCCSINCCODE 1007 . 3986) (\XCCSPEEKCCODE 3988 . 6657) (\XCCSOUTCHAR 6659 .
|
||||
8879) (\XCCSBACKCCODE 8881 . 10425) (\XCCSFORMATBYTESTREAM 10427 . 11048) (\XCCSCHARSETFN 11050 .
|
||||
12251)) (12254 13027 (\CREATE.XCCS.EXTERNALFORMAT 12264 . 13025)) (13028 13859 (
|
||||
\NSIN.24BITENCODING.ERROR 13038 . 13857)) (13860 14500 (KANJICHARSETP 13870 . 14126) (CHINESECHARSETP
|
||||
14128 . 14498)))))
|
||||
STOP
|
||||
Binary file not shown.
Reference in New Issue
Block a user