Compare commits
51 Commits
fgh_irm-01
...
rmk183--Te
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
f38e216446 | ||
|
|
d0d9b2329a | ||
|
|
4de89a6e94 | ||
|
|
ceccadacef | ||
|
|
6159c64b84 | ||
|
|
eb6ee87170 | ||
|
|
c16e3b4a55 | ||
|
|
285e35f2ea | ||
|
|
4e761298ea | ||
|
|
cbea9a7c9d | ||
|
|
47dd8edf60 | ||
|
|
1d2292aa62 | ||
|
|
4499b4d914 | ||
|
|
0317fbd882 | ||
|
|
b0c6136bd6 | ||
|
|
d922212de1 | ||
|
|
96c609e5f0 | ||
|
|
728a278dc0 | ||
|
|
2814618b9a | ||
|
|
af194bdaf7 | ||
|
|
e73aef6dcc | ||
|
|
61a05ac2b5 | ||
|
|
b611af518a | ||
|
|
fb0af3c05f | ||
|
|
93b09dec66 | ||
|
|
8f3d5c26b5 | ||
|
|
5790bce3db | ||
|
|
43f3118544 | ||
|
|
8eb02d2504 | ||
|
|
573d87aca3 | ||
|
|
13eb940538 | ||
|
|
3dc2bba019 | ||
|
|
322b2e0fbe | ||
|
|
a24a4dffc2 | ||
|
|
95e08680b8 | ||
|
|
7a7fca0bcf | ||
|
|
9e4d37efd7 | ||
|
|
b8c0c594a9 | ||
|
|
d9f1a78f47 | ||
|
|
ab4eb3d52d | ||
|
|
0f470b9753 | ||
|
|
b1bdd90338 | ||
|
|
1569a27209 | ||
|
|
1ff475a42c | ||
|
|
7904f9dd86 | ||
|
|
93a04227d8 | ||
|
|
cc0a819cd5 | ||
|
|
075ca1a9f1 | ||
|
|
69bb98c49a | ||
|
|
bb830e75f0 | ||
|
|
dc86cd8f80 |
3
.gitignore
vendored
3
.gitignore
vendored
@@ -43,6 +43,9 @@ loadups/gitinfo
|
|||||||
*.sysout
|
*.sysout
|
||||||
*.SYSOUT
|
*.SYSOUT
|
||||||
|
|
||||||
|
# GITFNS deleted subdirectory
|
||||||
|
deleted/**
|
||||||
|
|
||||||
#compiled code -- leave in for now
|
#compiled code -- leave in for now
|
||||||
|
|
||||||
# *.lcom
|
# *.lcom
|
||||||
|
|||||||
@@ -1,12 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "26-Nov-2025 12:30:08" {DSK}<Users>larry>il>MEDLEY>GREETFILES>APPS-INIT.;2 23361
|
(FILECREATED " 1-Feb-2026 13:41:02" {WMEDLEY}<greetfiles>APPS-INIT.;11 22926
|
||||||
|
|
||||||
:EDIT-BY "lmm"
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS Apps.CreateButtons)
|
:CHANGES-TO (FNS XCL-USER::EXEC¬INTERLISP)
|
||||||
|
|
||||||
:PREVIOUS-DATE "25-Feb-2024 13:56:23" {DSK}<Users>larry>il>MEDLEY>GREETFILES>APPS-INIT.;1)
|
:PREVIOUS-DATE " 1-Feb-2026 07:58:14" {WMEDLEY}<greetfiles>APPS-INIT.;9)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT APPS-INITCOMS)
|
(PRETTYCOMPRINT APPS-INITCOMS)
|
||||||
@@ -19,7 +19,7 @@
|
|||||||
(Apps.RoomsActivated NIL))
|
(Apps.RoomsActivated NIL))
|
||||||
(FNS Apps.InitNotecards Apps.SetUpNOTECARDSDIRECTORIES Apps.DoInit Apps.CreateButtons
|
(FNS Apps.InitNotecards Apps.SetUpNOTECARDSDIRECTORIES Apps.DoInit Apps.CreateButtons
|
||||||
Apps.CreateLabel Apps.ActivateCLOS Apps.ActivateRooms Apps.ShowDoc
|
Apps.CreateLabel Apps.ActivateCLOS Apps.ActivateRooms Apps.ShowDoc
|
||||||
XCL-USER::EXEC_INTERLISP Apps.AroundExitFn)
|
XCL-USER::EXEC¬INTERLISP Apps.AroundExitFn)
|
||||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (Apps.DoInit)))
|
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (Apps.DoInit)))
|
||||||
(DECLARE%: FIRST DONTEVAL@LOAD DOCOPY (P (BKSYSBUF " "])
|
(DECLARE%: FIRST DONTEVAL@LOAD DOCOPY (P (BKSYSBUF " "])
|
||||||
|
|
||||||
@@ -35,52 +35,53 @@
|
|||||||
(RPAQ? Apps.RoomsActivated NIL)
|
(RPAQ? Apps.RoomsActivated NIL)
|
||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(Apps.InitNotecards
|
(Apps.InitNotecards
|
||||||
[LAMBDA (DoNotRefreshButtons)
|
[LAMBDA (DoNotRefreshButtons)
|
||||||
(DECLARE (GLOBALVARS BackgroundMenuCommands BackgroundMenu))
|
(DECLARE (GLOBALVARS BackgroundMenuCommands BackgroundMenu))
|
||||||
(* ; "Edited 19-Jan-2023 11:57 by FGH")
|
(* ; "Edited 1-Feb-2026 00:00 by rmk")
|
||||||
(* ; "Edited 7-Dec-2022 11:14 by FGH")
|
(* ; "Edited 19-Jan-2023 11:57 by FGH")
|
||||||
(* ; "Edited 12-Nov-2022 14:41 by FGH")
|
(* ; "Edited 7-Dec-2022 11:14 by FGH")
|
||||||
(* ; "Edited 11-Sep-2022 01:09 by fgh")
|
(* ; "Edited 12-Nov-2022 14:41 by FGH")
|
||||||
(* ; "Edited 7-Feb-2022 20:22 by tp7")
|
(* ; "Edited 11-Sep-2022 01:09 by fgh")
|
||||||
|
(* ; "Edited 7-Feb-2022 20:22 by tp7")
|
||||||
(LET* [[SRCDIR (OR (UNIX-GETENV 'NOTEFILESSRC)
|
(LET* [[SRCDIR (OR (UNIX-GETENV 'NOTEFILESSRC)
|
||||||
(AND (UNIX-GETENV 'NC_INSTALLDIR)
|
(AND (UNIX-GETENV 'NC¬INSTALLDIR)
|
||||||
(CONCAT (UNIX-GETENV 'NC_INSTALLDIR)
|
(CONCAT (UNIX-GETENV 'NC¬INSTALLDIR)
|
||||||
"/notefiles"))
|
"/notefiles"))
|
||||||
(LET ((SUBDIR "notecards/notefiles"))
|
(LET ((SUBDIR "notecards/notefiles"))
|
||||||
(for DIR in (LIST (CONCAT (MEDLEYDIR)
|
(for DIR in (LIST (CONCAT (MEDLEYDIR)
|
||||||
SUBDIR)
|
SUBDIR)
|
||||||
(CONCAT (MEDLEYDIR)
|
(CONCAT (MEDLEYDIR)
|
||||||
"../" SUBDIR)
|
"../" SUBDIR)
|
||||||
(CONCAT (MEDLEYDIR)
|
(CONCAT (MEDLEYDIR)
|
||||||
"../../" SUBDIR)) thereis (DIRECTORYNAME DIR]
|
"../../" SUBDIR)) thereis (DIRECTORYNAME DIR]
|
||||||
(DESTDIR (OR (UNIX-GETENV 'NOTEFILESDIR)
|
(DESTDIR (OR (UNIX-GETENV 'NOTEFILESDIR)
|
||||||
(AND (UNIX-GETENV 'MEDLEY_USERDIR)
|
(AND (UNIX-GETENV 'MEDLEY¬USERDIR)
|
||||||
(CONCAT (UNIX-GETENV 'MEDLEY_USERDIR)
|
(CONCAT (UNIX-GETENV 'MEDLEY¬USERDIR)
|
||||||
"/notefiles"))
|
"/notefiles"))
|
||||||
(CONCAT LOGINDIR "notefiles"]
|
(CONCAT LOGINDIR "notefiles"]
|
||||||
[if (AND (NOT (DIRECTORYNAME DESTDIR))
|
[if (AND (NOT (DIRECTORYNAME DESTDIR))
|
||||||
(DIRECTORYNAME SRCDIR))
|
(DIRECTORYNAME SRCDIR))
|
||||||
then (for NF in (DIRECTORY (CONCAT SRCDIR "/*"))
|
then (for NF in (DIRECTORY (CONCAT SRCDIR "/*"))
|
||||||
do (COPYFILE NF (PACKFILENAME 'HOST "DSK" 'DIRECTORY DESTDIR 'NAME
|
do (COPYFILE NF (PACKFILENAME 'HOST "DSK" 'DIRECTORY DESTDIR 'NAME
|
||||||
(FILENAMEFIELD NF 'NAME)
|
(FILENAMEFIELD NF 'NAME)
|
||||||
'EXTENSION
|
'EXTENSION
|
||||||
(FILENAMEFIELD NF 'EXTENSION)
|
(FILENAMEFIELD NF 'EXTENSION)
|
||||||
'VERSION
|
'VERSION
|
||||||
(FILENAMEFIELD NF 'VERSION]
|
(FILENAMEFIELD NF 'VERSION]
|
||||||
(LET* ((PW-REGION (WINDOWPROP PROMPTWINDOW 'REGION))
|
(LET* ((PW-REGION (WINDOWPROP PROMPTWINDOW 'REGION))
|
||||||
(LEFT (IPLUS (fetch (REGION RIGHT) of PW-REGION)
|
(LEFT (IPLUS (fetch (REGION RIGHT) of PW-REGION)
|
||||||
20))
|
20))
|
||||||
(BOTTOM (fetch (REGION BOTTOM) of PW-REGION)))
|
(BOTTOM (fetch (REGION BOTTOM) of PW-REGION)))
|
||||||
(NC.BringUpNoteCardsIcon (create POSITION
|
(NC.BringUpNoteCardsIcon (create POSITION
|
||||||
XCOORD _ LEFT
|
XCOORD _ LEFT
|
||||||
YCOORD _ BOTTOM)))
|
YCOORD _ BOTTOM)))
|
||||||
(NC.FileBrowserMenu NC.NoteCardsIconWindow (PACKFILENAME 'HOST "DSK" 'DIRECTORY DESTDIR
|
(NC.FileBrowserMenu NC.NoteCardsIconWindow (PACKFILENAME 'HOST "DSK" 'DIRECTORY DESTDIR
|
||||||
'NAME "*" 'EXTENSION "notefile")
|
'NAME "*" 'EXTENSION "notefile")
|
||||||
(CREATEREGION 50 (IDIFFERENCE SCREENHEIGHT 700)
|
(CREATEREGION 50 (IDIFFERENCE SCREENHEIGHT 700)
|
||||||
550 220))
|
550 220))
|
||||||
(if (NULL (SASSOC 'NoteCards BackgroundMenuCommands))
|
(if (NULL (SASSOC 'NoteCards BackgroundMenuCommands))
|
||||||
then (PROGN [SETQ BackgroundMenuCommands (APPEND BackgroundMenuCommands
|
then (PROGN [SETQ BackgroundMenuCommands (APPEND BackgroundMenuCommands
|
||||||
(LIST '(NoteCards (
|
(LIST '(NoteCards (
|
||||||
NC.BringUpNoteCardsIcon
|
NC.BringUpNoteCardsIcon
|
||||||
)
|
)
|
||||||
@@ -89,59 +90,61 @@
|
|||||||
]
|
]
|
||||||
(SETQ BackgroundMenu NIL)))
|
(SETQ BackgroundMenu NIL)))
|
||||||
(SETQ Apps.NotecardsActivated T)
|
(SETQ Apps.NotecardsActivated T)
|
||||||
(if (NOT DoNotRefreshButtons)
|
(if (NOT DoNotRefreshButtons)
|
||||||
then (Apps.CreateButtons])
|
then (Apps.CreateButtons])
|
||||||
|
|
||||||
(Apps.SetUpNOTECARDSDIRECTORIES
|
(Apps.SetUpNOTECARDSDIRECTORIES
|
||||||
[LAMBDA NIL
|
[LAMBDA NIL
|
||||||
|
|
||||||
(* ;; "Find the location of the Notecards directory and call NC.SetUpNOTECARDSDIRECTORIES.")
|
(* ;; "Find the location of the Notecards directory and call NC.SetUpNOTECARDSDIRECTORIES.")
|
||||||
|
|
||||||
(* ;; " This is needed to make sure that lazy loading of Notecard types works.")
|
(* ;; " This is needed to make sure that lazy loading of Notecard types works.")
|
||||||
|
|
||||||
(LET* [(LOC1 (CONCAT MEDLEYDIR "notecards>"))
|
(LET* [(LOC1 (CONCAT MEDLEYDIR "notecards>"))
|
||||||
(LOC2 (CONCAT MEDLEYDIR "..>notecards>"))
|
(LOC2 (CONCAT MEDLEYDIR "..>notecards>"))
|
||||||
(LOC3 (CONCAT MEDLEYDIR "..>..>notecards>"))
|
(LOC3 (CONCAT MEDLEYDIR "..>..>notecards>"))
|
||||||
(NCDIR (for LOC in (LIST LOC1 LOC2 LOC3) thereis (OR (INFILEP (CONCAT LOC
|
(NCDIR (for LOC in (LIST LOC1 LOC2 LOC3) thereis (OR (INFILEP (CONCAT LOC
|
||||||
"system>NOTECARDS"))
|
"system>NOTECARDS"))
|
||||||
(INFILEP (CONCAT LOC
|
(INFILEP (CONCAT LOC
|
||||||
"system>NOTECARDS.LCOM"
|
"system>NOTECARDS.LCOM"
|
||||||
]
|
]
|
||||||
(if NCDIR
|
(if NCDIR
|
||||||
then [SETQ NCDIR (OR (INFILEP (CONCAT NCDIR "system>NOTECARDS"))
|
then [SETQ NCDIR (OR (INFILEP (CONCAT NCDIR "system>NOTECARDS"))
|
||||||
(INFILEP (CONCAT NCDIR "system>NOTECARDS.LCOM"]
|
(INFILEP (CONCAT NCDIR "system>NOTECARDS.LCOM"]
|
||||||
(SETQ NCDIR (SUBSTRING NCDIR 1 (IDIFFERENCE (STRPOS "system>NOTECARDS" NCDIR)
|
(SETQ NCDIR (SUBSTRING NCDIR 1 (IDIFFERENCE (STRPOS "system>NOTECARDS" NCDIR)
|
||||||
1)))
|
1)))
|
||||||
(NC.SetUpNOTECARDSDIRECTORIES NCDIR)
|
(NC.SetUpNOTECARDSDIRECTORIES NCDIR)
|
||||||
T
|
T
|
||||||
else (PRIN1 "Warning: Notecards directory could not be found." T)
|
else (PRIN1 "Warning: Notecards directory could not be found." T)
|
||||||
(PRIN1 "Hence, NOTECARDSDIRECTORIES is probably not set correctly" T)
|
(PRIN1 "Hence, NOTECARDSDIRECTORIES is probably not set correctly" T)
|
||||||
(PRIN1 "and Notecards will not work properly." T)
|
(PRIN1 "and Notecards will not work properly." T)
|
||||||
NIL])
|
NIL])
|
||||||
|
|
||||||
(Apps.DoInit
|
(Apps.DoInit
|
||||||
[LAMBDA NIL
|
[LAMBDA NIL
|
||||||
|
|
||||||
(* ;; "Edited 19-Jan-2023 12:43 by FGH")
|
(* ;; "Edited 31-Jan-2026 23:57 by rmk")
|
||||||
|
|
||||||
(* ;; "Edited 17-Jan-2023 23:23 by FGH")
|
(* ;; "Edited 19-Jan-2023 12:43 by FGH")
|
||||||
|
|
||||||
(* ;; "Edited 7-Dec-2022 11:14 by FGH")
|
(* ;; "Edited 17-Jan-2023 23:23 by FGH")
|
||||||
|
|
||||||
(* ;; "Edited 12-Nov-2022 13:57 by FGH")
|
(* ;; "Edited 7-Dec-2022 11:14 by FGH")
|
||||||
|
|
||||||
(* ;; "Edited 12-Oct-2022 20:23 by fgh")
|
(* ;; "Edited 12-Nov-2022 13:57 by FGH")
|
||||||
|
|
||||||
(* ;; "Edited 6-Sep-2022 17:22 by fgh")
|
(* ;; "Edited 12-Oct-2022 20:23 by fgh")
|
||||||
|
|
||||||
(* ;; "Edited 4-Sep-2022 16:44 by larry")
|
(* ;; "Edited 6-Sep-2022 17:22 by fgh")
|
||||||
|
|
||||||
(* ;; "Edited 18-Mar-2022 18:53 by fgh")
|
(* ;; "Edited 4-Sep-2022 16:44 by larry")
|
||||||
|
|
||||||
(* ;; "Edited 17-Dec-2021 22:05 by fgh")
|
(* ;; "Edited 18-Mar-2022 18:53 by fgh")
|
||||||
|
|
||||||
|
(* ;; "Edited 17-Dec-2021 22:05 by fgh")
|
||||||
|
|
||||||
(PROGN
|
(PROGN
|
||||||
(* ;; " Adjust windows so that the exec window and the prompt window don't overlap")
|
(* ;; " Adjust windows so that the exec window and the prompt window don't overlap")
|
||||||
|
|
||||||
[MAPC (OPENWINDOWS)
|
[MAPC (OPENWINDOWS)
|
||||||
(FUNCTION (LAMBDA (W)
|
(FUNCTION (LAMBDA (W)
|
||||||
@@ -152,90 +155,92 @@
|
|||||||
(IDIFFERENCE SCREENHEIGHT 18)))
|
(IDIFFERENCE SCREENHEIGHT 18)))
|
||||||
((STREQUAL (WINDOWPROP W 'TITLE)
|
((STREQUAL (WINDOWPROP W 'TITLE)
|
||||||
"Prompt Window")
|
"Prompt Window")
|
||||||
(PROGN (MOVEW W (create POSITION
|
(PROGN (MOVEW W (create POSITION
|
||||||
XCOORD _ 50
|
XCOORD _ 50
|
||||||
YCOORD _ (IDIFFERENCE SCREENHEIGHT 120)))
|
YCOORD _ (IDIFFERENCE SCREENHEIGHT 120)))
|
||||||
(CLEARW W)))
|
(CLEARW W)))
|
||||||
((STREQUAL (WINDOWPROP W 'TITLE)
|
((STREQUAL (WINDOWPROP W 'TITLE)
|
||||||
"Exec (XCL)")
|
"Exec (XCL)")
|
||||||
(PROGN (WINDOWPROP W 'TITLE "Exec (INTERLISP)")
|
(PROGN (WINDOWPROP W 'TITLE "Exec (INTERLISP)")
|
||||||
(MOVEW W (create POSITION
|
(MOVEW W (create POSITION
|
||||||
XCOORD _ 50
|
XCOORD _ 50
|
||||||
YCOORD _ (IDIFFERENCE SCREENHEIGHT 460]
|
YCOORD _ (IDIFFERENCE SCREENHEIGHT 460]
|
||||||
|
|
||||||
(* ;; " Set up INITIALSLST based on information passed in from the Linux environment")
|
(* ;; " Set up INITIALSLST based on information passed in from the Linux environment")
|
||||||
|
|
||||||
[SETQ INITIALSLST (LIST (LIST USERNAME (UNIX-GETENV 'MEDLEY_FIRSTNAME)
|
[SETQ INITIALSLST (LIST (LIST USERNAME (UNIX-GETENV 'MEDLEY¬FIRSTNAME)
|
||||||
(UNIX-GETENV 'MEDLEY_INITIALS]
|
(UNIX-GETENV 'MEDLEY¬INITIALS]
|
||||||
(LOAD '{DSK}/usr/local/interlisp/medley/lispusers/HELPSYS.LCOM T)
|
(LOAD '{DSK}/usr/local/interlisp/medley/lispusers/HELPSYS.LCOM T)
|
||||||
|
|
||||||
(* ;; "change to interlisp exec if required")
|
(* ;; "change to interlisp exec if required")
|
||||||
|
|
||||||
(COND
|
(COND
|
||||||
((OR (STRING-EQUAL (UNIX-GETENV 'MEDLEY_EXEC)
|
((OR (STRING-EQUAL (UNIX-GETENV 'MEDLEY¬EXEC)
|
||||||
"inter")
|
"inter")
|
||||||
(STRING-EQUAL (UNIX-GETENV 'NCO)
|
(STRING-EQUAL (UNIX-GETENV 'NCO)
|
||||||
"true"))
|
"true"))
|
||||||
(BKSYSBUF "(EXEC_INTERLISP)")))
|
(BKSYSBUF "(EXEC¬INTERLISP)")))
|
||||||
|
|
||||||
(* ;; "Always Activate CLOS")
|
(* ;; "Always Activate CLOS")
|
||||||
|
|
||||||
(Apps.ActivateCLOS)
|
(Apps.ActivateCLOS)
|
||||||
|
|
||||||
(* ;; " activate Notecards if requested")
|
(* ;; " activate Notecards if requested")
|
||||||
|
|
||||||
(COND
|
(COND
|
||||||
((STRING-EQUAL (UNIX-GETENV 'RUN_NOTECARDS)
|
((STRING-EQUAL (UNIX-GETENV 'RUN¬NOTECARDS)
|
||||||
"true")
|
"true")
|
||||||
(Apps.InitNotecards T)))
|
(Apps.InitNotecards T)))
|
||||||
|
|
||||||
(* ;; " activate Rooms if requested")
|
(* ;; " activate Rooms if requested")
|
||||||
|
|
||||||
(COND
|
(COND
|
||||||
((STRING-EQUAL (UNIX-GETENV 'RUN_ROOMS)
|
((STRING-EQUAL (UNIX-GETENV 'RUN¬ROOMS)
|
||||||
"true")
|
"true")
|
||||||
(Apps.ActivateRooms T)))
|
(Apps.ActivateRooms T)))
|
||||||
|
|
||||||
(* ;; " create the Documentation and ROOMS, Notecards Activation Buttons, if needed")
|
(* ;; " create the Documentation and ROOMS, Notecards Activation Buttons, if needed")
|
||||||
|
|
||||||
(Apps.CreateButtons T)
|
(Apps.CreateButtons T)
|
||||||
|
|
||||||
(* ;; " Make sure Notecards doesn't try to load its HASH file in NC.PostGreet")
|
(* ;; " Make sure Notecards doesn't try to load its HASH file in NC.PostGreet")
|
||||||
|
|
||||||
(SETTOPVAL '\NC.SourceAccessFlg NIL)
|
(SETTOPVAL '\NC.SourceAccessFlg NIL)
|
||||||
|
|
||||||
(* ;; "Setup NOTECARDSDIRECTORIES.")
|
(* ;; "Setup NOTECARDSDIRECTORIES.")
|
||||||
|
|
||||||
(Apps.SetUpNOTECARDSDIRECTORIES)
|
(Apps.SetUpNOTECARDSDIRECTORIES)
|
||||||
|
|
||||||
(* ;; "Add AROUNDEXITFN to ensure NOTECARDSDIRECTORIES get reset after LOGOUT, etc.")
|
(* ;; "Add AROUNDEXITFN to ensure NOTECARDSDIRECTORIES get reset after LOGOUT, etc.")
|
||||||
|
|
||||||
(SETQ AROUNDEXITFNS (LSUBST '(MEDLEY-INIT-VARS Apps.AroundExitFn)
|
(SETQ AROUNDEXITFNS (LSUBST '(MEDLEY-INIT-VARS Apps.AroundExitFn)
|
||||||
'MEDLEY-INIT-VARS AROUNDEXITFNS])
|
'MEDLEY-INIT-VARS AROUNDEXITFNS])
|
||||||
|
|
||||||
(Apps.CreateButtons
|
(Apps.CreateButtons
|
||||||
[LAMBDA (DoDocsToo) (* ; "Edited 26-Nov-2025 12:29 by lmm")
|
[LAMBDA (DoDocsToo) (* ; "Edited 31-Jan-2026 23:59 by rmk")
|
||||||
(* ; "Edited 13-Dec-2022 12:51 by frank")
|
(* ; "Edited 26-Nov-2025 12:29 by lmm")
|
||||||
(* ; "Edited 7-Dec-2022 11:28 by FGH")
|
(* ; "Edited 13-Dec-2022 12:51 by frank")
|
||||||
(* ; "Edited 5-Dec-2022 17:31 by FGH")
|
(* ; "Edited 7-Dec-2022 11:28 by FGH")
|
||||||
(* ; "Edited 12-Nov-2022 14:52 by FGH")
|
(* ; "Edited 5-Dec-2022 17:31 by FGH")
|
||||||
|
(* ; "Edited 12-Nov-2022 14:52 by FGH")
|
||||||
|
|
||||||
(* ;; " Create buttons for Documentation and to activate Rooms, Notecards ")
|
(* ;; " Create buttons for Documentation and to activate Rooms, Notecards ")
|
||||||
|
|
||||||
(* ;; "Note: due to bug in DELETE-BUTTON need to create Doc buttons last. This will make sure that the NoteCards/Rooms buttons get properl deleted when they are activated. But the Doc buttons will not necessariy get deleted properly (but then there is never a need for them to be deleted).")
|
(* ;; "Note: due to bug in DELETE-BUTTON need to create Doc buttons last. This will make sure that the NoteCards/Rooms buttons get properl deleted when they are activated. But the Doc buttons will not necessariy get deleted properly (but then there is never a need for them to be deleted).")
|
||||||
|
|
||||||
(LET* ((FEATURES (LIST (LIST Apps.NotecardsActivated '(Apps.InitNotecards)
|
|
||||||
|
(LET* ((FEATURES (LIST (LIST Apps.NotecardsActivated '(Apps.InitNotecards)
|
||||||
"NOTECARDS")
|
"NOTECARDS")
|
||||||
(LIST Apps.RoomsActivated '(Apps.ActivateRooms)
|
(LIST Apps.RoomsActivated '(Apps.ActivateRooms)
|
||||||
"ROOMS")))
|
"ROOMS")))
|
||||||
(FEATURES-LABELS (for FEATURE in FEATURES collect (CADDR FEATURE)))
|
(FEATURES-LABELS (for FEATURE in FEATURES collect (CADDR FEATURE)))
|
||||||
(DOCS (LIST (LIST "https://interlisp.org/docs/medley/orientation/" "BASICS")
|
(DOCS (LIST (LIST "https://interlisp.org/docs/medley/orientation/" "BASICS")
|
||||||
(LIST "https://primer.interlisp.org/" "PRIMER")
|
(LIST "https://primer.interlisp.org/" "PRIMER")
|
||||||
(LIST "https://interlisp.org/documentation/IRM.pdf" "MANUAL")
|
(LIST "https://interlisp.org/documentation/IRM.pdf" "MANUAL")
|
||||||
(LIST "https://interlisp.org/documentation/notecards_user_guide_v1.2.pdf"
|
(LIST "https://interlisp.org/documentation/notecards¬user-guide¬v1.2.pdf"
|
||||||
"NOTECARDS")
|
"NOTECARDS")
|
||||||
(LIST "https://interlisp.org/documentation/ROOMSTECHDESC.pdf" "ROOMS")))
|
(LIST "https://interlisp.org/documentation/ROOMSTECHDESC.pdf" "ROOMS")))
|
||||||
(DOCS-LABELS (for DOC in DOCS collect (CADR DOC)))
|
(DOCS-LABELS (for DOC in DOCS collect (CADR DOC)))
|
||||||
(RIGHTMARGINISH 140)
|
(RIGHTMARGINISH 140)
|
||||||
(SECTION1YPOS 225)
|
(SECTION1YPOS 225)
|
||||||
(YPOSDELTA 55)
|
(YPOSDELTA 55)
|
||||||
@@ -249,31 +254,31 @@
|
|||||||
(IWS NIL)
|
(IWS NIL)
|
||||||
(BUTTONS NIL))
|
(BUTTONS NIL))
|
||||||
|
|
||||||
(* ;; "First remove/re-create feature buttons")
|
(* ;; "First remove/re-create feature buttons")
|
||||||
|
|
||||||
(for W in (OPENWINDOWS) when (MEMBER (WINDOWPROP W 'ICONLABEL)
|
(for W in (OPENWINDOWS) when (MEMBER (WINDOWPROP W 'ICONLABEL)
|
||||||
(LIST "ACTIVATE" "FEATURES")) do (CLOSEW W))
|
(LIST "ACTIVATE" "FEATURES")) do (CLOSEW W))
|
||||||
(for B in *ALL-BUTTONS* when (AND (EQ (WINDOWPROP B 'Apps.BUTTON)
|
(for B in *ALL-BUTTONS* when (AND (EQ (WINDOWPROP B 'Apps.BUTTON)
|
||||||
'FEATURE)
|
'FEATURE)
|
||||||
(MEMBER (BUTTON-LABEL B)
|
(MEMBER (BUTTON-LABEL B)
|
||||||
FEATURES-LABELS)) do (DELETE-BUTTON B))
|
FEATURES-LABELS)) do (DELETE-BUTTON B))
|
||||||
[if FEATURES-REQUIREDP
|
[if FEATURES-REQUIREDP
|
||||||
then [SETQ IWS (LIST (Apps.CreateLabel "ACTIVATE" (IDIFFERENCE SCREENWIDTH
|
then [SETQ IWS (LIST (Apps.CreateLabel "ACTIVATE" (IDIFFERENCE SCREENWIDTH
|
||||||
(IDIFFERENCE RIGHTMARGINISH 50
|
(IDIFFERENCE RIGHTMARGINISH 50
|
||||||
))
|
))
|
||||||
(IDIFFERENCE SCREENHEIGHT (IDIFFERENCE SECTION2YPOS 20)))
|
(IDIFFERENCE SCREENHEIGHT (IDIFFERENCE SECTION2YPOS 20)))
|
||||||
(Apps.CreateLabel "FEATURES" (IDIFFERENCE SCREENWIDTH
|
(Apps.CreateLabel "FEATURES" (IDIFFERENCE SCREENWIDTH
|
||||||
(IDIFFERENCE RIGHTMARGINISH 50
|
(IDIFFERENCE RIGHTMARGINISH 50
|
||||||
))
|
))
|
||||||
(IDIFFERENCE SCREENHEIGHT SECTION2YPOS]
|
(IDIFFERENCE SCREENHEIGHT SECTION2YPOS]
|
||||||
(SETQ BUTTONS (for FEATURE in FEATURES
|
(SETQ BUTTONS (for FEATURE in FEATURES
|
||||||
collect (OR (CAR FEATURE)
|
collect (OR (CAR FEATURE)
|
||||||
(LET (B)
|
(LET (B)
|
||||||
(SETQ BUTTONY-FEATURES (IPLUS BUTTONY-FEATURES
|
(SETQ BUTTONY-FEATURES (IPLUS BUTTONY-FEATURES
|
||||||
YPOSDELTA))
|
YPOSDELTA))
|
||||||
[SETQ B (CREATE-BUTTON (CADR FEATURE)
|
[SETQ B (CREATE-BUTTON (CADR FEATURE)
|
||||||
(CADDR FEATURE)
|
(CADDR FEATURE)
|
||||||
(create POSITION
|
(create POSITION
|
||||||
XCOORD _ (IDIFFERENCE
|
XCOORD _ (IDIFFERENCE
|
||||||
SCREENWIDTH
|
SCREENWIDTH
|
||||||
RIGHTMARGINISH)
|
RIGHTMARGINISH)
|
||||||
@@ -284,30 +289,30 @@
|
|||||||
(WINDOWPROP B 'Apps.BUTTON 'FEATURE)
|
(WINDOWPROP B 'Apps.BUTTON 'FEATURE)
|
||||||
B]
|
B]
|
||||||
|
|
||||||
(* ;; "Then if needed, remove/recreate documentation buttons")
|
(* ;; "Then if needed, remove/recreate documentation buttons")
|
||||||
|
|
||||||
(if DoDocsToo
|
(if DoDocsToo
|
||||||
then (for W in (OPENWINDOWS) when (MEMBER (WINDOWPROP W 'ICONLABEL)
|
then (for W in (OPENWINDOWS) when (MEMBER (WINDOWPROP W 'ICONLABEL)
|
||||||
(LIST "DOCUMENTATION"))
|
(LIST "DOCUMENTATION"))
|
||||||
do (CLOSEW W))
|
do (CLOSEW W))
|
||||||
(for B in *ALL-BUTTONS* when (AND (EQ (WINDOWPROP B 'Apps.BUTTON)
|
(for B in *ALL-BUTTONS* when (AND (EQ (WINDOWPROP B 'Apps.BUTTON)
|
||||||
'DOC)
|
'DOC)
|
||||||
(MEMBER (BUTTON-LABEL B)
|
(MEMBER (BUTTON-LABEL B)
|
||||||
DOCS-LABELS)) do (DELETE-BUTTON B))
|
DOCS-LABELS)) do (DELETE-BUTTON B))
|
||||||
(SETQ IWS (CONS (Apps.CreateLabel "DOCUMENTATION" (IDIFFERENCE SCREENWIDTH
|
(SETQ IWS (CONS (Apps.CreateLabel "DOCUMENTATION" (IDIFFERENCE SCREENWIDTH
|
||||||
(IDIFFERENCE
|
(IDIFFERENCE
|
||||||
RIGHTMARGINISH 50)
|
RIGHTMARGINISH 50)
|
||||||
)
|
)
|
||||||
(IDIFFERENCE SCREENHEIGHT SECTION1YPOS))
|
(IDIFFERENCE SCREENHEIGHT SECTION1YPOS))
|
||||||
IWS))
|
IWS))
|
||||||
(SETQ BUTTONS (APPEND (for DOC in DOCS
|
(SETQ BUTTONS (APPEND (for DOC in DOCS
|
||||||
collect (LET (B)
|
collect (LET (B)
|
||||||
(SETQ BUTTONY-DOCS (IPLUS BUTTONY-DOCS
|
(SETQ BUTTONY-DOCS (IPLUS BUTTONY-DOCS
|
||||||
YPOSDELTA))
|
YPOSDELTA))
|
||||||
[SETQ B (CREATE-BUTTON (LIST 'Apps.ShowDoc
|
[SETQ B (CREATE-BUTTON (LIST 'Apps.ShowDoc
|
||||||
(CAR DOC))
|
(CAR DOC))
|
||||||
(CADR DOC)
|
(CADR DOC)
|
||||||
(create POSITION
|
(create POSITION
|
||||||
XCOORD _
|
XCOORD _
|
||||||
(IDIFFERENCE
|
(IDIFFERENCE
|
||||||
SCREENWIDTH
|
SCREENWIDTH
|
||||||
@@ -319,30 +324,30 @@
|
|||||||
(WINDOWPROP B 'Apps.BUTTON 'DOC)
|
(WINDOWPROP B 'Apps.BUTTON 'DOC)
|
||||||
B))
|
B))
|
||||||
BUTTONS)))
|
BUTTONS)))
|
||||||
[for B in BUTTONS do (COND
|
[for B in BUTTONS do (COND
|
||||||
((WINDOWP B)
|
((WINDOWP B)
|
||||||
(WINDOWPROP B 'RIGHTBUTTONFN 'NILL)
|
(WINDOWPROP B 'RIGHTBUTTONFN 'NILL)
|
||||||
(WINDOWPROP B 'BUTTONEVENTFN (FUNCTION (LAMBDA (BUTTON)
|
(WINDOWPROP B 'BUTTONEVENTFN (FUNCTION (LAMBDA (BUTTON)
|
||||||
(if (LASTMOUSESTATE
|
(if (LASTMOUSESTATE
|
||||||
(ONLY LEFT))
|
(ONLY LEFT))
|
||||||
then (EXECUTE-BUTTON
|
then (EXECUTE-BUTTON
|
||||||
BUTTON]
|
BUTTON]
|
||||||
[for IW in IWS do (COND
|
[for IW in IWS do (COND
|
||||||
((WINDOWP IW)
|
((WINDOWP IW)
|
||||||
(WINDOWPROP IW 'RIGHTBUTTONFN 'NILL]
|
(WINDOWPROP IW 'RIGHTBUTTONFN 'NILL]
|
||||||
(for B in BUTTONS when (WINDOWP B) collect B])
|
(for B in BUTTONS when (WINDOWP B) collect B])
|
||||||
|
|
||||||
(Apps.CreateLabel
|
(Apps.CreateLabel
|
||||||
[LAMBDA (Text CenterX BottomY) (* ; "Edited 5-Dec-2022 16:49 by FGH")
|
[LAMBDA (Text CenterX BottomY) (* ; "Edited 5-Dec-2022 16:49 by FGH")
|
||||||
(LET* ((DS (DSPCREATE))
|
(LET* ((DS (DSPCREATE))
|
||||||
(FONT (DSPFONT '(HELVETICA 18 BOLD)
|
(FONT (DSPFONT '(HELVETICA 18 BOLD)
|
||||||
DS))
|
DS))
|
||||||
(SR (STRINGREGION Text DS))
|
(SR (STRINGREGION Text DS))
|
||||||
(BMW (fetch (REGION WIDTH) of SR))
|
(BMW (fetch (REGION WIDTH) of SR))
|
||||||
(BMH (IPLUS (fetch (REGION HEIGHT) of SR)
|
(BMH (IPLUS (fetch (REGION HEIGHT) of SR)
|
||||||
(fetch (REGION BOTTOM) of SR)))
|
(fetch (REGION BOTTOM) of SR)))
|
||||||
(BM (BITMAPCREATE BMW BMH))
|
(BM (BITMAPCREATE BMW BMH))
|
||||||
(POS (create POSITION
|
(POS (create POSITION
|
||||||
XCOORD _ (IDIFFERENCE CenterX (IQUOTIENT BMW 2))
|
XCOORD _ (IDIFFERENCE CenterX (IQUOTIENT BMW 2))
|
||||||
YCOORD _ BottomY))
|
YCOORD _ BottomY))
|
||||||
IW)
|
IW)
|
||||||
@@ -352,12 +357,12 @@
|
|||||||
(WINDOWPROP IW 'ICONLABEL Text)
|
(WINDOWPROP IW 'ICONLABEL Text)
|
||||||
IW])
|
IW])
|
||||||
|
|
||||||
(Apps.ActivateCLOS
|
(Apps.ActivateCLOS
|
||||||
[LAMBDA NIL
|
[LAMBDA NIL
|
||||||
(DECLARE (GLOBALVARS BackgroundMenuCommands BackgroundMenu))
|
(DECLARE (GLOBALVARS BackgroundMenuCommands BackgroundMenu))
|
||||||
(* ; "Edited 12-Nov-2022 14:41 by FGH")
|
(* ; "Edited 12-Nov-2022 14:41 by FGH")
|
||||||
(if (NULL (SASSOC "CLOS Browse Class" BackgroundMenuCommands))
|
(if (NULL (SASSOC "CLOS Browse Class" BackgroundMenuCommands))
|
||||||
then (PROGN [SETQ BackgroundMenuCommands
|
then (PROGN [SETQ BackgroundMenuCommands
|
||||||
(APPEND BackgroundMenuCommands
|
(APPEND BackgroundMenuCommands
|
||||||
(LIST '("CLOS Browse Class" (CLOS-BROWSER::BROWSE-CLASS)
|
(LIST '("CLOS Browse Class" (CLOS-BROWSER::BROWSE-CLASS)
|
||||||
"Bring up a class browser."
|
"Bring up a class browser."
|
||||||
@@ -372,27 +377,27 @@
|
|||||||
]
|
]
|
||||||
(SETQ BackgroundMenu NIL])
|
(SETQ BackgroundMenu NIL])
|
||||||
|
|
||||||
(Apps.ActivateRooms
|
(Apps.ActivateRooms
|
||||||
[LAMBDA (DoNotRefreshButtons)
|
[LAMBDA (DoNotRefreshButtons)
|
||||||
(DECLARE (GLOBALVARS BackgroundMenuCommands ROOMS:*SUITE-DIRECTORIES*))
|
(DECLARE (GLOBALVARS BackgroundMenuCommands ROOMS:*SUITE-DIRECTORIES*))
|
||||||
(* ; "Edited 7-Dec-2022 11:13 by FGH")
|
(* ; "Edited 7-Dec-2022 11:13 by FGH")
|
||||||
(* ; "Edited 12-Nov-2022 14:56 by FGH")
|
(* ; "Edited 12-Nov-2022 14:56 by FGH")
|
||||||
(if (NULL (SASSOC "Rooms" BackgroundMenuCommands))
|
(if (NULL (SASSOC "Rooms" BackgroundMenuCommands))
|
||||||
then (ROOMS:RESET))
|
then (ROOMS:RESET))
|
||||||
(SETQ ROOMS:*SUITE-DIRECTORIES* (CONS (CONCAT (UNIX-GETENV 'MEDLE_USERDIR)
|
(SETQ ROOMS:*SUITE-DIRECTORIES* (CONS (CONCAT (UNIX-GETENV 'MEDLEY¬USERDIR)
|
||||||
"/suites")
|
"/suites")
|
||||||
ROOMS:*SUITE-DIRECTORIES*))
|
ROOMS:*SUITE-DIRECTORIES*))
|
||||||
(SETQ Apps.RoomsActivated T)
|
(SETQ Apps.RoomsActivated T)
|
||||||
(PROMPTPRINT "
|
(PROMPTPRINT "
|
||||||
ROOMS functionality is now available via the Background Menu")
|
ROOMS functionality is now available via the Background Menu")
|
||||||
(if (NOT DoNotRefreshButtons)
|
(if (NOT DoNotRefreshButtons)
|
||||||
then (Apps.CreateButtons])
|
then (Apps.CreateButtons])
|
||||||
|
|
||||||
(Apps.ShowDoc
|
(Apps.ShowDoc
|
||||||
[LAMBDA (URL) (* ; "Edited 18-Jan-2023 20:26 by FGH")
|
[LAMBDA (URL) (* ; "Edited 18-Jan-2023 20:26 by FGH")
|
||||||
(ShellBrowse URL])
|
(ShellBrowse URL])
|
||||||
|
|
||||||
(XCL-USER::EXEC_INTERLISP
|
(XCL-USER::EXEC¬INTERLISP
|
||||||
[LAMBDA NIL (* ; "Edited 18-Mar-2022 18:53 by fgh")
|
[LAMBDA NIL (* ; "Edited 18-Mar-2022 18:53 by fgh")
|
||||||
(PROGN [MAPC (OPENWINDOWS)
|
(PROGN [MAPC (OPENWINDOWS)
|
||||||
(FUNCTION (LAMBDA (W)
|
(FUNCTION (LAMBDA (W)
|
||||||
@@ -406,10 +411,10 @@
|
|||||||
(XCL:SET-DEFAULT-EXEC-TYPE 'INTERLISP)
|
(XCL:SET-DEFAULT-EXEC-TYPE 'INTERLISP)
|
||||||
(XCL:SET-EXEC-TYPE 'INTERLISP])
|
(XCL:SET-EXEC-TYPE 'INTERLISP])
|
||||||
|
|
||||||
(Apps.AroundExitFn
|
(Apps.AroundExitFn
|
||||||
[LAMBDA (EVENT)
|
[LAMBDA (EVENT)
|
||||||
(if (MEMB EVENT '(AFTERLOGOUT AFTERSYSOUT AFTERSAVEVM))
|
(if (MEMB EVENT '(AFTERLOGOUT AFTERSYSOUT AFTERSAVEVM))
|
||||||
then (Apps.SetUpNOTECARDSDIRECTORIES])
|
then (Apps.SetUpNOTECARDSDIRECTORIES])
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||||
|
|
||||||
@@ -420,8 +425,8 @@
|
|||||||
(BKSYSBUF " ")
|
(BKSYSBUF " ")
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (1184 23227 (Apps.InitNotecards 1194 . 5056) (Apps.SetUpNOTECARDSDIRECTORIES 5058 . 6613
|
(FILEMAP (NIL (1153 22792 (Apps.InitNotecards 1163 . 5006) (Apps.SetUpNOTECARDSDIRECTORIES 5008 . 6527
|
||||||
) (Apps.DoInit 6615 . 10212) (Apps.CreateButtons 10214 . 19123) (Apps.CreateLabel 19125 . 19935) (
|
) (Apps.DoInit 6529 . 10067) (Apps.CreateButtons 10069 . 18820) (Apps.CreateLabel 18822 . 19592) (
|
||||||
Apps.ActivateCLOS 19937 . 21286) (Apps.ActivateRooms 21288 . 22139) (Apps.ShowDoc 22141 . 22290) (
|
Apps.ActivateCLOS 19594 . 20919) (Apps.ActivateRooms 20921 . 21730) (Apps.ShowDoc 21732 . 21871) (
|
||||||
XCL-USER::EXEC_INTERLISP 22292 . 23064) (Apps.AroundExitFn 23066 . 23225)))))
|
XCL-USER::EXEC¬INTERLISP 21873 . 22645) (Apps.AroundExitFn 22647 . 22790)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
@@ -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 "13-Oct-2025 16:52:28" {WMEDLEY}<internal>TEDIT-DEBUG.;175 138298
|
(FILECREATED " 7-Feb-2026 17:00:39" {WMEDLEY}<internal>TEDIT-DEBUG.;178 138742
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS SP)
|
:CHANGES-TO (FNS TEDIT-DEBUG)
|
||||||
|
|
||||||
:PREVIOUS-DATE "29-Jul-2025 11:42:21" {WMEDLEY}<internal>TEDIT-DEBUG.;174)
|
:PREVIOUS-DATE " 7-Feb-2026 10:41:45" {WMEDLEY}<internal>TEDIT-DEBUG.;177)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-DEBUGCOMS)
|
(PRETTYCOMPRINT TEDIT-DEBUGCOMS)
|
||||||
@@ -540,7 +540,8 @@
|
|||||||
(RETURN PC])
|
(RETURN PC])
|
||||||
|
|
||||||
(SL
|
(SL
|
||||||
[LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE) (* ; "Edited 17-Apr-2025 13:36 by rmk")
|
[LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE) (* ; "Edited 9-Jan-2026 11:12 by rmk")
|
||||||
|
(* ; "Edited 17-Apr-2025 13:36 by rmk")
|
||||||
(* ; "Edited 15-Apr-2025 13:57 by rmk")
|
(* ; "Edited 15-Apr-2025 13:57 by rmk")
|
||||||
(* ; "Edited 11-Apr-2025 12:15 by rmk")
|
(* ; "Edited 11-Apr-2025 12:15 by rmk")
|
||||||
(* ; "Edited 29-Mar-2025 20:27 by rmk")
|
(* ; "Edited 29-Mar-2025 20:27 by rmk")
|
||||||
@@ -580,6 +581,7 @@
|
|||||||
(SETQ PANE (pop LINES))
|
(SETQ PANE (pop LINES))
|
||||||
(SETQ PNO (pop LINES))
|
(SETQ PNO (pop LINES))
|
||||||
(DEBUGOUTPUT (DEBUGOUTPUT.STREAM OFILE WTYPE TITLE NIL '(TERMINAL 8))
|
(DEBUGOUTPUT (DEBUGOUTPUT.STREAM OFILE WTYPE TITLE NIL '(TERMINAL 8))
|
||||||
|
(RESETSAVE (LINELENGTH MAX.SMALLP OFILE))
|
||||||
(PRINTOUT OFILE .FONT '(TERMINAL 8)
|
(PRINTOUT OFILE .FONT '(TERMINAL 8)
|
||||||
"Pane " PNO " = " PANE T)
|
"Pane " PNO " = " PANE T)
|
||||||
(PRINTOUT OFILE .FONT '(TERMINAL 8)
|
(PRINTOUT OFILE .FONT '(TERMINAL 8)
|
||||||
@@ -805,7 +807,8 @@
|
|||||||
else (RETURN OUTFILE))))])
|
else (RETURN OUTFILE))))])
|
||||||
|
|
||||||
(SHOWLINE
|
(SHOWLINE
|
||||||
[LAMBDA (LINE FILE TEXTOBJ) (* ; "Edited 20-Nov-2024 00:31 by rmk")
|
[LAMBDA (LINE FILE TEXTOBJ) (* ; "Edited 9-Jan-2026 11:09 by rmk")
|
||||||
|
(* ; "Edited 20-Nov-2024 00:31 by rmk")
|
||||||
(* ; "Edited 17-Nov-2024 15:56 by rmk")
|
(* ; "Edited 17-Nov-2024 15:56 by rmk")
|
||||||
(* ; "Edited 9-Nov-2024 10:37 by rmk")
|
(* ; "Edited 9-Nov-2024 10:37 by rmk")
|
||||||
(* ; "Edited 1-Sep-2024 16:49 by rmk")
|
(* ; "Edited 1-Sep-2024 16:49 by rmk")
|
||||||
@@ -836,7 +839,7 @@
|
|||||||
"*"
|
"*"
|
||||||
" ")
|
" ")
|
||||||
.FONT
|
.FONT
|
||||||
'(TERMINAL 6)
|
'(TERMINAL 8)
|
||||||
" ")
|
" ")
|
||||||
(if (GETLD LINE LDUMMY)
|
(if (GETLD LINE LDUMMY)
|
||||||
then (PRINTOUT FILE -8 (CL:IF (GETLD LINE LDUMMY)
|
then (PRINTOUT FILE -8 (CL:IF (GETLD LINE LDUMMY)
|
||||||
@@ -2480,7 +2483,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(TEDIT-DEBUG
|
(TEDIT-DEBUG
|
||||||
[LAMBDA (DONTOVERLOAD) (* ; "Edited 9-Aug-2024 13:20 by rmk")
|
[LAMBDA (DONTOVERLOAD) (* ; "Edited 7-Feb-2026 17:00 by rmk")
|
||||||
|
(* ; "Edited 9-Aug-2024 13:20 by rmk")
|
||||||
(* ; "Edited 16-Jul-2024 12:37 by rmk")
|
(* ; "Edited 16-Jul-2024 12:37 by rmk")
|
||||||
(* ; "Edited 6-Jul-2024 21:16 by rmk")
|
(* ; "Edited 6-Jul-2024 21:16 by rmk")
|
||||||
(* ; "Edited 10-Jun-2024 14:21 by rmk")
|
(* ; "Edited 10-Jun-2024 14:21 by rmk")
|
||||||
@@ -2493,6 +2497,7 @@
|
|||||||
(* ; "Edited 3-Dec-2023 21:00 by rmk")
|
(* ; "Edited 3-Dec-2023 21:00 by rmk")
|
||||||
(* ; "Edited 29-Nov-2023 10:49 by rmk")
|
(* ; "Edited 29-Nov-2023 10:49 by rmk")
|
||||||
(* ; "Edited 24-Nov-2023 12:53 by rmk")
|
(* ; "Edited 24-Nov-2023 12:53 by rmk")
|
||||||
|
(DRIBBLE "TEDIT-DEBUG.DRIBBLE")
|
||||||
(CL:WHEN (DIRECTORYNAMEP (MEDLEYDIR "../oldtedit/"))
|
(CL:WHEN (DIRECTORYNAMEP (MEDLEYDIR "../oldtedit/"))
|
||||||
(PSEUDOHOST 'OT (MEDLEYDIR "../oldtedit/")))
|
(PSEUDOHOST 'OT (MEDLEYDIR "../oldtedit/")))
|
||||||
(FILESLOAD (NOERROR FROM LOADUPS)
|
(FILESLOAD (NOERROR FROM LOADUPS)
|
||||||
@@ -2511,7 +2516,8 @@
|
|||||||
(FILESLOAD (NOERROR)
|
(FILESLOAD (NOERROR)
|
||||||
{OT}OTWHEREIS)
|
{OT}OTWHEREIS)
|
||||||
(PRINTOUT T T "Connected to " (PSEUDOFILENAME (MEDLEYDIR "library/tedit"))
|
(PRINTOUT T T "Connected to " (PSEUDOFILENAME (MEDLEYDIR "library/tedit"))
|
||||||
T])
|
T)
|
||||||
|
(DRIBBLE])
|
||||||
)
|
)
|
||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
@@ -2579,33 +2585,33 @@
|
|||||||
(ADDTOVAR LAMA )
|
(ADDTOVAR LAMA )
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (5115 7674 (GTO 5125 . 5375) (GTS 5377 . 7148) (GTW 7150 . 7306) (GSEL 7308 . 7672)) (
|
(FILEMAP (NIL (5124 7683 (GTO 5134 . 5384) (GTS 5386 . 7157) (GTW 7159 . 7315) (GSEL 7317 . 7681)) (
|
||||||
7707 8828 (TEST.TEMPLATE 7717 . 8826)) (8829 9764 (TESTACTION 8839 . 9762)) (9789 23604 (IPC 9799 .
|
7716 8837 (TEST.TEMPLATE 7726 . 8835)) (8838 9773 (TESTACTION 8848 . 9771)) (9798 23613 (IPC 9808 .
|
||||||
11303) (ILINES 11305 . 13846) (ISEL 13848 . 14459) (ITS 14461 . 16185) (IPANES 16187 . 16422) (ITL
|
11312) (ILINES 11314 . 13855) (ISEL 13857 . 14468) (ITS 14470 . 16194) (IPANES 16196 . 16431) (ITL
|
||||||
16424 . 16843) (IHIST 16845 . 19507) (IPCTB 19509 . 19935) (IMB 19937 . 20696) (ICL 20698 . 21399) (
|
16433 . 16852) (IHIST 16854 . 19516) (IPCTB 19518 . 19944) (IMB 19946 . 20705) (ICL 20707 . 21408) (
|
||||||
IPL 21401 . 21941) (ICARET 21943 . 22470) (INSPECTPIECES 22472 . 23602)) (23626 52365 (SP 23636 .
|
IPL 21410 . 21950) (ICARET 21952 . 22479) (INSPECTPIECES 22481 . 23611)) (23635 52650 (SP 23645 .
|
||||||
28751) (SL 28753 . 32588) (SSP 32590 . 34292) (SPF 34294 . 36824) (SLF 36826 . 45959) (SHOWLINE 45961
|
28760) (SL 28762 . 32764) (SSP 32766 . 34468) (SPF 34470 . 37000) (SLF 37002 . 46135) (SHOWLINE 46137
|
||||||
. 49523) (SLL 49525 . 50272) (STBYTES 50274 . 52000) (SSEL 52002 . 52363)) (52366 64879 (STL 52376 .
|
. 49808) (SLL 49810 . 50557) (STBYTES 50559 . 52285) (SSEL 52287 . 52648)) (52651 65164 (STL 52661 .
|
||||||
61377) (CLEARTHISLINE 61379 . 61859) (CHARSLOTP 61861 . 63180) (\TLVALIDATE 63182 . 64877)) (64880
|
61662) (CLEARTHISLINE 61664 . 62144) (CHARSLOTP 62146 . 63465) (\TLVALIDATE 63467 . 65162)) (65165
|
||||||
70253 (NTHPIECE 64890 . 66022) (NPIECES 66024 . 66889) (NTHPIECECHAR 66891 . 68199) (SELPIECE 68201 .
|
70538 (NTHPIECE 65175 . 66307) (NPIECES 66309 . 67174) (NTHPIECECHAR 67176 . 68484) (SELPIECE 68486 .
|
||||||
68643) (PIECENUM 68645 . 69364) (PCBYTES 69366 . 70251)) (70254 72728 (FILEBYTES 70264 . 71688) (
|
68928) (PIECENUM 68930 . 69649) (PCBYTES 69651 . 70536)) (70539 73013 (FILEBYTES 70549 . 71973) (
|
||||||
TFILEBYTES 71690 . 72726)) (72729 74051 (TRELMOVE 72739 . 72982) (TSCROLL 72984 . 73150) (TSCROLL*
|
TFILEBYTES 71975 . 73011)) (73014 74336 (TRELMOVE 73024 . 73267) (TSCROLL 73269 . 73435) (TSCROLL*
|
||||||
73152 . 74049)) (74052 77101 (TRY 74062 . 75331) (TEDITCLOSEW 75333 . 75676) (PARALASTWITHOUTEOL 75678
|
73437 . 74334)) (74337 77386 (TRY 74347 . 75616) (TEDITCLOSEW 75618 . 75961) (PARALASTWITHOUTEOL 75963
|
||||||
. 76563) (FIXPARALAST 76565 . 77099)) (77102 91989 (SPPRINT 77112 . 83937) (SPPRINT.CHAR 83939 .
|
. 76848) (FIXPARALAST 76850 . 77384)) (77387 92274 (SPPRINT 77397 . 84222) (SPPRINT.CHAR 84224 .
|
||||||
84923) (SPPRINT.OBJ 84925 . 87983) (SHOWPIECEBYTES 87985 . 89541) (CHECKPLENGTHS 89543 . 90000) (SBT
|
85208) (SPPRINT.OBJ 85210 . 88268) (SHOWPIECEBYTES 88270 . 89826) (CHECKPLENGTHS 89828 . 90285) (SBT
|
||||||
90002 . 91139) (COPYPCHAIN 91141 . 91987)) (91990 94051 (POSLINE 92000 . 94049)) (94052 94935 (
|
90287 . 91424) (COPYPCHAIN 91426 . 92272)) (92275 94336 (POSLINE 92285 . 94334)) (94337 95220 (
|
||||||
PRESPLIT 94062 . 94933)) (94936 96649 (ALLTL 94946 . 96199) (NTHCHARSLOT 96201 . 96647)) (96675 106888
|
PRESPLIT 94347 . 95218)) (95221 96934 (ALLTL 95231 . 96484) (NTHCHARSLOT 96486 . 96932)) (96960 107173
|
||||||
(PLCHAIN 96685 . 97213) (PRINTLINE 97215 . 100205) (SL.GETLINES 100207 . 103500) (CHECKLINES 103502
|
(PLCHAIN 96970 . 97498) (PRINTLINE 97500 . 100490) (SL.GETLINES 100492 . 103785) (CHECKLINES 103787
|
||||||
. 104482) (COLLECTLINES 104484 . 104736) (NTHLINE 104738 . 105743) (HEIGHT 105745 . 106033) (LINEBOTS
|
. 104767) (COLLECTLINES 104769 . 105021) (NTHLINE 105023 . 106028) (HEIGHT 106030 . 106318) (LINEBOTS
|
||||||
106035 . 106886)) (106889 109337 (IPC.DECODEARGS 106899 . 109335)) (109338 109931 (SPF1 109348 .
|
106320 . 107171)) (107174 109622 (IPC.DECODEARGS 107184 . 109620)) (109623 110216 (SPF1 109633 .
|
||||||
109929)) (109960 112338 (SLF.FATPLEN 109970 . 110829) (FILEPIECE 110831 . 112336)) (112371 113139 (
|
110214)) (110245 112623 (SLF.FATPLEN 110255 . 111114) (FILEPIECE 111116 . 112621)) (112656 113424 (
|
||||||
SELTEDIT 112381 . 113137)) (113209 118821 (PPARA 113219 . 113641) (PRUN 113643 . 115119) (
|
SELTEDIT 112666 . 113422)) (113494 119106 (PPARA 113504 . 113926) (PRUN 113928 . 115404) (
|
||||||
ADDLINEPOSITIONS 115121 . 116548) (SBR 116550 . 117204) (SBC 117206 . 118819)) (118878 120654 (OLDWI
|
ADDLINEPOSITIONS 115406 . 116833) (SBR 116835 . 117489) (SBC 117491 . 119104)) (119163 120939 (OLDWI
|
||||||
118888 . 119263) (COMP 119265 . 119460) (DFR 119462 . 120652)) (120655 121688 (DFGV 120665 . 121191) (
|
119173 . 119548) (COMP 119550 . 119745) (DFR 119747 . 120937)) (120940 121973 (DFGV 120950 . 121476) (
|
||||||
GDIRECTORIES 121193 . 121686)) (121689 128254 (TTEST 121699 . 126231) (LTEST 126233 . 127598) (THC
|
GDIRECTORIES 121478 . 121971)) (121974 128539 (TTEST 121984 . 126516) (LTEST 126518 . 127883) (THC
|
||||||
127600 . 128252)) (128568 129260 (SHOWSAFE 128578 . 129258)) (129313 129760 (MYH 129323 . 129758)) (
|
127885 . 128537)) (128853 129545 (SHOWSAFE 128863 . 129543)) (129598 130045 (MYH 129608 . 130043)) (
|
||||||
130005 131100 (DFVENUE 130015 . 130894) (VSEE 130896 . 131098)) (131101 131555 (PTT 131111 . 131553))
|
130290 131385 (DFVENUE 130300 . 131179) (VSEE 131181 . 131383)) (131386 131840 (PTT 131396 . 131838))
|
||||||
(131914 133495 (DEBUGOUTPUT.STREAM 131924 . 133493)) (133496 135812 (TEDIT-DEBUG 133506 . 135810)) (
|
(132199 133780 (DEBUGOUTPUT.STREAM 132209 . 133778)) (133781 136256 (TEDIT-DEBUG 133791 . 136254)) (
|
||||||
135813 136305 (HEXTOHILO 135823 . 136163) (CW 136165 . 136303)) (136306 138042 (TRENAME 136316 .
|
136257 136749 (HEXTOHILO 136267 . 136607) (CW 136609 . 136747)) (136750 138486 (TRENAME 136760 .
|
||||||
138040)))))
|
138484)))))
|
||||||
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 " 9-Mar-2025 20:03:27" {DSK}<home>frank>il>medley>internal>loadups>LOADUP-APPS.;10 3274
|
(FILECREATED " 1-Feb-2026 13:45:36" {WMEDLEY}<internal>loadups>LOADUP-APPS.;3 3343
|
||||||
|
|
||||||
:EDIT-BY "frank"
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS LOADUP-APPS)
|
:CHANGES-TO (FNS LOADUP-APPS)
|
||||||
|
|
||||||
:PREVIOUS-DATE " 9-Mar-2025 19:42:36" {DSK}<home>frank>il>medley>internal>loadups>LOADUP-APPS.;8
|
:PREVIOUS-DATE " 9-Mar-2025 20:03:27" {WMEDLEY}<internal>loadups>LOADUP-APPS.;2)
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT LOADUP-APPSCOMS)
|
(PRETTYCOMPRINT LOADUP-APPSCOMS)
|
||||||
@@ -21,7 +20,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(LOADUP-APPS
|
(LOADUP-APPS
|
||||||
[LAMBDA NIL (* ; "Edited 9-Mar-2025 20:02 by frank")
|
[LAMBDA NIL (* ; "Edited 1-Feb-2026 13:45 by rmk")
|
||||||
|
(* ; "Edited 9-Mar-2025 20:02 by frank")
|
||||||
(* ; "Edited 2-Jan-2025 20:38 by lmm")
|
(* ; "Edited 2-Jan-2025 20:38 by lmm")
|
||||||
(* ; "Edited 2-Jan-2025 06:30 by larry")
|
(* ; "Edited 2-Jan-2025 06:30 by larry")
|
||||||
|
|
||||||
@@ -46,7 +46,7 @@
|
|||||||
"/system"))
|
"/system"))
|
||||||
NOTECARDS))
|
NOTECARDS))
|
||||||
(Apps.RemoveBackgroundMenuItem 'NoteCards) (* ; "")
|
(Apps.RemoveBackgroundMenuItem 'NoteCards) (* ; "")
|
||||||
(PUTASSOC 'NOTECARDS (LIST (UNIX-GETENV 'NOTECARDS_COMMIT_ID))
|
(PUTASSOC 'NOTECARDS (LIST (UNIX-GETENV 'NOTECARDS¬COMMIT¬ID))
|
||||||
SYSOUTCOMMITS)
|
SYSOUTCOMMITS)
|
||||||
|
|
||||||
(* ;; "======================")
|
(* ;; "======================")
|
||||||
@@ -78,7 +78,7 @@
|
|||||||
|
|
||||||
(* ;; "")
|
(* ;; "")
|
||||||
|
|
||||||
(PUTASSOC 'MEDLEY (LIST (UNIX-GETENV 'LOADUP_COMMIT_ID))
|
(PUTASSOC 'MEDLEY (LIST (UNIX-GETENV 'LOADUP¬COMMIT¬ID))
|
||||||
SYSOUTCOMMITS)
|
SYSOUTCOMMITS)
|
||||||
(PRINTOUT T "commits-- " SYSOUTCOMMITS T])
|
(PRINTOUT T "commits-- " SYSOUTCOMMITS T])
|
||||||
|
|
||||||
@@ -95,5 +95,5 @@
|
|||||||
Apps.SBG])
|
Apps.SBG])
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (656 3251 (LOADUP-APPS 666 . 2579) (Apps.RemoveBackgroundMenuItem 2581 . 3249)))))
|
(FILEMAP (NIL (616 3320 (LOADUP-APPS 626 . 2648) (Apps.RemoveBackgroundMenuItem 2650 . 3318)))))
|
||||||
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 "28-Dec-2025 12:06:12" {WMEDLEY}<internal>loadups>LOADUP-FULL.;35 5759
|
(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 "20-Sep-2025 14:18:19" {WMEDLEY}<internal>loadups>LOADUP-FULL.;34)
|
: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,10 @@
|
|||||||
(PRINTOUT T "FULL fonts loaded" T])
|
(PRINTOUT T "FULL fonts loaded" T])
|
||||||
|
|
||||||
(LOADUP-FULL
|
(LOADUP-FULL
|
||||||
[LAMBDA (DRIBBLEFILE) (* ; "Edited 28-Dec-2025 12:06 by rmk")
|
[LAMBDA (DRIBBLEFILE) (* ; "Edited 28-Apr-2026 10:00 by rmk")
|
||||||
|
(* ; "Edited 14-Feb-2026 00:42 by rmk")
|
||||||
|
(* ; "Edited 5-Feb-2026 10:26 by rmk")
|
||||||
|
(* ; "Edited 28-Dec-2025 12:06 by rmk")
|
||||||
(* ; "Edited 1-Sep-2025 11:59 by rmk")
|
(* ; "Edited 1-Sep-2025 11:59 by rmk")
|
||||||
(* ; "Edited 18-Aug-2025 12:09 by rmk")
|
(* ; "Edited 18-Aug-2025 12:09 by rmk")
|
||||||
(* ; "Edited 21-Jun-2025 23:33 by rmk")
|
(* ; "Edited 21-Jun-2025 23:33 by rmk")
|
||||||
@@ -77,16 +78,15 @@
|
|||||||
(DIRECTORYNAME T)
|
(DIRECTORYNAME T)
|
||||||
T T) (* ; "For FONTSAVAILABLE lookup")
|
T T) (* ; "For FONTSAVAILABLE lookup")
|
||||||
(LOADUP '(POSTSCRIPTSTREAM)) (* ; " to get PSCFONT.READFONT")
|
(LOADUP '(POSTSCRIPTSTREAM)) (* ; " to get PSCFONT.READFONT")
|
||||||
(LOADFULLFONTS)
|
|
||||||
(LISTPUT IDLE.PROFILE 'TIMEOUT 0)
|
(LISTPUT IDLE.PROFILE 'TIMEOUT 0)
|
||||||
(SETQQ *DEFAULT-CLEANUP-COMPILER* BCOMPL)
|
(SETQQ *DEFAULT-CLEANUP-COMPILER* BCOMPL)
|
||||||
|
|
||||||
(* ;; "RMK: 2025: PRESS was after CHAT")
|
(* ;; "RMK: 2025: PRESS was after CHAT")
|
||||||
|
|
||||||
(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 ISO8859IO
|
GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT HELPSYS
|
||||||
HELPSYS DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE UNIXCOMM
|
DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE UNIXCOMM UNIXCHAT))
|
||||||
UNIXCHAT UNIXYCD))
|
(LOADFULLFONTS)
|
||||||
(COND
|
(COND
|
||||||
((WINDOWP *WHO-LINE*)
|
((WINDOWP *WHO-LINE*)
|
||||||
(CLOSEW *WHO-LINE*)))
|
(CLOSEW *WHO-LINE*)))
|
||||||
@@ -101,5 +101,5 @@
|
|||||||
|
|
||||||
(FIXMETA)
|
(FIXMETA)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (456 5721 (LOADFULLFONTS 466 . 2601) (LOADUP-FULL 2603 . 5471) (FIXMETA 5473 . 5719)))))
|
(FILEMAP (NIL (456 5858 (LOADFULLFONTS 466 . 2449) (LOADUP-FULL 2451 . 5608) (FIXMETA 5610 . 5856)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
@@ -1,13 +1,14 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "28-Jan-2026 14:30:48" |{DSK}<Users>larry>IL>medley>internal>loadups>LOADUP-LISP.;2| 7369
|
(FILECREATED "26-Mar-2026 18:38:22"
|
||||||
|
|{DSK}<Users>briggs>Projects>medley>internal>loadups>LOADUP-LISP.;14| 7604
|
||||||
|
|
||||||
:EDIT-BY "lmm"
|
:EDIT-BY "briggs"
|
||||||
|
|
||||||
:CHANGES-TO (FNS LOADUP-LISP)
|
:CHANGES-TO (FNS LOADUP-LISP)
|
||||||
|
|
||||||
:PREVIOUS-DATE "27-Dec-2025 15:02:04"
|
:PREVIOUS-DATE "22-Feb-2026 14:15:31"
|
||||||
|{DSK}<Users>larry>IL>medley>internal>loadups>LOADUP-LISP.;1|)
|
|{DSK}<Users>briggs>Projects>medley>internal>loadups>LOADUP-LISP.;13|)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT LOADUP-LISPCOMS)
|
(PRETTYCOMPRINT LOADUP-LISPCOMS)
|
||||||
@@ -20,7 +21,9 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(LOADUP-LISP
|
(LOADUP-LISP
|
||||||
(LAMBDA (DRIBBLEFILE) (* \; "Edited 28-Jan-2026 14:30 by lmm")
|
(LAMBDA (DRIBBLEFILE) (* \; "Edited 26-Mar-2026 18:38 by briggs")
|
||||||
|
(* \; "Edited 22-Feb-2026 14:15 by rmk")
|
||||||
|
(* \; "Edited 28-Jan-2026 14:30 by lmm")
|
||||||
(* \; "Edited 27-Dec-2025 15:02 by rmk")
|
(* \; "Edited 27-Dec-2025 15:02 by rmk")
|
||||||
(* \; "Edited 16-Oct-2025 16:55 by rmk")
|
(* \; "Edited 16-Oct-2025 16:55 by rmk")
|
||||||
(* \; "Edited 18-Aug-2025 12:08 by rmk")
|
(* \; "Edited 18-Aug-2025 12:08 by rmk")
|
||||||
@@ -95,9 +98,9 @@
|
|||||||
|
|
||||||
(* |;;| "Also, UNICODE is split into UNICODE-TABLES and UNICODE, so the tables are loaded before their MCCS/Uncode client functions are installed. Functions in UFS now depend on those translations so that filenames can have characters outside of Ascii. ")
|
(* |;;| "Also, UNICODE is split into UNICODE-TABLES and UNICODE, so the tables are loaded before their MCCS/Uncode client functions are installed. Functions in UFS now depend on those translations so that filenames can have characters outside of Ascii. ")
|
||||||
|
|
||||||
(LOADUP '(UNICODE-TABLES UNICODE CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY FONTPROFILE MENU
|
(LOADUP '(CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY FONTPROFILE MENU WINDOWOBJ WINDOWSCROLL
|
||||||
WINDOWOBJ WINDOWSCROLL WINDOW WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL
|
WINDOW WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT DESCRIBE
|
||||||
DEXEC INSPECT DESCRIBE CMLARRAYINSPECTOR EDITINTERFACE TTYIN))
|
CMLARRAYINSPECTOR EDITINTERFACE TTYIN))
|
||||||
(LOADUP '(BREAK-AND-TRACE))
|
(LOADUP '(BREAK-AND-TRACE))
|
||||||
(LOADUP '(FASDUMP XCL-COMPILER ADVISE))
|
(LOADUP '(FASDUMP XCL-COMPILER ADVISE))
|
||||||
|
|
||||||
@@ -135,6 +138,7 @@
|
|||||||
|
|
||||||
(LOADUP '(PUP 10MBDRIVER LEAF LLETHER DPUPFTP LOCALFILE DSKDISPLAY COURIER LLNS TRSERVER SPP
|
(LOADUP '(PUP 10MBDRIVER LEAF LLETHER DPUPFTP LOCALFILE DSKDISPLAY COURIER LLNS TRSERVER SPP
|
||||||
NSPRINT AUTHENTICATION BSP CLEARINGHOUSE NSFILING MAIKOETHER))
|
NSPRINT AUTHENTICATION BSP CLEARINGHOUSE NSFILING MAIKOETHER))
|
||||||
|
(RESTART.ETHER)
|
||||||
(DRIBBLE)
|
(DRIBBLE)
|
||||||
(SETQ MAKESYSNAME :MEDLEY)))
|
(SETQ MAKESYSNAME :MEDLEY)))
|
||||||
)
|
)
|
||||||
@@ -147,5 +151,5 @@
|
|||||||
(GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
|
(GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
|
||||||
)
|
)
|
||||||
(DECLARE\: DONTCOPY
|
(DECLARE\: DONTCOPY
|
||||||
(FILEMAP (NIL (675 7163 (LOADUP-LISP 685 . 7161)))))
|
(FILEMAP (NIL (695 7398 (LOADUP-LISP 705 . 7396)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
@@ -111,11 +111,11 @@ output directory called \f[I]gitinfo\f[R] which contains the git commit,
|
|||||||
git branch and git status information for the directory at the time the
|
git branch and git status information for the directory at the time the
|
||||||
loadup is run.
|
loadup is run.
|
||||||
.PP
|
.PP
|
||||||
Only one instance (per <MEDLEIDIR>) of loadup can be run at a time.
|
Only one instance (per <MEDLEYDIR>) of loadup can be run at a time.
|
||||||
There is lock file to prevent simultaneous loadups in the work directory
|
There is lock file to prevent simultaneous loadups in the work directory
|
||||||
(named \f[B]\f[BI]lock\f[B]\f[R]) that can be manually removed.
|
(named \f[B]\f[BI]lock\f[B]\f[R]) that can be manually removed.
|
||||||
The lock can also be automatically overridden (see the \[en]override
|
The lock can also be automatically overridden (see the --override flag
|
||||||
flag below).
|
below).
|
||||||
Alternatively, if a lock is encountered at run time, the user will be
|
Alternatively, if a lock is encountered at run time, the user will be
|
||||||
asked to choose whether to override or simply exit the loadup.
|
asked to choose whether to override or simply exit the loadup.
|
||||||
.PP
|
.PP
|
||||||
@@ -130,7 +130,7 @@ But Medley can be installed in multiple places on any given machine and
|
|||||||
hence MEDLEYDIR is computed on each invocation of loadup.
|
hence MEDLEYDIR is computed on each invocation of loadup.
|
||||||
.SH OPTIONS
|
.SH OPTIONS
|
||||||
.TP
|
.TP
|
||||||
\f[B]-z [+], --man [+], -man [+], -h [+], \[en]help [+]\f[R]
|
\f[B]-z [+], --man [+], -man [+], -h [+], --help [+]\f[R]
|
||||||
Print this manual page on the screen.
|
Print this manual page on the screen.
|
||||||
If the \f[B]+\f[R] parameter is specified, then no pager is used when
|
If the \f[B]+\f[R] parameter is specified, then no pager is used when
|
||||||
displaying the man page.
|
displaying the man page.
|
||||||
@@ -138,7 +138,7 @@ displaying the man page.
|
|||||||
\f[B]-t STAGE, --target STAGE, -target STAGE\f[R]
|
\f[B]-t STAGE, --target STAGE, -target STAGE\f[R]
|
||||||
Run the sequential loadup procedure until the STAGE is complete,
|
Run the sequential loadup procedure until the STAGE is complete,
|
||||||
starting from the files created by the previously run STAGE specified in
|
starting from the files created by the previously run STAGE specified in
|
||||||
the \[en]start option.
|
the --start option.
|
||||||
.RS
|
.RS
|
||||||
.PP
|
.PP
|
||||||
STAGE can be one of the following:
|
STAGE can be one of the following:
|
||||||
@@ -175,7 +175,7 @@ Full.sysout is copied into the loadups directory.
|
|||||||
.RS
|
.RS
|
||||||
.PP
|
.PP
|
||||||
a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout).
|
a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout).
|
||||||
Also run the Aux stage as if \[en]aux option had been specified.
|
Also run the Aux stage as if --aux option had been specified.
|
||||||
Apps.sysout and the Aux files are copied into the loadups directory.
|
Apps.sysout and the Aux files are copied into the loadups directory.
|
||||||
.RE
|
.RE
|
||||||
.RE
|
.RE
|
||||||
@@ -185,7 +185,7 @@ Apps.sysout and the Aux files are copied into the loadups directory.
|
|||||||
a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout).
|
a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout).
|
||||||
The Aux stage is not run unless otherwise specified.
|
The Aux stage is not run unless otherwise specified.
|
||||||
Apps.sysout is copied into the loadups directory.
|
Apps.sysout is copied into the loadups directory.
|
||||||
Also run the Aux stage as if \[en]aux option had been specified.
|
Also run the Aux stage as if --aux option had been specified.
|
||||||
.RE
|
.RE
|
||||||
.RE
|
.RE
|
||||||
.TP
|
.TP
|
||||||
@@ -245,22 +245,22 @@ If this stage complete successfully, these files are copied into
|
|||||||
loadups.
|
loadups.
|
||||||
.TP
|
.TP
|
||||||
\f[B]-i, --init, -init, -1\f[R]
|
\f[B]-i, --init, -init, -1\f[R]
|
||||||
Synonym for \[lq]\[en]target init\[rq]
|
Synonym for \[lq]--target init\[rq]
|
||||||
.TP
|
.TP
|
||||||
\f[B]-m, --mid, -mid, -2\f[R]
|
\f[B]-m, --mid, -mid, -2\f[R]
|
||||||
Synonym for \[lq]\[en]target mid\[rq]
|
Synonym for \[lq]--target mid\[rq]
|
||||||
.TP
|
.TP
|
||||||
\f[B]-l, --lisp, -lisp, -3\f[R]
|
\f[B]-l, --lisp, -lisp, -3\f[R]
|
||||||
Synonym for \[lq]\[en]target lisp\[rq]
|
Synonym for \[lq]--target lisp\[rq]
|
||||||
.TP
|
.TP
|
||||||
\f[B]-f, --full. -full, -4\f[R]
|
\f[B]-f, --full. -full, -4\f[R]
|
||||||
Synonym for \[lq]\[en]target full\[rq]
|
Synonym for \[lq]--target full\[rq]
|
||||||
.TP
|
.TP
|
||||||
\f[B]-a, --apps, -apps, -5\f[R]
|
\f[B]-a, --apps, -apps, -5\f[R]
|
||||||
Synonym for \[lq]\[en]target apps\[rq]
|
Synonym for \[lq]--target apps\[rq]
|
||||||
.TP
|
.TP
|
||||||
\f[B]-a-, --apps-, -apps-, -5-\f[R]
|
\f[B]-a-, --apps-, -apps-, -5-\f[R]
|
||||||
Synonym for \[lq]\[en]target apps\[rq]
|
Synonym for \[lq]--target apps\[rq]
|
||||||
.TP
|
.TP
|
||||||
\f[B]-ov, --override, -override\f[R]
|
\f[B]-ov, --override, -override\f[R]
|
||||||
Automatically override the lock that prevents two loadups from running
|
Automatically override the lock that prevents two loadups from running
|
||||||
@@ -300,14 +300,14 @@ contained in the working directory.
|
|||||||
If the \f[B]+\f[R] parameter is used, then instead of deleting just the
|
If the \f[B]+\f[R] parameter is used, then instead of deleting just the
|
||||||
versioned files, all files and subdirectories are deleted except for
|
versioned files, all files and subdirectories are deleted except for
|
||||||
those contained in the working directory.
|
those contained in the working directory.
|
||||||
If \f[B]+\f[R] is used and there is no working directory and
|
If \f[B]+\f[R] is used and there is no working directory and \f[I]--tag
|
||||||
\f[I]\[en]tag TAG\f[R] is also specified, then the tagged loadups
|
TAG\f[R] is also specified, then the tagged loadups directory
|
||||||
directory (<MEDLEYDIR>/loadups/tagged/TAG) is also deleted.
|
(<MEDLEYDIR>/loadups/tagged/TAG) is also deleted.
|
||||||
.TP
|
.TP
|
||||||
\f[B]-th [+], --thin [+], -thin [+]\f[R]
|
\f[B]-th [+], --thin [+], -thin [+]\f[R]
|
||||||
Equivalent to specifying both -tw [+] and -tl [+].
|
Equivalent to specifying both -tw [+] and -tl [+].
|
||||||
If \f[I]\[en]tag TAG\f[R] is also specified and the \f[B]+\f[R]
|
If \f[I]--tag TAG\f[R] is also specified and the \f[B]+\f[R] parameter
|
||||||
parameter is used here, then the tagged loadups directory
|
is used here, then the tagged loadups directory
|
||||||
(<MEDLEYDIR>/loadups/tagged/TAG) is removed.
|
(<MEDLEYDIR>/loadups/tagged/TAG) is removed.
|
||||||
.TP
|
.TP
|
||||||
\f[B]-d DIR, --maikodir DIR, -maikodir DIR\f[R]
|
\f[B]-d DIR, --maikodir DIR, -maikodir DIR\f[R]
|
||||||
@@ -328,38 +328,36 @@ commonly used in running Medley in the absence of an Xwindows server.
|
|||||||
.PP
|
.PP
|
||||||
The defaults for the Options context-dependent and somewhat complicated
|
The defaults for the Options context-dependent and somewhat complicated
|
||||||
due to the goal of maintaining compatibility with legacy loadup scripts.
|
due to the goal of maintaining compatibility with legacy loadup scripts.
|
||||||
All of the following defaults rules hold independent of the
|
All of the following defaults rules hold independent of the --maikodir
|
||||||
\[en]maikodir (-d) option.
|
(-d) option.
|
||||||
.IP "1." 3
|
.IP "1." 3
|
||||||
If none of \[en]target, \[en]start, \[en]aux, and \[en]db are specified,
|
If none of --target, --start, --aux, and --db are specified, then:
|
||||||
then:
|
|
||||||
.RS
|
.RS
|
||||||
.PP
|
.PP
|
||||||
1A.
|
1A.
|
||||||
If neither \[en]thinw nor \[en]thinl are specified, the options default
|
If neither --thinw nor --thinl are specified, the options default to:
|
||||||
to:
|
|
||||||
.RE
|
.RE
|
||||||
.RS
|
.RS
|
||||||
.RS
|
.RS
|
||||||
.PP
|
.PP
|
||||||
\f[B]\[en]target full \[en]start 0 \[en]aux\f[R]
|
\f[B]--target full --start 0 --aux\f[R]
|
||||||
.RE
|
.RE
|
||||||
.RE
|
.RE
|
||||||
.RS
|
.RS
|
||||||
.PP
|
.PP
|
||||||
1B.
|
1B.
|
||||||
If either \[en]thinw or \[en]thinl are specified, no loadups are run.
|
If either --thinw or --thinl are specified, no loadups are run.
|
||||||
.RE
|
.RE
|
||||||
.IP "2." 3
|
.IP "2." 3
|
||||||
If neither \[en]start nor \[en]target are specified but either -aux or
|
If neither --start nor --target are specified but either -aux or -db or
|
||||||
-db or both are, then \[en]start defaults to \f[I]full\f[R] and
|
both are, then --start defaults to \f[I]full\f[R] and --target is
|
||||||
\[en]target is irrelevant.
|
irrelevant.
|
||||||
.IP "3." 3
|
.IP "3." 3
|
||||||
If \[en]start is specified and \[en]target is not, then \[en]target
|
If --start is specified and --target is not, then --target defaults to
|
||||||
defaults to \f[I]full\f[R]
|
\f[I]full\f[R]
|
||||||
.IP "4." 3
|
.IP "4." 3
|
||||||
If \[en]target is specified and \[en]start is not, then \[en]start
|
If --target is specified and --start is not, then --start defaults to
|
||||||
defaults to \f[I]0\f[R]
|
\f[I]0\f[R]
|
||||||
.SH EXAMPLES
|
.SH EXAMPLES
|
||||||
.PP
|
.PP
|
||||||
\f[B]./loadup -full -s lisp\f[R] : run loadup thru Stage 4 (full.sysout)
|
\f[B]./loadup -full -s lisp\f[R] : run loadup thru Stage 4 (full.sysout)
|
||||||
@@ -368,14 +366,14 @@ starting from existing Stage 3 outputs (lisp.sysout).
|
|||||||
\f[B]./loadup --target full --start lisp\f[R] : run loadup thru Stage 4
|
\f[B]./loadup --target full --start lisp\f[R] : run loadup thru Stage 4
|
||||||
(full.sysout) starting from existing Stage 3 outputs (lisp.sysout).
|
(full.sysout) starting from existing Stage 3 outputs (lisp.sysout).
|
||||||
.PP
|
.PP
|
||||||
\f[B]./loadup -5 \[en]aux\f[R] : run loadup from the beginning thru
|
\f[B]./loadup -5 --aux\f[R] : run loadup from the beginning thru Stage 5
|
||||||
Stage 5 (apps.sysout) then run the Aux \[lq]stage\[rq] to create
|
(apps.sysout) then run the Aux \[lq]stage\[rq] to create
|
||||||
\f[I]whereis.hash\f[R] and \f[I]exports.all\f[R]
|
\f[I]whereis.hash\f[R] and \f[I]exports.all\f[R]
|
||||||
.PP
|
.PP
|
||||||
\f[B]./loadup -db\f[R] : just run the DB \[lq]stage\[rq] starting from
|
\f[B]./loadup -db\f[R] : just run the DB \[lq]stage\[rq] starting from
|
||||||
an existing full.sysout; do not run any of the sequential stages.
|
an existing full.sysout; do not run any of the sequential stages.
|
||||||
.PP
|
.PP
|
||||||
\f[B]./loadup \[en]maikodir \[ti]/il/newmaiko\f[R] : run loadup sequence
|
\f[B]./loadup --maikodir \[ti]/il/newmaiko\f[R] : run loadup sequence
|
||||||
from beginning to full plus the loadup Aux stage, while using
|
from beginning to full plus the loadup Aux stage, while using
|
||||||
\f[I]\[ti]/il/newmaiko\f[R] as the location for the lde executables when
|
\f[I]\[ti]/il/newmaiko\f[R] as the location for the lde executables when
|
||||||
running Medley.
|
running Medley.
|
||||||
|
|||||||
Binary file not shown.
@@ -52,7 +52,7 @@ Loadup does all of its work in a work directory (\<MEDLEYDIR>/loadups/build). T
|
|||||||
|
|
||||||
If \<MEDLEYDIR> is a git directory, then a file is created in the loadups output directory called *gitinfo* which contains the git commit, git branch and git status information for the directory at the time the loadup is run.
|
If \<MEDLEYDIR> is a git directory, then a file is created in the loadups output directory called *gitinfo* which contains the git commit, git branch and git status information for the directory at the time the loadup is run.
|
||||||
|
|
||||||
Only one instance (per \<MEDLEIDIR>) of loadup can be run at a time. There is lock file to prevent simultaneous loadups in the work directory (named ***lock***) that can be manually removed. The lock can also be automatically overridden (see the --override flag below). Alternatively, if a lock is encountered at run time, the user will be asked to choose whether to override or simply exit the loadup.
|
Only one instance (per \<MEDLEYDIR>) of loadup can be run at a time. There is lock file to prevent simultaneous loadups in the work directory (named ***lock***) that can be manually removed. The lock can also be automatically overridden (see the \-\-override flag below). Alternatively, if a lock is encountered at run time, the user will be asked to choose whether to override or simply exit the loadup.
|
||||||
|
|
||||||
Note: **MEDLEYDIR** is an environment variable set by the loadup script. It is set to the top level directory of the Medley installation that contains the specific loadup script that
|
Note: **MEDLEYDIR** is an environment variable set by the loadup script. It is set to the top level directory of the Medley installation that contains the specific loadup script that
|
||||||
is invoked after all symbolic links are resolved. In the standard global installation this will
|
is invoked after all symbolic links are resolved. In the standard global installation this will
|
||||||
@@ -61,12 +61,12 @@ hence MEDLEYDIR is computed on each invocation of loadup.
|
|||||||
|
|
||||||
OPTIONS
|
OPTIONS
|
||||||
=======
|
=======
|
||||||
**-z [+], \-\-man [+], \-man [+], -h [+], --help [+]**
|
**-z [+], \-\-man [+], \-man [+], -h [+], \-\-help [+]**
|
||||||
: Print this manual page on the screen. If the **+** parameter is specified, then no pager is used when
|
: Print this manual page on the screen. If the **+** parameter is specified, then no pager is used when
|
||||||
displaying the man page.
|
displaying the man page.
|
||||||
|
|
||||||
**-t STAGE, \-\-target STAGE, -target STAGE**
|
**-t STAGE, \-\-target STAGE, -target STAGE**
|
||||||
: Run the sequential loadup procedure until the STAGE is complete, starting from the files created by the previously run STAGE specified in the --start option.
|
: Run the sequential loadup procedure until the STAGE is complete, starting from the files created by the previously run STAGE specified in the \-\-start option.
|
||||||
|
|
||||||
>STAGE can be one of the following:
|
>STAGE can be one of the following:
|
||||||
|
|
||||||
@@ -78,9 +78,9 @@ displaying the man page.
|
|||||||
|
|
||||||
>>f, full, 4: Run the loadup sequence through Stage 4 (full.sysout). Full.sysout is copied into the loadups directory.
|
>>f, full, 4: Run the loadup sequence through Stage 4 (full.sysout). Full.sysout is copied into the loadups directory.
|
||||||
|
|
||||||
>>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout). Also run the Aux stage as if --aux option had been specified. Apps.sysout and the Aux files are copied into the loadups directory.
|
>>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout). Also run the Aux stage as if \-\-aux option had been specified. Apps.sysout and the Aux files are copied into the loadups directory.
|
||||||
|
|
||||||
>>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout). The Aux stage is not run unless otherwise specified. Apps.sysout is copied into the loadups directory. Also run the Aux stage as if --aux option had been specified.
|
>>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout). The Aux stage is not run unless otherwise specified. Apps.sysout is copied into the loadups directory. Also run the Aux stage as if \-\-aux option had been specified.
|
||||||
|
|
||||||
|
|
||||||
**-s STAGE \-\-start STAGE, -start STAGE**
|
**-s STAGE \-\-start STAGE, -start STAGE**
|
||||||
@@ -105,22 +105,22 @@ displaying the man page.
|
|||||||
: Run the DB loadup stage, creating the *fuller.database* file. If this stage complete successfully, these files are copied into loadups.
|
: Run the DB loadup stage, creating the *fuller.database* file. If this stage complete successfully, these files are copied into loadups.
|
||||||
|
|
||||||
**-i, \-\-init, -init, -1**
|
**-i, \-\-init, -init, -1**
|
||||||
: Synonym for "--target init"
|
: Synonym for "\-\-target init"
|
||||||
|
|
||||||
**-m, \-\-mid, -mid, -2**
|
**-m, \-\-mid, -mid, -2**
|
||||||
: Synonym for "--target mid"
|
: Synonym for "\-\-target mid"
|
||||||
|
|
||||||
**-l, \-\-lisp, -lisp, -3**
|
**-l, \-\-lisp, -lisp, -3**
|
||||||
: Synonym for "--target lisp"
|
: Synonym for "\-\-target lisp"
|
||||||
|
|
||||||
**-f, \-\-full. -full, -4**
|
**-f, \-\-full. -full, -4**
|
||||||
: Synonym for "--target full"
|
: Synonym for "\-\-target full"
|
||||||
|
|
||||||
**-a, \-\-apps, -apps, -5**
|
**-a, \-\-apps, -apps, -5**
|
||||||
: Synonym for "--target apps"
|
: Synonym for "\-\-target apps"
|
||||||
|
|
||||||
**-a-, \-\-apps-, -apps-, -5-**
|
**-a-, \-\-apps-, -apps-, -5-**
|
||||||
: Synonym for "--target apps"
|
: Synonym for "\-\-target apps"
|
||||||
|
|
||||||
**-ov, \-\-override, -override**
|
**-ov, \-\-override, -override**
|
||||||
: Automatically override the lock that prevents two loadups from running simultaneously. If this flag is not set and an active lock is encountered, the user will be asked to choose whether to override or exit.
|
: Automatically override the lock that prevents two loadups from running simultaneously. If this flag is not set and an active lock is encountered, the user will be asked to choose whether to override or exit.
|
||||||
@@ -149,11 +149,11 @@ working directory (and all files and subdirectories it contains) is deleted.
|
|||||||
files except for those contained in the working directory.
|
files except for those contained in the working directory.
|
||||||
If the **+** parameter is used, then instead of deleting just the versioned files, all files and
|
If the **+** parameter is used, then instead of deleting just the versioned files, all files and
|
||||||
subdirectories are deleted except for those contained in the working directory. If **+** is used and
|
subdirectories are deleted except for those contained in the working directory. If **+** is used and
|
||||||
there is no working directory and *--tag TAG* is also specified,
|
there is no working directory and *\-\-tag TAG* is also specified,
|
||||||
then the tagged loadups directory (\<MEDLEYDIR>/loadups/tagged/TAG) is also deleted.
|
then the tagged loadups directory (\<MEDLEYDIR>/loadups/tagged/TAG) is also deleted.
|
||||||
|
|
||||||
**-th [+], \-\-thin [+], -thin [+]**
|
**-th [+], \-\-thin [+], -thin [+]**
|
||||||
: Equivalent to specifying both -tw [+] and -tl [+]. If *--tag TAG* is also specified and
|
: Equivalent to specifying both -tw [+] and -tl [+]. If *\-\-tag TAG* is also specified and
|
||||||
the **+** parameter is used here, then the tagged loadups directory (\<MEDLEYDIR>/loadups/tagged/TAG)
|
the **+** parameter is used here, then the tagged loadups directory (\<MEDLEYDIR>/loadups/tagged/TAG)
|
||||||
is removed.
|
is removed.
|
||||||
|
|
||||||
@@ -168,21 +168,21 @@ running Medley in the absence of an Xwindows server.
|
|||||||
|
|
||||||
DEFAULTS
|
DEFAULTS
|
||||||
====
|
====
|
||||||
The defaults for the Options context-dependent and somewhat complicated due to the goal of maintaining compatibility with legacy loadup scripts. All of the following defaults rules hold independent of the --maikodir (-d) option.
|
The defaults for the Options context-dependent and somewhat complicated due to the goal of maintaining compatibility with legacy loadup scripts. All of the following defaults rules hold independent of the \-\-maikodir (-d) option.
|
||||||
|
|
||||||
1. If none of --target, --start, --aux, and --db are specified, then:
|
1. If none of \-\-target, \-\-start, \-\-aux, and \-\-db are specified, then:
|
||||||
|
|
||||||
>1A. If neither --thinw nor --thinl are specified, the options default to:
|
>1A. If neither \-\-thinw nor \-\-thinl are specified, the options default to:
|
||||||
|
|
||||||
>> **--target full --start 0 --aux**
|
>> **\-\-target full \-\-start 0 \-\-aux**
|
||||||
|
|
||||||
>1B. If either --thinw or --thinl are specified, no loadups are run.
|
>1B. If either \-\-thinw or \-\-thinl are specified, no loadups are run.
|
||||||
|
|
||||||
2. If neither --start nor --target are specified but either -aux or -db or both are, then --start defaults to *full* and --target is irrelevant.
|
2. If neither \-\-start nor \-\-target are specified but either -aux or -db or both are, then \-\-start defaults to *full* and \-\-target is irrelevant.
|
||||||
|
|
||||||
3. If --start is specified and --target is not, then --target defaults to *full*
|
3. If \-\-start is specified and \-\-target is not, then \-\-target defaults to *full*
|
||||||
|
|
||||||
4. If --target is specified and --start is not, then --start defaults to *0*
|
4. If \-\-target is specified and \-\-start is not, then \-\-start defaults to *0*
|
||||||
|
|
||||||
EXAMPLES
|
EXAMPLES
|
||||||
====
|
====
|
||||||
@@ -190,11 +190,11 @@ EXAMPLES
|
|||||||
|
|
||||||
**./loadup \-\-target full \-\-start lisp** : run loadup thru Stage 4 (full.sysout) starting from existing Stage 3 outputs (lisp.sysout).
|
**./loadup \-\-target full \-\-start lisp** : run loadup thru Stage 4 (full.sysout) starting from existing Stage 3 outputs (lisp.sysout).
|
||||||
|
|
||||||
**./loadup -5 --aux** : run loadup from the beginning thru Stage 5 (apps.sysout) then run the Aux "stage" to create *whereis.hash* and *exports.all*
|
**./loadup -5 \-\-aux** : run loadup from the beginning thru Stage 5 (apps.sysout) then run the Aux "stage" to create *whereis.hash* and *exports.all*
|
||||||
|
|
||||||
**./loadup -db** : just run the DB "stage" starting from an existing full.sysout; do not run any of the sequential stages.
|
**./loadup -db** : just run the DB "stage" starting from an existing full.sysout; do not run any of the sequential stages.
|
||||||
|
|
||||||
**./loadup --maikodir ~/il/newmaiko** : run loadup sequence from beginning to full plus the loadup Aux stage, while using *~/il/newmaiko* as the location for the lde executables when running Medley.
|
**./loadup \-\-maikodir ~/il/newmaiko** : run loadup sequence from beginning to full plus the loadup Aux stage, while using *~/il/newmaiko* as the location for the lde executables when running Medley.
|
||||||
|
|
||||||
**./loadup -full** : run loadup sequence from beginning thru full
|
**./loadup -full** : run loadup sequence from beginning thru full
|
||||||
|
|
||||||
|
|||||||
@@ -83,11 +83,11 @@ the work directory after the loadup completes.</p>
|
|||||||
the loadups output directory called <em>gitinfo</em> which contains the
|
the loadups output directory called <em>gitinfo</em> which contains the
|
||||||
git commit, git branch and git status information for the directory at
|
git commit, git branch and git status information for the directory at
|
||||||
the time the loadup is run.</p>
|
the time the loadup is run.</p>
|
||||||
<p>Only one instance (per <MEDLEIDIR>) of loadup can be run at a
|
<p>Only one instance (per <MEDLEYDIR>) of loadup can be run at a
|
||||||
time. There is lock file to prevent simultaneous loadups in the work
|
time. There is lock file to prevent simultaneous loadups in the work
|
||||||
directory (named <strong><em>lock</em></strong>) that can be manually
|
directory (named <strong><em>lock</em></strong>) that can be manually
|
||||||
removed. The lock can also be automatically overridden (see the
|
removed. The lock can also be automatically overridden (see the
|
||||||
–override flag below). Alternatively, if a lock is encountered at run
|
--override flag below). Alternatively, if a lock is encountered at run
|
||||||
time, the user will be asked to choose whether to override or simply
|
time, the user will be asked to choose whether to override or simply
|
||||||
exit the loadup.</p>
|
exit the loadup.</p>
|
||||||
<p>Note: <strong>MEDLEYDIR</strong> is an environment variable set by
|
<p>Note: <strong>MEDLEYDIR</strong> is an environment variable set by
|
||||||
@@ -99,7 +99,8 @@ installed in multiple places on any given machine and hence MEDLEYDIR is
|
|||||||
computed on each invocation of loadup.</p>
|
computed on each invocation of loadup.</p>
|
||||||
<h1>OPTIONS</h1>
|
<h1>OPTIONS</h1>
|
||||||
<dl>
|
<dl>
|
||||||
<dt><strong>-z [+], --man [+], -man [+], -h [+], –help [+]</strong></dt>
|
<dt><strong>-z [+], --man [+], -man [+], -h [+], --help
|
||||||
|
[+]</strong></dt>
|
||||||
<dd>
|
<dd>
|
||||||
<p>Print this manual page on the screen. If the <strong>+</strong>
|
<p>Print this manual page on the screen. If the <strong>+</strong>
|
||||||
parameter is specified, then no pager is used when displaying the man
|
parameter is specified, then no pager is used when displaying the man
|
||||||
@@ -109,7 +110,7 @@ page.</p>
|
|||||||
<dd>
|
<dd>
|
||||||
<p>Run the sequential loadup procedure until the STAGE is complete,
|
<p>Run the sequential loadup procedure until the STAGE is complete,
|
||||||
starting from the files created by the previously run STAGE specified in
|
starting from the files created by the previously run STAGE specified in
|
||||||
the –start option.</p>
|
the --start option.</p>
|
||||||
<p>STAGE can be one of the following:</p>
|
<p>STAGE can be one of the following:</p>
|
||||||
<blockquote>
|
<blockquote>
|
||||||
<p>i, init, 1: Run the loadup sequence through Stage 1 (init.dlinit).
|
<p>i, init, 1: Run the loadup sequence through Stage 1 (init.dlinit).
|
||||||
@@ -129,13 +130,13 @@ Full.sysout is copied into the loadups directory.</p>
|
|||||||
</blockquote>
|
</blockquote>
|
||||||
<blockquote>
|
<blockquote>
|
||||||
<p>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout).
|
<p>a, apps, 5: Run the loadup sequence through Stage 5 (apps.sysout).
|
||||||
Also run the Aux stage as if –aux option had been specified. Apps.sysout
|
Also run the Aux stage as if --aux option had been specified.
|
||||||
and the Aux files are copied into the loadups directory.</p>
|
Apps.sysout and the Aux files are copied into the loadups directory.</p>
|
||||||
</blockquote>
|
</blockquote>
|
||||||
<blockquote>
|
<blockquote>
|
||||||
<p>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout).
|
<p>a-, apps-, 5-: Run the loadup sequence through Stage 5 (apps.sysout).
|
||||||
The Aux stage is not run unless otherwise specified. Apps.sysout is
|
The Aux stage is not run unless otherwise specified. Apps.sysout is
|
||||||
copied into the loadups directory. Also run the Aux stage as if –aux
|
copied into the loadups directory. Also run the Aux stage as if --aux
|
||||||
option had been specified.</p>
|
option had been specified.</p>
|
||||||
</blockquote>
|
</blockquote>
|
||||||
</dd>
|
</dd>
|
||||||
@@ -181,27 +182,27 @@ loadups.</p>
|
|||||||
</dd>
|
</dd>
|
||||||
<dt><strong>-i, --init, -init, -1</strong></dt>
|
<dt><strong>-i, --init, -init, -1</strong></dt>
|
||||||
<dd>
|
<dd>
|
||||||
<p>Synonym for “–target init”</p>
|
<p>Synonym for “--target init”</p>
|
||||||
</dd>
|
</dd>
|
||||||
<dt><strong>-m, --mid, -mid, -2</strong></dt>
|
<dt><strong>-m, --mid, -mid, -2</strong></dt>
|
||||||
<dd>
|
<dd>
|
||||||
<p>Synonym for “–target mid”</p>
|
<p>Synonym for “--target mid”</p>
|
||||||
</dd>
|
</dd>
|
||||||
<dt><strong>-l, --lisp, -lisp, -3</strong></dt>
|
<dt><strong>-l, --lisp, -lisp, -3</strong></dt>
|
||||||
<dd>
|
<dd>
|
||||||
<p>Synonym for “–target lisp”</p>
|
<p>Synonym for “--target lisp”</p>
|
||||||
</dd>
|
</dd>
|
||||||
<dt><strong>-f, --full. -full, -4</strong></dt>
|
<dt><strong>-f, --full. -full, -4</strong></dt>
|
||||||
<dd>
|
<dd>
|
||||||
<p>Synonym for “–target full”</p>
|
<p>Synonym for “--target full”</p>
|
||||||
</dd>
|
</dd>
|
||||||
<dt><strong>-a, --apps, -apps, -5</strong></dt>
|
<dt><strong>-a, --apps, -apps, -5</strong></dt>
|
||||||
<dd>
|
<dd>
|
||||||
<p>Synonym for “–target apps”</p>
|
<p>Synonym for “--target apps”</p>
|
||||||
</dd>
|
</dd>
|
||||||
<dt><strong>-a-, --apps-, -apps-, -5-</strong></dt>
|
<dt><strong>-a-, --apps-, -apps-, -5-</strong></dt>
|
||||||
<dd>
|
<dd>
|
||||||
<p>Synonym for “–target apps”</p>
|
<p>Synonym for “--target apps”</p>
|
||||||
</dd>
|
</dd>
|
||||||
<dt><strong>-ov, --override, -override</strong></dt>
|
<dt><strong>-ov, --override, -override</strong></dt>
|
||||||
<dd>
|
<dd>
|
||||||
@@ -245,13 +246,13 @@ contained in the working directory. If the <strong>+</strong> parameter
|
|||||||
is used, then instead of deleting just the versioned files, all files
|
is used, then instead of deleting just the versioned files, all files
|
||||||
and subdirectories are deleted except for those contained in the working
|
and subdirectories are deleted except for those contained in the working
|
||||||
directory. If <strong>+</strong> is used and there is no working
|
directory. If <strong>+</strong> is used and there is no working
|
||||||
directory and <em>–tag TAG</em> is also specified, then the tagged
|
directory and <em>--tag</em> TAG is also specified, then the tagged
|
||||||
loadups directory (<MEDLEYDIR>/loadups/tagged/TAG) is also
|
loadups directory (<MEDLEYDIR>/loadups/tagged/TAG) is also
|
||||||
deleted.</p>
|
deleted.</p>
|
||||||
</dd>
|
</dd>
|
||||||
<dt><strong>-th [+], --thin [+], -thin [+]</strong></dt>
|
<dt><strong>-th [+], --thin [+], -thin [+]</strong></dt>
|
||||||
<dd>
|
<dd>
|
||||||
<p>Equivalent to specifying both -tw [+] and -tl [+]. If <em>–tag
|
<p>Equivalent to specifying both -tw [+] and -tl [+]. If <em>--tag
|
||||||
TAG</em> is also specified and the <strong>+</strong> parameter is used
|
TAG</em> is also specified and the <strong>+</strong> parameter is used
|
||||||
here, then the tagged loadups directory
|
here, then the tagged loadups directory
|
||||||
(<MEDLEYDIR>/loadups/tagged/TAG) is removed.</p>
|
(<MEDLEYDIR>/loadups/tagged/TAG) is removed.</p>
|
||||||
@@ -277,24 +278,24 @@ absence of an Xwindows server.</p>
|
|||||||
<p>The defaults for the Options context-dependent and somewhat
|
<p>The defaults for the Options context-dependent and somewhat
|
||||||
complicated due to the goal of maintaining compatibility with legacy
|
complicated due to the goal of maintaining compatibility with legacy
|
||||||
loadup scripts. All of the following defaults rules hold independent of
|
loadup scripts. All of the following defaults rules hold independent of
|
||||||
the –maikodir (-d) option.</p>
|
the --maikodir (-d) option.</p>
|
||||||
<ol type="1">
|
<ol type="1">
|
||||||
<li><p>If none of –target, –start, –aux, and –db are specified,
|
<li><p>If none of --target, --start, --aux, and --db are specified,
|
||||||
then:</p>
|
then:</p>
|
||||||
<p>1A. If neither –thinw nor –thinl are specified, the options default
|
<p>1A. If neither --thinw nor --thinl are specified, the options default
|
||||||
to:</p>
|
to:</p>
|
||||||
<blockquote>
|
<blockquote>
|
||||||
<p><strong>–target full –start 0 –aux</strong></p>
|
<p><strong>--target full --start 0 --aux</strong></p>
|
||||||
</blockquote>
|
</blockquote>
|
||||||
<p>1B. If either –thinw or –thinl are specified, no loadups are
|
<p>1B. If either --thinw or --thinl are specified, no loadups are
|
||||||
run.</p></li>
|
run.</p></li>
|
||||||
<li><p>If neither –start nor –target are specified but either -aux or
|
<li><p>If neither --start nor --target are specified but either -aux or
|
||||||
-db or both are, then –start defaults to <em>full</em> and –target is
|
-db or both are, then --start defaults to <em>full</em> and --target is
|
||||||
irrelevant.</p></li>
|
irrelevant.</p></li>
|
||||||
<li><p>If –start is specified and –target is not, then –target defaults
|
<li><p>If --start is specified and --target is not, then --target
|
||||||
to <em>full</em></p></li>
|
defaults to <em>full</em></p></li>
|
||||||
<li><p>If –target is specified and –start is not, then –start defaults
|
<li><p>If --target is specified and --start is not, then --start
|
||||||
to <em>0</em></p></li>
|
defaults to <em>0</em></p></li>
|
||||||
</ol>
|
</ol>
|
||||||
<h1>EXAMPLES</h1>
|
<h1>EXAMPLES</h1>
|
||||||
<p><strong>./loadup -full -s lisp</strong> : run loadup thru Stage 4
|
<p><strong>./loadup -full -s lisp</strong> : run loadup thru Stage 4
|
||||||
@@ -302,12 +303,12 @@ to <em>0</em></p></li>
|
|||||||
<p><strong>./loadup --target full --start lisp</strong> : run loadup
|
<p><strong>./loadup --target full --start lisp</strong> : run loadup
|
||||||
thru Stage 4 (full.sysout) starting from existing Stage 3 outputs
|
thru Stage 4 (full.sysout) starting from existing Stage 3 outputs
|
||||||
(lisp.sysout).</p>
|
(lisp.sysout).</p>
|
||||||
<p><strong>./loadup -5 –aux</strong> : run loadup from the beginning
|
<p><strong>./loadup -5 --aux</strong> : run loadup from the beginning
|
||||||
thru Stage 5 (apps.sysout) then run the Aux “stage” to create
|
thru Stage 5 (apps.sysout) then run the Aux “stage” to create
|
||||||
<em>whereis.hash</em> and <em>exports.all</em></p>
|
<em>whereis.hash</em> and <em>exports.all</em></p>
|
||||||
<p><strong>./loadup -db</strong> : just run the DB “stage” starting from
|
<p><strong>./loadup -db</strong> : just run the DB “stage” starting from
|
||||||
an existing full.sysout; do not run any of the sequential stages.</p>
|
an existing full.sysout; do not run any of the sequential stages.</p>
|
||||||
<p><strong>./loadup –maikodir ~/il/newmaiko</strong> : run loadup
|
<p><strong>./loadup --maikodir ~/il/newmaiko</strong> : run loadup
|
||||||
sequence from beginning to full plus the loadup Aux stage, while using
|
sequence from beginning to full plus the loadup Aux stage, while using
|
||||||
<em>~/il/newmaiko</em> as the location for the lde executables when
|
<em>~/il/newmaiko</em> as the location for the lde executables when
|
||||||
running Medley.</p>
|
running Medley.</p>
|
||||||
|
|||||||
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 "25-Sep-2025 15:00:01"
|
(FILECREATED "23-Feb-2026 12:35:55" {WMEDLEY}<library>CLIPBOARD.;29 8228
|
||||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>CLIPBOARD.;28 8305
|
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS PUTCLIPBOARD CLIPBOARD-COPY-STREAM)
|
:CHANGES-TO (VARS CLIPBOARDCOMS)
|
||||||
|
|
||||||
:PREVIOUS-DATE "21-Apr-2024 09:12:04" {WMEDLEY}<library>CLIPBOARD.;18)
|
:PREVIOUS-DATE "25-Sep-2025 15:00:01" {WMEDLEY}<library>CLIPBOARD.;28)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT CLIPBOARDCOMS)
|
(PRETTYCOMPRINT CLIPBOARDCOMS)
|
||||||
@@ -18,7 +17,7 @@
|
|||||||
CLIPBOARD-PASTE-STREAM)
|
CLIPBOARD-PASTE-STREAM)
|
||||||
(FNS SEDIT.COPYTOCLIPBOARD)
|
(FNS SEDIT.COPYTOCLIPBOARD)
|
||||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY (FILES (SYSLOAD)
|
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY (FILES (SYSLOAD)
|
||||||
UNIXCOMM UNICODE)
|
UNIXCOMM)
|
||||||
(P (INSTALL-CLIPBOARD)))
|
(P (INSTALL-CLIPBOARD)))
|
||||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||||
(NLAML)
|
(NLAML)
|
||||||
@@ -148,7 +147,7 @@
|
|||||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY
|
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY
|
||||||
|
|
||||||
(FILESLOAD (SYSLOAD)
|
(FILESLOAD (SYSLOAD)
|
||||||
UNIXCOMM UNICODE)
|
UNIXCOMM)
|
||||||
|
|
||||||
|
|
||||||
(INSTALL-CLIPBOARD)
|
(INSTALL-CLIPBOARD)
|
||||||
@@ -162,7 +161,7 @@
|
|||||||
(ADDTOVAR LAMA )
|
(ADDTOVAR LAMA )
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (1167 6486 (INSTALL-CLIPBOARD 1177 . 2504) (GETCLIPBOARD 2506 . 2880) (PUTCLIPBOARD 2882
|
(FILEMAP (NIL (1098 6417 (INSTALL-CLIPBOARD 1108 . 2435) (GETCLIPBOARD 2437 . 2811) (PUTCLIPBOARD 2813
|
||||||
. 4306) (PASTEFROMCLIPBOARD 4308 . 5226) (CLIPBOARD-COPY-STREAM 5228 . 5762) (CLIPBOARD-PASTE-STREAM
|
. 4237) (PASTEFROMCLIPBOARD 4239 . 5157) (CLIPBOARD-COPY-STREAM 5159 . 5693) (CLIPBOARD-PASTE-STREAM
|
||||||
5764 . 6484)) (6487 8026 (SEDIT.COPYTOCLIPBOARD 6497 . 8024)))))
|
5695 . 6415)) (6418 7957 (SEDIT.COPYTOCLIPBOARD 6428 . 7955)))))
|
||||||
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.
317
library/GRAPHER
317
library/GRAPHER
@@ -1,21 +1,18 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||||
(FILECREATED "14-Mar-2021 20:40:30"
|
|
||||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>GRAPHER.;5 214171
|
|
||||||
|
|
||||||
changes to%: (VARS GRAPHERCOMS)
|
(FILECREATED "14-Apr-2026 22:19:19" {DSK}<home>frank>il>medley>library>GRAPHER.;3 215302
|
||||||
|
|
||||||
previous date%: "14-May-2018 10:24:38"
|
:EDIT-BY "FGH"
|
||||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>GRAPHER.;4)
|
|
||||||
|
|
||||||
|
:CHANGES-TO (FNS DISPLAYLINK/RL DISPLAYLINK/LR DISPLAYLINK/BT DISPLAYLINK/TB)
|
||||||
|
|
||||||
|
:PREVIOUS-DATE "14-Mar-2021 20:40:30" {DSK}<home>frank>il>medley>library>GRAPHER.;1)
|
||||||
|
|
||||||
(* ; "
|
|
||||||
Copyright (c) 1983-1994, 2018, 2021 by Venue & Xerox Corporation.
|
|
||||||
")
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT GRAPHERCOMS)
|
(PRETTYCOMPRINT GRAPHERCOMS)
|
||||||
|
|
||||||
(RPAQQ GRAPHERCOMS
|
(RPAQQ GRAPHERCOMS
|
||||||
[(COMS (* ; "Graph Editing")
|
[(COMS (* ; "Graph Editing")
|
||||||
(FNS ADD/AND/DISPLAY/LINK APPLYTOSELECTEDNODE CALL.MOVENODEFN CHANGE.NODEFONT.SIZE
|
(FNS ADD/AND/DISPLAY/LINK APPLYTOSELECTEDNODE CALL.MOVENODEFN CHANGE.NODEFONT.SIZE
|
||||||
DEFAULT.ADDNODEFN DELETE/AND/DISPLAY/LINK DISPLAY/NAME DISPLAYGRAPH DISPLAYLINK
|
DEFAULT.ADDNODEFN DELETE/AND/DISPLAY/LINK DISPLAY/NAME DISPLAYGRAPH DISPLAYLINK
|
||||||
DISPLAYLINK/BT DISPLAYLINK/LR DISPLAYLINK/RL DISPLAYLINK/TB DISPLAYNODE
|
DISPLAYLINK/BT DISPLAYLINK/LR DISPLAYLINK/RL DISPLAYLINK/TB DISPLAYNODE
|
||||||
@@ -38,18 +35,18 @@ Copyright (c) 1983-1994, 2018, 2021 by Venue & Xerox Corporation.
|
|||||||
(CL:WHEN (GETD 'MODERNWINDOW.SETUP)
|
(CL:WHEN (GETD 'MODERNWINDOW.SETUP)
|
||||||
(MODERNWINDOW.SETUP 'APPLYTOSELECTEDNODE))]
|
(MODERNWINDOW.SETUP 'APPLYTOSELECTEDNODE))]
|
||||||
|
|
||||||
(* ;; "Support for EDITSUBGRAPH and EDITREGION")
|
(* ;; "Support for EDITSUBGRAPH and EDITREGION")
|
||||||
|
|
||||||
(FNS EDITMOVEREGION EDITMOVESUBTREE NOT.TRACKCURSOR RECURSIVE.COLLECTDESCENDENTS
|
(FNS EDITMOVEREGION EDITMOVESUBTREE NOT.TRACKCURSOR RECURSIVE.COLLECTDESCENDENTS
|
||||||
MOVEDESCENDENTS COLLECT.CHILD.NODES CREATE.NEW.NODEPOSITION
|
MOVEDESCENDENTS COLLECT.CHILD.NODES CREATE.NEW.NODEPOSITION
|
||||||
GETBOXPOSITION.FROMINITIALREGION COLLECTDESCENDENTS))
|
GETBOXPOSITION.FROMINITIALREGION COLLECTDESCENDENTS))
|
||||||
(COMS (* ;
|
(COMS (* ;
|
||||||
"functions for finding larger and smaller fonts")
|
"functions for finding larger and smaller fonts")
|
||||||
(FNS NEXTSIZEFONT DECREASING.FONT.LIST SCALE.FONT)
|
(FNS NEXTSIZEFONT DECREASING.FONT.LIST SCALE.FONT)
|
||||||
[DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (DECREASING.FONT.LIST (DECREASING.FONT.LIST]
|
[DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (DECREASING.FONT.LIST (DECREASING.FONT.LIST]
|
||||||
(GLOBALVARS DECREASING.FONT.LIST))
|
(GLOBALVARS DECREASING.FONT.LIST))
|
||||||
(* ;
|
(* ;
|
||||||
"functions for LAYOUTGRAPH And LAYOUTLATTICE")
|
"functions for LAYOUTGRAPH And LAYOUTLATTICE")
|
||||||
(FNS BRH/LAYOUT BRH/LAYOUT/DAUGHTERS BRH/OFFSET BRHC/INTERTREE/SPACE BRHC/LAYOUT
|
(FNS BRH/LAYOUT BRH/LAYOUT/DAUGHTERS BRH/OFFSET BRHC/INTERTREE/SPACE BRHC/LAYOUT
|
||||||
BRHC/LAYOUT/DAUGHTERS BRHC/LAYOUT/TERMINAL BRHC/OFFSET BRHL/LAYOUT BRHL/LAYOUT/DAUGHTERS
|
BRHC/LAYOUT/DAUGHTERS BRHC/LAYOUT/TERMINAL BRHC/OFFSET BRHL/LAYOUT BRHL/LAYOUT/DAUGHTERS
|
||||||
BRHL/MOVE/RIGHT BROWSE/LAYOUT/HORIZ BROWSE/LAYOUT/HORIZ/COMPACTLY BROWSE/LAYOUT/LATTICE
|
BRHL/MOVE/RIGHT BROWSE/LAYOUT/HORIZ BROWSE/LAYOUT/HORIZ/COMPACTLY BROWSE/LAYOUT/LATTICE
|
||||||
@@ -95,7 +92,7 @@ Copyright (c) 1983-1994, 2018, 2021 by Venue & Xerox Corporation.
|
|||||||
(LOCALVARS . T)
|
(LOCALVARS . T)
|
||||||
(RECORDS GRAPHNODE GRAPH)
|
(RECORDS GRAPHNODE GRAPH)
|
||||||
(DECLARE%: DONTCOPY (MACROS HALF))
|
(DECLARE%: DONTCOPY (MACROS HALF))
|
||||||
(COMS (* ; "Grapher image objects")
|
(COMS (* ; "Grapher image objects")
|
||||||
(FNS GRAPHERIMAGEFNS)
|
(FNS GRAPHERIMAGEFNS)
|
||||||
(FNS GRAPHERCOPYBUTTONEVENTFN GRAPHOBJ.FINDGRAPH)
|
(FNS GRAPHERCOPYBUTTONEVENTFN GRAPHOBJ.FINDGRAPH)
|
||||||
(FNS ALIGNMENTNODE GRAPHOBJ.CHECKALIGN)
|
(FNS ALIGNMENTNODE GRAPHOBJ.CHECKALIGN)
|
||||||
@@ -303,96 +300,112 @@ Copyright (c) 1983-1994, 2018, 2021 by Venue & Xerox Corporation.
|
|||||||
NIL])
|
NIL])
|
||||||
|
|
||||||
(DISPLAYLINK/BT
|
(DISPLAYLINK/BT
|
||||||
[LAMBDA (TRANS GNB GNT WIDTH OPERATION STREAM PARAMS)
|
[LAMBDA (TRANS GNB GNT WIDTH OPERATION STREAM PARAMS) (* ; "Edited 14-Apr-2026 22:08 by FGH")
|
||||||
(* ; "Edited 29-Apr-94 13:59 by sybalsky")
|
(* ; "Edited 29-Apr-94 13:59 by sybalsky")
|
||||||
|
|
||||||
(* draws a line from the bottom edge of GNB to the top edge of GNT translated
|
(* draws a line from the bottom edge of GNB to the top edge of GNT translated by
|
||||||
by TRANS)
|
TRANS)
|
||||||
|
|
||||||
(APPLY* (OR (LISTGET PARAMS 'DRAWLINKFN)
|
(LET* [(FN (LISTGET PARAMS 'DRAWLINKFN))
|
||||||
'DRAWLINE)
|
(DFN (AND FN (GETD FN]
|
||||||
(IPLUS (fetch XCOORD of TRANS)
|
(if (AND FN (NOT DFN))
|
||||||
(fetch XCOORD of (fetch (GRAPHNODE NODEPOSITION) of GNB)))
|
then (PROMPTPRINT (CONCAT "DISPLAYLINK: DRAWLINKFN " FN " NOT FOUND")))
|
||||||
(IPLUS (fetch YCOORD of TRANS)
|
(APPLY* (OR (AND DFN FN)
|
||||||
(SUB1 (GN/BOTTOM GNB)))
|
'DRAWLINE)
|
||||||
(IPLUS (fetch XCOORD of TRANS)
|
(IPLUS (fetch XCOORD of TRANS)
|
||||||
(fetch XCOORD of (fetch (GRAPHNODE NODEPOSITION) of GNT)))
|
(fetch XCOORD of (fetch (GRAPHNODE NODEPOSITION) of GNB)))
|
||||||
(IPLUS (fetch YCOORD of TRANS)
|
(IPLUS (fetch YCOORD of TRANS)
|
||||||
(ADD1 (GN/TOP GNT)))
|
(SUB1 (GN/BOTTOM GNB)))
|
||||||
(OR (LISTGET PARAMS 'LINEWIDTH)
|
(IPLUS (fetch XCOORD of TRANS)
|
||||||
WIDTH 1)
|
(fetch XCOORD of (fetch (GRAPHNODE NODEPOSITION) of GNT)))
|
||||||
OPERATION STREAM (LISTGET PARAMS 'COLOR)
|
(IPLUS (fetch YCOORD of TRANS)
|
||||||
(LISTGET PARAMS 'DASHING)
|
(ADD1 (GN/TOP GNT)))
|
||||||
PARAMS])
|
(OR (LISTGET PARAMS 'LINEWIDTH)
|
||||||
|
WIDTH 1)
|
||||||
|
OPERATION STREAM (LISTGET PARAMS 'COLOR)
|
||||||
|
(LISTGET PARAMS 'DASHING)
|
||||||
|
PARAMS])
|
||||||
|
|
||||||
(DISPLAYLINK/LR
|
(DISPLAYLINK/LR
|
||||||
[LAMBDA (TRANS GNL GNR WIDTH OPERATION STREAM PARAMS)
|
[LAMBDA (TRANS GNL GNR WIDTH OPERATION STREAM PARAMS) (* ; "Edited 14-Apr-2026 22:09 by FGH")
|
||||||
(* ; "Edited 29-Apr-94 13:59 by sybalsky")
|
(* ; "Edited 29-Apr-94 13:59 by sybalsky")
|
||||||
|
|
||||||
(* draws a line from the left edge of GNL to the right edge of GNR, translated
|
(* draws a line from the left edge of GNL to the right edge of GNR, translated by
|
||||||
by TRANS)
|
TRANS)
|
||||||
|
|
||||||
(APPLY* (OR (LISTGET PARAMS 'DRAWLINKFN)
|
(LET* [(FN (LISTGET PARAMS 'DRAWLINKFN))
|
||||||
'DRAWLINE)
|
(DFN (AND FN (GETD FN]
|
||||||
(IPLUS (fetch XCOORD of TRANS)
|
(if (AND FN (NOT DFN))
|
||||||
(SUB1 (GN/LEFT GNL)))
|
then (PROMPTPRINT (CONCAT "DISPLAYLINK: DRAWLINKFN " FN " NOT FOUND")))
|
||||||
(IPLUS (fetch YCOORD of TRANS)
|
(APPLY* (OR (AND DFN FN)
|
||||||
(fetch YCOORD of (fetch (GRAPHNODE NODEPOSITION) of GNL)))
|
'DRAWLINE)
|
||||||
(IPLUS (fetch XCOORD of TRANS)
|
(IPLUS (fetch XCOORD of TRANS)
|
||||||
(ADD1 (GN/RIGHT GNR)))
|
(SUB1 (GN/LEFT GNL)))
|
||||||
(IPLUS (fetch YCOORD of TRANS)
|
(IPLUS (fetch YCOORD of TRANS)
|
||||||
(fetch YCOORD of (fetch (GRAPHNODE NODEPOSITION) of GNR)))
|
(fetch YCOORD of (fetch (GRAPHNODE NODEPOSITION) of GNL)))
|
||||||
(OR (LISTGET PARAMS 'LINEWIDTH)
|
(IPLUS (fetch XCOORD of TRANS)
|
||||||
WIDTH 1)
|
(ADD1 (GN/RIGHT GNR)))
|
||||||
OPERATION STREAM (LISTGET PARAMS 'COLOR)
|
(IPLUS (fetch YCOORD of TRANS)
|
||||||
(LISTGET PARAMS 'DASHING)
|
(fetch YCOORD of (fetch (GRAPHNODE NODEPOSITION) of GNR)))
|
||||||
PARAMS])
|
(OR (LISTGET PARAMS 'LINEWIDTH)
|
||||||
|
WIDTH 1)
|
||||||
|
OPERATION STREAM (LISTGET PARAMS 'COLOR)
|
||||||
|
(LISTGET PARAMS 'DASHING)
|
||||||
|
PARAMS])
|
||||||
|
|
||||||
(DISPLAYLINK/RL
|
(DISPLAYLINK/RL
|
||||||
[LAMBDA (TRANS GNR GNL WIDTH OPERATION STREAM PARAMS)
|
[LAMBDA (TRANS GNR GNL WIDTH OPERATION STREAM PARAMS) (* ; "Edited 14-Apr-2026 22:09 by FGH")
|
||||||
(* ; "Edited 29-Apr-94 13:59 by sybalsky")
|
(* ; "Edited 29-Apr-94 13:59 by sybalsky")
|
||||||
|
|
||||||
(* draws a line from the right edge of GNR, to the left edge of GNL translated
|
(* draws a line from the right edge of GNR, to the left edge of GNL translated by
|
||||||
by TRANS)
|
TRANS)
|
||||||
|
|
||||||
(APPLY* (OR (LISTGET PARAMS 'DRAWLINKFN)
|
(LET* [(FN (LISTGET PARAMS 'DRAWLINKFN))
|
||||||
'DRAWLINE)
|
(DFN (AND FN (GETD FN]
|
||||||
(IPLUS (fetch XCOORD of TRANS)
|
(if (AND FN (NOT DFN))
|
||||||
(ADD1 (GN/RIGHT GNR)))
|
then (PROMPTPRINT (CONCAT "DISPLAYLINK: DRAWLINKFN " FN " NOT FOUND")))
|
||||||
(IPLUS (fetch YCOORD of TRANS)
|
(APPLY* (OR (AND DFN FN)
|
||||||
(fetch YCOORD of (fetch (GRAPHNODE NODEPOSITION) of GNR)))
|
'DRAWLINE)
|
||||||
(IPLUS (fetch XCOORD of TRANS)
|
(IPLUS (fetch XCOORD of TRANS)
|
||||||
(SUB1 (GN/LEFT GNL)))
|
(ADD1 (GN/RIGHT GNR)))
|
||||||
(IPLUS (fetch YCOORD of TRANS)
|
(IPLUS (fetch YCOORD of TRANS)
|
||||||
(fetch YCOORD of (fetch (GRAPHNODE NODEPOSITION) of GNL)))
|
(fetch YCOORD of (fetch (GRAPHNODE NODEPOSITION) of GNR)))
|
||||||
(OR (LISTGET PARAMS 'LINEWIDTH)
|
(IPLUS (fetch XCOORD of TRANS)
|
||||||
WIDTH 1)
|
(SUB1 (GN/LEFT GNL)))
|
||||||
OPERATION STREAM (LISTGET PARAMS 'COLOR)
|
(IPLUS (fetch YCOORD of TRANS)
|
||||||
(LISTGET PARAMS 'DASHING)
|
(fetch YCOORD of (fetch (GRAPHNODE NODEPOSITION) of GNL)))
|
||||||
PARAMS])
|
(OR (LISTGET PARAMS 'LINEWIDTH)
|
||||||
|
WIDTH 1)
|
||||||
|
OPERATION STREAM (LISTGET PARAMS 'COLOR)
|
||||||
|
(LISTGET PARAMS 'DASHING)
|
||||||
|
PARAMS])
|
||||||
|
|
||||||
(DISPLAYLINK/TB
|
(DISPLAYLINK/TB
|
||||||
[LAMBDA (TRANS GNT GNB WIDTH OPERATION STREAM PARAMS)
|
[LAMBDA (TRANS GNT GNB WIDTH OPERATION STREAM PARAMS) (* ; "Edited 14-Apr-2026 22:09 by FGH")
|
||||||
(* ; "Edited 29-Apr-94 13:59 by sybalsky")
|
(* ; "Edited 29-Apr-94 13:59 by sybalsky")
|
||||||
|
|
||||||
(* draws a line from the top edge of GNT to the bottom edge of GNR, translated
|
(* draws a line from the top edge of GNT to the bottom edge of GNR, translated by
|
||||||
by TRANS)
|
TRANS)
|
||||||
|
|
||||||
(APPLY* (OR (LISTGET PARAMS 'DRAWLINKFN)
|
(LET* [(FN (LISTGET PARAMS 'DRAWLINKFN))
|
||||||
'DRAWLINE)
|
(DFN (AND FN (GETD FN]
|
||||||
(IPLUS (fetch XCOORD of TRANS)
|
(if (AND FN (NOT DFN))
|
||||||
(fetch XCOORD of (fetch (GRAPHNODE NODEPOSITION) of GNT)))
|
then (PROMPTPRINT (CONCAT "DISPLAYLINK: DRAWLINKFN " FN " NOT FOUND")))
|
||||||
(IPLUS (fetch YCOORD of TRANS)
|
(APPLY* (OR (AND DFN FN)
|
||||||
(ADD1 (GN/TOP GNT)))
|
'DRAWLINE)
|
||||||
(IPLUS (fetch XCOORD of TRANS)
|
(IPLUS (fetch XCOORD of TRANS)
|
||||||
(fetch XCOORD of (fetch (GRAPHNODE NODEPOSITION) of GNB)))
|
(fetch XCOORD of (fetch (GRAPHNODE NODEPOSITION) of GNT)))
|
||||||
(IPLUS (fetch YCOORD of TRANS)
|
(IPLUS (fetch YCOORD of TRANS)
|
||||||
(SUB1 (GN/BOTTOM GNB)))
|
(ADD1 (GN/TOP GNT)))
|
||||||
(OR (LISTGET PARAMS 'LINEWIDTH)
|
(IPLUS (fetch XCOORD of TRANS)
|
||||||
WIDTH 1)
|
(fetch XCOORD of (fetch (GRAPHNODE NODEPOSITION) of GNB)))
|
||||||
OPERATION STREAM (LISTGET PARAMS 'COLOR)
|
(IPLUS (fetch YCOORD of TRANS)
|
||||||
(LISTGET PARAMS 'DASHING)
|
(SUB1 (GN/BOTTOM GNB)))
|
||||||
PARAMS])
|
(OR (LISTGET PARAMS 'LINEWIDTH)
|
||||||
|
WIDTH 1)
|
||||||
|
OPERATION STREAM (LISTGET PARAMS 'COLOR)
|
||||||
|
(LISTGET PARAMS 'DASHING)
|
||||||
|
PARAMS])
|
||||||
|
|
||||||
(DISPLAYNODE
|
(DISPLAYNODE
|
||||||
[LAMBDA (NODE TRANS STREAM G TOSONLY) (* kvl "10-Aug-84 19:08")
|
[LAMBDA (NODE TRANS STREAM G TOSONLY) (* kvl "10-Aug-84 19:08")
|
||||||
@@ -2014,7 +2027,7 @@ Copyright (c) 1983-1994, 2018, 2021 by Venue & Xerox Corporation.
|
|||||||
of N])
|
of N])
|
||||||
)
|
)
|
||||||
|
|
||||||
(* Was MODERNIZE loaded before?)
|
(* Was MODERNIZE loaded before?)
|
||||||
|
|
||||||
(CL:WHEN (GETD 'MODERNWINDOW.SETUP)
|
(CL:WHEN (GETD 'MODERNWINDOW.SETUP)
|
||||||
(MODERNWINDOW.SETUP 'APPLYTOSELECTEDNODE))
|
(MODERNWINDOW.SETUP 'APPLYTOSELECTEDNODE))
|
||||||
@@ -3075,7 +3088,7 @@ Copyright (c) 1983-1994, 2018, 2021 by Venue & Xerox Corporation.
|
|||||||
(RPAQQ GRAPH/HARDCOPY/FORMAT (MODE PORTRAIT PAGENUMBERS T TRANS NIL))
|
(RPAQQ GRAPH/HARDCOPY/FORMAT (MODE PORTRAIT PAGENUMBERS T TRANS NIL))
|
||||||
|
|
||||||
(RPAQ? DEFAULT.GRAPH.WINDOWSIZE (LIST (TIMES SCREENWIDTH 0.7)
|
(RPAQ? DEFAULT.GRAPH.WINDOWSIZE (LIST (TIMES SCREENWIDTH 0.7)
|
||||||
(TIMES SCREENHEIGHT 0.4)))
|
(TIMES SCREENHEIGHT 0.4)))
|
||||||
|
|
||||||
(RPAQ? EDITGRAPHMENUCOMMANDS
|
(RPAQ? EDITGRAPHMENUCOMMANDS
|
||||||
'((Move% Node 'MOVENODE "Moves a single node in the graph." (SUBITEMS (|Move Single Node|
|
'((Move% Node 'MOVENODE "Moves a single node in the graph." (SUBITEMS (|Move Single Node|
|
||||||
@@ -3113,19 +3126,19 @@ Copyright (c) 1983-1994, 2018, 2021 by Venue & Xerox Corporation.
|
|||||||
(DECLARE%: EVAL@COMPILE
|
(DECLARE%: EVAL@COMPILE
|
||||||
|
|
||||||
(RECORD GRAPHNODE (NODEID NODEPOSITION NODELABELBITMAP NIL NODELABELSHADE NODEWIDTH NODEHEIGHT
|
(RECORD GRAPHNODE (NODEID NODEPOSITION NODELABELBITMAP NIL NODELABELSHADE NODEWIDTH NODEHEIGHT
|
||||||
TONODES FROMNODES NODEFONT NODELABEL NODEBORDER)
|
TONODES FROMNODES NODEFONT NODELABEL NODEBORDER)
|
||||||
NODEBORDER _ DEFAULT.GRAPH.NODEBORDER NODELABELSHADE _
|
NODEBORDER _ DEFAULT.GRAPH.NODEBORDER NODELABELSHADE _ DEFAULT.GRAPH.NODELABELSHADE
|
||||||
DEFAULT.GRAPH.NODELABELSHADE NODEFONT _ DEFAULT.GRAPH.NODEFONT)
|
NODEFONT _ DEFAULT.GRAPH.NODEFONT)
|
||||||
|
|
||||||
(RECORD GRAPH (GRAPHNODES SIDESFLG DIRECTEDFLG GRAPH.MOVENODEFN GRAPH.ADDNODEFN
|
(RECORD GRAPH (GRAPHNODES SIDESFLG DIRECTEDFLG GRAPH.MOVENODEFN GRAPH.ADDNODEFN GRAPH.DELETENODEFN
|
||||||
GRAPH.DELETENODEFN GRAPH.ADDLINKFN GRAPH.DELETELINKFN GRAPH.FONTCHANGEFN
|
GRAPH.ADDLINKFN GRAPH.DELETELINKFN GRAPH.FONTCHANGEFN GRAPH.INVERTBORDERFN
|
||||||
GRAPH.INVERTBORDERFN GRAPH.INVERTLABELFN GRAPH.CHANGELABELFN . GRAPH.PROPS))
|
GRAPH.INVERTLABELFN GRAPH.CHANGELABELFN . GRAPH.PROPS))
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(DECLARE%: EVAL@COMPILE
|
(DECLARE%: EVAL@COMPILE
|
||||||
|
|
||||||
(PUTPROPS HALF MACRO ((X)
|
(PUTPROPS HALF MACRO ((X)
|
||||||
(LRSH X 1)))
|
(LRSH X 1)))
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
@@ -3789,61 +3802,59 @@ Copyright (c) 1983-1994, 2018, 2021 by Venue & Xerox Corporation.
|
|||||||
)
|
)
|
||||||
|
|
||||||
(ADDTOVAR IMAGEOBJGETFNS (GRAPHOBJ.GETFN))
|
(ADDTOVAR IMAGEOBJGETFNS (GRAPHOBJ.GETFN))
|
||||||
(PUTPROPS GRAPHER COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991
|
|
||||||
1992 1993 1994 2018 2021))
|
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (7195 111244 (ADD/AND/DISPLAY/LINK 7205 . 7907) (APPLYTOSELECTEDNODE 7909 . 8397) (
|
(FILEMAP (NIL (7149 112538 (ADD/AND/DISPLAY/LINK 7159 . 7861) (APPLYTOSELECTEDNODE 7863 . 8351) (
|
||||||
CALL.MOVENODEFN 8399 . 8748) (CHANGE.NODEFONT.SIZE 8750 . 10062) (DEFAULT.ADDNODEFN 10064 . 10862) (
|
CALL.MOVENODEFN 8353 . 8702) (CHANGE.NODEFONT.SIZE 8704 . 10016) (DEFAULT.ADDNODEFN 10018 . 10816) (
|
||||||
DELETE/AND/DISPLAY/LINK 10864 . 12431) (DISPLAY/NAME 12433 . 12604) (DISPLAYGRAPH 12606 . 14977) (
|
DELETE/AND/DISPLAY/LINK 10818 . 12385) (DISPLAY/NAME 12387 . 12558) (DISPLAYGRAPH 12560 . 14931) (
|
||||||
DISPLAYLINK 14979 . 17532) (DISPLAYLINK/BT 17534 . 18556) (DISPLAYLINK/LR 18558 . 19581) (
|
DISPLAYLINK 14933 . 17486) (DISPLAYLINK/BT 17488 . 18845) (DISPLAYLINK/LR 18847 . 20205) (
|
||||||
DISPLAYLINK/RL 19583 . 20606) (DISPLAYLINK/TB 20608 . 21631) (DISPLAYNODE 21633 . 21981) (
|
DISPLAYLINK/RL 20207 . 21565) (DISPLAYLINK/TB 21567 . 22925) (DISPLAYNODE 22927 . 23275) (
|
||||||
ERASE/GRAPHNODE 21983 . 23090) (DISPLAYNODE 23092 . 23440) (DISPLAYNODELINKS 23442 . 24586) (
|
ERASE/GRAPHNODE 23277 . 24384) (DISPLAYNODE 24386 . 24734) (DISPLAYNODELINKS 24736 . 25880) (
|
||||||
DRAW/GRAPHNODE/BORDER 24588 . 25507) (DRAWAREABOX 25509 . 26710) (EDITADDLINK 26712 . 27110) (
|
DRAW/GRAPHNODE/BORDER 25882 . 26801) (DRAWAREABOX 26803 . 28004) (EDITADDLINK 28006 . 28404) (
|
||||||
EDITADDNODE 27112 . 29201) (EDITAPPLYTOLINK 29203 . 31282) (EDITCHANGEFONT 31284 . 32456) (
|
EDITADDNODE 28406 . 30495) (EDITAPPLYTOLINK 30497 . 32576) (EDITCHANGEFONT 32578 . 33750) (
|
||||||
EDITCHANGELABEL 32458 . 33999) (EDITDELETELINK 34001 . 34407) (EDITDELETENODE 34409 . 37110) (
|
EDITCHANGELABEL 33752 . 35293) (EDITDELETELINK 35295 . 35701) (EDITDELETENODE 35703 . 38404) (
|
||||||
EDITGRAPH 37112 . 37179) (EDITGRAPH1 37181 . 37939) (EDITGRAPH2 37941 . 39672) (EDITMOVENODE 39674 .
|
EDITGRAPH 38406 . 38473) (EDITGRAPH1 38475 . 39233) (EDITGRAPH2 39235 . 40966) (EDITMOVENODE 40968 .
|
||||||
41251) (EDITTOGGLEBORDER 41253 . 42549) (EDITTOGGLELABEL 42551 . 43848) (FILL/GRAPHNODE/LABEL 43850 .
|
42545) (EDITTOGGLEBORDER 42547 . 43843) (EDITTOGGLELABEL 43845 . 45142) (FILL/GRAPHNODE/LABEL 45144 .
|
||||||
44678) (FIX/SCALE 44680 . 45236) (FLIPNODE 45238 . 45842) (FONTNAMELIST 45844 . 46063) (FROMLINKS
|
45972) (FIX/SCALE 45974 . 46530) (FLIPNODE 46532 . 47136) (FONTNAMELIST 47138 . 47357) (FROMLINKS
|
||||||
46065 . 46235) (GETNODEFROMID 46237 . 47256) (GN/BOTTOM 47258 . 47534) (GN/LEFT 47536 . 47809) (
|
47359 . 47529) (GETNODEFROMID 47531 . 48550) (GN/BOTTOM 48552 . 48828) (GN/LEFT 48830 . 49103) (
|
||||||
GN/RIGHT 47811 . 48202) (GN/TOP 48204 . 48628) (GRAPHADDLINK 48630 . 49189) (GRAPHADDNODE 49191 .
|
GN/RIGHT 49105 . 49496) (GN/TOP 49498 . 49922) (GRAPHADDLINK 49924 . 50483) (GRAPHADDNODE 50485 .
|
||||||
49980) (GRAPHBUTTONEVENTFN 49982 . 52162) (GRAPHCHANGELABEL 52164 . 52607) (GRAPHDELETELINK 52609 .
|
51274) (GRAPHBUTTONEVENTFN 51276 . 53456) (GRAPHCHANGELABEL 53458 . 53901) (GRAPHDELETELINK 53903 .
|
||||||
53917) (GRAPHDELETENODE 53919 . 54451) (GRAPHEDITCOMMANDFN 54453 . 55837) (GRAPHEDITEVENTFN 55839 .
|
55211) (GRAPHDELETENODE 55213 . 55745) (GRAPHEDITCOMMANDFN 55747 . 57131) (GRAPHEDITEVENTFN 57133 .
|
||||||
56550) (GRAPHER/CENTERPRINTINAREA 56552 . 57316) (GRAPHERPROP 57318 . 57862) (GRAPHNODE/BORDER/WIDTH
|
57844) (GRAPHER/CENTERPRINTINAREA 57846 . 58610) (GRAPHERPROP 58612 . 59156) (GRAPHNODE/BORDER/WIDTH
|
||||||
57864 . 58385) (GRAPHREGION 58387 . 59556) (HARDCOPYGRAPH 59558 . 66940) (INTERSECT/REGIONP/LBWH 66942
|
59158 . 59679) (GRAPHREGION 59681 . 60850) (HARDCOPYGRAPH 60852 . 68234) (INTERSECT/REGIONP/LBWH 68236
|
||||||
. 68218) (INVERTED/GRAPHNODE/BORDER 68220 . 68804) (INVERTED/SHADE/FOR/GRAPHER 68806 . 69438) (
|
. 69512) (INVERTED/GRAPHNODE/BORDER 69514 . 70098) (INVERTED/SHADE/FOR/GRAPHER 70100 . 70732) (
|
||||||
LAYOUT/POSITION 69440 . 69619) (LINKPARAMETERS 69621 . 70073) (MAX/RIGHT 70075 . 70277) (MAX/TOP 70279
|
LAYOUT/POSITION 70734 . 70913) (LINKPARAMETERS 70915 . 71367) (MAX/RIGHT 71369 . 71571) (MAX/TOP 71573
|
||||||
. 70477) (MEASUREGRAPHNODE 70479 . 70928) (MEMBTONODES 70930 . 71455) (MIN/BOTTOM 71457 . 71838) (
|
. 71771) (MEASUREGRAPHNODE 71773 . 72222) (MEMBTONODES 72224 . 72749) (MIN/BOTTOM 72751 . 73132) (
|
||||||
MIN/LEFT 71840 . 72215) (MOVENODE 72217 . 73460) (NODECREATE 73462 . 74242) (NODELST/AS/MENU 74244 .
|
MIN/LEFT 73134 . 73509) (MOVENODE 73511 . 74754) (NODECREATE 74756 . 75536) (NODELST/AS/MENU 75538 .
|
||||||
75844) (NODEREGION 75846 . 76306) (PRINTDISPLAYNODE 76308 . 81366) (PROMPTINWINDOW 81368 . 84177) (
|
77138) (NODEREGION 77140 . 77600) (PRINTDISPLAYNODE 77602 . 82660) (PROMPTINWINDOW 82662 . 85471) (
|
||||||
READ/NODE 84179 . 85293) (REDISPLAYGRAPH 85295 . 85737) (REMOVETONODES 85739 . 86260) (
|
READ/NODE 85473 . 86587) (REDISPLAYGRAPH 86589 . 87031) (REMOVETONODES 87033 . 87554) (
|
||||||
RESET/NODE/BORDER 86262 . 88049) (RESET/NODE/LABELSHADE 88051 . 89566) (SCALE/GRAPH 89568 . 95854) (
|
RESET/NODE/BORDER 87556 . 89343) (RESET/NODE/LABELSHADE 89345 . 90860) (SCALE/GRAPH 90862 . 97148) (
|
||||||
SCALE/GRAPHNODE/BORDER 95856 . 96551) (SCALE/TONODES 96553 . 97434) (SET/LABEL/SIZE 97436 . 100382) (
|
SCALE/GRAPHNODE/BORDER 97150 . 97845) (SCALE/TONODES 97847 . 98728) (SET/LABEL/SIZE 98730 . 101676) (
|
||||||
SET/LAYOUT/POSITION 100384 . 100869) (SHOWGRAPH 100871 . 102670) (SIZE/GRAPH/WINDOW 102672 . 106156) (
|
SET/LAYOUT/POSITION 101678 . 102163) (SHOWGRAPH 102165 . 103964) (SIZE/GRAPH/WINDOW 103966 . 107450) (
|
||||||
TOGGLE/DIRECTEDFLG 106158 . 106788) (TOGGLE/SIDESFLG 106790 . 107278) (TOLINKS 107280 . 107446) (
|
TOGGLE/DIRECTEDFLG 107452 . 108082) (TOGGLE/SIDESFLG 108084 . 108572) (TOLINKS 108574 . 108740) (
|
||||||
TRACKCURSOR 107448 . 108855) (TRACKNODE 108857 . 109493) (TRANSGRAPH 109495 . 111242)) (111485 128102
|
TRACKCURSOR 108742 . 110149) (TRACKNODE 110151 . 110787) (TRANSGRAPH 110789 . 112536)) (112779 129396
|
||||||
(EDITMOVEREGION 111495 . 115298) (EDITMOVESUBTREE 115300 . 117077) (NOT.TRACKCURSOR 117079 . 120057) (
|
(EDITMOVEREGION 112789 . 116592) (EDITMOVESUBTREE 116594 . 118371) (NOT.TRACKCURSOR 118373 . 121351) (
|
||||||
RECURSIVE.COLLECTDESCENDENTS 120059 . 121547) (MOVEDESCENDENTS 121549 . 123611) (COLLECT.CHILD.NODES
|
RECURSIVE.COLLECTDESCENDENTS 121353 . 122841) (MOVEDESCENDENTS 122843 . 124905) (COLLECT.CHILD.NODES
|
||||||
123613 . 124729) (CREATE.NEW.NODEPOSITION 124731 . 125271) (GETBOXPOSITION.FROMINITIALREGION 125273 .
|
124907 . 126023) (CREATE.NEW.NODEPOSITION 126025 . 126565) (GETBOXPOSITION.FROMINITIALREGION 126567 .
|
||||||
126745) (COLLECTDESCENDENTS 126747 . 128100)) (128166 130455 (NEXTSIZEFONT 128176 . 129366) (
|
128039) (COLLECTDESCENDENTS 128041 . 129394)) (129460 131749 (NEXTSIZEFONT 129470 . 130660) (
|
||||||
DECREASING.FONT.LIST 129368 . 129694) (SCALE.FONT 129696 . 130453)) (130679 169831 (BRH/LAYOUT 130689
|
DECREASING.FONT.LIST 130662 . 130988) (SCALE.FONT 130990 . 131747)) (131973 171125 (BRH/LAYOUT 131983
|
||||||
. 132433) (BRH/LAYOUT/DAUGHTERS 132435 . 133381) (BRH/OFFSET 133383 . 134061) (BRHC/INTERTREE/SPACE
|
. 133727) (BRH/LAYOUT/DAUGHTERS 133729 . 134675) (BRH/OFFSET 134677 . 135355) (BRHC/INTERTREE/SPACE
|
||||||
134063 . 135381) (BRHC/LAYOUT 135383 . 137239) (BRHC/LAYOUT/DAUGHTERS 137241 . 140195) (
|
135357 . 136675) (BRHC/LAYOUT 136677 . 138533) (BRHC/LAYOUT/DAUGHTERS 138535 . 141489) (
|
||||||
BRHC/LAYOUT/TERMINAL 140197 . 140878) (BRHC/OFFSET 140880 . 141776) (BRHL/LAYOUT 141778 . 144002) (
|
BRHC/LAYOUT/TERMINAL 141491 . 142172) (BRHC/OFFSET 142174 . 143070) (BRHL/LAYOUT 143072 . 145296) (
|
||||||
BRHL/LAYOUT/DAUGHTERS 144004 . 145762) (BRHL/MOVE/RIGHT 145764 . 146907) (BROWSE/LAYOUT/HORIZ 146909
|
BRHL/LAYOUT/DAUGHTERS 145298 . 147056) (BRHL/MOVE/RIGHT 147058 . 148201) (BROWSE/LAYOUT/HORIZ 148203
|
||||||
. 147633) (BROWSE/LAYOUT/HORIZ/COMPACTLY 147635 . 150441) (BROWSE/LAYOUT/LATTICE 150443 . 151299) (
|
. 148927) (BROWSE/LAYOUT/HORIZ/COMPACTLY 148929 . 151735) (BROWSE/LAYOUT/LATTICE 151737 . 152593) (
|
||||||
BRV/OFFSET 151301 . 152164) (EXTEND/TRANSITION/CHAIN 152166 . 153437) (FOREST/BREAK/CYCLES 153439 .
|
BRV/OFFSET 152595 . 153458) (EXTEND/TRANSITION/CHAIN 153460 . 154731) (FOREST/BREAK/CYCLES 154733 .
|
||||||
154369) (INIT/NODES/FOR/LAYOUT 154371 . 155866) (INTERPRET/MARK/FORMAT 155868 . 157135) (
|
155663) (INIT/NODES/FOR/LAYOUT 155665 . 157160) (INTERPRET/MARK/FORMAT 157162 . 158429) (
|
||||||
LATTICE/BREAK/CYCLES 157137 . 157841) (LAYOUTFOREST 157843 . 158544) (LAYOUTGRAPH 158546 . 162013) (
|
LATTICE/BREAK/CYCLES 158431 . 159135) (LAYOUTFOREST 159137 . 159838) (LAYOUTGRAPH 159840 . 163307) (
|
||||||
LAYOUTLATTICE 162015 . 163468) (LAYOUTSEXPR 163470 . 164541) (LAYOUTSEXPR1 164543 . 165245) (
|
LAYOUTLATTICE 163309 . 164762) (LAYOUTSEXPR 164764 . 165835) (LAYOUTSEXPR1 165837 . 166539) (
|
||||||
MARK/GRAPH/NODE 165247 . 165977) (NEW/INSTANCE/OF/GRAPHNODE 165979 . 167348) (RAISE/TRANSITION/CHAIN
|
MARK/GRAPH/NODE 166541 . 167271) (NEW/INSTANCE/OF/GRAPHNODE 167273 . 168642) (RAISE/TRANSITION/CHAIN
|
||||||
167350 . 167751) (REFLECT/GRAPH/DIAGONALLY 167753 . 168482) (REFLECT/GRAPH/HORIZONTALLY 168484 .
|
168644 . 169045) (REFLECT/GRAPH/DIAGONALLY 169047 . 169776) (REFLECT/GRAPH/HORIZONTALLY 169778 .
|
||||||
169010) (REFLECT/GRAPH/VERTICALLY 169012 . 169536) (SWITCH/NODE/HEIGHT/WIDTH 169538 . 169829)) (173177
|
170304) (REFLECT/GRAPH/VERTICALLY 170306 . 170830) (SWITCH/NODE/HEIGHT/WIDTH 170832 . 171123)) (174438
|
||||||
174528 (GRAPHERIMAGEFNS 173187 . 174526)) (174529 176257 (GRAPHERCOPYBUTTONEVENTFN 174539 . 175518) (
|
175789 (GRAPHERIMAGEFNS 174448 . 175787)) (175790 177518 (GRAPHERCOPYBUTTONEVENTFN 175800 . 176779) (
|
||||||
GRAPHOBJ.FINDGRAPH 175520 . 176255)) (176258 178878 (ALIGNMENTNODE 176268 . 177690) (
|
GRAPHOBJ.FINDGRAPH 176781 . 177516)) (177519 180139 (ALIGNMENTNODE 177529 . 178951) (
|
||||||
GRAPHOBJ.CHECKALIGN 177692 . 178876)) (178879 194729 (GRAPHEROBJ 178889 . 180635) (
|
GRAPHOBJ.CHECKALIGN 178953 . 180137)) (180140 195990 (GRAPHEROBJ 180150 . 181896) (
|
||||||
GRAPHOBJ.BUTTONEVENTINFN 180637 . 182064) (GRAPHOBJ.COPYBUTTONEVENTFN 182066 . 182503) (
|
GRAPHOBJ.BUTTONEVENTINFN 181898 . 183325) (GRAPHOBJ.COPYBUTTONEVENTFN 183327 . 183764) (
|
||||||
GRAPHOBJ.COPYFN 182505 . 183429) (GRAPHOBJ.DISPLAYFN 183431 . 186246) (GRAPHOBJ.GETALIGN 186248 .
|
GRAPHOBJ.COPYFN 183766 . 184690) (GRAPHOBJ.DISPLAYFN 184692 . 187507) (GRAPHOBJ.GETALIGN 187509 .
|
||||||
186987) (GRAPHOBJ.GETFN 186989 . 188494) (GRAPHOBJ.IMAGEBOXFN 188496 . 192512) (GRAPHOBJ.PUTALIGN
|
188248) (GRAPHOBJ.GETFN 188250 . 189755) (GRAPHOBJ.IMAGEBOXFN 189757 . 193773) (GRAPHOBJ.PUTALIGN
|
||||||
192514 . 193344) (GRAPHOBJ.PUTFN 193346 . 194727)) (194730 213882 (COPYGRAPH 194740 . 196288) (
|
193775 . 194605) (GRAPHOBJ.PUTFN 194607 . 195988)) (195991 215143 (COPYGRAPH 196001 . 197549) (
|
||||||
DUMPGRAPH 196290 . 206546) (READGRAPH 206548 . 213880)))))
|
DUMPGRAPH 197551 . 207807) (READGRAPH 207809 . 215141)))))
|
||||||
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-Feb-2026 19:27:31" {DSK}<Users>larry>il>MEDLEY>LIBRARY>MASTERSCOPE.;3 197425
|
(FILECREATED "16-Feb-2026 13:34:31" {WMEDLEY}<library>MASTERSCOPE.;41 197959
|
||||||
|
|
||||||
:EDIT-BY "lmm"
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS BUILDGETRELQ)
|
:CHANGES-TO (FNS MSOUTPUT)
|
||||||
|
|
||||||
:PREVIOUS-DATE " 8-Feb-2026 18:47:30" {DSK}<Users>larry>il>MEDLEY>LIBRARY>MASTERSCOPE.;2)
|
:PREVIOUS-DATE " 8-Feb-2026 22:38:50" {WMEDLEY}<library>MASTERSCOPE.;40)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT MASTERSCOPECOMS)
|
(PRETTYCOMPRINT MASTERSCOPECOMS)
|
||||||
@@ -2566,7 +2566,7 @@
|
|||||||
(* ; "interactive routines")
|
(* ; "interactive routines")
|
||||||
|
|
||||||
|
|
||||||
(RPAQ MASTERSCOPEDATE " 8-Feb-2026")
|
(RPAQ MASTERSCOPEDATE "16-Feb-2026")
|
||||||
|
|
||||||
(ADDTOVAR HISTORYCOMS %.)
|
(ADDTOVAR HISTORYCOMS %.)
|
||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
@@ -3498,13 +3498,17 @@
|
|||||||
(ERROR!])
|
(ERROR!])
|
||||||
|
|
||||||
(MSOUTPUT
|
(MSOUTPUT
|
||||||
[LAMBDA (FILE) (* ; "Edited 5-Apr-2025 11:48 by rmk")
|
[LAMBDA (FILE) (* ; "Edited 16-Feb-2026 13:34 by rmk")
|
||||||
|
(* ; "Edited 5-Feb-2026 01:01 by rmk")
|
||||||
|
(* ; "Edited 18-Nov-2025 14:01 by rmk")
|
||||||
|
(* ; "Edited 8-Nov-2025 23:21 by rmk")
|
||||||
|
(* ; "Edited 5-Apr-2025 11:48 by rmk")
|
||||||
(* ; "Edited 14-Jul-2024 08:41 by rmk")
|
(* ; "Edited 14-Jul-2024 08:41 by rmk")
|
||||||
(* ; "Edited 5-Jul-2024 11:54 by rmk")
|
(* ; "Edited 5-Jul-2024 11:54 by rmk")
|
||||||
(* ; "Edited 12-Jun-90 20:43 by teruuchi")
|
(* ; "Edited 12-Jun-90 20:43 by teruuchi")
|
||||||
(LET ((LLENGTH FILELINELENGTH))
|
(LET ((LLENGTH FILELINELENGTH))
|
||||||
[COND
|
[COND
|
||||||
((AND (LITATOM FILE)
|
[(AND (LITATOM FILE)
|
||||||
(MEMB (U-CASE FILE)
|
(MEMB (U-CASE FILE)
|
||||||
'(TEDIT :TEDIT))
|
'(TEDIT :TEDIT))
|
||||||
(GETD (FUNCTION TEDIT)))
|
(GETD (FUNCTION TEDIT)))
|
||||||
@@ -3512,12 +3516,14 @@
|
|||||||
(* ;;
|
(* ;;
|
||||||
"If no TEDIT, leave the current OUTPUT. The readtable for seprs etc is the current readtable.")
|
"If no TEDIT, leave the current OUTPUT. The readtable for seprs etc is the current readtable.")
|
||||||
|
|
||||||
[SETQ FILE (TEXTSTREAM (TEDIT NIL 'Masterscope NIL `(LEAVETTY T TITLE Masterscope FONT
|
[SETQ FILE (OPENTEXTSTREAM NIL NIL `(FONT ,DEFAULTFONT BOUNDTABLE ,(
|
||||||
,DEFAULTFONT BOUNDTABLE
|
TEDIT.ATOMBOUND.READTABLE
|
||||||
,(TEDIT.ATOMBOUND.READTABLE]
|
]
|
||||||
(SETQ LLENGTH T)
|
(SETQ LLENGTH T)
|
||||||
(TEDIT.DEFER.UPDATES FILE '(READONLY QUIET))
|
(RESETSAVE NIL `(PROGN (CL:UNLESS RESETSTATE
|
||||||
(RESETSAVE NIL (LIST 'CLOSEF FILE)))
|
(TEDIT ,FILE 'Masterscope NIL
|
||||||
|
'(TITLE Masterscope READONLY QUIET LEAVETTY T)))
|
||||||
|
(CLOSEF? ,FILE]
|
||||||
((OPENP FILE 'OUTPUT))
|
((OPENP FILE 'OUTPUT))
|
||||||
(T (SETQ FILE (OPENSTREAM FILE 'OUTPUT))
|
(T (SETQ FILE (OPENSTREAM FILE 'OUTPUT))
|
||||||
(RESETSAVE NIL (LIST 'CLOSEF FILE]
|
(RESETSAVE NIL (LIST 'CLOSEF FILE]
|
||||||
@@ -3724,36 +3730,36 @@
|
|||||||
(ADDTOVAR LAMA MSEDITE MSEDITF)
|
(ADDTOVAR LAMA MSEDITE MSEDITF)
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (3300 19547 (UPDATEFN 3310 . 4927) (MSGETDEF 4929 . 6335) (MSNOTICEFILE 6337 . 8730) (
|
(FILEMAP (NIL (3260 19507 (UPDATEFN 3270 . 4887) (MSGETDEF 4889 . 6295) (MSNOTICEFILE 6297 . 8690) (
|
||||||
MSSHOWUSE 8732 . 14713) (MSUPDATEFN1 14715 . 15403) (MSUPDATE 15405 . 17831) (MSNLAMBDACHECK 17833 .
|
MSSHOWUSE 8692 . 14673) (MSUPDATEFN1 14675 . 15363) (MSUPDATE 15365 . 17791) (MSNLAMBDACHECK 17793 .
|
||||||
18715) (MSCOLLECTDATA 18717 . 19545)) (19548 20447 (UPDATECHANGED 19558 . 19921) (UPDATECHANGED1 19923
|
18675) (MSCOLLECTDATA 18677 . 19505)) (19508 20407 (UPDATECHANGED 19518 . 19881) (UPDATECHANGED1 19883
|
||||||
. 20445)) (21021 21444 (MSCLOSEFILES 21031 . 21442)) (22125 26557 (MSDESCRIBE 22135 . 24923) (
|
. 20405)) (20981 21404 (MSCLOSEFILES 20991 . 21402)) (22085 26517 (MSDESCRIBE 22095 . 24883) (
|
||||||
MSDESCRIBE1 24925 . 25988) (FMAPRINT 25990 . 26555)) (26650 27090 (MSPRINTHELPFILE 26660 . 27088)) (
|
MSDESCRIBE1 24885 . 25948) (FMAPRINT 25950 . 26515)) (26610 27050 (MSPRINTHELPFILE 26620 . 27048)) (
|
||||||
27140 30278 (TEMPLATE 27150 . 28571) (GETTEMPLATE 28573 . 28708) (SETTEMPLATE 28710 . 30276)) (31148
|
27100 30238 (TEMPLATE 27110 . 28531) (GETTEMPLATE 28533 . 28668) (SETTEMPLATE 28670 . 30236)) (31108
|
||||||
36072 (ADDTEMPLATEWORD 31158 . 31830) (MSADDANALYZE 31832 . 33330) (MSADDMODIFIER 33332 . 34413) (
|
36032 (ADDTEMPLATEWORD 31118 . 31790) (MSADDANALYZE 31792 . 33290) (MSADDMODIFIER 33292 . 34373) (
|
||||||
MSADDRELATION 34415 . 35162) (MSADDTYPE 35164 . 36070)) (37573 42669 (MSMARKCHANGE1 37583 . 38377) (
|
MSADDRELATION 34375 . 35122) (MSADDTYPE 35124 . 36030)) (37533 42629 (MSMARKCHANGE1 37543 . 38337) (
|
||||||
MSINIT 38379 . 39560) (GETVERBTABLES 39562 . 40115) (MSSTOREDATA 40117 . 41671) (STORETABLE 41673 .
|
MSINIT 38339 . 39520) (GETVERBTABLES 39522 . 40075) (MSSTOREDATA 40077 . 41631) (STORETABLE 41633 .
|
||||||
42667)) (44071 49141 (PARSERELATION 44081 . 44681) (PARSERELATION1 44683 . 46138) (GETRELATION 46140
|
42627)) (44031 49101 (PARSERELATION 44041 . 44641) (PARSERELATION1 44643 . 46098) (GETRELATION 46100
|
||||||
. 47169) (MAPRELATION 47171 . 48305) (TESTRELATION 48307 . 49139)) (49142 50782 (ADDHASH 49152 .
|
. 47129) (MAPRELATION 47131 . 48265) (TESTRELATION 48267 . 49099)) (49102 50742 (ADDHASH 49112 .
|
||||||
49630) (SUBHASH 49632 . 49860) (MAKEHASH 49862 . 50006) (MSREHASH 50008 . 50461) (EQMEMBHASH 50463 .
|
49590) (SUBHASH 49592 . 49820) (MAKEHASH 49822 . 49966) (MSREHASH 49968 . 50421) (EQMEMBHASH 50423 .
|
||||||
50780)) (51121 57437 (MSVBTABLES 51131 . 57011) (MSUSERVBTABLES 57013 . 57435)) (57520 59823 (
|
50740)) (51081 57397 (MSVBTABLES 51091 . 56971) (MSUSERVBTABLES 56973 . 57395)) (57480 59783 (
|
||||||
BUILDGETRELQ 57530 . 58728) (BUILDTESTRELQ 58730 . 59821)) (59994 60382 (MSERASE 60004 . 60380)) (
|
BUILDGETRELQ 57490 . 58688) (BUILDTESTRELQ 58690 . 59781)) (59954 60342 (MSERASE 59964 . 60340)) (
|
||||||
60383 64843 (DUMPDATABASE 60393 . 62958) (DUMPDATABASE1 62960 . 63305) (READATABASE 63307 . 64841)) (
|
60343 64803 (DUMPDATABASE 60353 . 62918) (DUMPDATABASE1 62920 . 63265) (READATABASE 63267 . 64801)) (
|
||||||
65925 94984 (MSCHECKBLOCKS 65935 . 69755) (MSCHECKBLOCK 69757 . 78377) (MSCHECKFNINBLOCK 78379 . 81379
|
65885 94944 (MSCHECKBLOCKS 65895 . 69715) (MSCHECKBLOCK 69717 . 78337) (MSCHECKFNINBLOCK 78339 . 81339
|
||||||
) (MSCHECKBLOCKBASIC 81381 . 83801) (MSCHECKBOUNDFREE 83803 . 85702) (GLOBALVARP 85704 . 85871) (
|
) (MSCHECKBLOCKBASIC 81341 . 83761) (MSCHECKBOUNDFREE 83763 . 85662) (GLOBALVARP 85664 . 85831) (
|
||||||
PRINTERROR 85873 . 89089) (MSCHECKVARS1 89091 . 92044) (UNECCSPEC 92046 . 92324) (NECCSPEC 92326 .
|
PRINTERROR 85833 . 89049) (MSCHECKVARS1 89051 . 92004) (UNECCSPEC 92006 . 92284) (NECCSPEC 92286 .
|
||||||
92673) (SPECVARP 92675 . 93202) (SHORTLST 93204 . 93660) (DOERROR 93662 . 94372) (MSMSGPRINT 94374 .
|
92633) (SPECVARP 92635 . 93162) (SHORTLST 93164 . 93620) (DOERROR 93622 . 94332) (MSMSGPRINT 94334 .
|
||||||
94982)) (96128 110956 (MSPATHS 96138 . 99540) (MSPATHS1 99542 . 103777) (MSPATHS2 103779 . 107189) (
|
94942)) (96088 110916 (MSPATHS 96098 . 99500) (MSPATHS1 99502 . 103737) (MSPATHS2 103739 . 107149) (
|
||||||
MSONPATH 107191 . 108419) (MSPATHS4 108421 . 109503) (DASHES 109505 . 110031) (DOTABS 110033 . 110274)
|
MSONPATH 107151 . 108379) (MSPATHS4 108381 . 109463) (DASHES 109465 . 109991) (DOTABS 109993 . 110234)
|
||||||
(BELOWMARKER 110276 . 110739) (MSPATHSPRINTFN 110741 . 110954)) (111342 114766 (MSFIND 111352 .
|
(BELOWMARKER 110236 . 110699) (MSPATHSPRINTFN 110701 . 110914)) (111302 114726 (MSFIND 111312 .
|
||||||
111627) (MSEDITF 111629 . 112629) (MSEDITE 112631 . 113668) (EDITGETDEF 113670 . 114764)) (115708
|
111587) (MSEDITF 111589 . 112589) (MSEDITE 112591 . 113628) (EDITGETDEF 113630 . 114724)) (115668
|
||||||
124309 (MSMARKCHANGED 115718 . 117442) (CHANGEMACRO 117444 . 118149) (CHANGEVAR 118151 . 118467) (
|
124269 (MSMARKCHANGED 115678 . 117402) (CHANGEMACRO 117404 . 118109) (CHANGEVAR 118111 . 118427) (
|
||||||
CHANGEI.S. 118469 . 119802) (CHANGERECORD 119804 . 120675) (MSNEEDUNSAVE 120677 . 121669) (UNSAVEFNS
|
CHANGEI.S. 118429 . 119762) (CHANGERECORD 119764 . 120635) (MSNEEDUNSAVE 120637 . 121629) (UNSAVEFNS
|
||||||
121671 . 124307)) (124742 128352 (%. 124752 . 124892) (MASTERSCOPE 124894 . 125420) (MASTERSCOPE1
|
121631 . 124267)) (124702 128312 (%. 124712 . 124852) (MASTERSCOPE 124854 . 125380) (MASTERSCOPE1
|
||||||
125422 . 126290) (MASTERSCOPEXEC 126292 . 128350)) (128391 168041 (MSINTERPRETSET 128401 . 156935) (
|
125382 . 126250) (MASTERSCOPEXEC 126252 . 128310)) (128351 168001 (MSINTERPRETSET 128361 . 156895) (
|
||||||
MSINTERPA 156937 . 157471) (MSGETBLOCKDEC 157473 . 159986) (LISTHARD 159988 . 161206) (MSMEMBSET
|
MSINTERPA 156897 . 157431) (MSGETBLOCKDEC 157433 . 159946) (LISTHARD 159948 . 161166) (MSMEMBSET
|
||||||
161208 . 161353) (MSLISTSET 161355 . 161720) (MSHASHLIST 161722 . 161889) (MSHASHLIST1 161891 . 162217
|
161168 . 161313) (MSLISTSET 161315 . 161680) (MSHASHLIST 161682 . 161849) (MSHASHLIST1 161851 . 162177
|
||||||
) (CHECKPATHS 162219 . 162859) (ONFILE 162861 . 168039)) (168042 191603 (MSINTERPRET 168052 . 184107)
|
) (CHECKPATHS 162179 . 162819) (ONFILE 162821 . 167999)) (168002 192137 (MSINTERPRET 168012 . 184067)
|
||||||
(VERBNOTICELIST 184109 . 185219) (MSOUTPUT 185221 . 186731) (MSCHECKEMPTY 186733 . 187937) (
|
(VERBNOTICELIST 184069 . 185179) (MSOUTPUT 185181 . 187265) (MSCHECKEMPTY 187267 . 188471) (
|
||||||
CHECKFORCHANGED 187939 . 188459) (MSSOLVE 188461 . 191601)))))
|
CHECKFORCHANGED 188473 . 188993) (MSSOLVE 188995 . 192135)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
@@ -1,13 +1,13 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "27-Jan-2026 17:57:49" {DSK}<home>matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;4 258423
|
(FILECREATED "12-Feb-2026 12:19:03" {DSK}<home>matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;6 258522
|
||||||
|
|
||||||
:EDIT-BY "mth"
|
:EDIT-BY "mth"
|
||||||
|
|
||||||
:CHANGES-TO (FNS POSTSCRIPT.STARTPAGE)
|
:CHANGES-TO (FNS PSCFONT.READFONT)
|
||||||
|
|
||||||
:PREVIOUS-DATE "27-Jan-2026 13:15:17"
|
:PREVIOUS-DATE "27-Jan-2026 17:57:49"
|
||||||
{DSK}<home>matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;3)
|
{DSK}<home>matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;5)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS)
|
(PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS)
|
||||||
@@ -574,22 +574,24 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(PSCFONT.READFONT
|
(PSCFONT.READFONT
|
||||||
[LAMBDA (FONTFILENAME) (* ; "Edited 5-Oct-93 17:19 by rmk:")
|
[LAMBDA (FONTFILENAME) (* ; "Edited 12-Feb-2026 12:01 by mth")
|
||||||
(* ; "Edited 1-Sep-89 10:55 by jds")
|
(* ; "Edited 5-Oct-93 17:19 by rmk:")
|
||||||
|
(* ; "Edited 1-Sep-89 10:55 by jds")
|
||||||
|
|
||||||
(* ;; "Read one of Matt Heffron's .PSC files, to get postscript font metrics. First check to see if incore cache as information indexed under the file's name.")
|
(* ;; "Read one of Matt Heffron's .PSC files, to get postscript font metrics. First check to see if incore cache has information indexed under the file's name.")
|
||||||
|
|
||||||
(LET (FID W [S (OPENSTREAM FONTFILENAME 'INPUT NIL '((SEQUENTIAL T]
|
(LET (FID W [S (OPENSTREAM FONTFILENAME 'INPUT NIL '((SEQUENTIAL T]
|
||||||
(PF (create PSCFONT)))
|
(PF (create PSCFONT))
|
||||||
|
(*PACKAGE* (CL:FIND-PACKAGE "INTERLISP")))
|
||||||
[replace (PSCFONT FID) of PF with (SETQ FID (READ S (FIND-READTABLE "INTERLISP"]
|
[replace (PSCFONT FID) of PF with (SETQ FID (READ S (FIND-READTABLE "INTERLISP"]
|
||||||
|
|
||||||
(* ;; "Read until we hit a 255 byte, marking the end of the font-id section.")
|
(* ;; "Read until we hit a 255 byte, marking the end of the font-id section.")
|
||||||
|
|
||||||
(CL:DO NIL
|
(CL:DO NIL
|
||||||
((EQ (BIN S)
|
((EQ (BIN S)
|
||||||
255))
|
255))
|
||||||
|
|
||||||
(* ;; "Body of the loop is empty, the test does all of the work")
|
(* ;; "Body of the loop is empty, the test does all of the work")
|
||||||
|
|
||||||
)
|
)
|
||||||
(replace (PSCFONT IL-FONTID) of PF with (CAR FID))
|
(replace (PSCFONT IL-FONTID) of PF with (CAR FID))
|
||||||
@@ -601,13 +603,12 @@
|
|||||||
(for C from 0 to 255 do (SETA W C (\WIN S)))
|
(for C from 0 to 255 do (SETA W C (\WIN S)))
|
||||||
(CLOSEF S)
|
(CLOSEF S)
|
||||||
|
|
||||||
(* ;;
|
(* ;;
|
||||||
"PATCH JDS 9/1/89: The afm font reader made fonts too tall. This should fix things pro tem.")
|
"PATCH JDS 9/1/89: The afm font reader made fonts too tall. This should fix things pro tem.")
|
||||||
|
|
||||||
(replace (PSCFONT ASCENT) of PF with (- 1000 (fetch (PSCFONT DESCENT)
|
(replace (PSCFONT ASCENT) of PF with (- 1000 (fetch (PSCFONT DESCENT) OF PF)))
|
||||||
OF PF)))
|
|
||||||
(PUSH POSTSCRIPTFONTCACHE (CONS (L-CASE (FILENAMEFIELD FONTFILENAME 'NAME))
|
(PUSH POSTSCRIPTFONTCACHE (CONS (L-CASE (FILENAMEFIELD FONTFILENAME 'NAME))
|
||||||
(CREATE PSCFONT USING PF)))
|
(CREATE PSCFONT USING PF)))
|
||||||
PF])
|
PF])
|
||||||
|
|
||||||
(PSCFONT.SPELLFILE
|
(PSCFONT.SPELLFILE
|
||||||
@@ -4392,37 +4393,37 @@
|
|||||||
(ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND)
|
(ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND)
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (22370 32689 (POSTSCRIPT.INIT 22380 . 29295) (POSTSCRIPT.PUTRGBCOLOR 29297 . 30319) (
|
(FILEMAP (NIL (22366 32685 (POSTSCRIPT.INIT 22376 . 29291) (POSTSCRIPT.PUTRGBCOLOR 29293 . 30315) (
|
||||||
\PSC.COLOR.TO.RGB 30321 . 32687)) (33675 69097 (PSCFONT.READFONT 33685 . 35593) (PSCFONT.SPELLFILE
|
\PSC.COLOR.TO.RGB 30317 . 32683)) (33671 69196 (PSCFONT.READFONT 33681 . 35692) (PSCFONT.SPELLFILE
|
||||||
35595 . 36408) (PSCFONT.COERCEFILE 36410 . 37982) (PSCFONTFROMCACHE.SPELLFILE 37984 . 38969) (
|
35694 . 36507) (PSCFONT.COERCEFILE 36509 . 38081) (PSCFONTFROMCACHE.SPELLFILE 38083 . 39068) (
|
||||||
PSCFONTFROMCACHE.COERCEFILE 38971 . 40623) (PSCFONT.WRITEFONT 40625 . 41640) (READ-AFM-FILE 41642 .
|
PSCFONTFROMCACHE.COERCEFILE 39070 . 40722) (PSCFONT.WRITEFONT 40724 . 41739) (READ-AFM-FILE 41741 .
|
||||||
47513) (CONVERT-AFM-FILES 47515 . 48727) (POSTSCRIPT.GETFONTID 48729 . 50124) (POSTSCRIPT.FONTCREATE
|
47612) (CONVERT-AFM-FILES 47614 . 48826) (POSTSCRIPT.GETFONTID 48828 . 50223) (POSTSCRIPT.FONTCREATE
|
||||||
50126 . 63020) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63022 . 65419) (POSTSCRIPT.FONTSAVAILABLE 65421
|
50225 . 63119) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63121 . 65518) (POSTSCRIPT.FONTSAVAILABLE 65520
|
||||||
. 67708) (POSTSCRIPT.FONTEXISTS? 67710 . 69095)) (69098 79007 (OPENPOSTSCRIPTSTREAM 69108 . 78673) (
|
. 67807) (POSTSCRIPT.FONTEXISTS? 67809 . 69194)) (69197 79106 (OPENPOSTSCRIPTSTREAM 69207 . 78772) (
|
||||||
CLOSEPOSTSCRIPTSTREAM 78675 . 79005)) (79052 85378 (POSTSCRIPT.HARDCOPYW 79062 . 82169) (
|
CLOSEPOSTSCRIPTSTREAM 78774 . 79104)) (79151 85477 (POSTSCRIPT.HARDCOPYW 79161 . 82268) (
|
||||||
POSTSCRIPT.TEDIT 82171 . 82623) (POSTSCRIPTFILEP 82625 . 84113) (MAKEEPSFILE 84115 . 85376)) (85379
|
POSTSCRIPT.TEDIT 82270 . 82722) (POSTSCRIPTFILEP 82724 . 84212) (MAKEEPSFILE 84214 . 85475)) (85478
|
||||||
129123 (POSTSCRIPT.BITMAPSCALE 85389 . 87845) (POSTSCRIPT.CLOSESTRING 87847 . 88400) (
|
129222 (POSTSCRIPT.BITMAPSCALE 85488 . 87944) (POSTSCRIPT.CLOSESTRING 87946 . 88499) (
|
||||||
POSTSCRIPT.ENDPAGE 88402 . 89293) (POSTSCRIPT.OUTSTR 89295 . 90512) (POSTSCRIPT.PUTBITMAPBYTES 90514
|
POSTSCRIPT.ENDPAGE 88501 . 89392) (POSTSCRIPT.OUTSTR 89394 . 90611) (POSTSCRIPT.PUTBITMAPBYTES 90613
|
||||||
. 98985) (POSTSCRIPT.PUTCOMMAND 98987 . 99976) (POSTSCRIPT.SET-FAKE-LANDSCAPE 99978 . 104498) (
|
. 99084) (POSTSCRIPT.PUTCOMMAND 99086 . 100075) (POSTSCRIPT.SET-FAKE-LANDSCAPE 100077 . 104597) (
|
||||||
POSTSCRIPT.SHOWACCUM 104500 . 106655) (POSTSCRIPT.STARTPAGE 106657 . 109359) (\POSTSCRIPTTAB 109361 .
|
POSTSCRIPT.SHOWACCUM 104599 . 106754) (POSTSCRIPT.STARTPAGE 106756 . 109458) (\POSTSCRIPTTAB 109460 .
|
||||||
110158) (\PS.BOUTFIXP 110160 . 111440) (\PS.SCALEHACK 111442 . 114085) (\PS.SCALEREGION 114087 .
|
110257) (\PS.BOUTFIXP 110259 . 111539) (\PS.SCALEHACK 111541 . 114184) (\PS.SCALEREGION 114186 .
|
||||||
114647) (\SCALEDBITBLT.PSC 114649 . 118959) (\SETPOS.PSC 118961 . 119442) (\SETXFORM.PSC 119444 .
|
114746) (\SCALEDBITBLT.PSC 114748 . 119058) (\SETPOS.PSC 119060 . 119541) (\SETXFORM.PSC 119543 .
|
||||||
122028) (\STRINGWIDTH.PSC 122030 . 122503) (\SWITCHFONTS.PSC 122505 . 127997) (\TERPRI.PSC 127999 .
|
122127) (\STRINGWIDTH.PSC 122129 . 122602) (\SWITCHFONTS.PSC 122604 . 128096) (\TERPRI.PSC 128098 .
|
||||||
129121)) (129158 183014 (\BITBLT.PSC 129168 . 129720) (\BLTSHADE.PSC 129722 . 134383) (\CHARWIDTH.PSC
|
129220)) (129257 183113 (\BITBLT.PSC 129267 . 129819) (\BLTSHADE.PSC 129821 . 134482) (\CHARWIDTH.PSC
|
||||||
134385 . 134892) (\CREATECHARSET.PSC 134894 . 136250) (\DRAWARC.PSC 136252 . 138630) (\DRAWCIRCLE.PSC
|
134484 . 134991) (\CREATECHARSET.PSC 134993 . 136349) (\DRAWARC.PSC 136351 . 138729) (\DRAWCIRCLE.PSC
|
||||||
138632 . 140883) (\DRAWCURVE.PSC 140885 . 144729) (\DRAWELLIPSE.PSC 144731 . 147095) (\DRAWLINE.PSC
|
138731 . 140982) (\DRAWCURVE.PSC 140984 . 144828) (\DRAWELLIPSE.PSC 144830 . 147194) (\DRAWLINE.PSC
|
||||||
147097 . 149837) (\DRAWPOINT.PSC 149839 . 150415) (\DRAWPOLYGON.PSC 150417 . 153546) (
|
147196 . 149936) (\DRAWPOINT.PSC 149938 . 150514) (\DRAWPOLYGON.PSC 150516 . 153645) (
|
||||||
\DSPBOTTOMMARGIN.PSC 153548 . 154235) (\DSPCLIPPINGREGION.PSC 154237 . 155612) (\DSPCOLOR.PSC 155614
|
\DSPBOTTOMMARGIN.PSC 153647 . 154334) (\DSPCLIPPINGREGION.PSC 154336 . 155711) (\DSPCOLOR.PSC 155713
|
||||||
. 156545) (\DSPFONT.PSC 156547 . 160184) (\DSPLEFTMARGIN.PSC 160186 . 160872) (\DSPLINEFEED.PSC
|
. 156644) (\DSPFONT.PSC 156646 . 160283) (\DSPLEFTMARGIN.PSC 160285 . 160971) (\DSPLINEFEED.PSC
|
||||||
160874 . 161464) (\DSPPUSHSTATE.PSC 161466 . 162926) (\DSPPOPSTATE.PSC 162928 . 166413) (\DSPRESET.PSC
|
160973 . 161563) (\DSPPUSHSTATE.PSC 161565 . 163025) (\DSPPOPSTATE.PSC 163027 . 166512) (\DSPRESET.PSC
|
||||||
166415 . 167080) (\DSPRIGHTMARGIN.PSC 167082 . 167771) (\DSPROTATE.PSC 167773 . 168772) (
|
166514 . 167179) (\DSPRIGHTMARGIN.PSC 167181 . 167870) (\DSPROTATE.PSC 167872 . 168871) (
|
||||||
\DSPSCALE.PSC 168774 . 169726) (\DSPSCALE2.PSC 169728 . 170568) (\DSPSPACEFACTOR.PSC 170570 . 171491)
|
\DSPSCALE.PSC 168873 . 169825) (\DSPSCALE2.PSC 169827 . 170667) (\DSPSPACEFACTOR.PSC 170669 . 171590)
|
||||||
(\DSPTOPMARGIN.PSC 171493 . 172064) (\DSPTRANSLATE.PSC 172066 . 174097) (\DSPXPOSITION.PSC 174099 .
|
(\DSPTOPMARGIN.PSC 171592 . 172163) (\DSPTRANSLATE.PSC 172165 . 174196) (\DSPXPOSITION.PSC 174198 .
|
||||||
174663) (\DSPYPOSITION.PSC 174665 . 175256) (\FILLCIRCLE.PSC 175258 . 177483) (\FILLPOLYGON.PSC 177485
|
174762) (\DSPYPOSITION.PSC 174764 . 175355) (\FILLCIRCLE.PSC 175357 . 177582) (\FILLPOLYGON.PSC 177584
|
||||||
. 180722) (\FIXLINELENGTH.PSC 180724 . 182043) (\MOVETO.PSC 182045 . 182815) (\NEWPAGE.PSC 182817 .
|
. 180821) (\FIXLINELENGTH.PSC 180823 . 182142) (\MOVETO.PSC 182144 . 182914) (\NEWPAGE.PSC 182916 .
|
||||||
183012)) (183070 205216 (\POSTSCRIPT.CHANGECHARSET 183080 . 183798) (\POSTSCRIPT.OUTCHARFN 183800 .
|
183111)) (183169 205315 (\POSTSCRIPT.CHANGECHARSET 183179 . 183897) (\POSTSCRIPT.OUTCHARFN 183899 .
|
||||||
196070) (\POSTSCRIPT.PRINTSLUG 196072 . 197796) (\POSTSCRIPT.SPECIALOUTCHARFN 197798 . 200149) (
|
196169) (\POSTSCRIPT.PRINTSLUG 196171 . 197895) (\POSTSCRIPT.SPECIALOUTCHARFN 197897 . 200248) (
|
||||||
\UPDATE.PSC 200151 . 201397) (\POSTSCRIPT.ACCENTFN 201399 . 202341) (\POSTSCRIPT.ACCENTPAIR 202343 .
|
\UPDATE.PSC 200250 . 201496) (\POSTSCRIPT.ACCENTFN 201498 . 202440) (\POSTSCRIPT.ACCENTPAIR 202442 .
|
||||||
205214)) (205314 206959 (\PSC.SPACEDISP 205324 . 205603) (\PSC.SPACEWID 205605 . 206224) (\PSC.SYMBOLS
|
205313)) (205413 207058 (\PSC.SPACEDISP 205423 . 205702) (\PSC.SPACEWID 205704 . 206323) (\PSC.SYMBOLS
|
||||||
206226 . 206957)) (207068 210059 (\POSTSCRIPT.NSHASH 207078 . 210057)))))
|
206325 . 207056)) (207167 210158 (\POSTSCRIPT.NSHASH 207177 . 210156)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
1503
library/UNICODE
1503
library/UNICODE
File diff suppressed because it is too large
Load Diff
@@ -1,19 +1,19 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
|
||||||
|
|
||||||
(FILECREATED "22-Oct-2025 23:28:42" {WMEDLEY}<library>UNICODE-TABLES.;4 34028
|
(FILECREATED "31-Mar-2026 09:01:05" {WMEDLEY}<library>UNICODE-TABLES.;22 44782
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (VARS UNICODE-TABLESCOMS)
|
:CHANGES-TO (VARS XCCS-CHARSETS)
|
||||||
|
|
||||||
:PREVIOUS-DATE "16-Oct-2025 16:47:54" {WMEDLEY}<library>UNICODE-TABLES.;3)
|
:PREVIOUS-DATE "22-Feb-2026 10:44:33" {WMEDLEY}<library>UNICODE-TABLES.;20)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT UNICODE-TABLESCOMS)
|
(PRETTYCOMPRINT UNICODE-TABLESCOMS)
|
||||||
|
|
||||||
(RPAQQ UNICODE-TABLESCOMS
|
(RPAQQ UNICODE-TABLESCOMS
|
||||||
[
|
[
|
||||||
(* ;; "Read Unicode mapping tables. A separate file before UNICODE in the loadup, because the tables must be loaded while UTF8TOMCODE and MCODETOUTF8 are still equivalenced to EVQ. This file has to come before UNICODE in the loadup sequence.")
|
(* ;; "This is code for reading/writing the XCCS-to-UNICODE mapping tables. It runs offline, when UNICODE-UTF8 is modified. ")
|
||||||
|
|
||||||
(COMS (* ; "Read Unicode mapping files")
|
(COMS (* ; "Read Unicode mapping files")
|
||||||
(INITVARS (UNICODEDIRECTORIES NIL))
|
(INITVARS (UNICODEDIRECTORIES NIL))
|
||||||
@@ -22,22 +22,32 @@
|
|||||||
(FNS READ-UNICODE-MAPPING-FILENAMES READ-UNICODE-MAPPING))
|
(FNS READ-UNICODE-MAPPING-FILENAMES READ-UNICODE-MAPPING))
|
||||||
(COMS (* ;
|
(COMS (* ;
|
||||||
"Make translation tables for UTF external formats")
|
"Make translation tables for UTF external formats")
|
||||||
(FNS MAKE-UNICODE-TRANSLATION-TABLES XCCSTOMCCS-MAPPING
|
(FNS MAKE-UNICODE-TRANSLATION-TABLES GET-MCCS-UNICODE-MAPPING INVERT-UNICODE-MAPPING
|
||||||
MERGE-UNICODE-TRANSLATION-TABLES UNICODE.UNMAPPED UNICODE-EXTEND-TRANSLATION?)
|
XCCSTOMCCS-MAPPING)
|
||||||
(FNS ALL-UNICODE-MAPPINGS XCCSJAPANESECHARSETS)
|
(FNS ALL-UNICODE-MAPPINGS XCCSJAPANESECHARSETS)
|
||||||
(INITVARS (*MCCSTOUNICODE*)
|
(COMS (* ; "Write Unicode mapping files")
|
||||||
(*UNICODETOMCCS*)
|
(FNS WRITE-UNICODE-MAPPING WRITE-UNICODE-INCLUDED WRITE-UNICODE-MAPPING-HEADER
|
||||||
(*MCCS-LOADED-CHARSETS*)
|
WRITE-UNICODE-MAPPING-FILENAME)
|
||||||
(*UNICODE-LOADED-CHARSETS*)
|
(FNS XCCS-UTF8-AFTER-OPEN)
|
||||||
(*LARGEUNICODES*))
|
|
||||||
[DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAKE-UNICODE-TRANSLATION-TABLES 'ALL]
|
(* ;; "Automate dumping of a documentation prefix")
|
||||||
|
|
||||||
|
[DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (MISSINGCODE (CL:PARSE-INTEGER "FFFE"
|
||||||
|
:RADIX 16))
|
||||||
|
(UNDEFINEDCODE (CL:PARSE-INTEGER "FFFF"
|
||||||
|
:RADIX 16]
|
||||||
|
(VARS UNICODE-MAPPING-HEADER))
|
||||||
|
(FNS UTF8HEXSTRING)
|
||||||
|
(COMS (* ; "debugging")
|
||||||
|
(FNS SHOWCHARS)
|
||||||
|
(DECLARE%: DOEVAL@LOAD DONTCOPY (MACROS HEXCHAR OCTALCHAR)))
|
||||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||||
UNICODE-EXPORTS])
|
UNICODE-EXPORTS])
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* ;;
|
(* ;;
|
||||||
"Read Unicode mapping tables. A separate file before UNICODE in the loadup, because the tables must be loaded while UTF8TOMCODE and MCODETOUTF8 are still equivalenced to EVQ. This file has to come before UNICODE in the loadup sequence."
|
"This is code for reading/writing the XCCS-to-UNICODE mapping tables. It runs offline, when UNICODE-UTF8 is modified. "
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
@@ -65,8 +75,9 @@
|
|||||||
(RUNIC-GOTHIC "51")
|
(RUNIC-GOTHIC "51")
|
||||||
(MORE-CYRILLIC "52")
|
(MORE-CYRILLIC "52")
|
||||||
(UNKNOWN1 "56")
|
(UNKNOWN1 "56")
|
||||||
|
(DECORATED-RULES "56")
|
||||||
(UNKNOWN2 "57")
|
(UNKNOWN2 "57")
|
||||||
(JIS "60-166")
|
(VERTICAL-JAPANESE "57")
|
||||||
(ARABIC "340")
|
(ARABIC "340")
|
||||||
(HEBREW "341")
|
(HEBREW "341")
|
||||||
(IPA "342")
|
(IPA "342")
|
||||||
@@ -88,13 +99,15 @@
|
|||||||
(ACCENTED-GREEK2 "364")
|
(ACCENTED-GREEK2 "364")
|
||||||
(MORE-ARABIC "365")
|
(MORE-ARABIC "365")
|
||||||
(GRAPHIC-VARIANTS "375")
|
(GRAPHIC-VARIANTS "375")
|
||||||
|
(JAPANESE HIRAGANA KATAKANA JIS)
|
||||||
(DEFAULT LATIN ACCENTED-LATIN1 EXTENDED-LATIN SYMBOLS1 SYMBOLS2 FORMS JAPANESE-SYMBOLS1
|
(DEFAULT LATIN ACCENTED-LATIN1 EXTENDED-LATIN SYMBOLS1 SYMBOLS2 FORMS JAPANESE-SYMBOLS1
|
||||||
JAPANESE-SYMBOLS2)
|
JAPANESE-SYMBOLS2)
|
||||||
(JAPANESE HIRAGANA KATAKANA JIS)))
|
(JIS "60-166")))
|
||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(READ-UNICODE-MAPPING-FILENAMES
|
(READ-UNICODE-MAPPING-FILENAMES
|
||||||
[LAMBDA (FILESPEC) (* ; "Edited 16-Oct-2025 16:43 by rmk")
|
[LAMBDA (FILESPEC) (* ; "Edited 21-Feb-2026 18:14 by rmk")
|
||||||
|
(* ; "Edited 16-Oct-2025 16:43 by rmk")
|
||||||
(* ; "Edited 4-Sep-2025 00:11 by rmk")
|
(* ; "Edited 4-Sep-2025 00:11 by rmk")
|
||||||
(* ; "Edited 27-Jan-2025 16:46 by rmk")
|
(* ; "Edited 27-Jan-2025 16:46 by rmk")
|
||||||
(* ; "Edited 21-Jan-2025 22:51 by rmk")
|
(* ; "Edited 21-Jan-2025 22:51 by rmk")
|
||||||
@@ -107,51 +120,47 @@
|
|||||||
|
|
||||||
(* ;; "FILESPEC can be a file name, character-set name, the name of a collection of character sets, an XCCS character code, or a list of those. Maps those into the names of files that contain the indicated Unicode mappings.")
|
(* ;; "FILESPEC can be a file name, character-set name, the name of a collection of character sets, an XCCS character code, or a list of those. Maps those into the names of files that contain the indicated Unicode mappings.")
|
||||||
|
|
||||||
(CL:REMOVE-DUPLICATES [for F X CSI inside (if (EQ FILESPEC 'ALL)
|
(for F X CSI inside (if (EQ FILESPEC 'ALL)
|
||||||
then
|
then
|
||||||
(* ;;
|
(* ;;
|
||||||
"Perhaps should figure out which files in the directories and subdirectories are relevant?")
|
"Perhaps should figure out which files in the directories and subdirectories are relevant?")
|
||||||
|
|
||||||
(for N in XCCS-CHARSETS
|
(for N in XCCS-CHARSETS collect (CAR N))
|
||||||
collect (CAR N))
|
else FILESPEC)
|
||||||
else FILESPEC)
|
join
|
||||||
join
|
(* ;; "Last case hopes to pick up all the tables that are grouped together in a subdirectory (e.g. if F is JIS)")
|
||||||
(* ;; "Last case hopes to pick up all the tables that are grouped together in a subdirectory (e.g. if F is JIS)")
|
|
||||||
|
|
||||||
(OR (CL:WHEN (CHARCODEP F) (* ;
|
[OR (CL:WHEN (CHARCODEP F) (* ;
|
||||||
"An XCCS code can retrieve its character set")
|
"An XCCS code can retrieve its character set")
|
||||||
(for D FN (FOCTAL _ (OCTALSTRING (LRSH F 8))) inside
|
(for D FN (FOCTAL ← (OCTALSTRING (LRSH F 8))) inside UNICODEDIRECTORIES
|
||||||
UNICODEDIRECTORIES
|
when (SETQ FN (DIRECTORY (PACKFILENAME 'DIRECTORY D 'BODY (CONCAT 'XCCS-
|
||||||
when (SETQ FN (FILDIR (PACKFILENAME 'DIRECTORY D
|
FOCTAL
|
||||||
'BODY
|
'=*)
|
||||||
(CONCAT 'XCCS- FOCTAL
|
'EXTENSION
|
||||||
'=*)
|
'TXT
|
||||||
'EXTENSION
|
'VERSION ""))) do (RETURN FN)))
|
||||||
'TXT
|
(MKLIST (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION 'TXT 'VERSION "")
|
||||||
'VERSION "")))
|
T UNICODEDIRECTORIES))
|
||||||
do (RETURN FN)))
|
(for D inside UNICODEDIRECTORIES
|
||||||
(MKLIST (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION 'TXT
|
when [SETQ $$VAL (OR (DIRECTORY (PACKFILENAME 'NAME (CONCAT "XCCS-*=" F)
|
||||||
'VERSION "")
|
'EXTENSION
|
||||||
T UNICODEDIRECTORIES))
|
'TXT
|
||||||
(for D inside UNICODEDIRECTORIES
|
'VERSION "" 'BODY D))
|
||||||
when [SETQ $$VAL (OR (FILDIR (PACKFILENAME 'NAME
|
(DIRECTORY (PACKFILENAME 'NAME (CONCAT "XCCS-" F "=*")
|
||||||
(CONCAT "XCCS-*=" F)
|
'EXTENSION
|
||||||
'EXTENSION
|
'TXT
|
||||||
'TXT
|
'VERSION "" 'BODY D]
|
||||||
'VERSION "" 'BODY D))
|
do (RETURN $$VAL))
|
||||||
(FILDIR (PACKFILENAME 'NAME
|
(AND (SETQ CSI (ASSOC F XCCS-CHARSETS))
|
||||||
(CONCAT "XCCS-" F "=*")
|
(READ-UNICODE-MAPPING-FILENAMES (CDR CSI)))
|
||||||
'EXTENSION
|
(for D inside UNICODEDIRECTORIES when (DIRECTORYNAMEP (SETQ D
|
||||||
'TXT
|
(CONCAT D ">" F ">")))
|
||||||
'VERSION "" 'BODY D]
|
join (DIRECTORY (CONCAT D ">*.TXT;"]
|
||||||
do (RETURN $$VAL))
|
finally (* ;
|
||||||
(AND (SETQ CSI (ASSOC F XCCS-CHARSETS))
|
"CL:REMOVE-DUPLICATES doesn't exist in MAKEINIT")
|
||||||
(READ-UNICODE-MAPPING-FILENAMES (CDR CSI)))
|
(RETURN (for FTAIL on $$VAL unless (thereis FF in (CDR FTAIL)
|
||||||
(for D inside UNICODEDIRECTORIES
|
suchthat (STRING-EQUAL (CAR FTAIL)
|
||||||
when (DIRECTORYNAMEP (SETQ D (CONCAT D ">" F ">")))
|
FF)) collect (CAR FTAIL])
|
||||||
join (FILDIR (CONCAT D ">*.TXT;"]
|
|
||||||
:TEST
|
|
||||||
(FUNCTION STRING.EQUAL])
|
|
||||||
|
|
||||||
(READ-UNICODE-MAPPING
|
(READ-UNICODE-MAPPING
|
||||||
[LAMBDA (FILESPEC PRINT NOERROR) (* ; "Edited 16-Oct-2025 11:25 by rmk")
|
[LAMBDA (FILESPEC PRINT NOERROR) (* ; "Edited 16-Oct-2025 11:25 by rmk")
|
||||||
@@ -179,7 +188,7 @@
|
|||||||
(* ;; "")
|
(* ;; "")
|
||||||
|
|
||||||
(RESETLST
|
(RESETLST
|
||||||
(for FILE STREAM [SEPBITTABLE _ (MAKEBITTABLE (CHARCODE (TAB SPACE] in (
|
(for FILE STREAM [SEPBITTABLE ← (MAKEBITTABLE (CHARCODE (TAB SPACE] in (
|
||||||
READ-UNICODE-MAPPING-FILENAMES
|
READ-UNICODE-MAPPING-FILENAMES
|
||||||
FILESPEC)
|
FILESPEC)
|
||||||
join
|
join
|
||||||
@@ -221,7 +230,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(MAKE-UNICODE-TRANSLATION-TABLES
|
(MAKE-UNICODE-TRANSLATION-TABLES
|
||||||
[LAMBDA (MAPPING REINSTALL) (* ; "Edited 11-Oct-2025 11:54 by rmk")
|
[LAMBDA (MAPPING REINSTALL) (* ; "Edited 21-Feb-2026 22:42 by rmk")
|
||||||
|
(* ; "Edited 11-Oct-2025 11:54 by rmk")
|
||||||
(* ; "Edited 4-Sep-2025 00:30 by rmk")
|
(* ; "Edited 4-Sep-2025 00:30 by rmk")
|
||||||
(* ; "Edited 24-Apr-2025 15:47 by rmk")
|
(* ; "Edited 24-Apr-2025 15:47 by rmk")
|
||||||
(* ; "Edited 31-Jan-2025 17:46 by rmk")
|
(* ; "Edited 31-Jan-2025 17:46 by rmk")
|
||||||
@@ -232,26 +242,13 @@
|
|||||||
(* ; "Edited 3-Feb-2024 00:24 by rmk")
|
(* ; "Edited 3-Feb-2024 00:24 by rmk")
|
||||||
(* ; "Edited 30-Jan-2024 09:54 by rmk")
|
(* ; "Edited 30-Jan-2024 09:54 by rmk")
|
||||||
(* ; "Edited 21-Aug-2021 13:12 by rmk:")
|
(* ; "Edited 21-Aug-2021 13:12 by rmk:")
|
||||||
|
(SETQ MAPPING (GET-MCCS-UNICODE-MAPPING MAPPING))
|
||||||
|
|
||||||
(* ;; "MAPPING is the list of numeric code correspondence pairs constructed by applying READ-UNICODE-MAPPING to XCCS-to-Unicode mapping files. This applies the XCCS-to-MCCS translations, and then updates or produces two recoding arrays, one maps left-side codes into right-side codes (e.g. MCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. MCCS).")
|
(* ;; "This updates or produces two recoding arrays, one maps left-side codes into right-side codes (e.g. MCCS to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. MCCS).")
|
||||||
(* ; "Edited 17-Aug-2020 08:46 by rmk:")
|
|
||||||
(CL:UNLESS [AND (LISTP MAPPING)
|
|
||||||
(FOR PAIR R IN MAPPING AS I TO 10
|
|
||||||
ALWAYS (AND (LISTP PAIR)
|
|
||||||
(CHARCODEP (CAR PAIR))
|
|
||||||
[FIXP (SETQ R (CAR (MKLIST (CADR PAIR]
|
|
||||||
(CHARCODEP (IABS R]
|
|
||||||
|
|
||||||
(* ;; "Seems like the argument is not already a list of mapping pairs (perhaps with a combiner), presumably a list of charsets to be read.")
|
|
||||||
|
|
||||||
(SETQ MAPPING (READ-UNICODE-MAPPING MAPPING)))
|
|
||||||
(SETQ MAPPING (XCCSTOMCCS-MAPPING MAPPING))
|
|
||||||
|
|
||||||
(* ;; "This updates or produces two recoding arrays, one maps left-side codes into right-side codes (e.g. XCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. XCCS).")
|
|
||||||
|
|
||||||
(* ;; "")
|
(* ;; "")
|
||||||
|
|
||||||
(* ;; "If REINSTALL is T, the new mapping vectors replace the current maps in the *XCCSTOUNICODE* and *UNICODETOXCCS* global variables. Otherwise we create new tables (mostly for comparison and debugging).")
|
(* ;; "If REINSTALL is T, the new mapping vectors replace the current maps in the *MCCSTOUNICODE* and *UNICODETOMCCS* global variables. Otherwise we create new tables (mostly for comparison and debugging).")
|
||||||
|
|
||||||
(* ;; "")
|
(* ;; "")
|
||||||
|
|
||||||
@@ -270,6 +267,55 @@
|
|||||||
(SETQ *NEXT-PRIVATE-UNICODE* FIRST-PRIVATE-UNICODE))
|
(SETQ *NEXT-PRIVATE-UNICODE* FIRST-PRIVATE-UNICODE))
|
||||||
(MERGE-UNICODE-TRANSLATION-TABLES NIL MAPPING])
|
(MERGE-UNICODE-TRANSLATION-TABLES NIL MAPPING])
|
||||||
|
|
||||||
|
(GET-MCCS-UNICODE-MAPPING
|
||||||
|
[LAMBDA (MAPPING) (* ; "Edited 22-Feb-2026 00:29 by rmk")
|
||||||
|
|
||||||
|
(* ;; "MAPPING is the list of numeric code correspondence pairs mapping MCCS-to-Unicode, or a specification of XCCS-to-Unicode files to be read and converted to MCCS-to-UNICODE.")
|
||||||
|
|
||||||
|
(SORT (if [AND (LISTP MAPPING)
|
||||||
|
(for PAIR R in MAPPING as I to 10
|
||||||
|
always (AND (LISTP PAIR)
|
||||||
|
(CHARCODEP (CAR PAIR))
|
||||||
|
[FIXP (SETQ R (CAR (MKLIST (CADR PAIR]
|
||||||
|
(CHARCODEP (IABS R]
|
||||||
|
then
|
||||||
|
(* ;; "The argument is already a list of MCCS-to-UNICODE mapping pairs")
|
||||||
|
|
||||||
|
MAPPING
|
||||||
|
else
|
||||||
|
(* ;; "Mapping files are is read as XCCS-UNICODE, make it MCCS")
|
||||||
|
|
||||||
|
(XCCSTOMCCS-MAPPING (READ-UNICODE-MAPPING MAPPING)))
|
||||||
|
T])
|
||||||
|
|
||||||
|
(INVERT-UNICODE-MAPPING
|
||||||
|
[LAMBDA (MAPPING) (* ; "Edited 22-Feb-2026 00:39 by rmk")
|
||||||
|
|
||||||
|
(* ;; "MAPPING is a list of pairs that map domain codes to range codes (presumably MCCS to UNICODE). This produces an inverted list of pairs that map the range into the domain (Unicode to MCCS) ")
|
||||||
|
|
||||||
|
(LET (INVERTED)
|
||||||
|
(SETQ INVERTED (SORT (for P D R OLDR in MAPPING eachtime (SETQ D (CAR P))
|
||||||
|
(SETQ R (CADR P))
|
||||||
|
|
||||||
|
(* ;;
|
||||||
|
"We don't do combiners, but we are allowing non-SMALLP's")
|
||||||
|
unless (OR (LISTP D)
|
||||||
|
(LISTP R)) collect (LIST R D))
|
||||||
|
T))
|
||||||
|
|
||||||
|
(* ;; "If MAPPING contains two pairs that map to the same U (e.g. (M1 U) and (M2 U)), we want the inverse table to collect them into a single pair (U M1 M2) instead of two pairs (U M1) (U M2), with the lowest M code first. Those pairs represent alternative inverse mappings. There are no duplicates/alternative table entries in the M-to-U direction.")
|
||||||
|
|
||||||
|
(* ;; "The SORT above means that multiple inverted pairs for the same U will be next to each other in the list.")
|
||||||
|
|
||||||
|
[for PTAIL PTAIL2 U MS on INVERTED eachtime (SETQ U (CAAR PTAIL))
|
||||||
|
when (SETQ MS (for old PTAIL2 P2 on PTAIL eachtime (SETQ P2 (CADR PTAIL2))
|
||||||
|
while (EQ U (CAR P2)) collect (CADR P2)))
|
||||||
|
do (RPLACD PTAIL (CDR PTAIL2))
|
||||||
|
(RPLACD (CAR PTAIL)
|
||||||
|
(SORT (CONS (CADR (CAR PTAIL))
|
||||||
|
MS]
|
||||||
|
INVERTED])
|
||||||
|
|
||||||
(XCCSTOMCCS-MAPPING
|
(XCCSTOMCCS-MAPPING
|
||||||
[LAMBDA (XTOUMAPPING) (* ; "Edited 11-Oct-2025 12:57 by rmk")
|
[LAMBDA (XTOUMAPPING) (* ; "Edited 11-Oct-2025 12:57 by rmk")
|
||||||
|
|
||||||
@@ -292,152 +338,12 @@
|
|||||||
XTOMCODES)))
|
XTOMCODES)))
|
||||||
finally (push XTOUMAPPING (CHARCODE (DEL DEL)))
|
finally (push XTOUMAPPING (CHARCODE (DEL DEL)))
|
||||||
(RETURN XTOUMAPPING])
|
(RETURN XTOUMAPPING])
|
||||||
|
|
||||||
(MERGE-UNICODE-TRANSLATION-TABLES
|
|
||||||
[LAMBDA (INVERSE MAPPING TABLE INVERSETABLE) (* ; "Edited 11-Oct-2025 10:24 by rmk")
|
|
||||||
(* ; "Edited 24-Apr-2025 15:28 by rmk")
|
|
||||||
(* ; "Edited 1-Feb-2025 21:42 by rmk")
|
|
||||||
(* ; "Edited 26-Jan-2025 12:58 by rmk")
|
|
||||||
(* ; "Edited 22-Jan-2025 08:20 by rmk")
|
|
||||||
(* ; "Edited 19-Jan-2025 15:58 by rmk")
|
|
||||||
(* ; "Edited 18-Jan-2025 11:49 by rmk")
|
|
||||||
(* ; "Edited 27-Mar-2024 12:10 by rmk")
|
|
||||||
(* ; "Edited 3-Feb-2024 12:46 by rmk")
|
|
||||||
(* ; "Edited 31-Jan-2024 10:06 by rmk")
|
|
||||||
|
|
||||||
(* ;; "MAPPINGS is a list of pairs that map domain codes to range codes. TABLE and INVERSETABLE default to *MCCSTOUNICODE* *UNICODETOMCCS* respectively. ")
|
|
||||||
|
|
||||||
(CL:UNLESS TABLE
|
|
||||||
[SETQ TABLE (OR *MCCSTOUNICODE* (SETQ *MCCSTOUNICODE* (HASHARRAY (LENGTH MAPPING])
|
|
||||||
(CL:UNLESS INVERSETABLE
|
|
||||||
[SETQ INVERSETABLE (OR *UNICODETOMCCS* (SETQ *UNICODETOMCCS* (HASHARRAY (LENGTH MAPPING])
|
|
||||||
(for M D R OLDR in MAPPING first (CL:IF INVERSE (swap TABLE INVERSETABLE))
|
|
||||||
eachtime (SETQ D (CAR M))
|
|
||||||
(SETQ R (CADR M))
|
|
||||||
|
|
||||||
(* ;; "We don't do combiners, but we are allowing non-SMALLP's")
|
|
||||||
unless (OR (LISTP D)
|
|
||||||
(LISTP R)) do
|
|
||||||
(* ;; "The (CONS R OLDR) deals with alternatives: (U X1) (U X2) => (U (X1 X2)), lowest code first. Those are only possible in the U-to-X direction when the tables contain (X1 U) and (X2 U). There are no duplicates/alternative table entries in the X-to-U direction.")
|
|
||||||
|
|
||||||
(SETQ OLDR (GETHASH D TABLE))
|
|
||||||
(CL:UNLESS (MEMB R OLDR)
|
|
||||||
(PUTHASH D (SORT (CONS R OLDR))
|
|
||||||
TABLE))
|
|
||||||
(swap D R)
|
|
||||||
(SETQ OLDR (GETHASH D INVERSETABLE))
|
|
||||||
(CL:UNLESS (MEMB R OLDR)
|
|
||||||
(PUTHASH D (SORT (CONS R OLDR))
|
|
||||||
INVERSETABLE)))
|
|
||||||
(LIST TABLE INVERSETABLE])
|
|
||||||
|
|
||||||
(UNICODE.UNMAPPED
|
|
||||||
[LAMBDA (CODE TABLE DONTFAKE) (* ; "Edited 24-Apr-2025 15:48 by rmk")
|
|
||||||
(* ; "Edited 22-Jan-2025 08:19 by rmk")
|
|
||||||
(* ; "Edited 19-Jan-2025 22:02 by rmk")
|
|
||||||
(* ; "Edited 18-Jan-2025 12:02 by rmk")
|
|
||||||
(* ; "Edited 2-Feb-2024 23:52 by rmk")
|
|
||||||
(* ; "Edited 31-Jan-2024 10:07 by rmk")
|
|
||||||
(* ; "Edited 11-Aug-2020 20:23 by rmk:")
|
|
||||||
|
|
||||||
(* ;; "This is the slow fall-out when UNICODE.TRANSLATE determines that CODE has no fast mapping in TRANSLATION-TABLE.")
|
|
||||||
|
|
||||||
(* ;; "")
|
|
||||||
|
|
||||||
(* ;; "If we have not already installed the mapping segment for that code, we try to retrieve it from the numberic file. If that segment mapping doesn't exist or doesn't have an entry for CODE, we fake up a mapping with a negative range in both directions. One way or the other, there will be an entry for that segment in both mapping vectors.")
|
|
||||||
|
|
||||||
(* ;; "")
|
|
||||||
|
|
||||||
(PROG ((INVERSE (EQ TABLE *UNICODETOMCCS*))
|
|
||||||
RANGE HASH)
|
|
||||||
|
|
||||||
(* ;; "If we already looked up CODE's character set in a file, then we have already filled in its information in the translation table. If it didn't have a code for a particular character, then we fake it here. Faked codes are negative, so we can detect them easily, and interpret them with IABS.")
|
|
||||||
|
|
||||||
(CL:WHEN (AND (UNICODE-EXTEND-TRANSLATION? CODE TABLE)
|
|
||||||
(SETQ RANGE (GETHASH CODE TABLE)))
|
|
||||||
|
|
||||||
(* ;; "We might have gotten the segment that didn't have an entry for CODE.")
|
|
||||||
|
|
||||||
(RETURN RANGE))
|
|
||||||
|
|
||||||
(* ;; "")
|
|
||||||
|
|
||||||
(CL:UNLESS DONTFAKE
|
|
||||||
|
|
||||||
(* ;; "Our attempt at extending the known tables did not provide a mapping for CODE. So we fake it up with the next unused private code in the code space. ")
|
|
||||||
|
|
||||||
(* ;; "The number of possible faked mappings is determined by the number of private-use Unicodes, since the MCCS character space is pretty sparse. The codes don't have to come from the same part of the code space, and the NEXTCODEs are saved in global variables. The last available codes are constants.")
|
|
||||||
|
|
||||||
(CL:WHEN (IEQP *NEXT-PRIVATE-MCCSCODE* LAST-PRIVATE-MCCSCODE)
|
|
||||||
(* ;
|
|
||||||
"Same number of available codes both ways")
|
|
||||||
(ERROR "EXHAUSTED RANGE FOR UNMAPPED CODES"))
|
|
||||||
(if INVERSE
|
|
||||||
then (SETQ RANGE *NEXT-PRIVATE-MCCSCODE*)
|
|
||||||
(add *NEXT-PRIVATE-MCCSCODE* 1)
|
|
||||||
else (SETQ RANGE *NEXT-PRIVATE-UNICODE*)
|
|
||||||
(add *NEXT-PRIVATE-UNICODE* 1))
|
|
||||||
(MERGE-UNICODE-TRANSLATION-TABLES INVERSE (CONS (LIST CODE RANGE)))
|
|
||||||
|
|
||||||
(* ;; "CONS because of LIST convention so we can eventually distinguish combiners.")
|
|
||||||
|
|
||||||
(RETURN (CONS RANGE)))])
|
|
||||||
|
|
||||||
(UNICODE-EXTEND-TRANSLATION?
|
|
||||||
[LAMBDA (CODE TABLE) (* ; "Edited 11-Oct-2025 09:49 by rmk")
|
|
||||||
(* ; "Edited 4-Sep-2025 00:34 by rmk")
|
|
||||||
(* ; "Edited 29-Jun-2025 16:44 by rmk")
|
|
||||||
(* ; "Edited 24-Apr-2025 15:49 by rmk")
|
|
||||||
(* ; "Edited 26-Jan-2025 11:26 by rmk")
|
|
||||||
(* ; "Edited 21-Jan-2025 22:31 by rmk")
|
|
||||||
(* ; "Edited 18-Jan-2025 12:40 by rmk")
|
|
||||||
(* ; "Edited 13-Jan-2025 23:50 by rmk")
|
|
||||||
(* ; "Edited 26-Aug-2024 16:49 by rmk")
|
|
||||||
(* ; "Edited 27-Mar-2024 23:02 by rmk")
|
|
||||||
(* ; "Edited 5-Feb-2024 13:48 by rmk")
|
|
||||||
(* ; "Edited 3-Feb-2024 12:40 by rmk")
|
|
||||||
|
|
||||||
(* ;; "There is currently no mapping for CODE in TABLE, hopefully just because the relevant character-set mapping has not been installed. We infer from TABLE whether CODE is an MCCS or UNICODE code and look for the proper mapping table (forward or inverted) for its character set. ")
|
|
||||||
|
|
||||||
(* ;; "We record which character sets we have already expanded so we don't do them again.")
|
|
||||||
|
|
||||||
(LET ((CHARSET (\CHARSET CODE))
|
|
||||||
(INVERSE (EQ TABLE *UNICODETOMCCS*))
|
|
||||||
MAPPING FILE)
|
|
||||||
|
|
||||||
(* ;; "If we already looked for CHARSET in the file and found anything, it has already been merged. Otherwise, it would just fail again")
|
|
||||||
|
|
||||||
(CL:UNLESS (MEMB CHARSET (CL:IF INVERSE
|
|
||||||
*UNICODE-LOADED-CHARSETS*
|
|
||||||
*MCCS-LOADED-CHARSETS*))
|
|
||||||
|
|
||||||
(* ;; "Don't try this charset again.")
|
|
||||||
|
|
||||||
(CL:IF INVERSE
|
|
||||||
(push *UNICODE-LOADED-CHARSETS* CHARSET)
|
|
||||||
(push *MCCS-LOADED-CHARSETS* CHARSET))
|
|
||||||
(SETQ FILE (FINDFILE (CL:IF INVERSE
|
|
||||||
'UNICODE-TO-MCCS-MAPPINGS
|
|
||||||
'MCCS-TO-UNICODE-MAPPINGS)
|
|
||||||
T UNICODEDIRECTORIES))
|
|
||||||
|
|
||||||
(* ;; "The mappings files are indexed by CHARSET.")
|
|
||||||
|
|
||||||
(CL:WHEN [AND FILE (SETQ MAPPING (CL:WITH-OPEN-FILE (STREAM FILE :INPUT)
|
|
||||||
(CL:WHEN (FILEPOS (CONCAT "[" CHARSET " ")
|
|
||||||
STREAM NIL NIL NIL T)
|
|
||||||
(READ STREAM]
|
|
||||||
|
|
||||||
(* ;;
|
|
||||||
"Merge MAPPING into both tables, respecting the direction indicated by TABLE. ")
|
|
||||||
|
|
||||||
(MERGE-UNICODE-TRANSLATION-TABLES INVERSE MAPPING)
|
|
||||||
T))])
|
|
||||||
)
|
)
|
||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(ALL-UNICODE-MAPPINGS
|
(ALL-UNICODE-MAPPINGS
|
||||||
[LAMBDA (INVERTED FILE) (* ; "Edited 24-Apr-2025 15:51 by rmk")
|
[LAMBDA (INVERTED FILE) (* ; "Edited 22-Feb-2026 10:42 by rmk")
|
||||||
|
(* ; "Edited 24-Apr-2025 15:51 by rmk")
|
||||||
(* ; "Edited 31-Jan-2025 17:46 by rmk")
|
(* ; "Edited 31-Jan-2025 17:46 by rmk")
|
||||||
(* ; "Edited 26-Jan-2025 13:40 by rmk")
|
(* ; "Edited 26-Jan-2025 13:40 by rmk")
|
||||||
(* ; "Edited 22-Jan-2025 14:07 by rmk")
|
(* ; "Edited 22-Jan-2025 14:07 by rmk")
|
||||||
@@ -453,38 +359,32 @@
|
|||||||
(* ;; "The first index level segments all the domain codes according to their character sets. The segments are sorted by character set, the pairs within each segment are sorted by their domain codes. ")
|
(* ;; "The first index level segments all the domain codes according to their character sets. The segments are sorted by character set, the pairs within each segment are sorted by their domain codes. ")
|
||||||
|
|
||||||
(* ;;
|
(* ;;
|
||||||
"E.g. if INVERTED=NIL and given a XCCS code, the lookup for the corresponding Unicode(s) is")
|
"E.g. if INVERTED=NIL and given a MCCS code, the lookup for the corresponding Unicode(s) is")
|
||||||
|
|
||||||
(* ;; " (CADR (ASSOC MCCSCODE (\CHARSET MCCSCODE) INDEX)))).")
|
(* ;; " (CAR (GETMULTI INDEX (\CHARSET MCCSCODE) MCCSCODE).")
|
||||||
|
|
||||||
(* ;; "If FILE is not NIL, the result is written to a file. If FILE is T, the file is either MCCS-TO-UNICODE-MAPPINGS.TXT or UNICODE-TO-MCCS-MAPPINGS.TXT, depending on INVERTED.")
|
(* ;; "If FILE is not NIL, the result is written to a file. If FILE is T, the file is either MCCS-TO-UNICODE-MAPPINGS.TXT or UNICODE-TO-MCCS-MAPPINGS.TXT, depending on INVERTED.")
|
||||||
|
|
||||||
(LET (INDEX)
|
(LET [INDEX (MAPPING (GET-MCCS-UNICODE-MAPPING 'ALL]
|
||||||
(for PAIR DOMAIN RANGE CHARSET in (READ-UNICODE-MAPPING 'ALL) eachtime (SETQ DOMAIN
|
(for PAIR in (CL:IF INVERTED
|
||||||
(CAR PAIR))
|
(INVERT-UNICODE-MAPPING MAPPING)
|
||||||
(SETQ RANGE (CADR PAIR))
|
MAPPING) unless (LISTP (CADR PAIR)) do
|
||||||
|
(* ;;
|
||||||
(* ;;
|
"(LISTP (CADR PAIR) is a combiner, ignored for now.")
|
||||||
"(LISTP RANGE) is a combiner, ignored for now.")
|
|
||||||
unless (LISTP RANGE) do (CL:WHEN INVERTED (SWAP DOMAIN RANGE))
|
|
||||||
|
|
||||||
(* ;;
|
(* ;;
|
||||||
"One segment for each high-byte character set. This aligns with UNICODE-EXTEND.TRANSLATION?")
|
"One segment for each high-byte character set. This aligns with UNICODE-EXTEND.TRANSLATION?")
|
||||||
|
|
||||||
[SETQ CHARSET (OR (ASSOC (\CHARSET DOMAIN)
|
(* ;; "For alternative mappings (in the U-to-M direction) we end up with (D R1 R2 ...). (CAR (GETMULTI)) is the first (and almost always) the only one.")
|
||||||
INDEX)
|
|
||||||
(CAR (push INDEX (CONS (\CHARSET DOMAIN]
|
|
||||||
|
|
||||||
(* ;; "For alternative mappings (in the U-to-M direction) we end up with (D R1 R2 ...). (CADR is the first (and almost always) the only one.")
|
(PUSHMULTI-NEW INDEX
|
||||||
|
(\CHARSET (CAR PAIR))
|
||||||
(pushnew [CDR (OR (ASSOC DOMAIN (CDR CHARSET))
|
(CAR PAIR)
|
||||||
(CAR (push (CDR CHARSET)
|
(CADR PAIR)))
|
||||||
(CONS DOMAIN]
|
|
||||||
RANGE))
|
|
||||||
|
|
||||||
(* ;; "Push the charset mappings down an extra CONS, so that a subsequent READ will get them all after a FILEPOS search for super-paren [")
|
(* ;; "Push the charset mappings down an extra CONS, so that a subsequent READ will get them all after a FILEPOS search for super-paren [")
|
||||||
|
|
||||||
[for CS in INDEX do (for M in (CDR CS) when (CDDR M) do
|
(for CS in INDEX do (for M in (CDR CS) when (CDDR M) do
|
||||||
(* ;;
|
(* ;;
|
||||||
"Sort the range alternatives, if any")
|
"Sort the range alternatives, if any")
|
||||||
|
|
||||||
@@ -494,7 +394,7 @@
|
|||||||
(* ;; "Sort by domain codes and push down a level")
|
(* ;; "Sort by domain codes and push down a level")
|
||||||
|
|
||||||
(change (CDR CS)
|
(change (CDR CS)
|
||||||
(CONS (SORT DATUM T]
|
(SORT DATUM T)))
|
||||||
(SETQ INDEX (SORT INDEX T)) (* ; "Sort character sets")
|
(SETQ INDEX (SORT INDEX T)) (* ; "Sort character sets")
|
||||||
(if FILE
|
(if FILE
|
||||||
then (SETQ FILE (PACKFILENAME 'BODY (if (NEQ FILE T)
|
then (SETQ FILE (PACKFILENAME 'BODY (if (NEQ FILE T)
|
||||||
@@ -544,18 +444,347 @@
|
|||||||
(FULLNAME STREAM))))])
|
(FULLNAME STREAM))))])
|
||||||
)
|
)
|
||||||
|
|
||||||
(RPAQ? *MCCSTOUNICODE* )
|
|
||||||
|
|
||||||
(RPAQ? *UNICODETOMCCS* )
|
|
||||||
|
|
||||||
(RPAQ? *MCCS-LOADED-CHARSETS* )
|
(* ; "Write Unicode mapping files")
|
||||||
|
|
||||||
(RPAQ? *UNICODE-LOADED-CHARSETS* )
|
(DEFINEQ
|
||||||
|
|
||||||
(RPAQ? *LARGEUNICODES* )
|
(WRITE-UNICODE-MAPPING
|
||||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
[LAMBDA (MAPPING INCLUDECHARSETS FILE EMPTYOK) (* ; "Edited 4-Jan-2024 22:44 by rmk")
|
||||||
|
(* ; "Edited 16-Aug-2020 16:56 by rmk:")
|
||||||
|
|
||||||
(MAKE-UNICODE-TRANSLATION-TABLES 'ALL)
|
(* ;; "Writes a symbol unicode mapping file. Mapping is a list of (XCCS-code Unicode) pairs, which may contain codes in multiple character sets.")
|
||||||
|
|
||||||
|
(* ;; "If FILE is NIL, it defaults to a name XCCS- followed by the octal character sets in the mapping, in the unicode/XEROX directory.")
|
||||||
|
|
||||||
|
(* ;; "The output lines are of the form x0XXX<tab>x0UUUU<tab># Unicode-char")
|
||||||
|
|
||||||
|
(* ;;
|
||||||
|
"If INCLUDECHARSETS=T then the mappings are split up into separate per-character set files.")
|
||||||
|
|
||||||
|
(* ;; "Otherwise, all and only mappings included in thos charsets are included in a single output file--an implicit subset.")
|
||||||
|
|
||||||
|
(IF (AND (EQ INCLUDECHARSETS T)
|
||||||
|
(NULL FILE))
|
||||||
|
THEN (IF MAPPING
|
||||||
|
THEN (FOR CSI F IN XCCS-SET-NAMES WHEN (SETQ F (WRITE-UNICODE-MAPPING MAPPING
|
||||||
|
(CAR CSI)
|
||||||
|
NIL T)) COLLECT F)
|
||||||
|
ELSE (PRINTOUT T "THERE ARE NO MAPPINGS" T)
|
||||||
|
NIL)
|
||||||
|
ELSE
|
||||||
|
(LET
|
||||||
|
(IMAPPING CSETINFO RANGES)
|
||||||
|
(CL:MULTIPLE-VALUE-SETQ (IMAPPING CSETINFO RANGES)
|
||||||
|
(WRITE-UNICODE-INCLUDED MAPPING INCLUDECHARSETS))
|
||||||
|
(IF IMAPPING
|
||||||
|
THEN (CL:WITH-OPEN-FILE
|
||||||
|
(STREAM (WRITE-UNICODE-MAPPING-FILENAME FILE CSETINFO RANGES)
|
||||||
|
:DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :EXTERNAL-FORMAT :UTF-8-RAW)
|
||||||
|
(WRITE-UNICODE-MAPPING-HEADER STREAM CSETINFO RANGES)
|
||||||
|
(SORT IMAPPING T)
|
||||||
|
(FOR M CSET LEFTC FIRSTRIGHTC CSI IN IMAPPING
|
||||||
|
DO (SETQ LEFTC (CAR M))
|
||||||
|
(SETQ FIRSTRIGHTC (CADR M))
|
||||||
|
(CL:UNLESS (EQ CSET (LRSH LEFTC 8))
|
||||||
|
(SETQ CSET (LRSH LEFTC 8))
|
||||||
|
(SETQ CSI (ASSOC CSET CSETINFO))
|
||||||
|
(PRINTOUT STREAM T "# " .P2 (CADR CSI)
|
||||||
|
" "
|
||||||
|
(CADDR CSI)
|
||||||
|
T))
|
||||||
|
(PRINTOUT STREAM "0x" (HEXSTRING LEFTC 4)
|
||||||
|
%#
|
||||||
|
(FOR RIGHTC IN (CDR M) DO (PRINTOUT NIL " " "0x" (HEXSTRING RIGHTC 4)))
|
||||||
|
" # "
|
||||||
|
(SELECTC FIRSTRIGHTC
|
||||||
|
(UNDEFINEDCODE
|
||||||
|
(* ;; "FFFF")
|
||||||
|
|
||||||
|
"UNDEFINED")
|
||||||
|
(MISSINGCODE
|
||||||
|
(* ;; "FFFE")
|
||||||
|
|
||||||
|
"MISSING")
|
||||||
|
(IF (ILESSP FIRSTRIGHTC 32)
|
||||||
|
THEN (* ; "Control chars")
|
||||||
|
[CONCAT "↑" (CHARACTER (IPLUS FIRSTRIGHTC (CHARCODE @]
|
||||||
|
ELSE (CHARACTER FIRSTRIGHTC)))
|
||||||
|
T))
|
||||||
|
(FULLNAME STREAM))
|
||||||
|
ELSEIF (NOT EMPTYOK)
|
||||||
|
THEN (PRINTOUT T "THERE ARE NO MAPPINGS")
|
||||||
|
(CL:WHEN INCLUDECHARSETS
|
||||||
|
(PRINTOUT T " FOR " .PPVTL (MKLIST INCLUDECHARSETS)
|
||||||
|
T))
|
||||||
|
NIL])
|
||||||
|
|
||||||
|
(WRITE-UNICODE-INCLUDED
|
||||||
|
[LAMBDA (MAPPING INCLUDECHARSETS) (* ; "Edited 4-Aug-2020 17:47 by rmk:")
|
||||||
|
|
||||||
|
(* ;; "CSETINFO is a list of (num string name) for each included character set.")
|
||||||
|
|
||||||
|
(LET (CHARSETS CSETINFO RANGES ICSETS IMAPPING)
|
||||||
|
|
||||||
|
(* ;; "Normalize the INCLUDECHARSETS, then reduce MAPPING to the included mappings")
|
||||||
|
|
||||||
|
[SETQ ICSETS (FOR C POS KNOWN INSIDE (OR INCLUDECHARSETS (FOR CSI IN XCCS-SET-NAMES
|
||||||
|
COLLECT (CAR CSI)))
|
||||||
|
JOIN [SETQ KNOWN (OR (SASSOC C XCCS-SET-NAMES)
|
||||||
|
(FIND N IN XCCS-SET-NAMES
|
||||||
|
SUCHTHAT (EQ C (CADR N)))
|
||||||
|
(HELP "UNKNOWN CHARACTER SET" (OCTALSTRING C]
|
||||||
|
(IF (SETQ POS (STRPOS "-" (CAR KNOWN)))
|
||||||
|
THEN (FOR I FROM (CL:PARSE-INTEGER (SUBSTRING (CAR KNOWN)
|
||||||
|
1
|
||||||
|
(SUB1 POS))
|
||||||
|
:RADIX 8)
|
||||||
|
TO (CL:PARSE-INTEGER (SUBSTRING (CAR KNOWN)
|
||||||
|
(ADD1 POS))
|
||||||
|
:RADIX 8) COLLECT (LIST I (OCTALSTRING I)
|
||||||
|
(CADR KNOWN)))
|
||||||
|
ELSE (CONS (CONS (CL:PARSE-INTEGER (CAR KNOWN)
|
||||||
|
:RADIX 8)
|
||||||
|
KNOWN]
|
||||||
|
(SETQ IMAPPING (FOR M CSI IN MAPPING WHEN (SETQ CSI (ASSOC (LRSH (CAR M)
|
||||||
|
8)
|
||||||
|
ICSETS))
|
||||||
|
COLLECT
|
||||||
|
|
||||||
|
(* ;; "The attested subset of INCLUDED")
|
||||||
|
|
||||||
|
(CL:UNLESS (MEMB CSI CSETINFO)
|
||||||
|
(PUSH CSETINFO CSI))
|
||||||
|
M))
|
||||||
|
|
||||||
|
(* ;; "Sort as numbers, not octal strings, then group into consecutive ranges")
|
||||||
|
|
||||||
|
(SETQ CSETINFO (SORT CSETINFO T))
|
||||||
|
[SETQ RANGES (FOR CTAIL C START END ON (FOR CSI IN CSETINFO COLLECT (CAR CSI)) WHILE CTAIL
|
||||||
|
COLLECT (SETQ START (CAR CTAIL))
|
||||||
|
(SETQ END START)
|
||||||
|
(CONS START (WHILE [AND (CDR CTAIL)
|
||||||
|
(EQ END (SUB1 (CADR CTAIL]
|
||||||
|
COLLECT (SETQ CTAIL (CDR CTAIL))
|
||||||
|
(SETQ END (CAR CTAIL]
|
||||||
|
|
||||||
|
(* ;; "Split out groups of less than 3. But if a range exhaustively covers a known subset (like JIS), replace by the name")
|
||||||
|
|
||||||
|
[SETQ RANGES (FOR R STR KNOWN LAST IN RANGES
|
||||||
|
JOIN (SETQ LAST (CAR (LAST R)))
|
||||||
|
(IF (EQ (CAR R)
|
||||||
|
LAST)
|
||||||
|
THEN (CONS (OCTALSTRING (CAR R)))
|
||||||
|
ELSEIF (SETQ KNOWN (SASSOC (SETQ STR (CONCAT (OCTALSTRING
|
||||||
|
(CAR R))
|
||||||
|
"-"
|
||||||
|
(OCTALSTRING LAST)))
|
||||||
|
XCCS-SET-NAMES))
|
||||||
|
THEN (CONS (CADR KNOWN))
|
||||||
|
ELSEIF (CDDR R)
|
||||||
|
THEN (CONS STR)
|
||||||
|
ELSE (LIST (OCTALSTRING (CAR R))
|
||||||
|
(OCTALSTRING LAST]
|
||||||
|
(CL:VALUES IMAPPING CSETINFO RANGES])
|
||||||
|
|
||||||
|
(WRITE-UNICODE-MAPPING-HEADER
|
||||||
|
[LAMBDA (STREAM CSETINFO RANGES) (* ; "Edited 5-Jan-2024 13:24 by rmk")
|
||||||
|
(* ; "Edited 4-Aug-2020 17:38 by rmk:")
|
||||||
|
|
||||||
|
(* ;; "Writes the standard per-file header information")
|
||||||
|
|
||||||
|
(FOR LINE IN UNICODE-MAPPING-HEADER
|
||||||
|
DO (PRINTOUT STREAM "#" 2)
|
||||||
|
(SELECTQ LINE
|
||||||
|
(XCCSCHARACTERSETS
|
||||||
|
(PRINTOUT STREAM " XCCS charset")
|
||||||
|
(IF (CDR CSETINFO)
|
||||||
|
THEN (PRINTOUT STREAM "s:" -4)
|
||||||
|
(FOR R IN RANGES DO (PRINTOUT STREAM R " "))
|
||||||
|
ELSE (* ; "Singleton")
|
||||||
|
(PRINTOUT STREAM ": " -4 (CADAR CSETINFO)
|
||||||
|
" "
|
||||||
|
(CADDAR CSETINFO)))
|
||||||
|
(TERPRI STREAM))
|
||||||
|
(DATE (PRINTOUT STREAM " Date:" -13 (DATE (DATEFORMAT NO.TIME NO.LEADING.SPACES)
|
||||||
|
)
|
||||||
|
T))
|
||||||
|
(PRINTOUT STREAM LINE T)))
|
||||||
|
(TERPRI STREAM])
|
||||||
|
|
||||||
|
(WRITE-UNICODE-MAPPING-FILENAME
|
||||||
|
[LAMBDA (FILE CSETINFO RANGES) (* ; "Edited 4-Aug-2020 19:34 by rmk:")
|
||||||
|
(PACKFILENAME 'BODY [OR FILE (CONCATLIST
|
||||||
|
(CONS 'XCCS- (IF (CDR CSETINFO)
|
||||||
|
THEN (FOR RTAIL R ON RANGES
|
||||||
|
JOIN (SETQ R (CAR RTAIL))
|
||||||
|
(SETQ R (CL:IF (LISTP R)
|
||||||
|
(LIST (CAR R)
|
||||||
|
"-"
|
||||||
|
(CDR R))
|
||||||
|
(CONS R)))
|
||||||
|
(CL:IF (CDR RTAIL)
|
||||||
|
(NCONC1 R ","))
|
||||||
|
R)
|
||||||
|
ELSE (LIST (CADAR CSETINFO)
|
||||||
|
"="
|
||||||
|
(CADDAR CSETINFO]
|
||||||
|
'DIRECTORY
|
||||||
|
(CAR UNICODEDIRECTORIES)
|
||||||
|
'EXTENSION
|
||||||
|
'TXT])
|
||||||
|
)
|
||||||
|
(DEFINEQ
|
||||||
|
|
||||||
|
(XCCS-UTF8-AFTER-OPEN
|
||||||
|
[LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 3-Jan-2024 10:27 by rmk")
|
||||||
|
(* ; "Edited 13-Aug-2020 11:54 by rmk:")
|
||||||
|
|
||||||
|
(* ;;
|
||||||
|
"If added to STREAM-AFTER-OPEN-FNS, causes mapping files to be opened as UTF-8. For development")
|
||||||
|
|
||||||
|
(CL:WHEN (AND (STRPOS "XCCS-" (U-CASE (FULLNAME STREAM)))
|
||||||
|
[EQ 'TXT (U-CASE (FILENAMEFIELD (FULLNAME STREAM)
|
||||||
|
'EXTENSION]
|
||||||
|
(NOT (ASSOC 'EXTERNALFORMAT PARAMETERS)))
|
||||||
|
(STREAMPROP STREAM 'EXTERNALFORMAT :UTF-8))])
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(* ;; "Automate dumping of a documentation prefix")
|
||||||
|
|
||||||
|
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||||
|
(DECLARE%: EVAL@COMPILE
|
||||||
|
|
||||||
|
(RPAQ MISSINGCODE (CL:PARSE-INTEGER "FFFE" :RADIX 16))
|
||||||
|
|
||||||
|
(RPAQ UNDEFINEDCODE (CL:PARSE-INTEGER "FFFF" :RADIX 16))
|
||||||
|
|
||||||
|
|
||||||
|
(CONSTANTS (MISSINGCODE (CL:PARSE-INTEGER "FFFE" :RADIX 16))
|
||||||
|
(UNDEFINEDCODE (CL:PARSE-INTEGER "FFFF" :RADIX 16)))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(RPAQQ UNICODE-MAPPING-HEADER
|
||||||
|
("" " Name: XCCS (Version 2.0) to Unicode" " Unicode version: 3.0"
|
||||||
|
XCCSCHARACTERSETS " Table version: 0.1" " Table format: Format A"
|
||||||
|
DATE " Author: Ron Kaplan <Ron.Kaplan@post.harvard.edu>" ""
|
||||||
|
"This file contains mappings from the Xerox Character Code Standard (version"
|
||||||
|
"2.0, 1990) into Unicode 3.0. standard codes. That is an extension of the"
|
||||||
|
"version of XCCS corresponding to the fonts in the Medley system." ""
|
||||||
|
"The format of this file conforms to the format of the other Unicode-supplied"
|
||||||
|
"mapping files:" " Three white-space (tab or spaces) separated columns:"
|
||||||
|
" Column 1 is the XCCS code (as hex 0xXXXX)"
|
||||||
|
" Column 2 is the corresponding Unicode (as hex 0xXXXX)"
|
||||||
|
" Column 3 (after #) is a comment column. For convenience, it contains the"
|
||||||
|
" Unicode character itself and the Unicode character names when available."
|
||||||
|
"Unicode FFFF is used for undefined XCCS codes (Column 3 = UNDEFINED"
|
||||||
|
"Unicode FFFE is used for XCCS codes that have not yet been filled in."
|
||||||
|
"(Column 3 = MISSING)" "" "This file is encoded in UTF-8, so that the Unicode characters"
|
||||||
|
"are properly displayed in Column 3 and can be edited by standard"
|
||||||
|
"Unicode-enabled editors (e.g. Mac Textedit)." ""
|
||||||
|
"This file can also be read by the function"
|
||||||
|
"READ-UNICODE-MAPPING in the UNICODE Medley library package." ""
|
||||||
|
"The entries are in XCCS order and grouped by character sets. In front of"
|
||||||
|
"the mappings, for convenience, there is a line with the octal XCCS"
|
||||||
|
"character set, after #." ""
|
||||||
|
"Note that a given XCCS code might map to codes in several different Unicode"
|
||||||
|
"positions, since there are repetitions in the Unicode standard." ""
|
||||||
|
"For more details, see the associated README.TXT file." ""
|
||||||
|
"Any comments or problems, contact <ron.kaplan@post.harvard.edu>"))
|
||||||
|
(DEFINEQ
|
||||||
|
|
||||||
|
(UTF8HEXSTRING
|
||||||
|
[LAMBDA (CHARCODE) (* ; "Edited 10-Aug-2020 08:33 by rmk:")
|
||||||
|
|
||||||
|
(* ;; "Utility to produces the UTF8 hexstring representing CODE")
|
||||||
|
|
||||||
|
(HEXSTRING (IF (ILESSP CHARCODE 128)
|
||||||
|
THEN CHARCODE
|
||||||
|
ELSEIF (ILESSP CHARCODE 2048)
|
||||||
|
THEN (* ; "x800")
|
||||||
|
(LOGOR (LLSH (LOGOR (LLSH 3 6)
|
||||||
|
(LRSH CHARCODE 6))
|
||||||
|
8)
|
||||||
|
(LOGOR (LLSH 2 6)
|
||||||
|
(LOADBYTE CHARCODE 0 6)))
|
||||||
|
ELSEIF (ILESSP CHARCODE 65536)
|
||||||
|
THEN (* ; "x10000")
|
||||||
|
(LOGOR (LLSH (LOGOR (LLSH 7 5)
|
||||||
|
(LRSH CHARCODE 12))
|
||||||
|
16)
|
||||||
|
(LLSH (LOGOR (LLSH 2 6)
|
||||||
|
(LOADBYTE CHARCODE 6 6))
|
||||||
|
8)
|
||||||
|
(LOGOR (LLSH 2 6)
|
||||||
|
(LOADBYTE CHARCODE 0 6)))
|
||||||
|
ELSEIF (ILESSP CHARCODE 2097152)
|
||||||
|
THEN (* ; "x200000")
|
||||||
|
(LOGOR (LLSH (LOGOR (LLSH 15 4)
|
||||||
|
(LRSH CHARCODE 18))
|
||||||
|
24)
|
||||||
|
(LLSH (LOGOR (LLSH 2 6)
|
||||||
|
(LOADBYTE CHARCODE 12 6))
|
||||||
|
16)
|
||||||
|
(LLSH (LOGOR (LLSH 2 6)
|
||||||
|
(LOADBYTE CHARCODE 6 6))
|
||||||
|
8)
|
||||||
|
(LOGOR (LLSH 2 6)
|
||||||
|
(LOADBYTE CHARCODE 0 6)))
|
||||||
|
ELSE (ERROR "CHARCODE too big for UTF8" CHARCODE])
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(* ; "debugging")
|
||||||
|
|
||||||
|
(DEFINEQ
|
||||||
|
|
||||||
|
(SHOWCHARS
|
||||||
|
[LAMBDA (FONT FROMCHAR TOCHAR ONELINE) (* ; "Edited 5-Oct-2025 17:41 by rmk")
|
||||||
|
(* ; "Edited 7-Sep-2025 20:29 by rmk")
|
||||||
|
(* ; "Edited 2-Sep-2025 10:26 by rmk")
|
||||||
|
(* ; "Edited 24-Jul-2025 11:30 by rmk")
|
||||||
|
(* ; "Edited 8-Jun-2025 20:05 by rmk")
|
||||||
|
(* ; "Edited 26-Jan-2024 14:18 by mth")
|
||||||
|
(* ; "Edited 1-Aug-2020 09:27 by rmk:")
|
||||||
|
[SETQ FONT (FONTCREATE (OR FONT '(CLASSIC 12]
|
||||||
|
(RESETLST
|
||||||
|
[LET ((OLDFONT (DSPFONT NIL T))
|
||||||
|
CHARS)
|
||||||
|
(CL:UNLESS (CHARCODEP FROMCHAR)
|
||||||
|
(SETQ FROMCHAR (OR (CHARCODE.DECODE FROMCHAR T)
|
||||||
|
FROMCHAR)))
|
||||||
|
(SETQ CHARS (if (LISTP FROMCHAR)
|
||||||
|
elseif (CHARCODEP FROMCHAR)
|
||||||
|
then (CL:UNLESS (CHARCODEP TOCHAR)
|
||||||
|
(SETQ TOCHAR (OR (CHARCODE.DECODE TOCHAR)
|
||||||
|
FROMCHAR)))
|
||||||
|
(for C from FROMCHAR to TOCHAR collect C)
|
||||||
|
else (CHCON FROMCHAR)))
|
||||||
|
[RESETSAVE OLDFONT '(PROGN (DSPFONT OLDVALUE]
|
||||||
|
(TERPRI)
|
||||||
|
(for C in CHARS do (PRINTOUT T .FONT OLDFONT (CONCAT (OCTALSTRING (\CHARSET C))
|
||||||
|
","
|
||||||
|
(OCTALSTRING (\CHAR8CODE C)))
|
||||||
|
10 .FONT FONT (CHARACTER C))
|
||||||
|
(CL:UNLESS ONELINE (PRINTOUT T T])
|
||||||
|
(TERPRI])
|
||||||
|
)
|
||||||
|
(DECLARE%: DOEVAL@LOAD DONTCOPY
|
||||||
|
(DECLARE%: EVAL@COMPILE
|
||||||
|
|
||||||
|
(PUTPROPS HEXCHAR MACRO ((CODE)
|
||||||
|
(HEXSTRING CODE)))
|
||||||
|
|
||||||
|
(PUTPROPS OCTALCHAR MACRO [(CODE)
|
||||||
|
(CONCAT (OCTALSTRING (\CHARSET CODE))
|
||||||
|
","
|
||||||
|
(OCTALSTRING (LOGAND CODE 255])
|
||||||
|
)
|
||||||
)
|
)
|
||||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||||
|
|
||||||
@@ -563,9 +792,12 @@
|
|||||||
UNICODE-EXPORTS)
|
UNICODE-EXPORTS)
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (3341 12542 (READ-UNICODE-MAPPING-FILENAMES 3351 . 8301) (READ-UNICODE-MAPPING 8303 .
|
(FILEMAP (NIL (3929 12651 (READ-UNICODE-MAPPING-FILENAMES 3939 . 8408) (READ-UNICODE-MAPPING 8410 .
|
||||||
12540)) (12609 26839 (MAKE-UNICODE-TRANSLATION-TABLES 12619 . 16379) (XCCSTOMCCS-MAPPING 16381 . 17598
|
12649)) (12718 19526 (MAKE-UNICODE-TRANSLATION-TABLES 12728 . 15488) (GET-MCCS-UNICODE-MAPPING 15490
|
||||||
) (MERGE-UNICODE-TRANSLATION-TABLES 17600 . 20253) (UNICODE.UNMAPPED 20255 . 23579) (
|
. 16510) (INVERT-UNICODE-MAPPING 16512 . 18305) (XCCSTOMCCS-MAPPING 18307 . 19524)) (19527 26150 (
|
||||||
UNICODE-EXTEND-TRANSLATION? 23581 . 26837)) (26840 33676 (ALL-UNICODE-MAPPINGS 26850 . 32339) (
|
ALL-UNICODE-MAPPINGS 19537 . 24813) (XCCSJAPANESECHARSETS 24815 . 26148)) (26195 36957 (
|
||||||
XCCSJAPANESECHARSETS 32341 . 33674)))))
|
WRITE-UNICODE-MAPPING 26205 . 29949) (WRITE-UNICODE-INCLUDED 29951 . 34263) (
|
||||||
|
WRITE-UNICODE-MAPPING-HEADER 34265 . 35513) (WRITE-UNICODE-MAPPING-FILENAME 35515 . 36955)) (36958
|
||||||
|
37634 (XCCS-UTF8-AFTER-OPEN 36968 . 37632)) (40159 42248 (UTF8HEXSTRING 40169 . 42246)) (42275 44317 (
|
||||||
|
SHOWCHARS 42285 . 44315)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
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 " 2-Sep-2025 12:06:52"
|
(FILECREATED " 5-Feb-2026 18:38:23" {WMEDLEY}<library>UNIXCOMM.;15 14717
|
||||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>UNIXCOMM.;14 14825
|
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS FORK-UNIX)
|
:CHANGES-TO (FNS FORK-UNIX)
|
||||||
|
|
||||||
:PREVIOUS-DATE "29-Apr-2025 22:45:47"
|
:PREVIOUS-DATE " 2-Sep-2025 12:06:52" {WMEDLEY}<library>UNIXCOMM.;14)
|
||||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>UNIXCOMM.;13)
|
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT UNIXCOMMCOMS)
|
(PRETTYCOMPRINT UNIXCOMMCOMS)
|
||||||
@@ -74,13 +72,11 @@
|
|||||||
else (SUBRCALL UNIX-HANDLECOMM 4])
|
else (SUBRCALL UNIX-HANDLECOMM 4])
|
||||||
|
|
||||||
(FORK-UNIX
|
(FORK-UNIX
|
||||||
[LAMBDA (STR) (* ; "Edited 2-Sep-2025 12:03 by rmk")
|
[LAMBDA (STR) (* ; "Edited 5-Feb-2026 18:38 by rmk")
|
||||||
|
(* ; "Edited 2-Sep-2025 12:03 by rmk")
|
||||||
(* ; "Edited 29-Apr-2025 22:45 by rmk")
|
(* ; "Edited 29-Apr-2025 22:45 by rmk")
|
||||||
(* ; "Edited 25-May-88 15:47 by drc:")
|
(* ; "Edited 25-May-88 15:47 by drc:")
|
||||||
|
(SUBRCALL UNIX-HANDLECOMM 0 (MTOSYSSTRING (\DTEST STR 'ONED-ARRAY])
|
||||||
(* ;; "MTOUBYTES converts MCCS codes to Unicodes, and then lays out the bytes of the UTF-8 encoding of those characters. ")
|
|
||||||
|
|
||||||
(SUBRCALL UNIX-HANDLECOMM 0 (MTOUTF8STRING (\DTEST STR 'ONED-ARRAY])
|
|
||||||
|
|
||||||
(UNIX-KILL
|
(UNIX-KILL
|
||||||
[LAMBDA (CONN) (* ; "Edited 25-May-88 16:04 by drc:")
|
[LAMBDA (CONN) (* ; "Edited 25-May-88 16:04 by drc:")
|
||||||
@@ -321,10 +317,10 @@
|
|||||||
|
|
||||||
(PUTPROPS UNIXCOMM FILETYPE COMPILE-FILE)
|
(PUTPROPS UNIXCOMM FILETYPE COMPILE-FILE)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (1903 7339 (FORK-SHELL 1913 . 3110) (FORK-UNIX 3112 . 3659) (UNIX-KILL 3661 . 3850) (
|
(FILEMAP (NIL (1821 7231 (FORK-SHELL 1831 . 3028) (FORK-UNIX 3030 . 3551) (UNIX-KILL 3553 . 3742) (
|
||||||
UNIX-WRITE 3852 . 4563) (CREATE-SHELL-STREAM 4565 . 5449) (CREATE-PROCESS-STREAM 5451 . 6290) (
|
UNIX-WRITE 3744 . 4455) (CREATE-SHELL-STREAM 4457 . 5341) (CREATE-PROCESS-STREAM 5343 . 6182) (
|
||||||
UNIXCOMM-AROUNDEXITFN 6292 . 7337)) (7387 12578 (INITIALIZE-SHELL-DEVICE 7397 . 8825) (
|
UNIXCOMM-AROUNDEXITFN 6184 . 7229)) (7279 12470 (INITIALIZE-SHELL-DEVICE 7289 . 8717) (
|
||||||
UNIX-GET-NEXT-BUFFER 8827 . 11027) (UNIX-BACKFILEPTR 11029 . 11441) (UNIX-STREAM-EOFP 11443 . 11924) (
|
UNIX-GET-NEXT-BUFFER 8719 . 10919) (UNIX-BACKFILEPTR 10921 . 11333) (UNIX-STREAM-EOFP 11335 . 11816) (
|
||||||
UNIX-STREAM-OUT 11926 . 12182) (UNIX-STREAM-CLOSE 12184 . 12576)) (12826 14532 (
|
UNIX-STREAM-OUT 11818 . 12074) (UNIX-STREAM-CLOSE 12076 . 12468)) (12718 14424 (
|
||||||
CREATE-UNIX-SOCKET-STREAM 12836 . 13642) (ACCEPT-UNIX-SOCKET-STREAM 13644 . 14530)))))
|
CREATE-UNIX-SOCKET-STREAM 12728 . 13534) (ACCEPT-UNIX-SOCKET-STREAM 13536 . 14422)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
BIN
library/UNIXCOMM.DFASL
Normal file
BIN
library/UNIXCOMM.DFASL
Normal file
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 11:09:09" {WMEDLEY}<library>UNIXPRINT.;15 11553
|
(FILECREATED " 5-Feb-2026 18:37:09" {WMEDLEY}<library>UNIXPRINT.;17 11663
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS UnixPrint)
|
:CHANGES-TO (FNS UnixShellQuote)
|
||||||
|
|
||||||
:PREVIOUS-DATE "18-Jan-2026 08:44:40" {WMEDLEY}<library>UNIXPRINT.;14)
|
:PREVIOUS-DATE "25-Jan-2026 11:09:09" {WMEDLEY}<library>UNIXPRINT.;15)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT UNIXPRINTCOMS)
|
(PRETTYCOMPRINT UNIXPRINTCOMS)
|
||||||
@@ -130,7 +130,8 @@
|
|||||||
|
|
||||||
(UnixShellQuote
|
(UnixShellQuote
|
||||||
[LAMBDA (STRING)
|
[LAMBDA (STRING)
|
||||||
(DECLARE (LOCALVARS . T)) (* ; "Edited 18-Jan-2026 08:34 by rmk")
|
(DECLARE (LOCALVARS . T)) (* ; "Edited 5-Feb-2026 18:37 by rmk")
|
||||||
|
(* ; "Edited 18-Jan-2026 08:34 by rmk")
|
||||||
(* ; "Edited 19-Apr-89 21:14 by TAL")
|
(* ; "Edited 19-Apr-89 21:14 by TAL")
|
||||||
(LET* ((X (CHCON STRING))
|
(LET* ((X (CHCON STRING))
|
||||||
(CT X)
|
(CT X)
|
||||||
@@ -155,9 +156,9 @@
|
|||||||
(CHARCODE SPACE))
|
(CHARCODE SPACE))
|
||||||
(T C))
|
(T C))
|
||||||
(SETQ CT (CDR CT]
|
(SETQ CT (CDR CT]
|
||||||
(MTOUTF8STRING (COND
|
(MTOSYSSTRING (CL:IF FLG
|
||||||
(FLG (CONCATCODES X))
|
(CONCATCODES X)
|
||||||
(T STRING])
|
STRING)])
|
||||||
|
|
||||||
(UnixTempFile
|
(UnixTempFile
|
||||||
[LAMBDA (Prefix DontOpen) (* ; "Edited 28-Apr-93 13:49 by rmk:")
|
[LAMBDA (Prefix DontOpen) (* ; "Edited 28-Apr-93 13:49 by rmk:")
|
||||||
@@ -251,6 +252,6 @@
|
|||||||
(ADDTOVAR LAMA )
|
(ADDTOVAR LAMA )
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (1046 10887 (UnixPrint 1056 . 6392) (UnixShellQuote 6394 . 7977) (UnixTempFile 7979 .
|
(FILEMAP (NIL (1051 10997 (UnixPrint 1061 . 6397) (UnixShellQuote 6399 . 8087) (UnixTempFile 8089 .
|
||||||
9202) (UnixPrintCommand 9204 . 10885)))))
|
9312) (UnixPrintCommand 9314 . 10995)))))
|
||||||
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 "19-Jan-2026 14:09:03" {WMEDLEY}<library>UNIXUTILS.;55 20711
|
(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 "17-Jan-2026 23:16:17" {WMEDLEY}<library>UNIXUTILS.;54)
|
: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)))
|
||||||
@@ -287,7 +294,9 @@
|
|||||||
SLASHED])
|
SLASHED])
|
||||||
|
|
||||||
(UNIX-FILE-NAME
|
(UNIX-FILE-NAME
|
||||||
[LAMBDA (FILE ACCESS COPY EXTENSION) (* ; "Edited 19-Jan-2026 14:05 by rmk")
|
[LAMBDA (FILE ACCESS COPY EXTENSION) (* ; "Edited 31-Mar-2026 00:13 by rmk")
|
||||||
|
(* ; "Edited 29-Mar-2026 00:26 by rmk")
|
||||||
|
(* ; "Edited 19-Jan-2026 14:05 by rmk")
|
||||||
(* ; "Edited 17-Jan-2026 22:32 by rmk")
|
(* ; "Edited 17-Jan-2026 22:32 by rmk")
|
||||||
(* ; "Edited 11-Jan-2026 23:54 by rmk")
|
(* ; "Edited 11-Jan-2026 23:54 by rmk")
|
||||||
(* ; "Edited 27-Dec-2025 21:24 by rmk")
|
(* ; "Edited 27-Dec-2025 21:24 by rmk")
|
||||||
@@ -317,8 +326,13 @@
|
|||||||
FILE))
|
FILE))
|
||||||
(DSK [LET ((VERSION (FILENAMEFIELD FILE 'VERSION))
|
(DSK [LET ((VERSION (FILENAMEFIELD FILE 'VERSION))
|
||||||
(UNAME (PACKFILENAME 'VERSION NIL 'BODY FILE)))
|
(UNAME (PACKFILENAME 'VERSION NIL 'BODY FILE)))
|
||||||
(CL:UNLESS (EQ VERSION 1)
|
(CL:IF (EQ VERSION 1)
|
||||||
(CONCAT UNAME (CONCAT "~" VERSION "~")))])
|
UNAME
|
||||||
|
(CONCAT UNAME (CONCAT (CL:IF (EQ (CHARCODE %.)
|
||||||
|
(NTHCHARCODE UNAME -1))
|
||||||
|
""
|
||||||
|
".")
|
||||||
|
"~" VERSION "~")))])
|
||||||
(LET (UNAME)
|
(LET (UNAME)
|
||||||
|
|
||||||
(* ;; "Catch the streams as well as other devices (CORE, servers)")
|
(* ;; "Catch the streams as well as other devices (CORE, servers)")
|
||||||
@@ -358,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 20633
|
(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 . 18952) (
|
) (PROCESS-COMMAND 12200 . 12813) (SLASHIT 12815 . 16127) (UNIX-FILE-NAME 16129 . 20014) (
|
||||||
UNIX-TMP-FILE-NAME 18954 . 20631)))))
|
UNIX-TMP-FILE-NAME 20016 . 21693)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
@@ -1,13 +1,10 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "15-Feb-2025 14:11:54" {WMEDLEY}<library>lafite>LAFITE-INDENT.;4 26926
|
(FILECREATED "18-Feb-2026 15:47:08" {WMEDLEY}<library>LAFITE>LAFITE-INDENT.;2 26210
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS TEDIT-INDENT-BREAK-LONG-LINES TEDIT-INDENT-SELECTION TEDIT-OPEN-LINE
|
:PREVIOUS-DATE "22-Jan-87 01:34:36" {WMEDLEY}<library>LAFITE>LAFITE-INDENT.;1)
|
||||||
TEDIT-MAKE-LINES-EXPLICIT TEDIT-INDENT-SET-INDENT)
|
|
||||||
|
|
||||||
:PREVIOUS-DATE "15-Feb-2025 09:21:58" {WMEDLEY}<library>lafite>LAFITE-INDENT.;3)
|
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT LAFITE-INDENTCOMS)
|
(PRETTYCOMPRINT LAFITE-INDENTCOMS)
|
||||||
@@ -133,10 +130,14 @@
|
|||||||
max-length max-length])
|
max-length max-length])
|
||||||
|
|
||||||
(TEDIT-INDENT-BREAK-LONG-LINES
|
(TEDIT-INDENT-BREAK-LONG-LINES
|
||||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* ; "Edited 15-Feb-2025 14:07 by rmk")
|
[LAMBDA (text-stream explicit-paragraph-breaks?) (* smL "21-Jan-87 16:03")
|
||||||
(* smL "21-Jan-87 16:03")
|
|
||||||
|
(* * Break the current selection into explicit lines, each having no more than
|
||||||
(* ;;; "Break the current selection into explicit lines, each having no more than *TEDIT-INDENT-LINE-LENGTH* characters. --- If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in the current selection are removed. --- This is intended to be used in Lafite, where one wants to indent a piece of a forwarded document, but can be used in any TEdit document")
|
*TEDIT-INDENT-LINE-LENGTH* characters. -
|
||||||
|
If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in
|
||||||
|
the current selection are removed. -
|
||||||
|
This is intended to be used in Lafite, where one wants to indent a piece of a
|
||||||
|
forwarded document, but can be used in any TEdit document)
|
||||||
|
|
||||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||||
(TEDIT-INDENT-REPLACE-SELECTION
|
(TEDIT-INDENT-REPLACE-SELECTION
|
||||||
@@ -144,13 +145,11 @@
|
|||||||
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
|
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
|
||||||
text-stream selection)
|
text-stream selection)
|
||||||
explicit-paragraph-breaks?)
|
explicit-paragraph-breaks?)
|
||||||
bind [hanging-indent _ (AND [NOT (EQP (GETLD (CAR (GETSEL selection L1))
|
bind [hanging-indent _
|
||||||
LCHAR1)
|
(AND (NOT (EQP (fetch CHAR1 of (CAR (fetch L1 of selection)))
|
||||||
(TEDIT.SELPROP selection 'CH#]
|
(fetch CH# of selection)))
|
||||||
(DIFFERENCE (TEDIT.SELPROP selection
|
(DIFFERENCE (fetch CH# of selection)
|
||||||
'CH#)
|
(fetch CHAR1 of (CAR (fetch L1 of selection]
|
||||||
(GETLD (CAR (GETSEL selection L1))
|
|
||||||
LCHAR1]
|
|
||||||
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
|
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
|
||||||
"" *TEDIT-INDENT-LINE-LENGTH* hanging-indent)
|
"" *TEDIT-INDENT-LINE-LENGTH* hanging-indent)
|
||||||
*eol-string*)
|
*eol-string*)
|
||||||
@@ -185,10 +184,15 @@
|
|||||||
'RIGHT])
|
'RIGHT])
|
||||||
|
|
||||||
(TEDIT-INDENT-SELECTION
|
(TEDIT-INDENT-SELECTION
|
||||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* ; "Edited 15-Feb-2025 14:07 by rmk")
|
[LAMBDA (text-stream explicit-paragraph-breaks?) (* smL "21-Jan-87 16:00")
|
||||||
(* smL "21-Jan-87 16:00")
|
|
||||||
|
(* * Indent the current selection by prefacing each line with the value of
|
||||||
(* ;;; "Indent the current selection by prefacing each line with the value of *TEDIT-INDENT-STRING*, and inserting line breaks after each *TEDIT-INDENT-LINE-LENGTH* characters. --- If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in the current selection are removed. --- This is intended to be used in Lafite, where one wants to indent a piece of a forwarded document, but can be used in any TEdit document")
|
*TEDIT-INDENT-STRING*, and inserting line breaks after each
|
||||||
|
*TEDIT-INDENT-LINE-LENGTH* characters. -
|
||||||
|
If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in
|
||||||
|
the current selection are removed. -
|
||||||
|
This is intended to be used in Lafite, where one wants to indent a piece of a
|
||||||
|
forwarded document, but can be used in any TEdit document)
|
||||||
|
|
||||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||||
(TEDIT-INDENT-REPLACE-SELECTION
|
(TEDIT-INDENT-REPLACE-SELECTION
|
||||||
@@ -196,13 +200,11 @@
|
|||||||
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
|
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
|
||||||
text-stream selection)
|
text-stream selection)
|
||||||
explicit-paragraph-breaks?)
|
explicit-paragraph-breaks?)
|
||||||
bind [hanging-indent _ (AND [NOT (EQP (GETLD (CAR (GETSEL selection L1))
|
bind [hanging-indent _
|
||||||
LCHAR1)
|
(AND (NOT (EQP (fetch CHAR1 of (CAR (fetch L1 of selection)))
|
||||||
(TEDIT.SELPROP selection 'CH#]
|
(fetch CH# of selection)))
|
||||||
(DIFFERENCE (TEDIT.SELPROP selection
|
(DIFFERENCE (fetch CH# of selection)
|
||||||
'CH#)
|
(fetch CHAR1 of (CAR (fetch L1 of selection]
|
||||||
(GETLD (CAR (GETSEL selection L1))
|
|
||||||
LCHAR1]
|
|
||||||
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
|
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
|
||||||
*TEDIT-INDENT-STRING* *TEDIT-INDENT-LINE-LENGTH*
|
*TEDIT-INDENT-STRING* *TEDIT-INDENT-LINE-LENGTH*
|
||||||
hanging-indent)
|
hanging-indent)
|
||||||
@@ -232,19 +234,18 @@
|
|||||||
else (\TEDIT-INDENT-SEPERATE-PARAGRAPHS string NIL])
|
else (\TEDIT-INDENT-SEPERATE-PARAGRAPHS string NIL])
|
||||||
|
|
||||||
(TEDIT-INDENT-SET-INDENT
|
(TEDIT-INDENT-SET-INDENT
|
||||||
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 09:21 by rmk")
|
[LAMBDA (text-stream) (* smL "12-Sep-86 17:09")
|
||||||
(* smL "12-Sep-86 17:09")
|
|
||||||
|
(* * Prompt the user for a new indentation string)
|
||||||
|
|
||||||
(* ;;; "Prompt the user for a new indentation string")
|
(LET* ((window (fetch \WINDOW of (TEXTOBJ text-stream)))
|
||||||
|
|
||||||
(LET* ((window (\TEDIT.PRIMARYPANE text-stream))
|
|
||||||
(pwindow (if window
|
(pwindow (if window
|
||||||
then (GETPROMPTWINDOW (if (LISTP window)
|
then (GETPROMPTWINDOW (if (LISTP window)
|
||||||
then (CAR window)
|
then (CAR window)
|
||||||
else window))
|
else window))
|
||||||
else PROMPTWINDOW)))
|
else PROMPTWINDOW)))
|
||||||
(CLEARW pwindow)
|
(CLEARW pwindow)
|
||||||
(SETQ *TEDIT-INDENT-STRING* (PROMPTFORWORD "New indent string: " *TEDIT-INDENT-STRING* NIL
|
(SETQ *TEDIT-INDENT-STRING* (PROMPTFORWORD "New indent string: " *TEDIT-INDENT-STRING* NIL
|
||||||
pwindow NIL NIL (LIST (CHARCODE EOL])
|
pwindow NIL NIL (LIST (CHARCODE EOL])
|
||||||
|
|
||||||
(TEDIT-INDENT-STRIP-INDENTATION
|
(TEDIT-INDENT-STRIP-INDENTATION
|
||||||
@@ -269,34 +270,36 @@
|
|||||||
else string])
|
else string])
|
||||||
|
|
||||||
(TEDIT-MAKE-LINES-EXPLICIT
|
(TEDIT-MAKE-LINES-EXPLICIT
|
||||||
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 09:20 by rmk")
|
[LAMBDA (text-stream) (* smL " 8-Sep-86 18:20")
|
||||||
(* smL " 8-Sep-86 18:20")
|
|
||||||
|
(* * Take the current selection and replace all TEdit end-of-lines with
|
||||||
(* ;;; "Take the current selection and replace all TEdit end-of-lines with explicit line breaks. --- This is intended to be used in Lafite, where it is sometimes nice to know that anyone receiving the msg will see the same line breaks that you see. see, but can be used in any TEdit document")
|
explicit line breaks. -
|
||||||
|
This is intended to be used in Lafite, where it is sometimes nice to know that
|
||||||
|
anyone receiving the msg will see the same line breaks that you see.
|
||||||
|
see, but can be used in any TEdit document)
|
||||||
|
|
||||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||||
[for i in (bind (this-line _ (CAR (GETSEL selection L1)))
|
[for i in (bind (this-line _ (CAR (fetch L1 of selection)))
|
||||||
[last-line _ (CAR (LAST (GETSEL selection LN]
|
[last-line _ (CAR (LAST (fetch LN of selection]
|
||||||
repeatuntil (PROGN (SETQ this-line (GETLD this-line NEXTLINE))
|
repeatuntil (PROGN (SETQ this-line (fetch NEXTLINE of this-line))
|
||||||
(EQ this-line last-line)) collect (GETLD this-line LCHARLIM)
|
(EQ this-line last-line)) collect (fetch CHARLIM
|
||||||
) do (TEDIT.SETSEL text-stream i 1 'LEFT T)
|
of this-line))
|
||||||
(TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
|
do (TEDIT.SETSEL text-stream i 1 'LEFT T)
|
||||||
|
(TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
|
||||||
(TEDIT.SETSEL text-stream selection NIL 'RIGHT])
|
(TEDIT.SETSEL text-stream selection NIL 'RIGHT])
|
||||||
|
|
||||||
(TEDIT-OPEN-LINE
|
(TEDIT-OPEN-LINE
|
||||||
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 14:09 by rmk")
|
[LAMBDA (text-stream) (* smL "17-Sep-86 11:13")
|
||||||
(* smL "17-Sep-86 11:13")
|
|
||||||
|
(* * Open a new line at the current position.)
|
||||||
(* ;;; "Open a new line at the current position.")
|
|
||||||
|
|
||||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||||
(TEDIT.INSERT text-stream (CONCAT *eol-string* (ALLOCSTRING
|
(TEDIT.INSERT text-stream (CONCAT *eol-string*
|
||||||
(DIFFERENCE (TEDIT.SELPROP selection
|
(ALLOCSTRING [DIFFERENCE (fetch CH# of selection)
|
||||||
'CH#)
|
(fetch CHAR1
|
||||||
(GETLD (CAR (GETSEL selection L1))
|
of (CAR (fetch L1 of selection]
|
||||||
LCHAR1))
|
" ")))
|
||||||
" ")))
|
(if (ZEROP (fetch DCH of selection))
|
||||||
(if (ZEROP (TEDIT.SELPROP selection 'LENGTH))
|
|
||||||
then (TEDIT.SETSEL text-stream selection])
|
then (TEDIT.SETSEL text-stream selection])
|
||||||
|
|
||||||
(TEDIT-REMOVE-INDENT
|
(TEDIT-REMOVE-INDENT
|
||||||
@@ -433,12 +436,12 @@
|
|||||||
"Break long lines by inserting explicit <RETURN>'s"
|
"Break long lines by inserting explicit <RETURN>'s"
|
||||||
]
|
]
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (4363 24314 (TEDIT-INDENT-ADD-INDENTATION 4373 . 6941) (TEDIT-INDENT-BREAK-LINE 6943 .
|
(FILEMAP (NIL (4193 23598 (TEDIT-INDENT-ADD-INDENTATION 4203 . 6771) (TEDIT-INDENT-BREAK-LINE 6773 .
|
||||||
8876) (TEDIT-INDENT-BREAK-LONG-LINES 8878 . 10828) (TEDIT-INDENT-FIND-BREAKPOINT 10830 . 11653) (
|
8706) (TEDIT-INDENT-BREAK-LONG-LINES 8708 . 10475) (TEDIT-INDENT-FIND-BREAKPOINT 10477 . 11300) (
|
||||||
TEDIT-INDENT-REPLACE-SELECTION 11655 . 12212) (TEDIT-INDENT-SELECTION 12214 . 14283) (
|
TEDIT-INDENT-REPLACE-SELECTION 11302 . 11859) (TEDIT-INDENT-SELECTION 11861 . 13762) (
|
||||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 14285 . 14564) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 14566 .
|
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 13764 . 14043) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 14045 .
|
||||||
15295) (TEDIT-INDENT-SET-INDENT 15297 . 16143) (TEDIT-INDENT-STRIP-INDENTATION 16145 . 17365) (
|
14774) (TEDIT-INDENT-SET-INDENT 14776 . 15550) (TEDIT-INDENT-STRIP-INDENTATION 15552 . 16772) (
|
||||||
TEDIT-MAKE-LINES-EXPLICIT 17367 . 18517) (TEDIT-OPEN-LINE 18519 . 19453) (TEDIT-REMOVE-INDENT 19455 .
|
TEDIT-MAKE-LINES-EXPLICIT 16774 . 17979) (TEDIT-OPEN-LINE 17981 . 18737) (TEDIT-REMOVE-INDENT 18739 .
|
||||||
20225) (\TEDIT-INDENT-COUNT-SPACES 20227 . 20828) (\TEDIT-INDENT-FIND-PARAGRAPH-END 20830 . 21801) (
|
19509) (\TEDIT-INDENT-COUNT-SPACES 19511 . 20112) (\TEDIT-INDENT-FIND-PARAGRAPH-END 20114 . 21085) (
|
||||||
\TEDIT-INDENT-SEPERATE-LINES 21803 . 22601) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 22603 . 24312)))))
|
\TEDIT-INDENT-SEPERATE-LINES 21087 . 21885) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 21887 . 23596)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
@@ -1,30 +1,28 @@
|
|||||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
(FILECREATED "19-Jan-87 23:56:51" {ERIS}<LISPUSERS>LISPCORE>LAFITEPRIVATEDL.;1 10080
|
|
||||||
|
|
||||||
previous date%: "19-Jan-87 23:47:54" {PHYLUM}<LISPUSERS>KOTO>LAFITEPRIVATEDL.;2)
|
(FILECREATED "18-Feb-2026 15:50:14" {WMEDLEY}<library>lafite>LAFITE-PRIVATEDL.;2 9719
|
||||||
|
|
||||||
|
:EDIT-BY rmk
|
||||||
|
|
||||||
|
:CHANGES-TO (FNS \GV.PARSERECIPIENTS1 \GV.PARSE.PRIVATE.DISTRIBUTION.LIST))
|
||||||
|
|
||||||
|
|
||||||
(* "
|
(PRETTYCOMPRINT LAFITE-PRIVATEDLCOMS)
|
||||||
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
|
||||||
")
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT LAFITEPRIVATEDLCOMS)
|
(RPAQQ LAFITE-PRIVATEDLCOMS
|
||||||
|
((* * LAFITEDL.EXT is the default extension for dl files when no extension is specified)
|
||||||
(RPAQQ LAFITEPRIVATEDLCOMS ((* * LAFITEDL.EXT is the default extension for dl files when no extension
|
(* * LAFITEDLDIRECTORIES is a list of directories to be searched after the connected
|
||||||
is specified)
|
directory and the LAFITEDEFAULTHOST&DIR in order to locate a dl file when no host or
|
||||||
(* * LAFITEDLDIRECTORIES is a list of directories to be searched after
|
directory is specified)
|
||||||
the connected directory and the LAFITEDEFAULTHOST&DIR in order to
|
(INITVARS (LAFITEDL.EXT 'DL)
|
||||||
locate a dl file when no host or directory is specified)
|
(LAFITEDLDIRECTORIES NIL))
|
||||||
(INITVARS (LAFITEDL.EXT 'DL)
|
(* * no functions are user callable)
|
||||||
(LAFITEDLDIRECTORIES NIL))
|
(FNS \GV.PARSERECIPIENTS1 \GV.PARSE.PRIVATE.DISTRIBUTION.LIST)
|
||||||
(* * no functions are user callable)
|
(* Lafite's readtable for parsing addresses needs to have CR as a SEPRCHAR so that lines from
|
||||||
(FNS \GV.PARSERECIPIENTS1 \GV.PARSE.PRIVATE.DISTRIBUTION.LIST)
|
a text file can all be parsed at once. This has no effect on normal operation since before
|
||||||
(* Lafite's readtable for parsing addresses needs to have CR as a
|
private dls no CR was ever passed to the parser)
|
||||||
SEPRCHAR so that lines from a text file can all be parsed at once.
|
(P (SETSYNTAX (CHARCODE CR)
|
||||||
This has no effect on normal operation since before private dls no CR
|
'SEPRCHAR ADDRESSPARSERRDTBL))))
|
||||||
was ever passed to the parser)
|
|
||||||
(P (SETSYNTAX (CHARCODE CR)
|
|
||||||
'SEPRCHAR ADDRESSPARSERRDTBL))))
|
|
||||||
(* * LAFITEDL.EXT is the default extension for dl files when no extension is specified)
|
(* * LAFITEDL.EXT is the default extension for dl files when no extension is specified)
|
||||||
|
|
||||||
(* * LAFITEDLDIRECTORIES is a list of directories to be searched after the connected directory and the
|
(* * LAFITEDLDIRECTORIES is a list of directories to be searched after the connected directory and the
|
||||||
@@ -39,7 +37,7 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\GV.PARSERECIPIENTS1
|
(\GV.PARSERECIPIENTS1
|
||||||
[LAMBDA (FIELD REGISTRY INTERNALFLG EDITWINDOW) (* N.H.Briggs "19-Jan-87 23:44")
|
[LAMBDA (FIELD REGISTRY INTERNALFLG EDITWINDOW) (* N.H.Briggs "19-Jan-87 23:44")
|
||||||
|
|
||||||
(* ;;; "INTERNALFLG = T means produce addresses to give Grapevine; NIL means give human-readable addresses")
|
(* ;;; "INTERNALFLG = T means produce addresses to give Grapevine; NIL means give human-readable addresses")
|
||||||
|
|
||||||
@@ -73,8 +71,8 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
|||||||
(CHARCODE %"))
|
(CHARCODE %"))
|
||||||
(HELP]
|
(HELP]
|
||||||
(OR REGISTRY (SETQ REGISTRY DEFAULTREGISTRY))
|
(OR REGISTRY (SETQ REGISTRY DEFAULTREGISTRY))
|
||||||
|
|
||||||
(* ;; "first just collect all the atoms using a special readtable ")
|
(* ;; "first just collect all the atoms using a special readtable ")
|
||||||
|
|
||||||
(SETQ ADDRESSES (when (SETQ ADDR (until (OR (EOFP FIELDSTREAM)
|
(SETQ ADDRESSES (when (SETQ ADDR (until (OR (EOFP FIELDSTREAM)
|
||||||
(EQ (SETQ TOKEN (READ FIELDSTREAM
|
(EQ (SETQ TOKEN (READ FIELDSTREAM
|
||||||
@@ -107,14 +105,13 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
|||||||
(EQ (CADDR ADDRESS)
|
(EQ (CADDR ADDRESS)
|
||||||
';))
|
';))
|
||||||
then
|
then
|
||||||
|
(* ;; "it's a private dl --- foo:;")
|
||||||
(* ;; "it's a private dl --- foo:;")
|
|
||||||
|
|
||||||
(\GV.PARSE.PRIVATE.DISTRIBUTION.LIST ADDRESS REGISTRY INTERNALFLG
|
(\GV.PARSE.PRIVATE.DISTRIBUTION.LIST ADDRESS REGISTRY INTERNALFLG
|
||||||
EDITWINDOW)
|
EDITWINDOW)
|
||||||
else
|
else
|
||||||
|
(* ;;
|
||||||
(* ;; "ADDRESS will only get rebound if there is an address with <>'s in it ")
|
"ADDRESS will only get rebound if there is an address with <>'s in it ")
|
||||||
|
|
||||||
(SETQ VALIDRECIPIENT (\GV.PARSE.SINGLE.ADDRESS
|
(SETQ VALIDRECIPIENT (\GV.PARSE.SINGLE.ADDRESS
|
||||||
(COND
|
(COND
|
||||||
@@ -128,8 +125,8 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
|||||||
((OR T INTERNALFLG (NULL REALADDRESS))
|
((OR T INTERNALFLG (NULL REALADDRESS))
|
||||||
VALIDRECIPIENT)
|
VALIDRECIPIENT)
|
||||||
(T
|
(T
|
||||||
|
|
||||||
(* ;; "Need to figure out how to make GETREGISTRY of this work, and remove duplicates in MAKEANSWERFORM before we can enable this")
|
(* ;; "Need to figure out how to make GETREGISTRY of this work, and remove duplicates in MAKEANSWERFORM before we can enable this")
|
||||||
|
|
||||||
(\GV.REPACKADDRESS (APPEND (LDIFF ADDRESS OPEN)
|
(\GV.REPACKADDRESS (APPEND (LDIFF ADDRESS OPEN)
|
||||||
(LIST '< VALIDRECIPIENT
|
(LIST '< VALIDRECIPIENT
|
||||||
@@ -137,7 +134,7 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
|||||||
(CDR CLOSE])
|
(CDR CLOSE])
|
||||||
|
|
||||||
(\GV.PARSE.PRIVATE.DISTRIBUTION.LIST
|
(\GV.PARSE.PRIVATE.DISTRIBUTION.LIST
|
||||||
[LAMBDA (DL REGISTRY INTERNALFLG EDITWINDOW) (* N.H.Briggs "19-Jan-87 23:45")
|
[LAMBDA (DL REGISTRY INTERNALFLG EDITWINDOW) (* N.H.Briggs "19-Jan-87 23:45")
|
||||||
(LET* [(FILENAME (FINDFILE (PACKFILENAME.STRING 'BODY (CAR DL)
|
(LET* [(FILENAME (FINDFILE (PACKFILENAME.STRING 'BODY (CAR DL)
|
||||||
'EXTENSION LAFITEDL.EXT)
|
'EXTENSION LAFITEDL.EXT)
|
||||||
T
|
T
|
||||||
@@ -162,10 +159,10 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
|||||||
file can all be parsed at once. This has no effect on normal operation since before private dls no CR
|
file can all be parsed at once. This has no effect on normal operation since before private dls no CR
|
||||||
was ever passed to the parser)
|
was ever passed to the parser)
|
||||||
|
|
||||||
|
|
||||||
(SETSYNTAX (CHARCODE CR)
|
(SETSYNTAX (CHARCODE CR)
|
||||||
'SEPRCHAR ADDRESSPARSERRDTBL)
|
'SEPRCHAR ADDRESSPARSERRDTBL)
|
||||||
(PUTPROPS LAFITEPRIVATEDL COPYRIGHT ("Xerox Corporation" 1986 1987))
|
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (1965 9682 (\GV.PARSERECIPIENTS1 1975 . 8562) (\GV.PARSE.PRIVATE.DISTRIBUTION.LIST 8564
|
(FILEMAP (NIL (1617 9389 (\GV.PARSERECIPIENTS1 1627 . 8273) (\GV.PARSE.PRIVATE.DISTRIBUTION.LIST 8275
|
||||||
. 9680)))))
|
. 9387)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
BIN
library/lafite/LAFITE-PRIVATEDL.LCOM
Normal file
BIN
library/lafite/LAFITE-PRIVATEDL.LCOM
Normal file
Binary file not shown.
File diff suppressed because it is too large
Load Diff
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 22:45:39" {WMEDLEY}<library>TEDIT>TEDIT.;847 145111
|
(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 "24-Dec-2025 11:23:12" {WMEDLEY}<library>TEDIT>TEDIT.;846)
|
:PREVIOUS-DATE " 2-Mar-2026 18:32:06" {WMEDLEY}<library>tedit>TEDIT.;853)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDITCOMS)
|
(PRETTYCOMPRINT TEDITCOMS)
|
||||||
@@ -28,9 +28,7 @@
|
|||||||
|
|
||||||
(EXPORT (FILES (FROM LOADUPS)
|
(EXPORT (FILES (FROM LOADUPS)
|
||||||
EXPORTS.ALL)))
|
EXPORTS.ALL)))
|
||||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL))
|
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL)))
|
||||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
|
||||||
UNICODE)))
|
|
||||||
[DECLARE%: EVAL@COMPILE DONTCOPY
|
[DECLARE%: EVAL@COMPILE DONTCOPY
|
||||||
|
|
||||||
(* ;; "Assertions go to comments if not being checked, so we see value-warnings")
|
(* ;; "Assertions go to comments if not being checked, so we see value-warnings")
|
||||||
@@ -47,7 +45,7 @@
|
|||||||
|
|
||||||
(FNS TEDIT TEXTSTREAM TEXTSTREAMP COERCETEXTSTREAM TEDIT.CONCAT TEDITSTRING TEDIT-SEE
|
(FNS TEDIT TEXTSTREAM TEXTSTREAMP COERCETEXTSTREAM TEDIT.CONCAT TEDITSTRING TEDIT-SEE
|
||||||
TEDIT.COPY TEDIT.DELETE TEDIT.INSERT TEDIT.TERPRI TEDIT.KILL TEDIT.QUIT TEDIT.MOVE
|
TEDIT.COPY TEDIT.DELETE TEDIT.INSERT TEDIT.TERPRI TEDIT.KILL TEDIT.QUIT TEDIT.MOVE
|
||||||
TEDIT.STRINGWIDTH TEDIT.CHARWIDTH)
|
TEDIT.STRINGWIDTH TEDIT.CHARWIDTH TEDIT.PARAGRAPH.BOUNDARIES)
|
||||||
(FNS TEXTOBJ COERCETEXTOBJ)
|
(FNS TEXTOBJ COERCETEXTOBJ)
|
||||||
(MACROS TEVAL)
|
(MACROS TEVAL)
|
||||||
(FNS TDRIBBLE)
|
(FNS TDRIBBLE)
|
||||||
@@ -157,11 +155,6 @@
|
|||||||
(FILESLOAD TEDIT-EXPORTS.ALL)
|
(FILESLOAD TEDIT-EXPORTS.ALL)
|
||||||
)
|
)
|
||||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||||
|
|
||||||
(FILESLOAD (LOADCOMP)
|
|
||||||
UNICODE)
|
|
||||||
)
|
|
||||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
|
||||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||||
|
|
||||||
(PUTPROPS TEDIT-ASSERT MACRO [ARGS (COND
|
(PUTPROPS TEDIT-ASSERT MACRO [ARGS (COND
|
||||||
@@ -676,6 +669,26 @@
|
|||||||
(CR (IMAX 6 (CHARWIDTH CH FONT)))
|
(CR (IMAX 6 (CHARWIDTH CH FONT)))
|
||||||
(TAB 36)
|
(TAB 36)
|
||||||
(CHARWIDTH CH FONT])
|
(CHARWIDTH CH FONT])
|
||||||
|
|
||||||
|
(TEDIT.PARAGRAPH.BOUNDARIES
|
||||||
|
[LAMBDA (TSTREAM SELORCH# PROTECTEDNOTOK) (* ; "Edited 2-Feb-2026 23:05 by rmk")
|
||||||
|
|
||||||
|
(* ;; "Returns a pair (FIRSTCH# LASTCH#) where FIRSTCH# is the character number of the first character of the paragraph that contains the beginning of the selection, and LASTCH# is the last character number of the last character of the paragraph that contains the end of the selection.")
|
||||||
|
|
||||||
|
(* ;;
|
||||||
|
"If PROTECTIONNOTOK, the scans stop at any protected piece (e.g. doesn't cross menu boiler plate).")
|
||||||
|
|
||||||
|
(LET ((TEXTOBJ (TEXTOBJ TSTREAM)))
|
||||||
|
(CL:UNLESS SELORCH#
|
||||||
|
(SETQ SELORCH# (TEXTSEL TEXTOBJ)))
|
||||||
|
(LIST (CAR (\TEDIT.PARA.FIRST TEXTOBJ (CL:IF (type? SELECTION SELORCH#)
|
||||||
|
(GETSEL SELORCH# CH#)
|
||||||
|
SELORCH#)
|
||||||
|
PROTECTEDNOTOK))
|
||||||
|
(CAR (\TEDIT.PARA.LAST TEXTOBJ (CL:IF (type? SELECTION SELORCH#)
|
||||||
|
(GETSEL SELORCH# CHLAST)
|
||||||
|
SELORCH#)
|
||||||
|
PROTECTEDNOTOK])
|
||||||
)
|
)
|
||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
@@ -730,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)
|
||||||
@@ -912,7 +929,8 @@
|
|||||||
else (TEDIT.PROMPTPRINT TSTREAM "Changed object not found in document" T])
|
else (TEDIT.PROMPTPRINT TSTREAM "Changed object not found in document" T])
|
||||||
|
|
||||||
(TEDIT.MAP.OBJECTS
|
(TEDIT.MAP.OBJECTS
|
||||||
[LAMBDA (TSTREAM FN FNARG COLLECT?) (* ; "Edited 25-Feb-2025 15:06 by rmk")
|
[LAMBDA (TSTREAM FN FNARG COLLECT?) (* ; "Edited 4-Feb-2026 16:01 by rmk")
|
||||||
|
(* ; "Edited 25-Feb-2025 15:06 by rmk")
|
||||||
(* ; "Edited 23-Apr-2024 09:15 by rmk")
|
(* ; "Edited 23-Apr-2024 09:15 by rmk")
|
||||||
(* ; "Edited 16-Mar-2024 10:03 by rmk")
|
(* ; "Edited 16-Mar-2024 10:03 by rmk")
|
||||||
(* ; "Edited 4-Mar-2024 16:12 by rmk")
|
(* ; "Edited 4-Mar-2024 16:12 by rmk")
|
||||||
@@ -932,8 +950,7 @@
|
|||||||
(NIL)
|
(NIL)
|
||||||
(OBJECT (PUSH $$VAL OBJ))
|
(OBJECT (PUSH $$VAL OBJ))
|
||||||
(CH# (PUSH $$VAL CH#))
|
(CH# (PUSH $$VAL CH#))
|
||||||
(VALUE (PUSH $$VAL CH#)
|
(VALUE (PUSH $$VAL FNVAL))
|
||||||
FNVAL)
|
|
||||||
(FIRST (RETURN (LIST CH# OBJ FNVAL)))
|
(FIRST (RETURN (LIST CH# OBJ FNVAL)))
|
||||||
(PUSH $$VAL (LIST CH# OBJ FNVAL)))
|
(PUSH $$VAL (LIST CH# OBJ FNVAL)))
|
||||||
(CL:WHEN (EQ FNVAL 'STOP)
|
(CL:WHEN (EQ FNVAL 'STOP)
|
||||||
@@ -1325,7 +1342,9 @@
|
|||||||
(CL:WHEN TYPEIN (\TEDIT.SCROLL.CARET TSTREAM)))])])
|
(CL:WHEN TYPEIN (\TEDIT.SCROLL.CARET TSTREAM)))])])
|
||||||
|
|
||||||
(\TEDIT.MOVE
|
(\TEDIT.MOVE
|
||||||
[LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 7-May-2025 00:12 by rmk")
|
[LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 31-Jan-2026 11:48 by rmk")
|
||||||
|
(* ; "Edited 10-Jan-2026 01:38 by rmk")
|
||||||
|
(* ; "Edited 7-May-2025 00:12 by rmk")
|
||||||
(* ; "Edited 22-Apr-2025 09:21 by rmk")
|
(* ; "Edited 22-Apr-2025 09:21 by rmk")
|
||||||
(* ; "Edited 16-Apr-2025 09:01 by rmk")
|
(* ; "Edited 16-Apr-2025 09:01 by rmk")
|
||||||
(* ; "Edited 6-Apr-2025 14:14 by rmk")
|
(* ; "Edited 6-Apr-2025 14:14 by rmk")
|
||||||
@@ -1385,7 +1404,7 @@
|
|||||||
(CL:WHEN (AND (FGETTOBJ TOOBJ BLUEPENDINGDELETE)
|
(CL:WHEN (AND (FGETTOBJ TOOBJ BLUEPENDINGDELETE)
|
||||||
(IGREATERP TODCH 0))
|
(IGREATERP TODCH 0))
|
||||||
(FSETTOBJ TOOBJ BLUEPENDINGDELETE NIL)
|
(FSETTOBJ TOOBJ BLUEPENDINGDELETE NIL)
|
||||||
(CL:UNLESS (\TEDIT.DELETE TOOBJ TOSEL)
|
(CL:UNLESS (\TEDIT.DELETE TOTSTREAM TOSEL)
|
||||||
(RETURN NIL))
|
(RETURN NIL))
|
||||||
(SETQ BPD T)
|
(SETQ BPD T)
|
||||||
(CL:WHEN (EQ TOOBJ FROMOBJ) (* ; "Same text, pre-adjust the source")
|
(CL:WHEN (EQ TOOBJ FROMOBJ) (* ; "Same text, pre-adjust the source")
|
||||||
@@ -1421,15 +1440,14 @@
|
|||||||
|
|
||||||
(* ;; "Pop to accumulate into a single event (BPD, DELETE, INSERT).")
|
(* ;; "Pop to accumulate into a single event (BPD, DELETE, INSERT).")
|
||||||
|
|
||||||
else (\TEDIT.DELETE FROMOBJ FROMSEL NIL NIL T))
|
else (\TEDIT.DELETE FROMTSTREAM FROMSEL NIL NIL T))
|
||||||
|
|
||||||
(* ;; "Deletion accomplished possibly in separate FROMOBJ with its own history.")
|
(* ;; "Deletion accomplished possibly in separate FROMOBJ with its own history.")
|
||||||
|
|
||||||
(* ;; "")
|
(* ;; "")
|
||||||
|
|
||||||
(CL:WHEN (GETTEXTPROP TOOBJ 'COPYBYBKSYSBUF)
|
(CL:WHEN (GETTEXTPROP TOOBJ 'COPYBYBKSYSBUF)
|
||||||
(\TEDIT.FOREIGN.COPY (WFROMDS TOTSTREAM)
|
(\TEDIT.FOREIGN.COPY FROMSEL FROMTSTREAM T)
|
||||||
FROMSEL T)
|
|
||||||
(CL:WHEN BPD (* ; "If no BPD, TO history is good")
|
(CL:WHEN BPD (* ; "If no BPD, TO history is good")
|
||||||
(\TEDIT.HISTORYADD.COMPOSITE TOOBJ TOOBJ (LIST (\TEDIT.POPEVENT TOOBJ)
|
(\TEDIT.HISTORYADD.COMPOSITE TOOBJ TOOBJ (LIST (\TEDIT.POPEVENT TOOBJ)
|
||||||
(\TEDIT.POPEVENT TOOBJ))))
|
(\TEDIT.POPEVENT TOOBJ))))
|
||||||
@@ -1448,7 +1466,8 @@
|
|||||||
(CL:IF BPD (\TEDIT.POPEVENT TOOBJ])])
|
(CL:IF BPD (\TEDIT.POPEVENT TOOBJ])])
|
||||||
|
|
||||||
(\TEDIT.COPY
|
(\TEDIT.COPY
|
||||||
[LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 7-May-2025 00:12 by rmk")
|
[LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 31-Jan-2026 11:48 by rmk")
|
||||||
|
(* ; "Edited 7-May-2025 00:12 by rmk")
|
||||||
(* ; "Edited 22-Apr-2025 09:12 by rmk")
|
(* ; "Edited 22-Apr-2025 09:12 by rmk")
|
||||||
(* ; "Edited 6-Apr-2025 14:16 by rmk")
|
(* ; "Edited 6-Apr-2025 14:16 by rmk")
|
||||||
(* ; "Edited 5-Apr-2025 13:19 by rmk")
|
(* ; "Edited 5-Apr-2025 13:19 by rmk")
|
||||||
@@ -1497,8 +1516,7 @@
|
|||||||
(* ;; "")
|
(* ;; "")
|
||||||
|
|
||||||
(CL:WHEN (GETTEXTPROP TOOBJ 'COPYBYBKSYSBUF)
|
(CL:WHEN (GETTEXTPROP TOOBJ 'COPYBYBKSYSBUF)
|
||||||
(\TEDIT.FOREIGN.COPY (WFROMDS TOTSTREAM)
|
(\TEDIT.FOREIGN.COPY FROMSEL FROMTSTREAM T)
|
||||||
FROMSEL T)
|
|
||||||
(RETURN))
|
(RETURN))
|
||||||
|
|
||||||
(* ;; "")
|
(* ;; "")
|
||||||
@@ -2331,27 +2349,27 @@
|
|||||||
|
|
||||||
(DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE))
|
(DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE))
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (4840 7234 (MAKE-TEDIT-EXPORTS.ALL 4850 . 5396) (UPDATE-TEDIT 5398 . 6327) (EDIT-TEDIT
|
(FILEMAP (NIL (4736 7130 (MAKE-TEDIT-EXPORTS.ALL 4746 . 5292) (UPDATE-TEDIT 5294 . 6223) (EDIT-TEDIT
|
||||||
6329 . 7232)) (8664 36442 (TEDIT 8674 . 11288) (TEXTSTREAM 11290 . 13179) (TEXTSTREAMP 13181 . 13565)
|
6225 . 7128)) (8485 37484 (TEDIT 8495 . 11109) (TEXTSTREAM 11111 . 13000) (TEXTSTREAMP 13002 . 13386)
|
||||||
(COERCETEXTSTREAM 13567 . 17778) (TEDIT.CONCAT 17780 . 21082) (TEDITSTRING 21084 . 21998) (TEDIT-SEE
|
(COERCETEXTSTREAM 13388 . 17599) (TEDIT.CONCAT 17601 . 20903) (TEDITSTRING 20905 . 21819) (TEDIT-SEE
|
||||||
22000 . 22684) (TEDIT.COPY 22686 . 24831) (TEDIT.DELETE 24833 . 26194) (TEDIT.INSERT 26196 . 29165) (
|
21821 . 22505) (TEDIT.COPY 22507 . 24652) (TEDIT.DELETE 24654 . 26015) (TEDIT.INSERT 26017 . 28986) (
|
||||||
TEDIT.TERPRI 29167 . 30281) (TEDIT.KILL 30283 . 31265) (TEDIT.QUIT 31267 . 32633) (TEDIT.MOVE 32635 .
|
TEDIT.TERPRI 28988 . 30102) (TEDIT.KILL 30104 . 31086) (TEDIT.QUIT 31088 . 32454) (TEDIT.MOVE 32456 .
|
||||||
33523) (TEDIT.STRINGWIDTH 33525 . 34196) (TEDIT.CHARWIDTH 34198 . 36440)) (36443 38384 (TEXTOBJ 36453
|
33344) (TEDIT.STRINGWIDTH 33346 . 34017) (TEDIT.CHARWIDTH 34019 . 36261) (TEDIT.PARAGRAPH.BOUNDARIES
|
||||||
. 36918) (COERCETEXTOBJ 36920 . 38382)) (39784 41434 (TDRIBBLE 39794 . 41432)) (41475 53371 (
|
36263 . 37482)) (37485 39426 (TEXTOBJ 37495 . 37960) (COERCETEXTOBJ 37962 . 39424)) (40826 42825 (
|
||||||
TEDIT.INSERT.OBJECT 41485 . 45192) (TEDIT.EDIT.OBJECT 45194 . 48134) (TEDIT.OBJECT.CHANGED 48136 .
|
TDRIBBLE 40836 . 42823)) (42866 54846 (TEDIT.INSERT.OBJECT 42876 . 46583) (TEDIT.EDIT.OBJECT 46585 .
|
||||||
51326) (TEDIT.MAP.OBJECTS 51328 . 52899) (\TEDIT.FIRST.OBJPIECE 52901 . 53134) (\TEDIT.NEXT.OBJPIECE
|
49525) (TEDIT.OBJECT.CHANGED 49527 . 52717) (TEDIT.MAP.OBJECTS 52719 . 54374) (\TEDIT.FIRST.OBJPIECE
|
||||||
53136 . 53369)) (53394 60837 (\TEDIT.CONCAT.PAGEFRAMES 53404 . 58471) (\TEDIT.GET.PAGE.HEADINGS 58473
|
54376 . 54609) (\TEDIT.NEXT.OBJPIECE 54611 . 54844)) (54869 62312 (\TEDIT.CONCAT.PAGEFRAMES 54879 .
|
||||||
. 59502) (\TEDIT.CONCAT.INSTALL.HEADINGS 59504 . 60835)) (60838 64445 (\TEDIT.MOVE.MSG 60848 . 62929)
|
59946) (\TEDIT.GET.PAGE.HEADINGS 59948 . 60977) (\TEDIT.CONCAT.INSTALL.HEADINGS 60979 . 62310)) (62313
|
||||||
(\TEDIT.READONLY 62931 . 64443)) (64446 70337 (TEDIT.NCHARS 64456 . 64829) (TEDIT.RPLCHARCODE 64831
|
65920 (\TEDIT.MOVE.MSG 62323 . 64404) (\TEDIT.READONLY 64406 . 65918)) (65921 71812 (TEDIT.NCHARS
|
||||||
. 67821) (TEDIT.NTHCHARCODE 67823 . 69866) (TEDIT.NTHCHAR 69868 . 70335)) (70383 127160 (\TEDIT1
|
65931 . 66304) (TEDIT.RPLCHARCODE 66306 . 69296) (TEDIT.NTHCHARCODE 69298 . 71341) (TEDIT.NTHCHAR
|
||||||
70393 . 72470) (\TEDIT.INSERT 72472 . 78585) (\TEDIT.MOVE 78587 . 86493) (\TEDIT.COPY 86495 . 91026) (
|
71343 . 71810)) (71858 128902 (\TEDIT1 71868 . 73945) (\TEDIT.INSERT 73947 . 80060) (\TEDIT.MOVE 80062
|
||||||
\TEDIT.REPLACE.SELPIECES 91028 . 95564) (\TEDIT.INSERT.SELPIECES 95566 . 98563) (\TEDIT.RESTARTFN
|
. 88160) (\TEDIT.COPY 88162 . 92768) (\TEDIT.REPLACE.SELPIECES 92770 . 97306) (
|
||||||
98565 . 101070) (\TEDIT.CHARDELETE 101072 . 104001) (\TEDIT.COPYPIECE 104003 . 109165) (
|
\TEDIT.INSERT.SELPIECES 97308 . 100305) (\TEDIT.RESTARTFN 100307 . 102812) (\TEDIT.CHARDELETE 102814
|
||||||
\TEDIT.APPLY.OBJFN 109167 . 112253) (\TEDIT.DELETE 112255 . 116623) (\TEDIT.DIFFUSE.PARALOOKS 116625
|
. 105743) (\TEDIT.COPYPIECE 105745 . 110907) (\TEDIT.APPLY.OBJFN 110909 . 113995) (\TEDIT.DELETE
|
||||||
. 118896) (\TEDIT.WORDDELETE 118898 . 120513) (\TEDIT.WORDDELETE.FORWARD 120515 . 122304) (
|
113997 . 118365) (\TEDIT.DIFFUSE.PARALOOKS 118367 . 120638) (\TEDIT.WORDDELETE 120640 . 122255) (
|
||||||
\TEDIT.FINISHEDIT? 122306 . 127158)) (127161 127820 (\TEDIT.THELP 127171 . 127818)) (127854 136985 (
|
\TEDIT.WORDDELETE.FORWARD 122257 . 124046) (\TEDIT.FINISHEDIT? 124048 . 128900)) (128903 129562 (
|
||||||
\TEDIT.PARAPIECES 127864 . 129838) (\TEDIT.PARACHNOS 129840 . 130732) (\TEDIT.PARA.FIRST 130734 .
|
\TEDIT.THELP 128913 . 129560)) (129596 138727 (\TEDIT.PARAPIECES 129606 . 131580) (\TEDIT.PARACHNOS
|
||||||
133835) (\TEDIT.PARA.LAST 133837 . 136983)) (136986 144081 (\TEDIT.WORD.FIRST 136996 . 141000) (
|
131582 . 132474) (\TEDIT.PARA.FIRST 132476 . 135577) (\TEDIT.PARA.LAST 135579 . 138725)) (138728
|
||||||
\TEDIT.WORD.LAST 141002 . 144079)) (144282 144559 (TEDITSYSTEMDATE 144292 . 144557)) (144695 144902 (
|
145823 (\TEDIT.WORD.FIRST 138738 . 142742) (\TEDIT.WORD.LAST 142744 . 145821)) (146024 146301 (
|
||||||
TEDIT.IMAGESOURCEP 144705 . 144900)))))
|
TEDITSYSTEMDATE 146034 . 146299)) (146437 146644 (TEDIT.IMAGESOURCEP 146447 . 146642)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
@@ -1,13 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||||
|
|
||||||
(FILECREATED "13-Jan-2026 17:51:55" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;55 18063
|
(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)
|
||||||
(VARS TEDIT-ABBREVCOMS)
|
|
||||||
|
|
||||||
:PREVIOUS-DATE " 8-Jan-2026 09:09:58" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;53)
|
:PREVIOUS-DATE "23-Jan-2026 15:49:26" {MEDLEY}<library>tedit>TEDIT-ABBREV.;58)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-ABBREVCOMS)
|
(PRETTYCOMPRINT TEDIT-ABBREVCOMS)
|
||||||
@@ -87,7 +86,10 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.ABBREV.EXPAND
|
(\TEDIT.ABBREV.EXPAND
|
||||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 13-Jan-2026 17:51 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 13-Jan-2026 17:51 by rmk")
|
||||||
(* ; "Edited 8-Jan-2026 09:08 by rmk")
|
(* ; "Edited 8-Jan-2026 09:08 by rmk")
|
||||||
(* ; "Edited 3-Jan-2026 13:13 by rmk")
|
(* ; "Edited 3-Jan-2026 13:13 by rmk")
|
||||||
(* ; "Edited 20-Apr-2025 23:30 by rmk")
|
(* ; "Edited 20-Apr-2025 23:30 by rmk")
|
||||||
@@ -117,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)
|
||||||
@@ -143,11 +145,11 @@
|
|||||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.FROM.STRING EXPANSION TEXTOBJ NIL
|
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.FROM.STRING EXPANSION TEXTOBJ NIL
|
||||||
(PCHARLOOKS (\TEDIT.CHTOPC FIRSTCHNO TEXTOBJ)))
|
(PCHARLOOKS (\TEDIT.CHTOPC FIRSTCHNO TEXTOBJ)))
|
||||||
TSTREAM SEL)
|
TSTREAM SEL)
|
||||||
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "Replaced " (CL:IF BACKSLASH
|
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "Replaced %"" (CL:IF BACKSLASH
|
||||||
(CONCAT (CAR ABBREV)
|
(CONCAT (CAR ABBREV)
|
||||||
"\")
|
"\")
|
||||||
(CAR ABBREV))
|
(CAR ABBREV))
|
||||||
" with " EXPANSION)
|
"%" with %"" EXPANSION "%"")
|
||||||
T)
|
T)
|
||||||
else (TEDIT.PROMPTPRINT TSTREAM "No abbreviation to expand" T])
|
else (TEDIT.PROMPTPRINT TSTREAM "No abbreviation to expand" T])
|
||||||
|
|
||||||
@@ -362,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 (4390 14959 (\TEDIT.ABBREV.EXPAND 4400 . 8930) (\TEDIT.ABBREV.EXPANSION 8932 . 11996) (
|
(FILEMAP (NIL (4346 15268 (\TEDIT.ABBREV.EXPAND 4356 . 9239) (\TEDIT.ABBREV.EXPANSION 9241 . 12305) (
|
||||||
\TEDIT.ABBREV.TREE 11998 . 13129) (\TEDIT.ABBREV.PARSE 13131 . 14283) (\TEDIT.ABBREV.PARSE.CHARCODE
|
\TEDIT.ABBREV.TREE 12307 . 13438) (\TEDIT.ABBREV.PARSE 13440 . 14592) (\TEDIT.ABBREV.PARSE.CHARCODE
|
||||||
14285 . 14957)) (14960 15605 (\TEDIT.EXPAND.DATE 14970 . 15603)))))
|
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 "19-Oct-2025 10:44:18" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;229 125526
|
(FILECREATED " 8-May-2026 12:17:16" {MEDLEY}<library>TEDIT>TEDIT-BUTTONS.;234 123908
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS MB.ADD)
|
:CHANGES-TO (FNS MB.NWAY.SIZEFN)
|
||||||
|
|
||||||
:PREVIOUS-DATE "30-Apr-2025 14:09:18" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;228)
|
:PREVIOUS-DATE "29-Apr-2026 17:57:09" {MEDLEY}<library>TEDIT>TEDIT-BUTTONS.;233)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-BUTTONSCOMS)
|
(PRETTYCOMPRINT TEDIT-BUTTONSCOMS)
|
||||||
@@ -36,10 +36,9 @@
|
|||||||
|
|
||||||
(* ;; "Mutually exclusive togggles with a single enclosing object")
|
(* ;; "Mutually exclusive togggles with a single enclosing object")
|
||||||
|
|
||||||
(FNS MB.NWAY.CREATE MB.NWAY.DISPLAYFN MB.NWAY.WHENOPERATEDONFN MB.NWAY.SIZEFN
|
(FNS MB.NWAY.CREATE MB.NWAY.DISPLAYFN MB.NWAY.SIZEFN MB.NWAY.SELECT
|
||||||
MB.NWAY.SELECT MB.NWAY.BUTTONEVENTINFN MB.NWAY.NEWMENUBUTTON MB.NWAY.COPYFN
|
MB.NWAY.BUTTONEVENTINFN MB.NWAY.NEWMENUBUTTON MB.NWAY.COPYFN MB.NWAY.INIT
|
||||||
MB.NWAY.INIT MB.NWAY.ARRANGEBUTTONS MB.NWAY.ADDITEM MB.NWAY.FINDSUBOBJ
|
MB.NWAY.ARRANGEBUTTONS MB.NWAY.ADDITEM MB.NWAY.FINDSUBOBJ MB.NWAY.SETSTATEFN)
|
||||||
MB.NWAY.SETSTATEFN)
|
|
||||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.NWAY.INIT]
|
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.NWAY.INIT]
|
||||||
[COMS (* ; "TOGGLE")
|
[COMS (* ; "TOGGLE")
|
||||||
(FNS MB.TOGGLE.CREATE MB.TOGGLE.DISPLAYFN MB.TOGGLE.INIT MB.SET.TOGGLE
|
(FNS MB.TOGGLE.CREATE MB.TOGGLE.DISPLAYFN MB.TOGGLE.INIT MB.SET.TOGGLE
|
||||||
@@ -922,41 +921,10 @@
|
|||||||
(APPLY* (IMAGEOBJPROP SOBJ 'DISPLAYFN)
|
(APPLY* (IMAGEOBJPROP SOBJ 'DISPLAYFN)
|
||||||
SOBJ STREAM])
|
SOBJ STREAM])
|
||||||
|
|
||||||
(MB.NWAY.WHENOPERATEDONFN
|
|
||||||
[LAMBDA (OBJ PANE OPERATION SEL) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
|
||||||
(* ; "Edited 24-Aug-2024 23:38 by rmk")
|
|
||||||
(* ; "Edited 13-Aug-2024 23:43 by rmk")
|
|
||||||
(* ; "Edited 2-Aug-2024 00:36 by rmk")
|
|
||||||
(* ; "Edited 21-Jul-2024 13:17 by rmk")
|
|
||||||
(* ; "Edited 17-Jul-2024 21:51 by rmk")
|
|
||||||
(* ; "Edited 9-Apr-2023 15:57 by rmk")
|
|
||||||
(* ; "Edited 13-Sep-2022 12:09 by rmk")
|
|
||||||
(* ; "Edited 30-May-91 22:16 by jds")
|
|
||||||
|
|
||||||
(* ;; "Perhaps the selected subobject should be stored here, as the state?")
|
|
||||||
|
|
||||||
(* ;; "Mouse tracking and highlighting happens in the BUTTONEVENTINFN (MB.NWAYBUTTON.SELFN). The code here applies the STATECHANGEFN on the main object")
|
|
||||||
|
|
||||||
(NOTUSED)
|
|
||||||
(SELECTQ OPERATION
|
|
||||||
(SELECTED [AND NIL (\TEDIT.THELP)
|
|
||||||
(LET [(SELECTED (IMAGEOBJPROP OBJ 'SELECTED]
|
|
||||||
(if (IMAGEOBJPROP OBJ 'STATECHANGEFN)
|
|
||||||
then (\TEDIT.THELP)
|
|
||||||
(APPLY* (IMAGEOBJPROP OBJ 'STATECHANGEFN)
|
|
||||||
OBJ SELECTED SEL PANE)
|
|
||||||
elseif (AND NIL SELECTED (IMAGEOBJPROP SELECTED 'STATECHANGEFN))
|
|
||||||
then
|
|
||||||
(* ;;
|
|
||||||
"This is nuked out: the selected object may be should have done its own thing?")
|
|
||||||
|
|
||||||
(APPLY* (IMAGEOBJPROP SELECTED 'STATECHANGEFN)
|
|
||||||
OBJ SELECTED SEL PANE])
|
|
||||||
((HIGHLIGHTED UNHIGHLIGHTED DESELECTED))
|
|
||||||
NIL])
|
|
||||||
|
|
||||||
(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")
|
||||||
@@ -969,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 (* ;
|
||||||
@@ -984,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")
|
||||||
@@ -1783,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")
|
||||||
@@ -1839,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)
|
||||||
|
|
||||||
@@ -1971,25 +1946,25 @@
|
|||||||
(MB.FIELD.INIT)
|
(MB.FIELD.INIT)
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (3221 19357 (MB.ADD 3231 . 9943) (MB.DELETE 9945 . 10319) (MB.GET 10321 . 17091) (
|
(FILEMAP (NIL (3182 19318 (MB.ADD 3192 . 9904) (MB.DELETE 9906 . 10280) (MB.GET 10282 . 17052) (
|
||||||
MB.GET.MBARG 17093 . 18762) (TEDIT.BACKTOMAIN 18764 . 19355)) (19401 39337 (MB.BUTTONEVENTINFN 19411
|
MB.GET.MBARG 17054 . 18723) (TEDIT.BACKTOMAIN 18725 . 19316)) (19362 39298 (MB.BUTTONEVENTINFN 19372
|
||||||
. 20979) (MB.DISPLAYFN 20981 . 23040) (MB.SETIMAGE 23042 . 24210) (MB.SIZEFN 24212 . 25760) (
|
. 20940) (MB.DISPLAYFN 20942 . 23001) (MB.SETIMAGE 23003 . 24171) (MB.SIZEFN 24173 . 25721) (
|
||||||
MB.WHENOPERATEDONFN 25762 . 27711) (MB.COPYFN 27713 . 28171) (MB.GETFN 28173 . 29134) (MB.PUTFN 29136
|
MB.WHENOPERATEDONFN 25723 . 27672) (MB.COPYFN 27674 . 28132) (MB.GETFN 28134 . 29095) (MB.PUTFN 29097
|
||||||
. 30236) (MB.SHOWSELFN 30238 . 31747) (MB.CREATE 31749 . 35772) (MB.CHANGENAME 35774 . 36256) (
|
. 30197) (MB.SHOWSELFN 30199 . 31708) (MB.CREATE 31710 . 35733) (MB.CHANGENAME 35735 . 36217) (
|
||||||
MB.INIT 36258 . 37719) (MB.TRACK.UNTIL 37721 . 38416) (MB.DON'T 38418 . 38714) (MB.SPEC.REMAINDER
|
MB.INIT 36219 . 37680) (MB.TRACK.UNTIL 37682 . 38377) (MB.DON'T 38379 . 38675) (MB.SPEC.REMAINDER
|
||||||
38716 . 39335)) (39499 49504 (MB.3STATE.CREATE 39509 . 40373) (MB.3STATE.DISPLAYFN 40375 . 41361) (
|
38677 . 39296)) (39460 49465 (MB.3STATE.CREATE 39470 . 40334) (MB.3STATE.DISPLAYFN 40336 . 41322) (
|
||||||
MB.3STATE.SHOWSELFN 41363 . 43674) (MB.3STATE.INIT 43676 . 45087) (MB.3STATE.SETSTATEFN 45089 . 45747)
|
MB.3STATE.SHOWSELFN 41324 . 43635) (MB.3STATE.INIT 43637 . 45048) (MB.3STATE.SETSTATEFN 45050 . 45708)
|
||||||
(MB.3STATE.BUTTONEVENTINFN 45749 . 49502)) (49659 80755 (MB.NWAY.CREATE 49669 . 55852) (
|
(MB.3STATE.BUTTONEVENTINFN 45710 . 49463)) (49620 78972 (MB.NWAY.CREATE 49630 . 55813) (
|
||||||
MB.NWAY.DISPLAYFN 55854 . 56717) (MB.NWAY.WHENOPERATEDONFN 56719 . 58909) (MB.NWAY.SIZEFN 58911 .
|
MB.NWAY.DISPLAYFN 55815 . 56678) (MB.NWAY.SIZEFN 56680 . 61064) (MB.NWAY.SELECT 61066 . 64636) (
|
||||||
62847) (MB.NWAY.SELECT 62849 . 66419) (MB.NWAY.BUTTONEVENTINFN 66421 . 69633) (MB.NWAY.NEWMENUBUTTON
|
MB.NWAY.BUTTONEVENTINFN 64638 . 67850) (MB.NWAY.NEWMENUBUTTON 67852 . 68564) (MB.NWAY.COPYFN 68566 .
|
||||||
69635 . 70347) (MB.NWAY.COPYFN 70349 . 71316) (MB.NWAY.INIT 71318 . 72809) (MB.NWAY.ARRANGEBUTTONS
|
69533) (MB.NWAY.INIT 69535 . 71026) (MB.NWAY.ARRANGEBUTTONS 71028 . 72999) (MB.NWAY.ADDITEM 73001 .
|
||||||
72811 . 74782) (MB.NWAY.ADDITEM 74784 . 78933) (MB.NWAY.FINDSUBOBJ 78935 . 79449) (MB.NWAY.SETSTATEFN
|
77150) (MB.NWAY.FINDSUBOBJ 77152 . 77666) (MB.NWAY.SETSTATEFN 77668 . 78970)) (79051 91050 (
|
||||||
79451 . 80753)) (80834 92833 (MB.TOGGLE.CREATE 80844 . 81839) (MB.TOGGLE.DISPLAYFN 81841 . 83324) (
|
MB.TOGGLE.CREATE 79061 . 80056) (MB.TOGGLE.DISPLAYFN 80058 . 81541) (MB.TOGGLE.INIT 81543 . 83342) (
|
||||||
MB.TOGGLE.INIT 83326 . 85125) (MB.SET.TOGGLE 85127 . 86328) (MB.TOGGLE.SETSTATEFN 86330 . 87170) (
|
MB.SET.TOGGLE 83344 . 84545) (MB.TOGGLE.SETSTATEFN 84547 . 85387) (MB.TOGGLE.BUTTONEVENTINFN 85389 .
|
||||||
MB.TOGGLE.BUTTONEVENTINFN 87172 . 91488) (MB.TOGGLE.WHENOPERATEDONFN 91490 . 92831)) (92914 125447 (
|
89705) (MB.TOGGLE.WHENOPERATEDONFN 89707 . 91048)) (91131 123829 (MB.FIELD.CREATE 91141 . 96592) (
|
||||||
MB.FIELD.CREATE 92924 . 98375) (MB.FIELD.DISPLAYFN 98377 . 99168) (MB.FIELD.IMAGEBOXFN 99170 . 100652)
|
MB.FIELD.DISPLAYFN 96594 . 97385) (MB.FIELD.IMAGEBOXFN 97387 . 98869) (MB.FIELD.PREFIXCREATE 98871 .
|
||||||
(MB.FIELD.PREFIXCREATE 100654 . 104590) (MB.FIELD.SUFFIXCREATE 104592 . 106252) (MB.FIELD.INIT 106254
|
102807) (MB.FIELD.SUFFIXCREATE 102809 . 104469) (MB.FIELD.INIT 104471 . 106238) (
|
||||||
. 108021) (MB.FIELD.WHENOPERATEDONFN 108023 . 109294) (MB.FIELD.GETSTATEFN 109296 . 113230) (
|
MB.FIELD.WHENOPERATEDONFN 106240 . 107511) (MB.FIELD.GETSTATEFN 107513 . 111447) (MB.FIELD.SETSTATEFN
|
||||||
MB.FIELD.SETSTATEFN 113232 . 118036) (MB.FIELD.BUTTONEVENTINFN 118038 . 120343) (MB.FIELD.SIZEFN
|
111449 . 116418) (MB.FIELD.BUTTONEVENTINFN 116420 . 118725) (MB.FIELD.SIZEFN 118727 . 118967) (
|
||||||
120345 . 120585) (MB.FIELD.INSURETYPE 120587 . 125445)))))
|
MB.FIELD.INSURETYPE 118969 . 123827)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
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,12 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "24-Nov-2025 08:40:56" {WMEDLEY}<library>TEDIT>TEDIT-FNKEYS.;317 109076
|
(FILECREATED " 8-Feb-2026 19:54:41" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;318 109228
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (VARS TEDIT.BASIC.CHARBINDINGS)
|
:CHANGES-TO (VARS TEDIT.BASIC.CHARBINDINGS ORIG.TEDIT.CHARACTIONS)
|
||||||
|
|
||||||
:PREVIOUS-DATE "24-Nov-2025 00:38:18" {WMEDLEY}<library>TEDIT>TEDIT-FNKEYS.;316)
|
:PREVIOUS-DATE "24-Nov-2025 08:40:56" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;317)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-FNKEYSCOMS)
|
(PRETTYCOMPRINT TEDIT-FNKEYSCOMS)
|
||||||
@@ -1776,6 +1776,8 @@
|
|||||||
(:PRINT.MENU \TEDIT.PRINT.MENU)
|
(:PRINT.MENU \TEDIT.PRINT.MENU)
|
||||||
(:EXPAND \TEDIT.ABBREV.EXPAND)
|
(:EXPAND \TEDIT.ABBREV.EXPAND)
|
||||||
(:GET.OBJECT GET.OBJ.FROM.USER)
|
(:GET.OBJECT GET.OBJ.FROM.USER)
|
||||||
|
(:PAGENUMOBJ (TEDIT.INSERT.OBJECT (TEDIT.PAGENO.CREATE)
|
||||||
|
TSTREAM))
|
||||||
(:OPENLINE \TEDIT.KEY.OPENLINE)
|
(:OPENLINE \TEDIT.KEY.OPENLINE)
|
||||||
|
|
||||||
(* ;; "")
|
(* ;; "")
|
||||||
@@ -1913,6 +1915,7 @@
|
|||||||
(:PRINT.MENU "Meta,P" "Meta,p")
|
(:PRINT.MENU "Meta,P" "Meta,p")
|
||||||
(:EXPAND "^X")
|
(:EXPAND "^X")
|
||||||
(:GET.OBJECT "^O")
|
(:GET.OBJECT "^O")
|
||||||
|
(:PAGENUMOBJ "^P")
|
||||||
|
|
||||||
(* ;; "")
|
(* ;; "")
|
||||||
|
|
||||||
@@ -1986,30 +1989,30 @@
|
|||||||
(RPAQ TEDIT.WORDBOUND.READTABLE (\TEDIT.WORDBOUND.READTABLE))
|
(RPAQ TEDIT.WORDBOUND.READTABLE (\TEDIT.WORDBOUND.READTABLE))
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (5031 23296 (TEDIT.INSTALL.CHARBINDINGS 5041 . 7892) (TEDIT.CLEAR.CHARBINDINGS 7894 .
|
(FILEMAP (NIL (5054 23319 (TEDIT.INSTALL.CHARBINDINGS 5064 . 7915) (TEDIT.CLEAR.CHARBINDINGS 7917 .
|
||||||
10914) (TEDIT.GET.CHARACTION 10916 . 13697) (TEDIT.GET.CHARBINDING 13699 . 15876) (
|
10937) (TEDIT.GET.CHARACTION 10939 . 13720) (TEDIT.GET.CHARBINDING 13722 . 15899) (
|
||||||
TEDIT.GET.ALL.CHARBINDINGS 15878 . 18377) (TEDIT.CHARBINDINGS.INVERT 18379 . 19658) (
|
TEDIT.GET.ALL.CHARBINDINGS 15901 . 18400) (TEDIT.CHARBINDINGS.INVERT 18402 . 19681) (
|
||||||
TEDIT.GET.ALL.CHARACTIONS 19660 . 21982) (TEDIT.CONFLICTING.CHARBINDINGS 21984 . 23294)) (23356 33411
|
TEDIT.GET.ALL.CHARACTIONS 19683 . 22005) (TEDIT.CONFLICTING.CHARBINDINGS 22007 . 23317)) (23379 33434
|
||||||
(\TEDIT.KEY.CHARLOOKS 23366 . 24558) (\TEDIT.KEY.QUAD 24560 . 26653) (\TEDIT.DEFAULTSSEL 26655 . 27266
|
(\TEDIT.KEY.CHARLOOKS 23389 . 24581) (\TEDIT.KEY.QUAD 24583 . 26676) (\TEDIT.DEFAULTSSEL 26678 . 27289
|
||||||
) (\TEDIT.SETDEFAULT.FROM.SEL 27268 . 27945) (\TEDIT.KEY.SIZE 27947 . 29143) (\TEDIT.SUBSCRIPTSEL
|
) (\TEDIT.SETDEFAULT.FROM.SEL 27291 . 27968) (\TEDIT.KEY.SIZE 27970 . 29166) (\TEDIT.SUBSCRIPTSEL
|
||||||
29145 . 29348) (\TEDIT.SUPERSCRIPTSEL 29350 . 29554) (\TEDIT.KEY.TRANSFORM 29556 . 31553) (
|
29168 . 29371) (\TEDIT.SUPERSCRIPTSEL 29373 . 29577) (\TEDIT.KEY.TRANSFORM 29579 . 31576) (
|
||||||
\TEDIT.KEY.OPENLINE 31555 . 32009) (\TEDIT.KEY.FAMILYN 32011 . 33409)) (33412 33701 (CAP-CASECODE
|
\TEDIT.KEY.OPENLINE 31578 . 32032) (\TEDIT.KEY.FAMILYN 32034 . 33432)) (33435 33724 (CAP-CASECODE
|
||||||
33422 . 33699)) (33735 37167 (\TEDIT.SHOWCARETLOOKS 33745 . 36260) (\TEDIT.DESCRIBEFONT 36262 . 37165)
|
33445 . 33722)) (33758 37190 (\TEDIT.SHOWCARETLOOKS 33768 . 36283) (\TEDIT.DESCRIBEFONT 36285 . 37188)
|
||||||
) (37198 52171 (\TEDIT.ONECHAR.BACKWARD 37208 . 38355) (\TEDIT.ONECHAR.FORWARD 38357 . 39593) (
|
) (37221 52194 (\TEDIT.ONECHAR.BACKWARD 37231 . 38378) (\TEDIT.ONECHAR.FORWARD 38380 . 39616) (
|
||||||
\TEDIT.ONELINE.UP 39595 . 42556) (\TEDIT.ONELINE.DOWN 42558 . 44215) (\TEDIT.ONELINE.MOVE 44217 .
|
\TEDIT.ONELINE.UP 39618 . 42579) (\TEDIT.ONELINE.DOWN 42581 . 44238) (\TEDIT.ONELINE.MOVE 44240 .
|
||||||
46504) (\TEDIT.ONEWORD.BACKWARD 46506 . 47694) (\TEDIT.ONEWORD.FORWARD 47696 . 48883) (
|
46527) (\TEDIT.ONEWORD.BACKWARD 46529 . 47717) (\TEDIT.ONEWORD.FORWARD 47719 . 48906) (
|
||||||
\TEDIT.LINE.BEGIN 48885 . 49964) (\TEDIT.LINE.END 49966 . 51203) (\TEDIT.DOCUMENT.BEGIN 51205 . 51564)
|
\TEDIT.LINE.BEGIN 48908 . 49987) (\TEDIT.LINE.END 49989 . 51226) (\TEDIT.DOCUMENT.BEGIN 51228 . 51587)
|
||||||
(\TEDIT.DOCUMENT.END 51566 . 52169)) (52172 55480 (\TEDIT.LINEDELETE.FORWARD 52182 . 53291) (
|
(\TEDIT.DOCUMENT.END 51589 . 52192)) (52195 55503 (\TEDIT.LINEDELETE.FORWARD 52205 . 53314) (
|
||||||
\TEDIT.LINEDELETE.BACKWARD 53293 . 54432) (\TEDIT.LINEDELETE 54434 . 55478)) (55481 58009 (
|
\TEDIT.LINEDELETE.BACKWARD 53316 . 54455) (\TEDIT.LINEDELETE 54457 . 55501)) (55504 58032 (
|
||||||
\TEDIT.KEY.NEST 55491 . 58007)) (58010 59292 (\TEDIT.KEY.WRAP 58020 . 59290)) (59383 67431 (
|
\TEDIT.KEY.NEST 55514 . 58030)) (58033 59315 (\TEDIT.KEY.WRAP 58043 . 59313)) (59406 67454 (
|
||||||
\TEDIT.KEY.FIND 59393 . 64571) (\TEDIT.KEY.FIND.SEARCHSTRING 64573 . 65713) (\TEDIT.GET.TARGET.STRING
|
\TEDIT.KEY.FIND 59416 . 64594) (\TEDIT.KEY.FIND.SEARCHSTRING 64596 . 65736) (\TEDIT.GET.TARGET.STRING
|
||||||
65715 . 67429)) (67462 70094 (\TEDIT.KEY.SUBSTITUTE 67472 . 67693) (\TEDIT.MANPAGE 67695 . 68942) (
|
65738 . 67452)) (67485 70117 (\TEDIT.KEY.SUBSTITUTE 67495 . 67716) (\TEDIT.MANPAGE 67718 . 68965) (
|
||||||
\TEDIT.CALL.ED 68944 . 69774) (\TEDIT.SELECT.ALL 69776 . 70092)) (70121 75811 (\TEDIT.CLIPBOARD 70131
|
\TEDIT.CALL.ED 68967 . 69797) (\TEDIT.SELECT.ALL 69799 . 70115)) (70144 75834 (\TEDIT.CLIPBOARD 70154
|
||||||
. 71886) (\TEDIT.COPYTOCLIPBOARD 71888 . 72668) (\TEDIT.EXTRACTTOCLIPBOARD 72670 . 72865) (
|
. 71909) (\TEDIT.COPYTOCLIPBOARD 71911 . 72691) (\TEDIT.EXTRACTTOCLIPBOARD 72693 . 72888) (
|
||||||
\TEDIT.WRITE.SEL 72867 . 75809)) (75977 88484 (\TEDIT.READTABLE 75987 . 76923) (
|
\TEDIT.WRITE.SEL 72890 . 75832)) (76000 88507 (\TEDIT.READTABLE 76010 . 76946) (
|
||||||
\TEDIT.WORDBOUND.READTABLE 76925 . 79973) (TEDIT.GETSYNTAX 79975 . 81204) (TEDIT.SETSYNTAX 81206 .
|
\TEDIT.WORDBOUND.READTABLE 76948 . 79996) (TEDIT.GETSYNTAX 79998 . 81227) (TEDIT.SETSYNTAX 81229 .
|
||||||
82520) (TEDIT.GETFUNCTION 82522 . 83995) (TEDIT.SETFUNCTION 83997 . 86153) (TEDIT.WORDGET 86155 .
|
82543) (TEDIT.GETFUNCTION 82545 . 84018) (TEDIT.SETFUNCTION 84020 . 86176) (TEDIT.WORDGET 86178 .
|
||||||
86416) (TEDIT.WORDSET 86418 . 87158) (TEDIT.ATOMBOUND.READTABLE 87160 . 88482)) (88585 95573 (
|
86439) (TEDIT.WORDSET 86441 . 87181) (TEDIT.ATOMBOUND.READTABLE 87183 . 88505)) (88608 95596 (
|
||||||
TEDIT.BUTTONS.BUILD 88595 . 93841) (TEDIT.BUTTONBITMAP.FILL 93843 . 95571)) (98038 98626 (
|
TEDIT.BUTTONS.BUILD 88618 . 93864) (TEDIT.BUTTONBITMAP.FILL 93866 . 95594)) (98061 98649 (
|
||||||
\TEDIT.TTCCLASS 98048 . 98624)))))
|
\TEDIT.TTCCLASS 98071 . 98647)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
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 " 7-Dec-2025 16:32:32" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;460 155196
|
(FILECREATED "10-Apr-2026 09:34:11" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;469 155253
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (VARS TEDIT-LOOKSCOMS)
|
:CHANGES-TO (FNS \TEDIT.MCCS.TRANSLATE)
|
||||||
|
|
||||||
:PREVIOUS-DATE " 6-Oct-2025 20:50:59" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;459)
|
:PREVIOUS-DATE " 9-Apr-2026 17:25:54" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;468)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-LOOKSCOMS)
|
(PRETTYCOMPRINT TEDIT-LOOKSCOMS)
|
||||||
@@ -924,7 +924,9 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.MCCS.TRANSLATE
|
(\TEDIT.MCCS.TRANSLATE
|
||||||
[LAMBDA (TSTREAM) (* ; "Edited 6-Oct-2025 20:50 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 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")
|
||||||
(* ; "Edited 9-Sep-2025 21:48 by rmk")
|
(* ; "Edited 9-Sep-2025 21:48 by rmk")
|
||||||
@@ -954,33 +956,26 @@
|
|||||||
(SETQ CLOOKS
|
(SETQ CLOOKS
|
||||||
(PCHARLOOKS PC))
|
(PCHARLOOKS PC))
|
||||||
CLFONT]
|
CLFONT]
|
||||||
do (for OFFSET OLDCODE STRING FAT from 1 to (PLEN PC) eachtime (SETQ OLDCODE
|
do (for OFFSET OLDCODE STRING FAT from 0 to (PLAST PC)
|
||||||
(
|
eachtime (SETQ OLDCODE (\TEDIT.PIECE.NTHCHARCODE PC OFFSET))
|
||||||
\TEDIT.PIECE.NTHCHARCODE
|
|
||||||
PC OFFSET))
|
|
||||||
unless (EQ OLDCODE (APPLY* TOMCCSFN OLDCODE))
|
unless (EQ OLDCODE (APPLY* TOMCCSFN OLDCODE))
|
||||||
do
|
do
|
||||||
(* ;; "This piece has recoded character. Start over to convert it to a string piece with necessary code conversions. (The logic to split the original piece at just the changes while still preserving the iteration would be very complicated).")
|
(* ;; "This piece has recoded character. Start over to convert it to a string piece with necessary code conversions. (The logic to split the original piece at just the changes while still preserving the iteration would be very complicated).")
|
||||||
|
|
||||||
(SETQ STRING (ALLOCSTRING (PLEN PC)))
|
(SETQ STRING (ALLOCSTRING (PLEN PC)))
|
||||||
[for OFFSET from 1 to (PLEN PC) do (RPLCHARCODE STRING OFFSET
|
[for I from 0 to (PLAST PC) do (RPLCHARCODE STRING (ADD1 I)
|
||||||
(APPLY* TOMCCSFN (
|
(APPLY* TOMCCSFN (
|
||||||
\TEDIT.PIECE.NTHCHARCODE
|
\TEDIT.PIECE.NTHCHARCODE
|
||||||
PC OFFSET]
|
PC I]
|
||||||
(SETQ FAT (ffetch (STRINGP FATSTRINGP) of STRING))
|
(SETQ FAT (ffetch (STRINGP FATSTRINGP) of STRING))
|
||||||
(FSETPC PC PTYPE (CL:IF FAT
|
(FSETPC PC PTYPE (CL:IF FAT
|
||||||
FATSTRING.PTYPE
|
FATSTRING.PTYPE
|
||||||
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))
|
||||||
|
|
||||||
(* ;;
|
(* ;;
|
||||||
@@ -1377,7 +1372,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.CHANGE.CHARLOOKS
|
(\TEDIT.CHANGE.CHARLOOKS
|
||||||
[LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 31-Jul-2025 09:18 by rmk")
|
[LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 10-Feb-2026 11:06 by rmk")
|
||||||
|
(* ; "Edited 31-Jul-2025 09:18 by rmk")
|
||||||
(* ; "Edited 22-Apr-2025 20:17 by rmk")
|
(* ; "Edited 22-Apr-2025 20:17 by rmk")
|
||||||
(* ; "Edited 21-Apr-2025 20:17 by rmk")
|
(* ; "Edited 21-Apr-2025 20:17 by rmk")
|
||||||
(* ; "Edited 20-Apr-2025 13:27 by rmk")
|
(* ; "Edited 20-Apr-2025 13:27 by rmk")
|
||||||
@@ -1403,10 +1399,12 @@
|
|||||||
(* ;;; "Internal programmatic interface to changing character looks. DOES NOT CHANGE the current selection (unless it's the TARGETSEL).")
|
(* ;;; "Internal programmatic interface to changing character looks. DOES NOT CHANGE the current selection (unless it's the TARGETSEL).")
|
||||||
|
|
||||||
(PROG ((TEXTOBJ (TEXTOBJ TSTREAM))
|
(PROG ((TEXTOBJ (TEXTOBJ TSTREAM))
|
||||||
SELPIECES NEWLOOKSLIST FONT DIRTY) (* ;
|
SELPIECES NEWLOOKSLIST FONT DIRTY)
|
||||||
"Construct the set of new looks to apply:")
|
|
||||||
(CL:UNLESS TARGETSEL
|
(CL:UNLESS TARGETSEL
|
||||||
(SETQ TARGETSEL (TEXTSEL TEXTOBJ)))
|
(SETQ TARGETSEL (TEXTSEL TEXTOBJ)))
|
||||||
|
(CL:WHEN (EQ 0 (GETSEL TARGETSEL DCH))
|
||||||
|
(TEDIT.PROMPTPRINT TSTREAM "No characters are selected" T)
|
||||||
|
(RETURN))
|
||||||
(CL:UNLESS (AND NEWLOOKS (FGETSEL TARGETSEL SET)
|
(CL:UNLESS (AND NEWLOOKS (FGETSEL TARGETSEL SET)
|
||||||
(NOT (\TEDIT.READONLY TSTREAM NIL (GETSEL TARGETSEL CH#)))
|
(NOT (\TEDIT.READONLY TSTREAM NIL (GETSEL TARGETSEL CH#)))
|
||||||
(ILEQ (GETSEL TARGETSEL CH#)
|
(ILEQ (GETSEL TARGETSEL CH#)
|
||||||
@@ -2103,7 +2101,8 @@
|
|||||||
then (\TEDIT.CHANGE.PARALOOKS TSTREAM NEWLOOKS TARGETSEL)))])
|
then (\TEDIT.CHANGE.PARALOOKS TSTREAM NEWLOOKS TARGETSEL)))])
|
||||||
|
|
||||||
(\TEDIT.CHANGE.PARALOOKS
|
(\TEDIT.CHANGE.PARALOOKS
|
||||||
[LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 21-Apr-2025 23:27 by rmk")
|
[LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 10-Feb-2026 11:07 by rmk")
|
||||||
|
(* ; "Edited 21-Apr-2025 23:27 by rmk")
|
||||||
(* ; "Edited 20-Apr-2025 13:27 by rmk")
|
(* ; "Edited 20-Apr-2025 13:27 by rmk")
|
||||||
(* ; "Edited 16-Apr-2025 09:05 by rmk")
|
(* ; "Edited 16-Apr-2025 09:05 by rmk")
|
||||||
(* ; "Edited 6-Apr-2025 14:29 by rmk")
|
(* ; "Edited 6-Apr-2025 14:29 by rmk")
|
||||||
@@ -2126,6 +2125,9 @@
|
|||||||
NEWPAGEAFTER HEADINGKEEP KEEP HARDCOPY USERINFO REVISED STYLE
|
NEWPAGEAFTER HEADINGKEEP KEEP HARDCOPY USERINFO REVISED STYLE
|
||||||
CHARSTYLES COLUMN TABS DEFAULTTAB MARGINBAR))
|
CHARSTYLES COLUMN TABS DEFAULTTAB MARGINBAR))
|
||||||
PARAPIECES)
|
PARAPIECES)
|
||||||
|
(CL:WHEN (EQ 0 (TEXTLEN TEXTOBJ))
|
||||||
|
(TEDIT.PROMPTPRINT TSTREAM "No text to modify" T)
|
||||||
|
(RETURN))
|
||||||
(CL:UNLESS TARGETSEL
|
(CL:UNLESS TARGETSEL
|
||||||
(SETQ TARGETSEL (TEXTSEL TEXTOBJ)))
|
(SETQ TARGETSEL (TEXTSEL TEXTOBJ)))
|
||||||
(CL:UNLESS (AND NEWLOOKS (FGETSEL TARGETSEL SET)
|
(CL:UNLESS (AND NEWLOOKS (FGETSEL TARGETSEL SET)
|
||||||
@@ -2458,26 +2460,26 @@
|
|||||||
(ADDTOVAR LAMA )
|
(ADDTOVAR LAMA )
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (22014 23956 (\TEDIT.CHARLOOKS.DEFPRINT 22024 . 23160) (\TEDIT.PARALOOKS.DEFPRINT 23162
|
(FILEMAP (NIL (22019 23961 (\TEDIT.CHARLOOKS.DEFPRINT 22029 . 23165) (\TEDIT.PARALOOKS.DEFPRINT 23167
|
||||||
. 23954)) (24060 24446 (\TEDIT.CREATE.FACE.MENU 24070 . 24242) (\TEDIT.CREATE.SIZE.MENU 24244 . 24444
|
. 23959)) (24065 24451 (\TEDIT.CREATE.FACE.MENU 24075 . 24247) (\TEDIT.CREATE.SIZE.MENU 24249 . 24449
|
||||||
)) (25450 27339 (\TEDIT.CHARLOOKS.FEATURE.CHECK 25460 . 27337)) (27611 52868 (
|
)) (25455 27344 (\TEDIT.CHARLOOKS.FEATURE.CHECK 25465 . 27342)) (27616 52873 (
|
||||||
\TEDIT.CHARLOOKS.FROM.FONT 27621 . 29905) (\TEDIT.EQCLOOKS 29907 . 32938) (\TEDIT.SAMECLOOKS 32940 .
|
\TEDIT.CHARLOOKS.FROM.FONT 27626 . 29910) (\TEDIT.EQCLOOKS 29912 . 32943) (\TEDIT.SAMECLOOKS 32945 .
|
||||||
36111) (TEDIT.CARETLOOKS 36113 . 37659) (TEDIT.COPY.LOOKS 37661 . 40944) (
|
36116) (TEDIT.CARETLOOKS 36118 . 37664) (TEDIT.COPY.LOOKS 37666 . 40949) (
|
||||||
\TEDIT.UNPARSE.CHARLOOKS.LIST 40946 . 44440) (\TEDIT.MODIFYLOOKS 44442 . 46602) (TEDIT.NEW.FONT 46604
|
\TEDIT.UNPARSE.CHARLOOKS.LIST 40951 . 44445) (\TEDIT.MODIFYLOOKS 44447 . 46607) (TEDIT.NEW.FONT 46609
|
||||||
. 47051) (\TEDIT.CARETLOOKS.VERIFY 47053 . 47890) (\TEDIT.CARETPIECE 47892 . 48197) (
|
. 47056) (\TEDIT.CARETLOOKS.VERIFY 47058 . 47895) (\TEDIT.CARETPIECE 47897 . 48202) (
|
||||||
\TEDIT.GET.INSERT.CHARLOOKS 48199 . 51246) (\TEDIT.GET.TERMSA.WIDTHS 51248 . 51664) (
|
\TEDIT.GET.INSERT.CHARLOOKS 48204 . 51251) (\TEDIT.GET.TERMSA.WIDTHS 51253 . 51669) (
|
||||||
\TEDIT.PARSE.CHARLOOKS.LIST 51666 . 52866)) (52869 64996 (\TEDIT.MCCS.TRANSLATE 52879 . 58732) (
|
\TEDIT.PARSE.CHARLOOKS.LIST 51671 . 52871)) (52874 64689 (\TEDIT.MCCS.TRANSLATE 52884 . 58425) (
|
||||||
\TEDIT.CONVERT.TO.FORMATTED 58734 . 64994)) (65868 73205 (\TEDIT.UNIQUIFY.CHARLOOKS 65878 . 67538) (
|
\TEDIT.CONVERT.TO.FORMATTED 58427 . 64687)) (65561 72898 (\TEDIT.UNIQUIFY.CHARLOOKS 65571 . 67231) (
|
||||||
\TEDIT.UNIQUIFY.PARALOOKS 67540 . 68807) (\TEDIT.UNIQUIFY.ALL 68809 . 70897) (
|
\TEDIT.UNIQUIFY.PARALOOKS 67233 . 68500) (\TEDIT.UNIQUIFY.ALL 68502 . 70590) (
|
||||||
\TEDIT.FLUSH.UNUSED.LOOKS 70899 . 73203)) (73238 85196 (TEDIT.LOOKS 73248 . 75637) (TEDIT.GET.LOOKS
|
\TEDIT.FLUSH.UNUSED.LOOKS 70592 . 72896)) (72931 84889 (TEDIT.LOOKS 72941 . 75330) (TEDIT.GET.LOOKS
|
||||||
75639 . 77974) (TEDIT.SUBLOOKS 77976 . 82356) (TEDIT.FINDLOOKS 82358 . 85194)) (85197 114847 (
|
75332 . 77667) (TEDIT.SUBLOOKS 77669 . 82049) (TEDIT.FINDLOOKS 82051 . 84887)) (84890 114663 (
|
||||||
\TEDIT.CHANGE.CHARLOOKS 85207 . 93985) (\TEDIT.CHANGE.CHARLOOKS.NEW 93987 . 97802) (
|
\TEDIT.CHANGE.CHARLOOKS 84900 . 93801) (\TEDIT.CHANGE.CHARLOOKS.NEW 93803 . 97618) (
|
||||||
\TEDIT.CHARLOOKS.CHANGE.FONT 97804 . 106111) (\TEDIT.FONT.NEXTSIZE 106113 . 107734) (\TEDIT.LOOKS
|
\TEDIT.CHARLOOKS.CHANGE.FONT 97620 . 105927) (\TEDIT.FONT.NEXTSIZE 105929 . 107550) (\TEDIT.LOOKS
|
||||||
107736 . 111065) (\TEDIT.FONTCOPY 111067 . 112568) (\TEDIT.COERCE.FONTCLASS 112570 . 113721) (
|
107552 . 110881) (\TEDIT.FONTCOPY 110883 . 112384) (\TEDIT.COERCE.FONTCLASS 112386 . 113537) (
|
||||||
\TEDIT.FONTCLASS.TO.FONT 113723 . 114845)) (114890 146538 (\TEDIT.EQFMTSPEC 114900 . 118115) (
|
\TEDIT.FONTCLASS.TO.FONT 113539 . 114661)) (114706 146595 (\TEDIT.EQFMTSPEC 114716 . 117931) (
|
||||||
TEDIT.GET.PARALOOKS 118117 . 122164) (\TEDIT.PARSE.PARALOOKS.LIST 122166 . 130199) (TEDIT.PARALOOKS
|
TEDIT.GET.PARALOOKS 117933 . 121980) (\TEDIT.PARSE.PARALOOKS.LIST 121982 . 130015) (TEDIT.PARALOOKS
|
||||||
130201 . 131241) (\TEDIT.CHANGE.PARALOOKS 131243 . 138211) (\TEDIT.CHANGE.PARALOOKS.NEW 138213 .
|
130017 . 131057) (\TEDIT.CHANGE.PARALOOKS 131059 . 138268) (\TEDIT.CHANGE.PARALOOKS.NEW 138270 .
|
||||||
142196) (TEDIT.COPY.PARALOOKS 142198 . 144872) (\TEDIT.PARABOUNDS 144874 . 146536)) (146598 154314 (
|
142253) (TEDIT.COPY.PARALOOKS 142255 . 144929) (\TEDIT.PARABOUNDS 144931 . 146593)) (146655 154371 (
|
||||||
TEDIT.SUBPARALOOKS 146608 . 150710) (SAMEPARALOOKS 150712 . 154312)) (154315 155002 (
|
TEDIT.SUBPARALOOKS 146665 . 150767) (SAMEPARALOOKS 150769 . 154369)) (154372 155059 (
|
||||||
\TEDIT.MARK.REVISION 154325 . 155000)))))
|
\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 "12-Dec-2025 00:01:26" {WMEDLEY}<library>tedit>TEDIT-MENU.;501 183343
|
(FILECREATED "29-Apr-2026 15:35:33" {MEDLEY}<library>TEDIT>TEDIT-MENU.;512 183159
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (VARS TEDIT-MENUCOMS)
|
:CHANGES-TO (FNS \TEDIT.SHOW.PAGELOOKS)
|
||||||
|
|
||||||
:PREVIOUS-DATE " 7-Dec-2025 16:34:30" {WMEDLEY}<library>tedit>TEDIT-MENU.;499)
|
:PREVIOUS-DATE " 9-Feb-2026 09:10:43" {MEDLEY}<library>TEDIT>TEDIT-MENU.;510)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-MENUCOMS)
|
(PRETTYCOMPRINT TEDIT-MENUCOMS)
|
||||||
@@ -1381,7 +1381,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.EXPANDEDMENU.CREATE
|
(\TEDIT.EXPANDEDMENU.CREATE
|
||||||
[LAMBDA NIL (* ; "Edited 29-May-2025 09:31 by rmk")
|
[LAMBDA NIL (* ; "Edited 25-Jan-2026 10:52 by rmk")
|
||||||
|
(* ; "Edited 29-May-2025 09:31 by rmk")
|
||||||
(* ; "Edited 8-Mar-2025 12:27 by rmk")
|
(* ; "Edited 8-Mar-2025 12:27 by rmk")
|
||||||
(* ; "Edited 7-Jan-2025 16:05 by rmk")
|
(* ; "Edited 7-Jan-2025 16:05 by rmk")
|
||||||
(* ; "Edited 8-Nov-2024 08:35 by rmk")
|
(* ; "Edited 8-Nov-2024 08:35 by rmk")
|
||||||
@@ -1463,13 +1464,15 @@
|
|||||||
TAB
|
TAB
|
||||||
(FIELD (IDENTIFIER SERVER)
|
(FIELD (IDENTIFIER SERVER)
|
||||||
(PRELABEL "server:")
|
(PRELABEL "server:")
|
||||||
(FIELDTYPE SYMBOL))
|
(FIELDTYPE SYMBOL)
|
||||||
|
(EMPTYVALUE NIL))
|
||||||
(FIELD (IDENTIFIER COPIES)
|
(FIELD (IDENTIFIER COPIES)
|
||||||
(PRELABEL "copies:")
|
(PRELABEL "copies:")
|
||||||
|
(EMPTYVALUE 1)
|
||||||
(FIELDTYPE POSITIVENUMBER))
|
(FIELDTYPE POSITIVENUMBER))
|
||||||
2
|
3
|
||||||
(NWAY (IDENTIFIER SIDES)
|
(TOGGLE (IDENTIFIER DOUBLE-SIDED)
|
||||||
(BUTTONS (One% Side Duplex)))
|
(LABEL "Double-sided"))
|
||||||
EOL TAB TAB (FIELD (IDENTIFIER MESSAGE/PHONE#)
|
EOL TAB TAB (FIELD (IDENTIFIER MESSAGE/PHONE#)
|
||||||
(PRELABEL "Message/Phone#:")
|
(PRELABEL "Message/Phone#:")
|
||||||
(FIELDTYPE STRING])
|
(FIELDTYPE STRING])
|
||||||
@@ -1546,7 +1549,8 @@
|
|||||||
(RETURN 'DON'T])
|
(RETURN 'DON'T])
|
||||||
|
|
||||||
(\TEDIT.EXPANDEDMENU.ACTIONFN
|
(\TEDIT.EXPANDEDMENU.ACTIONFN
|
||||||
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM MAINSTREAM) (* ; "Edited 29-May-2025 09:29 by rmk")
|
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM MAINSTREAM) (* ; "Edited 25-Jan-2026 11:05 by rmk")
|
||||||
|
(* ; "Edited 29-May-2025 09:29 by rmk")
|
||||||
(* ; "Edited 11-May-2025 15:01 by rmk")
|
(* ; "Edited 11-May-2025 15:01 by rmk")
|
||||||
(* ; "Edited 6-Apr-2025 14:39 by rmk")
|
(* ; "Edited 6-Apr-2025 14:39 by rmk")
|
||||||
(* ; "Edited 18-Mar-2025 23:54 by rmk")
|
(* ; "Edited 18-Mar-2025 23:54 by rmk")
|
||||||
@@ -1564,11 +1568,11 @@
|
|||||||
(* ;
|
(* ;
|
||||||
"MBFN for TEdit default menu item buttons.")
|
"MBFN for TEdit default menu item buttons.")
|
||||||
(ERSETQ (RESETLST
|
(ERSETQ (RESETLST
|
||||||
|
(RESETSAVE NIL (LIST [FUNCTION (LAMBDA (SEL)
|
||||||
|
(FSETSEL SEL SET NIL]
|
||||||
|
MENUSEL))
|
||||||
(LET ((MENUTEXTOBJ (FTEXTOBJ MENUSTREAM))
|
(LET ((MENUTEXTOBJ (FTEXTOBJ MENUSTREAM))
|
||||||
STATES STATE)
|
STATES STATE)
|
||||||
[RESETSAVE (PROG1 OBJ
|
|
||||||
(IMAGEOBJPROP OBJ 'MENUBUTTON.SELECTED T))
|
|
||||||
'(AND (IMAGEOBJPROP OLDVALUE 'MENUBUTTON.SELECTED NIL]
|
|
||||||
(SELECTQ (IMAGEOBJPROP OBJ 'IDENTIFIER)
|
(SELECTQ (IMAGEOBJPROP OBJ 'IDENTIFIER)
|
||||||
(QUIT (* ; "Is it OK to quit the main edit?")
|
(QUIT (* ; "Is it OK to quit the main edit?")
|
||||||
(\TEDIT.FINISHEDIT? MAINSTREAM))
|
(\TEDIT.FINISHEDIT? MAINSTREAM))
|
||||||
@@ -1636,29 +1640,21 @@
|
|||||||
)
|
)
|
||||||
(EQ 'ON (LISTGET STATES 'CONFIRM))
|
(EQ 'ON (LISTGET STATES 'CONFIRM))
|
||||||
(EQ 'ON (LISTGET STATES 'USENEWLOOKS])])
|
(EQ 'ON (LISTGET STATES 'USENEWLOOKS])])
|
||||||
(HARDCOPY (SETQ STATES (MB.GET '(SERVER COPIES SIDES MESSAGE/PHONE#)
|
(HARDCOPY (SETQ STATES (MB.GET '(SERVER COPIES DOUBLE-SIDED MESSAGE/PHONE#)
|
||||||
MENUSTREAM
|
MENUSTREAM
|
||||||
'STATE MENUSEL))
|
'STATE MENUSEL))
|
||||||
(LET ((SERVER (LISTGET STATES 'SERVER))
|
(LET ((COPIES (LISTGET STATES 'COPIES))
|
||||||
(COPIES (LISTGET STATES 'COPIES))
|
|
||||||
(SIDES (LISTGET STATES 'SIDES))
|
|
||||||
(MSG (LISTGET STATES 'MESSAGE/PHONE#))
|
(MSG (LISTGET STATES 'MESSAGE/PHONE#))
|
||||||
PRINTOPTIONS)
|
PRINTOPTIONS)
|
||||||
(CL:UNLESS (AND SERVER (SETQ SERVER (\TEDIT.MAKEFILENAME
|
|
||||||
SERVER)))
|
|
||||||
(TEDIT.PROMPTPRINT MAINSTREAM
|
|
||||||
"Using default print server."))
|
|
||||||
(CL:WHEN COPIES
|
(CL:WHEN COPIES
|
||||||
(SETQ PRINTOPTIONS (LIST '%#COPIES COPIES)))
|
(SETQ PRINTOPTIONS (LIST '%#COPIES COPIES)))
|
||||||
(CL:WHEN SIDES
|
(CL:WHEN (LISTGET STATES 'DOUBLE-SIDED)
|
||||||
(push PRINTOPTIONS '%#SIDES (SELECTQ SIDES
|
(push PRINTOPTIONS '%#SIDES 2))
|
||||||
(One% Side 1)
|
|
||||||
(Duplex 2)
|
|
||||||
NIL)))
|
|
||||||
(CL:WHEN MSG
|
(CL:WHEN MSG
|
||||||
(push PRINTOPTIONS 'MESSAGE (\TEDIT.MAKEFILENAME MSG)))
|
(push PRINTOPTIONS 'MESSAGE (\TEDIT.MAKEFILENAME MSG)))
|
||||||
(TEDIT.HARDCOPY MAINSTREAM NIL NIL NIL SERVER PRINTOPTIONS)))
|
(SEND.FILE.TO.PRINTER MAINSTREAM (LISTGET STATES 'SERVER)
|
||||||
(ERROR))))])
|
PRINTOPTIONS)))
|
||||||
|
(SHOULDNT))))])
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
@@ -2371,7 +2367,9 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.PAGEMENU.CREATE
|
(\TEDIT.PAGEMENU.CREATE
|
||||||
[LAMBDA (TSTREAM) (* ; "Edited 5-Jun-2025 18:41 by rmk")
|
[LAMBDA (TSTREAM) (* ; "Edited 9-Feb-2026 09:09 by rmk")
|
||||||
|
(* ; "Edited 26-Jan-2026 12:03 by rmk")
|
||||||
|
(* ; "Edited 5-Jun-2025 18:41 by rmk")
|
||||||
(* ; "Edited 11-May-2025 14:40 by rmk")
|
(* ; "Edited 11-May-2025 14:40 by rmk")
|
||||||
(* ; "Edited 27-Jan-2025 08:51 by rmk")
|
(* ; "Edited 27-Jan-2025 08:51 by rmk")
|
||||||
(* ; "Edited 7-Jan-2025 15:47 by rmk")
|
(* ; "Edited 7-Jan-2025 15:47 by rmk")
|
||||||
@@ -2411,16 +2409,10 @@
|
|||||||
EOL "Paper Size: " (NWAY (IDENTIFIER PAPERSIZE)
|
EOL "Paper Size: " (NWAY (IDENTIFIER PAPERSIZE)
|
||||||
(BUTTONS (Letter Legal A4))
|
(BUTTONS (Letter Legal A4))
|
||||||
(INITSTATE Letter))
|
(INITSTATE Letter))
|
||||||
8
|
16
|
||||||
(TOGGLE (LABEL "Landscape"))
|
(TOGGLE (LABEL "Landscape"))
|
||||||
7
|
|
||||||
(FIELD (IDENTIFIER STARTINGPAGE#)
|
|
||||||
(PRELABEL "Starting page #:")
|
|
||||||
(LABELFONT (HELVETICA 10))
|
|
||||||
(FIELDTYPE POSITIVENUMBER))
|
|
||||||
EOL
|
EOL
|
||||||
(TEXT (STRING "For page: ")
|
(TEXT (STRING "For page: "))
|
||||||
(FONT (HELVETICA 10)))
|
|
||||||
(NWAY (IDENTIFIER PAGEID)
|
(NWAY (IDENTIFIER PAGEID)
|
||||||
(BUTTONS (|First(&Default)| Other% Left Other% Right)))
|
(BUTTONS (|First(&Default)| Other% Left Other% Right)))
|
||||||
EOL
|
EOL
|
||||||
@@ -2430,8 +2422,7 @@
|
|||||||
(* ;; "Page numbers")
|
(* ;; "Page numbers")
|
||||||
|
|
||||||
5
|
5
|
||||||
(TEXT (STRING "Page numbers: ")
|
(TEXT (STRING "Page numbers: "))
|
||||||
(FONT (HELVETICA 10)))
|
|
||||||
(NWAY (IDENTIFIER PAGENOS)
|
(NWAY (IDENTIFIER PAGENOS)
|
||||||
(BUTTONS (No Yes Heading))
|
(BUTTONS (No Yes Heading))
|
||||||
(INITSTATE Yes))
|
(INITSTATE Yes))
|
||||||
@@ -2454,14 +2445,18 @@
|
|||||||
3 "Alignment:" 2 (NWAY (IDENTIFIER QUAD)
|
3 "Alignment:" 2 (NWAY (IDENTIFIER QUAD)
|
||||||
(BUTTONS (Left Centered Right))
|
(BUTTONS (Left Centered Right))
|
||||||
(INITSTATE Centered))
|
(INITSTATE Centered))
|
||||||
|
EOL TAB (FIELD (IDENTIFIER FOLIOPRETEXT)
|
||||||
|
(PRELABEL "Text before number:"))
|
||||||
|
5
|
||||||
|
(FIELD (IDENTIFIER FOLIOPOSTTEXT)
|
||||||
|
(PRELABEL "Text after number:"))
|
||||||
EOL
|
EOL
|
||||||
|
|
||||||
(* ;; "")
|
(* ;; "")
|
||||||
|
|
||||||
(* ;; "Margins")
|
(* ;; "Margins")
|
||||||
|
|
||||||
EOL 5 (TEXT (STRING "Margins: ")
|
EOL 5 (TEXT (STRING "Margins: "))
|
||||||
(FONT (HELVETICA 10)))
|
|
||||||
(FIELD (IDENTIFIER LEFTMARGIN)
|
(FIELD (IDENTIFIER LEFTMARGIN)
|
||||||
(PRELABEL "Left")
|
(PRELABEL "Left")
|
||||||
(POSTLABEL "picas")
|
(POSTLABEL "picas")
|
||||||
@@ -2489,7 +2484,6 @@
|
|||||||
|
|
||||||
EOL 5 (FIELD (IDENTIFIER COLUMNS)
|
EOL 5 (FIELD (IDENTIFIER COLUMNS)
|
||||||
(PRELABEL "Columns:")
|
(PRELABEL "Columns:")
|
||||||
(LABELFONT (HELVETICA 10))
|
|
||||||
(INITSTATE 1)
|
(INITSTATE 1)
|
||||||
(FIELDTYPE POSITIVENUMBER))
|
(FIELDTYPE POSITIVENUMBER))
|
||||||
4
|
4
|
||||||
@@ -2531,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")
|
||||||
@@ -2544,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")
|
||||||
@@ -2735,7 +2729,8 @@
|
|||||||
(TEDIT.BACKTOMAIN MENUSTREAM])
|
(TEDIT.BACKTOMAIN MENUSTREAM])
|
||||||
|
|
||||||
(\TEDIT.CHANGE.PAGELOOKS
|
(\TEDIT.CHANGE.PAGELOOKS
|
||||||
[LAMBDA (MAINTEXTSTREAM PAGELOOKS) (* ; "Edited 11-May-2025 15:04 by rmk")
|
[LAMBDA (MAINTEXTSTREAM PAGELOOKS) (* ; "Edited 27-Jan-2026 10:41 by rmk")
|
||||||
|
(* ; "Edited 11-May-2025 15:04 by rmk")
|
||||||
(* ; "Edited 24-Dec-2024 21:28 by rmk")
|
(* ; "Edited 24-Dec-2024 21:28 by rmk")
|
||||||
(* ; "Edited 20-Oct-2024 17:17 by rmk")
|
(* ; "Edited 20-Oct-2024 17:17 by rmk")
|
||||||
(* ; "Edited 30-Aug-2024 23:43 by rmk")
|
(* ; "Edited 30-Aug-2024 23:43 by rmk")
|
||||||
@@ -2754,8 +2749,8 @@
|
|||||||
((OFF NEUTRAL)
|
((OFF NEUTRAL)
|
||||||
(RPLACA PLTAIL NIL))
|
(RPLACA PLTAIL NIL))
|
||||||
NIL))
|
NIL))
|
||||||
(SELECTQ PAGENOS
|
(SELECTQ (L-CASE PAGENOS T)
|
||||||
(Yes (* ;
|
((Yes T) (* ;
|
||||||
"Page number format specfified in pagelooks menu")
|
"Page number format specfified in pagelooks menu")
|
||||||
(CL:UNLESS (AND (LISTGET PAGELOOKS 'PAGENUMBERX)
|
(CL:UNLESS (AND (LISTGET PAGELOOKS 'PAGENUMBERX)
|
||||||
(LISTGET PAGELOOKS 'PAGENUMBERY))
|
(LISTGET PAGELOOKS 'PAGENUMBERY))
|
||||||
@@ -2776,7 +2771,7 @@
|
|||||||
(* ;; "Page numbers formatted/printed by image object in header paragraphs")
|
(* ;; "Page numbers formatted/printed by image object in header paragraphs")
|
||||||
|
|
||||||
(push PAGEPROPS 'STARTINGPAGE# (LISTGET PAGELOOKS 'STARTINGPAGE#)))
|
(push PAGEPROPS 'STARTINGPAGE# (LISTGET PAGELOOKS 'STARTINGPAGE#)))
|
||||||
NIL)
|
(SHOULDNT))
|
||||||
(CL:UNLESS (LISTGET PAGELOOKS 'COLUMNS)
|
(CL:UNLESS (LISTGET PAGELOOKS 'COLUMNS)
|
||||||
(LISTPUT PAGELOOKS 'COLUMNS 1)
|
(LISTPUT PAGELOOKS 'COLUMNS 1)
|
||||||
(RETURN))
|
(RETURN))
|
||||||
@@ -2786,9 +2781,6 @@
|
|||||||
(TEDIT.PROMPTPRINT MAINTEXTOBJ "Please specify the space between columns" T T)
|
(TEDIT.PROMPTPRINT MAINTEXTOBJ "Please specify the space between columns" T T)
|
||||||
(RETURN))
|
(RETURN))
|
||||||
[push PAGEPROPS 'LANDSCAPE? (EQ 'ON (LISTGET PAGELOOKS 'LANDSCAPE]
|
[push PAGEPROPS 'LANDSCAPE? (EQ 'ON (LISTGET PAGELOOKS 'LANDSCAPE]
|
||||||
|
|
||||||
(* ;; "**EMPTY** may come from field values in the pagelooks menue")
|
|
||||||
|
|
||||||
(TEDIT.PAGEFORMAT MAINTEXTOBJ (TEDIT.SINGLE.PAGEFORMAT PAGENOS (LISTGET PAGELOOKS
|
(TEDIT.PAGEFORMAT MAINTEXTOBJ (TEDIT.SINGLE.PAGEFORMAT PAGENOS (LISTGET PAGELOOKS
|
||||||
'PAGENUMBERX)
|
'PAGENUMBERX)
|
||||||
(LISTGET PAGELOOKS 'PAGENUMBERY)
|
(LISTGET PAGELOOKS 'PAGENUMBERY)
|
||||||
@@ -2907,32 +2899,32 @@
|
|||||||
(ADDTOVAR LAMA )
|
(ADDTOVAR LAMA )
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (4929 16567 (TEDIT.ADD.MENUITEM 4939 . 7056) (TEDIT.DEFAULT.MENUFN 7058 . 13779) (
|
(FILEMAP (NIL (4933 16571 (TEDIT.ADD.MENUITEM 4943 . 7060) (TEDIT.DEFAULT.MENUFN 7062 . 13783) (
|
||||||
TEDIT.REMOVE.MENUITEM 13781 . 14778) (\TEDIT.CREATEMENU 14780 . 15345) (\TEDIT.MENU.WHENHELDFN 15347
|
TEDIT.REMOVE.MENUITEM 13785 . 14782) (\TEDIT.CREATEMENU 14784 . 15349) (\TEDIT.MENU.WHENHELDFN 15351
|
||||||
. 16252) (\TEDIT.MENU.WHENSELECTEDFN 16254 . 16565)) (17381 65416 (DRAWMARGINSCALE 17391 . 20850) (
|
. 16256) (\TEDIT.MENU.WHENSELECTEDFN 16258 . 16569)) (17385 65420 (DRAWMARGINSCALE 17395 . 20854) (
|
||||||
MARGINBAR 20852 . 27977) (MARGINBAR.CREATE 27979 . 32177) (MB.MARGINBAR.BUTTONEVENTINFN 32179 . 39981)
|
MARGINBAR 20856 . 27981) (MARGINBAR.CREATE 27983 . 32181) (MB.MARGINBAR.BUTTONEVENTINFN 32183 . 39985)
|
||||||
(MB.MARGINBAR.SELFN.TABS 39983 . 45223) (MB.MARGINBAR.SELFN.TABS.KIND 45225 . 46160) (
|
(MB.MARGINBAR.SELFN.TABS 39987 . 45227) (MB.MARGINBAR.SELFN.TABS.KIND 45229 . 46164) (
|
||||||
MARGINBAR.GETSTATEFN 46162 . 50149) (MARGINBAR.SETSTATEFN 50151 . 50361) (MARGINBAR.NEUTRALIZE 50363
|
MARGINBAR.GETSTATEFN 46166 . 50153) (MARGINBAR.SETSTATEFN 50155 . 50365) (MARGINBAR.NEUTRALIZE 50367
|
||||||
. 51038) (MARGINBAR.LOOKS 51040 . 54146) (MB.MARGINBAR.SIZEFN 54148 . 54934) (MB.MARGINBAR.DISPLAYFN
|
. 51042) (MARGINBAR.LOOKS 51044 . 54150) (MB.MARGINBAR.SIZEFN 54152 . 54938) (MB.MARGINBAR.DISPLAYFN
|
||||||
54936 . 57997) (MDESCALE 57999 . 58539) (MSCALE 58541 . 58871) (MB.MARGINBAR.SHOWTAB 58873 . 61196) (
|
54940 . 58001) (MDESCALE 58003 . 58543) (MSCALE 58545 . 58875) (MB.MARGINBAR.SHOWTAB 58877 . 61200) (
|
||||||
MB.MARGINBAR.TABTRACK 61198 . 62583) (MARGINBAR.INIT 62585 . 63978) (\TEDIT.PARALOOKS.TO.MARBAR 63980
|
MB.MARGINBAR.TABTRACK 61202 . 62587) (MARGINBAR.INIT 62589 . 63982) (\TEDIT.PARALOOKS.TO.MARBAR 63984
|
||||||
. 65414)) (66241 73523 (TEDIT.MENUSTREAM 66251 . 67251) (TEDITMENUP 67253 . 68222) (\TEDIT.MENU.START
|
. 65418)) (66245 73527 (TEDIT.MENUSTREAM 66255 . 67255) (TEDITMENUP 67257 . 68226) (\TEDIT.MENU.START
|
||||||
68224 . 72571) (\TEDIT.MENU.OPEN? 72573 . 72947) (\TEDIT.MENU.BUTTONEVENTFN 72949 . 73521)) (73842
|
68228 . 72575) (\TEDIT.MENU.OPEN? 72577 . 72951) (\TEDIT.MENU.BUTTONEVENTFN 72953 . 73525)) (73846
|
||||||
81893 (\TEDIT.MENU.CREATE 73852 . 75792) (\TEDIT.MENU.PARSE 75794 . 79483) (\TEDIT.MENU.NEUTRALIZE
|
81897 (\TEDIT.MENU.CREATE 73856 . 75796) (\TEDIT.MENU.PARSE 75798 . 79487) (\TEDIT.MENU.NEUTRALIZE
|
||||||
79485 . 81556) (\TEDITMENU.RECORD.UNFORMATTED 81558 . 81891)) (81959 101740 (
|
79489 . 81560) (\TEDITMENU.RECORD.UNFORMATTED 81562 . 81895)) (81963 101365 (
|
||||||
\TEDIT.EXPANDEDMENU.CREATE 81969 . 87436) (\TEDIT.EXPANDEDMENU.START 87438 . 89062) (
|
\TEDIT.EXPANDEDMENU.CREATE 81973 . 87651) (\TEDIT.EXPANDEDMENU.START 87653 . 89277) (
|
||||||
\TEDIT.EXPANDEDMENU.FN 89064 . 92319) (\TEDIT.EXPANDEDMENU.ACTIONFN 92321 . 101738)) (101802 121227 (
|
\TEDIT.EXPANDEDMENU.FN 89279 . 92534) (\TEDIT.EXPANDEDMENU.ACTIONFN 92536 . 101363)) (101427 120852 (
|
||||||
\TEDIT.PARAMENU.CREATE 101812 . 110543) (\TEDIT.PARAMENU.START 110545 . 111799) (
|
\TEDIT.PARAMENU.CREATE 101437 . 110168) (\TEDIT.PARAMENU.START 110170 . 111424) (
|
||||||
\TEDIT.APPLY.PARALOOKS 111801 . 112853) (\TEDIT.SHOW.PARALOOKS 112855 . 115572) (
|
\TEDIT.APPLY.PARALOOKS 111426 . 112478) (\TEDIT.SHOW.PARALOOKS 112480 . 115197) (
|
||||||
\TEDIT.PARAMENU.FILLIN 115574 . 120323) (\TEDIT.PARAMENU.RESHAPEFN 120325 . 121225)) (121421 148263 (
|
\TEDIT.PARAMENU.FILLIN 115199 . 119948) (\TEDIT.PARAMENU.RESHAPEFN 119950 . 120850)) (121046 147888 (
|
||||||
\TEDIT.CHARMENU.CREATE 121431 . 124035) (\TEDIT.CHARMENU.START 124037 . 125327) (\TEDIT.CHARMENU.SPEC
|
\TEDIT.CHARMENU.CREATE 121056 . 123660) (\TEDIT.CHARMENU.START 123662 . 124952) (\TEDIT.CHARMENU.SPEC
|
||||||
125329 . 130012) (\TEDIT.CHARMENU.PARSE 130014 . 133182) (\TEDIT.CHARMENU.FILLIN 133184 . 137814) (
|
124954 . 129637) (\TEDIT.CHARMENU.PARSE 129639 . 132807) (\TEDIT.CHARMENU.FILLIN 132809 . 137439) (
|
||||||
\TEDIT.SHOW.CHARLOOKS 137816 . 141361) (\TEDIT.APPLY.CHARLOOKS 141363 . 142524) (
|
\TEDIT.SHOW.CHARLOOKS 137441 . 140986) (\TEDIT.APPLY.CHARLOOKS 140988 . 142149) (
|
||||||
\TEDIT.OFFSETTYPE.STATEFN 142526 . 144489) (\TEDIT.OTHER.STATECHANGEFN 144491 . 146136) (
|
\TEDIT.OFFSETTYPE.STATEFN 142151 . 144114) (\TEDIT.OTHER.STATECHANGEFN 144116 . 145761) (
|
||||||
\TEDIT.OTHER.SELECTFN 146138 . 148261)) (148325 177383 (\TEDIT.PAGEMENU.CREATE 148335 . 156847) (
|
\TEDIT.OTHER.SELECTFN 145763 . 147886)) (147950 177199 (\TEDIT.PAGEMENU.CREATE 147960 . 156481) (
|
||||||
\TEDIT.PAGEMENU.START 156849 . 157200) (\TEDIT.SHOW.PAGELOOKS 157202 . 159088) (\TEDIT.PAGEMENU.FILLIN
|
\TEDIT.PAGEMENU.START 156483 . 156834) (\TEDIT.SHOW.PAGELOOKS 156836 . 158857) (\TEDIT.PAGEMENU.FILLIN
|
||||||
159090 . 160640) (\TEDIT.PAGEREGION.UNPARSE 160642 . 170041) (\TEDIT.APPLY.PAGELOOKS 170043 . 171970)
|
158859 . 160409) (\TEDIT.PAGEREGION.UNPARSE 160411 . 169810) (\TEDIT.APPLY.PAGELOOKS 169812 . 171739)
|
||||||
(\TEDIT.CHANGE.PAGELOOKS 171972 . 176539) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 176541 . 177381)) (
|
(\TEDIT.CHANGE.PAGELOOKS 171741 . 176355) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 176357 . 177197)) (
|
||||||
177384 183187 (\TEDIT.PAGEMENU.CREATE.HEADINGS 177394 . 180206) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN
|
177200 183003 (\TEDIT.PAGEMENU.CREATE.HEADINGS 177210 . 180022) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN
|
||||||
180208 . 181633) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 181635 . 183185)))))
|
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,12 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||||
|
|
||||||
(FILECREATED "17-Jan-2026 12:00:08" {WMEDLEY}<library>tedit>TEDIT-PAGE.;241 130528
|
(FILECREATED " 6-May-2026 22:17:41" {MEDLEY}<library>TEDIT>TEDIT-PAGE.;244 130772
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS TEDIT.TO.IMAGEFILE)
|
:CHANGES-TO (FNS TEDIT.TO.IMAGEFILE)
|
||||||
|
|
||||||
:PREVIOUS-DATE "15-Jan-2026 10:48:30" {WMEDLEY}<library>tedit>TEDIT-PAGE.;240)
|
:PREVIOUS-DATE "27-Jan-2026 10:30:27" {MEDLEY}<library>TEDIT>TEDIT-PAGE.;243)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-PAGECOMS)
|
(PRETTYCOMPRINT TEDIT-PAGECOMS)
|
||||||
@@ -51,6 +51,7 @@
|
|||||||
(TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL 'RIGHT 72 72
|
(TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL 'RIGHT 72 72
|
||||||
72 72 NIL 1]
|
72 72 NIL 1]
|
||||||
(FNS TEDIT.TO.IMAGEFILE)
|
(FNS TEDIT.TO.IMAGEFILE)
|
||||||
|
[P (DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE]
|
||||||
(COMS
|
(COMS
|
||||||
(* ;; "Perform page layout, based on a regular expression of typed regions.")
|
(* ;; "Perform page layout, based on a regular expression of typed regions.")
|
||||||
|
|
||||||
@@ -313,7 +314,8 @@
|
|||||||
|
|
||||||
(TEDIT.SINGLE.PAGEFORMAT
|
(TEDIT.SINGLE.PAGEFORMAT
|
||||||
[LAMBDA (PAGE#S? PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS UNITS
|
[LAMBDA (PAGE#S? PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS UNITS
|
||||||
PAGEPROPS PAPERSIZE) (* ; "Edited 11-May-2025 14:59 by rmk")
|
PAGEPROPS PAPERSIZE) (* ; "Edited 27-Jan-2026 10:30 by rmk")
|
||||||
|
(* ; "Edited 11-May-2025 14:59 by rmk")
|
||||||
(* ; "Edited 10-Jan-2025 11:41 by rmk")
|
(* ; "Edited 10-Jan-2025 11:41 by rmk")
|
||||||
(* ; "Edited 24-Dec-2024 21:20 by rmk")
|
(* ; "Edited 24-Dec-2024 21:20 by rmk")
|
||||||
(* ; "Edited 15-Aug-2024 23:01 by rmk")
|
(* ; "Edited 15-Aug-2024 23:01 by rmk")
|
||||||
@@ -356,7 +358,8 @@
|
|||||||
(AND INTERCOL (SETQ INTERCOL (HCSCALE SCALEFACTOR INTERCOL)))
|
(AND INTERCOL (SETQ INTERCOL (HCSCALE SCALEFACTOR INTERCOL)))
|
||||||
(SETQ PAGEWIDTH (IDIFFERENCE (IDIFFERENCE PAPERWIDTH RIGHT)
|
(SETQ PAGEWIDTH (IDIFFERENCE (IDIFFERENCE PAPERWIDTH RIGHT)
|
||||||
LEFT))
|
LEFT))
|
||||||
(CL:WHEN (EQ PAGE#S? 'Yes)
|
(CL:WHEN (MEMB (L-CASE PAGE#S? T)
|
||||||
|
'(T Yes))
|
||||||
|
|
||||||
(* ;; "This asserts that the page number's region is 4 inches wide. Why? What if the pretext/posttext is longer?")
|
(* ;; "This asserts that the page number's region is 4 inches wide. Why? What if the pretext/posttext is longer?")
|
||||||
|
|
||||||
@@ -632,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")
|
||||||
@@ -646,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
|
||||||
@@ -730,6 +732,8 @@
|
|||||||
(RETURN (CLOSEF IMAGESTREAM))))])
|
(RETURN (CLOSEF IMAGESTREAM))))])
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* ;; "Perform page layout, based on a regular expression of typed regions.")
|
(* ;; "Perform page layout, based on a regular expression of typed regions.")
|
||||||
@@ -2056,18 +2060,18 @@
|
|||||||
(RETURN (DREMOVE NIL $$VAL])
|
(RETURN (DREMOVE NIL $$VAL])
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (12133 15745 (\TEDIT.PARSE.PAGEFRAMES 12143 . 13922) (\TEDIT.PUT.PAGEFRAMES 13924 .
|
(FILEMAP (NIL (12201 15813 (\TEDIT.PARSE.PAGEFRAMES 12211 . 13990) (\TEDIT.PUT.PAGEFRAMES 13992 .
|
||||||
14748) (\TEDIT.UNPARSE.PAGEFRAMES 14750 . 15743)) (15808 37825 (TEDIT.SINGLE.PAGEFORMAT 15818 . 26811)
|
14816) (\TEDIT.UNPARSE.PAGEFRAMES 14818 . 15811)) (15876 38044 (TEDIT.SINGLE.PAGEFORMAT 15886 . 27030)
|
||||||
(TEDIT.COMPOUND.PAGEFORMAT 26813 . 27792) (TEDIT.PAGEFORMAT 27794 . 35083) (TEDIT.GET.PAGEFORMAT
|
(TEDIT.COMPOUND.PAGEFORMAT 27032 . 28011) (TEDIT.PAGEFORMAT 28013 . 35302) (TEDIT.GET.PAGEFORMAT
|
||||||
35085 . 37823)) (38112 44592 (TEDIT.TO.IMAGEFILE 38122 . 44590)) (44679 97931 (\TEDIT.FORMATBOX 44689
|
35304 . 38042)) (38331 44775 (TEDIT.TO.IMAGEFILE 38341 . 44773)) (44923 98175 (\TEDIT.FORMATBOX 44933
|
||||||
. 58113) (\TEDIT.FORMATHEADING 58115 . 62761) (\TEDIT.FORMATPAGE 62763 . 71952) (\TEDIT.FORMATTEXTBOX
|
. 58357) (\TEDIT.FORMATHEADING 58359 . 63005) (\TEDIT.FORMATPAGE 63007 . 72196) (\TEDIT.FORMATTEXTBOX
|
||||||
71954 . 88467) (\TEDIT.FORMATFOLIO 88469 . 93786) (\TEDIT.FORMAT.FOUNDBOX? 93788 . 95827) (
|
72198 . 88711) (\TEDIT.FORMATFOLIO 88713 . 94030) (\TEDIT.FORMAT.FOUNDBOX? 94032 . 96071) (
|
||||||
\TEDIT.SKIP.SPECIALCOND 95829 . 97929)) (98011 103066 (\TEDIT.HARDCOPY.PAGEHEADINGS 98021 . 103064)) (
|
\TEDIT.SKIP.SPECIALCOND 96073 . 98173)) (98255 103310 (\TEDIT.HARDCOPY.PAGEHEADINGS 98265 . 103308)) (
|
||||||
103175 111226 (\TEDIT.HARDCOPY-COLUMN-END 103185 . 111224)) (111271 116212 (SCALEPAGEUNITS 111281 .
|
103419 111470 (\TEDIT.HARDCOPY-COLUMN-END 103429 . 111468)) (111515 116456 (SCALEPAGEUNITS 111525 .
|
||||||
112422) (SCALEPAGEXUNITS 112424 . 113194) (SCALEPAGEYUNITS 113196 . 113967) (\TEDIT.PAPERHEIGHT 113969
|
112666) (SCALEPAGEXUNITS 112668 . 113438) (SCALEPAGEYUNITS 113440 . 114211) (\TEDIT.PAPERHEIGHT 114213
|
||||||
. 114904) (\TEDIT.PAPERWIDTH 114906 . 116210)) (116628 120196 (ROMANNUMERALS 116638 . 120194)) (
|
. 115148) (\TEDIT.PAPERWIDTH 115150 . 116454)) (116872 120440 (ROMANNUMERALS 116882 . 120438)) (
|
||||||
120235 127501 (TEDIT.PAGENO.CREATE 120245 . 120621) (\TEDIT.PAGENO.OBJINIT 120623 . 121906) (
|
120479 127745 (TEDIT.PAGENO.CREATE 120489 . 120865) (\TEDIT.PAGENO.OBJINIT 120867 . 122150) (
|
||||||
\TEDIT.PAGENO.BUTTONEVENTINFN 121908 . 122974) (\TEDIT.PAGENO.IMAGEBOXFN 122976 . 125126) (
|
\TEDIT.PAGENO.BUTTONEVENTINFN 122152 . 123218) (\TEDIT.PAGENO.IMAGEBOXFN 123220 . 125370) (
|
||||||
\TEDIT.PAGENO.DISPLAYFN 125128 . 126778) (\TEDIT.PAGENO.GETFN 126780 . 127172) (\TEDIT.PAGENO.PUTFN
|
\TEDIT.PAGENO.DISPLAYFN 125372 . 127022) (\TEDIT.PAGENO.GETFN 127024 . 127416) (\TEDIT.PAGENO.PUTFN
|
||||||
127174 . 127499)) (127566 130505 (\TEDIT.FORMAT.FOOTNOTE 127576 . 130503)))))
|
127418 . 127743)) (127810 130749 (\TEDIT.FORMAT.FOOTNOTE 127820 . 130747)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
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 "28-Jul-2025 23:25:19"
|
(FILECREATED " 9-Apr-2026 17:25:38" {WMEDLEY}<library>TEDIT>TEDIT-PCTREE.;252 68540
|
||||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-PCTREE.;249 69193
|
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS \TEDIT.MAKEPCTB)
|
:CHANGES-TO (FNS \TEDIT.SPLITPIECE)
|
||||||
|
|
||||||
:PREVIOUS-DATE " 8-Feb-2025 20:56:54"
|
:PREVIOUS-DATE "14-Feb-2026 13:22:06" {WMEDLEY}<library>TEDIT>TEDIT-PCTREE.;251)
|
||||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-PCTREE.;248)
|
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
|
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
|
||||||
@@ -37,8 +35,8 @@
|
|||||||
(GLOBALVARS MULTIPLE-PIECE-TABLES)
|
(GLOBALVARS MULTIPLE-PIECE-TABLES)
|
||||||
(FNS \TEDIT.MAKEPCTB \TEDIT.UPDATEPCNODES \TEDIT.FIRSTPIECE \TEDIT.DELETETREE
|
(FNS \TEDIT.MAKEPCTB \TEDIT.UPDATEPCNODES \TEDIT.FIRSTPIECE \TEDIT.DELETETREE
|
||||||
\TEDIT.INSERTTREE \TEDIT.LASTPIECE \TEDIT.PCTOCH \TEDIT.CHTOPC \TEDIT.SET-TOTLEN
|
\TEDIT.INSERTTREE \TEDIT.LASTPIECE \TEDIT.PCTOCH \TEDIT.CHTOPC \TEDIT.SET-TOTLEN
|
||||||
\TEDIT.MAKE.VACANT.BTREESLOT \TEDIT.LINKNEWPIECE \TEDIT.UNLINKPIECE \TEDIT.SPLITPIECE
|
\TEDIT.MAKE.VACANT.BTREESLOT \TEDIT.LINKNEWPIECE \TEDIT.SPLITPIECE \TEDIT.INSERTPIECE
|
||||||
\TEDIT.INSERTPIECE \TEDIT.INSERTPIECES \TEDIT.DELETEPIECES \TEDIT.ALIGNEDPIECE)
|
\TEDIT.INSERTPIECES \TEDIT.DELETEPIECES \TEDIT.ALIGNEDPIECE)
|
||||||
(COMS (* ; "Debugging ")
|
(COMS (* ; "Debugging ")
|
||||||
(FNS \TEDIT.BTVALIDATE \TEDIT.BTVALIDATE.PRINT \TEDIT.CHECK-BTREE \TEDIT.CHECK-BTREE1
|
(FNS \TEDIT.BTVALIDATE \TEDIT.BTVALIDATE.PRINT \TEDIT.CHECK-BTREE \TEDIT.CHECK-BTREE1
|
||||||
\TEDIT.BTFAIL \TEDIT.MATCHPCS)
|
\TEDIT.BTFAIL \TEDIT.MATCHPCS)
|
||||||
@@ -658,22 +656,9 @@
|
|||||||
(freplace (PIECE PREVPIECE) of NEXT with NEW))
|
(freplace (PIECE PREVPIECE) of NEXT with NEW))
|
||||||
NEW])
|
NEW])
|
||||||
|
|
||||||
(\TEDIT.UNLINKPIECE
|
|
||||||
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:04 by rmk")
|
|
||||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
|
||||||
(* ; "Edited 21-Oct-2023 17:24 by rmk")
|
|
||||||
(* ; "Edited 30-May-2023 00:31 by rmk")
|
|
||||||
|
|
||||||
(* ;; "Takes PC out of the piece chain, linking prev and next around it.")
|
|
||||||
|
|
||||||
(\TEDIT.THELP 'NOTCALLED?)
|
|
||||||
(CL:WHEN PREV
|
|
||||||
(freplace (PIECE NEXTPIECE) of PREV with (NEXTPIECE PC)))
|
|
||||||
(freplace (PIECE PREVPIECE) of (OR (NEXTPIECE PC)
|
|
||||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)) with PREV])
|
|
||||||
|
|
||||||
(\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")
|
||||||
@@ -695,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.")
|
||||||
@@ -728,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))
|
||||||
|
|
||||||
@@ -838,7 +820,8 @@
|
|||||||
PIECES])
|
PIECES])
|
||||||
|
|
||||||
(\TEDIT.DELETEPIECES
|
(\TEDIT.DELETEPIECES
|
||||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 7-Feb-2025 08:08 by rmk")
|
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 14-Feb-2026 13:20 by rmk")
|
||||||
|
(* ; "Edited 7-Feb-2025 08:08 by rmk")
|
||||||
(* ; "Edited 26-Nov-2024 10:50 by rmk")
|
(* ; "Edited 26-Nov-2024 10:50 by rmk")
|
||||||
(* ; "Edited 16-Mar-2024 10:00 by rmk")
|
(* ; "Edited 16-Mar-2024 10:00 by rmk")
|
||||||
(* ; "Edited 25-Nov-2023 12:12 by rmk")
|
(* ; "Edited 25-Nov-2023 12:12 by rmk")
|
||||||
@@ -859,6 +842,11 @@
|
|||||||
(* ;; "This may not be entirely safe against an interrupt, which only matters on the call from \INSERTSELPIECES (otherwise the data isn't yet visible). Although the tree is consistent with the remaining pieces after each deletion, the fact that we keep the SELPIECE links intact means that the remaining pieces point to pieces that are no longer in the tree. We could do a little more work to incrementally chain the deleted pieces together, one by one, as they are deleted--in the end they would all be out of the tree, and the deletion chain would have been reconnected. Alternatively, we can make the whole loop be uninterruptable. ")
|
(* ;; "This may not be entirely safe against an interrupt, which only matters on the call from \INSERTSELPIECES (otherwise the data isn't yet visible). Although the tree is consistent with the remaining pieces after each deletion, the fact that we keep the SELPIECE links intact means that the remaining pieces point to pieces that are no longer in the tree. We could do a little more work to incrementally chain the deleted pieces together, one by one, as they are deleted--in the end they would all be out of the tree, and the deletion chain would have been reconnected. Alternatively, we can make the whole loop be uninterruptable. ")
|
||||||
|
|
||||||
(\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'BEFORE TEXTOBJ)
|
(\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'BEFORE TEXTOBJ)
|
||||||
|
(CL:WHEN (type? PIECE SELPIECES)
|
||||||
|
(SETQ SELPIECES (create SELPIECES
|
||||||
|
SPFIRST _ SELPIECES
|
||||||
|
SPLAST _ SELPIECES
|
||||||
|
SPLEN _ (PLEN SELPIECES))))
|
||||||
(for PC PREV NEXT first (FSETTOBJ TEXTOBJ HINTPC NIL)
|
(for PC PREV NEXT first (FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||||
(SETQ PREV (PREVPIECE (GETSPC SELPIECES SPFIRST)))
|
(SETQ PREV (PREVPIECE (GETSPC SELPIECES SPFIRST)))
|
||||||
(* ; "For incremental chain-update")
|
(* ; "For incremental chain-update")
|
||||||
@@ -1113,13 +1101,13 @@
|
|||||||
(GLOBALVARS BTVALIDATETAGS)
|
(GLOBALVARS BTVALIDATETAGS)
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (8767 56719 (\TEDIT.MAKEPCTB 8777 . 10670) (\TEDIT.UPDATEPCNODES 10672 . 12966) (
|
(FILEMAP (NIL (8668 56066 (\TEDIT.MAKEPCTB 8678 . 10571) (\TEDIT.UPDATEPCNODES 10573 . 12867) (
|
||||||
\TEDIT.FIRSTPIECE 12968 . 14375) (\TEDIT.DELETETREE 14377 . 17651) (\TEDIT.INSERTTREE 17653 . 20398) (
|
\TEDIT.FIRSTPIECE 12869 . 14276) (\TEDIT.DELETETREE 14278 . 17552) (\TEDIT.INSERTTREE 17554 . 20299) (
|
||||||
\TEDIT.LASTPIECE 20400 . 21207) (\TEDIT.PCTOCH 21209 . 23306) (\TEDIT.CHTOPC 23308 . 29485) (
|
\TEDIT.LASTPIECE 20301 . 21108) (\TEDIT.PCTOCH 21110 . 23207) (\TEDIT.CHTOPC 23209 . 29386) (
|
||||||
\TEDIT.SET-TOTLEN 29487 . 30275) (\TEDIT.MAKE.VACANT.BTREESLOT 30277 . 37007) (\TEDIT.LINKNEWPIECE
|
\TEDIT.SET-TOTLEN 29388 . 30176) (\TEDIT.MAKE.VACANT.BTREESLOT 30178 . 36908) (\TEDIT.LINKNEWPIECE
|
||||||
37009 . 38598) (\TEDIT.UNLINKPIECE 38600 . 39420) (\TEDIT.SPLITPIECE 39422 . 44078) (
|
36910 . 38499) (\TEDIT.SPLITPIECE 38501 . 43069) (\TEDIT.INSERTPIECE 43071 . 46343) (
|
||||||
\TEDIT.INSERTPIECE 44080 . 47352) (\TEDIT.INSERTPIECES 47354 . 50446) (\TEDIT.DELETEPIECES 50448 .
|
\TEDIT.INSERTPIECES 46345 . 49437) (\TEDIT.DELETEPIECES 49439 . 53949) (\TEDIT.ALIGNEDPIECE 53951 .
|
||||||
54602) (\TEDIT.ALIGNEDPIECE 54604 . 56717)) (56747 69070 (\TEDIT.BTVALIDATE 56757 . 58298) (
|
56064)) (56094 68417 (\TEDIT.BTVALIDATE 56104 . 57645) (\TEDIT.BTVALIDATE.PRINT 57647 . 59012) (
|
||||||
\TEDIT.BTVALIDATE.PRINT 58300 . 59665) (\TEDIT.CHECK-BTREE 59667 . 61994) (\TEDIT.CHECK-BTREE1 61996
|
\TEDIT.CHECK-BTREE 59014 . 61341) (\TEDIT.CHECK-BTREE1 61343 . 66974) (\TEDIT.BTFAIL 66976 . 67398) (
|
||||||
. 67627) (\TEDIT.BTFAIL 67629 . 68051) (\TEDIT.MATCHPCS 68053 . 69068)))))
|
\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 "31-Dec-2025 23:10:18" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;915 186658
|
(FILECREATED " 6-May-2026 22:52:37" {MEDLEY}<library>TEDIT>TEDIT-SCREEN.;918 186879
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (VARS TEDIT-SCREENCOMS)
|
:CHANGES-TO (FNS \TEDIT.FORMATLINE)
|
||||||
|
|
||||||
:PREVIOUS-DATE " 7-Dec-2025 16:28:01" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;914)
|
:PREVIOUS-DATE " 5-Feb-2026 00:39:54" {MEDLEY}<library>TEDIT>TEDIT-SCREEN.;916)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-SCREENCOMS)
|
(PRETTYCOMPRINT TEDIT-SCREENCOMS)
|
||||||
@@ -654,6 +654,8 @@
|
|||||||
|
|
||||||
(\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 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")
|
||||||
(* ; "Edited 27-Apr-2025 11:24 by rmk")
|
(* ; "Edited 27-Apr-2025 11:24 by rmk")
|
||||||
@@ -706,8 +708,10 @@
|
|||||||
(CL:UNLESS LINE
|
(CL:UNLESS LINE
|
||||||
(SETQ LINE (create LINEDESCRIPTOR)))
|
(SETQ LINE (create LINEDESCRIPTOR)))
|
||||||
(CL:UNLESS IMAGESTREAM
|
(CL:UNLESS IMAGESTREAM
|
||||||
(SETQ IMAGESTREAM (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM)
|
(SETQ IMAGESTREAM (CL:IF (\TEDIT.PRIMARYPANE TSTREAM)
|
||||||
'DSP)))
|
(WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM)
|
||||||
|
'DSP)
|
||||||
|
(DSPCREATE))))
|
||||||
(PROG ((TEXTOBJ (FTEXTOBJ TSTREAM))
|
(PROG ((TEXTOBJ (FTEXTOBJ TSTREAM))
|
||||||
(OFFSET 0)
|
(OFFSET 0)
|
||||||
(TRUEASCENT -1)
|
(TRUEASCENT -1)
|
||||||
@@ -1098,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. ")
|
||||||
|
|
||||||
@@ -2863,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 119502 (
|
(FILEMAP (NIL (26198 28414 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 26208 . 28412)) (35868 119723 (
|
||||||
\TEDIT.FORMATLINE 35880 . 70986) (\TEDIT.FORMATLINE.SETUP.PARA 70988 . 76182) (
|
\TEDIT.FORMATLINE 35878 . 71207) (\TEDIT.FORMATLINE.SETUP.PARA 71209 . 76403) (
|
||||||
\TEDIT.FORMATLINE.HORIZONTAL 76184 . 81001) (\TEDIT.FORMATLINE.VERTICAL 81003 . 83454) (
|
\TEDIT.FORMATLINE.HORIZONTAL 76405 . 81222) (\TEDIT.FORMATLINE.VERTICAL 81224 . 83675) (
|
||||||
\TEDIT.FORMATLINE.JUSTIFY 83456 . 89477) (\TEDIT.FORMATLINE.TABS 89479 . 97507) (\TEDIT.SCALE.TABS
|
\TEDIT.FORMATLINE.JUSTIFY 83677 . 89698) (\TEDIT.FORMATLINE.TABS 89700 . 97728) (\TEDIT.SCALE.TABS
|
||||||
97509 . 98300) (\TEDIT.FORMATLINE.PURGE.SPACES 98302 . 99729) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
|
97730 . 98521) (\TEDIT.FORMATLINE.PURGE.SPACES 98523 . 99950) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
|
||||||
99731 . 100808) (\TEDIT.FORMATLINE.EMPTY 100810 . 105630) (\TEDIT.FORMATLINE.UPDATELOOKS 105632 .
|
99952 . 101029) (\TEDIT.FORMATLINE.EMPTY 101031 . 105851) (\TEDIT.FORMATLINE.UPDATELOOKS 105853 .
|
||||||
111813) (\TEDIT.FORMATLINE.LASTLEGAL 111815 . 115265) (\TEDIT.LINES.ABOVE 115267 . 118878) (
|
112034) (\TEDIT.FORMATLINE.LASTLEGAL 112036 . 115486) (\TEDIT.LINES.ABOVE 115488 . 119099) (
|
||||||
\TEDIT.CHNO.TO.YTOP 118880 . 119500)) (119779 140359 (\TEDIT.DISPLAYLINE 119789 . 132299) (
|
\TEDIT.CHNO.TO.YTOP 119101 . 119721)) (120000 140580 (\TEDIT.DISPLAYLINE 120010 . 132520) (
|
||||||
\TEDIT.DISPLAYLINE.TABS 132301 . 135105) (\TEDIT.LINECACHE 135107 . 135835) (\TEDIT.CREATE.LINECACHE
|
\TEDIT.DISPLAYLINE.TABS 132522 . 135326) (\TEDIT.LINECACHE 135328 . 136056) (\TEDIT.CREATE.LINECACHE
|
||||||
135837 . 136673) (\TEDIT.BLTCHAR 136675 . 139302) (\TEDIT.DIACRITIC.SHIFT 139304 . 140357)) (140974
|
136058 . 136894) (\TEDIT.BLTCHAR 136896 . 139523) (\TEDIT.DIACRITIC.SHIFT 139525 . 140578)) (141195
|
||||||
186635 (\TEDIT.BACKFORMAT 140984 . 143538) (\TEDIT.PREVIOUS.LINEBREAK 143540 . 146343) (
|
186856 (\TEDIT.BACKFORMAT 141205 . 143759) (\TEDIT.PREVIOUS.LINEBREAK 143761 . 146564) (
|
||||||
\TEDIT.UPDATE.LINES 146345 . 152651) (\TEDIT.PANE.CREATELINES 152653 . 154943) (
|
\TEDIT.UPDATE.LINES 146566 . 152872) (\TEDIT.PANE.CREATELINES 152874 . 155164) (
|
||||||
\TEDIT.SUFFIXLINE.CREATE 154945 . 156560) (\TEDIT.LINES.BELOW 156562 . 161172) (\TEDIT.MEASURED.LINES
|
\TEDIT.SUFFIXLINE.CREATE 155166 . 156781) (\TEDIT.LINES.BELOW 156783 . 161393) (\TEDIT.MEASURED.LINES
|
||||||
161174 . 163183) (\TEDIT.VALID.LASTCHNOS 163185 . 166961) (\TEDIT.VALID.NEXTCHNOS 166963 . 170437) (
|
161395 . 163404) (\TEDIT.VALID.LASTCHNOS 163406 . 167182) (\TEDIT.VALID.NEXTCHNOS 167184 . 170658) (
|
||||||
\TEDIT.LASTVALIDLINE 170439 . 175110) (\TEDIT.NEXTVALIDLINE 175112 . 178082) (
|
\TEDIT.LASTVALIDLINE 170660 . 175331) (\TEDIT.NEXTVALIDLINE 175333 . 178303) (
|
||||||
\TEDIT.CLEARPANE.BELOW.LINE 178084 . 180190) (\TEDIT.INSERTLINE 180192 . 181578) (\TEDIT.LINE.BOTTOM
|
\TEDIT.CLEARPANE.BELOW.LINE 178305 . 180411) (\TEDIT.INSERTLINE 180413 . 181799) (\TEDIT.LINE.BOTTOM
|
||||||
181580 . 184810) (\TEDIT.SHOW.AT.BOTTOMP 184812 . 185922) (\TEDIT.SHOW.AT.TOPP 185924 . 186633)))))
|
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 "29-Jul-2025 11:22:10" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;731 161124
|
(FILECREATED "16-Apr-2026 09:27:41" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;741 161623
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS \TEDIT.FIND.PROTECTED.START \TEDIT.FIND.PROTECTED.END)
|
:CHANGES-TO (FNS \TEDIT.SELPIECES.FROM.STRING)
|
||||||
|
|
||||||
:PREVIOUS-DATE "28-Jul-2025 23:50:43" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;730)
|
:PREVIOUS-DATE "10-Apr-2026 09:31:20" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;740)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-SELECTIONCOMS)
|
(PRETTYCOMPRINT TEDIT-SELECTIONCOMS)
|
||||||
@@ -73,8 +73,7 @@
|
|||||||
|
|
||||||
(* ;; "If DCH=0, this is a caret-only selection, with no highlighting. In that case CHLIM=(ADD1 CH#) and POINT essentially indicates whether the caret blinks before or after CH#.")
|
(* ;; "If DCH=0, this is a caret-only selection, with no highlighting. In that case CHLIM=(ADD1 CH#) and POINT essentially indicates whether the caret blinks before or after CH#.")
|
||||||
|
|
||||||
NIL (* ;
|
SELOPERATION (* ; "NORMAL, MOVE, COPY... HOW and HOWHEIGHT are derived from the operation. Was Y0: Y value of topmost line of selection")
|
||||||
"Was Y0: Y value of topmost line of selection")
|
|
||||||
X0 (* ;
|
X0 (* ;
|
||||||
"X value of left edge of selection on the first line")
|
"X value of left edge of selection on the first line")
|
||||||
SELLINES (* ; "A list of (L1 L2) pairs one for each pane, to replace the separate L1 L2 lists. Was DX: Width of the selection, if it's on one line.")
|
SELLINES (* ; "A list of (L1 L2) pairs one for each pane, to replace the separate L1 L2 lists. Was DX: Width of the selection, if it's on one line.")
|
||||||
@@ -1214,7 +1213,8 @@
|
|||||||
(SETTOBJ TEXTOBJ BLUEPENDINGDELETE NIL])
|
(SETTOBJ TEXTOBJ BLUEPENDINGDELETE NIL])
|
||||||
|
|
||||||
(\TEDIT.SET.SEL.LOOKS
|
(\TEDIT.SET.SEL.LOOKS
|
||||||
[LAMBDA (SEL OPERATION) (* ; "Edited 6-May-2025 11:32 by rmk")
|
[LAMBDA (SEL OPERATION) (* ; "Edited 10-Jan-2026 12:30 by rmk")
|
||||||
|
(* ; "Edited 6-May-2025 11:32 by rmk")
|
||||||
(* ; "Edited 28-Feb-2025 17:45 by rmk")
|
(* ; "Edited 28-Feb-2025 17:45 by rmk")
|
||||||
(* ; "Edited 7-Nov-2024 21:50 by rmk")
|
(* ; "Edited 7-Nov-2024 21:50 by rmk")
|
||||||
(* ; "Edited 4-Oct-2024 08:40 by rmk")
|
(* ; "Edited 4-Oct-2024 08:40 by rmk")
|
||||||
@@ -1260,6 +1260,7 @@
|
|||||||
(FSETSEL SEL HASCARET T))
|
(FSETSEL SEL HASCARET T))
|
||||||
(NIL)
|
(NIL)
|
||||||
(\TEDIT.THELP "UNKNOWN SELECTION OPERATION" OPERATION))
|
(\TEDIT.THELP "UNKNOWN SELECTION OPERATION" OPERATION))
|
||||||
|
(FSETSEL SEL SELOPERATION OPERATION)
|
||||||
SEL])
|
SEL])
|
||||||
)
|
)
|
||||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||||
@@ -1421,7 +1422,8 @@
|
|||||||
'INVERT) repeatuntil (EQ L LN])
|
'INVERT) repeatuntil (EQ L LN])
|
||||||
|
|
||||||
(\TEDIT.UPDATE.SEL
|
(\TEDIT.UPDATE.SEL
|
||||||
[LAMBDA (TSTREAM/SEL CH# DCH POINT LOOKS CHLIM) (* ; "Edited 6-May-2025 11:36 by rmk")
|
[LAMBDA (TSTREAM/SEL CH# DCH POINT LOOKS CHLIM) (* ; "Edited 6-Jan-2026 20:18 by rmk")
|
||||||
|
(* ; "Edited 6-May-2025 11:36 by rmk")
|
||||||
(* ; "Edited 21-Apr-2025 22:50 by rmk")
|
(* ; "Edited 21-Apr-2025 22:50 by rmk")
|
||||||
(* ; "Edited 6-Apr-2025 11:47 by rmk")
|
(* ; "Edited 6-Apr-2025 11:47 by rmk")
|
||||||
(* ; "Edited 10-Jul-2024 17:25 by rmk")
|
(* ; "Edited 10-Jul-2024 17:25 by rmk")
|
||||||
@@ -1458,6 +1460,13 @@
|
|||||||
(CL:UNLESS POINT
|
(CL:UNLESS POINT
|
||||||
(SETQ POINT (GETTH CH# THPOINT CH#)))
|
(SETQ POINT (GETTH CH# THPOINT CH#)))
|
||||||
(SETQ CH# (GETTH CH# THCH#))
|
(SETQ CH# (GETTH CH# THCH#))
|
||||||
|
elseif (LISTP CH#)
|
||||||
|
then (CL:UNLESS DCH
|
||||||
|
(SETQ DCH (CADR CH#)))
|
||||||
|
(CL:UNLESS POINT
|
||||||
|
(SETQ POINT (CADDR CH#)))
|
||||||
|
(CL:UNLESS CH#
|
||||||
|
(SETQ POINT (CAR CH#)))
|
||||||
else
|
else
|
||||||
(* ;;
|
(* ;;
|
||||||
"Get defaults from SEL (either a selection or a textobj whose SEL is indicated)")
|
"Get defaults from SEL (either a selection or a textobj whose SEL is indicated)")
|
||||||
@@ -1611,7 +1620,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.COPYSEL
|
(\TEDIT.COPYSEL
|
||||||
[LAMBDA (FROM TO) (* ; "Edited 3-Sep-2024 22:44 by rmk")
|
[LAMBDA (FROM TO) (* ; "Edited 11-Jan-2026 00:17 by rmk")
|
||||||
|
(* ; "Edited 3-Sep-2024 22:44 by rmk")
|
||||||
(* ; "Edited 7-Jul-2024 11:21 by rmk")
|
(* ; "Edited 7-Jul-2024 11:21 by rmk")
|
||||||
(* ; "Edited 30-Jun-2024 23:21 by rmk")
|
(* ; "Edited 30-Jun-2024 23:21 by rmk")
|
||||||
(* ; "Edited 29-Apr-2024 12:35 by rmk")
|
(* ; "Edited 29-Apr-2024 12:35 by rmk")
|
||||||
@@ -1644,6 +1654,7 @@
|
|||||||
(FSETSEL TO HASCARET (FGETSEL FROM HASCARET))
|
(FSETSEL TO HASCARET (FGETSEL FROM HASCARET))
|
||||||
(FSETSEL TO SELOBJ (FGETSEL FROM SELOBJ))
|
(FSETSEL TO SELOBJ (FGETSEL FROM SELOBJ))
|
||||||
(FSETSEL TO ONFLG (FGETSEL FROM ONFLG))
|
(FSETSEL TO ONFLG (FGETSEL FROM ONFLG))
|
||||||
|
(FSETSEL TO SELOPERATION (FGETSEL FROM SELOPERATION))
|
||||||
else (SETQ TO (create SELECTION using FROM SELTEXTSTREAM _ NIL L1 _ (COPY (FGETSEL FROM L1))
|
else (SETQ TO (create SELECTION using FROM SELTEXTSTREAM _ NIL L1 _ (COPY (FGETSEL FROM L1))
|
||||||
LN _ (COPY (FGETSEL FROM LN))
|
LN _ (COPY (FGETSEL FROM LN))
|
||||||
SELLINES _ (COPY (FGETSEL FROM SELLINES]
|
SELLINES _ (COPY (FGETSEL FROM SELLINES]
|
||||||
@@ -2030,7 +2041,9 @@
|
|||||||
SPLASTCHAR _ (ffetch (SELPIECES SPLASTCHAR) of SP2])
|
SPLASTCHAR _ (ffetch (SELPIECES SPLASTCHAR) of SP2])
|
||||||
|
|
||||||
(\TEDIT.SELPIECES.CHARTRANSFORM
|
(\TEDIT.SELPIECES.CHARTRANSFORM
|
||||||
[LAMBDA (SELPIECES CHARFN OBJECTSTOO TSTREAM) (* ; "Edited 24-Apr-2025 16:02 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 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")
|
||||||
(* ; "Edited 7-Nov-2024 21:50 by rmk")
|
(* ; "Edited 7-Nov-2024 21:50 by rmk")
|
||||||
@@ -2051,24 +2064,20 @@
|
|||||||
(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.")
|
||||||
|
|
||||||
[for I from 1 to (PLEN PC)
|
[for I from 0 to (PLAST PC)
|
||||||
do (RPLCHARCODE STR I (APPLY* CHARFN (\TEDIT.PIECE.NTHCHARCODE
|
do (RPLCHARCODE STR (ADD1 I)
|
||||||
PC I)
|
(APPLY* CHARFN (\TEDIT.PIECE.NTHCHARCODE PC I)
|
||||||
(add INDEX 1]
|
(add INDEX 1]
|
||||||
(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))))
|
||||||
@@ -2076,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")
|
||||||
@@ -2097,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)))
|
||||||
@@ -2119,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)))
|
||||||
@@ -2146,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
|
||||||
@@ -2237,7 +2239,8 @@
|
|||||||
(FGETSEL SCRSEL CH#])
|
(FGETSEL SCRSEL CH#])
|
||||||
|
|
||||||
(TEDIT.SELPROP
|
(TEDIT.SELPROP
|
||||||
[LAMBDA X (* ; "Edited 28-Feb-2025 17:14 by rmk")
|
[LAMBDA X (* ; "Edited 11-Jan-2026 00:18 by rmk")
|
||||||
|
(* ; "Edited 28-Feb-2025 17:14 by rmk")
|
||||||
(* ; "Edited 6-Feb-2025 16:48 by rmk")
|
(* ; "Edited 6-Feb-2025 16:48 by rmk")
|
||||||
(* ; "Edited 31-Oct-2024 18:00 by rmk")
|
(* ; "Edited 31-Oct-2024 18:00 by rmk")
|
||||||
(* ; "Edited 23-Sep-2024 23:11 by rmk")
|
(* ; "Edited 23-Sep-2024 23:11 by rmk")
|
||||||
@@ -2277,6 +2280,7 @@
|
|||||||
(TEXTSTREAM (FGETSEL SEL SELTEXTSTREAM))
|
(TEXTSTREAM (FGETSEL SEL SELTEXTSTREAM))
|
||||||
(SHADE (FGETSEL SEL HOW))
|
(SHADE (FGETSEL SEL HOW))
|
||||||
(SHADEHEIGHT (FGETSEL SEL HOWHEIGHT))
|
(SHADEHEIGHT (FGETSEL SEL HOWHEIGHT))
|
||||||
|
(SELOPERATION (FGETSEL SEL SELOPERATION))
|
||||||
(SET (FGETSEL SEL SET))
|
(SET (FGETSEL SEL SET))
|
||||||
(\ILLEGAL.ARG PROP))
|
(\ILLEGAL.ARG PROP))
|
||||||
(CL:WHEN (IGREATERP X 2)
|
(CL:WHEN (IGREATERP X 2)
|
||||||
@@ -2296,6 +2300,7 @@
|
|||||||
(CHLIM (\TEDIT.UPDATE.SEL SEL NIL (IDIFFERENCE NEWVALUE (FGETSEL SEL CH#))))
|
(CHLIM (\TEDIT.UPDATE.SEL SEL NIL (IDIFFERENCE NEWVALUE (FGETSEL SEL CH#))))
|
||||||
(SHADE (FSETSEL SEL HOW NEWVALUE))
|
(SHADE (FSETSEL SEL HOW NEWVALUE))
|
||||||
(SHADEHEIGHT (FSETSEL SEL HOWHEIGHT NEWVALUE))
|
(SHADEHEIGHT (FSETSEL SEL HOWHEIGHT NEWVALUE))
|
||||||
|
(SELOPERATION (\TEDIT.SET.SEL.LOOKS SEL NEWVALUE))
|
||||||
(SET (FSETSEL SEL SET NEWVALUE))
|
(SET (FSETSEL SEL SET NEWVALUE))
|
||||||
(\ILLEGAL.ARG PROP))
|
(\ILLEGAL.ARG PROP))
|
||||||
(CL:WHEN (FGETSEL SEL SELTEXTSTREAM)
|
(CL:WHEN (FGETSEL SEL SELTEXTSTREAM)
|
||||||
@@ -2556,26 +2561,26 @@
|
|||||||
(ADDTOVAR LAMA TEDIT.SELPROP)
|
(ADDTOVAR LAMA TEDIT.SELPROP)
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (15897 17718 (\TEDIT.SELECTION.DEFPRINT 15907 . 17716)) (17755 19260 (
|
(FILEMAP (NIL (15886 17707 (\TEDIT.SELECTION.DEFPRINT 15896 . 17705)) (17744 19249 (
|
||||||
\TEDIT.SET.GLOBAL.SELECTIONS 17765 . 19258)) (19261 25482 (\TEDIT.SELECTED.PIECES 19271 . 20910) (
|
\TEDIT.SET.GLOBAL.SELECTIONS 17754 . 19247)) (19250 25471 (\TEDIT.SELECTED.PIECES 19260 . 20899) (
|
||||||
\TEDIT.FIND.PROTECTED.END 20912 . 22706) (\TEDIT.FIND.PROTECTED.START 22708 . 24691) (
|
\TEDIT.FIND.PROTECTED.END 20901 . 22695) (\TEDIT.FIND.PROTECTED.START 22697 . 24680) (
|
||||||
\TEDIT.WORD.BOUND 24693 . 25480)) (25616 59723 (\TEDIT.EXTEND.SEL 25626 . 32866) (\TEDIT.SCAN.LINE
|
\TEDIT.WORD.BOUND 24682 . 25469)) (25605 59712 (\TEDIT.EXTEND.SEL 25615 . 32855) (\TEDIT.SCAN.LINE
|
||||||
32868 . 44541) (\TEDIT.SCAN.LINE.WORD 44543 . 49536) (\TEDIT.XYTOSEL 49538 . 56876) (\TEDIT.REGIONTYPE
|
32857 . 44530) (\TEDIT.SCAN.LINE.WORD 44532 . 49525) (\TEDIT.XYTOSEL 49527 . 56865) (\TEDIT.REGIONTYPE
|
||||||
56878 . 57897) (\TEDIT.XYTOSEL.INLINEP 57899 . 58354) (\TEDIT.XYTOSEL.LINE 58356 . 59721)) (59724
|
56867 . 57886) (\TEDIT.XYTOSEL.INLINEP 57888 . 58343) (\TEDIT.XYTOSEL.LINE 58345 . 59710)) (59713
|
||||||
73269 (\TEDIT.FIXSEL 59734 . 69111) (\TEDIT.CHTOLINEX 69113 . 73267)) (73270 77324 (
|
73258 (\TEDIT.FIXSEL 59723 . 69100) (\TEDIT.CHTOLINEX 69102 . 73256)) (73259 77463 (
|
||||||
\TEDIT.RESET.EXTEND.PENDING.DELETE 73280 . 74558) (\TEDIT.SET.SEL.LOOKS 74560 . 77322)) (78261 99027 (
|
\TEDIT.RESET.EXTEND.PENDING.DELETE 73269 . 74547) (\TEDIT.SET.SEL.LOOKS 74549 . 77461)) (78400 99553 (
|
||||||
\TEDIT.SHOWSEL 78271 . 83247) (\TEDIT.NOSEL 83249 . 83550) (\TEDIT.SEL.OFF 83552 . 83963) (
|
\TEDIT.SHOWSEL 78410 . 83386) (\TEDIT.NOSEL 83388 . 83689) (\TEDIT.SEL.OFF 83691 . 84102) (
|
||||||
\TEDIT.SEL.ON 83965 . 84381) (\TEDIT.SHOWSEL.HILIGHT 84383 . 89004) (\TEDIT.UPDATE.SEL 89006 . 93221)
|
\TEDIT.SEL.ON 84104 . 84520) (\TEDIT.SHOWSEL.HILIGHT 84522 . 89143) (\TEDIT.UPDATE.SEL 89145 . 93747)
|
||||||
(\TEDIT.CARETLINE 93223 . 93937) (\TEDIT.SEL.L1 93939 . 94622) (\TEDIT.SEL.LN 94624 . 95307) (
|
(\TEDIT.CARETLINE 93749 . 94463) (\TEDIT.SEL.L1 94465 . 95148) (\TEDIT.SEL.LN 95150 . 95833) (
|
||||||
\TEDIT.SEL.DELETEDCHARS 95309 . 99025)) (99028 103734 (\TEDIT.COPYSEL 99038 . 101504) (
|
\TEDIT.SEL.DELETEDCHARS 95835 . 99551)) (99554 104436 (\TEDIT.COPYSEL 99564 . 102206) (
|
||||||
\TEDIT.SEL.CHANGED? 101506 . 103732)) (103765 117424 (\TEDIT.SELECT.OBJECT 103775 . 108728) (
|
\TEDIT.SEL.CHANGED? 102208 . 104434)) (104467 118126 (\TEDIT.SELECT.OBJECT 104477 . 109430) (
|
||||||
\TEDIT.SHOWSEL.OBJECT 108730 . 110961) (\TEDIT.CLIP.OBJECT 110963 . 112967) (\TEDIT.OPERATE.OBJECT
|
\TEDIT.SHOWSEL.OBJECT 109432 . 111663) (\TEDIT.CLIP.OBJECT 111665 . 113669) (\TEDIT.OPERATE.OBJECT
|
||||||
112969 . 117422)) (117452 137201 (\TEDIT.SELPIECES 117462 . 121743) (\TEDIT.SELPIECES.COPY 121745 .
|
113671 . 118124)) (118154 137453 (\TEDIT.SELPIECES 118164 . 122445) (\TEDIT.SELPIECES.COPY 122447 .
|
||||||
124234) (\TEDIT.SELPIECES.CONCAT 124236 . 126115) (\TEDIT.SELPIECES.CHARTRANSFORM 126117 . 129576) (
|
124936) (\TEDIT.SELPIECES.CONCAT 124938 . 126817) (\TEDIT.SELPIECES.CHARTRANSFORM 126819 . 130189) (
|
||||||
\TEDIT.SELPIECES.FROM.STRING 129578 . 134836) (\TEDIT.SELPIECES.TO.STRING 134838 . 137199)) (137254
|
\TEDIT.SELPIECES.FROM.STRING 130191 . 135088) (\TEDIT.SELPIECES.TO.STRING 135090 . 137451)) (137506
|
||||||
160955 (TEDIT.XYTOCH 137264 . 139840) (TEDIT.SELPROP 139842 . 143872) (TEDIT.GETPOINT 143874 . 145794)
|
161454 (TEDIT.XYTOCH 137516 . 140092) (TEDIT.SELPROP 140094 . 144371) (TEDIT.GETPOINT 144373 . 146293)
|
||||||
(TEDIT.GETSEL 145796 . 146672) (TEDIT.GETSEL.PARA 146674 . 147623) (TEDIT.SCANSEL 147625 . 148573) (
|
(TEDIT.GETSEL 146295 . 147171) (TEDIT.GETSEL.PARA 147173 . 148122) (TEDIT.SCANSEL 148124 . 149072) (
|
||||||
TEDIT.SET.SEL.LOOKS 148575 . 150060) (TEDIT.SETSEL 150062 . 154980) (TEDIT.SHOWSEL 154982 . 156846) (
|
TEDIT.SET.SEL.LOOKS 149074 . 150559) (TEDIT.SETSEL 150561 . 155479) (TEDIT.SHOWSEL 155481 . 157345) (
|
||||||
TEDIT.SEL.AS.STRING 156848 . 159333) (TEDIT.SEL.AS.SEXPR 159335 . 160621) (TEDIT.SELECTALL 160623 .
|
TEDIT.SEL.AS.STRING 157347 . 159832) (TEDIT.SEL.AS.SEXPR 159834 . 161120) (TEDIT.SELECTALL 161122 .
|
||||||
160953)))))
|
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 " 2-Dec-2025 17:50:45" {WMEDLEY}<library>tedit>TEDIT-STREAM.;930 194007
|
(FILECREATED " 1-May-2026 08:15:56" {MEDLEY}<library>tedit>TEDIT-STREAM.;956 190971
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS OPENTEXTSTREAM \TEDIT.OPENTEXTFILE)
|
:CHANGES-TO (RECORDS PIECE)
|
||||||
|
|
||||||
:PREVIOUS-DATE "19-Oct-2025 15:09:09" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;927)
|
: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 PTYPE PCONTENTS PCHARLOOKS PCHARSET PPARALOOKS
|
(MACROS NEXTPIECE PREVPIECE PLEN PLAST PTYPE PCONTENTS PCHARLOOKS 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)
|
||||||
@@ -43,7 +43,9 @@
|
|||||||
(FNS \TEDIT.REOPENTEXTSTREAM \TEDIT.OPENTEXTSTREAM.PIECES \TEDIT.OPENTEXTSTREAM.PROPS
|
(FNS \TEDIT.REOPENTEXTSTREAM \TEDIT.OPENTEXTSTREAM.PIECES \TEDIT.OPENTEXTSTREAM.PROPS
|
||||||
\TEDIT.OPENTEXTSTREAM.SETUP.SEL \TEDIT.OPENTEXTSTREAM.WINDOW
|
\TEDIT.OPENTEXTSTREAM.SETUP.SEL \TEDIT.OPENTEXTSTREAM.WINDOW
|
||||||
\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS \TEDIT.OPENTEXTFILE \TEDIT.CREATE.TEXTSTREAM
|
\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS \TEDIT.OPENTEXTFILE \TEDIT.CREATE.TEXTSTREAM
|
||||||
\TEDIT.REOPEN.STREAM \TEDIT.TEXTINIT)
|
\TEDIT.REOPEN.STREAM)
|
||||||
|
(FNS \TEDIT.STREAMINIT TEDIT.IMAGESTREAM.OPEN)
|
||||||
|
(ALISTS (IMAGESTREAMTYPES TEDIT))
|
||||||
|
|
||||||
(* ;; "Is this being used:")
|
(* ;; "Is this being used:")
|
||||||
|
|
||||||
@@ -69,10 +71,7 @@
|
|||||||
(MACROS \INSERTCH.EXTENDABLE))
|
(MACROS \INSERTCH.EXTENDABLE))
|
||||||
(FNS \TEDIT.DELETE.SELPIECES \TEDIT.INSERTCH \TEDIT.INSERTCH.HISTORY \TEDIT.INSERTEOL
|
(FNS \TEDIT.DELETE.SELPIECES \TEDIT.INSERTCH \TEDIT.INSERTCH.HISTORY \TEDIT.INSERTEOL
|
||||||
\TEDIT.INSERTCH.INSERTION \TEDIT.INSERTCH.EXTEND)
|
\TEDIT.INSERTCH.INSERTION \TEDIT.INSERTCH.EXTEND)
|
||||||
(FNS \TEDIT.NEXTCHANGEABLE.CHNO \TEDIT.LASTCHANGEABLE.CHNO)
|
(FNS \TEDIT.NEXTCHANGEABLE.CHNO \TEDIT.LASTCHANGEABLE.CHNO))
|
||||||
(FNS \SETUPGETCH))
|
|
||||||
(* ;
|
|
||||||
"Deprecated, maybe still external callers")
|
|
||||||
(FNS \TEDIT.INSTALL.PIECE)
|
(FNS \TEDIT.INSTALL.PIECE)
|
||||||
[COMS (* ; "Support for TEXTPROP")
|
[COMS (* ; "Support for TEXTPROP")
|
||||||
(FNS TEXTPROP GETTEXTPROP PUTTEXTPROP GETTEXTPROPS PUTTEXTPROPS TEXTPROP.ADD
|
(FNS TEXTPROP GETTEXTPROP PUTTEXTPROP GETTEXTPROPS PUTTEXTPROPS TEXTPROP.ADD
|
||||||
@@ -83,7 +82,7 @@
|
|||||||
(ADDVARS (INSPECTMACROS (TEXTOBJ \TEDIT.TEXTOBJ.PROPNAMES
|
(ADDVARS (INSPECTMACROS (TEXTOBJ \TEDIT.TEXTOBJ.PROPNAMES
|
||||||
\TEDIT.TEXTOBJ.PROPFETCHFN
|
\TEDIT.TEXTOBJ.PROPFETCHFN
|
||||||
\TEDIT.TEXTOBJ.PROPSTOREFN]
|
\TEDIT.TEXTOBJ.PROPSTOREFN]
|
||||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEDIT.TEXTINIT)))
|
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEDIT.STREAMINIT)))
|
||||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||||
(NLAML)
|
(NLAML)
|
||||||
(LAMA TEXTPROP])
|
(LAMA TEXTPROP])
|
||||||
@@ -95,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 (* ;
|
||||||
@@ -112,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 (
|
||||||
(* ;;
|
(* ;;
|
||||||
@@ -158,8 +155,7 @@
|
|||||||
"The current selection within the text")
|
"The current selection within the text")
|
||||||
LASTARROWX (* ;
|
LASTARROWX (* ;
|
||||||
"X for next arrow up or arrow down. Was: Scratch space for the selection code")
|
"X for next arrow up or arrow down. Was: Scratch space for the selection code")
|
||||||
NIL (* ;
|
SECONDARYSEL (* ; "Holds secondary selection and operation just before the mouse leaves a window. Was MOVESEL: Source for the next MOVE of text")
|
||||||
"Was MOVESEL: Source for the next MOVE of text")
|
|
||||||
NIL (* ;
|
NIL (* ;
|
||||||
"Was SHIFTEDSEL: Source for the next COPY")
|
"Was SHIFTEDSEL: Source for the next COPY")
|
||||||
NIL (* ;
|
NIL (* ;
|
||||||
@@ -296,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)
|
||||||
@@ -313,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
|
||||||
@@ -395,6 +391,9 @@
|
|||||||
(PUTPROPS PLEN MACRO ((PC)
|
(PUTPROPS PLEN MACRO ((PC)
|
||||||
(ffetch (PIECE PLEN) of PC)))
|
(ffetch (PIECE PLEN) of PC)))
|
||||||
|
|
||||||
|
(PUTPROPS PLAST MACRO ((PC)
|
||||||
|
(SUB1 (PLEN PC))))
|
||||||
|
|
||||||
(PUTPROPS PTYPE MACRO ((PC)
|
(PUTPROPS PTYPE MACRO ((PC)
|
||||||
(ffetch (PIECE PTYPE) of PC)))
|
(ffetch (PIECE PTYPE) of PC)))
|
||||||
|
|
||||||
@@ -404,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)))
|
||||||
|
|
||||||
@@ -416,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)))
|
||||||
|
|
||||||
@@ -453,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
|
||||||
@@ -516,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)
|
||||||
@@ -526,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)
|
||||||
@@ -556,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))
|
||||||
|
|
||||||
@@ -565,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)
|
||||||
@@ -579,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
|
||||||
|
|
||||||
@@ -598,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)
|
||||||
@@ -615,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
|
||||||
@@ -696,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")
|
||||||
@@ -817,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))
|
||||||
@@ -847,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")
|
||||||
@@ -910,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")))
|
||||||
@@ -922,7 +898,9 @@
|
|||||||
else (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM])
|
else (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM])
|
||||||
|
|
||||||
(\TEDIT.TEXTBACKFILEPTR
|
(\TEDIT.TEXTBACKFILEPTR
|
||||||
[LAMBDA (TSTREAM) (* ; "Edited 21-Oct-2024 00:33 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 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")
|
||||||
(* ; "Edited 28-Dec-2023 13:34 by rmk")
|
(* ; "Edited 28-Dec-2023 13:34 by rmk")
|
||||||
@@ -954,7 +932,7 @@
|
|||||||
then (CL:WHEN (SETQ PPC (\PREV.VISIBLE.PIECE PC))
|
then (CL:WHEN (SETQ PPC (\PREV.VISIBLE.PIECE PC))
|
||||||
(* ;
|
(* ;
|
||||||
"Back up to last char of previous piece, if any.")
|
"Back up to last char of previous piece, if any.")
|
||||||
(\TEDIT.INSTALL.PIECE TSTREAM PPC (SUB1 (PLEN PPC)))
|
(\TEDIT.INSTALL.PIECE TSTREAM PPC (PLAST PPC))
|
||||||
(SETQ PC PPC))
|
(SETQ PC PPC))
|
||||||
elseif (AND (MEMB (PTYPE PC)
|
elseif (AND (MEMB (PTYPE PC)
|
||||||
FILE.PTYPES)
|
FILE.PTYPES)
|
||||||
@@ -1006,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)))
|
||||||
@@ -1519,7 +1493,8 @@
|
|||||||
(\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS TEXTOBJ])
|
(\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS TEXTOBJ])
|
||||||
|
|
||||||
(\TEDIT.OPENTEXTSTREAM.SETUP.SEL
|
(\TEDIT.OPENTEXTSTREAM.SETUP.SEL
|
||||||
[LAMBDA (TSTREAM) (* ; "Edited 21-Apr-2025 20:14 by rmk")
|
[LAMBDA (TSTREAM) (* ; "Edited 10-Jan-2026 23:53 by rmk")
|
||||||
|
(* ; "Edited 21-Apr-2025 20:14 by rmk")
|
||||||
(* ; "Edited 6-Apr-2025 14:24 by rmk")
|
(* ; "Edited 6-Apr-2025 14:24 by rmk")
|
||||||
(* ; "Edited 17-Feb-2025 08:56 by rmk")
|
(* ; "Edited 17-Feb-2025 08:56 by rmk")
|
||||||
(* ; "Edited 25-Nov-2024 14:33 by rmk")
|
(* ; "Edited 25-Nov-2024 14:33 by rmk")
|
||||||
@@ -1562,20 +1537,22 @@
|
|||||||
(OR (CADR SELPROP)
|
(OR (CADR SELPROP)
|
||||||
0)
|
0)
|
||||||
(OR (CADDR SELPROP)
|
(OR (CADDR SELPROP)
|
||||||
'LEFT))
|
'LEFT)
|
||||||
|
'NORMAL)
|
||||||
elseif (FIXP SELPROP)
|
elseif (FIXP SELPROP)
|
||||||
then (\TEDIT.UPDATE.SEL SEL SELPROP 0 'LEFT)
|
then (\TEDIT.UPDATE.SEL SEL SELPROP 0 'LEFT 'NORMAL)
|
||||||
elseif (FGETTOBJ TEXTOBJ TXTAPPENDONLY)
|
elseif (FGETTOBJ TEXTOBJ TXTAPPENDONLY)
|
||||||
then
|
then
|
||||||
(* ;; "Default to after the last character")
|
(* ;; "Default to after the last character")
|
||||||
|
|
||||||
(\TEDIT.UPDATE.SEL SEL (FGETTOBJ TEXTOBJ TEXTLEN)
|
(\TEDIT.UPDATE.SEL SEL (FGETTOBJ TEXTOBJ TEXTLEN)
|
||||||
0
|
0
|
||||||
'RIGHT)
|
'RIGHT
|
||||||
|
'NORMAL)
|
||||||
else
|
else
|
||||||
(* ;; "Default to before the first character. UPDATE.SEL screws up the CHLIM=CH#+DCH invariant when DCH=0, it adds 1, But UPDATE.SEL adds 1 when DCH=0. That's wrong for the initial caret, so brute-force fix it here. Maybe it's wrong in general?")
|
(* ;; "Default to before the first character. UPDATE.SEL screws up the CHLIM=CH#+DCH invariant when DCH=0, it adds 1, But UPDATE.SEL adds 1 when DCH=0. That's wrong for the initial caret, so brute-force fix it here. Maybe it's wrong in general?")
|
||||||
|
|
||||||
(\TEDIT.UPDATE.SEL SEL 1 0 'LEFT)
|
(\TEDIT.UPDATE.SEL SEL 1 0 'LEFT 'NORMAL)
|
||||||
(FSETSEL SEL CHLIM 1))
|
(FSETSEL SEL CHLIM 1))
|
||||||
[FSETTOBJ TEXTOBJ CARETLOOKS (if (FGETSEL SEL SET)
|
[FSETTOBJ TEXTOBJ CARETLOOKS (if (FGETSEL SEL SET)
|
||||||
then (* ;
|
then (* ;
|
||||||
@@ -1751,9 +1728,14 @@
|
|||||||
(* ;; "Return the new value for the stream:")
|
(* ;; "Return the new value for the stream:")
|
||||||
|
|
||||||
NEWSTREAM])
|
NEWSTREAM])
|
||||||
|
)
|
||||||
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.TEXTINIT
|
(\TEDIT.STREAMINIT
|
||||||
[LAMBDA NIL (* ; "Edited 23-Sep-2025 21:03 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 23-Sep-2025 21:03 by rmk")
|
||||||
(* ; "Edited 20-Sep-2025 08:48 by rmk")
|
(* ; "Edited 20-Sep-2025 08:48 by rmk")
|
||||||
(* ; "Edited 18-Sep-2025 14:52 by rmk")
|
(* ; "Edited 18-Sep-2025 14:52 by rmk")
|
||||||
(* ; "Edited 10-Jul-2025 11:28 by rmk")
|
(* ; "Edited 10-Jul-2025 11:28 by rmk")
|
||||||
@@ -1807,22 +1789,14 @@
|
|||||||
IMSCALE _ [FUNCTION (LAMBDA NIL 1]
|
IMSCALE _ [FUNCTION (LAMBDA NIL 1]
|
||||||
IMCOLOR _ (FUNCTION \TEDIT.TEXTCOLOR)))
|
IMCOLOR _ (FUNCTION \TEDIT.TEXTCOLOR)))
|
||||||
|
|
||||||
(* ;; "Do we need TEXT here?")
|
|
||||||
|
|
||||||
(FONTPROFILE.ADDDEVICE 'TEXT 'DISPLAY)
|
|
||||||
(ADDTOVAR IMAGESTREAMTYPES (TEXT (FONTCREATE \CREATEDISPLAYFONT)
|
|
||||||
(CREATECHARSET \CREATECHARSET.DISPLAY)))
|
|
||||||
(ADDTOVAR IMAGESTREAMTYPES (TEDIT (FONTCREATE \CREATEDISPLAYFONT)
|
|
||||||
(CREATECHARSET \CREATECHARSET.DISPLAY)))
|
|
||||||
|
|
||||||
(* ;; "Maybe more functions later. The INCODE and BACK functions possibly need to count. If \TEXTBACKFILEPTR takes a count variable, the extra level wouldn't be needed. But INCCODE wants to go through the BIN opcode")
|
(* ;; "Maybe more functions later. The INCODE and BACK functions possibly need to count. If \TEXTBACKFILEPTR takes a count variable, the extra level wouldn't be needed. But INCCODE wants to go through the BIN opcode")
|
||||||
|
|
||||||
(MAKE-EXTERNALFORMAT :TEXTSTREAM (FUNCTION \TEDIT.TEXTINCCODEFN)
|
(MAKE-EXTERNALFORMAT :TEDIT (FUNCTION \TEDIT.TEXTINCCODEFN)
|
||||||
(FUNCTION \TEDIT.TEXTPEEKBIN)
|
(FUNCTION \TEDIT.TEXTPEEKBIN)
|
||||||
(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. ")
|
||||||
|
|
||||||
@@ -1860,8 +1834,7 @@
|
|||||||
FDEXTENDABLE _ NIL
|
FDEXTENDABLE _ NIL
|
||||||
TRUNCATEFILE _ (FUNCTION NILL)
|
TRUNCATEFILE _ (FUNCTION NILL)
|
||||||
WRITEPAGES _ (FUNCTION NILL)
|
WRITEPAGES _ (FUNCTION NILL)
|
||||||
DEFAULTEXTERNALFORMAT _ :TEXTSTREAM))
|
DEFAULTEXTERNALFORMAT _ :TEDIT)) (* ;
|
||||||
(* ;
|
|
||||||
"Only load once, not every time TEDIT-STREAM is loaded e.g. in development")
|
"Only load once, not every time TEDIT-STREAM is loaded e.g. in development")
|
||||||
(RPAQ? *TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN))
|
(RPAQ? *TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN))
|
||||||
(CL:SETF (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN)
|
(CL:SETF (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN)
|
||||||
@@ -1881,8 +1854,15 @@
|
|||||||
(* ;
|
(* ;
|
||||||
"Some other kind of stream, so punt to the old handler (if there is one):")
|
"Some other kind of stream, so punt to the old handler (if there is one):")
|
||||||
(APPLY* *TEDIT-OLD-STREAM-ERROR-HANDLER* CONDITION])
|
(APPLY* *TEDIT-OLD-STREAM-ERROR-HANDLER* CONDITION])
|
||||||
|
|
||||||
|
(TEDIT.IMAGESTREAM.OPEN
|
||||||
|
[LAMBDA (FILE OPTIONS) (* ; "Edited 26-Jan-2026 23:55 by rmk")
|
||||||
|
(OPENTEXTSTREAM FILE NIL OPTIONS])
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(ADDTOVAR IMAGESTREAMTYPES (TEDIT (OPENSTREAM TEDIT.IMAGESTREAM.OPEN)
|
||||||
|
(CREATECHARSET \CREATECHARSET.DISPLAY)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* ;; "Is this being used:")
|
(* ;; "Is this being used:")
|
||||||
@@ -2249,7 +2229,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.NTHCHARCODE
|
(\TEDIT.NTHCHARCODE
|
||||||
[LAMBDA (TSTREAM N) (* ; "Edited 24-Apr-2025 16:03 by rmk")
|
[LAMBDA (TSTREAM N) (* ; "Edited 15-Feb-2026 14:40 by rmk")
|
||||||
|
(* ; "Edited 24-Apr-2025 16:03 by rmk")
|
||||||
(* ; "Edited 28-Mar-2025 18:31 by rmk")
|
(* ; "Edited 28-Mar-2025 18:31 by rmk")
|
||||||
(* ; "Edited 7-Jul-2024 11:09 by rmk")
|
(* ; "Edited 7-Jul-2024 11:09 by rmk")
|
||||||
(* ; "Edited 29-Apr-2024 13:06 by rmk")
|
(* ; "Edited 29-Apr-2024 13:06 by rmk")
|
||||||
@@ -2266,11 +2247,12 @@
|
|||||||
(CL:WHEN (AND (IGEQ N 1)
|
(CL:WHEN (AND (IGEQ N 1)
|
||||||
(ILEQ N (FGETTOBJ TEXTOBJ TEXTLEN)))
|
(ILEQ N (FGETTOBJ TEXTOBJ TEXTLEN)))
|
||||||
(\TEDIT.PIECE.NTHCHARCODE (\TEDIT.CHTOPC N TEXTOBJ T)
|
(\TEDIT.PIECE.NTHCHARCODE (\TEDIT.CHTOPC N TEXTOBJ T)
|
||||||
(IDIFFERENCE (ADD1 N)
|
(IDIFFERENCE N START-OF-PIECE)))])
|
||||||
START-OF-PIECE)))])
|
|
||||||
|
|
||||||
(\TEDIT.PIECE.NTHCHARCODE
|
(\TEDIT.PIECE.NTHCHARCODE
|
||||||
[LAMBDA (PC OFFSET) (* ; "Edited 24-Apr-2025 16:04 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 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")
|
||||||
(* ; "Edited 22-Mar-2024 00:02 by rmk")
|
(* ; "Edited 22-Mar-2024 00:02 by rmk")
|
||||||
@@ -2282,39 +2264,29 @@
|
|||||||
(* ; "Edited 8-Nov-2023 08:43 by rmk")
|
(* ; "Edited 8-Nov-2023 08:43 by rmk")
|
||||||
(* ; "Edited 5-Nov-2023 08:17 by rmk")
|
(* ; "Edited 5-Nov-2023 08:17 by rmk")
|
||||||
|
|
||||||
(* ;; "Returns the OFFSETth charcode of PC, NIL if OFFSET is out of bounds. For file pieces, ensures that the backing stream is restored to its original position, so that it remains comaptible with the values (buffer, offset) in the textstream.")
|
(* ;; "Returns the OFFSETth charcode of PC, NIL if OFFSET is out of bounds. For file pieces, ensures that the backing stream is restored to its original position, so that it remains comaptible with the values (buffer, offset) in the textstream. OFFSET ranges from 0 to PLEN-1.")
|
||||||
|
|
||||||
(CL:WHEN (AND (IGEQ OFFSET 1)
|
(CL:WHEN (AND (IGEQ OFFSET 0)
|
||||||
(ILEQ OFFSET (PLEN PC)))
|
(ILESSP OFFSET (PLEN PC)))
|
||||||
[LET ((PCONTENTS (PCONTENTS PC))
|
[LET ((PCONTENTS (PCONTENTS PC))
|
||||||
FILEPOS)
|
FILEPOS)
|
||||||
(SELECTC (PTYPE PC)
|
(SELECTC (PTYPE PC)
|
||||||
(STRING.PTYPES (NTHCHARCODE PCONTENTS OFFSET))
|
(STRING.PTYPES (NTHCHARCODE PCONTENTS (ADD1 OFFSET)))
|
||||||
(THINFILE.PTYPE
|
(THINFILE.PTYPE
|
||||||
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
||||||
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
||||||
(SUB1 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)
|
|
||||||
(SUB1 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)
|
||||||
(UNFOLD (SUB1 OFFSET)
|
(UNFOLD OFFSET 2)))
|
||||||
2)))
|
|
||||||
(PROG1 (\WIN PCONTENTS)
|
(PROG1 (\WIN PCONTENTS)
|
||||||
(\SETFILEPTR PCONTENTS FILEPOS)))
|
(\SETFILEPTR PCONTENTS FILEPOS)))
|
||||||
(UTF8.PTYPE (SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
(UTF8.PTYPE (SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
||||||
[\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
[\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
||||||
(ITIMES (SUB1 OFFSET)
|
(ITIMES OFFSET (PBYTESPERCHAR PC]
|
||||||
(PBYTESPERCHAR PC]
|
|
||||||
(PROG1 (UTF8.INCCODEFN PCONTENTS)
|
(PROG1 (UTF8.INCCODEFN PCONTENTS)
|
||||||
(\SETFILEPTR PCONTENTS FILEPOS)))
|
(\SETFILEPTR PCONTENTS FILEPOS)))
|
||||||
(OBJECT.PTYPE PCONTENTS)
|
(OBJECT.PTYPE PCONTENTS)
|
||||||
@@ -2327,7 +2299,8 @@
|
|||||||
(\TEDIT.THELP '\TEDIT.PIECE.NTHCHARCODE])])
|
(\TEDIT.THELP '\TEDIT.PIECE.NTHCHARCODE])])
|
||||||
|
|
||||||
(\TEDIT.RPLCHARCODE
|
(\TEDIT.RPLCHARCODE
|
||||||
[LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "Edited 24-Apr-2025 17:24 by rmk")
|
[LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "Edited 16-Feb-2026 08:37 by rmk")
|
||||||
|
(* ; "Edited 24-Apr-2025 17:24 by rmk")
|
||||||
(* ; "Edited 20-Apr-2025 13:25 by rmk")
|
(* ; "Edited 20-Apr-2025 13:25 by rmk")
|
||||||
(* ; "Edited 28-Mar-2025 10:04 by rmk")
|
(* ; "Edited 28-Mar-2025 10:04 by rmk")
|
||||||
|
|
||||||
@@ -2343,16 +2316,18 @@
|
|||||||
(DECLARE (SPECVARS START-OF-PIECE))
|
(DECLARE (SPECVARS START-OF-PIECE))
|
||||||
(replace (STREAM BINABLE) of TSTREAM with NIL)
|
(replace (STREAM BINABLE) of TSTREAM with NIL)
|
||||||
(SETQ OLDCHAR (\TEDIT.PIECE.RPLCHARCODE TEXTOBJ (\TEDIT.CHTOPC N TEXTOBJ T)
|
(SETQ OLDCHAR (\TEDIT.PIECE.RPLCHARCODE TEXTOBJ (\TEDIT.CHTOPC N TEXTOBJ T)
|
||||||
(ADD1 (IDIFFERENCE N START-OF-PIECE))
|
(IDIFFERENCE N START-OF-PIECE)
|
||||||
NEWCHARCODE NEWCHARLOOKS))
|
NEWCHARCODE NEWCHARLOOKS))
|
||||||
(\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :ReplaceCode N NIL NIL NIL
|
(\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :ReplaceCode N 1 NIL NIL
|
||||||
OLDCHAR))
|
OLDCHAR))
|
||||||
(CL:UNLESS (OR DONTDISPLAY (NOT (\TEDIT.PRIMARYPANE TEXTOBJ)))
|
(CL:UNLESS (OR DONTDISPLAY (NOT (\TEDIT.PRIMARYPANE TEXTOBJ)))
|
||||||
(\TEDIT.UPDATE.LINES TSTREAM 'CHANGED N 1))
|
(\TEDIT.UPDATE.LINES TSTREAM 'CHANGED N 1))
|
||||||
TSTREAM))])
|
TSTREAM))])
|
||||||
|
|
||||||
(\TEDIT.PIECE.RPLCHARCODE
|
(\TEDIT.PIECE.RPLCHARCODE
|
||||||
[LAMBDA (TEXTOBJ PC OFFSET NEWCHARCODE NEWCHARLOOKS) (* ; "Edited 28-Jul-2025 23:38 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 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")
|
||||||
(* ; "Edited 28-Mar-2025 10:04 by rmk")
|
(* ; "Edited 28-Mar-2025 10:04 by rmk")
|
||||||
@@ -2377,17 +2352,15 @@
|
|||||||
"Fast case: Smash a new character code into an existing string piece with same looks. ")
|
"Fast case: Smash a new character code into an existing string piece with same looks. ")
|
||||||
|
|
||||||
(SETQ OLDCHAR (NTHCHARCODE (PCONTENTS PC)
|
(SETQ OLDCHAR (NTHCHARCODE (PCONTENTS PC)
|
||||||
OFFSET))
|
(ADD1 OFFSET)))
|
||||||
(RPLCHARCODE (PCONTENTS PC)
|
(RPLCHARCODE (PCONTENTS PC)
|
||||||
OFFSET NEWCHARCODE) (* ;
|
(ADD1 OFFSET)
|
||||||
|
NEWCHARCODE) (* ;
|
||||||
"May upgrade string from thin to fat")
|
"May upgrade string from thin to fat")
|
||||||
(CL:WHEN (AND (EQ THINSTRING.PTYPE (PTYPE PC))
|
(CL:WHEN (AND (EQ THINSTRING.PTYPE (PTYPE PC))
|
||||||
(IGREATERP NEWCHARCODE 255))
|
(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)
|
||||||
@@ -2396,43 +2369,37 @@
|
|||||||
(FSETPC PC PCONTENTS NEWCHARCODE)
|
(FSETPC PC PCONTENTS NEWCHARCODE)
|
||||||
else
|
else
|
||||||
(* ;;
|
(* ;;
|
||||||
"PC contained character OFFSET now becomes the suffix of characters after offset.")
|
"The PC that contained character OFFSET now becomes the suffix of characters after offset.")
|
||||||
|
|
||||||
(CL:UNLESS (IEQP OFFSET (PLEN PC)) (* ; "No suffix for the last character")
|
(CL:UNLESS (IEQP OFFSET (PLAST PC)) (* ; "No suffix for the last character")
|
||||||
|
|
||||||
(* ;;
|
(* ;;
|
||||||
"Chop off the suffix (essentially (\TEDIT.ALIGNEDPIECE CHNO ..) but we already have the piece")
|
"Chop off the suffix (essentially (\TEDIT.ALIGNEDPIECE CHNO ..) but we already have the piece")
|
||||||
|
|
||||||
(\TEDIT.SPLITPIECE PC OFFSET TEXTOBJ)
|
(\TEDIT.SPLITPIECE PC (ADD1 OFFSET)
|
||||||
|
TEXTOBJ)
|
||||||
(SETQ PC (PREVPIECE PC))) (* ;
|
(SETQ PC (PREVPIECE PC))) (* ;
|
||||||
"Original PC holds the suffix, new PC ends with change position.")
|
"Original PC holds the suffix, new PC ends with change position.")
|
||||||
(CL:UNLESS (EQ OFFSET 1)
|
(CL:UNLESS (EQ OFFSET 0)
|
||||||
(SETQ PC (\TEDIT.SPLITPIECE PC (SUB1 OFFSET)
|
(SETQ PC (\TEDIT.SPLITPIECE PC (SUB1 OFFSET)
|
||||||
TEXTOBJ))) (* ;
|
TEXTOBJ))) (* ;
|
||||||
"Chop off the prefix. PC is now the singleton target ")
|
"Chop off the prefix. PC is now the singleton target ")
|
||||||
|
|
||||||
(* ;; "OFFSET is now isolated into a one-character new piece which we smash. ")
|
(* ;; "OFFSET is now isolated into a one-character new piece which we smash. ")
|
||||||
|
|
||||||
(SETQ OLDCHAR (\TEDIT.PIECE.NTHCHARCODE PC 1))
|
(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 255)
|
(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)
|
||||||
@@ -2536,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")
|
||||||
@@ -2624,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))
|
||||||
|
|
||||||
@@ -2775,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")
|
||||||
@@ -2786,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)
|
||||||
@@ -2810,7 +2772,8 @@
|
|||||||
else (SUB1 (\TEDIT.PCTOCH PC TEXTOBJ])
|
else (SUB1 (\TEDIT.PCTOCH PC TEXTOBJ])
|
||||||
|
|
||||||
(\TEDIT.LASTCHANGEABLE.CHNO
|
(\TEDIT.LASTCHANGEABLE.CHNO
|
||||||
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 26-Nov-2024 00:00 by rmk")
|
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 16-Feb-2026 08:53 by rmk")
|
||||||
|
(* ; "Edited 26-Nov-2024 00:00 by rmk")
|
||||||
|
|
||||||
(* ;; "Returns the number of the first visible character at or before CHNO, NIL if the first visible character is protected. Almost always CHNO--PCTOCH is the unusual case.")
|
(* ;; "Returns the number of the first visible character at or before CHNO, NIL if the first visible character is protected. Almost always CHNO--PCTOCH is the unusual case.")
|
||||||
|
|
||||||
@@ -2819,48 +2782,14 @@
|
|||||||
CLPROTECTED) when (VISIBLEPIECEP PC)
|
CLPROTECTED) when (VISIBLEPIECEP PC)
|
||||||
do (RETURN (if (EQ PC FIRSTPIECE)
|
do (RETURN (if (EQ PC FIRSTPIECE)
|
||||||
then CHNO
|
then CHNO
|
||||||
else (IPLUS (SUB1 (PLEN PC))
|
else (IPLUS (PLAST PC)
|
||||||
(\TEDIT.PCTOCH PC TEXTOBJ])
|
(\TEDIT.PCTOCH PC TEXTOBJ])
|
||||||
)
|
)
|
||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\SETUPGETCH
|
|
||||||
[LAMBDA (CH# TEXTOBJ) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
|
||||||
(* ; "Edited 29-Apr-2024 12:14 by rmk")
|
|
||||||
(* ; "Edited 17-Mar-2024 00:27 by rmk")
|
|
||||||
(* ; "Edited 23-Dec-2023 12:14 by rmk")
|
|
||||||
(* ; "Edited 22-Aug-2022 13:04 by rmk")
|
|
||||||
(* ; "Edited 10-Aug-2022 17:20 by rmk")
|
|
||||||
(* ; "Edited 8-Aug-2022 15:07 by rmk")
|
|
||||||
(* ; "Edited 31-Jul-2022 21:27 by rmk")
|
|
||||||
(* ; "Edited 14-Apr-93 17:14 by jds")
|
|
||||||
|
|
||||||
(* ;;; "Set up TEXTOBJ so that the next \GETCH will retrieve character # CH#")
|
|
||||||
|
|
||||||
(* ;; "NB that 1st char in the textobj is #1.")
|
|
||||||
|
|
||||||
(* ;; "NOBODY CALLS IT WITH A PIECE. CALLS |INSTALL.PIECE INSTEAD")
|
|
||||||
|
|
||||||
(SETQ TEXTOBJ (TEXTOBJ))
|
|
||||||
(LET ((TSTREAM (TEXTSTREAM TEXTOBJ)))
|
|
||||||
(COND
|
|
||||||
((TYPE? PIECE CH#)
|
|
||||||
(\TEDIT.THELP "\SETUPGETCH CALLED WITH PIECE")
|
|
||||||
(\TEDIT.INSTALL.PIECE TSTREAM CH# 0))
|
|
||||||
(T (LET (START-OF-PIECE PC)
|
|
||||||
(DECLARE (SPECVARS START-OF-PIECE))
|
|
||||||
(SETQ PC (\TEDIT.CHTOPC CH# TEXTOBJ T))
|
|
||||||
(\TEDIT.INSTALL.PIECE TSTREAM PC (- CH# START-OF-PIECE])
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* ; "Deprecated, maybe still external callers")
|
|
||||||
|
|
||||||
(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")
|
||||||
@@ -2915,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)
|
||||||
@@ -3140,7 +3073,7 @@
|
|||||||
)
|
)
|
||||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||||
|
|
||||||
(\TEDIT.TEXTINIT)
|
(\TEDIT.STREAMINIT)
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||||
|
|
||||||
@@ -3151,34 +3084,33 @@
|
|||||||
(ADDTOVAR LAMA TEXTPROP)
|
(ADDTOVAR LAMA TEXTPROP)
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (36705 67564 (\TEDIT.TEXTBIN 36715 . 47508) (\TEDIT.TEXTPEEKBIN 47510 . 53060) (
|
(FILEMAP (NIL (36156 66033 (\TEDIT.TEXTBIN 36166 . 46068) (\TEDIT.TEXTPEEKBIN 46070 . 51495) (
|
||||||
\TEDIT.TEXTBACKFILEPTR 53062 . 58735) (\TEDIT.TEXTBOUT 58737 . 63354) (\TEDIT.INSTALL.FILEBUFFER 63356
|
\TEDIT.TEXTBACKFILEPTR 51497 . 57204) (\TEDIT.TEXTBOUT 57206 . 61823) (\TEDIT.INSTALL.FILEBUFFER 61825
|
||||||
. 67562)) (68462 72753 (\TEDIT.TEXTOUTCHARFN 68472 . 70028) (\TEDIT.TEXTINCCODEFN 70030 . 70769) (
|
. 66031)) (66931 71222 (\TEDIT.TEXTOUTCHARFN 66941 . 68497) (\TEDIT.TEXTINCCODEFN 68499 . 69238) (
|
||||||
\TEDIT.TEXTBACKCCODEFN 70771 . 71363) (\TEDIT.TEXTFORMATBYTESTREAM 71365 . 72202) (
|
\TEDIT.TEXTBACKCCODEFN 69240 . 69832) (\TEDIT.TEXTFORMATBYTESTREAM 69834 . 70671) (
|
||||||
\TEDIT.TEXTFORMATBYTESTRING 72204 . 72751)) (72800 84875 (OPENTEXTSTREAM 72810 . 79786) (
|
\TEDIT.TEXTFORMATBYTESTRING 70673 . 71220)) (71269 83344 (OPENTEXTSTREAM 71279 . 78255) (
|
||||||
COPYTEXTSTREAM 79788 . 84098) (TEDIT.STREAMCHANGEDP 84100 . 84402) (TXTFILE 84404 . 84873)) (84876
|
COPYTEXTSTREAM 78257 . 82567) (TEDIT.STREAMCHANGEDP 82569 . 82871) (TXTFILE 82873 . 83342)) (83345
|
||||||
116145 (\TEDIT.REOPENTEXTSTREAM 84886 . 86238) (\TEDIT.OPENTEXTSTREAM.PIECES 86240 . 91168) (
|
106550 (\TEDIT.REOPENTEXTSTREAM 83355 . 84707) (\TEDIT.OPENTEXTSTREAM.PIECES 84709 . 89637) (
|
||||||
\TEDIT.OPENTEXTSTREAM.PROPS 91170 . 92272) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92274 . 97515) (
|
\TEDIT.OPENTEXTSTREAM.PROPS 89639 . 90741) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 90743 . 96193) (
|
||||||
\TEDIT.OPENTEXTSTREAM.WINDOW 97517 . 100308) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100310 . 102249) (
|
\TEDIT.OPENTEXTSTREAM.WINDOW 96195 . 98986) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 98988 . 100927) (
|
||||||
\TEDIT.OPENTEXTFILE 102251 . 104383) (\TEDIT.CREATE.TEXTSTREAM 104385 . 105532) (\TEDIT.REOPEN.STREAM
|
\TEDIT.OPENTEXTFILE 100929 . 103061) (\TEDIT.CREATE.TEXTSTREAM 103063 . 104210) (\TEDIT.REOPEN.STREAM
|
||||||
105534 . 107870) (\TEDIT.TEXTINIT 107872 . 116143)) (116183 117371 (\TEDIT.TTYBOUT 116193 . 117369)) (
|
104212 . 106548)) (106551 114883 (\TEDIT.STREAMINIT 106561 . 114700) (TEDIT.IMAGESTREAM.OPEN 114702 .
|
||||||
117489 139172 (\TEDIT.TEXTCLOSEF 117499 . 118823) (\TEDIT.TEXTDSPFONT 118825 . 120023) (
|
114881)) (115071 116259 (\TEDIT.TTYBOUT 115081 . 116257)) (116377 138060 (\TEDIT.TEXTCLOSEF 116387 .
|
||||||
\TEDIT.TEXTEOFP 120025 . 121780) (\TEDIT.TEXTGETEOFPTR 121782 . 122105) (\TEDIT.TEXTSETEOFPTR 122107
|
117711) (\TEDIT.TEXTDSPFONT 117713 . 118911) (\TEDIT.TEXTEOFP 118913 . 120668) (\TEDIT.TEXTGETEOFPTR
|
||||||
. 123394) (\TEDIT.TEXTGETFILEPTR 123396 . 126231) (\TEDIT.TEXTSETFILEINFO 126233 . 126741) (
|
120670 . 120993) (\TEDIT.TEXTSETEOFPTR 120995 . 122282) (\TEDIT.TEXTGETFILEPTR 122284 . 125119) (
|
||||||
\TEDIT.TEXTOPENF 126743 . 127674) (\TEDIT.TEXTSETEOF 127676 . 128292) (\TEDIT.TEXTSETFILEPTR 128294 .
|
\TEDIT.TEXTSETFILEINFO 125121 . 125629) (\TEDIT.TEXTOPENF 125631 . 126562) (\TEDIT.TEXTSETEOF 126564
|
||||||
130404) (\TEDIT.TEXTDSPXPOSITION 130406 . 133109) (\TEDIT.TEXTDSPYPOSITION 133111 . 133852) (
|
. 127180) (\TEDIT.TEXTSETFILEPTR 127182 . 129292) (\TEDIT.TEXTDSPXPOSITION 129294 . 131997) (
|
||||||
\TEDIT.TEXTLEFTMARGIN 133854 . 134445) (\TEDIT.TEXTCOLOR 134447 . 135030) (\TEDIT.TEXTRIGHTMARGIN
|
\TEDIT.TEXTDSPYPOSITION 131999 . 132740) (\TEDIT.TEXTLEFTMARGIN 132742 . 133333) (\TEDIT.TEXTCOLOR
|
||||||
135032 . 138321) (\TEDIT.TEXTDSPCHARWIDTH 138323 . 138627) (\TEDIT.TEXTDSPSTRINGWIDTH 138629 . 138935)
|
133335 . 133918) (\TEDIT.TEXTRIGHTMARGIN 133920 . 137209) (\TEDIT.TEXTDSPCHARWIDTH 137211 . 137515) (
|
||||||
(\TEDIT.TEXTDSPLINEFEED 138937 . 139170)) (139210 151823 (\TEDIT.NTHCHARCODE 139220 . 140671) (
|
\TEDIT.TEXTDSPSTRINGWIDTH 137517 . 137823) (\TEDIT.TEXTDSPLINEFEED 137825 . 138058)) (138098 150332 (
|
||||||
\TEDIT.PIECE.NTHCHARCODE 140673 . 144583) (\TEDIT.RPLCHARCODE 144585 . 146043) (
|
\TEDIT.NTHCHARCODE 138108 . 139634) (\TEDIT.PIECE.NTHCHARCODE 139636 . 143204) (\TEDIT.RPLCHARCODE
|
||||||
\TEDIT.PIECE.RPLCHARCODE 146045 . 151468) (\TEDIT.NTHCHARLOOKS 151470 . 151821)) (152870 173964 (
|
143206 . 144764) (\TEDIT.PIECE.RPLCHARCODE 144766 . 149977) (\TEDIT.NTHCHARLOOKS 149979 . 150330)) (
|
||||||
\TEDIT.DELETE.SELPIECES 152880 . 156505) (\TEDIT.INSERTCH 156507 . 164546) (\TEDIT.INSERTCH.HISTORY
|
151379 172254 (\TEDIT.DELETE.SELPIECES 151389 . 155014) (\TEDIT.INSERTCH 155016 . 162821) (
|
||||||
164548 . 168012) (\TEDIT.INSERTEOL 168014 . 169839) (\TEDIT.INSERTCH.INSERTION 169841 . 172678) (
|
\TEDIT.INSERTCH.HISTORY 162823 . 166287) (\TEDIT.INSERTEOL 166289 . 168114) (\TEDIT.INSERTCH.INSERTION
|
||||||
\TEDIT.INSERTCH.EXTEND 172680 . 173962)) (173965 175469 (\TEDIT.NEXTCHANGEABLE.CHNO 173975 . 174690) (
|
168116 . 170953) (\TEDIT.INSERTCH.EXTEND 170955 . 172252)) (172255 173862 (\TEDIT.NEXTCHANGEABLE.CHNO
|
||||||
\TEDIT.LASTCHANGEABLE.CHNO 174692 . 175467)) (175470 177174 (\SETUPGETCH 175480 . 177172)) (177232
|
172265 . 172980) (\TEDIT.LASTCHANGEABLE.CHNO 172982 . 173860)) (173863 178652 (\TEDIT.INSTALL.PIECE
|
||||||
181690 (\TEDIT.INSTALL.PIECE 177242 . 181688)) (181728 191194 (TEXTPROP 181738 . 182085) (GETTEXTPROP
|
173873 . 178650)) (178690 188156 (TEXTPROP 178700 . 179047) (GETTEXTPROP 179049 . 179293) (PUTTEXTPROP
|
||||||
182087 . 182331) (PUTTEXTPROP 182333 . 182590) (GETTEXTPROPS 182592 . 183036) (PUTTEXTPROPS 183038 .
|
179295 . 179552) (GETTEXTPROPS 179554 . 179998) (PUTTEXTPROPS 180000 . 180904) (TEXTPROP.ADD 180906
|
||||||
183942) (TEXTPROP.ADD 183944 . 184207) (\TEDIT.TEXTPROP 184209 . 191192)) (191195 193572 (
|
. 181169) (\TEDIT.TEXTPROP 181171 . 188154)) (188157 190534 (\TEDIT.TEXTOBJ.PROPNAMES 188167 . 189426
|
||||||
\TEDIT.TEXTOBJ.PROPNAMES 191205 . 192464) (\TEDIT.TEXTOBJ.PROPFETCHFN 192466 . 192982) (
|
) (\TEDIT.TEXTOBJ.PROPFETCHFN 189428 . 189944) (\TEDIT.TEXTOBJ.PROPSTOREFN 189946 . 190532)))))
|
||||||
\TEDIT.TEXTOBJ.PROPSTOREFN 192984 . 193570)))))
|
|
||||||
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")
|
||||||
@@ -1230,35 +1262,27 @@
|
|||||||
(GETMOUSESTATE) (* ;
|
(GETMOUSESTATE) (* ;
|
||||||
"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 "20-Oct-2025 11:20:51"
|
(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;243 52506
|
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:PREVIOUS-DATE "20-Sep-2025 11:04:51" {WMEDLEY}<library>TEDIT>tedit-exports.all;242)
|
: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 "28-Sep-2025 11:35:06"))
|
(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,13 +50,14 @@ 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 "28-Jul-2025 23:25:19"))
|
(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)).") (* ;;
|
||||||
"If DCH=0, this is a caret-only selection, with no highlighting. In that case CHLIM=(ADD1 CH#) and POINT essentially indicates whether the caret blinks before or after CH#."
|
"If DCH=0, this is a caret-only selection, with no highlighting. In that case CHLIM=(ADD1 CH#) and POINT essentially indicates whether the caret blinks before or after CH#."
|
||||||
) NIL (* ; "Was Y0: Y value of topmost line of selection") X0 (* ;
|
) SELOPERATION (* ;
|
||||||
"X value of left edge of selection on the first line") SELLINES (* ;
|
"NORMAL, MOVE, COPY... HOW and HOWHEIGHT are derived from the operation. Was Y0: Y value of topmost line of selection"
|
||||||
|
) X0 (* ; "X value of left edge of selection on the first line") SELLINES (* ;
|
||||||
"A list of (L1 L2) pairs one for each pane, to replace the separate L1 L2 lists. Was DX: Width of the selection, if it's on one line."
|
"A list of (L1 L2) pairs one for each pane, to replace the separate L1 L2 lists. Was DX: Width of the selection, if it's on one line."
|
||||||
) CH# (* ; "CH# of the first selected character") XLIM (* ;
|
) CH# (* ; "CH# of the first selected character") XLIM (* ;
|
||||||
"X value of right edge of last selected character on the last line") CHLIM (* ;
|
"X value of right edge of last selected character on the last line") CHLIM (* ;
|
||||||
@@ -127,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 "29-Jul-2025 11:22:10"))
|
(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 (* ;
|
||||||
@@ -208,8 +208,6 @@ ITEM collect (FIXR (FTIMES SCALE ITEM))) (FIXR (FTIMES SCALE ITEM)))))
|
|||||||
(PUTPROPS SCALEDOWN MACRO (OPENLAMBDA (SCALE ITEM) (* ; "List = region?") (CL:IF (LISTP ITEM) (for I
|
(PUTPROPS SCALEDOWN MACRO (OPENLAMBDA (SCALE ITEM) (* ; "List = region?") (CL:IF (LISTP ITEM) (for I
|
||||||
in ITEM collect (FIXR (FQUOTIENT I SCALE))) (FIXR (FQUOTIENT ITEM SCALE)))))
|
in ITEM collect (FIXR (FQUOTIENT I SCALE))) (FIXR (FQUOTIENT ITEM SCALE)))))
|
||||||
(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)
|
(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)
|
||||||
(ADDTOVAR CHARACTERNAMES (SOFT-HYPHEN "357,043") (NONBREAKING-HYPHEN "357,042") (NONBREAKING-SPACE
|
|
||||||
"357,041"))
|
|
||||||
(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) (* ;; "An XCCS diacritic") (AND (SMALLP CHAR) (IGEQ CHAR
|
(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) (* ;; "An XCCS diacritic") (AND (SMALLP CHAR) (IGEQ CHAR
|
||||||
192) (ILEQ CHAR 207))))
|
192) (ILEQ CHAR 207))))
|
||||||
(PUTPROPS \TEDIT.LINE.TALLP MACRO ((LINE HEIGHT) (OR (IGREATERP (FGETLD LINE LHEIGHT) 50) (IGREATERP (
|
(PUTPROPS \TEDIT.LINE.TALLP MACRO ((LINE HEIGHT) (OR (IGREATERP (FGETLD LINE LHEIGHT) 50) (IGREATERP (
|
||||||
@@ -260,25 +258,26 @@ NEXTAVAILABLECHARSLOT) of THISLINE))) (T $$STARTSLOT))) (SETQ $$CHARSLOTLIMIT (F
|
|||||||
) by (PREVCHARSLOT I.V.) eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (
|
) by (PREVCHARSLOT I.V.) eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (
|
||||||
CHARSLOT CHARW) of I.V.)) (SETQ CHARCL (fetch (CHARSLOT CHARCL) of I.V.)) repeatuntil (EQ I.V.
|
CHARSLOT CHARW) of I.V.)) (SETQ CHARCL (fetch (CHARSLOT CHARCL) of I.V.)) repeatuntil (EQ I.V.
|
||||||
$$CHARSLOTLIMIT))))) T)
|
$$CHARSLOTLIMIT))))) T)
|
||||||
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "19-Oct-2025 00:07:29"))
|
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE " 5-Feb-2026 00:39:54"))
|
||||||
(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 (* ;
|
||||||
@@ -299,9 +298,10 @@ HINTPC (* ; "Was: Space left in the type-in piece") HINTPCSTARTCH# (* ;
|
|||||||
) DS (* ;
|
) DS (* ;
|
||||||
"NOTE: THIS IS ONLY USED INCORRECTLY BY TEDIT-CHAT Display stream where this textobj is displayed")
|
"NOTE: THIS IS ONLY USED INCORRECTLY BY TEDIT-CHAT Display stream where this textobj is displayed")
|
||||||
SEL (* ; "The current selection within the text") LASTARROWX (* ;
|
SEL (* ; "The current selection within the text") LASTARROWX (* ;
|
||||||
"X for next arrow up or arrow down. Was: Scratch space for the selection code") NIL (* ;
|
"X for next arrow up or arrow down. Was: Scratch space for the selection code") SECONDARYSEL (* ;
|
||||||
"Was MOVESEL: Source for the next MOVE of text") NIL (* ; "Was SHIFTEDSEL: Source for the next COPY")
|
"Holds secondary selection and operation just before the mouse leaves a window. Was MOVESEL: Source for the next MOVE of text"
|
||||||
NIL (* ; "Was DELETESEL: Text to be deleted imminently") NIL (* ;
|
) NIL (* ; "Was SHIFTEDSEL: Source for the next COPY") NIL (* ;
|
||||||
|
"Was DELETESEL: Text to be deleted imminently") NIL (* ;
|
||||||
"Was WRIGHT: Right edge of the window (or subregion) where this is displayed") WTOP (* ;
|
"Was WRIGHT: Right edge of the window (or subregion) where this is displayed") WTOP (* ;
|
||||||
"Top of the window/region") NIL (* ; "Was WBOTTOM: Bottom of the window/region") NIL (* ;
|
"Top of the window/region") NIL (* ; "Was WBOTTOM: Bottom of the window/region") NIL (* ;
|
||||||
"Was WLEFT: Left edge of the window/region") TXTFILE (* ; "The original text file we're editing") (
|
"Was WLEFT: Left edge of the window/region") TXTFILE (* ; "The original text file we're editing") (
|
||||||
@@ -372,16 +372,16 @@ IMAGEDATA _ NIL)))
|
|||||||
(PUTPROPS NEXTPIECE MACRO ((PC) (ffetch (PIECE NEXTPIECE) of PC)))
|
(PUTPROPS NEXTPIECE MACRO ((PC) (ffetch (PIECE NEXTPIECE) of PC)))
|
||||||
(PUTPROPS PREVPIECE MACRO ((PC) (ffetch (PIECE PREVPIECE) of PC)))
|
(PUTPROPS PREVPIECE MACRO ((PC) (ffetch (PIECE PREVPIECE) of PC)))
|
||||||
(PUTPROPS PLEN MACRO ((PC) (ffetch (PIECE PLEN) of PC)))
|
(PUTPROPS PLEN MACRO ((PC) (ffetch (PIECE PLEN) of PC)))
|
||||||
|
(PUTPROPS PLAST MACRO ((PC) (SUB1 (PLEN PC))))
|
||||||
(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)))
|
||||||
@@ -390,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 (
|
||||||
@@ -410,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)
|
||||||
@@ -427,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 "19-Oct-2025 15:09:09"))
|
(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))
|
||||||
@@ -449,13 +447,13 @@ THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTY
|
|||||||
I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (QUOTE HELP)
|
I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (QUOTE HELP)
|
||||||
"TEdit consistency-check failure [RETURN to continue]: " (COND ((STRINGP (CADR J))) (T (KWOTE I))))))
|
"TEdit consistency-check failure [RETURN to continue]: " (COND ((STRINGP (CADR J))) (T (KWOTE I))))))
|
||||||
)) (T (CONS COMMENTFLG ARGS)))))
|
)) (T (CONS COMMENTFLG ARGS)))))
|
||||||
(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "17-Jul-2025 00:24:49"))
|
(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE " 8-Nov-2025 10:03:19"))
|
||||||
(PUTPROPS \SMALLPIN MACRO (OPENLAMBDA (STREAM) (SIGNED (create WORD HIBYTE _ (\BIN STREAM) LOBYTE _ (
|
(PUTPROPS \SMALLPIN MACRO (OPENLAMBDA (STREAM) (SIGNED (create WORD HIBYTE _ (\BIN STREAM) LOBYTE _ (
|
||||||
\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 "25-Sep-2025 21:32:46"))
|
(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 (* ;;
|
||||||
@@ -537,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 " 6-Oct-2025 20:50:59"))
|
(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
|
||||||
@@ -600,17 +598,18 @@ OR (CL:IF (TYPENAMEP $$BODY (QUOTE TEXTOBJ)) (FGETTOBJ $$BODY PRIMARYPANE) $$BOD
|
|||||||
GETPANEPROP (PANEPROPS P) NEXTPANE))) (GO $$OUT))) by (OR (GETPANEPROP (PANEPROPS I.V.) PREVPANE) (GO
|
GETPANEPROP (PANEPROPS P) NEXTPANE))) (GO $$OUT))) by (OR (GETPANEPROP (PANEPROPS I.V.) PREVPANE) (GO
|
||||||
$$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 "19-Oct-2025 15:13:01"))
|
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE " 7-Feb-2026 18:53:22"))
|
||||||
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "19-Oct-2025 10:44:18"))
|
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "29-Apr-2026 17:57:09"))
|
||||||
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "19-Oct-2025 15:14:00"))
|
(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) (WORDDELETE 2) (DELETE 3) (FUNCTIONCALL 4) (REDO 5) (
|
(RPAQQ \TEDIT.TTCCODES ((NONE . 0) (CHARDELETE . 1) (:CHARDELETE.BACKWARD . 1) (WORDDELETE . 2) (
|
||||||
UNDO 6) (CMD 7) (NEXT 8) (EXPAND 9) (CHARDELETE.FORWARD 10) (WORDDELETE.FORWARD 11) (PUNCT 20) (TEXT
|
:WORDDELETE.BACKWORD . 2) (DELETE . 3) (:DELETE . 3) (FN . 4) (REDO . 5) (:REDO . 5) (UNDO . 6) (:UNDO
|
||||||
21) (WHITESPACE 22)))
|
. 6) (CMD . 7) (:CMD . 7) (NEXT . 8) (:NEXT . 8) (EXPAND . 9) (:EXPAND . 9) (CHARDELETE.FORWARD . 10)
|
||||||
|
(:CHARDELETE.FORWARD . 10) (:WORDDELETE.FORWARD . 11) (PUNCT . 20) (TEXT . 21) (WHITESPACE . 22)))
|
||||||
(CONSTANTS \TEDIT.TTCCODES)
|
(CONSTANTS \TEDIT.TTCCODES)
|
||||||
(PUTPROPS \TEDIT.TTC MACRO ((CLASS) (CONSTANT (CADR (ASSOC (QUOTE CLASS) \TEDIT.TTCCODES)))))
|
(PUTPROPS \TEDIT.TTC MACRO ((ACTION) (CONSTANT (GETMULTI \TEDIT.TTCCODES (QUOTE ACTION)))))
|
||||||
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE " 7-Aug-2025 15:00:51"))
|
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE " 8-Feb-2026 19:54:41"))
|
||||||
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "19-Sep-2025 17:08:05"))
|
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "15-Jan-2026 11:08:15"))
|
||||||
(DATATYPE TEDITHISTORYEVENT ((* ;; "Describes one event on the TEdit edit history list.") THACTION (*
|
(DATATYPE TEDITHISTORYEVENT ((* ;; "Describes one event on the TEdit edit history list.") THACTION (*
|
||||||
; "A keyword specifying what the event was") THPOINT (* ; "Was the selection to the left or right?")
|
; "A keyword specifying what the event was") THPOINT (* ; "Was the selection to the left or right?")
|
||||||
THLEN (* ; "The # of chars involved") THCH# (* ; "The starting ch#") THFIRSTPIECE (* ;
|
THLEN (* ; "The # of chars involved") THCH# (* ; "The starting ch#") THFIRSTPIECE (* ;
|
||||||
@@ -624,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."
|
||||||
@@ -659,9 +658,9 @@ REGIONPARENT FULLXPOINTER) (* ; "The parent node for this box, for sub-boxes") R
|
|||||||
$$VALUES)) (PROG1 (CAR $$VALUES) (\,@ (FOR V IN (CAR ARGS) collect (COND (V (BQUOTE (SETQ (\, V) (POP
|
$$VALUES)) (PROG1 (CAR $$VALUES) (\,@ (FOR V IN (CAR ARGS) collect (COND (V (BQUOTE (SETQ (\, V) (POP
|
||||||
$$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-Sep-2025 16:25:26"))
|
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "27-Jan-2026 10:30:27"))
|
||||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE " 6-Sep-2025 00:10:45"))
|
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "30-Apr-2026 11:55:15"))
|
||||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE " 7-Sep-2025 11:11:43"))
|
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "10-Apr-2026 09:25:52"))
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL)))
|
(FILEMAP (NIL)))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
@@ -1,10 +1,10 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT UTF-8)
|
||||||
|
|
||||||
(FILECREATED "13-Oct-2025 13:44:47" {WMEDLEY}<library>virtualkeyboards>KEYBOARDCONFIGS.;5 59521
|
(FILECREATED "19-Feb-2026 22:32:05" {WMEDLEY}<library>virtualkeyboards>KEYBOARDCONFIGS.;6 59604
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:PREVIOUS-DATE "13-Oct-2025 12:03:23" {WMEDLEY}<library>virtualkeyboards>KEYBOARDCONFIGS.;4)
|
:PREVIOUS-DATE "13-Oct-2025 13:44:47" {WMEDLEY}<library>virtualkeyboards>KEYBOARDCONFIGS.;5)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT KEYBOARDCONFIGSCOMS)
|
(PRETTYCOMPRINT KEYBOARDCONFIGSCOMS)
|
||||||
@@ -57,11 +57,11 @@
|
|||||||
(F3 (F3 ITALIC))
|
(F3 (F3 ITALIC))
|
||||||
(F4 (F4 UCASE))
|
(F4 (F4 UCASE))
|
||||||
(F5 (F5 STRIKE))
|
(F5 (F5 STRIKE))
|
||||||
(F6 (F6 ""))
|
(F6 (F6 "^"))
|
||||||
(F7 (F7 SUBSCR))
|
(F7 (F7 SUBSCR))
|
||||||
(F8 (F8 SMALL))
|
(F8 (F8 SMALL))
|
||||||
(F9 (F9 MARGIN))
|
(F9 (F9 MARGIN))
|
||||||
(F10 (F10 "¬"))
|
(F10 (F10 "_"))
|
||||||
(F11 (F11 ""))
|
(F11 (F11 ""))
|
||||||
(F12 (F12 ""))
|
(F12 (F12 ""))
|
||||||
(LOCK ("CAPS" "LOCK"))
|
(LOCK ("CAPS" "LOCK"))
|
||||||
@@ -115,7 +115,7 @@
|
|||||||
(THREE (|3| %# NLS))
|
(THREE (|3| %# NLS))
|
||||||
(FOUR (|4| $ NLS))
|
(FOUR (|4| $ NLS))
|
||||||
(FIVE (|5| %% NLS))
|
(FIVE (|5| %% NLS))
|
||||||
(SIX (|6| ^ NLS))
|
(SIX (|6| ↑ NLS))
|
||||||
(SEVEN (|7| & NLS))
|
(SEVEN (|7| & NLS))
|
||||||
(EIGHT (|8| * NLS))
|
(EIGHT (|8| * NLS))
|
||||||
(NINE (|9| %( NLS))))
|
(NINE (|9| %( NLS))))
|
||||||
@@ -234,7 +234,7 @@
|
|||||||
NIL
|
NIL
|
||||||
((%" (%' %" NLS))
|
((%" (%' %" NLS))
|
||||||
(+ (= + NLS))
|
(+ (= + NLS))
|
||||||
(- (- _ NLS))
|
(- (- ← NLS))
|
||||||
(%: (; %: NLS))
|
(%: (; %: NLS))
|
||||||
(< (%, < NLS))
|
(< (%, < NLS))
|
||||||
(> (%. > NLS))
|
(> (%. > NLS))
|
||||||
@@ -255,13 +255,13 @@
|
|||||||
(NUMERIC/ (/ /))
|
(NUMERIC/ (/ /))
|
||||||
(NUMERIC0 (INS |0| NLS))
|
(NUMERIC0 (INS |0| NLS))
|
||||||
(NUMERIC1 (END |1| NLS))
|
(NUMERIC1 (END |1| NLS))
|
||||||
(NUMERIC2 (¯ |2| NLS))
|
(NUMERIC2 (↓ |2| NLS))
|
||||||
(NUMERIC3 (PGDN |3| NLS))
|
(NUMERIC3 (PGDN |3| NLS))
|
||||||
(NUMERIC4 (¬ |4| NLS))
|
(NUMERIC4 (_ |4| NLS))
|
||||||
(NUMERIC5 (|5| |5|))
|
(NUMERIC5 (|5| |5|))
|
||||||
(NUMERIC6 (® |6| NLS))
|
(NUMERIC6 (→ |6| NLS))
|
||||||
(NUMERIC7 (HOME |7| NLS))
|
(NUMERIC7 (HOME |7| NLS))
|
||||||
(NUMERIC8 ( |8| NLS))
|
(NUMERIC8 (^ |8| NLS))
|
||||||
(NUMERIC9 (PGUP |9| NLS))
|
(NUMERIC9 (PGUP |9| NLS))
|
||||||
(NUMERIC= (= =))
|
(NUMERIC= (= =))
|
||||||
(RETURN (CR CR))
|
(RETURN (CR CR))
|
||||||
@@ -274,17 +274,17 @@
|
|||||||
(F3 (ITALIC NOTITALIC NLS))
|
(F3 (ITALIC NOTITALIC NLS))
|
||||||
(F4 (UCASE LCASE NLS))
|
(F4 (UCASE LCASE NLS))
|
||||||
(F5 (STRIKEOUT NOTSTRIKEOUT NLS))
|
(F5 (STRIKEOUT NOTSTRIKEOUT NLS))
|
||||||
(F6 ("" "" NLS))
|
(F6 ("^" "^" NLS))
|
||||||
(F7 (SUBSCRIPT SUPERSCRIPT NLS))
|
(F7 (SUBSCRIPT SUPERSCRIPT NLS))
|
||||||
(F8 (SMALLER LARGER NLS))
|
(F8 (SMALLER LARGER NLS))
|
||||||
(F9 (MARGINS NOTMARGINS NLS))
|
(F9 (MARGINS NOTMARGINS NLS))
|
||||||
(F10 ("¬" "¬" NLS))
|
(F10 ("_" "_" NLS))
|
||||||
(F11 (F11 NOTF11 NLS))
|
(F11 (F11 NOTF11 NLS))
|
||||||
(F12 (F12 NOTF12 NLS)))
|
(F12 (F12 NOTF12 NLS)))
|
||||||
((%` 45 B)
|
((%` 45 B)
|
||||||
(~ 45 T)
|
(~ 45 T)
|
||||||
(|6| 2 B)
|
(|6| 2 B)
|
||||||
(^ 2 T)
|
(↑ 2 T)
|
||||||
(%% 0 T)
|
(%% 0 T)
|
||||||
(|5| 0 B)
|
(|5| 0 B)
|
||||||
($ 1 T)
|
($ 1 T)
|
||||||
@@ -523,7 +523,7 @@
|
|||||||
(> (346 46 29 33))
|
(> (346 46 29 33))
|
||||||
(%: (362 82 29 33))
|
(%: (362 82 29 33))
|
||||||
(<-%| (426 82 63 33))
|
(<-%| (426 82 63 33))
|
||||||
(^ (450 118 29 33))
|
(↑ (450 118 29 33))
|
||||||
(DEL (498 154 29 33))
|
(DEL (498 154 29 33))
|
||||||
(R (162 118 29 33))
|
(R (162 118 29 33))
|
||||||
(T (194 118 29 33))
|
(T (194 118 29 33))
|
||||||
@@ -556,7 +556,7 @@
|
|||||||
(LF (LF LF))
|
(LF (LF LF))
|
||||||
(LOCK LOCKDOWN . LOCKUP)
|
(LOCK LOCKDOWN . LOCKUP)
|
||||||
(\ (\ %| NLS))
|
(\ (\ %| NLS))
|
||||||
(^ (_ ^ NLS))
|
(↑ (← ↑ NLS))
|
||||||
({ (%[ { NLS))
|
({ (%[ { NLS))
|
||||||
(} (%] } NLS)))
|
(} (%] } NLS)))
|
||||||
((BLANK-MIDDLE 30)
|
((BLANK-MIDDLE 30)
|
||||||
@@ -643,8 +643,8 @@
|
|||||||
(%: 43)
|
(%: 43)
|
||||||
(CR 44)
|
(CR 44)
|
||||||
(<-%| 44)
|
(<-%| 44)
|
||||||
(_ 45)
|
(← 45)
|
||||||
(^ 45)
|
(↑ 45)
|
||||||
(r 48)
|
(r 48)
|
||||||
(R 48)
|
(R 48)
|
||||||
(t 49)
|
(t 49)
|
||||||
@@ -744,7 +744,7 @@
|
|||||||
NIL
|
NIL
|
||||||
((%" (%' %" NLS))
|
((%" (%' %" NLS))
|
||||||
(+ (= + NLS))
|
(+ (= + NLS))
|
||||||
(- (- _ NLS))
|
(- (- ← NLS))
|
||||||
(ESC (ESC %| NLS))
|
(ESC (ESC %| NLS))
|
||||||
(%: (; %: NLS))
|
(%: (; %: NLS))
|
||||||
(< (%, < NLS))
|
(< (%, < NLS))
|
||||||
@@ -757,7 +757,7 @@
|
|||||||
(~ (%` ~ NLS)))
|
(~ (%` ~ NLS)))
|
||||||
((%` 45)
|
((%` 45)
|
||||||
(~ 45)
|
(~ 45)
|
||||||
(^ 2)
|
(↑ 2)
|
||||||
(|6| 2)
|
(|6| 2)
|
||||||
(w 18)
|
(w 18)
|
||||||
(W 18)
|
(W 18)
|
||||||
@@ -951,7 +951,7 @@
|
|||||||
NIL
|
NIL
|
||||||
((%" (%' %" NLS))
|
((%" (%' %" NLS))
|
||||||
(+ (= + NLS))
|
(+ (= + NLS))
|
||||||
(- (- _ NLS))
|
(- (- ← NLS))
|
||||||
(%: (; %: NLS))
|
(%: (; %: NLS))
|
||||||
(< (%, < NLS))
|
(< (%, < NLS))
|
||||||
(<-%| (CR CR))
|
(<-%| (CR CR))
|
||||||
@@ -962,21 +962,21 @@
|
|||||||
(KEYBOARD METADOWN . METAUP)
|
(KEYBOARD METADOWN . METAUP)
|
||||||
(LOCK LOCKDOWN . LOCKUP)
|
(LOCK LOCKDOWN . LOCKUP)
|
||||||
(NEXT (2,22 2,62 NLS))
|
(NEXT (2,22 2,62 NLS))
|
||||||
(NUMERIC* (NUMLK ´ NLS))
|
(NUMERIC* (NUMLK × NLS))
|
||||||
(NUMERIC+ (HELP 2,45 NLS))
|
(NUMERIC+ (HELP 2,45 NLS))
|
||||||
(NUMERIC, (\ %, NLS))
|
(NUMERIC, (\ %, NLS))
|
||||||
(NUMERIC- (SCRL - NLS))
|
(NUMERIC- (SCRL - NLS))
|
||||||
(NUMERIC. (%| 21 NLS))
|
(NUMERIC. (%| 21 NLS))
|
||||||
(NUMERIC/ (BREAK ¸ NLS))
|
(NUMERIC/ (BREAK ÷ NLS))
|
||||||
(NUMERIC0 (INS |0| NLS))
|
(NUMERIC0 (INS |0| NLS))
|
||||||
(NUMERIC1 (END |1| NLS))
|
(NUMERIC1 (END |1| NLS))
|
||||||
(NUMERIC2 (¯ |2| NLS))
|
(NUMERIC2 (↓ |2| NLS))
|
||||||
(NUMERIC3 (PGDN |3| NLS))
|
(NUMERIC3 (PGDN |3| NLS))
|
||||||
(NUMERIC4 (¬ |4| NLS))
|
(NUMERIC4 (_ |4| NLS))
|
||||||
(NUMERIC5 (% |5| NLS))
|
(NUMERIC5 (% |5| NLS))
|
||||||
(NUMERIC6 (® |6| NLS))
|
(NUMERIC6 (→ |6| NLS))
|
||||||
(NUMERIC7 (HOME |7| NLS))
|
(NUMERIC7 (HOME |7| NLS))
|
||||||
(NUMERIC8 ( |8| NLS))
|
(NUMERIC8 (^ |8| NLS))
|
||||||
(NUMERIC9 (PGUP |9| NLS))
|
(NUMERIC9 (PGUP |9| NLS))
|
||||||
(%` (%` ~ NLS))
|
(%` (%` ~ NLS))
|
||||||
({ (%[ { NLS))
|
({ (%[ { NLS))
|
||||||
@@ -987,7 +987,7 @@
|
|||||||
(|4| 1)
|
(|4| 1)
|
||||||
($ 1)
|
($ 1)
|
||||||
(|6| 2)
|
(|6| 2)
|
||||||
(^ 2)
|
(↑ 2)
|
||||||
(e 3)
|
(e 3)
|
||||||
(E 3)
|
(E 3)
|
||||||
(|7| 4)
|
(|7| 4)
|
||||||
@@ -1233,7 +1233,7 @@
|
|||||||
(%. (%. > NLS))
|
(%. (%. > NLS))
|
||||||
(/ (/ ? NLS))
|
(/ (/ ? NLS))
|
||||||
(\ (\ %| NLS))
|
(\ (\ %| NLS))
|
||||||
(- (- _ NLS))
|
(- (- ← NLS))
|
||||||
(%` (%` ~ NLS))
|
(%` (%` ~ NLS))
|
||||||
(%[ (%[ { NLS))
|
(%[ (%[ { NLS))
|
||||||
(%] (%] } NLS))
|
(%] (%] } NLS))
|
||||||
@@ -1249,13 +1249,13 @@
|
|||||||
(NUMERIC/ (/ /))
|
(NUMERIC/ (/ /))
|
||||||
(NUMERIC0 (INS |0| NLS))
|
(NUMERIC0 (INS |0| NLS))
|
||||||
(NUMERIC1 (END |1| NLS))
|
(NUMERIC1 (END |1| NLS))
|
||||||
(NUMERIC2 (¯ |2| NLS))
|
(NUMERIC2 (↓ |2| NLS))
|
||||||
(NUMERIC3 (PGDN |3| NLS))
|
(NUMERIC3 (PGDN |3| NLS))
|
||||||
(NUMERIC4 (¬ |4| NLS))
|
(NUMERIC4 (_ |4| NLS))
|
||||||
(NUMERIC5 (|5| |5|))
|
(NUMERIC5 (|5| |5|))
|
||||||
(NUMERIC6 (® |6| NLS))
|
(NUMERIC6 (→ |6| NLS))
|
||||||
(NUMERIC7 (HOME |7| NLS))
|
(NUMERIC7 (HOME |7| NLS))
|
||||||
(NUMERIC8 ( |8| NLS))
|
(NUMERIC8 (^ |8| NLS))
|
||||||
(NUMERIC9 (PGUP |9| NLS))
|
(NUMERIC9 (PGUP |9| NLS))
|
||||||
(NUMERICENTER (CR CR))
|
(NUMERICENTER (CR CR))
|
||||||
(RALT METADOWN . METAUP)
|
(RALT METADOWN . METAUP)
|
||||||
@@ -1264,11 +1264,11 @@
|
|||||||
(F3 (ITALIC NOTITALIC NLS))
|
(F3 (ITALIC NOTITALIC NLS))
|
||||||
(F4 (UCASE LCASE NLS))
|
(F4 (UCASE LCASE NLS))
|
||||||
(F5 (STRIKEOUT NOTSTRIKEOUT NLS))
|
(F5 (STRIKEOUT NOTSTRIKEOUT NLS))
|
||||||
(F6 ("" "" NLS))
|
(F6 ("^" "^" NLS))
|
||||||
(F7 (SUBSCRIPT SUPERSCRIPT NLS))
|
(F7 (SUBSCRIPT SUPERSCRIPT NLS))
|
||||||
(F8 (SMALLER LARGER NLS))
|
(F8 (SMALLER LARGER NLS))
|
||||||
(F9 (MARGINS NOTMARGINS NLS))
|
(F9 (MARGINS NOTMARGINS NLS))
|
||||||
(F10 ("¬" "¬" NLS))
|
(F10 ("_" "_" NLS))
|
||||||
(F11 (F11 NOTF11 NLS))
|
(F11 (F11 NOTF11 NLS))
|
||||||
(F12 (F12 NOTF12 NLS)))
|
(F12 (F12 NOTF12 NLS)))
|
||||||
((%' 28 B)
|
((%' 28 B)
|
||||||
@@ -1276,7 +1276,7 @@
|
|||||||
(%, 27 B)
|
(%, 27 B)
|
||||||
(< 27 T)
|
(< 27 T)
|
||||||
(- 10 B)
|
(- 10 B)
|
||||||
(_ 10 T)
|
(← 10 T)
|
||||||
(> 42 T)
|
(> 42 T)
|
||||||
(%. 42 B)
|
(%. 42 B)
|
||||||
(/ 12 B)
|
(/ 12 B)
|
||||||
@@ -1286,7 +1286,7 @@
|
|||||||
(%# 16 T)
|
(%# 16 T)
|
||||||
($ 1 T)
|
($ 1 T)
|
||||||
(%% 0 T)
|
(%% 0 T)
|
||||||
(^ 4 T)
|
(↑ 4 T)
|
||||||
(* 53 T)
|
(* 53 T)
|
||||||
(%( 22 T)
|
(%( 22 T)
|
||||||
(%) 8 T)
|
(%) 8 T)
|
||||||
@@ -1494,7 +1494,7 @@
|
|||||||
(M (370 42 29 29))
|
(M (370 42 29 29))
|
||||||
(; (402 42 29 29))
|
(; (402 42 29 29))
|
||||||
(%: (434 42 29 29))
|
(%: (434 42 29 29))
|
||||||
(_ (466 42 29 29))
|
(← (466 42 29 29))
|
||||||
(RSHIFT (498 42 53 29))
|
(RSHIFT (498 42 53 29))
|
||||||
(LINEFEED (554 42 29 29))
|
(LINEFEED (554 42 29 29))
|
||||||
(CONTROL (106 74 53 29))
|
(CONTROL (106 74 53 29))
|
||||||
@@ -1559,7 +1559,7 @@
|
|||||||
(ONE (|1| + NLS))
|
(ONE (|1| + NLS))
|
||||||
(TWO (|2| %" NLS))
|
(TWO (|2| %" NLS))
|
||||||
(THREE (|3| * NLS))
|
(THREE (|3| * NLS))
|
||||||
(FOUR (|4| ‡ NLS))
|
(FOUR (|4| NLS))
|
||||||
(SIX (|6| & NLS))
|
(SIX (|6| & NLS))
|
||||||
(SEVEN (|7| / NLS))
|
(SEVEN (|7| / NLS))
|
||||||
(EIGHT (|8| %( NLS))
|
(EIGHT (|8| %( NLS))
|
||||||
@@ -1567,7 +1567,7 @@
|
|||||||
(%: (%. %: NLS))
|
(%: (%. %: NLS))
|
||||||
(; (%, ; NLS))
|
(; (%, ; NLS))
|
||||||
(? (%' ? NLS))
|
(? (%' ? NLS))
|
||||||
(AUMLAUT (… „ NLS))
|
(AUMLAUT ( NLS))
|
||||||
(CAPSLOCK CTRLDOWN . CTRLUP)
|
(CAPSLOCK CTRLDOWN . CTRLUP)
|
||||||
(CONTROL LOCKDOWN . LOCKUP)
|
(CONTROL LOCKDOWN . LOCKUP)
|
||||||
(CR (CR CR))
|
(CR (CR CR))
|
||||||
@@ -1591,10 +1591,10 @@
|
|||||||
(NUMERIC8 (|8| |8|))
|
(NUMERIC8 (|8| |8|))
|
||||||
(NUMERIC9 (|9| |9|))
|
(NUMERIC9 (|9| |9|))
|
||||||
(NUMERIC= (= =))
|
(NUMERIC= (= =))
|
||||||
(OUMLAUT (‚ ” NLS))
|
(OUMLAUT ( NLS))
|
||||||
(UUMLAUT (Š <20> NLS))
|
(UUMLAUT ( NLS))
|
||||||
(%[ (%] %[ NLS))
|
(%[ (%] %[ NLS))
|
||||||
(_ (- _ NLS))
|
(← (- ← NLS))
|
||||||
({ (< { NLS))
|
({ (< { NLS))
|
||||||
(} (> } NLS)))
|
(} (> } NLS)))
|
||||||
((HELP 0)
|
((HELP 0)
|
||||||
@@ -1658,7 +1658,7 @@
|
|||||||
(%. 49)
|
(%. 49)
|
||||||
(%: 49)
|
(%: 49)
|
||||||
(- 50)
|
(- 50)
|
||||||
(_ 50)
|
(← 50)
|
||||||
(RSHIFT 51)
|
(RSHIFT 51)
|
||||||
(LINEFEED 52)
|
(LINEFEED 52)
|
||||||
(CONTROL 53)
|
(CONTROL 53)
|
||||||
|
|||||||
Binary file not shown.
@@ -1,18 +1,17 @@
|
|||||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
(FILECREATED "31-Jan-87 18:09:00" {ERIS}<LISPUSERS>LYRIC>BACKGROUNDMENU.;1 7367
|
|
||||||
|
|
||||||
previous date%: "31-Jan-86 11:36:13" {ERIS}<LISP>KOTO>LISPUSERS>BACKGROUNDMENU.;1)
|
(FILECREATED "18-Feb-2026 16:20:10" {WMEDLEY}<lispusers>BACKGROUNDMENU.;2 7230
|
||||||
|
|
||||||
|
:EDIT-BY rmk
|
||||||
|
|
||||||
|
:PREVIOUS-DATE "31-Jan-87 18:09:00" {WMEDLEY}<lispusers>BACKGROUNDMENU.;1)
|
||||||
|
|
||||||
(* "
|
|
||||||
Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
|
|
||||||
")
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT BACKGROUNDMENUCOMS)
|
(PRETTYCOMPRINT BACKGROUNDMENUCOMS)
|
||||||
|
|
||||||
(RPAQQ BACKGROUNDMENUCOMS ((INITVARS BackgroundMenuFixupMode BackgroundMenuSuperItem
|
(RPAQQ BACKGROUNDMENUCOMS ((INITVARS BackgroundMenuFixupMode BackgroundMenuSuperItem
|
||||||
BackgroundMenuTopLevelItems)
|
BackgroundMenuTopLevelItems)
|
||||||
(FNS BkgMenu.add.item BkgMenu.fixup BkgMenu.move.item BkgMenu.remove.item
|
(FNS BkgMenu.add.item BkgMenu.fixup BkgMenu.move.item BkgMenu.remove.item
|
||||||
BkgMenu.rename.item BkgMenu.reorder.items BkgMenu.subitems
|
BkgMenu.rename.item BkgMenu.reorder.items BkgMenu.subitems
|
||||||
\BkgMenu.locate \BkgMenu.locater \BkgMenu.remove.item
|
\BkgMenu.locate \BkgMenu.locater \BkgMenu.remove.item
|
||||||
\BkgMenu.scan.item.list \BkgMenu.unremove.item)))
|
\BkgMenu.scan.item.list \BkgMenu.unremove.item)))
|
||||||
@@ -153,11 +152,10 @@ Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
|
|||||||
else (SETQ BackgroundMenuCommands (CONS (CAR item)
|
else (SETQ BackgroundMenuCommands (CONS (CAR item)
|
||||||
BackgroundMenuCommands])
|
BackgroundMenuCommands])
|
||||||
)
|
)
|
||||||
(PUTPROPS BACKGROUNDMENU COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
|
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (1008 7271 (BkgMenu.add.item 1018 . 1910) (BkgMenu.fixup 1912 . 3131) (BkgMenu.move.item
|
(FILEMAP (NIL (944 7207 (BkgMenu.add.item 954 . 1846) (BkgMenu.fixup 1848 . 3067) (BkgMenu.move.item
|
||||||
3133 . 3557) (BkgMenu.remove.item 3559 . 3834) (BkgMenu.rename.item 3836 . 4128) (
|
3069 . 3493) (BkgMenu.remove.item 3495 . 3770) (BkgMenu.rename.item 3772 . 4064) (
|
||||||
BkgMenu.reorder.items 4130 . 4505) (BkgMenu.subitems 4507 . 4907) (\BkgMenu.locate 4909 . 5520) (
|
BkgMenu.reorder.items 4066 . 4441) (BkgMenu.subitems 4443 . 4843) (\BkgMenu.locate 4845 . 5456) (
|
||||||
\BkgMenu.locater 5522 . 6089) (\BkgMenu.remove.item 6091 . 6378) (\BkgMenu.scan.item.list 6380 . 6877)
|
\BkgMenu.locater 5458 . 6025) (\BkgMenu.remove.item 6027 . 6314) (\BkgMenu.scan.item.list 6316 . 6813)
|
||||||
(\BkgMenu.unremove.item 6879 . 7269)))))
|
(\BkgMenu.unremove.item 6815 . 7205)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
Binary file not shown.
187
lispusers/BROKEN-ATOMS
Normal file
187
lispusers/BROKEN-ATOMS
Normal file
@@ -0,0 +1,187 @@
|
|||||||
|
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||||
|
|
||||||
|
(FILECREATED "14-Apr-2026 12:14:44" {PROJECTS}<BROKENATOMS>BROKEN-ATOMS.;10 7207
|
||||||
|
|
||||||
|
:CHANGES-TO (FUNCTIONS WITHOUT-BROKEN-ATOMS TEST-PRETTY-FILE TEST-DEEP-COMPUTATION
|
||||||
|
CURE-BROKEN-ATOM)
|
||||||
|
(VARS BROKEN-ATOMSCOMS)
|
||||||
|
|
||||||
|
:PREVIOUS-DATE "18-Feb-2026 16:08:40" {PROJECTS}<BROKENATOMS>BROKEN-ATOMS.;3)
|
||||||
|
|
||||||
|
|
||||||
|
(PRETTYCOMPRINT BROKEN-ATOMSCOMS)
|
||||||
|
|
||||||
|
(RPAQQ BROKEN-ATOMSCOMS
|
||||||
|
(
|
||||||
|
(* ;; "the representation of a broken atom")
|
||||||
|
|
||||||
|
(RECORDS BROKEN-ATOM)
|
||||||
|
(FUNCTIONS CURE-BROKEN-ATOM)
|
||||||
|
|
||||||
|
(* ;; "for DEFPRINT")
|
||||||
|
|
||||||
|
(FNS BROKEN-ATOM-PRINTER)
|
||||||
|
|
||||||
|
(* ;; "special form")
|
||||||
|
|
||||||
|
(FUNCTIONS WITHOUT-BROKEN-ATOMS)
|
||||||
|
|
||||||
|
(* ;; "setup")
|
||||||
|
|
||||||
|
(P (DEFPRINT 'BROKEN-ATOM 'BROKEN-ATOM-PRINTER))
|
||||||
|
|
||||||
|
(* ;; "Debugging/testing")
|
||||||
|
|
||||||
|
(FUNCTIONS TEST-INTERNAL-BA TEST-EXTERNAL-BA TEST-DEEP-COMPUTATION TEST-PRETTY-FILE)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(* ;; "the representation of a broken atom")
|
||||||
|
|
||||||
|
(DECLARE%: EVAL@COMPILE
|
||||||
|
|
||||||
|
(DATATYPE BROKEN-ATOM ((PACKAGE POINTER)
|
||||||
|
(NAME POINTER)
|
||||||
|
(EXTERNAL FLAG)))
|
||||||
|
)
|
||||||
|
|
||||||
|
(/DECLAREDATATYPE 'BROKEN-ATOM '(POINTER POINTER FLAG)
|
||||||
|
'((BROKEN-ATOM 0 POINTER)
|
||||||
|
(BROKEN-ATOM 2 POINTER)
|
||||||
|
(BROKEN-ATOM 2 (FLAGBITS . 0)))
|
||||||
|
'4)
|
||||||
|
|
||||||
|
(CL:DEFUN CURE-BROKEN-ATOM (CONDITION)
|
||||||
|
"Given an XCL:MISSING-EXTERNAL-SYMBOL condition, return a corresponding BROKEN-ATOM"
|
||||||
|
(COND
|
||||||
|
((TYPEP CONDITION 'XCL:MISSING-PACKAGE) (* ; "no such package ")
|
||||||
|
(create BROKEN-ATOM
|
||||||
|
PACKAGE _ (XCL:MISSING-PACKAGE-PACKAGE-NAME CONDITION)
|
||||||
|
NAME _ (XCL:MISSING-PACKAGE-SYMBOL-NAME CONDITION)
|
||||||
|
EXTERNAL _ (XCL:MISSING-PACKAGE-EXTERNAL CONDITION)))
|
||||||
|
((TYPEP CONDITION 'XCL:MISSING-EXTERNAL-SYMBOL) (* ;
|
||||||
|
"package exists, no such external symbol")
|
||||||
|
(create BROKEN-ATOM
|
||||||
|
PACKAGE _ (CL:PACKAGE-NAME (XCL:MISSING-EXTERNAL-SYMBOL-PACKAGE CONDITION))
|
||||||
|
NAME _ (XCL:MISSING-EXTERNAL-SYMBOL-NAME CONDITION)
|
||||||
|
EXTERNAL _ NIL))
|
||||||
|
(T (HELP "Don't know how to cure" CONDITION))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(* ;; "for DEFPRINT")
|
||||||
|
|
||||||
|
(DEFINEQ
|
||||||
|
|
||||||
|
(BROKEN-ATOM-PRINTER
|
||||||
|
[LAMBDA (BROKEN-ATOM STREAM)
|
||||||
|
(CONS (CONCAT (fetch (BROKEN-ATOM PACKAGE) of BROKEN-ATOM)
|
||||||
|
(if (fetch (BROKEN-ATOM EXTERNAL) of BROKEN-ATOM)
|
||||||
|
then ":"
|
||||||
|
else "::")
|
||||||
|
(fetch (BROKEN-ATOM NAME) of BROKEN-ATOM])
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(* ;; "special form")
|
||||||
|
|
||||||
|
|
||||||
|
(DEFMACRO WITHOUT-BROKEN-ATOMS (&BODY FORMS)
|
||||||
|
"Handle any broken-atom errors by producing a BROKEN-ATOM that prints as if the original atom were intact"
|
||||||
|
`[HANDLER-BIND [[XCL:MISSING-PACKAGE #'(CL:LAMBDA (C)
|
||||||
|
(CONDITIONS:INVOKE-RESTART
|
||||||
|
'CREATE-MISSING-PACKAGE-BA (CURE-BROKEN-ATOM
|
||||||
|
C]
|
||||||
|
(XCL:MISSING-EXTERNAL-SYMBOL #'(CL:LAMBDA (C)
|
||||||
|
(CONDITIONS:INVOKE-RESTART
|
||||||
|
'CREATE-EXTERNAL-BA (CURE-BROKEN-ATOM
|
||||||
|
C]
|
||||||
|
(CONDITIONS:RESTART-BIND [(CREATE-MISSING-PACKAGE-BA
|
||||||
|
#'(CL:LAMBDA (V)
|
||||||
|
(RETFROM (FUNCTION RESOLVE-MISSING-PACKAGE)
|
||||||
|
V)
|
||||||
|
V))
|
||||||
|
(CREATE-EXTERNAL-BA #'(CL:LAMBDA (V)
|
||||||
|
(RETFROM (FUNCTION
|
||||||
|
RESOLVE-MISSING-EXTERNAL-SYMBOL
|
||||||
|
)
|
||||||
|
V)
|
||||||
|
V]
|
||||||
|
(PROGN ,@FORMS])
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(* ;; "setup")
|
||||||
|
|
||||||
|
|
||||||
|
(DEFPRINT 'BROKEN-ATOM 'BROKEN-ATOM-PRINTER)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(* ;; "Debugging/testing")
|
||||||
|
|
||||||
|
|
||||||
|
(CL:DEFUN TEST-INTERNAL-BA ()
|
||||||
|
[LET ((FILE NIL))
|
||||||
|
(CL:WITH-OPEN-STREAM (OUT (OPENSTREAM "{nodircore}" 'OUTPUT))
|
||||||
|
(SETQ FILE OUT)
|
||||||
|
(PRINTOUT OUT "BROKEN::INTERNAL-ATOM" T))
|
||||||
|
(CL:WITH-OPEN-STREAM (IN (OPENSTREAM FILE 'INPUT))
|
||||||
|
(WITHOUT-BROKEN-ATOMS (RATOM IN])
|
||||||
|
|
||||||
|
(CL:DEFUN TEST-EXTERNAL-BA ()
|
||||||
|
[LET ((FILE NIL))
|
||||||
|
(CL:WITH-OPEN-STREAM (OUT (OPENSTREAM "{nodircore}" 'OUTPUT))
|
||||||
|
(SETQ FILE OUT)
|
||||||
|
(PRINTOUT OUT "BROKEN:EXTERNAL-ATOM" T))
|
||||||
|
(CL:WITH-OPEN-STREAM (IN (OPENSTREAM FILE 'INPUT))
|
||||||
|
(WITHOUT-BROKEN-ATOMS (RATOM IN])
|
||||||
|
|
||||||
|
(CL:DEFUN TEST-DEEP-COMPUTATION ()
|
||||||
|
"Test that we can handle internal calls to READ that encounter broken atoms"
|
||||||
|
|
||||||
|
(* ;; "make sure it works when there's no error")
|
||||||
|
|
||||||
|
(LET [(RESULT (WITHOUT-BROKEN-ATOMS (CL:LOOP :FOR X :FROM 0 :TO 9 :COLLECT X]
|
||||||
|
(PRINTOUT T "No error loop result: " RESULT T))
|
||||||
|
|
||||||
|
(* ;; "and when reading legit atoms")
|
||||||
|
|
||||||
|
(LET [(RESULT (WITHOUT-BROKEN-ATOMS (CL:LOOP :FOR X :FROM 0 :TO 9 :COLLECT (CL:READ-FROM-STRING
|
||||||
|
(CONCAT "IL:ATOM" X]
|
||||||
|
(PRINTOUT T "No error read loop result: " RESULT T))
|
||||||
|
|
||||||
|
(* ;; "test XCL:MISSING-PACKAGE.")
|
||||||
|
|
||||||
|
(COND
|
||||||
|
((CL:FIND-PACKAGE :BROKEN)
|
||||||
|
(DELETE-PACKAGE :BROKEN)))
|
||||||
|
(LET [(RESULT (WITHOUT-BROKEN-ATOMS (CL:LOOP :FOR X :FROM 0 :TO 9 :COLLECT (CL:READ-FROM-STRING
|
||||||
|
(CONCAT "BROKEN:ATOM"
|
||||||
|
X]
|
||||||
|
(PRINTOUT T "No such package loop result: " RESULT T))
|
||||||
|
|
||||||
|
(* ;; "test XCL:MISSING-EXTERNAL-SYMBOL")
|
||||||
|
|
||||||
|
(CL:UNWIND-PROTECT
|
||||||
|
(PROGN (CL:MAKE-PACKAGE :BROKEN)
|
||||||
|
(LET [(RESULT (WITHOUT-BROKEN-ATOMS (CL:LOOP :FOR X :FROM 0 :TO 9 :COLLECT
|
||||||
|
(CL:READ-FROM-STRING (CONCAT "BROKEN:ATOM" X
|
||||||
|
]
|
||||||
|
(PRINTOUT T "Not external symbol loop result: " RESULT T)))
|
||||||
|
[COND
|
||||||
|
((CL:FIND-PACKAGE :BROKEN)
|
||||||
|
(DELETE-PACKAGE 'BROKEN]))
|
||||||
|
|
||||||
|
(CL:DEFUN TEST-PRETTY-FILE (SOURCE-FILE-NAME OUTPUT-FILE-NAME OUTPUT-TYPE)
|
||||||
|
"Prettyprint a Lisp source file to an imagestream file"
|
||||||
|
(CL:WITH-OPEN-STREAM (OUTPUT-STREAM (OPENIMAGESTREAM OUTPUT-FILE-NAME OUTPUT-TYPE))
|
||||||
|
(WITHOUT-BROKEN-ATOMS (PRETTYFILEINDEX SOURCE-FILE-NAME NIL OUTPUT-STREAM T))
|
||||||
|
(FULLNAME OUTPUT-STREAM)))
|
||||||
|
(DECLARE%: DONTCOPY
|
||||||
|
(FILEMAP (NIL (1403 2315 (CURE-BROKEN-ATOM 1403 . 2315)) (2346 2699 (BROKEN-ATOM-PRINTER 2356 . 2697))
|
||||||
|
(2731 4397 (WITHOUT-BROKEN-ATOMS 2731 . 4397)) (4503 4831 (TEST-INTERNAL-BA 4503 . 4831)) (4833 5160
|
||||||
|
(TEST-EXTERNAL-BA 4833 . 5160)) (5162 6829 (TEST-DEEP-COMPUTATION 5162 . 6829)) (6831 7184 (
|
||||||
|
TEST-PRETTY-FILE 6831 . 7184)))))
|
||||||
|
STOP
|
||||||
BIN
lispusers/BROKEN-ATOMS.DFASL
Normal file
BIN
lispusers/BROKEN-ATOMS.DFASL
Normal file
Binary file not shown.
BIN
lispusers/BROKEN-ATOMS.TEdit
Normal file
BIN
lispusers/BROKEN-ATOMS.TEdit
Normal file
Binary file not shown.
@@ -1,14 +1,13 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
(FILECREATED " 7-Sep-88 17:08:57" {ERINYES}<LISPUSERS>MEDLEY>CHATSERVER.;11 47957
|
|
||||||
|
|
||||||
changes to%: (FNS CHATSERVEROPENFN)
|
(FILECREATED " 9-Feb-2026 22:25:32" {WMEDLEY}<lispusers>CHATSERVER.;2 45227
|
||||||
|
|
||||||
previous date%: "19-May-88 00:37:49" {ERINYES}<LISPUSERS>MEDLEY>CHATSERVER.;10)
|
:EDIT-BY rmk
|
||||||
|
|
||||||
|
:CHANGES-TO (FNS \CREATELINEBUFFER)
|
||||||
|
|
||||||
|
:PREVIOUS-DATE " 7-Sep-88 17:08:57" {WMEDLEY}<lispusers>CHATSERVER.;1)
|
||||||
|
|
||||||
(* "
|
|
||||||
Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
|
|
||||||
")
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT CHATSERVERCOMS)
|
(PRETTYCOMPRINT CHATSERVERCOMS)
|
||||||
|
|
||||||
@@ -40,8 +39,7 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights res
|
|||||||
(COMMANDS "QUIT" "SAY")
|
(COMMANDS "QUIT" "SAY")
|
||||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||||
(NLAML)
|
(NLAML)
|
||||||
(LAMA \REMOTE.BIN
|
(LAMA CHATSERVEROPENFN])
|
||||||
CHATSERVEROPENFN])
|
|
||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(CHATSERVER
|
(CHATSERVER
|
||||||
@@ -450,34 +448,34 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights res
|
|||||||
(RETURN CHARBUFFER])
|
(RETURN CHARBUFFER])
|
||||||
|
|
||||||
(\CREATELINEBUFFER
|
(\CREATELINEBUFFER
|
||||||
[LAMBDA (TERMINAL.STREAM) (* ; "Edited 13-Apr-87 22:57 by bvm:")
|
[LAMBDA (TERMINAL.STREAM) (* ; "Edited 9-Feb-2026 22:21 by rmk")
|
||||||
(* ;;
|
(* ; "Edited 13-Apr-87 22:57 by bvm:")
|
||||||
"Create a new stream that buffers the raw input from TERMINAL.STREAM (default is the keyboard).")
|
|
||||||
|
|
||||||
(LET* ([STREAM (\OPENFILE '{LINEBUFFER} 'BOTH 'NEW '((CHARSET T]
|
(* ;; "This is a copy of \CREATELINEBUFFER on ATERM, except for the source of the EOFMETHOD.")
|
||||||
|
|
||||||
|
(* ;;
|
||||||
|
"Create a new stream that buffers the raw input from TERMINAL.STREAM (default is the keyboard).")
|
||||||
|
|
||||||
|
(LET* ([STREAM (\OPENFILE '{LINEBUFFER} 'BOTH 'NEW '((:EXTERNAL-FORMAT :THROUGH16]
|
||||||
(DEV (fetch (STREAM DEVICE) of STREAM))
|
(DEV (fetch (STREAM DEVICE) of STREAM))
|
||||||
EOFMETHOD)
|
EOFMETHOD)
|
||||||
(replace LINEBUFSTATE of STREAM with READING.LBS)
|
(replace LINEBUFSTATE of STREAM with READING.LBS)
|
||||||
(replace (LINEBUFFER KEYBOARDSTREAM) of STREAM with (OR TERMINAL.STREAM
|
(replace (LINEBUFFER KEYBOARDSTREAM) of STREAM with (OR TERMINAL.STREAM \KEYBOARD.STREAM))
|
||||||
\KEYBOARD.STREAM))
|
|
||||||
(replace USERCLOSEABLE of STREAM with NIL)
|
(replace USERCLOSEABLE of STREAM with NIL)
|
||||||
(replace USERVISIBLE of STREAM with NIL)
|
(replace USERVISIBLE of STREAM with NIL) (* ;
|
||||||
(* ;
|
"Other linebuffer fields default properly")
|
||||||
"Other linebuffer fields default properly")
|
|
||||||
[replace ENDOFSTREAMOP of STREAM with (FUNCTION (LAMBDA (STREAM)
|
[replace ENDOFSTREAMOP of STREAM with (FUNCTION (LAMBDA (STREAM)
|
||||||
(CL:FUNCALL \RefillBufferFn]
|
(CL:FUNCALL \RefillBufferFn]
|
||||||
(if (AND TERMINAL.STREAM (NEQ (SETQ EOFMETHOD (fetch (FDEV EOFP)
|
(if (AND TERMINAL.STREAM (NEQ (SETQ EOFMETHOD (fetch (FDEV EOFP) of (fetch (STREAM DEVICE)
|
||||||
of (fetch (STREAM DEVICE)
|
TERMINAL.STREAM)
|
||||||
TERMINAL.STREAM)))
|
))
|
||||||
'NILL))
|
'NILL))
|
||||||
then
|
then
|
||||||
(* ;; "Need to install an eof method for the buffered stream that looks at TERMINAL.STREAM when the buffer runs out. This is optimized away for the normal keyboard case, which never runs out.")
|
(* ;; "Need to install an eof method for the buffered stream that looks at TERMINAL.STREAM when the buffer runs out. This is optimized away for the normal keyboard case, which never runs out.")
|
||||||
|
|
||||||
(replace (STREAM DEVICE) of STREAM with (SETQ DEV (NCREATE
|
(replace (STREAM DEVICE) of STREAM with (SETQ DEV (NCREATE 'FDEV DEV)))
|
||||||
'FDEV DEV)))
|
(* ; "Copy the basic linebuffer device")
|
||||||
(* ;
|
(replace (FDEV EOFP) of DEV with EOFMETHOD))
|
||||||
"Copy the basic linebuffer device")
|
|
||||||
(replace (FDEV EOFP) of DEV with EOFMETHOD))
|
|
||||||
STREAM])
|
STREAM])
|
||||||
|
|
||||||
(\PROMPTFORWORDBIN
|
(\PROMPTFORWORDBIN
|
||||||
@@ -650,7 +648,7 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights res
|
|||||||
(SETQ CHATSERVERTTBL (COPYTERMTABLE 'ORIG))
|
(SETQ CHATSERVERTTBL (COPYTERMTABLE 'ORIG))
|
||||||
|
|
||||||
(for I from 1 to 8 do (ECHOCHAR I 'IGNORE CHATSERVERTTBL)
|
(for I from 1 to 8 do (ECHOCHAR I 'IGNORE CHATSERVERTTBL)
|
||||||
(ECHOCHAR I 'IGNORE ASKUSERTTBL))
|
(ECHOCHAR I 'IGNORE ASKUSERTTBL))
|
||||||
|
|
||||||
(ECHOCHAR (CHARCODE CR)
|
(ECHOCHAR (CHARCODE CR)
|
||||||
'SIMULATE CHATSERVERTTBL)
|
'SIMULATE CHATSERVERTTBL)
|
||||||
@@ -715,29 +713,25 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights res
|
|||||||
(DECLARE%: EVAL@COMPILE
|
(DECLARE%: EVAL@COMPILE
|
||||||
|
|
||||||
[PROGN (PUTPROPS \SYNCODE DMACRO [OPENLAMBDA (TABLE CHAR)
|
[PROGN (PUTPROPS \SYNCODE DMACRO [OPENLAMBDA (TABLE CHAR)
|
||||||
(CHECK (type? CHARTABLE TABLE))
|
(CHECK (type? CHARTABLE TABLE))
|
||||||
(* ;
|
(* ;
|
||||||
"0 is either NONE.TC, REAL.CCE, or OTHER.RC")
|
"0 is either NONE.TC, REAL.CCE, or OTHER.RC")
|
||||||
(COND
|
(COND
|
||||||
((IGREATERP CHAR \MAXTHINCHAR)
|
((IGREATERP CHAR \MAXTHINCHAR)
|
||||||
(OR (AND (fetch (CHARTABLE NSCHARHASH)
|
(OR (AND (fetch (CHARTABLE NSCHARHASH) of TABLE)
|
||||||
of TABLE)
|
(GETHASH CHAR (fetch (CHARTABLE NSCHARHASH)
|
||||||
(GETHASH CHAR (fetch (CHARTABLE
|
of TABLE)))
|
||||||
NSCHARHASH)
|
0))
|
||||||
of TABLE)))
|
(T (\GETBASEBYTE TABLE CHAR])
|
||||||
0))
|
|
||||||
(T (\GETBASEBYTE TABLE CHAR])
|
|
||||||
(PUTPROPS \SYNCODE MACRO [OPENLAMBDA (TABLE CHAR)
|
(PUTPROPS \SYNCODE MACRO [OPENLAMBDA (TABLE CHAR)
|
||||||
(CHECK (type? CHARTABLE TABLE))
|
(CHECK (type? CHARTABLE TABLE))
|
||||||
(COND
|
(COND
|
||||||
((IGREATERP CHAR \MAXTHINCHAR)
|
((IGREATERP CHAR \MAXTHINCHAR)
|
||||||
(OR (AND (fetch (CHARTABLE NSCHARHASH)
|
(OR (AND (fetch (CHARTABLE NSCHARHASH) of TABLE)
|
||||||
of TABLE)
|
(GETHASH CHAR (fetch (CHARTABLE NSCHARHASH)
|
||||||
(GETHASH CHAR (fetch (CHARTABLE
|
of TABLE)))
|
||||||
NSCHARHASH)
|
0))
|
||||||
of TABLE)))
|
(T (\GETBASEBYTE TABLE CHAR])]
|
||||||
0))
|
|
||||||
(T (\GETBASEBYTE TABLE CHAR])]
|
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||||
|
|
||||||
@@ -773,10 +767,9 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights res
|
|||||||
(READVISE MENU CHAT RINGBELLS)
|
(READVISE MENU CHAT RINGBELLS)
|
||||||
)
|
)
|
||||||
|
|
||||||
(DEFCOMMAND "QUIT" ()
|
(DEFCOMMAND "QUIT" NIL (RETFROM 'CHATSERVEROPENFN))
|
||||||
(RETFROM 'CHATSERVEROPENFN))
|
|
||||||
|
|
||||||
(DEFCOMMAND "SAY" (&REST LINE)
|
(DEFCOMMAND "SAY" (&REST LINE)
|
||||||
[MAPC \PROCESSES (FUNCTION (LAMBDA (PROC)
|
[MAPC \PROCESSES (FUNCTION (LAMBDA (PROC)
|
||||||
(CL:WHEN (STRPOS "CHAT.SERVER" (PROCESS.NAME PROC))
|
(CL:WHEN (STRPOS "CHAT.SERVER" (PROCESS.NAME PROC))
|
||||||
(MAPRINT LINE (IF (EQ PROC (THIS.PROCESS))
|
(MAPRINT LINE (IF (EQ PROC (THIS.PROCESS))
|
||||||
@@ -795,53 +788,13 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights res
|
|||||||
|
|
||||||
(ADDTOVAR NLAML )
|
(ADDTOVAR NLAML )
|
||||||
|
|
||||||
(ADDTOVAR LAMA \REMOTE.BIN CHATSERVEROPENFN)
|
|
||||||
)
|
|
||||||
(PRETTYCOMPRINT CHATSERVERCOMS)
|
|
||||||
|
|
||||||
(RPAQQ CHATSERVERCOMS
|
|
||||||
[(FNS CHATSERVER CHATSERVERWHENCLOSEDFN CHATSERVEROPENFN DOBE REQUIRED.LOGIN SERVER-EXEC
|
|
||||||
SWEEP.OFD \CLEARSYSBUF PROMPTFORWORD \CREATELINEBUFFER \PROMPTFORWORDBIN \REMOTE.BIN
|
|
||||||
\REMOTE.EXEC.OUTCHARFN CHATSERVER.FONT)
|
|
||||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (DISPLAYTERMFLG 'DM))
|
|
||||||
(INITVARS (CHATSERVER.PROFILE)
|
|
||||||
(\SIMPLEIMAGEOPS))
|
|
||||||
(P (SETQ CHATSERVERTTBL (COPYTERMTABLE 'ORIG))
|
|
||||||
(for I from 1 to 8 do (ECHOCHAR I 'IGNORE CHATSERVERTTBL)
|
|
||||||
(ECHOCHAR I 'IGNORE ASKUSERTTBL))
|
|
||||||
(ECHOCHAR (CHARCODE CR)
|
|
||||||
'SIMULATE CHATSERVERTTBL)
|
|
||||||
(ECHOCHAR (CHARCODE CR)
|
|
||||||
'SIMULATE ASKUSERTTBL)
|
|
||||||
(ECHOCHAR 0 'SIMULATE ASKUSERTTBL)
|
|
||||||
(ECHOCHAR 0 'SIMULATE CHATSERVERTTBL)))
|
|
||||||
(ADDVARS (\SWEPT.OFDS))
|
|
||||||
(DECLARE%: EVAL@COMPILE DONTCOPY (P (CHECKIMPORTS '(LLCHAR ATERM IMAGEIO FILEIO ATBL AOFD)
|
|
||||||
T)))
|
|
||||||
[COMS (FNS SIMPLECHATSERVER)
|
|
||||||
(INITVARS (CHATSERVERWINDOW)
|
|
||||||
(CHATSERVERWINDOWREGION '(11 228 392 190]
|
|
||||||
(MACROS \SYNCODE)
|
|
||||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (FILES CL-TTYEDIT SIMPLECHAT)
|
|
||||||
(ADVISE MENU CHAT RINGBELLS))
|
|
||||||
(COMMANDS "QUIT" "SAY")
|
|
||||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
|
||||||
(NLAML)
|
|
||||||
(LAMA CHATSERVEROPENFN])
|
|
||||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
|
||||||
|
|
||||||
(ADDTOVAR NLAMA )
|
|
||||||
|
|
||||||
(ADDTOVAR NLAML )
|
|
||||||
|
|
||||||
(ADDTOVAR LAMA CHATSERVEROPENFN)
|
(ADDTOVAR LAMA CHATSERVEROPENFN)
|
||||||
)
|
)
|
||||||
(PUTPROPS CHATSERVER COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988))
|
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (2216 38509 (CHATSERVER 2226 . 3955) (CHATSERVERWHENCLOSEDFN 3957 . 4304) (
|
(FILEMAP (NIL (2029 38278 (CHATSERVER 2039 . 3768) (CHATSERVERWHENCLOSEDFN 3770 . 4117) (
|
||||||
CHATSERVEROPENFN 4306 . 8433) (DOBE 8435 . 8481) (REQUIRED.LOGIN 8483 . 11220) (SERVER-EXEC 11222 .
|
CHATSERVEROPENFN 4119 . 8246) (DOBE 8248 . 8294) (REQUIRED.LOGIN 8296 . 11033) (SERVER-EXEC 11035 .
|
||||||
11395) (SWEEP.OFD 11397 . 11933) (\CLEARSYSBUF 11935 . 12184) (PROMPTFORWORD 12186 . 26531) (
|
11208) (SWEEP.OFD 11210 . 11746) (\CLEARSYSBUF 11748 . 11997) (PROMPTFORWORD 11999 . 26344) (
|
||||||
\CREATELINEBUFFER 26533 . 28708) (\PROMPTFORWORDBIN 28710 . 31646) (\REMOTE.BIN 31648 . 33890) (
|
\CREATELINEBUFFER 26346 . 28477) (\PROMPTFORWORDBIN 28479 . 31415) (\REMOTE.BIN 31417 . 33659) (
|
||||||
\REMOTE.EXEC.OUTCHARFN 33892 . 38114) (CHATSERVER.FONT 38116 . 38507)) (39151 41493 (SIMPLECHATSERVER
|
\REMOTE.EXEC.OUTCHARFN 33661 . 37883) (CHATSERVER.FONT 37885 . 38276)) (38905 41247 (SIMPLECHATSERVER
|
||||||
39161 . 41491)))))
|
38915 . 41245)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
@@ -1,95 +1,88 @@
|
|||||||
(DEFINE-FILE-INFO §PACKAGE "INTERLISP" §READTABLE "INTERLISP" §BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
(FILECREATED " 2-Apr-87 17:06:05" {ERIS}<LISPUSERS>LYRIC>COMMWINDOW.;3 49786
|
|
||||||
|
|
||||||
changes to%: (VARS REMOTE-CURSOR COMMWINDOWCOMS)
|
(FILECREATED "18-Feb-2026 16:21:29" {WMEDLEY}<lispusers>COMMWINDOW.;2 48680
|
||||||
(COURIERPROGRAMS COMMWINDOW)
|
|
||||||
(FNS CLOSE-FRAME START-GET-BITS SEND-BITS FRAME-EVENT MAKE-FRAME)
|
|
||||||
(FUNCTIONS \PILOTBITBLT)
|
|
||||||
|
|
||||||
previous date%: " 2-Apr-87 16:54:24" {ERIS}<LISPUSERS>LYRIC>COMMWINDOW.;2)
|
:EDIT-BY rmk
|
||||||
|
|
||||||
|
:PREVIOUS-DATE " 2-Apr-87 17:06:05" {WMEDLEY}<lispusers>COMMWINDOW.;1)
|
||||||
|
|
||||||
(* "
|
|
||||||
Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
|
|
||||||
")
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT COMMWINDOWCOMS)
|
(PRETTYCOMPRINT COMMWINDOWCOMS)
|
||||||
|
|
||||||
(RPAQQ COMMWINDOWCOMS (
|
(RPAQQ COMMWINDOWCOMS
|
||||||
|
(
|
||||||
|
|
||||||
(* ;;; "Viewer end")
|
(* ;;; "Viewer end")
|
||||||
|
|
||||||
(FNS CLOSE-FRAME GET-BITS START-GET-BITS)
|
(FNS CLOSE-FRAME GET-BITS START-GET-BITS)
|
||||||
(FILES COURIERSERVE)
|
(FILES COURIERSERVE)
|
||||||
|
|
||||||
|
|
||||||
(* ;;; "Sender end")
|
(* ;;; "Sender end")
|
||||||
|
|
||||||
(FNS SEND-BITS SEND-TILE LISTEN-TO-VIEWER MAPTILES SHUT-DOWN-VIEWER
|
(FNS SEND-BITS SEND-TILE LISTEN-TO-VIEWER MAPTILES SHUT-DOWN-VIEWER CHANGE-SENDER-UPDATE-MODE
|
||||||
CHANGE-SENDER-UPDATE-MODE)
|
)
|
||||||
(FUNCTIONS INCR \PILOTBITBLT)
|
(FUNCTIONS INCR \PILOTBITBLT)
|
||||||
|
|
||||||
|
(* ;; "Controling update schemes")
|
||||||
(* ;; "Controling update schemes")
|
|
||||||
|
|
||||||
(INITVARS (COMM.DEFAULT.TRANSMIT.TYPE 'SQUARE)
|
(INITVARS (COMM.DEFAULT.TRANSMIT.TYPE 'SQUARE)
|
||||||
(COMM.SEND.UNCHANGED.TILES T)
|
(COMM.SEND.UNCHANGED.TILES T)
|
||||||
(COMM.UPDATE.MOUSE.POSITION 'Sender))
|
(COMM.UPDATE.MOUSE.POSITION 'Sender))
|
||||||
(GLOBALVARS COMM.DEFAULT.TRANSMIT.TYPE COMM.UPDATE.MOUSE.POSITION
|
(GLOBALVARS COMM.DEFAULT.TRANSMIT.TYPE COMM.UPDATE.MOUSE.POSITION COMM.SEND.UNCHANGED.TILES)
|
||||||
COMM.SEND.UNCHANGED.TILES)
|
|
||||||
|
|
||||||
|
|
||||||
(* ;;; "Pruning out unchanged screen tiles")
|
(* ;;; "Pruning out unchanged screen tiles")
|
||||||
|
|
||||||
(FNS PACKET-EQUAL GET-CACHED-PACKET PUT-CACHED-PACKET)
|
(FNS PACKET-EQUAL GET-CACHED-PACKET PUT-CACHED-PACKET)
|
||||||
|
|
||||||
|
|
||||||
(* ;;; "Low level packet exchange code")
|
(* ;;; "Low level packet exchange code")
|
||||||
|
|
||||||
(CONSTANTS COMM.BAND.PACKET.TYPE COMM.CURSOR.PACKET.TYPE
|
(CONSTANTS COMM.BAND.PACKET.TYPE COMM.CURSOR.PACKET.TYPE COMM.CURSOR.CLOSE.PACKET.TYPE
|
||||||
COMM.CURSOR.CLOSE.PACKET.TYPE COMM.SHUT.DOWN.PACKET.TYPE)
|
COMM.SHUT.DOWN.PACKET.TYPE)
|
||||||
(VARIABLES MAX-PACKET-BITS)
|
(VARIABLES MAX-PACKET-BITS)
|
||||||
(RECORDS COMM.XFER.PACKET)
|
(RECORDS COMM.XFER.PACKET)
|
||||||
|
|
||||||
|
|
||||||
(* ;;; "Packing and unpacking bitmaps into etherpackets")
|
(* ;;; "Packing and unpacking bitmaps into etherpackets")
|
||||||
|
|
||||||
(FNS BMTOPACKET PACKETTOBM)
|
(FNS BMTOPACKET PACKETTOBM)
|
||||||
|
|
||||||
|
|
||||||
(* ;;; "Displaying the viewing machine's cursor")
|
(* ;;; "Displaying the viewing machine's cursor")
|
||||||
|
|
||||||
(VARS REMOTE-CURSOR)
|
(VARS REMOTE-CURSOR)
|
||||||
(INITVARS (CURSORICON NIL))
|
(INITVARS (CURSORICON NIL))
|
||||||
|
|
||||||
|
|
||||||
(* ;;; "Manipulating the frame that outlines the region being viewed")
|
(* ;;; "Manipulating the frame that outlines the region being viewed")
|
||||||
|
|
||||||
(INITVARS (*FRAME-SHADE* GRAYSHADE))
|
(INITVARS (*FRAME-SHADE* GRAYSHADE))
|
||||||
(FNS FRAME-EVENT MAKE-FRAME MOVE-FRAME SHAPE-FRAME SET-FRAME-TITLE)
|
(FNS FRAME-EVENT MAKE-FRAME MOVE-FRAME SHAPE-FRAME SET-FRAME-TITLE)
|
||||||
|
|
||||||
|
|
||||||
(* ;;; "Changing the system parameters")
|
(* ;;; "Changing the system parameters")
|
||||||
|
|
||||||
(FNS MAKE-MENUS-WINDOW MODE-MENU)
|
(FNS MAKE-MENUS-WINDOW MODE-MENU)
|
||||||
(VARS COMM-MODES)
|
(VARS COMM-MODES)
|
||||||
|
|
||||||
|
|
||||||
(* ;;; "Initialization")
|
(* ;;; "Initialization")
|
||||||
|
|
||||||
(P (COURIER.START.SERVER))
|
(P (COURIER.START.SERVER))
|
||||||
|
|
||||||
|
|
||||||
(* ;;; "Unused stuff, as far as I can tell")
|
(* ;;; "Unused stuff, as far as I can tell")
|
||||||
|
|
||||||
(FNS FASTBITBLT)
|
(FNS FASTBITBLT)
|
||||||
|
|
||||||
|
|
||||||
(* ;;; "System file dependencies")
|
(* ;;; "System file dependencies")
|
||||||
|
|
||||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE (FILES (LOADCOMP)
|
(DECLARE%: DONTCOPY DOEVAL@COMPILE (FILES (LOADCOMP)
|
||||||
LLDISPLAY LLETHER LLNS))
|
LLDISPLAY LLETHER LLNS))
|
||||||
(COURIERPROGRAMS COMMWINDOW)))
|
(COURIERPROGRAMS COMMWINDOW)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -236,6 +229,7 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
|
|||||||
(LIST 'RETURN (LIST (NSOCKETNUMBER NS)
|
(LIST 'RETURN (LIST (NSOCKETNUMBER NS)
|
||||||
(USERNAME])
|
(USERNAME])
|
||||||
)
|
)
|
||||||
|
|
||||||
(FILESLOAD COURIERSERVE)
|
(FILESLOAD COURIERSERVE)
|
||||||
|
|
||||||
|
|
||||||
@@ -446,19 +440,18 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
|
|||||||
(SETQ COMM.DEFAULT.TRANSMIT.TYPE NEW-MODE)))
|
(SETQ COMM.DEFAULT.TRANSMIT.TYPE NEW-MODE)))
|
||||||
)
|
)
|
||||||
|
|
||||||
(DEFMACRO INCR (VAR START HEIGHT REPEATS UNTIL &REST FORMS)
|
(DEFMACRO INCR (VAR START HEIGHT REPEATS UNTIL &REST FORMS)
|
||||||
`(CL:DO ((REPEAT-COUNT 0 (+ REPEAT-COUNT 1)))
|
`(CL:DO ((REPEAT-COUNT 0 (+ REPEAT-COUNT 1)))
|
||||||
((>= REPEAT-COUNT ,REPEATS))
|
((>= REPEAT-COUNT ,REPEATS))
|
||||||
(CL:DO [(,VAR (+ ,START (CL:* REPEAT-COUNT ,HEIGHT))
|
(CL:DO [(,VAR (+ ,START (CL:* REPEAT-COUNT ,HEIGHT))
|
||||||
(+ ,VAR (CL:* ,REPEATS ,HEIGHT]
|
(+ ,VAR (CL:* ,REPEATS ,HEIGHT]
|
||||||
(,UNTIL)
|
(,UNTIL)
|
||||||
,@FORMS)))
|
,@FORMS)))
|
||||||
|
|
||||||
|
|
||||||
(DEFMACRO \PILOTBITBLT (XCL-USER::TABLE &OPTIONAL (XCL-USER::N 0)) (CL:ASSERT (EQL XCL-USER::N 0))
|
|
||||||
`((OPCODES PILOTBITBLT)
|
|
||||||
,XCL-USER::TABLE 0))
|
|
||||||
|
|
||||||
|
(DEFMACRO \PILOTBITBLT (XCL-USER::TABLE &OPTIONAL (XCL-USER::N 0))
|
||||||
|
(CL:ASSERT (EQL XCL-USER::N 0))
|
||||||
|
`((OPCODES PILOTBITBLT)
|
||||||
|
,XCL-USER::TABLE 0))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -525,12 +518,12 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
|
|||||||
|
|
||||||
(RPAQQ COMM.SHUT.DOWN.PACKET.TYPE 4246)
|
(RPAQQ COMM.SHUT.DOWN.PACKET.TYPE 4246)
|
||||||
|
|
||||||
|
|
||||||
(CONSTANTS COMM.BAND.PACKET.TYPE COMM.CURSOR.PACKET.TYPE COMM.CURSOR.CLOSE.PACKET.TYPE
|
(CONSTANTS COMM.BAND.PACKET.TYPE COMM.CURSOR.PACKET.TYPE COMM.CURSOR.CLOSE.PACKET.TYPE
|
||||||
COMM.SHUT.DOWN.PACKET.TYPE)
|
COMM.SHUT.DOWN.PACKET.TYPE)
|
||||||
)
|
)
|
||||||
|
|
||||||
(CL:DEFCONSTANT MAX-PACKET-BITS (CL:* 400 8) )
|
(CL:DEFCONSTANT MAX-PACKET-BITS (CL:* 400 8))
|
||||||
|
|
||||||
(DECLARE%: EVAL@COMPILE
|
(DECLARE%: EVAL@COMPILE
|
||||||
|
|
||||||
(ACCESSFNS COMM.XFER.PACKET ((COMMPACKET (fetch (XIP XIPCONTENTS) of DATUM)))
|
(ACCESSFNS COMM.XFER.PACKET ((COMMPACKET (fetch (XIP XIPCONTENTS) of DATUM)))
|
||||||
@@ -807,6 +800,7 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
|
|||||||
|
|
||||||
(* ;;; "Initialization")
|
(* ;;; "Initialization")
|
||||||
|
|
||||||
|
|
||||||
(COURIER.START.SERVER)
|
(COURIER.START.SERVER)
|
||||||
|
|
||||||
|
|
||||||
@@ -862,6 +856,7 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
|
|||||||
(* ;;; "System file dependencies")
|
(* ;;; "System file dependencies")
|
||||||
|
|
||||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE
|
(DECLARE%: DONTCOPY DOEVAL@COMPILE
|
||||||
|
|
||||||
(FILESLOAD (LOADCOMP)
|
(FILESLOAD (LOADCOMP)
|
||||||
LLDISPLAY LLETHER LLNS)
|
LLDISPLAY LLETHER LLNS)
|
||||||
)
|
)
|
||||||
@@ -885,14 +880,14 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
|
|||||||
ERRORS
|
ERRORS
|
||||||
((ERROR 1 (STRING))
|
((ERROR 1 (STRING))
|
||||||
(USE.COURIER 2 NIL)))
|
(USE.COURIER 2 NIL)))
|
||||||
(PUTPROPS COMMWINDOW COPYRIGHT ("Xerox Corporation" 1986 1900 1987))
|
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (3203 13134 (CLOSE-FRAME 3213 . 3364) (GET-BITS 3366 . 11655) (START-GET-BITS 11657 .
|
(FILEMAP (NIL (2306 12237 (CLOSE-FRAME 2316 . 2467) (GET-BITS 2469 . 10758) (START-GET-BITS 10760 .
|
||||||
13132)) (13189 26236 (SEND-BITS 13199 . 16020) (SEND-TILE 16022 . 19145) (LISTEN-TO-VIEWER 19147 .
|
12235)) (12293 25340 (SEND-BITS 12303 . 15124) (SEND-TILE 15126 . 18249) (LISTEN-TO-VIEWER 18251 .
|
||||||
20450) (MAPTILES 20452 . 25175) (SHUT-DOWN-VIEWER 25177 . 26046) (CHANGE-SENDER-UPDATE-MODE 26048 .
|
19554) (MAPTILES 19556 . 24279) (SHUT-DOWN-VIEWER 24281 . 25150) (CHANGE-SENDER-UPDATE-MODE 25152 .
|
||||||
26234)) (27219 29090 (PACKET-EQUAL 27229 . 28632) (GET-CACHED-PACKET 28634 . 28949) (PUT-CACHED-PACKET
|
25338)) (25342 25656 (INCR 25342 . 25656)) (25658 25816 (\PILOTBITBLT 25658 . 25816)) (26181 28052 (
|
||||||
28951 . 29088)) (30529 34252 (BMTOPACKET 30539 . 32500) (PACKETTOBM 32502 . 34250)) (34556 38865 (
|
PACKET-EQUAL 26191 . 27594) (GET-CACHED-PACKET 27596 . 27911) (PUT-CACHED-PACKET 27913 . 28050)) (
|
||||||
FRAME-EVENT 34566 . 35224) (MAKE-FRAME 35226 . 37008) (MOVE-FRAME 37010 . 37280) (SHAPE-FRAME 37282 .
|
29490 33213 (BMTOPACKET 29500 . 31461) (PACKETTOBM 31463 . 33211)) (33517 37826 (FRAME-EVENT 33527 .
|
||||||
38672) (SET-FRAME-TITLE 38674 . 38863)) (38915 45792 (MAKE-MENUS-WINDOW 38925 . 41284) (MODE-MENU
|
34185) (MAKE-FRAME 34187 . 35969) (MOVE-FRAME 35971 . 36241) (SHAPE-FRAME 36243 . 37633) (
|
||||||
41286 . 45790)) (45968 48955 (FASTBITBLT 45978 . 48953)))))
|
SET-FRAME-TITLE 37635 . 37824)) (37876 44753 (MAKE-MENUS-WINDOW 37886 . 40245) (MODE-MENU 40247 .
|
||||||
|
44751)) (44930 47917 (FASTBITBLT 44940 . 47915)))))
|
||||||
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-Nov-2025 13:07:39" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;285 138536
|
(FILECREATED "28-Apr-2026 23:41:24" {MEDLEY}<lispusers>COMPAREDIRECTORIES.;289 139726
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS CD-MENUFN CDBROWSER-COPY)
|
:CHANGES-TO (FNS CDFILES.PATS CDFILES.MATCH CDBROWSER-COPY)
|
||||||
|
|
||||||
:PREVIOUS-DATE "28-Oct-2025 14:52:05" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;280)
|
: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))
|
||||||
])
|
])
|
||||||
@@ -1983,6 +1991,8 @@
|
|||||||
(CD-MENUFN
|
(CD-MENUFN
|
||||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
|
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
|
||||||
|
|
||||||
|
(* ;; "Edited 10-Feb-2026 21:28 by rmk")
|
||||||
|
|
||||||
(* ;; "Edited 8-Nov-2025 13:06 by rmk")
|
(* ;; "Edited 8-Nov-2025 13:06 by rmk")
|
||||||
|
|
||||||
(* ;; "Edited 28-Oct-2025 17:35 by rmk")
|
(* ;; "Edited 28-Oct-2025 17:35 by rmk")
|
||||||
@@ -2059,11 +2069,11 @@
|
|||||||
ELSE (FLASHWINDOW T)
|
ELSE (FLASHWINDOW T)
|
||||||
(PRIN3 "No file to print" T)))
|
(PRIN3 "No file to print" T)))
|
||||||
((See See% both)
|
((See See% both)
|
||||||
(IF (PDFFILEP FILE1)
|
(IF (AND FILE1 (PDFFILEP FILE1))
|
||||||
then (SEE-PDF FILE1)
|
then (SEE-PDF FILE1)
|
||||||
(CL:WHEN (PDFFILEP FILE2)
|
(CL:WHEN (AND FILE2 (PDFFILEP FILE2))
|
||||||
(SEE-PDF FILE2))
|
(SEE-PDF FILE2))
|
||||||
elseif (PDFFILEP FILE2)
|
elseif (AND FILE2 (PDFFILEP FILE2))
|
||||||
then (SEE-PDF FILE2)
|
then (SEE-PDF FILE2)
|
||||||
else (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
|
else (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
|
||||||
(RELCREATEREGION (ITIMES 2 (CL:IF (LISPSOURCEFILEP FILE1)
|
(RELCREATEREGION (ITIMES 2 (CL:IF (LISPSOURCEFILEP FILE1)
|
||||||
@@ -2144,7 +2154,9 @@
|
|||||||
NIL])
|
NIL])
|
||||||
|
|
||||||
(CDBROWSER-COPY
|
(CDBROWSER-COPY
|
||||||
[LAMBDA (CDBROWSER TBITEM SOURCE UNIXDEST) (* ; "Edited 28-Oct-2025 17:39 by rmk")
|
[LAMBDA (CDBROWSER TBITEM SOURCE UNIXDEST) (* ; "Edited 28-Apr-2026 18:54 by rmk")
|
||||||
|
(* ; "Edited 31-Mar-2026 10:49 by rmk")
|
||||||
|
(* ; "Edited 28-Oct-2025 17:39 by rmk")
|
||||||
(* ; "Edited 25-Oct-2025 23:58 by rmk")
|
(* ; "Edited 25-Oct-2025 23:58 by rmk")
|
||||||
(* ; "Edited 24-May-2022 15:49 by rmk")
|
(* ; "Edited 24-May-2022 15:49 by rmk")
|
||||||
(* ; "Edited 25-Apr-2022 09:24 by rmk")
|
(* ; "Edited 25-Apr-2022 09:24 by rmk")
|
||||||
@@ -2182,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))
|
||||||
@@ -2192,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? "
|
||||||
]
|
]
|
||||||
@@ -2200,8 +2214,10 @@
|
|||||||
(CL:UNLESS DESTFILE
|
(CL:UNLESS DESTFILE
|
||||||
(SETQ DESTFILE (CD-SWAPDIRS SOURCEFILE SOURCEDIR DESTDIR)))
|
(SETQ DESTFILE (CD-SWAPDIRS SOURCEFILE SOURCEDIR DESTDIR)))
|
||||||
[SETQ RESULT (if UNIXDEST
|
[SETQ RESULT (if UNIXDEST
|
||||||
then (SPUTMULTI (fetch (TABLEBROWSER TBUSERDATA) of CDBROWSER)
|
then (CL:WHEN (INFILEP DESTFILE)
|
||||||
'ORIGINALFILES DESTFILE (COPYFILE DESTFILE '{NODIRCORE))
|
(SPUTMULTI (fetch (TABLEBROWSER TBUSERDATA) of CDBROWSER)
|
||||||
|
'ORIGINALFILES DESTFILE (COPYFILE DESTFILE
|
||||||
|
'{NODIRCORE})))
|
||||||
[PSEUDOFILENAME (PACKFILENAME 'HOST 'DSK 'BODY
|
[PSEUDOFILENAME (PACKFILENAME 'HOST 'DSK 'BODY
|
||||||
(COPYFILE SOURCEFILE (PACKFILENAME
|
(COPYFILE SOURCEFILE (PACKFILENAME
|
||||||
'HOST
|
'HOST
|
||||||
@@ -2321,25 +2337,25 @@
|
|||||||
|
|
||||||
(MOVD? 'NILL 'TEDIT.FILEDATE)
|
(MOVD? 'NILL 'TEDIT.FILEDATE)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (2668 23647 (COMPAREDIRECTORIES 2678 . 8013) (COMPAREDIRECTORIES.INFOS 8015 . 11244) (
|
(FILEMAP (NIL (2683 23662 (COMPAREDIRECTORIES 2693 . 8028) (COMPAREDIRECTORIES.INFOS 8030 . 11259) (
|
||||||
COMPAREDIRECTORIES.CANDIDATES 11246 . 14631) (CDENTRIES.SELECT 14633 . 19535) (
|
COMPAREDIRECTORIES.CANDIDATES 11261 . 14646) (CDENTRIES.SELECT 14648 . 19550) (
|
||||||
COMPAREDIRECTORIES.INFOS.TYPE 19537 . 20881) (MATCHNAME 20883 . 21563) (CD.INSURECDVALUE 21565 . 23179
|
COMPAREDIRECTORIES.INFOS.TYPE 19552 . 20896) (MATCHNAME 20898 . 21578) (CD.INSURECDVALUE 21580 . 23194
|
||||||
) (CD.UPDATEWIDTHS 23181 . 23645)) (23648 34353 (CDFILES 23658 . 29755) (CDFILES.MATCH 29757 . 31382)
|
) (CD.UPDATEWIDTHS 23196 . 23660)) (23663 34971 (CDFILES 23673 . 29770) (CDFILES.MATCH 29772 . 31782)
|
||||||
(CDFILES.PATS 31384 . 34351)) (34354 52372 (CDPRINT 34364 . 36881) (CDPRINT.HEADER 36883 . 37780) (
|
(CDFILES.PATS 31784 . 34969)) (34972 52990 (CDPRINT 34982 . 37499) (CDPRINT.HEADER 37501 . 38398) (
|
||||||
CDPRINT.LINE 37782 . 41211) (CDPRINT.MAXWIDTHS 41213 . 45328) (CDPRINT.COLHEADERS 45330 . 46615) (
|
CDPRINT.LINE 38400 . 41829) (CDPRINT.MAXWIDTHS 41831 . 45946) (CDPRINT.COLHEADERS 45948 . 47233) (
|
||||||
CDPRINT.COLUMNS 46617 . 51737) (CDTEDIT 51739 . 52370)) (52373 61494 (CDMAP 52383 . 53815) (CDENTRY
|
CDPRINT.COLUMNS 47235 . 52355) (CDTEDIT 52357 . 52988)) (52991 62112 (CDMAP 53001 . 54433) (CDENTRY
|
||||||
53817 . 54126) (CDSUBSET 54128 . 55567) (CDMERGE 55569 . 59553) (CDMERGE.COMMON 59555 . 60870) (
|
54435 . 54744) (CDSUBSET 54746 . 56185) (CDMERGE 56187 . 60171) (CDMERGE.COMMON 60173 . 61488) (
|
||||||
CD.SORT 60872 . 61492)) (61495 69033 (BINCOMP 61505 . 65794) (EOLTYPE 65796 . 68358) (EOLTYPE.SHOW
|
CD.SORT 61490 . 62110)) (62113 69651 (BINCOMP 62123 . 66412) (EOLTYPE 66414 . 68976) (EOLTYPE.SHOW
|
||||||
68360 . 69031)) (69561 82088 (FIND-UNCOMPILED-FILES 69571 . 73214) (FIND-UNSOURCED-FILES 73216 . 75600
|
68978 . 69649)) (70179 82706 (FIND-UNCOMPILED-FILES 70189 . 73832) (FIND-UNSOURCED-FILES 73834 . 76218
|
||||||
) (FIND-SOURCE-FILES 75602 . 77340) (FIND-COMPILED-FILES 77342 . 79219) (FIND-UNLOADED-FILES 79221 .
|
) (FIND-SOURCE-FILES 76220 . 77958) (FIND-COMPILED-FILES 77960 . 79837) (FIND-UNLOADED-FILES 79839 .
|
||||||
80074) (FIND-LOADED-FILES 80076 . 80504) (FIND-MULTICOMPILED-FILES 80506 . 82086)) (82089 90520 (
|
80692) (FIND-LOADED-FILES 80694 . 81122) (FIND-MULTICOMPILED-FILES 81124 . 82704)) (82707 91138 (
|
||||||
CREATED-AS 82099 . 86896) (SOURCE-FOR-COMPILED-P 86898 . 89825) (COMPILE-SOURCE-DATE-DIFF 89827 .
|
CREATED-AS 82717 . 87514) (SOURCE-FOR-COMPILED-P 87516 . 90443) (COMPILE-SOURCE-DATE-DIFF 90445 .
|
||||||
90518)) (90521 101284 (FIX-DIRECTORY-DATES 90531 . 93981) (FIX-EQUIV-DATES 93983 . 95508) (
|
91136)) (91139 101902 (FIX-DIRECTORY-DATES 91149 . 94599) (FIX-EQUIV-DATES 94601 . 96126) (
|
||||||
COPY-COMPARED-FILES 95510 . 97331) (COPY-MISSING-FILES 97333 . 99490) (COMPILED-ON-SAME-SOURCE 99492
|
COPY-COMPARED-FILES 96128 . 97949) (COPY-MISSING-FILES 97951 . 100108) (COMPILED-ON-SAME-SOURCE 100110
|
||||||
. 101282)) (101478 109356 (CDBROWSER 101488 . 105455) (CDBROWSER.STRINGS 105457 . 109354)) (109518
|
. 101900)) (102096 109974 (CDBROWSER 102106 . 106073) (CDBROWSER.STRINGS 106075 . 109972)) (110136
|
||||||
111254 (CD.TABLEITEM 109528 . 109748) (CD.TABLEITEM.PRINTFN 109750 . 109949) (CD.TABLEITEM.COPYFN
|
111872 (CD.TABLEITEM 110146 . 110366) (CD.TABLEITEM.PRINTFN 110368 . 110567) (CD.TABLEITEM.COPYFN
|
||||||
109951 . 111009) (CDTABLEBROWSER.HEADING.REPAINTFN 111011 . 111252)) (111255 138020 (
|
110569 . 111627) (CDTABLEBROWSER.HEADING.REPAINTFN 111629 . 111870)) (111873 139210 (
|
||||||
CDTABLEBROWSER.WHENSELECTEDFN 111265 . 111733) (CD.COMMANDSELECTEDFN 111735 . 117908) (CD-MENUFN
|
CDTABLEBROWSER.WHENSELECTEDFN 111883 . 112351) (CD.COMMANDSELECTEDFN 112353 . 118526) (CD-MENUFN
|
||||||
117910 . 124301) (CD-COMPARE-FILES 124303 . 127830) (CDBROWSER-COPY 127832 . 132894) (
|
118528 . 125005) (CD-COMPARE-FILES 125007 . 128534) (CDBROWSER-COPY 128536 . 134084) (
|
||||||
CDBROWSER-DELETE-FILE 132896 . 137499) (CD-SWAPDIRS 137501 . 138018)))))
|
CDBROWSER-DELETE-FILE 134086 . 138689) (CD-SWAPDIRS 138691 . 139208)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
Binary file not shown.
52
lispusers/CONVERT-TO-UTF8
Normal file
52
lispusers/CONVERT-TO-UTF8
Normal file
@@ -0,0 +1,52 @@
|
|||||||
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
|
(FILECREATED "25-Feb-2026 09:09:57" {WMEDLEY}<lispusers>CONVERT-TO-UTF8.;16 2573
|
||||||
|
|
||||||
|
:EDIT-BY rmk
|
||||||
|
|
||||||
|
:CHANGES-TO (FNS CONVERT-TO-UTF8)
|
||||||
|
|
||||||
|
:PREVIOUS-DATE "24-Feb-2026 22:45:57" {WMEDLEY}<lispusers>CONVERT-TO-UTF8.;14)
|
||||||
|
|
||||||
|
|
||||||
|
(PRETTYCOMPRINT CONVERT-TO-UTF8COMS)
|
||||||
|
|
||||||
|
(RPAQQ CONVERT-TO-UTF8COMS ((FNS CONVERT-TO-UTF8)))
|
||||||
|
(DEFINEQ
|
||||||
|
|
||||||
|
(CONVERT-TO-UTF8
|
||||||
|
[LAMBDA (FILENAME FILETYPE) (* ; "Edited 25-Feb-2026 09:09 by rmk")
|
||||||
|
|
||||||
|
(* ;; "This produces a new version of the source FILENAME with :UTF-8 external format.")
|
||||||
|
|
||||||
|
(* ;; "If we had a list of problematic functions (multiple definitions on multiple files, MOVD's), we could check that against the functions in FILENAME, and at least produce a warning.")
|
||||||
|
|
||||||
|
(* ;; "Compiling may be tricky: some files have CL:COMPILE-FILE FILETYPE properties that don't correspond to the fact that they actually have only an LCOM. This tries to revert the filetype back to FAKE-COMPILE-FILE so that we don't get confused when a DFASL mysteriously appears.")
|
||||||
|
|
||||||
|
(SETQ FILENAME (PSEUDOFILENAME FILENAME))
|
||||||
|
(SETQ FILENAME (OR (FINDFILE FILENAME T)
|
||||||
|
(ERROR "FILE NOT FOUND" FILENAME)))
|
||||||
|
(if [EQ :UTF-8 (CL:WITH-OPEN-FILE (STREAM FILENAME :DIRECTION :INPUT)
|
||||||
|
(fetch (READER-ENVIRONMENT REFORMAT) of (GET-ENVIRONMENT-AND-FILEMAP STREAM
|
||||||
|
T]
|
||||||
|
then (PRINTOUT T FILENAME " is already " .P2 :UTF-8 T)
|
||||||
|
NIL
|
||||||
|
else (LOAD? (MEDLEYDIR "loadups" 'EXPORTS.ALL)) (* ; "Maybe this should load SYSEDIT ?")
|
||||||
|
(LOAD FILENAME 'PROP)
|
||||||
|
(LOADCOMP FILENAME)
|
||||||
|
(SETQ FILENAME (PACKFILENAME 'VERSION NIL 'BODY FILENAME))
|
||||||
|
(CL:WHEN [AND (EQ 'CL:COMPILE-FILE (GETPROP (ROOTFILENAME FILENAME)
|
||||||
|
'FILETYPE))
|
||||||
|
(FINDFILE (PACKFILENAME 'EXTENSION 'LCOM 'BODY FILENAME))
|
||||||
|
(NOT (FINDFILE (PACKFILENAME 'EXTENSION 'DFASL 'BODY FILENAME]
|
||||||
|
(CL:UNLESS FILETYPE (SETQ FILETYPE :FAKE-COMPILE-FILE))
|
||||||
|
(PRINTOUT T "Changing FILETYPE back to " .P2 FILETYPE T)
|
||||||
|
(PUTPROP (ROOTFILENAME FILENAME)
|
||||||
|
'FILETYPE FILETYPE))
|
||||||
|
[SETQ FILENAME (MAKEFILE FILENAME '(NEW :UTF-8]
|
||||||
|
(MAKEFILE1 FILENAME NIL '(F))
|
||||||
|
FILENAME])
|
||||||
|
)
|
||||||
|
(DECLARE%: DONTCOPY
|
||||||
|
(FILEMAP (NIL (406 2550 (CONVERT-TO-UTF8 416 . 2548)))))
|
||||||
|
STOP
|
||||||
BIN
lispusers/CONVERT-TO-UTF8.LCOM
Normal file
BIN
lispusers/CONVERT-TO-UTF8.LCOM
Normal file
Binary file not shown.
BIN
lispusers/CONVERT-TO-UTF8.TEDIT
Normal file
BIN
lispusers/CONVERT-TO-UTF8.TEDIT
Normal file
Binary file not shown.
116
lispusers/CROCK
116
lispusers/CROCK
@@ -1,43 +1,43 @@
|
|||||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
(FILECREATED " 2-Apr-87 00:37:46" {ERIS}<LISPUSERS>LYRIC>CROCK.;2 17791
|
|
||||||
|
|
||||||
previous date%: "11-Jan-86 19:46:27" {PHYLUM}<LISPUSERS>LYRIC>CROCK.;1)
|
(FILECREATED "18-Feb-2026 16:26:31" {WMEDLEY}<lispusers>CROCK.;2 17189
|
||||||
|
|
||||||
|
:EDIT-BY rmk
|
||||||
|
|
||||||
|
:PREVIOUS-DATE " 2-Apr-87 00:37:46" {WMEDLEY}<lispusers>CROCK.;1)
|
||||||
|
|
||||||
(* "
|
|
||||||
Copyright (c) 1984, 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
|
|
||||||
")
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT CROCKCOMS)
|
(PRETTYCOMPRINT CROCKCOMS)
|
||||||
|
|
||||||
(RPAQQ CROCKCOMS ((* CROCK -- By Kelly Roach *)
|
(RPAQQ CROCKCOMS
|
||||||
(FNS CROCK CROCK.BUTTONEVENTFN CROCK.CHANGE.STYLE CROCK.CLOSEFN CROCK.PROCESS
|
((* CROCK -- By Kelly Roach *)
|
||||||
CROCK.RESHAPEFN CROCK.ALARM CROCK.RING.ALARM CROCK.INIT)
|
(FNS CROCK CROCK.BUTTONEVENTFN CROCK.CHANGE.STYLE CROCK.CLOSEFN CROCK.PROCESS CROCK.RESHAPEFN
|
||||||
(INITVARS (CROCK.DEFAULT.STYLE '(HANDS T TIMES NIL RINGS NIL NUMBERS T))
|
CROCK.ALARM CROCK.RING.ALARM CROCK.INIT)
|
||||||
(CROCK.STYLE.MENU)
|
(INITVARS (CROCK.DEFAULT.STYLE '(HANDS T TIMES NIL RINGS NIL NUMBERS T))
|
||||||
(CROCK.ALARMS)
|
(CROCK.STYLE.MENU)
|
||||||
(CROCK.DATEFORMAT '(DATEFORMAT NO.SECONDS))
|
(CROCK.ALARMS)
|
||||||
[CROCK.TUNE '((1000 . 1000)
|
(CROCK.DATEFORMAT '(DATEFORMAT NO.SECONDS))
|
||||||
(800 . 1000)
|
[CROCK.TUNE '((1000 . 1000)
|
||||||
(600 . 1000)
|
(800 . 1000)
|
||||||
(500 . 1000)
|
(600 . 1000)
|
||||||
(400 . 1000)
|
(500 . 1000)
|
||||||
(NIL . 500)
|
(400 . 1000)
|
||||||
(440 . 1000)
|
(NIL . 500)
|
||||||
(484 . 1000)
|
(440 . 1000)
|
||||||
(540 . 1000)
|
(484 . 1000)
|
||||||
(600 . 1000)
|
(540 . 1000)
|
||||||
(2000 . 1000)
|
(600 . 1000)
|
||||||
(1600 . 1000)
|
(2000 . 1000)
|
||||||
(1200 . 1000)
|
(1600 . 1000)
|
||||||
(1000 . 1000)
|
(1200 . 1000)
|
||||||
(800 . 1000)
|
(1000 . 1000)
|
||||||
(NIL . 500)
|
(800 . 1000)
|
||||||
(880 . 1000)
|
(NIL . 500)
|
||||||
(968 . 1000)
|
(880 . 1000)
|
||||||
(1080 . 1000)
|
(968 . 1000)
|
||||||
(1188 . 1000]
|
(1080 . 1000)
|
||||||
(CROCKWINDOW))))
|
(1188 . 1000]
|
||||||
|
(CROCKWINDOW))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -334,31 +334,31 @@ Copyright (c) 1984, 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
|
|||||||
|
|
||||||
(RPAQ? CROCK.DATEFORMAT '(DATEFORMAT NO.SECONDS))
|
(RPAQ? CROCK.DATEFORMAT '(DATEFORMAT NO.SECONDS))
|
||||||
|
|
||||||
(RPAQ? CROCK.TUNE '((1000 . 1000)
|
(RPAQ? CROCK.TUNE
|
||||||
(800 . 1000)
|
'((1000 . 1000)
|
||||||
(600 . 1000)
|
(800 . 1000)
|
||||||
(500 . 1000)
|
(600 . 1000)
|
||||||
(400 . 1000)
|
(500 . 1000)
|
||||||
(NIL . 500)
|
(400 . 1000)
|
||||||
(440 . 1000)
|
(NIL . 500)
|
||||||
(484 . 1000)
|
(440 . 1000)
|
||||||
(540 . 1000)
|
(484 . 1000)
|
||||||
(600 . 1000)
|
(540 . 1000)
|
||||||
(2000 . 1000)
|
(600 . 1000)
|
||||||
(1600 . 1000)
|
(2000 . 1000)
|
||||||
(1200 . 1000)
|
(1600 . 1000)
|
||||||
(1000 . 1000)
|
(1200 . 1000)
|
||||||
(800 . 1000)
|
(1000 . 1000)
|
||||||
(NIL . 500)
|
(800 . 1000)
|
||||||
(880 . 1000)
|
(NIL . 500)
|
||||||
(968 . 1000)
|
(880 . 1000)
|
||||||
(1080 . 1000)
|
(968 . 1000)
|
||||||
(1188 . 1000)))
|
(1080 . 1000)
|
||||||
|
(1188 . 1000)))
|
||||||
|
|
||||||
(RPAQ? CROCKWINDOW )
|
(RPAQ? CROCKWINDOW )
|
||||||
(PUTPROPS CROCK COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987))
|
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (1940 16814 (CROCK 1950 . 2520) (CROCK.BUTTONEVENTFN 2522 . 2811) (CROCK.CHANGE.STYLE
|
(FILEMAP (NIL (1609 16483 (CROCK 1619 . 2189) (CROCK.BUTTONEVENTFN 2191 . 2480) (CROCK.CHANGE.STYLE
|
||||||
2813 . 5626) (CROCK.CLOSEFN 5628 . 5790) (CROCK.PROCESS 5792 . 14290) (CROCK.RESHAPEFN 14292 . 14451)
|
2482 . 5295) (CROCK.CLOSEFN 5297 . 5459) (CROCK.PROCESS 5461 . 13959) (CROCK.RESHAPEFN 13961 . 14120)
|
||||||
(CROCK.ALARM 14453 . 15681) (CROCK.RING.ALARM 15683 . 16424) (CROCK.INIT 16426 . 16812)))))
|
(CROCK.ALARM 14122 . 15350) (CROCK.RING.ALARM 15352 . 16093) (CROCK.INIT 16095 . 16481)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user