Compare commits
12 Commits
fgh_fix256
...
rmk183--Te
| Author | SHA1 | Date | |
|---|---|---|---|
|
f38e216446 | ||
|
|
d0d9b2329a | ||
|
4de89a6e94 | ||
|
ceccadacef | ||
|
|
6159c64b84 | ||
|
|
eb6ee87170 | ||
|
|
c16e3b4a55 | ||
|
|
285e35f2ea | ||
|
|
4e761298ea | ||
|
|
cbea9a7c9d | ||
|
47dd8edf60 | ||
|
|
1d2292aa62 |
@@ -1,27 +1,29 @@
|
|||||||
(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 "16-Apr-2026 22:42:51" {DSK}<home>matt>Interlisp>medley>internal>MEDLEY-UTILS.;2 30564
|
||||||
|
|
||||||
:EDIT-BY "lmm"
|
:EDIT-BY "mth"
|
||||||
|
|
||||||
:CHANGES-TO (FNS MAKE-INDEX-HTMLS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES
|
:CHANGES-TO (FNS HCFILES MAKE-EXPORTS-ALL MAKE-INDEX-HTMLS)
|
||||||
MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH MAKE-WHEREIS-LOOPS HCFILES RECOMPILE-ONE
|
(FUNCTIONS REPORT-AND-GO)
|
||||||
RECMPL COMPILE-SETUP REMAKEFILES)
|
(VARS MEDLEY-UTILSCOMS HC-SKIP-EXTENSIONS)
|
||||||
(ADVICE TEDIT.PROMPTPRINT)
|
(ADVICE TEDIT.PROMPTPRINT)
|
||||||
|
|
||||||
:PREVIOUS-DATE "28-Jan-2026 10:46:02" {DSK}<Users>larry>il>medley>internal>MEDLEY-UTILS.;1)
|
:PREVIOUS-DATE "16-Apr-2026 22:27:40" {DSK}<home>matt>Interlisp>medley>internal>MEDLEY-UTILS.;1
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
|
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
|
||||||
|
|
||||||
(RPAQQ MEDLEY-UTILSCOMS
|
(RPAQQ MEDLEY-UTILSCOMS
|
||||||
[(FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
|
[(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 MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH MAKE-WHEREIS-LOOPS)
|
||||||
(FNS HCFILES MAKE-INDEX-HTMLS)
|
(FNS HCFILES MAKE-INDEX-HTMLS)
|
||||||
(PROP FILETYPE MEDLEY-UTILS)
|
(PROP FILETYPE MEDLEY-UTILS)
|
||||||
(ADVISE TEDIT.PROMPTPRINT)
|
(ADVISE TEDIT.PROMPTPRINT)
|
||||||
(FNS RECOMPILE-ONE RECMPL COMPILE-SETUP REMAKEFILES)
|
(FNS RECOMPILE-ONE RECMPL COMPILE-SETUP REMAKEFILES)
|
||||||
|
(FUNCTIONS REPORT-AND-GO)
|
||||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||||
(NLAML)
|
(NLAML)
|
||||||
(LAMA])
|
(LAMA])
|
||||||
@@ -140,6 +142,12 @@
|
|||||||
(for X in (OR DIRS MEDLEY-FIX-DIRS) join (FIX-DIRECTORY-DATES (MEDLEYDIR (PRINT X T])
|
(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 MEDLEY-FIX-DIRS ("sources" "library" "lispusers" "internal" "greetfiles" "doctools"))
|
||||||
|
|
||||||
(RPAQQ OKSOURCES (RENAMEFNS VMEM READSYS CASH-FILE HASH-FILE MEDLEYDIR MAKEINIT))
|
(RPAQQ OKSOURCES (RENAMEFNS VMEM READSYS CASH-FILE HASH-FILE MEDLEYDIR MAKEINIT))
|
||||||
@@ -162,15 +170,18 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(MAKE-EXPORTS-ALL
|
(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 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 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 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 July 5, 1990 by Sybalsky -- point it to Pele as the truth directory.")
|
||||||
"Edited September 29, 1986 by van Melle")
|
|
||||||
|
(* ;; "Edited September 29, 1986 by van Melle")
|
||||||
|
|
||||||
(CNDIR (MEDLEYDIR "sources"))
|
(CNDIR (MEDLEYDIR "sources"))
|
||||||
(LOAD 'FILESETS)
|
(LOAD 'FILESETS)
|
||||||
(GATHEREXPORTS EXPORTFILES (OR OUTFILE "exports.all"])
|
(GATHEREXPORTS EXPORTFILES (OR OUTFILE "exports.all"])
|
||||||
@@ -204,7 +215,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(HCFILES
|
(HCFILES
|
||||||
[LAMBDA (BASE REDO SUBSETS) (* ; "Edited 30-Jun-2024 08:27 by lmm")
|
[LAMBDA (BASE REDO SUBSETS) (* ; "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 23-Apr-2024 23:15 by lmm")
|
||||||
(* ; "Edited 22-Apr-2024 13:22 by lmm")
|
(* ; "Edited 22-Apr-2024 13:22 by lmm")
|
||||||
(* ; "Edited 5-Feb-2024 12:16 by lmm")
|
(* ; "Edited 5-Feb-2024 12:16 by lmm")
|
||||||
@@ -213,74 +225,116 @@
|
|||||||
|
|
||||||
(* ;;;; "BASE is the root directory. Doesn't replace PDF files except when REDO")
|
(* ;;;; "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
|
(LET* ([DIRLIST (LIST (OR BASE (PSEUDOFILENAME (MEDLEYDIR]
|
||||||
[[DIRLIST (LIST (OR BASE (PSEUDOFILENAME (MEDLEYDIR]
|
[PHASES (OR SUBSETS '(TEDIT PRETTY INDEX HRULE]
|
||||||
(PHASES (OR SUBSETS '(TEDIT PRETTY INDEX HRULE]
|
(DOTEDIT (MEMB 'TEDIT PHASES))
|
||||||
(FILESLOAD PDFSTREAM SKETCH)
|
(DOPRETTY (MEMB 'PRETTY PHASES)))
|
||||||
(FONTSET 'STANDARD)
|
(FILESLOAD PDFSTREAM SKETCH)
|
||||||
(while DIRLIST
|
(FONTSET 'STANDARD)
|
||||||
do
|
(while DIRLIST
|
||||||
(SETQ BASE (pop 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)
|
|
||||||
|
|
||||||
(* ;; "any directory names, push them off and do them in another phase")
|
(* ;; "Breadth-first processing")
|
||||||
|
|
||||||
(CL:UNLESS (OR (STRPOS ">." NOV)
|
(for SRCPATH in (DIRECTORY (CONCAT BASE "*.*;"))
|
||||||
(INFILEP (CONCAT NOV ".skip")))
|
do (PROG* ((SRC (UNPACKFILENAME SRCPATH))
|
||||||
(SETQ DIRLIST (NCONC1 DIRLIST SRCPATH)))
|
[EXT (U-CASE (LISTGET SRC 'EXTENSION]
|
||||||
(RETURN))
|
(DIR (LISTGET SRC 'DIRECTORY))
|
||||||
(CL:WHEN
|
[NAME (U-CASE (LISTGET SRC 'NAME]
|
||||||
(MEMB EXT
|
[NOV (PACKFILENAME.STRING `(VERSION NIL ,@SRC]
|
||||||
'(PDF SKIP HTML LCOM DFASL SH SYSOUT DRIBBLE IMPTR DISPLAYFONT ALL
|
LSFP DEST)
|
||||||
DATABASE))
|
(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))
|
||||||
|
|
||||||
(* ;;
|
(* ;; "Fixup files that start with . and have no other extension")
|
||||||
" doesnt (yet) implement / to - translattion. .readme should show up as -.readme.")
|
|
||||||
|
|
||||||
(SETQ DEST (CONCAT NOV ".pdf"))
|
(CL:WHEN (AND (NULL EXT)
|
||||||
(CL:WHEN (AND (NOT REDO)
|
(EQ (CHCON1 NAME)
|
||||||
(INFILEP DEST))
|
(CHARCODE %.)))
|
||||||
(CL:FORMAT T "~a already there~%%" DEST)
|
(SETQ EXT (SUBATOM NAME 2)))
|
||||||
(RETURN))
|
(CL:WHEN (MEMB EXT HC-SKIP-EXTENSIONS)
|
||||||
(CL:WHEN (INFILEP (CONCAT DEST ".skip"))
|
|
||||||
(PRINTOUT T "Explicit .skip " DEST T)
|
(* ;; "ignore any of these extensions")
|
||||||
(RETURN))
|
|
||||||
(if (MEMB 'TEDIT PHASES)
|
(CL:FORMAT T "~&Ignoring (on extension): ~a~%%" SRCPATH)
|
||||||
then (CL:WHEN [OR (MEMB EXT '(TEDIT TED SKETCH BRAVO))
|
(RETURN))
|
||||||
(CAR (NLSETQ (TEDIT.FORMATTEDFILEP SRCPATH]
|
|
||||||
(if (EQ REDO 'TEST)
|
(* ;;
|
||||||
then (CL:FORMAT T "Testing open ~a..." SRCPATH)
|
" doesn't (yet) implement / to - translation. .readme should show up as -.readme.")
|
||||||
(CLOSEF? (OPENTEXTSTREAM SRCPATH))
|
|
||||||
else (OR [NLSETQ (CL:WITH-OPEN-STREAM (S (OPENTEXTSTREAM SRCPATH)
|
(SETQ DEST (CONCAT NOV ".pdf"))
|
||||||
)
|
(CL:WHEN (AND (NOT REDO)
|
||||||
(TEDIT.FORMAT.HARDCOPY S DEST T NIL NIL
|
(INFILEP DEST))
|
||||||
NIL 'PDF]
|
(CL:FORMAT T "~a is already there~%%" DEST)
|
||||||
(PRINT 'FAIL T)))
|
(RETURN))
|
||||||
(CL:FORMAT T "DONE")))
|
(CL:WHEN (INFILEP (CONCAT DEST ".skip"))
|
||||||
(CL:WHEN (AND (MEMB 'PRETTY PHASES)
|
(CL:FORMAT T "Explicit .skip ~a~%%" DEST)
|
||||||
(MEMB EXT '(NIL IL))
|
(RETURN))
|
||||||
[SETQ LSFP (CAR (NLSETQ (LISPSOURCEFILEP SRCPATH]
|
(CL:FORMAT T "~&Starting on ~a:~%%" SRCPATH)
|
||||||
(NEQ LSFP *COMMON-LISP-READ-ENVIRONMENT*))
|
(CL:WHEN [AND DOTEDIT (OR (MEMB EXT '(TEDIT TED SKETCH BRAVO))
|
||||||
(PRINTOUT T "PDF printing " " to " DEST "...")
|
(CAR (REPORT-AND-GO (TEDIT.FORMATTEDFILEP
|
||||||
(OR (NLSETQ (CL:WITH-OPEN-STREAM (STR (OPEN-PDF-STREAM DEST))
|
SRCPATH)
|
||||||
(PRETTYFILEINDEX SRCPATH NIL STR)))
|
(CL:FORMAT NIL
|
||||||
(PRINT 'FAIL T))
|
"~~%%~S TEDIT.FORMATTEDFILEP of ~A -- Condition: ~~A"
|
||||||
(PRINTOUT T "DONE" T))])
|
'FAIL SRCPATH]
|
||||||
|
(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))
|
||||||
|
(CL:FORMAT NIL
|
||||||
|
"~~%%~S TEDIT.FORMAT.HARDCOPY 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
|
(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 27-Jan-2026 10:50 by lmm")
|
||||||
(* ; "Edited 23-Jan-2026 11:59 by lmm")
|
(* ; "Edited 23-Jan-2026 11:59 by lmm")
|
||||||
(* ; "Edited 29-Apr-2024 14:18 by lmm")
|
(* ; "Edited 29-Apr-2024 14:18 by lmm")
|
||||||
@@ -339,8 +393,8 @@
|
|||||||
then 2
|
then 2
|
||||||
else 1))
|
else 1))
|
||||||
-2)))
|
-2)))
|
||||||
(CL:UNLESS (OR (MEMB SHORTNAME '(.git))
|
(CL:UNLESS (OR (EQ SHORTNAME '.git)
|
||||||
(MEMB SHORTNAME '(.GIT))
|
(EQ SHORTNAME '.GIT)
|
||||||
[AND (STRPOS ".git" (L-CASE FULLNAME))
|
[AND (STRPOS ".git" (L-CASE FULLNAME))
|
||||||
(NOT (STRPOS ".github" (L-CASE FULLNAME]
|
(NOT (STRPOS ".github" (L-CASE FULLNAME]
|
||||||
(INFILEP (CONCAT FULLNAME ".skip")))
|
(INFILEP (CONCAT FULLNAME ".skip")))
|
||||||
@@ -372,7 +426,8 @@
|
|||||||
|
|
||||||
(PUTPROPS MEDLEY-UTILS FILETYPE :COMPILE-FILE)
|
(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
|
:AFTER
|
||||||
'((:LAST (AND (STRPOS "GETFN" MSG)
|
'((:LAST (AND (STRPOS "GETFN" MSG)
|
||||||
(HELP MSG]
|
(HELP MSG]
|
||||||
@@ -463,6 +518,15 @@
|
|||||||
(SETQ DIFF (COMPARESOURCES X DESTFILE NIL))
|
(SETQ DIFF (COMPARESOURCES X DESTFILE NIL))
|
||||||
(TERPRI])
|
(TERPRI])
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(DEFMACRO REPORT-AND-GO (FORM REPORT-FORMAT) (* ; "Edited 16-Apr-2026 16:02 by mth")
|
||||||
|
`[CL:MULTIPLE-VALUE-BIND (FORM-RESULT ERROR-CONDITION)
|
||||||
|
(IGNORE-ERRORS (CL:VALUES ,FORM)) (* ; "Only the first value")
|
||||||
|
(COND
|
||||||
|
(ERROR-CONDITION (PRIN3 (CL:FORMAT NIL ,REPORT-FORMAT ERROR-CONDITION)
|
||||||
|
T)
|
||||||
|
NIL)
|
||||||
|
(T (LIST FORM-RESULT])
|
||||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||||
|
|
||||||
(ADDTOVAR NLAMA )
|
(ADDTOVAR NLAMA )
|
||||||
@@ -472,9 +536,10 @@
|
|||||||
(ADDTOVAR LAMA )
|
(ADDTOVAR LAMA )
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (1312 8246 (GATHER-INFO 1322 . 6704) (MAKE-FULLER-DB 6706 . 7615) (MEDLEY-FIX-LINKS 7617
|
(FILEMAP (NIL (1289 8223 (GATHER-INFO 1299 . 6681) (MAKE-FULLER-DB 6683 . 7592) (MEDLEY-FIX-LINKS 7594
|
||||||
. 8010) (MEDLEY-FIX-DATES 8012 . 8244)) (9425 12213 (MAKE-EXPORTS-ALL 9435 . 10494) (
|
. 7987) (MEDLEY-FIX-DATES 7989 . 8221)) (9795 12371 (MAKE-EXPORTS-ALL 9805 . 10652) (
|
||||||
MAKE-WHEREIS-HASH 10496 . 11685) (MAKE-WHEREIS-LOOPS 11687 . 12211)) (12214 21862 (HCFILES 12224 .
|
MAKE-WHEREIS-HASH 10654 . 11843) (MAKE-WHEREIS-LOOPS 11845 . 12369)) (12372 24990 (HCFILES 12382 .
|
||||||
16487) (MAKE-INDEX-HTMLS 16489 . 21860)) (22112 26724 (RECOMPILE-ONE 22122 . 24019) (RECMPL 24021 .
|
19514) (MAKE-INDEX-HTMLS 19516 . 24988)) (25324 29936 (RECOMPILE-ONE 25334 . 27231) (RECMPL 27233 .
|
||||||
24624) (COMPILE-SETUP 24626 . 25250) (REMAKEFILES 25252 . 26722)))))
|
27836) (COMPILE-SETUP 27838 . 28462) (REMAKEFILES 28464 . 29934)) (29938 30408 (REPORT-AND-GO 29938 .
|
||||||
|
30408)))))
|
||||||
STOP
|
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
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS LOADUP-FULL)
|
: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)
|
(PRETTYCOMPRINT LOADUP-FULLCOMS)
|
||||||
@@ -16,7 +16,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(LOADFULLFONTS
|
(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 2-Sep-2025 20:06 by rmk")
|
||||||
(* ; "Edited 13-Jul-2025 11:40 by rmk")
|
(* ; "Edited 13-Jul-2025 11:40 by rmk")
|
||||||
(* ; "Edited 30-Jun-2025 00:04 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")
|
(* ;; " 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)
|
(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)
|
(for FAMILY in '(CLASSIC MODERN TERMINAL)
|
||||||
do (PRINTOUT T " Loading " FAMILY " ")
|
do (PRINTOUT T " Loading " FAMILY " ")
|
||||||
[for SIZE in '(8 10 12)
|
[for SIZE in '(8 10 12)
|
||||||
@@ -47,7 +45,8 @@
|
|||||||
(PRINTOUT T "FULL fonts loaded" T])
|
(PRINTOUT T "FULL fonts loaded" T])
|
||||||
|
|
||||||
(LOADUP-FULL
|
(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 5-Feb-2026 10:26 by rmk")
|
||||||
(* ; "Edited 28-Dec-2025 12:06 by rmk")
|
(* ; "Edited 28-Dec-2025 12:06 by rmk")
|
||||||
(* ; "Edited 1-Sep-2025 11:59 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
|
(LOADUP '(CHAT INTERPRESS TEDIT HRULE TEDIT-CHAT READNUMBER EDITBITMAP FILEBROWSER THINFILES
|
||||||
GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT HELPSYS
|
GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT HELPSYS
|
||||||
DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE UNIXCOMM UNIXCHAT
|
DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE UNIXCOMM UNIXCHAT))
|
||||||
UNIXYCD))
|
|
||||||
(LOADFULLFONTS)
|
(LOADFULLFONTS)
|
||||||
(COND
|
(COND
|
||||||
((WINDOWP *WHO-LINE*)
|
((WINDOWP *WHO-LINE*)
|
||||||
@@ -103,5 +101,5 @@
|
|||||||
|
|
||||||
(FIXMETA)
|
(FIXMETA)
|
||||||
(DECLARE%: DONTCOPY
|
(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
|
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"
|
:EDIT-BY "mth"
|
||||||
|
|
||||||
:CHANGES-TO (FNS DUMPDB)
|
: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)
|
(PRETTYCOMPRINT DATABASEFNSCOMS)
|
||||||
@@ -164,7 +165,9 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(DUMPDB
|
(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 7-Feb-2024 18:26 by mth")
|
||||||
(* ; "Edited 27-Oct-2021 10:51 by larry")
|
(* ; "Edited 27-Oct-2021 10:51 by larry")
|
||||||
(* ; "Edited 24-Oct-2021 16:24 by rmk:")
|
(* ; "Edited 24-Oct-2021 16:24 by rmk:")
|
||||||
@@ -180,7 +183,7 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
|||||||
(LET ((SAVEDCOPYRIGHTFLG COPYRIGHTFLG)
|
(LET ((SAVEDCOPYRIGHTFLG COPYRIGHTFLG)
|
||||||
(SAVEDDEFAULTCOPYRIGHTOWNER DEFAULTCOPYRIGHTOWNER))
|
(SAVEDDEFAULTCOPYRIGHTOWNER DEFAULTCOPYRIGHTOWNER))
|
||||||
(CL:UNWIND-PROTECT
|
(CL:UNWIND-PROTECT
|
||||||
(PROG (DBFILE DBFN DBROOTFN FLCPR (FL (NAMEFIELD FILE))
|
(PROG (DBFILE DBFN DBROOTFN FLCPR (FL (ROOTFILENAME FILE))
|
||||||
(FNS (FILEFNSLST FILE)))
|
(FNS (FILEFNSLST FILE)))
|
||||||
(SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE))
|
(SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE))
|
||||||
(SETQ DBROOTFN (ROOTFILENAME DBFN))
|
(SETQ DBROOTFN (ROOTFILENAME DBFN))
|
||||||
@@ -230,7 +233,7 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
|||||||
(PRETTYDEF NIL DBFN
|
(PRETTYDEF NIL DBFN
|
||||||
`((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
|
`((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
|
||||||
(ERROR!)))
|
(ERROR!)))
|
||||||
(E [PRINT (CAR (GETPROP ',FILE 'FILEDATES]
|
(E [PRINT (CAR (GETPROP ',FL 'FILEDATES]
|
||||||
(DUMPDATABASE ',FNS]
|
(DUMPDATABASE ',FNS]
|
||||||
[COND
|
[COND
|
||||||
(PROPFLG (PRINT (FULLNAME DBFILE)
|
(PROPFLG (PRINT (FULLNAME DBFILE)
|
||||||
@@ -375,9 +378,9 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
|||||||
|
|
||||||
(RESETSAVE DWIMIFYCOMPFLG T)
|
(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
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (1768 6793 (DBFILE 1778 . 3423) (DBFILE1 3425 . 4935) (DBFILE2 4937 . 6159) (LOAD 6161
|
(FILEMAP (NIL (1783 6808 (DBFILE 1793 . 3438) (DBFILE1 3440 . 4950) (DBFILE2 4952 . 6174) (LOAD 6176
|
||||||
. 6391) (LOADFROM 6393 . 6581) (MAKEFILE 6583 . 6791)) (6849 17838 (DUMPDB 6859 . 11873) (LOADDB
|
. 6406) (LOADFROM 6408 . 6596) (MAKEFILE 6598 . 6806)) (6864 18072 (DUMPDB 6874 . 12107) (LOADDB
|
||||||
11875 . 16750) (MAKEDB 16752 . 17836)))))
|
12109 . 16984) (MAKEDB 16986 . 18070)))))
|
||||||
STOP
|
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 "31-Mar-2026 00:14:19" {WMEDLEY}<library>UNIXUTILS.;58 21269
|
(FILECREATED "28-Apr-2026 09:59:13" {WMEDLEY}<library>UNIXUTILS.;61 22079
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS UNIX-FILE-NAME)
|
:CHANGES-TO (VARS UNIXUTILSCOMS)
|
||||||
|
|
||||||
:PREVIOUS-DATE "29-Mar-2026 00:26:43" {WMEDLEY}<library>UNIXUTILS.;57)
|
:PREVIOUS-DATE "27-Apr-2026 11:10:07" {MEDLEY}<library>UNIXUTILS.;60)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT UNIXUTILSCOMS)
|
(PRETTYCOMPRINT UNIXUTILSCOMS)
|
||||||
@@ -23,6 +23,7 @@
|
|||||||
(ShellOpener NIL RESET)))
|
(ShellOpener NIL RESET)))
|
||||||
(FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME
|
(FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME
|
||||||
UNIX-TMP-FILE-NAME)
|
UNIX-TMP-FILE-NAME)
|
||||||
|
(COMMANDS "cd" cdm "ls" "pwd")
|
||||||
(PROPS (UNIXUTILS FILETYPE))))
|
(PROPS (UNIXUTILS FILETYPE))))
|
||||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||||
|
|
||||||
@@ -148,7 +149,8 @@
|
|||||||
"true"])
|
"true"])
|
||||||
|
|
||||||
(ShellOpen
|
(ShellOpen
|
||||||
[LAMBDA (FilenameOrURL) (* ; "Edited 28-Dec-2025 18:26 by rmk")
|
[LAMBDA (FilenameOrURL) (* ; "Edited 27-Apr-2026 11:08 by FGH")
|
||||||
|
(* ; "Edited 28-Dec-2025 18:26 by rmk")
|
||||||
(* ; "Edited 10-Sep-2025 15:29 by rmk")
|
(* ; "Edited 10-Sep-2025 15:29 by rmk")
|
||||||
(* ; "Edited 4-May-2025 11:14 by rmk")
|
(* ; "Edited 4-May-2025 11:14 by rmk")
|
||||||
|
|
||||||
@@ -210,7 +212,8 @@
|
|||||||
'NAME NEWNAME 'EXTENSION EXTENSION))
|
'NAME NEWNAME 'EXTENSION EXTENSION))
|
||||||
(TARGETFILE.UNIX (SLASHIT (PACKFILENAME.STRING 'HOST NIL 'DIRECTORY
|
(TARGETFILE.UNIX (SLASHIT (PACKFILENAME.STRING 'HOST NIL 'DIRECTORY
|
||||||
TMPDIR 'NAME NEWNAME 'EXTENSION
|
TMPDIR 'NAME NEWNAME 'EXTENSION
|
||||||
EXTENSION)))
|
EXTENSION)
|
||||||
|
NIL NIL NIL T))
|
||||||
(UNIXFILE NIL))
|
(UNIXFILE NIL))
|
||||||
(DECLARE (SPECVARS UNIXFILE))
|
(DECLARE (SPECVARS UNIXFILE))
|
||||||
(if (OR VERSION.SPECIFIED (NOT UNVERSIONED.EXISTS))
|
(if (OR VERSION.SPECIFIED (NOT UNVERSIONED.EXISTS))
|
||||||
@@ -245,7 +248,8 @@
|
|||||||
0))) DO (BLOCK) FINALLY (RETURN CODE])
|
0))) DO (BLOCK) FINALLY (RETURN CODE])
|
||||||
|
|
||||||
(SLASHIT
|
(SLASHIT
|
||||||
[LAMBDA (X LCASEDIRS NOHOST KEEPDOT) (* ; "Edited 17-Jan-2026 23:15 by rmk")
|
[LAMBDA (X LCASEDIRS NOHOST KEEPDOT NO.QUOTE.SPACE) (* ; "Edited 27-Apr-2026 11:00 by FGH")
|
||||||
|
(* ; "Edited 17-Jan-2026 23:15 by rmk")
|
||||||
(* ; "Edited 4-Nov-2025 10:10 by rmk")
|
(* ; "Edited 4-Nov-2025 10:10 by rmk")
|
||||||
(* ; "Edited 22-Oct-2025 13:05 by rmk")
|
(* ; "Edited 22-Oct-2025 13:05 by rmk")
|
||||||
(* ; "Edited 25-Sep-2025 09:57 by rmk")
|
(* ; "Edited 25-Sep-2025 09:57 by rmk")
|
||||||
@@ -258,7 +262,10 @@
|
|||||||
(* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file. For now, this just involves replacing directory brackets with /, removing the host, perhaps lower-casing the directory, and perhaps removing a final dot. It probably should be extended to deal with version number translation, for now it just keeps the ; version. ")
|
(* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file. For now, this just involves replacing directory brackets with /, removing the host, perhaps lower-casing the directory, and perhaps removing a final dot. It probably should be extended to deal with version number translation, for now it just keeps the ; version. ")
|
||||||
|
|
||||||
(LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X)
|
(LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X)
|
||||||
0]
|
0)))
|
||||||
|
(REPLACE.SPACE (if NO.QUOTE.SPACE
|
||||||
|
then (CONS (CHARCODE SPACE))
|
||||||
|
else (CHARCODE (\ SPACE]
|
||||||
[SETQ SLASHED (CONCATCODES (for I C from DIRPOS while (SETQ C (NTHCHARCODE X I))
|
[SETQ SLASHED (CONCATCODES (for I C from DIRPOS while (SETQ C (NTHCHARCODE X I))
|
||||||
join (SELCHARQ C
|
join (SELCHARQ C
|
||||||
((< >)
|
((< >)
|
||||||
@@ -266,7 +273,7 @@
|
|||||||
(CONS (CHARCODE /)))
|
(CONS (CHARCODE /)))
|
||||||
(/ (SETQ LASTDIRPOS I)
|
(/ (SETQ LASTDIRPOS I)
|
||||||
(CONS C))
|
(CONS C))
|
||||||
(SPACE (APPEND (CHARCODE (\ SPACE))))
|
(SPACE (APPEND REPLACE.SPACE))
|
||||||
(CONS C]
|
(CONS C]
|
||||||
(CL:WHEN (AND LCASEDIRS LASTDIRPOS)
|
(CL:WHEN (AND LCASEDIRS LASTDIRPOS)
|
||||||
(SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS)))
|
(SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS)))
|
||||||
@@ -365,10 +372,20 @@
|
|||||||
unless (INFILEP UNAME) do (RETURN (SLASHIT (CLOSEF (OPENSTREAM UNAME 'OUTPUT 'NEW])
|
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)
|
(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (1170 1543 (ShellCommand 1170 . 1543)) (1545 1942 (ShellWhich 1545 . 1942)) (2052 21191
|
(FILEMAP (NIL (1208 1581 (ShellCommand 1208 . 1581)) (1583 1980 (ShellWhich 1583 . 1980)) (2090 21695
|
||||||
(ShellBrowser 2062 . 3834) (ShellBrowse 3836 . 4521) (ShellOpener 4523 . 6211) (ShellOpen 6213 . 11982
|
(ShellBrowser 2100 . 3872) (ShellBrowse 3874 . 4559) (ShellOpener 4561 . 6249) (ShellOpen 6251 . 12198
|
||||||
) (PROCESS-COMMAND 11984 . 12597) (SLASHIT 12599 . 15623) (UNIX-FILE-NAME 15625 . 19510) (
|
) (PROCESS-COMMAND 12200 . 12813) (SLASHIT 12815 . 16127) (UNIX-FILE-NAME 16129 . 20014) (
|
||||||
UNIX-TMP-FILE-NAME 19512 . 21189)))))
|
UNIX-TMP-FILE-NAME 20016 . 21693)))))
|
||||||
STOP
|
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 " 2-Mar-2026 18:32:06" {WMEDLEY}<library>tedit>TEDIT.;853 146506
|
(FILECREATED "10-Mar-2026 18:07:31" {WMEDLEY}<library>tedit>TEDIT.;855 146853
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (VARS TEDITCOMS)
|
:CHANGES-TO (FNS TDRIBBLE)
|
||||||
|
|
||||||
:PREVIOUS-DATE " 4-Feb-2026 16:02:02" {WMEDLEY}<library>tedit>TEDIT.;852)
|
:PREVIOUS-DATE " 2-Mar-2026 18:32:06" {WMEDLEY}<library>tedit>TEDIT.;853)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDITCOMS)
|
(PRETTYCOMPRINT TEDITCOMS)
|
||||||
@@ -743,17 +743,21 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(TDRIBBLE
|
(TDRIBBLE
|
||||||
[LAMBDA NIL (* ; "Edited 31-Mar-2025 12:03 by rmk")
|
[LAMBDA (TITLE WINDOW) (* ; "Edited 10-Mar-2026 17:39 by rmk")
|
||||||
|
(* ; "Edited 31-Mar-2025 12:03 by rmk")
|
||||||
(* ; "Edited 16-Mar-2025 21:47 by rmk")
|
(* ; "Edited 16-Mar-2025 21:47 by rmk")
|
||||||
(* ; "Edited 27-Nov-2024 23:20 by rmk")
|
(* ; "Edited 27-Nov-2024 23:20 by rmk")
|
||||||
(* ; "Edited 17-Nov-2024 14:10 by rmk")
|
(* ; "Edited 17-Nov-2024 14:10 by rmk")
|
||||||
(* ; "Edited 15-Nov-2024 21:13 by rmk")
|
(* ; "Edited 15-Nov-2024 21:13 by rmk")
|
||||||
(* ; "Edited 22-Oct-2024 21:23 by rmk")
|
(* ; "Edited 22-Oct-2024 21:23 by rmk")
|
||||||
(LET [(TSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL `(HISTORY OFF FONT DEFAULTFONT]
|
(LET [(TSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL `(TITLE ,(CONCAT (OR TITLE "Tedit Dribble")
|
||||||
|
" "
|
||||||
|
(DATE))
|
||||||
|
HISTORY OFF FONT DEFAULTFONT]
|
||||||
[WHENCLOSE TSTREAM 'BEFORE
|
[WHENCLOSE TSTREAM 'BEFORE
|
||||||
(FUNCTION (LAMBDA (TSTREAM)
|
(FUNCTION (LAMBDA (TSTREAM)
|
||||||
[TEDIT TSTREAM 'Dribble NIL
|
[TEDIT TSTREAM 'Dribble NIL
|
||||||
`(TITLE ,(CONCAT "Tedit Dribble " (DATE))
|
`(TITLE ,(TEXTPROP TSTREAM 'TITLE)
|
||||||
LEAVETTY T APPEND QUIET PARABREAKCHARS NIL HISTORY OFF
|
LEAVETTY T APPEND QUIET PARABREAKCHARS NIL HISTORY OFF
|
||||||
OPENWIDTH ,(fetch (REGION WIDTH)
|
OPENWIDTH ,(fetch (REGION WIDTH)
|
||||||
of (WINDOWPROP (WFROMDS T)
|
of (WINDOWPROP (WFROMDS T)
|
||||||
@@ -2345,27 +2349,27 @@
|
|||||||
|
|
||||||
(DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE))
|
(DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE))
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (4738 7132 (MAKE-TEDIT-EXPORTS.ALL 4748 . 5294) (UPDATE-TEDIT 5296 . 6225) (EDIT-TEDIT
|
(FILEMAP (NIL (4736 7130 (MAKE-TEDIT-EXPORTS.ALL 4746 . 5292) (UPDATE-TEDIT 5294 . 6223) (EDIT-TEDIT
|
||||||
6227 . 7130)) (8487 37486 (TEDIT 8497 . 11111) (TEXTSTREAM 11113 . 13002) (TEXTSTREAMP 13004 . 13388)
|
6225 . 7128)) (8485 37484 (TEDIT 8495 . 11109) (TEXTSTREAM 11111 . 13000) (TEXTSTREAMP 13002 . 13386)
|
||||||
(COERCETEXTSTREAM 13390 . 17601) (TEDIT.CONCAT 17603 . 20905) (TEDITSTRING 20907 . 21821) (TEDIT-SEE
|
(COERCETEXTSTREAM 13388 . 17599) (TEDIT.CONCAT 17601 . 20903) (TEDITSTRING 20905 . 21819) (TEDIT-SEE
|
||||||
21823 . 22507) (TEDIT.COPY 22509 . 24654) (TEDIT.DELETE 24656 . 26017) (TEDIT.INSERT 26019 . 28988) (
|
21821 . 22505) (TEDIT.COPY 22507 . 24652) (TEDIT.DELETE 24654 . 26015) (TEDIT.INSERT 26017 . 28986) (
|
||||||
TEDIT.TERPRI 28990 . 30104) (TEDIT.KILL 30106 . 31088) (TEDIT.QUIT 31090 . 32456) (TEDIT.MOVE 32458 .
|
TEDIT.TERPRI 28988 . 30102) (TEDIT.KILL 30104 . 31086) (TEDIT.QUIT 31088 . 32454) (TEDIT.MOVE 32456 .
|
||||||
33346) (TEDIT.STRINGWIDTH 33348 . 34019) (TEDIT.CHARWIDTH 34021 . 36263) (TEDIT.PARAGRAPH.BOUNDARIES
|
33344) (TEDIT.STRINGWIDTH 33346 . 34017) (TEDIT.CHARWIDTH 34019 . 36261) (TEDIT.PARAGRAPH.BOUNDARIES
|
||||||
36265 . 37484)) (37487 39428 (TEXTOBJ 37497 . 37962) (COERCETEXTOBJ 37964 . 39426)) (40828 42478 (
|
36263 . 37482)) (37485 39426 (TEXTOBJ 37495 . 37960) (COERCETEXTOBJ 37962 . 39424)) (40826 42825 (
|
||||||
TDRIBBLE 40838 . 42476)) (42519 54499 (TEDIT.INSERT.OBJECT 42529 . 46236) (TEDIT.EDIT.OBJECT 46238 .
|
TDRIBBLE 40836 . 42823)) (42866 54846 (TEDIT.INSERT.OBJECT 42876 . 46583) (TEDIT.EDIT.OBJECT 46585 .
|
||||||
49178) (TEDIT.OBJECT.CHANGED 49180 . 52370) (TEDIT.MAP.OBJECTS 52372 . 54027) (\TEDIT.FIRST.OBJPIECE
|
49525) (TEDIT.OBJECT.CHANGED 49527 . 52717) (TEDIT.MAP.OBJECTS 52719 . 54374) (\TEDIT.FIRST.OBJPIECE
|
||||||
54029 . 54262) (\TEDIT.NEXT.OBJPIECE 54264 . 54497)) (54522 61965 (\TEDIT.CONCAT.PAGEFRAMES 54532 .
|
54376 . 54609) (\TEDIT.NEXT.OBJPIECE 54611 . 54844)) (54869 62312 (\TEDIT.CONCAT.PAGEFRAMES 54879 .
|
||||||
59599) (\TEDIT.GET.PAGE.HEADINGS 59601 . 60630) (\TEDIT.CONCAT.INSTALL.HEADINGS 60632 . 61963)) (61966
|
59946) (\TEDIT.GET.PAGE.HEADINGS 59948 . 60977) (\TEDIT.CONCAT.INSTALL.HEADINGS 60979 . 62310)) (62313
|
||||||
65573 (\TEDIT.MOVE.MSG 61976 . 64057) (\TEDIT.READONLY 64059 . 65571)) (65574 71465 (TEDIT.NCHARS
|
65920 (\TEDIT.MOVE.MSG 62323 . 64404) (\TEDIT.READONLY 64406 . 65918)) (65921 71812 (TEDIT.NCHARS
|
||||||
65584 . 65957) (TEDIT.RPLCHARCODE 65959 . 68949) (TEDIT.NTHCHARCODE 68951 . 70994) (TEDIT.NTHCHAR
|
65931 . 66304) (TEDIT.RPLCHARCODE 66306 . 69296) (TEDIT.NTHCHARCODE 69298 . 71341) (TEDIT.NTHCHAR
|
||||||
70996 . 71463)) (71511 128555 (\TEDIT1 71521 . 73598) (\TEDIT.INSERT 73600 . 79713) (\TEDIT.MOVE 79715
|
71343 . 71810)) (71858 128902 (\TEDIT1 71868 . 73945) (\TEDIT.INSERT 73947 . 80060) (\TEDIT.MOVE 80062
|
||||||
. 87813) (\TEDIT.COPY 87815 . 92421) (\TEDIT.REPLACE.SELPIECES 92423 . 96959) (
|
. 88160) (\TEDIT.COPY 88162 . 92768) (\TEDIT.REPLACE.SELPIECES 92770 . 97306) (
|
||||||
\TEDIT.INSERT.SELPIECES 96961 . 99958) (\TEDIT.RESTARTFN 99960 . 102465) (\TEDIT.CHARDELETE 102467 .
|
\TEDIT.INSERT.SELPIECES 97308 . 100305) (\TEDIT.RESTARTFN 100307 . 102812) (\TEDIT.CHARDELETE 102814
|
||||||
105396) (\TEDIT.COPYPIECE 105398 . 110560) (\TEDIT.APPLY.OBJFN 110562 . 113648) (\TEDIT.DELETE 113650
|
. 105743) (\TEDIT.COPYPIECE 105745 . 110907) (\TEDIT.APPLY.OBJFN 110909 . 113995) (\TEDIT.DELETE
|
||||||
. 118018) (\TEDIT.DIFFUSE.PARALOOKS 118020 . 120291) (\TEDIT.WORDDELETE 120293 . 121908) (
|
113997 . 118365) (\TEDIT.DIFFUSE.PARALOOKS 118367 . 120638) (\TEDIT.WORDDELETE 120640 . 122255) (
|
||||||
\TEDIT.WORDDELETE.FORWARD 121910 . 123699) (\TEDIT.FINISHEDIT? 123701 . 128553)) (128556 129215 (
|
\TEDIT.WORDDELETE.FORWARD 122257 . 124046) (\TEDIT.FINISHEDIT? 124048 . 128900)) (128903 129562 (
|
||||||
\TEDIT.THELP 128566 . 129213)) (129249 138380 (\TEDIT.PARAPIECES 129259 . 131233) (\TEDIT.PARACHNOS
|
\TEDIT.THELP 128913 . 129560)) (129596 138727 (\TEDIT.PARAPIECES 129606 . 131580) (\TEDIT.PARACHNOS
|
||||||
131235 . 132127) (\TEDIT.PARA.FIRST 132129 . 135230) (\TEDIT.PARA.LAST 135232 . 138378)) (138381
|
131582 . 132474) (\TEDIT.PARA.FIRST 132476 . 135577) (\TEDIT.PARA.LAST 135579 . 138725)) (138728
|
||||||
145476 (\TEDIT.WORD.FIRST 138391 . 142395) (\TEDIT.WORD.LAST 142397 . 145474)) (145677 145954 (
|
145823 (\TEDIT.WORD.FIRST 138738 . 142742) (\TEDIT.WORD.LAST 142744 . 145821)) (146024 146301 (
|
||||||
TEDITSYSTEMDATE 145687 . 145952)) (146090 146297 (TEDIT.IMAGESOURCEP 146100 . 146295)))))
|
TEDITSYSTEMDATE 146034 . 146299)) (146437 146644 (TEDIT.IMAGESOURCEP 146447 . 146642)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
@@ -1,12 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||||
|
|
||||||
(FILECREATED "23-Jan-2026 15:49:26" {WMEDLEY}<library>TEDIT>TEDIT-ABBREV.;58 18256
|
(FILECREATED "30-Apr-2026 11:55:15" {MEDLEY}<library>tedit>TEDIT-ABBREV.;59 18372
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND)
|
:CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND)
|
||||||
|
|
||||||
:PREVIOUS-DATE "13-Jan-2026 17:51:55" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;55)
|
:PREVIOUS-DATE "23-Jan-2026 15:49:26" {MEDLEY}<library>tedit>TEDIT-ABBREV.;58)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-ABBREVCOMS)
|
(PRETTYCOMPRINT TEDIT-ABBREVCOMS)
|
||||||
@@ -86,7 +86,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.ABBREV.EXPAND
|
(\TEDIT.ABBREV.EXPAND
|
||||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 23-Jan-2026 15:49 by rmk")
|
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 30-Apr-2026 11:53 by rmk")
|
||||||
|
(* ; "Edited 23-Jan-2026 15:49 by rmk")
|
||||||
(* ; "Edited 20-Jan-2026 09:56 by rmk")
|
(* ; "Edited 20-Jan-2026 09:56 by rmk")
|
||||||
(* ; "Edited 13-Jan-2026 17:51 by rmk")
|
(* ; "Edited 13-Jan-2026 17:51 by rmk")
|
||||||
(* ; "Edited 8-Jan-2026 09:08 by rmk")
|
(* ; "Edited 8-Jan-2026 09:08 by rmk")
|
||||||
@@ -118,7 +119,7 @@
|
|||||||
(SETQ BACKSLASH T) (* ;
|
(SETQ BACKSLASH T) (* ;
|
||||||
"Started with backslash, extend match")
|
"Started with backslash, extend match")
|
||||||
(SETQ POINTSELECTION NIL)
|
(SETQ POINTSELECTION NIL)
|
||||||
(for I CH from (SUB1 LASTCHNO) by -1 as J from 1 to 25
|
(for I CH from (SUB1 LASTCHNO) by -1 to 1 as J from 1 to 25
|
||||||
do (SETQ CH (TEDIT.NTHCHARCODE TSTREAM I)) (* ; "Don't cross over an image obj")
|
do (SETQ CH (TEDIT.NTHCHARCODE TSTREAM I)) (* ; "Don't cross over an image obj")
|
||||||
(if (IMAGEOBJP CH)
|
(if (IMAGEOBJP CH)
|
||||||
then (RETURN)
|
then (RETURN)
|
||||||
@@ -363,7 +364,7 @@
|
|||||||
("DATE" \TEDIT.EXPAND.DATE)
|
("DATE" \TEDIT.EXPAND.DATE)
|
||||||
(">>DATE<<" \TEDIT.EXPAND.DATE)))
|
(">>DATE<<" \TEDIT.EXPAND.DATE)))
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (4348 15152 (\TEDIT.ABBREV.EXPAND 4358 . 9123) (\TEDIT.ABBREV.EXPANSION 9125 . 12189) (
|
(FILEMAP (NIL (4346 15268 (\TEDIT.ABBREV.EXPAND 4356 . 9239) (\TEDIT.ABBREV.EXPANSION 9241 . 12305) (
|
||||||
\TEDIT.ABBREV.TREE 12191 . 13322) (\TEDIT.ABBREV.PARSE 13324 . 14476) (\TEDIT.ABBREV.PARSE.CHARCODE
|
\TEDIT.ABBREV.TREE 12307 . 13438) (\TEDIT.ABBREV.PARSE 13440 . 14592) (\TEDIT.ABBREV.PARSE.CHARCODE
|
||||||
14478 . 15150)) (15153 15798 (\TEDIT.EXPAND.DATE 15163 . 15796)))))
|
14594 . 15266)) (15269 15914 (\TEDIT.EXPAND.DATE 15279 . 15912)))))
|
||||||
STOP
|
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 "25-Jan-2026 09:14:04" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;230 123301
|
(FILECREATED " 8-May-2026 12:17:16" {MEDLEY}<library>TEDIT>TEDIT-BUTTONS.;234 123908
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (VARS TEDIT-BUTTONSCOMS)
|
:CHANGES-TO (FNS MB.NWAY.SIZEFN)
|
||||||
|
|
||||||
:PREVIOUS-DATE "19-Oct-2025 10:44:18" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;229)
|
:PREVIOUS-DATE "29-Apr-2026 17:57:09" {MEDLEY}<library>TEDIT>TEDIT-BUTTONS.;233)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-BUTTONSCOMS)
|
(PRETTYCOMPRINT TEDIT-BUTTONSCOMS)
|
||||||
@@ -922,7 +922,9 @@
|
|||||||
SOBJ STREAM])
|
SOBJ STREAM])
|
||||||
|
|
||||||
(MB.NWAY.SIZEFN
|
(MB.NWAY.SIZEFN
|
||||||
[LAMBDA (OBJ STREAM CURX RIGHTMARGIN) (* ; "Edited 20-Aug-2024 15:12 by rmk")
|
[LAMBDA (OBJ STREAM CURX RIGHTMARGIN) (* ; "Edited 8-May-2026 12:16 by rmk")
|
||||||
|
(* ; "Edited 29-Apr-2026 17:56 by rmk")
|
||||||
|
(* ; "Edited 20-Aug-2024 15:12 by rmk")
|
||||||
(* ; "Edited 22-Jul-2024 11:31 by rmk")
|
(* ; "Edited 22-Jul-2024 11:31 by rmk")
|
||||||
(* jds " 6-Sep-84 14:19")
|
(* jds " 6-Sep-84 14:19")
|
||||||
(* ; "Tell the size of an n-way menu")
|
(* ; "Tell the size of an n-way menu")
|
||||||
@@ -935,7 +937,9 @@
|
|||||||
(BUTTONHEIGHT (IMAGEOBJPROP OBJ 'BUTTONHEIGHT))
|
(BUTTONHEIGHT (IMAGEOBJPROP OBJ 'BUTTONHEIGHT))
|
||||||
(SPACING (IMAGEOBJPROP OBJ 'ITEMSPACE))
|
(SPACING (IMAGEOBJPROP OBJ 'ITEMSPACE))
|
||||||
(SLACK (IDIFFERENCE RIGHTMARGIN CURX))
|
(SLACK (IDIFFERENCE RIGHTMARGIN CURX))
|
||||||
BOX XSIZE YSIZE LINES)
|
(XSIZE 0)
|
||||||
|
(YSIZE 0)
|
||||||
|
BOX YSIZE LINES)
|
||||||
[if (AND (IGEQ SLACK MAXWIDTH)
|
[if (AND (IGEQ SLACK MAXWIDTH)
|
||||||
(EQ MAXITEMS/LINE (LENGTH SUBOBJECTS)))
|
(EQ MAXITEMS/LINE (LENGTH SUBOBJECTS)))
|
||||||
then (* ;
|
then (* ;
|
||||||
@@ -950,8 +954,11 @@
|
|||||||
(IMAGEOBJPROP SO 'Y 0))
|
(IMAGEOBJPROP SO 'Y 0))
|
||||||
elseif (ILEQ SLACK (IMAGEOBJPROP OBJ 'MINWIDTH))
|
elseif (ILEQ SLACK (IMAGEOBJPROP OBJ 'MINWIDTH))
|
||||||
then (* ; "Stack them vertically.")
|
then (* ; "Stack them vertically.")
|
||||||
(for SO (Y _ (ITIMES BUTTONHEIGHT (LENGTH SUBOBJECTS))) in SUBOBJECTS
|
(SETQ YSIZE (ITIMES BUTTONHEIGHT (LENGTH SUBOBJECTS)))
|
||||||
|
(SETQ XSIZE SPACING)
|
||||||
|
(for SO (Y _ YSIZE) in SUBOBJECTS
|
||||||
do (add Y (IMINUS BUTTONHEIGHT))
|
do (add Y (IMINUS BUTTONHEIGHT))
|
||||||
|
[SETQ XSIZE (IMAX XSIZE (fetch XSIZE of (IMAGEOBJPROP SO 'BOUNDBOX]
|
||||||
(IMAGEOBJPROP SO 'Y Y)
|
(IMAGEOBJPROP SO 'Y Y)
|
||||||
(IMAGEOBJPROP SO 'X 0))
|
(IMAGEOBJPROP SO 'X 0))
|
||||||
else (* ; "Divide them into lines")
|
else (* ; "Divide them into lines")
|
||||||
@@ -1749,7 +1756,8 @@
|
|||||||
ENDPC])
|
ENDPC])
|
||||||
|
|
||||||
(MB.FIELD.SETSTATEFN
|
(MB.FIELD.SETSTATEFN
|
||||||
[LAMBDA (PREFIXPC NEWVALUE TSTREAM) (* ; "Edited 6-Apr-2025 12:23 by rmk")
|
[LAMBDA (PREFIXPC NEWVALUE TSTREAM) (* ; "Edited 17-Mar-2026 00:38 by rmk")
|
||||||
|
(* ; "Edited 6-Apr-2025 12:23 by rmk")
|
||||||
(* ; "Edited 9-Dec-2024 22:14 by rmk")
|
(* ; "Edited 9-Dec-2024 22:14 by rmk")
|
||||||
(* ; "Edited 4-Dec-2024 20:31 by rmk")
|
(* ; "Edited 4-Dec-2024 20:31 by rmk")
|
||||||
(* ; "Edited 20-Oct-2024 17:20 by rmk")
|
(* ; "Edited 20-Oct-2024 17:20 by rmk")
|
||||||
@@ -1805,8 +1813,9 @@
|
|||||||
(\TEDIT.INSERT NEWVALUE FSEL TSTREAM T T)
|
(\TEDIT.INSERT NEWVALUE FSEL TSTREAM T T)
|
||||||
(NCHARS NEWVALUE)))
|
(NCHARS NEWVALUE)))
|
||||||
(\TEDIT.UPDATE.SEL FSEL FIELDSTART FIELDLENGTH 'LEFT)
|
(\TEDIT.UPDATE.SEL FSEL FIELDSTART FIELDLENGTH 'LEFT)
|
||||||
(\TEDIT.CHANGE.CHARLOOKS TSTREAM (IMAGEOBJPROP PREFIXOBJ 'FIELDLOOKS)
|
(CL:UNLESS (EQ 0 (GETSEL FSEL DCH))
|
||||||
FSEL)
|
(\TEDIT.CHANGE.CHARLOOKS TSTREAM (IMAGEOBJPROP PREFIXOBJ 'FIELDLOOKS)
|
||||||
|
FSEL))
|
||||||
(IMAGEOBJPROP PREFIXOBJ 'FIELDLENGTH FIELDLENGTH)
|
(IMAGEOBJPROP PREFIXOBJ 'FIELDLENGTH FIELDLENGTH)
|
||||||
(IMAGEOBJPROP PREFIXOBJ 'STATE NEWVALUE)
|
(IMAGEOBJPROP PREFIXOBJ 'STATE NEWVALUE)
|
||||||
|
|
||||||
@@ -1937,25 +1946,25 @@
|
|||||||
(MB.FIELD.INIT)
|
(MB.FIELD.INIT)
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (3188 19324 (MB.ADD 3198 . 9910) (MB.DELETE 9912 . 10286) (MB.GET 10288 . 17058) (
|
(FILEMAP (NIL (3182 19318 (MB.ADD 3192 . 9904) (MB.DELETE 9906 . 10280) (MB.GET 10282 . 17052) (
|
||||||
MB.GET.MBARG 17060 . 18729) (TEDIT.BACKTOMAIN 18731 . 19322)) (19368 39304 (MB.BUTTONEVENTINFN 19378
|
MB.GET.MBARG 17054 . 18723) (TEDIT.BACKTOMAIN 18725 . 19316)) (19362 39298 (MB.BUTTONEVENTINFN 19372
|
||||||
. 20946) (MB.DISPLAYFN 20948 . 23007) (MB.SETIMAGE 23009 . 24177) (MB.SIZEFN 24179 . 25727) (
|
. 20940) (MB.DISPLAYFN 20942 . 23001) (MB.SETIMAGE 23003 . 24171) (MB.SIZEFN 24173 . 25721) (
|
||||||
MB.WHENOPERATEDONFN 25729 . 27678) (MB.COPYFN 27680 . 28138) (MB.GETFN 28140 . 29101) (MB.PUTFN 29103
|
MB.WHENOPERATEDONFN 25723 . 27672) (MB.COPYFN 27674 . 28132) (MB.GETFN 28134 . 29095) (MB.PUTFN 29097
|
||||||
. 30203) (MB.SHOWSELFN 30205 . 31714) (MB.CREATE 31716 . 35739) (MB.CHANGENAME 35741 . 36223) (
|
. 30197) (MB.SHOWSELFN 30199 . 31708) (MB.CREATE 31710 . 35733) (MB.CHANGENAME 35735 . 36217) (
|
||||||
MB.INIT 36225 . 37686) (MB.TRACK.UNTIL 37688 . 38383) (MB.DON'T 38385 . 38681) (MB.SPEC.REMAINDER
|
MB.INIT 36219 . 37680) (MB.TRACK.UNTIL 37682 . 38377) (MB.DON'T 38379 . 38675) (MB.SPEC.REMAINDER
|
||||||
38683 . 39302)) (39466 49471 (MB.3STATE.CREATE 39476 . 40340) (MB.3STATE.DISPLAYFN 40342 . 41328) (
|
38677 . 39296)) (39460 49465 (MB.3STATE.CREATE 39470 . 40334) (MB.3STATE.DISPLAYFN 40336 . 41322) (
|
||||||
MB.3STATE.SHOWSELFN 41330 . 43641) (MB.3STATE.INIT 43643 . 45054) (MB.3STATE.SETSTATEFN 45056 . 45714)
|
MB.3STATE.SHOWSELFN 41324 . 43635) (MB.3STATE.INIT 43637 . 45048) (MB.3STATE.SETSTATEFN 45050 . 45708)
|
||||||
(MB.3STATE.BUTTONEVENTINFN 45716 . 49469)) (49626 78530 (MB.NWAY.CREATE 49636 . 55819) (
|
(MB.3STATE.BUTTONEVENTINFN 45710 . 49463)) (49620 78972 (MB.NWAY.CREATE 49630 . 55813) (
|
||||||
MB.NWAY.DISPLAYFN 55821 . 56684) (MB.NWAY.SIZEFN 56686 . 60622) (MB.NWAY.SELECT 60624 . 64194) (
|
MB.NWAY.DISPLAYFN 55815 . 56678) (MB.NWAY.SIZEFN 56680 . 61064) (MB.NWAY.SELECT 61066 . 64636) (
|
||||||
MB.NWAY.BUTTONEVENTINFN 64196 . 67408) (MB.NWAY.NEWMENUBUTTON 67410 . 68122) (MB.NWAY.COPYFN 68124 .
|
MB.NWAY.BUTTONEVENTINFN 64638 . 67850) (MB.NWAY.NEWMENUBUTTON 67852 . 68564) (MB.NWAY.COPYFN 68566 .
|
||||||
69091) (MB.NWAY.INIT 69093 . 70584) (MB.NWAY.ARRANGEBUTTONS 70586 . 72557) (MB.NWAY.ADDITEM 72559 .
|
69533) (MB.NWAY.INIT 69535 . 71026) (MB.NWAY.ARRANGEBUTTONS 71028 . 72999) (MB.NWAY.ADDITEM 73001 .
|
||||||
76708) (MB.NWAY.FINDSUBOBJ 76710 . 77224) (MB.NWAY.SETSTATEFN 77226 . 78528)) (78609 90608 (
|
77150) (MB.NWAY.FINDSUBOBJ 77152 . 77666) (MB.NWAY.SETSTATEFN 77668 . 78970)) (79051 91050 (
|
||||||
MB.TOGGLE.CREATE 78619 . 79614) (MB.TOGGLE.DISPLAYFN 79616 . 81099) (MB.TOGGLE.INIT 81101 . 82900) (
|
MB.TOGGLE.CREATE 79061 . 80056) (MB.TOGGLE.DISPLAYFN 80058 . 81541) (MB.TOGGLE.INIT 81543 . 83342) (
|
||||||
MB.SET.TOGGLE 82902 . 84103) (MB.TOGGLE.SETSTATEFN 84105 . 84945) (MB.TOGGLE.BUTTONEVENTINFN 84947 .
|
MB.SET.TOGGLE 83344 . 84545) (MB.TOGGLE.SETSTATEFN 84547 . 85387) (MB.TOGGLE.BUTTONEVENTINFN 85389 .
|
||||||
89263) (MB.TOGGLE.WHENOPERATEDONFN 89265 . 90606)) (90689 123222 (MB.FIELD.CREATE 90699 . 96150) (
|
89705) (MB.TOGGLE.WHENOPERATEDONFN 89707 . 91048)) (91131 123829 (MB.FIELD.CREATE 91141 . 96592) (
|
||||||
MB.FIELD.DISPLAYFN 96152 . 96943) (MB.FIELD.IMAGEBOXFN 96945 . 98427) (MB.FIELD.PREFIXCREATE 98429 .
|
MB.FIELD.DISPLAYFN 96594 . 97385) (MB.FIELD.IMAGEBOXFN 97387 . 98869) (MB.FIELD.PREFIXCREATE 98871 .
|
||||||
102365) (MB.FIELD.SUFFIXCREATE 102367 . 104027) (MB.FIELD.INIT 104029 . 105796) (
|
102807) (MB.FIELD.SUFFIXCREATE 102809 . 104469) (MB.FIELD.INIT 104471 . 106238) (
|
||||||
MB.FIELD.WHENOPERATEDONFN 105798 . 107069) (MB.FIELD.GETSTATEFN 107071 . 111005) (MB.FIELD.SETSTATEFN
|
MB.FIELD.WHENOPERATEDONFN 106240 . 107511) (MB.FIELD.GETSTATEFN 107513 . 111447) (MB.FIELD.SETSTATEFN
|
||||||
111007 . 115811) (MB.FIELD.BUTTONEVENTINFN 115813 . 118118) (MB.FIELD.SIZEFN 118120 . 118360) (
|
111449 . 116418) (MB.FIELD.BUTTONEVENTINFN 116420 . 118725) (MB.FIELD.SIZEFN 118727 . 118967) (
|
||||||
MB.FIELD.INSURETYPE 118362 . 123220)))))
|
MB.FIELD.INSURETYPE 118969 . 123827)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
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 "15-Feb-2026 23:45:51" {WMEDLEY}<library>tedit>TEDIT-FILE.;666 175062
|
(FILECREATED "29-Apr-2026 23:49:14" {MEDLEY}<library>tedit>TEDIT-FILE.;684 174888
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS \TEDIT.PUT.MCCS.SPLITPIECES \TEDIT.PUT.PCTB.NEXTNEW)
|
:CHANGES-TO (FNS \TEDIT.INTERPRET.MCCS.SHIFTS)
|
||||||
(VARS TEDIT-FILECOMS)
|
|
||||||
|
|
||||||
:PREVIOUS-DATE "14-Feb-2026 10:32:44" {WMEDLEY}<library>tedit>TEDIT-FILE.;659)
|
:PREVIOUS-DATE "24-Apr-2026 21:09:13" {MEDLEY}<library>tedit>TEDIT-FILE.;683)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-FILECOMS)
|
(PRETTYCOMPRINT TEDIT-FILECOMS)
|
||||||
@@ -39,8 +38,8 @@
|
|||||||
(P (MOVD? '\TEDIT.GET.TRAILER '\TEDIT.FORMATTEDP1]
|
(P (MOVD? '\TEDIT.GET.TRAILER '\TEDIT.FORMATTEDP1]
|
||||||
(FNS \TEDIT.GET.PIECES3 \TEDIT.GET.PROPS3 \TEDIT.MAKE.STRINGPIECE)
|
(FNS \TEDIT.GET.PIECES3 \TEDIT.GET.PROPS3 \TEDIT.MAKE.STRINGPIECE)
|
||||||
(FNS \TEDIT.GET.UNFORMATTED.FILE.MCCS \TEDIT.INTERPRET.MCCS.SHIFTS
|
(FNS \TEDIT.GET.UNFORMATTED.FILE.MCCS \TEDIT.INTERPRET.MCCS.SHIFTS
|
||||||
\TEDIT.CONVERT.XCCSTOMCCS)
|
\TEDIT.CONVERT.XCCSTOMCCS \TEDIT.RUN.TO.STRINGPIECE)
|
||||||
(* ; "XCCS")
|
(* ; "MCCS")
|
||||||
(FNS \TEDIT.GET.UNFORMATTED.FILE.UTF8)
|
(FNS \TEDIT.GET.UNFORMATTED.FILE.UTF8)
|
||||||
(* ; "UTF-8")
|
(* ; "UTF-8")
|
||||||
(FNS \TEDIT.GET.CHARLOOKS.LIST \TEDIT.GET.SINGLE.CHARLOOKS \TEDIT.GET.CHARLOOKS
|
(FNS \TEDIT.GET.CHARLOOKS.LIST \TEDIT.GET.SINGLE.CHARLOOKS \TEDIT.GET.CHARLOOKS
|
||||||
@@ -643,7 +642,8 @@
|
|||||||
TSTREAM)])
|
TSTREAM)])
|
||||||
|
|
||||||
(\TEDIT.GET.UNFORMATTED.FILE
|
(\TEDIT.GET.UNFORMATTED.FILE
|
||||||
[LAMBDA (STREAM TSTREAM START END PROPS) (* ; "Edited 28-Jul-2025 23:46 by rmk")
|
[LAMBDA (STREAM TSTREAM START END PROPS) (* ; "Edited 10-Apr-2026 09:33 by rmk")
|
||||||
|
(* ; "Edited 28-Jul-2025 23:46 by rmk")
|
||||||
(* ; "Edited 24-Apr-2025 17:21 by rmk")
|
(* ; "Edited 24-Apr-2025 17:21 by rmk")
|
||||||
(* ; "Edited 8-Feb-2025 20:21 by rmk")
|
(* ; "Edited 8-Feb-2025 20:21 by rmk")
|
||||||
(* ; "Edited 17-Mar-2024 00:21 by rmk")
|
(* ; "Edited 17-Mar-2024 00:21 by rmk")
|
||||||
@@ -669,7 +669,7 @@
|
|||||||
(CL:WHEN (AND (EQ FORMAT :STRING)
|
(CL:WHEN (AND (EQ FORMAT :STRING)
|
||||||
(\IOMODEP STREAM 'OUTPUT T))
|
(\IOMODEP STREAM 'OUTPUT T))
|
||||||
(SETQ STREAM (COPYFILE STREAM '{NODIRCORE})))
|
(SETQ STREAM (COPYFILE STREAM '{NODIRCORE})))
|
||||||
[SETQ PIECES
|
(SETQ PIECES
|
||||||
(SELECTQ FORMAT
|
(SELECTQ FORMAT
|
||||||
((:MCCS :XCCS) (* ; "XCCS is done later")
|
((:MCCS :XCCS) (* ; "XCCS is done later")
|
||||||
(\TEDIT.GET.UNFORMATTED.FILE.MCCS STREAM START END DEFAULTCHARLOOKS
|
(\TEDIT.GET.UNFORMATTED.FILE.MCCS STREAM START END DEFAULTCHARLOOKS
|
||||||
@@ -703,8 +703,7 @@
|
|||||||
PPARALAST _ NIL
|
PPARALAST _ NIL
|
||||||
PPARALOOKS _ DEFAULTPARALOOKS
|
PPARALOOKS _ DEFAULTPARALOOKS
|
||||||
PTYPE _ THINFILE.PTYPE
|
PTYPE _ THINFILE.PTYPE
|
||||||
PBYTESPERCHAR _ 1
|
PBYTESPERCHAR _ 1)))
|
||||||
PBINABLE _ (fetch (STREAM BINABLE) of STREAM]
|
|
||||||
(\TEDIT.INSERTPIECES PIECES NIL TEXTOBJ)))])
|
(\TEDIT.INSERTPIECES PIECES NIL TEXTOBJ)))])
|
||||||
|
|
||||||
(\TEDIT.GET.FORMATTED.FILE
|
(\TEDIT.GET.FORMATTED.FILE
|
||||||
@@ -940,7 +939,9 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.GET.PIECES3
|
(\TEDIT.GET.PIECES3
|
||||||
[LAMBDA (TEXT TSTREAM PCCOUNT CURFILEBYTE# END) (* ; "Edited 29-Jul-2025 09:30 by rmk")
|
[LAMBDA (TEXT TSTREAM PCCOUNT CURTEXTBYTE# END) (* ; "Edited 15-Apr-2026 12:06 by rmk")
|
||||||
|
(* ; "Edited 9-Apr-2026 13:45 by rmk")
|
||||||
|
(* ; "Edited 29-Jul-2025 09:30 by rmk")
|
||||||
(* ; "Edited 24-Apr-2025 17:20 by rmk")
|
(* ; "Edited 24-Apr-2025 17:20 by rmk")
|
||||||
(* ; "Edited 8-Feb-2025 20:21 by rmk")
|
(* ; "Edited 8-Feb-2025 20:21 by rmk")
|
||||||
(* ; "Edited 30-Aug-2024 15:44 by rmk")
|
(* ; "Edited 30-Aug-2024 15:44 by rmk")
|
||||||
@@ -962,7 +963,7 @@
|
|||||||
(SETFILEPTR TEXT (\DWIN TEXT)) (* ; "Pieceinfo byte #")
|
(SETFILEPTR TEXT (\DWIN TEXT)) (* ; "Pieceinfo byte #")
|
||||||
(for PCNO PC BYTELEN PREVPC FIRSTPC PARALOOKSMAP CHARLOOKSMAP DEFAULTCHARLOOKS OLDPARALOOKS
|
(for PCNO PC BYTELEN PREVPC FIRSTPC PARALOOKSMAP CHARLOOKSMAP DEFAULTCHARLOOKS OLDPARALOOKS
|
||||||
(TEXTOBJ _ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
|
(TEXTOBJ _ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
|
||||||
(ORIGBYTE# _ CURFILEBYTE#) from 1 to PCCOUNT first (SETQ DEFAULTCHARLOOKS (FGETTOBJ TEXTOBJ
|
(ORIGBYTE# _ CURTEXTBYTE#) from 1 to PCCOUNT first (SETQ DEFAULTCHARLOOKS (FGETTOBJ TEXTOBJ
|
||||||
|
|
||||||
DEFAULTCHARLOOKS
|
DEFAULTCHARLOOKS
|
||||||
))
|
))
|
||||||
@@ -981,17 +982,15 @@
|
|||||||
(SETQ PC
|
(SETQ PC
|
||||||
(create PIECE
|
(create PIECE
|
||||||
PCONTENTS _ TEXT
|
PCONTENTS _ TEXT
|
||||||
PFPOS _ CURFILEBYTE#
|
PFPOS _ CURTEXTBYTE#
|
||||||
PLEN _ BYTELEN
|
PLEN _ BYTELEN
|
||||||
PBYTELEN _ BYTELEN
|
|
||||||
PPARALOOKS _ OLDPARALOOKS
|
PPARALOOKS _ OLDPARALOOKS
|
||||||
PTYPE _ THINFILE.PTYPE
|
PTYPE _ THINFILE.PTYPE
|
||||||
PCHARSET _ 0
|
|
||||||
PBYTESPERCHAR _ 1
|
PBYTESPERCHAR _ 1
|
||||||
PREVPIECE _ PREVPC))
|
PREVPIECE _ PREVPC))
|
||||||
(\TEDIT.GET.CHARLOOKS.INDEX PC TEXT) (* ;
|
(\TEDIT.GET.CHARLOOKS.INDEX PC TEXT) (* ;
|
||||||
"Get its looks and character-pointers")
|
"Get its looks and character-pointers")
|
||||||
(add CURFILEBYTE# BYTELEN))
|
(add CURTEXTBYTE# BYTELEN))
|
||||||
(\PieceDescriptorPARA (* ;
|
(\PieceDescriptorPARA (* ;
|
||||||
"Reading a new set of paragraph looks.")
|
"Reading a new set of paragraph looks.")
|
||||||
(CL:WHEN PREVPC (FSETPC PREVPC PPARALAST T))
|
(CL:WHEN PREVPC (FSETPC PREVPC PPARALAST T))
|
||||||
@@ -1010,14 +1009,13 @@
|
|||||||
(SETQ PC
|
(SETQ PC
|
||||||
(create PIECE
|
(create PIECE
|
||||||
PCONTENTS _ TEXT
|
PCONTENTS _ TEXT
|
||||||
PFPOS _ CURFILEBYTE#
|
PFPOS _ CURTEXTBYTE#
|
||||||
PBYTELEN _ BYTELEN
|
|
||||||
PLEN _ 1
|
PLEN _ 1
|
||||||
PPARALOOKS _ OLDPARALOOKS
|
PPARALOOKS _ OLDPARALOOKS
|
||||||
PTYPE _ OBJECT.PTYPE
|
PTYPE _ OBJECT.PTYPE
|
||||||
PREVPIECE _ PREVPC))
|
PREVPIECE _ PREVPC))
|
||||||
(\TEDIT.GET.OBJECT TSTREAM PC TEXT CURFILEBYTE#)
|
(\TEDIT.GET.OBJECT TSTREAM PC TEXT CURTEXTBYTE#)
|
||||||
(add CURFILEBYTE# BYTELEN)
|
(add CURTEXTBYTE# BYTELEN)
|
||||||
(FSETPC PC PCHARLOOKS (if (ZEROP (BIN TEXT))
|
(FSETPC PC PCHARLOOKS (if (ZEROP (BIN TEXT))
|
||||||
then
|
then
|
||||||
|
|
||||||
@@ -1142,7 +1140,9 @@
|
|||||||
PROPS)))])
|
PROPS)))])
|
||||||
|
|
||||||
(\TEDIT.MAKE.STRINGPIECE
|
(\TEDIT.MAKE.STRINGPIECE
|
||||||
[LAMBDA (PC STRING) (* ; "Edited 23-Jan-2024 14:32 by rmk")
|
[LAMBDA (PC STRING) (* ; "Edited 12-Apr-2026 21:30 by rmk")
|
||||||
|
(* ; "Edited 10-Apr-2026 09:33 by rmk")
|
||||||
|
(* ; "Edited 23-Jan-2024 14:32 by rmk")
|
||||||
(* ; "Edited 16-Jan-2024 11:15 by rmk")
|
(* ; "Edited 16-Jan-2024 11:15 by rmk")
|
||||||
(* ; "Edited 12-Jan-2024 16:34 by rmk")
|
(* ; "Edited 12-Jan-2024 16:34 by rmk")
|
||||||
|
|
||||||
@@ -1155,15 +1155,10 @@
|
|||||||
(SETQ SPIECE (if (fetch (STRINGP FATSTRINGP) of STRING)
|
(SETQ SPIECE (if (fetch (STRINGP FATSTRINGP) of STRING)
|
||||||
then (create PIECE using PC PTYPE _ FATSTRING.PTYPE PCONTENTS _ STRING PLEN
|
then (create PIECE using PC PTYPE _ FATSTRING.PTYPE PCONTENTS _ STRING PLEN
|
||||||
_ (NCHARS STRING)
|
_ (NCHARS STRING)
|
||||||
PBYTESPERCHAR _ 2 PBINABLE _ NIL PBYTELEN _
|
PBYTESPERCHAR _ 2 PREVPIECE _ PC)
|
||||||
(UNFOLD (NCHARS STRING)
|
|
||||||
2)
|
|
||||||
PREVPIECE _ PC PUTF8BYTESPERCHAR _ 2 PFPOS _ 0)
|
|
||||||
else (create PIECE using PC PTYPE _ THINSTRING.PTYPE PCONTENTS _ STRING PLEN
|
else (create PIECE using PC PTYPE _ THINSTRING.PTYPE PCONTENTS _ STRING PLEN
|
||||||
_ (NCHARS STRING)
|
_ (NCHARS STRING)
|
||||||
PBYTESPERCHAR _ 1 PBINABLE _ T PBYTELEN _
|
PBYTESPERCHAR _ 1 PREVPIECE _ PC)))
|
||||||
(NCHARS STRING)
|
|
||||||
PREVPIECE _ PC PUTF8BYTESPERCHAR _ 1 PFPOS _ 0)))
|
|
||||||
(CL:WHEN (NEXTPIECE PC)
|
(CL:WHEN (NEXTPIECE PC)
|
||||||
(FSETPC (NEXTPIECE PC)
|
(FSETPC (NEXTPIECE PC)
|
||||||
PREVPIECE SPIECE))
|
PREVPIECE SPIECE))
|
||||||
@@ -1173,111 +1168,114 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.GET.UNFORMATTED.FILE.MCCS
|
(\TEDIT.GET.UNFORMATTED.FILE.MCCS
|
||||||
[LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS) (* ; "Edited 28-Jul-2025 23:45 by rmk")
|
[LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS) (* ; "Edited 12-Apr-2026 21:34 by rmk")
|
||||||
(* ; "Edited 21-Jan-2024 09:40 by rmk")
|
(* ; "Edited 10-Apr-2026 09:33 by rmk")
|
||||||
(* ; "Edited 12-Jan-2024 13:13 by rmk")
|
|
||||||
(* ; "Edited 10-Jan-2024 11:19 by rmk")
|
|
||||||
(* ; "Edited 8-Jan-2024 13:15 by rmk")
|
|
||||||
|
|
||||||
(* ;; "We build a chain of pieces for the NS stringlets, some of which are divided at CR/LF. ")
|
(* ;;
|
||||||
|
"We build a chain of pieces for the MCCS stringlets, some of which are subdivided at CR/LF. ")
|
||||||
|
|
||||||
(* ;; "We assume that caller has positioned the stream at the intended start byte and has set the ENDOFSTREAMOP to return NIL on EOF. ")
|
(* ;; "We assume that caller has positioned the stream at the intended start byte and has set the ENDOFSTREAMOP to return NIL on EOF. ")
|
||||||
|
|
||||||
(* ;; "CRBEFORE and the LF test are used to ensure that potential EOL's are normalized to EOL and appear at the end of their pieces, whether or not they we decide to make them PPARALAST on input. LF's after CR are discarded, LF's by themselves are converted to singleton EOLstring pieces.")
|
(* ;; "This does not set PPARALAST on EOL pieces. Maybe double EOL's?")
|
||||||
|
|
||||||
(bind (NEXTFILEPOS _ START)
|
(* ;; "If a shift at the EOF is ill-formed, it is ignored--no error.")
|
||||||
(CHARSET _ 0)
|
|
||||||
(FIRSTPC _ (create PIECE
|
|
||||||
PCHARLOOKS _ DEFAULTCHARLOOKS
|
|
||||||
PPARALOOKS _ DEFAULTPARALOOKS))
|
|
||||||
(CODESIZE _ 1)
|
|
||||||
(SBINABLE _ (fetch (STREAM BINABLE) of STRM))
|
|
||||||
EOLC PC BYTE CHAR PREVPC PTYPE RUNLEN FILEPOS CRBEFORE SHIFTNEXT first (SETQ PREVPC FIRSTPC
|
|
||||||
)
|
|
||||||
(* ; "FIRSTPC is a throwaway")
|
|
||||||
do (SETQ FILEPOS NEXTFILEPOS) (* ; "Start of next file piece")
|
|
||||||
|
|
||||||
(* ;; "In thin or fat mode, we have to look at the first byte of the next character, to see if it is a shift. If not a shift, we have to decode the byte configuration to make sure we can detect CR or LF.")
|
(* ;;
|
||||||
|
" LF's after CR are discarded, LF's by themselves are converted to singleton EOLstring pieces.")
|
||||||
|
|
||||||
(do (CL:WHEN (IGEQ NEXTFILEPOS END)
|
(bind PREVPC PC CHAR TWOBYTE CHARLIST PLEN STARTPOS STRING (FIRSTPIECE _ (create PIECE))
|
||||||
(RETURN))
|
(CHARSET _ 0) first (SETQ PREVPC FIRSTPIECE)
|
||||||
(SETQ BYTE (\PEEKBIN STRM T))
|
do (SETQ PLEN 0)
|
||||||
(CL:WHEN (SETQ SHIFTNEXT (EQ NSCHARSETSHIFT BYTE))
|
(SETQ STARTPOS (GETFILEPTR STRM))
|
||||||
(SETQ CHAR NIL) (* ;
|
[while (SETQ CHAR (BIN STRM)) until (EQ CHAR NSCHARSETSHIFT)
|
||||||
"Suppress CR/LF checking on real shift")
|
do (CL:WHEN TWOBYTE
|
||||||
(RETURN))
|
(SETQ CHARSET (LLSH CHAR 8))
|
||||||
(BIN STRM) (* ; "Not a shift, read the peeked byte")
|
(CL:UNLESS (SETQ CHAR (BIN STRM)) (* ; "Ill-formed at EOF, skip last byte")
|
||||||
(SETQ CHAR (if (EQ CODESIZE 2)
|
(RETURN)))
|
||||||
then (* ;
|
(SETQ CHAR (LOGOR CHARSET CHAR))
|
||||||
"Return T if this takes us over the end")
|
(CL:UNLESS (OR TWOBYTE (EQ CHARSET 0)) (* ; "Collect characters for fatstring")
|
||||||
(LOGOR (LLSH BYTE 8)
|
(push CHARLIST CHAR))
|
||||||
(CL:IF (AND (ILEQ NEXTFILEPOS END)
|
(add PLEN 1) repeatuntil (MEMB CHAR (CHARCODE (CR LF]
|
||||||
(SETQ BYTE (BIN STRM)))
|
|
||||||
BYTE
|
|
||||||
(RETURN)))
|
|
||||||
else (LOGOR (LLSH CHARSET 8)
|
|
||||||
BYTE)))
|
|
||||||
(add NEXTFILEPOS CODESIZE)
|
|
||||||
(CL:WHEN (MEMB CHAR (CHARCODE (CR LF)))
|
|
||||||
(RETURN)))
|
|
||||||
|
|
||||||
(* ;; "NEXTFILEPOS and file are positioned at beginning of the next piece, possibly after CR and LF have been read.")
|
(* ;; "Reached the end of the current (sub) run")
|
||||||
|
|
||||||
(SETQ RUNLEN (IDIFFERENCE NEXTFILEPOS FILEPOS))
|
(CL:UNLESS (EQ PLEN 0) (* ; "Make subrun's piece")
|
||||||
(CL:WHEN (EQ CHAR (CHARCODE LF)) (* ; "We never produce raw LF's")
|
(SELCHARQ CHAR
|
||||||
(add RUNLEN (IMINUS CODESIZE)))
|
(CR (* ; "Skip following LF")
|
||||||
(CL:WHEN (IGREATERP RUNLEN 0)
|
(if TWOBYTE
|
||||||
(SETQ PTYPE (if (EQ CODESIZE 2)
|
then (CL:WHEN (EQ 0 (\PEEKCCODE STRM T))
|
||||||
then FATFILE2.PTYPE
|
(BIN STRM)
|
||||||
elseif (EQ CHARSET 0)
|
(CL:IF (EQ (CHARCODE LF)
|
||||||
then THINFILE.PTYPE
|
(\PEEKCCODE STRM T))
|
||||||
else FATFILE1.PTYPE))
|
(BIN STRM)
|
||||||
|
(\BACKFILEPTR STRM)))
|
||||||
|
elseif (EQ (CHARCODE LF)
|
||||||
|
(\PEEKCCODE STRM T))
|
||||||
|
then (BIN STRM)))
|
||||||
|
(LF (* ;
|
||||||
|
"Prefix bcomes a separate piece, LF a singleton coerced to EOL")
|
||||||
|
(if (EQ PLEN 1)
|
||||||
|
then (SETQ CHARLIST (CHARCODE (EOL)))
|
||||||
|
(* ; "Let it be fat below")
|
||||||
|
else (add PLEN -1) (* ;
|
||||||
|
"Back up to split the LF off into a separate EOL piece")
|
||||||
|
(\BACKFILEPTR STRM)
|
||||||
|
(CL:WHEN TWOBYTE (\BACKFILEPTR STRM))))
|
||||||
|
NIL)
|
||||||
(SETQ PC
|
(SETQ PC
|
||||||
(create PIECE
|
(if CHARLIST
|
||||||
PTYPE _ PTYPE
|
then (SETQ STRING (ALLOCSTRING (LENGTH CHARLIST)
|
||||||
PCONTENTS _ STRM
|
NIL NIL T))
|
||||||
PFPOS _ FILEPOS
|
(for C in CHARLIST as I from PLEN by -1 do (RPLCHARCODE STRING I C))
|
||||||
PLEN _ (IQUOTIENT RUNLEN CODESIZE)
|
(SETQ CHARLIST NIL)
|
||||||
PCHARLOOKS _ DEFAULTCHARLOOKS
|
(create PIECE
|
||||||
PPARALOOKS _ DEFAULTPARALOOKS
|
PTYPE _ FATSTRING.PTYPE
|
||||||
PCHARSET _ CHARSET
|
PCONTENTS _ STRING
|
||||||
PBYTESPERCHAR _ CODESIZE
|
PLEN _ PLEN
|
||||||
PBYTELEN _ RUNLEN
|
PBYTESPERCHAR _ 2)
|
||||||
PREVPIECE _ PREVPC
|
elseif TWOBYTE
|
||||||
PBINABLE _ (AND (EQ PTYPE THINFILE.PTYPE)
|
then (create PIECE
|
||||||
SBINABLE)))
|
PTYPE _ FATFILE2.PTYPE
|
||||||
(SETQ PREVPC (FSETPC PREVPC NEXTPIECE PC)))
|
PCONTENTS _ STRM
|
||||||
(CL:WHEN (EQ CHAR (CHARCODE LF))
|
PFPOS _ STARTPOS
|
||||||
[if CRBEFORE
|
PLEN _ PLEN
|
||||||
then (SETQ EOLC CRLF.EOLC)
|
PBYTESPERCHAR _ 2)
|
||||||
else
|
else (create PIECE
|
||||||
(* ;; "Linefeed not preceded by CR, replace by string piece")
|
PTYPE _ THINFILE.PTYPE
|
||||||
|
PCONTENTS _ STRM
|
||||||
|
PFPOS _ STARTPOS
|
||||||
|
PLEN _ PLEN
|
||||||
|
PBYTESPERCHAR _ 1)))
|
||||||
|
(FSETPC PC PCHARLOOKS DEFAULTCHARLOOKS)
|
||||||
|
(FSETPC PC PPARALOOKS DEFAULTPARALOOKS)
|
||||||
|
(FSETPC PC PREVPIECE PREVPC)
|
||||||
|
(FSETPC PREVPC NEXTPIECE PC)
|
||||||
|
(SETQ PREVPC PC))
|
||||||
|
|
||||||
(SETQ EOLC LF.EOLC)
|
(* ;; "Switch to next run, end, or continue with next subrun")
|
||||||
(SETQ PREVPC (\TEDIT.MAKE.STRINGPIECE PREVPC (CHARCODE EOL])
|
|
||||||
(CL:WHEN SHIFTNEXT (* ;
|
(SELECTC CHAR
|
||||||
"Interpret and bump NEXTFILEPOS for the shifting bytes. ")
|
(NSCHARSETSHIFT (* ; "Switch to next run")
|
||||||
(BIN STRM) (* ; "Read the original peeked byte")
|
(SETQ CHARSET (BIN STRM))
|
||||||
(SETQ CHARSET (BIN STRM))
|
(CL:UNLESS CHARSET (* ; "Ill-formed")
|
||||||
(if (EQ CHARSET \NORUNCODE)
|
(RETURN (NEXTPIECE FIRSTPIECE)))
|
||||||
then (CL:UNLESS (MEMB (BIN STRM)
|
(SETQ TWOBYTE (CL:WHEN (EQ CHARSET \NORUNCODE)
|
||||||
'(0 NIL))
|
(SETQ CHARSET (BIN STRM))
|
||||||
(ERROR "EXPECTED PLANE 0 XCCS CHARACTER IS ILL-FORMED"))
|
(CL:UNLESS CHARSET (* ; "Ill-formed")
|
||||||
(SETQ CHARSET 0)
|
(RETURN (NEXTPIECE FIRSTPIECE)))
|
||||||
(SETQ CODESIZE 2)
|
(CL:UNLESS (EQ CHARSET 0)
|
||||||
else (SETQ CODESIZE 1))
|
(\MCCS.24BITENCODING.ERROR STRM))
|
||||||
(add NEXTFILEPOS (ADD1 CODESIZE))
|
T))
|
||||||
(SETQ SHIFTNEXT NIL))
|
(SETQ CHARSET (LLSH CHARSET 8)))
|
||||||
(CL:WHEN (IGEQ NEXTFILEPOS END)
|
(NIL (* ; "End of file")
|
||||||
(CL:WHEN EOLC (* ;
|
(RETURN (NEXTPIECE FIRSTPIECE)))
|
||||||
"Record the last one we encountered")
|
NIL])
|
||||||
(replace (STREAM EOLCONVENTION) of STRM with EOLC))
|
|
||||||
(RETURN (NEXTPIECE FIRSTPC)))
|
|
||||||
(CL:WHEN (SETQ CRBEFORE (EQ CHAR (CHARCODE CR)))
|
|
||||||
(SETQ EOLC CR.EOLC])
|
|
||||||
|
|
||||||
(\TEDIT.INTERPRET.MCCS.SHIFTS
|
(\TEDIT.INTERPRET.MCCS.SHIFTS
|
||||||
[LAMBDA (PIECES PFILE) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
[LAMBDA (PIECES PFILE) (* ; "Edited 29-Apr-2026 23:48 by rmk")
|
||||||
|
(* ; "Edited 24-Apr-2026 21:08 by rmk")
|
||||||
|
(* ; "Edited 10-Apr-2026 09:33 by rmk")
|
||||||
|
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||||
(* ; "Edited 14-May-2024 18:39 by rmk")
|
(* ; "Edited 14-May-2024 18:39 by rmk")
|
||||||
(* ; "Edited 21-Jan-2024 00:02 by rmk")
|
(* ; "Edited 21-Jan-2024 00:02 by rmk")
|
||||||
(* ; "Edited 19-Jan-2024 10:34 by rmk")
|
(* ; "Edited 19-Jan-2024 10:34 by rmk")
|
||||||
@@ -1285,58 +1283,44 @@
|
|||||||
(* ; "Edited 6-Jan-2024 15:02 by rmk")
|
(* ; "Edited 6-Jan-2024 15:02 by rmk")
|
||||||
(* ; "Edited 19-Dec-2023 13:13 by rmk")
|
(* ; "Edited 19-Dec-2023 13:13 by rmk")
|
||||||
|
|
||||||
(* ;; "This is called after a GET or PUT, when the file pieces are known all to reside in PFILE.PIECES is a chain of pieces read from a formatted XCCS file but not yet inserted into the BTREE. Each file piece has PFILE, PFPOS, and PBYTELEN. This function interprets any XCCS shift characters that prefix the actual characters, coercing the piece properties and bumping the PFPOS/PLEN to hide the shifts. ")
|
(* ;; "This is called after by \TEDIT.GET.PIECES, after a GET, when the pieces are known all to reside in PFILE. PIECES is a chain of pieces read from a formatted MCCS (or XCCS) file but not yet inserted into the BTREE. Each file piece has PFILE and PFPOS. This function makes sure that no shift bytes are included in the pieces, by coercing the piece properties and bumping the PFPOS/PLEN to hide the shifts. This also coerces non-charset 0 one-byte pieces to fatstrings.")
|
||||||
|
|
||||||
(* ;; "We run this before the pieces are inistalled in a stream, since this may change the character lengths.")
|
(* ;; "We run this before the pieces are inistalled in a stream, since this may change the character lengths.")
|
||||||
|
|
||||||
|
(* ;; "This also has some EOL normalization.")
|
||||||
|
|
||||||
(for PC BYTE EOLC inpieces PIECES when (EQ PFILE (PCONTENTS PC))
|
(for PC BYTE EOLC inpieces PIECES when (EQ PFILE (PCONTENTS PC))
|
||||||
do (\SETFILEPTR PFILE (PFPOS PC))
|
do (\SETFILEPTR PFILE (PFPOS PC))
|
||||||
(SETQ BYTE (BIN PFILE))
|
(SETQ BYTE (BIN PFILE))
|
||||||
[if (EQ NSCHARSETSHIFT BYTE)
|
(if (EQ NSCHARSETSHIFT BYTE)
|
||||||
then (SELECTC (SETQ BYTE (BIN PFILE))
|
then (SELECTC (SETQ BYTE (BIN PFILE))
|
||||||
(0 (* ; "Runlength of charset 0")
|
(0 (add (PFPOS PC)
|
||||||
(add (PBYTELEN PC)
|
2)
|
||||||
-2) (* ;
|
(add (PLEN PC)
|
||||||
"The shift characters really disappear")
|
-2))
|
||||||
(FSETPC PC PLEN (PBYTELEN PC))
|
(\NORUNCODE (* ; "Going for 2 byte characters")
|
||||||
(FSETPC PC PTYPE THINFILE.PTYPE)
|
|
||||||
(FSETPC PC PBINABLE T)
|
|
||||||
(FSETPC PC PCHARSET 0)
|
|
||||||
(add (PFPOS PC)
|
|
||||||
2))
|
|
||||||
(\NORUNCODE (* ; "Going for 3 byte characters")
|
|
||||||
(CL:UNLESS (EQ 0 (BIN PFILE))
|
(CL:UNLESS (EQ 0 (BIN PFILE))
|
||||||
(\TEDIT.THELP "XCCS CHARACTER NOT IN PLANE 0"))
|
(\TEDIT.THELP "MCCS CHARACTER NOT IN PLANE 0, FILEPOS = "
|
||||||
|
(IDIFFERENCE (GETFILEPTR PFILE)
|
||||||
|
2)))
|
||||||
(FSETPC PC PTYPE FATFILE2.PTYPE)
|
(FSETPC PC PTYPE FATFILE2.PTYPE)
|
||||||
(FSETPC PC PBYTESPERCHAR 2)
|
|
||||||
(add (PFPOS PC)
|
(add (PFPOS PC)
|
||||||
3)
|
3)
|
||||||
(add (PBYTELEN PC)
|
(change (PLEN PC)
|
||||||
-3)
|
(FOLDLO (IDIFFERENCE DATUM 3)
|
||||||
(FSETPC PC PLEN (FOLDLO (PBYTELEN PC)
|
2)))
|
||||||
2)))
|
|
||||||
(PROGN
|
(PROGN
|
||||||
(* ;; "A run in a non-zero charset. Convert it to FATFILE1. Could also read into a FATSTRING instead, get rid of on-file FATFILE1. A string piece could hold adjacent substrings in different charsets")
|
(* ;; "A run in a non-zero charset. Convert it to FATSTRING so we don't have to maintain code to interpret XCCS stringlet pieces. After all, space efficiency is far worse for our ultimate goal of UTF-8 codes.")
|
||||||
|
|
||||||
(add (PBYTELEN PC)
|
(\TEDIT.RUN.TO.STRINGPIECE PC BYTE PFILE)))
|
||||||
-2)
|
elseif (EQ FATFILE2.PTYPE (PTYPE PC))
|
||||||
(add (PFPOS PC)
|
then (* ; "This is the continuation of an MCCS 2-byte run that was broken up presumably for looks or paragraphs")
|
||||||
2)
|
(change (PLEN PC)
|
||||||
(FSETPC PC PLEN (PBYTELEN PC))
|
(FOLDLO DATUM 2))
|
||||||
(FSETPC PC PBINABLE NIL)
|
else (FSETPC PC PBYTESPERCHAR 1) (* ; "A charset 0 1-byte run")
|
||||||
(FSETPC PC PTYPE FATFILE1.PTYPE)
|
[\SETFILEPTR PFILE (SUB1 (IPLUS (PFPOS PC)
|
||||||
(FSETPC PC PBYTESPERCHAR 1)
|
(PLEN PC] (* ;
|
||||||
(FSETPC PC PCHARSET BYTE)))
|
"Position for the last byte for EOL processing. Maybe only if PPARALAST ?")
|
||||||
elseif (EQ 2 (PBYTESPERCHAR PC))
|
|
||||||
then (FSETPC PC PTYPE FATFILE2.PTYPE) (* ; "This is the continuation of an XCCS 2-byte run that was broken up presumably for looks or paragraphs")
|
|
||||||
(FSETPC PC PCHARSET \NORUNCODE)
|
|
||||||
(FSETPC PC PLEN (FOLDLO (PBYTELEN PC)
|
|
||||||
2))
|
|
||||||
else (FSETPC PC PCHARSET 0) (* ; "A charset 0 1-byte run")
|
|
||||||
(FSETPC PC PBINABLE T)
|
|
||||||
(FSETPC PC PBYTESPERCHAR 1)
|
|
||||||
[\SETFILEPTR PFILE (IPLUS (PFPOS PC)
|
|
||||||
(SUB1 (PLEN PC]
|
|
||||||
(if (EQ (CHARCODE LF)
|
(if (EQ (CHARCODE LF)
|
||||||
(SETQ BYTE (BIN PFILE)))
|
(SETQ BYTE (BIN PFILE)))
|
||||||
then
|
then
|
||||||
@@ -1350,8 +1334,6 @@
|
|||||||
else (add (PLEN PC)
|
else (add (PLEN PC)
|
||||||
-1) (* ;
|
-1) (* ;
|
||||||
"Shorten PC, add EOL string piece unless preceded by CR")
|
"Shorten PC, add EOL string piece unless preceded by CR")
|
||||||
(add (PBYTELEN PC)
|
|
||||||
-1)
|
|
||||||
(if (EQ (CHARCODE CR)
|
(if (EQ (CHARCODE CR)
|
||||||
(\BACKBIN PFILE))
|
(\BACKBIN PFILE))
|
||||||
then (SETQ EOLC CRLF.EOLC)
|
then (SETQ EOLC CRLF.EOLC)
|
||||||
@@ -1360,10 +1342,9 @@
|
|||||||
(FSETPC PC PPARALAST NIL]
|
(FSETPC PC PPARALAST NIL]
|
||||||
else (CL:WHEN (EQ BYTE (CHARCODE CR))
|
else (CL:WHEN (EQ BYTE (CHARCODE CR))
|
||||||
(SETQ EOLC CR.EOLC))
|
(SETQ EOLC CR.EOLC))
|
||||||
(FSETPC PC PTYPE THINFILE.PTYPE)
|
(FSETPC PC PTYPE THINFILE.PTYPE)))
|
||||||
(FSETPC PC PLEN (PBYTELEN PC] finally (CL:WHEN EOLC
|
finally (CL:WHEN EOLC
|
||||||
(replace (STREAM EOLCONVENTION)
|
(replace (STREAM EOLCONVENTION) of PFILE with EOLC)))
|
||||||
of PFILE with EOLC)))
|
|
||||||
PIECES])
|
PIECES])
|
||||||
|
|
||||||
(\TEDIT.CONVERT.XCCSTOMCCS
|
(\TEDIT.CONVERT.XCCSTOMCCS
|
||||||
@@ -1379,16 +1360,30 @@
|
|||||||
TSTREAM CHNO)))
|
TSTREAM CHNO)))
|
||||||
unless (EQ CHAR (SETQ CHAR (MTOXCODE CHAR))) do (\TEDIT.RPLCHARCODE TSTREAM CHNO CHAR NIL
|
unless (EQ CHAR (SETQ CHAR (MTOXCODE CHAR))) do (\TEDIT.RPLCHARCODE TSTREAM CHNO CHAR NIL
|
||||||
T)))])
|
T)))])
|
||||||
|
|
||||||
|
(\TEDIT.RUN.TO.STRINGPIECE
|
||||||
|
[LAMBDA (PC CHARSET PFILE) (* ; "Edited 10-Apr-2026 09:20 by rmk")
|
||||||
|
(* ; "Edited 7-Apr-2026 18:16 by rmk")
|
||||||
|
(SETQ CHARSET (LLSH CHARSET 8))
|
||||||
|
(LET ((STRING (ALLOCSTRING (PLEN PC)
|
||||||
|
NIL NIL T)))
|
||||||
|
[for I from 1 to (PLEN PC) do (RPLCHARCODE STRING I (LOGOR CHARSET (BIN PFILE]
|
||||||
|
(FSETPC PC PTYPE FATSTRING.PTYPE)
|
||||||
|
(FSETPC PC PCONTENTS STRING)
|
||||||
|
(FSETPC PC PBYTESPERCHAR 2)
|
||||||
|
PC])
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* ; "XCCS")
|
(* ; "MCCS")
|
||||||
|
|
||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.GET.UNFORMATTED.FILE.UTF8
|
(\TEDIT.GET.UNFORMATTED.FILE.UTF8
|
||||||
[LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS) (* ; "Edited 23-Oct-2025 08:48 by rmk")
|
[LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS) (* ; "Edited 12-Apr-2026 21:46 by rmk")
|
||||||
|
(* ; "Edited 10-Apr-2026 09:24 by rmk")
|
||||||
|
(* ; "Edited 23-Oct-2025 08:48 by rmk")
|
||||||
(* ; "Edited 28-Jul-2025 23:45 by rmk")
|
(* ; "Edited 28-Jul-2025 23:45 by rmk")
|
||||||
(* ; "Edited 11-Mar-2024 23:55 by rmk")
|
(* ; "Edited 11-Mar-2024 23:55 by rmk")
|
||||||
(* ; "Edited 4-Feb-2024 10:12 by rmk")
|
(* ; "Edited 4-Feb-2024 10:12 by rmk")
|
||||||
@@ -1409,7 +1404,6 @@
|
|||||||
PCHARLOOKS _ DEFAULTCHARLOOKS
|
PCHARLOOKS _ DEFAULTCHARLOOKS
|
||||||
PPARALOOKS _ DEFAULTPARALOOKS))
|
PPARALOOKS _ DEFAULTPARALOOKS))
|
||||||
(NEXTCODESIZE _ 1)
|
(NEXTCODESIZE _ 1)
|
||||||
(SBINABLE _ (fetch (STREAM BINABLE) of STRM))
|
|
||||||
EOLC CHAR PREVPC PTYPE RUNLEN FILEPOS CRBEFORE CODESIZE PREVCRLF
|
EOLC CHAR PREVPC PTYPE RUNLEN FILEPOS CRBEFORE CODESIZE PREVCRLF
|
||||||
first (SELECTQ (READBOM STRM)
|
first (SELECTQ (READBOM STRM)
|
||||||
(:UTF-8 (add NEXTFILEPOS 3))
|
(:UTF-8 (add NEXTFILEPOS 3))
|
||||||
@@ -1457,21 +1451,16 @@
|
|||||||
(SETQ PTYPE (CL:IF (EQ CODESIZE 1)
|
(SETQ PTYPE (CL:IF (EQ CODESIZE 1)
|
||||||
THINFILE.PTYPE
|
THINFILE.PTYPE
|
||||||
UTF8.PTYPE))
|
UTF8.PTYPE))
|
||||||
(SETQ PREVPC
|
(SETQ PREVPC (FSETPC PREVPC NEXTPIECE
|
||||||
(FSETPC PREVPC NEXTPIECE
|
(create PIECE
|
||||||
(create PIECE
|
PTYPE _ PTYPE
|
||||||
PTYPE _ PTYPE
|
PCONTENTS _ STRM
|
||||||
PCONTENTS _ STRM
|
PFPOS _ FILEPOS
|
||||||
PFPOS _ FILEPOS
|
PLEN _ (IQUOTIENT RUNLEN CODESIZE)
|
||||||
PLEN _ (IQUOTIENT RUNLEN CODESIZE)
|
PCHARLOOKS _ DEFAULTCHARLOOKS
|
||||||
PCHARLOOKS _ DEFAULTCHARLOOKS
|
PPARALOOKS _ DEFAULTPARALOOKS
|
||||||
PPARALOOKS _ DEFAULTPARALOOKS
|
PBYTESPERCHAR _ CODESIZE
|
||||||
PBYTESPERCHAR _ CODESIZE
|
PREVPIECE _ PREVPC))))
|
||||||
PBYTELEN _ RUNLEN
|
|
||||||
PREVPIECE _ PREVPC
|
|
||||||
PBINABLE _ (AND (EQ PTYPE THINFILE.PTYPE)
|
|
||||||
SBINABLE)
|
|
||||||
PUTF8BYTESPERCHAR _ CODESIZE))))
|
|
||||||
(CL:WHEN (EQ CHAR (CHARCODE LF))
|
(CL:WHEN (EQ CHAR (CHARCODE LF))
|
||||||
[if CRBEFORE
|
[if CRBEFORE
|
||||||
then (SETQ EOLC CRLF.EOLC)
|
then (SETQ EOLC CRLF.EOLC)
|
||||||
@@ -1646,7 +1635,8 @@
|
|||||||
(\WIN STREAM])
|
(\WIN STREAM])
|
||||||
|
|
||||||
(\TEDIT.GET.CHARLOOKS.INDEX
|
(\TEDIT.GET.CHARLOOKS.INDEX
|
||||||
[LAMBDA (PC FORMATSTREAM) (* ; "Edited 28-Jul-2025 23:46 by rmk")
|
[LAMBDA (PC FORMATSTREAM) (* ; "Edited 24-Apr-2026 21:03 by rmk")
|
||||||
|
(* ; "Edited 28-Jul-2025 23:46 by rmk")
|
||||||
(* ; "Edited 14-Jan-2024 00:11 by rmk")
|
(* ; "Edited 14-Jan-2024 00:11 by rmk")
|
||||||
(* ; "Edited 19-Dec-2023 10:13 by rmk")
|
(* ; "Edited 19-Dec-2023 10:13 by rmk")
|
||||||
(* ; "Edited 3-Sep-2023 23:31 by rmk")
|
(* ; "Edited 3-Sep-2023 23:31 by rmk")
|
||||||
@@ -1654,18 +1644,18 @@
|
|||||||
(* ; "Edited 26-Aug-2023 23:22 by rmk")
|
(* ; "Edited 26-Aug-2023 23:22 by rmk")
|
||||||
(* ; "Edited 30-May-91 21:43 by jds")
|
(* ; "Edited 30-May-91 21:43 by jds")
|
||||||
|
|
||||||
(* ;; "Set the type, length, and and charlooks-index for the current piece, PC")
|
(* ;; "Set the type, length, and charlooks-index for the current piece, PC")
|
||||||
|
|
||||||
(LET ((FLAGS (BIN FORMATSTREAM)))
|
(LET ((FLAGS (BIN FORMATSTREAM)))
|
||||||
(FSETPC PC PCHARLOOKS (\WIN FORMATSTREAM))
|
(FSETPC PC PCHARLOOKS (\WIN FORMATSTREAM))
|
||||||
(CL:UNLESS (ZEROP (LOGAND FLAGS 1))
|
(CL:UNLESS (ZEROP (LOGAND FLAGS 1))
|
||||||
(FSETPC PC PNEW T))
|
(FSETPC PC PNEW T))
|
||||||
(CL:UNLESS (ZEROP (LOGAND FLAGS 2)) (* ;
|
(CL:UNLESS (ZEROP (LOGAND FLAGS 2))
|
||||||
"XCSS FAT. It may be a continuation of a previous fat piece")
|
|
||||||
(FSETPC PC PLEN (IQUOTIENT (FGETPC PC PLEN)
|
(* ;; "MCSS FAT. It may have a 255 255 0 (NSHIFTBYTES=3) prefix or it may be a continuation of a previous fat piece. PLEN on the file is the runlength including the NSHIFTBYTES, so we can't fold from bytes to chars here: \TEDIT.INTERPRET.MCCS.SHIFTS. Until then, this is goofy")
|
||||||
2))
|
|
||||||
(FSETPC PC PTYPE FATFILE2.PTYPE)
|
(FSETPC PC PBYTESPERCHAR 2)
|
||||||
(FSETPC PC PBYTESPERCHAR 2))])
|
(FSETPC PC PTYPE FATFILE2.PTYPE))])
|
||||||
)
|
)
|
||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
@@ -1773,7 +1763,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.GET.OBJECT
|
(\TEDIT.GET.OBJECT
|
||||||
[LAMBDA (TSTREAM PIECE FILE CURFILEBYTE# BYTELEN) (* ; "Edited 1-Aug-2025 14:50 by rmk")
|
[LAMBDA (TSTREAM PIECE FILE CURTEXTBYTE# BYTELEN) (* ; "Edited 15-Apr-2026 12:05 by rmk")
|
||||||
|
(* ; "Edited 1-Aug-2025 14:50 by rmk")
|
||||||
(* ; "Edited 28-Jul-2025 23:46 by rmk")
|
(* ; "Edited 28-Jul-2025 23:46 by rmk")
|
||||||
(* ; "Edited 31-Jul-2024 12:09 by rmk")
|
(* ; "Edited 31-Jul-2024 12:09 by rmk")
|
||||||
(* ; "Edited 5-Dec-2023 12:28 by rmk")
|
(* ; "Edited 5-Dec-2023 12:28 by rmk")
|
||||||
@@ -1794,13 +1785,13 @@
|
|||||||
|
|
||||||
(* ;; "rrb 10-AUG-87 --- calculate the length of the image object's data. This assumes that the file is currently pointed at the end of the data which is where the GETFN is written {I think}.")
|
(* ;; "rrb 10-AUG-87 --- calculate the length of the image object's data. This assumes that the file is currently pointed at the end of the data which is where the GETFN is written {I think}.")
|
||||||
|
|
||||||
(* ;; "RMK: Originally, BYTELEN was calculated here as (DIFFERENCE (GETFILEPTR FILE) CURFILEBYTE#). But this is garbage: (GETFILEPTR FILE) is in the looks section, CURFILEBYTE# is in the text section. The caller knows the true value, now passes it in. ")
|
(* ;; "RMK: Originally, BYTELEN was calculated here as (DIFFERENCE (GETFILEPTR FILE) CURTEXTBYTE#). But this is garbage: (GETFILEPTR FILE) is in the looks section, CURTEXTBYTE# is in the text section. The caller knows the true value, now passes it in. ")
|
||||||
|
|
||||||
(SETQ GETFN (\ATMIN FILE)) (* ;
|
(SETQ GETFN (\ATMIN FILE)) (* ;
|
||||||
"The GETFN for this kind of IMAGEOBJ")
|
"The GETFN for this kind of IMAGEOBJ")
|
||||||
(SETQ FILEPTRSAVE (GETFILEPTR FILE)) (* ;
|
(SETQ FILEPTRSAVE (GETFILEPTR FILE)) (* ;
|
||||||
"Save our file location thru the building of the object")
|
"Save our file location thru the building of the object")
|
||||||
(SETFILEPTR FILE CURFILEBYTE#)
|
(SETFILEPTR FILE CURTEXTBYTE#)
|
||||||
(SETQ OBJ (READIMAGEOBJ FILE GETFN NIL BYTELEN))
|
(SETQ OBJ (READIMAGEOBJ FILE GETFN NIL BYTELEN))
|
||||||
(CL:WHEN (IMAGEOBJPROP OBJ 'UNKNOWNGETFN) (* ;
|
(CL:WHEN (IMAGEOBJPROP OBJ 'UNKNOWNGETFN) (* ;
|
||||||
"If the object has an unknown getfn property, then it's an encapsulated object. Warn the user")
|
"If the object has an unknown getfn property, then it's an encapsulated object. Warn the user")
|
||||||
@@ -1832,6 +1823,9 @@
|
|||||||
|
|
||||||
(\TEDIT.PUT.PCTB
|
(\TEDIT.PUT.PCTB
|
||||||
[LAMBDA (TEXTOBJ CHARSTREAM FORMATSTREAM CONTINUE KEEPSEPARATE)
|
[LAMBDA (TEXTOBJ CHARSTREAM FORMATSTREAM CONTINUE KEEPSEPARATE)
|
||||||
|
(* ; "Edited 18-Apr-2026 14:56 by rmk")
|
||||||
|
(* ; "Edited 9-Apr-2026 23:19 by rmk")
|
||||||
|
(* ; "Edited 7-Apr-2026 12:31 by rmk")
|
||||||
(* ; "Edited 14-Feb-2026 10:32 by rmk")
|
(* ; "Edited 14-Feb-2026 10:32 by rmk")
|
||||||
(* ; "Edited 9-Sep-2025 21:32 by rmk")
|
(* ; "Edited 9-Sep-2025 21:32 by rmk")
|
||||||
(* ; "Edited 26-Apr-2025 00:11 by rmk")
|
(* ; "Edited 26-Apr-2025 00:11 by rmk")
|
||||||
@@ -1870,8 +1864,8 @@
|
|||||||
(CL:WHEN (EQ :UTF-8 (STREAMPROP CHARSTREAM 'FORMAT))
|
(CL:WHEN (EQ :UTF-8 (STREAMPROP CHARSTREAM 'FORMAT))
|
||||||
(\TEDIT.PUT.UTF8.SPLITPIECES TEXTOBJ))
|
(\TEDIT.PUT.UTF8.SPLITPIECES TEXTOBJ))
|
||||||
(for PC PFILE NEXTNEW RUNLEN UNFORMATTED? (NSHIFTBYTES _ 0)
|
(for PC PFILE NEXTNEW RUNLEN UNFORMATTED? (NSHIFTBYTES _ 0)
|
||||||
(CURBYTE# _ 0)
|
(CURTEXTBYTE# _ 0)
|
||||||
(OLDBYTE# _ 0)
|
(OLDTEXTBYTE# _ 0)
|
||||||
[UNFORMATTED? _ (PROG1 (EQ FORMATSTREAM T)
|
[UNFORMATTED? _ (PROG1 (EQ FORMATSTREAM T)
|
||||||
(CL:UNLESS (STREAMP FORMATSTREAM)
|
(CL:UNLESS (STREAMP FORMATSTREAM)
|
||||||
[SETQ FORMATSTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW
|
[SETQ FORMATSTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW
|
||||||
@@ -1906,8 +1900,8 @@
|
|||||||
|
|
||||||
(* ;; " We're ready to put the pieces on the output file. ")
|
(* ;; " We're ready to put the pieces on the output file. ")
|
||||||
|
|
||||||
(SETQ CURBYTE# (\GETFILEPTR CHARSTREAM))
|
(SETQ CURTEXTBYTE# (\GETFILEPTR CHARSTREAM))
|
||||||
(SETQ OLDBYTE# CURBYTE#)
|
(SETQ OLDTEXTBYTE# CURTEXTBYTE#)
|
||||||
|
|
||||||
(* ;; "ZEROP should never happen, but...")
|
(* ;; "ZEROP should never happen, but...")
|
||||||
|
|
||||||
@@ -1915,7 +1909,7 @@
|
|||||||
|
|
||||||
unless (ZEROP (PLEN PC))
|
unless (ZEROP (PLEN PC))
|
||||||
do
|
do
|
||||||
(* ;; "PC starts a run of one or more pieces that can be collapsed together into a single file piece. The paragraph looks are produced before the first piece of a new paragraph (first piece or previous piece was PPARALAST), then the piece(s)-characters, followed by the charlooks. I.e., FORMATSTREAM describes the paragraph-start piece with its paragraph looks forllowed by its char looks.")
|
(* ;; "PC starts a run of one or more pieces that can be collapsed together into a single file piece. The paragraph looks are produced before the first piece of a new paragraph (first piece or previous piece was PPARALAST), then the piece(s)-characters, followed by the charlooks. I.e., FORMATSTREAM describes the paragraph-start piece with its paragraph looks followed by its char looks.")
|
||||||
|
|
||||||
(CL:WHEN (OR (NULL (PREVPIECE PC))
|
(CL:WHEN (OR (NULL (PREVPIECE PC))
|
||||||
(PPARALAST (PREVPIECE PC)))
|
(PPARALAST (PREVPIECE PC)))
|
||||||
@@ -1923,15 +1917,15 @@
|
|||||||
(add PCCOUNT 1))
|
(add PCCOUNT 1))
|
||||||
(CL:WHEN (MEMB EXTFORMAT '(:MCCS :XCCS))
|
(CL:WHEN (MEMB EXTFORMAT '(:MCCS :XCCS))
|
||||||
|
|
||||||
(* ;; "For MCCS, CHARSET will put out the char-shifting prefix bytes as needed. In format-version 3 all the file bytes belong to a piece, no skipping in the file. TEDIT.GET calls \TEDIT.INTERPRET.XCCS.SHIFTS to shave those bytes. NSHIFTBYTES is used here if the edit will continue.")
|
(* ;; "For MCCS, CHARSET will put out the char-shifting prefix bytes as needed. In format-version 3 all the file bytes belong to a piece, no skipping in the file. TEDIT.GET calls \TEDIT.INTERPRET.MCCS.SHIFTS to shave those bytes. NSHIFTBYTES is used here so the edit can continue.")
|
||||||
|
|
||||||
(CHARSET CHARSTREAM (OR (AND (EQ EXTFORMAT :XCCS)
|
(CHARSET CHARSTREAM (CL:IF (MEMB (PTYPE PC)
|
||||||
(MEMB (PTYPE PC)
|
FAT.PTYPES)
|
||||||
FAT.PTYPES))
|
T
|
||||||
(PCHARSET PC)))
|
0))
|
||||||
(SETQ NSHIFTBYTES (IDIFFERENCE (\GETFILEPTR CHARSTREAM)
|
(SETQ NSHIFTBYTES (IDIFFERENCE (\GETFILEPTR CHARSTREAM)
|
||||||
OLDBYTE#)))
|
OLDTEXTBYTE#)))
|
||||||
(do (\TEDIT.PUT.PCTB.PIECEDATA PC CHARSTREAM TEXTOBJ FORMATSTREAM OLDBYTE#)
|
(do (\TEDIT.PUT.PCTB.PIECEDATA PC CHARSTREAM TEXTOBJ FORMATSTREAM OLDTEXTBYTE#)
|
||||||
(CL:UNLESS (\TEDIT.PUT.PCTB.MERGEABLE PC (NEXTPIECE PC)
|
(CL:UNLESS (\TEDIT.PUT.PCTB.MERGEABLE PC (NEXTPIECE PC)
|
||||||
EDITSTENTATIVE EXTFORMAT TEXTOBJ)
|
EDITSTENTATIVE EXTFORMAT TEXTOBJ)
|
||||||
(RETURN))
|
(RETURN))
|
||||||
@@ -1939,8 +1933,8 @@
|
|||||||
|
|
||||||
(* ;; "PC is the last piece written for a mergeable sequence. Finish off the corresponding file piece by writing PC's character looks into FORMATSTREAM. ")
|
(* ;; "PC is the last piece written for a mergeable sequence. Finish off the corresponding file piece by writing PC's character looks into FORMATSTREAM. ")
|
||||||
|
|
||||||
(SETQ CURBYTE# (\GETFILEPTR CHARSTREAM))
|
(SETQ CURTEXTBYTE# (\GETFILEPTR CHARSTREAM))
|
||||||
(SETQ RUNLEN (IDIFFERENCE CURBYTE# OLDBYTE#))
|
(SETQ RUNLEN (IDIFFERENCE CURTEXTBYTE# OLDTEXTBYTE#))
|
||||||
(CL:UNLESS (EQ OBJECT.PTYPE (PTYPE PC)) (* ;
|
(CL:UNLESS (EQ OBJECT.PTYPE (PTYPE PC)) (* ;
|
||||||
"Objects get their charlooks from the preceding piece.")
|
"Objects get their charlooks from the preceding piece.")
|
||||||
(\TEDIT.PUT.CHARLOOKS FORMATSTREAM RUNLEN PC EDITSTENTATIVE LOOKSHASH))
|
(\TEDIT.PUT.CHARLOOKS FORMATSTREAM RUNLEN PC EDITSTENTATIVE LOOKSHASH))
|
||||||
@@ -1952,28 +1946,30 @@
|
|||||||
|
|
||||||
(* ;; "Only for continued editing: make a new piece that describes those characters as they now reside on CHARSTREAM. ")
|
(* ;; "Only for continued editing: make a new piece that describes those characters as they now reside on CHARSTREAM. ")
|
||||||
|
|
||||||
(SETQ NEXTNEW (\TEDIT.PUT.PCTB.NEXTNEW NEXTNEW PC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ
|
(SETQ NEXTNEW (\TEDIT.PUT.PCTB.NEXTNEW NEXTNEW PC OLDTEXTBYTE# RUNLEN EXTFORMAT TEXTOBJ
|
||||||
EOLC NSHIFTBYTES)))
|
EOLC NSHIFTBYTES)))
|
||||||
(SETQ OLDBYTE# CURBYTE#) finally
|
(SETQ OLDTEXTBYTE# CURTEXTBYTE#) finally
|
||||||
|
|
||||||
(* ;; "Finalize and append FORMATSTREAM unless unformatted or KEEPSEPARATE (for splitting). If KEEPSEPARATE, the caller must have provided the formatstream")
|
(* ;; "Finalize and append FORMATSTREAM unless unformatted or KEEPSEPARATE (for splitting). If KEEPSEPARATE, the caller must have provided the formatstream")
|
||||||
|
|
||||||
(CL:UNLESS UNFORMATTED?
|
(CL:UNLESS UNFORMATTED?
|
||||||
(\TEDIT.PUT.TRAILER FORMATSTREAM (\GETFILEPTR CHARSTREAM
|
(\TEDIT.PUT.TRAILER FORMATSTREAM (\GETFILEPTR
|
||||||
)
|
CHARSTREAM)
|
||||||
PCCOUNT 3 (FGETTOBJ TEXTOBJ DOCPROPS)))
|
PCCOUNT 3 (FGETTOBJ TEXTOBJ DOCPROPS)))
|
||||||
(CL:UNLESS (OR UNFORMATTED? KEEPSEPARATE)
|
(CL:UNLESS (OR UNFORMATTED? KEEPSEPARATE)
|
||||||
(COPYBYTES FORMATSTREAM CHARSTREAM 0 (GETEOFPTR
|
(COPYBYTES FORMATSTREAM CHARSTREAM 0
|
||||||
FORMATSTREAM
|
(GETEOFPTR FORMATSTREAM)))
|
||||||
)))
|
(RETURN (CL:WHEN NEWPIECES
|
||||||
(RETURN (CL:WHEN NEWPIECES
|
|
||||||
|
|
||||||
(* ;; "Throw away the dummy head of the new piece chain (NEWPIECES is NIL if not continuing). The caller must make install the new pieces.")
|
(* ;; "Throw away the dummy head of the new piece chain (NEWPIECES is NIL if not continuing). The caller must install the new pieces.")
|
||||||
|
|
||||||
(NEXTPIECE NEWPIECES))])
|
(NEXTPIECE NEWPIECES))])
|
||||||
|
|
||||||
(\TEDIT.PUT.PCTB.PIECEDATA
|
(\TEDIT.PUT.PCTB.PIECEDATA
|
||||||
[LAMBDA (PC CHARSTREAM TEXTOBJ FORMATSTREAM OLDBYTE#) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
[LAMBDA (PC CHARSTREAM TEXTOBJ FORMATSTREAM OLDTEXTBYTE#) (* ; "Edited 18-Apr-2026 14:54 by rmk")
|
||||||
|
(* ; "Edited 9-Apr-2026 13:37 by rmk")
|
||||||
|
(* ; "Edited 7-Apr-2026 18:10 by rmk")
|
||||||
|
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||||
(* ; "Edited 15-May-2024 17:04 by rmk")
|
(* ; "Edited 15-May-2024 17:04 by rmk")
|
||||||
|
|
||||||
(* ;; "Write the data defining PC on CHARSTREAM.")
|
(* ;; "Write the data defining PC on CHARSTREAM.")
|
||||||
@@ -1982,7 +1978,7 @@
|
|||||||
|
|
||||||
(* ;; "FORMATSTREAM is needed for objects.")
|
(* ;; "FORMATSTREAM is needed for objects.")
|
||||||
|
|
||||||
(* ;; "OLDBYTE# needed to deal with XCCS shift before objects.")
|
(* ;; "OLDTEXTBYTE# needed to deal with XCCS shift before objects.")
|
||||||
|
|
||||||
(LET (PFILE)
|
(LET (PFILE)
|
||||||
(CL:WHEN (MEMB (PTYPE PC)
|
(CL:WHEN (MEMB (PTYPE PC)
|
||||||
@@ -2004,16 +2000,9 @@
|
|||||||
(for CH instring (PCONTENTS PC) do (\OUTCHAR CHARSTREAM CH)))
|
(for CH instring (PCONTENTS PC) do (\OUTCHAR CHARSTREAM CH)))
|
||||||
(FATFILE2.PTYPE
|
(FATFILE2.PTYPE
|
||||||
(for I from 1 to (PLEN PC) do (\OUTCHAR CHARSTREAM (\WIN PFILE))))
|
(for I from 1 to (PLEN PC) do (\OUTCHAR CHARSTREAM (\WIN PFILE))))
|
||||||
(FATFILE1.PTYPE
|
|
||||||
(* ;;
|
|
||||||
"We read but don't write FATFILE1 pieces, they merge with FATFILE2.")
|
|
||||||
|
|
||||||
[for I (CSET _ (LLSH (PCHARSET PC)
|
|
||||||
8)) from 1 to (PLEN PC)
|
|
||||||
do (\OUTCHAR CHARSTREAM (LOGOR CSET (BIN PFILE])
|
|
||||||
(UTF8.PTYPE (for I from 1 to (PLEN PC) do (\OUTCHAR CHARSTREAM (UTF8.INCCODEFN PFILE))))
|
(UTF8.PTYPE (for I from 1 to (PLEN PC) do (\OUTCHAR CHARSTREAM (UTF8.INCCODEFN PFILE))))
|
||||||
(OBJECT.PTYPE (* ; "It's an object, use its PUTFN.")
|
(OBJECT.PTYPE (* ; "It's an object, use its PUTFN.")
|
||||||
(\TEDIT.PUT.OBJECT PC CHARSTREAM FORMATSTREAM OLDBYTE#)
|
(\TEDIT.PUT.OBJECT PC CHARSTREAM FORMATSTREAM OLDTEXTBYTE#)
|
||||||
|
|
||||||
(* ;; "0 indicates that nothing special needs to be done here to recover the looks of this piece. \TEDIT.GET.PIECES3 says that the object-piece looks are taken from the previous piece (or default for first piece. In earlier versions the value 1 indicated that the looks were not indexed and therefore had to be written explicitly here. This byte won't be needed in the next version of the format.")
|
(* ;; "0 indicates that nothing special needs to be done here to recover the looks of this piece. \TEDIT.GET.PIECES3 says that the object-piece looks are taken from the previous piece (or default for first piece. In earlier versions the value 1 indicated that the looks were not indexed and therefore had to be written explicitly here. This byte won't be needed in the next version of the format.")
|
||||||
|
|
||||||
@@ -2041,7 +2030,9 @@
|
|||||||
(\WOUT FORMATSTREAM (IPLUS 31415 VERSION])
|
(\WOUT FORMATSTREAM (IPLUS 31415 VERSION])
|
||||||
|
|
||||||
(\TEDIT.PUT.PCTB.MERGEABLE
|
(\TEDIT.PUT.PCTB.MERGEABLE
|
||||||
[LAMBDA (PREVPC PC EDITSTENTATIVE EXTFORMAT TEXTOBJ) (* ; "Edited 1-Aug-2025 14:51 by rmk")
|
[LAMBDA (PREVPC PC EDITSTENTATIVE EXTFORMAT TEXTOBJ) (* ; "Edited 12-Apr-2026 21:44 by rmk")
|
||||||
|
(* ; "Edited 7-Apr-2026 18:07 by rmk")
|
||||||
|
(* ; "Edited 1-Aug-2025 14:51 by rmk")
|
||||||
(* ; "Edited 25-Apr-2025 23:50 by rmk")
|
(* ; "Edited 25-Apr-2025 23:50 by rmk")
|
||||||
(* ; "Edited 24-Apr-2025 16:02 by rmk")
|
(* ; "Edited 24-Apr-2025 16:02 by rmk")
|
||||||
(* ; "Edited 14-May-2024 11:55 by rmk")
|
(* ; "Edited 14-May-2024 11:55 by rmk")
|
||||||
@@ -2076,21 +2067,21 @@
|
|||||||
(THINPIECEP PC)))
|
(THINPIECEP PC)))
|
||||||
(:UTF-8
|
(:UTF-8
|
||||||
|
|
||||||
(* ;; "UTF8 pieces with the same bytesperchar are mergeable. We rely on \TEDIT.PUT.UTF8.SPLITPIECES to examine string pieces and split thin strings that include mixtures of Ascii and non-Ascii characters, and to split fat pieces that may contain Ascii character in 2-byte form. After splitting, all pieces with the same PUTF8BYTESPERCHAR can be merged.")
|
(* ;; "UTF8 pieces with the same bytesperchar are mergeable. We rely on \TEDIT.PUT.UTF8.SPLITPIECES to examine string pieces and split thin strings that include mixtures of Ascii and non-Ascii characters, and to split fat pieces that may contain Ascii character in 2-byte form. After splitting, all pieces with the same PBYTESPERCHAR can be merged.")
|
||||||
|
|
||||||
(EQ (FGETPC PREVPC PUTF8BYTESPERCHAR)
|
(EQ (FGETPC PREVPC PBYTESPERCHAR)
|
||||||
(FGETPC PC PUTF8BYTESPERCHAR)))
|
(FGETPC PC PBYTESPERCHAR)))
|
||||||
NIL)
|
NIL)
|
||||||
(OR (EQ PREVTYPE UTF8.PTYPE)
|
(OR (EQ PREVTYPE UTF8.PTYPE)
|
||||||
(AND (EQ PREVTYPE FATFILE1.PTYPE)
|
|
||||||
(NEQ 0 (PCHARSET PREVPC)))
|
|
||||||
[AND (EQ EXTFORMAT :UTF-8)
|
[AND (EQ EXTFORMAT :UTF-8)
|
||||||
(NOT (MEMB PREVTYPE (CONSTANT (LIST THINFILE.PTYPE THINSTRING.PTYPE]
|
(NOT (MEMB PREVTYPE (CONSTANT (LIST THINFILE.PTYPE THINSTRING.PTYPE]
|
||||||
(NOT (MEMB (\TEDIT.PIECE.NTHCHARCODE PREVPC (SUB1 (PLEN PREVPC)))
|
(NOT (MEMB (\TEDIT.PIECE.NTHCHARCODE PREVPC (SUB1 (PLEN PREVPC)))
|
||||||
(CHARCODE (EOL LF])])])
|
(CHARCODE (EOL LF])])])
|
||||||
|
|
||||||
(\TEDIT.PUT.UTF8.SPLITPIECES
|
(\TEDIT.PUT.UTF8.SPLITPIECES
|
||||||
[LAMBDA (TEXTOBJ) (* ; "Edited 19-Jan-2025 15:02 by rmk")
|
[LAMBDA (TEXTOBJ) (* ; "Edited 12-Apr-2026 21:49 by rmk")
|
||||||
|
(* ; "Edited 9-Apr-2026 00:05 by rmk")
|
||||||
|
(* ; "Edited 19-Jan-2025 15:02 by rmk")
|
||||||
(* ; "Edited 17-Mar-2024 00:14 by rmk")
|
(* ; "Edited 17-Mar-2024 00:14 by rmk")
|
||||||
(* ; "Edited 3-Feb-2024 14:52 by rmk")
|
(* ; "Edited 3-Feb-2024 14:52 by rmk")
|
||||||
(* ; "Edited 11-Jan-2024 23:29 by rmk")
|
(* ; "Edited 11-Jan-2024 23:29 by rmk")
|
||||||
@@ -2101,24 +2092,24 @@
|
|||||||
|
|
||||||
(for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
|
(for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
|
||||||
do (SELECTC (PTYPE PC)
|
do (SELECTC (PTYPE PC)
|
||||||
(UTF8.PTYPE (FSETPC PC PUTF8BYTESPERCHAR (PBYTESPERCHAR PC)))
|
(UTF8.PTYPE)
|
||||||
(STRING.PTYPES (for CH BPC instring (PCONTENTS PC) as I from 1
|
(STRING.PTYPES (for CH BPC instring (PCONTENTS PC) as I from 1
|
||||||
do
|
do
|
||||||
|
|
||||||
(* ;; "If BPC changes, split off and mark the prefix piece with the previous value, go back to the main loop to continue on the residual suffix piece.")
|
(* ;; "If BPC changes, split off and mark the prefix piece with the previous value, go back to the main loop to continue on the residual suffix piece.")
|
||||||
|
|
||||||
(if (EQ I 1)
|
(if (EQ I 1)
|
||||||
then (SETQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
|
then (SETQ BPC (NUTF8-CODE-BYTES (MTOUCODE CH)))
|
||||||
(FSETPC PC PUTF8BYTESPERCHAR BPC)
|
(FSETPC PC PBYTESPERCHAR BPC)
|
||||||
(* ;
|
(* ;
|
||||||
"The first character defines the piece")
|
"The first character defines the piece")
|
||||||
elseif (EQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
|
elseif (EQ BPC (NUTF8-CODE-BYTES (MTOUCODE CH)))
|
||||||
else (\TEDIT.SPLITPIECE PC (SUB1 I)
|
else (\TEDIT.SPLITPIECE PC (SUB1 I)
|
||||||
TEXTOBJ)
|
TEXTOBJ)
|
||||||
(SETQ PC (PREVPIECE PC))
|
(SETQ PC (PREVPIECE PC))
|
||||||
(* ;
|
(* ;
|
||||||
"Prefix piece always exists since I>1")
|
"Prefix piece always exists since I>1")
|
||||||
(FSETPC PC PUTF8BYTESPERCHAR BPC)
|
(FSETPC PC PBYTESPERCHAR BPC)
|
||||||
(* ;
|
(* ;
|
||||||
"Mark it, iteration continues on its next.")
|
"Mark it, iteration continues on its next.")
|
||||||
(RETURN))))
|
(RETURN))))
|
||||||
@@ -2128,30 +2119,26 @@
|
|||||||
(for I BPC (PFILE _ (PCONTENTS PC)) from 1 to (PLEN PC)
|
(for I BPC (PFILE _ (PCONTENTS PC)) from 1 to (PLEN PC)
|
||||||
first (\SETFILEPTR PFILE (PFPOS PC))
|
first (\SETFILEPTR PFILE (PFPOS PC))
|
||||||
do (if (EQ I 1)
|
do (if (EQ I 1)
|
||||||
then [SETQ BPC (NUTF8-CODE-BYTES (XTOUCODE (BIN PFILE]
|
then [SETQ BPC (NUTF8-CODE-BYTES (MTOUCODE (BIN PFILE]
|
||||||
(FSETPC PC PUTF8BYTESPERCHAR BPC)
|
(FSETPC PC PBYTESPERCHAR BPC)
|
||||||
elseif [EQ BPC (NUTF8-CODE-BYTES (XTOUCODE (BIN PFILE]
|
elseif [EQ BPC (NUTF8-CODE-BYTES (MTOUCODE (BIN PFILE]
|
||||||
else (\TEDIT.SPLITPIECE PC (SUB1 I)
|
else (\TEDIT.SPLITPIECE PC (SUB1 I)
|
||||||
TEXTOBJ)
|
TEXTOBJ)
|
||||||
(SETQ PC (PREVPIECE PC))
|
(SETQ PC (PREVPIECE PC))
|
||||||
(FSETPC PC PUTF8BYTESPERCHAR BPC)
|
(FSETPC PC PBYTESPERCHAR BPC)
|
||||||
(RETURN)))))
|
(RETURN)))))
|
||||||
((LIST FATFILE2.PTYPE FATFILE1.PTYPE) (* ; "XCCS pieces")
|
(FATFILE2.PTYPE (* ; "XCCS pieces")
|
||||||
(for I BPC CH (PFILE _ (PCONTENTS PC)) from 1 to (PLEN PC)
|
(for I BPC CH (PFILE _ (PCONTENTS PC)) from 1 to (PLEN PC)
|
||||||
first (\SETFILEPTR PFILE (PFPOS PC))
|
first (\SETFILEPTR PFILE (PFPOS PC))
|
||||||
do (SETQ CH (LOGOR (LLSH (CL:IF (EQ FATFILE2.PTYPE (PTYPE PC))
|
do (SETQ CH (\WIN PFILE))
|
||||||
(BIN PFILE)
|
|
||||||
(PCHARSET PC))
|
|
||||||
8)
|
|
||||||
(BIN PFILE)))
|
|
||||||
(if (EQ I 1)
|
(if (EQ I 1)
|
||||||
then (SETQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
|
then (SETQ BPC (NUTF8-CODE-BYTES (MTOUCODE CH)))
|
||||||
(FSETPC PC PUTF8BYTESPERCHAR BPC)
|
(FSETPC PC PBYTESPERCHAR BPC)
|
||||||
elseif (EQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
|
elseif (EQ BPC (NUTF8-CODE-BYTES (MTOUCODE CH)))
|
||||||
else (\TEDIT.SPLITPIECE PC (SUB1 I)
|
else (\TEDIT.SPLITPIECE PC (SUB1 I)
|
||||||
TEXTOBJ)
|
TEXTOBJ)
|
||||||
(SETQ PC (PREVPIECE PC))
|
(SETQ PC (PREVPIECE PC))
|
||||||
(FSETPC PC PUTF8BYTESPERCHAR BPC)
|
(FSETPC PC PBYTESPERCHAR BPC)
|
||||||
(RETURN))))
|
(RETURN))))
|
||||||
NIL])
|
NIL])
|
||||||
|
|
||||||
@@ -2183,6 +2170,11 @@
|
|||||||
|
|
||||||
(\TEDIT.PUT.PCTB.NEXTNEW
|
(\TEDIT.PUT.PCTB.NEXTNEW
|
||||||
[LAMBDA (NEXTNEW PC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ EOLC NSHIFTBYTES)
|
[LAMBDA (NEXTNEW PC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ EOLC NSHIFTBYTES)
|
||||||
|
(* ; "Edited 24-Apr-2026 20:45 by rmk")
|
||||||
|
(* ; "Edited 17-Apr-2026 23:55 by rmk")
|
||||||
|
(* ; "Edited 12-Apr-2026 21:47 by rmk")
|
||||||
|
(* ; "Edited 9-Apr-2026 13:20 by rmk")
|
||||||
|
(* ; "Edited 7-Apr-2026 18:12 by rmk")
|
||||||
(* ; "Edited 15-Feb-2026 15:09 by rmk")
|
(* ; "Edited 15-Feb-2026 15:09 by rmk")
|
||||||
(* ; "Edited 25-Apr-2025 08:48 by rmk")
|
(* ; "Edited 25-Apr-2025 08:48 by rmk")
|
||||||
(* ; "Edited 26-Mar-2025 09:27 by rmk")
|
(* ; "Edited 26-Mar-2025 09:27 by rmk")
|
||||||
@@ -2198,28 +2190,25 @@
|
|||||||
|
|
||||||
(* ;; "This updates the piece chain that is created for continued editing.")
|
(* ;; "This updates the piece chain that is created for continued editing.")
|
||||||
|
|
||||||
(* ;; "Note that the PCONTENTS (= PFILE) field for these file pieces isn't filled in, that has to be done after CHARSTREAM is closed and reopened at the TEDIT.PUT level. For the same reason, PBINABLE isn't set here.")
|
(* ;; "Note that the PCONTENTS (= PFILE) field for these file pieces isn't filled in, that has to be done after CHARSTREAM is closed and reopened at the TEDIT.PUT level. ")
|
||||||
|
|
||||||
(* ;; "NSHIFTBYTES strips any MCCS/XCCS charset shifts at the beginning of the new piece.")
|
(* ;; "NSHIFTBYTES ignores any MCCS/XCCS charset shifts at the beginning of the new piece.")
|
||||||
|
|
||||||
(SETQ RUNLEN (IDIFFERENCE RUNLEN NSHIFTBYTES))
|
(SETQ RUNLEN (IDIFFERENCE RUNLEN NSHIFTBYTES))
|
||||||
(FSETPC NEXTNEW NEXTPIECE (SETQ NEXTNEW (create PIECE
|
(FSETPC NEXTNEW NEXTPIECE (SETQ NEXTNEW (create PIECE
|
||||||
using PC PFPOS _ (IPLUS NSHIFTBYTES OLDBYTE#)
|
using PC PFPOS _ (IPLUS NSHIFTBYTES OLDBYTE#)
|
||||||
PBYTELEN _ RUNLEN PREVPIECE _ NEXTNEW PTREENODE
|
PLEN _ RUNLEN PREVPIECE _ NEXTNEW PTREENODE _
|
||||||
_ NIL)))
|
NIL)))
|
||||||
(SELECTQ EXTFORMAT
|
(SELECTQ EXTFORMAT
|
||||||
(:UTF-8 (FSETPC NEXTNEW PTYPE (CL:IF (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR))
|
(:UTF-8 (FSETPC NEXTNEW PTYPE (CL:IF (EQ 1 (FGETPC PC PBYTESPERCHAR))
|
||||||
THINFILE.PTYPE
|
THINFILE.PTYPE
|
||||||
UTF8.PTYPE))
|
UTF8.PTYPE)))
|
||||||
(FSETPC NEXTNEW PBYTESPERCHAR (FGETPC PC PUTF8BYTESPERCHAR)))
|
|
||||||
((:MCCS :XCCS) (* ;
|
((:MCCS :XCCS) (* ;
|
||||||
"String pieces can be merged with corresponding file pieces")
|
"String pieces can be merged with corresponding file pieces")
|
||||||
(FSETPC NEXTNEW PTYPE (SELECTC (PTYPE PC)
|
(FSETPC NEXTNEW PTYPE (SELECTC (PTYPE PC)
|
||||||
(THINSTRING.PTYPE
|
(THINSTRING.PTYPE
|
||||||
THINFILE.PTYPE)
|
THINFILE.PTYPE)
|
||||||
((LIST FATSTRING.PTYPE FATFILE1.PTYPE)
|
(FATSTRING.PTYPE
|
||||||
(* ;
|
|
||||||
"PCHARSET is not relevant for FILEFILE2")
|
|
||||||
(FSETPC NEXTNEW PBYTESPERCHAR 2)
|
(FSETPC NEXTNEW PBYTESPERCHAR 2)
|
||||||
FATFILE2.PTYPE)
|
FATFILE2.PTYPE)
|
||||||
(PTYPE PC))))
|
(PTYPE PC))))
|
||||||
@@ -2238,15 +2227,14 @@
|
|||||||
(FSETPC NEXTNEW PCONTENTS (ALLOCSTRING 1 (CHARCODE EOL)))
|
(FSETPC NEXTNEW PCONTENTS (ALLOCSTRING 1 (CHARCODE EOL)))
|
||||||
else (add (FGETPC NEXTNEW PLEN)
|
else (add (FGETPC NEXTNEW PLEN)
|
||||||
-1) (* ; "We know it's thin, maybe paralast")
|
-1) (* ; "We know it's thin, maybe paralast")
|
||||||
(add (FGETPC NEXTNEW PBYTELEN)
|
|
||||||
-1)
|
|
||||||
(SETQ NEXTNEW (\TEDIT.MAKE.STRINGPIECE NEXTNEW (CHARCODE EOL)))
|
(SETQ NEXTNEW (\TEDIT.MAKE.STRINGPIECE NEXTNEW (CHARCODE EOL)))
|
||||||
(FSETPC (PREVPIECE NEXTNEW)
|
(FSETPC (PREVPIECE NEXTNEW)
|
||||||
PPARALAST NIL))))
|
PPARALAST NIL))))
|
||||||
NEXTNEW])
|
NEXTNEW])
|
||||||
|
|
||||||
(\TEDIT.INSERT.NEWPIECES
|
(\TEDIT.INSERT.NEWPIECES
|
||||||
[LAMBDA (DESTSTREAM OLDSTREAM NEWPIECES) (* ; "Edited 14-May-2024 18:38 by rmk")
|
[LAMBDA (DESTSTREAM OLDSTREAM NEWPIECES) (* ; "Edited 10-Apr-2026 09:25 by rmk")
|
||||||
|
(* ; "Edited 14-May-2024 18:38 by rmk")
|
||||||
(* ; "Edited 29-Apr-2024 10:13 by rmk")
|
(* ; "Edited 29-Apr-2024 10:13 by rmk")
|
||||||
(* ; "Edited 20-Mar-2024 10:59 by rmk")
|
(* ; "Edited 20-Mar-2024 10:59 by rmk")
|
||||||
(* ; "Edited 17-Mar-2024 12:06 by rmk")
|
(* ; "Edited 17-Mar-2024 12:06 by rmk")
|
||||||
@@ -2265,13 +2253,8 @@
|
|||||||
(LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of OLDSTREAM)))
|
(LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of OLDSTREAM)))
|
||||||
FILEPTR)
|
FILEPTR)
|
||||||
(SETQ FILEPTR (\TEDIT.TEXTGETFILEPTR OLDSTREAM)) (* ; "Restore the editing parameters")
|
(SETQ FILEPTR (\TEDIT.TEXTGETFILEPTR OLDSTREAM)) (* ; "Restore the editing parameters")
|
||||||
(for PC (SBINABLE _ (fetch (STREAM BINABLE) of DESTSTREAM)) inpieces NEWPIECES
|
(for PC inpieces NEWPIECES when (MEMB (PTYPE PC)
|
||||||
when (MEMB (PTYPE PC)
|
FILE.PTYPES) do (FSETPC PC PCONTENTS DESTSTREAM))
|
||||||
FILE.PTYPES) do (FSETPC PC PCONTENTS DESTSTREAM)
|
|
||||||
(CL:WHEN (EQ THINFILE.PTYPE (PTYPE PC))
|
|
||||||
(* ;
|
|
||||||
"If the backing stream isn't binable, the thinfile pieces aren't either")
|
|
||||||
(FSETPC PC PBINABLE SBINABLE)))
|
|
||||||
(* ; "Non-object pieces are on OFILE")
|
(* ; "Non-object pieces are on OFILE")
|
||||||
|
|
||||||
(* ;; "Here, finally, we toss the out-of-date pieces to install the new ones. For complete safety, the rest should be uninterruptable (although the file has just been saved, so nothing would really be lost)")
|
(* ;; "Here, finally, we toss the out-of-date pieces to install the new ones. For complete safety, the rest should be uninterruptable (although the file has just been saved, so nothing would really be lost)")
|
||||||
@@ -2459,6 +2442,7 @@
|
|||||||
|
|
||||||
(\TEDIT.PUT.CHARLOOKS
|
(\TEDIT.PUT.CHARLOOKS
|
||||||
[LAMBDA (FORMATSTREAM BYTELEN PC EDITSTENTATIVE LOOKSHARRAY)
|
[LAMBDA (FORMATSTREAM BYTELEN PC EDITSTENTATIVE LOOKSHARRAY)
|
||||||
|
(* ; "Edited 9-Apr-2026 23:24 by rmk")
|
||||||
(* ; "Edited 1-Aug-2025 14:51 by rmk")
|
(* ; "Edited 1-Aug-2025 14:51 by rmk")
|
||||||
(* ; "Edited 14-May-2024 10:24 by rmk")
|
(* ; "Edited 14-May-2024 10:24 by rmk")
|
||||||
(* ; "Edited 13-Jan-2024 16:35 by rmk")
|
(* ; "Edited 13-Jan-2024 16:35 by rmk")
|
||||||
@@ -2471,7 +2455,7 @@
|
|||||||
(* ;; "Put a description of PC's charlooks into FORMATSTREAM. The looks apply to bytes OLDBYTE# thru CURBYTE#-1")
|
(* ;; "Put a description of PC's charlooks into FORMATSTREAM. The looks apply to bytes OLDBYTE# thru CURBYTE#-1")
|
||||||
|
|
||||||
(\DTEST PC 'PIECE)
|
(\DTEST PC 'PIECE)
|
||||||
(\TEDIT.PUT.CHARLOOKS1 FORMATSTREAM BYTELEN (GETHASH (PCHARALOOKS PC)
|
(\TEDIT.PUT.CHARLOOKS1 FORMATSTREAM BYTELEN (GETHASH (PCHARLOOKS PC)
|
||||||
LOOKSHARRAY)
|
LOOKSHARRAY)
|
||||||
(AND EDITSTENTATIVE PC (PNEW PC))
|
(AND EDITSTENTATIVE PC (PNEW PC))
|
||||||
(EQ FATFILE2.PTYPE (PTYPE PC])
|
(EQ FATFILE2.PTYPE (PTYPE PC])
|
||||||
@@ -2496,7 +2480,8 @@
|
|||||||
(\WOUT FORMATSTREAM CHARLOOKSINDEX])
|
(\WOUT FORMATSTREAM CHARLOOKSINDEX])
|
||||||
|
|
||||||
(\TEDIT.PUT.OBJECT
|
(\TEDIT.PUT.OBJECT
|
||||||
[LAMBDA (PIECE CHARSTREAM FORMATSTREAM CURFILEBYTE#) (* ; "Edited 14-May-2024 12:09 by rmk")
|
[LAMBDA (PIECE CHARSTREAM FORMATSTREAM CURTEXTBYTE#) (* ; "Edited 18-Apr-2026 14:52 by rmk")
|
||||||
|
(* ; "Edited 14-May-2024 12:09 by rmk")
|
||||||
(* ; "Edited 24-Jan-2024 23:35 by rmk")
|
(* ; "Edited 24-Jan-2024 23:35 by rmk")
|
||||||
(* ; "Edited 13-Jan-2024 12:20 by rmk")
|
(* ; "Edited 13-Jan-2024 12:20 by rmk")
|
||||||
(* ; "Edited 19-Dec-2023 10:14 by rmk")
|
(* ; "Edited 19-Dec-2023 10:14 by rmk")
|
||||||
@@ -2519,7 +2504,7 @@
|
|||||||
(APPLY* (IMAGEOBJPROP OBJECT 'PUTFN)
|
(APPLY* (IMAGEOBJPROP OBJECT 'PUTFN)
|
||||||
OBJECT CHARSTREAM)
|
OBJECT CHARSTREAM)
|
||||||
(SETQ BYTELEN (IDIFFERENCE (GETEOFPTR CHARSTREAM)
|
(SETQ BYTELEN (IDIFFERENCE (GETEOFPTR CHARSTREAM)
|
||||||
CURFILEBYTE#))
|
CURTEXTBYTE#))
|
||||||
(SETFILEPTR FORMATSTREAM ORIGFILEPTR) (* ;
|
(SETFILEPTR FORMATSTREAM ORIGFILEPTR) (* ;
|
||||||
"Now go back and fill in the length of the text description of the object.")
|
"Now go back and fill in the length of the text description of the object.")
|
||||||
(\DWOUT FORMATSTREAM BYTELEN)
|
(\DWOUT FORMATSTREAM BYTELEN)
|
||||||
@@ -2721,29 +2706,29 @@
|
|||||||
|
|
||||||
(RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE))
|
(RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE))
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (5423 35682 (TEDIT.GET 5433 . 11843) (TEDIT.FORMATTEDFILEP 11845 . 13161) (
|
(FILEMAP (NIL (5384 35643 (TEDIT.GET 5394 . 11804) (TEDIT.FORMATTEDFILEP 11806 . 13122) (
|
||||||
TEDIT.FILEDATE 13163 . 14472) (TEDIT.INCLUDE 14474 . 22503) (TEDIT.RAW.INCLUDE 22505 . 23313) (
|
TEDIT.FILEDATE 13124 . 14433) (TEDIT.INCLUDE 14435 . 22464) (TEDIT.RAW.INCLUDE 22466 . 23274) (
|
||||||
TEDIT.PUT 23315 . 31671) (TEDIT.PUT.STREAM 31673 . 35680)) (35683 56957 (\TEDIT.GET.FOREIGN.FILE 35693
|
TEDIT.PUT 23276 . 31632) (TEDIT.PUT.STREAM 31634 . 35641)) (35644 56951 (\TEDIT.GET.FOREIGN.FILE 35654
|
||||||
. 39118) (\TEDIT.GET.UNFORMATTED.FILE 39120 . 43426) (\TEDIT.GET.FORMATTED.FILE 43428 . 47071) (
|
. 39079) (\TEDIT.GET.UNFORMATTED.FILE 39081 . 43420) (\TEDIT.GET.FORMATTED.FILE 43422 . 47065) (
|
||||||
\TEDIT.FORMATTEDSTREAMP 47073 . 50204) (\ARBIN 50206 . 50926) (\ATMIN 50928 . 51465) (\DWIN 51467 .
|
\TEDIT.FORMATTEDSTREAMP 47067 . 50198) (\ARBIN 50200 . 50920) (\ATMIN 50922 . 51459) (\DWIN 51461 .
|
||||||
51846) (\STRINGIN 51848 . 52556) (\TEDIT.GET.TRAILER 52558 . 55426) (\TEDIT.CACHEFILE 55428 . 56955))
|
51840) (\STRINGIN 51842 . 52550) (\TEDIT.GET.TRAILER 52552 . 55420) (\TEDIT.CACHEFILE 55422 . 56949))
|
||||||
(57123 73161 (\TEDIT.GET.PIECES3 57133 . 68096) (\TEDIT.GET.PROPS3 68098 . 71320) (
|
(57117 73044 (\TEDIT.GET.PIECES3 57127 . 68176) (\TEDIT.GET.PROPS3 68178 . 71400) (
|
||||||
\TEDIT.MAKE.STRINGPIECE 71322 . 73159)) (73162 86588 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 73172 . 79405)
|
\TEDIT.MAKE.STRINGPIECE 71402 . 73042)) (73045 85841 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 73055 . 78706)
|
||||||
(\TEDIT.INTERPRET.MCCS.SHIFTS 79407 . 85652) (\TEDIT.CONVERT.XCCSTOMCCS 85654 . 86586)) (86610 92855 (
|
(\TEDIT.INTERPRET.MCCS.SHIFTS 78708 . 84304) (\TEDIT.CONVERT.XCCSTOMCCS 84306 . 85238) (
|
||||||
\TEDIT.GET.UNFORMATTED.FILE.UTF8 86620 . 92853)) (92878 104220 (\TEDIT.GET.CHARLOOKS.LIST 92888 .
|
\TEDIT.RUN.TO.STRINGPIECE 85240 . 85839)) (85863 92124 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 85873 . 92122
|
||||||
93619) (\TEDIT.GET.SINGLE.CHARLOOKS 93621 . 100693) (\TEDIT.GET.CHARLOOKS 100695 . 102251) (
|
)) (92147 103665 (\TEDIT.GET.CHARLOOKS.LIST 92157 . 92888) (\TEDIT.GET.SINGLE.CHARLOOKS 92890 . 99962)
|
||||||
\TEDIT.GET.PARALOOKS.INDEX 102253 . 102797) (\TEDIT.GET.CHARLOOKS.INDEX 102799 . 104218)) (104221
|
(\TEDIT.GET.CHARLOOKS 99964 . 101520) (\TEDIT.GET.PARALOOKS.INDEX 101522 . 102066) (
|
||||||
111878 (\TEDIT.GET.PARALOOKS.LIST 104231 . 104853) (\TEDIT.GET.SINGLE.PARALOOKS 104855 . 111876)) (
|
\TEDIT.GET.CHARLOOKS.INDEX 102068 . 103663)) (103666 111323 (\TEDIT.GET.PARALOOKS.LIST 103676 . 104298
|
||||||
111879 115712 (\TEDIT.GET.OBJECT 111889 . 115710)) (115777 150880 (\TEDIT.PUT.PCTB 115787 . 125844) (
|
) (\TEDIT.GET.SINGLE.PARALOOKS 104300 . 111321)) (111324 115266 (\TEDIT.GET.OBJECT 111334 . 115264)) (
|
||||||
\TEDIT.PUT.PCTB.PIECEDATA 125846 . 129044) (\TEDIT.PUT.TRAILER 129046 . 130374) (
|
115331 150489 (\TEDIT.PUT.PCTB 115341 . 125667) (\TEDIT.PUT.PCTB.PIECEDATA 125669 . 128826) (
|
||||||
\TEDIT.PUT.PCTB.MERGEABLE 130376 . 134149) (\TEDIT.PUT.UTF8.SPLITPIECES 134151 . 138853) (
|
\TEDIT.PUT.TRAILER 128828 . 130156) (\TEDIT.PUT.PCTB.MERGEABLE 130158 . 134019) (
|
||||||
\TEDIT.PUT.MCCS.SPLITPIECES 138855 . 140433) (\TEDIT.PUT.PCTB.NEXTNEW 140435 . 145041) (
|
\TEDIT.PUT.UTF8.SPLITPIECES 134021 . 138597) (\TEDIT.PUT.MCCS.SPLITPIECES 138599 . 140177) (
|
||||||
\TEDIT.INSERT.NEWPIECES 145043 . 148478) (\TEDIT.PUTRESET 148480 . 148722) (\ARBOUT 148724 . 149448) (
|
\TEDIT.PUT.PCTB.NEXTNEW 140179 . 144920) (\TEDIT.INSERT.NEWPIECES 144922 . 148087) (\TEDIT.PUTRESET
|
||||||
\ATMOUT 149450 . 150055) (\DWOUT 150057 . 150336) (\STRINGOUT 150338 . 150878)) (150881 163615 (
|
148089 . 148331) (\ARBOUT 148333 . 149057) (\ATMOUT 149059 . 149664) (\DWOUT 149666 . 149945) (
|
||||||
\TEDIT.PUT.CHARLOOKS.LIST 150891 . 152563) (\TEDIT.PUT.SINGLE.CHARLOOKS 152565 . 158845) (
|
\STRINGOUT 149947 . 150487)) (150490 163441 (\TEDIT.PUT.CHARLOOKS.LIST 150500 . 152172) (
|
||||||
\TEDIT.PUT.CHARLOOKS 158847 . 160186) (\TEDIT.PUT.CHARLOOKS1 160188 . 161239) (\TEDIT.PUT.OBJECT
|
\TEDIT.PUT.SINGLE.CHARLOOKS 152174 . 158454) (\TEDIT.PUT.CHARLOOKS 158456 . 159903) (
|
||||||
161241 . 163613)) (163616 171255 (\TEDIT.PUT.PARALOOKS.LIST 163626 . 164528) (
|
\TEDIT.PUT.CHARLOOKS1 159905 . 160956) (\TEDIT.PUT.OBJECT 160958 . 163439)) (163442 171081 (
|
||||||
\TEDIT.PUT.SINGLE.PARALOOKS 164530 . 170114) (\TEDIT.PUT.PARALOOKS 170116 . 171253)) (171350 174755 (
|
\TEDIT.PUT.PARALOOKS.LIST 163452 . 164354) (\TEDIT.PUT.SINGLE.PARALOOKS 164356 . 169940) (
|
||||||
TEDITFROMLISPSOURCE 171360 . 174004) (SHELLSCRIPTP 174006 . 174235) (TEDITFROMSHELLSCRIPT 174237 .
|
\TEDIT.PUT.PARALOOKS 169942 . 171079)) (171176 174581 (TEDITFROMLISPSOURCE 171186 . 173830) (
|
||||||
174753)))))
|
SHELLSCRIPTP 173832 . 174061) (TEDITFROMSHELLSCRIPT 174063 . 174579)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
183
library/tedit/TEDIT-FIXFILES
Normal file
183
library/tedit/TEDIT-FIXFILES
Normal file
@@ -0,0 +1,183 @@
|
|||||||
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
|
(FILECREATED "14-Dec-2024 16:53:27" {WMEDLEY}<library>TEDIT>TEDIT-FIXFILES.;14 9776
|
||||||
|
|
||||||
|
:EDIT-BY rmk
|
||||||
|
|
||||||
|
:CHANGES-TO (FNS CR-LF-FONTFIX)
|
||||||
|
(VARS TEDIT-FIXFILESCOMS)
|
||||||
|
(ADVICE ELT)
|
||||||
|
|
||||||
|
:PREVIOUS-DATE "12-Dec-2024 21:50:29" {WMEDLEY}<library>TEDIT>TEDIT-FIXFILES.;10)
|
||||||
|
|
||||||
|
|
||||||
|
(PRETTYCOMPRINT TEDIT-FIXFILESCOMS)
|
||||||
|
|
||||||
|
(RPAQQ TEDIT-FIXFILESCOMS (
|
||||||
|
(* ;; "Hacks that may help in fixing broken Tedit files")
|
||||||
|
|
||||||
|
(FILES TEDIT-DEBUG)
|
||||||
|
(FNS CRLFSWAP CHANGEPLEN)
|
||||||
|
(FNS CR-LF-FONTFIX)
|
||||||
|
(P (MOVD 'CR-LF-FONTFIX '\TEDIT.GET.SINGLE.CHARLOOKS))
|
||||||
|
(ADVISE ELT)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(* ;; "Hacks that may help in fixing broken Tedit files")
|
||||||
|
|
||||||
|
|
||||||
|
(FILESLOAD TEDIT-DEBUG)
|
||||||
|
(DEFINEQ
|
||||||
|
|
||||||
|
(CRLFSWAP
|
||||||
|
[LAMBDA (INFILE OUTFILE) (* ; "Edited 12-Dec-2024 08:25 by rmk")
|
||||||
|
(* ; "Edited 9-Dec-2024 13:33 by rmk")
|
||||||
|
(CL:WITH-OPEN-FILE (INSTREAM INFILE :DIRECTION :INPUT)
|
||||||
|
(CL:UNLESS OUTFILE
|
||||||
|
(SETQ OUTFILE (PACKFILENAME 'VERSION NIL 'NAME (CONCAT (FILENAMEFIELD INSTREAM
|
||||||
|
'NAME)
|
||||||
|
"-SWAPPED")
|
||||||
|
'BODY INSTREAM)))
|
||||||
|
(CL:WITH-OPEN-FILE (OUTSTREAM OUTFILE :DIRECTION :OUTPUT)
|
||||||
|
(for I B from 1 to (GETEOFPTR INSTREAM)
|
||||||
|
do (BOUT OUTSTREAM (SELCHARQ (SETQ B (BIN INSTREAM))
|
||||||
|
(LF (CHARCODE CR))
|
||||||
|
(CR (CHARCODE LF))
|
||||||
|
B)))
|
||||||
|
(FULLNAME OUTSTREAM])
|
||||||
|
|
||||||
|
(CHANGEPLEN
|
||||||
|
[LAMBDA (PC DELTA ARG) (* ; "Edited 11-Dec-2024 15:18 by rmk")
|
||||||
|
|
||||||
|
(* ;; "Change the length of piece PC by DELTA (negative = shorter).")
|
||||||
|
|
||||||
|
(LET [(PC (SP PC 1 NIL (GTO ARG]
|
||||||
|
(CL:WHEN (EQ 'Y (ASKUSER NIL NIL (CONCAT "Confirm changing PLEN by " DELTA " from "
|
||||||
|
(PLEN PC)
|
||||||
|
" to "
|
||||||
|
(IPLUS (PLEN PC)
|
||||||
|
DELTA)
|
||||||
|
" ? ")))
|
||||||
|
(FSETPC PC PLEN (IPLUS (PLEN PC)
|
||||||
|
DELTA))
|
||||||
|
(SP PC 1 NIL (GTO ARG)))])
|
||||||
|
)
|
||||||
|
(DEFINEQ
|
||||||
|
|
||||||
|
(CR-LF-FONTFIX
|
||||||
|
[LAMBDA (FILE TEXTOBJ) (* ; "Edited 14-Dec-2024 14:31 by rmk")
|
||||||
|
(* ; "Edited 12-Dec-2024 21:50 by rmk")
|
||||||
|
(SI::%%WITH-CHANGED-CALLS
|
||||||
|
((|TEXTPROP in INTERLISP::\TEDIT.GET.SINGLE.CHARLOOKS| . TEXTPROP))
|
||||||
|
(* ; "Edited 12-Dec-2024 20:51 by rmk")
|
||||||
|
(* ; "Edited 11-Dec-2024 17:11 by rmk")
|
||||||
|
(* ; "Edited 9-Dec-2024 20:11 by rmk")
|
||||||
|
(* ; "Edited 13-Aug-2024 08:49 by rmk")
|
||||||
|
(* ; "Edited 31-Jul-2024 00:04 by rmk")
|
||||||
|
(* ; "Edited 7-Apr-2024 17:21 by rmk")
|
||||||
|
(* ; "Edited 16-Jan-2024 22:46 by rmk")
|
||||||
|
(* ; "Edited 21-Dec-2023 23:54 by rmk")
|
||||||
|
(* ; "Edited 19-Dec-2023 10:13 by rmk")
|
||||||
|
(* ; "Edited 25-Nov-2023 23:21 by rmk")
|
||||||
|
(* ; "Edited 24-Aug-2023 15:05 by rmk")
|
||||||
|
(* ; "Edited 20-Feb-2022 12:42 by larry")
|
||||||
|
(* ; "Edited 30-May-91 20:25 by jds")
|
||||||
|
|
||||||
|
(* ;; "Read one CHARLOOKS from FILE. This gets and then sets the file pointer, based on the stored length. But that won't work if the file is not random access. Maybe that's not necessary?")
|
||||||
|
|
||||||
|
(* ;; "TEXTOBJ only for printing in the local promptwindow, if necessary.")
|
||||||
|
|
||||||
|
(PROG* ((LOOKS (create CHARLOOKS))
|
||||||
|
(FILEPOS (GETFILEPTR FILE))
|
||||||
|
(LOOKSLEN (\WIN FILE))
|
||||||
|
FONT NAME FACE SIZE SUPER PROPS STYLESTR)
|
||||||
|
(SETQ NAME (\ARBIN FILE)) (* ; "The font name")
|
||||||
|
(SETQ SIZE (\WIN FILE)) (* ; "Size of the type, in points")
|
||||||
|
(SETQ SUPER (\SMALLPIN FILE)) (* ;
|
||||||
|
"Superscripting distance, could be negative")
|
||||||
|
(FSETCLOOKS LOOKS CLSTYLE (OR (\ARBIN FILE)
|
||||||
|
0))
|
||||||
|
(FSETCLOOKS LOOKS CLUSERINFO (\ARBIN FILE))
|
||||||
|
(SETQ PROPS (\WIN FILE))
|
||||||
|
(with CHARLOOKS LOOKS [SETQ CLSELBEFORE (NOT (ZEROP (LOGAND 8192 PROPS]
|
||||||
|
[SETQ CLUNBREAKABLE (NOT (ZEROP (LOGAND 4096 PROPS]
|
||||||
|
[SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS]
|
||||||
|
[SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS]
|
||||||
|
[SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
|
||||||
|
[SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
|
||||||
|
[SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
|
||||||
|
[SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
|
||||||
|
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
|
||||||
|
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
|
||||||
|
[SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
|
||||||
|
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
|
||||||
|
[SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
|
||||||
|
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
|
||||||
|
(SETQ CLSIZE SIZE)
|
||||||
|
(SETQ CLOFFSET SUPER))
|
||||||
|
(SETQ FACE (PACK* (CL:IF (FGETCLOOKS LOOKS CLBOLD)
|
||||||
|
'B
|
||||||
|
'M)
|
||||||
|
(CL:IF (FGETCLOOKS LOOKS CLITAL)
|
||||||
|
'I
|
||||||
|
'R)
|
||||||
|
'R))
|
||||||
|
(if (LISTP NAME)
|
||||||
|
then (* ;
|
||||||
|
"This was a font class. Restore it.")
|
||||||
|
(SETQ FONT (FONTCLASS (pop NAME)
|
||||||
|
NAME))
|
||||||
|
elseif (OR (NOT NAME)
|
||||||
|
(ZEROP SIZE))
|
||||||
|
then
|
||||||
|
(* ;; "This was a test in the original, seems bogus")
|
||||||
|
|
||||||
|
elseif (SETQ FONT (FONTCREATE NAME SIZE FACE NIL NIL T))
|
||||||
|
elseif [AND (EQ SIZE 13)
|
||||||
|
(SETQ FONT (FONTCREATE NAME 10 FACE NIL NIL T))
|
||||||
|
(SELECTQ (STREAMPROP FILE 'COERCEFONT)
|
||||||
|
(YES T)
|
||||||
|
(NO NIL)
|
||||||
|
(SELECTQ [U-CASE (MKATOM (CL:IF TEXTOBJ
|
||||||
|
(TEDIT.GETINPUT TEXTOBJ
|
||||||
|
"Change font size 13 to 10 ? ")
|
||||||
|
(ASKUSER NIL NIL
|
||||||
|
"Change font size 13 to 10 ? "))]
|
||||||
|
((Y YES)
|
||||||
|
(STREAMPROP FILE 'COERCEFONT 'YES)
|
||||||
|
T)
|
||||||
|
(PROGN (STREAMPROP FILE 'COERCEFONT 'NO)
|
||||||
|
NIL]
|
||||||
|
then
|
||||||
|
(* ;; "A hack to deal with files that have CR-LF corruption")
|
||||||
|
|
||||||
|
(SETQ SIZE 10)
|
||||||
|
(FSETCLOOKS LOOKS CLSIZE 10)
|
||||||
|
else (SETQ FONT (FONTCREATE NAME SIZE FACE)))
|
||||||
|
(FSETCLOOKS LOOKS CLNAME (if (type? FONTCLASS FONT)
|
||||||
|
then
|
||||||
|
(* ;;
|
||||||
|
"Put the display family in the CLNAME spot. Better than NIL.")
|
||||||
|
|
||||||
|
(CL:WHEN [SETQ NAME (FONTCOPY FONT
|
||||||
|
'(DEVICE DISPLAY NOERROR T]
|
||||||
|
(FONTPROP NAME 'FAMILY))
|
||||||
|
else NAME))
|
||||||
|
(FSETCLOOKS LOOKS CLFONT FONT)
|
||||||
|
(SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN))
|
||||||
|
(RETURN LOOKS])
|
||||||
|
)
|
||||||
|
|
||||||
|
(MOVD 'CR-LF-FONTFIX '\TEDIT.GET.SINGLE.CHARLOOKS)
|
||||||
|
|
||||||
|
[XCL:REINSTALL-ADVICE 'ELT :BEFORE '((:LAST (CL:WHEN (AND (EQ N 13)
|
||||||
|
(ILESSP (ARRAYSIZE A)
|
||||||
|
13))
|
||||||
|
(SETQ N 10]
|
||||||
|
|
||||||
|
(READVISE ELT)
|
||||||
|
(DECLARE%: DONTCOPY
|
||||||
|
(FILEMAP (NIL (912 2760 (CRLFSWAP 922 . 1990) (CHANGEPLEN 1992 . 2758)) (2761 9403 (CR-LF-FONTFIX 2771
|
||||||
|
. 9401)))))
|
||||||
|
STOP
|
||||||
BIN
library/tedit/TEDIT-FIXFILES.LCOM
Normal file
BIN
library/tedit/TEDIT-FIXFILES.LCOM
Normal file
Binary file not shown.
@@ -1,14 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED " 1-Aug-2025 14:58:56"
|
(FILECREATED "19-Feb-2026 12:39:37" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;253 59143
|
||||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-HISTORY.;252 59126
|
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS \TEDIT.UNDO.CHARLOOKS)
|
:CHANGES-TO (FNS \TEDIT.UNDO1)
|
||||||
|
|
||||||
:PREVIOUS-DATE "28-Jul-2025 23:47:41"
|
:PREVIOUS-DATE " 1-Aug-2025 14:58:56" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;252)
|
||||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-HISTORY.;251)
|
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-HISTORYCOMS)
|
(PRETTYCOMPRINT TEDIT-HISTORYCOMS)
|
||||||
@@ -407,7 +405,8 @@
|
|||||||
(\TEDIT.SHOWSEL SEL T TSTREAM])
|
(\TEDIT.SHOWSEL SEL T TSTREAM])
|
||||||
|
|
||||||
(\TEDIT.UNDO1
|
(\TEDIT.UNDO1
|
||||||
[LAMBDA (TSTREAM EVENT) (* ; "Edited 6-Apr-2025 14:42 by rmk")
|
[LAMBDA (TSTREAM EVENT) (* ; "Edited 19-Feb-2026 12:39 by rmk")
|
||||||
|
(* ; "Edited 6-Apr-2025 14:42 by rmk")
|
||||||
(* ; "Edited 1-Apr-2025 21:22 by rmk")
|
(* ; "Edited 1-Apr-2025 21:22 by rmk")
|
||||||
(* ; "Edited 28-Mar-2025 14:22 by rmk")
|
(* ; "Edited 28-Mar-2025 14:22 by rmk")
|
||||||
(* ; "Edited 16-Mar-2025 18:46 by rmk")
|
(* ; "Edited 16-Mar-2025 18:46 by rmk")
|
||||||
@@ -457,7 +456,7 @@
|
|||||||
(COND
|
(COND
|
||||||
(UNDOFN
|
(UNDOFN
|
||||||
|
|
||||||
(* ;; "<EFBFBD>TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")
|
(* ;; "TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")
|
||||||
|
|
||||||
(APPLY* UNDOFN TSTREAM EVENT (GETTH EVENT THLEN)
|
(APPLY* UNDOFN TSTREAM EVENT (GETTH EVENT THLEN)
|
||||||
(GETTH EVENT THCH#)
|
(GETTH EVENT THCH#)
|
||||||
@@ -920,15 +919,15 @@
|
|||||||
(\TEDIT.THELP 'Redo-composite])
|
(\TEDIT.THELP 'Redo-composite])
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (5022 6043 (\TEDIT.HISTORYEVENT.DEFPRINT 5032 . 6041)) (7133 18387 (\TEDIT.HISTORYADD
|
(FILEMAP (NIL (4931 5952 (\TEDIT.HISTORYEVENT.DEFPRINT 4941 . 5950)) (7042 18296 (\TEDIT.HISTORYADD
|
||||||
7143 . 12405) (\TEDIT.HISTORYADD.COMPOSITE 12407 . 13439) (\TEDIT.CUMULATE.EVENTS 13441 . 15035) (
|
7052 . 12314) (\TEDIT.HISTORYADD.COMPOSITE 12316 . 13348) (\TEDIT.CUMULATE.EVENTS 13350 . 14944) (
|
||||||
\TEDIT.COMPOSITE.EVENT 15037 . 15773) (\TEDIT.HISTORY.PROP 15775 . 17138) (\TEDIT.HISTORY.EVENT 17140
|
\TEDIT.COMPOSITE.EVENT 14946 . 15682) (\TEDIT.HISTORY.PROP 15684 . 17047) (\TEDIT.HISTORY.EVENT 17049
|
||||||
. 18211) (\TEDIT.POPEVENT 18213 . 18385)) (18440 37427 (TEDIT.UNDO 18450 . 23326) (\TEDIT.UNDO1 23328
|
. 18120) (\TEDIT.POPEVENT 18122 . 18294)) (18349 37444 (TEDIT.UNDO 18359 . 23235) (\TEDIT.UNDO1 23237
|
||||||
. 27666) (TEDIT.REDO 27668 . 34581) (\TEDIT.UNDO.UNDO 34583 . 37425)) (37428 56129 (
|
. 27683) (TEDIT.REDO 27685 . 34598) (\TEDIT.UNDO.UNDO 34600 . 37442)) (37445 56146 (
|
||||||
\TEDIT.UNDO.INSERT 37438 . 38563) (\TEDIT.UNDO.DELETE 38565 . 39577) (\TEDIT.UNDO.MOVE 39579 . 41232)
|
\TEDIT.UNDO.INSERT 37455 . 38580) (\TEDIT.UNDO.DELETE 38582 . 39594) (\TEDIT.UNDO.MOVE 39596 . 41249)
|
||||||
(\TEDIT.UNDO.REPLACE 41234 . 42744) (\TEDIT.UNDO.CHARLOOKS 42746 . 48209) (\TEDIT.UNDO.PARALOOKS 48211
|
(\TEDIT.UNDO.REPLACE 41251 . 42761) (\TEDIT.UNDO.CHARLOOKS 42763 . 48226) (\TEDIT.UNDO.PARALOOKS 48228
|
||||||
. 52040) (\TEDIT.UNDO.PAGELOOKS 52042 . 52600) (\TEDIT.UNDO.COMPOSITE 52602 . 54202) (
|
. 52057) (\TEDIT.UNDO.PAGELOOKS 52059 . 52617) (\TEDIT.UNDO.COMPOSITE 52619 . 54219) (
|
||||||
\TEDIT.UNDO.REPLACECODE 54204 . 54538) (\TEDIT.UNDO.WRAP 54540 . 55469) (\TEDIT.UNDO.SEL 55471 . 56127
|
\TEDIT.UNDO.REPLACECODE 54221 . 54555) (\TEDIT.UNDO.WRAP 54557 . 55486) (\TEDIT.UNDO.SEL 55488 . 56144
|
||||||
)) (56130 59103 (\TEDIT.REDO.INSERT 56140 . 57102) (\TEDIT.REDO.REPLACE 57104 . 58710) (
|
)) (56147 59120 (\TEDIT.REDO.INSERT 56157 . 57119) (\TEDIT.REDO.REPLACE 57121 . 58727) (
|
||||||
\TEDIT.REDO.COMPOSITE 58712 . 59101)))))
|
\TEDIT.REDO.COMPOSITE 58729 . 59118)))))
|
||||||
STOP
|
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 "16-Feb-2026 00:36:00" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;467 155443
|
(FILECREATED "10-Apr-2026 09:34:11" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;469 155253
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS \TEDIT.MCCS.TRANSLATE)
|
:CHANGES-TO (FNS \TEDIT.MCCS.TRANSLATE)
|
||||||
|
|
||||||
:PREVIOUS-DATE "10-Feb-2026 11:07:12" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;465)
|
:PREVIOUS-DATE " 9-Apr-2026 17:25:54" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;468)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-LOOKSCOMS)
|
(PRETTYCOMPRINT TEDIT-LOOKSCOMS)
|
||||||
@@ -924,7 +924,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.MCCS.TRANSLATE
|
(\TEDIT.MCCS.TRANSLATE
|
||||||
[LAMBDA (TSTREAM) (* ; "Edited 16-Feb-2026 00:35 by rmk")
|
[LAMBDA (TSTREAM) (* ; "Edited 10-Apr-2026 09:34 by rmk")
|
||||||
|
(* ; "Edited 16-Feb-2026 00:35 by rmk")
|
||||||
(* ; "Edited 6-Oct-2025 20:50 by rmk")
|
(* ; "Edited 6-Oct-2025 20:50 by rmk")
|
||||||
(* ; "Edited 5-Oct-2025 10:57 by rmk")
|
(* ; "Edited 5-Oct-2025 10:57 by rmk")
|
||||||
(* ; "Edited 25-Sep-2025 21:30 by rmk")
|
(* ; "Edited 25-Sep-2025 21:30 by rmk")
|
||||||
@@ -972,14 +973,9 @@
|
|||||||
THINSTRING.PTYPE))
|
THINSTRING.PTYPE))
|
||||||
(FSETPC PC PCONTENTS STRING)
|
(FSETPC PC PCONTENTS STRING)
|
||||||
(FSETPC PC PFPOS NIL)
|
(FSETPC PC PFPOS NIL)
|
||||||
(FSETPC PC PBINABLE (NOT FAT))
|
|
||||||
(FSETPC PC PBYTESPERCHAR (CL:IF FAT
|
(FSETPC PC PBYTESPERCHAR (CL:IF FAT
|
||||||
2
|
2
|
||||||
1))
|
1))
|
||||||
(FSETPC PC PBYTELEN (CL:IF FAT
|
|
||||||
(UNFOLD (PLEN PC)
|
|
||||||
2)
|
|
||||||
(PLEN PC)))
|
|
||||||
(CL:UNLESS (EQ 'MCCS (fetch (FONTDESCRIPTOR FONTCHARENCODING) of CLFONT))
|
(CL:UNLESS (EQ 'MCCS (fetch (FONTDESCRIPTOR FONTCHARENCODING) of CLFONT))
|
||||||
|
|
||||||
(* ;;
|
(* ;;
|
||||||
@@ -2472,18 +2468,18 @@
|
|||||||
\TEDIT.UNPARSE.CHARLOOKS.LIST 40951 . 44445) (\TEDIT.MODIFYLOOKS 44447 . 46607) (TEDIT.NEW.FONT 46609
|
\TEDIT.UNPARSE.CHARLOOKS.LIST 40951 . 44445) (\TEDIT.MODIFYLOOKS 44447 . 46607) (TEDIT.NEW.FONT 46609
|
||||||
. 47056) (\TEDIT.CARETLOOKS.VERIFY 47058 . 47895) (\TEDIT.CARETPIECE 47897 . 48202) (
|
. 47056) (\TEDIT.CARETLOOKS.VERIFY 47058 . 47895) (\TEDIT.CARETPIECE 47897 . 48202) (
|
||||||
\TEDIT.GET.INSERT.CHARLOOKS 48204 . 51251) (\TEDIT.GET.TERMSA.WIDTHS 51253 . 51669) (
|
\TEDIT.GET.INSERT.CHARLOOKS 48204 . 51251) (\TEDIT.GET.TERMSA.WIDTHS 51253 . 51669) (
|
||||||
\TEDIT.PARSE.CHARLOOKS.LIST 51671 . 52871)) (52874 64879 (\TEDIT.MCCS.TRANSLATE 52884 . 58615) (
|
\TEDIT.PARSE.CHARLOOKS.LIST 51671 . 52871)) (52874 64689 (\TEDIT.MCCS.TRANSLATE 52884 . 58425) (
|
||||||
\TEDIT.CONVERT.TO.FORMATTED 58617 . 64877)) (65751 73088 (\TEDIT.UNIQUIFY.CHARLOOKS 65761 . 67421) (
|
\TEDIT.CONVERT.TO.FORMATTED 58427 . 64687)) (65561 72898 (\TEDIT.UNIQUIFY.CHARLOOKS 65571 . 67231) (
|
||||||
\TEDIT.UNIQUIFY.PARALOOKS 67423 . 68690) (\TEDIT.UNIQUIFY.ALL 68692 . 70780) (
|
\TEDIT.UNIQUIFY.PARALOOKS 67233 . 68500) (\TEDIT.UNIQUIFY.ALL 68502 . 70590) (
|
||||||
\TEDIT.FLUSH.UNUSED.LOOKS 70782 . 73086)) (73121 85079 (TEDIT.LOOKS 73131 . 75520) (TEDIT.GET.LOOKS
|
\TEDIT.FLUSH.UNUSED.LOOKS 70592 . 72896)) (72931 84889 (TEDIT.LOOKS 72941 . 75330) (TEDIT.GET.LOOKS
|
||||||
75522 . 77857) (TEDIT.SUBLOOKS 77859 . 82239) (TEDIT.FINDLOOKS 82241 . 85077)) (85080 114853 (
|
75332 . 77667) (TEDIT.SUBLOOKS 77669 . 82049) (TEDIT.FINDLOOKS 82051 . 84887)) (84890 114663 (
|
||||||
\TEDIT.CHANGE.CHARLOOKS 85090 . 93991) (\TEDIT.CHANGE.CHARLOOKS.NEW 93993 . 97808) (
|
\TEDIT.CHANGE.CHARLOOKS 84900 . 93801) (\TEDIT.CHANGE.CHARLOOKS.NEW 93803 . 97618) (
|
||||||
\TEDIT.CHARLOOKS.CHANGE.FONT 97810 . 106117) (\TEDIT.FONT.NEXTSIZE 106119 . 107740) (\TEDIT.LOOKS
|
\TEDIT.CHARLOOKS.CHANGE.FONT 97620 . 105927) (\TEDIT.FONT.NEXTSIZE 105929 . 107550) (\TEDIT.LOOKS
|
||||||
107742 . 111071) (\TEDIT.FONTCOPY 111073 . 112574) (\TEDIT.COERCE.FONTCLASS 112576 . 113727) (
|
107552 . 110881) (\TEDIT.FONTCOPY 110883 . 112384) (\TEDIT.COERCE.FONTCLASS 112386 . 113537) (
|
||||||
\TEDIT.FONTCLASS.TO.FONT 113729 . 114851)) (114896 146785 (\TEDIT.EQFMTSPEC 114906 . 118121) (
|
\TEDIT.FONTCLASS.TO.FONT 113539 . 114661)) (114706 146595 (\TEDIT.EQFMTSPEC 114716 . 117931) (
|
||||||
TEDIT.GET.PARALOOKS 118123 . 122170) (\TEDIT.PARSE.PARALOOKS.LIST 122172 . 130205) (TEDIT.PARALOOKS
|
TEDIT.GET.PARALOOKS 117933 . 121980) (\TEDIT.PARSE.PARALOOKS.LIST 121982 . 130015) (TEDIT.PARALOOKS
|
||||||
130207 . 131247) (\TEDIT.CHANGE.PARALOOKS 131249 . 138458) (\TEDIT.CHANGE.PARALOOKS.NEW 138460 .
|
130017 . 131057) (\TEDIT.CHANGE.PARALOOKS 131059 . 138268) (\TEDIT.CHANGE.PARALOOKS.NEW 138270 .
|
||||||
142443) (TEDIT.COPY.PARALOOKS 142445 . 145119) (\TEDIT.PARABOUNDS 145121 . 146783)) (146845 154561 (
|
142253) (TEDIT.COPY.PARALOOKS 142255 . 144929) (\TEDIT.PARABOUNDS 144931 . 146593)) (146655 154371 (
|
||||||
TEDIT.SUBPARALOOKS 146855 . 150957) (SAMEPARALOOKS 150959 . 154559)) (154562 155249 (
|
TEDIT.SUBPARALOOKS 146665 . 150767) (SAMEPARALOOKS 150769 . 154369)) (154372 155059 (
|
||||||
\TEDIT.MARK.REVISION 154572 . 155247)))))
|
\TEDIT.MARK.REVISION 154382 . 155057)))))
|
||||||
STOP
|
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 " 9-Feb-2026 09:10:43" {WMEDLEY}<library>tedit>TEDIT-MENU.;510 183027
|
(FILECREATED "29-Apr-2026 15:35:33" {MEDLEY}<library>TEDIT>TEDIT-MENU.;512 183159
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS \TEDIT.PAGEMENU.CREATE)
|
:CHANGES-TO (FNS \TEDIT.SHOW.PAGELOOKS)
|
||||||
|
|
||||||
:PREVIOUS-DATE "27-Jan-2026 10:42:09" {WMEDLEY}<library>tedit>TEDIT-MENU.;508)
|
:PREVIOUS-DATE " 9-Feb-2026 09:10:43" {MEDLEY}<library>TEDIT>TEDIT-MENU.;510)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-MENUCOMS)
|
(PRETTYCOMPRINT TEDIT-MENUCOMS)
|
||||||
@@ -2525,7 +2525,8 @@
|
|||||||
'PAGE))])
|
'PAGE))])
|
||||||
|
|
||||||
(\TEDIT.SHOW.PAGELOOKS
|
(\TEDIT.SHOW.PAGELOOKS
|
||||||
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM) (* ; "Edited 20-Apr-2025 23:41 by rmk")
|
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM) (* ; "Edited 29-Apr-2026 15:35 by rmk")
|
||||||
|
(* ; "Edited 20-Apr-2025 23:41 by rmk")
|
||||||
(* ; "Edited 22-Oct-2024 11:04 by rmk")
|
(* ; "Edited 22-Oct-2024 11:04 by rmk")
|
||||||
(* ; "Edited 20-Oct-2024 17:32 by rmk")
|
(* ; "Edited 20-Oct-2024 17:32 by rmk")
|
||||||
(* ; "Edited 29-Sep-2024 15:10 by rmk")
|
(* ; "Edited 29-Sep-2024 15:10 by rmk")
|
||||||
@@ -2538,19 +2539,18 @@
|
|||||||
|
|
||||||
(* ;; "OBJ is unused, presumably to have a standard interface with other menu functions that update image objects.")
|
(* ;; "OBJ is unused, presumably to have a standard interface with other menu functions that update image objects.")
|
||||||
|
|
||||||
(PROG [(PAGEID (MB.GET 'PAGEID MENUSTREAM 'STATE]
|
(LET [(PAGEID (MB.GET 'PAGEID MENUSTREAM 'STATE]
|
||||||
(CL:WHEN (MEMB PAGEID '(NIL OFF))
|
(if (MEMB PAGEID '(NIL OFF))
|
||||||
(TEDIT.PROMPTPRINT MENUWINDOW "Please specify the page-type" T T)
|
then (TEDIT.PROMPTPRINT MENUWINDOW "Please specify the page-type" T T)
|
||||||
(RETURN))
|
else (RESETLST
|
||||||
(RESETLST
|
(TEDIT.DEFER.UPDATES MENUSTREAM)
|
||||||
(TEDIT.DEFER.UPDATES MENUSTREAM)
|
(\TEDIT.PAGEMENU.FILLIN MENUSTREAM (\TEDIT.PAGEREGION.UNPARSE (\TEDIT.MAINSTREAM
|
||||||
(\TEDIT.PAGEMENU.FILLIN MENUSTREAM (\TEDIT.PAGEREGION.UNPARSE (\TEDIT.MAINSTREAM
|
|
||||||
MENUSTREAM)
|
MENUSTREAM)
|
||||||
PAGEID)))
|
PAGEID)))
|
||||||
(FSETSEL MENUSEL ONFLG T)
|
(FSETSEL MENUSEL ONFLG T)
|
||||||
(\TEDIT.UPDATE.SEL MENUSEL 1 0 'LEFT)
|
(\TEDIT.UPDATE.SEL MENUSEL 1 0 'LEFT)
|
||||||
(\TEDIT.FIXSEL MENUSEL MENUSTREAM)
|
(\TEDIT.FIXSEL MENUSEL MENUSTREAM))
|
||||||
(TEDIT.BACKTOMAIN MENUSTREAM])
|
(TEDIT.BACKTOMAIN MENUSTREAM])
|
||||||
|
|
||||||
(\TEDIT.PAGEMENU.FILLIN
|
(\TEDIT.PAGEMENU.FILLIN
|
||||||
[LAMBDA (MENUSTREAM PAGELOOKS) (* ; "Edited 29-Sep-2024 12:53 by rmk")
|
[LAMBDA (MENUSTREAM PAGELOOKS) (* ; "Edited 29-Sep-2024 12:53 by rmk")
|
||||||
@@ -2899,32 +2899,32 @@
|
|||||||
(ADDTOVAR LAMA )
|
(ADDTOVAR LAMA )
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (4936 16574 (TEDIT.ADD.MENUITEM 4946 . 7063) (TEDIT.DEFAULT.MENUFN 7065 . 13786) (
|
(FILEMAP (NIL (4933 16571 (TEDIT.ADD.MENUITEM 4943 . 7060) (TEDIT.DEFAULT.MENUFN 7062 . 13783) (
|
||||||
TEDIT.REMOVE.MENUITEM 13788 . 14785) (\TEDIT.CREATEMENU 14787 . 15352) (\TEDIT.MENU.WHENHELDFN 15354
|
TEDIT.REMOVE.MENUITEM 13785 . 14782) (\TEDIT.CREATEMENU 14784 . 15349) (\TEDIT.MENU.WHENHELDFN 15351
|
||||||
. 16259) (\TEDIT.MENU.WHENSELECTEDFN 16261 . 16572)) (17388 65423 (DRAWMARGINSCALE 17398 . 20857) (
|
. 16256) (\TEDIT.MENU.WHENSELECTEDFN 16258 . 16569)) (17385 65420 (DRAWMARGINSCALE 17395 . 20854) (
|
||||||
MARGINBAR 20859 . 27984) (MARGINBAR.CREATE 27986 . 32184) (MB.MARGINBAR.BUTTONEVENTINFN 32186 . 39988)
|
MARGINBAR 20856 . 27981) (MARGINBAR.CREATE 27983 . 32181) (MB.MARGINBAR.BUTTONEVENTINFN 32183 . 39985)
|
||||||
(MB.MARGINBAR.SELFN.TABS 39990 . 45230) (MB.MARGINBAR.SELFN.TABS.KIND 45232 . 46167) (
|
(MB.MARGINBAR.SELFN.TABS 39987 . 45227) (MB.MARGINBAR.SELFN.TABS.KIND 45229 . 46164) (
|
||||||
MARGINBAR.GETSTATEFN 46169 . 50156) (MARGINBAR.SETSTATEFN 50158 . 50368) (MARGINBAR.NEUTRALIZE 50370
|
MARGINBAR.GETSTATEFN 46166 . 50153) (MARGINBAR.SETSTATEFN 50155 . 50365) (MARGINBAR.NEUTRALIZE 50367
|
||||||
. 51045) (MARGINBAR.LOOKS 51047 . 54153) (MB.MARGINBAR.SIZEFN 54155 . 54941) (MB.MARGINBAR.DISPLAYFN
|
. 51042) (MARGINBAR.LOOKS 51044 . 54150) (MB.MARGINBAR.SIZEFN 54152 . 54938) (MB.MARGINBAR.DISPLAYFN
|
||||||
54943 . 58004) (MDESCALE 58006 . 58546) (MSCALE 58548 . 58878) (MB.MARGINBAR.SHOWTAB 58880 . 61203) (
|
54940 . 58001) (MDESCALE 58003 . 58543) (MSCALE 58545 . 58875) (MB.MARGINBAR.SHOWTAB 58877 . 61200) (
|
||||||
MB.MARGINBAR.TABTRACK 61205 . 62590) (MARGINBAR.INIT 62592 . 63985) (\TEDIT.PARALOOKS.TO.MARBAR 63987
|
MB.MARGINBAR.TABTRACK 61202 . 62587) (MARGINBAR.INIT 62589 . 63982) (\TEDIT.PARALOOKS.TO.MARBAR 63984
|
||||||
. 65421)) (66248 73530 (TEDIT.MENUSTREAM 66258 . 67258) (TEDITMENUP 67260 . 68229) (\TEDIT.MENU.START
|
. 65418)) (66245 73527 (TEDIT.MENUSTREAM 66255 . 67255) (TEDITMENUP 67257 . 68226) (\TEDIT.MENU.START
|
||||||
68231 . 72578) (\TEDIT.MENU.OPEN? 72580 . 72954) (\TEDIT.MENU.BUTTONEVENTFN 72956 . 73528)) (73849
|
68228 . 72575) (\TEDIT.MENU.OPEN? 72577 . 72951) (\TEDIT.MENU.BUTTONEVENTFN 72953 . 73525)) (73846
|
||||||
81900 (\TEDIT.MENU.CREATE 73859 . 75799) (\TEDIT.MENU.PARSE 75801 . 79490) (\TEDIT.MENU.NEUTRALIZE
|
81897 (\TEDIT.MENU.CREATE 73856 . 75796) (\TEDIT.MENU.PARSE 75798 . 79487) (\TEDIT.MENU.NEUTRALIZE
|
||||||
79492 . 81563) (\TEDITMENU.RECORD.UNFORMATTED 81565 . 81898)) (81966 101368 (
|
79489 . 81560) (\TEDITMENU.RECORD.UNFORMATTED 81562 . 81895)) (81963 101365 (
|
||||||
\TEDIT.EXPANDEDMENU.CREATE 81976 . 87654) (\TEDIT.EXPANDEDMENU.START 87656 . 89280) (
|
\TEDIT.EXPANDEDMENU.CREATE 81973 . 87651) (\TEDIT.EXPANDEDMENU.START 87653 . 89277) (
|
||||||
\TEDIT.EXPANDEDMENU.FN 89282 . 92537) (\TEDIT.EXPANDEDMENU.ACTIONFN 92539 . 101366)) (101430 120855 (
|
\TEDIT.EXPANDEDMENU.FN 89279 . 92534) (\TEDIT.EXPANDEDMENU.ACTIONFN 92536 . 101363)) (101427 120852 (
|
||||||
\TEDIT.PARAMENU.CREATE 101440 . 110171) (\TEDIT.PARAMENU.START 110173 . 111427) (
|
\TEDIT.PARAMENU.CREATE 101437 . 110168) (\TEDIT.PARAMENU.START 110170 . 111424) (
|
||||||
\TEDIT.APPLY.PARALOOKS 111429 . 112481) (\TEDIT.SHOW.PARALOOKS 112483 . 115200) (
|
\TEDIT.APPLY.PARALOOKS 111426 . 112478) (\TEDIT.SHOW.PARALOOKS 112480 . 115197) (
|
||||||
\TEDIT.PARAMENU.FILLIN 115202 . 119951) (\TEDIT.PARAMENU.RESHAPEFN 119953 . 120853)) (121049 147891 (
|
\TEDIT.PARAMENU.FILLIN 115199 . 119948) (\TEDIT.PARAMENU.RESHAPEFN 119950 . 120850)) (121046 147888 (
|
||||||
\TEDIT.CHARMENU.CREATE 121059 . 123663) (\TEDIT.CHARMENU.START 123665 . 124955) (\TEDIT.CHARMENU.SPEC
|
\TEDIT.CHARMENU.CREATE 121056 . 123660) (\TEDIT.CHARMENU.START 123662 . 124952) (\TEDIT.CHARMENU.SPEC
|
||||||
124957 . 129640) (\TEDIT.CHARMENU.PARSE 129642 . 132810) (\TEDIT.CHARMENU.FILLIN 132812 . 137442) (
|
124954 . 129637) (\TEDIT.CHARMENU.PARSE 129639 . 132807) (\TEDIT.CHARMENU.FILLIN 132809 . 137439) (
|
||||||
\TEDIT.SHOW.CHARLOOKS 137444 . 140989) (\TEDIT.APPLY.CHARLOOKS 140991 . 142152) (
|
\TEDIT.SHOW.CHARLOOKS 137441 . 140986) (\TEDIT.APPLY.CHARLOOKS 140988 . 142149) (
|
||||||
\TEDIT.OFFSETTYPE.STATEFN 142154 . 144117) (\TEDIT.OTHER.STATECHANGEFN 144119 . 145764) (
|
\TEDIT.OFFSETTYPE.STATEFN 142151 . 144114) (\TEDIT.OTHER.STATECHANGEFN 144116 . 145761) (
|
||||||
\TEDIT.OTHER.SELECTFN 145766 . 147889)) (147953 177067 (\TEDIT.PAGEMENU.CREATE 147963 . 156484) (
|
\TEDIT.OTHER.SELECTFN 145763 . 147886)) (147950 177199 (\TEDIT.PAGEMENU.CREATE 147960 . 156481) (
|
||||||
\TEDIT.PAGEMENU.START 156486 . 156837) (\TEDIT.SHOW.PAGELOOKS 156839 . 158725) (\TEDIT.PAGEMENU.FILLIN
|
\TEDIT.PAGEMENU.START 156483 . 156834) (\TEDIT.SHOW.PAGELOOKS 156836 . 158857) (\TEDIT.PAGEMENU.FILLIN
|
||||||
158727 . 160277) (\TEDIT.PAGEREGION.UNPARSE 160279 . 169678) (\TEDIT.APPLY.PAGELOOKS 169680 . 171607)
|
158859 . 160409) (\TEDIT.PAGEREGION.UNPARSE 160411 . 169810) (\TEDIT.APPLY.PAGELOOKS 169812 . 171739)
|
||||||
(\TEDIT.CHANGE.PAGELOOKS 171609 . 176223) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 176225 . 177065)) (
|
(\TEDIT.CHANGE.PAGELOOKS 171741 . 176355) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 176357 . 177197)) (
|
||||||
177068 182871 (\TEDIT.PAGEMENU.CREATE.HEADINGS 177078 . 179890) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN
|
177200 183003 (\TEDIT.PAGEMENU.CREATE.HEADINGS 177210 . 180022) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN
|
||||||
179892 . 181317) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 181319 . 182869)))))
|
180024 . 181449) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 181451 . 183001)))))
|
||||||
STOP
|
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 " 8-Sep-2025 22:10:10" {WMEDLEY}<library>TEDIT>TEDIT-OLDFILE.;40 73888
|
(FILECREATED "10-Apr-2026 09:29:21" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;45 73241
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS \TEDIT.GET.PCTB2)
|
:CHANGES-TO (FNS \TEDIT.GET.PCTB2 \TEDIT.GET.PCTB1 \TEDIT.GET.PCTB0)
|
||||||
|
|
||||||
:PREVIOUS-DATE " 7-Sep-2025 11:07:57" {WMEDLEY}<library>TEDIT>TEDIT-OLDFILE.;39)
|
:PREVIOUS-DATE "10-Apr-2026 00:16:32" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;41)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-OLDFILECOMS)
|
(PRETTYCOMPRINT TEDIT-OLDFILECOMS)
|
||||||
@@ -46,23 +46,18 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.GET.PCTB2
|
(\TEDIT.GET.PCTB2
|
||||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 8-Sep-2025 22:08 by rmk")
|
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 10-Apr-2026 09:28 by rmk")
|
||||||
|
(* ; "Edited 8-Sep-2025 22:08 by rmk")
|
||||||
(* ; "Edited 1-Aug-2025 14:55 by rmk")
|
(* ; "Edited 1-Aug-2025 14:55 by rmk")
|
||||||
(* ; "Edited 28-Jul-2025 23:39 by rmk")
|
(* ; "Edited 28-Jul-2025 23:39 by rmk")
|
||||||
(* ; "Edited 8-Feb-2025 20:21 by rmk")
|
(* ; "Edited 8-Feb-2025 20:21 by rmk")
|
||||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||||
(* ; "Edited 29-Apr-2024 10:28 by rmk")
|
(* ; "Edited 29-Apr-2024 10:28 by rmk")
|
||||||
(* ; "Edited 20-Mar-2024 11:00 by rmk")
|
(* ; "Edited 20-Mar-2024 11:00 by rmk")
|
||||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
|
||||||
(* ; "Edited 15-Mar-2024 14:37 by rmk")
|
|
||||||
(* ; "Edited 21-Jan-2024 10:21 by rmk")
|
(* ; "Edited 21-Jan-2024 10:21 by rmk")
|
||||||
(* ; "Edited 13-Jan-2024 12:09 by rmk")
|
|
||||||
(* ; "Edited 19-Dec-2023 10:13 by rmk")
|
|
||||||
(* ; "Edited 25-Nov-2023 23:18 by rmk")
|
(* ; "Edited 25-Nov-2023 23:18 by rmk")
|
||||||
(* ; "Edited 8-Nov-2023 13:48 by rmk")
|
|
||||||
(* ; "Edited 4-Oct-2022 16:58 by rmk")
|
(* ; "Edited 4-Oct-2022 16:58 by rmk")
|
||||||
(* ; "Edited 8-Sep-2022 23:06 by rmk")
|
(* ; "Edited 8-Sep-2022 23:06 by rmk")
|
||||||
(* ; "Edited 5-Sep-2022 21:33 by rmk")
|
|
||||||
(* ; "Edited 4-May-93 16:27 by jds")
|
(* ; "Edited 4-May-93 16:27 by jds")
|
||||||
|
|
||||||
(* ;; "READ OBSOLETE FORMATS OF TEDIT FILE")
|
(* ;; "READ OBSOLETE FORMATS OF TEDIT FILE")
|
||||||
@@ -80,8 +75,7 @@
|
|||||||
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
||||||
(SETFILEPTR TEXT PIECEINFOCH#)
|
(SETFILEPTR TEXT PIECEINFOCH#)
|
||||||
(bind PC TYPECODE PCLEN OLDPC (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
(bind PC TYPECODE PCLEN OLDPC (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
||||||
(OLDPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
(OLDPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS)) for I from 1 to PCCOUNT
|
||||||
(SBINABLE _ (fetch (STREAM BINABLE) of TEXT)) for I from 1 to PCCOUNT
|
|
||||||
do (SETQ PC NIL) (* ;
|
do (SETQ PC NIL) (* ;
|
||||||
"This loop may not really read a piece, so we have to distinguish that case.")
|
"This loop may not really read a piece, so we have to distinguish that case.")
|
||||||
(SETQ PCLEN (\DWIN TEXT))
|
(SETQ PCLEN (\DWIN TEXT))
|
||||||
@@ -131,37 +125,35 @@
|
|||||||
(create PIECE
|
(create PIECE
|
||||||
PCONTENTS _ TEXT
|
PCONTENTS _ TEXT
|
||||||
PFPOS _ CURFILECH#
|
PFPOS _ CURFILECH#
|
||||||
PBYTELEN _ PCLEN
|
|
||||||
PLEN _ PCLEN
|
PLEN _ PCLEN
|
||||||
PPARALOOKS _ OLDPARALOOKS
|
PPARALOOKS _ OLDPARALOOKS
|
||||||
PTYPE _ THINFILE.PTYPE
|
PTYPE _ THINFILE.PTYPE
|
||||||
PBYTESPERCHAR _ 1)) (* ; "Build the new piece")
|
PBYTESPERCHAR _ 1)) (* ; "Build the new piece")
|
||||||
(\TEDIT.GET.CHARLOOKS2 PC TEXT LOOKSHASH)
|
(\TEDIT.GET.CHARLOOKS2 PC TEXT LOOKSHASH)
|
||||||
(CL:WHEN (EQ THINFILE.PTYPE (PTYPE PC))
|
(* ;
|
||||||
(FSETPC PC PBINABLE SBINABLE))(* ;
|
|
||||||
"Read the character looks for this guy.")
|
"Read the character looks for this guy.")
|
||||||
(COND
|
(if OLDPC
|
||||||
[OLDPC (* ;
|
then (* ;
|
||||||
"If there's a prior piece, hook this one on the chain.")
|
"If there's a prior piece, hook this one on the chain.")
|
||||||
(COND
|
(if [AND (EQ FATFILE2.PTYPE (PTYPE PC))
|
||||||
([AND (EQ FATFILE2.PTYPE (PTYPE PC))
|
(NOT (EQ FATFILE2.PTYPE (PTYPE OLDPC]
|
||||||
(NOT (EQ FATFILE2.PTYPE (PTYPE OLDPC]
|
then (* ;
|
||||||
(* ;
|
|
||||||
"Switching from not-fat to fat. Add 3 bytes for the 255-255-0")
|
"Switching from not-fat to fat. Add 3 bytes for the 255-255-0")
|
||||||
(add (PFPOS PC)
|
(add (PFPOS PC)
|
||||||
3)
|
3)
|
||||||
(add CURFILECH# -3))
|
(add CURFILECH# -3)
|
||||||
([AND (EQ FATFILE2.PTYPE (PTYPE OLDPC))
|
elseif [AND (EQ FATFILE2.PTYPE (PTYPE OLDPC))
|
||||||
(NOT (EQ FATFILE2.PTYPE (PTYPE PC]
|
(NOT (EQ FATFILE2.PTYPE (PTYPE PC]
|
||||||
(* ;
|
then (* ;
|
||||||
"Switching from fat to not-fat. Add 3 bytes for the 255-0")
|
"Switching from fat to not-fat. Add 3 bytes for the 255-0")
|
||||||
(add (PFPOS PC)
|
(add (PFPOS PC)
|
||||||
2]
|
2))
|
||||||
((EQ FATFILE2.PTYPE (PTYPE PC)) (* ;
|
elseif (EQ FATFILE2.PTYPE (PTYPE PC))
|
||||||
|
then (* ;
|
||||||
"Switching from not-fat to fat. Add 3 bytes for the 255-255-0")
|
"Switching from not-fat to fat. Add 3 bytes for the 255-255-0")
|
||||||
(add (PFPOS PC)
|
(add (PFPOS PC)
|
||||||
3)
|
3)
|
||||||
(add CURFILECH# -3))) (* ;
|
(add CURFILECH# -3)) (* ;
|
||||||
"And note the passing of characters.")
|
"And note the passing of characters.")
|
||||||
(add CURFILECH# PCLEN))
|
(add CURFILECH# PCLEN))
|
||||||
(\PieceDescriptorOBJECT (* ;
|
(\PieceDescriptorOBJECT (* ;
|
||||||
@@ -580,7 +572,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.GET.PCTB1
|
(\TEDIT.GET.PCTB1
|
||||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 1-Aug-2025 14:56 by rmk")
|
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 10-Apr-2026 09:25 by rmk")
|
||||||
|
(* ; "Edited 1-Aug-2025 14:56 by rmk")
|
||||||
(* ; "Edited 28-Jul-2025 23:39 by rmk")
|
(* ; "Edited 28-Jul-2025 23:39 by rmk")
|
||||||
(* ; "Edited 8-Feb-2025 20:22 by rmk")
|
(* ; "Edited 8-Feb-2025 20:22 by rmk")
|
||||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||||
@@ -612,8 +605,7 @@
|
|||||||
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
||||||
(SETFILEPTR TEXT PIECEINFOCH#)
|
(SETFILEPTR TEXT PIECEINFOCH#)
|
||||||
(bind PC TYPECODE PCLEN OLDPC (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
(bind PC TYPECODE PCLEN OLDPC (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
|
||||||
(OLDPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
|
(OLDPARALOOKS _ (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS)) for I from 1 to PCCOUNT
|
||||||
(SBINABLE _ (fetch (STREAM BINABLE) of TEXT)) for I from 1 to PCCOUNT
|
|
||||||
do (SETQ PC NIL) (* ;
|
do (SETQ PC NIL) (* ;
|
||||||
"This loop may not really read a piece, so we have to distinguish that case.")
|
"This loop may not really read a piece, so we have to distinguish that case.")
|
||||||
(SETQ PCLEN (\DWIN TEXT))
|
(SETQ PCLEN (\DWIN TEXT))
|
||||||
@@ -640,13 +632,11 @@
|
|||||||
(create PIECE
|
(create PIECE
|
||||||
PCONTENTS _ TEXT
|
PCONTENTS _ TEXT
|
||||||
PFPOS _ CURFILECH#
|
PFPOS _ CURFILECH#
|
||||||
PBYTELEN _ PCLEN
|
|
||||||
PLEN _ PCLEN
|
PLEN _ PCLEN
|
||||||
PPARALOOKS _ OLDPARALOOKS
|
PPARALOOKS _ OLDPARALOOKS
|
||||||
PTYPE _ THINFILE.PTYPE
|
PTYPE _ THINFILE.PTYPE
|
||||||
PBYTESPERCHAR _ 1))
|
PBYTESPERCHAR _ 1))
|
||||||
(\TEDIT.GET.CHARLOOKS1 PC TEXT)
|
(\TEDIT.GET.CHARLOOKS1 PC TEXT) (* ;
|
||||||
(FSETPC PC PBINABLE SBINABLE) (* ;
|
|
||||||
"Read the character looks for this guy.")
|
"Read the character looks for this guy.")
|
||||||
(add CURFILECH# (PLEN PC)) (* ;
|
(add CURFILECH# (PLEN PC)) (* ;
|
||||||
"And note the passing of characters.")
|
"And note the passing of characters.")
|
||||||
@@ -891,7 +881,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.GET.PCTB0
|
(\TEDIT.GET.PCTB0
|
||||||
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 8-Feb-2025 20:22 by rmk")
|
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 10-Apr-2026 09:22 by rmk")
|
||||||
|
(* ; "Edited 8-Feb-2025 20:22 by rmk")
|
||||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||||
(* ; "Edited 29-Apr-2024 10:27 by rmk")
|
(* ; "Edited 29-Apr-2024 10:27 by rmk")
|
||||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||||
@@ -908,7 +899,7 @@
|
|||||||
|
|
||||||
(LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
|
(LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
|
||||||
OLDPC TYPECODE PCLEN PIECEINFOCH# TSTREAM USERFILEFORMAT USERTEMP (CURFILECH# (OR START 0))
|
OLDPC TYPECODE PCLEN PIECEINFOCH# TSTREAM USERFILEFORMAT USERTEMP (CURFILECH# (OR START 0))
|
||||||
(SBINABLE (fetch (STREAM BINABLE) of TEXT)))
|
)
|
||||||
(SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
|
(SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
|
||||||
8))
|
8))
|
||||||
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
(SETQ PIECEINFOCH# (\DWIN TEXT))
|
||||||
@@ -924,8 +915,7 @@
|
|||||||
PREVPIECE _ OLDPC
|
PREVPIECE _ OLDPC
|
||||||
PPARALOOKS _ DEFAULTPARALOOKS
|
PPARALOOKS _ DEFAULTPARALOOKS
|
||||||
PTYPE _ THINFILE.PTYPE
|
PTYPE _ THINFILE.PTYPE
|
||||||
PBYTESPERCHAR _ 1
|
PBYTESPERCHAR _ 1))
|
||||||
PBINABLE _ SBINABLE))
|
|
||||||
[COND
|
[COND
|
||||||
(OLDPC (FSETPC OLDPC NEXTPIECE PC)
|
(OLDPC (FSETPC OLDPC NEXTPIECE PC)
|
||||||
(FSETPC PC PPARALOOKS (PPARALOOKS OLDPC]
|
(FSETPC PC PPARALOOKS (PPARALOOKS OLDPC]
|
||||||
@@ -1100,14 +1090,14 @@
|
|||||||
PARALOOKS])
|
PARALOOKS])
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (1649 37832 (\TEDIT.GET.PCTB2 1659 . 12415) (\TEDIT.GET.PARALOOKS2 12417 . 13006) (
|
(FILEMAP (NIL (1683 37235 (\TEDIT.GET.PCTB2 1693 . 11818) (\TEDIT.GET.PARALOOKS2 11820 . 12409) (
|
||||||
\TEDIT.GET.CHARLOOKS2 13008 . 14565) (\TEDIT.PARSE.PAGEFRAMES2 14567 . 17306) (
|
\TEDIT.GET.CHARLOOKS2 12411 . 13968) (\TEDIT.PARSE.PAGEFRAMES2 13970 . 16709) (
|
||||||
\TEDIT.GET.CHARLOOKS.LIST2 17308 . 17815) (\TEDIT.GET.SINGLE.CHARLOOKS2 17817 . 21176) (
|
\TEDIT.GET.CHARLOOKS.LIST2 16711 . 17218) (\TEDIT.GET.SINGLE.CHARLOOKS2 17220 . 20579) (
|
||||||
\TEDIT.PUT.SINGLE.PARALOOKS2 21178 . 25428) (\TEDIT.PUT.SINGLE.CHARLOOKS2 25430 . 29140) (
|
\TEDIT.PUT.SINGLE.PARALOOKS2 20581 . 24831) (\TEDIT.PUT.SINGLE.CHARLOOKS2 24833 . 28543) (
|
||||||
\TEDIT.GET.PARALOOKS.LIST2 29142 . 29649) (\TEDIT.GET.SINGLE.PARALOOKS2 29651 . 34550) (
|
\TEDIT.GET.PARALOOKS.LIST2 28545 . 29052) (\TEDIT.GET.SINGLE.PARALOOKS2 29054 . 33953) (
|
||||||
\TEDIT.PUT.CHARLOOKS.LIST2 34552 . 36631) (\TEDIT.PUT.PARALOOKS.LIST2 36633 . 37830)) (37909 59190 (
|
\TEDIT.PUT.CHARLOOKS.LIST2 33955 . 36034) (\TEDIT.PUT.PARALOOKS.LIST2 36036 . 37233)) (37312 58528 (
|
||||||
\TEDIT.GET.PCTB1 37919 . 44936) (\TEDIT.GET.PAGEFRAMES1 44938 . 45390) (\TEDIT.PARSE.PAGEFRAMES1 45392
|
\TEDIT.GET.PCTB1 37322 . 44274) (\TEDIT.GET.PAGEFRAMES1 44276 . 44728) (\TEDIT.PARSE.PAGEFRAMES1 44730
|
||||||
. 48045) (\TEDIT.GET.CHARLOOKS1 48047 . 52413) (\TEDIT.GET.PARALOOKS1 52415 . 57326) (
|
. 47383) (\TEDIT.GET.CHARLOOKS1 47385 . 51751) (\TEDIT.GET.PARALOOKS1 51753 . 56664) (
|
||||||
TEDIT.GET.OBJECT1 57328 . 59188)) (59250 73865 (\TEDIT.GET.PCTB0 59260 . 63341) (\TEDIT.GET.CHARLOOKS0
|
TEDIT.GET.OBJECT1 56666 . 58526)) (58588 73218 (\TEDIT.GET.PCTB0 58598 . 62694) (\TEDIT.GET.CHARLOOKS0
|
||||||
63343 . 67783) (\TEDIT.GET.OBJECT0 67785 . 69860) (\TEDIT.GET.PARALOOKS0 69862 . 73863)))))
|
62696 . 67136) (\TEDIT.GET.OBJECT0 67138 . 69213) (\TEDIT.GET.PARALOOKS0 69215 . 73216)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
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 10:30:27" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;243 130855
|
(FILECREATED " 6-May-2026 22:17:41" {MEDLEY}<library>TEDIT>TEDIT-PAGE.;244 130772
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS TEDIT.SINGLE.PAGEFORMAT)
|
:CHANGES-TO (FNS TEDIT.TO.IMAGEFILE)
|
||||||
(VARS TEDIT-PAGECOMS)
|
|
||||||
|
|
||||||
:PREVIOUS-DATE "17-Jan-2026 12:00:08" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;241)
|
:PREVIOUS-DATE "27-Jan-2026 10:30:27" {MEDLEY}<library>TEDIT>TEDIT-PAGE.;243)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-PAGECOMS)
|
(PRETTYCOMPRINT TEDIT-PAGECOMS)
|
||||||
@@ -636,7 +635,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(TEDIT.TO.IMAGEFILE
|
(TEDIT.TO.IMAGEFILE
|
||||||
[LAMBDA (TSTREAM IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 17-Jan-2026 11:59 by rmk")
|
[LAMBDA (TSTREAM IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 6-May-2026 22:16 by rmk")
|
||||||
|
(* ; "Edited 17-Jan-2026 11:59 by rmk")
|
||||||
(* ; "Edited 15-Jan-2026 08:46 by rmk")
|
(* ; "Edited 15-Jan-2026 08:46 by rmk")
|
||||||
(* ; "Edited 25-Dec-2025 15:07 by rmk")
|
(* ; "Edited 25-Dec-2025 15:07 by rmk")
|
||||||
(* ; "Edited 20-Dec-2025 23:03 by rmk")
|
(* ; "Edited 20-Dec-2025 23:03 by rmk")
|
||||||
@@ -650,11 +650,9 @@
|
|||||||
|
|
||||||
(RESETLST
|
(RESETLST
|
||||||
(SETQ TSTREAM (if (TEXTSTREAM TSTREAM T)
|
(SETQ TSTREAM (if (TEXTSTREAM TSTREAM T)
|
||||||
elseif (TEDIT.FORMATTEDFILEP TSTREAM)
|
else [RESETSAVE (SETQ TSTREAM (OPENTEXTSTREAM TSTREAM))
|
||||||
then [RESETSAVE (SETQ TSTREAM (OPENTEXTSTREAM TSTREAM))
|
`(PROGN (CLOSEF? OLDVALUE]
|
||||||
`(PROGN (CLOSEF? OLDVALUE]
|
TSTREAM))
|
||||||
TSTREAM
|
|
||||||
else (ERROR TSTREAM "is not a Tedit stream")))
|
|
||||||
(CL:WHEN (GETTEXTPROP TSTREAM 'MENUFLG)
|
(CL:WHEN (GETTEXTPROP TSTREAM 'MENUFLG)
|
||||||
(SETQ TSTREAM (TEXTSTREAM (\TEDIT.MAINW TSTREAM))))
|
(SETQ TSTREAM (TEXTSTREAM (\TEDIT.MAINW TSTREAM))))
|
||||||
(CL:UNLESS IMAGEFILE
|
(CL:UNLESS IMAGEFILE
|
||||||
@@ -2062,18 +2060,18 @@
|
|||||||
(RETURN (DREMOVE NIL $$VAL])
|
(RETURN (DREMOVE NIL $$VAL])
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (12248 15860 (\TEDIT.PARSE.PAGEFRAMES 12258 . 14037) (\TEDIT.PUT.PAGEFRAMES 14039 .
|
(FILEMAP (NIL (12201 15813 (\TEDIT.PARSE.PAGEFRAMES 12211 . 13990) (\TEDIT.PUT.PAGEFRAMES 13992 .
|
||||||
14863) (\TEDIT.UNPARSE.PAGEFRAMES 14865 . 15858)) (15923 38091 (TEDIT.SINGLE.PAGEFORMAT 15933 . 27077)
|
14816) (\TEDIT.UNPARSE.PAGEFRAMES 14818 . 15811)) (15876 38044 (TEDIT.SINGLE.PAGEFORMAT 15886 . 27030)
|
||||||
(TEDIT.COMPOUND.PAGEFORMAT 27079 . 28058) (TEDIT.PAGEFORMAT 28060 . 35349) (TEDIT.GET.PAGEFORMAT
|
(TEDIT.COMPOUND.PAGEFORMAT 27032 . 28011) (TEDIT.PAGEFORMAT 28013 . 35302) (TEDIT.GET.PAGEFORMAT
|
||||||
35351 . 38089)) (38378 44858 (TEDIT.TO.IMAGEFILE 38388 . 44856)) (45006 98258 (\TEDIT.FORMATBOX 45016
|
35304 . 38042)) (38331 44775 (TEDIT.TO.IMAGEFILE 38341 . 44773)) (44923 98175 (\TEDIT.FORMATBOX 44933
|
||||||
. 58440) (\TEDIT.FORMATHEADING 58442 . 63088) (\TEDIT.FORMATPAGE 63090 . 72279) (\TEDIT.FORMATTEXTBOX
|
. 58357) (\TEDIT.FORMATHEADING 58359 . 63005) (\TEDIT.FORMATPAGE 63007 . 72196) (\TEDIT.FORMATTEXTBOX
|
||||||
72281 . 88794) (\TEDIT.FORMATFOLIO 88796 . 94113) (\TEDIT.FORMAT.FOUNDBOX? 94115 . 96154) (
|
72198 . 88711) (\TEDIT.FORMATFOLIO 88713 . 94030) (\TEDIT.FORMAT.FOUNDBOX? 94032 . 96071) (
|
||||||
\TEDIT.SKIP.SPECIALCOND 96156 . 98256)) (98338 103393 (\TEDIT.HARDCOPY.PAGEHEADINGS 98348 . 103391)) (
|
\TEDIT.SKIP.SPECIALCOND 96073 . 98173)) (98255 103310 (\TEDIT.HARDCOPY.PAGEHEADINGS 98265 . 103308)) (
|
||||||
103502 111553 (\TEDIT.HARDCOPY-COLUMN-END 103512 . 111551)) (111598 116539 (SCALEPAGEUNITS 111608 .
|
103419 111470 (\TEDIT.HARDCOPY-COLUMN-END 103429 . 111468)) (111515 116456 (SCALEPAGEUNITS 111525 .
|
||||||
112749) (SCALEPAGEXUNITS 112751 . 113521) (SCALEPAGEYUNITS 113523 . 114294) (\TEDIT.PAPERHEIGHT 114296
|
112666) (SCALEPAGEXUNITS 112668 . 113438) (SCALEPAGEYUNITS 113440 . 114211) (\TEDIT.PAPERHEIGHT 114213
|
||||||
. 115231) (\TEDIT.PAPERWIDTH 115233 . 116537)) (116955 120523 (ROMANNUMERALS 116965 . 120521)) (
|
. 115148) (\TEDIT.PAPERWIDTH 115150 . 116454)) (116872 120440 (ROMANNUMERALS 116882 . 120438)) (
|
||||||
120562 127828 (TEDIT.PAGENO.CREATE 120572 . 120948) (\TEDIT.PAGENO.OBJINIT 120950 . 122233) (
|
120479 127745 (TEDIT.PAGENO.CREATE 120489 . 120865) (\TEDIT.PAGENO.OBJINIT 120867 . 122150) (
|
||||||
\TEDIT.PAGENO.BUTTONEVENTINFN 122235 . 123301) (\TEDIT.PAGENO.IMAGEBOXFN 123303 . 125453) (
|
\TEDIT.PAGENO.BUTTONEVENTINFN 122152 . 123218) (\TEDIT.PAGENO.IMAGEBOXFN 123220 . 125370) (
|
||||||
\TEDIT.PAGENO.DISPLAYFN 125455 . 127105) (\TEDIT.PAGENO.GETFN 127107 . 127499) (\TEDIT.PAGENO.PUTFN
|
\TEDIT.PAGENO.DISPLAYFN 125372 . 127022) (\TEDIT.PAGENO.GETFN 127024 . 127416) (\TEDIT.PAGENO.PUTFN
|
||||||
127501 . 127826)) (127893 130832 (\TEDIT.FORMAT.FOOTNOTE 127903 . 130830)))))
|
127418 . 127743)) (127810 130749 (\TEDIT.FORMAT.FOOTNOTE 127820 . 130747)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
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 "14-Feb-2026 13:22:06" {WMEDLEY}<library>TEDIT>TEDIT-PCTREE.;251 68691
|
(FILECREATED " 9-Apr-2026 17:25:38" {WMEDLEY}<library>TEDIT>TEDIT-PCTREE.;252 68540
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (VARS TEDIT-PCTREECOMS)
|
:CHANGES-TO (FNS \TEDIT.SPLITPIECE)
|
||||||
(FNS \TEDIT.UNLINKPIECE \TEDIT.DELETEPIECES)
|
|
||||||
|
|
||||||
:PREVIOUS-DATE "28-Jul-2025 23:25:19" {WMEDLEY}<library>TEDIT>TEDIT-PCTREE.;249)
|
:PREVIOUS-DATE "14-Feb-2026 13:22:06" {WMEDLEY}<library>TEDIT>TEDIT-PCTREE.;251)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
|
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
|
||||||
@@ -658,7 +657,8 @@
|
|||||||
NEW])
|
NEW])
|
||||||
|
|
||||||
(\TEDIT.SPLITPIECE
|
(\TEDIT.SPLITPIECE
|
||||||
[LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
[LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 9-Apr-2026 13:22 by rmk")
|
||||||
|
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||||
(* ; "Edited 17-Mar-2024 00:11 by rmk")
|
(* ; "Edited 17-Mar-2024 00:11 by rmk")
|
||||||
(* ; "Edited 28-Dec-2023 22:17 by rmk")
|
(* ; "Edited 28-Dec-2023 22:17 by rmk")
|
||||||
(* ; "Edited 7-Dec-2023 21:07 by rmk")
|
(* ; "Edited 7-Dec-2023 21:07 by rmk")
|
||||||
@@ -680,9 +680,8 @@
|
|||||||
(\INSURE.VACANT.BTREESLOT (FGETPC PC PTREENODE)
|
(\INSURE.VACANT.BTREESLOT (FGETPC PC PTREENODE)
|
||||||
TEXTOBJ) (* ;
|
TEXTOBJ) (* ;
|
||||||
"Do this before reducing PC, so tree remains valid")
|
"Do this before reducing PC, so tree remains valid")
|
||||||
(LET [(PREVPC (create PIECE using PC PPARALAST _ NIL PLEN _ CHOFFSET PBYTELEN _
|
(LET ((PREVPC (create PIECE using PC PPARALAST _ NIL PLEN _ CHOFFSET)))
|
||||||
(ITIMES (PBYTESPERCHAR PC)
|
(* ;
|
||||||
CHOFFSET] (* ;
|
|
||||||
"There can be no para break before the split, as things now work.")
|
"There can be no para break before the split, as things now work.")
|
||||||
|
|
||||||
(* ;; "PREVPC is the prefix before the split point of length CHOFFSET, PC will be the suffix, a shortened version of a piece that was already in the piece tree.")
|
(* ;; "PREVPC is the prefix before the split point of length CHOFFSET, PC will be the suffix, a shortened version of a piece that was already in the piece tree.")
|
||||||
@@ -713,8 +712,6 @@
|
|||||||
|
|
||||||
(change (PLEN PC)
|
(change (PLEN PC)
|
||||||
(IDIFFERENCE DATUM CHOFFSET))
|
(IDIFFERENCE DATUM CHOFFSET))
|
||||||
(FSETPC PC PBYTELEN (ITIMES (PBYTESPERCHAR PC)
|
|
||||||
(PLEN PC)))
|
|
||||||
(freplace (BTSLOT DLEN) of (\FINDSLOT (FGETPC PC PTREENODE)
|
(freplace (BTSLOT DLEN) of (\FINDSLOT (FGETPC PC PTREENODE)
|
||||||
PC) with (PLEN PC))
|
PC) with (PLEN PC))
|
||||||
|
|
||||||
@@ -1104,13 +1101,13 @@
|
|||||||
(GLOBALVARS BTVALIDATETAGS)
|
(GLOBALVARS BTVALIDATETAGS)
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (8731 56217 (\TEDIT.MAKEPCTB 8741 . 10634) (\TEDIT.UPDATEPCNODES 10636 . 12930) (
|
(FILEMAP (NIL (8668 56066 (\TEDIT.MAKEPCTB 8678 . 10571) (\TEDIT.UPDATEPCNODES 10573 . 12867) (
|
||||||
\TEDIT.FIRSTPIECE 12932 . 14339) (\TEDIT.DELETETREE 14341 . 17615) (\TEDIT.INSERTTREE 17617 . 20362) (
|
\TEDIT.FIRSTPIECE 12869 . 14276) (\TEDIT.DELETETREE 14278 . 17552) (\TEDIT.INSERTTREE 17554 . 20299) (
|
||||||
\TEDIT.LASTPIECE 20364 . 21171) (\TEDIT.PCTOCH 21173 . 23270) (\TEDIT.CHTOPC 23272 . 29449) (
|
\TEDIT.LASTPIECE 20301 . 21108) (\TEDIT.PCTOCH 21110 . 23207) (\TEDIT.CHTOPC 23209 . 29386) (
|
||||||
\TEDIT.SET-TOTLEN 29451 . 30239) (\TEDIT.MAKE.VACANT.BTREESLOT 30241 . 36971) (\TEDIT.LINKNEWPIECE
|
\TEDIT.SET-TOTLEN 29388 . 30176) (\TEDIT.MAKE.VACANT.BTREESLOT 30178 . 36908) (\TEDIT.LINKNEWPIECE
|
||||||
36973 . 38562) (\TEDIT.SPLITPIECE 38564 . 43220) (\TEDIT.INSERTPIECE 43222 . 46494) (
|
36910 . 38499) (\TEDIT.SPLITPIECE 38501 . 43069) (\TEDIT.INSERTPIECE 43071 . 46343) (
|
||||||
\TEDIT.INSERTPIECES 46496 . 49588) (\TEDIT.DELETEPIECES 49590 . 54100) (\TEDIT.ALIGNEDPIECE 54102 .
|
\TEDIT.INSERTPIECES 46345 . 49437) (\TEDIT.DELETEPIECES 49439 . 53949) (\TEDIT.ALIGNEDPIECE 53951 .
|
||||||
56215)) (56245 68568 (\TEDIT.BTVALIDATE 56255 . 57796) (\TEDIT.BTVALIDATE.PRINT 57798 . 59163) (
|
56064)) (56094 68417 (\TEDIT.BTVALIDATE 56104 . 57645) (\TEDIT.BTVALIDATE.PRINT 57647 . 59012) (
|
||||||
\TEDIT.CHECK-BTREE 59165 . 61492) (\TEDIT.CHECK-BTREE1 61494 . 67125) (\TEDIT.BTFAIL 67127 . 67549) (
|
\TEDIT.CHECK-BTREE 59014 . 61341) (\TEDIT.CHECK-BTREE1 61343 . 66974) (\TEDIT.BTFAIL 66976 . 67398) (
|
||||||
\TEDIT.MATCHPCS 67551 . 68566)))))
|
\TEDIT.MATCHPCS 67400 . 68415)))))
|
||||||
STOP
|
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 " 5-Feb-2026 00:39:54" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;916 186880
|
(FILECREATED " 6-May-2026 22:52:37" {MEDLEY}<library>TEDIT>TEDIT-SCREEN.;918 186879
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS \TEDIT.FORMATLINE)
|
:CHANGES-TO (FNS \TEDIT.FORMATLINE)
|
||||||
|
|
||||||
:PREVIOUS-DATE "31-Dec-2025 23:10:18" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;915)
|
:PREVIOUS-DATE " 5-Feb-2026 00:39:54" {MEDLEY}<library>TEDIT>TEDIT-SCREEN.;916)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-SCREENCOMS)
|
(PRETTYCOMPRINT TEDIT-SCREENCOMS)
|
||||||
@@ -654,6 +654,7 @@
|
|||||||
|
|
||||||
(\TEDIT.FORMATLINE
|
(\TEDIT.FORMATLINE
|
||||||
[LAMBDA (TSTREAM CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE)
|
[LAMBDA (TSTREAM CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE)
|
||||||
|
(* ; "Edited 6-May-2026 22:52 by rmk")
|
||||||
(* ; "Edited 5-Feb-2026 00:38 by rmk")
|
(* ; "Edited 5-Feb-2026 00:38 by rmk")
|
||||||
(* ; "Edited 21-Nov-2025 16:36 by rmk")
|
(* ; "Edited 21-Nov-2025 16:36 by rmk")
|
||||||
(* ; "Edited 7-Aug-2025 12:49 by rmk")
|
(* ; "Edited 7-Aug-2025 12:49 by rmk")
|
||||||
@@ -1101,28 +1102,26 @@
|
|||||||
|
|
||||||
(CL:WHEN (EQ CHARSLOT LASTCHARSLOT)
|
(CL:WHEN (EQ CHARSLOT LASTCHARSLOT)
|
||||||
|
|
||||||
(* ;;
|
(* ;; "If too long, we let it roll over to the next line. ")
|
||||||
"If too long, we let it roll over to the next line. Should we put something in the margin??")
|
|
||||||
|
|
||||||
(TEDIT.PROMPTPRINT TEXTOBJ "Line too long to format." T)
|
(GO $$OUT)) finally
|
||||||
(RETURN)) finally
|
|
||||||
|
|
||||||
(* ;;
|
(* ;;
|
||||||
"Ran out of TEXTLEN (and paragraph). Back up and force a break. Are ASCENT/DESCENT correct?")
|
"Ran out of TEXTLEN (and paragraph). Back up and force a break. Are ASCENT/DESCENT correct?")
|
||||||
|
|
||||||
(CL:WHEN (AND (EQ PREVSP (PREVCHARSLOT CHARSLOT))
|
(CL:WHEN (AND (EQ PREVSP (PREVCHARSLOT CHARSLOT))
|
||||||
(NULL (CHAR PREVSP)))
|
(NULL (CHAR PREVSP)))
|
||||||
|
|
||||||
(* ;; "The line ended in a space that needs to be resolved. If we coded the end of a space-chain as (CHARCODE SPACE) instead of NIL, maybe this wouldn't be necessary.")
|
(* ;; "The line ended in a space that needs to be resolved. If we coded the end of a space-chain as (CHARCODE SPACE) instead of NIL, maybe this wouldn't be necessary.")
|
||||||
|
|
||||||
(FILLCHARSLOT PREVSP (CHARCODE SPACE)
|
(FILLCHARSLOT PREVSP (CHARCODE SPACE)
|
||||||
(CHARW PREVSP)
|
(CHARW PREVSP)
|
||||||
CHARLOOKS)
|
CHARLOOKS)
|
||||||
(SETQ PREVSP NIL))
|
(SETQ PREVSP NIL))
|
||||||
(SETQ CHARSLOT (PREVCHARSLOT CHARSLOT))
|
(SETQ CHARSLOT (PREVCHARSLOT CHARSLOT))
|
||||||
(add CHNO -1)
|
(add CHNO -1)
|
||||||
(SETQ DX 0) (* ; "TX is already correct")
|
(SETQ DX 0) (* ; "TX is already correct")
|
||||||
(FORCEBREAK))
|
(FORCEBREAK))
|
||||||
|
|
||||||
(* ;; "End of character loop. ")
|
(* ;; "End of character loop. ")
|
||||||
|
|
||||||
@@ -2866,21 +2865,21 @@
|
|||||||
(\TEDIT.LINE.TALLP LINE PHEIGHT))))])
|
(\TEDIT.LINE.TALLP LINE PHEIGHT))))])
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (26200 28416 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 26210 . 28414)) (35870 119724 (
|
(FILEMAP (NIL (26198 28414 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 26208 . 28412)) (35868 119723 (
|
||||||
\TEDIT.FORMATLINE 35880 . 71208) (\TEDIT.FORMATLINE.SETUP.PARA 71210 . 76404) (
|
\TEDIT.FORMATLINE 35878 . 71207) (\TEDIT.FORMATLINE.SETUP.PARA 71209 . 76403) (
|
||||||
\TEDIT.FORMATLINE.HORIZONTAL 76406 . 81223) (\TEDIT.FORMATLINE.VERTICAL 81225 . 83676) (
|
\TEDIT.FORMATLINE.HORIZONTAL 76405 . 81222) (\TEDIT.FORMATLINE.VERTICAL 81224 . 83675) (
|
||||||
\TEDIT.FORMATLINE.JUSTIFY 83678 . 89699) (\TEDIT.FORMATLINE.TABS 89701 . 97729) (\TEDIT.SCALE.TABS
|
\TEDIT.FORMATLINE.JUSTIFY 83677 . 89698) (\TEDIT.FORMATLINE.TABS 89700 . 97728) (\TEDIT.SCALE.TABS
|
||||||
97731 . 98522) (\TEDIT.FORMATLINE.PURGE.SPACES 98524 . 99951) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
|
97730 . 98521) (\TEDIT.FORMATLINE.PURGE.SPACES 98523 . 99950) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
|
||||||
99953 . 101030) (\TEDIT.FORMATLINE.EMPTY 101032 . 105852) (\TEDIT.FORMATLINE.UPDATELOOKS 105854 .
|
99952 . 101029) (\TEDIT.FORMATLINE.EMPTY 101031 . 105851) (\TEDIT.FORMATLINE.UPDATELOOKS 105853 .
|
||||||
112035) (\TEDIT.FORMATLINE.LASTLEGAL 112037 . 115487) (\TEDIT.LINES.ABOVE 115489 . 119100) (
|
112034) (\TEDIT.FORMATLINE.LASTLEGAL 112036 . 115486) (\TEDIT.LINES.ABOVE 115488 . 119099) (
|
||||||
\TEDIT.CHNO.TO.YTOP 119102 . 119722)) (120001 140581 (\TEDIT.DISPLAYLINE 120011 . 132521) (
|
\TEDIT.CHNO.TO.YTOP 119101 . 119721)) (120000 140580 (\TEDIT.DISPLAYLINE 120010 . 132520) (
|
||||||
\TEDIT.DISPLAYLINE.TABS 132523 . 135327) (\TEDIT.LINECACHE 135329 . 136057) (\TEDIT.CREATE.LINECACHE
|
\TEDIT.DISPLAYLINE.TABS 132522 . 135326) (\TEDIT.LINECACHE 135328 . 136056) (\TEDIT.CREATE.LINECACHE
|
||||||
136059 . 136895) (\TEDIT.BLTCHAR 136897 . 139524) (\TEDIT.DIACRITIC.SHIFT 139526 . 140579)) (141196
|
136058 . 136894) (\TEDIT.BLTCHAR 136896 . 139523) (\TEDIT.DIACRITIC.SHIFT 139525 . 140578)) (141195
|
||||||
186857 (\TEDIT.BACKFORMAT 141206 . 143760) (\TEDIT.PREVIOUS.LINEBREAK 143762 . 146565) (
|
186856 (\TEDIT.BACKFORMAT 141205 . 143759) (\TEDIT.PREVIOUS.LINEBREAK 143761 . 146564) (
|
||||||
\TEDIT.UPDATE.LINES 146567 . 152873) (\TEDIT.PANE.CREATELINES 152875 . 155165) (
|
\TEDIT.UPDATE.LINES 146566 . 152872) (\TEDIT.PANE.CREATELINES 152874 . 155164) (
|
||||||
\TEDIT.SUFFIXLINE.CREATE 155167 . 156782) (\TEDIT.LINES.BELOW 156784 . 161394) (\TEDIT.MEASURED.LINES
|
\TEDIT.SUFFIXLINE.CREATE 155166 . 156781) (\TEDIT.LINES.BELOW 156783 . 161393) (\TEDIT.MEASURED.LINES
|
||||||
161396 . 163405) (\TEDIT.VALID.LASTCHNOS 163407 . 167183) (\TEDIT.VALID.NEXTCHNOS 167185 . 170659) (
|
161395 . 163404) (\TEDIT.VALID.LASTCHNOS 163406 . 167182) (\TEDIT.VALID.NEXTCHNOS 167184 . 170658) (
|
||||||
\TEDIT.LASTVALIDLINE 170661 . 175332) (\TEDIT.NEXTVALIDLINE 175334 . 178304) (
|
\TEDIT.LASTVALIDLINE 170660 . 175331) (\TEDIT.NEXTVALIDLINE 175333 . 178303) (
|
||||||
\TEDIT.CLEARPANE.BELOW.LINE 178306 . 180412) (\TEDIT.INSERTLINE 180414 . 181800) (\TEDIT.LINE.BOTTOM
|
\TEDIT.CLEARPANE.BELOW.LINE 178305 . 180411) (\TEDIT.INSERTLINE 180413 . 181799) (\TEDIT.LINE.BOTTOM
|
||||||
181802 . 185032) (\TEDIT.SHOW.AT.BOTTOMP 185034 . 186144) (\TEDIT.SHOW.AT.TOPP 186146 . 186855)))))
|
181801 . 185031) (\TEDIT.SHOW.AT.BOTTOMP 185033 . 186143) (\TEDIT.SHOW.AT.TOPP 186145 . 186854)))))
|
||||||
STOP
|
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 "16-Feb-2026 00:38:33" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;738 162152
|
(FILECREATED "16-Apr-2026 09:27:41" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;741 161623
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS \TEDIT.SELPIECES.CHARTRANSFORM)
|
:CHANGES-TO (FNS \TEDIT.SELPIECES.FROM.STRING)
|
||||||
|
|
||||||
:PREVIOUS-DATE "14-Jan-2026 14:32:01" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;736)
|
:PREVIOUS-DATE "10-Apr-2026 09:31:20" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;740)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-SELECTIONCOMS)
|
(PRETTYCOMPRINT TEDIT-SELECTIONCOMS)
|
||||||
@@ -2041,7 +2041,8 @@
|
|||||||
SPLASTCHAR _ (ffetch (SELPIECES SPLASTCHAR) of SP2])
|
SPLASTCHAR _ (ffetch (SELPIECES SPLASTCHAR) of SP2])
|
||||||
|
|
||||||
(\TEDIT.SELPIECES.CHARTRANSFORM
|
(\TEDIT.SELPIECES.CHARTRANSFORM
|
||||||
[LAMBDA (SELPIECES CHARFN OBJECTSTOO TSTREAM) (* ; "Edited 16-Feb-2026 00:38 by rmk")
|
[LAMBDA (SELPIECES CHARFN OBJECTSTOO TSTREAM) (* ; "Edited 10-Apr-2026 09:17 by rmk")
|
||||||
|
(* ; "Edited 16-Feb-2026 00:38 by rmk")
|
||||||
(* ; "Edited 24-Apr-2025 16:02 by rmk")
|
(* ; "Edited 24-Apr-2025 16:02 by rmk")
|
||||||
(* ; "Edited 20-Apr-2025 23:23 by rmk")
|
(* ; "Edited 20-Apr-2025 23:23 by rmk")
|
||||||
(* ; "Edited 16-Mar-2025 10:03 by rmk")
|
(* ; "Edited 16-Mar-2025 10:03 by rmk")
|
||||||
@@ -2063,7 +2064,7 @@
|
|||||||
(STRING.PTYPES (for I CH (STR _ PCONTENTS) from 1 while (SETQ CH (NTHCHARCODE STR I))
|
(STRING.PTYPES (for I CH (STR _ PCONTENTS) from 1 while (SETQ CH (NTHCHARCODE STR I))
|
||||||
do (RPLCHARCODE STR I (APPLY* CHARFN CH (add INDEX 1)
|
do (RPLCHARCODE STR I (APPLY* CHARFN CH (add INDEX 1)
|
||||||
TEXTOBJ))))
|
TEXTOBJ))))
|
||||||
(FILE.PTYPES [LET [(STR (ALLOCSTRING (PLEN PC]
|
(FILE.PTYPES (LET [(STR (ALLOCSTRING (PLEN PC]
|
||||||
|
|
||||||
(* ;; "This assumes that no file piece has a PLEN greater than \MaxArrayLen characters. We rely on the piece-table reader and writer to guarantee this. If not, ALLOCSTRING will cause an error.")
|
(* ;; "This assumes that no file piece has a PLEN greater than \MaxArrayLen characters. We rely on the piece-table reader and writer to guarantee this. If not, ALLOCSTRING will cause an error.")
|
||||||
|
|
||||||
@@ -2074,13 +2075,9 @@
|
|||||||
(if (fetch (STRINGP FATSTRINGP) of STR)
|
(if (fetch (STRINGP FATSTRINGP) of STR)
|
||||||
then (FSETPC PC PTYPE FATSTRING.PTYPE)
|
then (FSETPC PC PTYPE FATSTRING.PTYPE)
|
||||||
(FSETPC PC PBYTESPERCHAR 2)
|
(FSETPC PC PBYTESPERCHAR 2)
|
||||||
(FSETPC PC PBINABLE NIL)
|
|
||||||
else (FSETPC PC PTYPE THINSTRING.PTYPE)
|
else (FSETPC PC PTYPE THINSTRING.PTYPE)
|
||||||
(FSETPC PC PBYTESPERCHAR 1)
|
(FSETPC PC PBYTESPERCHAR 1))
|
||||||
(FSETPC PC PBINABLE T))
|
(FSETPC PC PCONTENTS STR)))
|
||||||
(FSETPC PC PCONTENTS STR)
|
|
||||||
(FSETPC PC PBYTELEN (ITIMES (PBYTESPERCHAR PC)
|
|
||||||
(PLEN PC])
|
|
||||||
(OBJECT.PTYPE (add INDEX 1)
|
(OBJECT.PTYPE (add INDEX 1)
|
||||||
(CL:WHEN OBJECTSTOO
|
(CL:WHEN OBJECTSTOO
|
||||||
(FSETPC PC PCONTENTS (APPLY* CHARFN PCONTENTS INDEX))))
|
(FSETPC PC PCONTENTS (APPLY* CHARFN PCONTENTS INDEX))))
|
||||||
@@ -2088,7 +2085,8 @@
|
|||||||
SELPIECES])
|
SELPIECES])
|
||||||
|
|
||||||
(\TEDIT.SELPIECES.FROM.STRING
|
(\TEDIT.SELPIECES.FROM.STRING
|
||||||
[LAMBDA (STRING TEXTOBJ CHECKFOREOL CHARLOOKS PARALOOKS) (* ; "Edited 28-Jul-2025 23:50 by rmk")
|
[LAMBDA (STRING TEXTOBJ CHECKFOREOL CHARLOOKS PARALOOKS) (* ; "Edited 10-Apr-2026 09:18 by rmk")
|
||||||
|
(* ; "Edited 28-Jul-2025 23:50 by rmk")
|
||||||
(* ; "Edited 8-Feb-2025 20:14 by rmk")
|
(* ; "Edited 8-Feb-2025 20:14 by rmk")
|
||||||
(* ; "Edited 20-Mar-2024 10:57 by rmk")
|
(* ; "Edited 20-Mar-2024 10:57 by rmk")
|
||||||
(* ; "Edited 3-Mar-2024 13:00 by rmk")
|
(* ; "Edited 3-Mar-2024 13:00 by rmk")
|
||||||
@@ -2109,12 +2107,10 @@
|
|||||||
(CL:WHEN (AND TEXTOBJ (FGETTOBJ TEXTOBJ FORMATTEDP))
|
(CL:WHEN (AND TEXTOBJ (FGETTOBJ TEXTOBJ FORMATTEDP))
|
||||||
(SETQ CHECKFOREOL T))
|
(SETQ CHECKFOREOL T))
|
||||||
(LET (FIRSTPIECE EOLPOS (BYTESPERCHAR 1)
|
(LET (FIRSTPIECE EOLPOS (BYTESPERCHAR 1)
|
||||||
(PTYPE THINSTRING.PTYPE)
|
(PTYPE THINSTRING.PTYPE))
|
||||||
(PBINABLE T))
|
|
||||||
(SETQ STRING (CONCAT STRING))
|
(SETQ STRING (CONCAT STRING))
|
||||||
(CL:WHEN (fetch (STRINGP FATSTRINGP) of STRING)
|
(CL:WHEN (fetch (STRINGP FATSTRINGP) of STRING)
|
||||||
(SETQ PTYPE FATSTRING.PTYPE)
|
(SETQ PTYPE FATSTRING.PTYPE)
|
||||||
(SETQ PBINABLE NIL)
|
|
||||||
(SETQ BYTESPERCHAR 2))
|
(SETQ BYTESPERCHAR 2))
|
||||||
(if (AND CHECKFOREOL (SETQ EOLPOS (STRPOS (CONSTANT (CHARACTER (CHARCODE EOL)))
|
(if (AND CHECKFOREOL (SETQ EOLPOS (STRPOS (CONSTANT (CHARACTER (CHARCODE EOL)))
|
||||||
STRING)))
|
STRING)))
|
||||||
@@ -2131,13 +2127,10 @@
|
|||||||
PTYPE _ PTYPE
|
PTYPE _ PTYPE
|
||||||
PCONTENTS _ STR
|
PCONTENTS _ STR
|
||||||
PLEN _ (NCHARS STR)
|
PLEN _ (NCHARS STR)
|
||||||
PBYTELEN _ (ITIMES (NCHARS STR)
|
|
||||||
BYTESPERCHAR)
|
|
||||||
PCHARLOOKS _ CHARLOOKS
|
PCHARLOOKS _ CHARLOOKS
|
||||||
PPARALOOKS _ PARALOOKS
|
PPARALOOKS _ PARALOOKS
|
||||||
PPARALAST _ T
|
PPARALAST _ T
|
||||||
PREVPIECE _ PC
|
PREVPIECE _ PC))
|
||||||
PBINABLE _ PBINABLE))
|
|
||||||
(CL:WHEN PREVPC (FSETPC PREVPC NEXTPIECE PC))
|
(CL:WHEN PREVPC (FSETPC PREVPC NEXTPIECE PC))
|
||||||
(SETQ PREVPC PC)
|
(SETQ PREVPC PC)
|
||||||
(SETQ EOLPOS (OR (STRPOS (CONSTANT (CHARACTER (CHARCODE EOL)))
|
(SETQ EOLPOS (OR (STRPOS (CONSTANT (CHARACTER (CHARCODE EOL)))
|
||||||
@@ -2158,10 +2151,7 @@
|
|||||||
PTYPE _ PTYPE
|
PTYPE _ PTYPE
|
||||||
PCONTENTS _ STRING
|
PCONTENTS _ STRING
|
||||||
PLEN _ (NCHARS STRING)
|
PLEN _ (NCHARS STRING)
|
||||||
PBYTELEN _ (ITIMES (NCHARS STRING)
|
|
||||||
BYTESPERCHAR)
|
|
||||||
PBYTESPERCHAR _ BYTESPERCHAR
|
PBYTESPERCHAR _ BYTESPERCHAR
|
||||||
PBINABLE _ PBINABLE
|
|
||||||
PCHARLOOKS _ CHARLOOKS
|
PCHARLOOKS _ CHARLOOKS
|
||||||
PPARALOOKS _ PARALOOKS))
|
PPARALOOKS _ PARALOOKS))
|
||||||
(create SELPIECES
|
(create SELPIECES
|
||||||
@@ -2571,26 +2561,26 @@
|
|||||||
(ADDTOVAR LAMA TEDIT.SELPROP)
|
(ADDTOVAR LAMA TEDIT.SELPROP)
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (15888 17709 (\TEDIT.SELECTION.DEFPRINT 15898 . 17707)) (17746 19251 (
|
(FILEMAP (NIL (15886 17707 (\TEDIT.SELECTION.DEFPRINT 15896 . 17705)) (17744 19249 (
|
||||||
\TEDIT.SET.GLOBAL.SELECTIONS 17756 . 19249)) (19252 25473 (\TEDIT.SELECTED.PIECES 19262 . 20901) (
|
\TEDIT.SET.GLOBAL.SELECTIONS 17754 . 19247)) (19250 25471 (\TEDIT.SELECTED.PIECES 19260 . 20899) (
|
||||||
\TEDIT.FIND.PROTECTED.END 20903 . 22697) (\TEDIT.FIND.PROTECTED.START 22699 . 24682) (
|
\TEDIT.FIND.PROTECTED.END 20901 . 22695) (\TEDIT.FIND.PROTECTED.START 22697 . 24680) (
|
||||||
\TEDIT.WORD.BOUND 24684 . 25471)) (25607 59714 (\TEDIT.EXTEND.SEL 25617 . 32857) (\TEDIT.SCAN.LINE
|
\TEDIT.WORD.BOUND 24682 . 25469)) (25605 59712 (\TEDIT.EXTEND.SEL 25615 . 32855) (\TEDIT.SCAN.LINE
|
||||||
32859 . 44532) (\TEDIT.SCAN.LINE.WORD 44534 . 49527) (\TEDIT.XYTOSEL 49529 . 56867) (\TEDIT.REGIONTYPE
|
32857 . 44530) (\TEDIT.SCAN.LINE.WORD 44532 . 49525) (\TEDIT.XYTOSEL 49527 . 56865) (\TEDIT.REGIONTYPE
|
||||||
56869 . 57888) (\TEDIT.XYTOSEL.INLINEP 57890 . 58345) (\TEDIT.XYTOSEL.LINE 58347 . 59712)) (59715
|
56867 . 57886) (\TEDIT.XYTOSEL.INLINEP 57888 . 58343) (\TEDIT.XYTOSEL.LINE 58345 . 59710)) (59713
|
||||||
73260 (\TEDIT.FIXSEL 59725 . 69102) (\TEDIT.CHTOLINEX 69104 . 73258)) (73261 77465 (
|
73258 (\TEDIT.FIXSEL 59723 . 69100) (\TEDIT.CHTOLINEX 69102 . 73256)) (73259 77463 (
|
||||||
\TEDIT.RESET.EXTEND.PENDING.DELETE 73271 . 74549) (\TEDIT.SET.SEL.LOOKS 74551 . 77463)) (78402 99555 (
|
\TEDIT.RESET.EXTEND.PENDING.DELETE 73269 . 74547) (\TEDIT.SET.SEL.LOOKS 74549 . 77461)) (78400 99553 (
|
||||||
\TEDIT.SHOWSEL 78412 . 83388) (\TEDIT.NOSEL 83390 . 83691) (\TEDIT.SEL.OFF 83693 . 84104) (
|
\TEDIT.SHOWSEL 78410 . 83386) (\TEDIT.NOSEL 83388 . 83689) (\TEDIT.SEL.OFF 83691 . 84102) (
|
||||||
\TEDIT.SEL.ON 84106 . 84522) (\TEDIT.SHOWSEL.HILIGHT 84524 . 89145) (\TEDIT.UPDATE.SEL 89147 . 93749)
|
\TEDIT.SEL.ON 84104 . 84520) (\TEDIT.SHOWSEL.HILIGHT 84522 . 89143) (\TEDIT.UPDATE.SEL 89145 . 93747)
|
||||||
(\TEDIT.CARETLINE 93751 . 94465) (\TEDIT.SEL.L1 94467 . 95150) (\TEDIT.SEL.LN 95152 . 95835) (
|
(\TEDIT.CARETLINE 93749 . 94463) (\TEDIT.SEL.L1 94465 . 95148) (\TEDIT.SEL.LN 95150 . 95833) (
|
||||||
\TEDIT.SEL.DELETEDCHARS 95837 . 99553)) (99556 104438 (\TEDIT.COPYSEL 99566 . 102208) (
|
\TEDIT.SEL.DELETEDCHARS 95835 . 99551)) (99554 104436 (\TEDIT.COPYSEL 99564 . 102206) (
|
||||||
\TEDIT.SEL.CHANGED? 102210 . 104436)) (104469 118128 (\TEDIT.SELECT.OBJECT 104479 . 109432) (
|
\TEDIT.SEL.CHANGED? 102208 . 104434)) (104467 118126 (\TEDIT.SELECT.OBJECT 104477 . 109430) (
|
||||||
\TEDIT.SHOWSEL.OBJECT 109434 . 111665) (\TEDIT.CLIP.OBJECT 111667 . 113671) (\TEDIT.OPERATE.OBJECT
|
\TEDIT.SHOWSEL.OBJECT 109432 . 111663) (\TEDIT.CLIP.OBJECT 111665 . 113669) (\TEDIT.OPERATE.OBJECT
|
||||||
113673 . 118126)) (118156 137982 (\TEDIT.SELPIECES 118166 . 122447) (\TEDIT.SELPIECES.COPY 122449 .
|
113671 . 118124)) (118154 137453 (\TEDIT.SELPIECES 118164 . 122445) (\TEDIT.SELPIECES.COPY 122447 .
|
||||||
124938) (\TEDIT.SELPIECES.CONCAT 124940 . 126819) (\TEDIT.SELPIECES.CHARTRANSFORM 126821 . 130357) (
|
124936) (\TEDIT.SELPIECES.CONCAT 124938 . 126817) (\TEDIT.SELPIECES.CHARTRANSFORM 126819 . 130189) (
|
||||||
\TEDIT.SELPIECES.FROM.STRING 130359 . 135617) (\TEDIT.SELPIECES.TO.STRING 135619 . 137980)) (138035
|
\TEDIT.SELPIECES.FROM.STRING 130191 . 135088) (\TEDIT.SELPIECES.TO.STRING 135090 . 137451)) (137506
|
||||||
161983 (TEDIT.XYTOCH 138045 . 140621) (TEDIT.SELPROP 140623 . 144900) (TEDIT.GETPOINT 144902 . 146822)
|
161454 (TEDIT.XYTOCH 137516 . 140092) (TEDIT.SELPROP 140094 . 144371) (TEDIT.GETPOINT 144373 . 146293)
|
||||||
(TEDIT.GETSEL 146824 . 147700) (TEDIT.GETSEL.PARA 147702 . 148651) (TEDIT.SCANSEL 148653 . 149601) (
|
(TEDIT.GETSEL 146295 . 147171) (TEDIT.GETSEL.PARA 147173 . 148122) (TEDIT.SCANSEL 148124 . 149072) (
|
||||||
TEDIT.SET.SEL.LOOKS 149603 . 151088) (TEDIT.SETSEL 151090 . 156008) (TEDIT.SHOWSEL 156010 . 157874) (
|
TEDIT.SET.SEL.LOOKS 149074 . 150559) (TEDIT.SETSEL 150561 . 155479) (TEDIT.SHOWSEL 155481 . 157345) (
|
||||||
TEDIT.SEL.AS.STRING 157876 . 160361) (TEDIT.SEL.AS.SEXPR 160363 . 161649) (TEDIT.SELECTALL 161651 .
|
TEDIT.SEL.AS.STRING 157347 . 159832) (TEDIT.SEL.AS.SEXPR 159834 . 161120) (TEDIT.SELECTALL 161122 .
|
||||||
161981)))))
|
161452)))))
|
||||||
STOP
|
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 "16-Feb-2026 12:40:44" {WMEDLEY}<library>tedit>TEDIT-STREAM.;944 193110
|
(FILECREATED " 1-May-2026 08:15:56" {MEDLEY}<library>tedit>TEDIT-STREAM.;956 190971
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS \TEDIT.STREAMINIT)
|
:CHANGES-TO (RECORDS PIECE)
|
||||||
|
|
||||||
:PREVIOUS-DATE "16-Feb-2026 09:39:00" {WMEDLEY}<library>tedit>TEDIT-STREAM.;943)
|
:PREVIOUS-DATE "26-Apr-2026 23:46:38" {MEDLEY}<library>tedit>TEDIT-STREAM.;955)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-STREAMCOMS)
|
(PRETTYCOMPRINT TEDIT-STREAMCOMS)
|
||||||
@@ -14,8 +14,8 @@
|
|||||||
(RPAQQ TEDIT-STREAMCOMS
|
(RPAQQ TEDIT-STREAMCOMS
|
||||||
[(DECLARE%: EVAL@COMPILE DONTCOPY
|
[(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||||
(EXPORT (RECORDS PIECE TEXTOBJ TEXTSTREAM)
|
(EXPORT (RECORDS PIECE TEXTOBJ TEXTSTREAM)
|
||||||
(MACROS NEXTPIECE PREVPIECE PLEN PLAST PTYPE PCONTENTS PCHARLOOKS PCHARSET
|
(MACROS NEXTPIECE PREVPIECE PLEN PLAST PTYPE PCONTENTS PCHARLOOKS PPARALOOKS
|
||||||
PPARALOOKS PPARALAST PFPOS PBYTELEN PNEW PBINABLE PBYTESPERCHAR POBJ)
|
PPARALAST PFPOS PBYTELEN PNEW PBYTESPERCHAR POBJ)
|
||||||
(MACROS SETPC FSETPC GETPC FGETPC)
|
(MACROS SETPC FSETPC GETPC FGETPC)
|
||||||
(MACROS THINPIECEP)
|
(MACROS THINPIECEP)
|
||||||
(MACROS VISIBLEPIECEP \NEXT.VISIBLE.PIECE \PREV.VISIBLE.PIECE)
|
(MACROS VISIBLEPIECEP \NEXT.VISIBLE.PIECE \PREV.VISIBLE.PIECE)
|
||||||
@@ -94,8 +94,8 @@
|
|||||||
PCONTENTS (* ; "The background source of data for this piece (stream, string, block, object, depending on the PTYPE).")
|
PCONTENTS (* ; "The background source of data for this piece (stream, string, block, object, depending on the PTYPE).")
|
||||||
(PTYPE BITS 4) (* ;
|
(PTYPE BITS 4) (* ;
|
||||||
"How the characters are delivered: thinfile, fatstring, object, substream")
|
"How the characters are delivered: thinfile, fatstring, object, substream")
|
||||||
PBYTELEN (* ;
|
NIL (* ;
|
||||||
"Length of this character piece in bytes. PBYTELEN = PLEN*PBYTESPERCHAR")
|
"Was PBYTELEN: Length of this character piece in bytes. PBYTELEN = PLEN*PBYTESPERCHAR")
|
||||||
PFPOS (* ;
|
PFPOS (* ;
|
||||||
"The FILEPTR of the start of the piece in the file")
|
"The FILEPTR of the start of the piece in the file")
|
||||||
PLEN (* ;
|
PLEN (* ;
|
||||||
@@ -111,20 +111,18 @@
|
|||||||
(PNEW FLAG) (* ;
|
(PNEW FLAG) (* ;
|
||||||
"This text is new here; used by the tentative edit system, and anyone else interested.")
|
"This text is new here; used by the tentative edit system, and anyone else interested.")
|
||||||
(NIL FLAG) (* ; "Was PFATP")
|
(NIL FLAG) (* ; "Was PFATP")
|
||||||
(PBINABLE FLAG) (* ;
|
(NIL FLAG)
|
||||||
"8-bit bytes are binable (THINSTRING and THINFILE) ")
|
|
||||||
(PTREENODE XPOINTER) (* ;
|
(PTREENODE XPOINTER) (* ;
|
||||||
"Points to the PCTB tree-node that contains this piece.")
|
"Points to the PCTB tree-node that contains this piece.")
|
||||||
(PCHARSET BYTE) (* ;
|
(NIL BYTE) (* ;
|
||||||
"High-order charset for FATFILE1 pieces")
|
"Was PCHARSET: High-order charset for FATFILE1 pieces")
|
||||||
(PUTF8BYTESPERCHAR BYTE)) (* ;
|
NIL) (* ; "Was PUTF8BYTESPERCHAR: The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece. But this just duplicates PBYTESPERCHAR for UTF-8 pieces")
|
||||||
"The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece")
|
|
||||||
[ACCESSFNS ((POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM))
|
[ACCESSFNS ((POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM))
|
||||||
(type? IMAGEOBJ (PCONTENTS DATUM))
|
(type? IMAGEOBJ (PCONTENTS DATUM))
|
||||||
(PCONTENTS DATUM))
|
(PCONTENTS DATUM))
|
||||||
(AND (EQ OBJECT.PTYPE (PTYPE DATUM))
|
(AND (EQ OBJECT.PTYPE (PTYPE DATUM))
|
||||||
(SETPC DATUM PCONTENTS NEWVALUE]
|
(SETPC DATUM PCONTENTS NEWVALUE]
|
||||||
PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0)
|
PFPOS _ 0 PLEN _ 0)
|
||||||
|
|
||||||
(DATATYPE TEXTOBJ (
|
(DATATYPE TEXTOBJ (
|
||||||
(* ;;
|
(* ;;
|
||||||
@@ -294,7 +292,7 @@
|
|||||||
(/DECLAREDATATYPE 'PIECE
|
(/DECLAREDATATYPE 'PIECE
|
||||||
'(POINTER (BITS 4)
|
'(POINTER (BITS 4)
|
||||||
POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER FLAG POINTER FLAG FLAG
|
POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER FLAG POINTER FLAG FLAG
|
||||||
FLAG XPOINTER BYTE BYTE)
|
FLAG XPOINTER BYTE POINTER)
|
||||||
'((PIECE 0 POINTER)
|
'((PIECE 0 POINTER)
|
||||||
(PIECE 0 (BITS . 3))
|
(PIECE 0 (BITS . 3))
|
||||||
(PIECE 2 POINTER)
|
(PIECE 2 POINTER)
|
||||||
@@ -311,8 +309,8 @@
|
|||||||
(PIECE 16 (FLAGBITS . 32))
|
(PIECE 16 (FLAGBITS . 32))
|
||||||
(PIECE 18 XPOINTER)
|
(PIECE 18 XPOINTER)
|
||||||
(PIECE 20 (BITS . 7))
|
(PIECE 20 (BITS . 7))
|
||||||
(PIECE 20 (BITS . 135)))
|
(PIECE 22 POINTER))
|
||||||
'22)
|
'24)
|
||||||
|
|
||||||
(/DECLAREDATATYPE 'TEXTOBJ
|
(/DECLAREDATATYPE 'TEXTOBJ
|
||||||
'(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG POINTER
|
'(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG POINTER
|
||||||
@@ -405,9 +403,6 @@
|
|||||||
(PUTPROPS PCHARLOOKS MACRO ((PC)
|
(PUTPROPS PCHARLOOKS MACRO ((PC)
|
||||||
(ffetch (PIECE PCHARLOOKS) of PC)))
|
(ffetch (PIECE PCHARLOOKS) of PC)))
|
||||||
|
|
||||||
(PUTPROPS PCHARSET MACRO ((PC)
|
|
||||||
(ffetch (PIECE PCHARSET) of PC)))
|
|
||||||
|
|
||||||
(PUTPROPS PPARALOOKS MACRO ((PC)
|
(PUTPROPS PPARALOOKS MACRO ((PC)
|
||||||
(ffetch (PIECE PPARALOOKS) of PC)))
|
(ffetch (PIECE PPARALOOKS) of PC)))
|
||||||
|
|
||||||
@@ -417,15 +412,13 @@
|
|||||||
(PUTPROPS PFPOS MACRO ((PC)
|
(PUTPROPS PFPOS MACRO ((PC)
|
||||||
(ffetch (PIECE PFPOS) of PC)))
|
(ffetch (PIECE PFPOS) of PC)))
|
||||||
|
|
||||||
(PUTPROPS PBYTELEN MACRO ((PC)
|
(PUTPROPS PBYTELEN MACRO (OPENLAMBDA (PC)
|
||||||
(ffetch (PIECE PBYTELEN) of PC)))
|
(ITIMES (ffetch (PIECE PLEN) of PC)
|
||||||
|
(ffetch (PIECE PBYTESPERCHAR) of PC))))
|
||||||
|
|
||||||
(PUTPROPS PNEW MACRO ((PC)
|
(PUTPROPS PNEW MACRO ((PC)
|
||||||
(ffetch (PIECE PNEW) of PC)))
|
(ffetch (PIECE PNEW) of PC)))
|
||||||
|
|
||||||
(PUTPROPS PBINABLE MACRO ((PC)
|
|
||||||
(ffetch (PIECE PBINABLE) of PC)))
|
|
||||||
|
|
||||||
(PUTPROPS PBYTESPERCHAR MACRO ((PC)
|
(PUTPROPS PBYTESPERCHAR MACRO ((PC)
|
||||||
(ffetch (PIECE PBYTESPERCHAR) of PC)))
|
(ffetch (PIECE PBYTESPERCHAR) of PC)))
|
||||||
|
|
||||||
@@ -454,7 +447,7 @@
|
|||||||
|
|
||||||
(SELECTC (PTYPE PC)
|
(SELECTC (PTYPE PC)
|
||||||
(THIN.PTYPES T)
|
(THIN.PTYPES T)
|
||||||
(UTF8.PTYPE (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR)))
|
(UTF8.PTYPE (EQ 1 (FGETPC PC PBYTESPERCHAR)))
|
||||||
NIL)))
|
NIL)))
|
||||||
)
|
)
|
||||||
(DECLARE%: EVAL@COMPILE
|
(DECLARE%: EVAL@COMPILE
|
||||||
@@ -517,7 +510,6 @@
|
|||||||
|
|
||||||
(RPAQQ PTYPES
|
(RPAQQ PTYPES
|
||||||
((THINFILE.PTYPE 0)
|
((THINFILE.PTYPE 0)
|
||||||
(FATFILE1.PTYPE 1)
|
|
||||||
(FATFILE2.PTYPE 2)
|
(FATFILE2.PTYPE 2)
|
||||||
(THINSTRING.PTYPE 3)
|
(THINSTRING.PTYPE 3)
|
||||||
(FATSTRING.PTYPE 4)
|
(FATSTRING.PTYPE 4)
|
||||||
@@ -527,18 +519,15 @@
|
|||||||
(UTF16BE.PTYPE 8)
|
(UTF16BE.PTYPE 8)
|
||||||
(UTF16LE.PTYPE 9)
|
(UTF16LE.PTYPE 9)
|
||||||
(UTF8.PTYPE 11)
|
(UTF8.PTYPE 11)
|
||||||
(FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE
|
(FILE.PTYPES (LIST THINFILE.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE))
|
||||||
UTF16LE.PTYPE))
|
|
||||||
(STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE))
|
(STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE))
|
||||||
(BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
(BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
||||||
(THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
(THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
||||||
(FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE))))
|
(FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE))))
|
||||||
(DECLARE%: EVAL@COMPILE
|
(DECLARE%: EVAL@COMPILE
|
||||||
|
|
||||||
(RPAQQ THINFILE.PTYPE 0)
|
(RPAQQ THINFILE.PTYPE 0)
|
||||||
|
|
||||||
(RPAQQ FATFILE1.PTYPE 1)
|
|
||||||
|
|
||||||
(RPAQQ FATFILE2.PTYPE 2)
|
(RPAQQ FATFILE2.PTYPE 2)
|
||||||
|
|
||||||
(RPAQQ THINSTRING.PTYPE 3)
|
(RPAQQ THINSTRING.PTYPE 3)
|
||||||
@@ -557,8 +546,7 @@
|
|||||||
|
|
||||||
(RPAQQ UTF8.PTYPE 11)
|
(RPAQQ UTF8.PTYPE 11)
|
||||||
|
|
||||||
(RPAQ FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE
|
(RPAQ FILE.PTYPES (LIST THINFILE.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE))
|
||||||
UTF16LE.PTYPE))
|
|
||||||
|
|
||||||
(RPAQ STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE))
|
(RPAQ STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE))
|
||||||
|
|
||||||
@@ -566,11 +554,10 @@
|
|||||||
|
|
||||||
(RPAQ THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
(RPAQ THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
||||||
|
|
||||||
(RPAQ FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE))
|
(RPAQ FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE))
|
||||||
|
|
||||||
|
|
||||||
(CONSTANTS (THINFILE.PTYPE 0)
|
(CONSTANTS (THINFILE.PTYPE 0)
|
||||||
(FATFILE1.PTYPE 1)
|
|
||||||
(FATFILE2.PTYPE 2)
|
(FATFILE2.PTYPE 2)
|
||||||
(THINSTRING.PTYPE 3)
|
(THINSTRING.PTYPE 3)
|
||||||
(FATSTRING.PTYPE 4)
|
(FATSTRING.PTYPE 4)
|
||||||
@@ -580,12 +567,11 @@
|
|||||||
(UTF16BE.PTYPE 8)
|
(UTF16BE.PTYPE 8)
|
||||||
(UTF16LE.PTYPE 9)
|
(UTF16LE.PTYPE 9)
|
||||||
(UTF8.PTYPE 11)
|
(UTF8.PTYPE 11)
|
||||||
(FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE
|
(FILE.PTYPES (LIST THINFILE.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE))
|
||||||
UTF16LE.PTYPE))
|
|
||||||
(STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE))
|
(STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE))
|
||||||
(BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
(BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
||||||
(THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
(THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
||||||
(FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))
|
(FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE)))
|
||||||
)
|
)
|
||||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||||
|
|
||||||
@@ -599,7 +585,7 @@
|
|||||||
(/DECLAREDATATYPE 'PIECE
|
(/DECLAREDATATYPE 'PIECE
|
||||||
'(POINTER (BITS 4)
|
'(POINTER (BITS 4)
|
||||||
POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER FLAG POINTER FLAG FLAG
|
POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER FLAG POINTER FLAG FLAG
|
||||||
FLAG XPOINTER BYTE BYTE)
|
FLAG XPOINTER BYTE POINTER)
|
||||||
'((PIECE 0 POINTER)
|
'((PIECE 0 POINTER)
|
||||||
(PIECE 0 (BITS . 3))
|
(PIECE 0 (BITS . 3))
|
||||||
(PIECE 2 POINTER)
|
(PIECE 2 POINTER)
|
||||||
@@ -616,8 +602,8 @@
|
|||||||
(PIECE 16 (FLAGBITS . 32))
|
(PIECE 16 (FLAGBITS . 32))
|
||||||
(PIECE 18 XPOINTER)
|
(PIECE 18 XPOINTER)
|
||||||
(PIECE 20 (BITS . 7))
|
(PIECE 20 (BITS . 7))
|
||||||
(PIECE 20 (BITS . 135)))
|
(PIECE 22 POINTER))
|
||||||
'22)
|
'24)
|
||||||
|
|
||||||
(/DECLAREDATATYPE 'TEXTOBJ
|
(/DECLAREDATATYPE 'TEXTOBJ
|
||||||
'(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG POINTER
|
'(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG POINTER
|
||||||
@@ -697,6 +683,10 @@
|
|||||||
(\TEDIT.TEXTBIN
|
(\TEDIT.TEXTBIN
|
||||||
[LAMBDA (TSTREAM)
|
[LAMBDA (TSTREAM)
|
||||||
|
|
||||||
|
(* ;; "Edited 9-Apr-2026 00:06 by rmk")
|
||||||
|
|
||||||
|
(* ;; "Edited 7-Apr-2026 09:57 by rmk")
|
||||||
|
|
||||||
(* ;; "Edited 13-Oct-2025 17:16 by rmk")
|
(* ;; "Edited 13-Oct-2025 17:16 by rmk")
|
||||||
|
|
||||||
(* ;; "Edited 21-Oct-2024 00:26 by rmk")
|
(* ;; "Edited 21-Oct-2024 00:26 by rmk")
|
||||||
@@ -818,18 +808,6 @@
|
|||||||
(\TEDIT.INSTALL.FILEBUFFER TSTREAM
|
(\TEDIT.INSTALL.FILEBUFFER TSTREAM
|
||||||
(ffetch (TEXTSTREAM PCCHARSLEFT)
|
(ffetch (TEXTSTREAM PCCHARSLEFT)
|
||||||
of TSTREAM)))))
|
of TSTREAM)))))
|
||||||
(FATFILE1.PTYPE
|
|
||||||
(PROG1 (create WORD
|
|
||||||
HIBYTE _ (PCHARSET PC)
|
|
||||||
LOBYTE _ (BIN (PCONTENTS PC)))
|
|
||||||
(add (ffetch (STREAM COFFSET) of TSTREAM)
|
|
||||||
1)
|
|
||||||
(CL:WHEN (\ENDOFBUFFERP TSTREAM)
|
|
||||||
(\TEDIT.INSTALL.FILEBUFFER TSTREAM (ffetch
|
|
||||||
(TEXTSTREAM
|
|
||||||
PCCHARSLEFT
|
|
||||||
)
|
|
||||||
of TSTREAM)))))
|
|
||||||
(THINFILE.PTYPE (* ;
|
(THINFILE.PTYPE (* ;
|
||||||
"Fall through when the underlying stream is not binable")
|
"Fall through when the underlying stream is not binable")
|
||||||
(PROG1 (BIN (PCONTENTS PC))
|
(PROG1 (BIN (PCONTENTS PC))
|
||||||
@@ -848,7 +826,8 @@
|
|||||||
(\TEDIT.THELP "\TEXTBIN UNKNOWN PTYPE" (PTYPE PC])
|
(\TEDIT.THELP "\TEXTBIN UNKNOWN PTYPE" (PTYPE PC])
|
||||||
|
|
||||||
(\TEDIT.TEXTPEEKBIN
|
(\TEDIT.TEXTPEEKBIN
|
||||||
[LAMBDA (TSTREAM NOERROR) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
[LAMBDA (TSTREAM NOERROR) (* ; "Edited 9-Apr-2026 00:06 by rmk")
|
||||||
|
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||||
(* ; "Edited 19-Mar-2024 19:14 by rmk")
|
(* ; "Edited 19-Mar-2024 19:14 by rmk")
|
||||||
(* ; "Edited 16-Mar-2024 12:44 by rmk")
|
(* ; "Edited 16-Mar-2024 12:44 by rmk")
|
||||||
(* ; "Edited 1-Feb-2024 11:13 by rmk")
|
(* ; "Edited 1-Feb-2024 11:13 by rmk")
|
||||||
@@ -911,10 +890,6 @@
|
|||||||
'OBJECTBYTE)
|
'OBJECTBYTE)
|
||||||
PCONTENTS))
|
PCONTENTS))
|
||||||
(UTF8.PTYPE (UTF8.PEEKCCODEFN PCONTENTS))
|
(UTF8.PTYPE (UTF8.PEEKCCODEFN PCONTENTS))
|
||||||
(FATFILE1.PTYPE
|
|
||||||
(create WORD
|
|
||||||
HIBYTE _ (PCHARSET PC)
|
|
||||||
LOBYTE _ (\PEEKBIN PCONTENTS)))
|
|
||||||
(SUBSTREAM.PTYPE (* ; "A substream stored as an object")
|
(SUBSTREAM.PTYPE (* ; "A substream stored as an object")
|
||||||
(\PEEKBIN (IMAGEOBJPROP PCONTENTS 'SUBSTREAM)))
|
(\PEEKBIN (IMAGEOBJPROP PCONTENTS 'SUBSTREAM)))
|
||||||
(\TEDIT.THELP "UNKNOWN PIECE TYPE")))
|
(\TEDIT.THELP "UNKNOWN PIECE TYPE")))
|
||||||
@@ -923,7 +898,8 @@
|
|||||||
else (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM])
|
else (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM])
|
||||||
|
|
||||||
(\TEDIT.TEXTBACKFILEPTR
|
(\TEDIT.TEXTBACKFILEPTR
|
||||||
[LAMBDA (TSTREAM) (* ; "Edited 16-Feb-2026 08:54 by rmk")
|
[LAMBDA (TSTREAM) (* ; "Edited 9-Apr-2026 00:07 by rmk")
|
||||||
|
(* ; "Edited 16-Feb-2026 08:54 by rmk")
|
||||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||||
(* ; "Edited 1-Feb-2024 11:25 by rmk")
|
(* ; "Edited 1-Feb-2024 11:25 by rmk")
|
||||||
(* ; "Edited 5-Jan-2024 17:57 by rmk")
|
(* ; "Edited 5-Jan-2024 17:57 by rmk")
|
||||||
@@ -1008,10 +984,6 @@
|
|||||||
'OBJECTBYTE)
|
'OBJECTBYTE)
|
||||||
(PCONTENTS PC)))
|
(PCONTENTS PC)))
|
||||||
(UTF8.PTYPE (UTF8.PEEKCCODEFN (PCONTENTS PC)))
|
(UTF8.PTYPE (UTF8.PEEKCCODEFN (PCONTENTS PC)))
|
||||||
(FATFILE1.PTYPE
|
|
||||||
(LOGOR (LLSH (PCHARSET PC)
|
|
||||||
8)
|
|
||||||
(\PEEKBIN (PCONTENTS PC))))
|
|
||||||
(SUBSTREAM.PTYPE (* ; "A substream stored as an object")
|
(SUBSTREAM.PTYPE (* ; "A substream stored as an object")
|
||||||
(BIN (IMAGEOBJPROP (PCONTENTS PC)
|
(BIN (IMAGEOBJPROP (PCONTENTS PC)
|
||||||
'SUBSTREAM)))
|
'SUBSTREAM)))
|
||||||
@@ -1760,7 +1732,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.STREAMINIT
|
(\TEDIT.STREAMINIT
|
||||||
[LAMBDA NIL (* ; "Edited 16-Feb-2026 12:40 by rmk")
|
[LAMBDA NIL (* ; "Edited 24-Feb-2026 23:38 by rmk")
|
||||||
|
(* ; "Edited 16-Feb-2026 12:40 by rmk")
|
||||||
(* ; "Edited 26-Jan-2026 16:06 by rmk")
|
(* ; "Edited 26-Jan-2026 16:06 by rmk")
|
||||||
(* ; "Edited 23-Sep-2025 21:03 by rmk")
|
(* ; "Edited 23-Sep-2025 21:03 by rmk")
|
||||||
(* ; "Edited 20-Sep-2025 08:48 by rmk")
|
(* ; "Edited 20-Sep-2025 08:48 by rmk")
|
||||||
@@ -1823,7 +1796,7 @@
|
|||||||
(FUNCTION \TEDIT.TEXTBACKCCODEFN)
|
(FUNCTION \TEDIT.TEXTBACKCCODEFN)
|
||||||
(FUNCTION \TEDIT.TEXTOUTCHARFN)
|
(FUNCTION \TEDIT.TEXTOUTCHARFN)
|
||||||
(FUNCTION \TEDIT.TEXTFORMATBYTESTREAM)
|
(FUNCTION \TEDIT.TEXTFORMATBYTESTREAM)
|
||||||
'CR NIL (FUNCTION \TEDIT.TEXTFORMATBYTESTRING))
|
'CR T (FUNCTION \TEDIT.TEXTFORMATBYTESTRING))
|
||||||
|
|
||||||
(* ;; "Support for error handling: The old error handler for the stream-not-open error. ")
|
(* ;; "Support for error handling: The old error handler for the stream-not-open error. ")
|
||||||
|
|
||||||
@@ -2277,7 +2250,8 @@
|
|||||||
(IDIFFERENCE N START-OF-PIECE)))])
|
(IDIFFERENCE N START-OF-PIECE)))])
|
||||||
|
|
||||||
(\TEDIT.PIECE.NTHCHARCODE
|
(\TEDIT.PIECE.NTHCHARCODE
|
||||||
[LAMBDA (PC OFFSET) (* ; "Edited 15-Feb-2026 14:31 by rmk")
|
[LAMBDA (PC OFFSET) (* ; "Edited 9-Apr-2026 00:06 by rmk")
|
||||||
|
(* ; "Edited 15-Feb-2026 14:31 by rmk")
|
||||||
(* ; "Edited 24-Apr-2025 16:04 by rmk")
|
(* ; "Edited 24-Apr-2025 16:04 by rmk")
|
||||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||||
(* ; "Edited 29-Apr-2024 08:46 by rmk")
|
(* ; "Edited 29-Apr-2024 08:46 by rmk")
|
||||||
@@ -2304,14 +2278,6 @@
|
|||||||
OFFSET))
|
OFFSET))
|
||||||
(PROG1 (BIN PCONTENTS)
|
(PROG1 (BIN PCONTENTS)
|
||||||
(\SETFILEPTR PCONTENTS FILEPOS)))
|
(\SETFILEPTR PCONTENTS FILEPOS)))
|
||||||
(FATFILE1.PTYPE
|
|
||||||
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
|
||||||
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
|
||||||
OFFSET))
|
|
||||||
(PROG1 (create WORD
|
|
||||||
HIBYTE _ (PCHARSET PC)
|
|
||||||
LOBYTE _ (BIN PCONTENTS))
|
|
||||||
(\SETFILEPTR PCONTENTS FILEPOS)))
|
|
||||||
(FATFILE2.PTYPE
|
(FATFILE2.PTYPE
|
||||||
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
||||||
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
||||||
@@ -2359,7 +2325,8 @@
|
|||||||
TSTREAM))])
|
TSTREAM))])
|
||||||
|
|
||||||
(\TEDIT.PIECE.RPLCHARCODE
|
(\TEDIT.PIECE.RPLCHARCODE
|
||||||
[LAMBDA (TEXTOBJ PC OFFSET NEWCHARCODE NEWCHARLOOKS) (* ; "Edited 16-Feb-2026 08:41 by rmk")
|
[LAMBDA (TEXTOBJ PC OFFSET NEWCHARCODE NEWCHARLOOKS) (* ; "Edited 10-Apr-2026 09:32 by rmk")
|
||||||
|
(* ; "Edited 16-Feb-2026 08:41 by rmk")
|
||||||
(* ; "Edited 28-Jul-2025 23:38 by rmk")
|
(* ; "Edited 28-Jul-2025 23:38 by rmk")
|
||||||
(* ; "Edited 24-Apr-2025 16:30 by rmk")
|
(* ; "Edited 24-Apr-2025 16:30 by rmk")
|
||||||
(* ; "Edited 20-Apr-2025 13:25 by rmk")
|
(* ; "Edited 20-Apr-2025 13:25 by rmk")
|
||||||
@@ -2393,10 +2360,7 @@
|
|||||||
(CL:WHEN (AND (EQ THINSTRING.PTYPE (PTYPE PC))
|
(CL:WHEN (AND (EQ THINSTRING.PTYPE (PTYPE PC))
|
||||||
(IGREATERP NEWCHARCODE \MAXTHINCHAR))
|
(IGREATERP NEWCHARCODE \MAXTHINCHAR))
|
||||||
(FSETPC PC PTYPE FATSTRING.PTYPE)
|
(FSETPC PC PTYPE FATSTRING.PTYPE)
|
||||||
(FSETPC PC PBINABLE NIL)
|
(FSETPC PC PBYTESPERCHAR 2))
|
||||||
(FSETPC PC PBYTESPERCHAR 2)
|
|
||||||
(FSETPC PC PBYTELEN (UNFOLD (PLEN PC)
|
|
||||||
2)))
|
|
||||||
elseif [AND (IMAGEOBJP NEWCHARCODE)
|
elseif [AND (IMAGEOBJP NEWCHARCODE)
|
||||||
(EQ OBJECT.PTYPE (PTYPE PC))
|
(EQ OBJECT.PTYPE (PTYPE PC))
|
||||||
(OR (NULL NEWCHARLOOKS)
|
(OR (NULL NEWCHARLOOKS)
|
||||||
@@ -2425,24 +2389,17 @@
|
|||||||
|
|
||||||
(SETQ OLDCHAR (\TEDIT.PIECE.NTHCHARCODE PC 0))
|
(SETQ OLDCHAR (\TEDIT.PIECE.NTHCHARCODE PC 0))
|
||||||
(if (IMAGEOBJP NEWCHARCODE)
|
(if (IMAGEOBJP NEWCHARCODE)
|
||||||
then (FSETPC PC PBINABLE NIL)
|
then (FSETPC PC PCONTENTS NEWCHARCODE)
|
||||||
(FSETPC PC PCONTENTS NEWCHARCODE)
|
|
||||||
(FSETPC PC PTYPE OBJECT.PTYPE)
|
(FSETPC PC PTYPE OBJECT.PTYPE)
|
||||||
(FSETPC PC PBYTESPERCHAR NIL) (* ; "Doesn't make sense for objects")
|
(FSETPC PC PBYTESPERCHAR NIL) (* ; "Doesn't make sense for objects")
|
||||||
(FSETPC PC PBYTELEN NIL)
|
|
||||||
else (FSETPC PC PCONTENTS (MKSTRING (CHARACTER NEWCHARCODE)))
|
else (FSETPC PC PCONTENTS (MKSTRING (CHARACTER NEWCHARCODE)))
|
||||||
(* ;
|
(* ;
|
||||||
"Use the extend-string in INSERTCH for repeated calls?")
|
"Use the extend-string in INSERTCH for repeated calls?")
|
||||||
(if (IGREATERP NEWCHARCODE \MAXTHINCHAR)
|
(if (IGREATERP NEWCHARCODE \MAXTHINCHAR)
|
||||||
then (FSETPC PC PTYPE FATSTRING.PTYPE)
|
then (FSETPC PC PTYPE FATSTRING.PTYPE)
|
||||||
(FSETPC PC PBINABLE NIL)
|
|
||||||
(FSETPC PC PBYTESPERCHAR 2)
|
(FSETPC PC PBYTESPERCHAR 2)
|
||||||
(FSETPC PC PBYTELEN 2)
|
|
||||||
else (FSETPC PC PTYPE THINSTRING.PTYPE)
|
else (FSETPC PC PTYPE THINSTRING.PTYPE)
|
||||||
(FSETPC PC PBINABLE T)
|
(FSETPC PC PBYTESPERCHAR 1)))
|
||||||
(FSETPC PC PBYTESPERCHAR 1)
|
|
||||||
(FSETPC PC PBYTELEN 1)
|
|
||||||
(FSETPC PC PCHARSET 0)))
|
|
||||||
(FSETPC PC PFPOS NIL)
|
(FSETPC PC PFPOS NIL)
|
||||||
(CL:WHEN NEWCHARLOOKS
|
(CL:WHEN NEWCHARLOOKS
|
||||||
(FSETPC PC PCHARLOOKS (CL:IF (FONTP NEWCHARLOOKS)
|
(FSETPC PC PCHARLOOKS (CL:IF (FONTP NEWCHARLOOKS)
|
||||||
@@ -2546,7 +2503,8 @@
|
|||||||
T)])
|
T)])
|
||||||
|
|
||||||
(\TEDIT.INSERTCH
|
(\TEDIT.INSERTCH
|
||||||
[LAMBDA (CH CH# TEXTOBJ PARALAST) (* ; "Edited 26-Jul-2025 21:13 by rmk")
|
[LAMBDA (CH CH# TEXTOBJ PARALAST) (* ; "Edited 10-Apr-2026 09:46 by rmk")
|
||||||
|
(* ; "Edited 26-Jul-2025 21:13 by rmk")
|
||||||
(* ; "Edited 26-Mar-2025 00:29 by rmk")
|
(* ; "Edited 26-Mar-2025 00:29 by rmk")
|
||||||
(* ; "Edited 22-Nov-2024 13:48 by rmk")
|
(* ; "Edited 22-Nov-2024 13:48 by rmk")
|
||||||
(* ; "Edited 22-Sep-2024 12:32 by rmk")
|
(* ; "Edited 22-Sep-2024 12:32 by rmk")
|
||||||
@@ -2634,14 +2592,9 @@
|
|||||||
PNEW _ T))
|
PNEW _ T))
|
||||||
(SELECTC INSERTPTYPE
|
(SELECTC INSERTPTYPE
|
||||||
(THINSTRING.PTYPE
|
(THINSTRING.PTYPE
|
||||||
(FSETPC PREVPC PBYTESPERCHAR 1)
|
(FSETPC PREVPC PBYTESPERCHAR 1))
|
||||||
(FSETPC PREVPC PBYTELEN ILEN)
|
(FATSTRING.PTYPE
|
||||||
(FSETPC PREVPC PBINABLE T)
|
(FSETPC PREVPC PBYTESPERCHAR 2))
|
||||||
(FSETPC PREVPC PCHARSET 0))
|
|
||||||
(FATSTRING.PTYPE (* ; "PCHARSET is not relevant")
|
|
||||||
(FSETPC PREVPC PBYTESPERCHAR 2)
|
|
||||||
(FSETPC PREVPC PBYTELEN (UNFOLD ILEN 2))
|
|
||||||
(FSETPC PREVPC PBINABLE NIL))
|
|
||||||
(\TEDIT.THELP "Unexpected PTYPE"))
|
(\TEDIT.THELP "Unexpected PTYPE"))
|
||||||
(\TEDIT.INSERTPIECE PREVPC INSERTPC TEXTOBJ))
|
(\TEDIT.INSERTPIECE PREVPC INSERTPC TEXTOBJ))
|
||||||
|
|
||||||
@@ -2785,7 +2738,8 @@
|
|||||||
INSERTION])
|
INSERTION])
|
||||||
|
|
||||||
(\TEDIT.INSERTCH.EXTEND
|
(\TEDIT.INSERTCH.EXTEND
|
||||||
[LAMBDA (PC ILEN TEXTOBJ) (* ; "Edited 16-Mar-2024 09:56 by rmk")
|
[LAMBDA (PC ILEN TEXTOBJ) (* ; "Edited 9-Apr-2026 13:24 by rmk")
|
||||||
|
(* ; "Edited 16-Mar-2024 09:56 by rmk")
|
||||||
(* ; "Edited 21-Jan-2024 14:09 by rmk")
|
(* ; "Edited 21-Jan-2024 14:09 by rmk")
|
||||||
(* ; "Edited 12-Apr-2023 09:37 by rmk")
|
(* ; "Edited 12-Apr-2023 09:37 by rmk")
|
||||||
(* ; "Edited 1-Sep-2022 08:26 by rmk")
|
(* ; "Edited 1-Sep-2022 08:26 by rmk")
|
||||||
@@ -2796,8 +2750,6 @@
|
|||||||
|
|
||||||
(add (PLEN PC)
|
(add (PLEN PC)
|
||||||
ILEN)
|
ILEN)
|
||||||
(FSETPC PC PBYTELEN (ITIMES (PLEN PC)
|
|
||||||
(PBYTESPERCHAR PC)))
|
|
||||||
(add (ffetch (STRINGP LENGTH) of (PCONTENTS PC))
|
(add (ffetch (STRINGP LENGTH) of (PCONTENTS PC))
|
||||||
ILEN)
|
ILEN)
|
||||||
(add (ffetch (BTSLOT DLEN) of (\FINDSLOT (ffetch (PIECE PTREENODE) of PC)
|
(add (ffetch (BTSLOT DLEN) of (\FINDSLOT (ffetch (PIECE PTREENODE) of PC)
|
||||||
@@ -2836,7 +2788,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.INSTALL.PIECE
|
(\TEDIT.INSTALL.PIECE
|
||||||
[LAMBDA (TSTREAM PC CHOFFSET) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
[LAMBDA (TSTREAM PC CHOFFSET) (* ; "Edited 26-Apr-2026 23:46 by rmk")
|
||||||
|
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||||
(* ; "Edited 18-May-2024 22:39 by rmk")
|
(* ; "Edited 18-May-2024 22:39 by rmk")
|
||||||
(* ; "Edited 9-May-2024 22:34 by rmk")
|
(* ; "Edited 9-May-2024 22:34 by rmk")
|
||||||
(* ; "Edited 18-Mar-2024 22:26 by rmk")
|
(* ; "Edited 18-Mar-2024 22:26 by rmk")
|
||||||
@@ -2891,7 +2844,11 @@
|
|||||||
PLEN)))
|
PLEN)))
|
||||||
(OBJECT.PTYPE (freplace (STREAM CBUFSIZE) of TSTREAM with 1))
|
(OBJECT.PTYPE (freplace (STREAM CBUFSIZE) of TSTREAM with 1))
|
||||||
NIL)
|
NIL)
|
||||||
(freplace (STREAM BINABLE) of TSTREAM with (PBINABLE PC))
|
|
||||||
|
(* ;; "Would work for an ASCII. PTYPE or 1-byte UTF-8, except for MCCS/UNICODE differences.")
|
||||||
|
|
||||||
|
[freplace (STREAM BINABLE) of TSTREAM with (OR (EQ THINFILE.PTYPE (PTYPE PC))
|
||||||
|
(EQ THINSTRING.PTYPE (PTYPE PC]
|
||||||
(freplace (TEXTSTREAM STARTINGCOFFSET) of TSTREAM with (ffetch (STREAM COFFSET)
|
(freplace (TEXTSTREAM STARTINGCOFFSET) of TSTREAM with (ffetch (STREAM COFFSET)
|
||||||
of TSTREAM))
|
of TSTREAM))
|
||||||
(freplace (TEXTSTREAM PCCHARSLEFT) of TSTREAM with PCCHARSLEFT)
|
(freplace (TEXTSTREAM PCCHARSLEFT) of TSTREAM with PCCHARSLEFT)
|
||||||
@@ -3127,33 +3084,33 @@
|
|||||||
(ADDTOVAR LAMA TEXTPROP)
|
(ADDTOVAR LAMA TEXTPROP)
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (36667 67629 (\TEDIT.TEXTBIN 36677 . 47470) (\TEDIT.TEXTPEEKBIN 47472 . 53022) (
|
(FILEMAP (NIL (36156 66033 (\TEDIT.TEXTBIN 36166 . 46068) (\TEDIT.TEXTPEEKBIN 46070 . 51495) (
|
||||||
\TEDIT.TEXTBACKFILEPTR 53024 . 58800) (\TEDIT.TEXTBOUT 58802 . 63419) (\TEDIT.INSTALL.FILEBUFFER 63421
|
\TEDIT.TEXTBACKFILEPTR 51497 . 57204) (\TEDIT.TEXTBOUT 57206 . 61823) (\TEDIT.INSTALL.FILEBUFFER 61825
|
||||||
. 67627)) (68527 72818 (\TEDIT.TEXTOUTCHARFN 68537 . 70093) (\TEDIT.TEXTINCCODEFN 70095 . 70834) (
|
. 66031)) (66931 71222 (\TEDIT.TEXTOUTCHARFN 66941 . 68497) (\TEDIT.TEXTINCCODEFN 68499 . 69238) (
|
||||||
\TEDIT.TEXTBACKCCODEFN 70836 . 71428) (\TEDIT.TEXTFORMATBYTESTREAM 71430 . 72267) (
|
\TEDIT.TEXTBACKCCODEFN 69240 . 69832) (\TEDIT.TEXTFORMATBYTESTREAM 69834 . 70671) (
|
||||||
\TEDIT.TEXTFORMATBYTESTRING 72269 . 72816)) (72865 84940 (OPENTEXTSTREAM 72875 . 79851) (
|
\TEDIT.TEXTFORMATBYTESTRING 70673 . 71220)) (71269 83344 (OPENTEXTSTREAM 71279 . 78255) (
|
||||||
COPYTEXTSTREAM 79853 . 84163) (TEDIT.STREAMCHANGEDP 84165 . 84467) (TXTFILE 84469 . 84938)) (84941
|
COPYTEXTSTREAM 78257 . 82567) (TEDIT.STREAMCHANGEDP 82569 . 82871) (TXTFILE 82873 . 83342)) (83345
|
||||||
108146 (\TEDIT.REOPENTEXTSTREAM 84951 . 86303) (\TEDIT.OPENTEXTSTREAM.PIECES 86305 . 91233) (
|
106550 (\TEDIT.REOPENTEXTSTREAM 83355 . 84707) (\TEDIT.OPENTEXTSTREAM.PIECES 84709 . 89637) (
|
||||||
\TEDIT.OPENTEXTSTREAM.PROPS 91235 . 92337) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92339 . 97789) (
|
\TEDIT.OPENTEXTSTREAM.PROPS 89639 . 90741) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 90743 . 96193) (
|
||||||
\TEDIT.OPENTEXTSTREAM.WINDOW 97791 . 100582) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100584 . 102523) (
|
\TEDIT.OPENTEXTSTREAM.WINDOW 96195 . 98986) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 98988 . 100927) (
|
||||||
\TEDIT.OPENTEXTFILE 102525 . 104657) (\TEDIT.CREATE.TEXTSTREAM 104659 . 105806) (\TEDIT.REOPEN.STREAM
|
\TEDIT.OPENTEXTFILE 100929 . 103061) (\TEDIT.CREATE.TEXTSTREAM 103063 . 104210) (\TEDIT.REOPEN.STREAM
|
||||||
105808 . 108144)) (108147 116372 (\TEDIT.STREAMINIT 108157 . 116189) (TEDIT.IMAGESTREAM.OPEN 116191 .
|
104212 . 106548)) (106551 114883 (\TEDIT.STREAMINIT 106561 . 114700) (TEDIT.IMAGESTREAM.OPEN 114702 .
|
||||||
116370)) (116560 117748 (\TEDIT.TTYBOUT 116570 . 117746)) (117866 139549 (\TEDIT.TEXTCLOSEF 117876 .
|
114881)) (115071 116259 (\TEDIT.TTYBOUT 115081 . 116257)) (116377 138060 (\TEDIT.TEXTCLOSEF 116387 .
|
||||||
119200) (\TEDIT.TEXTDSPFONT 119202 . 120400) (\TEDIT.TEXTEOFP 120402 . 122157) (\TEDIT.TEXTGETEOFPTR
|
117711) (\TEDIT.TEXTDSPFONT 117713 . 118911) (\TEDIT.TEXTEOFP 118913 . 120668) (\TEDIT.TEXTGETEOFPTR
|
||||||
122159 . 122482) (\TEDIT.TEXTSETEOFPTR 122484 . 123771) (\TEDIT.TEXTGETFILEPTR 123773 . 126608) (
|
120670 . 120993) (\TEDIT.TEXTSETEOFPTR 120995 . 122282) (\TEDIT.TEXTGETFILEPTR 122284 . 125119) (
|
||||||
\TEDIT.TEXTSETFILEINFO 126610 . 127118) (\TEDIT.TEXTOPENF 127120 . 128051) (\TEDIT.TEXTSETEOF 128053
|
\TEDIT.TEXTSETFILEINFO 125121 . 125629) (\TEDIT.TEXTOPENF 125631 . 126562) (\TEDIT.TEXTSETEOF 126564
|
||||||
. 128669) (\TEDIT.TEXTSETFILEPTR 128671 . 130781) (\TEDIT.TEXTDSPXPOSITION 130783 . 133486) (
|
. 127180) (\TEDIT.TEXTSETFILEPTR 127182 . 129292) (\TEDIT.TEXTDSPXPOSITION 129294 . 131997) (
|
||||||
\TEDIT.TEXTDSPYPOSITION 133488 . 134229) (\TEDIT.TEXTLEFTMARGIN 134231 . 134822) (\TEDIT.TEXTCOLOR
|
\TEDIT.TEXTDSPYPOSITION 131999 . 132740) (\TEDIT.TEXTLEFTMARGIN 132742 . 133333) (\TEDIT.TEXTCOLOR
|
||||||
134824 . 135407) (\TEDIT.TEXTRIGHTMARGIN 135409 . 138698) (\TEDIT.TEXTDSPCHARWIDTH 138700 . 139004) (
|
133335 . 133918) (\TEDIT.TEXTRIGHTMARGIN 133920 . 137209) (\TEDIT.TEXTDSPCHARWIDTH 137211 . 137515) (
|
||||||
\TEDIT.TEXTDSPSTRINGWIDTH 139006 . 139312) (\TEDIT.TEXTDSPLINEFEED 139314 . 139547)) (139587 152583 (
|
\TEDIT.TEXTDSPSTRINGWIDTH 137517 . 137823) (\TEDIT.TEXTDSPLINEFEED 137825 . 138058)) (138098 150332 (
|
||||||
\TEDIT.NTHCHARCODE 139597 . 141123) (\TEDIT.PIECE.NTHCHARCODE 141125 . 145033) (\TEDIT.RPLCHARCODE
|
\TEDIT.NTHCHARCODE 138108 . 139634) (\TEDIT.PIECE.NTHCHARCODE 139636 . 143204) (\TEDIT.RPLCHARCODE
|
||||||
145035 . 146593) (\TEDIT.PIECE.RPLCHARCODE 146595 . 152228) (\TEDIT.NTHCHARLOOKS 152230 . 152581)) (
|
143206 . 144764) (\TEDIT.PIECE.RPLCHARCODE 144766 . 149977) (\TEDIT.NTHCHARLOOKS 149979 . 150330)) (
|
||||||
153630 174724 (\TEDIT.DELETE.SELPIECES 153640 . 157265) (\TEDIT.INSERTCH 157267 . 165306) (
|
151379 172254 (\TEDIT.DELETE.SELPIECES 151389 . 155014) (\TEDIT.INSERTCH 155016 . 162821) (
|
||||||
\TEDIT.INSERTCH.HISTORY 165308 . 168772) (\TEDIT.INSERTEOL 168774 . 170599) (\TEDIT.INSERTCH.INSERTION
|
\TEDIT.INSERTCH.HISTORY 162823 . 166287) (\TEDIT.INSERTEOL 166289 . 168114) (\TEDIT.INSERTCH.INSERTION
|
||||||
170601 . 173438) (\TEDIT.INSERTCH.EXTEND 173440 . 174722)) (174725 176332 (\TEDIT.NEXTCHANGEABLE.CHNO
|
168116 . 170953) (\TEDIT.INSERTCH.EXTEND 170955 . 172252)) (172255 173862 (\TEDIT.NEXTCHANGEABLE.CHNO
|
||||||
174735 . 175450) (\TEDIT.LASTCHANGEABLE.CHNO 175452 . 176330)) (176333 180791 (\TEDIT.INSTALL.PIECE
|
172265 . 172980) (\TEDIT.LASTCHANGEABLE.CHNO 172982 . 173860)) (173863 178652 (\TEDIT.INSTALL.PIECE
|
||||||
176343 . 180789)) (180829 190295 (TEXTPROP 180839 . 181186) (GETTEXTPROP 181188 . 181432) (PUTTEXTPROP
|
173873 . 178650)) (178690 188156 (TEXTPROP 178700 . 179047) (GETTEXTPROP 179049 . 179293) (PUTTEXTPROP
|
||||||
181434 . 181691) (GETTEXTPROPS 181693 . 182137) (PUTTEXTPROPS 182139 . 183043) (TEXTPROP.ADD 183045
|
179295 . 179552) (GETTEXTPROPS 179554 . 179998) (PUTTEXTPROPS 180000 . 180904) (TEXTPROP.ADD 180906
|
||||||
. 183308) (\TEDIT.TEXTPROP 183310 . 190293)) (190296 192673 (\TEDIT.TEXTOBJ.PROPNAMES 190306 . 191565
|
. 181169) (\TEDIT.TEXTPROP 181171 . 188154)) (188157 190534 (\TEDIT.TEXTOBJ.PROPNAMES 188167 . 189426
|
||||||
) (\TEDIT.TEXTOBJ.PROPFETCHFN 191567 . 192083) (\TEDIT.TEXTOBJ.PROPSTOREFN 192085 . 192671)))))
|
) (\TEDIT.TEXTOBJ.PROPFETCHFN 189428 . 189944) (\TEDIT.TEXTOBJ.PROPSTOREFN 189946 . 190532)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
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 "21-Jan-2026 12:15:57" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;190 98203
|
(FILECREATED "10-Apr-2026 09:25:52" {WMEDLEY}<library>tedit>TEDIT-TFBRAVO.;192 97960
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS BRAVOFILEP)
|
:CHANGES-TO (FNS \TFBRAVO.INSERT.RUN)
|
||||||
(VARS TEDIT-TFBRAVOCOMS)
|
|
||||||
|
|
||||||
:PREVIOUS-DATE " 7-Sep-2025 11:11:43" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;187)
|
:PREVIOUS-DATE " 9-Apr-2026 17:24:28" {WMEDLEY}<library>tedit>TEDIT-TFBRAVO.;191)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
|
(PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
|
||||||
@@ -1027,7 +1026,8 @@
|
|||||||
(\TFBRAVO.INSERT.RUN RUN BSTREAM PARALOOKS TEXTOBJ])
|
(\TFBRAVO.INSERT.RUN RUN BSTREAM PARALOOKS TEXTOBJ])
|
||||||
|
|
||||||
(\TFBRAVO.INSERT.RUN
|
(\TFBRAVO.INSERT.RUN
|
||||||
[LAMBDA (RUN BSTREAM PARALOOKS TEXTOBJ) (* ; "Edited 28-Jul-2025 23:33 by rmk")
|
[LAMBDA (RUN BSTREAM PARALOOKS TEXTOBJ) (* ; "Edited 10-Apr-2026 09:22 by rmk")
|
||||||
|
(* ; "Edited 28-Jul-2025 23:33 by rmk")
|
||||||
(* ; "Edited 8-Feb-2025 23:08 by rmk")
|
(* ; "Edited 8-Feb-2025 23:08 by rmk")
|
||||||
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
(* ; "Edited 17-Mar-2024 12:41 by rmk")
|
||||||
(* ; "Edited 16-Jan-2024 18:28 by rmk")
|
(* ; "Edited 16-Jan-2024 18:28 by rmk")
|
||||||
@@ -1064,17 +1064,11 @@
|
|||||||
THINSTRING.PTYPE))
|
THINSTRING.PTYPE))
|
||||||
(SETQ PBYTESPERCHAR (CL:IF FATP
|
(SETQ PBYTESPERCHAR (CL:IF FATP
|
||||||
2
|
2
|
||||||
1))
|
1)))
|
||||||
(SETQ PBINABLE (NOT FATP))
|
|
||||||
(SETQ PBYTELEN (UNFOLD NCHARS 2))
|
|
||||||
(SETQ PUTF8BYTESPERCHAR 2))
|
|
||||||
else (with PIECE PC (SETQ PCONTENTS BSTREAM)
|
else (with PIECE PC (SETQ PCONTENTS BSTREAM)
|
||||||
(SETQ PFPOS RUNSTART)
|
(SETQ PFPOS RUNSTART)
|
||||||
(SETQ PTYPE THINFILE.PTYPE)
|
(SETQ PTYPE THINFILE.PTYPE)
|
||||||
(SETQ PBINABLE T)
|
(SETQ PBYTESPERCHAR 1)))
|
||||||
(SETQ PBYTESPERCHAR 1)
|
|
||||||
(SETQ PBYTELEN NCHARS)
|
|
||||||
(SETQ PUTF8BYTESPERCHAR 2)))
|
|
||||||
(\TEDIT.INSERTPIECE PC NIL TEXTOBJ)
|
(\TEDIT.INSERTPIECE PC NIL TEXTOBJ)
|
||||||
PC))])
|
PC))])
|
||||||
|
|
||||||
@@ -1571,18 +1565,18 @@
|
|||||||
(AND NIL (\TEDIT.NAMEDTAB.INIT))
|
(AND NIL (\TEDIT.NAMEDTAB.INIT))
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (7784 15335 (BRAVOFILEP 7794 . 9981) (TEDITFROMBRAVO 9983 . 15333)) (15610 32026 (
|
(FILEMAP (NIL (7750 15301 (BRAVOFILEP 7760 . 9947) (TEDITFROMBRAVO 9949 . 15299)) (15576 31992 (
|
||||||
\TFBRAVO.GET.USER.CM 15620 . 18800) (\TFBRAVO.USER.CM.LOOKS 18802 . 20295) (\TFBRAVO.READ.USER.CM
|
\TFBRAVO.GET.USER.CM 15586 . 18766) (\TFBRAVO.USER.CM.LOOKS 18768 . 20261) (\TFBRAVO.READ.USER.CM
|
||||||
20297 . 24920) (\TFBRAVO.INIT.PARALOOKS 24922 . 27139) (\TFBRAVO.INIT.PAGEFORMAT 27141 . 28021) (
|
20263 . 24886) (\TFBRAVO.INIT.PARALOOKS 24888 . 27105) (\TFBRAVO.INIT.PAGEFORMAT 27107 . 27987) (
|
||||||
\TFBRAVO.GETPARAMS 28023 . 30877) (\TFBRAVO.FIND.LAST.TRAILER 30879 . 32024)) (32068 52773 (
|
\TFBRAVO.GETPARAMS 27989 . 30843) (\TFBRAVO.FIND.LAST.TRAILER 30845 . 31990)) (32034 52739 (
|
||||||
\TFBRAVO.PARSE.PARA 32078 . 36005) (\TFBRAVO.READ.PARALOOKS 36007 . 42897) (\TFBRAVO.CREATE.RUNS 42899
|
\TFBRAVO.PARSE.PARA 32044 . 35971) (\TFBRAVO.READ.PARALOOKS 35973 . 42863) (\TFBRAVO.CREATE.RUNS 42865
|
||||||
. 44287) (\TFBRAVO.READ.CHARLOOKS 44289 . 49318) (\TFBRAVO.FONT.FROM.CHARLOOKS 49320 . 50874) (
|
. 44253) (\TFBRAVO.READ.CHARLOOKS 44255 . 49284) (\TFBRAVO.FONT.FROM.CHARLOOKS 49286 . 50840) (
|
||||||
\TFBRAVO.READNUM? 50876 . 52771)) (52810 63851 (\TFBRAVO.HANDLE.HEADING 52820 . 55547) (
|
\TFBRAVO.READNUM? 50842 . 52737)) (52776 63817 (\TFBRAVO.HANDLE.HEADING 52786 . 55513) (
|
||||||
\TFBRAVO.PARSE.PROFILE.PARA 55549 . 63849)) (63894 86228 (\TFBRAVO.INSERT.PARA 63904 . 64745) (
|
\TFBRAVO.PARSE.PROFILE.PARA 55515 . 63815)) (63860 85985 (\TFBRAVO.INSERT.PARA 63870 . 64711) (
|
||||||
\TFBRAVO.INSERT.RUN 64747 . 68238) (\TFBRAVO.SPLIT.PARA 68240 . 75664) (\TFBRAVO.RUN.TABSPEC 75666 .
|
\TFBRAVO.INSERT.RUN 64713 . 67995) (\TFBRAVO.SPLIT.PARA 67997 . 75421) (\TFBRAVO.RUN.TABSPEC 75423 .
|
||||||
80533) (\TFBRAVO.INSTALL.PAGEFORMAT 80535 . 86226)) (86229 90372 (\TFBRAVO.ASSERT 86239 . 86769) (
|
80290) (\TFBRAVO.INSTALL.PAGEFORMAT 80292 . 85983)) (85986 90129 (\TFBRAVO.ASSERT 85996 . 86526) (
|
||||||
\TEST.CHARACTER.LOOKS 86771 . 88657) (\TEST.PARAGRAPH.LOOKS 88659 . 90370)) (91382 98037 (
|
\TEST.CHARACTER.LOOKS 86528 . 88414) (\TEST.PARAGRAPH.LOOKS 88416 . 90127)) (91139 97794 (
|
||||||
\TFBRAVO.ADD.NAMEDTAB 91392 . 94995) (\TFBRAVO.COPY.NAMEDTAB 94997 . 95445) (\TFBRAVO.PUT.NAMEDTAB
|
\TFBRAVO.ADD.NAMEDTAB 91149 . 94752) (\TFBRAVO.COPY.NAMEDTAB 94754 . 95202) (\TFBRAVO.PUT.NAMEDTAB
|
||||||
95447 . 95727) (\TFBRAVO.GET.NAMEDTAB 95729 . 96106) (\NAMEDTABNYET 96108 . 96268) (\NAMEDTABSIZE
|
95204 . 95484) (\TFBRAVO.GET.NAMEDTAB 95486 . 95863) (\NAMEDTABNYET 95865 . 96025) (\NAMEDTABSIZE
|
||||||
96270 . 96785) (\NAMEDTABPREPRINT 96787 . 96985) (\TEDIT.NAMEDTAB.INIT 96987 . 98035)))))
|
96027 . 96542) (\NAMEDTABPREPRINT 96544 . 96742) (\TEDIT.NAMEDTAB.INIT 96744 . 97792)))))
|
||||||
STOP
|
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 "24-Dec-2025 11:22:33" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;883 231422
|
(FILECREATED " 7-Feb-2026 18:53:22" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;896 234678
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS \TEDIT.MINIMAL.WINDOW.SETUP TEDIT.PROMPTCLEAR TEDIT.PROMPTPRINT)
|
:CHANGES-TO (FNS TEDIT.PROMPTPRINT)
|
||||||
|
|
||||||
:PREVIOUS-DATE "15-Nov-2025 01:27:38" {WMEDLEY}<library>tedit>TEDIT-WINDOW.;881)
|
:PREVIOUS-DATE " 5-Feb-2026 08:24:23" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;895)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-WINDOWCOMS)
|
(PRETTYCOMPRINT TEDIT-WINDOWCOMS)
|
||||||
@@ -458,7 +458,10 @@
|
|||||||
WINDOW])
|
WINDOW])
|
||||||
|
|
||||||
(\TEDIT.WINDOW.GETREGION
|
(\TEDIT.WINDOW.GETREGION
|
||||||
[LAMBDA (TSTREAM REGIONTYPE PHEIGHT) (* ; "Edited 25-Oct-2025 10:27 by rmk")
|
[LAMBDA (TSTREAM REGIONTYPE PHEIGHT) (* ; "Edited 5-Feb-2026 08:24 by rmk")
|
||||||
|
(* ; "Edited 27-Jan-2026 15:30 by rmk")
|
||||||
|
(* ; "Edited 25-Jan-2026 20:09 by rmk")
|
||||||
|
(* ; "Edited 25-Oct-2025 10:27 by rmk")
|
||||||
(* ; "Edited 19-Oct-2025 01:05 by rmk")
|
(* ; "Edited 19-Oct-2025 01:05 by rmk")
|
||||||
(* ; "Edited 14-Apr-2025 00:05 by rmk")
|
(* ; "Edited 14-Apr-2025 00:05 by rmk")
|
||||||
(* ; "Edited 31-Mar-2025 22:43 by rmk")
|
(* ; "Edited 31-Mar-2025 22:43 by rmk")
|
||||||
@@ -466,87 +469,94 @@
|
|||||||
(* ; "Edited 18-Mar-2025 21:52 by rmk")
|
(* ; "Edited 18-Mar-2025 21:52 by rmk")
|
||||||
(* ; "Edited 19-Feb-2025 16:48 by rmk")
|
(* ; "Edited 19-Feb-2025 16:48 by rmk")
|
||||||
(* ; "Edited 18-Feb-2025 10:09 by rmk")
|
(* ; "Edited 18-Feb-2025 10:09 by rmk")
|
||||||
(LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
(LET* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
|
||||||
[WIDTHOVERHEAD (IPLUS \TEDIT.LINEREGION.WIDTH (TIMES 2 WBorder)
|
[WIDTHOVERHEAD (IPLUS \TEDIT.LINEREGION.WIDTH (TIMES 2 WBorder)
|
||||||
(if (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)
|
(if (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)
|
||||||
then 0
|
then 0
|
||||||
elseif (ILEQ \TEDIT.OP.WIDTH 0)
|
elseif (ILEQ \TEDIT.OP.WIDTH 0)
|
||||||
then
|
then
|
||||||
(* ;; "On both sides, for symmetry")
|
(* ;; "On both sides, for symmetry")
|
||||||
|
|
||||||
\TEDIT.LINEREGION.WIDTH
|
\TEDIT.LINEREGION.WIDTH
|
||||||
else
|
else
|
||||||
(* ;;
|
(* ;;
|
||||||
"36 to allow for some spacing between the text and the OPS area on the right.")
|
"36 to allow for some spacing between the text and the OPS area on the right.")
|
||||||
|
|
||||||
(IPLUS \TEDIT.OP.WIDTH 36]
|
(IPLUS \TEDIT.OP.WIDTH 36]
|
||||||
[HEIGHTOVERHEAD (IPLUS PHEIGHT (ADD1 (TIMES 2 WBorder))
|
[HEIGHTOVERHEAD (IPLUS PHEIGHT (ADD1 (TIMES 2 WBorder))
|
||||||
(FONTPROP WindowTitleDisplayStream 'HEIGHT]
|
(FONTPROP WindowTitleDisplayStream 'HEIGHT]
|
||||||
WIDTH HEIGHT)
|
WIDTH HEIGHT)
|
||||||
|
|
||||||
(* ;; "Explict properties cover content")
|
(* ;; "Explict properties cover content")
|
||||||
|
|
||||||
[SETQ WIDTH (OR (GETTEXTPROP TEXTOBJ 'OPENWIDTH)
|
[SETQ WIDTH (OR (GETTEXTPROP TEXTOBJ 'OPENWIDTH)
|
||||||
(for PARALOOKS in (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST)
|
(for PARALOOKS in (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST)
|
||||||
when (IGREATERP (GETPLOOKS PARALOOKS RIGHTMAR)
|
when (IGREATERP (GETPLOOKS PARALOOKS RIGHTMAR)
|
||||||
0) largest (GETPLOOKS PARALOOKS RIGHTMAR)
|
0) largest (GETPLOOKS PARALOOKS RIGHTMAR)
|
||||||
finally (RETURN $$EXTREME]
|
finally (RETURN $$EXTREME]
|
||||||
(SETQ HEIGHT (GETTEXTPROP TEXTOBJ 'OPENHEIGHT))
|
(SETQ HEIGHT (GETTEXTPROP TEXTOBJ 'OPENHEIGHT))
|
||||||
|
|
||||||
(* ;; "If still no WIDTH or HEIGHT, look at the first 20 lines")
|
(* ;; "If still no WIDTH or HEIGHT, look at the first 20 lines")
|
||||||
|
|
||||||
(CL:UNLESS (AND HEIGHT WIDTH)
|
(CL:UNLESS (AND HEIGHT WIDTH)
|
||||||
(for I L (TEXTLEN _ (TEXTLEN TEXTOBJ))
|
(for I L (TEXTLEN _ (TEXTLEN TEXTOBJ))
|
||||||
(REG _ (CREATEREGION 0 0 (IDIFFERENCE SCREENWIDTH WIDTHOVERHEAD)
|
(REG _ (CREATEREGION 0 0 (IDIFFERENCE SCREENWIDTH WIDTHOVERHEAD)
|
||||||
(IDIFFERENCE SCREENHEIGHT HEIGHTOVERHEAD)))
|
(IDIFFERENCE SCREENHEIGHT HEIGHTOVERHEAD)))
|
||||||
(W _ 0)
|
(IMAGESTREAM _ (CL:IF (\TEDIT.PRIMARYPANE TSTREAM)
|
||||||
(H _ 0)
|
(WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM)
|
||||||
(CHNO _ 1) from 1 to 20 while (ILEQ CHNO TEXTLEN)
|
'DSP)
|
||||||
do
|
(DSPCREATE)))
|
||||||
(* ;;
|
(W _ 0)
|
||||||
|
(H _ 0)
|
||||||
|
(CHNO _ 1) from 1 to 20 while (ILESSP CHNO TEXTLEN)
|
||||||
|
do
|
||||||
|
(* ;;
|
||||||
"But we start by saying that the right margin is infinite, so we can find the true width")
|
"But we start by saying that the right margin is infinite, so we can find the true width")
|
||||||
|
|
||||||
(SETQ L (\TEDIT.FORMATLINE TSTREAM CHNO NIL REG))
|
(SETQ L (\TEDIT.FORMATLINE TSTREAM CHNO NIL REG IMAGESTREAM))
|
||||||
(SETQ CHNO (FGETLD L LCHARLIM))
|
(SETQ CHNO (FGETLD L LCHARLIM))
|
||||||
(add H (FGETLD L LHEIGHT))
|
(add H (FGETLD L LHEIGHT))
|
||||||
(CL:UNLESS WIDTH
|
(CL:UNLESS WIDTH
|
||||||
(CL:WHEN (EQ 'LEFT (FGETPLOOKS (FGETLD L LPARALOOKS)
|
(CL:WHEN (EQ 'LEFT (FGETPLOOKS (FGETLD L LPARALOOKS)
|
||||||
QUAD))
|
QUAD))
|
||||||
|
|
||||||
(* ;;
|
(* ;;
|
||||||
"JUSTIFIED, RIGHT and CENTERED involve right margin, which we don't know")
|
"JUSTIFIED, RIGHT and CENTERED involve right margin, which we don't know")
|
||||||
|
|
||||||
(SETQ W (IMAX W (FGETLD L LXLIM)))))
|
(SETQ W (IMAX W (FGETLD L LXLIM)))))
|
||||||
finally (CL:UNLESS (OR WIDTH (EQ W 0)) (* ; "Maybe no lefts?")
|
finally (CL:UNLESS (OR WIDTH (EQ W 0)) (* ; "Maybe no lefts?")
|
||||||
(SETQ WIDTH W))
|
(SETQ WIDTH W))
|
||||||
(CL:UNLESS (OR HEIGHT (EQ H 0))
|
(CL:UNLESS (OR HEIGHT (EQ H 0))
|
||||||
(SETQ HEIGHT H))))
|
(SETQ HEIGHT H))))
|
||||||
|
|
||||||
(* ;; "Minimum sizes")
|
(* ;; "Minimum sizes: 90 characters by 10 lines")
|
||||||
|
|
||||||
(SETQ WIDTH (IMAX 200 (OR WIDTH 0)))
|
(CL:UNLESS WIDTH
|
||||||
(SETQ HEIGHT (IMAX 100 (OR HEIGHT 0)))
|
[SETQ WIDTH (TIMES 80 (FONTPROP TSTREAM 'AVGCHARWIDTH])
|
||||||
|
(CL:UNLESS HEIGHT
|
||||||
|
[SETQ HEIGHT (TIMES 10 (FONTPROP TSTREAM 'HEIGHT])
|
||||||
|
|
||||||
(* ;; "Allow for the extra stuff")
|
(* ;; "Allow for the extra stuff")
|
||||||
|
|
||||||
(add WIDTH WIDTHOVERHEAD)
|
(add WIDTH WIDTHOVERHEAD)
|
||||||
(add HEIGHT HEIGHTOVERHEAD)
|
(add HEIGHT HEIGHTOVERHEAD)
|
||||||
(if (GRAB-TYPED-REGION REGIONTYPE WIDTH HEIGHT 1.1)
|
(if (GRAB-TYPED-REGION REGIONTYPE WIDTH HEIGHT 1.1)
|
||||||
else
|
else
|
||||||
(* ;; "Maximum new sizes")
|
(* ;; "Maximum new sizes")
|
||||||
|
|
||||||
[SETQ WIDTH (IMIN WIDTH (FIXR (FTIMES SCREENWIDTH 0.9]
|
[SETQ WIDTH (IMIN WIDTH (FIXR (FTIMES SCREENWIDTH 0.9]
|
||||||
[SETQ HEIGHT (IMIN HEIGHT (FIXR (FTIMES SCREENHEIGHT 0.9]
|
[SETQ HEIGHT (IMIN HEIGHT (FIXR (FTIMES SCREENHEIGHT 0.9]
|
||||||
(CLRPROMPT) (* ; "System promptwindow")
|
(CLRPROMPT) (* ; "System promptwindow")
|
||||||
(printout PROMPTWINDOW "Please specify a " (OR REGIONTYPE "Tedit")
|
(printout PROMPTWINDOW "Please specify a " (OR REGIONTYPE "Tedit")
|
||||||
" region")
|
" region")
|
||||||
(CL:WHEN (TXTFILE TSTREAM)
|
(CL:WHEN (TXTFILE TSTREAM)
|
||||||
(printout PROMPTWINDOW " for " 2 (GETTEXTPROP TSTREAM 'FILENAME)))
|
(printout PROMPTWINDOW " for " 2 (GETTEXTPROP TSTREAM 'FILENAME)))
|
||||||
(TERPRI PROMPTWINDOW)
|
(TERPRI PROMPTWINDOW)
|
||||||
(GETBOXREGION WIDTH HEIGHT])
|
(GETBOXREGION WIDTH HEIGHT])
|
||||||
|
|
||||||
(\TEDIT.WINDOW.SETUP
|
(\TEDIT.WINDOW.SETUP
|
||||||
[LAMBDA (PANE TSTREAM PROPS AFTERPANE LCHAR1) (* ; "Edited 6-May-2025 11:44 by rmk")
|
[LAMBDA (PANE TSTREAM PROPS AFTERPANE LCHAR1) (* ; "Edited 15-Jan-2026 10:35 by rmk")
|
||||||
|
(* ; "Edited 6-May-2025 11:44 by rmk")
|
||||||
(* ; "Edited 21-Apr-2025 12:02 by rmk")
|
(* ; "Edited 21-Apr-2025 12:02 by rmk")
|
||||||
(* ; "Edited 6-Apr-2025 18:56 by rmk")
|
(* ; "Edited 6-Apr-2025 18:56 by rmk")
|
||||||
(* ; "Edited 5-Apr-2025 14:07 by rmk")
|
(* ; "Edited 5-Apr-2025 14:07 by rmk")
|
||||||
@@ -595,11 +605,12 @@
|
|||||||
(\TEDIT.CLEARPANE PANE)
|
(\TEDIT.CLEARPANE PANE)
|
||||||
(\TEDIT.SUFFIXLINE.CREATE PANE TSTREAM (\TEDIT.LINES.BELOW NIL PANE TSTREAM))
|
(\TEDIT.SUFFIXLINE.CREATE PANE TSTREAM (\TEDIT.LINES.BELOW NIL PANE TSTREAM))
|
||||||
(CL:WHEN AFTERPANE
|
(CL:WHEN AFTERPANE
|
||||||
(for PANE inpanes (PROGN TEXTOBJ) as L1 on (GETSEL SEL L1) as LN
|
(for P inpanes (PROGN TEXTOBJ) as L1 on (GETSEL SEL L1) as LN
|
||||||
on (GETSEL SEL LN) when (EQ PANE AFTERPANE) do (push (CDR L1)
|
on (GETSEL SEL LN) when (EQ P AFTERPANE) do (push (CDR L1)
|
||||||
NIL)
|
NIL)
|
||||||
(push (CDR LN)
|
(push (CDR LN)
|
||||||
NIL)))
|
NIL))
|
||||||
|
(WINDOWPROP PANE 'PROMPTWINDOW (WINDOWPROP AFTERPANE 'PROMPTWINDOW)))
|
||||||
(FSETSEL SEL HASCARET (NOT (FGETTOBJ TEXTOBJ TXTREADONLY)))
|
(FSETSEL SEL HASCARET (NOT (FGETTOBJ TEXTOBJ TXTREADONLY)))
|
||||||
(\TEDIT.FIXSEL SEL TSTREAM (AND AFTERPANE PANE)) (* ;
|
(\TEDIT.FIXSEL SEL TSTREAM (AND AFTERPANE PANE)) (* ;
|
||||||
"If not fixed, the highlight in the lower pane will disappear")
|
"If not fixed, the highlight in the lower pane will disappear")
|
||||||
@@ -775,7 +786,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.CURSORMOVEDFN
|
(\TEDIT.CURSORMOVEDFN
|
||||||
[LAMBDA (PANE) (* ; "Edited 27-Apr-2025 23:43 by rmk")
|
[LAMBDA (PANE) (* ; "Edited 14-Jan-2026 00:42 by rmk")
|
||||||
|
(* ; "Edited 27-Apr-2025 23:43 by rmk")
|
||||||
(* ; "Edited 24-Apr-2025 10:35 by rmk")
|
(* ; "Edited 24-Apr-2025 10:35 by rmk")
|
||||||
(* ; "Edited 19-Apr-2025 22:22 by rmk")
|
(* ; "Edited 19-Apr-2025 22:22 by rmk")
|
||||||
(* ; "Edited 1-Dec-2024 11:55 by rmk")
|
(* ; "Edited 1-Dec-2024 11:55 by rmk")
|
||||||
@@ -792,71 +804,68 @@
|
|||||||
|
|
||||||
(CL:WHEN (fetch (TEXTWINDOW WTEXTSTREAM) of (OR (WINDOWP PANE)
|
(CL:WHEN (fetch (TEXTWINDOW WTEXTSTREAM) of (OR (WINDOWP PANE)
|
||||||
(PANEWINDOW PANE)))
|
(PANEWINDOW PANE)))
|
||||||
[PROG ((X (LASTMOUSEX PANE))
|
[LET ((X (LASTMOUSEX PANE))
|
||||||
(Y (LASTMOUSEY PANE))
|
(Y (LASTMOUSEY PANE))
|
||||||
(TEXTOBJ (PANETEXTOBJ PANE))
|
(TEXTOBJ (PANETEXTOBJ PANE))
|
||||||
(CURSORREG (fetch (TEXTWINDOW CURSORREGION) of (PANEWINDOW PANE)))
|
(CURSORREG (fetch (TEXTWINDOW CURSORREGION) of (PANEWINDOW PANE)))
|
||||||
LINE LEFT)
|
LINE LEFT)
|
||||||
(CL:UNLESS (INSIDE? (PANEREGION PANE)
|
(CL:UNLESS (INSIDE? CURSORREG X Y)
|
||||||
X Y)
|
[if [AND (IGEQ X (SETQ LEFT (IDIFFERENCE (PANERIGHT PANE)
|
||||||
(CURSOR T)
|
\TEDIT.OP.WIDTH)))
|
||||||
(RETURN))
|
(IGEQ Y (IPLUS (PANEBOTTOM PANE)
|
||||||
(CL:UNLESS (INSIDE? CURSORREG X Y)
|
\TEDIT.OP.BOTTOM))
|
||||||
[if [AND (IGEQ X (SETQ LEFT (IDIFFERENCE (PANERIGHT PANE)
|
(NOT (OR (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)
|
||||||
\TEDIT.OP.WIDTH)))
|
(EQ \TEDIT.OP.WIDTH -1]
|
||||||
(IGEQ Y (IPLUS (PANEBOTTOM PANE)
|
then
|
||||||
\TEDIT.OP.BOTTOM))
|
(* ;; "We're in the split region on the right")
|
||||||
(NOT (OR (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)
|
|
||||||
(EQ \TEDIT.OP.WIDTH -1]
|
|
||||||
then
|
|
||||||
(* ;; "We're in the split region on the right")
|
|
||||||
|
|
||||||
(CURSOR \TEDIT.SPLITCURSOR)
|
(CURSOR \TEDIT.SPLITCURSOR)
|
||||||
(FSETTOBJ TEXTOBJ MOUSEREGION 'PANE)
|
(FSETTOBJ TEXTOBJ MOUSEREGION 'PANE)
|
||||||
(* ;
|
(* ;
|
||||||
"PANE just signals \TEDIT.BUTTONEVENTFN to do a split operation.")
|
"PANE just signals \TEDIT.BUTTONEVENTFN to do a split operation.")
|
||||||
(replace (REGION LEFT) of CURSORREG with LEFT)
|
(replace (REGION LEFT) of CURSORREG with LEFT)
|
||||||
(replace (REGION WIDTH) of CURSORREG with \TEDIT.OP.WIDTH)
|
(replace (REGION WIDTH) of CURSORREG with \TEDIT.OP.WIDTH)
|
||||||
else
|
else
|
||||||
(* ;; "Not in the split region. Are we in the line-select region on the left? Don't call PANEPREFIX, because that tests for LINEDESCRIPTOR")
|
(* ;; "Not in the split region. Are we in the line-select region on the left? Don't call PANEPREFIX, because that tests for LINEDESCRIPTOR")
|
||||||
|
|
||||||
(SETQ LINE (find L inlines (GETPANEPROP (PANEPROPS PANE)
|
(SETQ LINE (find L inlines (GETPANEPROP (PANEPROPS PANE)
|
||||||
PREFIXLINE)
|
PREFIXLINE)
|
||||||
suchthat (ILEQ (FGETLD L YBOT)
|
suchthat (ILEQ (FGETLD L YBOT)
|
||||||
Y)))
|
Y)))
|
||||||
(CL:WHEN LINE (* ;
|
(CL:WHEN LINE (* ;
|
||||||
"The CURSORREGION picks out just LINE")
|
"The CURSORREGION picks out just LINE")
|
||||||
(replace BOTTOM of CURSORREG with (FGETLD LINE YBOT))
|
(replace BOTTOM of CURSORREG with (FGETLD LINE YBOT))
|
||||||
(replace HEIGHT of CURSORREG with (FGETLD LINE LHEIGHT)))
|
(replace HEIGHT of CURSORREG with (FGETLD LINE LHEIGHT)))
|
||||||
|
|
||||||
(* ;; "The line region gets wider if the paragraph is indented")
|
(* ;; "The line region gets wider if the paragraph is indented")
|
||||||
|
|
||||||
(SETQ LEFT (OR (AND LINE (FGETLD LINE LEFTMARGIN))
|
(SETQ LEFT (OR (AND LINE (FGETLD LINE LEFTMARGIN))
|
||||||
(IPLUS (PANELEFT PANE)
|
(IPLUS (PANELEFT PANE)
|
||||||
\TEDIT.LINEREGION.WIDTH)))
|
\TEDIT.LINEREGION.WIDTH)))
|
||||||
(if (ILESSP X LEFT)
|
(if (ILESSP X LEFT)
|
||||||
then
|
then
|
||||||
(* ;; "In left margin; switch to the line-select cursor")
|
(* ;; "In left margin; switch to the line-select cursor")
|
||||||
|
|
||||||
(CURSOR \TEDIT.LINECURSOR)
|
(CURSOR \TEDIT.LINECURSOR)
|
||||||
(FSETTOBJ TEXTOBJ MOUSEREGION 'LINE)
|
(FSETTOBJ TEXTOBJ MOUSEREGION 'LINE)
|
||||||
(replace (REGION LEFT) of CURSORREG with 0)
|
(replace (REGION LEFT) of CURSORREG with 0)
|
||||||
(replace (REGION WIDTH) of CURSORREG with LEFT)
|
(replace (REGION WIDTH) of CURSORREG with LEFT)
|
||||||
else
|
else
|
||||||
(* ;;
|
(* ;;
|
||||||
"Not in the line-select region, not in the split region, must be the main text. ")
|
"Not in the line-select region, not in the split region, must be the main text. ")
|
||||||
|
|
||||||
(CURSOR T)
|
(CURSOR T)
|
||||||
(FSETTOBJ TEXTOBJ MOUSEREGION 'TEXT)
|
(FSETTOBJ TEXTOBJ MOUSEREGION 'TEXT)
|
||||||
(replace (REGION LEFT) of CURSORREG with LEFT)
|
(replace (REGION LEFT) of CURSORREG with LEFT)
|
||||||
(replace (REGION WIDTH) of CURSORREG with (IDIFFERENCE (PANERIGHT
|
(replace (REGION WIDTH) of CURSORREG with (IDIFFERENCE (PANERIGHT
|
||||||
PANE)
|
PANE)
|
||||||
(IPLUS LEFT
|
(IPLUS LEFT
|
||||||
\TEDIT.LINEREGION.WIDTH
|
\TEDIT.LINEREGION.WIDTH
|
||||||
])])])
|
])])])
|
||||||
|
|
||||||
(\TEDIT.CURSOROUTFN
|
(\TEDIT.CURSOROUTFN
|
||||||
[LAMBDA (PANE) (* ; "Edited 4-May-2025 14:27 by rmk")
|
[LAMBDA (PANE) (* ; "Edited 10-Jan-2026 22:49 by rmk")
|
||||||
|
(* ; "Edited 4-May-2025 14:27 by rmk")
|
||||||
(* ; "Edited 20-Jul-2023 20:32 by rmk")
|
(* ; "Edited 20-Jul-2023 20:32 by rmk")
|
||||||
(* ; "Edited 30-May-91 23:32 by jds")
|
(* ; "Edited 30-May-91 23:32 by jds")
|
||||||
|
|
||||||
@@ -1147,7 +1156,9 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.BUTTONEVENTFN
|
(\TEDIT.BUTTONEVENTFN
|
||||||
[LAMBDA (PANE) (* ; "Edited 6-May-2025 20:35 by rmk")
|
[LAMBDA (PANE) (* ; "Edited 15-Jan-2026 00:39 by rmk")
|
||||||
|
(* ; "Edited 11-Jan-2026 08:30 by rmk")
|
||||||
|
(* ; "Edited 6-May-2025 20:35 by rmk")
|
||||||
(* ; "Edited 21-Apr-2025 20:19 by rmk")
|
(* ; "Edited 21-Apr-2025 20:19 by rmk")
|
||||||
(* ; "Edited 13-Apr-2025 13:33 by rmk")
|
(* ; "Edited 13-Apr-2025 13:33 by rmk")
|
||||||
(* ; "Edited 6-Apr-2025 18:59 by rmk")
|
(* ; "Edited 6-Apr-2025 18:59 by rmk")
|
||||||
@@ -1187,7 +1198,7 @@
|
|||||||
(OLDX _ MIN.SMALLP)
|
(OLDX _ MIN.SMALLP)
|
||||||
(OLDY _ MIN.SMALLP)
|
(OLDY _ MIN.SMALLP)
|
||||||
(PREG _ (PANEREGION PANE))
|
(PREG _ (PANEREGION PANE))
|
||||||
TEXTOBJ CURSEL NEWSEL CUROPERATION NEWOPERATION PENDINGDEL READONLY
|
TEXTOBJ CURSEL NEWSEL CUROPERATION NEWOPERATION PENDINGDEL READONLY SECSEL
|
||||||
declare (SPECVARS CURSEL) first
|
declare (SPECVARS CURSEL) first
|
||||||
|
|
||||||
(* ;; "Pick off and return from a bunch of peripheral situations, then fall through to the complexities of normal text selection.")
|
(* ;; "Pick off and return from a bunch of peripheral situations, then fall through to the complexities of normal text selection.")
|
||||||
@@ -1215,13 +1226,34 @@
|
|||||||
(* ;; "")
|
(* ;; "")
|
||||||
|
|
||||||
(SETQ READONLY (FGETTOBJ TEXTOBJ TXTREADONLY))
|
(SETQ READONLY (FGETTOBJ TEXTOBJ TXTREADONLY))
|
||||||
(SETQ CUROPERATION 'NORMAL)
|
|
||||||
(SETQ NEWOPERATION (\TEDIT.BUTTONEVENTFN.GETOPERATION
|
(SETQ NEWOPERATION (\TEDIT.BUTTONEVENTFN.GETOPERATION
|
||||||
READONLY NIL))
|
READONLY NIL))
|
||||||
(CL:UNLESS (SETQ CURSEL (
|
|
||||||
|
(* ;; "")
|
||||||
|
|
||||||
|
(if (SETQ CURSEL (FGETTOBJ TEXTOBJ SECONDARYSEL))
|
||||||
|
then (* ;
|
||||||
|
"Mouse moved out and came back...and clicked.")
|
||||||
|
(SETQ CUROPERATION (FGETSEL CURSEL
|
||||||
|
SELOPERATION))
|
||||||
|
(SETQ PENDINGDEL (EQ CUROPERATION
|
||||||
|
'PENDINGDEL))
|
||||||
|
(CL:UNLESS (EQ NEWOPERATION CUROPERATION)
|
||||||
|
(* ;
|
||||||
|
"Shift keys have changed, turn off old secondary")
|
||||||
|
(\TEDIT.SEL.OFF TSTREAM CURSEL))
|
||||||
|
(CL:WHEN (EQ NEWOPERATION 'NORMAL)
|
||||||
|
(* ; "")
|
||||||
|
(CL:UNLESS (SETQ CURSEL (
|
||||||
\TEDIT.BUTTONEVENTFN.CURSEL.INIT
|
\TEDIT.BUTTONEVENTFN.CURSEL.INIT
|
||||||
NEWOPERATION TSTREAM))
|
NEWOPERATION
|
||||||
(RETURN))
|
TSTREAM))
|
||||||
|
(RETURN)))
|
||||||
|
elseif (SETQ CURSEL (
|
||||||
|
\TEDIT.BUTTONEVENTFN.CURSEL.INIT
|
||||||
|
NEWOPERATION TSTREAM))
|
||||||
|
then (SETQ CUROPERATION 'NORMAL)
|
||||||
|
else (RETURN))
|
||||||
(SETQ NEWSEL (\TEDIT.COPYSEL CURSEL))
|
(SETQ NEWSEL (\TEDIT.COPYSEL CURSEL))
|
||||||
(* ;
|
(* ;
|
||||||
"Gets line-chains and consistent initial looks")
|
"Gets line-chains and consistent initial looks")
|
||||||
@@ -1231,34 +1263,26 @@
|
|||||||
"And get the new mouse and key info")
|
"And get the new mouse and key info")
|
||||||
(\TEDIT.CURSORMOVEDFN PANE)
|
(\TEDIT.CURSORMOVEDFN PANE)
|
||||||
(SETQ NEWOPERATION (\TEDIT.BUTTONEVENTFN.GETOPERATION READONLY CUROPERATION))
|
(SETQ NEWOPERATION (\TEDIT.BUTTONEVENTFN.GETOPERATION READONLY CUROPERATION))
|
||||||
|
(FSETTOBJ TEXTOBJ SECONDARYSEL CURSEL)
|
||||||
|
|
||||||
(* ;; "We're done if keys and buttons are up")
|
(* ;; "We're done if keys and buttons are up")
|
||||||
until (AND (EQ NEWOPERATION 'NORMAL)
|
until (AND (EQ NEWOPERATION 'NORMAL)
|
||||||
(ALLBUTTONSUP)) unless (AND (IEQP OLDX (SETQ X (LASTMOUSEX DS)))
|
(ALLBUTTONSUP)) unless (AND (IEQP OLDX (SETQ X (LASTMOUSEX DS)))
|
||||||
(IEQP OLDY (SETQ Y (LASTMOUSEY DS)))
|
(IEQP OLDY (SETQ Y (LASTMOUSEY DS)))
|
||||||
(EQ CUROPERATION NEWOPERATION))
|
(EQ CUROPERATION NEWOPERATION))
|
||||||
do
|
do (CL:UNLESS (INSIDEP (PANEREGION PANE PREG)
|
||||||
|
X Y) (* ;
|
||||||
|
"Left the window, stay in the loop if scrolling")
|
||||||
|
(CL:UNLESS (IN/SCROLL/BAR? PANE LASTMOUSEX LASTMOUSEY)
|
||||||
|
(RETURN))
|
||||||
|
(SCROLL.HANDLER PANE))
|
||||||
|
|
||||||
|
(* ;; "")
|
||||||
|
|
||||||
(* ;; "Polling loop, track the mouse until the buttons and modifier keys come up, i.e. NORMAL Nothing to do until the mouse moves or the operation changes. .")
|
(* ;; "Polling loop, track the mouse until the buttons and modifier keys come up, i.e. NORMAL Nothing to do until the mouse moves or the operation changes. .")
|
||||||
|
|
||||||
(* ;; "First and always: CURSEL is ON at this point and matches the display. NEWSEL may not be well-defined.")
|
(* ;; "First and always: CURSEL is ON at this point and matches the display. NEWSEL may not be well-defined.")
|
||||||
|
|
||||||
(CL:UNLESS (INSIDEP (PANEREGION PANE PREG)
|
|
||||||
X Y) (* ;
|
|
||||||
"The mouse left the window: cleanup and leave. ")
|
|
||||||
(CL:UNLESS (EQ CUROPERATION 'NORMAL) (* ;
|
|
||||||
"Take down the copy/delete/copylooks highlight")
|
|
||||||
(\TEDIT.SEL.OFF TSTREAM CURSEL)
|
|
||||||
(\TEDIT.SEL.ON TSTREAM)) (* ; "Go back to original selection?")
|
|
||||||
|
|
||||||
(* ;;
|
|
||||||
"Scroll if mouse moved to scroll bar (and scroll bar doesn't overlap the window)")
|
|
||||||
|
|
||||||
(CL:WHEN (IN/SCROLL/BAR? PANE LASTMOUSEX LASTMOUSEY)
|
|
||||||
(SCROLL.HANDLER PANE))
|
|
||||||
(RETURN))
|
|
||||||
|
|
||||||
(* ;; "")
|
|
||||||
|
|
||||||
(* ;; "Ready to track the selection.")
|
(* ;; "Ready to track the selection.")
|
||||||
|
|
||||||
(SETQ OLDX X)
|
(SETQ OLDX X)
|
||||||
@@ -1322,9 +1346,12 @@
|
|||||||
|
|
||||||
(* ;; "Out of Polling loop")
|
(* ;; "Out of Polling loop")
|
||||||
|
|
||||||
|
(SETTOBJ (FTEXTOBJ TSTREAM)
|
||||||
|
SECONDARYSEL NIL) (* ;
|
||||||
|
"All keys are up, secondary selection is closed")
|
||||||
(CL:UNLESS (FGETSEL NEWSEL SET)
|
(CL:UNLESS (FGETSEL NEWSEL SET)
|
||||||
|
|
||||||
(* ;; ".Here to restore when no valid selection, maybe an unhappy image object?")
|
(* ;; "Here to restore when no valid selection, maybe an unhappy image object?")
|
||||||
|
|
||||||
(\TEDIT.SEL.OFF TSTREAM CURSEL) (* ; "Turn off CURSEL")
|
(\TEDIT.SEL.OFF TSTREAM CURSEL) (* ; "Turn off CURSEL")
|
||||||
(\TEDIT.SET.SEL.LOOKS (TEXTSEL TEXTOBJ)
|
(\TEDIT.SET.SEL.LOOKS (TEXTSEL TEXTOBJ)
|
||||||
@@ -1335,6 +1362,8 @@
|
|||||||
|
|
||||||
(\TEDIT.BUTTONEVENTFN.DOOPERATION
|
(\TEDIT.BUTTONEVENTFN.DOOPERATION
|
||||||
[LAMBDA (CURSEL CUROPERATION TSTREAM PANE PENDINGDEL TTYPROC)
|
[LAMBDA (CURSEL CUROPERATION TSTREAM PANE PENDINGDEL TTYPROC)
|
||||||
|
(* ; "Edited 31-Jan-2026 11:51 by rmk")
|
||||||
|
(* ; "Edited 9-Jan-2026 11:28 by rmk")
|
||||||
(* ; "Edited 6-May-2025 11:54 by rmk")
|
(* ; "Edited 6-May-2025 11:54 by rmk")
|
||||||
(* ; "Edited 27-Apr-2025 22:26 by rmk")
|
(* ; "Edited 27-Apr-2025 22:26 by rmk")
|
||||||
(* ; "Edited 21-Apr-2025 20:32 by rmk")
|
(* ; "Edited 21-Apr-2025 20:32 by rmk")
|
||||||
@@ -1388,14 +1417,14 @@
|
|||||||
"Make sure the caret blinks in the position of a successful deletion")
|
"Make sure the caret blinks in the position of a successful deletion")
|
||||||
(FSETSEL TEXTSEL HASCARET T))
|
(FSETSEL TEXTSEL HASCARET T))
|
||||||
(\TEDIT.SETCARET TEXTSEL PANE TEXTOBJ T))
|
(\TEDIT.SETCARET TEXTSEL PANE TEXTOBJ T))
|
||||||
(COPY (CL:IF TTYSEL
|
(COPY (\TEDIT.SEL.OFF TSTREAM CURSEL)
|
||||||
|
(CL:IF TTYSEL
|
||||||
(\TEDIT.COPY CURSEL TTYSEL TSTREAM TTYSTREAM)
|
(\TEDIT.COPY CURSEL TTYSEL TSTREAM TTYSTREAM)
|
||||||
(\TEDIT.FOREIGN.COPY TTYW CURSEL TSTREAM))
|
(\TEDIT.FOREIGN.COPY CURSEL TSTREAM)))
|
||||||
(\TEDIT.SEL.OFF TSTREAM CURSEL))
|
|
||||||
(MOVE (\TEDIT.SEL.OFF TSTREAM CURSEL)
|
(MOVE (\TEDIT.SEL.OFF TSTREAM CURSEL)
|
||||||
(if TTYSEL
|
(if TTYSEL
|
||||||
then (\TEDIT.MOVE CURSEL TTYSEL TSTREAM TTYSTREAM)
|
then (\TEDIT.MOVE CURSEL TTYSEL TSTREAM TTYSTREAM)
|
||||||
else (\TEDIT.FOREIGN.COPY TTYW CURSEL TSTREAM)
|
else (\TEDIT.FOREIGN.COPY CURSEL TSTREAM)
|
||||||
(* ; "TEXTSEL moves to deletion point")
|
(* ; "TEXTSEL moves to deletion point")
|
||||||
(\TEDIT.UPDATE.SEL TEXTSEL (FGETSEL CURSEL CH#)
|
(\TEDIT.UPDATE.SEL TEXTSEL (FGETSEL CURSEL CH#)
|
||||||
0
|
0
|
||||||
@@ -1618,7 +1647,8 @@
|
|||||||
then (TEDIT.INSERT TSTREAM I])
|
then (TEDIT.INSERT TSTREAM I])
|
||||||
|
|
||||||
(\TEDIT.FOREIGN.COPY
|
(\TEDIT.FOREIGN.COPY
|
||||||
[LAMBDA (TTYW SOURCESEL SOURCESTREAM BKSYSBUFP) (* ; "Edited 28-Mar-2025 12:51 by rmk")
|
[LAMBDA (SOURCESEL SOURCESTREAM BKSYSBUFP) (* ; "Edited 31-Jan-2026 09:20 by rmk")
|
||||||
|
(* ; "Edited 28-Mar-2025 12:51 by rmk")
|
||||||
(* ; "Edited 27-Aug-2024 13:38 by rmk")
|
(* ; "Edited 27-Aug-2024 13:38 by rmk")
|
||||||
(* ; "Edited 7-Jul-2024 09:26 by rmk")
|
(* ; "Edited 7-Jul-2024 09:26 by rmk")
|
||||||
(* ; "Edited 29-Apr-2024 13:37 by rmk")
|
(* ; "Edited 29-Apr-2024 13:37 by rmk")
|
||||||
@@ -1630,7 +1660,8 @@
|
|||||||
(CL:WHEN (IGREATERP (GETSEL SOURCESEL DCH)
|
(CL:WHEN (IGREATERP (GETSEL SOURCESEL DCH)
|
||||||
0) (* ; "If empty, nothing to do")
|
0) (* ; "If empty, nothing to do")
|
||||||
[if (AND NIL (NOT BKSYSBUFP)
|
[if (AND NIL (NOT BKSYSBUFP)
|
||||||
(WINDOWPROP TTYW 'COPYINSERTFN))
|
(PROCESSPROP (TTY.PROCESS)
|
||||||
|
'WINDOW))
|
||||||
then
|
then
|
||||||
(* ;; "This is a stub for a definition that knows how to do a looked string object, given that the destination TTY window has a COPYINSERTFN. OBJECTFROMSEL is in {LFG}tedit/UNBREAKABLESTRING")
|
(* ;; "This is a stub for a definition that knows how to do a looked string object, given that the destination TTY window has a COPYINSERTFN. OBJECTFROMSEL is in {LFG}tedit/UNBREAKABLESTRING")
|
||||||
|
|
||||||
@@ -2060,7 +2091,8 @@
|
|||||||
PROMPTWINDOW])
|
PROMPTWINDOW])
|
||||||
|
|
||||||
(TEDIT.PROMPTPRINT
|
(TEDIT.PROMPTPRINT
|
||||||
[LAMBDA (TSTREAM MSG CLEAR? FLASH?) (* ; "Edited 14-Dec-2025 17:41 by rmk")
|
[LAMBDA (TSTREAM MSG CLEAR? FLASH?) (* ; "Edited 7-Feb-2026 18:51 by rmk")
|
||||||
|
(* ; "Edited 14-Dec-2025 17:41 by rmk")
|
||||||
(* ; "Edited 29-Dec-2024 14:45 by rmk")
|
(* ; "Edited 29-Dec-2024 14:45 by rmk")
|
||||||
(* ; "Edited 26-Nov-2023 10:10 by rmk")
|
(* ; "Edited 26-Nov-2023 10:10 by rmk")
|
||||||
(* ; "Edited 10-Sep-2023 00:27 by rmk")
|
(* ; "Edited 10-Sep-2023 00:27 by rmk")
|
||||||
@@ -2072,31 +2104,33 @@
|
|||||||
|
|
||||||
(* ;; "Print a message in the editor's prompt window (if none, use the global promptwindow). Optionally clear the window first.")
|
(* ;; "Print a message in the editor's prompt window (if none, use the global promptwindow). Optionally clear the window first.")
|
||||||
|
|
||||||
(LET ((TEXTOBJ (TEXTOBJ TSTREAM T))
|
(PROG ((TEXTOBJ (TEXTOBJ TSTREAM T))
|
||||||
PWINDOW MAINWINDOW)
|
PWINDOW MAINWINDOW)
|
||||||
(if TEXTOBJ
|
(CL:UNLESS TEXTOBJ
|
||||||
then (CL:WHEN (SETQ MAINWINDOW (\TEDIT.MAINW TEXTOBJ))
|
(PROMPTPRINT MSG)
|
||||||
[SETQ PWINDOW
|
(RETURN))
|
||||||
(CAR (NLSETQ (SELECTQ PWINDOW
|
(CL:WHEN (SETQ MAINWINDOW (\TEDIT.MAINW TSTREAM))
|
||||||
(DON'T (CL:WHEN (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND)
|
(SETQ PWINDOW (FGETTOBJ TEXTOBJ PROMPTWINDOW))
|
||||||
(GETPROMPTWINDOW MAINWINDOW)))
|
[SETQ PWINDOW (CAR (NLSETQ (SELECTQ PWINDOW
|
||||||
(NIL (CL:WHEN TSTREAM
|
(DON'T (CL:WHEN (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND)
|
||||||
[GETPROMPTWINDOW MAINWINDOW NIL NIL
|
(GETPROMPTWINDOW MAINWINDOW)))
|
||||||
(NOT (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND]))
|
(NIL (CL:WHEN TSTREAM
|
||||||
PWINDOW]) (* ;
|
[GETPROMPTWINDOW MAINWINDOW NIL NIL
|
||||||
|
(NOT (GETTEXTPROP TEXTOBJ
|
||||||
|
'PWINDOW.ON.DEMAND]))
|
||||||
|
PWINDOW]) (* ;
|
||||||
"Try to find an editor's prompt window for our message")
|
"Try to find an editor's prompt window for our message")
|
||||||
(COND
|
(if (WINDOWP PWINDOW)
|
||||||
((WINDOWP PWINDOW) (* ;
|
then (* ;
|
||||||
"We found a window to use. Print the message.")
|
"We found a window to use. Print the message.")
|
||||||
(CL:WHEN CLEAR? (CLEARW PWINDOW))
|
(CL:WHEN CLEAR? (CLEARW PWINDOW))
|
||||||
(CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
|
(CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
|
||||||
(PRIN1 MSG PWINDOW))
|
(PRIN1 MSG PWINDOW)
|
||||||
(T (* ;
|
else (* ;
|
||||||
"Failing all else, use global PROMPTWINDOW.")
|
"Failing all else, use global PROMPTWINDOW.")
|
||||||
(FRESHLINE PROMPTWINDOW)
|
(FRESHLINE PROMPTWINDOW)
|
||||||
(CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
|
(CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
|
||||||
(printout PROMPTWINDOW MSG)))
|
(printout PROMPTWINDOW MSG])
|
||||||
else (PROMPTPRINT MSG])
|
|
||||||
|
|
||||||
(TEDIT.PROMPTCLEAR
|
(TEDIT.PROMPTCLEAR
|
||||||
[LAMBDA (TSTREAM FONT) (* ; "Edited 14-Dec-2025 17:34 by rmk")
|
[LAMBDA (TSTREAM FONT) (* ; "Edited 14-Dec-2025 17:34 by rmk")
|
||||||
@@ -3664,36 +3698,36 @@
|
|||||||
(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _
|
(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _
|
||||||
TEDIT.ICON.TITLE.REGION))
|
TEDIT.ICON.TITLE.REGION))
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (17143 18039 (TEDIT.DEFER.UPDATES 17153 . 18037)) (18040 45281 (\TEDIT.WINDOW.CREATE
|
(FILEMAP (NIL (17097 17993 (TEDIT.DEFER.UPDATES 17107 . 17991)) (17994 46195 (\TEDIT.WINDOW.CREATE
|
||||||
18050 . 24913) (\TEDIT.WINDOW.GETREGION 24915 . 29619) (\TEDIT.WINDOW.SETUP 29621 . 33951) (
|
18004 . 24867) (\TEDIT.WINDOW.GETREGION 24869 . 30356) (\TEDIT.WINDOW.SETUP 30358 . 34865) (
|
||||||
\TEDIT.MINIMAL.WINDOW.SETUP 33953 . 41913) (\TEDIT.CLEARPANE 41915 . 42632) (\TEDIT.FILL.PANES 42634
|
\TEDIT.MINIMAL.WINDOW.SETUP 34867 . 42827) (\TEDIT.CLEARPANE 42829 . 43546) (\TEDIT.FILL.PANES 43548
|
||||||
. 45279)) (45282 68983 (\TEDIT.CURSORMOVEDFN 45292 . 50902) (\TEDIT.CURSOROUTFN 50904 . 51592) (
|
. 46193)) (46196 69923 (\TEDIT.CURSORMOVEDFN 46206 . 51733) (\TEDIT.CURSOROUTFN 51735 . 52532) (
|
||||||
\TEDIT.ACTIVE.WINDOWP 51594 . 52664) (\TEDIT.EXPANDFN 52666 . 53229) (\TEDIT.MAINW 53231 . 54511) (
|
\TEDIT.ACTIVE.WINDOWP 52534 . 53604) (\TEDIT.EXPANDFN 53606 . 54169) (\TEDIT.MAINW 54171 . 55451) (
|
||||||
\TEDIT.MAINSTREAM 54513 . 54847) (\TEDIT.PRIMARYPANE 54849 . 55619) (\TEDIT.PANELIST 55621 . 56117) (
|
\TEDIT.MAINSTREAM 55453 . 55787) (\TEDIT.PRIMARYPANE 55789 . 56559) (\TEDIT.PANELIST 56561 . 57057) (
|
||||||
\TEDIT.NEWREGIONFN 56119 . 58635) (\TEDIT.SET.WINDOW.EXTENT 58637 . 63619) (\TEDIT.SHRINK.ICONCREATE
|
\TEDIT.NEWREGIONFN 57059 . 59575) (\TEDIT.SET.WINDOW.EXTENT 59577 . 64559) (\TEDIT.SHRINK.ICONCREATE
|
||||||
63621 . 66354) (\TEDIT.SHRINKFN 66356 . 66765) (\TEDIT.PANEREGION 66767 . 68981)) (69015 102061 (
|
64561 . 67294) (\TEDIT.SHRINKFN 67296 . 67705) (\TEDIT.PANEREGION 67707 . 69921)) (69955 105080 (
|
||||||
\TEDIT.BUTTONEVENTFN 69025 . 81998) (\TEDIT.BUTTONEVENTFN.DOOPERATION 82000 . 89263) (
|
\TEDIT.BUTTONEVENTFN 69965 . 84672) (\TEDIT.BUTTONEVENTFN.DOOPERATION 84674 . 92145) (
|
||||||
\TEDIT.BUTTONEVENTFN.GETOPERATION 89265 . 91107) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 91109 . 94779) (
|
\TEDIT.BUTTONEVENTFN.GETOPERATION 92147 . 93989) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 93991 . 97661) (
|
||||||
\TEDIT.BUTTONEVENTFN.INACTIVE 94781 . 97211) (\TEDIT.BUTTONEVENTFN.INTITLE 97213 . 99048) (
|
\TEDIT.BUTTONEVENTFN.INACTIVE 97663 . 100093) (\TEDIT.BUTTONEVENTFN.INTITLE 100095 . 101930) (
|
||||||
\TEDIT.COPYINSERTFN 99050 . 100182) (\TEDIT.FOREIGN.COPY 100184 . 102059)) (102062 119625 (
|
\TEDIT.COPYINSERTFN 101932 . 103064) (\TEDIT.FOREIGN.COPY 103066 . 105078)) (105081 122644 (
|
||||||
\TEDIT.PANE.SPLIT 102072 . 106020) (\TEDIT.SPLITW 106022 . 114081) (\TEDIT.UNSPLITW 114083 . 118282) (
|
\TEDIT.PANE.SPLIT 105091 . 109039) (\TEDIT.SPLITW 109041 . 117100) (\TEDIT.UNSPLITW 117102 . 121301) (
|
||||||
\TEDIT.LINKPANES 118284 . 119047) (\TEDIT.UNLINKPANE 119049 . 119623)) (121059 121950 (TEDITWINDOWP
|
\TEDIT.LINKPANES 121303 . 122066) (\TEDIT.UNLINKPANE 122068 . 122642)) (124078 124969 (TEDITWINDOWP
|
||||||
121069 . 121948)) (121987 125090 (TEDIT.GETINPUT 121997 . 124440) (\TEDIT.MAKEFILENAME 124442 . 125088
|
124088 . 124967)) (125006 128109 (TEDIT.GETINPUT 125016 . 127459) (\TEDIT.MAKEFILENAME 127461 . 128107
|
||||||
)) (125139 132985 (TEDIT.PROMPTWINDOW 125149 . 125463) (TEDIT.PROMPTPRINT 125465 . 128195) (
|
)) (128158 136241 (TEDIT.PROMPTWINDOW 128168 . 128482) (TEDIT.PROMPTPRINT 128484 . 131451) (
|
||||||
TEDIT.PROMPTCLEAR 128197 . 130032) (TEDIT.PROMPTFLASH 130034 . 131292) (\TEDIT.PROMPT.PAGEFULLFN
|
TEDIT.PROMPTCLEAR 131453 . 133288) (TEDIT.PROMPTFLASH 133290 . 134548) (\TEDIT.PROMPT.PAGEFULLFN
|
||||||
131294 . 132983)) (133223 143801 (\TEDIT.FILENAME 133233 . 134005) (\TEDIT.DEFAULT.TITLE 134007 .
|
134550 . 136239)) (136479 147057 (\TEDIT.FILENAME 136489 . 137261) (\TEDIT.DEFAULT.TITLE 137263 .
|
||||||
136386) (\TEDIT.WINDOW.TITLE 136388 . 138557) (\TEDIT.LIKELY.FILENAME 138559 . 141283) (
|
139642) (\TEDIT.WINDOW.TITLE 139644 . 141813) (\TEDIT.LIKELY.FILENAME 141815 . 144539) (
|
||||||
\TEDIT.UPDATE.TITLE 141285 . 143799)) (143844 156328 (TEDIT.DEACTIVATE.WINDOW 143854 . 149427) (
|
\TEDIT.UPDATE.TITLE 144541 . 147055)) (147100 159584 (TEDIT.DEACTIVATE.WINDOW 147110 . 152683) (
|
||||||
\TEDIT.RESHAPEFN 149429 . 151514) (\TEDIT.REPAINTFN 151516 . 151740) (\TEDIT.CLOSESPLITS 151742 .
|
\TEDIT.RESHAPEFN 152685 . 154770) (\TEDIT.REPAINTFN 154772 . 154996) (\TEDIT.CLOSESPLITS 154998 .
|
||||||
154187) (\TEDIT.CLOSEPANE 154189 . 156326)) (156329 199128 (\TEDIT.SCROLLFN 156339 . 158570) (
|
157443) (\TEDIT.CLOSEPANE 157445 . 159582)) (159585 202384 (\TEDIT.SCROLLFN 159595 . 161826) (
|
||||||
\TEDIT.SCROLLCH.TOP 158572 . 160683) (\TEDIT.SCROLLCH.BOTTOM 160685 . 165015) (\TEDIT.SCROLLUP 165017
|
\TEDIT.SCROLLCH.TOP 161828 . 163939) (\TEDIT.SCROLLCH.BOTTOM 163941 . 168271) (\TEDIT.SCROLLUP 168273
|
||||||
. 170743) (\TEDIT.TOPLINE.YTOP 170745 . 172414) (\TEDIT.SCROLLDOWN 172416 . 179455) (
|
. 173999) (\TEDIT.TOPLINE.YTOP 174001 . 175670) (\TEDIT.SCROLLDOWN 175672 . 182711) (
|
||||||
\TEDIT.SCROLL.CARET 179457 . 182295) (\TEDIT.VISIBLECARETP 182297 . 184591) (\TEDIT.VISIBLECHARP
|
\TEDIT.SCROLL.CARET 182713 . 185551) (\TEDIT.VISIBLECARETP 185553 . 187847) (\TEDIT.VISIBLECHARP
|
||||||
184593 . 185684) (\TEDIT.BITMAPLINES 185686 . 189606) (\TEDIT.SETPANE.TOPLINE 189608 . 190220) (
|
187849 . 188940) (\TEDIT.BITMAPLINES 188942 . 192862) (\TEDIT.SETPANE.TOPLINE 192864 . 193476) (
|
||||||
\TEDIT.SHIFTLINES 190222 . 199126)) (199129 209998 (\TEDIT.ONSCREEN? 199139 . 203690) (
|
\TEDIT.SHIFTLINES 193478 . 202382)) (202385 213254 (\TEDIT.ONSCREEN? 202395 . 206946) (
|
||||||
\TEDIT.ONSCREEN.REGION 203692 . 207343) (\TEDIT.AFTERMOVEFN 207345 . 208242) (OFFSCREENP 208244 .
|
\TEDIT.ONSCREEN.REGION 206948 . 210599) (\TEDIT.AFTERMOVEFN 210601 . 211498) (OFFSCREENP 211500 .
|
||||||
209996)) (210040 212854 (\TEDIT.PROCIDLEFN 210050 . 211710) (\TEDIT.PROCENTRYFN 211712 . 212157) (
|
213252)) (213296 216110 (\TEDIT.PROCIDLEFN 213306 . 214966) (\TEDIT.PROCENTRYFN 214968 . 215413) (
|
||||||
\TEDIT.PROCEXITFN 212159 . 212852)) (212933 226158 (\TEDIT.DOWNCARET 212943 . 213736) (
|
\TEDIT.PROCEXITFN 215415 . 216108)) (216189 229414 (\TEDIT.DOWNCARET 216199 . 216992) (
|
||||||
\TEDIT.FLASHCARET 213738 . 215849) (\TEDIT.UPCARET 215851 . 216955) (TEDIT.NORMALIZECARET 216957 .
|
\TEDIT.FLASHCARET 216994 . 219105) (\TEDIT.UPCARET 219107 . 220211) (TEDIT.NORMALIZECARET 220213 .
|
||||||
220175) (\TEDIT.SETCARET 220177 . 225528) (\TEDIT.CARET 225530 . 226156)))))
|
223431) (\TEDIT.SETCARET 223433 . 228784) (\TEDIT.CARET 228786 . 229412)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
Binary file not shown.
@@ -1,11 +1,10 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||||
|
|
||||||
(FILECREATED "16-Feb-2026 08:56:58"
|
(FILECREATED " 1-May-2026 08:16:04" {MEDLEY}<library>tedit>tedit-exports.all;255 52514
|
||||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;249 52790
|
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:PREVIOUS-DATE "14-Jan-2026 14:50:53" {WMEDLEY}<library>TEDIT>tedit-exports.all;248)
|
:PREVIOUS-DATE "15-Apr-2026 23:45:28" {MEDLEY}<library>TEDIT>tedit-exports.all;254)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION
|
(PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION
|
||||||
@@ -17,7 +16,7 @@ PRINT))))))))
|
|||||||
(PUTPROPS FTEXTOBJ MACRO ((X) (TEXTOBJ! (CL:IF (type? TEXTOBJ X) X (GETTSTR X TEXTOBJ)))))
|
(PUTPROPS FTEXTOBJ MACRO ((X) (TEXTOBJ! (CL:IF (type? TEXTOBJ X) X (GETTSTR X TEXTOBJ)))))
|
||||||
(GLOBALVARS CHECK-TEDIT-ASSERTIONS)
|
(GLOBALVARS CHECK-TEDIT-ASSERTIONS)
|
||||||
(RPAQ? CHECK-TEDIT-ASSERTIONS T)
|
(RPAQ? CHECK-TEDIT-ASSERTIONS T)
|
||||||
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE " 4-Feb-2026 16:02:02"))
|
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "10-Mar-2026 18:07:31"))
|
||||||
(RPAQQ \BTREEWORDSPERSLOT 4)
|
(RPAQQ \BTREEWORDSPERSLOT 4)
|
||||||
(RPAQQ \BTREEMAXCOUNT 8)
|
(RPAQQ \BTREEMAXCOUNT 8)
|
||||||
(CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
|
(CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
|
||||||
@@ -51,7 +50,7 @@ DLEN1 DOWN2 DLEN2 DOWN3 DLEN3 DOWN4 DLEN4 DOWN5 DLEN5 DOWN6 DLEN6 DOWN7 DLEN7 DO
|
|||||||
(\DTEST (OR (NEXTPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
|
(\DTEST (OR (NEXTPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
|
||||||
(I.S.OPR (QUOTE backpieces) NIL (QUOTE (first (SETQ I.V. (\DTEST (OR BODY (GO $$OUT)) (QUOTE PIECE)))
|
(I.S.OPR (QUOTE backpieces) NIL (QUOTE (first (SETQ I.V. (\DTEST (OR BODY (GO $$OUT)) (QUOTE PIECE)))
|
||||||
by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
|
by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
|
||||||
(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "14-Feb-2026 13:22:06"))
|
(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE " 9-Apr-2026 17:25:38"))
|
||||||
(DATATYPE SELECTION ((* ;;
|
(DATATYPE SELECTION ((* ;;
|
||||||
"Description of a piece of selected text for TEdit. Text has to be selected before it can be operated on by the user. The caret is to the left of CH# if POINT is LEFT, to the keft of CHLIM if POINT is RIGHT."
|
"Description of a piece of selected text for TEdit. Text has to be selected before it can be operated on by the user. The caret is to the left of CH# if POINT is LEFT, to the keft of CHLIM if POINT is RIGHT."
|
||||||
) (* ;; "If DCH > 0, highlighting goes from CH# to (SUB1 CHLIM = (SUB1 (IPLUS CH# DCH)).") (* ;;
|
) (* ;; "If DCH > 0, highlighting goes from CH# to (SUB1 CHLIM = (SUB1 (IPLUS CH# DCH)).") (* ;;
|
||||||
@@ -128,7 +127,7 @@ TSTREAM ONLYPANE DONTFIX)))
|
|||||||
(PUTPROPS \TEDIT.SEL.OFF MACRO ((TSTREAM SEL ONLYPANE) (* ;
|
(PUTPROPS \TEDIT.SEL.OFF MACRO ((TSTREAM SEL ONLYPANE) (* ;
|
||||||
"Takes down SEL in TSTREAM, where SEL defaults to the current selection") (\TEDIT.SHOWSEL SEL NIL
|
"Takes down SEL in TSTREAM, where SEL defaults to the current selection") (\TEDIT.SHOWSEL SEL NIL
|
||||||
TSTREAM ONLYPANE)))
|
TSTREAM ONLYPANE)))
|
||||||
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "16-Feb-2026 00:38:33"))
|
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "16-Apr-2026 09:27:41"))
|
||||||
(RECORD TAB (TABX . TABKIND))
|
(RECORD TAB (TABX . TABKIND))
|
||||||
(RECORD TABSPEC (DEFAULTTAB . TABS))
|
(RECORD TABSPEC (DEFAULTTAB . TABS))
|
||||||
(DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ;
|
(DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ;
|
||||||
@@ -263,21 +262,22 @@ $$CHARSLOTLIMIT))))) T)
|
|||||||
(DATATYPE PIECE ((* ;
|
(DATATYPE PIECE ((* ;
|
||||||
"The piece describes either a string or part of a file. , or a generalized OBJECT.") PCONTENTS (* ;
|
"The piece describes either a string or part of a file. , or a generalized OBJECT.") PCONTENTS (* ;
|
||||||
"The background source of data for this piece (stream, string, block, object, depending on the PTYPE)."
|
"The background source of data for this piece (stream, string, block, object, depending on the PTYPE)."
|
||||||
) (PTYPE BITS 4) (* ; "How the characters are delivered: thinfile, fatstring, object, substream")
|
) (PTYPE BITS 4) (* ; "How the characters are delivered: thinfile, fatstring, object, substream") NIL
|
||||||
PBYTELEN (* ; "Length of this character piece in bytes. PBYTELEN = PLEN*PBYTESPERCHAR") PFPOS (* ;
|
(* ; "Was PBYTELEN: Length of this character piece in bytes. PBYTELEN = PLEN*PBYTESPERCHAR") PFPOS (*
|
||||||
"The FILEPTR of the start of the piece in the file") PLEN (* ; "Length of the piece, in characters.")
|
; "The FILEPTR of the start of the piece in the file") PLEN (* ;
|
||||||
NEXTPIECE (* ; "-> Next piece in this textobj.") (PREVPIECE FULLXPOINTER) (* ;
|
"Length of the piece, in characters.") NEXTPIECE (* ; "-> Next piece in this textobj.") (PREVPIECE
|
||||||
"-> Prior piece in this text object.") PCHARLOOKS (* ; "Character formatting info ") PBYTESPERCHAR (*
|
FULLXPOINTER) (* ; "-> Prior piece in this text object.") PCHARLOOKS (* ; "Character formatting info "
|
||||||
; "The number of bytes per character, given that all characters in a piece are the same length.") (
|
) PBYTESPERCHAR (* ;
|
||||||
|
"The number of bytes per character, given that all characters in a piece are the same length.") (
|
||||||
PPARALAST FLAG) (* ; "This piece ends paragraph") PPARALOOKS (* ; "Paragraph looks for this piece") (
|
PPARALAST FLAG) (* ; "This piece ends paragraph") PPARALOOKS (* ; "Paragraph looks for this piece") (
|
||||||
PNEW FLAG) (* ;
|
PNEW FLAG) (* ;
|
||||||
"This text is new here; used by the tentative edit system, and anyone else interested.") (NIL FLAG) (
|
"This text is new here; used by the tentative edit system, and anyone else interested.") (NIL FLAG) (
|
||||||
* ; "Was PFATP") (PBINABLE FLAG) (* ; "8-bit bytes are binable (THINSTRING and THINFILE) ") (PTREENODE
|
* ; "Was PFATP") (NIL FLAG) (PTREENODE XPOINTER) (* ;
|
||||||
XPOINTER) (* ; "Points to the PCTB tree-node that contains this piece.") (PCHARSET BYTE) (* ;
|
"Points to the PCTB tree-node that contains this piece.") (NIL BYTE) (* ;
|
||||||
"High-order charset for FATFILE1 pieces") (PUTF8BYTESPERCHAR BYTE)) (* ;
|
"Was PCHARSET: High-order charset for FATFILE1 pieces") NIL) (* ;
|
||||||
"The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece") (ACCESSFNS ((
|
"Was PUTF8BYTESPERCHAR: The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece. But this just duplicates PBYTESPERCHAR for UTF-8 pieces"
|
||||||
POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM)) (type? IMAGEOBJ (PCONTENTS DATUM)) (PCONTENTS DATUM)) (AND (
|
) (ACCESSFNS ((POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM)) (type? IMAGEOBJ (PCONTENTS DATUM)) (PCONTENTS
|
||||||
EQ OBJECT.PTYPE (PTYPE DATUM)) (SETPC DATUM PCONTENTS NEWVALUE))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0)
|
DATUM)) (AND (EQ OBJECT.PTYPE (PTYPE DATUM)) (SETPC DATUM PCONTENTS NEWVALUE))))) PFPOS _ 0 PLEN _ 0)
|
||||||
(DATATYPE TEXTOBJ ((* ;;
|
(DATATYPE TEXTOBJ ((* ;;
|
||||||
"This is where TEdit stores its state information, and internal data about the text being edited.")
|
"This is where TEdit stores its state information, and internal data about the text being edited.")
|
||||||
PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") PRIMARYPANE (* ;
|
PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") PRIMARYPANE (* ;
|
||||||
@@ -376,13 +376,12 @@ IMAGEDATA _ NIL)))
|
|||||||
(PUTPROPS PTYPE MACRO ((PC) (ffetch (PIECE PTYPE) of PC)))
|
(PUTPROPS PTYPE MACRO ((PC) (ffetch (PIECE PTYPE) of PC)))
|
||||||
(PUTPROPS PCONTENTS MACRO ((PC) (ffetch (PIECE PCONTENTS) of PC)))
|
(PUTPROPS PCONTENTS MACRO ((PC) (ffetch (PIECE PCONTENTS) of PC)))
|
||||||
(PUTPROPS PCHARLOOKS MACRO ((PC) (ffetch (PIECE PCHARLOOKS) of PC)))
|
(PUTPROPS PCHARLOOKS MACRO ((PC) (ffetch (PIECE PCHARLOOKS) of PC)))
|
||||||
(PUTPROPS PCHARSET MACRO ((PC) (ffetch (PIECE PCHARSET) of PC)))
|
|
||||||
(PUTPROPS PPARALOOKS MACRO ((PC) (ffetch (PIECE PPARALOOKS) of PC)))
|
(PUTPROPS PPARALOOKS MACRO ((PC) (ffetch (PIECE PPARALOOKS) of PC)))
|
||||||
(PUTPROPS PPARALAST MACRO ((PC) (ffetch (PIECE PPARALAST) of PC)))
|
(PUTPROPS PPARALAST MACRO ((PC) (ffetch (PIECE PPARALAST) of PC)))
|
||||||
(PUTPROPS PFPOS MACRO ((PC) (ffetch (PIECE PFPOS) of PC)))
|
(PUTPROPS PFPOS MACRO ((PC) (ffetch (PIECE PFPOS) of PC)))
|
||||||
(PUTPROPS PBYTELEN MACRO ((PC) (ffetch (PIECE PBYTELEN) of PC)))
|
(PUTPROPS PBYTELEN MACRO (OPENLAMBDA (PC) (ITIMES (ffetch (PIECE PLEN) of PC) (ffetch (PIECE
|
||||||
|
PBYTESPERCHAR) of PC))))
|
||||||
(PUTPROPS PNEW MACRO ((PC) (ffetch (PIECE PNEW) of PC)))
|
(PUTPROPS PNEW MACRO ((PC) (ffetch (PIECE PNEW) of PC)))
|
||||||
(PUTPROPS PBINABLE MACRO ((PC) (ffetch (PIECE PBINABLE) of PC)))
|
|
||||||
(PUTPROPS PBYTESPERCHAR MACRO ((PC) (ffetch (PIECE PBYTESPERCHAR) of PC)))
|
(PUTPROPS PBYTESPERCHAR MACRO ((PC) (ffetch (PIECE PBYTESPERCHAR) of PC)))
|
||||||
(PUTPROPS POBJ MACRO ((PC) (ffetch (PIECE POBJ) of PC)))
|
(PUTPROPS POBJ MACRO ((PC) (ffetch (PIECE POBJ) of PC)))
|
||||||
(PUTPROPS SETPC MACRO ((PC FIELD NEWVALUE) (replace (PIECE FIELD) of PC with NEWVALUE)))
|
(PUTPROPS SETPC MACRO ((PC FIELD NEWVALUE) (replace (PIECE FIELD) of PC with NEWVALUE)))
|
||||||
@@ -391,7 +390,7 @@ IMAGEDATA _ NIL)))
|
|||||||
(PUTPROPS FGETPC MACRO ((PC FIELD) (ffetch (PIECE FIELD) of PC)))
|
(PUTPROPS FGETPC MACRO ((PC FIELD) (ffetch (PIECE FIELD) of PC)))
|
||||||
(PUTPROPS THINPIECEP MACRO ((PC) (* ;;
|
(PUTPROPS THINPIECEP MACRO ((PC) (* ;;
|
||||||
"Assume that objects start out thin, for CHARSET in \TEDIT.PUT.PCTB. The putfn might immediately change that, but we don't care."
|
"Assume that objects start out thin, for CHARSET in \TEDIT.PUT.PCTB. The putfn might immediately change that, but we don't care."
|
||||||
) (SELECTC (PTYPE PC) (THIN.PTYPES T) (UTF8.PTYPE (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR))) NIL)))
|
) (SELECTC (PTYPE PC) (THIN.PTYPES T) (UTF8.PTYPE (EQ 1 (FGETPC PC PBYTESPERCHAR))) NIL)))
|
||||||
(PUTPROPS VISIBLEPIECEP MACRO ((PC) (AND PC (NEQ 0 (PLEN PC)) (NOT (FGETCLOOKS (PCHARLOOKS PC)
|
(PUTPROPS VISIBLEPIECEP MACRO ((PC) (AND PC (NEQ 0 (PLEN PC)) (NOT (FGETCLOOKS (PCHARLOOKS PC)
|
||||||
CLINVISIBLE)))))
|
CLINVISIBLE)))))
|
||||||
(PUTPROPS \NEXT.VISIBLE.PIECE MACRO ((PC) (find NPC inpieces (AND PC (NEXTPIECE PC)) suchthat (
|
(PUTPROPS \NEXT.VISIBLE.PIECE MACRO ((PC) (find NPC inpieces (AND PC (NEXTPIECE PC)) suchthat (
|
||||||
@@ -411,14 +410,13 @@ VISIBLEPIECEP PPC))))
|
|||||||
(PUTPROPS FSETTSTR MACRO ((TSTR FIELD NEWVALUE) (freplace (TEXTSTREAM FIELD) of TSTR with NEWVALUE)))
|
(PUTPROPS FSETTSTR MACRO ((TSTR FIELD NEWVALUE) (freplace (TEXTSTREAM FIELD) of TSTR with NEWVALUE)))
|
||||||
(PUTPROPS TEXTSTREAM! MACRO (OPENLAMBDA (TSTR) (AND (\DTEST TSTR (QUOTE STREAM)) (TEXTOBJ! (FGETTSTR
|
(PUTPROPS TEXTSTREAM! MACRO (OPENLAMBDA (TSTR) (AND (\DTEST TSTR (QUOTE STREAM)) (TEXTOBJ! (FGETTSTR
|
||||||
TSTR TEXTOBJ)) TSTR)))
|
TSTR TEXTOBJ)) TSTR)))
|
||||||
(RPAQQ PTYPES ((THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) (FATFILE2.PTYPE 2) (THINSTRING.PTYPE 3) (
|
(RPAQQ PTYPES ((THINFILE.PTYPE 0) (FATFILE2.PTYPE 2) (THINSTRING.PTYPE 3) (FATSTRING.PTYPE 4) (
|
||||||
FATSTRING.PTYPE 4) (SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF16BE.PTYPE 8) (
|
SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF16BE.PTYPE 8) (UTF16LE.PTYPE 9) (UTF8.PTYPE 11
|
||||||
UTF16LE.PTYPE 9) (UTF8.PTYPE 11) (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE
|
) (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (
|
||||||
UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (
|
STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (BINABLE.PTYPES (LIST THINFILE.PTYPE
|
||||||
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
|
THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (FAT.PTYPES (LIST
|
||||||
THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE))))
|
FATFILE2.PTYPE FATSTRING.PTYPE))))
|
||||||
(RPAQQ THINFILE.PTYPE 0)
|
(RPAQQ THINFILE.PTYPE 0)
|
||||||
(RPAQQ FATFILE1.PTYPE 1)
|
|
||||||
(RPAQQ FATFILE2.PTYPE 2)
|
(RPAQQ FATFILE2.PTYPE 2)
|
||||||
(RPAQQ THINSTRING.PTYPE 3)
|
(RPAQQ THINSTRING.PTYPE 3)
|
||||||
(RPAQQ FATSTRING.PTYPE 4)
|
(RPAQQ FATSTRING.PTYPE 4)
|
||||||
@@ -428,20 +426,19 @@ THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTY
|
|||||||
(RPAQQ UTF16BE.PTYPE 8)
|
(RPAQQ UTF16BE.PTYPE 8)
|
||||||
(RPAQQ UTF16LE.PTYPE 9)
|
(RPAQQ UTF16LE.PTYPE 9)
|
||||||
(RPAQQ UTF8.PTYPE 11)
|
(RPAQQ UTF8.PTYPE 11)
|
||||||
(RPAQ FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE
|
(RPAQ FILE.PTYPES (LIST THINFILE.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE))
|
||||||
UTF16LE.PTYPE))
|
|
||||||
(RPAQ STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE))
|
(RPAQ STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE))
|
||||||
(RPAQ BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
(RPAQ BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
||||||
(RPAQ THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
(RPAQ THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
|
||||||
(RPAQ FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE))
|
(RPAQ FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE))
|
||||||
(CONSTANTS (THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) (FATFILE2.PTYPE 2) (THINSTRING.PTYPE 3) (
|
(CONSTANTS (THINFILE.PTYPE 0) (FATFILE2.PTYPE 2) (THINSTRING.PTYPE 3) (FATSTRING.PTYPE 4) (
|
||||||
FATSTRING.PTYPE 4) (SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF16BE.PTYPE 8) (
|
SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF16BE.PTYPE 8) (UTF16LE.PTYPE 9) (UTF8.PTYPE 11
|
||||||
UTF16LE.PTYPE 9) (UTF8.PTYPE 11) (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE
|
) (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (
|
||||||
UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (
|
STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (BINABLE.PTYPES (LIST THINFILE.PTYPE
|
||||||
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
|
THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (FAT.PTYPES (LIST
|
||||||
THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))
|
FATFILE2.PTYPE FATSTRING.PTYPE)))
|
||||||
(GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
|
(GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
|
||||||
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "16-Feb-2026 08:56:40"))
|
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE " 1-May-2026 08:15:56"))
|
||||||
(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* ;;
|
(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* ;;
|
||||||
"Test to see if only the specified mouse button is down. DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it was called."
|
"Test to see if only the specified mouse button is down. DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it was called."
|
||||||
) (SELECTQ (CAR BUTTON) (LEFT (QUOTE (EQ LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (EQ LASTMOUSEBUTTONS 1))
|
) (SELECTQ (CAR BUTTON) (LEFT (QUOTE (EQ LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (EQ LASTMOUSEBUTTONS 1))
|
||||||
@@ -455,8 +452,8 @@ I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (
|
|||||||
\BIN STREAM)) BITSPERWORD)))
|
\BIN STREAM)) BITSPERWORD)))
|
||||||
(PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) (* ; "Signed smallp, unlike \WOUT") (\BOUT STREAM (
|
(PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) (* ; "Signed smallp, unlike \WOUT") (\BOUT STREAM (
|
||||||
LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
|
LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
|
||||||
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "15-Feb-2026 23:45:51"))
|
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "29-Apr-2026 23:49:14"))
|
||||||
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE " 8-Sep-2025 22:10:10"))
|
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "10-Apr-2026 09:29:21"))
|
||||||
(DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.")
|
(DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.")
|
||||||
(* ;; "NOTE: If fields change EQCLOOKS should change too.") CLFONT (* ;
|
(* ;; "NOTE: If fields change EQCLOOKS should change too.") CLFONT (* ;
|
||||||
"The font descriptor for these characters") CLFONTUNPARSE (* ;;
|
"The font descriptor for these characters") CLFONTUNPARSE (* ;;
|
||||||
@@ -538,7 +535,7 @@ LINELEAD _ 0)
|
|||||||
(PUTPROPS FSETPLOOKS MACRO ((PLOOKS FIELD NEWVALUE) (freplace (PARALOOKS FIELD) of PLOOKS with
|
(PUTPROPS FSETPLOOKS MACRO ((PLOOKS FIELD NEWVALUE) (freplace (PARALOOKS FIELD) of PLOOKS with
|
||||||
NEWVALUE)))
|
NEWVALUE)))
|
||||||
(PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE PARALOOKS))))
|
(PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE PARALOOKS))))
|
||||||
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "16-Feb-2026 00:36:00"))
|
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "10-Apr-2026 09:34:11"))
|
||||||
(PUTPROP (QUOTE TEDIT-STYLES) (QUOTE IMPORTDATE) (IDATE "28-Jul-2025 23:25:43"))
|
(PUTPROP (QUOTE TEDIT-STYLES) (QUOTE IMPORTDATE) (IDATE "28-Jul-2025 23:25:43"))
|
||||||
(DATATYPE TEDITCARET (TCNOWTIME (* Used to hold the current time, when checking to see if a transition
|
(DATATYPE TEDITCARET (TCNOWTIME (* Used to hold the current time, when checking to see if a transition
|
||||||
is due) TCTHENTIME (* Time when the next transition is to take place) TCFORCEDDOWN (* TCFORCEDOWN = T
|
is due) TCTHENTIME (* Time when the next transition is to take place) TCFORCEDDOWN (* TCFORCEDOWN = T
|
||||||
@@ -602,8 +599,8 @@ GETPANEPROP (PANEPROPS P) NEXTPANE))) (GO $$OUT))) by (OR (GETPANEPROP (PANEPROP
|
|||||||
$$OUT)))))
|
$$OUT)))))
|
||||||
(PUTPROPS ALLBUTTONSUP MACRO (NIL (ZEROP (LOGAND 7 LASTMOUSEBUTTONS))))
|
(PUTPROPS ALLBUTTONSUP MACRO (NIL (ZEROP (LOGAND 7 LASTMOUSEBUTTONS))))
|
||||||
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE " 7-Feb-2026 18:53:22"))
|
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE " 7-Feb-2026 18:53:22"))
|
||||||
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "25-Jan-2026 09:14:04"))
|
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "29-Apr-2026 17:57:09"))
|
||||||
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE " 9-Feb-2026 09:10:43"))
|
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "29-Apr-2026 15:35:33"))
|
||||||
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 22:42:57"))
|
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 22:42:57"))
|
||||||
(RPAQQ \TEDIT.TTCCODES ((NONE . 0) (CHARDELETE . 1) (:CHARDELETE.BACKWARD . 1) (WORDDELETE . 2) (
|
(RPAQQ \TEDIT.TTCCODES ((NONE . 0) (CHARDELETE . 1) (:CHARDELETE.BACKWARD . 1) (WORDDELETE . 2) (
|
||||||
:WORDDELETE.BACKWORD . 2) (DELETE . 3) (:DELETE . 3) (FN . 4) (REDO . 5) (:REDO . 5) (UNDO . 6) (:UNDO
|
:WORDDELETE.BACKWORD . 2) (DELETE . 3) (:DELETE . 3) (FN . 4) (REDO . 5) (:REDO . 5) (UNDO . 6) (:UNDO
|
||||||
@@ -626,7 +623,7 @@ TEDITHISTORYEVENT THLEN) of DATUM) 0))))) (INIT (DEFPRINT (QUOTE TEDITHISTORYEVE
|
|||||||
(PUTPROPS GETTH MACRO ((EVENT FIELD) (fetch (TEDITHISTORYEVENT FIELD) of EVENT)))
|
(PUTPROPS GETTH MACRO ((EVENT FIELD) (fetch (TEDITHISTORYEVENT FIELD) of EVENT)))
|
||||||
(PUTPROPS SETTH MACRO ((EVENT FIELD NEWVALUE) (replace (TEDITHISTORYEVENT FIELD) of EVENT with
|
(PUTPROPS SETTH MACRO ((EVENT FIELD NEWVALUE) (replace (TEDITHISTORYEVENT FIELD) of EVENT with
|
||||||
NEWVALUE)))
|
NEWVALUE)))
|
||||||
(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE " 1-Aug-2025 14:58:56"))
|
(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE "19-Feb-2026 12:39:37"))
|
||||||
(RECORD PAGEFORMATTINGSTATE ((* ;; "Contains the state for a TEdit page-formatting job.") PAGE# (* ;
|
(RECORD PAGEFORMATTINGSTATE ((* ;; "Contains the state for a TEdit page-formatting job.") PAGE# (* ;
|
||||||
"The current page number. Counted from 1") FIRSTPAGE (* ;;
|
"The current page number. Counted from 1") FIRSTPAGE (* ;;
|
||||||
"T if the current page is the 'first page' . Is set initially, and can be set again by the user at will. Gets reset after each page image is printed."
|
"T if the current page is the 'first page' . Is set initially, and can be set again by the user at will. Gets reset after each page image is printed."
|
||||||
@@ -662,8 +659,8 @@ $$VALUES)) (PROG1 (CAR $$VALUES) (\,@ (FOR V IN (CAR ARGS) collect (COND (V (BQU
|
|||||||
$$VALUES)))) (T (BQUOTE (SETQ $$VALUES (CDR $$VALUES))))))))))))
|
$$VALUES)))) (T (BQUOTE (SETQ $$VALUES (CDR $$VALUES))))))))))))
|
||||||
(PUTPROPS TEDIT.VALUES MACRO (ARGS (BQUOTE (LIST (\,@ ARGS)))))
|
(PUTPROPS TEDIT.VALUES MACRO (ARGS (BQUOTE (LIST (\,@ ARGS)))))
|
||||||
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "27-Jan-2026 10:30:27"))
|
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "27-Jan-2026 10:30:27"))
|
||||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "23-Jan-2026 15:49:26"))
|
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "30-Apr-2026 11:55:15"))
|
||||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "21-Jan-2026 12:15:57"))
|
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "10-Apr-2026 09:25:52"))
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL)))
|
(FILEMAP (NIL)))
|
||||||
STOP
|
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 "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
|
: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)
|
(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
|
||||||
@@ -507,32 +507,37 @@
|
|||||||
UNLESS (CDFILES.MATCH SUBDIR NAME EXT THISDEPTH EXCLUDES) COLLECT FULLNAME])
|
UNLESS (CDFILES.MATCH SUBDIR NAME EXT THISDEPTH EXCLUDES) COLLECT FULLNAME])
|
||||||
|
|
||||||
(CDFILES.MATCH
|
(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")
|
(* ; "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)
|
(AND [OR (STRING.EQUAL NAME (CAR P)
|
||||||
FILEDIRCASEARRAY)
|
FILEDIRCASEARRAY)
|
||||||
(EQ '* (CAR P))
|
(EQ '* (CAR P))
|
||||||
(AND (EQ (CHARCODE %.)
|
(AND (EQ (CHARCODE %.)
|
||||||
(CHCON1 (CAR P)))
|
(CHCON1 (CAR P)))
|
||||||
(EQ (CHARCODE %.)
|
(EQ (CHARCODE %.)
|
||||||
(CHCON1 NAME))
|
(CHCON1 NAME))
|
||||||
(OR (STRING.EQUAL NAME (SUBATOM (CAR P)
|
(OR (STRING.EQUAL NAME (SUBATOM (CAR P)
|
||||||
2))
|
2))
|
||||||
(EQ (CHARCODE *)
|
(EQ (CHARCODE *)
|
||||||
(NTHCHARCODE (CAR P)
|
(NTHCHARCODE (CAR P)
|
||||||
2]
|
2]
|
||||||
(OR (STRING.EQUAL EXT (CADR P))
|
(OR (STRING.EQUAL EXT (CADR P))
|
||||||
(EQ '* (CADR P)))
|
(EQ '* (CADR P)))
|
||||||
(OR (STRING.EQUAL SUBDIR (CADDR P))
|
(ILEQ THISDEPTH (CADDDR P))
|
||||||
(NULL (CADDR P))
|
(OR (STRING.EQUAL SUBDIR (CADDR P))
|
||||||
(EQ '* (CADDR P)))
|
(NULL (CADDR P))
|
||||||
(ILEQ THISDEPTH (CADDDR P])
|
(EQ '* (CADDR P))
|
||||||
|
(STRPOS (CADDR P)
|
||||||
|
SUBDIR 1 NIL T])
|
||||||
|
|
||||||
(CDFILES.PATS
|
(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")
|
(* ; "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")
|
(* ;; "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)
|
(* * NIL 1)
|
||||||
)
|
)
|
||||||
ELSE (FOR P N E SD DEPTH UNPACK INSIDE PATTERNS
|
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.")
|
"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")
|
(* ;; "Count the subdirectory depth")
|
||||||
|
|
||||||
[SETQ DEPTH (IF (EQ SD '*)
|
[SETQ DEPTH (if (EQ SD '*)
|
||||||
THEN MAX.SMALLP
|
then MAX.SMALLP
|
||||||
ELSE (FOR I (CNT _ 1) FROM 1 DO (SELCHARQ (NTHCHARCODE SD I)
|
else (for I (CNT _ 1) from 1 do (SELCHARQ (NTHCHARCODE SD I)
|
||||||
((/ >)
|
((/ >)
|
||||||
(ADD CNT 1))
|
(ADD CNT 1))
|
||||||
(NIL (RETURN CNT))
|
(NIL (RETURN CNT))
|
||||||
@@ -560,28 +565,31 @@
|
|||||||
(SETQ N (LISTGET UNPACK 'NAME))
|
(SETQ N (LISTGET UNPACK 'NAME))
|
||||||
(SETQ N (if (NULL N)
|
(SETQ N (if (NULL N)
|
||||||
then '*
|
then '*
|
||||||
|
elseif (EQ N '**)
|
||||||
|
then (SETQ DEPTH MAX.SMALLP)
|
||||||
|
'*
|
||||||
elseif (NEQ 0 (NCHARS N))
|
elseif (NEQ 0 (NCHARS N))
|
||||||
then (MKATOM N)))
|
then N))
|
||||||
(SETQ E (LISTGET UNPACK 'EXTENSION))
|
(SETQ E (LISTGET UNPACK 'EXTENSION))
|
||||||
(SETQ E (if (NULL E)
|
(SETQ E (if (NULL E)
|
||||||
then '*
|
then '*
|
||||||
elseif (NEQ 0 (NCHARS E))
|
elseif (NEQ 0 (NCHARS E))
|
||||||
then (MKATOM E)))
|
then E))
|
||||||
(if [OR (AND (STRING.EQUAL N 'COM)
|
(if [OR (AND (EQ N 'COM)
|
||||||
(NULL E))
|
(NULL E))
|
||||||
(AND (STRING.EQUAL E 'COM)
|
(AND (EQ E 'COM)
|
||||||
(MEMB N ' (* NIL)]
|
(MEMB N ' (* NIL)]
|
||||||
THEN (FOR CE IN *COMPILED-EXTENSIONS* COLLECT (LIST '* CE SD DEPTH))
|
then (for CE in *COMPILED-EXTENSIONS* collect (LIST '* CE SD DEPTH))
|
||||||
ELSE (CONS (IF N
|
else (CONS (if N
|
||||||
THEN (LIST N E SD DEPTH)
|
then (LIST N E SD DEPTH)
|
||||||
ELSEIF E
|
elseif E
|
||||||
THEN
|
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.")
|
(* ;; "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)
|
(LIST (PACK* '%. E)
|
||||||
NIL SD DEPTH)
|
NIL SD DEPTH)
|
||||||
ELSE `
|
else `
|
||||||
|
|
||||||
(* * (\, SD) (\, DEPTH))
|
(* * (\, SD) (\, DEPTH))
|
||||||
])
|
])
|
||||||
@@ -2146,7 +2154,8 @@
|
|||||||
NIL])
|
NIL])
|
||||||
|
|
||||||
(CDBROWSER-COPY
|
(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 28-Oct-2025 17:39 by rmk")
|
||||||
(* ; "Edited 25-Oct-2025 23:58 by rmk")
|
(* ; "Edited 25-Oct-2025 23:58 by rmk")
|
||||||
(* ; "Edited 24-May-2022 15:49 by rmk")
|
(* ; "Edited 24-May-2022 15:49 by rmk")
|
||||||
@@ -2185,7 +2194,8 @@
|
|||||||
(PRIN3 "No source file to copy" T)
|
(PRIN3 "No source file to copy" T)
|
||||||
(RETURN NIL))
|
(RETURN NIL))
|
||||||
(CL:WHEN [AND (EQ DATERELBAD (FETCH (CDENTRY DATEREL) OF CDENTRY))
|
(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
|
(EQ 'N (ASKUSER NIL NIL
|
||||||
"Target is newer than source. Really copy? "]
|
"Target is newer than source. Really copy? "]
|
||||||
(RETURN NIL))
|
(RETURN NIL))
|
||||||
@@ -2195,6 +2205,7 @@
|
|||||||
))
|
))
|
||||||
'VERSION))
|
'VERSION))
|
||||||
(PROGN (FLASHWINDOW T)
|
(PROGN (FLASHWINDOW T)
|
||||||
|
(GIVE.TTY.PROCESS T)
|
||||||
(EQ 'N (ASKUSER NIL NIL (CONCAT SOURCEFILE
|
(EQ 'N (ASKUSER NIL NIL (CONCAT SOURCEFILE
|
||||||
" is not the newest version. Really copy? "
|
" is not the newest version. Really copy? "
|
||||||
]
|
]
|
||||||
@@ -2326,25 +2337,25 @@
|
|||||||
|
|
||||||
(MOVD? 'NILL 'TEDIT.FILEDATE)
|
(MOVD? 'NILL 'TEDIT.FILEDATE)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (2658 23637 (COMPAREDIRECTORIES 2668 . 8003) (COMPAREDIRECTORIES.INFOS 8005 . 11234) (
|
(FILEMAP (NIL (2683 23662 (COMPAREDIRECTORIES 2693 . 8028) (COMPAREDIRECTORIES.INFOS 8030 . 11259) (
|
||||||
COMPAREDIRECTORIES.CANDIDATES 11236 . 14621) (CDENTRIES.SELECT 14623 . 19525) (
|
COMPAREDIRECTORIES.CANDIDATES 11261 . 14646) (CDENTRIES.SELECT 14648 . 19550) (
|
||||||
COMPAREDIRECTORIES.INFOS.TYPE 19527 . 20871) (MATCHNAME 20873 . 21553) (CD.INSURECDVALUE 21555 . 23169
|
COMPAREDIRECTORIES.INFOS.TYPE 19552 . 20896) (MATCHNAME 20898 . 21578) (CD.INSURECDVALUE 21580 . 23194
|
||||||
) (CD.UPDATEWIDTHS 23171 . 23635)) (23638 34343 (CDFILES 23648 . 29745) (CDFILES.MATCH 29747 . 31372)
|
) (CD.UPDATEWIDTHS 23196 . 23660)) (23663 34971 (CDFILES 23673 . 29770) (CDFILES.MATCH 29772 . 31782)
|
||||||
(CDFILES.PATS 31374 . 34341)) (34344 52362 (CDPRINT 34354 . 36871) (CDPRINT.HEADER 36873 . 37770) (
|
(CDFILES.PATS 31784 . 34969)) (34972 52990 (CDPRINT 34982 . 37499) (CDPRINT.HEADER 37501 . 38398) (
|
||||||
CDPRINT.LINE 37772 . 41201) (CDPRINT.MAXWIDTHS 41203 . 45318) (CDPRINT.COLHEADERS 45320 . 46605) (
|
CDPRINT.LINE 38400 . 41829) (CDPRINT.MAXWIDTHS 41831 . 45946) (CDPRINT.COLHEADERS 45948 . 47233) (
|
||||||
CDPRINT.COLUMNS 46607 . 51727) (CDTEDIT 51729 . 52360)) (52363 61484 (CDMAP 52373 . 53805) (CDENTRY
|
CDPRINT.COLUMNS 47235 . 52355) (CDTEDIT 52357 . 52988)) (52991 62112 (CDMAP 53001 . 54433) (CDENTRY
|
||||||
53807 . 54116) (CDSUBSET 54118 . 55557) (CDMERGE 55559 . 59543) (CDMERGE.COMMON 59545 . 60860) (
|
54435 . 54744) (CDSUBSET 54746 . 56185) (CDMERGE 56187 . 60171) (CDMERGE.COMMON 60173 . 61488) (
|
||||||
CD.SORT 60862 . 61482)) (61485 69023 (BINCOMP 61495 . 65784) (EOLTYPE 65786 . 68348) (EOLTYPE.SHOW
|
CD.SORT 61490 . 62110)) (62113 69651 (BINCOMP 62123 . 66412) (EOLTYPE 66414 . 68976) (EOLTYPE.SHOW
|
||||||
68350 . 69021)) (69551 82078 (FIND-UNCOMPILED-FILES 69561 . 73204) (FIND-UNSOURCED-FILES 73206 . 75590
|
68978 . 69649)) (70179 82706 (FIND-UNCOMPILED-FILES 70189 . 73832) (FIND-UNSOURCED-FILES 73834 . 76218
|
||||||
) (FIND-SOURCE-FILES 75592 . 77330) (FIND-COMPILED-FILES 77332 . 79209) (FIND-UNLOADED-FILES 79211 .
|
) (FIND-SOURCE-FILES 76220 . 77958) (FIND-COMPILED-FILES 77960 . 79837) (FIND-UNLOADED-FILES 79839 .
|
||||||
80064) (FIND-LOADED-FILES 80066 . 80494) (FIND-MULTICOMPILED-FILES 80496 . 82076)) (82079 90510 (
|
80692) (FIND-LOADED-FILES 80694 . 81122) (FIND-MULTICOMPILED-FILES 81124 . 82704)) (82707 91138 (
|
||||||
CREATED-AS 82089 . 86886) (SOURCE-FOR-COMPILED-P 86888 . 89815) (COMPILE-SOURCE-DATE-DIFF 89817 .
|
CREATED-AS 82717 . 87514) (SOURCE-FOR-COMPILED-P 87516 . 90443) (COMPILE-SOURCE-DATE-DIFF 90445 .
|
||||||
90508)) (90511 101274 (FIX-DIRECTORY-DATES 90521 . 93971) (FIX-EQUIV-DATES 93973 . 95498) (
|
91136)) (91139 101902 (FIX-DIRECTORY-DATES 91149 . 94599) (FIX-EQUIV-DATES 94601 . 96126) (
|
||||||
COPY-COMPARED-FILES 95500 . 97321) (COPY-MISSING-FILES 97323 . 99480) (COMPILED-ON-SAME-SOURCE 99482
|
COPY-COMPARED-FILES 96128 . 97949) (COPY-MISSING-FILES 97951 . 100108) (COMPILED-ON-SAME-SOURCE 100110
|
||||||
. 101272)) (101468 109346 (CDBROWSER 101478 . 105445) (CDBROWSER.STRINGS 105447 . 109344)) (109508
|
. 101900)) (102096 109974 (CDBROWSER 102106 . 106073) (CDBROWSER.STRINGS 106075 . 109972)) (110136
|
||||||
111244 (CD.TABLEITEM 109518 . 109738) (CD.TABLEITEM.PRINTFN 109740 . 109939) (CD.TABLEITEM.COPYFN
|
111872 (CD.TABLEITEM 110146 . 110366) (CD.TABLEITEM.PRINTFN 110368 . 110567) (CD.TABLEITEM.COPYFN
|
||||||
109941 . 110999) (CDTABLEBROWSER.HEADING.REPAINTFN 111001 . 111242)) (111245 138359 (
|
110569 . 111627) (CDTABLEBROWSER.HEADING.REPAINTFN 111629 . 111870)) (111873 139210 (
|
||||||
CDTABLEBROWSER.WHENSELECTEDFN 111255 . 111723) (CD.COMMANDSELECTEDFN 111725 . 117898) (CD-MENUFN
|
CDTABLEBROWSER.WHENSELECTEDFN 111883 . 112351) (CD.COMMANDSELECTEDFN 112353 . 118526) (CD-MENUFN
|
||||||
117900 . 124377) (CD-COMPARE-FILES 124379 . 127906) (CDBROWSER-COPY 127908 . 133233) (
|
118528 . 125005) (CD-COMPARE-FILES 125007 . 128534) (CDBROWSER-COPY 128536 . 134084) (
|
||||||
CDBROWSER-DELETE-FILE 133235 . 137838) (CD-SWAPDIRS 137840 . 138357)))))
|
CDBROWSER-DELETE-FILE 134086 . 138689) (CD-SWAPDIRS 138691 . 139208)))))
|
||||||
STOP
|
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)
|
(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
|
: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)
|
(PRETTYCOMPRINT GITFNSCOMS)
|
||||||
@@ -51,7 +53,7 @@
|
|||||||
(INITVARS (GIT-MERGE-COMPARES T)
|
(INITVARS (GIT-MERGE-COMPARES T)
|
||||||
(GIT-CDBROWSER-SEPARATE-DIRECTIONS T))
|
(GIT-CDBROWSER-SEPARATE-DIRECTIONS T))
|
||||||
(COMMANDS gwc bbc prc cob b? cdg cdw)
|
(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 ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS)
|
||||||
(FNS TOGIT FROMGIT)
|
(FNS TOGIT FROMGIT)
|
||||||
(FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE)
|
(FNS WORKINGSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE)
|
||||||
(FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME)
|
(FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME)
|
||||||
|
|
||||||
(* ;; "")
|
(* ;; "")
|
||||||
@@ -169,6 +171,9 @@
|
|||||||
|
|
||||||
(GIT-MAKE-PROJECT
|
(GIT-MAKE-PROJECT
|
||||||
[LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)
|
[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-Feb-2026 23:25 by rmk")
|
||||||
(* ; "Edited 25-Oct-2025 16:53 by rmk")
|
(* ; "Edited 25-Oct-2025 16:53 by rmk")
|
||||||
(* ; "Edited 22-Oct-2025 12:45 by rmk")
|
(* ; "Edited 22-Oct-2025 12:45 by rmk")
|
||||||
@@ -275,7 +280,8 @@
|
|||||||
"for " PROJECTNAME]
|
"for " PROJECTNAME]
|
||||||
(SETQ PROJECT (create GIT-PROJECT
|
(SETQ PROJECT (create GIT-PROJECT
|
||||||
PROJECTNAME ← PROJECTNAME
|
PROJECTNAME ← PROJECTNAME
|
||||||
GITHOST ← (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH)
|
GITHOST ← (PACK* "{" (PSEUDOHOST (CONCAT "G" PROJECTNAME)
|
||||||
|
CLONEPATH)
|
||||||
"}")
|
"}")
|
||||||
WHOST ← (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W"
|
WHOST ← (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W"
|
||||||
PROJECTNAME)
|
PROJECTNAME)
|
||||||
@@ -439,18 +445,7 @@
|
|||||||
|
|
||||||
(RPAQ? GIT-CDBROWSER-SEPARATE-DIRECTIONS T)
|
(RPAQ? GIT-CDBROWSER-SEPARATE-DIRECTIONS T)
|
||||||
|
|
||||||
(DEFCOMMAND gwc (SUBDIR . OTHERS)
|
(DEFCOMMAND gwc (SUBDIR . OTHERS) (GIT-GWC-COMMAND 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 bbc (BRANCH1 BRANCH2 LOCAL PROJECT)
|
(DEFCOMMAND bbc (BRANCH1 BRANCH2 LOCAL PROJECT)
|
||||||
|
|
||||||
@@ -616,6 +611,32 @@
|
|||||||
PROJECT))
|
PROJECT))
|
||||||
else (CONCAT "No open " (OR REMOTEBRANCH "")
|
else (CONCAT "No open " (OR REMOTEBRANCH "")
|
||||||
" pull requests"])
|
" 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
|
(DEFINEQ
|
||||||
|
|
||||||
(MYMEDLEYSUBDIR
|
(WORKINGSUBDIR
|
||||||
[LAMBDA (SUBDIR STAR PROJECT) (* ; "Edited 13-May-2022 10:40 by rmk")
|
[LAMBDA (SUBDIR STAR PROJECT) (* ; "Edited 13-May-2022 10:40 by rmk")
|
||||||
(* ; "Edited 7-May-2022 23:15 by rmk")
|
(* ; "Edited 7-May-2022 23:15 by rmk")
|
||||||
(UNSLASHIT (PACK* (PACKFILENAME 'HOST (FETCH WHOST OF PROJECT)
|
(UNSLASHIT (PACK* (PACKFILENAME 'HOST (FETCH WHOST OF PROJECT)
|
||||||
@@ -1398,13 +1419,12 @@
|
|||||||
" branches"])
|
" branches"])
|
||||||
|
|
||||||
(GIT-BRANCH-MENU
|
(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 6-Jul-2023 22:31 by rmk")
|
||||||
(* ; "Edited 30-Jun-2023 16:58 by rmk")
|
(* ; "Edited 30-Jun-2023 16:58 by rmk")
|
||||||
(* ; "Edited 18-May-2022 13:44 by rmk")
|
(* ; "Edited 18-May-2022 13:44 by rmk")
|
||||||
(CL:WHEN (SETQ BRANCHES (MKLIST BRANCHES))
|
(CL:WHEN (SETQ BRANCHES (MKLIST BRANCHES))
|
||||||
(CL:WHEN PIN?
|
|
||||||
[SETQ BRANCHES (APPEND BRANCHES '((" Pin menu" 'PinMenu])
|
|
||||||
(create MENU
|
(create MENU
|
||||||
TITLE ← (OR TITLE (CONCAT (LENGTH BRANCHES)
|
TITLE ← (OR TITLE (CONCAT (LENGTH BRANCHES)
|
||||||
" branches"))
|
" branches"))
|
||||||
@@ -1950,6 +1970,8 @@
|
|||||||
(GIT-WORKING-COMPARE-DIRECTORIES
|
(GIT-WORKING-COMPARE-DIRECTORIES
|
||||||
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
|
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
|
||||||
|
|
||||||
|
(* ;; "Edited 29-Apr-2026 08:46 by rmk")
|
||||||
|
|
||||||
(* ;; "Edited 28-Oct-2025 14:00 by rmk")
|
(* ;; "Edited 28-Oct-2025 14:00 by rmk")
|
||||||
|
|
||||||
(* ;; "Edited 25-Oct-2025 23:32 by rmk")
|
(* ;; "Edited 25-Oct-2025 23:32 by rmk")
|
||||||
@@ -1960,18 +1982,12 @@
|
|||||||
|
|
||||||
(* ;; "Edited 26-Sep-2023 22:41 by rmk")
|
(* ;; "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 20-Jul-2022 21:18 by rmk")
|
||||||
|
|
||||||
(* ;; "Edited 25-Jun-2022 21:37 by rmk")
|
(* ;; "Edited 25-Jun-2022 21:37 by rmk")
|
||||||
|
|
||||||
(* ;; "Edited 17-May-2022 17:39 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.")
|
"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)
|
(LET ((SUBDIRSTRING (if (EQ SUBDIRS 'all)
|
||||||
then (SETQ SUBDIRS (ALLSUBDIRS PROJECT))
|
then (SETQ SUBDIRS (ALLSUBDIRS PROJECT))
|
||||||
"ALL subdirectories"
|
"ALL subdirectories"
|
||||||
else SUBDIRS)))
|
else SUBDIRS))
|
||||||
|
(EXCLUSIONS))
|
||||||
(for SUBDIR TITLE CDVAL (WPROJ ← (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT)
|
(for SUBDIR TITLE CDVAL (WPROJ ← (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT)
|
||||||
T)))
|
T)))
|
||||||
(NENTRIES ← 0)
|
(NENTRIES ← 0)
|
||||||
@@ -1999,11 +2016,12 @@
|
|||||||
first (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
|
first (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
|
||||||
(BKSYSBUF " ") inside SUBDIRS
|
(BKSYSBUF " ") inside SUBDIRS
|
||||||
collect (TERPRI T)
|
collect (TERPRI T)
|
||||||
(SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR SUBDIR T PROJECT)
|
(SETQ CDVAL (COMPAREDIRECTORIES (WORKINGSUBDIR SUBDIR T PROJECT)
|
||||||
(GITSUBDIR SUBDIR T PROJECT)
|
(GITSUBDIR SUBDIR T PROJECT)
|
||||||
(OR SELECT '(> < ~= -* *-))
|
(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
|
collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E
|
||||||
'DIRECTORY)
|
'DIRECTORY)
|
||||||
1 NIL T T FILEDIRCASEARRAY))
|
1 NIL T T FILEDIRCASEARRAY))
|
||||||
@@ -2216,7 +2234,7 @@
|
|||||||
(OR LABEL2 FILE2])
|
(OR LABEL2 FILE2])
|
||||||
|
|
||||||
(GIT-CD-MENUFN
|
(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 25-Oct-2025 23:44 by rmk")
|
||||||
(* ; "Edited 21-Sep-2022 21:34 by rmk")
|
(* ; "Edited 21-Sep-2022 21:34 by rmk")
|
||||||
(* ; "Edited 22-May-2022 19:13 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")
|
(* ;; "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)
|
(SELECTQ (OR (CADDR MENUITEM)
|
||||||
(CAR 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)))
|
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT (CADDDR MENUITEM)))
|
||||||
(SHOULDNT])
|
(SHOULDNT])
|
||||||
|
|
||||||
@@ -2429,33 +2470,33 @@
|
|||||||
|
|
||||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (4197 21075 (GIT-CLONEP 4207 . 5638) (GIT-INIT 5640 . 6270) (GIT-MAKE-PROJECT 6272 .
|
(FILEMAP (NIL (4257 21537 (GIT-CLONEP 4267 . 5698) (GIT-INIT 5700 . 6330) (GIT-MAKE-PROJECT 6332 .
|
||||||
14129) (GIT-GET-PROJECT 14131 . 16056) (GIT-PUT-PROJECT-FIELD 16058 . 17699) (GIT-PROJECT-PATH 17701
|
14591) (GIT-GET-PROJECT 14593 . 16518) (GIT-PUT-PROJECT-FIELD 16520 . 18161) (GIT-PROJECT-PATH 18163
|
||||||
. 18745) (FIND-ANCESTOR-DIRECTORY 18747 . 19098) (GIT-FIND-CLONE 19100 . 20183) (GIT-MAINBRANCH 20185
|
. 19207) (FIND-ANCESTOR-DIRECTORY 19209 . 19560) (GIT-FIND-CLONE 19562 . 20645) (GIT-MAINBRANCH 20647
|
||||||
. 20580) (GIT-MAINBRANCH? 20582 . 21073)) (26538 31832 (PRC-COMMAND 26548 . 31830)) (31888 34676 (
|
. 21042) (GIT-MAINBRANCH? 21044 . 21535)) (26309 33483 (PRC-COMMAND 26319 . 31601) (GIT-GWC-COMMAND
|
||||||
ALLSUBDIRS 31898 . 33184) (MEDLEYSUBDIRS 33186 . 33879) (GITSUBDIRS 33881 . 34674)) (34677 37082 (
|
31603 . 33481)) (33539 36327 (ALLSUBDIRS 33549 . 34835) (MEDLEYSUBDIRS 34837 . 35530) (GITSUBDIRS
|
||||||
TOGIT 34687 . 36095) (FROMGIT 36097 . 37080)) (37083 40093 (MYMEDLEYSUBDIR 37093 . 37549) (GITSUBDIR
|
35532 . 36325)) (36328 38733 (TOGIT 36338 . 37746) (FROMGIT 37748 . 38731)) (38734 41743 (
|
||||||
37551 . 37994) (STRIPDIR 37996 . 38374) (STRIPHOST 38376 . 38616) (STRIPNAME 38618 . 39371) (
|
WORKINGSUBDIR 38744 . 39199) (GITSUBDIR 39201 . 39644) (STRIPDIR 39646 . 40024) (STRIPHOST 40026 .
|
||||||
STRIPWHERE 39373 . 40091)) (40094 42329 (GFILE4MFILE 40104 . 40800) (MFILE4GFILE 40802 . 41371) (
|
40266) (STRIPNAME 40268 . 41021) (STRIPWHERE 41023 . 41741)) (41744 43979 (GFILE4MFILE 41754 . 42450)
|
||||||
GIT-REPO-FILENAME 41373 . 42327)) (42378 52635 (GIT-COMMIT 42388 . 43214) (GIT-PUSH 43216 . 43976) (
|
(MFILE4GFILE 42452 . 43021) (GIT-REPO-FILENAME 43023 . 43977)) (44028 54285 (GIT-COMMIT 44038 . 44864)
|
||||||
GIT-PULL 43978 . 44730) (GIT-APPROVAL 44732 . 45081) (GIT-GET-FILE 45083 . 46998) (GIT-FILE-EXISTS?
|
(GIT-PUSH 44866 . 45626) (GIT-PULL 45628 . 46380) (GIT-APPROVAL 46382 . 46731) (GIT-GET-FILE 46733 .
|
||||||
47000 . 47274) (GIT-REMOTE-UPDATE 47276 . 48111) (GIT-REMOTE-ADD 48113 . 48420) (GIT-FILE-DATE 48422
|
48648) (GIT-FILE-EXISTS? 48650 . 48924) (GIT-REMOTE-UPDATE 48926 . 49761) (GIT-REMOTE-ADD 49763 .
|
||||||
. 49469) (GIT-FILE-HISTORY 49471 . 51405) (GIT-PRINT-FILE-HISTORY 51407 . 52459) (GIT-FETCH 52461 .
|
50070) (GIT-FILE-DATE 50072 . 51119) (GIT-FILE-HISTORY 51121 . 53055) (GIT-PRINT-FILE-HISTORY 53057 .
|
||||||
52633)) (52665 64617 (GIT-BRANCH-DIFF 52675 . 59564) (GIT-COMMIT-DIFFS 59566 . 60457) (
|
54109) (GIT-FETCH 54111 . 54283)) (54315 66267 (GIT-BRANCH-DIFF 54325 . 61214) (GIT-COMMIT-DIFFS 61216
|
||||||
GIT-BRANCH-RELATIONS 60459 . 64143) (GIT-MODIFIED 64145 . 64615)) (64662 83597 (GIT-BRANCH-NUM 64672
|
. 62107) (GIT-BRANCH-RELATIONS 62109 . 65793) (GIT-MODIFIED 65795 . 66265)) (66312 85259 (
|
||||||
. 65245) (GIT-CHECKOUT 65247 . 66533) (GIT-WHICH-BRANCH 66535 . 66942) (GIT-MAKE-BRANCH 66944 . 69523
|
GIT-BRANCH-NUM 66322 . 66895) (GIT-CHECKOUT 66897 . 68183) (GIT-WHICH-BRANCH 68185 . 68592) (
|
||||||
) (GIT-BRANCHES 69525 . 72122) (GIT-BRANCH-EXISTS? 72124 . 72995) (GIT-PICK-BRANCH 72997 . 73487) (
|
GIT-MAKE-BRANCH 68594 . 71173) (GIT-BRANCHES 71175 . 73772) (GIT-BRANCH-EXISTS? 73774 . 74645) (
|
||||||
GIT-BRANCH-MENU 73489 . 74378) (GIT-BRANCH-WHENSELECTEDFN 74380 . 76087) (GIT-PULL-REQUESTS 76089 .
|
GIT-PICK-BRANCH 74647 . 75137) (GIT-BRANCH-MENU 75139 . 76040) (GIT-BRANCH-WHENSELECTEDFN 76042 .
|
||||||
79974) (GIT-SHORT-BRANCH-NAME 79976 . 80267) (GIT-LONG-NAME 80269 . 80586) (GIT-PRC-BRANCHES 80588 .
|
77749) (GIT-PULL-REQUESTS 77751 . 81636) (GIT-SHORT-BRANCH-NAME 81638 . 81929) (GIT-LONG-NAME 81931 .
|
||||||
83595)) (83627 88381 (GIT-MY-CURRENT-BRANCH 83637 . 84007) (GIT-MY-BRANCHP 84009 . 84627) (
|
82248) (GIT-PRC-BRANCHES 82250 . 85257)) (85289 90043 (GIT-MY-CURRENT-BRANCH 85299 . 85669) (
|
||||||
GIT-MY-NEXT-BRANCH 84629 . 86429) (GIT-MY-BRANCHES 86431 . 88379)) (88427 92511 (GIT-ADD-WORKTREE
|
GIT-MY-BRANCHP 85671 . 86289) (GIT-MY-NEXT-BRANCH 86291 . 88091) (GIT-MY-BRANCHES 88093 . 90041)) (
|
||||||
88437 . 90044) (GIT-REMOVE-WORKTREE 90046 . 90978) (GIT-LIST-WORKTREES 90980 . 91791) (WORKTREEDIR
|
90089 94173 (GIT-ADD-WORKTREE 90099 . 91706) (GIT-REMOVE-WORKTREE 91708 . 92640) (GIT-LIST-WORKTREES
|
||||||
91793 . 92509)) (92559 125597 (GIT-GET-DIFFERENT-FILES 92569 . 99477) (
|
92642 . 93453) (WORKTREEDIR 93455 . 94171)) (94221 128732 (GIT-GET-DIFFERENT-FILES 94231 . 101139) (
|
||||||
GIT-BRANCHES-COMPARE-DIRECTORIES 99479 . 107118) (GIT-WORKING-COMPARE-DIRECTORIES 107120 . 112922) (
|
GIT-BRANCHES-COMPARE-DIRECTORIES 101141 . 108780) (GIT-WORKING-COMPARE-DIRECTORIES 108782 . 114597) (
|
||||||
GIT-COMPARE-WORKTREE 112924 . 116902) (GITCDOBJBUTTONFN 116904 . 121402) (GIT-CD-LABELFN 121404 .
|
GIT-COMPARE-WORKTREE 114599 . 118577) (GITCDOBJBUTTONFN 118579 . 123077) (GIT-CD-LABELFN 123079 .
|
||||||
122490) (GIT-CD-MENUFN 122492 . 123578) (GIT-WORKING-COMPARE-FILES 123580 . 124200) (
|
124165) (GIT-CD-MENUFN 124167 . 126713) (GIT-WORKING-COMPARE-FILES 126715 . 127335) (
|
||||||
GIT-BRANCHES-COMPARE-FILES 124202 . 125366) (GIT-PR-COMPARE 125368 . 125595)) (125667 133998 (CDGITDIR
|
GIT-BRANCHES-COMPARE-FILES 127337 . 128501) (GIT-PR-COMPARE 128503 . 128730)) (128802 137133 (CDGITDIR
|
||||||
125677 . 126364) (GIT-COMMAND 126366 . 127924) (GITORIGIN 127926 . 128623) (GIT-INITIALS 128625 .
|
128812 . 129499) (GIT-COMMAND 129501 . 131059) (GITORIGIN 131061 . 131758) (GIT-INITIALS 131760 .
|
||||||
128929) (GIT-COMMAND-TO-FILE 128931 . 132416) (GIT-RESULT-TO-LINES 132418 . 133331) (STRIPLOCAL 133333
|
132064) (GIT-COMMAND-TO-FILE 132066 . 135551) (GIT-RESULT-TO-LINES 135553 . 136466) (STRIPLOCAL 136468
|
||||||
. 133996)))))
|
. 137131)))))
|
||||||
STOP
|
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
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS DOCS.LOOKUP GENERIC.MAN.LOOKUP)
|
:CHANGES-TO (FNS REPO.LOOKUP)
|
||||||
(VARS HELPSYSCOMS)
|
|
||||||
|
|
||||||
: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)
|
(PRETTYCOMPRINT HELPSYSCOMS)
|
||||||
@@ -340,21 +339,27 @@
|
|||||||
else "git web--browse"])
|
else "git web--browse"])
|
||||||
|
|
||||||
(REPO.LOOKUP
|
(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")
|
(* ; "Edited 16-Aug-2022 16:26 by lmm")
|
||||||
(for FL in (UNION (WHEREIS ENTRY (OR TYPES HELPSYS.REPO.TYPES)
|
(for FL POS FND TSTREAM in (UNION (WHEREIS ENTRY (OR TYPES HELPSYS.REPO.TYPES)
|
||||||
T)
|
T)
|
||||||
(LIST ENTRY)) bind POS FND
|
(LIST ENTRY))
|
||||||
when [SETQ FND (OR (FINDFILE-WITH-EXTENSIONS FL NIL '(TEDIT TXT TED))
|
when [SETQ FND (OR (FINDFILE-WITH-EXTENSIONS FL NIL '(TEDIT TXT TED))
|
||||||
(AND (SETQ POS (STRPOS "-" FL))
|
(AND (SETQ POS (STRPOS "-" FL))
|
||||||
(FINDFILE-WITH-EXTENSIONS (SUBSTRING FL 1 (CL:1- POS))
|
(FINDFILE-WITH-EXTENSIONS (SUBSTRING FL 1 (CL:1- POS))
|
||||||
NIL
|
NIL
|
||||||
'(TEDIT TXT TTY TED]
|
'(TEDIT TXT TTY TED]
|
||||||
join (CL:WITH-OPEN-FILE (STR (PATHNAME FND)
|
collect (SETQ TSTREAM (OPENTEXTSTREAM FND))
|
||||||
:DIRECTION :INPUT)
|
[TEDIT TSTREAM NIL NIL `(READONLY T LEAVETTY T FONT ,DEFAULTFONT TITLE
|
||||||
(CL:WHEN (SETQ POS (FFILEPOS ENTRY STR))
|
,(CL:IF (EQ FL ENTRY)
|
||||||
(TEDIT-SEE STR NIL NIL (CL:FORMAT NIL "~a [~a]" FL ENTRY))
|
FL
|
||||||
(LIST 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
|
(RPAQQ CLHS.INDEX
|
||||||
@@ -1716,14 +1721,14 @@
|
|||||||
|
|
||||||
(PUTPROPS HELPSYS FILETYPE :FAKE-COMPILE-FILE)
|
(PUTPROPS HELPSYS FILETYPE :FAKE-COMPILE-FILE)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (4640 10992 (HELPSYS 4650 . 6491) (IRM.LOOKUP 6493 . 8131) (GENERIC.MAN.LOOKUP 8133 .
|
(FILEMAP (NIL (4582 10934 (HELPSYS 4592 . 6433) (IRM.LOOKUP 6435 . 8073) (GENERIC.MAN.LOOKUP 8075 .
|
||||||
10001) (IRM.SMART.LOOKUP 10003 . 10159) (IRM.RESET 10161 . 10570) (DOCS.LOOKUP 10572 . 10990)) (11249
|
9943) (IRM.SMART.LOOKUP 9945 . 10101) (IRM.RESET 10103 . 10512) (DOCS.LOOKUP 10514 . 10932)) (11191
|
||||||
18568 (CLHS.INDEX 11259 . 14223) (CLHS.LOOKUP 14225 . 16231) (CLHS.OPENER 16233 . 17556) (REPO.LOOKUP
|
18932 (CLHS.INDEX 11201 . 14165) (CLHS.LOOKUP 14167 . 16173) (CLHS.OPENER 16175 . 17498) (REPO.LOOKUP
|
||||||
17558 . 18566)) (71663 73181 (IRM.GET.DINFOGRAPH 71673 . 72548) (IRM.DISPLAY.REF 72550 . 73179)) (
|
17500 . 18930)) (72027 73545 (IRM.GET.DINFOGRAPH 72037 . 72912) (IRM.DISPLAY.REF 72914 . 73543)) (
|
||||||
73183 73545 (IRM.LOAD-GRAPH 73183 . 73545)) (73870 79374 (IRM.DISPLAY.CREF 73880 . 75594) (
|
73547 73909 (IRM.LOAD-GRAPH 73547 . 73909)) (74234 79738 (IRM.DISPLAY.CREF 74244 . 75958) (
|
||||||
IRM.CREF.BOX 75596 . 76423) (IRM.PUT.CREF 76425 . 76650) (IRM.GET.CREF 76652 . 77023) (
|
IRM.CREF.BOX 75960 . 76787) (IRM.PUT.CREF 76789 . 77014) (IRM.GET.CREF 77016 . 77387) (
|
||||||
IRM.CREF.BUTTONEVENTFN 77025 . 79372)) (79929 88235 (\IRM.GET.REF 79939 . 81270) (\IRM.SMART.REF 81272
|
IRM.CREF.BUTTONEVENTFN 77389 . 79736)) (80293 88599 (\IRM.GET.REF 80303 . 81634) (\IRM.SMART.REF 81636
|
||||||
. 83199) (\IRM.CHOOSE.REF 83201 . 84452) (\IRM.WILD.REF 84454 . 85709) (\IRM.WILDCARD 85711 . 86077)
|
. 83563) (\IRM.CHOOSE.REF 83565 . 84816) (\IRM.WILD.REF 84818 . 86073) (\IRM.WILDCARD 86075 . 86441)
|
||||||
(\IRM.WILD.MATCH 86079 . 87309) (\IRM.GET.HASHFILE 87311 . 87774) (\IRM.GET.KEYWORDS 87776 . 88233)) (
|
(\IRM.WILD.MATCH 86443 . 87673) (\IRM.GET.HASHFILE 87675 . 88138) (\IRM.GET.KEYWORDS 88140 . 88597)) (
|
||||||
88372 88528 (\IRM.AROUND-EXIT 88372 . 88528)))))
|
88736 88892 (\IRM.AROUND-EXIT 88736 . 88892)))))
|
||||||
STOP
|
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
|
# save dribble file to loadups; extract and save fails
|
||||||
"${MEDLEYDIR}"/scripts/cpv ${logindir}/HCFILES.DRIBBLE "${MEDLEYDIR}"/loadups/hcfiles.dribble
|
"${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
|
"${MEDLEYDIR}"/scripts/cpv ${logindir}/fails "${MEDLEYDIR}"/loadups/hcfiles-fails.txt
|
||||||
|
|
||||||
# cleanup
|
# 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)
|
(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)
|
: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)
|
(PRETTYCOMPRINT FILEIOCOMS)
|
||||||
@@ -1446,7 +1446,8 @@
|
|||||||
(GO RETRY])
|
(GO RETRY])
|
||||||
|
|
||||||
(\DO.PARAMS.AT.OPEN
|
(\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 20-Apr-2026 17:36 by mth")
|
||||||
(* ; "Edited 25-Dec-2024 10:54 by rmk")
|
(* ; "Edited 25-Dec-2024 10:54 by rmk")
|
||||||
(* ; "Edited 15-Jul-2024 22:29 by rmk")
|
(* ; "Edited 15-Jul-2024 22:29 by rmk")
|
||||||
@@ -1484,40 +1485,27 @@
|
|||||||
(CHARSET (CHARSET STREAM VAL))
|
(CHARSET (CHARSET STREAM VAL))
|
||||||
((FORMAT EXTERNALFORMAT :EXTERNAL-FORMAT)
|
((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)
|
(for V inside VAL do (if (MEMB V '(LF CR CRLF ANY))
|
||||||
then
|
then (SETQ EOL V)
|
||||||
(* ;;
|
else (\EXTERNALFORMAT STREAM V))))
|
||||||
"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])
|
|
||||||
(CONVHANKAKU (CONVHANKAKU STREAM VAL))
|
(CONVHANKAKU (CONVHANKAKU STREAM VAL))
|
||||||
((EOL EOLCONVENTION EOLC)
|
((EOL EOLCONVENTION EOLC)
|
||||||
(SETQ EOL VAL))
|
(SETQ EOL VAL))
|
||||||
NIL) finally
|
NIL) finally
|
||||||
|
|
||||||
(* ;;
|
(* ;; "If EOL is not specified, default input streams to ANY. ")
|
||||||
"If not specified, default EOL to ANY--SETFILEINFO checks for output streams")
|
|
||||||
|
|
||||||
(* ;;
|
(CL:UNLESS (OR EOL (\GETSTREAM STREAM 'OUTPUT T))
|
||||||
" Cannot depend on SETFILEINFO checking for ANY on output stream, because it ERRORs!")
|
(SETQ EOL 'ANY))
|
||||||
|
(CL:WHEN EOL
|
||||||
(CL:WHEN (OR (NEQ (SETQ EOL (OR EOL 'ANY))
|
|
||||||
'ANY)
|
|
||||||
(EQ ACCESS 'INPUT))
|
|
||||||
(SETFILEINFO STREAM 'EOL 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
|
(\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")
|
(* ; "Edited 16-Dec-2024 21:07 by rmk")
|
||||||
(* hdj " 7-May-86 12:22")
|
(* hdj " 7-May-86 12:22")
|
||||||
(SETQ OLDFILE (\ADD.CONNECTED.DIR OLDFILE))
|
(SETQ OLDFILE (\ADD.CONNECTED.DIR OLDFILE))
|
||||||
@@ -1532,7 +1520,7 @@
|
|||||||
NEW-DEVICE
|
NEW-DEVICE
|
||||||
(TRUEFILENAME NEWFILE)))
|
(TRUEFILENAME NEWFILE)))
|
||||||
(CL:IF (PSEUDOHOSTP NEWFILE)
|
(CL:IF (PSEUDOHOSTP NEWFILE)
|
||||||
(PSEUDOFILENAME NEWFULLNAME)
|
(PSEUDOFILENAME NEWFULLNAME (FILENAMEFIELD NEWFILE 'HOST))
|
||||||
NEWFULLNAME))])
|
NEWFULLNAME))])
|
||||||
|
|
||||||
(\REVALIDATEFILE
|
(\REVALIDATEFILE
|
||||||
@@ -3172,39 +3160,39 @@ update the map")
|
|||||||
(ADDTOVAR LAMA \IS.NOT.RANDACCESSP \ILLEGAL.DEVICEOP STREAMPROP)
|
(ADDTOVAR LAMA \IS.NOT.RANDACCESSP \ILLEGAL.DEVICEOP STREAMPROP)
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (27757 31873 (STREAMPROP 27767 . 28201) (GETSTREAMPROP 28203 . 28952) (PUTSTREAMPROP
|
(FILEMAP (NIL (27711 31827 (STREAMPROP 27721 . 28155) (GETSTREAMPROP 28157 . 28906) (PUTSTREAMPROP
|
||||||
28954 . 31721) (STREAMP 31723 . 31871)) (31916 35295 (\DEFPRINT.BY.NAME 31926 . 33078) (
|
28908 . 31675) (STREAMP 31677 . 31825)) (31870 35249 (\DEFPRINT.BY.NAME 31880 . 33032) (
|
||||||
\STREAM.DEFPRINT 33080 . 34988) (\FDEV.DEFPRINT 34990 . 35293)) (35553 40594 (\GETACCESS 35563 . 36017
|
\STREAM.DEFPRINT 33034 . 34942) (\FDEV.DEFPRINT 34944 . 35247)) (35507 40548 (\GETACCESS 35517 . 35971
|
||||||
) (\SETACCESS 36019 . 40592)) (60820 66789 (\DEFINEDEVICE 60830 . 63146) (\GETDEVICEFROMNAME 63148 .
|
) (\SETACCESS 35973 . 40546)) (60774 66743 (\DEFINEDEVICE 60784 . 63100) (\GETDEVICEFROMNAME 63102 .
|
||||||
63621) (\GETDEVICEFROMHOSTNAME 63623 . 64667) (\REMOVEDEVICE 64669 . 65792) (\REMOVEDEVICE.NAMES 65794
|
63575) (\GETDEVICEFROMHOSTNAME 63577 . 64621) (\REMOVEDEVICE 64623 . 65746) (\REMOVEDEVICE.NAMES 65748
|
||||||
. 66787)) (66829 94486 (\CLOSEFILE 66839 . 67664) (\DELETEFILE 67666 . 67960) (\DEVICEEVENT 67962 .
|
. 66741)) (66783 93926 (\CLOSEFILE 66793 . 67618) (\DELETEFILE 67620 . 67914) (\DEVICEEVENT 67916 .
|
||||||
69732) (\GENERATEFILES 69734 . 70681) (\GENERATENEXTFILE 70683 . 71334) (\GENERATEFILEINFO 71336 .
|
69686) (\GENERATEFILES 69688 . 70635) (\GENERATENEXTFILE 70637 . 71288) (\GENERATEFILEINFO 71290 .
|
||||||
71797) (\GETFILENAME 71799 . 72188) (\GENERIC.OUTFILEP 72190 . 72660) (\OPENFILE 72662 . 75240) (
|
71751) (\GETFILENAME 71753 . 72142) (\GENERIC.OUTFILEP 72144 . 72614) (\OPENFILE 72616 . 75194) (
|
||||||
\DO.PARAMS.AT.OPEN 75242 . 79364) (\RENAMEFILE 79366 . 80322) (\REVALIDATEFILE 80324 . 82926) (
|
\DO.PARAMS.AT.OPEN 75196 . 78665) (\RENAMEFILE 78667 . 79762) (\REVALIDATEFILE 79764 . 82366) (
|
||||||
\PAGED.REVALIDATEFILELST 82928 . 84486) (\PAGED.REVALIDATEFILES 84488 . 86207) (\PAGED.REVALIDATEFILE
|
\PAGED.REVALIDATEFILELST 82368 . 83926) (\PAGED.REVALIDATEFILES 83928 . 85647) (\PAGED.REVALIDATEFILE
|
||||||
86209 . 88492) (\BUFFERED.REVALIDATEFILE 88494 . 90780) (\BUFFERED.REVALIDATEFILELST 90782 . 91966) (
|
85649 . 87932) (\BUFFERED.REVALIDATEFILE 87934 . 90220) (\BUFFERED.REVALIDATEFILELST 90222 . 91406) (
|
||||||
\PRINT-REVALIDATION-RESULT 91968 . 92810) (\TRUNCATEFILE 92812 . 93203) (\FILE-CONFLICT 93205 . 94484)
|
\PRINT-REVALIDATION-RESULT 91408 . 92250) (\TRUNCATEFILE 92252 . 92643) (\FILE-CONFLICT 92645 . 93924)
|
||||||
) (94522 99185 (\GENERATENOFILES 94532 . 96628) (\NULLFILEGENERATOR 96630 . 96874) (\NOFILESNEXTFILEFN
|
) (93962 98625 (\GENERATENOFILES 93972 . 96068) (\NULLFILEGENERATOR 96070 . 96314) (\NOFILESNEXTFILEFN
|
||||||
96876 . 98867) (\NOFILESINFOFN 98869 . 99183)) (99304 101212 (\FILE.NOT.OPEN 99314 . 99827) (
|
96316 . 98307) (\NOFILESINFOFN 98309 . 98623)) (98744 100652 (\FILE.NOT.OPEN 98754 . 99267) (
|
||||||
\FILE.WONT.OPEN 99829 . 100157) (\ILLEGAL.DEVICEOP 100159 . 100441) (\IS.NOT.RANDACCESSP 100443 .
|
\FILE.WONT.OPEN 99269 . 99597) (\ILLEGAL.DEVICEOP 99599 . 99881) (\IS.NOT.RANDACCESSP 99883 . 100329)
|
||||||
100889) (\STREAM.NOT.OPEN 100891 . 101210)) (101347 103645 (\FDEVINSTANCE 101357 . 103643)) (104847
|
(\STREAM.NOT.OPEN 100331 . 100650)) (100787 103085 (\FDEVINSTANCE 100797 . 103083)) (104287 111258 (
|
||||||
111818 (CNDIR 104857 . 106162) (DIRECTORYNAME 106164 . 109944) (DIRECTORYNAMEP 109946 . 110562) (
|
CNDIR 104297 . 105602) (DIRECTORYNAME 105604 . 109384) (DIRECTORYNAMEP 109386 . 110002) (HOSTNAMEP
|
||||||
HOSTNAMEP 110564 . 111371) (\ADD.CONNECTED.DIR 111373 . 111816)) (111863 140810 (\BACKFILEPTR 111873
|
110004 . 110811) (\ADD.CONNECTED.DIR 110813 . 111256)) (111303 140250 (\BACKFILEPTR 111313 . 111501) (
|
||||||
. 112061) (\BACKPEEKBIN 112063 . 112424) (\BACKBIN 112426 . 112777) (BIN 112779 . 112996) (\BIN
|
\BACKPEEKBIN 111503 . 111864) (\BACKBIN 111866 . 112217) (BIN 112219 . 112436) (\BIN 112438 . 112715)
|
||||||
112998 . 113275) (\BINS 113277 . 113563) (BOUT 113565 . 113927) (\BOUT 113929 . 114244) (\BOUTS 114246
|
(\BINS 112717 . 113003) (BOUT 113005 . 113367) (\BOUT 113369 . 113684) (\BOUTS 113686 . 113997) (
|
||||||
. 114557) (COPYBYTES 114559 . 117891) (COPYCHARS 117893 . 121691) (COPYFILE 121693 . 123053) (
|
COPYBYTES 113999 . 117331) (COPYCHARS 117333 . 121131) (COPYFILE 121133 . 122493) (\COPYOPENFILE
|
||||||
\COPYOPENFILE 123055 . 126254) (\INFER.FILE.TYPE 126256 . 127210) (EOFP 127212 . 127509) (FORCEOUTPUT
|
122495 . 125694) (\INFER.FILE.TYPE 125696 . 126650) (EOFP 126652 . 126949) (FORCEOUTPUT 126951 .
|
||||||
127511 . 127758) (\FLUSH.OPEN.STREAMS 127760 . 128116) (CHARSET 128118 . 129477) (ACCESS-CHARSET
|
127198) (\FLUSH.OPEN.STREAMS 127200 . 127556) (CHARSET 127558 . 128917) (ACCESS-CHARSET 128919 .
|
||||||
129479 . 130116) (GETEOFPTR 130118 . 130368) (GETFILEINFO 130370 . 133563) (\TYPE.FROM.FILETYPE 133565
|
129556) (GETEOFPTR 129558 . 129808) (GETFILEINFO 129810 . 133003) (\TYPE.FROM.FILETYPE 133005 . 133475
|
||||||
. 134035) (\FILETYPE.FROM.TYPE 134037 . 134216) (GETFILEPTR 134218 . 134470) (SETFILEINFO 134472 .
|
) (\FILETYPE.FROM.TYPE 133477 . 133656) (GETFILEPTR 133658 . 133910) (SETFILEINFO 133912 . 138149) (
|
||||||
138709) (SETFILEPTR 138711 . 140430) (BOUT16 140432 . 140617) (BIN16 140619 . 140808)) (140913 148093
|
SETFILEPTR 138151 . 139870) (BOUT16 139872 . 140057) (BIN16 140059 . 140248)) (140353 147533 (
|
||||||
(\GENERIC.BINS 140923 . 141203) (\GENERIC.BOUTS 141205 . 141470) (\GENERIC.RENAMEFILE 141472 . 143720)
|
\GENERIC.BINS 140363 . 140643) (\GENERIC.BOUTS 140645 . 140910) (\GENERIC.RENAMEFILE 140912 . 143160)
|
||||||
(\GENERIC.OPENP 143722 . 145037) (\GENERIC.READP 145039 . 146191) (\GENERIC.CHARSET 146193 . 148091))
|
(\GENERIC.OPENP 143162 . 144477) (\GENERIC.READP 144479 . 145631) (\GENERIC.CHARSET 145633 . 147531))
|
||||||
(148094 148433 (\MAP-OPEN-STREAMS 148104 . 148431)) (150288 152368 (\EOF.ACTION 150298 . 150549) (
|
(147534 147873 (\MAP-OPEN-STREAMS 147544 . 147871)) (149728 151808 (\EOF.ACTION 149738 . 149989) (
|
||||||
\EOSERROR 150551 . 150744) (\GETEOFPTR 150746 . 150928) (\INCFILEPTR 150930 . 151280) (\PEEKBIN 151282
|
\EOSERROR 149991 . 150184) (\GETEOFPTR 150186 . 150368) (\INCFILEPTR 150370 . 150720) (\PEEKBIN 150722
|
||||||
. 151473) (\SETCLOSEDFILELENGTH 151475 . 151809) (\SETEOFPTR 151811 . 151999) (\SETFILEPTR 152001 .
|
. 150913) (\SETCLOSEDFILELENGTH 150915 . 151249) (\SETEOFPTR 151251 . 151439) (\SETFILEPTR 151441 .
|
||||||
152366)) (152369 152911 (\FIXPOUT 152379 . 152679) (\FIXPIN 152681 . 152909)) (152912 153478 (\BOUTEOL
|
151806)) (151809 152351 (\FIXPOUT 151819 . 152119) (\FIXPIN 152121 . 152349)) (152352 152918 (\BOUTEOL
|
||||||
152922 . 153476)) (156374 166238 (\BUFFERED.BIN 156384 . 157236) (\BUFFERED.PEEKBIN 157238 . 158020)
|
152362 . 152916)) (155814 165678 (\BUFFERED.BIN 155824 . 156676) (\BUFFERED.PEEKBIN 156678 . 157460)
|
||||||
(\BUFFERED.BOUT 158022 . 158882) (\BUFFERED.BINS 158884 . 162569) (\BUFFERED.BOUTS 162571 . 164372) (
|
(\BUFFERED.BOUT 157462 . 158322) (\BUFFERED.BINS 158324 . 162009) (\BUFFERED.BOUTS 162011 . 163812) (
|
||||||
\BUFFERED.COPYBYTES 164374 . 166236)))))
|
\BUFFERED.COPYBYTES 163814 . 165676)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
@@ -1,10 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
|
(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
|
: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)
|
(PRETTYCOMPRINT UNICODE-FORMATSCOMS)
|
||||||
@@ -1246,7 +1248,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(SYSTEM-EXTERNALFORMAT
|
(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 31-Jan-2026 18:51 by rmk")
|
||||||
(* ; "Edited 10-Oct-2022 11:55 by lmm")
|
(* ; "Edited 10-Oct-2022 11:55 by lmm")
|
||||||
(* ; "Edited 7-Jul-2022 10:41 by rmk")
|
(* ; "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.")
|
(* ;; "Returns the name, sets the global. For now, UTF-8 or through, could be something else.")
|
||||||
|
|
||||||
(fetch (EXTERNALFORMAT NAME) of (SETQ *SYSTEM-EXTERNALFORMAT*
|
(fetch (EXTERNALFORMAT NAME) of (SETQ *SYSTEM-EXTERNALFORMAT*
|
||||||
(FIND-FORMAT (FOR X IN '("LC_CTYPE" "LC_ALL" "LANG")
|
(FIND-FORMAT (for X in '("LC_CTYPE" "LC_ALL" "LANG")
|
||||||
WHEN (STRPOS ".UTF-8" (UNIX-GETENV X))
|
when (STRPOS "UTF" (U-CASE (UNIX-GETENV X)))
|
||||||
DO (RETURN :UTF-8) FINALLY (RETURN :THROUGH])
|
do
|
||||||
|
(* ;;
|
||||||
|
"Should it check separately for 8? Would anyone ever say UTF-16 ?")
|
||||||
|
|
||||||
|
(RETURN :UTF-8) finally (RETURN :THROUGH])
|
||||||
|
|
||||||
(MTOSYSSTRING
|
(MTOSYSSTRING
|
||||||
[LAMBDA (MSTRING) (* ; "Edited 6-Feb-2026 00:20 by rmk")
|
[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
|
(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)))))
|
8329) (65002 8331) (65003 8330) (65004 8332) (65008 (48 824)))))
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (3431 19523 (UTF8.OUTCHARFN 3441 . 6457) (UTF8.SLUG.OUTCHARFN 6459 . 7123) (
|
(FILEMAP (NIL (3476 19568 (UTF8.OUTCHARFN 3486 . 6502) (UTF8.SLUG.OUTCHARFN 6504 . 7168) (
|
||||||
UTF8.INCCODEFN 7125 . 13404) (UTF8.PEEKCCODEFN 13406 . 18539) (\UTF8.BACKCCODEFN 18541 . 19521)) (
|
UTF8.INCCODEFN 7170 . 13449) (UTF8.PEEKCCODEFN 13451 . 18584) (\UTF8.BACKCCODEFN 18586 . 19566)) (
|
||||||
19524 24439 (UTF16BE.OUTCHARFN 19534 . 20553) (UTF16BE.INCCODEFN 20555 . 21897) (UTF16BE.PEEKCCODEFN
|
19569 24484 (UTF16BE.OUTCHARFN 19579 . 20598) (UTF16BE.INCCODEFN 20600 . 21942) (UTF16BE.PEEKCCODEFN
|
||||||
21899 . 23243) (\UTF16BE.BACKCCODEFN 23245 . 24437)) (24440 29171 (UTF16LE.OUTCHARFN 24450 . 25566) (
|
21944 . 23288) (\UTF16BE.BACKCCODEFN 23290 . 24482)) (24485 29216 (UTF16LE.OUTCHARFN 24495 . 25611) (
|
||||||
UTF16LE.INCCODEFN 25568 . 26697) (UTF16LE.PEEKCCODEFN 26699 . 27975) (\UTF16LE.BACKCCODEFN 27977 .
|
UTF16LE.INCCODEFN 25613 . 26742) (UTF16LE.PEEKCCODEFN 26744 . 28020) (\UTF16LE.BACKCCODEFN 28022 .
|
||||||
29169)) (29172 32219 (READBOM 29182 . 31251) (WRITEBOM 31253 . 32217)) (32220 36251 (
|
29214)) (29217 32264 (READBOM 29227 . 31296) (WRITEBOM 31298 . 32262)) (32265 36296 (
|
||||||
MAKE-UNICODE-FORMATS 32230 . 36249)) (36319 40813 (UTF8.BINCODE 36329 . 39017) (\UTF8.FETCHCODE 39019
|
MAKE-UNICODE-FORMATS 32275 . 36294)) (36364 40858 (UTF8.BINCODE 36374 . 39062) (\UTF8.FETCHCODE 39064
|
||||||
. 40811)) (40814 46437 (UTF8.VALIDATE 40824 . 43421) (NUTF8-BYTE1-BYTES 43423 . 44160) (
|
. 40856)) (40859 46482 (UTF8.VALIDATE 40869 . 43466) (NUTF8-BYTE1-BYTES 43468 . 44205) (
|
||||||
NUTF8-CODE-BYTES 44162 . 45219) (NUTF8-STRING-BYTES 45221 . 46113) (N-MCHARS 46115 . 46435)) (46501
|
NUTF8-CODE-BYTES 44207 . 45264) (NUTF8-STRING-BYTES 45266 . 46158) (N-MCHARS 46160 . 46480)) (46546
|
||||||
47775 (MTOUCODE 46511 . 46680) (UTOMCODE 46682 . 46879) (MTOUCODE? 46881 . 47260) (UTOMCODE? 47262 .
|
47820 (MTOUCODE 46556 . 46725) (UTOMCODE 46727 . 46924) (MTOUCODE? 46926 . 47305) (UTOMCODE? 47307 .
|
||||||
47773)) (47776 54348 (MTOUSTRING 47786 . 48369) (UTOMSTRING 48371 . 48954) (MTOUTF8STRING 48956 .
|
47818)) (47821 54393 (MTOUSTRING 47831 . 48414) (UTOMSTRING 48416 . 48999) (MTOUTF8STRING 49001 .
|
||||||
53235) (UTF8TOMSTRING 53237 . 54346)) (54406 60114 (XTOUCODE 54416 . 54934) (UTOXCODE 54936 . 55444) (
|
53280) (UTF8TOMSTRING 53282 . 54391)) (54451 60159 (XTOUCODE 54461 . 54979) (UTOXCODE 54981 . 55489) (
|
||||||
XTOUCODE? 55446 . 56507) (UTOXCODE? 56509 . 57592) (XTOUSTRING 57594 . 58289) (UTOXSTRING 58291 .
|
XTOUCODE? 55491 . 56552) (UTOXCODE? 56554 . 57637) (XTOUSTRING 57639 . 58334) (UTOXSTRING 58336 .
|
||||||
59034) (XTOUTF8STRING 59036 . 60112)) (60115 65294 (MERGE-UNICODE-TRANSLATION-TABLES 60125 . 62887) (
|
59079) (XTOUTF8STRING 59081 . 60157)) (60160 65339 (MERGE-UNICODE-TRANSLATION-TABLES 60170 . 62932) (
|
||||||
UNICODE.UNMAPPED 62889 . 65292)) (69033 69286 (UNICODE-INIT 69043 . 69284)) (69307 70745 (
|
UNICODE.UNMAPPED 62934 . 65337)) (69078 69331 (UNICODE-INIT 69088 . 69329)) (69352 71137 (
|
||||||
SYSTEM-EXTERNALFORMAT 69317 . 70261) (MTOSYSSTRING 70263 . 70456) (SYSTOMSTRING 70458 . 70743)))))
|
SYSTEM-EXTERNALFORMAT 69362 . 70653) (MTOSYSSTRING 70655 . 70848) (SYSTOMSTRING 70850 . 71135)))))
|
||||||
STOP
|
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