Compare commits
1 Commits
rmk164--Up
...
mth63--Mis
| Author | SHA1 | Date | |
|---|---|---|---|
|
a8a0313bd9 |
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 1-Feb-2026 13:41:02" {WMEDLEY}<greetfiles>APPS-INIT.;11 22926
|
||||
(FILECREATED "26-Nov-2025 12:30:08" {DSK}<Users>larry>il>MEDLEY>GREETFILES>APPS-INIT.;2 23361
|
||||
|
||||
:EDIT-BY rmk
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (FNS XCL-USER::EXEC¬INTERLISP)
|
||||
:CHANGES-TO (FNS Apps.CreateButtons)
|
||||
|
||||
:PREVIOUS-DATE " 1-Feb-2026 07:58:14" {WMEDLEY}<greetfiles>APPS-INIT.;9)
|
||||
:PREVIOUS-DATE "25-Feb-2024 13:56:23" {DSK}<Users>larry>il>MEDLEY>GREETFILES>APPS-INIT.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT APPS-INITCOMS)
|
||||
@@ -19,7 +19,7 @@
|
||||
(Apps.RoomsActivated NIL))
|
||||
(FNS Apps.InitNotecards Apps.SetUpNOTECARDSDIRECTORIES Apps.DoInit Apps.CreateButtons
|
||||
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%: FIRST DONTEVAL@LOAD DOCOPY (P (BKSYSBUF " "])
|
||||
|
||||
@@ -35,53 +35,52 @@
|
||||
(RPAQ? Apps.RoomsActivated NIL)
|
||||
(DEFINEQ
|
||||
|
||||
(Apps.InitNotecards
|
||||
(Apps.InitNotecards
|
||||
[LAMBDA (DoNotRefreshButtons)
|
||||
(DECLARE (GLOBALVARS BackgroundMenuCommands BackgroundMenu))
|
||||
(* ; "Edited 1-Feb-2026 00:00 by rmk")
|
||||
(* ; "Edited 19-Jan-2023 11:57 by FGH")
|
||||
(* ; "Edited 7-Dec-2022 11:14 by FGH")
|
||||
(* ; "Edited 12-Nov-2022 14:41 by FGH")
|
||||
(* ; "Edited 11-Sep-2022 01:09 by fgh")
|
||||
(* ; "Edited 7-Feb-2022 20:22 by tp7")
|
||||
(DECLARE (GLOBALVARS BackgroundMenuCommands BackgroundMenu))
|
||||
(* ; "Edited 19-Jan-2023 11:57 by FGH")
|
||||
(* ; "Edited 7-Dec-2022 11:14 by FGH")
|
||||
(* ; "Edited 12-Nov-2022 14:41 by FGH")
|
||||
(* ; "Edited 11-Sep-2022 01:09 by fgh")
|
||||
(* ; "Edited 7-Feb-2022 20:22 by tp7")
|
||||
(LET* [[SRCDIR (OR (UNIX-GETENV 'NOTEFILESSRC)
|
||||
(AND (UNIX-GETENV 'NC¬INSTALLDIR)
|
||||
(CONCAT (UNIX-GETENV 'NC¬INSTALLDIR)
|
||||
(AND (UNIX-GETENV 'NC_INSTALLDIR)
|
||||
(CONCAT (UNIX-GETENV 'NC_INSTALLDIR)
|
||||
"/notefiles"))
|
||||
(LET ((SUBDIR "notecards/notefiles"))
|
||||
(for DIR in (LIST (CONCAT (MEDLEYDIR)
|
||||
(for DIR in (LIST (CONCAT (MEDLEYDIR)
|
||||
SUBDIR)
|
||||
(CONCAT (MEDLEYDIR)
|
||||
"../" SUBDIR)
|
||||
(CONCAT (MEDLEYDIR)
|
||||
"../../" SUBDIR)) thereis (DIRECTORYNAME DIR]
|
||||
"../../" SUBDIR)) thereis (DIRECTORYNAME DIR]
|
||||
(DESTDIR (OR (UNIX-GETENV 'NOTEFILESDIR)
|
||||
(AND (UNIX-GETENV 'MEDLEY¬USERDIR)
|
||||
(CONCAT (UNIX-GETENV 'MEDLEY¬USERDIR)
|
||||
(AND (UNIX-GETENV 'MEDLEY_USERDIR)
|
||||
(CONCAT (UNIX-GETENV 'MEDLEY_USERDIR)
|
||||
"/notefiles"))
|
||||
(CONCAT LOGINDIR "notefiles"]
|
||||
[if (AND (NOT (DIRECTORYNAME DESTDIR))
|
||||
[if (AND (NOT (DIRECTORYNAME DESTDIR))
|
||||
(DIRECTORYNAME SRCDIR))
|
||||
then (for NF in (DIRECTORY (CONCAT SRCDIR "/*"))
|
||||
do (COPYFILE NF (PACKFILENAME 'HOST "DSK" 'DIRECTORY DESTDIR 'NAME
|
||||
then (for NF in (DIRECTORY (CONCAT SRCDIR "/*"))
|
||||
do (COPYFILE NF (PACKFILENAME 'HOST "DSK" 'DIRECTORY DESTDIR 'NAME
|
||||
(FILENAMEFIELD NF 'NAME)
|
||||
'EXTENSION
|
||||
(FILENAMEFIELD NF 'EXTENSION)
|
||||
'VERSION
|
||||
(FILENAMEFIELD NF 'VERSION]
|
||||
(LET* ((PW-REGION (WINDOWPROP PROMPTWINDOW 'REGION))
|
||||
(LEFT (IPLUS (fetch (REGION RIGHT) of PW-REGION)
|
||||
(LEFT (IPLUS (fetch (REGION RIGHT) of PW-REGION)
|
||||
20))
|
||||
(BOTTOM (fetch (REGION BOTTOM) of PW-REGION)))
|
||||
(NC.BringUpNoteCardsIcon (create POSITION
|
||||
(BOTTOM (fetch (REGION BOTTOM) of PW-REGION)))
|
||||
(NC.BringUpNoteCardsIcon (create POSITION
|
||||
XCOORD _ LEFT
|
||||
YCOORD _ BOTTOM)))
|
||||
(NC.FileBrowserMenu NC.NoteCardsIconWindow (PACKFILENAME 'HOST "DSK" 'DIRECTORY DESTDIR
|
||||
'NAME "*" 'EXTENSION "notefile")
|
||||
(CREATEREGION 50 (IDIFFERENCE SCREENHEIGHT 700)
|
||||
550 220))
|
||||
(if (NULL (SASSOC 'NoteCards BackgroundMenuCommands))
|
||||
then (PROGN [SETQ BackgroundMenuCommands (APPEND BackgroundMenuCommands
|
||||
(if (NULL (SASSOC 'NoteCards BackgroundMenuCommands))
|
||||
then (PROGN [SETQ BackgroundMenuCommands (APPEND BackgroundMenuCommands
|
||||
(LIST '(NoteCards (
|
||||
NC.BringUpNoteCardsIcon
|
||||
)
|
||||
@@ -90,61 +89,59 @@
|
||||
]
|
||||
(SETQ BackgroundMenu NIL)))
|
||||
(SETQ Apps.NotecardsActivated T)
|
||||
(if (NOT DoNotRefreshButtons)
|
||||
then (Apps.CreateButtons])
|
||||
(if (NOT DoNotRefreshButtons)
|
||||
then (Apps.CreateButtons])
|
||||
|
||||
(Apps.SetUpNOTECARDSDIRECTORIES
|
||||
(Apps.SetUpNOTECARDSDIRECTORIES
|
||||
[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>"))
|
||||
(LOC2 (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"))
|
||||
(INFILEP (CONCAT LOC
|
||||
"system>NOTECARDS.LCOM"
|
||||
]
|
||||
(if NCDIR
|
||||
then [SETQ NCDIR (OR (INFILEP (CONCAT NCDIR "system>NOTECARDS"))
|
||||
(if NCDIR
|
||||
then [SETQ NCDIR (OR (INFILEP (CONCAT NCDIR "system>NOTECARDS"))
|
||||
(INFILEP (CONCAT NCDIR "system>NOTECARDS.LCOM"]
|
||||
(SETQ NCDIR (SUBSTRING NCDIR 1 (IDIFFERENCE (STRPOS "system>NOTECARDS" NCDIR)
|
||||
1)))
|
||||
(NC.SetUpNOTECARDSDIRECTORIES NCDIR)
|
||||
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 "and Notecards will not work properly." T)
|
||||
NIL])
|
||||
|
||||
(Apps.DoInit
|
||||
(Apps.DoInit
|
||||
[LAMBDA NIL
|
||||
|
||||
(* ;; "Edited 31-Jan-2026 23:57 by rmk")
|
||||
(* ;; "Edited 19-Jan-2023 12:43 by FGH")
|
||||
|
||||
(* ;; "Edited 19-Jan-2023 12:43 by FGH")
|
||||
(* ;; "Edited 17-Jan-2023 23:23 by FGH")
|
||||
|
||||
(* ;; "Edited 17-Jan-2023 23:23 by FGH")
|
||||
(* ;; "Edited 7-Dec-2022 11:14 by FGH")
|
||||
|
||||
(* ;; "Edited 7-Dec-2022 11:14 by FGH")
|
||||
(* ;; "Edited 12-Nov-2022 13:57 by FGH")
|
||||
|
||||
(* ;; "Edited 12-Nov-2022 13:57 by FGH")
|
||||
(* ;; "Edited 12-Oct-2022 20:23 by fgh")
|
||||
|
||||
(* ;; "Edited 12-Oct-2022 20:23 by fgh")
|
||||
(* ;; "Edited 6-Sep-2022 17:22 by fgh")
|
||||
|
||||
(* ;; "Edited 6-Sep-2022 17:22 by fgh")
|
||||
(* ;; "Edited 4-Sep-2022 16:44 by larry")
|
||||
|
||||
(* ;; "Edited 4-Sep-2022 16:44 by larry")
|
||||
(* ;; "Edited 18-Mar-2022 18:53 by fgh")
|
||||
|
||||
(* ;; "Edited 18-Mar-2022 18:53 by fgh")
|
||||
|
||||
(* ;; "Edited 17-Dec-2021 22:05 by fgh")
|
||||
(* ;; "Edited 17-Dec-2021 22:05 by fgh")
|
||||
|
||||
(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)
|
||||
(FUNCTION (LAMBDA (W)
|
||||
@@ -155,92 +152,90 @@
|
||||
(IDIFFERENCE SCREENHEIGHT 18)))
|
||||
((STREQUAL (WINDOWPROP W 'TITLE)
|
||||
"Prompt Window")
|
||||
(PROGN (MOVEW W (create POSITION
|
||||
(PROGN (MOVEW W (create POSITION
|
||||
XCOORD _ 50
|
||||
YCOORD _ (IDIFFERENCE SCREENHEIGHT 120)))
|
||||
(CLEARW W)))
|
||||
((STREQUAL (WINDOWPROP W 'TITLE)
|
||||
"Exec (XCL)")
|
||||
(PROGN (WINDOWPROP W 'TITLE "Exec (INTERLISP)")
|
||||
(MOVEW W (create POSITION
|
||||
(MOVEW W (create POSITION
|
||||
XCOORD _ 50
|
||||
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)
|
||||
(UNIX-GETENV 'MEDLEY¬INITIALS]
|
||||
[SETQ INITIALSLST (LIST (LIST USERNAME (UNIX-GETENV 'MEDLEY_FIRSTNAME)
|
||||
(UNIX-GETENV 'MEDLEY_INITIALS]
|
||||
(LOAD '{DSK}/usr/local/interlisp/medley/lispusers/HELPSYS.LCOM T)
|
||||
|
||||
(* ;; "change to interlisp exec if required")
|
||||
(* ;; "change to interlisp exec if required")
|
||||
|
||||
(COND
|
||||
((OR (STRING-EQUAL (UNIX-GETENV 'MEDLEY¬EXEC)
|
||||
((OR (STRING-EQUAL (UNIX-GETENV 'MEDLEY_EXEC)
|
||||
"inter")
|
||||
(STRING-EQUAL (UNIX-GETENV 'NCO)
|
||||
"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
|
||||
((STRING-EQUAL (UNIX-GETENV 'RUN¬NOTECARDS)
|
||||
((STRING-EQUAL (UNIX-GETENV 'RUN_NOTECARDS)
|
||||
"true")
|
||||
(Apps.InitNotecards T)))
|
||||
(Apps.InitNotecards T)))
|
||||
|
||||
(* ;; " activate Rooms if requested")
|
||||
(* ;; " activate Rooms if requested")
|
||||
|
||||
(COND
|
||||
((STRING-EQUAL (UNIX-GETENV 'RUN¬ROOMS)
|
||||
((STRING-EQUAL (UNIX-GETENV 'RUN_ROOMS)
|
||||
"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)
|
||||
|
||||
(* ;; "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)
|
||||
'MEDLEY-INIT-VARS AROUNDEXITFNS])
|
||||
|
||||
(Apps.CreateButtons
|
||||
[LAMBDA (DoDocsToo) (* ; "Edited 31-Jan-2026 23:59 by rmk")
|
||||
(* ; "Edited 26-Nov-2025 12:29 by lmm")
|
||||
(* ; "Edited 13-Dec-2022 12:51 by frank")
|
||||
(* ; "Edited 7-Dec-2022 11:28 by FGH")
|
||||
(* ; "Edited 5-Dec-2022 17:31 by FGH")
|
||||
(* ; "Edited 12-Nov-2022 14:52 by FGH")
|
||||
(Apps.CreateButtons
|
||||
[LAMBDA (DoDocsToo) (* ; "Edited 26-Nov-2025 12:29 by lmm")
|
||||
(* ; "Edited 13-Dec-2022 12:51 by frank")
|
||||
(* ; "Edited 7-Dec-2022 11:28 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")
|
||||
(LIST Apps.RoomsActivated '(Apps.ActivateRooms)
|
||||
(LIST Apps.RoomsActivated '(Apps.ActivateRooms)
|
||||
"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")
|
||||
(LIST "https://primer.interlisp.org/" "PRIMER")
|
||||
(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")
|
||||
(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)
|
||||
(SECTION1YPOS 225)
|
||||
(YPOSDELTA 55)
|
||||
@@ -254,31 +249,31 @@
|
||||
(IWS NIL)
|
||||
(BUTTONS NIL))
|
||||
|
||||
(* ;; "First remove/re-create feature buttons")
|
||||
(* ;; "First remove/re-create feature buttons")
|
||||
|
||||
(for W in (OPENWINDOWS) when (MEMBER (WINDOWPROP W 'ICONLABEL)
|
||||
(LIST "ACTIVATE" "FEATURES")) do (CLOSEW W))
|
||||
(for B in *ALL-BUTTONS* when (AND (EQ (WINDOWPROP B 'Apps.BUTTON)
|
||||
(for W in (OPENWINDOWS) when (MEMBER (WINDOWPROP W 'ICONLABEL)
|
||||
(LIST "ACTIVATE" "FEATURES")) do (CLOSEW W))
|
||||
(for B in *ALL-BUTTONS* when (AND (EQ (WINDOWPROP B 'Apps.BUTTON)
|
||||
'FEATURE)
|
||||
(MEMBER (BUTTON-LABEL B)
|
||||
FEATURES-LABELS)) do (DELETE-BUTTON B))
|
||||
[if FEATURES-REQUIREDP
|
||||
then [SETQ IWS (LIST (Apps.CreateLabel "ACTIVATE" (IDIFFERENCE SCREENWIDTH
|
||||
FEATURES-LABELS)) do (DELETE-BUTTON B))
|
||||
[if FEATURES-REQUIREDP
|
||||
then [SETQ IWS (LIST (Apps.CreateLabel "ACTIVATE" (IDIFFERENCE SCREENWIDTH
|
||||
(IDIFFERENCE RIGHTMARGINISH 50
|
||||
))
|
||||
(IDIFFERENCE SCREENHEIGHT (IDIFFERENCE SECTION2YPOS 20)))
|
||||
(Apps.CreateLabel "FEATURES" (IDIFFERENCE SCREENWIDTH
|
||||
(Apps.CreateLabel "FEATURES" (IDIFFERENCE SCREENWIDTH
|
||||
(IDIFFERENCE RIGHTMARGINISH 50
|
||||
))
|
||||
(IDIFFERENCE SCREENHEIGHT SECTION2YPOS]
|
||||
(SETQ BUTTONS (for FEATURE in FEATURES
|
||||
collect (OR (CAR FEATURE)
|
||||
(SETQ BUTTONS (for FEATURE in FEATURES
|
||||
collect (OR (CAR FEATURE)
|
||||
(LET (B)
|
||||
(SETQ BUTTONY-FEATURES (IPLUS BUTTONY-FEATURES
|
||||
YPOSDELTA))
|
||||
[SETQ B (CREATE-BUTTON (CADR FEATURE)
|
||||
(CADDR FEATURE)
|
||||
(create POSITION
|
||||
(create POSITION
|
||||
XCOORD _ (IDIFFERENCE
|
||||
SCREENWIDTH
|
||||
RIGHTMARGINISH)
|
||||
@@ -289,30 +284,30 @@
|
||||
(WINDOWPROP B 'Apps.BUTTON 'FEATURE)
|
||||
B]
|
||||
|
||||
(* ;; "Then if needed, remove/recreate documentation buttons")
|
||||
(* ;; "Then if needed, remove/recreate documentation buttons")
|
||||
|
||||
(if DoDocsToo
|
||||
then (for W in (OPENWINDOWS) when (MEMBER (WINDOWPROP W 'ICONLABEL)
|
||||
(if DoDocsToo
|
||||
then (for W in (OPENWINDOWS) when (MEMBER (WINDOWPROP W 'ICONLABEL)
|
||||
(LIST "DOCUMENTATION"))
|
||||
do (CLOSEW W))
|
||||
(for B in *ALL-BUTTONS* when (AND (EQ (WINDOWPROP B 'Apps.BUTTON)
|
||||
do (CLOSEW W))
|
||||
(for B in *ALL-BUTTONS* when (AND (EQ (WINDOWPROP B 'Apps.BUTTON)
|
||||
'DOC)
|
||||
(MEMBER (BUTTON-LABEL B)
|
||||
DOCS-LABELS)) do (DELETE-BUTTON B))
|
||||
(SETQ IWS (CONS (Apps.CreateLabel "DOCUMENTATION" (IDIFFERENCE SCREENWIDTH
|
||||
DOCS-LABELS)) do (DELETE-BUTTON B))
|
||||
(SETQ IWS (CONS (Apps.CreateLabel "DOCUMENTATION" (IDIFFERENCE SCREENWIDTH
|
||||
(IDIFFERENCE
|
||||
RIGHTMARGINISH 50)
|
||||
)
|
||||
(IDIFFERENCE SCREENHEIGHT SECTION1YPOS))
|
||||
IWS))
|
||||
(SETQ BUTTONS (APPEND (for DOC in DOCS
|
||||
collect (LET (B)
|
||||
(SETQ BUTTONS (APPEND (for DOC in DOCS
|
||||
collect (LET (B)
|
||||
(SETQ BUTTONY-DOCS (IPLUS BUTTONY-DOCS
|
||||
YPOSDELTA))
|
||||
[SETQ B (CREATE-BUTTON (LIST 'Apps.ShowDoc
|
||||
(CAR DOC))
|
||||
(CADR DOC)
|
||||
(create POSITION
|
||||
(create POSITION
|
||||
XCOORD _
|
||||
(IDIFFERENCE
|
||||
SCREENWIDTH
|
||||
@@ -324,30 +319,30 @@
|
||||
(WINDOWPROP B 'Apps.BUTTON 'DOC)
|
||||
B))
|
||||
BUTTONS)))
|
||||
[for B in BUTTONS do (COND
|
||||
[for B in BUTTONS do (COND
|
||||
((WINDOWP B)
|
||||
(WINDOWPROP B 'RIGHTBUTTONFN 'NILL)
|
||||
(WINDOWPROP B 'BUTTONEVENTFN (FUNCTION (LAMBDA (BUTTON)
|
||||
(if (LASTMOUSESTATE
|
||||
(if (LASTMOUSESTATE
|
||||
(ONLY LEFT))
|
||||
then (EXECUTE-BUTTON
|
||||
then (EXECUTE-BUTTON
|
||||
BUTTON]
|
||||
[for IW in IWS do (COND
|
||||
[for IW in IWS do (COND
|
||||
((WINDOWP IW)
|
||||
(WINDOWPROP IW 'RIGHTBUTTONFN 'NILL]
|
||||
(for B in BUTTONS when (WINDOWP B) collect B])
|
||||
(for B in BUTTONS when (WINDOWP B) collect B])
|
||||
|
||||
(Apps.CreateLabel
|
||||
[LAMBDA (Text CenterX BottomY) (* ; "Edited 5-Dec-2022 16:49 by FGH")
|
||||
(Apps.CreateLabel
|
||||
[LAMBDA (Text CenterX BottomY) (* ; "Edited 5-Dec-2022 16:49 by FGH")
|
||||
(LET* ((DS (DSPCREATE))
|
||||
(FONT (DSPFONT '(HELVETICA 18 BOLD)
|
||||
DS))
|
||||
(SR (STRINGREGION Text DS))
|
||||
(BMW (fetch (REGION WIDTH) of SR))
|
||||
(BMH (IPLUS (fetch (REGION HEIGHT) of SR)
|
||||
(fetch (REGION BOTTOM) of SR)))
|
||||
(BMW (fetch (REGION WIDTH) of SR))
|
||||
(BMH (IPLUS (fetch (REGION HEIGHT) of SR)
|
||||
(fetch (REGION BOTTOM) of SR)))
|
||||
(BM (BITMAPCREATE BMW BMH))
|
||||
(POS (create POSITION
|
||||
(POS (create POSITION
|
||||
XCOORD _ (IDIFFERENCE CenterX (IQUOTIENT BMW 2))
|
||||
YCOORD _ BottomY))
|
||||
IW)
|
||||
@@ -357,12 +352,12 @@
|
||||
(WINDOWPROP IW 'ICONLABEL Text)
|
||||
IW])
|
||||
|
||||
(Apps.ActivateCLOS
|
||||
(Apps.ActivateCLOS
|
||||
[LAMBDA NIL
|
||||
(DECLARE (GLOBALVARS BackgroundMenuCommands BackgroundMenu))
|
||||
(* ; "Edited 12-Nov-2022 14:41 by FGH")
|
||||
(if (NULL (SASSOC "CLOS Browse Class" BackgroundMenuCommands))
|
||||
then (PROGN [SETQ BackgroundMenuCommands
|
||||
(DECLARE (GLOBALVARS BackgroundMenuCommands BackgroundMenu))
|
||||
(* ; "Edited 12-Nov-2022 14:41 by FGH")
|
||||
(if (NULL (SASSOC "CLOS Browse Class" BackgroundMenuCommands))
|
||||
then (PROGN [SETQ BackgroundMenuCommands
|
||||
(APPEND BackgroundMenuCommands
|
||||
(LIST '("CLOS Browse Class" (CLOS-BROWSER::BROWSE-CLASS)
|
||||
"Bring up a class browser."
|
||||
@@ -377,27 +372,27 @@
|
||||
]
|
||||
(SETQ BackgroundMenu NIL])
|
||||
|
||||
(Apps.ActivateRooms
|
||||
(Apps.ActivateRooms
|
||||
[LAMBDA (DoNotRefreshButtons)
|
||||
(DECLARE (GLOBALVARS BackgroundMenuCommands ROOMS:*SUITE-DIRECTORIES*))
|
||||
(* ; "Edited 7-Dec-2022 11:13 by FGH")
|
||||
(* ; "Edited 12-Nov-2022 14:56 by FGH")
|
||||
(if (NULL (SASSOC "Rooms" BackgroundMenuCommands))
|
||||
then (ROOMS:RESET))
|
||||
(SETQ ROOMS:*SUITE-DIRECTORIES* (CONS (CONCAT (UNIX-GETENV 'MEDLEY¬USERDIR)
|
||||
(DECLARE (GLOBALVARS BackgroundMenuCommands ROOMS:*SUITE-DIRECTORIES*))
|
||||
(* ; "Edited 7-Dec-2022 11:13 by FGH")
|
||||
(* ; "Edited 12-Nov-2022 14:56 by FGH")
|
||||
(if (NULL (SASSOC "Rooms" BackgroundMenuCommands))
|
||||
then (ROOMS:RESET))
|
||||
(SETQ ROOMS:*SUITE-DIRECTORIES* (CONS (CONCAT (UNIX-GETENV 'MEDLE_USERDIR)
|
||||
"/suites")
|
||||
ROOMS:*SUITE-DIRECTORIES*))
|
||||
(SETQ Apps.RoomsActivated T)
|
||||
(PROMPTPRINT "
|
||||
ROOMS functionality is now available via the Background Menu")
|
||||
(if (NOT DoNotRefreshButtons)
|
||||
then (Apps.CreateButtons])
|
||||
(if (NOT DoNotRefreshButtons)
|
||||
then (Apps.CreateButtons])
|
||||
|
||||
(Apps.ShowDoc
|
||||
[LAMBDA (URL) (* ; "Edited 18-Jan-2023 20:26 by FGH")
|
||||
(Apps.ShowDoc
|
||||
[LAMBDA (URL) (* ; "Edited 18-Jan-2023 20:26 by FGH")
|
||||
(ShellBrowse URL])
|
||||
|
||||
(XCL-USER::EXEC¬INTERLISP
|
||||
(XCL-USER::EXEC_INTERLISP
|
||||
[LAMBDA NIL (* ; "Edited 18-Mar-2022 18:53 by fgh")
|
||||
(PROGN [MAPC (OPENWINDOWS)
|
||||
(FUNCTION (LAMBDA (W)
|
||||
@@ -411,10 +406,10 @@
|
||||
(XCL:SET-DEFAULT-EXEC-TYPE 'INTERLISP)
|
||||
(XCL:SET-EXEC-TYPE 'INTERLISP])
|
||||
|
||||
(Apps.AroundExitFn
|
||||
(Apps.AroundExitFn
|
||||
[LAMBDA (EVENT)
|
||||
(if (MEMB EVENT '(AFTERLOGOUT AFTERSYSOUT AFTERSAVEVM))
|
||||
then (Apps.SetUpNOTECARDSDIRECTORIES])
|
||||
(if (MEMB EVENT '(AFTERLOGOUT AFTERSYSOUT AFTERSAVEVM))
|
||||
then (Apps.SetUpNOTECARDSDIRECTORIES])
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
@@ -425,8 +420,8 @@
|
||||
(BKSYSBUF " ")
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1153 22792 (Apps.InitNotecards 1163 . 5006) (Apps.SetUpNOTECARDSDIRECTORIES 5008 . 6527
|
||||
) (Apps.DoInit 6529 . 10067) (Apps.CreateButtons 10069 . 18820) (Apps.CreateLabel 18822 . 19592) (
|
||||
Apps.ActivateCLOS 19594 . 20919) (Apps.ActivateRooms 20921 . 21730) (Apps.ShowDoc 21732 . 21871) (
|
||||
XCL-USER::EXEC¬INTERLISP 21873 . 22645) (Apps.AroundExitFn 22647 . 22790)))))
|
||||
(FILEMAP (NIL (1184 23227 (Apps.InitNotecards 1194 . 5056) (Apps.SetUpNOTECARDSDIRECTORIES 5058 . 6613
|
||||
) (Apps.DoInit 6615 . 10212) (Apps.CreateButtons 10214 . 19123) (Apps.CreateLabel 19125 . 19935) (
|
||||
Apps.ActivateCLOS 19937 . 21286) (Apps.ActivateRooms 21288 . 22139) (Apps.ShowDoc 22141 . 22290) (
|
||||
XCL-USER::EXEC_INTERLISP 22292 . 23064) (Apps.AroundExitFn 23066 . 23225)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 1-Feb-2026 13:45:36" {WMEDLEY}<internal>loadups>LOADUP-APPS.;3 3343
|
||||
(FILECREATED " 9-Mar-2025 20:03:27" {DSK}<home>frank>il>medley>internal>loadups>LOADUP-APPS.;10 3274
|
||||
|
||||
:EDIT-BY rmk
|
||||
:EDIT-BY "frank"
|
||||
|
||||
:CHANGES-TO (FNS LOADUP-APPS)
|
||||
|
||||
:PREVIOUS-DATE " 9-Mar-2025 20:03:27" {WMEDLEY}<internal>loadups>LOADUP-APPS.;2)
|
||||
:PREVIOUS-DATE " 9-Mar-2025 19:42:36" {DSK}<home>frank>il>medley>internal>loadups>LOADUP-APPS.;8
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-APPSCOMS)
|
||||
@@ -20,8 +21,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(LOADUP-APPS
|
||||
[LAMBDA NIL (* ; "Edited 1-Feb-2026 13:45 by rmk")
|
||||
(* ; "Edited 9-Mar-2025 20:02 by frank")
|
||||
[LAMBDA NIL (* ; "Edited 9-Mar-2025 20:02 by frank")
|
||||
(* ; "Edited 2-Jan-2025 20:38 by lmm")
|
||||
(* ; "Edited 2-Jan-2025 06:30 by larry")
|
||||
|
||||
@@ -46,7 +46,7 @@
|
||||
"/system"))
|
||||
NOTECARDS))
|
||||
(Apps.RemoveBackgroundMenuItem 'NoteCards) (* ; "")
|
||||
(PUTASSOC 'NOTECARDS (LIST (UNIX-GETENV 'NOTECARDS¬COMMIT¬ID))
|
||||
(PUTASSOC 'NOTECARDS (LIST (UNIX-GETENV 'NOTECARDS_COMMIT_ID))
|
||||
SYSOUTCOMMITS)
|
||||
|
||||
(* ;; "======================")
|
||||
@@ -78,7 +78,7 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(PUTASSOC 'MEDLEY (LIST (UNIX-GETENV 'LOADUP¬COMMIT¬ID))
|
||||
(PUTASSOC 'MEDLEY (LIST (UNIX-GETENV 'LOADUP_COMMIT_ID))
|
||||
SYSOUTCOMMITS)
|
||||
(PRINTOUT T "commits-- " SYSOUTCOMMITS T])
|
||||
|
||||
@@ -95,5 +95,5 @@
|
||||
Apps.SBG])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (616 3320 (LOADUP-APPS 626 . 2648) (Apps.RemoveBackgroundMenuItem 2650 . 3318)))))
|
||||
(FILEMAP (NIL (656 3251 (LOADUP-APPS 666 . 2579) (Apps.RemoveBackgroundMenuItem 2581 . 3249)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Feb-2026 10:26:39" {WMEDLEY}<internal>loadups>LOADUP-FULL.;36 5858
|
||||
(FILECREATED "28-Dec-2025 12:06:12" {WMEDLEY}<internal>loadups>LOADUP-FULL.;35 5759
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS LOADUP-FULL)
|
||||
|
||||
:PREVIOUS-DATE "28-Dec-2025 12:06:12" {WMEDLEY}<internal>loadups>LOADUP-FULL.;35)
|
||||
:PREVIOUS-DATE "20-Sep-2025 14:18:19" {WMEDLEY}<internal>loadups>LOADUP-FULL.;34)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-FULLCOMS)
|
||||
@@ -47,8 +47,7 @@
|
||||
(PRINTOUT T "FULL fonts loaded" T])
|
||||
|
||||
(LOADUP-FULL
|
||||
[LAMBDA (DRIBBLEFILE) (* ; "Edited 5-Feb-2026 10:26 by rmk")
|
||||
(* ; "Edited 28-Dec-2025 12:06 by rmk")
|
||||
[LAMBDA (DRIBBLEFILE) (* ; "Edited 28-Dec-2025 12:06 by rmk")
|
||||
(* ; "Edited 1-Sep-2025 11:59 by rmk")
|
||||
(* ; "Edited 18-Aug-2025 12:09 by rmk")
|
||||
(* ; "Edited 21-Jun-2025 23:33 by rmk")
|
||||
@@ -85,9 +84,9 @@
|
||||
(* ;; "RMK: 2025: PRESS was after CHAT")
|
||||
|
||||
(LOADUP '(CHAT INTERPRESS TEDIT HRULE TEDIT-CHAT READNUMBER EDITBITMAP FILEBROWSER THINFILES
|
||||
GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT HELPSYS
|
||||
DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE UNIXCOMM UNIXCHAT
|
||||
UNIXYCD))
|
||||
GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT ISO8859IO
|
||||
HELPSYS DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE UNIXCOMM
|
||||
UNIXCHAT UNIXYCD))
|
||||
(COND
|
||||
((WINDOWP *WHO-LINE*)
|
||||
(CLOSEW *WHO-LINE*)))
|
||||
@@ -102,5 +101,5 @@
|
||||
|
||||
(FIXMETA)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (456 5820 (LOADFULLFONTS 466 . 2601) (LOADUP-FULL 2603 . 5570) (FIXMETA 5572 . 5818)))))
|
||||
(FILEMAP (NIL (456 5721 (LOADFULLFONTS 466 . 2601) (LOADUP-FULL 2603 . 5471) (FIXMETA 5473 . 5719)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "16-Feb-2026 13:34:31" {WMEDLEY}<library>MASTERSCOPE.;41 197959
|
||||
(FILECREATED " 8-Feb-2026 19:27:31" {DSK}<Users>larry>il>MEDLEY>LIBRARY>MASTERSCOPE.;3 197425
|
||||
|
||||
:EDIT-BY rmk
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (FNS MSOUTPUT)
|
||||
:CHANGES-TO (FNS BUILDGETRELQ)
|
||||
|
||||
:PREVIOUS-DATE " 8-Feb-2026 22:38:50" {WMEDLEY}<library>MASTERSCOPE.;40)
|
||||
:PREVIOUS-DATE " 8-Feb-2026 18:47:30" {DSK}<Users>larry>il>MEDLEY>LIBRARY>MASTERSCOPE.;2)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MASTERSCOPECOMS)
|
||||
@@ -2566,7 +2566,7 @@
|
||||
(* ; "interactive routines")
|
||||
|
||||
|
||||
(RPAQ MASTERSCOPEDATE "16-Feb-2026")
|
||||
(RPAQ MASTERSCOPEDATE " 8-Feb-2026")
|
||||
|
||||
(ADDTOVAR HISTORYCOMS %.)
|
||||
(DEFINEQ
|
||||
@@ -3498,17 +3498,13 @@
|
||||
(ERROR!])
|
||||
|
||||
(MSOUTPUT
|
||||
[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")
|
||||
[LAMBDA (FILE) (* ; "Edited 5-Apr-2025 11:48 by rmk")
|
||||
(* ; "Edited 14-Jul-2024 08:41 by rmk")
|
||||
(* ; "Edited 5-Jul-2024 11:54 by rmk")
|
||||
(* ; "Edited 12-Jun-90 20:43 by teruuchi")
|
||||
(LET ((LLENGTH FILELINELENGTH))
|
||||
[COND
|
||||
[(AND (LITATOM FILE)
|
||||
((AND (LITATOM FILE)
|
||||
(MEMB (U-CASE FILE)
|
||||
'(TEDIT :TEDIT))
|
||||
(GETD (FUNCTION TEDIT)))
|
||||
@@ -3516,14 +3512,12 @@
|
||||
(* ;;
|
||||
"If no TEDIT, leave the current OUTPUT. The readtable for seprs etc is the current readtable.")
|
||||
|
||||
[SETQ FILE (OPENTEXTSTREAM NIL NIL `(FONT ,DEFAULTFONT BOUNDTABLE ,(
|
||||
TEDIT.ATOMBOUND.READTABLE
|
||||
]
|
||||
[SETQ FILE (TEXTSTREAM (TEDIT NIL 'Masterscope NIL `(LEAVETTY T TITLE Masterscope FONT
|
||||
,DEFAULTFONT BOUNDTABLE
|
||||
,(TEDIT.ATOMBOUND.READTABLE]
|
||||
(SETQ LLENGTH T)
|
||||
(RESETSAVE NIL `(PROGN (CL:UNLESS RESETSTATE
|
||||
(TEDIT ,FILE 'Masterscope NIL
|
||||
'(TITLE Masterscope READONLY QUIET LEAVETTY T)))
|
||||
(CLOSEF? ,FILE]
|
||||
(TEDIT.DEFER.UPDATES FILE '(READONLY QUIET))
|
||||
(RESETSAVE NIL (LIST 'CLOSEF FILE)))
|
||||
((OPENP FILE 'OUTPUT))
|
||||
(T (SETQ FILE (OPENSTREAM FILE 'OUTPUT))
|
||||
(RESETSAVE NIL (LIST 'CLOSEF FILE]
|
||||
@@ -3730,36 +3724,36 @@
|
||||
(ADDTOVAR LAMA MSEDITE MSEDITF)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3260 19507 (UPDATEFN 3270 . 4887) (MSGETDEF 4889 . 6295) (MSNOTICEFILE 6297 . 8690) (
|
||||
MSSHOWUSE 8692 . 14673) (MSUPDATEFN1 14675 . 15363) (MSUPDATE 15365 . 17791) (MSNLAMBDACHECK 17793 .
|
||||
18675) (MSCOLLECTDATA 18677 . 19505)) (19508 20407 (UPDATECHANGED 19518 . 19881) (UPDATECHANGED1 19883
|
||||
. 20405)) (20981 21404 (MSCLOSEFILES 20991 . 21402)) (22085 26517 (MSDESCRIBE 22095 . 24883) (
|
||||
MSDESCRIBE1 24885 . 25948) (FMAPRINT 25950 . 26515)) (26610 27050 (MSPRINTHELPFILE 26620 . 27048)) (
|
||||
27100 30238 (TEMPLATE 27110 . 28531) (GETTEMPLATE 28533 . 28668) (SETTEMPLATE 28670 . 30236)) (31108
|
||||
36032 (ADDTEMPLATEWORD 31118 . 31790) (MSADDANALYZE 31792 . 33290) (MSADDMODIFIER 33292 . 34373) (
|
||||
MSADDRELATION 34375 . 35122) (MSADDTYPE 35124 . 36030)) (37533 42629 (MSMARKCHANGE1 37543 . 38337) (
|
||||
MSINIT 38339 . 39520) (GETVERBTABLES 39522 . 40075) (MSSTOREDATA 40077 . 41631) (STORETABLE 41633 .
|
||||
42627)) (44031 49101 (PARSERELATION 44041 . 44641) (PARSERELATION1 44643 . 46098) (GETRELATION 46100
|
||||
. 47129) (MAPRELATION 47131 . 48265) (TESTRELATION 48267 . 49099)) (49102 50742 (ADDHASH 49112 .
|
||||
49590) (SUBHASH 49592 . 49820) (MAKEHASH 49822 . 49966) (MSREHASH 49968 . 50421) (EQMEMBHASH 50423 .
|
||||
50740)) (51081 57397 (MSVBTABLES 51091 . 56971) (MSUSERVBTABLES 56973 . 57395)) (57480 59783 (
|
||||
BUILDGETRELQ 57490 . 58688) (BUILDTESTRELQ 58690 . 59781)) (59954 60342 (MSERASE 59964 . 60340)) (
|
||||
60343 64803 (DUMPDATABASE 60353 . 62918) (DUMPDATABASE1 62920 . 63265) (READATABASE 63267 . 64801)) (
|
||||
65885 94944 (MSCHECKBLOCKS 65895 . 69715) (MSCHECKBLOCK 69717 . 78337) (MSCHECKFNINBLOCK 78339 . 81339
|
||||
) (MSCHECKBLOCKBASIC 81341 . 83761) (MSCHECKBOUNDFREE 83763 . 85662) (GLOBALVARP 85664 . 85831) (
|
||||
PRINTERROR 85833 . 89049) (MSCHECKVARS1 89051 . 92004) (UNECCSPEC 92006 . 92284) (NECCSPEC 92286 .
|
||||
92633) (SPECVARP 92635 . 93162) (SHORTLST 93164 . 93620) (DOERROR 93622 . 94332) (MSMSGPRINT 94334 .
|
||||
94942)) (96088 110916 (MSPATHS 96098 . 99500) (MSPATHS1 99502 . 103737) (MSPATHS2 103739 . 107149) (
|
||||
MSONPATH 107151 . 108379) (MSPATHS4 108381 . 109463) (DASHES 109465 . 109991) (DOTABS 109993 . 110234)
|
||||
(BELOWMARKER 110236 . 110699) (MSPATHSPRINTFN 110701 . 110914)) (111302 114726 (MSFIND 111312 .
|
||||
111587) (MSEDITF 111589 . 112589) (MSEDITE 112591 . 113628) (EDITGETDEF 113630 . 114724)) (115668
|
||||
124269 (MSMARKCHANGED 115678 . 117402) (CHANGEMACRO 117404 . 118109) (CHANGEVAR 118111 . 118427) (
|
||||
CHANGEI.S. 118429 . 119762) (CHANGERECORD 119764 . 120635) (MSNEEDUNSAVE 120637 . 121629) (UNSAVEFNS
|
||||
121631 . 124267)) (124702 128312 (%. 124712 . 124852) (MASTERSCOPE 124854 . 125380) (MASTERSCOPE1
|
||||
125382 . 126250) (MASTERSCOPEXEC 126252 . 128310)) (128351 168001 (MSINTERPRETSET 128361 . 156895) (
|
||||
MSINTERPA 156897 . 157431) (MSGETBLOCKDEC 157433 . 159946) (LISTHARD 159948 . 161166) (MSMEMBSET
|
||||
161168 . 161313) (MSLISTSET 161315 . 161680) (MSHASHLIST 161682 . 161849) (MSHASHLIST1 161851 . 162177
|
||||
) (CHECKPATHS 162179 . 162819) (ONFILE 162821 . 167999)) (168002 192137 (MSINTERPRET 168012 . 184067)
|
||||
(VERBNOTICELIST 184069 . 185179) (MSOUTPUT 185181 . 187265) (MSCHECKEMPTY 187267 . 188471) (
|
||||
CHECKFORCHANGED 188473 . 188993) (MSSOLVE 188995 . 192135)))))
|
||||
(FILEMAP (NIL (3300 19547 (UPDATEFN 3310 . 4927) (MSGETDEF 4929 . 6335) (MSNOTICEFILE 6337 . 8730) (
|
||||
MSSHOWUSE 8732 . 14713) (MSUPDATEFN1 14715 . 15403) (MSUPDATE 15405 . 17831) (MSNLAMBDACHECK 17833 .
|
||||
18715) (MSCOLLECTDATA 18717 . 19545)) (19548 20447 (UPDATECHANGED 19558 . 19921) (UPDATECHANGED1 19923
|
||||
. 20445)) (21021 21444 (MSCLOSEFILES 21031 . 21442)) (22125 26557 (MSDESCRIBE 22135 . 24923) (
|
||||
MSDESCRIBE1 24925 . 25988) (FMAPRINT 25990 . 26555)) (26650 27090 (MSPRINTHELPFILE 26660 . 27088)) (
|
||||
27140 30278 (TEMPLATE 27150 . 28571) (GETTEMPLATE 28573 . 28708) (SETTEMPLATE 28710 . 30276)) (31148
|
||||
36072 (ADDTEMPLATEWORD 31158 . 31830) (MSADDANALYZE 31832 . 33330) (MSADDMODIFIER 33332 . 34413) (
|
||||
MSADDRELATION 34415 . 35162) (MSADDTYPE 35164 . 36070)) (37573 42669 (MSMARKCHANGE1 37583 . 38377) (
|
||||
MSINIT 38379 . 39560) (GETVERBTABLES 39562 . 40115) (MSSTOREDATA 40117 . 41671) (STORETABLE 41673 .
|
||||
42667)) (44071 49141 (PARSERELATION 44081 . 44681) (PARSERELATION1 44683 . 46138) (GETRELATION 46140
|
||||
. 47169) (MAPRELATION 47171 . 48305) (TESTRELATION 48307 . 49139)) (49142 50782 (ADDHASH 49152 .
|
||||
49630) (SUBHASH 49632 . 49860) (MAKEHASH 49862 . 50006) (MSREHASH 50008 . 50461) (EQMEMBHASH 50463 .
|
||||
50780)) (51121 57437 (MSVBTABLES 51131 . 57011) (MSUSERVBTABLES 57013 . 57435)) (57520 59823 (
|
||||
BUILDGETRELQ 57530 . 58728) (BUILDTESTRELQ 58730 . 59821)) (59994 60382 (MSERASE 60004 . 60380)) (
|
||||
60383 64843 (DUMPDATABASE 60393 . 62958) (DUMPDATABASE1 62960 . 63305) (READATABASE 63307 . 64841)) (
|
||||
65925 94984 (MSCHECKBLOCKS 65935 . 69755) (MSCHECKBLOCK 69757 . 78377) (MSCHECKFNINBLOCK 78379 . 81379
|
||||
) (MSCHECKBLOCKBASIC 81381 . 83801) (MSCHECKBOUNDFREE 83803 . 85702) (GLOBALVARP 85704 . 85871) (
|
||||
PRINTERROR 85873 . 89089) (MSCHECKVARS1 89091 . 92044) (UNECCSPEC 92046 . 92324) (NECCSPEC 92326 .
|
||||
92673) (SPECVARP 92675 . 93202) (SHORTLST 93204 . 93660) (DOERROR 93662 . 94372) (MSMSGPRINT 94374 .
|
||||
94982)) (96128 110956 (MSPATHS 96138 . 99540) (MSPATHS1 99542 . 103777) (MSPATHS2 103779 . 107189) (
|
||||
MSONPATH 107191 . 108419) (MSPATHS4 108421 . 109503) (DASHES 109505 . 110031) (DOTABS 110033 . 110274)
|
||||
(BELOWMARKER 110276 . 110739) (MSPATHSPRINTFN 110741 . 110954)) (111342 114766 (MSFIND 111352 .
|
||||
111627) (MSEDITF 111629 . 112629) (MSEDITE 112631 . 113668) (EDITGETDEF 113670 . 114764)) (115708
|
||||
124309 (MSMARKCHANGED 115718 . 117442) (CHANGEMACRO 117444 . 118149) (CHANGEVAR 118151 . 118467) (
|
||||
CHANGEI.S. 118469 . 119802) (CHANGERECORD 119804 . 120675) (MSNEEDUNSAVE 120677 . 121669) (UNSAVEFNS
|
||||
121671 . 124307)) (124742 128352 (%. 124752 . 124892) (MASTERSCOPE 124894 . 125420) (MASTERSCOPE1
|
||||
125422 . 126290) (MASTERSCOPEXEC 126292 . 128350)) (128391 168041 (MSINTERPRETSET 128401 . 156935) (
|
||||
MSINTERPA 156937 . 157471) (MSGETBLOCKDEC 157473 . 159986) (LISTHARD 159988 . 161206) (MSMEMBSET
|
||||
161208 . 161353) (MSLISTSET 161355 . 161720) (MSHASHLIST 161722 . 161889) (MSHASHLIST1 161891 . 162217
|
||||
) (CHECKPATHS 162219 . 162859) (ONFILE 162861 . 168039)) (168042 191603 (MSINTERPRET 168052 . 184107)
|
||||
(VERBNOTICELIST 184109 . 185219) (MSOUTPUT 185221 . 186731) (MSCHECKEMPTY 186733 . 187937) (
|
||||
CHECKFORCHANGED 187939 . 188459) (MSSOLVE 188461 . 191601)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Feb-2026 11:07:12" {WMEDLEY}<library>UNICODE.;213 82607
|
||||
(FILECREATED "23-Oct-2025 08:31:21" {WMEDLEY}<library>UNICODE.;211 82245
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MAKE-UNICODE-FORMATS)
|
||||
:CHANGES-TO (FNS UTOMCODE UTF8.INCCODEFN UTOMCODE? UTF8.PEEKCCODEFN)
|
||||
(VARS UNICODECOMS)
|
||||
(MACROS UNICODE.SMALLP)
|
||||
|
||||
:PREVIOUS-DATE "31-Jan-2026 19:24:45" {WMEDLEY}<library>UNICODE.;212)
|
||||
:PREVIOUS-DATE "22-Oct-2025 23:28:51" {WMEDLEY}<library>UNICODE.;210)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UNICODECOMS)
|
||||
@@ -588,8 +590,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MAKE-UNICODE-FORMATS
|
||||
[LAMBDA (EXTERNALEOL) (* ; "Edited 5-Feb-2026 11:06 by rmk")
|
||||
(* ; "Edited 17-Jan-2025 18:38 by rmk")
|
||||
[LAMBDA (EXTERNALEOL) (* ; "Edited 17-Jan-2025 18:38 by rmk")
|
||||
(* ; "Edited 10-Mar-2024 11:55 by rmk")
|
||||
(* ; "Edited 8-Dec-2023 15:19 by rmk")
|
||||
(* ; "Edited 19-Jul-2022 15:36 by rmk")
|
||||
@@ -603,10 +604,7 @@
|
||||
(FUNCTION UTF8.PEEKCCODEFN)
|
||||
(FUNCTION \UTF8.BACKCCODEFN)
|
||||
(FUNCTION UTF8.OUTCHARFN)
|
||||
NIL EXTERNALEOL NIL (FUNCTION MTOUTF8STRING)
|
||||
NIL
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION UTF8TOMSTRING))
|
||||
NIL EXTERNALEOL NIL NIL NIL (FUNCTION NILL))
|
||||
(MAKE-EXTERNALFORMAT :UTF-8-RAW [FUNCTION (LAMBDA (STREAM COUNTP)
|
||||
(UTF8.INCCODEFN STREAM COUNTP T]
|
||||
[FUNCTION (LAMBDA (STREAM NOERROR)
|
||||
@@ -957,8 +955,7 @@
|
||||
do (RPLCHARCODE MSTRING I (UTOMCODE UCODE)) finally (RETURN MSTRING])
|
||||
|
||||
(MTOUTF8STRING
|
||||
[LAMBDA (MSTRING) (* ; "Edited 31-Jan-2026 19:15 by rmk")
|
||||
(* ; "Edited 9-Sep-2025 07:51 by rmk")
|
||||
[LAMBDA (MSTRING) (* ; "Edited 9-Sep-2025 07:51 by rmk")
|
||||
(* ; "Edited 4-Sep-2025 15:13 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 11:12 by rmk")
|
||||
(* ; "Edited 24-Apr-2025 15:37 by rmk")
|
||||
@@ -971,13 +968,11 @@
|
||||
(* ;; "The resulting string will not be directly interpretable inside Medley.")
|
||||
|
||||
(if (if (STRINGP MSTRING)
|
||||
then [OR (ffetch (STRINGP FATSTRINGP) of MSTRING)
|
||||
(thereis C instring MSTRING suchthat (OR (IGEQ C 128)
|
||||
(NEQ C (MTOUCODE C]
|
||||
then (OR (ffetch (STRINGP FATSTRINGP) of MSTRING)
|
||||
(thereis C instring MSTRING suchthat (IGEQ C 128)))
|
||||
elseif (LITATOM MSTRING)
|
||||
then [OR (ffetch (LITATOM FATPNAMEP) of MSTRING)
|
||||
(thereis C inatom MSTRING suchthat (OR (IGEQ C 128)
|
||||
(NEQ C (MTOUCODE C]
|
||||
then (OR (ffetch (LITATOM FATPNAMEP) of MSTRING)
|
||||
(thereis C inatom MSTRING suchthat (IGEQ C 128)))
|
||||
else T)
|
||||
then (LET [(USTR (ALLOCSTRING (NUTF8-STRING-BYTES MSTRING]
|
||||
(for I UCODE MCODE (SINDEX _ 0) from 1 while (SETQ MCODE (NTHCHARCODE MSTRING I))
|
||||
@@ -1488,21 +1483,21 @@
|
||||
|
||||
(PUTPROPS UNICODE FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3379 18917 (UTF8.OUTCHARFN 3389 . 6405) (UTF8.SLUG.OUTCHARFN 6407 . 7071) (
|
||||
UTF8.INCCODEFN 7073 . 12926) (UTF8.PEEKCCODEFN 12928 . 17935) (\UTF8.BACKCCODEFN 17937 . 18915)) (
|
||||
18918 23608 (UTF16BE.OUTCHARFN 18928 . 19947) (UTF16BE.INCCODEFN 19949 . 21074) (UTF16BE.PEEKCCODEFN
|
||||
21076 . 22416) (\UTF16BE.BACKCCODEFN 22418 . 23606)) (23609 28332 (UTF16LE.OUTCHARFN 23619 . 24735) (
|
||||
UTF16LE.INCCODEFN 24737 . 25862) (UTF16LE.PEEKCCODEFN 25864 . 27140) (\UTF16LE.BACKCCODEFN 27142 .
|
||||
28330)) (28333 31380 (READBOM 28343 . 30412) (WRITEBOM 30414 . 31378)) (31410 35163 (
|
||||
MAKE-UNICODE-FORMATS 31420 . 35161)) (35260 39754 (UTF8.BINCODE 35270 . 37958) (\UTF8.FETCHCODE 37960
|
||||
. 39752)) (39755 45382 (UTF8.VALIDATE 39765 . 42362) (NUTF8-BYTE1-BYTES 42364 . 43101) (
|
||||
NUTF8-CODE-BYTES 43103 . 44160) (NUTF8-STRING-BYTES 44162 . 45058) (N-MCHARS 45060 . 45380)) (47864
|
||||
57575 (MTOUCODE 47874 . 48261) (UTOMCODE 48263 . 48789) (MTOUCODE? 48791 . 49824) (UTOMCODE? 49826 .
|
||||
50995) (MTOUSTRING 50997 . 51582) (UTOMSTRING 51584 . 52169) (MTOUTF8STRING 52171 . 56460) (
|
||||
UTF8TOMSTRING 56462 . 57573)) (57576 63278 (XTOUCODE 57586 . 58104) (UTOXCODE 58106 . 58614) (
|
||||
XTOUCODE? 58616 . 59677) (UTOXCODE? 59679 . 60762) (XTOUSTRING 60764 . 61457) (UTOXSTRING 61459 .
|
||||
62200) (XTOUTF8STRING 62202 . 63276)) (63341 74609 (WRITE-UNICODE-MAPPING 63351 . 67101) (
|
||||
WRITE-UNICODE-INCLUDED 67103 . 71825) (WRITE-UNICODE-MAPPING-HEADER 71827 . 73075) (
|
||||
WRITE-UNICODE-MAPPING-FILENAME 73077 . 74607)) (74610 75286 (XCCS-UTF8-AFTER-OPEN 74620 . 75284)) (
|
||||
77811 80028 (UTF8HEXSTRING 77821 . 80026)) (80055 82097 (SHOWCHARS 80065 . 82095)))))
|
||||
(FILEMAP (NIL (3488 19026 (UTF8.OUTCHARFN 3498 . 6514) (UTF8.SLUG.OUTCHARFN 6516 . 7180) (
|
||||
UTF8.INCCODEFN 7182 . 13035) (UTF8.PEEKCCODEFN 13037 . 18044) (\UTF8.BACKCCODEFN 18046 . 19024)) (
|
||||
19027 23717 (UTF16BE.OUTCHARFN 19037 . 20056) (UTF16BE.INCCODEFN 20058 . 21183) (UTF16BE.PEEKCCODEFN
|
||||
21185 . 22525) (\UTF16BE.BACKCCODEFN 22527 . 23715)) (23718 28441 (UTF16LE.OUTCHARFN 23728 . 24844) (
|
||||
UTF16LE.INCCODEFN 24846 . 25971) (UTF16LE.PEEKCCODEFN 25973 . 27249) (\UTF16LE.BACKCCODEFN 27251 .
|
||||
28439)) (28442 31489 (READBOM 28452 . 30521) (WRITEBOM 30523 . 31487)) (31519 35084 (
|
||||
MAKE-UNICODE-FORMATS 31529 . 35082)) (35181 39675 (UTF8.BINCODE 35191 . 37879) (\UTF8.FETCHCODE 37881
|
||||
. 39673)) (39676 45303 (UTF8.VALIDATE 39686 . 42283) (NUTF8-BYTE1-BYTES 42285 . 43022) (
|
||||
NUTF8-CODE-BYTES 43024 . 44081) (NUTF8-STRING-BYTES 44083 . 44979) (N-MCHARS 44981 . 45301)) (47785
|
||||
57213 (MTOUCODE 47795 . 48182) (UTOMCODE 48184 . 48710) (MTOUCODE? 48712 . 49745) (UTOMCODE? 49747 .
|
||||
50916) (MTOUSTRING 50918 . 51503) (UTOMSTRING 51505 . 52090) (MTOUTF8STRING 52092 . 56098) (
|
||||
UTF8TOMSTRING 56100 . 57211)) (57214 62916 (XTOUCODE 57224 . 57742) (UTOXCODE 57744 . 58252) (
|
||||
XTOUCODE? 58254 . 59315) (UTOXCODE? 59317 . 60400) (XTOUSTRING 60402 . 61095) (UTOXSTRING 61097 .
|
||||
61838) (XTOUTF8STRING 61840 . 62914)) (62979 74247 (WRITE-UNICODE-MAPPING 62989 . 66739) (
|
||||
WRITE-UNICODE-INCLUDED 66741 . 71463) (WRITE-UNICODE-MAPPING-HEADER 71465 . 72713) (
|
||||
WRITE-UNICODE-MAPPING-FILENAME 72715 . 74245)) (74248 74924 (XCCS-UTF8-AFTER-OPEN 74258 . 74922)) (
|
||||
77449 79666 (UTF8HEXSTRING 77459 . 79664)) (79693 81735 (SHOWCHARS 79703 . 81733)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Feb-2026 18:38:23" {WMEDLEY}<library>UNIXCOMM.;15 14717
|
||||
(FILECREATED " 2-Sep-2025 12:06:52"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>UNIXCOMM.;14 14825
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS FORK-UNIX)
|
||||
|
||||
:PREVIOUS-DATE " 2-Sep-2025 12:06:52" {WMEDLEY}<library>UNIXCOMM.;14)
|
||||
:PREVIOUS-DATE "29-Apr-2025 22:45:47"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>UNIXCOMM.;13)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UNIXCOMMCOMS)
|
||||
@@ -72,11 +74,13 @@
|
||||
else (SUBRCALL UNIX-HANDLECOMM 4])
|
||||
|
||||
(FORK-UNIX
|
||||
[LAMBDA (STR) (* ; "Edited 5-Feb-2026 18:38 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 12:03 by rmk")
|
||||
[LAMBDA (STR) (* ; "Edited 2-Sep-2025 12:03 by rmk")
|
||||
(* ; "Edited 29-Apr-2025 22:45 by rmk")
|
||||
(* ; "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
|
||||
[LAMBDA (CONN) (* ; "Edited 25-May-88 16:04 by drc:")
|
||||
@@ -317,10 +321,10 @@
|
||||
|
||||
(PUTPROPS UNIXCOMM FILETYPE COMPILE-FILE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1821 7231 (FORK-SHELL 1831 . 3028) (FORK-UNIX 3030 . 3551) (UNIX-KILL 3553 . 3742) (
|
||||
UNIX-WRITE 3744 . 4455) (CREATE-SHELL-STREAM 4457 . 5341) (CREATE-PROCESS-STREAM 5343 . 6182) (
|
||||
UNIXCOMM-AROUNDEXITFN 6184 . 7229)) (7279 12470 (INITIALIZE-SHELL-DEVICE 7289 . 8717) (
|
||||
UNIX-GET-NEXT-BUFFER 8719 . 10919) (UNIX-BACKFILEPTR 10921 . 11333) (UNIX-STREAM-EOFP 11335 . 11816) (
|
||||
UNIX-STREAM-OUT 11818 . 12074) (UNIX-STREAM-CLOSE 12076 . 12468)) (12718 14424 (
|
||||
CREATE-UNIX-SOCKET-STREAM 12728 . 13534) (ACCEPT-UNIX-SOCKET-STREAM 13536 . 14422)))))
|
||||
(FILEMAP (NIL (1903 7339 (FORK-SHELL 1913 . 3110) (FORK-UNIX 3112 . 3659) (UNIX-KILL 3661 . 3850) (
|
||||
UNIX-WRITE 3852 . 4563) (CREATE-SHELL-STREAM 4565 . 5449) (CREATE-PROCESS-STREAM 5451 . 6290) (
|
||||
UNIXCOMM-AROUNDEXITFN 6292 . 7337)) (7387 12578 (INITIALIZE-SHELL-DEVICE 7397 . 8825) (
|
||||
UNIX-GET-NEXT-BUFFER 8827 . 11027) (UNIX-BACKFILEPTR 11029 . 11441) (UNIX-STREAM-EOFP 11443 . 11924) (
|
||||
UNIX-STREAM-OUT 11926 . 12182) (UNIX-STREAM-CLOSE 12184 . 12576)) (12826 14532 (
|
||||
CREATE-UNIX-SOCKET-STREAM 12836 . 13642) (ACCEPT-UNIX-SOCKET-STREAM 13644 . 14530)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Feb-2026 18:37:09" {WMEDLEY}<library>UNIXPRINT.;17 11663
|
||||
(FILECREATED "25-Jan-2026 11:09:09" {WMEDLEY}<library>UNIXPRINT.;15 11553
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS UnixShellQuote)
|
||||
:CHANGES-TO (FNS UnixPrint)
|
||||
|
||||
:PREVIOUS-DATE "25-Jan-2026 11:09:09" {WMEDLEY}<library>UNIXPRINT.;15)
|
||||
:PREVIOUS-DATE "18-Jan-2026 08:44:40" {WMEDLEY}<library>UNIXPRINT.;14)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UNIXPRINTCOMS)
|
||||
@@ -130,8 +130,7 @@
|
||||
|
||||
(UnixShellQuote
|
||||
[LAMBDA (STRING)
|
||||
(DECLARE (LOCALVARS . T)) (* ; "Edited 5-Feb-2026 18:37 by rmk")
|
||||
(* ; "Edited 18-Jan-2026 08:34 by rmk")
|
||||
(DECLARE (LOCALVARS . T)) (* ; "Edited 18-Jan-2026 08:34 by rmk")
|
||||
(* ; "Edited 19-Apr-89 21:14 by TAL")
|
||||
(LET* ((X (CHCON STRING))
|
||||
(CT X)
|
||||
@@ -156,9 +155,9 @@
|
||||
(CHARCODE SPACE))
|
||||
(T C))
|
||||
(SETQ CT (CDR CT]
|
||||
(MTOSYSSTRING (CL:IF FLG
|
||||
(CONCATCODES X)
|
||||
STRING)])
|
||||
(MTOUTF8STRING (COND
|
||||
(FLG (CONCATCODES X))
|
||||
(T STRING])
|
||||
|
||||
(UnixTempFile
|
||||
[LAMBDA (Prefix DontOpen) (* ; "Edited 28-Apr-93 13:49 by rmk:")
|
||||
@@ -252,6 +251,6 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1051 10997 (UnixPrint 1061 . 6397) (UnixShellQuote 6399 . 8087) (UnixTempFile 8089 .
|
||||
9312) (UnixPrintCommand 9314 . 10995)))))
|
||||
(FILEMAP (NIL (1046 10887 (UnixPrint 1056 . 6392) (UnixShellQuote 6394 . 7977) (UnixTempFile 7979 .
|
||||
9202) (UnixPrintCommand 9204 . 10885)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,10 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "18-Feb-2026 15:47:08" {WMEDLEY}<library>LAFITE>LAFITE-INDENT.;2 26210
|
||||
(FILECREATED "15-Feb-2025 14:11:54" {WMEDLEY}<library>lafite>LAFITE-INDENT.;4 26926
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "22-Jan-87 01:34:36" {WMEDLEY}<library>LAFITE>LAFITE-INDENT.;1)
|
||||
:CHANGES-TO (FNS TEDIT-INDENT-BREAK-LONG-LINES TEDIT-INDENT-SELECTION TEDIT-OPEN-LINE
|
||||
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)
|
||||
@@ -130,14 +133,10 @@
|
||||
max-length max-length])
|
||||
|
||||
(TEDIT-INDENT-BREAK-LONG-LINES
|
||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* smL "21-Jan-87 16:03")
|
||||
|
||||
(* * 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)
|
||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* ; "Edited 15-Feb-2025 14:07 by rmk")
|
||||
(* smL "21-Jan-87 16:03")
|
||||
|
||||
(* ;;; "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")
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
(TEDIT-INDENT-REPLACE-SELECTION
|
||||
@@ -145,11 +144,13 @@
|
||||
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
|
||||
text-stream selection)
|
||||
explicit-paragraph-breaks?)
|
||||
bind [hanging-indent _
|
||||
(AND (NOT (EQP (fetch CHAR1 of (CAR (fetch L1 of selection)))
|
||||
(fetch CH# of selection)))
|
||||
(DIFFERENCE (fetch CH# of selection)
|
||||
(fetch CHAR1 of (CAR (fetch L1 of selection]
|
||||
bind [hanging-indent _ (AND [NOT (EQP (GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1)
|
||||
(TEDIT.SELPROP selection 'CH#]
|
||||
(DIFFERENCE (TEDIT.SELPROP selection
|
||||
'CH#)
|
||||
(GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1]
|
||||
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
|
||||
"" *TEDIT-INDENT-LINE-LENGTH* hanging-indent)
|
||||
*eol-string*)
|
||||
@@ -184,15 +185,10 @@
|
||||
'RIGHT])
|
||||
|
||||
(TEDIT-INDENT-SELECTION
|
||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* smL "21-Jan-87 16:00")
|
||||
|
||||
(* * 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)
|
||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* ; "Edited 15-Feb-2025 14:07 by rmk")
|
||||
(* smL "21-Jan-87 16:00")
|
||||
|
||||
(* ;;; "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")
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
(TEDIT-INDENT-REPLACE-SELECTION
|
||||
@@ -200,11 +196,13 @@
|
||||
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
|
||||
text-stream selection)
|
||||
explicit-paragraph-breaks?)
|
||||
bind [hanging-indent _
|
||||
(AND (NOT (EQP (fetch CHAR1 of (CAR (fetch L1 of selection)))
|
||||
(fetch CH# of selection)))
|
||||
(DIFFERENCE (fetch CH# of selection)
|
||||
(fetch CHAR1 of (CAR (fetch L1 of selection]
|
||||
bind [hanging-indent _ (AND [NOT (EQP (GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1)
|
||||
(TEDIT.SELPROP selection 'CH#]
|
||||
(DIFFERENCE (TEDIT.SELPROP selection
|
||||
'CH#)
|
||||
(GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1]
|
||||
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
|
||||
*TEDIT-INDENT-STRING* *TEDIT-INDENT-LINE-LENGTH*
|
||||
hanging-indent)
|
||||
@@ -234,18 +232,19 @@
|
||||
else (\TEDIT-INDENT-SEPERATE-PARAGRAPHS string NIL])
|
||||
|
||||
(TEDIT-INDENT-SET-INDENT
|
||||
[LAMBDA (text-stream) (* smL "12-Sep-86 17:09")
|
||||
|
||||
(* * Prompt the user for a new indentation string)
|
||||
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 09:21 by rmk")
|
||||
(* smL "12-Sep-86 17:09")
|
||||
|
||||
(LET* ((window (fetch \WINDOW of (TEXTOBJ text-stream)))
|
||||
(* ;;; "Prompt the user for a new indentation string")
|
||||
|
||||
(LET* ((window (\TEDIT.PRIMARYPANE text-stream))
|
||||
(pwindow (if window
|
||||
then (GETPROMPTWINDOW (if (LISTP window)
|
||||
then (CAR window)
|
||||
else window))
|
||||
else PROMPTWINDOW)))
|
||||
(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])
|
||||
|
||||
(TEDIT-INDENT-STRIP-INDENTATION
|
||||
@@ -270,36 +269,34 @@
|
||||
else string])
|
||||
|
||||
(TEDIT-MAKE-LINES-EXPLICIT
|
||||
[LAMBDA (text-stream) (* smL " 8-Sep-86 18:20")
|
||||
|
||||
(* * 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)
|
||||
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 09:20 by rmk")
|
||||
(* smL " 8-Sep-86 18:20")
|
||||
|
||||
(* ;;; "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")
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
[for i in (bind (this-line _ (CAR (fetch L1 of selection)))
|
||||
[last-line _ (CAR (LAST (fetch LN of selection]
|
||||
repeatuntil (PROGN (SETQ this-line (fetch NEXTLINE of this-line))
|
||||
(EQ this-line last-line)) collect (fetch CHARLIM
|
||||
of this-line))
|
||||
do (TEDIT.SETSEL text-stream i 1 'LEFT T)
|
||||
(TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
|
||||
[for i in (bind (this-line _ (CAR (GETSEL selection L1)))
|
||||
[last-line _ (CAR (LAST (GETSEL selection LN]
|
||||
repeatuntil (PROGN (SETQ this-line (GETLD this-line NEXTLINE))
|
||||
(EQ this-line last-line)) collect (GETLD this-line LCHARLIM)
|
||||
) 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-OPEN-LINE
|
||||
[LAMBDA (text-stream) (* smL "17-Sep-86 11:13")
|
||||
|
||||
(* * Open a new line at the current position.)
|
||||
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 14:09 by rmk")
|
||||
(* smL "17-Sep-86 11:13")
|
||||
|
||||
(* ;;; "Open a new line at the current position.")
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
(TEDIT.INSERT text-stream (CONCAT *eol-string*
|
||||
(ALLOCSTRING [DIFFERENCE (fetch CH# of selection)
|
||||
(fetch CHAR1
|
||||
of (CAR (fetch L1 of selection]
|
||||
" ")))
|
||||
(if (ZEROP (fetch DCH of selection))
|
||||
(TEDIT.INSERT text-stream (CONCAT *eol-string* (ALLOCSTRING
|
||||
(DIFFERENCE (TEDIT.SELPROP selection
|
||||
'CH#)
|
||||
(GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1))
|
||||
" ")))
|
||||
(if (ZEROP (TEDIT.SELPROP selection 'LENGTH))
|
||||
then (TEDIT.SETSEL text-stream selection])
|
||||
|
||||
(TEDIT-REMOVE-INDENT
|
||||
@@ -436,12 +433,12 @@
|
||||
"Break long lines by inserting explicit <RETURN>'s"
|
||||
]
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4193 23598 (TEDIT-INDENT-ADD-INDENTATION 4203 . 6771) (TEDIT-INDENT-BREAK-LINE 6773 .
|
||||
8706) (TEDIT-INDENT-BREAK-LONG-LINES 8708 . 10475) (TEDIT-INDENT-FIND-BREAKPOINT 10477 . 11300) (
|
||||
TEDIT-INDENT-REPLACE-SELECTION 11302 . 11859) (TEDIT-INDENT-SELECTION 11861 . 13762) (
|
||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 13764 . 14043) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 14045 .
|
||||
14774) (TEDIT-INDENT-SET-INDENT 14776 . 15550) (TEDIT-INDENT-STRIP-INDENTATION 15552 . 16772) (
|
||||
TEDIT-MAKE-LINES-EXPLICIT 16774 . 17979) (TEDIT-OPEN-LINE 17981 . 18737) (TEDIT-REMOVE-INDENT 18739 .
|
||||
19509) (\TEDIT-INDENT-COUNT-SPACES 19511 . 20112) (\TEDIT-INDENT-FIND-PARAGRAPH-END 20114 . 21085) (
|
||||
\TEDIT-INDENT-SEPERATE-LINES 21087 . 21885) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 21887 . 23596)))))
|
||||
(FILEMAP (NIL (4363 24314 (TEDIT-INDENT-ADD-INDENTATION 4373 . 6941) (TEDIT-INDENT-BREAK-LINE 6943 .
|
||||
8876) (TEDIT-INDENT-BREAK-LONG-LINES 8878 . 10828) (TEDIT-INDENT-FIND-BREAKPOINT 10830 . 11653) (
|
||||
TEDIT-INDENT-REPLACE-SELECTION 11655 . 12212) (TEDIT-INDENT-SELECTION 12214 . 14283) (
|
||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 14285 . 14564) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 14566 .
|
||||
15295) (TEDIT-INDENT-SET-INDENT 15297 . 16143) (TEDIT-INDENT-STRIP-INDENTATION 16145 . 17365) (
|
||||
TEDIT-MAKE-LINES-EXPLICIT 17367 . 18517) (TEDIT-OPEN-LINE 18519 . 19453) (TEDIT-REMOVE-INDENT 19455 .
|
||||
20225) (\TEDIT-INDENT-COUNT-SPACES 20227 . 20828) (\TEDIT-INDENT-FIND-PARAGRAPH-END 20830 . 21801) (
|
||||
\TEDIT-INDENT-SEPERATE-LINES 21803 . 22601) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 22603 . 24312)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,28 +1,30 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED "19-Jan-87 23:56:51" {ERIS}<LISPUSERS>LISPCORE>LAFITEPRIVATEDL.;1 10080
|
||||
|
||||
(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))
|
||||
previous date%: "19-Jan-87 23:47:54" {PHYLUM}<LISPUSERS>KOTO>LAFITEPRIVATEDL.;2)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LAFITE-PRIVATEDLCOMS)
|
||||
(* "
|
||||
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(RPAQQ LAFITE-PRIVATEDLCOMS
|
||||
((* * 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 LAFITEDEFAULTHOST&DIR in order to locate a dl file when no host or
|
||||
directory is specified)
|
||||
(INITVARS (LAFITEDL.EXT 'DL)
|
||||
(LAFITEDLDIRECTORIES NIL))
|
||||
(* * no functions are user callable)
|
||||
(FNS \GV.PARSERECIPIENTS1 \GV.PARSE.PRIVATE.DISTRIBUTION.LIST)
|
||||
(* Lafite's readtable for parsing addresses needs to have CR as a SEPRCHAR so that lines from
|
||||
a text 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)
|
||||
(P (SETSYNTAX (CHARCODE CR)
|
||||
'SEPRCHAR ADDRESSPARSERRDTBL))))
|
||||
(PRETTYCOMPRINT LAFITEPRIVATEDLCOMS)
|
||||
|
||||
(RPAQQ LAFITEPRIVATEDLCOMS ((* * 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 LAFITEDEFAULTHOST&DIR in order to
|
||||
locate a dl file when no host or directory is specified)
|
||||
(INITVARS (LAFITEDL.EXT 'DL)
|
||||
(LAFITEDLDIRECTORIES NIL))
|
||||
(* * no functions are user callable)
|
||||
(FNS \GV.PARSERECIPIENTS1 \GV.PARSE.PRIVATE.DISTRIBUTION.LIST)
|
||||
(* Lafite's readtable for parsing addresses needs to have CR as a
|
||||
SEPRCHAR so that lines from a text 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)
|
||||
(P (SETSYNTAX (CHARCODE CR)
|
||||
'SEPRCHAR ADDRESSPARSERRDTBL))))
|
||||
(* * 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
|
||||
@@ -37,7 +39,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\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")
|
||||
|
||||
@@ -71,8 +73,8 @@
|
||||
(CHARCODE %"))
|
||||
(HELP]
|
||||
(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)
|
||||
(EQ (SETQ TOKEN (READ FIELDSTREAM
|
||||
@@ -105,13 +107,14 @@
|
||||
(EQ (CADDR ADDRESS)
|
||||
';))
|
||||
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)
|
||||
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
|
||||
(COND
|
||||
@@ -125,8 +128,8 @@
|
||||
((OR T INTERNALFLG (NULL REALADDRESS))
|
||||
VALIDRECIPIENT)
|
||||
(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)
|
||||
(LIST '< VALIDRECIPIENT
|
||||
@@ -134,7 +137,7 @@
|
||||
(CDR CLOSE])
|
||||
|
||||
(\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)
|
||||
'EXTENSION LAFITEDL.EXT)
|
||||
T
|
||||
@@ -159,10 +162,10 @@
|
||||
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)
|
||||
|
||||
|
||||
(SETSYNTAX (CHARCODE CR)
|
||||
'SEPRCHAR ADDRESSPARSERRDTBL)
|
||||
(PUTPROPS LAFITEPRIVATEDL COPYRIGHT ("Xerox Corporation" 1986 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1617 9389 (\GV.PARSERECIPIENTS1 1627 . 8273) (\GV.PARSE.PRIVATE.DISTRIBUTION.LIST 8275
|
||||
. 9387)))))
|
||||
(FILEMAP (NIL (1965 9682 (\GV.PARSERECIPIENTS1 1975 . 8562) (\GV.PARSE.PRIVATE.DISTRIBUTION.LIST 8564
|
||||
. 9680)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "15-Feb-2026 23:45:51" {WMEDLEY}<library>tedit>TEDIT-FILE.;666 175062
|
||||
(FILECREATED " 7-Feb-2026 17:02:37" {WMEDLEY}<library>tedit>TEDIT-FILE.;657 173103
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.PUT.MCCS.SPLITPIECES \TEDIT.PUT.PCTB.NEXTNEW)
|
||||
(VARS TEDIT-FILECOMS)
|
||||
:CHANGES-TO (FNS TEDITFROMLISPSOURCE)
|
||||
|
||||
:PREVIOUS-DATE "14-Feb-2026 10:32:44" {WMEDLEY}<library>tedit>TEDIT-FILE.;659)
|
||||
:PREVIOUS-DATE "23-Oct-2025 08:49:06" {WMEDLEY}<library>tedit>TEDIT-FILE.;656)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FILECOMS)
|
||||
@@ -51,9 +50,8 @@
|
||||
(* ;; "Putting pageframe functions are on TEDIT-PAGE)")
|
||||
|
||||
(FNS \TEDIT.PUT.PCTB \TEDIT.PUT.PCTB.PIECEDATA \TEDIT.PUT.TRAILER
|
||||
\TEDIT.PUT.PCTB.MERGEABLE \TEDIT.PUT.UTF8.SPLITPIECES \TEDIT.PUT.MCCS.SPLITPIECES
|
||||
\TEDIT.PUT.PCTB.NEXTNEW \TEDIT.INSERT.NEWPIECES \TEDIT.PUTRESET \ARBOUT \ATMOUT
|
||||
\DWOUT \STRINGOUT)
|
||||
\TEDIT.PUT.PCTB.MERGEABLE \TEDIT.PUT.UTF8.SPLITPIECES \TEDIT.PUT.PCTB.NEXTNEW
|
||||
\TEDIT.INSERT.NEWPIECES \TEDIT.PUTRESET \ARBOUT \ATMOUT \DWOUT \STRINGOUT)
|
||||
(FNS \TEDIT.PUT.CHARLOOKS.LIST \TEDIT.PUT.SINGLE.CHARLOOKS \TEDIT.PUT.CHARLOOKS
|
||||
\TEDIT.PUT.CHARLOOKS1 \TEDIT.PUT.OBJECT)
|
||||
(FNS \TEDIT.PUT.PARALOOKS.LIST \TEDIT.PUT.SINGLE.PARALOOKS \TEDIT.PUT.PARALOOKS))
|
||||
@@ -1832,7 +1830,6 @@
|
||||
|
||||
(\TEDIT.PUT.PCTB
|
||||
[LAMBDA (TEXTOBJ CHARSTREAM FORMATSTREAM CONTINUE KEEPSEPARATE)
|
||||
(* ; "Edited 14-Feb-2026 10:32 by rmk")
|
||||
(* ; "Edited 9-Sep-2025 21:32 by rmk")
|
||||
(* ; "Edited 26-Apr-2025 00:11 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
@@ -1925,10 +1922,10 @@
|
||||
|
||||
(* ;; "For MCCS, CHARSET will put out the char-shifting prefix bytes as needed. In format-version 3 all the file bytes belong to a piece, no skipping in the file. TEDIT.GET calls \TEDIT.INTERPRET.XCCS.SHIFTS to shave those bytes. NSHIFTBYTES is used here if the edit will continue.")
|
||||
|
||||
(CHARSET CHARSTREAM (OR (AND (EQ EXTFORMAT :XCCS)
|
||||
(MEMB (PTYPE PC)
|
||||
FAT.PTYPES))
|
||||
(PCHARSET PC)))
|
||||
(CHARSET CHARSTREAM (CL:IF (MEMB (PTYPE PC)
|
||||
FAT.PTYPES)
|
||||
T
|
||||
0))
|
||||
(SETQ NSHIFTBYTES (IDIFFERENCE (\GETFILEPTR CHARSTREAM)
|
||||
OLDBYTE#)))
|
||||
(do (\TEDIT.PUT.PCTB.PIECEDATA PC CHARSTREAM TEXTOBJ FORMATSTREAM OLDBYTE#)
|
||||
@@ -2155,35 +2152,8 @@
|
||||
(RETURN))))
|
||||
NIL])
|
||||
|
||||
(\TEDIT.PUT.MCCS.SPLITPIECES
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 15-Feb-2026 23:45 by rmk")
|
||||
|
||||
(* ;; "We are putting to a :MCCS format file, and MCCS doesn't support single-byte runs of non-charset 0 characters. This function splits fat pieces into subpieces with only charset-0 characters or no charset-0 characters. The former will be put out as THINFILE pieces, the latter as FATFILE2.")
|
||||
|
||||
(for PC FIRST0 FIRSTNON0 inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
|
||||
when [AND (MEMB (PTYPE PC)
|
||||
(CONSTANT (LIST FATSTRING.PTYPE FATFILE2.PTYPE UTF8.PTYPE)))
|
||||
(SETQ FIRST0 (find I from 0 to (PLAST PC)
|
||||
suchthat (EQ 0 (\CHARSET (\TEDIT.PIECE.NTHCHARCODE PC I]
|
||||
do (if [SETQ FIRSTNON0 (find I from (ADD1 FIRST0) to (PLAST PC)
|
||||
suchthat (NEQ 0 (\CHARSET (\TEDIT.PIECE.NTHCHARCODE PC I]
|
||||
then
|
||||
(* ;; "xxx000yyy --> xxx 000yyy or 000yyy --> 000 yyy")
|
||||
|
||||
(\TEDIT.SPLITPIECE PC (CL:IF (EQ FIRST0 0)
|
||||
FIRSTNON0
|
||||
FIRST0)
|
||||
TEXTOBJ) (* ; "Iterate to the residual piece")
|
||||
(SETQ PC (PREVPIECE PC))
|
||||
elseif (NEQ 0 FIRST0)
|
||||
then
|
||||
(* ;; "xxx000")
|
||||
|
||||
(\TEDIT.SPLITPIECE PC FIRST0 TEXTOBJ])
|
||||
|
||||
(\TEDIT.PUT.PCTB.NEXTNEW
|
||||
[LAMBDA (NEXTNEW PC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ EOLC NSHIFTBYTES)
|
||||
(* ; "Edited 15-Feb-2026 15:09 by rmk")
|
||||
(* ; "Edited 25-Apr-2025 08:48 by rmk")
|
||||
(* ; "Edited 26-Mar-2025 09:27 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
@@ -2232,7 +2202,7 @@
|
||||
"The file may have LF, but we want to restore EOL internally")
|
||||
(CL:WHEN [AND (EQ THINFILE.PTYPE (PTYPE NEXTNEW))
|
||||
(EQ (CHARCODE EOL)
|
||||
(\TEDIT.PIECE.NTHCHARCODE PC (PLAST PC]
|
||||
(\TEDIT.PIECE.NTHCHARCODE PC (PLEN PC]
|
||||
(if (EQ 1 (PLEN NEXTNEW))
|
||||
then (FSETPC NEXTNEW PTYPE THINSTRING.PTYPE)
|
||||
(FSETPC NEXTNEW PCONTENTS (ALLOCSTRING 1 (CHARCODE EOL)))
|
||||
@@ -2721,29 +2691,28 @@
|
||||
|
||||
(RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5423 35682 (TEDIT.GET 5433 . 11843) (TEDIT.FORMATTEDFILEP 11845 . 13161) (
|
||||
TEDIT.FILEDATE 13163 . 14472) (TEDIT.INCLUDE 14474 . 22503) (TEDIT.RAW.INCLUDE 22505 . 23313) (
|
||||
TEDIT.PUT 23315 . 31671) (TEDIT.PUT.STREAM 31673 . 35680)) (35683 56957 (\TEDIT.GET.FOREIGN.FILE 35693
|
||||
. 39118) (\TEDIT.GET.UNFORMATTED.FILE 39120 . 43426) (\TEDIT.GET.FORMATTED.FILE 43428 . 47071) (
|
||||
\TEDIT.FORMATTEDSTREAMP 47073 . 50204) (\ARBIN 50206 . 50926) (\ATMIN 50928 . 51465) (\DWIN 51467 .
|
||||
51846) (\STRINGIN 51848 . 52556) (\TEDIT.GET.TRAILER 52558 . 55426) (\TEDIT.CACHEFILE 55428 . 56955))
|
||||
(57123 73161 (\TEDIT.GET.PIECES3 57133 . 68096) (\TEDIT.GET.PROPS3 68098 . 71320) (
|
||||
\TEDIT.MAKE.STRINGPIECE 71322 . 73159)) (73162 86588 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 73172 . 79405)
|
||||
(\TEDIT.INTERPRET.MCCS.SHIFTS 79407 . 85652) (\TEDIT.CONVERT.XCCSTOMCCS 85654 . 86586)) (86610 92855 (
|
||||
\TEDIT.GET.UNFORMATTED.FILE.UTF8 86620 . 92853)) (92878 104220 (\TEDIT.GET.CHARLOOKS.LIST 92888 .
|
||||
93619) (\TEDIT.GET.SINGLE.CHARLOOKS 93621 . 100693) (\TEDIT.GET.CHARLOOKS 100695 . 102251) (
|
||||
\TEDIT.GET.PARALOOKS.INDEX 102253 . 102797) (\TEDIT.GET.CHARLOOKS.INDEX 102799 . 104218)) (104221
|
||||
111878 (\TEDIT.GET.PARALOOKS.LIST 104231 . 104853) (\TEDIT.GET.SINGLE.PARALOOKS 104855 . 111876)) (
|
||||
111879 115712 (\TEDIT.GET.OBJECT 111889 . 115710)) (115777 150880 (\TEDIT.PUT.PCTB 115787 . 125844) (
|
||||
\TEDIT.PUT.PCTB.PIECEDATA 125846 . 129044) (\TEDIT.PUT.TRAILER 129046 . 130374) (
|
||||
\TEDIT.PUT.PCTB.MERGEABLE 130376 . 134149) (\TEDIT.PUT.UTF8.SPLITPIECES 134151 . 138853) (
|
||||
\TEDIT.PUT.MCCS.SPLITPIECES 138855 . 140433) (\TEDIT.PUT.PCTB.NEXTNEW 140435 . 145041) (
|
||||
\TEDIT.INSERT.NEWPIECES 145043 . 148478) (\TEDIT.PUTRESET 148480 . 148722) (\ARBOUT 148724 . 149448) (
|
||||
\ATMOUT 149450 . 150055) (\DWOUT 150057 . 150336) (\STRINGOUT 150338 . 150878)) (150881 163615 (
|
||||
\TEDIT.PUT.CHARLOOKS.LIST 150891 . 152563) (\TEDIT.PUT.SINGLE.CHARLOOKS 152565 . 158845) (
|
||||
\TEDIT.PUT.CHARLOOKS 158847 . 160186) (\TEDIT.PUT.CHARLOOKS1 160188 . 161239) (\TEDIT.PUT.OBJECT
|
||||
161241 . 163613)) (163616 171255 (\TEDIT.PUT.PARALOOKS.LIST 163626 . 164528) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS 164530 . 170114) (\TEDIT.PUT.PARALOOKS 170116 . 171253)) (171350 174755 (
|
||||
TEDITFROMLISPSOURCE 171360 . 174004) (SHELLSCRIPTP 174006 . 174235) (TEDITFROMSHELLSCRIPT 174237 .
|
||||
174753)))))
|
||||
(FILEMAP (NIL (5304 35563 (TEDIT.GET 5314 . 11724) (TEDIT.FORMATTEDFILEP 11726 . 13042) (
|
||||
TEDIT.FILEDATE 13044 . 14353) (TEDIT.INCLUDE 14355 . 22384) (TEDIT.RAW.INCLUDE 22386 . 23194) (
|
||||
TEDIT.PUT 23196 . 31552) (TEDIT.PUT.STREAM 31554 . 35561)) (35564 56838 (\TEDIT.GET.FOREIGN.FILE 35574
|
||||
. 38999) (\TEDIT.GET.UNFORMATTED.FILE 39001 . 43307) (\TEDIT.GET.FORMATTED.FILE 43309 . 46952) (
|
||||
\TEDIT.FORMATTEDSTREAMP 46954 . 50085) (\ARBIN 50087 . 50807) (\ATMIN 50809 . 51346) (\DWIN 51348 .
|
||||
51727) (\STRINGIN 51729 . 52437) (\TEDIT.GET.TRAILER 52439 . 55307) (\TEDIT.CACHEFILE 55309 . 56836))
|
||||
(57004 73042 (\TEDIT.GET.PIECES3 57014 . 67977) (\TEDIT.GET.PROPS3 67979 . 71201) (
|
||||
\TEDIT.MAKE.STRINGPIECE 71203 . 73040)) (73043 86469 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 73053 . 79286)
|
||||
(\TEDIT.INTERPRET.MCCS.SHIFTS 79288 . 85533) (\TEDIT.CONVERT.XCCSTOMCCS 85535 . 86467)) (86491 92736 (
|
||||
\TEDIT.GET.UNFORMATTED.FILE.UTF8 86501 . 92734)) (92759 104101 (\TEDIT.GET.CHARLOOKS.LIST 92769 .
|
||||
93500) (\TEDIT.GET.SINGLE.CHARLOOKS 93502 . 100574) (\TEDIT.GET.CHARLOOKS 100576 . 102132) (
|
||||
\TEDIT.GET.PARALOOKS.INDEX 102134 . 102678) (\TEDIT.GET.CHARLOOKS.INDEX 102680 . 104099)) (104102
|
||||
111759 (\TEDIT.GET.PARALOOKS.LIST 104112 . 104734) (\TEDIT.GET.SINGLE.PARALOOKS 104736 . 111757)) (
|
||||
111760 115593 (\TEDIT.GET.OBJECT 111770 . 115591)) (115658 148921 (\TEDIT.PUT.PCTB 115668 . 125575) (
|
||||
\TEDIT.PUT.PCTB.PIECEDATA 125577 . 128775) (\TEDIT.PUT.TRAILER 128777 . 130105) (
|
||||
\TEDIT.PUT.PCTB.MERGEABLE 130107 . 133880) (\TEDIT.PUT.UTF8.SPLITPIECES 133882 . 138584) (
|
||||
\TEDIT.PUT.PCTB.NEXTNEW 138586 . 143082) (\TEDIT.INSERT.NEWPIECES 143084 . 146519) (\TEDIT.PUTRESET
|
||||
146521 . 146763) (\ARBOUT 146765 . 147489) (\ATMOUT 147491 . 148096) (\DWOUT 148098 . 148377) (
|
||||
\STRINGOUT 148379 . 148919)) (148922 161656 (\TEDIT.PUT.CHARLOOKS.LIST 148932 . 150604) (
|
||||
\TEDIT.PUT.SINGLE.CHARLOOKS 150606 . 156886) (\TEDIT.PUT.CHARLOOKS 156888 . 158227) (
|
||||
\TEDIT.PUT.CHARLOOKS1 158229 . 159280) (\TEDIT.PUT.OBJECT 159282 . 161654)) (161657 169296 (
|
||||
\TEDIT.PUT.PARALOOKS.LIST 161667 . 162569) (\TEDIT.PUT.SINGLE.PARALOOKS 162571 . 168155) (
|
||||
\TEDIT.PUT.PARALOOKS 168157 . 169294)) (169391 172796 (TEDITFROMLISPSOURCE 169401 . 172045) (
|
||||
SHELLSCRIPTP 172047 . 172276) (TEDITFROMSHELLSCRIPT 172278 . 172794)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "16-Feb-2026 00:36:00" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;467 155443
|
||||
(FILECREATED "10-Feb-2026 11:07:12" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;465 155591
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.MCCS.TRANSLATE)
|
||||
:CHANGES-TO (FNS \TEDIT.CHANGE.CHARLOOKS \TEDIT.CHANGE.PARALOOKS)
|
||||
|
||||
:PREVIOUS-DATE "10-Feb-2026 11:07:12" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;465)
|
||||
:PREVIOUS-DATE " 7-Dec-2025 16:32:32" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;460)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-LOOKSCOMS)
|
||||
@@ -924,8 +924,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.MCCS.TRANSLATE
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 16-Feb-2026 00:35 by rmk")
|
||||
(* ; "Edited 6-Oct-2025 20:50 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 6-Oct-2025 20:50 by rmk")
|
||||
(* ; "Edited 5-Oct-2025 10:57 by rmk")
|
||||
(* ; "Edited 25-Sep-2025 21:30 by rmk")
|
||||
(* ; "Edited 9-Sep-2025 21:48 by rmk")
|
||||
@@ -955,17 +954,19 @@
|
||||
(SETQ CLOOKS
|
||||
(PCHARLOOKS PC))
|
||||
CLFONT]
|
||||
do (for OFFSET OLDCODE STRING FAT from 0 to (PLAST PC)
|
||||
eachtime (SETQ OLDCODE (\TEDIT.PIECE.NTHCHARCODE PC OFFSET))
|
||||
do (for OFFSET OLDCODE STRING FAT from 1 to (PLEN PC) eachtime (SETQ OLDCODE
|
||||
(
|
||||
\TEDIT.PIECE.NTHCHARCODE
|
||||
PC OFFSET))
|
||||
unless (EQ OLDCODE (APPLY* TOMCCSFN OLDCODE))
|
||||
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).")
|
||||
|
||||
(SETQ STRING (ALLOCSTRING (PLEN PC)))
|
||||
[for I from 0 to (PLAST PC) do (RPLCHARCODE STRING (ADD1 I)
|
||||
(APPLY* TOMCCSFN (
|
||||
[for OFFSET from 1 to (PLEN PC) do (RPLCHARCODE STRING OFFSET
|
||||
(APPLY* TOMCCSFN (
|
||||
\TEDIT.PIECE.NTHCHARCODE
|
||||
PC I]
|
||||
PC OFFSET]
|
||||
(SETQ FAT (ffetch (STRINGP FATSTRINGP) of STRING))
|
||||
(FSETPC PC PTYPE (CL:IF FAT
|
||||
FATSTRING.PTYPE
|
||||
@@ -2464,26 +2465,26 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (22019 23961 (\TEDIT.CHARLOOKS.DEFPRINT 22029 . 23165) (\TEDIT.PARALOOKS.DEFPRINT 23167
|
||||
. 23959)) (24065 24451 (\TEDIT.CREATE.FACE.MENU 24075 . 24247) (\TEDIT.CREATE.SIZE.MENU 24249 . 24449
|
||||
)) (25455 27344 (\TEDIT.CHARLOOKS.FEATURE.CHECK 25465 . 27342)) (27616 52873 (
|
||||
\TEDIT.CHARLOOKS.FROM.FONT 27626 . 29910) (\TEDIT.EQCLOOKS 29912 . 32943) (\TEDIT.SAMECLOOKS 32945 .
|
||||
36116) (TEDIT.CARETLOOKS 36118 . 37664) (TEDIT.COPY.LOOKS 37666 . 40949) (
|
||||
\TEDIT.UNPARSE.CHARLOOKS.LIST 40951 . 44445) (\TEDIT.MODIFYLOOKS 44447 . 46607) (TEDIT.NEW.FONT 46609
|
||||
. 47056) (\TEDIT.CARETLOOKS.VERIFY 47058 . 47895) (\TEDIT.CARETPIECE 47897 . 48202) (
|
||||
\TEDIT.GET.INSERT.CHARLOOKS 48204 . 51251) (\TEDIT.GET.TERMSA.WIDTHS 51253 . 51669) (
|
||||
\TEDIT.PARSE.CHARLOOKS.LIST 51671 . 52871)) (52874 64879 (\TEDIT.MCCS.TRANSLATE 52884 . 58615) (
|
||||
\TEDIT.CONVERT.TO.FORMATTED 58617 . 64877)) (65751 73088 (\TEDIT.UNIQUIFY.CHARLOOKS 65761 . 67421) (
|
||||
\TEDIT.UNIQUIFY.PARALOOKS 67423 . 68690) (\TEDIT.UNIQUIFY.ALL 68692 . 70780) (
|
||||
\TEDIT.FLUSH.UNUSED.LOOKS 70782 . 73086)) (73121 85079 (TEDIT.LOOKS 73131 . 75520) (TEDIT.GET.LOOKS
|
||||
75522 . 77857) (TEDIT.SUBLOOKS 77859 . 82239) (TEDIT.FINDLOOKS 82241 . 85077)) (85080 114853 (
|
||||
\TEDIT.CHANGE.CHARLOOKS 85090 . 93991) (\TEDIT.CHANGE.CHARLOOKS.NEW 93993 . 97808) (
|
||||
\TEDIT.CHARLOOKS.CHANGE.FONT 97810 . 106117) (\TEDIT.FONT.NEXTSIZE 106119 . 107740) (\TEDIT.LOOKS
|
||||
107742 . 111071) (\TEDIT.FONTCOPY 111073 . 112574) (\TEDIT.COERCE.FONTCLASS 112576 . 113727) (
|
||||
\TEDIT.FONTCLASS.TO.FONT 113729 . 114851)) (114896 146785 (\TEDIT.EQFMTSPEC 114906 . 118121) (
|
||||
TEDIT.GET.PARALOOKS 118123 . 122170) (\TEDIT.PARSE.PARALOOKS.LIST 122172 . 130205) (TEDIT.PARALOOKS
|
||||
130207 . 131247) (\TEDIT.CHANGE.PARALOOKS 131249 . 138458) (\TEDIT.CHANGE.PARALOOKS.NEW 138460 .
|
||||
142443) (TEDIT.COPY.PARALOOKS 142445 . 145119) (\TEDIT.PARABOUNDS 145121 . 146783)) (146845 154561 (
|
||||
TEDIT.SUBPARALOOKS 146855 . 150957) (SAMEPARALOOKS 150959 . 154559)) (154562 155249 (
|
||||
\TEDIT.MARK.REVISION 154572 . 155247)))))
|
||||
(FILEMAP (NIL (22045 23987 (\TEDIT.CHARLOOKS.DEFPRINT 22055 . 23191) (\TEDIT.PARALOOKS.DEFPRINT 23193
|
||||
. 23985)) (24091 24477 (\TEDIT.CREATE.FACE.MENU 24101 . 24273) (\TEDIT.CREATE.SIZE.MENU 24275 . 24475
|
||||
)) (25481 27370 (\TEDIT.CHARLOOKS.FEATURE.CHECK 25491 . 27368)) (27642 52899 (
|
||||
\TEDIT.CHARLOOKS.FROM.FONT 27652 . 29936) (\TEDIT.EQCLOOKS 29938 . 32969) (\TEDIT.SAMECLOOKS 32971 .
|
||||
36142) (TEDIT.CARETLOOKS 36144 . 37690) (TEDIT.COPY.LOOKS 37692 . 40975) (
|
||||
\TEDIT.UNPARSE.CHARLOOKS.LIST 40977 . 44471) (\TEDIT.MODIFYLOOKS 44473 . 46633) (TEDIT.NEW.FONT 46635
|
||||
. 47082) (\TEDIT.CARETLOOKS.VERIFY 47084 . 47921) (\TEDIT.CARETPIECE 47923 . 48228) (
|
||||
\TEDIT.GET.INSERT.CHARLOOKS 48230 . 51277) (\TEDIT.GET.TERMSA.WIDTHS 51279 . 51695) (
|
||||
\TEDIT.PARSE.CHARLOOKS.LIST 51697 . 52897)) (52900 65027 (\TEDIT.MCCS.TRANSLATE 52910 . 58763) (
|
||||
\TEDIT.CONVERT.TO.FORMATTED 58765 . 65025)) (65899 73236 (\TEDIT.UNIQUIFY.CHARLOOKS 65909 . 67569) (
|
||||
\TEDIT.UNIQUIFY.PARALOOKS 67571 . 68838) (\TEDIT.UNIQUIFY.ALL 68840 . 70928) (
|
||||
\TEDIT.FLUSH.UNUSED.LOOKS 70930 . 73234)) (73269 85227 (TEDIT.LOOKS 73279 . 75668) (TEDIT.GET.LOOKS
|
||||
75670 . 78005) (TEDIT.SUBLOOKS 78007 . 82387) (TEDIT.FINDLOOKS 82389 . 85225)) (85228 115001 (
|
||||
\TEDIT.CHANGE.CHARLOOKS 85238 . 94139) (\TEDIT.CHANGE.CHARLOOKS.NEW 94141 . 97956) (
|
||||
\TEDIT.CHARLOOKS.CHANGE.FONT 97958 . 106265) (\TEDIT.FONT.NEXTSIZE 106267 . 107888) (\TEDIT.LOOKS
|
||||
107890 . 111219) (\TEDIT.FONTCOPY 111221 . 112722) (\TEDIT.COERCE.FONTCLASS 112724 . 113875) (
|
||||
\TEDIT.FONTCLASS.TO.FONT 113877 . 114999)) (115044 146933 (\TEDIT.EQFMTSPEC 115054 . 118269) (
|
||||
TEDIT.GET.PARALOOKS 118271 . 122318) (\TEDIT.PARSE.PARALOOKS.LIST 122320 . 130353) (TEDIT.PARALOOKS
|
||||
130355 . 131395) (\TEDIT.CHANGE.PARALOOKS 131397 . 138606) (\TEDIT.CHANGE.PARALOOKS.NEW 138608 .
|
||||
142591) (TEDIT.COPY.PARALOOKS 142593 . 145267) (\TEDIT.PARABOUNDS 145269 . 146931)) (146993 154709 (
|
||||
TEDIT.SUBPARALOOKS 147003 . 151105) (SAMEPARALOOKS 151107 . 154707)) (154710 155397 (
|
||||
\TEDIT.MARK.REVISION 154720 . 155395)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "14-Feb-2026 13:22:06" {WMEDLEY}<library>TEDIT>TEDIT-PCTREE.;251 68691
|
||||
(FILECREATED "28-Jul-2025 23:25:19"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-PCTREE.;249 69193
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDIT-PCTREECOMS)
|
||||
(FNS \TEDIT.UNLINKPIECE \TEDIT.DELETEPIECES)
|
||||
:CHANGES-TO (FNS \TEDIT.MAKEPCTB)
|
||||
|
||||
:PREVIOUS-DATE "28-Jul-2025 23:25:19" {WMEDLEY}<library>TEDIT>TEDIT-PCTREE.;249)
|
||||
:PREVIOUS-DATE " 8-Feb-2025 20:56:54"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-PCTREE.;248)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
|
||||
@@ -36,8 +37,8 @@
|
||||
(GLOBALVARS MULTIPLE-PIECE-TABLES)
|
||||
(FNS \TEDIT.MAKEPCTB \TEDIT.UPDATEPCNODES \TEDIT.FIRSTPIECE \TEDIT.DELETETREE
|
||||
\TEDIT.INSERTTREE \TEDIT.LASTPIECE \TEDIT.PCTOCH \TEDIT.CHTOPC \TEDIT.SET-TOTLEN
|
||||
\TEDIT.MAKE.VACANT.BTREESLOT \TEDIT.LINKNEWPIECE \TEDIT.SPLITPIECE \TEDIT.INSERTPIECE
|
||||
\TEDIT.INSERTPIECES \TEDIT.DELETEPIECES \TEDIT.ALIGNEDPIECE)
|
||||
\TEDIT.MAKE.VACANT.BTREESLOT \TEDIT.LINKNEWPIECE \TEDIT.UNLINKPIECE \TEDIT.SPLITPIECE
|
||||
\TEDIT.INSERTPIECE \TEDIT.INSERTPIECES \TEDIT.DELETEPIECES \TEDIT.ALIGNEDPIECE)
|
||||
(COMS (* ; "Debugging ")
|
||||
(FNS \TEDIT.BTVALIDATE \TEDIT.BTVALIDATE.PRINT \TEDIT.CHECK-BTREE \TEDIT.CHECK-BTREE1
|
||||
\TEDIT.BTFAIL \TEDIT.MATCHPCS)
|
||||
@@ -657,6 +658,20 @@
|
||||
(freplace (PIECE PREVPIECE) of NEXT with 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
|
||||
[LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:11 by rmk")
|
||||
@@ -823,8 +838,7 @@
|
||||
PIECES])
|
||||
|
||||
(\TEDIT.DELETEPIECES
|
||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 14-Feb-2026 13:20 by rmk")
|
||||
(* ; "Edited 7-Feb-2025 08:08 by rmk")
|
||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 7-Feb-2025 08:08 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 10:50 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:00 by rmk")
|
||||
(* ; "Edited 25-Nov-2023 12:12 by rmk")
|
||||
@@ -845,11 +859,6 @@
|
||||
(* ;; "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)
|
||||
(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)
|
||||
(SETQ PREV (PREVPIECE (GETSPC SELPIECES SPFIRST)))
|
||||
(* ; "For incremental chain-update")
|
||||
@@ -1104,13 +1113,13 @@
|
||||
(GLOBALVARS BTVALIDATETAGS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (8731 56217 (\TEDIT.MAKEPCTB 8741 . 10634) (\TEDIT.UPDATEPCNODES 10636 . 12930) (
|
||||
\TEDIT.FIRSTPIECE 12932 . 14339) (\TEDIT.DELETETREE 14341 . 17615) (\TEDIT.INSERTTREE 17617 . 20362) (
|
||||
\TEDIT.LASTPIECE 20364 . 21171) (\TEDIT.PCTOCH 21173 . 23270) (\TEDIT.CHTOPC 23272 . 29449) (
|
||||
\TEDIT.SET-TOTLEN 29451 . 30239) (\TEDIT.MAKE.VACANT.BTREESLOT 30241 . 36971) (\TEDIT.LINKNEWPIECE
|
||||
36973 . 38562) (\TEDIT.SPLITPIECE 38564 . 43220) (\TEDIT.INSERTPIECE 43222 . 46494) (
|
||||
\TEDIT.INSERTPIECES 46496 . 49588) (\TEDIT.DELETEPIECES 49590 . 54100) (\TEDIT.ALIGNEDPIECE 54102 .
|
||||
56215)) (56245 68568 (\TEDIT.BTVALIDATE 56255 . 57796) (\TEDIT.BTVALIDATE.PRINT 57798 . 59163) (
|
||||
\TEDIT.CHECK-BTREE 59165 . 61492) (\TEDIT.CHECK-BTREE1 61494 . 67125) (\TEDIT.BTFAIL 67127 . 67549) (
|
||||
\TEDIT.MATCHPCS 67551 . 68566)))))
|
||||
(FILEMAP (NIL (8767 56719 (\TEDIT.MAKEPCTB 8777 . 10670) (\TEDIT.UPDATEPCNODES 10672 . 12966) (
|
||||
\TEDIT.FIRSTPIECE 12968 . 14375) (\TEDIT.DELETETREE 14377 . 17651) (\TEDIT.INSERTTREE 17653 . 20398) (
|
||||
\TEDIT.LASTPIECE 20400 . 21207) (\TEDIT.PCTOCH 21209 . 23306) (\TEDIT.CHTOPC 23308 . 29485) (
|
||||
\TEDIT.SET-TOTLEN 29487 . 30275) (\TEDIT.MAKE.VACANT.BTREESLOT 30277 . 37007) (\TEDIT.LINKNEWPIECE
|
||||
37009 . 38598) (\TEDIT.UNLINKPIECE 38600 . 39420) (\TEDIT.SPLITPIECE 39422 . 44078) (
|
||||
\TEDIT.INSERTPIECE 44080 . 47352) (\TEDIT.INSERTPIECES 47354 . 50446) (\TEDIT.DELETEPIECES 50448 .
|
||||
54602) (\TEDIT.ALIGNEDPIECE 54604 . 56717)) (56747 69070 (\TEDIT.BTVALIDATE 56757 . 58298) (
|
||||
\TEDIT.BTVALIDATE.PRINT 58300 . 59665) (\TEDIT.CHECK-BTREE 59667 . 61994) (\TEDIT.CHECK-BTREE1 61996
|
||||
. 67627) (\TEDIT.BTFAIL 67629 . 68051) (\TEDIT.MATCHPCS 68053 . 69068)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "16-Feb-2026 00:38:33" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;738 162152
|
||||
(FILECREATED "14-Jan-2026 14:32:01" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;736 162073
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.SELPIECES.CHARTRANSFORM)
|
||||
:CHANGES-TO (FNS \TEDIT.COPYSEL TEDIT.SELPROP)
|
||||
|
||||
:PREVIOUS-DATE "14-Jan-2026 14:32:01" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;736)
|
||||
:PREVIOUS-DATE "10-Jan-2026 12:33:26" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;735)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-SELECTIONCOMS)
|
||||
@@ -2041,8 +2041,7 @@
|
||||
SPLASTCHAR _ (ffetch (SELPIECES SPLASTCHAR) of SP2])
|
||||
|
||||
(\TEDIT.SELPIECES.CHARTRANSFORM
|
||||
[LAMBDA (SELPIECES CHARFN OBJECTSTOO TSTREAM) (* ; "Edited 16-Feb-2026 00:38 by rmk")
|
||||
(* ; "Edited 24-Apr-2025 16:02 by rmk")
|
||||
[LAMBDA (SELPIECES CHARFN OBJECTSTOO TSTREAM) (* ; "Edited 24-Apr-2025 16:02 by rmk")
|
||||
(* ; "Edited 20-Apr-2025 23:23 by rmk")
|
||||
(* ; "Edited 16-Mar-2025 10:03 by rmk")
|
||||
(* ; "Edited 7-Nov-2024 21:50 by rmk")
|
||||
@@ -2067,10 +2066,10 @@
|
||||
|
||||
(* ;; "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 0 to (PLAST PC)
|
||||
do (RPLCHARCODE STR (ADD1 I)
|
||||
(APPLY* CHARFN (\TEDIT.PIECE.NTHCHARCODE PC I)
|
||||
(add INDEX 1]
|
||||
[for I from 1 to (PLEN PC)
|
||||
do (RPLCHARCODE STR I (APPLY* CHARFN (\TEDIT.PIECE.NTHCHARCODE
|
||||
PC I)
|
||||
(add INDEX 1]
|
||||
(if (fetch (STRINGP FATSTRINGP) of STR)
|
||||
then (FSETPC PC PTYPE FATSTRING.PTYPE)
|
||||
(FSETPC PC PBYTESPERCHAR 2)
|
||||
@@ -2571,26 +2570,26 @@
|
||||
(ADDTOVAR LAMA TEDIT.SELPROP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (15888 17709 (\TEDIT.SELECTION.DEFPRINT 15898 . 17707)) (17746 19251 (
|
||||
\TEDIT.SET.GLOBAL.SELECTIONS 17756 . 19249)) (19252 25473 (\TEDIT.SELECTED.PIECES 19262 . 20901) (
|
||||
\TEDIT.FIND.PROTECTED.END 20903 . 22697) (\TEDIT.FIND.PROTECTED.START 22699 . 24682) (
|
||||
\TEDIT.WORD.BOUND 24684 . 25471)) (25607 59714 (\TEDIT.EXTEND.SEL 25617 . 32857) (\TEDIT.SCAN.LINE
|
||||
32859 . 44532) (\TEDIT.SCAN.LINE.WORD 44534 . 49527) (\TEDIT.XYTOSEL 49529 . 56867) (\TEDIT.REGIONTYPE
|
||||
56869 . 57888) (\TEDIT.XYTOSEL.INLINEP 57890 . 58345) (\TEDIT.XYTOSEL.LINE 58347 . 59712)) (59715
|
||||
73260 (\TEDIT.FIXSEL 59725 . 69102) (\TEDIT.CHTOLINEX 69104 . 73258)) (73261 77465 (
|
||||
\TEDIT.RESET.EXTEND.PENDING.DELETE 73271 . 74549) (\TEDIT.SET.SEL.LOOKS 74551 . 77463)) (78402 99555 (
|
||||
\TEDIT.SHOWSEL 78412 . 83388) (\TEDIT.NOSEL 83390 . 83691) (\TEDIT.SEL.OFF 83693 . 84104) (
|
||||
\TEDIT.SEL.ON 84106 . 84522) (\TEDIT.SHOWSEL.HILIGHT 84524 . 89145) (\TEDIT.UPDATE.SEL 89147 . 93749)
|
||||
(\TEDIT.CARETLINE 93751 . 94465) (\TEDIT.SEL.L1 94467 . 95150) (\TEDIT.SEL.LN 95152 . 95835) (
|
||||
\TEDIT.SEL.DELETEDCHARS 95837 . 99553)) (99556 104438 (\TEDIT.COPYSEL 99566 . 102208) (
|
||||
\TEDIT.SEL.CHANGED? 102210 . 104436)) (104469 118128 (\TEDIT.SELECT.OBJECT 104479 . 109432) (
|
||||
\TEDIT.SHOWSEL.OBJECT 109434 . 111665) (\TEDIT.CLIP.OBJECT 111667 . 113671) (\TEDIT.OPERATE.OBJECT
|
||||
113673 . 118126)) (118156 137982 (\TEDIT.SELPIECES 118166 . 122447) (\TEDIT.SELPIECES.COPY 122449 .
|
||||
124938) (\TEDIT.SELPIECES.CONCAT 124940 . 126819) (\TEDIT.SELPIECES.CHARTRANSFORM 126821 . 130357) (
|
||||
\TEDIT.SELPIECES.FROM.STRING 130359 . 135617) (\TEDIT.SELPIECES.TO.STRING 135619 . 137980)) (138035
|
||||
161983 (TEDIT.XYTOCH 138045 . 140621) (TEDIT.SELPROP 140623 . 144900) (TEDIT.GETPOINT 144902 . 146822)
|
||||
(TEDIT.GETSEL 146824 . 147700) (TEDIT.GETSEL.PARA 147702 . 148651) (TEDIT.SCANSEL 148653 . 149601) (
|
||||
TEDIT.SET.SEL.LOOKS 149603 . 151088) (TEDIT.SETSEL 151090 . 156008) (TEDIT.SHOWSEL 156010 . 157874) (
|
||||
TEDIT.SEL.AS.STRING 157876 . 160361) (TEDIT.SEL.AS.SEXPR 160363 . 161649) (TEDIT.SELECTALL 161651 .
|
||||
161981)))))
|
||||
(FILEMAP (NIL (15886 17707 (\TEDIT.SELECTION.DEFPRINT 15896 . 17705)) (17744 19249 (
|
||||
\TEDIT.SET.GLOBAL.SELECTIONS 17754 . 19247)) (19250 25471 (\TEDIT.SELECTED.PIECES 19260 . 20899) (
|
||||
\TEDIT.FIND.PROTECTED.END 20901 . 22695) (\TEDIT.FIND.PROTECTED.START 22697 . 24680) (
|
||||
\TEDIT.WORD.BOUND 24682 . 25469)) (25605 59712 (\TEDIT.EXTEND.SEL 25615 . 32855) (\TEDIT.SCAN.LINE
|
||||
32857 . 44530) (\TEDIT.SCAN.LINE.WORD 44532 . 49525) (\TEDIT.XYTOSEL 49527 . 56865) (\TEDIT.REGIONTYPE
|
||||
56867 . 57886) (\TEDIT.XYTOSEL.INLINEP 57888 . 58343) (\TEDIT.XYTOSEL.LINE 58345 . 59710)) (59713
|
||||
73258 (\TEDIT.FIXSEL 59723 . 69100) (\TEDIT.CHTOLINEX 69102 . 73256)) (73259 77463 (
|
||||
\TEDIT.RESET.EXTEND.PENDING.DELETE 73269 . 74547) (\TEDIT.SET.SEL.LOOKS 74549 . 77461)) (78400 99553 (
|
||||
\TEDIT.SHOWSEL 78410 . 83386) (\TEDIT.NOSEL 83388 . 83689) (\TEDIT.SEL.OFF 83691 . 84102) (
|
||||
\TEDIT.SEL.ON 84104 . 84520) (\TEDIT.SHOWSEL.HILIGHT 84522 . 89143) (\TEDIT.UPDATE.SEL 89145 . 93747)
|
||||
(\TEDIT.CARETLINE 93749 . 94463) (\TEDIT.SEL.L1 94465 . 95148) (\TEDIT.SEL.LN 95150 . 95833) (
|
||||
\TEDIT.SEL.DELETEDCHARS 95835 . 99551)) (99554 104436 (\TEDIT.COPYSEL 99564 . 102206) (
|
||||
\TEDIT.SEL.CHANGED? 102208 . 104434)) (104467 118126 (\TEDIT.SELECT.OBJECT 104477 . 109430) (
|
||||
\TEDIT.SHOWSEL.OBJECT 109432 . 111663) (\TEDIT.CLIP.OBJECT 111665 . 113669) (\TEDIT.OPERATE.OBJECT
|
||||
113671 . 118124)) (118154 137903 (\TEDIT.SELPIECES 118164 . 122445) (\TEDIT.SELPIECES.COPY 122447 .
|
||||
124936) (\TEDIT.SELPIECES.CONCAT 124938 . 126817) (\TEDIT.SELPIECES.CHARTRANSFORM 126819 . 130278) (
|
||||
\TEDIT.SELPIECES.FROM.STRING 130280 . 135538) (\TEDIT.SELPIECES.TO.STRING 135540 . 137901)) (137956
|
||||
161904 (TEDIT.XYTOCH 137966 . 140542) (TEDIT.SELPROP 140544 . 144821) (TEDIT.GETPOINT 144823 . 146743)
|
||||
(TEDIT.GETSEL 146745 . 147621) (TEDIT.GETSEL.PARA 147623 . 148572) (TEDIT.SCANSEL 148574 . 149522) (
|
||||
TEDIT.SET.SEL.LOOKS 149524 . 151009) (TEDIT.SETSEL 151011 . 155929) (TEDIT.SHOWSEL 155931 . 157795) (
|
||||
TEDIT.SEL.AS.STRING 157797 . 160282) (TEDIT.SEL.AS.SEXPR 160284 . 161570) (TEDIT.SELECTALL 161572 .
|
||||
161902)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "16-Feb-2026 12:40:44" {WMEDLEY}<library>tedit>TEDIT-STREAM.;944 193110
|
||||
(FILECREATED "26-Jan-2026 23:58:48" {WMEDLEY}<library>tedit>TEDIT-STREAM.;936 194450
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.STREAMINIT)
|
||||
:CHANGES-TO (VARS TEDIT-STREAMCOMS)
|
||||
(FNS TEDIT.IMAGESTREAM.OPEN \TEDIT.STREAMINIT \TEDIT.TEXTINIT)
|
||||
|
||||
:PREVIOUS-DATE "16-Feb-2026 09:39:00" {WMEDLEY}<library>tedit>TEDIT-STREAM.;943)
|
||||
:PREVIOUS-DATE "14-Jan-2026 14:32:01" {WMEDLEY}<library>tedit>TEDIT-STREAM.;933)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-STREAMCOMS)
|
||||
@@ -14,8 +15,8 @@
|
||||
(RPAQQ TEDIT-STREAMCOMS
|
||||
[(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(EXPORT (RECORDS PIECE TEXTOBJ TEXTSTREAM)
|
||||
(MACROS NEXTPIECE PREVPIECE PLEN PLAST PTYPE PCONTENTS PCHARLOOKS PCHARSET
|
||||
PPARALOOKS PPARALAST PFPOS PBYTELEN PNEW PBINABLE PBYTESPERCHAR POBJ)
|
||||
(MACROS NEXTPIECE PREVPIECE PLEN PTYPE PCONTENTS PCHARLOOKS PCHARSET PPARALOOKS
|
||||
PPARALAST PFPOS PBYTELEN PNEW PBINABLE PBYTESPERCHAR POBJ)
|
||||
(MACROS SETPC FSETPC GETPC FGETPC)
|
||||
(MACROS THINPIECEP)
|
||||
(MACROS VISIBLEPIECEP \NEXT.VISIBLE.PIECE \PREV.VISIBLE.PIECE)
|
||||
@@ -71,7 +72,10 @@
|
||||
(MACROS \INSERTCH.EXTENDABLE))
|
||||
(FNS \TEDIT.DELETE.SELPIECES \TEDIT.INSERTCH \TEDIT.INSERTCH.HISTORY \TEDIT.INSERTEOL
|
||||
\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)
|
||||
[COMS (* ; "Support for TEXTPROP")
|
||||
(FNS TEXTPROP GETTEXTPROP PUTTEXTPROP GETTEXTPROPS PUTTEXTPROPS TEXTPROP.ADD
|
||||
@@ -393,9 +397,6 @@
|
||||
(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)))
|
||||
|
||||
@@ -923,8 +924,7 @@
|
||||
else (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM])
|
||||
|
||||
(\TEDIT.TEXTBACKFILEPTR
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 16-Feb-2026 08:54 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 1-Feb-2024 11:25 by rmk")
|
||||
(* ; "Edited 5-Jan-2024 17:57 by rmk")
|
||||
(* ; "Edited 28-Dec-2023 13:34 by rmk")
|
||||
@@ -956,7 +956,7 @@
|
||||
then (CL:WHEN (SETQ PPC (\PREV.VISIBLE.PIECE PC))
|
||||
(* ;
|
||||
"Back up to last char of previous piece, if any.")
|
||||
(\TEDIT.INSTALL.PIECE TSTREAM PPC (PLAST PPC))
|
||||
(\TEDIT.INSTALL.PIECE TSTREAM PPC (SUB1 (PLEN PPC)))
|
||||
(SETQ PC PPC))
|
||||
elseif (AND (MEMB (PTYPE PC)
|
||||
FILE.PTYPES)
|
||||
@@ -1760,8 +1760,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.STREAMINIT
|
||||
[LAMBDA NIL (* ; "Edited 16-Feb-2026 12:40 by rmk")
|
||||
(* ; "Edited 26-Jan-2026 16:06 by rmk")
|
||||
[LAMBDA NIL (* ; "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 18-Sep-2025 14:52 by rmk")
|
||||
@@ -1818,7 +1817,7 @@
|
||||
|
||||
(* ;; "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 :TEDIT (FUNCTION \TEDIT.TEXTINCCODEFN)
|
||||
(MAKE-EXTERNALFORMAT :TEXTSTREAM (FUNCTION \TEDIT.TEXTINCCODEFN)
|
||||
(FUNCTION \TEDIT.TEXTPEEKBIN)
|
||||
(FUNCTION \TEDIT.TEXTBACKCCODEFN)
|
||||
(FUNCTION \TEDIT.TEXTOUTCHARFN)
|
||||
@@ -1861,7 +1860,8 @@
|
||||
FDEXTENDABLE _ NIL
|
||||
TRUNCATEFILE _ (FUNCTION NILL)
|
||||
WRITEPAGES _ (FUNCTION NILL)
|
||||
DEFAULTEXTERNALFORMAT _ :TEDIT)) (* ;
|
||||
DEFAULTEXTERNALFORMAT _ :TEXTSTREAM))
|
||||
(* ;
|
||||
"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))
|
||||
(CL:SETF (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN)
|
||||
@@ -2256,8 +2256,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.NTHCHARCODE
|
||||
[LAMBDA (TSTREAM N) (* ; "Edited 15-Feb-2026 14:40 by rmk")
|
||||
(* ; "Edited 24-Apr-2025 16:03 by rmk")
|
||||
[LAMBDA (TSTREAM N) (* ; "Edited 24-Apr-2025 16:03 by rmk")
|
||||
(* ; "Edited 28-Mar-2025 18:31 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:09 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 13:06 by rmk")
|
||||
@@ -2274,11 +2273,11 @@
|
||||
(CL:WHEN (AND (IGEQ N 1)
|
||||
(ILEQ N (FGETTOBJ TEXTOBJ TEXTLEN)))
|
||||
(\TEDIT.PIECE.NTHCHARCODE (\TEDIT.CHTOPC N TEXTOBJ T)
|
||||
(IDIFFERENCE N START-OF-PIECE)))])
|
||||
(IDIFFERENCE (ADD1 N)
|
||||
START-OF-PIECE)))])
|
||||
|
||||
(\TEDIT.PIECE.NTHCHARCODE
|
||||
[LAMBDA (PC OFFSET) (* ; "Edited 15-Feb-2026 14:31 by rmk")
|
||||
(* ; "Edited 24-Apr-2025 16:04 by rmk")
|
||||
[LAMBDA (PC OFFSET) (* ; "Edited 24-Apr-2025 16:04 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 08:46 by rmk")
|
||||
(* ; "Edited 22-Mar-2024 00:02 by rmk")
|
||||
@@ -2290,24 +2289,24 @@
|
||||
(* ; "Edited 8-Nov-2023 08:43 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. OFFSET ranges from 0 to PLEN-1.")
|
||||
(* ;; "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.")
|
||||
|
||||
(CL:WHEN (AND (IGEQ OFFSET 0)
|
||||
(ILESSP OFFSET (PLEN PC)))
|
||||
(CL:WHEN (AND (IGEQ OFFSET 1)
|
||||
(ILEQ OFFSET (PLEN PC)))
|
||||
[LET ((PCONTENTS (PCONTENTS PC))
|
||||
FILEPOS)
|
||||
(SELECTC (PTYPE PC)
|
||||
(STRING.PTYPES (NTHCHARCODE PCONTENTS (ADD1 OFFSET)))
|
||||
(STRING.PTYPES (NTHCHARCODE PCONTENTS OFFSET))
|
||||
(THINFILE.PTYPE
|
||||
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
||||
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
||||
OFFSET))
|
||||
(SUB1 OFFSET)))
|
||||
(PROG1 (BIN PCONTENTS)
|
||||
(\SETFILEPTR PCONTENTS FILEPOS)))
|
||||
(FATFILE1.PTYPE
|
||||
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
||||
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
||||
OFFSET))
|
||||
(SUB1 OFFSET)))
|
||||
(PROG1 (create WORD
|
||||
HIBYTE _ (PCHARSET PC)
|
||||
LOBYTE _ (BIN PCONTENTS))
|
||||
@@ -2315,12 +2314,14 @@
|
||||
(FATFILE2.PTYPE
|
||||
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
||||
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
||||
(UNFOLD OFFSET 2)))
|
||||
(UNFOLD (SUB1 OFFSET)
|
||||
2)))
|
||||
(PROG1 (\WIN PCONTENTS)
|
||||
(\SETFILEPTR PCONTENTS FILEPOS)))
|
||||
(UTF8.PTYPE (SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
||||
[\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
||||
(ITIMES OFFSET (PBYTESPERCHAR PC]
|
||||
(ITIMES (SUB1 OFFSET)
|
||||
(PBYTESPERCHAR PC]
|
||||
(PROG1 (UTF8.INCCODEFN PCONTENTS)
|
||||
(\SETFILEPTR PCONTENTS FILEPOS)))
|
||||
(OBJECT.PTYPE PCONTENTS)
|
||||
@@ -2333,8 +2334,7 @@
|
||||
(\TEDIT.THELP '\TEDIT.PIECE.NTHCHARCODE])])
|
||||
|
||||
(\TEDIT.RPLCHARCODE
|
||||
[LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "Edited 16-Feb-2026 08:37 by rmk")
|
||||
(* ; "Edited 24-Apr-2025 17:24 by rmk")
|
||||
[LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "Edited 24-Apr-2025 17:24 by rmk")
|
||||
(* ; "Edited 20-Apr-2025 13:25 by rmk")
|
||||
(* ; "Edited 28-Mar-2025 10:04 by rmk")
|
||||
|
||||
@@ -2350,17 +2350,16 @@
|
||||
(DECLARE (SPECVARS START-OF-PIECE))
|
||||
(replace (STREAM BINABLE) of TSTREAM with NIL)
|
||||
(SETQ OLDCHAR (\TEDIT.PIECE.RPLCHARCODE TEXTOBJ (\TEDIT.CHTOPC N TEXTOBJ T)
|
||||
(IDIFFERENCE N START-OF-PIECE)
|
||||
(ADD1 (IDIFFERENCE N START-OF-PIECE))
|
||||
NEWCHARCODE NEWCHARLOOKS))
|
||||
(\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :ReplaceCode N 1 NIL NIL
|
||||
(\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :ReplaceCode N NIL NIL NIL
|
||||
OLDCHAR))
|
||||
(CL:UNLESS (OR DONTDISPLAY (NOT (\TEDIT.PRIMARYPANE TEXTOBJ)))
|
||||
(\TEDIT.UPDATE.LINES TSTREAM 'CHANGED N 1))
|
||||
TSTREAM))])
|
||||
|
||||
(\TEDIT.PIECE.RPLCHARCODE
|
||||
[LAMBDA (TEXTOBJ PC OFFSET NEWCHARCODE NEWCHARLOOKS) (* ; "Edited 16-Feb-2026 08:41 by rmk")
|
||||
(* ; "Edited 28-Jul-2025 23:38 by rmk")
|
||||
[LAMBDA (TEXTOBJ PC OFFSET NEWCHARCODE NEWCHARLOOKS) (* ; "Edited 28-Jul-2025 23:38 by rmk")
|
||||
(* ; "Edited 24-Apr-2025 16:30 by rmk")
|
||||
(* ; "Edited 20-Apr-2025 13:25 by rmk")
|
||||
(* ; "Edited 28-Mar-2025 10:04 by rmk")
|
||||
@@ -2385,13 +2384,12 @@
|
||||
"Fast case: Smash a new character code into an existing string piece with same looks. ")
|
||||
|
||||
(SETQ OLDCHAR (NTHCHARCODE (PCONTENTS PC)
|
||||
(ADD1 OFFSET)))
|
||||
OFFSET))
|
||||
(RPLCHARCODE (PCONTENTS PC)
|
||||
(ADD1 OFFSET)
|
||||
NEWCHARCODE) (* ;
|
||||
OFFSET NEWCHARCODE) (* ;
|
||||
"May upgrade string from thin to fat")
|
||||
(CL:WHEN (AND (EQ THINSTRING.PTYPE (PTYPE PC))
|
||||
(IGREATERP NEWCHARCODE \MAXTHINCHAR))
|
||||
(IGREATERP NEWCHARCODE 255))
|
||||
(FSETPC PC PTYPE FATSTRING.PTYPE)
|
||||
(FSETPC PC PBINABLE NIL)
|
||||
(FSETPC PC PBYTESPERCHAR 2)
|
||||
@@ -2405,25 +2403,24 @@
|
||||
(FSETPC PC PCONTENTS NEWCHARCODE)
|
||||
else
|
||||
(* ;;
|
||||
"The PC that contained character OFFSET now becomes the suffix of characters after offset.")
|
||||
"PC contained character OFFSET now becomes the suffix of characters after offset.")
|
||||
|
||||
(CL:UNLESS (IEQP OFFSET (PLAST PC)) (* ; "No suffix for the last character")
|
||||
(CL:UNLESS (IEQP OFFSET (PLEN PC)) (* ; "No suffix for the last character")
|
||||
|
||||
(* ;;
|
||||
"Chop off the suffix (essentially (\TEDIT.ALIGNEDPIECE CHNO ..) but we already have the piece")
|
||||
|
||||
(\TEDIT.SPLITPIECE PC (ADD1 OFFSET)
|
||||
TEXTOBJ)
|
||||
(\TEDIT.SPLITPIECE PC OFFSET TEXTOBJ)
|
||||
(SETQ PC (PREVPIECE PC))) (* ;
|
||||
"Original PC holds the suffix, new PC ends with change position.")
|
||||
(CL:UNLESS (EQ OFFSET 0)
|
||||
(CL:UNLESS (EQ OFFSET 1)
|
||||
(SETQ PC (\TEDIT.SPLITPIECE PC (SUB1 OFFSET)
|
||||
TEXTOBJ))) (* ;
|
||||
"Chop off the prefix. PC is now the singleton target ")
|
||||
|
||||
(* ;; "OFFSET is now isolated into a one-character new piece which we smash. ")
|
||||
|
||||
(SETQ OLDCHAR (\TEDIT.PIECE.NTHCHARCODE PC 0))
|
||||
(SETQ OLDCHAR (\TEDIT.PIECE.NTHCHARCODE PC 1))
|
||||
(if (IMAGEOBJP NEWCHARCODE)
|
||||
then (FSETPC PC PBINABLE NIL)
|
||||
(FSETPC PC PCONTENTS NEWCHARCODE)
|
||||
@@ -2433,7 +2430,7 @@
|
||||
else (FSETPC PC PCONTENTS (MKSTRING (CHARACTER NEWCHARCODE)))
|
||||
(* ;
|
||||
"Use the extend-string in INSERTCH for repeated calls?")
|
||||
(if (IGREATERP NEWCHARCODE \MAXTHINCHAR)
|
||||
(if (IGREATERP NEWCHARCODE 255)
|
||||
then (FSETPC PC PTYPE FATSTRING.PTYPE)
|
||||
(FSETPC PC PBINABLE NIL)
|
||||
(FSETPC PC PBYTESPERCHAR 2)
|
||||
@@ -2820,8 +2817,7 @@
|
||||
else (SUB1 (\TEDIT.PCTOCH PC TEXTOBJ])
|
||||
|
||||
(\TEDIT.LASTCHANGEABLE.CHNO
|
||||
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 16-Feb-2026 08:53 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 00:00 by rmk")
|
||||
[LAMBDA (CHNO TEXTOBJ) (* ; "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.")
|
||||
|
||||
@@ -2830,11 +2826,46 @@
|
||||
CLPROTECTED) when (VISIBLEPIECEP PC)
|
||||
do (RETURN (if (EQ PC FIRSTPIECE)
|
||||
then CHNO
|
||||
else (IPLUS (PLAST PC)
|
||||
else (IPLUS (SUB1 (PLEN PC))
|
||||
(\TEDIT.PCTOCH PC TEXTOBJ])
|
||||
)
|
||||
(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
|
||||
[LAMBDA (TSTREAM PC CHOFFSET) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 18-May-2024 22:39 by rmk")
|
||||
@@ -3127,33 +3158,34 @@
|
||||
(ADDTOVAR LAMA TEXTPROP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (36667 67629 (\TEDIT.TEXTBIN 36677 . 47470) (\TEDIT.TEXTPEEKBIN 47472 . 53022) (
|
||||
\TEDIT.TEXTBACKFILEPTR 53024 . 58800) (\TEDIT.TEXTBOUT 58802 . 63419) (\TEDIT.INSTALL.FILEBUFFER 63421
|
||||
. 67627)) (68527 72818 (\TEDIT.TEXTOUTCHARFN 68537 . 70093) (\TEDIT.TEXTINCCODEFN 70095 . 70834) (
|
||||
\TEDIT.TEXTBACKCCODEFN 70836 . 71428) (\TEDIT.TEXTFORMATBYTESTREAM 71430 . 72267) (
|
||||
\TEDIT.TEXTFORMATBYTESTRING 72269 . 72816)) (72865 84940 (OPENTEXTSTREAM 72875 . 79851) (
|
||||
COPYTEXTSTREAM 79853 . 84163) (TEDIT.STREAMCHANGEDP 84165 . 84467) (TXTFILE 84469 . 84938)) (84941
|
||||
108146 (\TEDIT.REOPENTEXTSTREAM 84951 . 86303) (\TEDIT.OPENTEXTSTREAM.PIECES 86305 . 91233) (
|
||||
\TEDIT.OPENTEXTSTREAM.PROPS 91235 . 92337) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92339 . 97789) (
|
||||
\TEDIT.OPENTEXTSTREAM.WINDOW 97791 . 100582) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100584 . 102523) (
|
||||
\TEDIT.OPENTEXTFILE 102525 . 104657) (\TEDIT.CREATE.TEXTSTREAM 104659 . 105806) (\TEDIT.REOPEN.STREAM
|
||||
105808 . 108144)) (108147 116372 (\TEDIT.STREAMINIT 108157 . 116189) (TEDIT.IMAGESTREAM.OPEN 116191 .
|
||||
116370)) (116560 117748 (\TEDIT.TTYBOUT 116570 . 117746)) (117866 139549 (\TEDIT.TEXTCLOSEF 117876 .
|
||||
119200) (\TEDIT.TEXTDSPFONT 119202 . 120400) (\TEDIT.TEXTEOFP 120402 . 122157) (\TEDIT.TEXTGETEOFPTR
|
||||
122159 . 122482) (\TEDIT.TEXTSETEOFPTR 122484 . 123771) (\TEDIT.TEXTGETFILEPTR 123773 . 126608) (
|
||||
\TEDIT.TEXTSETFILEINFO 126610 . 127118) (\TEDIT.TEXTOPENF 127120 . 128051) (\TEDIT.TEXTSETEOF 128053
|
||||
. 128669) (\TEDIT.TEXTSETFILEPTR 128671 . 130781) (\TEDIT.TEXTDSPXPOSITION 130783 . 133486) (
|
||||
\TEDIT.TEXTDSPYPOSITION 133488 . 134229) (\TEDIT.TEXTLEFTMARGIN 134231 . 134822) (\TEDIT.TEXTCOLOR
|
||||
134824 . 135407) (\TEDIT.TEXTRIGHTMARGIN 135409 . 138698) (\TEDIT.TEXTDSPCHARWIDTH 138700 . 139004) (
|
||||
\TEDIT.TEXTDSPSTRINGWIDTH 139006 . 139312) (\TEDIT.TEXTDSPLINEFEED 139314 . 139547)) (139587 152583 (
|
||||
\TEDIT.NTHCHARCODE 139597 . 141123) (\TEDIT.PIECE.NTHCHARCODE 141125 . 145033) (\TEDIT.RPLCHARCODE
|
||||
145035 . 146593) (\TEDIT.PIECE.RPLCHARCODE 146595 . 152228) (\TEDIT.NTHCHARLOOKS 152230 . 152581)) (
|
||||
153630 174724 (\TEDIT.DELETE.SELPIECES 153640 . 157265) (\TEDIT.INSERTCH 157267 . 165306) (
|
||||
\TEDIT.INSERTCH.HISTORY 165308 . 168772) (\TEDIT.INSERTEOL 168774 . 170599) (\TEDIT.INSERTCH.INSERTION
|
||||
170601 . 173438) (\TEDIT.INSERTCH.EXTEND 173440 . 174722)) (174725 176332 (\TEDIT.NEXTCHANGEABLE.CHNO
|
||||
174735 . 175450) (\TEDIT.LASTCHANGEABLE.CHNO 175452 . 176330)) (176333 180791 (\TEDIT.INSTALL.PIECE
|
||||
176343 . 180789)) (180829 190295 (TEXTPROP 180839 . 181186) (GETTEXTPROP 181188 . 181432) (PUTTEXTPROP
|
||||
181434 . 181691) (GETTEXTPROPS 181693 . 182137) (PUTTEXTPROPS 182139 . 183043) (TEXTPROP.ADD 183045
|
||||
. 183308) (\TEDIT.TEXTPROP 183310 . 190293)) (190296 192673 (\TEDIT.TEXTOBJ.PROPNAMES 190306 . 191565
|
||||
) (\TEDIT.TEXTOBJ.PROPFETCHFN 191567 . 192083) (\TEDIT.TEXTOBJ.PROPSTOREFN 192085 . 192671)))))
|
||||
(FILEMAP (NIL (36872 67731 (\TEDIT.TEXTBIN 36882 . 47675) (\TEDIT.TEXTPEEKBIN 47677 . 53227) (
|
||||
\TEDIT.TEXTBACKFILEPTR 53229 . 58902) (\TEDIT.TEXTBOUT 58904 . 63521) (\TEDIT.INSTALL.FILEBUFFER 63523
|
||||
. 67729)) (68629 72920 (\TEDIT.TEXTOUTCHARFN 68639 . 70195) (\TEDIT.TEXTINCCODEFN 70197 . 70936) (
|
||||
\TEDIT.TEXTBACKCCODEFN 70938 . 71530) (\TEDIT.TEXTFORMATBYTESTREAM 71532 . 72369) (
|
||||
\TEDIT.TEXTFORMATBYTESTRING 72371 . 72918)) (72967 85042 (OPENTEXTSTREAM 72977 . 79953) (
|
||||
COPYTEXTSTREAM 79955 . 84265) (TEDIT.STREAMCHANGEDP 84267 . 84569) (TXTFILE 84571 . 85040)) (85043
|
||||
108248 (\TEDIT.REOPENTEXTSTREAM 85053 . 86405) (\TEDIT.OPENTEXTSTREAM.PIECES 86407 . 91335) (
|
||||
\TEDIT.OPENTEXTSTREAM.PROPS 91337 . 92439) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92441 . 97891) (
|
||||
\TEDIT.OPENTEXTSTREAM.WINDOW 97893 . 100684) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100686 . 102625) (
|
||||
\TEDIT.OPENTEXTFILE 102627 . 104759) (\TEDIT.CREATE.TEXTSTREAM 104761 . 105908) (\TEDIT.REOPEN.STREAM
|
||||
105910 . 108246)) (108249 116436 (\TEDIT.STREAMINIT 108259 . 116253) (TEDIT.IMAGESTREAM.OPEN 116255 .
|
||||
116434)) (116624 117812 (\TEDIT.TTYBOUT 116634 . 117810)) (117930 139613 (\TEDIT.TEXTCLOSEF 117940 .
|
||||
119264) (\TEDIT.TEXTDSPFONT 119266 . 120464) (\TEDIT.TEXTEOFP 120466 . 122221) (\TEDIT.TEXTGETEOFPTR
|
||||
122223 . 122546) (\TEDIT.TEXTSETEOFPTR 122548 . 123835) (\TEDIT.TEXTGETFILEPTR 123837 . 126672) (
|
||||
\TEDIT.TEXTSETFILEINFO 126674 . 127182) (\TEDIT.TEXTOPENF 127184 . 128115) (\TEDIT.TEXTSETEOF 128117
|
||||
. 128733) (\TEDIT.TEXTSETFILEPTR 128735 . 130845) (\TEDIT.TEXTDSPXPOSITION 130847 . 133550) (
|
||||
\TEDIT.TEXTDSPYPOSITION 133552 . 134293) (\TEDIT.TEXTLEFTMARGIN 134295 . 134886) (\TEDIT.TEXTCOLOR
|
||||
134888 . 135471) (\TEDIT.TEXTRIGHTMARGIN 135473 . 138762) (\TEDIT.TEXTDSPCHARWIDTH 138764 . 139068) (
|
||||
\TEDIT.TEXTDSPSTRINGWIDTH 139070 . 139376) (\TEDIT.TEXTDSPLINEFEED 139378 . 139611)) (139651 152264 (
|
||||
\TEDIT.NTHCHARCODE 139661 . 141112) (\TEDIT.PIECE.NTHCHARCODE 141114 . 145024) (\TEDIT.RPLCHARCODE
|
||||
145026 . 146484) (\TEDIT.PIECE.RPLCHARCODE 146486 . 151909) (\TEDIT.NTHCHARLOOKS 151911 . 152262)) (
|
||||
153311 174405 (\TEDIT.DELETE.SELPIECES 153321 . 156946) (\TEDIT.INSERTCH 156948 . 164987) (
|
||||
\TEDIT.INSERTCH.HISTORY 164989 . 168453) (\TEDIT.INSERTEOL 168455 . 170280) (\TEDIT.INSERTCH.INSERTION
|
||||
170282 . 173119) (\TEDIT.INSERTCH.EXTEND 173121 . 174403)) (174406 175910 (\TEDIT.NEXTCHANGEABLE.CHNO
|
||||
174416 . 175131) (\TEDIT.LASTCHANGEABLE.CHNO 175133 . 175908)) (175911 177615 (\SETUPGETCH 175921 .
|
||||
177613)) (177673 182131 (\TEDIT.INSTALL.PIECE 177683 . 182129)) (182169 191635 (TEXTPROP 182179 .
|
||||
182526) (GETTEXTPROP 182528 . 182772) (PUTTEXTPROP 182774 . 183031) (GETTEXTPROPS 183033 . 183477) (
|
||||
PUTTEXTPROPS 183479 . 184383) (TEXTPROP.ADD 184385 . 184648) (\TEDIT.TEXTPROP 184650 . 191633)) (
|
||||
191636 194013 (\TEDIT.TEXTOBJ.PROPNAMES 191646 . 192905) (\TEDIT.TEXTOBJ.PROPFETCHFN 192907 . 193423)
|
||||
(\TEDIT.TEXTOBJ.PROPSTOREFN 193425 . 194011)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "16-Feb-2026 08:56:58"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;249 52790
|
||||
(FILECREATED "14-Jan-2026 14:50:53"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;248 52743
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "14-Jan-2026 14:50:53" {WMEDLEY}<library>TEDIT>tedit-exports.all;248)
|
||||
:PREVIOUS-DATE "10-Jan-2026 23:04:09" {WMEDLEY}<library>TEDIT>tedit-exports.all;247)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION
|
||||
@@ -17,7 +17,7 @@ PRINT))))))))
|
||||
(PUTPROPS FTEXTOBJ MACRO ((X) (TEXTOBJ! (CL:IF (type? TEXTOBJ X) X (GETTSTR X TEXTOBJ)))))
|
||||
(GLOBALVARS CHECK-TEDIT-ASSERTIONS)
|
||||
(RPAQ? CHECK-TEDIT-ASSERTIONS T)
|
||||
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE " 4-Feb-2026 16:02:02"))
|
||||
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "10-Jan-2026 01:39:21"))
|
||||
(RPAQQ \BTREEWORDSPERSLOT 4)
|
||||
(RPAQQ \BTREEMAXCOUNT 8)
|
||||
(CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
|
||||
@@ -51,7 +51,7 @@ DLEN1 DOWN2 DLEN2 DOWN3 DLEN3 DOWN4 DLEN4 DOWN5 DLEN5 DOWN6 DLEN6 DOWN7 DLEN7 DO
|
||||
(\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)))
|
||||
by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
|
||||
(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "14-Feb-2026 13:22:06"))
|
||||
(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "28-Jul-2025 23:25:19"))
|
||||
(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."
|
||||
) (* ;; "If DCH > 0, highlighting goes from CH# to (SUB1 CHLIM = (SUB1 (IPLUS CH# DCH)).") (* ;;
|
||||
@@ -128,7 +128,7 @@ TSTREAM ONLYPANE DONTFIX)))
|
||||
(PUTPROPS \TEDIT.SEL.OFF MACRO ((TSTREAM SEL ONLYPANE) (* ;
|
||||
"Takes down SEL in TSTREAM, where SEL defaults to the current selection") (\TEDIT.SHOWSEL SEL NIL
|
||||
TSTREAM ONLYPANE)))
|
||||
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "16-Feb-2026 00:38:33"))
|
||||
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "14-Jan-2026 14:32:01"))
|
||||
(RECORD TAB (TABX . TABKIND))
|
||||
(RECORD TABSPEC (DEFAULTTAB . TABS))
|
||||
(DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ;
|
||||
@@ -259,7 +259,7 @@ NEXTAVAILABLECHARSLOT) of THISLINE))) (T $$STARTSLOT))) (SETQ $$CHARSLOTLIMIT (F
|
||||
) 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.
|
||||
$$CHARSLOTLIMIT))))) T)
|
||||
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE " 5-Feb-2026 00:39:54"))
|
||||
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "31-Dec-2025 23:10:18"))
|
||||
(DATATYPE PIECE ((* ;
|
||||
"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)."
|
||||
@@ -372,7 +372,6 @@ IMAGEDATA _ NIL)))
|
||||
(PUTPROPS NEXTPIECE MACRO ((PC) (ffetch (PIECE NEXTPIECE) of PC)))
|
||||
(PUTPROPS PREVPIECE MACRO ((PC) (ffetch (PIECE PREVPIECE) 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 PCONTENTS MACRO ((PC) (ffetch (PIECE PCONTENTS) of PC)))
|
||||
(PUTPROPS PCHARLOOKS MACRO ((PC) (ffetch (PIECE PCHARLOOKS) of PC)))
|
||||
@@ -441,7 +440,7 @@ UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE F
|
||||
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
|
||||
THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))
|
||||
(GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
|
||||
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "16-Feb-2026 08:56:40"))
|
||||
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "14-Jan-2026 14:32:01"))
|
||||
(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."
|
||||
) (SELECTQ (CAR BUTTON) (LEFT (QUOTE (EQ LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (EQ LASTMOUSEBUTTONS 1))
|
||||
@@ -455,7 +454,7 @@ I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (
|
||||
\BIN STREAM)) BITSPERWORD)))
|
||||
(PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) (* ; "Signed smallp, unlike \WOUT") (\BOUT STREAM (
|
||||
LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
|
||||
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "15-Feb-2026 23:45:51"))
|
||||
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "23-Oct-2025 08:49:06"))
|
||||
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE " 8-Sep-2025 22:10:10"))
|
||||
(DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.")
|
||||
(* ;; "NOTE: If fields change EQCLOOKS should change too.") CLFONT (* ;
|
||||
@@ -538,7 +537,7 @@ LINELEAD _ 0)
|
||||
(PUTPROPS FSETPLOOKS MACRO ((PLOOKS FIELD NEWVALUE) (freplace (PARALOOKS FIELD) of PLOOKS with
|
||||
NEWVALUE)))
|
||||
(PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE PARALOOKS))))
|
||||
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "16-Feb-2026 00:36:00"))
|
||||
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 7-Dec-2025 16:32:32"))
|
||||
(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
|
||||
is due) TCTHENTIME (* Time when the next transition is to take place) TCFORCEDDOWN (* TCFORCEDOWN = T
|
||||
@@ -601,9 +600,9 @@ 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
|
||||
$$OUT)))))
|
||||
(PUTPROPS ALLBUTTONSUP MACRO (NIL (ZEROP (LOGAND 7 LASTMOUSEBUTTONS))))
|
||||
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE " 7-Feb-2026 18:53:22"))
|
||||
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "25-Jan-2026 09:14:04"))
|
||||
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE " 9-Feb-2026 09:10:43"))
|
||||
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "14-Jan-2026 14:32:01"))
|
||||
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "19-Oct-2025 10:44:18"))
|
||||
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "12-Dec-2025 00:01:26"))
|
||||
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 22:42:57"))
|
||||
(RPAQQ \TEDIT.TTCCODES ((NONE . 0) (CHARDELETE . 1) (:CHARDELETE.BACKWARD . 1) (WORDDELETE . 2) (
|
||||
:WORDDELETE.BACKWORD . 2) (DELETE . 3) (:DELETE . 3) (FN . 4) (REDO . 5) (:REDO . 5) (UNDO . 6) (:UNDO
|
||||
@@ -611,8 +610,8 @@ $$OUT)))))
|
||||
(:CHARDELETE.FORWARD . 10) (:WORDDELETE.FORWARD . 11) (PUNCT . 20) (TEXT . 21) (WHITESPACE . 22)))
|
||||
(CONSTANTS \TEDIT.TTCCODES)
|
||||
(PUTPROPS \TEDIT.TTC MACRO ((ACTION) (CONSTANT (GETMULTI \TEDIT.TTCCODES (QUOTE ACTION)))))
|
||||
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE " 8-Feb-2026 19:54:41"))
|
||||
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "15-Jan-2026 11:08:15"))
|
||||
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "24-Nov-2025 08:40:56"))
|
||||
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "24-Dec-2025 11:16:22"))
|
||||
(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?")
|
||||
THLEN (* ; "The # of chars involved") THCH# (* ; "The starting ch#") THFIRSTPIECE (* ;
|
||||
@@ -661,9 +660,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)))) (T (BQUOTE (SETQ $$VALUES (CDR $$VALUES))))))))))))
|
||||
(PUTPROPS TEDIT.VALUES MACRO (ARGS (BQUOTE (LIST (\,@ ARGS)))))
|
||||
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "27-Jan-2026 10:30:27"))
|
||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "23-Jan-2026 15:49:26"))
|
||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "21-Jan-2026 12:15:57"))
|
||||
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "25-Dec-2025 15:07:57"))
|
||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "13-Jan-2026 17:51:55"))
|
||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE " 7-Sep-2025 11:11:43"))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
@@ -1,17 +1,18 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED "31-Jan-87 18:09:00" {ERIS}<LISPUSERS>LYRIC>BACKGROUNDMENU.;1 7367
|
||||
|
||||
(FILECREATED "18-Feb-2026 16:20:10" {WMEDLEY}<lispusers>BACKGROUNDMENU.;2 7230
|
||||
previous date%: "31-Jan-86 11:36:13" {ERIS}<LISP>KOTO>LISPUSERS>BACKGROUNDMENU.;1)
|
||||
|
||||
: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)
|
||||
|
||||
(RPAQQ BACKGROUNDMENUCOMS ((INITVARS BackgroundMenuFixupMode BackgroundMenuSuperItem
|
||||
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.locate \BkgMenu.locater \BkgMenu.remove.item
|
||||
\BkgMenu.scan.item.list \BkgMenu.unremove.item)))
|
||||
@@ -152,10 +153,11 @@
|
||||
else (SETQ BackgroundMenuCommands (CONS (CAR item)
|
||||
BackgroundMenuCommands])
|
||||
)
|
||||
(PUTPROPS BACKGROUNDMENU COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (944 7207 (BkgMenu.add.item 954 . 1846) (BkgMenu.fixup 1848 . 3067) (BkgMenu.move.item
|
||||
3069 . 3493) (BkgMenu.remove.item 3495 . 3770) (BkgMenu.rename.item 3772 . 4064) (
|
||||
BkgMenu.reorder.items 4066 . 4441) (BkgMenu.subitems 4443 . 4843) (\BkgMenu.locate 4845 . 5456) (
|
||||
\BkgMenu.locater 5458 . 6025) (\BkgMenu.remove.item 6027 . 6314) (\BkgMenu.scan.item.list 6316 . 6813)
|
||||
(\BkgMenu.unremove.item 6815 . 7205)))))
|
||||
(FILEMAP (NIL (1008 7271 (BkgMenu.add.item 1018 . 1910) (BkgMenu.fixup 1912 . 3131) (BkgMenu.move.item
|
||||
3133 . 3557) (BkgMenu.remove.item 3559 . 3834) (BkgMenu.rename.item 3836 . 4128) (
|
||||
BkgMenu.reorder.items 4130 . 4505) (BkgMenu.subitems 4507 . 4907) (\BkgMenu.locate 4909 . 5520) (
|
||||
\BkgMenu.locater 5522 . 6089) (\BkgMenu.remove.item 6091 . 6378) (\BkgMenu.scan.item.list 6380 . 6877)
|
||||
(\BkgMenu.unremove.item 6879 . 7269)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 7-Sep-88 17:08:57" {ERINYES}<LISPUSERS>MEDLEY>CHATSERVER.;11 47957
|
||||
|
||||
(FILECREATED " 9-Feb-2026 22:25:32" {WMEDLEY}<lispusers>CHATSERVER.;2 45227
|
||||
changes to%: (FNS CHATSERVEROPENFN)
|
||||
|
||||
:EDIT-BY rmk
|
||||
previous date%: "19-May-88 00:37:49" {ERINYES}<LISPUSERS>MEDLEY>CHATSERVER.;10)
|
||||
|
||||
: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)
|
||||
|
||||
@@ -39,7 +40,8 @@
|
||||
(COMMANDS "QUIT" "SAY")
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA CHATSERVEROPENFN])
|
||||
(LAMA \REMOTE.BIN
|
||||
CHATSERVEROPENFN])
|
||||
(DEFINEQ
|
||||
|
||||
(CHATSERVER
|
||||
@@ -448,34 +450,34 @@
|
||||
(RETURN CHARBUFFER])
|
||||
|
||||
(\CREATELINEBUFFER
|
||||
[LAMBDA (TERMINAL.STREAM) (* ; "Edited 9-Feb-2026 22:21 by rmk")
|
||||
(* ; "Edited 13-Apr-87 22:57 by bvm:")
|
||||
[LAMBDA (TERMINAL.STREAM) (* ; "Edited 13-Apr-87 22:57 by bvm:")
|
||||
(* ;;
|
||||
"Create a new stream that buffers the raw input from TERMINAL.STREAM (default is the keyboard).")
|
||||
|
||||
(* ;; "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]
|
||||
(LET* ([STREAM (\OPENFILE '{LINEBUFFER} 'BOTH 'NEW '((CHARSET T]
|
||||
(DEV (fetch (STREAM DEVICE) of STREAM))
|
||||
EOFMETHOD)
|
||||
(replace LINEBUFSTATE of STREAM with READING.LBS)
|
||||
(replace (LINEBUFFER KEYBOARDSTREAM) of STREAM with (OR TERMINAL.STREAM \KEYBOARD.STREAM))
|
||||
(replace (LINEBUFFER KEYBOARDSTREAM) of STREAM with (OR TERMINAL.STREAM
|
||||
\KEYBOARD.STREAM))
|
||||
(replace USERCLOSEABLE of STREAM with NIL)
|
||||
(replace USERVISIBLE of STREAM with NIL) (* ;
|
||||
"Other linebuffer fields default properly")
|
||||
(replace USERVISIBLE of STREAM with NIL)
|
||||
(* ;
|
||||
"Other linebuffer fields default properly")
|
||||
[replace ENDOFSTREAMOP of STREAM with (FUNCTION (LAMBDA (STREAM)
|
||||
(CL:FUNCALL \RefillBufferFn]
|
||||
(if (AND TERMINAL.STREAM (NEQ (SETQ EOFMETHOD (fetch (FDEV EOFP) of (fetch (STREAM DEVICE)
|
||||
TERMINAL.STREAM)
|
||||
))
|
||||
'NILL))
|
||||
(CL:FUNCALL \RefillBufferFn]
|
||||
(if (AND TERMINAL.STREAM (NEQ (SETQ EOFMETHOD (fetch (FDEV EOFP)
|
||||
of (fetch (STREAM DEVICE)
|
||||
TERMINAL.STREAM)))
|
||||
'NILL))
|
||||
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 'FDEV DEV)))
|
||||
(* ; "Copy the basic linebuffer device")
|
||||
(replace (FDEV EOFP) of DEV with EOFMETHOD))
|
||||
(replace (STREAM DEVICE) of STREAM with (SETQ DEV (NCREATE
|
||||
'FDEV DEV)))
|
||||
(* ;
|
||||
"Copy the basic linebuffer device")
|
||||
(replace (FDEV EOFP) of DEV with EOFMETHOD))
|
||||
STREAM])
|
||||
|
||||
(\PROMPTFORWORDBIN
|
||||
@@ -648,7 +650,7 @@
|
||||
(SETQ CHATSERVERTTBL (COPYTERMTABLE 'ORIG))
|
||||
|
||||
(for I from 1 to 8 do (ECHOCHAR I 'IGNORE CHATSERVERTTBL)
|
||||
(ECHOCHAR I 'IGNORE ASKUSERTTBL))
|
||||
(ECHOCHAR I 'IGNORE ASKUSERTTBL))
|
||||
|
||||
(ECHOCHAR (CHARCODE CR)
|
||||
'SIMULATE CHATSERVERTTBL)
|
||||
@@ -713,25 +715,29 @@
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[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")
|
||||
(COND
|
||||
((IGREATERP CHAR \MAXTHINCHAR)
|
||||
(OR (AND (fetch (CHARTABLE NSCHARHASH) of TABLE)
|
||||
(GETHASH CHAR (fetch (CHARTABLE NSCHARHASH)
|
||||
of TABLE)))
|
||||
0))
|
||||
(T (\GETBASEBYTE TABLE CHAR])
|
||||
"0 is either NONE.TC, REAL.CCE, or OTHER.RC")
|
||||
(COND
|
||||
((IGREATERP CHAR \MAXTHINCHAR)
|
||||
(OR (AND (fetch (CHARTABLE NSCHARHASH)
|
||||
of TABLE)
|
||||
(GETHASH CHAR (fetch (CHARTABLE
|
||||
NSCHARHASH)
|
||||
of TABLE)))
|
||||
0))
|
||||
(T (\GETBASEBYTE TABLE CHAR])
|
||||
(PUTPROPS \SYNCODE MACRO [OPENLAMBDA (TABLE CHAR)
|
||||
(CHECK (type? CHARTABLE TABLE))
|
||||
(COND
|
||||
((IGREATERP CHAR \MAXTHINCHAR)
|
||||
(OR (AND (fetch (CHARTABLE NSCHARHASH) of TABLE)
|
||||
(GETHASH CHAR (fetch (CHARTABLE NSCHARHASH)
|
||||
of TABLE)))
|
||||
0))
|
||||
(T (\GETBASEBYTE TABLE CHAR])]
|
||||
(CHECK (type? CHARTABLE TABLE))
|
||||
(COND
|
||||
((IGREATERP CHAR \MAXTHINCHAR)
|
||||
(OR (AND (fetch (CHARTABLE NSCHARHASH)
|
||||
of TABLE)
|
||||
(GETHASH CHAR (fetch (CHARTABLE
|
||||
NSCHARHASH)
|
||||
of TABLE)))
|
||||
0))
|
||||
(T (\GETBASEBYTE TABLE CHAR])]
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
@@ -767,9 +773,10 @@
|
||||
(READVISE MENU CHAT RINGBELLS)
|
||||
)
|
||||
|
||||
(DEFCOMMAND "QUIT" NIL (RETFROM 'CHATSERVEROPENFN))
|
||||
(DEFCOMMAND "QUIT" ()
|
||||
(RETFROM 'CHATSERVEROPENFN))
|
||||
|
||||
(DEFCOMMAND "SAY" (&REST LINE)
|
||||
(DEFCOMMAND "SAY" (&REST LINE)
|
||||
[MAPC \PROCESSES (FUNCTION (LAMBDA (PROC)
|
||||
(CL:WHEN (STRPOS "CHAT.SERVER" (PROCESS.NAME PROC))
|
||||
(MAPRINT LINE (IF (EQ PROC (THIS.PROCESS))
|
||||
@@ -788,13 +795,53 @@
|
||||
|
||||
(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)
|
||||
)
|
||||
(PUTPROPS CHATSERVER COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2029 38278 (CHATSERVER 2039 . 3768) (CHATSERVERWHENCLOSEDFN 3770 . 4117) (
|
||||
CHATSERVEROPENFN 4119 . 8246) (DOBE 8248 . 8294) (REQUIRED.LOGIN 8296 . 11033) (SERVER-EXEC 11035 .
|
||||
11208) (SWEEP.OFD 11210 . 11746) (\CLEARSYSBUF 11748 . 11997) (PROMPTFORWORD 11999 . 26344) (
|
||||
\CREATELINEBUFFER 26346 . 28477) (\PROMPTFORWORDBIN 28479 . 31415) (\REMOTE.BIN 31417 . 33659) (
|
||||
\REMOTE.EXEC.OUTCHARFN 33661 . 37883) (CHATSERVER.FONT 37885 . 38276)) (38905 41247 (SIMPLECHATSERVER
|
||||
38915 . 41245)))))
|
||||
(FILEMAP (NIL (2216 38509 (CHATSERVER 2226 . 3955) (CHATSERVERWHENCLOSEDFN 3957 . 4304) (
|
||||
CHATSERVEROPENFN 4306 . 8433) (DOBE 8435 . 8481) (REQUIRED.LOGIN 8483 . 11220) (SERVER-EXEC 11222 .
|
||||
11395) (SWEEP.OFD 11397 . 11933) (\CLEARSYSBUF 11935 . 12184) (PROMPTFORWORD 12186 . 26531) (
|
||||
\CREATELINEBUFFER 26533 . 28708) (\PROMPTFORWORDBIN 28710 . 31646) (\REMOTE.BIN 31648 . 33890) (
|
||||
\REMOTE.EXEC.OUTCHARFN 33892 . 38114) (CHATSERVER.FONT 38116 . 38507)) (39151 41493 (SIMPLECHATSERVER
|
||||
39161 . 41491)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,88 +1,95 @@
|
||||
(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
|
||||
|
||||
(FILECREATED "18-Feb-2026 16:21:29" {WMEDLEY}<lispusers>COMMWINDOW.;2 48680
|
||||
changes to%: (VARS REMOTE-CURSOR COMMWINDOWCOMS)
|
||||
(COURIERPROGRAMS COMMWINDOW)
|
||||
(FNS CLOSE-FRAME START-GET-BITS SEND-BITS FRAME-EVENT MAKE-FRAME)
|
||||
(FUNCTIONS \PILOTBITBLT)
|
||||
|
||||
:EDIT-BY rmk
|
||||
previous date%: " 2-Apr-87 16:54:24" {ERIS}<LISPUSERS>LYRIC>COMMWINDOW.;2)
|
||||
|
||||
: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)
|
||||
|
||||
(RPAQQ COMMWINDOWCOMS
|
||||
(
|
||||
(RPAQQ COMMWINDOWCOMS (
|
||||
|
||||
(* ;;; "Viewer end")
|
||||
|
||||
(FNS CLOSE-FRAME GET-BITS START-GET-BITS)
|
||||
(FILES COURIERSERVE)
|
||||
|
||||
(FNS CLOSE-FRAME GET-BITS START-GET-BITS)
|
||||
(FILES COURIERSERVE)
|
||||
|
||||
|
||||
(* ;;; "Sender end")
|
||||
|
||||
(FNS SEND-BITS SEND-TILE LISTEN-TO-VIEWER MAPTILES SHUT-DOWN-VIEWER CHANGE-SENDER-UPDATE-MODE
|
||||
)
|
||||
(FUNCTIONS INCR \PILOTBITBLT)
|
||||
|
||||
(* ;; "Controling update schemes")
|
||||
(FNS SEND-BITS SEND-TILE LISTEN-TO-VIEWER MAPTILES SHUT-DOWN-VIEWER
|
||||
CHANGE-SENDER-UPDATE-MODE)
|
||||
(FUNCTIONS INCR \PILOTBITBLT)
|
||||
|
||||
|
||||
(* ;; "Controling update schemes")
|
||||
|
||||
(INITVARS (COMM.DEFAULT.TRANSMIT.TYPE 'SQUARE)
|
||||
(COMM.SEND.UNCHANGED.TILES T)
|
||||
(COMM.UPDATE.MOUSE.POSITION 'Sender))
|
||||
(GLOBALVARS COMM.DEFAULT.TRANSMIT.TYPE COMM.UPDATE.MOUSE.POSITION COMM.SEND.UNCHANGED.TILES)
|
||||
|
||||
(INITVARS (COMM.DEFAULT.TRANSMIT.TYPE 'SQUARE)
|
||||
(COMM.SEND.UNCHANGED.TILES T)
|
||||
(COMM.UPDATE.MOUSE.POSITION 'Sender))
|
||||
(GLOBALVARS COMM.DEFAULT.TRANSMIT.TYPE COMM.UPDATE.MOUSE.POSITION
|
||||
COMM.SEND.UNCHANGED.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")
|
||||
|
||||
(CONSTANTS COMM.BAND.PACKET.TYPE COMM.CURSOR.PACKET.TYPE COMM.CURSOR.CLOSE.PACKET.TYPE
|
||||
COMM.SHUT.DOWN.PACKET.TYPE)
|
||||
(VARIABLES MAX-PACKET-BITS)
|
||||
(RECORDS COMM.XFER.PACKET)
|
||||
|
||||
(CONSTANTS COMM.BAND.PACKET.TYPE COMM.CURSOR.PACKET.TYPE
|
||||
COMM.CURSOR.CLOSE.PACKET.TYPE COMM.SHUT.DOWN.PACKET.TYPE)
|
||||
(VARIABLES MAX-PACKET-BITS)
|
||||
(RECORDS COMM.XFER.PACKET)
|
||||
|
||||
|
||||
(* ;;; "Packing and unpacking bitmaps into etherpackets")
|
||||
|
||||
(FNS BMTOPACKET PACKETTOBM)
|
||||
|
||||
(FNS BMTOPACKET PACKETTOBM)
|
||||
|
||||
|
||||
(* ;;; "Displaying the viewing machine's cursor")
|
||||
|
||||
(VARS REMOTE-CURSOR)
|
||||
(INITVARS (CURSORICON NIL))
|
||||
|
||||
(VARS REMOTE-CURSOR)
|
||||
(INITVARS (CURSORICON NIL))
|
||||
|
||||
|
||||
(* ;;; "Manipulating the frame that outlines the region being viewed")
|
||||
|
||||
(INITVARS (*FRAME-SHADE* GRAYSHADE))
|
||||
(FNS FRAME-EVENT MAKE-FRAME MOVE-FRAME SHAPE-FRAME SET-FRAME-TITLE)
|
||||
|
||||
(INITVARS (*FRAME-SHADE* GRAYSHADE))
|
||||
(FNS FRAME-EVENT MAKE-FRAME MOVE-FRAME SHAPE-FRAME SET-FRAME-TITLE)
|
||||
|
||||
|
||||
(* ;;; "Changing the system parameters")
|
||||
|
||||
(FNS MAKE-MENUS-WINDOW MODE-MENU)
|
||||
(VARS COMM-MODES)
|
||||
|
||||
(FNS MAKE-MENUS-WINDOW MODE-MENU)
|
||||
(VARS COMM-MODES)
|
||||
|
||||
|
||||
(* ;;; "Initialization")
|
||||
|
||||
(P (COURIER.START.SERVER))
|
||||
|
||||
(P (COURIER.START.SERVER))
|
||||
|
||||
|
||||
(* ;;; "Unused stuff, as far as I can tell")
|
||||
|
||||
(FNS FASTBITBLT)
|
||||
|
||||
(FNS FASTBITBLT)
|
||||
|
||||
|
||||
(* ;;; "System file dependencies")
|
||||
|
||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE (FILES (LOADCOMP)
|
||||
LLDISPLAY LLETHER LLNS))
|
||||
(COURIERPROGRAMS COMMWINDOW)))
|
||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE (FILES (LOADCOMP)
|
||||
LLDISPLAY LLETHER LLNS))
|
||||
(COURIERPROGRAMS COMMWINDOW)))
|
||||
|
||||
|
||||
|
||||
@@ -229,7 +236,6 @@
|
||||
(LIST 'RETURN (LIST (NSOCKETNUMBER NS)
|
||||
(USERNAME])
|
||||
)
|
||||
|
||||
(FILESLOAD COURIERSERVE)
|
||||
|
||||
|
||||
@@ -440,18 +446,19 @@
|
||||
(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)))
|
||||
((>= REPEAT-COUNT ,REPEATS))
|
||||
(CL:DO [(,VAR (+ ,START (CL:* REPEAT-COUNT ,HEIGHT))
|
||||
(+ ,VAR (CL:* ,REPEATS ,HEIGHT]
|
||||
(,UNTIL)
|
||||
,@FORMS)))
|
||||
(CL:DO [(,VAR (+ ,START (CL:* REPEAT-COUNT ,HEIGHT))
|
||||
(+ ,VAR (CL:* ,REPEATS ,HEIGHT]
|
||||
(,UNTIL)
|
||||
,@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))
|
||||
|
||||
|
||||
|
||||
@@ -518,12 +525,12 @@
|
||||
|
||||
(RPAQQ COMM.SHUT.DOWN.PACKET.TYPE 4246)
|
||||
|
||||
|
||||
(CONSTANTS COMM.BAND.PACKET.TYPE COMM.CURSOR.PACKET.TYPE COMM.CURSOR.CLOSE.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
|
||||
|
||||
(ACCESSFNS COMM.XFER.PACKET ((COMMPACKET (fetch (XIP XIPCONTENTS) of DATUM)))
|
||||
@@ -800,7 +807,6 @@
|
||||
|
||||
(* ;;; "Initialization")
|
||||
|
||||
|
||||
(COURIER.START.SERVER)
|
||||
|
||||
|
||||
@@ -856,7 +862,6 @@
|
||||
(* ;;; "System file dependencies")
|
||||
|
||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE
|
||||
|
||||
(FILESLOAD (LOADCOMP)
|
||||
LLDISPLAY LLETHER LLNS)
|
||||
)
|
||||
@@ -880,14 +885,14 @@
|
||||
ERRORS
|
||||
((ERROR 1 (STRING))
|
||||
(USE.COURIER 2 NIL)))
|
||||
(PUTPROPS COMMWINDOW COPYRIGHT ("Xerox Corporation" 1986 1900 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2306 12237 (CLOSE-FRAME 2316 . 2467) (GET-BITS 2469 . 10758) (START-GET-BITS 10760 .
|
||||
12235)) (12293 25340 (SEND-BITS 12303 . 15124) (SEND-TILE 15126 . 18249) (LISTEN-TO-VIEWER 18251 .
|
||||
19554) (MAPTILES 19556 . 24279) (SHUT-DOWN-VIEWER 24281 . 25150) (CHANGE-SENDER-UPDATE-MODE 25152 .
|
||||
25338)) (25342 25656 (INCR 25342 . 25656)) (25658 25816 (\PILOTBITBLT 25658 . 25816)) (26181 28052 (
|
||||
PACKET-EQUAL 26191 . 27594) (GET-CACHED-PACKET 27596 . 27911) (PUT-CACHED-PACKET 27913 . 28050)) (
|
||||
29490 33213 (BMTOPACKET 29500 . 31461) (PACKETTOBM 31463 . 33211)) (33517 37826 (FRAME-EVENT 33527 .
|
||||
34185) (MAKE-FRAME 34187 . 35969) (MOVE-FRAME 35971 . 36241) (SHAPE-FRAME 36243 . 37633) (
|
||||
SET-FRAME-TITLE 37635 . 37824)) (37876 44753 (MAKE-MENUS-WINDOW 37886 . 40245) (MODE-MENU 40247 .
|
||||
44751)) (44930 47917 (FASTBITBLT 44940 . 47915)))))
|
||||
(FILEMAP (NIL (3203 13134 (CLOSE-FRAME 3213 . 3364) (GET-BITS 3366 . 11655) (START-GET-BITS 11657 .
|
||||
13132)) (13189 26236 (SEND-BITS 13199 . 16020) (SEND-TILE 16022 . 19145) (LISTEN-TO-VIEWER 19147 .
|
||||
20450) (MAPTILES 20452 . 25175) (SHUT-DOWN-VIEWER 25177 . 26046) (CHANGE-SENDER-UPDATE-MODE 26048 .
|
||||
26234)) (27219 29090 (PACKET-EQUAL 27229 . 28632) (GET-CACHED-PACKET 28634 . 28949) (PUT-CACHED-PACKET
|
||||
28951 . 29088)) (30529 34252 (BMTOPACKET 30539 . 32500) (PACKETTOBM 32502 . 34250)) (34556 38865 (
|
||||
FRAME-EVENT 34566 . 35224) (MAKE-FRAME 35226 . 37008) (MOVE-FRAME 37010 . 37280) (SHAPE-FRAME 37282 .
|
||||
38672) (SET-FRAME-TITLE 38674 . 38863)) (38915 45792 (MAKE-MENUS-WINDOW 38925 . 41284) (MODE-MENU
|
||||
41286 . 45790)) (45968 48955 (FASTBITBLT 45978 . 48953)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
116
lispusers/CROCK
116
lispusers/CROCK
@@ -1,43 +1,43 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED " 2-Apr-87 00:37:46" {ERIS}<LISPUSERS>LYRIC>CROCK.;2 17791
|
||||
|
||||
(FILECREATED "18-Feb-2026 16:26:31" {WMEDLEY}<lispusers>CROCK.;2 17189
|
||||
previous date%: "11-Jan-86 19:46:27" {PHYLUM}<LISPUSERS>LYRIC>CROCK.;1)
|
||||
|
||||
: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)
|
||||
|
||||
(RPAQQ CROCKCOMS
|
||||
((* CROCK -- By Kelly Roach *)
|
||||
(FNS CROCK CROCK.BUTTONEVENTFN CROCK.CHANGE.STYLE CROCK.CLOSEFN CROCK.PROCESS CROCK.RESHAPEFN
|
||||
CROCK.ALARM CROCK.RING.ALARM CROCK.INIT)
|
||||
(INITVARS (CROCK.DEFAULT.STYLE '(HANDS T TIMES NIL RINGS NIL NUMBERS T))
|
||||
(CROCK.STYLE.MENU)
|
||||
(CROCK.ALARMS)
|
||||
(CROCK.DATEFORMAT '(DATEFORMAT NO.SECONDS))
|
||||
[CROCK.TUNE '((1000 . 1000)
|
||||
(800 . 1000)
|
||||
(600 . 1000)
|
||||
(500 . 1000)
|
||||
(400 . 1000)
|
||||
(NIL . 500)
|
||||
(440 . 1000)
|
||||
(484 . 1000)
|
||||
(540 . 1000)
|
||||
(600 . 1000)
|
||||
(2000 . 1000)
|
||||
(1600 . 1000)
|
||||
(1200 . 1000)
|
||||
(1000 . 1000)
|
||||
(800 . 1000)
|
||||
(NIL . 500)
|
||||
(880 . 1000)
|
||||
(968 . 1000)
|
||||
(1080 . 1000)
|
||||
(1188 . 1000]
|
||||
(CROCKWINDOW))))
|
||||
(RPAQQ CROCKCOMS ((* CROCK -- By Kelly Roach *)
|
||||
(FNS CROCK CROCK.BUTTONEVENTFN CROCK.CHANGE.STYLE CROCK.CLOSEFN CROCK.PROCESS
|
||||
CROCK.RESHAPEFN CROCK.ALARM CROCK.RING.ALARM CROCK.INIT)
|
||||
(INITVARS (CROCK.DEFAULT.STYLE '(HANDS T TIMES NIL RINGS NIL NUMBERS T))
|
||||
(CROCK.STYLE.MENU)
|
||||
(CROCK.ALARMS)
|
||||
(CROCK.DATEFORMAT '(DATEFORMAT NO.SECONDS))
|
||||
[CROCK.TUNE '((1000 . 1000)
|
||||
(800 . 1000)
|
||||
(600 . 1000)
|
||||
(500 . 1000)
|
||||
(400 . 1000)
|
||||
(NIL . 500)
|
||||
(440 . 1000)
|
||||
(484 . 1000)
|
||||
(540 . 1000)
|
||||
(600 . 1000)
|
||||
(2000 . 1000)
|
||||
(1600 . 1000)
|
||||
(1200 . 1000)
|
||||
(1000 . 1000)
|
||||
(800 . 1000)
|
||||
(NIL . 500)
|
||||
(880 . 1000)
|
||||
(968 . 1000)
|
||||
(1080 . 1000)
|
||||
(1188 . 1000]
|
||||
(CROCKWINDOW))))
|
||||
|
||||
|
||||
|
||||
@@ -334,31 +334,31 @@
|
||||
|
||||
(RPAQ? CROCK.DATEFORMAT '(DATEFORMAT NO.SECONDS))
|
||||
|
||||
(RPAQ? CROCK.TUNE
|
||||
'((1000 . 1000)
|
||||
(800 . 1000)
|
||||
(600 . 1000)
|
||||
(500 . 1000)
|
||||
(400 . 1000)
|
||||
(NIL . 500)
|
||||
(440 . 1000)
|
||||
(484 . 1000)
|
||||
(540 . 1000)
|
||||
(600 . 1000)
|
||||
(2000 . 1000)
|
||||
(1600 . 1000)
|
||||
(1200 . 1000)
|
||||
(1000 . 1000)
|
||||
(800 . 1000)
|
||||
(NIL . 500)
|
||||
(880 . 1000)
|
||||
(968 . 1000)
|
||||
(1080 . 1000)
|
||||
(1188 . 1000)))
|
||||
(RPAQ? CROCK.TUNE '((1000 . 1000)
|
||||
(800 . 1000)
|
||||
(600 . 1000)
|
||||
(500 . 1000)
|
||||
(400 . 1000)
|
||||
(NIL . 500)
|
||||
(440 . 1000)
|
||||
(484 . 1000)
|
||||
(540 . 1000)
|
||||
(600 . 1000)
|
||||
(2000 . 1000)
|
||||
(1600 . 1000)
|
||||
(1200 . 1000)
|
||||
(1000 . 1000)
|
||||
(800 . 1000)
|
||||
(NIL . 500)
|
||||
(880 . 1000)
|
||||
(968 . 1000)
|
||||
(1080 . 1000)
|
||||
(1188 . 1000)))
|
||||
|
||||
(RPAQ? CROCKWINDOW )
|
||||
(PUTPROPS CROCK COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1609 16483 (CROCK 1619 . 2189) (CROCK.BUTTONEVENTFN 2191 . 2480) (CROCK.CHANGE.STYLE
|
||||
2482 . 5295) (CROCK.CLOSEFN 5297 . 5459) (CROCK.PROCESS 5461 . 13959) (CROCK.RESHAPEFN 13961 . 14120)
|
||||
(CROCK.ALARM 14122 . 15350) (CROCK.RING.ALARM 15352 . 16093) (CROCK.INIT 16095 . 16481)))))
|
||||
(FILEMAP (NIL (1940 16814 (CROCK 1950 . 2520) (CROCK.BUTTONEVENTFN 2522 . 2811) (CROCK.CHANGE.STYLE
|
||||
2813 . 5626) (CROCK.CLOSEFN 5628 . 5790) (CROCK.PROCESS 5792 . 14290) (CROCK.RESHAPEFN 14292 . 14451)
|
||||
(CROCK.ALARM 14453 . 15681) (CROCK.RING.ALARM 15683 . 16424) (CROCK.INIT 16426 . 16812)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED "13-Jan-87 01:23:25" {ERIS}<LISPUSERS>LISPCORE>DEFAULTICON.;1 4586
|
||||
|
||||
(FILECREATED "18-Feb-2026 16:26:48" {WMEDLEY}<lispusers>DEFAULTICON.;2 4702
|
||||
changes to%: (FNS \MAKEICONWINDOW)
|
||||
|
||||
:EDIT-BY rmk
|
||||
previous date%: "19-Dec-85 01:24:06" {ERIS}<LISP>KOTO>LISPUSERS>DEFAULTICON.;1)
|
||||
|
||||
:PREVIOUS-DATE "13-Jan-87 01:23:25" {WMEDLEY}<lispusers>DEFAULTICON.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT DEFAULTICONCOMS)
|
||||
|
||||
@@ -13,140 +16,137 @@
|
||||
(UGLYVARS \DEFAULTICON)
|
||||
(INITVARS (DEFAULTICON \DEFAULTICON))
|
||||
(FNS \MAKEICONWINDOW)))
|
||||
|
||||
(FILESLOAD ICONW)
|
||||
|
||||
(READVARS-FROM-STRINGS '(\DEFAULTICON)
|
||||
"(({(READBITMAP)(64 64
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@AOOOOOOOOOOH@@%"
|
||||
%"@@N@@@@@@@@@@G@@%"
|
||||
%"@C@@@@@@@@@@@@L@%"
|
||||
%"@D@@@@@@@@@@@@B@%"
|
||||
%"@H@@@@@@@@@@@@A@%"
|
||||
%"A@@@@@@@@@@@@@@H%"
|
||||
%"B@@@@@@@@@@@CO@D%"
|
||||
%"B@@@@@@@@@@@BDHD%"
|
||||
%"D@@@@@@@@@@@ABDB%"
|
||||
%"D@@@@@@@@@@@AODB%"
|
||||
%"D@@@@@@@@@@@ABLB%"
|
||||
%"D@@@@@@@@@@@ABDA%"
|
||||
%"H@@@@@@@@@@@ABDA%"
|
||||
%"H@@@@@@@@@@@AOHA%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"D@@@@@@@@@@@@@@B%"
|
||||
%"D@@@@@@@@@@@@@@B%"
|
||||
%"D@@@@@@@@@@@@@@B%"
|
||||
%"B@@@@@@@@@@@@@@D%"
|
||||
%"B@@@@@@@@@@@@@@D%"
|
||||
%"A@@@@@@@@@@@@@@H%"
|
||||
%"@H@@@@@@@@@@@@A@%"
|
||||
%"@D@@@@@@@@@@@@B@%"
|
||||
%"@C@@@@@@@@@@@@L@%"
|
||||
%"@@N@@@@@@@@@@G@@%"
|
||||
%"@@AOOOOOOOOOOH@@%")} {(READBITMAP)(64 64
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@AOOOOOOOOOOH@@%"
|
||||
%"@@OOOOOOOOOOOO@@%"
|
||||
%"@COOOOOOOOOOOOL@%"
|
||||
%"@GOOOOOOOOOOOON@%"
|
||||
%"@OOOOOOOOOOOOOO@%"
|
||||
%"AOOOOOOOOOOOOOOH%"
|
||||
%"COOOOOOOOOOOOOOL%"
|
||||
%"COOOOOOOOOOONDOL%"
|
||||
%"GOOOOOOOOOOOOBGN%"
|
||||
%"GOOOOOOOOOOOOOGN%"
|
||||
%"GOOOOOOOOOOOOBON%"
|
||||
%"GOOOOOOOOOOOOBGO%"
|
||||
%"OOOOOOOOOOOOOBGO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"GOOOOOOOOOOOOOON%"
|
||||
%"GOOOOOOOOOOOOOON%"
|
||||
%"GOOOOOOOOOOOOOON%"
|
||||
%"COOOOOOOOOOOOOOL%"
|
||||
%"COOOOOOOOOOOOOOL%"
|
||||
%"AOOOOOOOOOOOOOOH%"
|
||||
%"@OOOOOOOOOOOOOO@%"
|
||||
%"@GOOOOOOOOOOOON@%"
|
||||
%"@COOOOOOOOOOOOL@%"
|
||||
%"@@OOOOOOOOOOOO@@%"
|
||||
%"@@AOOOOOOOOOOH@@%")} (5 6 52 46)))
|
||||
")
|
||||
(READVARS \DEFAULTICON)
|
||||
(({(READBITMAP)(64 64
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@AOOOOOOOOOOH@@"
|
||||
"@@N@@@@@@@@@@G@@"
|
||||
"@C@@@@@@@@@@@@L@"
|
||||
"@D@@@@@@@@@@@@B@"
|
||||
"@H@@@@@@@@@@@@A@"
|
||||
"A@@@@@@@@@@@@@@H"
|
||||
"B@@@@@@@@@@@CO@D"
|
||||
"B@@@@@@@@@@@BDHD"
|
||||
"D@@@@@@@@@@@ABDB"
|
||||
"D@@@@@@@@@@@AODB"
|
||||
"D@@@@@@@@@@@ABLB"
|
||||
"D@@@@@@@@@@@ABDA"
|
||||
"H@@@@@@@@@@@ABDA"
|
||||
"H@@@@@@@@@@@AOHA"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"D@@@@@@@@@@@@@@B"
|
||||
"D@@@@@@@@@@@@@@B"
|
||||
"D@@@@@@@@@@@@@@B"
|
||||
"B@@@@@@@@@@@@@@D"
|
||||
"B@@@@@@@@@@@@@@D"
|
||||
"A@@@@@@@@@@@@@@H"
|
||||
"@H@@@@@@@@@@@@A@"
|
||||
"@D@@@@@@@@@@@@B@"
|
||||
"@C@@@@@@@@@@@@L@"
|
||||
"@@N@@@@@@@@@@G@@"
|
||||
"@@AOOOOOOOOOOH@@")} {(READBITMAP)(64 64
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@AOOOOOOOOOOH@@"
|
||||
"@@OOOOOOOOOOOO@@"
|
||||
"@COOOOOOOOOOOOL@"
|
||||
"@GOOOOOOOOOOOON@"
|
||||
"@OOOOOOOOOOOOOO@"
|
||||
"AOOOOOOOOOOOOOOH"
|
||||
"COOOOOOOOOOOOOOL"
|
||||
"COOOOOOOOOOONDOL"
|
||||
"GOOOOOOOOOOOOBGN"
|
||||
"GOOOOOOOOOOOOOGN"
|
||||
"GOOOOOOOOOOOOBON"
|
||||
"GOOOOOOOOOOOOBGO"
|
||||
"OOOOOOOOOOOOOBGO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"GOOOOOOOOOOOOOON"
|
||||
"GOOOOOOOOOOOOOON"
|
||||
"GOOOOOOOOOOOOOON"
|
||||
"COOOOOOOOOOOOOOL"
|
||||
"COOOOOOOOOOOOOOL"
|
||||
"AOOOOOOOOOOOOOOH"
|
||||
"@OOOOOOOOOOOOOO@"
|
||||
"@GOOOOOOOOOOOON@"
|
||||
"@COOOOOOOOOOOOL@"
|
||||
"@@OOOOOOOOOOOO@@"
|
||||
"@@AOOOOOOOOOOH@@")} (5 6 52 46)))
|
||||
|
||||
(RPAQ? DEFAULTICON \DEFAULTICON)
|
||||
(DEFINEQ
|
||||
@@ -175,6 +175,7 @@
|
||||
(WINDOWPROP icon 'HEIGHT]
|
||||
icon])
|
||||
)
|
||||
(PUTPROPS DEFAULTICON COPYRIGHT ("Xerox Corporation" 1985 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3351 4679 (\MAKEICONWINDOW 3361 . 4677)))))
|
||||
(FILEMAP (NIL (3170 4498 (\MAKEICONWINDOW 3180 . 4496)))))
|
||||
STOP
|
||||
|
||||
@@ -1,17 +1,17 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED " 4-Mar-87 15:59:01" {PHYLUM}<LISPUSERS>LYRIC>DEFAULTSUBITEMFN.;1 1299
|
||||
|
||||
(FILECREATED "18-Feb-2026 16:28:38" {WMEDLEY}<lispusers>DEFAULTSUBITEMFN.;2 1229
|
||||
previous date%: "31-Jan-86 17:45:55" {PHYLUM}<LISP>KOTO>LISPUSERS>DEFAULTSUBITEMFN.;1)
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE " 4-Mar-87 15:59:01" {WMEDLEY}<lispusers>DEFAULTSUBITEMFN.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT DEFAULTSUBITEMFNCOMS)
|
||||
|
||||
(RPAQQ DEFAULTSUBITEMFNCOMS ((* * redefine the DEFAULTSUBITEMFN to add the EVAL keyword to the
|
||||
subitem menu field)
|
||||
(FNS DEFAULTSUBITEMFN)))
|
||||
(RPAQQ DEFAULTSUBITEMFNCOMS ((* * redefine the DEFAULTSUBITEMFN to add the EVAL keyword to the subitem menu field) (FNS DEFAULTSUBITEMFN))
|
||||
)
|
||||
(* * redefine the DEFAULTSUBITEMFN to add the EVAL keyword to the subitem menu field)
|
||||
|
||||
(DEFINEQ
|
||||
@@ -20,6 +20,7 @@
|
||||
(LAMBDA (MENU ITEM) (* edited%: "31-Dec-85 16:41") (* rrb "17-Aug-84 17:24") (* default subitemfn for menus. Checks the fourth element of the item for an expression of the form (SUBITEMS a b c) or if the fourth element is (EVAL form) will return the value of form. MENU and ITEM will be available during the evaluation) (PROG (TEMP) (RETURN (if (AND (LISTP ITEM) (LISTP (SETQ TEMP (CDR ITEM))) (LISTP (SETQ TEMP (CDR TEMP))) (LISTP (SETQ TEMP (CDR TEMP)))) then (SELECTQ (CAR (SETQ TEMP (LISTP (CAR TEMP)))) (SUBITEMS (CDR TEMP)) (EVAL (EVAL (CADR TEMP))) NIL)))))
|
||||
)
|
||||
)
|
||||
(PUTPROPS DEFAULTSUBITEMFN COPYRIGHT ("Xerox Corporation" 1986 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (606 1206 (DEFAULTSUBITEMFN 616 . 1204)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,37 +1,39 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 8-Aug-2021 13:22:31"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>ISO8859IO.;18 22218
|
||||
|
||||
(FILECREATED " 1-Feb-2026 13:03:18" {WMEDLEY}<lispusers>ISO8859IO.;19 23459
|
||||
changes to%: (FNS \8859OUTCHARFN \IBMOUTCHARFN \MACOUTCHARFN)
|
||||
|
||||
:EDIT-BY rmk
|
||||
previous date%: " 6-Aug-2021 16:12:42"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>ISO8859IO.;17)
|
||||
|
||||
:CHANGES-TO (FNS \MAKERECODEMAP MAKEISOFORMAT \8859OUTCHARFN \8859INCCODEFN \8859PEEKCCODEFN)
|
||||
(VARS ISO8859IOCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 8-Aug-2021 13:22:31" {WMEDLEY}<lispusers>ISO8859IO.;11)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT ISO8859IOCOMS)
|
||||
|
||||
(RPAQQ ISO8859IOCOMS
|
||||
(
|
||||
(* ;; "This package defines EXTERNALFORMATS for files that are encoded in either ISO8859/1, the standard IBM extended ascii, or the usual MAC encoding.")
|
||||
(* ;; "This package defines EXTERNALFORMATS for files that are encoded in either ISO8859/1, the standard IBM extended ascii, or the usual MAC encoding.")
|
||||
|
||||
(COMS (* ; "ISO8859/1")
|
||||
(COMS (* ; "ISO8859/1")
|
||||
(FNS \8859OUTCHARFN \8859INCCODEFN \8859PEEKCCODEFN)
|
||||
(GLOBALVARS *MCCSTOISO8859MAP* *ISO8859TOMCCSMAP*)
|
||||
(GLOBALVARS *XEROXTOISO8859MAP* *ISO8859TOXEROXMAP*)
|
||||
(FNS MAKEISOFORMAT)
|
||||
(P (MAKEISOFORMAT)))
|
||||
(COMS (* ; "IBM-PC Extended Ascii")
|
||||
(COMS (* ; "IBM-PC Extended Ascii")
|
||||
(FNS \IBMOUTCHARFN \IBMINCCODEFN \IBMPEEKCCODEFN)
|
||||
(GLOBALVARS *XEROXTOIBMMAP* *IBMTOXEROXMAP*)
|
||||
(FNS MAKEIBMFORMAT)
|
||||
(P (MAKEIBMFORMAT)))
|
||||
(COMS (* ; "Macintosh")
|
||||
(COMS (* ; "Macintosh")
|
||||
(FNS \MACOUTCHARFN \MACINCCODEFN \MACPEEKCCODEFN)
|
||||
(GLOBALVARS *XEROXTOMACMAP* *MACTOXEROXMAP*)
|
||||
(FNS MAKEMACFORMAT)
|
||||
(P (MAKEMACFORMAT)))
|
||||
(COMS (* ; "Independent of char encoding")
|
||||
(COMS (* ; "Independent of char encoding")
|
||||
(FNS \COMMONBACKCCODEFN \MAKERECODEMAP \RECODECCODE))))
|
||||
|
||||
|
||||
@@ -49,143 +51,137 @@
|
||||
|
||||
(\8859OUTCHARFN
|
||||
[LAMBDA (STREAM CHARCODE)
|
||||
(DECLARE (GLOBALVARS *XEROXTOISO8859MAP*)) (* ; "Edited 1-Feb-2026 10:11 by rmk")
|
||||
(* ; "Edited 8-Aug-2021 13:21 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 14:34 by ")
|
||||
(* ; "Edited 7-Dec-95 14:32 by ")
|
||||
(DECLARE (GLOBALVARS *XEROXTOISO8859MAP*)) (* ; "Edited 8-Aug-2021 13:21 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 14:34 by ")
|
||||
(* ; "Edited 7-Dec-95 14:32 by ")
|
||||
|
||||
(* ;; "Converts CHARCODE from internal encoding to ISO8859 before printing.")
|
||||
(* ;; "Converts CHARCODE from internal encoding to ISO8859 before printing.")
|
||||
|
||||
(* ;; "Unconverted codes are left unchanged (no error).")
|
||||
(* ;; "Unconverted codes are left unchanged (no error).")
|
||||
|
||||
(* ;; "If any remaining codes are out of charset 0, the streams external format will be used. ")
|
||||
(* ;; "If any remaining codes are out of charset 0, the streams external format will be used. ")
|
||||
|
||||
(IF (EQ CHARCODE (CHARCODE EOL))
|
||||
THEN (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0)
|
||||
(\BOUTEOL STREAM)
|
||||
(\BOUTEOL STREAM)
|
||||
ELSE (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM)
|
||||
(IPLUS16 1 DATUM))
|
||||
(\BOUT STREAM (IF (IGREATERP CHARCODE 127)
|
||||
THEN
|
||||
(IPLUS16 1 DATUM))
|
||||
(\BOUT STREAM (IF (IGREATERP CHARCODE 127)
|
||||
THEN
|
||||
|
||||
(* ;; "We know that ISO doesn't have floating accents, so only singletons are returned. We also know that it agrees with MCCS on first 128, except for cirumflex and underscore")
|
||||
(* ;; "We know that ISO doesn't have floating accents, so only singletons are returned. We also know that it agrees with Xerox on first 128")
|
||||
|
||||
(\RECODECCODE CHARCODE *MCCSTOISO8859MAP*)
|
||||
ELSE CHARCODE])
|
||||
(\RECODECCODE CHARCODE *XEROXTOISO8859MAP*)
|
||||
ELSE CHARCODE])
|
||||
|
||||
(\8859INCCODEFN
|
||||
[LAMBDA (STRM COUNTP) (* ; "Edited 1-Feb-2026 10:10 by rmk")
|
||||
(* ; "Edited 6-Aug-2021 16:10 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 15:24 by ")
|
||||
(* ; "Edited 7-Dec-95 15:19 by ")
|
||||
[LAMBDA (STRM COUNTP) (* ; "Edited 6-Aug-2021 16:10 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 15:24 by ")
|
||||
(* ; "Edited 7-Dec-95 15:19 by ")
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1))
|
||||
(\RECODECCODE (\BIN STRM)
|
||||
*ISO8859TOMCCSMAP*])
|
||||
*ISO8859TOXEROXMAP*])
|
||||
|
||||
(\8859PEEKCCODEFN
|
||||
[LAMBDA (STRM NOERROR) (* ; "Edited 1-Feb-2026 10:10 by rmk")
|
||||
(* ; "Edited 5-May-2021 17:44 by rmk:")
|
||||
(* ; "Edited 3-Jan-96 14:21 by ")
|
||||
(* ; "Edited 7-Dec-95 15:51 by ")
|
||||
(* ; "Edited 7-Dec-95 15:19 by ")
|
||||
[LAMBDA (STRM NOERROR) (* ; "Edited 5-May-2021 17:44 by rmk:")
|
||||
(* ; "Edited 3-Jan-96 14:21 by ")
|
||||
(* ; "Edited 7-Dec-95 15:51 by ")
|
||||
(* ; "Edited 7-Dec-95 15:19 by ")
|
||||
(\RECODECCODE (\PEEKCCODE STRM NOERROR)
|
||||
*ISO8859TOMCCSMAP*])
|
||||
*ISO8859TOXEROXMAP*])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *MCCSTOISO8859MAP* *ISO8859TOMCCSMAP*)
|
||||
(GLOBALVARS *XEROXTOISO8859MAP* *ISO8859TOXEROXMAP*)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(MAKEISOFORMAT
|
||||
[LAMBDA NIL (* ; "Edited 1-Feb-2026 11:18 by rmk")
|
||||
(* ; "Edited 5-Aug-2021 22:15 by rmk:")
|
||||
(* ; "Edited 9-Mar-99 17:19 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 16:24 by ")
|
||||
(* ; "Edited 7-Dec-95 16:20 by ")
|
||||
(LET [(MCCSTOISO '(("0,255" "0,136")
|
||||
("0,254" "0,137")
|
||||
("357,41" "0,240")
|
||||
("357,153" "0,246")
|
||||
("43,42" "0,250")
|
||||
("0,323" "0,251")
|
||||
("0,343" "0,252")
|
||||
("357,152" "0,254")
|
||||
("357,43" "0,255")
|
||||
("0,322" "0,256")
|
||||
("43,176" "0,257")
|
||||
("43,47" "0,264")
|
||||
("0,313" "0,270")
|
||||
("0,321" "0,271")
|
||||
("0,353" "0.272")
|
||||
("361,41" "0,300")
|
||||
("361,42" "0,301")
|
||||
("361,43" "0,302")
|
||||
("361,44" "0,303")
|
||||
("361,47" "0,304")
|
||||
("361,50" "0,305")
|
||||
("0,341" "0,306")
|
||||
("361,55" "0,307")
|
||||
("361,60" "0,310")
|
||||
("361,61" "0,311")
|
||||
("361,62" "0,312")
|
||||
("361,65" "0,313")
|
||||
("361,76" "0,314")
|
||||
("361,77" "0,315")
|
||||
("361,100" "0,316")
|
||||
("361,104" "0,317")
|
||||
("0,342" "0,320")
|
||||
("361,114" "0,321")
|
||||
("361,117" "0,322")
|
||||
("361,120" "0,323")
|
||||
("361,121" "0,324")
|
||||
("361,122" "0,325")
|
||||
("361,124" "0,326")
|
||||
("0,264" "0,327")
|
||||
("0,351" "0,330")
|
||||
("361,137" "0,331")
|
||||
("361,140" "0,332")
|
||||
("361,141" "0,333")
|
||||
("361,145" "0,334")
|
||||
("361,153" "0,335")
|
||||
("0,354" "0,336")
|
||||
("0,373" "0,337")
|
||||
("361,241" "0,340")
|
||||
("361,242" "0,341")
|
||||
("361,243" "0,342")
|
||||
("361,244" "0,343")
|
||||
("361,247" "0,344")
|
||||
("361,250" "0,345")
|
||||
("0,361" "0,346")
|
||||
("361,255" "0,347")
|
||||
("361,260" "0,350")
|
||||
("361,261" "0,351")
|
||||
("361,262" "0,352")
|
||||
("361,265" "0,353")
|
||||
("361,276" "0,354")
|
||||
("361,277" "0,355")
|
||||
("361,300" "0,356")
|
||||
("361,304" "0,357")
|
||||
("0,363" "0,360")
|
||||
("361,314" "0,361")
|
||||
("361,317" "0,362")
|
||||
("361,320" "0,363")
|
||||
("361,321" "0,364")
|
||||
("361,322" "0,365")
|
||||
("361,324" "0,366")
|
||||
("0,270" "0,367")
|
||||
("0,371" "0,370")
|
||||
("361,337" "0,371")
|
||||
("361,340" "0,372")
|
||||
("361,341" "0,373")
|
||||
("361,345" "0,374")
|
||||
("361,353" "0,375")
|
||||
("0,374" "0,376")
|
||||
("361,355" "0,377")
|
||||
("361,155" "Meta,170"]
|
||||
(SETQ *MCCSTOISO8859MAP* (\MAKERECODEMAP MCCSTOISO))
|
||||
(SETQ *ISO8859TOMCCSMAP* (\MAKERECODEMAP MCCSTOISO T)))
|
||||
[LAMBDA NIL (* ; "Edited 5-Aug-2021 22:15 by rmk:")
|
||||
(* ; "Edited 9-Mar-99 17:19 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 16:24 by ")
|
||||
(* ; "Edited 7-Dec-95 16:20 by ")
|
||||
(LET [(XEROXTOISO '((61217 160)
|
||||
(61291 166)
|
||||
(8994 168)
|
||||
(211 169)
|
||||
(227 170)
|
||||
(61290 172)
|
||||
(61219 173)
|
||||
(210 174)
|
||||
(9086 175)
|
||||
(8999 180)
|
||||
(203 184)
|
||||
(209 185)
|
||||
(235 186)
|
||||
(61729 192)
|
||||
(61730 193)
|
||||
(61731 194)
|
||||
(61732 195)
|
||||
(61735 196)
|
||||
(61736 197)
|
||||
(225 198)
|
||||
(61741 199)
|
||||
(61744 200)
|
||||
(61745 201)
|
||||
(61746 202)
|
||||
(61749 203)
|
||||
(61758 204)
|
||||
(61759 205)
|
||||
(61760 206)
|
||||
(61764 207)
|
||||
(226 208)
|
||||
(61772 209)
|
||||
(61775 210)
|
||||
(61776 211)
|
||||
(61777 212)
|
||||
(61778 213)
|
||||
(61780 214)
|
||||
(180 215)
|
||||
(233 216)
|
||||
(61791 217)
|
||||
(61792 218)
|
||||
(61793 219)
|
||||
(61797 220)
|
||||
(61803 221)
|
||||
(236 222)
|
||||
(251 223)
|
||||
(61857 224)
|
||||
(61858 225)
|
||||
(61859 226)
|
||||
(61860 227)
|
||||
(61863 228)
|
||||
(61864 229)
|
||||
(241 230)
|
||||
(61869 231)
|
||||
(61872 232)
|
||||
(61873 233)
|
||||
(61874 234)
|
||||
(61877 235)
|
||||
(61886 236)
|
||||
(61887 237)
|
||||
(61888 238)
|
||||
(61892 239)
|
||||
(243 240)
|
||||
(61900 241)
|
||||
(61903 242)
|
||||
(61904 243)
|
||||
(61905 244)
|
||||
(61906 245)
|
||||
(61908 246)
|
||||
(184 247)
|
||||
(249 248)
|
||||
(61919 249)
|
||||
(61920 250)
|
||||
(61921 251)
|
||||
(61925 252)
|
||||
(61931 253)
|
||||
(252 254)
|
||||
(61933 255)
|
||||
(61805 376]
|
||||
(SETQ *XEROXTOISO8859MAP* (\MAKERECODEMAP XEROXTOISO))
|
||||
(SETQ *ISO8859TOXEROXMAP* (\MAKERECODEMAP XEROXTOISO T)))
|
||||
(MAKE-EXTERNALFORMAT :ISO8859/1 (FUNCTION \8859INCCODEFN)
|
||||
(FUNCTION \8859PEEKCCODEFN)
|
||||
(FUNCTION \COMMONBACKCCODEFN)
|
||||
@@ -519,28 +515,26 @@
|
||||
(\COMMONBACKCCODEFN
|
||||
[LAMBDA (STRM COUNTP) (* ; "Edited 6-Aug-2021 16:12 by rmk:")
|
||||
(* ; "Edited 8-Dec-95 13:26 by ")
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(CL:WHEN (\BACKFILEPTR STRM)
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(CL:WHEN (\BACKFILEPTR STRM)
|
||||
T)])
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
|
||||
T)])
|
||||
|
||||
(\MAKERECODEMAP
|
||||
[LAMBDA (CODEMAP INVERTED) (* ; "Edited 9-Mar-99 17:23 by rmk:")
|
||||
|
||||
(* ;; "Produces a map array for use by \RECODECCODE. The map array is a 256-array of either NIL or 256-arrays, so that space isn't allocated for widely separated codes.")
|
||||
|
||||
(DECLARE (USEDFREE FASTRECODEMAPCACHE))
|
||||
(CL:WHEN INVERTED
|
||||
[SETQ CODEMAP (FOR C IN CODEMAP COLLECT (LIST (CADR C)
|
||||
(CAR C])
|
||||
(FOR M LEFT RIGHT (MAPARRAY ¬ (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL))
|
||||
CSMAP IN CODEMAP eachtime (SETQ LEFT (CAR M))
|
||||
(SETQ RIGHT (CADR M))
|
||||
(CL:UNLESS (CHARCODEP LEFT)
|
||||
(SETQ LEFT (CHARCODE.DECODE LEFT)))
|
||||
(CL:UNLESS (CHARCODEP RIGHT)
|
||||
(SETQ RIGHT (CHARCODE.DECODE RIGHT)))
|
||||
|
||||
(* ;; "Produces a map array for use by \RECODECCODE. The map array is a 256-array of either NIL or 256-arrays, so that space isn't allocated for widely separated codes.")
|
||||
|
||||
(DECLARE (USEDFREE FASTRECODEMAPCACHE))
|
||||
(CL:WHEN INVERTED
|
||||
[SETQ CODEMAP (FOR C IN CODEMAP COLLECT (LIST (CADR C)
|
||||
(CAR C])
|
||||
(FOR M (MAPARRAY _ (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL))
|
||||
CSMAP IN CODEMAP UNLESS (EQ (CAR M)
|
||||
(CADR M))
|
||||
DO (CL:UNLESS (SETQ CSMAP (CL:SVREF MAPARRAY (LRSH (CAR M)
|
||||
8)))
|
||||
(SETQ CSMAP (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL))
|
||||
(CL:SETF (CL:SVREF MAPARRAY (LRSH (CAR M)
|
||||
8))
|
||||
CSMAP))
|
||||
@@ -552,11 +546,12 @@
|
||||
[LAMBDA (CODE MAPARRAY) (* ; "Edited 9-Mar-99 17:28 by rmk:")
|
||||
(* ; "Edited 21-Jun-95 10:18 by rmk:")
|
||||
|
||||
(* ;; "Recodes a singleton charcode. Leaves everything else unchanged.")
|
||||
|
||||
|
||||
(LET [(CSMAP (CL:SVREF MAPARRAY (LRSH CODE 8]
|
||||
(OR (AND CSMAP (CL:SVREF CSMAP (LOGAND CODE 255)))
|
||||
CODE])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(LET [(CSMAP (CL:SVREF MAPARRAY (LRSH CODE 8]
|
||||
(OR (AND CSMAP (CL:SVREF CSMAP (LOGAND CODE 255)))
|
||||
CODE])
|
||||
)
|
||||
(PUTPROPS ISO8859IO COPYRIGHT ("Xerox Corporation" 1995 1996 1997 1999 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1909 4233 (\8859OUTCHARFN 1919 . 3222) (\8859INCCODEFN 3224 . 3710) (\8859PEEKCCODEFN
|
||||
|
||||
Binary file not shown.
@@ -1,38 +1,41 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED "19-Feb-87 10:40:43" {QV}<LFG>PARSER>NEXT>LAMBDATRAN.;2 9556
|
||||
|
||||
(FILECREATED "18-Feb-2026 16:30:17" {WMEDLEY}<lispusers>LAMBDATRAN.;2 9157
|
||||
changes to%: (FNS FNTYP1 LTDWIMUSERFN LTSTKNAME NARGS)
|
||||
|
||||
:EDIT-BY rmk
|
||||
previous date%: "19-Feb-87 09:56:18" {QV}<LFG>PARSER>NEXT>LAMBDATRAN.;1)
|
||||
|
||||
:PREVIOUS-DATE "19-Feb-87 10:40:43" {WMEDLEY}<lispusers>LAMBDATRAN.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1984, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LAMBDATRANCOMS)
|
||||
|
||||
(RPAQQ LAMBDATRANCOMS
|
||||
[(* Translation machinery for new LAMBDA words)
|
||||
(LOCALVARS . T)
|
||||
[DECLARE%: FIRST (P (VIRGINFN 'ARGLIST T)
|
||||
(MOVD? 'ARGLIST 'OLDARGLIST)
|
||||
(VIRGINFN 'NARGS T)
|
||||
(MOVD? 'NARGS 'OLDNARGS)
|
||||
(VIRGINFN 'ARGTYPE T)
|
||||
(MOVD? 'ARGTYPE 'OLDARGTYPE)
|
||||
(MOVD? 'NILL 'LTDWIMUSERFN]
|
||||
(FNS ARGLIST ARGTYPE FNTYP1 LTDWIMUSERFN LTSTKNAME NARGS)
|
||||
(ADDVARS (DWIMUSERFORMS (LTDWIMUSERFN)))
|
||||
(PROP VARTYPE LAMBDATRANFNS)
|
||||
(ALISTS (LAMBDATRANFNS))
|
||||
(PROP MACRO LTSTKNAME)
|
||||
(P (PUTHASH 'LTSTKNAME '(NIL)
|
||||
MSTEMPLATES))
|
||||
(P (RELINK 'WORLD))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (P (RESETSAVE DWIMIFYCOMPFLG T))
|
||||
(GLOBALVARS CLISPARRAY COMMENTFLG LAMBDASPLST LAMBDATRANFNS BOUNDPDUMMY))
|
||||
(DECLARE%: DONTCOPY (RECORDS LAMBDAWORD))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML LTSTKNAME)
|
||||
(LAMA])
|
||||
(RPAQQ LAMBDATRANCOMS [(* Translation machinery for new LAMBDA words)
|
||||
(LOCALVARS . T)
|
||||
[DECLARE%: FIRST (P (VIRGINFN 'ARGLIST T)
|
||||
(MOVD? 'ARGLIST 'OLDARGLIST)
|
||||
(VIRGINFN 'NARGS T)
|
||||
(MOVD? 'NARGS 'OLDNARGS)
|
||||
(VIRGINFN 'ARGTYPE T)
|
||||
(MOVD? 'ARGTYPE 'OLDARGTYPE)
|
||||
(MOVD? 'NILL 'LTDWIMUSERFN]
|
||||
(FNS ARGLIST ARGTYPE FNTYP1 LTDWIMUSERFN LTSTKNAME NARGS)
|
||||
(ADDVARS (DWIMUSERFORMS (LTDWIMUSERFN)))
|
||||
(PROP VARTYPE LAMBDATRANFNS)
|
||||
(ALISTS (LAMBDATRANFNS))
|
||||
(PROP MACRO LTSTKNAME)
|
||||
(P (PUTHASH 'LTSTKNAME '(NIL) MSTEMPLATES))
|
||||
(P (RELINK 'WORLD))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (P (RESETSAVE DWIMIFYCOMPFLG T))
|
||||
(GLOBALVARS CLISPARRAY COMMENTFLG LAMBDASPLST LAMBDATRANFNS BOUNDPDUMMY
|
||||
))
|
||||
(DECLARE%: DONTCOPY (RECORDS LAMBDAWORD))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA)
|
||||
(NLAML LTSTKNAME)
|
||||
(LAMA])
|
||||
|
||||
|
||||
|
||||
@@ -43,19 +46,12 @@
|
||||
(LOCALVARS . T)
|
||||
)
|
||||
(DECLARE%: FIRST
|
||||
|
||||
(VIRGINFN 'ARGLIST T)
|
||||
|
||||
(MOVD? 'ARGLIST 'OLDARGLIST)
|
||||
|
||||
(VIRGINFN 'NARGS T)
|
||||
|
||||
(MOVD? 'NARGS 'OLDNARGS)
|
||||
|
||||
(VIRGINFN 'ARGTYPE T)
|
||||
|
||||
(MOVD? 'ARGTYPE 'OLDARGTYPE)
|
||||
|
||||
(MOVD? 'NILL 'LTDWIMUSERFN)
|
||||
)
|
||||
(DEFINEQ
|
||||
@@ -194,18 +190,14 @@
|
||||
|
||||
(ADDTOVAR DWIMUSERFORMS (LTDWIMUSERFN))
|
||||
|
||||
(PUTPROPS LAMBDATRANFNS VARTYPE ALIST)
|
||||
(PUTPROPS LAMBDATRANFNS VARTYPE ALIST)
|
||||
|
||||
(ADDTOVAR LAMBDATRANFNS )
|
||||
|
||||
(PUTPROPS LTSTKNAME MACRO (X (CONS COMMENTFLG X)))
|
||||
|
||||
(PUTHASH 'LTSTKNAME '(NIL)
|
||||
MSTEMPLATES)
|
||||
|
||||
(PUTPROPS LTSTKNAME MACRO (X (CONS COMMENTFLG X)))
|
||||
(PUTHASH 'LTSTKNAME '(NIL) MSTEMPLATES)
|
||||
(RELINK 'WORLD)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(RESETSAVE DWIMIFYCOMPFLG T)
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
@@ -227,7 +219,8 @@
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS LAMBDATRAN COPYRIGHT ("Xerox Corporation" 1984 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1871 8468 (ARGLIST 1881 . 2835) (ARGTYPE 2837 . 3191) (FNTYP1 3193 . 4102) (
|
||||
LTDWIMUSERFN 4104 . 7604) (LTSTKNAME 7606 . 8130) (NARGS 8132 . 8466)))))
|
||||
(FILEMAP (NIL (2224 8821 (ARGLIST 2234 . 3188) (ARGTYPE 3190 . 3544) (FNTYP1 3546 . 4455) (
|
||||
LTDWIMUSERFN 4457 . 7957) (LTSTKNAME 7959 . 8483) (NARGS 8485 . 8819)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,127 +1,128 @@
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "LAYOUT-SEDIT" ( NICKNAMES "L-S")) READTABLE "XCL" BASE 10)
|
||||
(DEFINE-FILE-INFO §READTABLE "XCL" §PACKAGE (DEFPACKAGE "LAYOUT-SEDIT" (§NICKNAMES "L-S")))
|
||||
(il:filecreated " 9-Jan-87 19:55:25" il:{eris}<lispusers>lispcore>layout-sedit.\;2 7190
|
||||
|
||||
(IL:FILECREATED "18-Feb-2026 16:36:18" IL:|{WMEDLEY}<lispusers>LAYOUT-SEDIT.;2| 5714
|
||||
il:|changes| il:|to:| (il:variables user::*l-s-region-zero* user::*l-s-region-delta*
|
||||
user::*l-s-reuse-earlier-regions*)
|
||||
(il:functions get-region save-region user::use-l-s-regions
|
||||
user::stop-using-l-s-regions)
|
||||
(il:vars il:layout-seditcoms)
|
||||
|
||||
:EDIT-BY IL:|rmk|
|
||||
|
||||
:CHANGES-TO (IL:VARS IL:LAYOUT-SEDITCOMS)
|
||||
(IL:VARIABLES *REGION-ALIST* USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA*
|
||||
USER::*L-S-REUSE-EARLIER-REGIONS*)
|
||||
(IL:FUNCTIONS USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS REGION-PLUS
|
||||
GET-REGION SAVE-REGION)
|
||||
|
||||
:PREVIOUS-DATE " 9-Jan-87 19:55:25" IL:|{WMEDLEY}<lispusers>LAYOUT-SEDIT.;1|)
|
||||
il:|previous| il:|date:| "26-Dec-86 19:42:46" il:{eris}<pavel>lisp>layout-sedit.\;2)
|
||||
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:LAYOUT-SEDITCOMS)
|
||||
; Copyright (c) 1986, 1987 by Pavel Curtis. All rights reserved.
|
||||
|
||||
(IL:RPAQQ IL:LAYOUT-SEDITCOMS
|
||||
((IL:FUNCTIONS USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS)
|
||||
(IL:VARIABLES *REGION-ALIST* USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA*
|
||||
USER::*L-S-REUSE-EARLIER-REGIONS*)
|
||||
(IL:FUNCTIONS REGION-PLUS)
|
||||
(IL:FUNCTIONS GET-REGION SAVE-REGION)
|
||||
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DONTEVAL@COMPILE IL:DOCOPY (IL:P (USER::USE-L-S-REGIONS)
|
||||
))
|
||||
|
||||
(IL:* IL:|;;| "Arrange to use the proper compiler and makefile environment ")
|
||||
(il:prettycomprint il:layout-seditcoms)
|
||||
|
||||
(IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT)
|
||||
IL:LAYOUT-SEDIT)))
|
||||
(il:rpaqq il:layout-seditcoms ((il:functions user::use-l-s-regions user::stop-using-l-s-regions)
|
||||
(il:variables *region-alist* user::*l-s-region-zero*
|
||||
user::*l-s-region-delta* user::*l-s-reuse-earlier-regions*)
|
||||
(il:functions region-plus)
|
||||
(il:functions get-region save-region)
|
||||
(il:declare\: il:donteval@load il:donteval@compile il:docopy
|
||||
(il:p (user::use-l-s-regions)))
|
||||
(il:* il:|;;|
|
||||
"Arrange to use the proper compiler and makefile environment ")
|
||||
(il:prop (il:filetype il:makefile-environment)
|
||||
il:layout-sedit)))
|
||||
|
||||
(DEFUN USER::USE-L-S-REGIONS ()
|
||||
(ASSERT (NULL IL:|\\\\contexts|)
|
||||
NIL "Close all open SEdit windows")
|
||||
(IL:SEDIT.RESET)
|
||||
(IL:MOVD 'IL:SEDIT.GET.WINDOW.REGION 'OLD-GET-REGION)
|
||||
(IL:MOVD 'IL:SEDIT.SAVE.WINDOW.REGION 'OLD-SAVE-REGION)
|
||||
(IL:MOVD 'GET-REGION 'IL:SEDIT.GET.WINDOW.REGION)
|
||||
(IL:MOVD 'SAVE-REGION 'IL:SEDIT.SAVE.WINDOW.REGION))
|
||||
(defun user::use-l-s-regions nil (assert (null il:|\\\\contexts|)
|
||||
nil "Close all open SEdit windows")
|
||||
(il:sedit.reset)
|
||||
(il:movd 'il:sedit.get.window.region 'old-get-region)
|
||||
(il:movd 'il:sedit.save.window.region 'old-save-region)
|
||||
(il:movd 'get-region 'il:sedit.get.window.region)
|
||||
(il:movd 'save-region 'il:sedit.save.window.region))
|
||||
|
||||
(DEFUN USER::STOP-USING-L-S-REGIONS ()
|
||||
(ASSERT (NULL IL:|\\\\contexts|)
|
||||
NIL "Close all open SEdit windows")
|
||||
(IL:SEDIT.RESET)
|
||||
(IL:MOVD 'OLD-GET-REGION 'IL:SEDIT.GET.WINDOW.REGION)
|
||||
(IL:MOVD 'OLD-SAVE-REGION 'IL:SEDIT.SAVE.WINDOW.REGION))
|
||||
|
||||
(DEFVAR *REGION-ALIST* NIL
|
||||
(defun user::stop-using-l-s-regions nil (assert (null il:|\\\\contexts|)
|
||||
nil "Close all open SEdit windows")
|
||||
(il:sedit.reset)
|
||||
(il:movd 'old-get-region 'il:sedit.get.window.region)
|
||||
(il:movd 'old-save-region 'il:sedit.save.window.region))
|
||||
|
||||
(IL:* IL:|;;;| "An AList mapping a region to the SEdit context that currently owns it. The associations of regions no longer in use should have a CDR of NIL. The list is kept in reverse order, with the farthest region from *REGION-ZERO* at the front of the list. So as to allow experimentation by users, we maintain the invariant that the first association on the list never has a CDR of NIL. To reestablish that invariant, we sometimes POP the AList rather than set the CDR to NIL.")
|
||||
|
||||
)
|
||||
(defvar *region-alist* nil
|
||||
|
||||
(DEFVAR USER::*L-S-REGION-ZERO* (IL:CREATEREGION 25 (- (TRUNCATE IL:SCREENHEIGHT 2)
|
||||
(il:* il:|;;;| "An AList mapping a region to the SEdit context that currently owns it. The associations of regions no longer in use should have a CDR of NIL. The list is kept in reverse order, with the farthest region from *REGION-ZERO* at the front of the list. So as to allow experimentation by users, we maintain the invariant that the first association on the list never has a CDR of NIL. To reestablish that invariant, we sometimes POP the AList rather than set the CDR to NIL.")
|
||||
)
|
||||
|
||||
|
||||
(defvar user::*l-s-region-zero* (il:createregion 25 (- (truncate il:screenheight 2)
|
||||
19)
|
||||
(TRUNCATE IL:SCREENWIDTH 2)
|
||||
(TRUNCATE IL:SCREENHEIGHT 2))
|
||||
(truncate il:screenwidth 2)
|
||||
(truncate il:screenheight 2))
|
||||
|
||||
(IL:* IL:|;;;| "The region to be used by the first SEdit window. This works in conjunction with USER::*L-S-REGION-DELTA* to specify the region for each new SEdit window.")
|
||||
(il:* il:|;;;| "The region to be used by the first SEdit window. This works in conjunction with USER::*L-S-REGION-DELTA* to specify the region for each new SEdit window.")
|
||||
)
|
||||
|
||||
)
|
||||
|
||||
(DEFVAR USER::*L-S-REGION-DELTA* (IL:CREATEREGION 11 -44 0 0))
|
||||
(defvar user::*l-s-region-delta* (il:createregion 11 -44 0 0) )
|
||||
|
||||
(DEFVAR USER::*L-S-REUSE-EARLIER-REGIONS* NIL
|
||||
|
||||
(IL:* IL:|;;;| "If non-NIL, then earlier regions (i.e., those closer to USER::*L-S-REGION-ZERO* will get reused when free. Otherwise, new regions, farther from USER::*L-S-REGION-ZERO* than any currently in use, will be created.")
|
||||
(defvar user::*l-s-reuse-earlier-regions* nil
|
||||
|
||||
)
|
||||
(il:* il:|;;;| "If non-NIL, then earlier regions (i.e., those closer to USER::*L-S-REGION-ZERO* will get reused when free. Otherwise, new regions, farther from USER::*L-S-REGION-ZERO* than any currently in use, will be created.")
|
||||
)
|
||||
|
||||
(DEFUN REGION-PLUS (ONE TWO)
|
||||
(IL:CREATEREGION (+ (IL:FETCH (IL:REGION IL:LEFT) IL:OF ONE)
|
||||
(IL:FETCH (IL:REGION IL:LEFT) IL:OF TWO))
|
||||
(+ (IL:FETCH (IL:REGION IL:BOTTOM) IL:OF ONE)
|
||||
(IL:FETCH (IL:REGION IL:BOTTOM) IL:OF TWO))
|
||||
(+ (IL:FETCH (IL:REGION IL:WIDTH) IL:OF ONE)
|
||||
(IL:FETCH (IL:REGION IL:WIDTH) IL:OF TWO))
|
||||
(+ (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF ONE)
|
||||
(IL:FETCH (IL:REGION IL:HEIGHT) IL:OF TWO))))
|
||||
|
||||
(DEFUN GET-REGION (CONTEXT)
|
||||
(LET ((PAIR (AND USER::*L-S-REUSE-EARLIER-REGIONS* (FIND NIL *REGION-ALIST* :KEY 'CDR))))
|
||||
(COND
|
||||
((NULL PAIR)
|
||||
(COND
|
||||
((NULL *REGION-ALIST*)
|
||||
(SETQ *REGION-ALIST* (LIST (CONS USER::*L-S-REGION-ZERO* CONTEXT)))
|
||||
USER::*L-S-REGION-ZERO*)
|
||||
(T (LET ((NEW-REGION (REGION-PLUS (CAR (FIRST *REGION-ALIST*))
|
||||
USER::*L-S-REGION-DELTA*)))
|
||||
(PUSH (CONS NEW-REGION CONTEXT)
|
||||
*REGION-ALIST*)
|
||||
NEW-REGION))))
|
||||
(T (SETF (CDR PAIR)
|
||||
CONTEXT)
|
||||
(CAR PAIR)))))
|
||||
(defun region-plus (one two) (il:createregion (+ (il:fetch (il:region il:left) il:of one)
|
||||
(il:fetch (il:region il:left) il:of two))
|
||||
(+ (il:fetch (il:region il:bottom) il:of one)
|
||||
(il:fetch (il:region il:bottom) il:of two))
|
||||
(+ (il:fetch (il:region il:width) il:of one)
|
||||
(il:fetch (il:region il:width) il:of two))
|
||||
(+ (il:fetch (il:region il:height) il:of one)
|
||||
(il:fetch (il:region il:height) il:of two))))
|
||||
|
||||
(DEFUN SAVE-REGION (CONTEXT)
|
||||
|
||||
(IL:* IL:|;;;| "The context is done with its region. Deallocate it.")
|
||||
(defun get-region (context) (let ((pair (and user::*l-s-reuse-earlier-regions* (find nil
|
||||
*region-alist*
|
||||
:key
|
||||
'cdr))))
|
||||
(cond
|
||||
((null pair)
|
||||
(cond
|
||||
((null *region-alist*)
|
||||
(setq *region-alist* (list (cons user::*l-s-region-zero*
|
||||
context)))
|
||||
user::*l-s-region-zero*)
|
||||
(t (let ((new-region (region-plus (car (first *region-alist*)
|
||||
)
|
||||
user::*l-s-region-delta*)))
|
||||
(push (cons new-region context)
|
||||
*region-alist*)
|
||||
new-region))))
|
||||
(t (setf (cdr pair)
|
||||
context)
|
||||
(car pair)))))
|
||||
|
||||
(LET ((PAIR (FIND CONTEXT *REGION-ALIST* :KEY 'CDR)))
|
||||
(IF (NULL PAIR)
|
||||
(WARN "An SEdit context is trying to give up an unallocated region.")
|
||||
(SETF (CDR PAIR)
|
||||
NIL))
|
||||
(SETQ *REGION-ALIST* (MEMBER-IF-NOT 'NULL *REGION-ALIST* :KEY 'CDR))))
|
||||
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DONTEVAL@COMPILE IL:DOCOPY
|
||||
|
||||
(USER::USE-L-S-REGIONS)
|
||||
(defun save-region (context)
|
||||
|
||||
(il:* il:|;;;| "The context is done with its region. Deallocate it.")
|
||||
(let ((pair (find context *region-alist* :key 'cdr)))
|
||||
(if (null pair)
|
||||
(warn "An SEdit context is trying to give up an unallocated region.")
|
||||
(setf (cdr pair)
|
||||
nil))
|
||||
(setq *region-alist* (member-if-not 'null *region-alist* :key 'cdr))))
|
||||
|
||||
(il:declare\: il:donteval@load il:donteval@compile il:docopy
|
||||
(user::use-l-s-regions)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(IL:* IL:|;;| "Arrange to use the proper compiler and makefile environment ")
|
||||
(il:* il:|;;| "Arrange to use the proper compiler and makefile environment ")
|
||||
|
||||
|
||||
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:FILETYPE COMPILE-FILE)
|
||||
(il:putprops il:layout-sedit il:filetype compile-file)
|
||||
|
||||
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE (XCL:DEFPACKAGE
|
||||
(il:putprops il:layout-sedit il:makefile-environment (:readtable "XCL" :package (xcl:defpackage
|
||||
"LAYOUT-SEDIT"
|
||||
(:NICKNAMES "L-S"))))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL (1426 1788 (USER::USE-L-S-REGIONS 1426 . 1788)) (1790 2051 (USER::STOP-USING-L-S-REGIONS
|
||||
1790 . 2051)) (3443 4007 (REGION-PLUS 3443 . 4007)) (4009 4732 (GET-REGION 4009 . 4732)) (4734 5138 (
|
||||
SAVE-REGION 4734 . 5138)))))
|
||||
IL:STOP
|
||||
(:nicknames "L-S"))))
|
||||
(il:putprops il:layout-sedit il:copyright ("Pavel Curtis" 1986 1987))
|
||||
(il:declare\: il:dontcopy
|
||||
(il:filemap (nil)))
|
||||
il:stop
|
||||
|
||||
@@ -1,52 +1 @@
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "LAYOUT-SEDIT" ( NICKNAMES "L-S")) READTABLE "XCL" BASE 10)
|
||||
|
||||
(IL:FILECREATED "18-Feb-2026 16:39:44" ("compiled on " IL:|{WMEDLEY}<lispusers>LAYOUT-SEDIT.;2|)
|
||||
"18-Feb-2026 16:37:55" IL:|bcompl'd| IL:|in| "FULL 18-Feb-2026 ..." IL:|dated| "18-Feb-2026 16:38:04")
|
||||
(IL:FILECREATED "18-Feb-2026 16:36:18" IL:|{WMEDLEY}<lispusers>LAYOUT-SEDIT.;2| 5714 :EDIT-BY IL:|rmk|
|
||||
:CHANGES-TO (IL:VARS IL:LAYOUT-SEDITCOMS) (IL:VARIABLES *REGION-ALIST* USER::*L-S-REGION-ZERO*
|
||||
USER::*L-S-REGION-DELTA* USER::*L-S-REUSE-EARLIER-REGIONS*) (IL:FUNCTIONS USER::USE-L-S-REGIONS
|
||||
USER::STOP-USING-L-S-REGIONS REGION-PLUS GET-REGION SAVE-REGION) :PREVIOUS-DATE " 9-Jan-87 19:55:25"
|
||||
IL:|{WMEDLEY}<lispusers>LAYOUT-SEDIT.;1|)
|
||||
(IL:PRETTYCOMPRINT IL:LAYOUT-SEDITCOMS)
|
||||
(IL:RPAQQ IL:LAYOUT-SEDITCOMS ((IL:FUNCTIONS USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS) (
|
||||
IL:VARIABLES *REGION-ALIST* USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA*
|
||||
USER::*L-S-REUSE-EARLIER-REGIONS*) (IL:FUNCTIONS REGION-PLUS) (IL:FUNCTIONS GET-REGION SAVE-REGION) (
|
||||
IL:DECLARE\: IL:DONTEVAL@LOAD IL:DONTEVAL@COMPILE IL:DOCOPY (IL:P (USER::USE-L-S-REGIONS))) (IL:*
|
||||
IL:|;;| "Arrange to use the proper compiler and makefile environment ") (IL:PROP (IL:FILETYPE
|
||||
IL:MAKEFILE-ENVIRONMENT) IL:LAYOUT-SEDIT)))
|
||||
(DEFUN USER::USE-L-S-REGIONS NIL (ASSERT (NULL IL:|\\\\contexts|) NIL "Close all open SEdit windows")
|
||||
(IL:SEDIT.RESET) (IL:MOVD (QUOTE IL:SEDIT.GET.WINDOW.REGION) (QUOTE OLD-GET-REGION)) (IL:MOVD (QUOTE
|
||||
IL:SEDIT.SAVE.WINDOW.REGION) (QUOTE OLD-SAVE-REGION)) (IL:MOVD (QUOTE GET-REGION) (QUOTE
|
||||
IL:SEDIT.GET.WINDOW.REGION)) (IL:MOVD (QUOTE SAVE-REGION) (QUOTE IL:SEDIT.SAVE.WINDOW.REGION)))
|
||||
(DEFUN USER::STOP-USING-L-S-REGIONS NIL (ASSERT (NULL IL:|\\\\contexts|) NIL
|
||||
"Close all open SEdit windows") (IL:SEDIT.RESET) (IL:MOVD (QUOTE OLD-GET-REGION) (QUOTE
|
||||
IL:SEDIT.GET.WINDOW.REGION)) (IL:MOVD (QUOTE OLD-SAVE-REGION) (QUOTE IL:SEDIT.SAVE.WINDOW.REGION)))
|
||||
(DEFVAR *REGION-ALIST* NIL (IL:* IL:|;;;|
|
||||
"An AList mapping a region to the SEdit context that currently owns it. The associations of regions no longer in use should have a CDR of NIL. The list is kept in reverse order, with the farthest region from *REGION-ZERO* at the front of the list. So as to allow experimentation by users, we maintain the invariant that the first association on the list never has a CDR of NIL. To reestablish that invariant, we sometimes POP the AList rather than set the CDR to NIL."
|
||||
))
|
||||
(DEFVAR USER::*L-S-REGION-ZERO* (IL:CREATEREGION 25 (- (TRUNCATE IL:SCREENHEIGHT 2) 19) (TRUNCATE
|
||||
IL:SCREENWIDTH 2) (TRUNCATE IL:SCREENHEIGHT 2)) (IL:* IL:|;;;|
|
||||
"The region to be used by the first SEdit window. This works in conjunction with USER::*L-S-REGION-DELTA* to specify the region for each new SEdit window."
|
||||
))
|
||||
(DEFVAR USER::*L-S-REGION-DELTA* (IL:CREATEREGION 11 -44 0 0))
|
||||
(DEFVAR USER::*L-S-REUSE-EARLIER-REGIONS* NIL (IL:* IL:|;;;|
|
||||
"If non-NIL, then earlier regions (i.e., those closer to USER::*L-S-REGION-ZERO* will get reused when free. Otherwise, new regions, farther from USER::*L-S-REGION-ZERO* than any currently in use, will be created."
|
||||
))
|
||||
(DEFUN REGION-PLUS (ONE TWO) (IL:CREATEREGION (+ (IL:FETCH (IL:REGION IL:LEFT) IL:OF ONE) (IL:FETCH (
|
||||
IL:REGION IL:LEFT) IL:OF TWO)) (+ (IL:FETCH (IL:REGION IL:BOTTOM) IL:OF ONE) (IL:FETCH (IL:REGION
|
||||
IL:BOTTOM) IL:OF TWO)) (+ (IL:FETCH (IL:REGION IL:WIDTH) IL:OF ONE) (IL:FETCH (IL:REGION IL:WIDTH) IL:OF
|
||||
TWO)) (+ (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF ONE) (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF TWO))))
|
||||
(DEFUN GET-REGION (CONTEXT) (LET ((PAIR (AND USER::*L-S-REUSE-EARLIER-REGIONS* (FIND NIL
|
||||
*REGION-ALIST* :KEY (QUOTE CDR))))) (COND ((NULL PAIR) (COND ((NULL *REGION-ALIST*) (SETQ
|
||||
*REGION-ALIST* (LIST (CONS USER::*L-S-REGION-ZERO* CONTEXT))) USER::*L-S-REGION-ZERO*) (T (LET ((
|
||||
NEW-REGION (REGION-PLUS (CAR (FIRST *REGION-ALIST*)) USER::*L-S-REGION-DELTA*))) (PUSH (CONS
|
||||
NEW-REGION CONTEXT) *REGION-ALIST*) NEW-REGION)))) (T (SETF (CDR PAIR) CONTEXT) (CAR PAIR)))))
|
||||
(DEFUN SAVE-REGION (CONTEXT) (IL:* IL:|;;;| "The context is done with its region. Deallocate it.") (
|
||||
LET ((PAIR (FIND CONTEXT *REGION-ALIST* :KEY (QUOTE CDR)))) (IF (NULL PAIR) (WARN
|
||||
"An SEdit context is trying to give up an unallocated region.") (SETF (CDR PAIR) NIL)) (SETQ
|
||||
*REGION-ALIST* (MEMBER-IF-NOT (QUOTE NULL) *REGION-ALIST* :KEY (QUOTE CDR)))))
|
||||
(USER::USE-L-S-REGIONS)
|
||||
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:FILETYPE COMPILE-FILE)
|
||||
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE (XCL:DEFPACKAGE
|
||||
"LAYOUT-SEDIT" (:NICKNAMES "L-S"))))
|
||||
NIL
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "LAYOUT-SEDIT" ( NICKNAMES "L-S")))
(IL:FILECREATED " 9-Sep-94 13:47:35" ("compiled on " IL:|{DSK}<lispcore>lispusers>LAYOUT-SEDIT.;1|)
"28-Jul-94 17:28:46" IL:|bcompl'd| IL:|in| "Medley 25-Aug-94 ..." IL:|dated| "25-Aug-94 10:02:49")
(IL:FILECREATED " 9-Jan-87 19:55:25" IL:{ERIS}<LISPUSERS>LISPCORE>LAYOUT-SEDIT.\;2 7190 IL:|changes|
IL:|to:| (IL:VARIABLES USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA* USER::*L-S-REUSE-EARLIER-REGIONS*
) (IL:FUNCTIONS GET-REGION SAVE-REGION USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS) (IL:VARS
IL:LAYOUT-SEDITCOMS) IL:|previous| IL:|date:| "26-Dec-86 19:42:46" IL:{ERIS}<PAVEL>LISP>LAYOUT-SEDIT.\;2
)
(IL:PRETTYCOMPRINT IL:LAYOUT-SEDITCOMS)
(IL:RPAQQ IL:LAYOUT-SEDITCOMS ((IL:FUNCTIONS USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS) (
IL:VARIABLES *REGION-ALIST* USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA*
USER::*L-S-REUSE-EARLIER-REGIONS*) (IL:FUNCTIONS REGION-PLUS) (IL:FUNCTIONS GET-REGION SAVE-REGION) (
IL:DECLARE\: IL:DONTEVAL@LOAD IL:DONTEVAL@COMPILE IL:DOCOPY (IL:P (USER::USE-L-S-REGIONS))) (IL:*
IL:|;;| "Arrange to use the proper compiler and makefile environment ") (IL:PROP (IL:FILETYPE
IL:MAKEFILE-ENVIRONMENT) IL:LAYOUT-SEDIT)))
(DEFUN USER::USE-L-S-REGIONS NIL (ASSERT (NULL IL:|\\\\contexts|) NIL "Close all open SEdit windows")
(IL:SEDIT.RESET) (IL:MOVD (QUOTE IL:SEDIT.GET.WINDOW.REGION) (QUOTE OLD-GET-REGION)) (IL:MOVD (QUOTE
IL:SEDIT.SAVE.WINDOW.REGION) (QUOTE OLD-SAVE-REGION)) (IL:MOVD (QUOTE GET-REGION) (QUOTE
IL:SEDIT.GET.WINDOW.REGION)) (IL:MOVD (QUOTE SAVE-REGION) (QUOTE IL:SEDIT.SAVE.WINDOW.REGION)))
(DEFUN USER::STOP-USING-L-S-REGIONS NIL (ASSERT (NULL IL:|\\\\contexts|) NIL
"Close all open SEdit windows") (IL:SEDIT.RESET) (IL:MOVD (QUOTE OLD-GET-REGION) (QUOTE
IL:SEDIT.GET.WINDOW.REGION)) (IL:MOVD (QUOTE OLD-SAVE-REGION) (QUOTE IL:SEDIT.SAVE.WINDOW.REGION)))
(DEFVAR *REGION-ALIST* NIL (IL:* IL:|;;;|
"An AList mapping a region to the SEdit context that currently owns it. The associations of regions no longer in use should have a CDR of NIL. The list is kept in reverse order, with the farthest region from *REGION-ZERO* at the front of the list. So as to allow experimentation by users, we maintain the invariant that the first association on the list never has a CDR of NIL. To reestablish that invariant, we sometimes POP the AList rather than set the CDR to NIL."
))
(DEFVAR USER::*L-S-REGION-ZERO* (IL:CREATEREGION 25 (- (TRUNCATE IL:SCREENHEIGHT 2) 19) (TRUNCATE
IL:SCREENWIDTH 2) (TRUNCATE IL:SCREENHEIGHT 2)) (IL:* IL:|;;;|
"The region to be used by the first SEdit window. This works in conjunction with USER::*L-S-REGION-DELTA* to specify the region for each new SEdit window."
))
(DEFVAR USER::*L-S-REGION-DELTA* (IL:CREATEREGION 11 -44 0 0))
(DEFVAR USER::*L-S-REUSE-EARLIER-REGIONS* NIL (IL:* IL:|;;;|
"If non-NIL, then earlier regions (i.e., those closer to USER::*L-S-REGION-ZERO* will get reused when free. Otherwise, new regions, farther from USER::*L-S-REGION-ZERO* than any currently in use, will be created."
))
(DEFUN REGION-PLUS (ONE TWO) (IL:CREATEREGION (+ (IL:FETCH (IL:REGION IL:LEFT) IL:OF ONE) (IL:FETCH (
IL:REGION IL:LEFT) IL:OF TWO)) (+ (IL:FETCH (IL:REGION IL:BOTTOM) IL:OF ONE) (IL:FETCH (IL:REGION
IL:BOTTOM) IL:OF TWO)) (+ (IL:FETCH (IL:REGION IL:WIDTH) IL:OF ONE) (IL:FETCH (IL:REGION IL:WIDTH) IL:OF
TWO)) (+ (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF ONE) (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF TWO))))
(DEFUN GET-REGION (CONTEXT) (LET ((PAIR (AND USER::*L-S-REUSE-EARLIER-REGIONS* (FIND NIL
*REGION-ALIST* :KEY (QUOTE CDR))))) (COND ((NULL PAIR) (COND ((NULL *REGION-ALIST*) (SETQ
*REGION-ALIST* (LIST (CONS USER::*L-S-REGION-ZERO* CONTEXT))) USER::*L-S-REGION-ZERO*) (T (LET ((
NEW-REGION (REGION-PLUS (CAR (FIRST *REGION-ALIST*)) USER::*L-S-REGION-DELTA*))) (PUSH (CONS
NEW-REGION CONTEXT) *REGION-ALIST*) NEW-REGION)))) (T (SETF (CDR PAIR) CONTEXT) (CAR PAIR)))))
(DEFUN SAVE-REGION (CONTEXT) (IL:* IL:|;;;| "The context is done with its region. Deallocate it.") (
LET ((PAIR (FIND CONTEXT *REGION-ALIST* :KEY (QUOTE CDR)))) (IF (NULL PAIR) (WARN
"An SEdit context is trying to give up an unallocated region.") (SETF (CDR PAIR) NIL)) (SETQ
*REGION-ALIST* (MEMBER-IF-NOT (QUOTE NULL) *REGION-ALIST* :KEY (QUOTE CDR)))))
(USER::USE-L-S-REGIONS)
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:FILETYPE COMPILE-FILE)
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE (XCL:DEFPACKAGE
"LAYOUT-SEDIT" (:NICKNAMES "L-S"))))
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:COPYRIGHT ("Pavel Curtis" 1986 1987))
NIL
|
||||
@@ -1,27 +1,32 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED " 2-Feb-87 10:38:19" {ERIS}<LISPUSERS>LYRIC>PHONE-DIRECTORY.;1 9029
|
||||
|
||||
(FILECREATED "18-Feb-2026 16:27:33" {WMEDLEY}<lispusers>PHONE-DIRECTORY.;2 8485
|
||||
changes to%: (VARS PHONE-DIRECTORYCOMS)
|
||||
|
||||
:EDIT-BY rmk
|
||||
previous date%: " 9-Jan-87 19:45:25" {ERIS}<LISPUSERS>KOTO>PHONE-DIRECTORY.;3)
|
||||
|
||||
:PREVIOUS-DATE " 2-Feb-87 10:38:19" {WMEDLEY}<lispusers>PHONE-DIRECTORY.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT PHONE-DIRECTORYCOMS)
|
||||
|
||||
(RPAQQ PHONE-DIRECTORYCOMS
|
||||
((FNS Cache-Phone-Directory-Files Let-your-fingers-do-the-walking Phone-Directory-Kill-Proc
|
||||
Phone-Window-ButtonEventFn Lookup-Person Phone-Window-WhenOpenedFn)
|
||||
(VARS fingersIconMask fingersIconBM)
|
||||
(INITVARS (*Cached-Phone-Directory-Files* NIL)
|
||||
(*Phone-Directory-Pos* (create POSITION XCOORD _ 15 YCOORD _ (DIFFERENCE SCREENHEIGHT
|
||||
75)))
|
||||
(*Phone-Directory-Region* (CREATEREGION 15 (DIFFERENCE SCREENHEIGHT 258)
|
||||
400 250)))
|
||||
(GLOBALVARS *Cached-Phone-Directory-Files* *Phone-Directory-Pos* *Phone-Directory-Region*
|
||||
fingersIconMask fingersIconBM)
|
||||
(FILES GREP)
|
||||
(P (Let-your-fingers-do-the-walking))))
|
||||
(RPAQQ PHONE-DIRECTORYCOMS ((FNS Cache-Phone-Directory-Files Let-your-fingers-do-the-walking
|
||||
Phone-Directory-Kill-Proc Phone-Window-ButtonEventFn Lookup-Person
|
||||
Phone-Window-WhenOpenedFn)
|
||||
(VARS fingersIconMask fingersIconBM)
|
||||
(INITVARS (*Cached-Phone-Directory-Files* NIL)
|
||||
(*Phone-Directory-Pos* (create POSITION XCOORD _ 15 YCOORD _
|
||||
(DIFFERENCE SCREENHEIGHT 75)))
|
||||
(*Phone-Directory-Region* (CREATEREGION 15 (DIFFERENCE
|
||||
SCREENHEIGHT 258
|
||||
)
|
||||
400 250)))
|
||||
(GLOBALVARS *Cached-Phone-Directory-Files* *Phone-Directory-Pos*
|
||||
*Phone-Directory-Region* fingersIconMask fingersIconBM)
|
||||
(FILES GREP)
|
||||
(P (Let-your-fingers-do-the-walking))))
|
||||
(DEFINEQ
|
||||
|
||||
(Cache-Phone-Directory-Files
|
||||
@@ -134,12 +139,11 @@
|
||||
(GLOBALVARS *Cached-Phone-Directory-Files* *Phone-Directory-Pos* *Phone-Directory-Region*
|
||||
fingersIconMask fingersIconBM)
|
||||
)
|
||||
|
||||
(FILESLOAD GREP)
|
||||
|
||||
(Let-your-fingers-do-the-walking)
|
||||
(Let-your-fingers-do-the-walking)
|
||||
(PUTPROPS PHONE-DIRECTORY COPYRIGHT ("Xerox Corporation" 1986 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1168 5892 (Cache-Phone-Directory-Files 1178 . 2473) (Let-your-fingers-do-the-walking
|
||||
2475 . 3770) (Phone-Directory-Kill-Proc 3772 . 4203) (Phone-Window-ButtonEventFn 4205 . 4881) (
|
||||
Lookup-Person 4883 . 5495) (Phone-Window-WhenOpenedFn 5497 . 5890)))))
|
||||
(FILEMAP (NIL (1649 6373 (Cache-Phone-Directory-Files 1659 . 2954) (Let-your-fingers-do-the-walking
|
||||
2956 . 4251) (Phone-Directory-Kill-Proc 4253 . 4684) (Phone-Window-ButtonEventFn 4686 . 5362) (
|
||||
Lookup-Person 5364 . 5976) (Phone-Window-WhenOpenedFn 5978 . 6371)))))
|
||||
STOP
|
||||
|
||||
@@ -1,18 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" ( USE "XCL" "LISP") ( EXPORT "READ-BDF" "BUILD-COMPOSITE"
|
||||
"WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE") ( IMPORT-FROM "IL" "BITBLT" "BITMAPBIT" "BITMAPCREATE"
|
||||
"BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "CHARSETPROP"
|
||||
"DISPLAY" "FONTDESCRIPTOR" "FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MCCS" "MEDIUM"
|
||||
"REGULAR" "TCONC" "UTOMCODE?" "MEDLEYFONT.FILENAME" "MEDLEYFONT.WRITE.FONT")) READTABLE "XCL" BASE
|
||||
10)
|
||||
"BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "DISPLAY"
|
||||
"FONTDESCRIPTOR" "FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MCCS" "MEDIUM" "REGULAR" "TCONC"
|
||||
"UTOMCODE?" "MEDLEYFONT.FILENAME" "MEDLEYFONT.WRITE.FONT")) READTABLE "XCL" BASE 10)
|
||||
|
||||
(IL:FILECREATED " 8-Dec-2025 12:13:40" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;9| 51309
|
||||
(IL:FILECREATED "23-Feb-2026 20:11:48" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;20| 54795
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR)
|
||||
(FILE-ENVIRONMENTS "READ-BDF")
|
||||
:CHANGES-TO (IL:FUNCTIONS READ-GLYPH)
|
||||
|
||||
:PREVIOUS-DATE " 8-Dec-2025 12:12:47" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;8|
|
||||
:PREVIOUS-DATE "23-Feb-2026 17:38:07" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;19|
|
||||
)
|
||||
|
||||
|
||||
@@ -20,7 +18,7 @@
|
||||
|
||||
(IL:RPAQQ IL:READ-BDFCOMS
|
||||
((IL:STRUCTURES BDF-FONT GLYPH XLFD)
|
||||
(IL:VARIABLES MAXCHARSET MAXTHINCHAR NOMAPPINGCHARSET)
|
||||
(IL:VARIABLES GLYPH-PROCESSING-HOOK MAXCHARSET MAXTHINCHAR NOMAPPINGCHARSET)
|
||||
(IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR BUILD-COMPOSITE CHAR-PRESENT-BIT
|
||||
COUNT-MCHARS GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF
|
||||
READ-DELIMITED-LIST-FROM-STRING READ-GLYPH WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE
|
||||
@@ -71,6 +69,8 @@
|
||||
(CHARSET昱EGISTRY NIL :TYPE STRING)
|
||||
(CHARSET挂NCODING NIL :TYPE STRING))
|
||||
|
||||
(DEFVAR GLYPH-PROCESSING-HOOK NIL)
|
||||
|
||||
(DEFCONSTANT MAXCHARSET 255)
|
||||
|
||||
(DEFCONSTANT MAXTHINCHAR 255)
|
||||
@@ -126,7 +126,7 @@
|
||||
(IMAGEWIDTHS (IL:\\CREATECSINFOELEMENT))
|
||||
(DLEFT 0)
|
||||
GLYPHS-LIMITS BMAP OFFSETS HEIGHT WIDTHS)
|
||||
(CHARSETPROP CSINFO 'IL:CSCHARENCODING 'MCCS)
|
||||
(IL:CHARSETPROP CSINFO 'IL:CSCHARENCODING 'MCCS)
|
||||
(LOOP :FOR XGL :IN CSGLYPHS :DO (LET* ((MCODE (CAR XGL))
|
||||
(GL (CDR XGL))
|
||||
(GWIDTH (GLYPH-WIDTH GL))
|
||||
@@ -309,7 +309,9 @@
|
||||
(LIST CSET)))))
|
||||
(LIST FONTDESC CHARSETS))))
|
||||
|
||||
(DEFUN BUILD-COMPOSITE (FONTS &KEY VERBOSE) (IL:* IL:\; "Edited 1-Dec-2025 23:07 by mth")
|
||||
(DEFUN BUILD-COMPOSITE (FONTS &KEY VERBOSE (BLOCKING T))
|
||||
(IL:* IL:\; "Edited 19-Feb-2026 21:45 by mth")
|
||||
(IL:* IL:\; "Edited 1-Dec-2025 23:07 by mth")
|
||||
(IL:* IL:\; "Edited 30-Nov-2025 12:32 by mth")
|
||||
(IL:* IL:\; "Edited 26-Nov-2025 21:23 by mth")
|
||||
(IL:* IL:\; "Edited 18-Nov-2025 21:22 by mth")
|
||||
@@ -327,53 +329,61 @@
|
||||
(WHEN VERBOSE
|
||||
(FORMAT *STANDARD-OUTPUT* "~&Loading initial font file: ~A~%" (NAMESTRING BASE-FONT)
|
||||
))
|
||||
(SETQ BASE-FONT (READ-BDF BASE-FONT :MCCS-ONLY T :VERBOSE VERBOSE)))
|
||||
(SETQ BASE-FONT (READ-BDF BASE-FONT :MCCS-ONLY T :VERBOSE VERBOSE))
|
||||
(WHEN BLOCKING (IL:BLOCK)))
|
||||
((NOT (BDF-FONT-P BASE-FONT))
|
||||
(ERROR "Initial font (~S) is not a BDF-FONT, nor string, nor pathname." BASE-FONT)))
|
||||
(WHEN VERBOSE
|
||||
(FORMAT *STANDARD-OUTPUT* "~&Initial font contains ~D MCCS characters.~%"
|
||||
(SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT))))
|
||||
(SETQ MCHAR-PRESENT (BF-MCHAR-PRESENT BASE-FONT))
|
||||
(LOOP :FOR FILL-FONT :IN FILL-FROM :WITH PREV-CC :WHEN FILL-FONT :DO
|
||||
(COND
|
||||
((OR (STRINGP FILL-FONT)
|
||||
(PATHNAMEP FILL-FONT))
|
||||
(UNLESS (IL:INFILEP FILL-FONT)
|
||||
(ERROR "Subsequent font ~S doesn't exist or is unreadable." (NAMESTRING
|
||||
FILL-FONT)))
|
||||
(WHEN VERBOSE
|
||||
(FORMAT *STANDARD-OUTPUT* "~&Loading subsequent font file: ~A~%" (NAMESTRING
|
||||
FILL-FONT)))
|
||||
(SETQ FILL-FONT (READ-BDF FILL-FONT :MCCS-ONLY T :VERBOSE VERBOSE)))
|
||||
((NOT (BDF-FONT-P FILL-FONT))
|
||||
(ERROR "Subsequent font (~S) is not a BDF-FONT, nor string, nor pathname."
|
||||
FILL-FONT)))
|
||||
(SETQ PREV-CC CHAR-COUNT)
|
||||
(LOOP :FOR GL :IN (BF-GLYPHS FILL-FONT)
|
||||
:WITH V :DO (SETQ V (GLYPH-ENCODING GL))
|
||||
(WHEN (AND (LISTP V)
|
||||
(EQ (FIRST V)
|
||||
-1))
|
||||
(SETQ V (OR (SECOND V)
|
||||
-1)))
|
||||
(LOOP :FOR FILL-FONT :IN FILL-FROM :WITH PREV-CC :WITH FF-NAME :WHEN FILL-FONT :DO
|
||||
(FLET ((MERGE-GLYPH (GL &AUX V)
|
||||
(SETQ V (GLYPH-ENCODING GL))
|
||||
(WHEN (AND (LISTP V)
|
||||
(EQ (FIRST V)
|
||||
-1))
|
||||
(SETQ V (OR (SECOND V)
|
||||
-1)))
|
||||
|
||||
(IL:* IL:|;;|
|
||||
(IL:* IL:|;;|
|
||||
"Need to change this use of UTOMCODE? based on the CHARSET昱EGISTRY of the XLFD of FILL-FONT")
|
||||
|
||||
(WHEN (AND (UTOMCODE? V)
|
||||
(ZEROP (CHAR-PRESENT-BIT MCHAR-PRESENT V)))
|
||||
(CHAR-PRESENT-BIT MCHAR-PRESENT V 1)
|
||||
(WHEN (AND (UTOMCODE? V)
|
||||
(ZEROP (CHAR-PRESENT-BIT MCHAR-PRESENT V)))
|
||||
(CHAR-PRESENT-BIT MCHAR-PRESENT V 1)
|
||||
|
||||
(IL:* IL:|;;|
|
||||
(IL:* IL:|;;|
|
||||
"What other bookkeping of BASE-FONT needs to be done when adding a glyph? Any?")
|
||||
|
||||
(PUSH GL (BF-GLYPHS BASE-FONT))))
|
||||
(SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT))
|
||||
(WHEN VERBOSE
|
||||
(FORMAT *STANDARD-OUTPUT* "~&Font ~A supplied ~D additional MCCS characters.~%"
|
||||
(NAMESTRING FILL-FONT)
|
||||
(- (SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT))
|
||||
PREV-CC))))
|
||||
(PUSH GL (BF-GLYPHS BASE-FONT)))
|
||||
NIL))
|
||||
(COND
|
||||
((OR (STRINGP FILL-FONT)
|
||||
(PATHNAMEP FILL-FONT))
|
||||
(SETQ FF-NAME (NAMESTRING FILL-FONT))
|
||||
(UNLESS (IL:INFILEP FILL-FONT)
|
||||
(ERROR "Subsequent font ~S doesn't exist or is unreadable." FF-NAME))
|
||||
(WHEN VERBOSE (FORMAT *STANDARD-OUTPUT*
|
||||
"~&Loading subsequent font file: ~A~%" FF-NAME))
|
||||
(LET ((GLYPH-PROCESSING-HOOK #'MERGE-GLYPH))
|
||||
(READ-BDF FILL-FONT :MCCS-ONLY T :VERBOSE VERBOSE)
|
||||
(SETQ FILL-FONT NIL))
|
||||
(WHEN BLOCKING (IL:BLOCK)))
|
||||
((NOT (BDF-FONT-P FILL-FONT))
|
||||
(ERROR "Subsequent font (~S) is not a BDF-FONT, nor string, nor pathname."
|
||||
FF-NAME)))
|
||||
(SETQ PREV-CC CHAR-COUNT)
|
||||
(WHEN FILL-FONT
|
||||
(LOOP :FOR GL :IN (BF-GLYPHS FILL-FONT)
|
||||
:DO
|
||||
(MERGE-GLYPH GL)))
|
||||
(SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT))
|
||||
(WHEN VERBOSE
|
||||
(FORMAT *STANDARD-OUTPUT*
|
||||
"~&Font ~A supplied ~D additional MCCS characters.~%" FF-NAME
|
||||
(- (SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT))
|
||||
PREV-CC)))))
|
||||
BASE-FONT))
|
||||
|
||||
(DEFUN CHAR-PRESENT-BIT (BM MCODE &OPTIONAL (NEWBIT -1 SBIT)
|
||||
@@ -472,6 +482,7 @@
|
||||
Y))))
|
||||
|
||||
(DEFUN READ-BDF (PATH &KEY VERBOSE MCCS-ONLY (EXTERNAL-FORMAT :ISO8859/1))
|
||||
(IL:* IL:\; "Edited 19-Feb-2026 21:42 by mth")
|
||||
(IL:* IL:\; "Edited 1-Dec-2025 22:40 by mth")
|
||||
(IL:* IL:\; "Edited 30-Nov-2025 11:59 by mth")
|
||||
(IL:* IL:\; "Edited 28-Nov-2025 17:39 by mth")
|
||||
@@ -586,13 +597,12 @@
|
||||
(PLUSP NGLYPHS))
|
||||
(ERROR "Invalid BDF file - CHARS count (~A) is invalid or missing."
|
||||
NGLYPHS))
|
||||
(LOOP :REPEAT NGLYPHS :WITH ENC :WITH MC :DO (SETQ GL (READ-GLYPH
|
||||
FILE-STREAM
|
||||
FONT))
|
||||
(LOOP :REPEAT NGLYPHS :WITH ENC :WITH MC :DO
|
||||
(SETQ GL (READ-GLYPH FILE-STREAM FONT :MCCS-ONLY MCCS-ONLY))
|
||||
(SETQ ENC (GLYPH-ENCODING GL))
|
||||
(WHEN (AND (LISTP ENC)
|
||||
(EQ (FIRST ENC)
|
||||
-1))
|
||||
(EQL (FIRST ENC)
|
||||
-1))
|
||||
(SETQ ENC (OR (SECOND ENC)
|
||||
-1)))
|
||||
(COND
|
||||
@@ -615,143 +625,195 @@
|
||||
|
||||
(IL:* IL:|;;| "It ought to be safe to share the bitmap")
|
||||
|
||||
(TCONC MAPPED-GLYPHS CGL)
|
||||
(WHEN (AND GLYPH-PROCESSING-HOOK (FUNCTIONP
|
||||
GLYPH-PROCESSING-HOOK
|
||||
))
|
||||
(SETQ CGL (FUNCALL GLYPH-PROCESSING-HOOK CGL)))
|
||||
(WHEN CGL (TCONC MAPPED-GLYPHS CGL))
|
||||
(CHAR-PRESENT-BIT MCHAR-PRESENT CC 1)))
|
||||
(T (TCONC UNMAPPED-GLYPHS GL))))
|
||||
((NOT MCCS-ONLY)
|
||||
(WHEN (AND GLYPH-PROCESSING-HOOK (FUNCTIONP GLYPH-PROCESSING-HOOK)
|
||||
)
|
||||
(SETQ GL (FUNCALL GLYPH-PROCESSING-HOOK GL)))
|
||||
(WHEN GL (TCONC UNMAPPED-GLYPHS GL)))))
|
||||
(SETF (BF-GLYPHS FONT)
|
||||
(CAR MAPPED-GLYPHS))
|
||||
(SETF (BF-UNMAPPED故LYPHS FONT)
|
||||
(CAR UNMAPPED-GLYPHS)))
|
||||
(ENDFONT (SETQ FONT-COMPLETE T))))))))
|
||||
(WHEN VERBOSE
|
||||
(ENDFONT (SETQ FONT-COMPLETE T)))))))))
|
||||
(WHEN VERBOSE
|
||||
|
||||
(IL:* IL:|;;| "The SIZE reported needs clarification:")
|
||||
(IL:* IL:|;;| "The SIZE reported needs clarification:")
|
||||
|
||||
(FORMAT *STANDARD-OUTPUT* "Name: ~A~%Family: ~A~%Sizes: Font: ~A Pixel: ~A Point: ~A (decipoints)~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%"
|
||||
(BF-NAME FONT)
|
||||
(XLFD-FAMILY XLFD)
|
||||
(FIRST (BF-SIZE FONT))
|
||||
(XLFD-PIXEL昤IZE XLFD)
|
||||
(XLFD-POINT昤IZE XLFD)
|
||||
(XLFD-WEIGHT XLFD)
|
||||
(XLFD-SLANT XLFD)
|
||||
(XLFD-SETWIDTH昧AME XLFD)))
|
||||
FONT)))
|
||||
(FORMAT *STANDARD-OUTPUT* "Name: ~A~%Family: ~A~%Sizes: Font: ~A Pixel: ~A Point: ~A (decipoints)~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%Glyphs: ~D~%Unmapped glyphs: ~D~%"
|
||||
(BF-NAME FONT)
|
||||
(XLFD-FAMILY XLFD)
|
||||
(FIRST (BF-SIZE FONT))
|
||||
(XLFD-PIXEL昤IZE XLFD)
|
||||
(XLFD-POINT昤IZE XLFD)
|
||||
(XLFD-WEIGHT XLFD)
|
||||
(XLFD-SLANT XLFD)
|
||||
(XLFD-SETWIDTH昧AME XLFD)
|
||||
(LENGTH (BF-GLYPHS FONT))
|
||||
(LENGTH (BF-UNMAPPED故LYPHS FONT))))
|
||||
FONT))
|
||||
|
||||
(DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\]))
|
||||
(IL:* IL:\; "Edited 20-Aug-2024 16:46 by mth")
|
||||
(WITH-INPUT-FROM-STRING (SI (CONCATENATE 'STRING INPUT-STRING " " (STRING DELIMIT)))
|
||||
(READ-DELIMITED-LIST DELIMIT SI)))
|
||||
|
||||
(DEFUN READ-GLYPH (FILE-STREAM FONT) (IL:* IL:\; "Edited 26-Nov-2025 23:32 by mth")
|
||||
(DEFUN READ-GLYPH (FILE-STREAM FONT &KEY MCCS-ONLY) (IL:* IL:\; "Edited 23-Feb-2026 20:11 by mth")
|
||||
(IL:* IL:\; "Edited 19-Feb-2026 15:46 by mth")
|
||||
(IL:* IL:\; "Edited 26-Nov-2025 23:32 by mth")
|
||||
(IL:* IL:\; "Edited 17-Nov-2025 20:03 by mth")
|
||||
(IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth")
|
||||
(IL:* IL:\; "Edited 21-Apr-2025 13:37 by mth")
|
||||
(IL:* IL:\; "Edited 19-Apr-2025 09:32 by mth")
|
||||
(IL:* IL:\; "Edited 17-Apr-2025 18:14 by mth")
|
||||
(IL:* IL:\; "Edited 21-Aug-2024 01:10 by mth")
|
||||
(LET ((GLYPH (MAKE-GLYPH :SWIDTH (COPY-LIST (BF-SWIDTH FONT))
|
||||
:DWIDTH
|
||||
(COPY-LIST (BF-DWIDTH FONT))
|
||||
:SWIDTH1
|
||||
(COPY-LIST (BF-SWIDTH1 FONT))
|
||||
:DWIDTH1
|
||||
(COPY-LIST (BF-DWIDTH1 FONT))
|
||||
:VVECTOR
|
||||
(COPY-LIST (BF-VVECTOR FONT))))
|
||||
CHAR-COMPLETE LINE ITEMS V KEY POS STARTED BBW BBH)
|
||||
(LOOP :UNTIL CHAR-COMPLETE :DO (SETQ LINE (READ-LINE FILE-STREAM))
|
||||
(WHEN LINE (IL:* IL:\; "Ignore blank lines")
|
||||
(MULTIPLE-VALUE-SETQ (KEY POS)
|
||||
(READ-FROM-STRING LINE))
|
||||
(WHEN (<= POS (LENGTH LINE))
|
||||
(SETQ LINE (SUBSEQ LINE POS)))
|
||||
(COND
|
||||
((EQ KEY 'COMMENT) (IL:* IL:\; "Ignore COMMENT lines")
|
||||
(LET
|
||||
((GLYPH (MAKE-GLYPH :SWIDTH (COPY-LIST (BF-SWIDTH FONT))
|
||||
:DWIDTH
|
||||
(COPY-LIST (BF-DWIDTH FONT))
|
||||
:SWIDTH1
|
||||
(COPY-LIST (BF-SWIDTH1 FONT))
|
||||
:DWIDTH1
|
||||
(COPY-LIST (BF-DWIDTH1 FONT))
|
||||
:VVECTOR
|
||||
(COPY-LIST (BF-VVECTOR FONT))))
|
||||
CHAR-COMPLETE ENC LINE ITEMS V KEY POS STARTED BBW BBH)
|
||||
(LOOP
|
||||
:UNTIL CHAR-COMPLETE :DO (SETQ LINE (READ-LINE FILE-STREAM))
|
||||
(WHEN LINE (IL:* IL:\; "Ignore blank lines")
|
||||
(MULTIPLE-VALUE-SETQ (KEY POS)
|
||||
(READ-FROM-STRING LINE))
|
||||
(WHEN (<= POS (LENGTH LINE))
|
||||
(SETQ LINE (SUBSEQ LINE POS)))
|
||||
(COND
|
||||
((EQ KEY 'COMMENT) (IL:* IL:\; "Ignore COMMENT lines")
|
||||
(IL:* IL:\;
|
||||
"Probably aren't \"legal\" here, anyway.")
|
||||
)
|
||||
((EQ KEY 'STARTCHAR)
|
||||
(WHEN STARTED (ERROR "Invalid BDF file - STARTCHAR inside glyph."))
|
||||
(SETF STARTED T)
|
||||
(SETF (GLYPH-NAME GLYPH)
|
||||
(STRING LINE)))
|
||||
(T (UNLESS STARTED (ERROR
|
||||
)
|
||||
((EQ KEY 'STARTCHAR)
|
||||
(WHEN STARTED (ERROR "Invalid BDF file - STARTCHAR inside glyph."))
|
||||
(SETF STARTED T)
|
||||
(SETF (GLYPH-NAME GLYPH)
|
||||
(STRING LINE)))
|
||||
(T
|
||||
(UNLESS STARTED (ERROR
|
||||
"Invalid BDF file - glyph has not been started. STARTCHAR missing."
|
||||
))
|
||||
(SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE))
|
||||
(CASE KEY
|
||||
(ENCODING (SETF (GLYPH-ENCODING GLYPH)
|
||||
(IF (EQL -1 (FIRST ITEMS))
|
||||
ITEMS
|
||||
(FIRST ITEMS))))
|
||||
(SWIDTH (SETF (GLYPH-SWIDTH GLYPH)
|
||||
ITEMS))
|
||||
(DWIDTH (SETF (GLYPH-DWIDTH GLYPH)
|
||||
ITEMS))
|
||||
(SWIDTH1 (SETF (GLYPH-SWIDTH1 GLYPH)
|
||||
ITEMS))
|
||||
(DWIDTH1 (SETF (GLYPH-DWIDTH1 GLYPH)
|
||||
ITEMS))
|
||||
(VVECTOR (SETF (GLYPH-VVECTOR GLYPH)
|
||||
ITEMS))
|
||||
(BBX (SETF (GLYPH-BBW GLYPH)
|
||||
(SETQ BBW (FIRST ITEMS))
|
||||
(GLYPH-BBH GLYPH)
|
||||
(SETQ BBH (SECOND ITEMS))
|
||||
(GLYPH-BBXOFF0 GLYPH)
|
||||
(THIRD ITEMS)
|
||||
(GLYPH-BBYOFF0 GLYPH)
|
||||
(FOURTH ITEMS)))
|
||||
(BITMAP (UNLESS (ZEROP (* BBW BBH))
|
||||
))
|
||||
(SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE))
|
||||
(CASE KEY
|
||||
(ENCODING (SETF (GLYPH-ENCODING GLYPH)
|
||||
(SETQ ENC (IF (EQL -1 (FIRST ITEMS))
|
||||
ITEMS
|
||||
(FIRST ITEMS)))))
|
||||
(SWIDTH (SETF (GLYPH-SWIDTH GLYPH)
|
||||
ITEMS))
|
||||
(DWIDTH (SETF (GLYPH-DWIDTH GLYPH)
|
||||
ITEMS))
|
||||
(SWIDTH1 (SETF (GLYPH-SWIDTH1 GLYPH)
|
||||
ITEMS))
|
||||
(DWIDTH1 (SETF (GLYPH-DWIDTH1 GLYPH)
|
||||
ITEMS))
|
||||
(VVECTOR (SETF (GLYPH-VVECTOR GLYPH)
|
||||
ITEMS))
|
||||
(BBX (SETF (GLYPH-BBW GLYPH)
|
||||
(SETQ BBW (FIRST ITEMS))
|
||||
(GLYPH-BBH GLYPH)
|
||||
(SETQ BBH (SECOND ITEMS))
|
||||
(GLYPH-BBXOFF0 GLYPH)
|
||||
(THIRD ITEMS)
|
||||
(GLYPH-BBYOFF0 GLYPH)
|
||||
(FOURTH ITEMS)))
|
||||
(BITMAP
|
||||
(UNLESS (ZEROP (* BBW BBH)) (IL:* IL:\;
|
||||
"Don't bother creating a BITMAP with no area")
|
||||
(IF (AND MCCS-ONLY (NOT (UTOMCODE? ENC)))
|
||||
(PROGN
|
||||
(IL:* IL:|;;|
|
||||
"This is the case of skipping over non-MCCS encoded glyph when MCCS-ONLY")
|
||||
|
||||
(IL:* IL:|;;| "Don't bother creating a BITMAP with no area")
|
||||
(LOOP :REPEAT BBH :DO (READ-LINE FILE-STREAM)))
|
||||
(LET*
|
||||
((BM (BITMAPCREATE BBW BBH 1))
|
||||
(BM.BASE (IL:|fetch| IL:BITMAPBASE IL:|of| BM))
|
||||
(BM.RASTERWIDTH (IL:|fetch| IL:BITMAPRASTERWIDTH IL:|of| BM))
|
||||
(NBYTES (CEILING BBW 8))
|
||||
(NCHARS (* 2 NBYTES))
|
||||
(NWORDS (CEILING BBW 16))
|
||||
BITS WORDINDEX)
|
||||
(LABELS ((CHAR-HEX-VALUE (C)
|
||||
(IF (CHARACTERP C)
|
||||
(COND
|
||||
((CHAR<= #\0 C #\9)
|
||||
(- (CHAR-CODE C)
|
||||
(IL:CONSTANT (CHAR-CODE #\0))))
|
||||
((CHAR<= #\A C #\F)
|
||||
|
||||
(LET* ((BM (BITMAPCREATE BBW BBH 1))
|
||||
(BM.BASE (IL:|fetch| IL:BITMAPBASE IL:|of| BM))
|
||||
(BM.RASTERWIDTH (IL:|fetch| IL:BITMAPRASTERWIDTH
|
||||
IL:|of| BM))
|
||||
(NBYTES (CEILING BBW 8))
|
||||
(NCHARS (* 2 NBYTES))
|
||||
(NWORDS (CEILING BBW 16))
|
||||
BITS BYTEPOS WORDINDEX)
|
||||
(LOOP :WITH BITROW = 0 :REPEAT BBH :DO
|
||||
(SETQ LINE (STRING-TRIM '(#\Space #\Tab)
|
||||
(READ-LINE FILE-STREAM)))
|
||||
(UNLESS (AND (EQUAL NCHARS (LENGTH LINE))
|
||||
(SETQ BITS
|
||||
(PARSE-INTEGER LINE :RADIX 16
|
||||
:JUNK-ALLOWED T)))
|
||||
(ERROR
|
||||
"Invalid BDF file - bad line in BITMAP: ~A"
|
||||
LINE))
|
||||
(WHEN (ODDP NBYTES)
|
||||
(SETQ BITS (ASH BITS 8)))
|
||||
(SETQ WORDINDEX (* BITROW BM.RASTERWIDTH))
|
||||
(SETQ BYTEPOS (* 16 (1- NWORDS)))
|
||||
(LOOP :REPEAT NWORDS :DO
|
||||
(IL:\\PUTBASE BM.BASE WORDINDEX
|
||||
(LDB (BYTE 16 BYTEPOS)
|
||||
BITS))
|
||||
(INCF WORDINDEX)
|
||||
(DECF BYTEPOS 16))
|
||||
(INCF BITROW))
|
||||
(SETF (GLYPH-BITMAP GLYPH)
|
||||
BM))))
|
||||
(ENDCHAR (SETQ CHAR-COMPLETE T)))))))
|
||||
(SETF (GLYPH-ASCENT GLYPH)
|
||||
(+ (GLYPH-BBH GLYPH)
|
||||
(GLYPH-BBYOFF0 GLYPH)))
|
||||
(SETF (GLYPH-DESCENT GLYPH)
|
||||
(ABS (MIN 0 (GLYPH-BBYOFF0 GLYPH))))
|
||||
(SETF (GLYPH-WIDTH GLYPH)
|
||||
(MAX (+ (MAX 0 (GLYPH-BBXOFF0 GLYPH))
|
||||
(GLYPH-BBW GLYPH))
|
||||
(FIRST (GLYPH-DWIDTH GLYPH))))
|
||||
GLYPH))
|
||||
(IL:* IL:|;;|
|
||||
"The (- (CHAR-CODE #\\A) 10) accomplishes adding 10 after the outer subtraction")
|
||||
|
||||
(- (CHAR-CODE C)
|
||||
(IL:CONSTANT (- (CHAR-CODE #\A)
|
||||
10))))
|
||||
((CHAR<= #\a C #\f)
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"The (- (CHAR-CODE #\\a) 10) accomplishes adding 10 after the outer subtraction")
|
||||
|
||||
(- (CHAR-CODE C)
|
||||
(IL:CONSTANT (- (CHAR-CODE #\a)
|
||||
10))))
|
||||
(T 0))
|
||||
0))
|
||||
(PARSE-WORDS
|
||||
NIL
|
||||
(LOOP :FOR I :FROM 0 :TO (1- NCHARS)
|
||||
:BY 4 :WITH C3LIMIT = (- NCHARS 3)
|
||||
:WITH C4LIMIT = (- NCHARS 4)
|
||||
:COLLECT
|
||||
(+ (ASH (CHAR-HEX-VALUE (CHAR LINE I))
|
||||
12)
|
||||
(ASH (CHAR-HEX-VALUE (CHAR LINE (+ 1 I)))
|
||||
8)
|
||||
(ASH (CHAR-HEX-VALUE (AND (<= I C3LIMIT)
|
||||
(CHAR LINE (+ 2 I))))
|
||||
4)
|
||||
(CHAR-HEX-VALUE (AND (<= I C4LIMIT)
|
||||
(CHAR LINE (+ 3 I))))))))
|
||||
(LOOP :WITH BITROW = 0 :REPEAT BBH :DO
|
||||
(SETQ LINE (STRING-TRIM '(#\Space #\Tab)
|
||||
(READ-LINE FILE-STREAM)))
|
||||
(UNLESS (EQUAL NCHARS (LENGTH LINE))
|
||||
(ERROR "Invalid BDF file - bad line in BITMAP: ~A"
|
||||
LINE))
|
||||
(SETQ BITS (PARSE-WORDS))
|
||||
(SETQ WORDINDEX (* BITROW BM.RASTERWIDTH))
|
||||
(LOOP :REPEAT NWORDS :DO (IL:\\PUTBASE BM.BASE WORDINDEX
|
||||
(POP BITS))
|
||||
(INCF WORDINDEX))
|
||||
(INCF BITROW)))
|
||||
(SETF (GLYPH-BITMAP GLYPH)
|
||||
BM)))))
|
||||
(ENDCHAR (SETQ CHAR-COMPLETE T)))))))
|
||||
(SETF (GLYPH-ASCENT GLYPH)
|
||||
(+ (GLYPH-BBH GLYPH)
|
||||
(GLYPH-BBYOFF0 GLYPH)))
|
||||
(SETF (GLYPH-DESCENT GLYPH)
|
||||
(ABS (MIN 0 (GLYPH-BBYOFF0 GLYPH))))
|
||||
(SETF (GLYPH-WIDTH GLYPH)
|
||||
(MAX (+ (MAX 0 (GLYPH-BBXOFF0 GLYPH))
|
||||
(GLYPH-BBW GLYPH))
|
||||
(FIRST (GLYPH-DWIDTH GLYPH))))
|
||||
GLYPH))
|
||||
|
||||
(DEFUN WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE
|
||||
&AUX FULLFILENAME)
|
||||
TEST &AUX FULLFILENAME)
|
||||
(IL:* IL:\; "Edited 23-Feb-2026 15:57 by mth")
|
||||
(IL:* IL:\; "Edited 17-Feb-2026 14:17 by mth")
|
||||
(IL:* IL:\; "Edited 2-Dec-2025 14:47 by mth")
|
||||
(IL:* IL:\; "Edited 30-Nov-2025 16:03 by mth")
|
||||
(IL:* IL:\; "Edited 28-Nov-2025 17:56 by mth")
|
||||
@@ -769,8 +831,10 @@
|
||||
|
||||
(IL:* IL:|;;| "CSETS correspond to the charsets actually present in the FONTDESC.")
|
||||
|
||||
(SETQ FULLFILENAME (MEDLEYFONT.WRITE.FONT FONTDESC (MEDLEYFONT.FILENAME FONTDESC NIL NIL
|
||||
DEST-DIR)))
|
||||
(SETQ FULLFILENAME (IF TEST
|
||||
"WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE TEST"
|
||||
(MEDLEYFONT.WRITE.FONT FONTDESC (MEDLEYFONT.FILENAME NIL FONTDESC
|
||||
NIL NIL DEST-DIR))))
|
||||
(LIST FULLFILENAME FONTDESC CSETS)))
|
||||
|
||||
(DEFUN XLFD-SPLIT-FONT-NAME (NAME) (IL:* IL:\; "Edited 26-Nov-2025 09:43 by mth")
|
||||
@@ -880,21 +944,21 @@
|
||||
"BITMAPCREATE" "BITMAPHEIGHT"
|
||||
"BITMAPWIDTH" "BLACKSHADE" "BLTSHADE"
|
||||
"BOLD" "COMPRESSED" "CHARSETINFO"
|
||||
"CHARSETPROP" "DISPLAY" "FONTDESCRIPTOR"
|
||||
"FONTP" "FONTPROP" "INPUT" "ITALIC"
|
||||
"LIGHT" "LRSH" "MCCS" "MEDIUM" "REGULAR"
|
||||
"TCONC" "UTOMCODE?" "MEDLEYFONT.FILENAME"
|
||||
"DISPLAY" "FONTDESCRIPTOR" "FONTP"
|
||||
"FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH"
|
||||
"MCCS" "MEDIUM" "REGULAR" "TCONC"
|
||||
"UTOMCODE?" "MEDLEYFONT.FILENAME"
|
||||
"MEDLEYFONT.WRITE.FONT"))
|
||||
:READTABLE "XCL"
|
||||
:COMPILER :COMPILE-FILE)
|
||||
|
||||
(IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO)
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL (3116 10226 (BDF-TO-CHARSETINFO 3116 . 10226)) (10228 16847 (BDF-TO-FONTDESCRIPTOR
|
||||
10228 . 16847)) (16849 20782 (BUILD-COMPOSITE 16849 . 20782)) (20784 21533 (CHAR-PRESENT-BIT 20784 .
|
||||
21533)) (21535 21819 (COUNT-MCHARS 21535 . 21819)) (21821 24856 (GLYPHS-BY-CHARSET 21821 . 24856)) (
|
||||
24858 26283 (PACKFILENAME.STRING 24858 . 26283)) (26285 35760 (READ-BDF 26285 . 35760)) (35762 36085 (
|
||||
READ-DELIMITED-LIST-FROM-STRING 35762 . 36085)) (36087 43085 (READ-GLYPH 36087 . 43085)) (43087 44472
|
||||
(WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 43087 . 44472)) (44474 46891 (XLFD-SPLIT-FONT-NAME 44474 . 46891)
|
||||
) (46893 49905 (XLFD-TO-FACE 46893 . 49905)))))
|
||||
(IL:FILEMAP (NIL (3086 10199 (BDF-TO-CHARSETINFO 3086 . 10199)) (10201 16820 (BDF-TO-FONTDESCRIPTOR
|
||||
10201 . 16820)) (16822 21401 (BUILD-COMPOSITE 16822 . 21401)) (21403 22152 (CHAR-PRESENT-BIT 21403 .
|
||||
22152)) (22154 22438 (COUNT-MCHARS 22154 . 22438)) (22440 25475 (GLYPHS-BY-CHARSET 22440 . 25475)) (
|
||||
25477 26902 (PACKFILENAME.STRING 25477 . 26902)) (26904 37150 (READ-BDF 26904 . 37150)) (37152 37475 (
|
||||
READ-DELIMITED-LIST-FROM-STRING 37152 . 37475)) (37477 46234 (READ-GLYPH 37477 . 46234)) (46236 47972
|
||||
(WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 46236 . 47972)) (47974 50391 (XLFD-SPLIT-FONT-NAME 47974 . 50391)
|
||||
) (50393 53405 (XLFD-TO-FACE 50393 . 53405)))))
|
||||
IL:STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,11 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED " 9-Jan-87 16:47:16" {ERIS}<LISPCORE>LIBRARY>SKETCHCOLOR.;2 4779
|
||||
|
||||
(FILECREATED "18-Feb-2026 16:28:03" {WMEDLEY}<lispusers>SKETCHCOLOR.;2 4732
|
||||
changes to%: (VARS BLACKSHADE16 DARKGRAY16 MEDIUMGRAY16 LIGHTGRAY16 WHITESHADE16 REDTEXTURE
|
||||
GREENTEXTURE BLUETEXTURE SKETCHCOLORCOMS)
|
||||
|
||||
:EDIT-BY rmk
|
||||
previous date%: "29-Oct-85 14:44:30" {ERIS}<LISPCORE>LIBRARY>SKETCHCOLOR.;1)
|
||||
|
||||
:PREVIOUS-DATE " 9-Jan-87 16:47:16" {WMEDLEY}<lispusers>SKETCHCOLOR.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT SKETCHCOLORCOMS)
|
||||
|
||||
@@ -71,30 +75,25 @@
|
||||
)
|
||||
|
||||
(RPAQQ SKETCHINCOLORFLG T)
|
||||
|
||||
(FILESLOAD COLOR STYLESHEET)
|
||||
|
||||
[XCL:REINSTALL-ADVICE '\FILLCIRCLE.DISPLAY :BEFORE '((:LAST (COND
|
||||
((LISTP TEXTURE)
|
||||
(COND
|
||||
((TEXTUREP (CAR TEXTURE))
|
||||
(SETQ TEXTURE (CAR TEXTURE)))
|
||||
(T (SETQ TEXTURE
|
||||
(TEXTUREOFCOLOR (CADR TEXTURE]
|
||||
|
||||
[XCL:REINSTALL-ADVICE '\POLYSHADE.DISPLAY :BEFORE '((:LAST (COND
|
||||
((LISTP FILL.SHADE)
|
||||
(COND
|
||||
((TEXTUREP (CAR FILL.SHADE))
|
||||
(SETQ FILL.SHADE (CAR FILL.SHADE))
|
||||
)
|
||||
(T (SETQ FILL.SHADE
|
||||
(TEXTUREOFCOLOR (CADR
|
||||
FILL.SHADE
|
||||
]
|
||||
(PUTPROPS \FILLCIRCLE.DISPLAY READVICE [NIL (BEFORE NIL (COND ((LISTP TEXTURE)
|
||||
(COND ((TEXTUREP (CAR TEXTURE))
|
||||
(SETQ TEXTURE (CAR TEXTURE)))
|
||||
(T (SETQ TEXTURE
|
||||
(TEXTUREOFCOLOR
|
||||
(CADR TEXTURE])
|
||||
|
||||
(PUTPROPS \POLYSHADE.DISPLAY READVICE [NIL (BEFORE NIL (COND ((LISTP FILL.SHADE)
|
||||
(COND ((TEXTUREP (CAR FILL.SHADE))
|
||||
(SETQ FILL.SHADE (CAR FILL.SHADE
|
||||
)))
|
||||
(T (SETQ FILL.SHADE
|
||||
(TEXTUREOFCOLOR
|
||||
(CADR FILL.SHADE])
|
||||
(READVISE \FILLCIRCLE.DISPLAY \POLYSHADE.DISPLAY)
|
||||
(PUTPROPS SKETCHCOLOR COPYRIGHT ("Xerox Corporation" 1985 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (547 3144 (COLORTEXTURETEST 557 . 1904) (LEVELTEXTURE 1906 . 2438) (PRIMARYTEXTURE 2440
|
||||
. 3142)))))
|
||||
(FILEMAP (NIL (771 3368 (COLORTEXTURETEST 781 . 2128) (LEVELTEXTURE 2130 . 2662) (PRIMARYTEXTURE 2664
|
||||
. 3366)))))
|
||||
STOP
|
||||
|
||||
@@ -1,18 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED "17-Mar-87 17:03:54" {DSK}<XAVIER>TRANSOR.;16 44778
|
||||
|
||||
(FILECREATED "18-Feb-2026 21:57:19" {WMEDLEY}<lispusers>TRANSOR.;2 43458
|
||||
changes to%: (VARS TRANSORCOMS)
|
||||
(FNS PRECH1 TRANSOUT)
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TRANSORCOMS)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-87 17:03:54" {WMEDLEY}<lispusers>TRANSOR.;1)
|
||||
previous date%: "17-Mar-87 17:00:04" {DSK}<XAVIER>TRANSOR.;15)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TRANSORCOMS)
|
||||
|
||||
(RPAQQ TRANSORCOMS
|
||||
[(FNS TRANSOR TRANSOR-PROCEED TRANSORFORM TRANSORFNS TRANSFORM TRANSIT TRANXT TRANSEXIT
|
||||
(RPAQQ TRANSORCOMS
|
||||
((FNS TRANSOR TRANSOR-PROCEED TRANSORFORM TRANSORFNS TRANSFORM TRANSIT TRANXT TRANSEXIT
|
||||
KEEPLIST TRANSERR TRANSOUT PPASS1 TRANSLIST TRANSLIST1 PREMTEXT WACHADOON PRECH PRECH1
|
||||
PRECH2 RETAIL LNC PRESCAN)
|
||||
TRANSORMACROS TRANSOREMARKS TRANSORGLOBALS
|
||||
@@ -20,10 +18,8 @@
|
||||
(TESTRAN)
|
||||
(USERMACROS (APPEND TRANSORMACROS USERMACROS))
|
||||
(GLOBALVARS (APPEND TRANSORGLOBALS GLOBALVARS))
|
||||
(EDITCOMSA (UNION '(NLAM NLAMIT DOTHESE DOTHIS XFORMER CONTINUE)
|
||||
EDITCOMSA))
|
||||
(EDITCOMSL (UNION '(REMARK)
|
||||
EDITCOMSL))
|
||||
(EDITCOMSA (UNION '(NLAM NLAMIT DOTHESE DOTHIS XFORMER CONTINUE) EDITCOMSA))
|
||||
(EDITCOMSL (UNION '(REMARK) EDITCOMSL))
|
||||
(TRANSITCONSES '(ORR NIL XFORMER))
|
||||
(PRESCARRAY (ARRAY 127 127)))
|
||||
(INITVARS (NLISTPCOMS)
|
||||
@@ -40,9 +36,10 @@
|
||||
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP))
|
||||
(NIL PRESCAN (GLOBALVARS PRESCARRAY)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML TRANSERR KEEPLIST
|
||||
(NLAML TRANSERR KEEPLIST
|
||||
TRANSOR-PROCEED)
|
||||
(LAMA])
|
||||
(LAMA)))
|
||||
(EDITHIST TRANSOR)))
|
||||
(DEFINEQ
|
||||
|
||||
(TRANSOR
|
||||
@@ -864,49 +861,52 @@ TRANSOR made a translation error: " T)
|
||||
(RETURN (CLOSEF OUTF)))))
|
||||
)
|
||||
|
||||
(RPAQQ TRANSORMACROS
|
||||
((REMARK (TXT)
|
||||
(E (KEEPLIST TXT)
|
||||
T))
|
||||
(NLAM NIL (E (SETQQ WHERETOGONEXT NLAMIT)
|
||||
T))
|
||||
[NLAMIT NIL (ORR NX !NX ((E (TRANSEXIT]
|
||||
(DOTHESE NIL (E (TRANSOR-PROCEED DOTHESE)
|
||||
T)
|
||||
NLAM)
|
||||
(DOTHIS NIL (E (TRANSOR-PROCEED DOTHIS)
|
||||
T)
|
||||
NLAM)
|
||||
(XFORMER NIL (E (TRANSERR TRANSFORMATIONERROR "FAULTY TRANSFORMATION" (CURRENTFORM
|
||||
CURRENTCOMS))
|
||||
T))))
|
||||
(RPAQQ TRANSORMACROS ((REMARK (TXT)
|
||||
(E (KEEPLIST TXT)
|
||||
T))
|
||||
(NLAM NIL (E (SETQQ WHERETOGONEXT NLAMIT)
|
||||
T))
|
||||
[NLAMIT NIL (ORR NX !NX ((E (TRANSEXIT]
|
||||
(DOTHESE NIL (E (TRANSOR-PROCEED DOTHESE)
|
||||
T)
|
||||
NLAM)
|
||||
(DOTHIS NIL (E (TRANSOR-PROCEED DOTHIS)
|
||||
T)
|
||||
NLAM)
|
||||
(XFORMER NIL (E (TRANSERR TRANSFORMATIONERROR "FAULTY TRANSFORMATION"
|
||||
(CURRENTFORM CURRENTCOMS))
|
||||
T))))
|
||||
|
||||
(RPAQQ TRANSOREMARKS
|
||||
((TRANSFORMATIONERROR (* The TRANSFORMATIONS specified for this form failed to work properly.
|
||||
The TTY message %'FAULTY TRANSFORMATION' was printed, any commands
|
||||
remaining in the transformation after the erroneous one were skipped,
|
||||
and translation continued as if the transformation had been normally
|
||||
completed. The user should treat the translated form with caution and
|
||||
amend his transformation to avoid future problems.))
|
||||
(TRANSERROR (* TRANSOR got confused at this point. The TTY message %'SHOW JIM GOODWIN' was
|
||||
printed and translation continued with the next form, but the user should
|
||||
treat the compromised area of code with caution.))
|
||||
(BLAMBDA1 (* Non-atomic CAR of form, but not an open lambda. Either a parenthesis error or
|
||||
computed CAR of form. Computed CAR of form is no longer legal in BBN-LISP;
|
||||
APPLY* is used instead. If computed CAR of form was intended, the translation to
|
||||
APPLY* will run ok. See manual for discussion of APPLY*.))
|
||||
(BLAMBDA2 (* Open LAMBDA with wrong number of args. What can it mean?))
|
||||
(BLAMBDA3 (* Lambda-expression without forms. What can it mean?))
|
||||
(ILLCAR (* Illegal data-type encountered as CAR of form Expression treated as list of forms.)
|
||||
)
|
||||
(TAILP/DOTHIS (* When the transormacro DOTHIS is executed at a TAILP position, TRANSOR does a
|
||||
1 command first, assuming that the current position is a list of forms and
|
||||
CAR of it is the form intended. The user should make sure that this is what
|
||||
was intended by the TRANSFORMATIONS which called DOTHIS, i.e. the
|
||||
TRANSFORMATIONS for the form containing this one.))))
|
||||
(RPAQQ TRANSOREMARKS ((TRANSFORMATIONERROR (* The TRANSFORMATIONS specified for this form failed to
|
||||
work properly. The TTY message %'FAULTY TRANSFORMATION'
|
||||
was printed, any commands remaining in the
|
||||
transformation after the erroneous one were skipped,
|
||||
and translation continued as if the transformation had
|
||||
been normally completed. The user should treat the
|
||||
translated form with caution and amend his
|
||||
transformation to avoid future problems.))
|
||||
(TRANSERROR (* TRANSOR got confused at this point. The TTY message %'SHOW JIM
|
||||
GOODWIN' was printed and translation continued with the next
|
||||
form, but the user should treat the compromised area of code
|
||||
with caution.))
|
||||
(BLAMBDA1 (* Non-atomic CAR of form, but not an open lambda. Either a
|
||||
parenthesis error or computed CAR of form. Computed CAR of form is
|
||||
no longer legal in BBN-LISP; APPLY* is used instead. If computed
|
||||
CAR of form was intended, the translation to APPLY* will run ok.
|
||||
See manual for discussion of APPLY*.))
|
||||
(BLAMBDA2 (* Open LAMBDA with wrong number of args. What can it mean?))
|
||||
(BLAMBDA3 (* Lambda-expression without forms. What can it mean?))
|
||||
(ILLCAR (* Illegal data-type encountered as CAR of form Expression treated as
|
||||
list of forms.))
|
||||
(TAILP/DOTHIS (* When the transormacro DOTHIS is executed at a TAILP position,
|
||||
TRANSOR does a 1 command first, assuming that the current
|
||||
position is a list of forms and CAR of it is the form
|
||||
intended. The user should make sure that this is what was
|
||||
intended by the TRANSFORMATIONS which called DOTHIS, i.e. the
|
||||
TRANSFORMATIONS for the form containing this one.))))
|
||||
|
||||
(RPAQQ TRANSORGLOBALS (USERNOTES USERNOTES TESTFORM TESTFORM TRANSFORMATIONS TRANSFORMATIONS
|
||||
XFORMSFNS XFORMSVARS XFORMSVARS DUMPFILE TRANSFORMATIONS TRANSFORMATIONS
|
||||
XFORMSFNS XFORMSVARS XFORMSVARS DUMPFILE TRANSFORMATIONS TRANSFORMATIONS
|
||||
TRANSFORMATIONS TRANSFORMATIONS))
|
||||
|
||||
(RPAQQ MAXLOOP 1530)
|
||||
@@ -917,11 +917,9 @@ TRANSOR made a translation error: " T)
|
||||
|
||||
(RPAQ GLOBALVARS (APPEND TRANSORGLOBALS GLOBALVARS))
|
||||
|
||||
(RPAQ EDITCOMSA (UNION '(NLAM NLAMIT DOTHESE DOTHIS XFORMER CONTINUE)
|
||||
EDITCOMSA))
|
||||
(RPAQ EDITCOMSA (UNION '(NLAM NLAMIT DOTHESE DOTHIS XFORMER CONTINUE) EDITCOMSA))
|
||||
|
||||
(RPAQ EDITCOMSL (UNION '(REMARK)
|
||||
EDITCOMSL))
|
||||
(RPAQ EDITCOMSL (UNION '(REMARK) EDITCOMSL))
|
||||
|
||||
(RPAQQ TRANSITCONSES (ORR NIL XFORMER))
|
||||
|
||||
@@ -934,7 +932,7 @@ TRANSOR made a translation error: " T)
|
||||
(RPAQ? TRANSOUTREADTABLE FILERDTBL)
|
||||
(DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(PUTPROPS TAILP BLKLIBRARYDEF [LAMBDA (.BLKVAR.X .BLKVAR.Y)
|
||||
(PUTPROPS TAILP BLKLIBRARYDEF [LAMBDA (.BLKVAR.X .BLKVAR.Y)
|
||||
(* True if .BLKVAR.X is A tail of .BLKVAR.Y .BLKVAR.X and
|
||||
.BLKVAR.Y non-null.)
|
||||
(* Included with editor for block compilation purposes.)
|
||||
@@ -946,19 +944,15 @@ TRANSOR made a translation error: " T)
|
||||
(GO LP])
|
||||
)
|
||||
|
||||
(PUTPROPS TRANSOR FILEGROUP (TRANSOR TSET))
|
||||
(PUTPROPS TRANSOR FILEGROUP (TRANSOR TSET))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(BLOCK%: PRECHBLOCK PRECH PRECH1 PRECH2 RETAIL LNC (ENTRIES PRECH)
|
||||
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP))
|
||||
|
||||
(BLOCK%: TRANSITBLOCK TRANSIT WACHADOON (ENTRIES TRANSIT WACHADOON)
|
||||
(GLOBALVARS WACHADID WHENTODOIT TRANSITCONSES LAMBDACOMS NLISTPCOMS)
|
||||
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP))
|
||||
|
||||
(BLOCK%: TRANXTBLOCK TRANXT (ENTRIES TRANXT)
|
||||
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP))
|
||||
|
||||
(BLOCK%: NIL PRESCAN (GLOBALVARS PRESCARRAY))
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
@@ -969,11 +963,23 @@ TRANSOR made a translation error: " T)
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
|
||||
(ADDTOVAR EDITHISTALIST (TRANSOR (" 5-Feb-87 16:18:06" DJVB {DSK}<XAVIER>TRANSOR.;11 (TRANSOR)
|
||||
(FIXED TO WORK WITH NEW FILE RULES IN LYRIC))
|
||||
(" 6-Feb-87 15:24:20" DJVB {DSK}<XAVIER>TRANSOR.;12 (TRANSOR))
|
||||
(" 6-Mar-87 14:41:26" DJVB {DSK}<XAVIER>TRANSOR.;13
|
||||
(TRANSOR TRANSOR-PROCEED TRANSORFORM TRANSORFNS TRANSFORM
|
||||
RETAIL))
|
||||
("17-Mar-87 17:01:53" DJVB {DSK}<XAVIER>TRANSOR.;15 (PRECH1 TRANSOUT)
|
||||
(ADDED SPLIT READ/WRITE READTABLES AND PP FOR DEFUN))))
|
||||
)
|
||||
(PUTPROPS TRANSOR COPYRIGHT (NONE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2262 38355 (TRANSOR 2272 . 6315) (TRANSOR-PROCEED 6317 . 9124) (TRANSORFORM 9126 . 9558
|
||||
) (TRANSORFNS 9560 . 10256) (TRANSFORM 10258 . 11996) (TRANSIT 11998 . 14766) (TRANXT 14768 . 17981) (
|
||||
TRANSEXIT 17983 . 18293) (KEEPLIST 18295 . 19255) (TRANSERR 19257 . 20021) (TRANSOUT 20023 . 22467) (
|
||||
PPASS1 22469 . 22710) (TRANSLIST 22712 . 23731) (TRANSLIST1 23733 . 23965) (PREMTEXT 23967 . 24672) (
|
||||
WACHADOON 24674 . 25145) (PRECH 25147 . 25640) (PRECH1 25642 . 27810) (PRECH2 27812 . 28758) (RETAIL
|
||||
28760 . 30007) (LNC 30009 . 30872) (PRESCAN 30874 . 38353)))))
|
||||
(FILEMAP (NIL (2231 38324 (TRANSOR 2241 . 6284) (TRANSOR-PROCEED 6286 . 9093) (TRANSORFORM 9095 . 9527
|
||||
) (TRANSORFNS 9529 . 10225) (TRANSFORM 10227 . 11965) (TRANSIT 11967 . 14735) (TRANXT 14737 . 17950) (
|
||||
TRANSEXIT 17952 . 18262) (KEEPLIST 18264 . 19224) (TRANSERR 19226 . 19990) (TRANSOUT 19992 . 22436) (
|
||||
PPASS1 22438 . 22679) (TRANSLIST 22681 . 23700) (TRANSLIST1 23702 . 23934) (PREMTEXT 23936 . 24641) (
|
||||
WACHADOON 24643 . 25114) (PRECH 25116 . 25609) (PRECH1 25611 . 27779) (PRECH2 27781 . 28727) (RETAIL
|
||||
28729 . 29976) (LNC 29978 . 30841) (PRESCAN 30843 . 38322)))))
|
||||
STOP
|
||||
|
||||
@@ -1,19 +1,25 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "XCL-USER" READTABLE "XCL" BASE 10)
|
||||
(DEFINE-FILE-INFO §PACKAGE "XCL-USER" §READTABLE "XCL")
|
||||
(IL:FILECREATED "13-Apr-87 17:38:17" IL:{DSK}<XAVIER>LOADTRAN.\;9 2045
|
||||
|
||||
(IL:FILECREATED "18-Feb-2026 22:58:35" IL:|{WMEDLEY}<lispusers>TRANSOR-LOADTRAN.;2| 1561
|
||||
IL:|changes| IL:|to:| (IL:VARS IL:LOADTRANCOMS STOP)
|
||||
(IL:FUNCTIONS MYLOAD I.S.OPR PRETTYCOMPRINT SETTEMPLATE DEFINE-FILE-INFO
|
||||
)
|
||||
(IL:FNS PRETTYCOMPRINT SETTEMPLATE)
|
||||
|
||||
:EDIT-BY IL:|rmk|)
|
||||
IL:|previous| IL:|date:| " 6-Apr-87 16:57:48" IL:{DSK}<XAVIER>LOADTRAN.\;1)
|
||||
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:TRANSOR-LOADTRANCOMS)
|
||||
; Copyright (c) 1987 by System Development Corp.. All rights reserved.
|
||||
|
||||
(IL:RPAQQ IL:TRANSOR-LOADTRANCOMS ((IL:VARS STOP)
|
||||
(IL:FNS PRETTYCOMPRINT SETTEMPLATE)
|
||||
(IL:FUNCTIONS DEFINE-FILE-INFO I.S.OPR MYLOAD)
|
||||
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY
|
||||
IL:COMPILERVARS (IL:ADDVARS (IL:NLAMA PRETTYCOMPRINT)
|
||||
(IL:NLAML)
|
||||
(IL:LAMA SETTEMPLATE)))))
|
||||
(IL:PRETTYCOMPRINT IL:LOADTRANCOMS)
|
||||
|
||||
(IL:RPAQQ IL:LOADTRANCOMS ((IL:VARS STOP)
|
||||
(IL:FNS PRETTYCOMPRINT SETTEMPLATE)
|
||||
(IL:FUNCTIONS DEFINE-FILE-INFO I.S.OPR MYLOAD)
|
||||
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY
|
||||
IL:COMPILERVARS (IL:ADDVARS (IL:NLAMA PRETTYCOMPRINT)
|
||||
(IL:NLAML)
|
||||
(IL:LAMA SETTEMPLATE)))))
|
||||
|
||||
(IL:RPAQQ STOP STOP)
|
||||
(IL:DEFINEQ
|
||||
@@ -27,17 +33,17 @@
|
||||
(BLOCK SETTEMPLATE (NILL))))
|
||||
)
|
||||
|
||||
(DEFUN DEFINE-FILE-INFO (&REST ARGS)
|
||||
(NILL))
|
||||
(DEFUN DEFINE-FILE-INFO (&REST ARGS) (NILL))
|
||||
|
||||
(DEFUN I.S.OPR (X)
|
||||
(NILL))
|
||||
|
||||
(DEFUN MYLOAD (FILE)
|
||||
(LET ((FILE (OPEN FILE :DIRECTION :INPUT)))
|
||||
(UNWIND-PROTECT
|
||||
(IL:\\CML-LOAD FILE T *TERMINAL-IO* (FIND-PACKAGE "XCL-USER"))
|
||||
(CLOSE FILE))))
|
||||
(DEFUN I.S.OPR (X) (NILL))
|
||||
|
||||
|
||||
(DEFUN MYLOAD (FILE) (LET ((FILE (OPEN FILE :DIRECTION :INPUT)))
|
||||
(UNWIND-PROTECT (IL:\\CML-LOAD FILE T *TERMINAL-IO* (FIND-PACKAGE
|
||||
"XCL-USER"))
|
||||
(CLOSE FILE))))
|
||||
|
||||
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY IL:COMPILERVARS
|
||||
|
||||
(IL:ADDTOVAR IL:NLAMA PRETTYCOMPRINT)
|
||||
@@ -46,7 +52,7 @@
|
||||
|
||||
(IL:ADDTOVAR IL:LAMA SETTEMPLATE)
|
||||
)
|
||||
(IL:PUTPROPS IL:LOADTRAN IL:COPYRIGHT ("System Development Corp." 1987))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL (830 1053 (PRETTYCOMPRINT 843 . 979) (SETTEMPLATE 981 . 1051)) (1055 1106 (
|
||||
DEFINE-FILE-INFO 1055 . 1106)) (1108 1141 (I.S.OPR 1108 . 1141)) (1143 1341 (MYLOAD 1143 . 1341)))))
|
||||
(IL:FILEMAP (NIL (1134 1357 (PRETTYCOMPRINT 1147 . 1283) (SETTEMPLATE 1285 . 1355)))))
|
||||
IL:STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,15 +1,20 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO §PACKAGE "INTERLISP" §READTABLE "INTERLISP" §BASE 10)
|
||||
(FILECREATED " 7-Dec-86 17:26:23" {ERIS}<LISPUSERS>LISPCORE>UNBOXEDOPS.;7 12906
|
||||
|
||||
(FILECREATED "18-Feb-2026 16:17:02" {WMEDLEY}<lispusers>UNBOXEDOPS.;2 10856
|
||||
changes to%: (OPTIMIZERS UFREMAINDER2 UFREMAINDER)
|
||||
(FNS UFREMAINDER)
|
||||
(VARS UNBOXEDOPSCOMS)
|
||||
|
||||
:EDIT-BY rmk
|
||||
previous date%: " 3-Nov-86 20:30:24" {ERIS}<LISPUSERS>LISPCORE>UNBOXEDOPS.;6)
|
||||
|
||||
:PREVIOUS-DATE " 7-Dec-86 17:26:23" {WMEDLEY}<lispusers>UNBOXEDOPS.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1986 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT UNBOXEDOPSCOMS)
|
||||
|
||||
(RPAQQ UNBOXEDOPSCOMS
|
||||
(RPAQQ UNBOXEDOPSCOMS
|
||||
[(FNS UFABS UFEQP UFGEQ UFGREATERP UFIX UFLEQ UFLESSP UFMAX UFMIN UFMINUS UFREMAINDER)
|
||||
(OPTIMIZERS UFABS UFABS1 UFEQP UFEQP2 UFGEQ UFGEQ2 UFGREATERP UFGREATERP2 UFIX UFIX1 UFLEQ
|
||||
UFLEQ2 UFLESSP UFLESSP2 UFMAX UFMAX2 UFMIN UFMIN2 UFMINUS UFMINUS1 UFREMAINDER)
|
||||
@@ -76,168 +81,178 @@
|
||||
FY])
|
||||
)
|
||||
|
||||
(DEFOPTIMIZER UFABS (&OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
&REST RESTARGS &WHOLE ORIGINAL)
|
||||
(if (OR (NOT ARG1GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFABS" %, %, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFABS1 ARG1))
|
||||
(DEFOPTIMIZER UFABS (&OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
&REST RESTARGS &WHOLE ORIGINAL) (if (OR (NOT ARG1GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T
|
||||
"Illegal args to UFABS" %,
|
||||
%, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFABS1 ARG1))
|
||||
|
||||
(DEFOPTIMIZER UFABS1 (X)
|
||||
`[\FLOATBOX ((OPCODES UBFLOAT1 2)
|
||||
(\FLOATUNBOX ,X])
|
||||
|
||||
(DEFOPTIMIZER UFEQP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(DEFOPTIMIZER UFABS1 (X) `[\FLOATBOX ((OPCODES UBFLOAT1 2)
|
||||
(\FLOATUNBOX ,X])
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFEQP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(ARG2 NIL ARG2GIVEN)
|
||||
&REST RESTARGS)
|
||||
(if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFEQP" %, %, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFEQP2 ARG1 ARG2))
|
||||
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFEQP" %, %,
|
||||
ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFEQP2 ARG1 ARG2))
|
||||
|
||||
(DEFOPTIMIZER UFEQP2 (X Y)
|
||||
`(EQ (\FLOATUNBOX (FDIFFERENCE ,X ,Y))
|
||||
NIL))
|
||||
|
||||
(DEFOPTIMIZER UFGEQ (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(DEFOPTIMIZER UFEQP2 (X Y) `(EQ (\FLOATUNBOX (FDIFFERENCE ,X ,Y))
|
||||
NIL))
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFGEQ (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(ARG2 NIL ARG2GIVEN)
|
||||
&REST RESTARGS)
|
||||
(if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFGEQ" %, %, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFGEQ2 ARG1 ARG2))
|
||||
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFGEQ" %, %,
|
||||
ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFGEQ2 ARG1 ARG2))
|
||||
|
||||
(DEFOPTIMIZER UFGEQ2 (X Y)
|
||||
`[NOT ((OPCODES SWAP UBFLOAT2 5)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y])
|
||||
|
||||
(DEFOPTIMIZER UFGREATERP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(DEFOPTIMIZER UFGEQ2 (X Y) `[NOT ((OPCODES SWAP UBFLOAT2 5)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y])
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFGREATERP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(ARG2 NIL ARG2GIVEN)
|
||||
&REST RESTARGS)
|
||||
(if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFGREATERP" %, %, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFGREATERP2 ARG1 ARG2))
|
||||
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFGREATERP" %,
|
||||
%, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFGREATERP2 ARG1 ARG2))
|
||||
|
||||
(DEFOPTIMIZER UFGREATERP2 (X Y)
|
||||
`((OPCODES UBFLOAT2 5)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y)))
|
||||
|
||||
(DEFOPTIMIZER UFIX (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
&REST RESTARGS)
|
||||
(if (OR (NOT ARG1GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFIX" %, %, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFIX1 ARG1))
|
||||
(DEFOPTIMIZER UFGREATERP2 (X Y) `((OPCODES UBFLOAT2 5)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y)))
|
||||
|
||||
(DEFOPTIMIZER UFIX1 (X)
|
||||
`((OPCODES UBFLOAT1 4)
|
||||
(\FLOATUNBOX ,X)))
|
||||
|
||||
(DEFOPTIMIZER UFLEQ (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(DEFOPTIMIZER UFIX (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFIX" %, %, ORIGINAL
|
||||
T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFIX1 ARG1))
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFIX1 (X) `((OPCODES UBFLOAT1 4)
|
||||
(\FLOATUNBOX ,X)))
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFLEQ (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(ARG2 NIL ARG2GIVEN)
|
||||
&REST RESTARGS)
|
||||
(if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFLEQ" %, %, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFLEQ2 ARG1 ARG2))
|
||||
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFLEQ" %, %,
|
||||
ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFLEQ2 ARG1 ARG2))
|
||||
|
||||
(DEFOPTIMIZER UFLEQ2 (X Y)
|
||||
`[NOT ((OPCODES UBFLOAT2 5)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y])
|
||||
|
||||
(DEFOPTIMIZER UFLESSP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(DEFOPTIMIZER UFLEQ2 (X Y) `[NOT ((OPCODES UBFLOAT2 5)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y])
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFLESSP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(ARG2 NIL ARG2GIVEN)
|
||||
&REST RESTARGS)
|
||||
(if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFLESSP" %, %, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFLESSP2 ARG1 ARG2))
|
||||
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFLESSP" %, %,
|
||||
ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFLESSP2 ARG1 ARG2))
|
||||
|
||||
(DEFOPTIMIZER UFLESSP2 (X Y)
|
||||
`((OPCODES SWAP UBFLOAT2 5)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y)))
|
||||
|
||||
(DEFOPTIMIZER UFMAX (&OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(DEFOPTIMIZER UFLESSP2 (X Y) `((OPCODES SWAP UBFLOAT2 5)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y)))
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFMAX (&OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(ARG2 NIL ARG2GIVEN)
|
||||
&REST RESTARGS)
|
||||
(if (NOT ARG1GIVEN)
|
||||
then 'MIN.FLOAT
|
||||
elseif (NOT ARG2GIVEN)
|
||||
then `(FLOAT %, ARG1)
|
||||
elseif RESTARGS
|
||||
then `(UFMAX (UFMAX2 %, ARG1 %, ARG2)
|
||||
., RESTARGS)
|
||||
else (LIST 'UFMAX2 ARG1 ARG2)))
|
||||
&REST RESTARGS) (if (NOT ARG1GIVEN)
|
||||
then 'MIN.FLOAT
|
||||
elseif (NOT ARG2GIVEN)
|
||||
then `(FLOAT %, ARG1)
|
||||
elseif RESTARGS
|
||||
then `(UFMAX (UFMAX2 %, ARG1 %, ARG2)
|
||||
., RESTARGS)
|
||||
else (LIST 'UFMAX2 ARG1 ARG2)))
|
||||
|
||||
(DEFOPTIMIZER UFMAX2 (X Y)
|
||||
`[\FLOATBOX ((OPCODES UBFLOAT2 6)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y])
|
||||
|
||||
(DEFOPTIMIZER UFMIN (&OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(DEFOPTIMIZER UFMAX2 (X Y) `[\FLOATBOX ((OPCODES UBFLOAT2 6)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y])
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFMIN (&OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(ARG2 NIL ARG2GIVEN)
|
||||
&REST RESTARGS)
|
||||
(if (NOT ARG1GIVEN)
|
||||
then 'MAX.FLOAT
|
||||
elseif (NOT ARG2GIVEN)
|
||||
then `(FLOAT %, ARG1)
|
||||
elseif RESTARGS
|
||||
then `(UFMIN (UFMIN2 %, ARG1 %, ARG2)
|
||||
., RESTARGS)
|
||||
else (LIST 'UFMIN2 ARG1 ARG2)))
|
||||
&REST RESTARGS) (if (NOT ARG1GIVEN)
|
||||
then 'MAX.FLOAT
|
||||
elseif (NOT ARG2GIVEN)
|
||||
then `(FLOAT %, ARG1)
|
||||
elseif RESTARGS
|
||||
then `(UFMIN (UFMIN2 %, ARG1 %, ARG2)
|
||||
., RESTARGS)
|
||||
else (LIST 'UFMIN2 ARG1 ARG2)))
|
||||
|
||||
(DEFOPTIMIZER UFMIN2 (X Y)
|
||||
`[\FLOATBOX ((OPCODES UBFLOAT2 7)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y])
|
||||
|
||||
(DEFOPTIMIZER UFMINUS (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
&REST RESTARGS)
|
||||
(if (OR (NOT ARG1GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFMINUS" %, %, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFMINUS1 ARG1))
|
||||
(DEFOPTIMIZER UFMIN2 (X Y) `[\FLOATBOX ((OPCODES UBFLOAT2 7)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y])
|
||||
|
||||
(DEFOPTIMIZER UFMINUS1 (X)
|
||||
`[\FLOATBOX ((OPCODES UBFLOAT1 3)
|
||||
(\FLOATUNBOX ,X])
|
||||
|
||||
(DEFOPTIMIZER UFREMAINDER (X Y)
|
||||
(CL:IF (AND (OR (CL:CONSTANTP X)
|
||||
(CL:SYMBOLP X))
|
||||
(OR (CL:CONSTANTP Y)
|
||||
(CL:SYMBOLP Y)))
|
||||
`(FDIFFERENCE ,X (FTIMES [FLOAT (UFIX (FQUOTIENT ,X ,Y]
|
||||
,Y))
|
||||
'COMPILER:PASS))
|
||||
(DEFOPTIMIZER UFMINUS (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFMINUS" %, %,
|
||||
ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFMINUS1 ARG1))
|
||||
|
||||
(PUTPROPS UNBOXEDOPS FILETYPE CL:COMPILE-FILE)
|
||||
|
||||
(DEFOPTIMIZER UFMINUS1 (X) `[\FLOATBOX ((OPCODES UBFLOAT1 3)
|
||||
(\FLOATUNBOX ,X])
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFREMAINDER (X Y) (CL:IF (AND (OR (CL:CONSTANTP X)
|
||||
(CL:SYMBOLP X))
|
||||
(OR (CL:CONSTANTP Y)
|
||||
(CL:SYMBOLP Y)))
|
||||
`(FDIFFERENCE ,X (FTIMES [FLOAT (UFIX (FQUOTIENT ,X
|
||||
,Y]
|
||||
,Y))
|
||||
'COMPILER:PASS))
|
||||
|
||||
|
||||
(PUTPROPS UNBOXEDOPS FILETYPE CL:COMPILE-FILE)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -252,8 +267,9 @@
|
||||
|
||||
(ADDTOVAR LAMA UFMIN UFMAX)
|
||||
)
|
||||
(PUTPROPS UNBOXEDOPS COPYRIGHT ("Xerox Corporation" 1986))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (983 3183 (UFABS 993 . 1114) (UFEQP 1116 . 1239) (UFGEQ 1241 . 1363) (UFGREATERP 1365 .
|
||||
1498) (UFIX 1500 . 1619) (UFLEQ 1621 . 1743) (UFLESSP 1745 . 1872) (UFMAX 1874 . 2276) (UFMIN 2278 .
|
||||
2677) (UFMINUS 2679 . 2804) (UFREMAINDER 2806 . 3181)))))
|
||||
(FILEMAP (NIL (1185 3385 (UFABS 1195 . 1316) (UFEQP 1318 . 1441) (UFGEQ 1443 . 1565) (UFGREATERP 1567
|
||||
. 1700) (UFIX 1702 . 1821) (UFLEQ 1823 . 1945) (UFLESSP 1947 . 2074) (UFMAX 2076 . 2478) (UFMIN 2480
|
||||
. 2879) (UFMINUS 2881 . 3006) (UFREMAINDER 3008 . 3383)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,17 +1,19 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(DEFINE-FILE-INFO §PACKAGE "INTERLISP" §READTABLE "XCL" §BASE 10)
|
||||
(filecreated "18-Dec-86 19:03:25" {eris}<lispcore>internal>library>whocalls.\;2 4500
|
||||
|
||||
(FILECREATED "18-Feb-2026 16:08:45" |{WMEDLEY}<lispusers>WHOCALLS.;2| 4272
|
||||
|changes| |to:| (fns distribute.callinfo distribute-call-info-for-symbol)
|
||||
(vars whocallscoms)
|
||||
|
||||
:EDIT-BY |rmk|
|
||||
|
||||
:PREVIOUS-DATE "18-Dec-86 19:03:25" |{WMEDLEY}<lispusers>WHOCALLS.;1|)
|
||||
|previous| |date:| " 7-Nov-86 02:47:11" {eris}<lispusers>lispcore>whocalls.\;2)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT WHOCALLSCOMS)
|
||||
; Copyright (c) 1986 by Xerox Corporation. All rights reserved.
|
||||
|
||||
(RPAQQ WHOCALLSCOMS ((FNS WHOCALLS WHOCALLS1 DISTRIBUTE.CALLINFO DISTRIBUTE-CALL-INFO-FOR-SYMBOL)
|
||||
(PROP PROPTYPE CALLEDBY USEDFREEBY USEDGLOBALBY BOUNDBY)))
|
||||
(DEFINEQ
|
||||
(prettycomprint whocallscoms)
|
||||
|
||||
(rpaqq whocallscoms ((fns whocalls whocalls1 distribute.callinfo distribute-call-info-for-symbol)
|
||||
(prop proptype calledby usedfreeby usedglobalby boundby)))
|
||||
(defineq
|
||||
|
||||
(WHOCALLS
|
||||
(LAMBDA (CALLEE USAGE)
|
||||
@@ -76,14 +78,15 @@
|
||||
x))))))
|
||||
)
|
||||
|
||||
(PUTPROPS CALLEDBY PROPTYPE IGNORE)
|
||||
(putprops calledby proptype ignore)
|
||||
|
||||
(PUTPROPS USEDFREEBY PROPTYPE IGNORE)
|
||||
(putprops usedfreeby proptype ignore)
|
||||
|
||||
(PUTPROPS USEDGLOBALBY PROPTYPE IGNORE)
|
||||
(putprops usedglobalby proptype ignore)
|
||||
|
||||
(PUTPROPS BOUNDBY PROPTYPE IGNORE)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (466 4064 (WHOCALLS 476 . 1870) (WHOCALLS1 1872 . 3004) (DISTRIBUTE.CALLINFO 3006 . 3232
|
||||
) (DISTRIBUTE-CALL-INFO-FOR-SYMBOL 3234 . 4062)))))
|
||||
STOP
|
||||
(putprops boundby proptype ignore)
|
||||
(putprops whocalls copyright ("Xerox Corporation" 1986))
|
||||
(declare\: dontcopy
|
||||
(filemap (nil (653 4251 (whocalls 663 . 2057) (whocalls1 2059 . 3191) (distribute.callinfo 3193 . 3419
|
||||
) (distribute-call-info-for-symbol 3421 . 4249)))))
|
||||
stop
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO §PACKAGE "INTERLISP" §READTABLE "INTERLISP" §BASE 10)
|
||||
(FILECREATED "22-Dec-86 18:42:34" {ERIS}<LISPUSERS>LISPCORE>COMPILEBANG.;3 3465
|
||||
|
||||
(FILECREATED "18-Feb-2026 16:23:37" {WMEDLEY}<lispusers>compilebang.;2 3232
|
||||
changes to%: (FNS COMPILE!)
|
||||
|
||||
:EDIT-BY rmk
|
||||
previous date%: "18-Nov-86 22:23:43" {ERIS}<LISPUSERS>LISPCORE>COMPILEBANG.;2)
|
||||
|
||||
:PREVIOUS-DATE "22-Dec-86 18:42:34" {WMEDLEY}<lispusers>compilebang.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1982, 1983, 1984, 1986 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT COMPILEBANGCOMS)
|
||||
|
||||
@@ -60,22 +63,23 @@
|
||||
NIL NIL T))
|
||||
(T C))))
|
||||
|
||||
(ADDTOVAR USERMACROS
|
||||
[C NIL (ORR (UP 1)
|
||||
NIL)
|
||||
(ORR ((E (COMPILE! (OR (LISTP (%##))
|
||||
(%## !0))
|
||||
T T T)))
|
||||
((E 'C?])
|
||||
(ADDTOVAR USERMACROS [C NIL (ORR (UP 1)
|
||||
NIL)
|
||||
(ORR ((E (COMPILE! (OR (LISTP (%##))
|
||||
(%## !0))
|
||||
T T T)))
|
||||
((E 'C?])
|
||||
|
||||
(ADDTOVAR EDITCOMSA C)
|
||||
|
||||
(DEFCOMMAND (C :EVAL) (&REST LISPXLINE) (COND
|
||||
(LISPXLINE (COMPILE! (CAR LISPXLINE)
|
||||
(DEFCOMMAND (C :EVAL) (&REST LISPXLINE) (COND
|
||||
(LISPXLINE (COMPILE! (CAR LISPXLINE)
|
||||
NIL NIL T))
|
||||
(T C)))
|
||||
|
||||
(PUTPROPS COMPILEBANG FILETYPE CL:COMPILE-FILE)
|
||||
|
||||
(PUTPROPS COMPILEBANG FILETYPE CL:COMPILE-FILE)
|
||||
(PUTPROPS COMPILEBANG COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1986))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (506 2451 (COMPILE! 516 . 2449)))))
|
||||
(FILEMAP (NIL (622 2567 (COMPILE! 632 . 2565)))))
|
||||
STOP
|
||||
|
||||
46
sources/ADIR
46
sources/ADIR
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Feb-2026 10:27:45" {WMEDLEY}<sources>ADIR.;67 70247
|
||||
(FILECREATED "15-Oct-2025 15:20:48" {WMEDLEY}<sources>ADIR.;62 70135
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS INTERPRET.REM.CM)
|
||||
:CHANGES-TO (MACROS \UPF.EXTRACT)
|
||||
|
||||
:PREVIOUS-DATE " 1-Feb-2026 13:17:10" {WMEDLEY}<sources>ADIR.;66)
|
||||
:PREVIOUS-DATE " 6-Feb-2025 17:48:54" {WMEDLEY}<sources>ADIR.;61)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT ADIRCOMS)
|
||||
@@ -1179,8 +1179,7 @@
|
||||
HERALDSTRING])
|
||||
|
||||
(INTERPRET.REM.CM
|
||||
[LAMBDA (RETFLG) (* ; "Edited 1-Feb-2026 17:49 by rmk")
|
||||
(* ; "Edited 15-Mar-2021 12:27 by larry")
|
||||
[LAMBDA (RETFLG) (* ; "Edited 15-Mar-2021 12:27 by larry")
|
||||
(DECLARE (GLOBALVARS STARTUPFORM))
|
||||
|
||||
(* ;;; "Looks at REM.CM and evaluates the form there if the first character of the file is open paren or doublequote. If it's a string, it will be unread,, else the form will be evaluated at the next prompt. For use in INIT.LISP, among others. If RETFLG is true, the expression read is simply returned")
|
||||
@@ -1188,22 +1187,23 @@
|
||||
(PROG ([FILE (INFILEP (PACKFILENAME 'HOST '{DSK} 'BODY (UNIX-GETENV "LDEREMCM"]
|
||||
COM)
|
||||
(OR FILE (RETURN))
|
||||
[SETQ FILE (OPENSTREAM FILE 'INPUT 'OLD '((:EXTERNAL-FORMAT :UTF-8]
|
||||
(SETQ FILE (OPENSTREAM FILE 'INPUT))
|
||||
(COND
|
||||
([AND (IGREATERP (GETFILEINFO FILE 'LENGTH)
|
||||
[[AND (IGREATERP (GETFILEINFO FILE 'LENGTH)
|
||||
0)
|
||||
(EQ (SKIPSEPRS FILE T)
|
||||
'%")
|
||||
(SETQ COM (CAR (NLSETQ (READ FILE T]
|
||||
(CLOSEF FILE)
|
||||
(CL:UNLESS RETFLG (* ;
|
||||
"Save it to return; otherwise unread a string")
|
||||
(COND
|
||||
(RETFLG (* ; "Save it to return"))
|
||||
(T (* ; "Unread a string")
|
||||
(* ;
|
||||
"RMK: Replace CR and LF by space to avoid EOL convention issues")
|
||||
(for I from 1 to (NCHARS COM) when (FMEMB (NTHCHARCODE COM I)
|
||||
(CHARCODE (CR LF EOL)))
|
||||
do (RPLCHARCODE COM I (CHARCODE EOL)))
|
||||
(BKSYSBUF COM)))
|
||||
(for I from 1 to (NCHARS COM) when (FMEMB (NTHCHARCODE COM I)
|
||||
(CHARCODE (CR LF EOL)))
|
||||
do (RPLCHARCODE COM I (CHARCODE EOL)))
|
||||
(BKSYSBUF COM]
|
||||
(T (CLOSEF FILE)))
|
||||
(RETURN (COND
|
||||
(RETFLG COM)
|
||||
@@ -1282,14 +1282,14 @@
|
||||
(ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3171 15998 (DELFILE 3181 . 3342) (FULLNAME 3344 . 3711) (INFILE 3713 . 3972) (INFILEP
|
||||
3974 . 4109) (IOFILE 4111 . 4362) (OPENFILE 4364 . 4667) (OPENSTREAM 4669 . 9009) (OUTFILE 9011 . 9273
|
||||
) (OUTFILEP 9275 . 9411) (RENAMEFILE 9413 . 9719) (SIMPLE.FINDFILE 9721 . 10131) (VMEMSIZE 10133 .
|
||||
10300) (\COPYSYS 10302 . 14593) (\FLUSHVM 14595 . 15667) (\LOGOUT0 15669 . 15996)) (16497 41157 (
|
||||
UNPACKFILENAME.STRING 16507 . 38343) (\UPF.DIRECTORY 38345 . 41155)) (42742 45048 (UNPACKFILENAME
|
||||
42752 . 42938) (LASTCHPOS 42940 . 43634) (FILENAMEFIELD 43636 . 43930) (FILENAMEFIELD.STRING 43932 .
|
||||
44336) (PACKFILENAME 44338 . 44681) (PACKFILENAME.STRING 44683 . 45046)) (59518 60431 (
|
||||
FILEDIRCASEARRAY 59528 . 60429)) (60598 68006 (LOGOUT 60608 . 61653) (MAKESYS 61655 . 63284) (SYSOUT
|
||||
63286 . 64838) (SAVEVM 64840 . 65640) (HERALD 65642 . 65802) (INTERPRET.REM.CM 65804 . 67629) (
|
||||
\USEREVENT 67631 . 68004)) (68188 69915 (USERNAME 68198 . 69154) (SETUSERNAME 69156 . 69913)))))
|
||||
(FILEMAP (NIL (3170 15997 (DELFILE 3180 . 3341) (FULLNAME 3343 . 3710) (INFILE 3712 . 3971) (INFILEP
|
||||
3973 . 4108) (IOFILE 4110 . 4361) (OPENFILE 4363 . 4666) (OPENSTREAM 4668 . 9008) (OUTFILE 9010 . 9272
|
||||
) (OUTFILEP 9274 . 9410) (RENAMEFILE 9412 . 9718) (SIMPLE.FINDFILE 9720 . 10130) (VMEMSIZE 10132 .
|
||||
10299) (\COPYSYS 10301 . 14592) (\FLUSHVM 14594 . 15666) (\LOGOUT0 15668 . 15995)) (16496 41156 (
|
||||
UNPACKFILENAME.STRING 16506 . 38342) (\UPF.DIRECTORY 38344 . 41154)) (42741 45047 (UNPACKFILENAME
|
||||
42751 . 42937) (LASTCHPOS 42939 . 43633) (FILENAMEFIELD 43635 . 43929) (FILENAMEFIELD.STRING 43931 .
|
||||
44335) (PACKFILENAME 44337 . 44680) (PACKFILENAME.STRING 44682 . 45045)) (59517 60430 (
|
||||
FILEDIRCASEARRAY 59527 . 60428)) (60597 67894 (LOGOUT 60607 . 61652) (MAKESYS 61654 . 63283) (SYSOUT
|
||||
63285 . 64837) (SAVEVM 64839 . 65639) (HERALD 65641 . 65801) (INTERPRET.REM.CM 65803 . 67517) (
|
||||
\USEREVENT 67519 . 67892)) (68076 69803 (USERNAME 68086 . 69042) (SETUSERNAME 69044 . 69801)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Feb-2026 15:49:51" {WMEDLEY}<sources>ATERM.;7 56918
|
||||
(FILECREATED "20-Jul-2022 17:05:17" {DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>ATERM.;5 57463
|
||||
|
||||
:EDIT-BY rmk
|
||||
:CHANGES-TO (FNS \CHDEL1)
|
||||
|
||||
:CHANGES-TO (FNS \CREATELINEBUFFER)
|
||||
:PREVIOUS-DATE "19-Jul-2022 22:49:20"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>ATERM.;4)
|
||||
|
||||
:PREVIOUS-DATE "20-Jul-2022 17:05:17" {WMEDLEY}<sources>ATERM.;5)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT ATERMCOMS)
|
||||
|
||||
@@ -912,33 +915,39 @@
|
||||
(RETURN STREAM])
|
||||
|
||||
(\CREATELINEBUFFER
|
||||
[LAMBDA (TERMINAL.STREAM) (* ; "Edited 9-Feb-2026 15:49 by rmk")
|
||||
(* ; "Edited 29-Apr-2021 09:38 by rmk:")
|
||||
[LAMBDA (TERMINAL.STREAM) (* ; "Edited 29-Apr-2021 09:38 by rmk:")
|
||||
|
||||
(* ;;
|
||||
"Create a new stream that buffers the raw input from TERMINAL.STREAM (default is the keyboard).")
|
||||
(* ;;
|
||||
"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]
|
||||
(LET* ([STREAM (\OPENFILE '{LINEBUFFER} 'BOTH 'NEW '((CHARSET T]
|
||||
(DEV (fetch (STREAM DEVICE) of STREAM))
|
||||
EOFMETHOD)
|
||||
(replace LINEBUFSTATE of STREAM with READING.LBS)
|
||||
(replace (LINEBUFFER KEYBOARDSTREAM) of STREAM with (OR TERMINAL.STREAM \KEYBOARD.STREAM))
|
||||
(replace (LINEBUFFER KEYBOARDSTREAM) of STREAM with (OR TERMINAL.STREAM
|
||||
\KEYBOARD.STREAM))
|
||||
(replace USERCLOSEABLE of STREAM with NIL)
|
||||
(replace USERVISIBLE of STREAM with NIL) (* ;
|
||||
"Other linebuffer fields default properly")
|
||||
(replace USERVISIBLE of STREAM with NIL)
|
||||
(* ;
|
||||
"Other linebuffer fields default properly")
|
||||
[replace ENDOFSTREAMOP of STREAM with (FUNCTION (LAMBDA (STREAM)
|
||||
(CL:FUNCALL \RefillBufferFn]
|
||||
(CL:FUNCALL \RefillBufferFn]
|
||||
(replace (STREAM EOLCONVENTION) of STREAM with CR.EOLC)
|
||||
(* ;
|
||||
"RMK: Terminal is CR, even if stream default is LF")
|
||||
(if (AND TERMINAL.STREAM (NEQ (SETQ EOFMETHOD (fetch (FDEV EOFP) of TERMINAL.STREAM))
|
||||
'NILL))
|
||||
(* ;
|
||||
"RMK: Terminal is CR, even if stream default is LF")
|
||||
(if (AND TERMINAL.STREAM (NEQ (SETQ EOFMETHOD (fetch (FDEV EOFP) of
|
||||
TERMINAL.STREAM
|
||||
))
|
||||
'NILL))
|
||||
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.")
|
||||
|
||||
(replace (STREAM DEVICE) of STREAM with (SETQ DEV (NCREATE 'FDEV DEV)))
|
||||
(* ; "Copy the basic linebuffer device")
|
||||
(replace (FDEV EOFP) of DEV with EOFMETHOD))
|
||||
(* ;; "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
|
||||
'FDEV DEV)))
|
||||
(* ;
|
||||
"Copy the basic linebuffer device")
|
||||
(replace (FDEV EOFP) of DEV with EOFMETHOD))
|
||||
STREAM])
|
||||
|
||||
(\LINEBUF.READP
|
||||
@@ -1133,19 +1142,20 @@
|
||||
|
||||
(ADDTOVAR LAMA VIDEOCOLOR TERMINAL-OUTPUT TERMINAL-INPUT)
|
||||
)
|
||||
(PUTPROPS ATERM COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2854 31931 (BKLINBUF 2864 . 3339) (CLEARBUF 3341 . 4673) (LINBUF 4675 . 4861) (
|
||||
PAGEFULLFN 4863 . 6344) (SETLINELENGTH 6346 . 6542) (SYSBUF 6544 . 6730) (TERMCHARWIDTH 6732 . 7149) (
|
||||
TERMINAL-INPUT 7151 . 7719) (TERMINAL-OUTPUT 7721 . 8307) (\CHDEL1 8309 . 8698) (\CLOSELINE 8700 .
|
||||
8989) (\DECPARENCOUNT 8991 . 10574) (\ECHOCHAR 10576 . 11268) (\FILLBUFFER 11270 . 24261) (
|
||||
\FILLBUFFER.WORDSEPRP 24263 . 24508) (\FILLBUFFER.BACKUP 24510 . 24689) (\GETCHAR 24691 . 25080) (
|
||||
\INCPARENCOUNT 25082 . 27694) (\RESETLINE 27696 . 28020) (\RESETTERMINAL 28022 . 28786) (\SAVELINEBUF
|
||||
28788 . 30759) (\STOPSCROLL? 30761 . 31929)) (32134 35990 (\DSCCOUT 32144 . 35284) (\INITBCPLDISPLAY
|
||||
35286 . 35988)) (36183 37433 (VIDEOCOLOR 36193 . 37431)) (38201 44055 (\PEEKREFILL 38211 . 42322) (
|
||||
\READREFILL 42324 . 42918) (\RATOM/RSTRING-REFILL 42920 . 43498) (\READCREFILL 43500 . 44053)) (44056
|
||||
45885 (DRIBBLE 44066 . 45667) (DRIBBLEFILE 45669 . 45883)) (45886 52246 (\SETUP.DEFAULT.LINEBUF 45896
|
||||
. 48353) (\CREATELINEBUFFER 48355 . 50462) (\LINEBUF.READP 50464 . 50813) (\LINEBUF.EOFP 50815 .
|
||||
51154) (\LINEBUF.PEEKBIN 51156 . 51363) (\OPENLINEBUF 51365 . 52244)) (52321 53560 (LINEBUFFER-EOFP
|
||||
52331 . 52789) (LINEBUFFER-SKIPSEPRS 52791 . 53558)) (53917 54191 (\INTERMP 53927 . 54058) (\OUTTERMP
|
||||
54060 . 54189)))))
|
||||
(FILEMAP (NIL (2982 32059 (BKLINBUF 2992 . 3467) (CLEARBUF 3469 . 4801) (LINBUF 4803 . 4989) (
|
||||
PAGEFULLFN 4991 . 6472) (SETLINELENGTH 6474 . 6670) (SYSBUF 6672 . 6858) (TERMCHARWIDTH 6860 . 7277) (
|
||||
TERMINAL-INPUT 7279 . 7847) (TERMINAL-OUTPUT 7849 . 8435) (\CHDEL1 8437 . 8826) (\CLOSELINE 8828 .
|
||||
9117) (\DECPARENCOUNT 9119 . 10702) (\ECHOCHAR 10704 . 11396) (\FILLBUFFER 11398 . 24389) (
|
||||
\FILLBUFFER.WORDSEPRP 24391 . 24636) (\FILLBUFFER.BACKUP 24638 . 24817) (\GETCHAR 24819 . 25208) (
|
||||
\INCPARENCOUNT 25210 . 27822) (\RESETLINE 27824 . 28148) (\RESETTERMINAL 28150 . 28914) (\SAVELINEBUF
|
||||
28916 . 30887) (\STOPSCROLL? 30889 . 32057)) (32262 36118 (\DSCCOUT 32272 . 35412) (\INITBCPLDISPLAY
|
||||
35414 . 36116)) (36311 37561 (VIDEOCOLOR 36321 . 37559)) (38329 44183 (\PEEKREFILL 38339 . 42450) (
|
||||
\READREFILL 42452 . 43046) (\RATOM/RSTRING-REFILL 43048 . 43626) (\READCREFILL 43628 . 44181)) (44184
|
||||
46013 (DRIBBLE 44194 . 45795) (DRIBBLEFILE 45797 . 46011)) (46014 52689 (\SETUP.DEFAULT.LINEBUF 46024
|
||||
. 48481) (\CREATELINEBUFFER 48483 . 50905) (\LINEBUF.READP 50907 . 51256) (\LINEBUF.EOFP 51258 .
|
||||
51597) (\LINEBUF.PEEKBIN 51599 . 51806) (\OPENLINEBUF 51808 . 52687)) (52764 54003 (LINEBUFFER-EOFP
|
||||
52774 . 53232) (LINEBUFFER-SKIPSEPRS 53234 . 54001)) (54360 54634 (\INTERMP 54370 . 54501) (\OUTTERMP
|
||||
54503 . 54632)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Feb-2026 15:54:22" {WMEDLEY}<sources>EXTERNALFORMAT.;120 47422
|
||||
(FILECREATED "29-Jan-2026 21:09:02" {WMEDLEY}<sources>EXTERNALFORMAT.;92 39722
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS EXTERNALFORMATCOMS)
|
||||
(FNS \CREATE.THROUGH16.EXTERNALFORMAT \CREATE.THROUGH.EXTERNALFORMAT)
|
||||
:CHANGES-TO (FNS \EXTERNALFORMAT)
|
||||
|
||||
:PREVIOUS-DATE " 6-Feb-2026 23:21:32" {WMEDLEY}<sources>EXTERNALFORMAT.;116)
|
||||
:PREVIOUS-DATE "24-Apr-2025 08:43:01" {WMEDLEY}<sources>EXTERNALFORMAT.;91)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT EXTERNALFORMATCOMS)
|
||||
@@ -20,12 +19,10 @@
|
||||
(SYSRECORDS EXTERNALFORMAT)
|
||||
(FNS \EXTERNALFORMAT MAKE-EXTERNALFORMAT \EXTERNALFORMAT.DEFPRINT)
|
||||
(FNS \INSTALL.EXTERNALFORMAT \REMOVE.EXTERNALFORMAT FIND-FORMAT)
|
||||
(EXPORT (GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*))
|
||||
(FNS SYSTEM-EXTERNALFORMAT)
|
||||
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
|
||||
(INITVARS (*EXTERNALFORMATS* NIL)
|
||||
(*DEFAULT-EXTERNALFORMAT* :MCCS))
|
||||
(COMS (FNS SYSTEM-EXTERNALFORMAT MTOSYSSTRING SYSTOMSTRING)
|
||||
(EXPORT (GLOBALVARS *SYSTEM-EXTERNALFORMAT*))
|
||||
(INITVARS (*SYSTEM-EXTERNALFORMAT* :UTF-8)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (DEFPRINT 'EXTERNALFORMAT (FUNCTION
|
||||
\EXTERNALFORMAT.DEFPRINT
|
||||
]
|
||||
@@ -33,8 +30,7 @@
|
||||
(* ;; "Generic functions not compiled open (originally on LLREAD)")
|
||||
|
||||
(FNS \OUTCHAR \INCCODE \BACKCCODE \BACKCCODE.EOLC \PEEKCCODE \PEEKCCODE.EOLC
|
||||
\INCCODE.EOLC \FORMATBYTESTREAM \CHECKEOLC.CRLF)
|
||||
(FNS MCCSTOFORMATBYTES FORMATBYTESTOMCCS)
|
||||
\INCCODE.EOLC \FORMATBYTESTREAM \FORMATBYTESTRING \CHECKEOLC.CRLF)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CHECKEOLC))
|
||||
(RESOURCES \FORMATBYTESTRING.STREAM))
|
||||
(INITRESOURCES \FORMATBYTESTRING.STREAM))
|
||||
@@ -42,12 +38,10 @@
|
||||
(FNS \NULLDEVICE \NULL.OPENFILE)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\NULLDEVICE]
|
||||
(COMS
|
||||
(* ;; "Also from FILEIO.")
|
||||
(* ;; "Also from FILEIO, but not clear that this is or ever has been used.")
|
||||
|
||||
(FNS \CREATE.THROUGH.EXTERNALFORMAT \CREATE.THROUGH16.EXTERNALFORMAT \THROUGHIN
|
||||
\THROUGHBACKCCODE \THROUGHOUTCHARFN)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.THROUGH.EXTERNALFORMAT)
|
||||
(\CREATE.THROUGH16.EXTERNALFORMAT])
|
||||
(FNS \CREATE.THROUGH.EXTERNALFORMAT \THROUGHIN \THROUGHBACKCCODE \THROUGHOUTCHARFN)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.THROUGH.EXTERNALFORMAT])
|
||||
|
||||
|
||||
|
||||
@@ -73,18 +67,15 @@
|
||||
(EF1 POINTER) (* ;
|
||||
"Extra fields for use of particular formats. Possibly to hold standardized translation tables")
|
||||
(EF2 POINTER)
|
||||
(MCCSTOFORMATBYTESFN POINTER) (* ; "Translates an MCCS string into a string containing the bytes that represent that string in this format")
|
||||
(FORMATBYTESTRINGFN POINTER) (* ; "Translates an internal string into a string containing the bytes that represent that string in this format")
|
||||
(FORMATCHARSETFN POINTER) (* ;
|
||||
"If present, apply by \GENERIC.CHARSET")
|
||||
(FORMATBYTESTOMCCSFN POINTER)) (* ;
|
||||
"Translates format bytes into a string containing the corresponding MCCS codes")
|
||||
)
|
||||
))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'EXTERNALFORMAT
|
||||
'(FLAG (BITS 2)
|
||||
FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER)
|
||||
FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)
|
||||
'((EXTERNALFORMAT 0 (FLAGBITS . 0))
|
||||
(EXTERNALFORMAT 0 (BITS . 17))
|
||||
(EXTERNALFORMAT 0 (FLAGBITS . 48))
|
||||
@@ -97,9 +88,8 @@
|
||||
(EXTERNALFORMAT 12 POINTER)
|
||||
(EXTERNALFORMAT 14 POINTER)
|
||||
(EXTERNALFORMAT 16 POINTER)
|
||||
(EXTERNALFORMAT 18 POINTER)
|
||||
(EXTERNALFORMAT 20 POINTER))
|
||||
'22)
|
||||
(EXTERNALFORMAT 18 POINTER))
|
||||
'20)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
@@ -107,8 +97,7 @@
|
||||
|
||||
(/DECLAREDATATYPE 'EXTERNALFORMAT
|
||||
'(FLAG (BITS 2)
|
||||
FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER)
|
||||
FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)
|
||||
'((EXTERNALFORMAT 0 (FLAGBITS . 0))
|
||||
(EXTERNALFORMAT 0 (BITS . 17))
|
||||
(EXTERNALFORMAT 0 (FLAGBITS . 48))
|
||||
@@ -121,9 +110,8 @@
|
||||
(EXTERNALFORMAT 12 POINTER)
|
||||
(EXTERNALFORMAT 14 POINTER)
|
||||
(EXTERNALFORMAT 16 POINTER)
|
||||
(EXTERNALFORMAT 18 POINTER)
|
||||
(EXTERNALFORMAT 20 POINTER))
|
||||
'22)
|
||||
(EXTERNALFORMAT 18 POINTER))
|
||||
'20)
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG)
|
||||
@@ -137,9 +125,8 @@
|
||||
(FORMATBYTESTREAMFN POINTER)
|
||||
(EF1 POINTER)
|
||||
(EF2 POINTER)
|
||||
(MCCSTOFORMATBYTESFN POINTER)
|
||||
(FORMATCHARSETFN POINTER)
|
||||
(FORMATBYTESTOMCCSFN POINTER)))
|
||||
(FORMATBYTESTRINGFN POINTER)
|
||||
(FORMATCHARSETFN POINTER)))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -212,10 +199,7 @@
|
||||
|
||||
(MAKE-EXTERNALFORMAT
|
||||
[LAMBDA (NAME INCCODEFN PEEKCCODEFN BACKCCODEFN OUTCHARFN FORMATBYTESTREAMFN EOL UNSTABLE
|
||||
MCCSTOFORMATBYTESFN DEFAULT FORMATCHARSETFN FORMATBYTESTOMCCSFN)
|
||||
(* ; "Edited 5-Feb-2026 14:26 by rmk")
|
||||
(* ; "Edited 2-Feb-2026 23:04 by rmk")
|
||||
(* ; "Edited 8-Dec-2023 22:02 by rmk")
|
||||
FORMATBYTESTRINGFN DEFAULT FORMATCHARSETFN) (* ; "Edited 8-Dec-2023 22:02 by rmk")
|
||||
(* ; "Edited 3-Jul-2022 00:35 by rmk")
|
||||
(* ; "Edited 10-Sep-2021 19:47 by rmk:")
|
||||
|
||||
@@ -226,13 +210,17 @@
|
||||
*DEFAULT-EXTERNALFORMAT*
|
||||
DEFAULT)]
|
||||
(CL:UNLESS INCCODEFN
|
||||
(SETQ INCCODEFN (FETCH (EXTERNALFORMAT INCCODEFN) OF DEF)))
|
||||
(SETQ INCCODEFN (FETCH (EXTERNALFORMAT INCCODEFN)
|
||||
DEF)))
|
||||
(CL:UNLESS PEEKCCODEFN
|
||||
(SETQ PEEKCCODEFN (FETCH (EXTERNALFORMAT PEEKCCODEFN) OF DEF)))
|
||||
(SETQ PEEKCCODEFN (FETCH (EXTERNALFORMAT PEEKCCODEFN)
|
||||
DEF)))
|
||||
(CL:UNLESS BACKCCODEFN
|
||||
(SETQ BACKCCODEFN (FETCH (EXTERNALFORMAT BACKCCODEFN) OF DEF)))
|
||||
(SETQ BACKCCODEFN (FETCH (EXTERNALFORMAT BACKCCODEFN)
|
||||
DEF)))
|
||||
(CL:UNLESS OUTCHARFN
|
||||
(SETQ OUTCHARFN (FETCH (EXTERNALFORMAT OUTCHARFN) OF DEF)))])
|
||||
(SETQ OUTCHARFN (FETCH (EXTERNALFORMAT OUTCHARFN)
|
||||
DEF)))])
|
||||
(SETQ EOL (SELECTC EOL
|
||||
((LIST 'LF LF.EOLC)
|
||||
LF.EOLC)
|
||||
@@ -252,8 +240,7 @@
|
||||
EOLVALID _ EOL
|
||||
EOL _ (OR EOL LF.EOLC)
|
||||
UNSTABLE _ UNSTABLE
|
||||
MCCSTOFORMATBYTESFN _ MCCSTOFORMATBYTESFN
|
||||
FORMATBYTESTOMCCSFN _ FORMATBYTESTOMCCSFN
|
||||
FORMATBYTESTRINGFN _ FORMATBYTESTRINGFN
|
||||
FORMATCHARSETFN _ (OR FORMATCHARSETFN (FUNCTION NILL])
|
||||
|
||||
(\EXTERNALFORMAT.DEFPRINT
|
||||
@@ -319,52 +306,22 @@
|
||||
OF EF)))
|
||||
(CL:UNLESS NOERROR (ERROR NAME "is not an external format"])
|
||||
)
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
(DEFINEQ
|
||||
|
||||
(SYSTEM-EXTERNALFORMAT
|
||||
[LAMBDA NIL (* ; "Edited 10-Oct-2022 11:55 by lmm")
|
||||
(* ; "Edited 7-Jul-2022 10:41 by rmk")
|
||||
(FOR X IN '("LC_CTYPE" "LC_ALL" "LANG") WHEN (STRPOS ".UTF-8" (UNIX-GETENV X))
|
||||
DO (RETURN :UTF-8) FINALLY (RETURN :THROUGH])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
|
||||
(RPAQ? *EXTERNALFORMATS* NIL)
|
||||
|
||||
(RPAQ? *DEFAULT-EXTERNALFORMAT* :MCCS)
|
||||
(DEFINEQ
|
||||
|
||||
(SYSTEM-EXTERNALFORMAT
|
||||
[LAMBDA NIL (* ; "Edited 6-Feb-2026 11:29 by rmk")
|
||||
(* ; "Edited 31-Jan-2026 18:51 by rmk")
|
||||
(* ; "Edited 10-Oct-2022 11:55 by lmm")
|
||||
(* ; "Edited 7-Jul-2022 10:41 by rmk")
|
||||
|
||||
(* ;; "Returns the name, sets the global. For now, UTF-8 or through, could be something else.")
|
||||
|
||||
(fetch (EXTERNALFORMAT NAME) of (SETQ *SYSTEM-EXTERNALFORMAT*
|
||||
(FIND-FORMAT (FOR X IN '("LC¬CTYPE" "LC¬ALL" "LANG")
|
||||
WHEN (STRPOS ".UTF-8" (UNIX-GETENV X))
|
||||
DO (RETURN :UTF-8) FINALLY (RETURN :THROUGH])
|
||||
|
||||
(MTOSYSSTRING
|
||||
[LAMBDA (MSTRING) (* ; "Edited 6-Feb-2026 00:20 by rmk")
|
||||
(MCCSTOFORMATBYTES *SYSTEM-EXTERNALFORMAT* (MKSTRING MSTRING])
|
||||
|
||||
(SYSTOMSTRING
|
||||
[LAMBDA (SYSTRING) (* ; "Edited 5-Feb-2026 23:36 by rmk")
|
||||
|
||||
(* ;; "SYSSTRING is presumably shared with Unix, guarantee a copy on the way out")
|
||||
|
||||
(CONCAT (FORMATBYTESTOMCCS *SYSTEM-EXTERNALFORMAT* SYSTRING])
|
||||
)
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *SYSTEM-EXTERNALFORMAT*)
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
|
||||
(RPAQ? *SYSTEM-EXTERNALFORMAT* :UTF-8)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(DEFPRINT 'EXTERNALFORMAT (FUNCTION \EXTERNALFORMAT.DEFPRINT))
|
||||
@@ -567,6 +524,28 @@
|
||||
(freplace (STREAM ENDOFSTREAMOP) of BYTESTREAM with (FUNCTION NILL)))
|
||||
BYTESTREAM])
|
||||
|
||||
(\FORMATBYTESTRING
|
||||
[LAMBDA (STREAM STRING) (* ; "Edited 19-Mar-2024 18:24 by rmk")
|
||||
(* ; "Edited 10-Jul-2022 16:39 by rmk")
|
||||
(* ; "Edited 22-Jun-2022 11:07 by rmk")
|
||||
(* ; "Edited 18-Jun-2022 22:04 by rmk")
|
||||
(WITH-RESOURCE \FORMATBYTESTRING.STREAM (\SETFILEPTR \FORMATBYTESTRING.STREAM 0)
|
||||
(LET [FSTRING NBYTES (BYTESTRINGFN (FETCH (EXTERNALFORMAT FORMATBYTESTRINGFN)
|
||||
OF (FETCH (STREAM EXTERNALFORMAT) OF STREAM]
|
||||
(IF BYTESTRINGFN
|
||||
THEN (CL:WHEN (SETQ FSTRING (APPLY* BYTESTRINGFN STREAM STRING
|
||||
\FORMATBYTESTRING.STREAM))
|
||||
(MKSTRING FSTRING))
|
||||
ELSE (\FORMATBYTESTREAM STREAM \FORMATBYTESTRING.STREAM)
|
||||
(FOR C INPNAME STRING DO (\OUTCHAR \FORMATBYTESTRING.STREAM C))
|
||||
(SETQ NBYTES (\GETFILEPTR \FORMATBYTESTRING.STREAM))
|
||||
(\SETFILEPTR \FORMATBYTESTRING.STREAM 0)
|
||||
(SETQ FSTRING (ALLOCSTRING NBYTES))
|
||||
(FOR I FROM 1 TO NBYTES DO (RPLCHARCODE FSTRING I (\BIN
|
||||
\FORMATBYTESTRING.STREAM
|
||||
)))
|
||||
FSTRING])
|
||||
|
||||
(\CHECKEOLC.CRLF
|
||||
[LAMBDA (STREAM PEEKBINFLG COUNTP EOLC) (* ; "Edited 6-Dec-2023 23:39 by rmk")
|
||||
(* ; "Edited 17-Oct-2023 11:56 by rmk")
|
||||
@@ -627,66 +606,6 @@
|
||||
(CHARCODE CR]
|
||||
CH])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(MCCSTOFORMATBYTES
|
||||
[LAMBDA (FORMAT MSTRING) (* ; "Edited 6-Feb-2026 18:12 by rmk")
|
||||
(* ; "Edited 5-Feb-2026 10:24 by rmk")
|
||||
(* ; "Edited 3-Feb-2026 11:06 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 18:24 by rmk")
|
||||
(* ; "Edited 10-Jul-2022 16:39 by rmk")
|
||||
(* ; "Edited 22-Jun-2022 11:07 by rmk")
|
||||
(* ; "Edited 18-Jun-2022 22:04 by rmk")
|
||||
(CL:WHEN MSTRING
|
||||
(CL:UNLESS (type? EXTERNALFORMAT FORMAT)
|
||||
(SETQ FORMAT (OR (if (type? STREAM FORMAT)
|
||||
then (fetch (STREAM EXTERNALFORMAT) of FORMAT)
|
||||
else (FIND-FORMAT FORMAT))
|
||||
(\ILLEGAL.ARG FORMAT))))
|
||||
(LET (FSTRING NBYTES (TOBYTESFN (fetch (EXTERNALFORMAT MCCSTOFORMATBYTESFN) of FORMAT)))
|
||||
(if TOBYTESFN
|
||||
then (CL:WHEN (SETQ FSTRING (APPLY* TOBYTESFN MSTRING))
|
||||
(MKSTRING FSTRING))
|
||||
else
|
||||
(* ;;
|
||||
"No specific function, fake it by the outchar function. Maybe return NIL if UNSTABLE?")
|
||||
|
||||
(WITH-RESOURCE \FORMATBYTESTRING.STREAM (\SETFILEPTR \FORMATBYTESTRING.STREAM 0)
|
||||
(STREAMPROP \FORMATBYTESTRING.STREAM :EXTERNAL-FORMAT FORMAT)
|
||||
(for C inpname MSTRING do (\OUTCHAR \FORMATBYTESTRING.STREAM C))
|
||||
(SETQ NBYTES (\GETFILEPTR \FORMATBYTESTRING.STREAM))
|
||||
(\SETFILEPTR \FORMATBYTESTRING.STREAM 0)
|
||||
(SETQ FSTRING (ALLOCSTRING NBYTES))
|
||||
(for I from 1 to NBYTES do (RPLCHARCODE FSTRING I (\BIN
|
||||
\FORMATBYTESTRING.STREAM
|
||||
)))
|
||||
FSTRING))))])
|
||||
|
||||
(FORMATBYTESTOMCCS
|
||||
[LAMBDA (FORMAT FSTRING) (* ; "Edited 6-Feb-2026 18:13 by rmk")
|
||||
|
||||
(* ;; "Produces an MCCS string with characters that correspond to the format bytes in FSTRING according to FORMAT.")
|
||||
|
||||
(CL:WHEN FSTRING
|
||||
(CL:UNLESS (type? EXTERNALFORMAT FORMAT)
|
||||
(SETQ FORMAT (OR (if (type? STREAM FORMAT)
|
||||
then (fetch (STREAM EXTERNALFORMAT) of FORMAT)
|
||||
else (FIND-FORMAT FORMAT))
|
||||
(\ILLEGAL.ARG FORMAT))))
|
||||
(SETQ FSTRING (MKSTRING FSTRING)) (* ; "Should be thin, if bytes")
|
||||
[LET ((TOMCCSFN (fetch (EXTERNALFORMAT FORMATBYTESTOMCCSFN) of FORMAT))
|
||||
MSTRING)
|
||||
(if TOMCCSFN
|
||||
then (APPLY* TOMCCSFN FSTRING)
|
||||
else
|
||||
(* ;; "No specific function, fake it by bouting the FSTRING characters and reading them with \INCCODEFN. ENDOFSTREAMOP is NILL")
|
||||
|
||||
(WITH-RESOURCE \FORMATBYTESTRING.STREAM (\SETFILEPTR \FORMATBYTESTRING.STREAM 0)
|
||||
(for B instring FSTRING do (\BOUT \FORMATBYTESTRING.STREAM B))
|
||||
(\SETFILEPTR \FORMATBYTESTRING.STREAM 0)
|
||||
(STREAMPROP \FORMATBYTESTRING.STREAM :EXTERNAL-FORMAT FORMAT)
|
||||
(RSTRING \FORMATBYTESTRING.STREAM])])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@@ -710,9 +629,7 @@
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTDEF '\FORMATBYTESTRING.STREAM 'RESOURCES '(NEW (OPENSTREAM '{NODIRCORE} 'BOTH)
|
||||
NIL
|
||||
'((ENDOFSTREAMOP NILL]
|
||||
[PUTDEF '\FORMATBYTESTRING.STREAM 'RESOURCES '(NEW (OPENSTREAM '{NODIRCORE} 'BOTH]
|
||||
)
|
||||
)
|
||||
|
||||
@@ -773,82 +690,31 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "Also from FILEIO.")
|
||||
(* ;; "Also from FILEIO, but not clear that this is or ever has been used.")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\CREATE.THROUGH.EXTERNALFORMAT
|
||||
[LAMBDA NIL (* ; "Edited 9-Feb-2026 15:43 by rmk")
|
||||
(* ; "Edited 5-Feb-2026 13:12 by rmk")
|
||||
(* ; "Edited 24-Jul-2022 08:08 by rmk")
|
||||
[LAMBDA NIL (* ; "Edited 24-Jul-2022 08:08 by rmk")
|
||||
(* ; "Edited 23-Jun-2021 13:34 by rmk:")
|
||||
|
||||
(* ;;; "Create the :THROUGH external format. EOL is adjusted so that the .EOLC callers will not do any conversion.")
|
||||
|
||||
(MAKE-EXTERNALFORMAT :THROUGH [FUNCTION (LAMBDA (STREAM COUNTP)
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1))
|
||||
(\BIN STREAM]
|
||||
(MAKE-EXTERNALFORMAT :THROUGH (FUNCTION \THROUGHIN)
|
||||
(FUNCTION \PEEKBIN)
|
||||
[FUNCTION (LAMBDA (STREAM COUNTP)
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(CL:WHEN (\BACKFILEPTR STREAM)
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
|
||||
T)]
|
||||
[FUNCTION (LAMBDA (OUTSTREAM CHARCODE)
|
||||
(CL:WHEN (> CHARCODE \MAXTHINCHAR)
|
||||
(ERROR ":THROUGH external format can't represent 16 bit characters"))
|
||||
(\BOUT OUTSTREAM CHARCODE]
|
||||
(FUNCTION \THROUGHBACKCCODE)
|
||||
(FUNCTION \THROUGHOUTCHARFN)
|
||||
NIL
|
||||
(CL:IF (EQ (CHARCODE CR)
|
||||
(CHARCODE EOL))
|
||||
CR.EOLC
|
||||
LF.EOLC)
|
||||
NIL
|
||||
(FUNCTION MKSTRING)
|
||||
NIL NIL (FUNCTION MKSTRING])
|
||||
|
||||
(\CREATE.THROUGH16.EXTERNALFORMAT
|
||||
[LAMBDA NIL (* ; "Edited 9-Feb-2026 15:47 by rmk")
|
||||
(* ; "Edited 5-Feb-2026 13:12 by rmk")
|
||||
(* ; "Edited 24-Jul-2022 08:08 by rmk")
|
||||
(* ; "Edited 23-Jun-2021 13:34 by rmk:")
|
||||
|
||||
(* ;;; "Create the :THROUGH external format. EOL is adjusted so that the .EOLC callers will not do any conversion.")
|
||||
|
||||
(MAKE-EXTERNALFORMAT :THROUGH16 [FUNCTION (LAMBDA (STREAM COUNTP)
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* 2))
|
||||
(\WIN STREAM]
|
||||
[FUNCTION (LAMBDA (STREAM NOERRORFLG)
|
||||
(LET (BYTE1 BYTE2)
|
||||
(CL:WHEN (SETQ BYTE1 (\PEEKBIN STREAM NOERRORFLG))
|
||||
(\BIN STREAM)
|
||||
(SETQ BYTE2 (\PEEKBIN STREAM NOERRORFLG))
|
||||
(\BACKFILEPTR STREAM)
|
||||
(CL:WHEN BYTE2
|
||||
(LOGOR (LLSH BYTE1 8)
|
||||
BYTE2)))]
|
||||
[FUNCTION (LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:14 by rmk:")
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(CL:WHEN (\BACKFILEPTR STREAM)
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
|
||||
(CL:WHEN (\BACKFILEPTR STREAM)
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2))
|
||||
T))]
|
||||
[FUNCTION (LAMBDA (OUTSTREAM CHARCODE)
|
||||
(\WOUT OUTSTREAM CHARCODE]
|
||||
NIL
|
||||
(CL:IF (EQ (CHARCODE CR)
|
||||
(CHARCODE EOL))
|
||||
CR.EOLC
|
||||
LF.EOLC)
|
||||
NIL
|
||||
(FUNCTION MKSTRING)
|
||||
NIL NIL (FUNCTION MKSTRING])
|
||||
(FUNCTION (LAMBDA (STREAM STRING)
|
||||
(MKSTRING STRING])
|
||||
|
||||
(\THROUGHIN
|
||||
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:13 by rmk:")
|
||||
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:13 by rmk:")
|
||||
|
||||
(* ;;; "Read in a single byte from STREAM and returns it without any character conversion, just through as if.")
|
||||
|
||||
@@ -859,14 +725,14 @@
|
||||
(\BIN STREAM])
|
||||
|
||||
(\THROUGHBACKCCODE
|
||||
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:14 by rmk:")
|
||||
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:14 by rmk:")
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(CL:WHEN (\BACKFILEPTR STREAM)
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
|
||||
T)])
|
||||
|
||||
(\THROUGHOUTCHARFN
|
||||
[LAMBDA (OUTSTREAM CHARCODE) (* ; "Edited 26-Feb-91 13:44 by nm")
|
||||
[LAMBDA (OUTSTREAM CHARCODE) (* ; "Edited 26-Feb-91 13:44 by nm")
|
||||
|
||||
(* ;;; "Encoder for THROUGH format.")
|
||||
|
||||
@@ -879,19 +745,15 @@
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(\CREATE.THROUGH.EXTERNALFORMAT)
|
||||
|
||||
(\CREATE.THROUGH16.EXTERNALFORMAT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (7446 15343 (\EXTERNALFORMAT 7456 . 12055) (MAKE-EXTERNALFORMAT 12057 . 14870) (
|
||||
\EXTERNALFORMAT.DEFPRINT 14872 . 15341)) (15344 18385 (\INSTALL.EXTERNALFORMAT 15354 . 16803) (
|
||||
\REMOVE.EXTERNALFORMAT 16805 . 17636) (FIND-FORMAT 17638 . 18383)) (18628 20078 (SYSTEM-EXTERNALFORMAT
|
||||
18638 . 19586) (MTOSYSSTRING 19588 . 19785) (SYSTOMSTRING 19787 . 20076)) (20442 34717 (\OUTCHAR
|
||||
20452 . 21669) (\INCCODE 21671 . 22824) (\BACKCCODE 22826 . 24505) (\BACKCCODE.EOLC 24507 . 26697) (
|
||||
\PEEKCCODE 26699 . 27024) (\PEEKCCODE.EOLC 27026 . 27405) (\INCCODE.EOLC 27407 . 29206) (
|
||||
\FORMATBYTESTREAM 29208 . 31652) (\CHECKEOLC.CRLF 31654 . 34715)) (34718 38634 (MCCSTOFORMATBYTES
|
||||
34728 . 37127) (FORMATBYTESTOMCCS 37129 . 38632)) (40045 42281 (\NULLDEVICE 40055 . 41957) (
|
||||
\NULL.OPENFILE 41959 . 42279)) (42371 47286 (\CREATE.THROUGH.EXTERNALFORMAT 42381 . 44050) (
|
||||
\CREATE.THROUGH16.EXTERNALFORMAT 44052 . 46243) (\THROUGHIN 46245 . 46669) (\THROUGHBACKCCODE 46671 .
|
||||
46942) (\THROUGHOUTCHARFN 46944 . 47284)))))
|
||||
(FILEMAP (NIL (6706 14360 (\EXTERNALFORMAT 6716 . 11315) (MAKE-EXTERNALFORMAT 11317 . 13887) (
|
||||
\EXTERNALFORMAT.DEFPRINT 13889 . 14358)) (14361 17402 (\INSTALL.EXTERNALFORMAT 14371 . 15820) (
|
||||
\REMOVE.EXTERNALFORMAT 15822 . 16653) (FIND-FORMAT 16655 . 17400)) (17403 17815 (SYSTEM-EXTERNALFORMAT
|
||||
17413 . 17813)) (18164 34141 (\OUTCHAR 18174 . 19391) (\INCCODE 19393 . 20546) (\BACKCCODE 20548 .
|
||||
22227) (\BACKCCODE.EOLC 22229 . 24419) (\PEEKCCODE 24421 . 24746) (\PEEKCCODE.EOLC 24748 . 25127) (
|
||||
\INCCODE.EOLC 25129 . 26928) (\FORMATBYTESTREAM 26930 . 29374) (\FORMATBYTESTRING 29376 . 31076) (
|
||||
\CHECKEOLC.CRLF 31078 . 34139)) (35423 37659 (\NULLDEVICE 35433 . 37335) (\NULL.OPENFILE 37337 . 37657
|
||||
)) (37799 39626 (\CREATE.THROUGH.EXTERNALFORMAT 37809 . 38595) (\THROUGHIN 38597 . 39017) (
|
||||
\THROUGHBACKCCODE 39019 . 39286) (\THROUGHOUTCHARFN 39288 . 39624)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
192
sources/FILEIO
192
sources/FILEIO
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 6-Feb-2026 23:22:00" {WMEDLEY}<sources>FILEIO.;142 166519
|
||||
(FILECREATED "12-Sep-2025 08:19:06" {WMEDLEY}<sources>FILEIO.;141 166968
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS DIRECTORYNAME)
|
||||
:CHANGES-TO (FNS COPYFILE COPYCHARS)
|
||||
|
||||
:PREVIOUS-DATE "12-Sep-2025 08:19:06" {WMEDLEY}<sources>FILEIO.;141)
|
||||
:PREVIOUS-DATE "24-Apr-2025 22:16:47"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>FILEIO.;139)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT FILEIOCOMS)
|
||||
@@ -1985,63 +1986,68 @@ update the map")
|
||||
\CONNECTED.DIRECTORY])
|
||||
|
||||
(DIRECTORYNAME
|
||||
[LAMBDA (DIRNAME STRPTR CREATE?) (* ; "Edited 6-Feb-2026 23:19 by rmk")
|
||||
(* ; "Edited 20-May-92 11:08 by jds")
|
||||
[LAMBDA (DIRNAME STRPTR CREATE?) (* ; "Edited 20-May-92 11:08 by jds")
|
||||
|
||||
(* ;; "Returns connected directory name")
|
||||
(* ;; "Returns connected directory name")
|
||||
|
||||
(DECLARE (GLOBALVARS LOGINHOST/DIR))
|
||||
(CL:WHEN (CL:PATHNAMEP DIRNAME)
|
||||
(SETQ DIRNAME (CL:NAMESTRING DIRNAME)))
|
||||
(PROG (DN FDEV)
|
||||
[SELECTQ DIRNAME
|
||||
(T (* ; "Connected host/dir")
|
||||
(SETQ DN \CONNECTED.DIRECTORY))
|
||||
(NIL (SETQ DN (OR LOGINHOST/DIR '{DSK})))
|
||||
(COND
|
||||
[(AND [SETQ FDEV
|
||||
(LET [(HOST (FILENAMEFIELD DIRNAME 'HOST]
|
||||
(SELCHARQ (NTHCHARCODE DIRNAME 1)
|
||||
(> (* ;
|
||||
"Remove leading > from a subdirectory spec.")
|
||||
(SETQ DIRNAME (SUBSTRING DIRNAME 2)))
|
||||
NIL)
|
||||
(\GETDEVICEFROMHOSTNAME
|
||||
(OR HOST (FILENAMEFIELD [SELCHARQ (NTHCHARCODE DIRNAME 1)
|
||||
((< /)
|
||||
(* ; "Whole directory, use it all.")
|
||||
(SETQ DIRNAME (PACKFILENAME.STRING
|
||||
'DIRECTORY DIRNAME
|
||||
'BODY
|
||||
\CONNECTED.DIRECTORY)))
|
||||
(SELCHARQ (NTHCHARCODE DIRNAME
|
||||
(NCHARS DIRNAME))
|
||||
((> /)
|
||||
(* ;
|
||||
"Remove any trailing > or / from a subdirectory spec.")
|
||||
(SETQ DIRNAME
|
||||
(PACKFILENAME.STRING
|
||||
'SUBDIRECTORY
|
||||
(SUBSTRING DIRNAME 1 -2)
|
||||
'DIRECTORY
|
||||
\CONNECTED.DIRECTORY)))
|
||||
(SETQ DIRNAME (PACKFILENAME.STRING
|
||||
'SUBDIRECTORY DIRNAME
|
||||
'DIRECTORY
|
||||
\CONNECTED.DIRECTORY]
|
||||
'HOST]
|
||||
(SETQ DN (FDEVOP 'DIRECTORYNAMEP FDEV DIRNAME FDEV CREATE?)))
|
||||
(COND
|
||||
((EQ DN T)
|
||||
(SETQ DN (PACKFILENAME.STRING 'HOST (fetch (FDEV DEVICENAME) of FDEV)
|
||||
'DIRECTORY DIRNAME]
|
||||
(T (RETURN]
|
||||
(RETURN (COND
|
||||
((NOT STRPTR)
|
||||
(MKSTRING DN))
|
||||
((EQ STRPTR T)
|
||||
(MKATOM DN))
|
||||
(T (MKSTRING DN])
|
||||
(AND (CL:PATHNAMEP DIRNAME)
|
||||
(SETQ DIRNAME (CL:NAMESTRING DIRNAME)))
|
||||
(SELECTQ (SYSTEMTYPE)
|
||||
(VAX (GETDIRNAME))
|
||||
(D (DECLARE (GLOBALVARS LOGINHOST/DIR))
|
||||
[PROG (DN FDEV)
|
||||
[SELECTQ DIRNAME
|
||||
(T (* ; "Connected host/dir")
|
||||
(SETQ DN \CONNECTED.DIRECTORY))
|
||||
(NIL (SETQ DN (OR LOGINHOST/DIR '{DSK})))
|
||||
(COND
|
||||
[(AND [SETQ FDEV
|
||||
(LET [(HOST (FILENAMEFIELD DIRNAME 'HOST]
|
||||
(SELCHARQ (NTHCHARCODE DIRNAME 1)
|
||||
(> (* ;
|
||||
"Remove leading > from a subdirectory spec.")
|
||||
(SETQ DIRNAME (SUBSTRING DIRNAME 2)))
|
||||
NIL)
|
||||
(\GETDEVICEFROMHOSTNAME
|
||||
(OR HOST (FILENAMEFIELD [SELCHARQ (NTHCHARCODE DIRNAME 1)
|
||||
((< /)
|
||||
(* ; "Whole directory, use it all.")
|
||||
(SETQ DIRNAME
|
||||
(PACKFILENAME.STRING
|
||||
'DIRECTORY DIRNAME
|
||||
'BODY \CONNECTED.DIRECTORY)))
|
||||
(SELCHARQ (NTHCHARCODE DIRNAME
|
||||
(NCHARS DIRNAME))
|
||||
((> /)
|
||||
(* ;
|
||||
"Remove any trailing > or / from a subdirectory spec.")
|
||||
(SETQ DIRNAME
|
||||
(PACKFILENAME.STRING
|
||||
'SUBDIRECTORY
|
||||
(SUBSTRING DIRNAME 1 -2
|
||||
)
|
||||
'DIRECTORY
|
||||
\CONNECTED.DIRECTORY)))
|
||||
(SETQ DIRNAME
|
||||
(PACKFILENAME.STRING
|
||||
'SUBDIRECTORY DIRNAME
|
||||
'DIRECTORY
|
||||
\CONNECTED.DIRECTORY]
|
||||
'HOST]
|
||||
(SETQ DN (FDEVOP 'DIRECTORYNAMEP FDEV DIRNAME FDEV CREATE?)))
|
||||
(COND
|
||||
((EQ DN T)
|
||||
(SETQ DN (PACKFILENAME.STRING 'HOST (fetch (FDEV DEVICENAME)
|
||||
of FDEV)
|
||||
'DIRECTORY DIRNAME]
|
||||
(T (RETURN]
|
||||
(RETURN (COND
|
||||
((NOT STRPTR)
|
||||
(MKSTRING DN))
|
||||
((EQ STRPTR T)
|
||||
(MKATOM DN))
|
||||
(T (MKSTRING DN])
|
||||
(HELP])
|
||||
|
||||
(DIRECTORYNAMEP
|
||||
[LAMBDA (DIRNAME HOSTNAME) (* bvm%: "18-Oct-85 14:38")
|
||||
@@ -3161,39 +3167,39 @@ update the map")
|
||||
(ADDTOVAR LAMA \IS.NOT.RANDACCESSP \ILLEGAL.DEVICEOP STREAMPROP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (27706 31822 (STREAMPROP 27716 . 28150) (GETSTREAMPROP 28152 . 28901) (PUTSTREAMPROP
|
||||
28903 . 31670) (STREAMP 31672 . 31820)) (31865 35244 (\DEFPRINT.BY.NAME 31875 . 33027) (
|
||||
\STREAM.DEFPRINT 33029 . 34937) (\FDEV.DEFPRINT 34939 . 35242)) (35502 40543 (\GETACCESS 35512 . 35966
|
||||
) (\SETACCESS 35968 . 40541)) (60769 66738 (\DEFINEDEVICE 60779 . 63095) (\GETDEVICEFROMNAME 63097 .
|
||||
63570) (\GETDEVICEFROMHOSTNAME 63572 . 64616) (\REMOVEDEVICE 64618 . 65741) (\REMOVEDEVICE.NAMES 65743
|
||||
. 66736)) (66778 94509 (\CLOSEFILE 66788 . 67613) (\DELETEFILE 67615 . 67909) (\DEVICEEVENT 67911 .
|
||||
69681) (\GENERATEFILES 69683 . 70630) (\GENERATENEXTFILE 70632 . 71283) (\GENERATEFILEINFO 71285 .
|
||||
71746) (\GETFILENAME 71748 . 72137) (\GENERIC.OUTFILEP 72139 . 72609) (\OPENFILE 72611 . 75189) (
|
||||
\DO.PARAMS.AT.OPEN 75191 . 79387) (\RENAMEFILE 79389 . 80345) (\REVALIDATEFILE 80347 . 82949) (
|
||||
\PAGED.REVALIDATEFILELST 82951 . 84509) (\PAGED.REVALIDATEFILES 84511 . 86230) (\PAGED.REVALIDATEFILE
|
||||
86232 . 88515) (\BUFFERED.REVALIDATEFILE 88517 . 90803) (\BUFFERED.REVALIDATEFILELST 90805 . 91989) (
|
||||
\PRINT-REVALIDATION-RESULT 91991 . 92833) (\TRUNCATEFILE 92835 . 93226) (\FILE-CONFLICT 93228 . 94507)
|
||||
) (94545 99208 (\GENERATENOFILES 94555 . 96651) (\NULLFILEGENERATOR 96653 . 96897) (\NOFILESNEXTFILEFN
|
||||
96899 . 98890) (\NOFILESINFOFN 98892 . 99206)) (99327 101235 (\FILE.NOT.OPEN 99337 . 99850) (
|
||||
\FILE.WONT.OPEN 99852 . 100180) (\ILLEGAL.DEVICEOP 100182 . 100464) (\IS.NOT.RANDACCESSP 100466 .
|
||||
100912) (\STREAM.NOT.OPEN 100914 . 101233)) (101370 103668 (\FDEVINSTANCE 101380 . 103666)) (104870
|
||||
111841 (CNDIR 104880 . 106185) (DIRECTORYNAME 106187 . 109967) (DIRECTORYNAMEP 109969 . 110585) (
|
||||
HOSTNAMEP 110587 . 111394) (\ADD.CONNECTED.DIR 111396 . 111839)) (111886 140833 (\BACKFILEPTR 111896
|
||||
. 112084) (\BACKPEEKBIN 112086 . 112447) (\BACKBIN 112449 . 112800) (BIN 112802 . 113019) (\BIN
|
||||
113021 . 113298) (\BINS 113300 . 113586) (BOUT 113588 . 113950) (\BOUT 113952 . 114267) (\BOUTS 114269
|
||||
. 114580) (COPYBYTES 114582 . 117914) (COPYCHARS 117916 . 121714) (COPYFILE 121716 . 123076) (
|
||||
\COPYOPENFILE 123078 . 126277) (\INFER.FILE.TYPE 126279 . 127233) (EOFP 127235 . 127532) (FORCEOUTPUT
|
||||
127534 . 127781) (\FLUSH.OPEN.STREAMS 127783 . 128139) (CHARSET 128141 . 129500) (ACCESS-CHARSET
|
||||
129502 . 130139) (GETEOFPTR 130141 . 130391) (GETFILEINFO 130393 . 133586) (\TYPE.FROM.FILETYPE 133588
|
||||
. 134058) (\FILETYPE.FROM.TYPE 134060 . 134239) (GETFILEPTR 134241 . 134493) (SETFILEINFO 134495 .
|
||||
138732) (SETFILEPTR 138734 . 140453) (BOUT16 140455 . 140640) (BIN16 140642 . 140831)) (140936 148116
|
||||
(\GENERIC.BINS 140946 . 141226) (\GENERIC.BOUTS 141228 . 141493) (\GENERIC.RENAMEFILE 141495 . 143743)
|
||||
(\GENERIC.OPENP 143745 . 145060) (\GENERIC.READP 145062 . 146214) (\GENERIC.CHARSET 146216 . 148114))
|
||||
(148117 148456 (\MAP-OPEN-STREAMS 148127 . 148454)) (150311 152391 (\EOF.ACTION 150321 . 150572) (
|
||||
\EOSERROR 150574 . 150767) (\GETEOFPTR 150769 . 150951) (\INCFILEPTR 150953 . 151303) (\PEEKBIN 151305
|
||||
. 151496) (\SETCLOSEDFILELENGTH 151498 . 151832) (\SETEOFPTR 151834 . 152022) (\SETFILEPTR 152024 .
|
||||
152389)) (152392 152934 (\FIXPOUT 152402 . 152702) (\FIXPIN 152704 . 152932)) (152935 153501 (\BOUTEOL
|
||||
152945 . 153499)) (156397 166261 (\BUFFERED.BIN 156407 . 157259) (\BUFFERED.PEEKBIN 157261 . 158043)
|
||||
(\BUFFERED.BOUT 158045 . 158905) (\BUFFERED.BINS 158907 . 162592) (\BUFFERED.BOUTS 162594 . 164395) (
|
||||
\BUFFERED.COPYBYTES 164397 . 166259)))))
|
||||
(FILEMAP (NIL (27752 31868 (STREAMPROP 27762 . 28196) (GETSTREAMPROP 28198 . 28947) (PUTSTREAMPROP
|
||||
28949 . 31716) (STREAMP 31718 . 31866)) (31911 35290 (\DEFPRINT.BY.NAME 31921 . 33073) (
|
||||
\STREAM.DEFPRINT 33075 . 34983) (\FDEV.DEFPRINT 34985 . 35288)) (35548 40589 (\GETACCESS 35558 . 36012
|
||||
) (\SETACCESS 36014 . 40587)) (60815 66784 (\DEFINEDEVICE 60825 . 63141) (\GETDEVICEFROMNAME 63143 .
|
||||
63616) (\GETDEVICEFROMHOSTNAME 63618 . 64662) (\REMOVEDEVICE 64664 . 65787) (\REMOVEDEVICE.NAMES 65789
|
||||
. 66782)) (66824 94555 (\CLOSEFILE 66834 . 67659) (\DELETEFILE 67661 . 67955) (\DEVICEEVENT 67957 .
|
||||
69727) (\GENERATEFILES 69729 . 70676) (\GENERATENEXTFILE 70678 . 71329) (\GENERATEFILEINFO 71331 .
|
||||
71792) (\GETFILENAME 71794 . 72183) (\GENERIC.OUTFILEP 72185 . 72655) (\OPENFILE 72657 . 75235) (
|
||||
\DO.PARAMS.AT.OPEN 75237 . 79433) (\RENAMEFILE 79435 . 80391) (\REVALIDATEFILE 80393 . 82995) (
|
||||
\PAGED.REVALIDATEFILELST 82997 . 84555) (\PAGED.REVALIDATEFILES 84557 . 86276) (\PAGED.REVALIDATEFILE
|
||||
86278 . 88561) (\BUFFERED.REVALIDATEFILE 88563 . 90849) (\BUFFERED.REVALIDATEFILELST 90851 . 92035) (
|
||||
\PRINT-REVALIDATION-RESULT 92037 . 92879) (\TRUNCATEFILE 92881 . 93272) (\FILE-CONFLICT 93274 . 94553)
|
||||
) (94591 99254 (\GENERATENOFILES 94601 . 96697) (\NULLFILEGENERATOR 96699 . 96943) (\NOFILESNEXTFILEFN
|
||||
96945 . 98936) (\NOFILESINFOFN 98938 . 99252)) (99373 101281 (\FILE.NOT.OPEN 99383 . 99896) (
|
||||
\FILE.WONT.OPEN 99898 . 100226) (\ILLEGAL.DEVICEOP 100228 . 100510) (\IS.NOT.RANDACCESSP 100512 .
|
||||
100958) (\STREAM.NOT.OPEN 100960 . 101279)) (101416 103714 (\FDEVINSTANCE 101426 . 103712)) (104916
|
||||
112290 (CNDIR 104926 . 106231) (DIRECTORYNAME 106233 . 110416) (DIRECTORYNAMEP 110418 . 111034) (
|
||||
HOSTNAMEP 111036 . 111843) (\ADD.CONNECTED.DIR 111845 . 112288)) (112335 141282 (\BACKFILEPTR 112345
|
||||
. 112533) (\BACKPEEKBIN 112535 . 112896) (\BACKBIN 112898 . 113249) (BIN 113251 . 113468) (\BIN
|
||||
113470 . 113747) (\BINS 113749 . 114035) (BOUT 114037 . 114399) (\BOUT 114401 . 114716) (\BOUTS 114718
|
||||
. 115029) (COPYBYTES 115031 . 118363) (COPYCHARS 118365 . 122163) (COPYFILE 122165 . 123525) (
|
||||
\COPYOPENFILE 123527 . 126726) (\INFER.FILE.TYPE 126728 . 127682) (EOFP 127684 . 127981) (FORCEOUTPUT
|
||||
127983 . 128230) (\FLUSH.OPEN.STREAMS 128232 . 128588) (CHARSET 128590 . 129949) (ACCESS-CHARSET
|
||||
129951 . 130588) (GETEOFPTR 130590 . 130840) (GETFILEINFO 130842 . 134035) (\TYPE.FROM.FILETYPE 134037
|
||||
. 134507) (\FILETYPE.FROM.TYPE 134509 . 134688) (GETFILEPTR 134690 . 134942) (SETFILEINFO 134944 .
|
||||
139181) (SETFILEPTR 139183 . 140902) (BOUT16 140904 . 141089) (BIN16 141091 . 141280)) (141385 148565
|
||||
(\GENERIC.BINS 141395 . 141675) (\GENERIC.BOUTS 141677 . 141942) (\GENERIC.RENAMEFILE 141944 . 144192)
|
||||
(\GENERIC.OPENP 144194 . 145509) (\GENERIC.READP 145511 . 146663) (\GENERIC.CHARSET 146665 . 148563))
|
||||
(148566 148905 (\MAP-OPEN-STREAMS 148576 . 148903)) (150760 152840 (\EOF.ACTION 150770 . 151021) (
|
||||
\EOSERROR 151023 . 151216) (\GETEOFPTR 151218 . 151400) (\INCFILEPTR 151402 . 151752) (\PEEKBIN 151754
|
||||
. 151945) (\SETCLOSEDFILELENGTH 151947 . 152281) (\SETEOFPTR 152283 . 152471) (\SETFILEPTR 152473 .
|
||||
152838)) (152841 153383 (\FIXPOUT 152851 . 153151) (\FIXPIN 153153 . 153381)) (153384 153950 (\BOUTEOL
|
||||
153394 . 153948)) (156846 166710 (\BUFFERED.BIN 156856 . 157708) (\BUFFERED.PEEKBIN 157710 . 158492)
|
||||
(\BUFFERED.BOUT 158494 . 159354) (\BUFFERED.BINS 159356 . 163041) (\BUFFERED.BOUTS 163043 . 164844) (
|
||||
\BUFFERED.COPYBYTES 164846 . 166708)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
107
sources/FONT
107
sources/FONT
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Feb-2026 00:10:22" {WMEDLEY}<sources>FONT.;674 277477
|
||||
(FILECREATED " 6-Feb-2026 23:44:25" {WMEDLEY}<sources>FONT.;671 276511
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \FONT.CHECKARGS1)
|
||||
:CHANGES-TO (FNS \FINDFONTFILE)
|
||||
|
||||
:PREVIOUS-DATE "14-Feb-2026 13:14:08" {WMEDLEY}<sources>FONT.;673)
|
||||
:PREVIOUS-DATE " 6-Feb-2026 00:24:55" {WMEDLEY}<sources>FONT.;670)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT FONTCOMS)
|
||||
@@ -608,8 +608,7 @@
|
||||
FONTDESC])
|
||||
|
||||
(\FONT.CHECKARGS1
|
||||
[LAMBDA (SPEC STREAM NOERRORFLG) (* ; "Edited 19-Feb-2026 00:03 by rmk")
|
||||
(* ; "Edited 22-Jul-2025 18:47 by rmk")
|
||||
[LAMBDA (SPEC STREAM NOERRORFLG) (* ; "Edited 22-Jul-2025 18:47 by rmk")
|
||||
(* ; "Edited 14-Jul-2025 19:40 by rmk")
|
||||
(* ; "Edited 5-Jul-2025 14:16 by rmk")
|
||||
(* ; "Edited 29-Aug-91 12:19 by jds")
|
||||
@@ -621,8 +620,6 @@
|
||||
(* ;; "STREAM denotes a device: NIL means DISPLAY, another atom is a device name itself, an IMAGESTREAM means its IMAGESTREAMTYPE. Anything else here maps to DISPLAY, but maybe that should be an illegal arg error, even of NOERRORFLG.")
|
||||
|
||||
(DECLARE (GLOBALVARS DEFAULTFONT \GUARANTEEDDISPLAYFONT))
|
||||
(CL:WHEN (IMAGESTREAMP SPEC)
|
||||
(SETQ SPEC (DSPFONT NIL SPEC)))
|
||||
(LET (FONT DEVICE TEMP)
|
||||
(CL:UNLESS SPEC
|
||||
(if DEFAULTFONT
|
||||
@@ -706,8 +703,7 @@
|
||||
(CLOSEF? STRM))))])
|
||||
|
||||
(\READCHARSET
|
||||
[LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 14-Feb-2026 09:47 by rmk")
|
||||
(* ; "Edited 6-Feb-2026 00:03 by rmk")
|
||||
[LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 6-Feb-2026 00:03 by rmk")
|
||||
(* ; "Edited 11-Nov-2025 14:30 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 23:57 by rmk")
|
||||
(* ; "Edited 28-Aug-2025 23:17 by rmk")
|
||||
@@ -727,8 +723,7 @@
|
||||
do
|
||||
(* ;; "We know that FILE exists and is the best source of information about charset--maybe none. We assume FILE is one of the valid formats, we open it separately for each format-type, and ensure it is closed on exit. We can't used CL:WITHOPEN-FILE because that doesn't exist in the loadup when the first font is created.")
|
||||
|
||||
(for FNS FAMILY in [OR (FONTDEVICEPROP FONTSPEC 'CHARSETFNS)
|
||||
'((MEDLEYFONT MEDLEYFONT.FILEP MEDLEYFONT.GETCHARSET]
|
||||
(for FNS FAMILY in (FONTDEVICEPROP FONTSPEC 'CHARSETFNS)
|
||||
do [RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT))
|
||||
`(PROGN (CLOSEF? OLDVALUE]
|
||||
(CL:WHEN (CAR (NLSETQ (APPLY* (CADR FNS)
|
||||
@@ -3501,8 +3496,7 @@
|
||||
FONT])
|
||||
|
||||
(\CREATECHARSET
|
||||
[LAMBDA (CHARSET FONT) (* ; "Edited 14-Feb-2026 13:12 by rmk")
|
||||
(* ; "Edited 25-Sep-2025 21:24 by rmk")
|
||||
[LAMBDA (CHARSET FONT) (* ; "Edited 25-Sep-2025 21:24 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 22:59 by rmk")
|
||||
(* ; "Edited 31-Aug-2025 14:36 by rmk")
|
||||
(* ; "Edited 28-Aug-2025 14:31 by rmk")
|
||||
@@ -3531,16 +3525,11 @@
|
||||
(\ILLEGAL.ARG CHARSET))
|
||||
(LET [(CSINFO (if (fetch (FONTDESCRIPTOR FONTCOMPLETEP) of FONT)
|
||||
then (\GETCHARSETINFO FONT CHARSET)
|
||||
else (APPLY* [OR (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTDESCRIPTOR
|
||||
else (APPLY* (OR (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTDESCRIPTOR
|
||||
FONTDEVICE)
|
||||
of FONT)
|
||||
'CREATECHARSET))
|
||||
(FUNCTION (LAMBDA (FONTSPEC FONT CHARSET)
|
||||
(* ;
|
||||
"No function: read or read-coerced-font")
|
||||
(OR (\READCHARSET FONTSPEC CHARSET FONT)
|
||||
(\READCHARSET (COERCEFONTSPEC FONTSPEC)
|
||||
CHARSET FONT]
|
||||
(FUNCTION \READCHARSET))
|
||||
(create FONTSPEC using (FONTPROP FONT 'DEVICESPEC))
|
||||
FONT CHARSET]
|
||||
|
||||
@@ -4496,43 +4485,43 @@
|
||||
(ADDTOVAR LAMA FONTCOPY)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (11417 21130 (CHARWIDTH 11427 . 12212) (CHARWIDTHY 12214 . 13731) (STRINGWIDTH 13733 .
|
||||
14826) (\CHARWIDTH.DISPLAY 14828 . 15241) (\STRINGWIDTH.DISPLAY 15243 . 15667) (\STRINGWIDTH.GENERIC
|
||||
15669 . 21128)) (21131 27651 (DEFAULTFONT 21141 . 22426) (FONTCLASS 22428 . 24590) (FONTCLASSUNPARSE
|
||||
24592 . 25491) (FONTCLASSCOMPONENT 25493 . 26081) (SETFONTCLASSCOMPONENT 26083 . 26525) (
|
||||
GETFONTCLASSCOMPONENT 26527 . 27649)) (29364 47382 (FONTCREATE 29374 . 32619) (FONTCREATE1 32621 .
|
||||
35236) (FONTCREATE.SLUGFD 35238 . 36720) (\FONT.CHECKARGS1 36722 . 41427) (\FONTCREATE1.NOFN 41429 .
|
||||
41643) (FONTFILEP 41645 . 42533) (\READCHARSET 42535 . 47380)) (47383 54459 (\FONT.CHECKARGS 47393 .
|
||||
54142) (\CHARSET.CHECK 54144 . 54457)) (54460 61071 (COERCEFONTSPEC 54470 . 60382) (
|
||||
COERCEFONTSPEC.TARGETFACE 60384 . 61069)) (63266 64605 (MAKEFONTSPEC 63276 . 64603)) (64606 72783 (
|
||||
COMPLETE.FONT 64616 . 67139) (COMPLETEFONTP 67141 . 67764) (COMPLETE.CHARSET 67766 . 70451) (
|
||||
PRUNESLUGCSINFOS 70453 . 71378) (MONOSPACEFONTP 71380 . 72781)) (72822 81268 (FONTASCENT 72832 . 73216
|
||||
) (FONTDESCENT 73218 . 73703) (FONTHEIGHT 73705 . 74107) (FONTPROP 74109 . 80545) (\AVGCHARWIDTH 80547
|
||||
. 81266)) (81925 82833 (FONTDEVICEPROP 81935 . 82831)) (82879 83733 (EDITCHAR 82889 . 83731)) (83779
|
||||
95969 (GETCHARBITMAP 83789 . 84913) (PUTCHARBITMAP 84915 . 87073) (\GETCHARBITMAP.CSINFO 87075 . 89091
|
||||
) (\PUTCHARBITMAP.CSINFO 89093 . 95967)) (95970 116450 (MOVECHARBITMAP 95980 . 97874) (MOVEFONTCHARS
|
||||
97876 . 101836) (\MOVEFONTCHAR 101838 . 106681) (\MOVEFONTCHARS.SOURCEDATA 106683 . 112788) (
|
||||
\MAKESLUGCHAR 112790 . 115325) (SLUGCHARP.DISPLAY 115327 . 116448)) (117108 128945 (FONTFILES 117118
|
||||
. 118951) (\FINDFONTFILE 118953 . 120930) (\FONTFILENAMES 120932 . 121492) (\FONTFILENAME 121494 .
|
||||
124405) (FONTSPECFROMFILENAME 124407 . 128943)) (128946 165521 (FONTCOPY 128956 . 134019) (FONTP
|
||||
134021 . 134320) (FONTUNPARSE 134322 . 136041) (SETFONTDESCRIPTOR 136043 . 137507) (\STREAMCHARWIDTH
|
||||
137509 . 141673) (\COERCECHARSET 141675 . 145042) (\BUILDSLUGCSINFO 145044 . 148667) (\FONTSYMBOL
|
||||
148669 . 149319) (\DEVICESYMBOL 149321 . 150190) (\FONTFACE 150192 . 157382) (\FONTFACE.COLOR 157384
|
||||
. 164304) (SETFONTCHARENCODING 164306 . 165519)) (165522 185183 (FONTSAVAILABLE 165532 . 170886) (
|
||||
FONTEXISTS? 170888 . 174427) (\SEARCHFONTFILES 174429 . 177514) (FLUSHFONTCACHE 177516 . 179739) (
|
||||
FINDFONTFILES 179741 . 182955) (SORTFONTSPECS 182957 . 185181)) (185184 189291 (MATCHFONTFACE 185194
|
||||
. 186009) (MAKEFONTFACE 186011 . 187037) (FONTFACETOATOM 187039 . 189289)) (189922 190414 (
|
||||
\UNITWIDTHSVECTOR 189932 . 190412)) (205043 207110 (FONTDESCRIPTOR.DEFPRINT 205053 . 206632) (
|
||||
FONTCLASS.DEFPRINT 206634 . 207108)) (210939 213729 (\CREATEKERNELEMENT 210949 . 211307) (
|
||||
\FSETLEFTKERN 211309 . 211800) (\FGETLEFTKERN 211802 . 213727)) (213730 225378 (\CREATEFONT 213740 .
|
||||
216618) (\CREATECHARSET 216620 . 221129) (\INSTALLCHARSETINFO 221131 . 224465) (
|
||||
\INSTALLCHARSETINFO.CHARENCODING 224467 . 225376)) (225700 227064 (\FONTRESETCHARWIDTHS 225710 .
|
||||
227062)) (227694 237735 (\CREATEDISPLAYFONT 227704 . 229553) (\CREATECHARSET.DISPLAY 229555 . 235264)
|
||||
(\FONTEXISTS?.DISPLAY 235266 . 237733)) (237736 252601 (STRIKEFONT.FILEP 237746 . 238634) (
|
||||
STRIKEFONT.GETCHARSET 238636 . 244228) (WRITESTRIKEFONTFILE 244230 . 249141) (STRIKECSINFO 249143 .
|
||||
252599)) (252632 268949 (MAKEBOLD.CHARSET 252642 . 256291) (MAKEBOLD.CHAR 256293 . 258045) (
|
||||
MAKEITALIC.CHARSET 258047 . 261720) (MAKEITALIC.CHAR 261722 . 264068) (\SFMAKEBOLD 264070 . 266294) (
|
||||
\SFMAKEITALIC 266296 . 268947)) (268950 273099 (\SFMAKEROTATEDFONT 268960 . 270361) (\SFROTATECSINFO
|
||||
270363 . 271000) (\SFROTATEFONTCHARACTERS 271002 . 271382) (\SFROTATECSINFOOFFSETS 271384 . 273097)) (
|
||||
273100 274481 (\SFMAKECOLOR 273110 . 274479)))))
|
||||
(FILEMAP (NIL (11414 21127 (CHARWIDTH 11424 . 12209) (CHARWIDTHY 12211 . 13728) (STRINGWIDTH 13730 .
|
||||
14823) (\CHARWIDTH.DISPLAY 14825 . 15238) (\STRINGWIDTH.DISPLAY 15240 . 15664) (\STRINGWIDTH.GENERIC
|
||||
15666 . 21125)) (21128 27648 (DEFAULTFONT 21138 . 22423) (FONTCLASS 22425 . 24587) (FONTCLASSUNPARSE
|
||||
24589 . 25488) (FONTCLASSCOMPONENT 25490 . 26078) (SETFONTCLASSCOMPONENT 26080 . 26522) (
|
||||
GETFONTCLASSCOMPONENT 26524 . 27646)) (29361 46989 (FONTCREATE 29371 . 32616) (FONTCREATE1 32618 .
|
||||
35233) (FONTCREATE.SLUGFD 35235 . 36717) (\FONT.CHECKARGS1 36719 . 41242) (\FONTCREATE1.NOFN 41244 .
|
||||
41458) (FONTFILEP 41460 . 42348) (\READCHARSET 42350 . 46987)) (46990 54066 (\FONT.CHECKARGS 47000 .
|
||||
53749) (\CHARSET.CHECK 53751 . 54064)) (54067 60678 (COERCEFONTSPEC 54077 . 59989) (
|
||||
COERCEFONTSPEC.TARGETFACE 59991 . 60676)) (62873 64212 (MAKEFONTSPEC 62883 . 64210)) (64213 72390 (
|
||||
COMPLETE.FONT 64223 . 66746) (COMPLETEFONTP 66748 . 67371) (COMPLETE.CHARSET 67373 . 70058) (
|
||||
PRUNESLUGCSINFOS 70060 . 70985) (MONOSPACEFONTP 70987 . 72388)) (72429 80875 (FONTASCENT 72439 . 72823
|
||||
) (FONTDESCENT 72825 . 73310) (FONTHEIGHT 73312 . 73714) (FONTPROP 73716 . 80152) (\AVGCHARWIDTH 80154
|
||||
. 80873)) (81532 82440 (FONTDEVICEPROP 81542 . 82438)) (82486 83340 (EDITCHAR 82496 . 83338)) (83386
|
||||
95576 (GETCHARBITMAP 83396 . 84520) (PUTCHARBITMAP 84522 . 86680) (\GETCHARBITMAP.CSINFO 86682 . 88698
|
||||
) (\PUTCHARBITMAP.CSINFO 88700 . 95574)) (95577 116057 (MOVECHARBITMAP 95587 . 97481) (MOVEFONTCHARS
|
||||
97483 . 101443) (\MOVEFONTCHAR 101445 . 106288) (\MOVEFONTCHARS.SOURCEDATA 106290 . 112395) (
|
||||
\MAKESLUGCHAR 112397 . 114932) (SLUGCHARP.DISPLAY 114934 . 116055)) (116715 128552 (FONTFILES 116725
|
||||
. 118558) (\FINDFONTFILE 118560 . 120537) (\FONTFILENAMES 120539 . 121099) (\FONTFILENAME 121101 .
|
||||
124012) (FONTSPECFROMFILENAME 124014 . 128550)) (128553 165128 (FONTCOPY 128563 . 133626) (FONTP
|
||||
133628 . 133927) (FONTUNPARSE 133929 . 135648) (SETFONTDESCRIPTOR 135650 . 137114) (\STREAMCHARWIDTH
|
||||
137116 . 141280) (\COERCECHARSET 141282 . 144649) (\BUILDSLUGCSINFO 144651 . 148274) (\FONTSYMBOL
|
||||
148276 . 148926) (\DEVICESYMBOL 148928 . 149797) (\FONTFACE 149799 . 156989) (\FONTFACE.COLOR 156991
|
||||
. 163911) (SETFONTCHARENCODING 163913 . 165126)) (165129 184790 (FONTSAVAILABLE 165139 . 170493) (
|
||||
FONTEXISTS? 170495 . 174034) (\SEARCHFONTFILES 174036 . 177121) (FLUSHFONTCACHE 177123 . 179346) (
|
||||
FINDFONTFILES 179348 . 182562) (SORTFONTSPECS 182564 . 184788)) (184791 188898 (MATCHFONTFACE 184801
|
||||
. 185616) (MAKEFONTFACE 185618 . 186644) (FONTFACETOATOM 186646 . 188896)) (189529 190021 (
|
||||
\UNITWIDTHSVECTOR 189539 . 190019)) (204650 206717 (FONTDESCRIPTOR.DEFPRINT 204660 . 206239) (
|
||||
FONTCLASS.DEFPRINT 206241 . 206715)) (210546 213336 (\CREATEKERNELEMENT 210556 . 210914) (
|
||||
\FSETLEFTKERN 210916 . 211407) (\FGETLEFTKERN 211409 . 213334)) (213337 224412 (\CREATEFONT 213347 .
|
||||
216225) (\CREATECHARSET 216227 . 220163) (\INSTALLCHARSETINFO 220165 . 223499) (
|
||||
\INSTALLCHARSETINFO.CHARENCODING 223501 . 224410)) (224734 226098 (\FONTRESETCHARWIDTHS 224744 .
|
||||
226096)) (226728 236769 (\CREATEDISPLAYFONT 226738 . 228587) (\CREATECHARSET.DISPLAY 228589 . 234298)
|
||||
(\FONTEXISTS?.DISPLAY 234300 . 236767)) (236770 251635 (STRIKEFONT.FILEP 236780 . 237668) (
|
||||
STRIKEFONT.GETCHARSET 237670 . 243262) (WRITESTRIKEFONTFILE 243264 . 248175) (STRIKECSINFO 248177 .
|
||||
251633)) (251666 267983 (MAKEBOLD.CHARSET 251676 . 255325) (MAKEBOLD.CHAR 255327 . 257079) (
|
||||
MAKEITALIC.CHARSET 257081 . 260754) (MAKEITALIC.CHAR 260756 . 263102) (\SFMAKEBOLD 263104 . 265328) (
|
||||
\SFMAKEITALIC 265330 . 267981)) (267984 272133 (\SFMAKEROTATEDFONT 267994 . 269395) (\SFROTATECSINFO
|
||||
269397 . 270034) (\SFROTATEFONTCHARACTERS 270036 . 270416) (\SFROTATECSINFOOFFSETS 270418 . 272131)) (
|
||||
272134 273515 (\SFMAKECOLOR 272144 . 273513)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
1485
sources/IOCHAR
1485
sources/IOCHAR
File diff suppressed because it is too large
Load Diff
Binary file not shown.
140
sources/LLSUBRS
140
sources/LLSUBRS
@@ -1,13 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "13-Sep-2021 17:12:03" {DSK}<Users>briggs>Projects>medley>sources>LLSUBRS.;8 27017
|
||||
|
||||
(FILECREATED " 5-Feb-2026 23:25:59" {WMEDLEY}<sources>LLSUBRS.;18 26279
|
||||
changes to%: (VARS \INITSUBRS)
|
||||
(FNS WRITECALLSUBRS)
|
||||
|
||||
:EDIT-BY rmk
|
||||
previous date%: "13-Sep-2021 16:07:08" {DSK}<VAR>TMP>LLSUBRS.;1)
|
||||
|
||||
:CHANGES-TO (FNS UNIX-GETENV UNIX-USERNAME UNIX-FULLNAME UNIX-GETPARM)
|
||||
|
||||
:PREVIOUS-DATE " 5-Feb-2026 18:13:25" {WMEDLEY}<sources>LLSUBRS.;11)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983-1986, 1988-1992, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LLSUBRSCOMS)
|
||||
|
||||
@@ -92,9 +94,9 @@
|
||||
,@ARGS])
|
||||
|
||||
(DEFOPTIMIZER MISCN (NAME &REST ARGS)
|
||||
`((OPCODES MISCN ,(MISCN-NUMBER NAME)
|
||||
,(LENGTH ARGS))
|
||||
,@ARGS))
|
||||
`((OPCODES MISCN ,(MISCN-NUMBER NAME)
|
||||
,(LENGTH ARGS))
|
||||
,@ARGS))
|
||||
(DEFINEQ
|
||||
|
||||
(MISCN-NUMBER
|
||||
@@ -188,15 +190,25 @@
|
||||
(SETQ \MISCN-TABLE BASE])
|
||||
)
|
||||
|
||||
(PUTPROPS MISCN ARGNAMES ("NAME" &REST "ARGS"))
|
||||
(PUTPROPS MISCN ARGNAMES (NAME &REST ARGS))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD MISCN-UFN-SPEC (NAME INDEX UFN-NAME MVS))
|
||||
(RECORD MISCN-UFN-SPEC (
|
||||
(* ;;
|
||||
"This is the description for a MISCN opcode's UFN, as placed in \MISCN-TABLE-LIST.")
|
||||
|
||||
NAME (* ;
|
||||
"Name of the MISCN, for the MISCN macro's use.")
|
||||
INDEX (* ; "Sub-opcode index.")
|
||||
UFN-NAME (* ; "Name of the UFN")
|
||||
MVS (* ;
|
||||
"T if the UFN can returnmultiple values. If this is NIL, MVs WILL NOT BE PRESERVED.")
|
||||
))
|
||||
|
||||
(BLOCKRECORD MISCN-UFN-ENTRY ((MISCN-MVS FLAG)
|
||||
(NIL BITS 3)
|
||||
(MISCN-UFN POINTER)))
|
||||
(NIL BITS 3)
|
||||
(MISCN-UFN POINTER)))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -206,7 +218,7 @@
|
||||
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")
|
||||
(RPAQQ \USER-SUBR-LIST ((DUMMY 10 DUMMY-UFN)
|
||||
(SAMPLE-USER-SUBR 0 SAMPLE-USER-SUBR-UFN)))
|
||||
(SAMPLE-USER-SUBR 0 SAMPLE-USER-SUBR-UFN)))
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
@@ -221,7 +233,7 @@
|
||||
(* ;; "Make Sure \USER-SUBR-TABLE is made")
|
||||
|
||||
(IF (NOT (AND (BOUNDP '\USER-SUBR-TABLE)
|
||||
\USER-SUBR-TABLE))
|
||||
\USER-SUBR-TABLE))
|
||||
THEN (\INIT-USER-SUBR-TABLE))
|
||||
|
||||
(* ;; "See if the Name is already defined")
|
||||
@@ -438,9 +450,9 @@
|
||||
,@ARGS])
|
||||
|
||||
(DEFOPTIMIZER SUBRCALL (NAME &REST ARGS)
|
||||
`((OPCODES SUBRCALL ,(SUBRNUMBER NAME)
|
||||
,(LENGTH ARGS))
|
||||
,@ARGS))
|
||||
`((OPCODES SUBRCALL ,(SUBRNUMBER NAME)
|
||||
,(LENGTH ARGS))
|
||||
,@ARGS))
|
||||
(DEFINEQ
|
||||
|
||||
(SUBRNUMBER
|
||||
@@ -600,51 +612,52 @@
|
||||
else NIL])
|
||||
|
||||
(UNIX-USERNAME
|
||||
[LAMBDA NIL (* ; "Edited 5-Feb-2026 23:24 by rmk")
|
||||
(* ; "Edited 1-Aug-88 23:22 by masinter")
|
||||
(WITH-RESOURCE UNIXSTRING (CL:WHEN (SUBRCALL UNIX-USERNAME UNIXSTRING)
|
||||
(SYSTOMSTRING (SUBSTRING UNIXSTRING 1 (CL:POSITION #\Null
|
||||
UNIXSTRING))))])
|
||||
[LAMBDA NIL (* ; "Edited 1-Aug-88 23:22 by masinter")
|
||||
(if (EQ \MACHINETYPE \MAIKO)
|
||||
then (WITH-RESOURCE UNIXSTRING (if (SUBRCALL UNIX-USERNAME UNIXSTRING)
|
||||
then (CONCAT (SUBSTRING UNIXSTRING 1
|
||||
(CL:POSITION #\Null UNIXSTRING
|
||||
])
|
||||
|
||||
(UNIX-FULLNAME
|
||||
[LAMBDA NIL (* ; "Edited 5-Feb-2026 23:24 by rmk")
|
||||
(* ; "Edited 18-Jul-88 03:47 by masinter")
|
||||
(WITH-RESOURCES UNIXSTRING (CL:WHEN (SUBRCALL UNIX-FULLNAME UNIXSTRING)
|
||||
(SYSTOMSTRING (SUBSTRING UNIXSTRING 1 (CL:POSITION #\Null
|
||||
UNIXSTRING))))])
|
||||
[LAMBDA NIL (* ; "Edited 18-Jul-88 03:47 by masinter")
|
||||
(if (EQ \MACHINETYPE \MAIKO)
|
||||
then (WITH-RESOURCES UNIXSTRING (if (SUBRCALL UNIX-FULLNAME UNIXSTRING)
|
||||
then (CONCAT (SUBSTRING UNIXSTRING 1
|
||||
(CL:POSITION #\Null
|
||||
UNIXSTRING])
|
||||
|
||||
(UNIX-GETENV
|
||||
[LAMBDA (NAME) (* ; "Edited 5-Feb-2026 23:25 by rmk")
|
||||
(* ; "Edited 31-Jan-2026 22:28 by rmk")
|
||||
(* ; "Edited 21-Feb-2021 21:09 by larry")
|
||||
(WITH-RESOURCES UNIXSTRING
|
||||
(CL:WHEN (SUBRCALL UNIX-GETENV (MTOSYSSTRING NAME)
|
||||
UNIXSTRING)
|
||||
[SYSTOMSTRING (SUBSTRING UNIXSTRING 1
|
||||
(for I from 1
|
||||
do (if (FMEMB (NTHCHARCODE UNIXSTRING I)
|
||||
'(0 NIL))
|
||||
then (RETURN (SUB1 I])])
|
||||
[LAMBDA (NAME) (* ; "Edited 21-Feb-2021 21:09 by larry")
|
||||
(WITH-RESOURCES
|
||||
UNIXSTRING
|
||||
(LET ((X UNIXSTRING))
|
||||
(if (SUBRCALL UNIX-GETENV (MKSTRING NAME)
|
||||
X)
|
||||
then (CONCAT (SUBSTRING X 1 (for I from 1
|
||||
do (if (FMEMB (NTHCHARCODE X I)
|
||||
'(0 NIL))
|
||||
then (RETURN (SUB1 I])
|
||||
|
||||
(UNIX-GETPARM
|
||||
[LAMBDA (NAME) (* ; "Edited 5-Feb-2026 23:21 by rmk")
|
||||
(* ; "Edited 27-Feb-91 17:11 by nm")
|
||||
[LAMBDA (NAME) (* ; "Edited 27-Feb-91 17:11 by nm")
|
||||
|
||||
(* ;; "Read information from the C emulator. Usually gets info about configuration of the machine we're running on.")
|
||||
|
||||
(* ;;
|
||||
"Used to use CL:POSITION, but now called in the INIT if you're on a Sun, so I changed it to STRPOS.")
|
||||
"Used to use CL:POSITION, but now called in the INIT if you're on a Sun, so I changed it to STRPOS.")
|
||||
|
||||
(* ;; "SUBRCALL UNIX-GETPARM now returns the length of the string.")
|
||||
|
||||
(LET (LEN)
|
||||
(WITH-RESOURCE UNIXSTRING (SETQ LEN (SUBRCALL UNIX-GETPARM (MTOSYSSTRING NAME)
|
||||
UNIXSTRING))
|
||||
(COND
|
||||
[(SMALLP LEN)
|
||||
(if (> LEN 0)
|
||||
then (SYSTOMSTRING (SUBSTRING UNIXSTRING 1 LEN]
|
||||
(LEN (SYSTOMSTRING (SUBSTRING UNIXSTRING 1 (SUB1 (STRPOS #\Null UNIXSTRING])
|
||||
(if (EQ \MACHINETYPE \MAIKO)
|
||||
then (LET (LEN)
|
||||
(WITH-RESOURCE UNIXSTRING (SETQ LEN (SUBRCALL UNIX-GETPARM (MKSTRING NAME)
|
||||
UNIXSTRING))
|
||||
(COND
|
||||
[(SMALLP LEN)
|
||||
(if (> LEN 0)
|
||||
then (CONCAT (SUBSTRING UNIXSTRING 1 LEN]
|
||||
(LEN (CONCAT (SUBSTRING UNIXSTRING 1 (SUB1 (STRPOS #\Null UNIXSTRING])
|
||||
)
|
||||
|
||||
(PUTPROPS SHOWDISPLAY ARGNAMES (BASE RASTERWIDTH))
|
||||
@@ -671,19 +684,20 @@
|
||||
|
||||
(PUTPROPS \CHECKBCPLPASSWORD ARGNAMES (PASS CL:VECTOR))
|
||||
|
||||
(PUTPROPS LLSUBRS FILETYPE :FAKE-COMPILE-FILE)
|
||||
(PUTPROPS LLSUBRS FILETYPE CL:COMPILE-FILE)
|
||||
(PUTPROPS LLSUBRS COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1988 1989 1990 1991 1992
|
||||
2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2955 3362 (MISCN 2955 . 3362)) (3544 8288 (MISCN-NUMBER 3554 . 3770) (\MISCN.UFN 3772
|
||||
. 6029) (\UNDEFINED-MISCN-UFN 6031 . 6347) (MISCN-COLLECT 6349 . 6566) (\GET-MY-BF 6568 . 6780) (
|
||||
\INIT-MISCN-TABLE 6782 . 8286)) (8844 8979 (USER-SUBR 8844 . 8979)) (8981 10266 (ADD-USER-SUBR 8981 .
|
||||
10266)) (10267 12018 (\USER-SUBR-UFN 10277 . 10852) (\INIT-USER-SUBR-TABLE 10854 . 11319) (
|
||||
\UNDEFINED-USER-SUBR-UFN 11321 . 11664) (USER-SUBR-NUMBER 11666 . 11888) (EQ-TO-CAR 11890 . 11951) (
|
||||
EQ-TO-CADR 11953 . 12016)) (15683 16094 (SUBRCALL 15683 . 16094)) (16289 16938 (SUBRNUMBER 16299 .
|
||||
16936)) (16999 19302 (WRITECALLSUBRS 17009 . 18545) (FIX-SUBR-NAME 18547 . 19300)) (19511 25586 (
|
||||
\MOREVMEMFILE 19521 . 19686) (\WRITEMAP 19688 . 19848) (\COPYSYS0SUBR 19850 . 20010) (\PUPLEVEL1STATE
|
||||
20012 . 20176) (SHOWDISPLAY 20178 . 20467) (SETSCREENCOLOR 20469 . 20632) (\WRITERAWPBI 20634 . 20792)
|
||||
(\READRAWPBI 20794 . 20946) (RAID 20948 . 21103) (\LISPFINISH 21105 . 21263) (\GETPACKETBUFFER 21265
|
||||
. 21427) (\GATHERSTATS 21429 . 21587) (\DSPRATE 21589 . 21856) (DSPBOUT 21858 . 22012) (DISKPARTITION
|
||||
22014 . 22309) (\CHECKBCPLPASSWORD 22311 . 22490) (SUSPEND-LISP 22492 . 22750) (UNIX-USERNAME 22752
|
||||
. 23256) (UNIX-FULLNAME 23258 . 23765) (UNIX-GETENV 23767 . 24583) (UNIX-GETPARM 24585 . 25584)))))
|
||||
(FILEMAP (NIL (3639 8383 (MISCN-NUMBER 3649 . 3865) (\MISCN.UFN 3867 . 6124) (\UNDEFINED-MISCN-UFN
|
||||
6126 . 6442) (MISCN-COLLECT 6444 . 6661) (\GET-MY-BF 6663 . 6875) (\INIT-MISCN-TABLE 6877 . 8381)) (
|
||||
9767 11056 (ADD-USER-SUBR 9767 . 11056)) (11057 12808 (\USER-SUBR-UFN 11067 . 11642) (
|
||||
\INIT-USER-SUBR-TABLE 11644 . 12109) (\UNDEFINED-USER-SUBR-UFN 12111 . 12454) (USER-SUBR-NUMBER 12456
|
||||
. 12678) (EQ-TO-CAR 12680 . 12741) (EQ-TO-CADR 12743 . 12806)) (17091 17740 (SUBRNUMBER 17101 . 17738
|
||||
)) (17801 20104 (WRITECALLSUBRS 17811 . 19347) (FIX-SUBR-NAME 19349 . 20102)) (20313 26217 (
|
||||
\MOREVMEMFILE 20323 . 20488) (\WRITEMAP 20490 . 20650) (\COPYSYS0SUBR 20652 . 20812) (\PUPLEVEL1STATE
|
||||
20814 . 20978) (SHOWDISPLAY 20980 . 21269) (SETSCREENCOLOR 21271 . 21434) (\WRITERAWPBI 21436 . 21594)
|
||||
(\READRAWPBI 21596 . 21748) (RAID 21750 . 21905) (\LISPFINISH 21907 . 22065) (\GETPACKETBUFFER 22067
|
||||
. 22229) (\GATHERSTATS 22231 . 22389) (\DSPRATE 22391 . 22658) (DSPBOUT 22660 . 22814) (DISKPARTITION
|
||||
22816 . 23111) (\CHECKBCPLPASSWORD 23113 . 23292) (SUSPEND-LISP 23294 . 23552) (UNIX-USERNAME 23554
|
||||
. 24076) (UNIX-FULLNAME 24078 . 24604) (UNIX-GETENV 24606 . 25203) (UNIX-GETPARM 25205 . 26215)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
265
sources/MCCS
265
sources/MCCS
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Feb-2026 15:58:32" {WMEDLEY}<sources>MCCS.;163 65441
|
||||
(FILECREATED "17-Oct-2025 08:50:00" {WMEDLEY}<sources>MCCS.;155 57020
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \DUMMY-UTF8-FORMAT \CREATE.XCCS.EXTERNALFORMAT)
|
||||
:CHANGES-TO (VARS MCCSCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 5-Feb-2026 12:26:39" {WMEDLEY}<sources>MCCS.;161)
|
||||
:PREVIOUS-DATE "15-Oct-2025 18:31:01" {WMEDLEY}<sources>MCCS.;154)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MCCSCOMS)
|
||||
@@ -17,14 +17,14 @@
|
||||
|
||||
(FNS \MCCSINCCODE \MCCSPEEKCCODE \MCCSOUTCHAR \MCCSBACKCCODE \MCCSFORMATBYTESTREAM
|
||||
\MCCSCHARSETFN)
|
||||
(FNS \CREATE.MCCS.EXTERNALFORMAT \CREATE.XCCS.EXTERNALFORMAT)
|
||||
(FNS \CREATE.MCCS.EXTERNALFORMAT)
|
||||
(FNS \MCCS.24BITENCODING.ERROR)
|
||||
(INITVARS (*SIGNAL-MCCS.24BITENCODING.ERROR*))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (CONSTANTS (\NORUNCODE 255)
|
||||
(NSCHARSETSHIFT 255))
|
||||
(MACROS \RUNCODED)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.MCCS.EXTERNALFORMAT :MCCS)
|
||||
(\CREATE.XCCS.EXTERNALFORMAT :XCCS)))
|
||||
(\CREATE.MCCS.EXTERNALFORMAT :XCCS)))
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -57,14 +57,7 @@
|
||||
"Mappings into MCCS: needed for hardcopy and Tedit coercion, e.g. \TEDIT.MCCS.TRANSLATE")
|
||||
|
||||
(FNS GACHATOMCODE SYMBOLTOMCODE SIGMATOMCODE ATOMCODE MATHTOMCODE HIPPOTOMCODE
|
||||
CYRILLICTOMCODE PALATINOTOMCODE)))
|
||||
(COMS (* ; "ISO8859/1")
|
||||
(FNS ISO1TOMCODE MTOISO1CODE \CREATE.ISO1.FORMAT \DUMMY-UTF8-FORMAT)
|
||||
(FNS ISO1TOMSTRING MTOISO1STRING)
|
||||
(VARS ISO1TOMCCS)
|
||||
(GLOBALVARS ISO1TOMCCS)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.ISO1.FORMAT)
|
||||
(\DUMMY-UTF8-FORMAT])
|
||||
CYRILLICTOMCODE PALATINOTOMCODE])
|
||||
|
||||
|
||||
|
||||
@@ -298,33 +291,6 @@
|
||||
(FUNCTION \MCCSFORMATBYTESTREAM)
|
||||
(OR EOL 'LF)
|
||||
T NIL NIL (FUNCTION \MCCSCHARSETFN])
|
||||
|
||||
(\CREATE.XCCS.EXTERNALFORMAT
|
||||
[LAMBDA (NAME EOL) (* ; "Edited 5-Feb-2026 15:54 by rmk")
|
||||
(* ; "Edited 1-Feb-2026 12:22 by rmk")
|
||||
(* ; "Edited 23-Apr-2025 14:19 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 23:03 by rmk")
|
||||
(* ; "Edited 30-Jun-2022 18:08 by rmk")
|
||||
(* ; "Edited 10-Sep-2021 19:49 by rmk:")
|
||||
|
||||
(* ;;; "Create the :XCCS external format. Stream's EOL overrides the (vacuous) default here. Just like :MCCS except for switch of underscore-circumflex/arrows.")
|
||||
|
||||
(MAKE-EXTERNALFORMAT (OR NAME :XCCS)
|
||||
[FUNCTION (LAMBDA (STREAM COUNTP)
|
||||
(XTOMCODE (\MCCSINCCODE STREAM COUNTP]
|
||||
[FUNCTION (LAMBDA (STREAM NOERROR)
|
||||
(XTOMCODE (\MCCSPEEKCCODE STREAM NOERROR]
|
||||
[FUNCTION (LAMBDA (STREAM COUNTP)
|
||||
(XTOMCODE (\MCCSBACKCCODE STREAM COUNTP]
|
||||
[FUNCTION (LAMBDA (STREAM CHARCODE)
|
||||
(\MCCSOUTCHAR STREAM (MTOXCODE CHARCODE]
|
||||
(FUNCTION \MCCSFORMATBYTESTREAM)
|
||||
(OR EOL 'LF)
|
||||
T
|
||||
(FUNCTION MTOXSTRING)
|
||||
NIL
|
||||
(FUNCTION \MCCSCHARSETFN)
|
||||
(FUNCTION XTOMSTRING])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -372,7 +338,7 @@
|
||||
|
||||
(\CREATE.MCCS.EXTERNALFORMAT :MCCS)
|
||||
|
||||
(\CREATE.XCCS.EXTERNALFORMAT :XCCS)
|
||||
(\CREATE.MCCS.EXTERNALFORMAT :XCCS)
|
||||
)
|
||||
|
||||
|
||||
@@ -1280,9 +1246,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MCCSCODEMAPARRAY
|
||||
[LAMBDA (MAP INVERT) (* ; "Edited 5-Feb-2026 11:02 by rmk")
|
||||
(* ; "Edited 2-Feb-2026 23:11 by rmk")
|
||||
(* ; "Edited 6-Sep-2025 18:26 by rmk")
|
||||
[LAMBDA (MAP) (* ; "Edited 6-Sep-2025 18:26 by rmk")
|
||||
(* ; "Edited 31-Aug-2025 16:15 by rmk")
|
||||
(* ; "Edited 7-Aug-2025 08:55 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 11:45 by rmk")
|
||||
@@ -1296,28 +1260,19 @@
|
||||
(XCCS (SETQ MAP (APPEND MTOXCODEMAP ALTOTEXT2MCCS)))
|
||||
(MCCS (SETQ MAP ALTOTEXT2MCCS))
|
||||
NIL)
|
||||
(LET ((ARRAY (ARRAY (ADD1 \MAXTHINCHAR)
|
||||
'WORD 0 0))
|
||||
HARRAY)
|
||||
(for I from 0 to \MAXTHINCHAR do (SETA ARRAY I I)) (* ; "Default")
|
||||
(LET ((TABLE (ARRAY (ADD1 \MAXTHINCHAR)
|
||||
'WORD 0 0)))
|
||||
(for I from 0 to \MAXTHINCHAR do (SETA TABLE I I))
|
||||
[for PAIR FROMCODE in MAP when (LISTP PAIR) unless (EQ '* (CAR PAIR))
|
||||
when (SETQ FROMCODE (OR (CHARCODEP (CAR PAIR))
|
||||
when (SETQ FROMCODE (CL:IF (CHARCODEP (CAR PAIR))
|
||||
(CAR PAIR)
|
||||
(CHARCODE.DECODE (CAR PAIR)
|
||||
T))) do (SETA ARRAY FROMCODE (OR (CHARCODEP (CADR PAIR))
|
||||
T))) do (SETA TABLE FROMCODE (CL:IF (CHARCODEP
|
||||
(CADR PAIR))
|
||||
(CADR PAIR)
|
||||
(CHARCODE.DECODE
|
||||
(CADR PAIR]
|
||||
(CL:WHEN INVERT
|
||||
(SETQ HARRAY (HASHARRAY 20))
|
||||
(for I from 0 to \MAXTHINCHAR do (PUTHASH I I HARRAY))
|
||||
(for PAIR FROMCODE in MAP when (LISTP PAIR) unless (EQ '* (CAR PAIR))
|
||||
do (PUTHASH (OR (CHARCODEP (CADR PAIR))
|
||||
(CHARCODE.DECODE (CADR PAIR)))
|
||||
(OR (CHARCODEP (CAR PAIR))
|
||||
(CHARCODE.DECODE (CAR PAIR)))
|
||||
HARRAY)))
|
||||
(CL:IF HARRAY
|
||||
(LIST ARRAY HARRAY)
|
||||
ARRAY)])
|
||||
(CADR PAIR)))]
|
||||
TABLE])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -1541,178 +1496,16 @@
|
||||
MCODE)))
|
||||
PCODE])
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ; "ISO8859/1")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(ISO1TOMCODE
|
||||
[LAMBDA (ICODE) (* ; "Edited 5-Feb-2026 12:09 by rmk")
|
||||
(* ; "Edited 2-Feb-2026 23:14 by rmk")
|
||||
(* ; "Edited 7-Sep-2025 22:39 by rmk")
|
||||
(* ; "Edited 3-Sep-2025 10:21 by rmk")
|
||||
(* ; "Edited 7-Aug-2025 09:37 by rmk")
|
||||
|
||||
(* ;; "ISO codes are 8bit, MCODES maybe not. Caller shouldn't pass a fat code.")
|
||||
|
||||
(OR [CAR (find PAIR in ISO1TOMCCS suchthat (EQ ICODE (CADR PAIR]
|
||||
ICODE])
|
||||
|
||||
(MTOISO1CODE
|
||||
[LAMBDA (MCODE) (* ; "Edited 5-Feb-2026 12:26 by rmk")
|
||||
(* ; "Edited 2-Feb-2026 22:58 by rmk")
|
||||
(OR (CADR (ASSOC MCODE ISO1TOMCCS))
|
||||
MCODE])
|
||||
|
||||
(\CREATE.ISO1.FORMAT
|
||||
[LAMBDA NIL (* ; "Edited 5-Feb-2026 10:42 by rmk")
|
||||
(* ; "Edited 2-Feb-2026 23:37 by rmk")
|
||||
(* ; "Edited 1-Feb-2026 11:18 by rmk")
|
||||
(* ; "Edited 5-Aug-2021 22:15 by rmk:")
|
||||
(* ; "Edited 9-Mar-99 17:19 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 16:24 by ")
|
||||
(* ; "Edited 7-Dec-95 16:20 by ")
|
||||
(MAKE-EXTERNALFORMAT :ISO8859/1 [FUNCTION (LAMBDA (STREAM COUNTP)
|
||||
(ISO1TOMCODE (\THROUGHIN STREAM COUNTP]
|
||||
[FUNCTION (LAMBDA (STREAM NOERRORFLG)
|
||||
(ISO1TOMCODE (\PEEKBIN STREAM NOERRORFLG]
|
||||
(FUNCTION \THROUGHBACKCCODE)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
NIL NIL (FUNCTION MTOISO1STRING)
|
||||
NIL
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION ISO1TOMSTRING])
|
||||
|
||||
(\DUMMY-UTF8-FORMAT
|
||||
[LAMBDA NIL (* ; "Edited 5-Feb-2026 15:58 by rmk")
|
||||
(* ; "Edited 1-Feb-2026 13:16 by rmk")
|
||||
|
||||
(* ;; "Works only for 7-bit codes, during the loadup")
|
||||
|
||||
(\INSTALL.EXTERNALFORMAT (create EXTERNALFORMAT using (FIND-FORMAT :ISO8859/1)
|
||||
NAME _ :UTF-8])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(ISO1TOMSTRING
|
||||
[LAMBDA (ISTRING DESTRUCTIVE) (* ; "Edited 5-Feb-2026 11:01 by rmk")
|
||||
(* ; "Edited 2-Feb-2026 23:46 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 12:14 by rmk")
|
||||
(* ; "Edited 29-Apr-2025 13:08 by rmk")
|
||||
|
||||
(* ;; "Converts ISO8859/1 codes to MCCS codes in MSTRING.")
|
||||
|
||||
(for I ICODE (MSTRING _ (CL:IF DESTRUCTIVE
|
||||
ISTRING
|
||||
(CONCAT ISTRING))) from 1 while (SETQ ICODE (NTHCHARCODE ISTRING I))
|
||||
do (RPLCHARCODE MSTRING I (ISO1TOMCODE ICODE)) finally (RETURN MSTRING])
|
||||
|
||||
(MTOISO1STRING
|
||||
[LAMBDA (MSTRING DESTRUCTIVE) (* ; "Edited 2-Feb-2026 23:47 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 12:22 by rmk")
|
||||
(* ; "Edited 29-Apr-2025 13:08 by rmk")
|
||||
|
||||
(* ;; "Converts MCCS to ISO8859/1 codes in MSTRING.")
|
||||
|
||||
(for I MCODE (ISTRING _ (CL:IF DESTRUCTIVE
|
||||
MSTRING
|
||||
(CONCAT MSTRING))) from 1 while (SETQ MCODE (NTHCHARCODE MSTRING I))
|
||||
do (RPLCHARCODE ISTRING I (MTOISO1CODE MCODE)) finally (RETURN ISTRING])
|
||||
)
|
||||
|
||||
(RPAQQ ISO1TOMCCS
|
||||
((94 8593)
|
||||
(95 8592)
|
||||
(169 8216)
|
||||
(170 8220)
|
||||
(172 95)
|
||||
(173 94)
|
||||
(174 8594)
|
||||
(175 8595)
|
||||
(180 215)
|
||||
(184 247)
|
||||
(185 8217)
|
||||
(186 8221)
|
||||
(193 768)
|
||||
(194 769)
|
||||
(195 770)
|
||||
(196 771)
|
||||
(197 772)
|
||||
(198 774)
|
||||
(199 775)
|
||||
(200 776)
|
||||
(202 778)
|
||||
(203 807)
|
||||
(204 818)
|
||||
(205 779)
|
||||
(206 808)
|
||||
(207 780)
|
||||
(208 8213)
|
||||
(209 185)
|
||||
(210 174)
|
||||
(211 169)
|
||||
(212 8482)
|
||||
(213 9834)
|
||||
(220 8539)
|
||||
(221 8540)
|
||||
(222 8541)
|
||||
(223 8542)
|
||||
(224 8486)
|
||||
(225 198)
|
||||
(226 208)
|
||||
(227 170)
|
||||
(228 294)
|
||||
(229 567)
|
||||
(230 306)
|
||||
(231 319)
|
||||
(232 321)
|
||||
(233 216)
|
||||
(234 338)
|
||||
(235 186)
|
||||
(236 222)
|
||||
(237 358)
|
||||
(238 330)
|
||||
(239 329)
|
||||
(240 312)
|
||||
(241 230)
|
||||
(242 273)
|
||||
(243 240)
|
||||
(244 295)
|
||||
(245 305)
|
||||
(246 307)
|
||||
(247 320)
|
||||
(248 322)
|
||||
(249 248)
|
||||
(250 339)
|
||||
(251 223)
|
||||
(252 254)
|
||||
(253 359)
|
||||
(254 331)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS ISO1TOMCCS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(\CREATE.ISO1.FORMAT)
|
||||
|
||||
(\DUMMY-UTF8-FORMAT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3345 14916 (\MCCSINCCODE 3355 . 6443) (\MCCSPEEKCCODE 6445 . 9332) (\MCCSOUTCHAR 9334
|
||||
. 11433) (\MCCSBACKCCODE 11435 . 12979) (\MCCSFORMATBYTESTREAM 12981 . 13711) (\MCCSCHARSETFN 13713
|
||||
. 14914)) (14917 17368 (\CREATE.MCCS.EXTERNALFORMAT 14927 . 15797) (\CREATE.XCCS.EXTERNALFORMAT 15799
|
||||
. 17366)) (17369 18346 (\MCCS.24BITENCODING.ERROR 17379 . 18344)) (19722 22360 (MTOXCODE 19732 .
|
||||
20529) (XTOMCODE 20531 . 21188) (XTOMSTRING 21190 . 21775) (MTOXSTRING 21777 . 22358)) (22361 24021 (
|
||||
MTOX$CODE 22371 . 23103) (X$TOMCODE 23105 . 24019)) (24022 24662 (KANJICHARSETP 24032 . 24288) (
|
||||
CHINESECHARSETP 24290 . 24660)) (45230 47719 (MCCSCODEMAPARRAY 45240 . 47717)) (48335 54816 (MCCSMAPFN
|
||||
48345 . 49712) (MCCSMAPPAIRS 49714 . 53822) (XCCS.CS0.UNDEFINED 53824 . 54453) (XCCSUNDEFINEDPAIRS
|
||||
54455 . 54814)) (54921 59673 (GACHATOMCODE 54931 . 55443) (SYMBOLTOMCODE 55445 . 56093) (SIGMATOMCODE
|
||||
56095 . 56741) (ATOMCODE 56743 . 57275) (MATHTOMCODE 57277 . 57933) (HIPPOTOMCODE 57935 . 58472) (
|
||||
CYRILLICTOMCODE 58474 . 58908) (PALATINOTOMCODE 58910 . 59671)) (59700 62493 (ISO1TOMCODE 59710 .
|
||||
60459) (MTOISO1CODE 60461 . 60751) (\CREATE.ISO1.FORMAT 60753 . 62018) (\DUMMY-UTF8-FORMAT 62020 .
|
||||
62491)) (62494 64025 (ISO1TOMSTRING 62504 . 63320) (MTOISO1STRING 63322 . 64023)))))
|
||||
(FILEMAP (NIL (2853 14424 (\MCCSINCCODE 2863 . 5951) (\MCCSPEEKCCODE 5953 . 8840) (\MCCSOUTCHAR 8842
|
||||
. 10941) (\MCCSBACKCCODE 10943 . 12487) (\MCCSFORMATBYTESTREAM 12489 . 13219) (\MCCSCHARSETFN 13221
|
||||
. 14422)) (14425 15307 (\CREATE.MCCS.EXTERNALFORMAT 14435 . 15305)) (15308 16285 (
|
||||
\MCCS.24BITENCODING.ERROR 15318 . 16283)) (17661 20299 (MTOXCODE 17671 . 18468) (XTOMCODE 18470 .
|
||||
19127) (XTOMSTRING 19129 . 19714) (MTOXSTRING 19716 . 20297)) (20300 21960 (MTOX$CODE 20310 . 21042) (
|
||||
X$TOMCODE 21044 . 21958)) (21961 22601 (KANJICHARSETP 21971 . 22227) (CHINESECHARSETP 22229 . 22599))
|
||||
(43169 45043 (MCCSCODEMAPARRAY 43179 . 45041)) (45659 52140 (MCCSMAPFN 45669 . 47036) (MCCSMAPPAIRS
|
||||
47038 . 51146) (XCCS.CS0.UNDEFINED 51148 . 51777) (XCCSUNDEFINEDPAIRS 51779 . 52138)) (52245 56997 (
|
||||
GACHATOMCODE 52255 . 52767) (SYMBOLTOMCODE 52769 . 53417) (SIGMATOMCODE 53419 . 54065) (ATOMCODE 54067
|
||||
. 54599) (MATHTOMCODE 54601 . 55257) (HIPPOTOMCODE 55259 . 55796) (CYRILLICTOMCODE 55798 . 56232) (
|
||||
PALATINOTOMCODE 56234 . 56995)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "31-Jan-2026 23:43:06" {WMEDLEY}<sources>MEDLEYDIR.;44 16074
|
||||
(FILECREATED "26-Nov-2025 21:51:39" {WMEDLEY}<sources>MEDLEYDIR.;43 15970
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MEDLEYDIR)
|
||||
:CHANGES-TO (VARS MEDLEYDIRCOMS)
|
||||
|
||||
:PREVIOUS-DATE "26-Nov-2025 21:51:39" {WMEDLEY}<sources>MEDLEYDIR.;43)
|
||||
:PREVIOUS-DATE "26-Nov-2025 17:12:16" {WMEDLEY}<sources>MEDLEYDIR.;42)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEYDIRCOMS)
|
||||
@@ -139,8 +139,7 @@
|
||||
NIL])
|
||||
|
||||
(MEDLEYDIR
|
||||
[LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 31-Jan-2026 23:42 by rmk")
|
||||
(* ; "Edited 23-Aug-2025 17:21 by lmm")
|
||||
[LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 23-Aug-2025 17:21 by lmm")
|
||||
(* ; "Edited 18-Aug-2025 11:15 by FGH")
|
||||
(* ; "Edited 29-Jun-2023 22:48 by rmk")
|
||||
(* ; "Edited 18-Oct-2022 17:49 by lmm")
|
||||
@@ -185,7 +184,7 @@
|
||||
(UNIX-GETENV "HOME")
|
||||
DIRNAME)))
|
||||
[(EQUAL DIRNAME "loadups") (* ; "special case for loadups dir")
|
||||
(OR (DIRECTORYNAME (UNIX-GETENV "MEDLEY¬LOADUPS¬DIR"))
|
||||
(OR (DIRECTORYNAME (UNIX-GETENV "MEDLEY_LOADUPS_DIR"))
|
||||
(DIRECTORYNAME (CONCAT (MEDLEYDIR)
|
||||
"loadups" ">")
|
||||
NIL OUTPUT)
|
||||
@@ -285,6 +284,6 @@
|
||||
(ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5324 13336 (MEDLEY-INIT-VARS 5334 . 8812) (MEDLEYDIR 8814 . 12136) (MEDLEYSUBSTDIR
|
||||
12138 . 13116) (SET-SYSOUT-COMMIT 13118 . 13334)))))
|
||||
(FILEMAP (NIL (5329 13232 (MEDLEY-INIT-VARS 5339 . 8817) (MEDLEYDIR 8819 . 12032) (MEDLEYSUBSTDIR
|
||||
12034 . 13012) (SET-SYSOUT-COMMIT 13014 . 13230)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED " 8-Feb-2026 11:47:57" |{WMEDLEY}<sources>PACKAGE-STARTUP.;6| 36725
|
||||
(FILECREATED "21-Mar-2024 10:21:14" |{DSK}<home>larry>il>medley>sources>PACKAGE-STARTUP.;9| 36658
|
||||
|
||||
:EDIT-BY |rmk|
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (FUNCTIONS PACKAGE-ENABLE)
|
||||
:CHANGES-TO (VARIABLES CMLSYMBOLS.DECLARATORS CMLSYMBOLS.SHARED)
|
||||
|
||||
:PREVIOUS-DATE "21-Mar-2024 10:21:14" |{WMEDLEY}<sources>PACKAGE-STARTUP.;5|)
|
||||
:PREVIOUS-DATE "20-Mar-2024 23:34:56" |{DSK}<home>larry>il>medley>sources>PACKAGE-STARTUP.;8|
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PACKAGE-STARTUPCOMS)
|
||||
@@ -565,8 +566,7 @@
|
||||
(CONCOCT-SYMBOL I))
|
||||
T)
|
||||
|
||||
(CL:DEFUN PACKAGE-ENABLE (&OPTIONAL (PACKAGE *INTERLISP-PACKAGE*))
|
||||
(* \; "Edited 8-Feb-2026 11:47 by rmk")
|
||||
(CL:DEFUN PACKAGE-ENABLE (&OPTIONAL (PACKAGE *INTERLISP-PACKAGE*))
|
||||
"Turn on the package system, making PACKAGE the current one and redefining \\READ.SYMBOL and \\MKATOM appropriatly."
|
||||
(DECLARE (CL:SPECIAL *INTERLISP-PACKAGE* *PACKAGE* *OLD-INTERLISP-READ-ENVIRONMENT*
|
||||
*PER-EXEC-VARIABLES*))
|
||||
@@ -594,8 +594,8 @@
|
||||
(T (PROMPTPRINT "Invalid package, reset to LISP")
|
||||
(SETQ *PACKAGE* (CL:FIND-PACKAGE "LISP")))))
|
||||
*PER-EXEC-VARIABLES* :TEST 'CL:EQUAL)
|
||||
(CL:SETF *DEFAULT-MAKEFILE-ENVIRONMENT* `(:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :FORMAT
|
||||
,*DEFAULT-EXTERNALFORMAT*))
|
||||
(CL:SETF *DEFAULT-MAKEFILE-ENVIRONMENT* '(:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :FORMAT
|
||||
:XCCS))
|
||||
(MOVD '\\NEW.READ.SYMBOL '\\READ.SYMBOL)
|
||||
(MOVD '\\NEW.MKATOM '\\MKATOM)
|
||||
(CL:SETF *PACKAGE* PACKAGE)
|
||||
@@ -644,14 +644,14 @@
|
||||
(PACKAGE-INIT)
|
||||
)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (2977 3072 (RETURN-FIRST-OF-THREE 2977 . 3072)) (3074 3212 (
|
||||
ERROR-MISSING-EXTERNAL-SYMBOL 3074 . 3212)) (3819 4787 (CHECK-SYMBOL-NAMESTRING 3819 . 4787)) (4789
|
||||
7947 (\\NEW.READ.SYMBOL 4789 . 7947)) (7949 9659 (\\NEW.MKATOM 7949 . 9659)) (23488 23570 (
|
||||
LITATOM.EXISTS 23488 . 23570)) (24250 25256 (NAMESTRING-CONVERSION-CLAUSE 24250 . 25256)) (25258 26513
|
||||
(CONVERT-LITATOM 25258 . 26513)) (26515 28588 (CONCOCT-SYMBOL 26515 . 28588)) (28590 28884 (
|
||||
TRANSFER-SYMBOL 28590 . 28884)) (28886 29594 (INTERN-LITATOM 28886 . 29594)) (29596 30275 (
|
||||
\\LITATOM.EATCHARS 29596 . 30275)) (30277 30554 (PACKAGE-INIT 30277 . 30554)) (30556 31129 (
|
||||
PACKAGE-CLEAR 30556 . 31129)) (31131 32522 (PACKAGE-MAKE 31131 . 32522)) (32524 33836 (
|
||||
PACKAGE-HIERARCHY-INIT 32524 . 33836)) (33838 35575 (PACKAGE-ENABLE 33838 . 35575)) (35577 36220 (
|
||||
PACKAGE-DISABLE 35577 . 36220)) (36267 36293 (ID 36267 . 36293)))))
|
||||
(FILEMAP (NIL (3038 3133 (RETURN-FIRST-OF-THREE 3038 . 3133)) (3135 3273 (
|
||||
ERROR-MISSING-EXTERNAL-SYMBOL 3135 . 3273)) (3880 4848 (CHECK-SYMBOL-NAMESTRING 3880 . 4848)) (4850
|
||||
8008 (\\NEW.READ.SYMBOL 4850 . 8008)) (8010 9720 (\\NEW.MKATOM 8010 . 9720)) (23549 23631 (
|
||||
LITATOM.EXISTS 23549 . 23631)) (24311 25317 (NAMESTRING-CONVERSION-CLAUSE 24311 . 25317)) (25319 26574
|
||||
(CONVERT-LITATOM 25319 . 26574)) (26576 28649 (CONCOCT-SYMBOL 26576 . 28649)) (28651 28945 (
|
||||
TRANSFER-SYMBOL 28651 . 28945)) (28947 29655 (INTERN-LITATOM 28947 . 29655)) (29657 30336 (
|
||||
\\LITATOM.EATCHARS 29657 . 30336)) (30338 30615 (PACKAGE-INIT 30338 . 30615)) (30617 31190 (
|
||||
PACKAGE-CLEAR 30617 . 31190)) (31192 32583 (PACKAGE-MAKE 31192 . 32583)) (32585 33897 (
|
||||
PACKAGE-HIERARCHY-INIT 32585 . 33897)) (33899 35508 (PACKAGE-ENABLE 33899 . 35508)) (35510 36153 (
|
||||
PACKAGE-DISABLE 35510 . 36153)) (36200 36226 (ID 36200 . 36226)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
317
sources/UFS
317
sources/UFS
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 6-Feb-2026 23:23:31" {WMEDLEY}<sources>UFS.;68 92871
|
||||
(FILECREATED "17-Jan-2026 11:06:10" {WMEDLEY}<sources>UFS.;62 91935
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \UFS.NEXTFILEFN \UFSGenerateFiles \UFSDirectoryNameP \UFS.DIRECTORY.NAME)
|
||||
:CHANGES-TO (VARS UFSCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 5-Feb-2026 18:34:38" {WMEDLEY}<sources>UFS.;66)
|
||||
:PREVIOUS-DATE "27-Oct-2025 11:10:55" {WMEDLEY}<sources>UFS.;61)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UFSCOMS)
|
||||
@@ -14,6 +14,11 @@
|
||||
(RPAQQ UFSCOMS
|
||||
[(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
|
||||
UFS)
|
||||
[COMS
|
||||
(* ;; "For filename coercion before UNICODE-TABLES and UNICODE are loaded. Until then, only files with 7-bit MCCS names are allowed.")
|
||||
|
||||
(P (MOVD? 'EVQ 'UTF8TOMSTRING)
|
||||
(MOVD? 'EVQ 'MTOUTF8STRING]
|
||||
(DECLARE%: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY (FILES (LOADCOMP)
|
||||
DIRECTORY FILEIO))
|
||||
(INITVARS (\UFS.DEFAULT.EOLC NIL))
|
||||
@@ -130,6 +135,17 @@
|
||||
(PUTPROPS UFS FILETYPE :BCOMPL)
|
||||
|
||||
(PUTPROPS UFS MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10))
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"For filename coercion before UNICODE-TABLES and UNICODE are loaded. Until then, only files with 7-bit MCCS names are allowed."
|
||||
)
|
||||
|
||||
|
||||
(MOVD? 'EVQ 'UTF8TOMSTRING)
|
||||
|
||||
(MOVD? 'EVQ 'MTOUTF8STRING)
|
||||
(DECLARE%: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY
|
||||
|
||||
(FILESLOAD (LOADCOMP)
|
||||
@@ -274,8 +290,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\UFSOpenFile
|
||||
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* ; "Edited 5-Feb-2026 18:31 by rmk")
|
||||
(* ; "Edited 16-Oct-2025 08:52 by rmk")
|
||||
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* ; "Edited 16-Oct-2025 08:52 by rmk")
|
||||
(* ; "Edited 6-Jun-90 12:18 by nm")
|
||||
|
||||
(* ;;; "Open a file.")
|
||||
@@ -340,7 +355,7 @@
|
||||
(\UFSError CASE.CORRECT.NAME 23 FDEV)))
|
||||
(SETQ CDATE (CREATECELL \FIXP))
|
||||
(SETQ BYTESIZE (CREATECELL \FIXP))
|
||||
[SETQ FILEID (OR (\UFSOpenFile-C (MTOSYSSTRING CASE.CORRECT.FULLFILENAME)
|
||||
[SETQ FILEID (OR (\UFSOpenFile-C (MTOUTF8STRING CASE.CORRECT.FULLFILENAME)
|
||||
REC ACC CDATE BYTESIZE ERRNO)
|
||||
(RETURN (\UFSError CASE.CORRECT.NAME ERRNO FDEV]
|
||||
(if (= (IPLUS BYTESIZE 0)
|
||||
@@ -383,8 +398,7 @@
|
||||
)
|
||||
|
||||
(\UFS.RECOGNIZE.FILE
|
||||
[LAMBDA (FILENAME RECOG DEV) (* ; "Edited 5-Feb-2026 18:32 by rmk")
|
||||
(* ; "Edited 16-Oct-2025 10:19 by rmk")
|
||||
[LAMBDA (FILENAME RECOG DEV) (* ; "Edited 16-Oct-2025 10:19 by rmk")
|
||||
(* ; "Edited 13-Mar-90 11:19 by nm")
|
||||
|
||||
(* ;; "This assumes that input FILENAME is MCCS, returns MCCS")
|
||||
@@ -396,7 +410,7 @@
|
||||
(ERRNO (CREATECELL \FIXP))
|
||||
LEN)
|
||||
(SETQ LEN (CL:FUNCALL (\UFS.FILE.RECOGNIZER DEV)
|
||||
(MTOSYSSTRING (\UFS.REMOVE.HOST.FIELD FILENAME DEV))
|
||||
(MTOUTF8STRING (\UFS.REMOVE.HOST.FIELD FILENAME DEV))
|
||||
(SELECTQ RECOG
|
||||
(OLD RECOG-OLD)
|
||||
(OLDEST RECOG-OLDEST)
|
||||
@@ -407,28 +421,28 @@
|
||||
NAMEAREA ERRNO))
|
||||
(COND
|
||||
((FIXP LEN)
|
||||
(SYSTOMSTRING (SUBSTRING NAMEAREA 1 LEN)))
|
||||
(UTF8TOMSTRING (SUBSTRING NAMEAREA 1 LEN)))
|
||||
(T (\UFSError FILENAME ERRNO])])
|
||||
|
||||
(\UFS.DIRECTORY.NAME
|
||||
[LAMBDA (DIRSTRING NAMEAREA DEV) (* ; "Edited 6-Feb-2026 18:23 by rmk")
|
||||
(* ; "Edited 15-Oct-2025 16:30 by rmk")
|
||||
[LAMBDA (DIRSTRING NAMEAREA DEV) (* ; "Edited 15-Oct-2025 16:30 by rmk")
|
||||
(* ; "Edited 1-Apr-90 23:36 by nm")
|
||||
|
||||
(* ;;; "Accepts a Xerox Lisp canonical directory name, and recognize it. If such directory exists, sets the %"true%" name of the directory in NAMEAREA and returns the length of the name. If such directory does not exist, returns NIL. The canonical directory name does not include the initial directory delimiter and the trail directory delimiter, but the result %"true%" name includes both of them. If DIRSTRING is %"<%", it means the root directory.")
|
||||
|
||||
(* ;; "DIRSTRING is in system format")
|
||||
(* ;; "DIRSTRING is MCCS, the true name is not")
|
||||
|
||||
(if (STREQUAL DIRSTRING "<")
|
||||
then (RPLSTRING NAMEAREA 1 "<")
|
||||
1
|
||||
else (WITH.MONITOR (\UFSGetMonitor DEV)
|
||||
(CL:FUNCALL (\UFS.DIRECTORY.RECOGNIZER DEV)
|
||||
DIRSTRING NAMEAREA (CREATECELL \FIXP)))])
|
||||
(MTOUTF8STRING DIRSTRING)
|
||||
NAMEAREA
|
||||
(CREATECELL \FIXP)))])
|
||||
|
||||
(\UFSCloseFile
|
||||
[LAMBDA (STREAMFILE) (* ; "Edited 5-Feb-2026 18:31 by rmk")
|
||||
(* ; "Edited 16-Oct-2025 13:47 by rmk")
|
||||
[LAMBDA (STREAMFILE) (* ; "Edited 16-Oct-2025 13:47 by rmk")
|
||||
(* ; "Edited 16-Sep-2023 09:21 by briggs")
|
||||
(* ; "Edited 30-Mar-90 10:39 by nm")
|
||||
(* ; "return stream")
|
||||
@@ -453,7 +467,7 @@
|
||||
then (* ; "Open for output")
|
||||
(FDEVOP 'TRUNCATEFILE DEVICE STREAMFILE)
|
||||
(SETQ CDATE (fetch (UFSSTREAM CDATE) of STREAMFILE)))
|
||||
(RETURN (if (\UFSCloseFile-C (MTOSYSSTRING UNIXNAME)
|
||||
(RETURN (if (\UFSCloseFile-C (MTOUTF8STRING UNIXNAME)
|
||||
(fetch (UFSSTREAM FILEID) of STREAMFILE)
|
||||
CDATE ERRNO)
|
||||
then (replace (UFSSTREAM FILEID) of STREAMFILE with NIL)
|
||||
@@ -468,8 +482,7 @@
|
||||
)
|
||||
|
||||
(\UFSDeleteFile
|
||||
[LAMBDA (FILENAME DEV) (* ; "Edited 5-Feb-2026 18:31 by rmk")
|
||||
(* ; "Edited 27-Oct-2025 11:10 by rmk")
|
||||
[LAMBDA (FILENAME DEV) (* ; "Edited 27-Oct-2025 11:10 by rmk")
|
||||
(* ; "Edited 30-Mar-90 10:46 by nm")
|
||||
(* ; "return deleted file name")
|
||||
(* ; "if error, return NIL")
|
||||
@@ -480,15 +493,14 @@
|
||||
"file found and not open, so try to delete")
|
||||
(LET ((ERRNO (CREATECELL \FIXP)))
|
||||
(COND
|
||||
((\UFSDeleteFile-C (MTOSYSSTRING (\UFS.REMOVE.HOST.FIELD NAME DEV))
|
||||
((\UFSDeleteFile-C (MTOUTF8STRING (\UFS.REMOVE.HOST.FIELD NAME DEV))
|
||||
DEV ERRNO) (* ; "Success")
|
||||
(\UFS.FULLNAME NAME DEV T))
|
||||
(T (* ; "Failure")
|
||||
(\UFSError NAME ERRNO DEV])])
|
||||
|
||||
(\UFSRenameFile
|
||||
[LAMBDA (OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME) (* ; "Edited 5-Feb-2026 18:31 by rmk")
|
||||
(* ; "Edited 16-Oct-2025 08:46 by rmk")
|
||||
[LAMBDA (OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME) (* ; "Edited 16-Oct-2025 08:46 by rmk")
|
||||
(* ; "Edited 18-Dec-2024 12:52 by rmk")
|
||||
(* ; "Edited 16-Apr-90 13:46 by nm")
|
||||
(if (NEQ OLD-DEVICE NEW-DEVICE)
|
||||
@@ -506,10 +518,10 @@
|
||||
(LET ((NEWUNIXNAME (\UFS.RECOGNIZE.FILE NEW-NAME 'NEW NEW-DEVICE))
|
||||
(ERRNO (CREATECELL \FIXP)))
|
||||
(COND
|
||||
((\UFSRenameFile-C (MTOSYSSTRING (\UFS.REMOVE.HOST.FIELD OLDUNIXNAME
|
||||
OLD-DEVICE))
|
||||
(MTOSYSSTRING (\UFS.REMOVE.HOST.FIELD NEWUNIXNAME NEW-DEVICE
|
||||
))
|
||||
((\UFSRenameFile-C (MTOUTF8STRING (\UFS.REMOVE.HOST.FIELD
|
||||
OLDUNIXNAME OLD-DEVICE))
|
||||
(MTOUTF8STRING (\UFS.REMOVE.HOST.FIELD NEWUNIXNAME
|
||||
NEW-DEVICE))
|
||||
NEW-DEVICE ERRNO)
|
||||
(\UFS.FULLNAME NEWUNIXNAME NEW-DEVICE))
|
||||
(T (if (EQL (IPLUS ERRNO 0)
|
||||
@@ -531,8 +543,7 @@
|
||||
)
|
||||
|
||||
(\UFSTruncateFile
|
||||
[LAMBDA (STREAM PAGE# OFFSET) (* ; "Edited 5-Feb-2026 18:31 by rmk")
|
||||
(* ; "Edited 16-Oct-2025 08:56 by rmk")
|
||||
[LAMBDA (STREAM PAGE# OFFSET) (* ; "Edited 16-Oct-2025 08:56 by rmk")
|
||||
(* ; "Edited 22-Aug-90 16:46 by nm")
|
||||
|
||||
(* ;;; "Used to shorten or lengthen STREAM. If lengthening, pad the file with nulls. Used by SETEOFPTR and FORCEOUTPUT.")
|
||||
@@ -570,19 +581,16 @@
|
||||
(* ;;
|
||||
"Set new validation value. UNIX mtime is updated, so Lisp stream validation must be updated.")
|
||||
|
||||
(if (\UFSGetFileInfo-C (MTOSYSSTRING (fetch (UFSSTREAM UNIXNAME) of STREAM))
|
||||
(if (\UFSGetFileInfo-C (MTOUTF8STRING (fetch (UFSSTREAM UNIXNAME) of STREAM))
|
||||
ATTR-WDATE DT ERRNO)
|
||||
then (replace (STREAM VALIDATION) of STREAM with DT])
|
||||
|
||||
(\UFSDirectoryNameP
|
||||
[LAMBDA (DIRSPEC DEV) (* ; "Edited 6-Feb-2026 23:19 by rmk")
|
||||
(* ; "Edited 16-Oct-2025 10:23 by rmk")
|
||||
[LAMBDA (DIRSPEC DEV) (* ; "Edited 16-Oct-2025 10:23 by rmk")
|
||||
(* ; "Edited 21-Sep-92 15:27 by jds")
|
||||
|
||||
(* ;;; " DIRECTORYNAMEP FDEV method. Performs a recognition as well and returns the %"true%" name if it exists.")
|
||||
|
||||
(* ;; "DIRSPEC is in system format")
|
||||
|
||||
(LET ([DIRECTORY (CONCAT (OR (UNPACKFILENAME.STRING DIRSPEC 'DEVICE)
|
||||
"")
|
||||
(OR (UNPACKFILENAME.STRING DIRSPEC 'DIRECTORY 'RETURN)
|
||||
@@ -598,13 +606,12 @@
|
||||
(COND
|
||||
(DIRECTORY (SETQ NAMEAREA (ALLOCSTRING MAX-PATHNAME-LEN))
|
||||
(* ; "NAMEAREA will be modified by C code and hold the %"true%" name of DIRECTORY if DIRECTORY is recognized as a valid directory name.")
|
||||
(SETQ LEN (\UFS.DIRECTORY.NAME (MTOSYSSTRING DIRECTORY)
|
||||
NAMEAREA DEV))
|
||||
(SETQ LEN (\UFS.DIRECTORY.NAME DIRECTORY NAMEAREA DEV))
|
||||
(COND
|
||||
((FIXP LEN) (* ;
|
||||
"LEN holds the length of the %"true%" name of DIRECTORY.")
|
||||
(\UFS.FULLNAME (SYSTOMSTRING (SUBSTRING NAMEAREA 1 LEN))
|
||||
DEV NIL))
|
||||
(UTF8TOMSTRING (\UFS.FULLNAME (SUBSTRING NAMEAREA 1 LEN)
|
||||
DEV NIL)))
|
||||
(T NIL)))
|
||||
(T NIL])
|
||||
|
||||
@@ -613,8 +620,7 @@
|
||||
)
|
||||
|
||||
(\UFSGetFileInfo
|
||||
[LAMBDA (STREAM ATTRIBUTE DEVICE) (* ; "Edited 5-Feb-2026 18:32 by rmk")
|
||||
(* ; "Edited 16-Oct-2025 08:49 by rmk")
|
||||
[LAMBDA (STREAM ATTRIBUTE DEVICE) (* ; "Edited 16-Oct-2025 08:49 by rmk")
|
||||
(* ; "Edited 30-Mar-90 12:27 by nm")
|
||||
|
||||
(* ;;; "Get the value of the attribute for a file.")
|
||||
@@ -633,7 +639,7 @@
|
||||
(ERRNO (CREATECELL \FIXP))
|
||||
BUFFER NAMESIZE)
|
||||
(if FILENAME
|
||||
then (SETQ FILENAME (MTOSYSSTRING FILENAME))
|
||||
then (SETQ FILENAME (MTOUTF8STRING FILENAME))
|
||||
(SELECTQ ATTRIBUTE
|
||||
(LENGTH (SETQ BUFFER (CREATECELL \FIXP))
|
||||
(if (\UFSGetFileInfo-C FILENAME ATTR-LENGTH BUFFER ERRNO)
|
||||
@@ -665,7 +671,7 @@
|
||||
(AUTHOR (SETQ BUFFER (ALLOCSTRING MAX-UNAME-LEN))
|
||||
(if (SETQ NAMESIZE (\UFSGetFileInfo-C FILENAME ATTR-AUTHOR BUFFER
|
||||
ERRNO))
|
||||
then (SYSTOMSTRING (CL:SUBSEQ BUFFER 0 NAMESIZE))
|
||||
then (UTF8TOMSTRING (CL:SUBSEQ BUFFER 0 NAMESIZE))
|
||||
else (\UFSError FILENAME ERRNO DEVICE)))
|
||||
(PROTECTION (SETQ BUFFER (CREATECELL \FIXP))
|
||||
(if (\UFSGetFileInfo-C FILENAME ATTR-PROTECTION BUFFER ERRNO)
|
||||
@@ -686,8 +692,7 @@
|
||||
)
|
||||
|
||||
(\UFSSetFileInfo
|
||||
[LAMBDA (STREAM ATTRIBUTE VALUE DEVICE) (* ; "Edited 5-Feb-2026 18:31 by rmk")
|
||||
(* ; "Edited 16-Oct-2025 08:51 by rmk")
|
||||
[LAMBDA (STREAM ATTRIBUTE VALUE DEVICE) (* ; "Edited 16-Oct-2025 08:51 by rmk")
|
||||
(* ; "Edited 30-Mar-90 12:31 by nm")
|
||||
|
||||
(* ;;; "Get the VALUE of the ATTRIBUTE for a file.")
|
||||
@@ -706,7 +711,7 @@
|
||||
(ERRNO (CREATECELL \FIXP))
|
||||
BUFFER NAMESIZE PATHNAME)
|
||||
(if FILENAME
|
||||
then (SETQ FILENAME (MTOSYSSTRING FILENAME))
|
||||
then (SETQ FILENAME (MTOUTF8STRING FILENAME))
|
||||
(SELECTQ ATTRIBUTE
|
||||
(TYPE (\UFSSetFileType FILENAME VALUE))
|
||||
((CREATIONDATE WRITEDATE)
|
||||
@@ -730,8 +735,6 @@
|
||||
(\UFSGenerateFiles
|
||||
[LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS)
|
||||
|
||||
(* ;; "Edited 6-Feb-2026 22:43 by rmk")
|
||||
|
||||
(* ;; "Edited 16-Oct-2025 11:06 by rmk")
|
||||
|
||||
(* ;; "Edited 27-Mar-2022 15:55 by rmk: Use the EXTENSION and VERFSION in the pattern instead of the inherited defaults")
|
||||
@@ -747,13 +750,8 @@
|
||||
|
||||
(* ;;; "Returns a file-generator object that will generate exactly those files in the sys-dir of FDEV whose names match PATTERN.")
|
||||
|
||||
(* ;;
|
||||
"All the internals are in system format, individual results must be converted back to MCCS.")
|
||||
|
||||
(* ;; "PATTERN is MCCS, is immediately converted to system format")
|
||||
|
||||
(WITH.MONITOR (\UFSGetMonitor FDEV)
|
||||
[PROG* ((PARSED (UNPACKFILENAME.STRING (MTOSYSSTRING PATTERN)))
|
||||
[PROG* ((PARSED (UNPACKFILENAME.STRING PATTERN))
|
||||
(DIRECTORY (OR (LISTGET PARSED 'DIRECTORY)
|
||||
(\UFS.HANDLE.RELATIVEDIRECTORY (LISTGET PARSED 'RELATIVEDIRECTORY)
|
||||
FDEV)
|
||||
@@ -771,26 +769,27 @@
|
||||
(DEFAULTVERS (OR (LISTGET PARSED 'VERSION)
|
||||
DEFAULTVERS)))
|
||||
|
||||
(* ;; "All fields are now in the system external format")
|
||||
|
||||
(* ;; "rmk: uses the default below, don't want NIL if the pattern includes something else.")
|
||||
|
||||
(COND
|
||||
((STREQUAL DIRECTORY "/")
|
||||
(SETQ DIRECTORY "<")))
|
||||
[SETQ FILTER (COND
|
||||
((STREQUAL DIRECTORY "<")
|
||||
(CONCAT "{" (LISTGET PARSED 'HOST)
|
||||
"}"
|
||||
(OR DEVICE "")
|
||||
"<"
|
||||
(PACKFILENAME.STRING 'NAME NAME 'EXTENSION EXTENSION
|
||||
'VERSION VERSION)))
|
||||
(T (PACKFILENAME.STRING 'DIRECTORY DIRECTORY 'HOST (LISTGET
|
||||
PARSED
|
||||
'HOST)
|
||||
'DEVICE DEVICE 'NAME NAME 'EXTENSION EXTENSION 'VERSION
|
||||
VERSION]
|
||||
|
||||
(* ;; "DIRECTORY is MCCS, FILTER is UTF8")
|
||||
|
||||
[SETQ FILTER (MTOUTF8STRING (COND
|
||||
((STREQUAL DIRECTORY "<")
|
||||
(CONCAT "{" (LISTGET PARSED 'HOST)
|
||||
"}"
|
||||
(OR DEVICE "")
|
||||
"<"
|
||||
(PACKFILENAME.STRING 'NAME NAME 'EXTENSION
|
||||
EXTENSION 'VERSION VERSION)))
|
||||
(T (PACKFILENAME.STRING 'DIRECTORY DIRECTORY
|
||||
'HOST
|
||||
(LISTGET PARSED 'HOST)
|
||||
'DEVICE DEVICE 'NAME NAME 'EXTENSION
|
||||
EXTENSION 'VERSION VERSION]
|
||||
(SETQ LEN (\UFS.DIRECTORY.NAME (CONCAT (OR DEVICE "")
|
||||
DIRECTORY)
|
||||
NAMEAREA FDEV))
|
||||
@@ -798,7 +797,7 @@
|
||||
((NOT (FIXP LEN)) (* ; "No such directory. We go thru this recognition step so that \UFSFindFile gives us name in the correct case")
|
||||
(PRINTOUT PROMPTWINDOW T "Can't enumerate " PATTERN " because no such directory")
|
||||
(RETURN (\NULLFILEGENERATOR]
|
||||
(SETQ DIRECTORY (SUBSTRING NAMEAREA 1 LEN))
|
||||
(SETQ DIRECTORY (SUBSTRING NAMEAREA 1 LEN)) (* ; "DIRECTORY is now UTF8")
|
||||
|
||||
(* ;; "The information about enumerated files are cached in the emulator. We receive the ID and the total number of enumerated files. The ID is used to identify the object corresponding to the enumerated file.")
|
||||
|
||||
@@ -809,7 +808,8 @@
|
||||
(SETQ TOTALNUM (\UFSReadDir-C FILTER PROPP ID ERRNO))
|
||||
(COND
|
||||
[(< TOTALNUM 0)
|
||||
(OR (\UFSError DIRECTORY ERRNO FDEV)
|
||||
(OR (\UFSError (UTF8TOMSTRING DIRECTORY)
|
||||
ERRNO FDEV)
|
||||
(RETURN (\NULLFILEGENERATOR]
|
||||
(T (COND
|
||||
((ZEROP TOTALNUM)
|
||||
@@ -819,8 +819,7 @@
|
||||
(FMEMB 'RESETLST OPTIONS))
|
||||
(RESETSAVE NIL '(AND RESETSTATE (\UFSFinishFileInfo-C ID]
|
||||
|
||||
(* ;;
|
||||
"Everything in FILEGENOBJ is in system character encoding (UTF-8?)")
|
||||
(* ;; "Everything in FILEGENOBJ is UTF8")
|
||||
|
||||
(RETURN (create FILEGENOBJ
|
||||
NEXTFILEFN _ (FUNCTION \UFS.NEXTFILEFN)
|
||||
@@ -843,21 +842,20 @@
|
||||
CURRENT-DEPTH _ 1
|
||||
MAX-DEPTH _
|
||||
FILING.ENUMERATION.DEPTH
|
||||
FILTER _ (
|
||||
PACKFILENAME.STRING
|
||||
'NAME NAME
|
||||
'EXTENSION
|
||||
EXTENSION
|
||||
'VERSION VERSION])
|
||||
])
|
||||
FILTER _
|
||||
(PACKFILENAME.STRING
|
||||
'NAME
|
||||
(AND NAME (MTOUTF8STRING
|
||||
NAME))
|
||||
'EXTENSION
|
||||
(AND EXTENSION (
|
||||
MTOUTF8STRING
|
||||
EXTENSION))
|
||||
'VERSION VERSION])])
|
||||
|
||||
(\UFS.NEXTFILEFN
|
||||
[LAMBDA (GENFILESTATE NAMEONLY)
|
||||
|
||||
(* ;; "Edited 6-Feb-2026 23:23 by rmk")
|
||||
|
||||
(* ;; "Edited 5-Feb-2026 18:32 by rmk")
|
||||
|
||||
(* ;; "Edited 16-Oct-2025 16:59 by rmk")
|
||||
|
||||
(* ;;
|
||||
@@ -867,7 +865,7 @@
|
||||
|
||||
(* ;; "Given a UFS filesystem generator, return the %"next%" file in line.")
|
||||
|
||||
(* ;; "All the fields of the UFSGENFILESTATE are in system format (UTF-8?). Returned FILENAME is converted to MCCS")
|
||||
(* ;; "All the fields of the UFSGENFILESTATE are UTF8. FILENAME is MCCS")
|
||||
|
||||
(LET ((SUBGEN (fetch (UFSGENFILESTATE SUBGENERATOR) of GENFILESTATE))
|
||||
FILENAME NAMELEN NEWNAME)
|
||||
@@ -902,74 +900,72 @@
|
||||
(LET [(FINFOID (fetch (UFSGENFILESTATE FINFOID) of GENFILESTATE))
|
||||
(FILEID (fetch (UFSGENFILESTATE FILEID) of GENFILESTATE))
|
||||
(ERRNO (LOCF (fetch (UFSGENFILESTATE ERRONO) of GENFILESTATE]
|
||||
(CL:WHEN (AND (> FINFOID -1)
|
||||
(< FILEID (fetch (UFSGENFILESTATE TOTALNUM) of GENFILESTATE)))
|
||||
(CL:UNWIND-PROTECT
|
||||
(CL:WHEN (> (SETQ NAMELEN (\UFSNextFile-C GENFILESTATE))
|
||||
0)
|
||||
(SETQ NEWNAME (CL:SUBSEQ (fetch (UFSGENFILESTATE NAME) of
|
||||
(AND (> FINFOID -1)
|
||||
(< FILEID (fetch (UFSGENFILESTATE TOTALNUM) of GENFILESTATE))
|
||||
(CL:UNWIND-PROTECT
|
||||
(CL:WHEN (> (SETQ NAMELEN (\UFSNextFile-C GENFILESTATE))
|
||||
0)
|
||||
(SETQ NEWNAME (CL:SUBSEQ (fetch (UFSGENFILESTATE NAME) of
|
||||
GENFILESTATE
|
||||
)
|
||||
0 NAMELEN))
|
||||
)
|
||||
0 NAMELEN))
|
||||
|
||||
(* ;;
|
||||
"NEWNAME and DIRECTORY are both in system format, and so is FILENAME here")
|
||||
(* ;; "NEWNAME and DIRECTORY are both UTF8")
|
||||
|
||||
(SETQ FILENAME (\UFS.FULLNAME.M (fetch (UFSGENFILESTATE DIRECTORY)
|
||||
of GENFILESTATE)
|
||||
NEWNAME
|
||||
(fetch (UFSGENFILESTATE DEV) of GENFILESTATE)))
|
||||
(replace (UFSGENFILESTATE THISFILE) of GENFILESTATE with FILENAME)
|
||||
(COND
|
||||
((= (add FILEID 1)
|
||||
(fetch (UFSGENFILESTATE TOTALNUM) of GENFILESTATE))
|
||||
(SETQ FILENAME (\UFS.FULLNAME.M (fetch (UFSGENFILESTATE DIRECTORY)
|
||||
of GENFILESTATE)
|
||||
NEWNAME
|
||||
(fetch (UFSGENFILESTATE DEV) of GENFILESTATE))
|
||||
)
|
||||
(replace (UFSGENFILESTATE THISFILE) of GENFILESTATE with FILENAME)
|
||||
(COND
|
||||
((= (add FILEID 1)
|
||||
(fetch (UFSGENFILESTATE TOTALNUM) of GENFILESTATE))
|
||||
(* ; "Generator exhausted. ")
|
||||
(\UFS.UNREGISTER.GFS GENFILESTATE T))
|
||||
(T (replace (UFSGENFILESTATE FILEID) of GENFILESTATE with FILEID))
|
||||
) (* ; "\GENERATEFILES operates in MCCS")
|
||||
(COND
|
||||
((AND (EQ (CHARCODE >)
|
||||
(NTHCHARCODE FILENAME -1))
|
||||
(OR (EQ (fetch (UFSGENFILESTATE MAX-DEPTH) of GENFILESTATE)
|
||||
T)
|
||||
(ILESSP (fetch (UFSGENFILESTATE CURRENT-DEPTH)
|
||||
of GENFILESTATE)
|
||||
(fetch (UFSGENFILESTATE MAX-DEPTH) of
|
||||
(\UFS.UNREGISTER.GFS GENFILESTATE T))
|
||||
(T (replace (UFSGENFILESTATE FILEID) of GENFILESTATE with FILEID)
|
||||
))
|
||||
(COND
|
||||
((AND (EQ (CHARCODE >)
|
||||
(NTHCHARCODE FILENAME -1))
|
||||
(OR (EQ (fetch (UFSGENFILESTATE MAX-DEPTH) of GENFILESTATE)
|
||||
T)
|
||||
(ILESSP (fetch (UFSGENFILESTATE CURRENT-DEPTH)
|
||||
of GENFILESTATE)
|
||||
(fetch (UFSGENFILESTATE MAX-DEPTH) of
|
||||
GENFILESTATE
|
||||
)))
|
||||
[SETQ SUBGEN (\GENERATEFILES
|
||||
(SYSTOMSTRING (CONCAT FILENAME
|
||||
(FETCH (UFSGENFILESTATE
|
||||
FILTER)
|
||||
OF GENFILESTATE)))
|
||||
(CL:WHEN (fetch (UFSGENFILESTATE PROPP)
|
||||
of GENFILESTATE)
|
||||
)))
|
||||
[SETQ SUBGEN (\GENERATEFILES (CONCAT FILENAME
|
||||
(FETCH (UFSGENFILESTATE
|
||||
FILTER)
|
||||
OF GENFILESTATE))
|
||||
(CL:WHEN (fetch (UFSGENFILESTATE PROPP)
|
||||
of GENFILESTATE)
|
||||
|
||||
(* ;;
|
||||
(* ;;
|
||||
"Need any legal attributes to cause string allocation.")
|
||||
|
||||
'(SIZE CREATIONDATE AUTHOR))
|
||||
'(SORT RESETLST]
|
||||
(fetch (FILEGENOBJ GENFILESTATE) of SUBGEN))
|
||||
'(SIZE CREATIONDATE AUTHOR))
|
||||
'(SORT RESETLST]
|
||||
(fetch (FILEGENOBJ GENFILESTATE) of SUBGEN))
|
||||
|
||||
(* ;; "It's a directory, so let's recurse into it.")
|
||||
(* ;; "It's a directory, so let's recurse into it.")
|
||||
|
||||
(SETQ SUBGEN (fetch (FILEGENOBJ GENFILESTATE) of SUBGEN))
|
||||
(replace (UFSGENFILESTATE SUBGENERATOR) of GENFILESTATE
|
||||
with SUBGEN)
|
||||
(replace (UFSGENFILESTATE CURRENT-DEPTH) of SUBGEN
|
||||
with (ADD1 (fetch (UFSGENFILESTATE CURRENT-DEPTH) of
|
||||
GENFILESTATE
|
||||
)))
|
||||
(replace (UFSGENFILESTATE MAX-DEPTH) of SUBGEN
|
||||
with (fetch (UFSGENFILESTATE MAX-DEPTH) of GENFILESTATE))
|
||||
(SETQ SUBGEN (fetch (FILEGENOBJ GENFILESTATE) of SUBGEN))
|
||||
(replace (UFSGENFILESTATE SUBGENERATOR) of GENFILESTATE
|
||||
with SUBGEN)
|
||||
(replace (UFSGENFILESTATE CURRENT-DEPTH) of SUBGEN
|
||||
with (ADD1 (fetch (UFSGENFILESTATE CURRENT-DEPTH)
|
||||
of GENFILESTATE)))
|
||||
(replace (UFSGENFILESTATE MAX-DEPTH) of SUBGEN
|
||||
with (fetch (UFSGENFILESTATE MAX-DEPTH) of GENFILESTATE))
|
||||
|
||||
(* ;; "We're set up to recurse into the SUBGEN above")
|
||||
(* ;; "We're set up to recurse into the SUBGEN above")
|
||||
|
||||
(\UFS.NEXTFILEFN GENFILESTATE NAMEONLY))
|
||||
(NAMEONLY (SYSTOMSTRING NEWNAME))
|
||||
(T (SYSTOMSTRING FILENAME))))
|
||||
(AND RESETSTATE (\UFS.UNREGISTER.GFS GENFILESTATE T))))])
|
||||
(\UFS.NEXTFILEFN GENFILESTATE NAMEONLY))
|
||||
(NAMEONLY (UTF8TOMSTRING NEWNAME))
|
||||
(T (UTF8TOMSTRING FILENAME))))
|
||||
(AND RESETSTATE (\UFS.UNREGISTER.GFS GENFILESTATE T)))])
|
||||
|
||||
(\UFS.FILEINFOFN
|
||||
(LAMBDA (GENFILESTATE ATTRIBUTE) (* ; "Edited 7-May-90 23:21 by nm") (* ;;; "FILEINFOFN for UFS--return the value of the specified ATTRIBUTE. ALLPROPS is fetched when a file is generated if GENERATEFILES method is invoked with some valid PROPs when the generator is created. ALLPROPS strucure is re-used. We have to be careful to COPY the values that come out.") (AND (fetch (UFSGENFILESTATE PROPP) of GENFILESTATE) (CL:UNWIND-PROTECT (if (EQ ATTRIBUTE (QUOTE TYPE)) then (\UFSGetFileType (fetch (UFSGENFILESTATE THISFILE) of GENFILESTATE)) else (BLOCK) (SELECTQ ATTRIBUTE (LENGTH (* ; "Copy numeric value") (+ 0 (fetch (UFSGENFILESTATE LENGTH) of GENFILESTATE))) (PROTECTION (* ; "Copy numeric value") (+ 0 (fetch (UFSGENFILESTATE PROTECTION) of GENFILESTATE))) (SIZE (FOLDHI (fetch (UFSGENFILESTATE LENGTH) of GENFILESTATE) BYTESPERPAGE)) ((CREATIONDATE WRITEDATE) (GDATE (fetch (UFSGENFILESTATE WDATE) of GENFILESTATE))) (READDATE (GDATE (fetch (UFSGENFILESTATE RDATE) of GENFILESTATE))) ((ICREATIONDATE IWRITEDATE) (+ 0 (fetch (UFSGENFILESTATE WDATE) of GENFILESTATE))) (IREADDATE (+ 0 (fetch (UFSGENFILESTATE RDATE) of GENFILESTATE))) (AUTHOR (* ; "Copy the string out of the buffer") (CL:SUBSEQ (fetch (UFSGENFILESTATE AUTHOR) of GENFILESTATE) 0 (fetch (UFSGENFILESTATE AULEN) of GENFILESTATE))) NIL)) (AND RESETSTATE (> (fetch (UFSGENFILESTATE FINFOID) of GENFILESTATE) -1) (\UFS.UNREGISTER.GFS GENFILESTATE T)))))
|
||||
@@ -1080,8 +1076,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(CHDIR
|
||||
[LAMBDA (PATHNAME) (* ; "Edited 5-Feb-2026 18:31 by rmk")
|
||||
(* ; "Edited 16-Oct-2025 18:22 by rmk")
|
||||
[LAMBDA (PATHNAME) (* ; "Edited 16-Oct-2025 18:22 by rmk")
|
||||
(* ; "Edited 2-Apr-90 01:07 by nm")
|
||||
|
||||
(* ;;; "(\CALL-C SUBR-UFS-DIRECTORYNAMEP ..) returns T(=1) or NIL.")
|
||||
@@ -1094,7 +1089,7 @@
|
||||
(if (OR (EQ HOST 'DSK)
|
||||
(EQ HOST 'UNIX))
|
||||
then (if (SETQ PATH (DIRECTORYNAME PATH))
|
||||
then (if (\UFSCHDIR-C (MTOSYSSTRING PATH))
|
||||
then (if (\UFSCHDIR-C (MTOUTF8STRING PATH))
|
||||
then (DIRECTORYNAME PATH)
|
||||
else (ERROR "NO-SUCH-DIRECTORY" PATHNAME))
|
||||
else (ERROR "NO-SUCH-DIRECTORY" PATHNAME))
|
||||
@@ -1562,23 +1557,23 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (8911 10464 (\UFSCreateDevice 8921 . 9286) (\UFS.CREATE.DEVICE 9288 . 10144) (
|
||||
\UFSOpenDevice 10146 . 10323) (\UFSCloseDevice 10325 . 10462)) (14727 64649 (\UFSOpenFile 14737 .
|
||||
21421) (\UFS.OPENP 21423 . 21920) (\UFS.RECOGNIZE.FILE 21922 . 23459) (\UFS.DIRECTORY.NAME 23461 .
|
||||
24590) (\UFSCloseFile 24592 . 26759) (\UFSGetFileName 26761 . 26960) (\UFSDeleteFile 26962 . 28264) (
|
||||
\UFSRenameFile 28266 . 30687) (\UFSReadPages 30689 . 31824) (\UFSWritePages 31826 . 33046) (
|
||||
\UFSTruncateFile 33048 . 35562) (\UFSDirectoryNameP 35564 . 37617) (\UFSEventFn 37619 . 38281) (
|
||||
\UFSGetFileInfo 38283 . 42853) (\UFS.CREATE.PROPS 42855 . 43208) (\UFSSetFileInfo 43210 . 45664) (
|
||||
\UFSGenerateFiles 45666 . 53078) (\UFS.NEXTFILEFN 53080 . 61237) (\UFS.FILEINFOFN 61239 . 62688) (
|
||||
\UFS.VALID.PROPP 62690 . 62982) (\UFS.REGISTER.GFS 62984 . 63239) (\UFS.UNREGISTER.GFS 63241 . 63824)
|
||||
(\UFS.ABORT.DIRECTORY 63826 . 64174) (\UFS.ABORT.CL-DIRECTORY 64176 . 64463) (\UFS.CLEANUP.GFS.TABLE
|
||||
64465 . 64647)) (64684 71368 (\UFSMakeUnixFormatName 64694 . 65715) (\UFSParseNameString 65717 . 66091
|
||||
) (\UFSParse-Directory 66093 . 66634) (\UFS.PARSE.BODY 66636 . 67181) (\UFS.ADJUST.HOST 67183 . 67342)
|
||||
(\UFS.FULLNAME 67344 . 68552) (\UFS.ADD.HOST.FIELD 68554 . 68914) (\UFS.REMOVE.HOST.FIELD 68916 .
|
||||
70586) (\UFS.HANDLE.RELATIVEDIRECTORY 70588 . 71366)) (72184 73437 (CHDIR 72194 . 73435)) (73509 74495
|
||||
(\DEVICEFILE.EOSERROR 73519 . 74493)) (74568 75805 (\UNVISIBLE.PAGED.REVALIDATEFILELST 74578 . 75423)
|
||||
(\UNVISIBLE.FLUSH.OPEN.STREAMS 75425 . 75803)) (75838 77464 (\UFSError 75848 . 77462)) (77508 79923 (
|
||||
\UFSGetFileType 77518 . 78119) (\UFSSetFileType 78121 . 78718) (\UFSeol 78720 . 79921)) (88566 89690 (
|
||||
\UFSGetPrintFileType 88576 . 88988) (\UFSGetFileTypeConfirm 88990 . 89438) (\UFSPrintTypeMenu 89440 .
|
||||
89688)) (89720 92558 (\UFStoOtherCopyMess 89730 . 91408) (\UFStoOtherRenameMess 91410 . 92556)))))
|
||||
(FILEMAP (NIL (9311 10864 (\UFSCreateDevice 9321 . 9686) (\UFS.CREATE.DEVICE 9688 . 10544) (
|
||||
\UFSOpenDevice 10546 . 10723) (\UFSCloseDevice 10725 . 10862)) (15127 63821 (\UFSOpenFile 15137 .
|
||||
21713) (\UFS.OPENP 21715 . 22212) (\UFS.RECOGNIZE.FILE 22214 . 23644) (\UFS.DIRECTORY.NAME 23646 .
|
||||
24736) (\UFSCloseFile 24738 . 26797) (\UFSGetFileName 26799 . 26998) (\UFSDeleteFile 27000 . 28194) (
|
||||
\UFSRenameFile 28196 . 30513) (\UFSReadPages 30515 . 31650) (\UFSWritePages 31652 . 32872) (
|
||||
\UFSTruncateFile 32874 . 35280) (\UFSDirectoryNameP 35282 . 37145) (\UFSEventFn 37147 . 37809) (
|
||||
\UFSGetFileInfo 37811 . 42274) (\UFS.CREATE.PROPS 42276 . 42629) (\UFSSetFileInfo 42631 . 44977) (
|
||||
\UFSGenerateFiles 44979 . 52591) (\UFS.NEXTFILEFN 52593 . 60409) (\UFS.FILEINFOFN 60411 . 61860) (
|
||||
\UFS.VALID.PROPP 61862 . 62154) (\UFS.REGISTER.GFS 62156 . 62411) (\UFS.UNREGISTER.GFS 62413 . 62996)
|
||||
(\UFS.ABORT.DIRECTORY 62998 . 63346) (\UFS.ABORT.CL-DIRECTORY 63348 . 63635) (\UFS.CLEANUP.GFS.TABLE
|
||||
63637 . 63819)) (63856 70540 (\UFSMakeUnixFormatName 63866 . 64887) (\UFSParseNameString 64889 . 65263
|
||||
) (\UFSParse-Directory 65265 . 65806) (\UFS.PARSE.BODY 65808 . 66353) (\UFS.ADJUST.HOST 66355 . 66514)
|
||||
(\UFS.FULLNAME 66516 . 67724) (\UFS.ADD.HOST.FIELD 67726 . 68086) (\UFS.REMOVE.HOST.FIELD 68088 .
|
||||
69758) (\UFS.HANDLE.RELATIVEDIRECTORY 69760 . 70538)) (71356 72501 (CHDIR 71366 . 72499)) (72573 73559
|
||||
(\DEVICEFILE.EOSERROR 72583 . 73557)) (73632 74869 (\UNVISIBLE.PAGED.REVALIDATEFILELST 73642 . 74487)
|
||||
(\UNVISIBLE.FLUSH.OPEN.STREAMS 74489 . 74867)) (74902 76528 (\UFSError 74912 . 76526)) (76572 78987 (
|
||||
\UFSGetFileType 76582 . 77183) (\UFSSetFileType 77185 . 77782) (\UFSeol 77784 . 78985)) (87630 88754 (
|
||||
\UFSGetPrintFileType 87640 . 88052) (\UFSGetFileTypeConfirm 88054 . 88502) (\UFSPrintTypeMenu 88504 .
|
||||
88752)) (88784 91622 (\UFStoOtherCopyMess 88794 . 90472) (\UFStoOtherRenameMess 90474 . 91620)))))
|
||||
STOP
|
||||
|
||||
BIN
sources/UFS.LCOM
BIN
sources/UFS.LCOM
Binary file not shown.
Reference in New Issue
Block a user