Compare commits
16 Commits
medley-210
...
medley-210
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
205223c9b1 | ||
|
|
ccc776608d | ||
|
|
25617e383a | ||
|
|
5e6eb4b424 | ||
|
|
7175669633 | ||
|
|
21088d3eff | ||
|
|
8ec1ca966d | ||
|
|
c55239f744 | ||
|
|
d6f7ad7de9 | ||
|
|
0236971881 | ||
|
|
d04f734295 | ||
|
|
27a52b6ce0 | ||
|
|
0e2e16f183 | ||
|
|
b760d005fb | ||
|
|
95c9496780 | ||
|
|
4bb4457d55 |
19
greetfiles/NOGREET
Normal file
19
greetfiles/NOGREET
Normal file
@@ -0,0 +1,19 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "10-Sep-2021 21:25:42" {DSK}<home>larry>medley>greetfiles>NOGREET.;1 537 )
|
||||
|
||||
|
||||
(PRETTYCOMPRINT NOGREETCOMS)
|
||||
|
||||
(RPAQQ NOGREETCOMS [(P (COND ((STKPOS 'GREET)
|
||||
(SETQ USERGREETFILES NIL)
|
||||
(CLOSEF? (INPUT))
|
||||
(RETFROM 'GREET])
|
||||
|
||||
[COND
|
||||
((STKPOS 'GREET)
|
||||
(SETQ USERGREETFILES NIL)
|
||||
(CLOSEF? (INPUT))
|
||||
(RETFROM 'GREET]
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
@@ -1,10 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED "21-Aug-2021 23:33:58"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;9| 263236
|
||||
(FILECREATED "19-Sep-2021 18:08:05"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;9| 260675
|
||||
|
||||
|changes| |to:| (FNS FB.FIX-DIRECTORY-DATES)
|
||||
|changes| |to:| (FNS FB.EDITCOMMAND.ONEFILE)
|
||||
|
||||
|previous| |date:| "21-Aug-2021 23:08:34"
|
||||
|previous| |date:| "21-Aug-2021 23:33:58"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;7|)
|
||||
|
||||
|
||||
@@ -22,11 +22,11 @@
|
||||
(TERPRI T))))
|
||||
(FILES ATTACHEDWINDOW ICONW TABLEBROWSER)
|
||||
(P
|
||||
(* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")
|
||||
(* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")
|
||||
|
||||
(MOVD? 'NILL 'TOTOPW.MODERNIZE))
|
||||
|
||||
(* |;;| "JDS 11/94 FB.ICONSPEC is now an INITVAR so we can create smaller ones in profiles for, e.g., laptops.")
|
||||
(* |;;| "JDS 11/94 FB.ICONSPEC is now an INITVAR so we can create smaller ones in profiles for, e.g., laptops.")
|
||||
|
||||
(INITVARS (FB.EXPUNGE?MENU)
|
||||
(FB.BROWSERFONT DEFAULTFONT)
|
||||
@@ -45,7 +45,7 @@
|
||||
(FB.PROMPTFONT LITTLEFONT)
|
||||
(FB.BROWSER.DIRECTORY.FONT BOLDFONT)))
|
||||
(P
|
||||
(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")
|
||||
(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")
|
||||
|
||||
(FONTSET (FONTSET)))
|
||||
(ADDVARS (CACHEDMENUS FB.EXPUNGE?MENU))
|
||||
@@ -170,16 +170,16 @@ You specify how many versions to keep.")))
|
||||
(VARS FB.VERSION.MENU.ITEMS FB.CLOSE.MENU.ITEMS FB.DEPTH.MENU.ITEMS FB.INFO.MENU.ITEMS
|
||||
FB.DEFAULT.NAME.WIDTH FB.INFO.FIELDS FB.INFOSHADE FB.ITEMUNSELECTEDSHADE
|
||||
FB.ITEMSELECTEDSHADE))
|
||||
(COMS (* \; "Entries")
|
||||
(COMS (* \; "Entries")
|
||||
(COMMANDS "fb")
|
||||
(FNS FB FB.COPYBINARYCOMMAND FB.COPYTEXTCOMMAND FILEBROWSER FB.TABLEBROWSER
|
||||
FB.SELECTEDFILES FB.FETCHFILENAME FB.DIRECTORYP FB.PROMPTWPRINT FB.PROMPTW.FORMAT
|
||||
FB.PROMPTFORINPUT FB.YES-OR-NO-P FB.ALLOW.ABORT \\FB.HARDCOPY.TOFILE.EXTENSION)
|
||||
(* \; "Setup")
|
||||
(* \; "Setup")
|
||||
(FNS FB.STARTUP FB.MAKERIGIDWINDOW)
|
||||
(FNS FB.PRINTFN FB.COPYFN))
|
||||
(COMS (* \;
|
||||
"commands and major subfunctions")
|
||||
(COMS (* \;
|
||||
"commands and major subfunctions")
|
||||
(FNS FB.MENU.WHENSELECTEDFN FB.COMMANDSELECTEDFN FB.SUBITEMP FB.MAKE.BROWSER.BUSY
|
||||
FB.FINISH.COMMAND FB.HANDLE.ABORT.BUTTON)
|
||||
(FNS FB.DELETECOMMAND FB.DELVERCOMMAND FB.IS.NOT.SUBDIRECTORY.ITEM FB.DELVER.FILES
|
||||
@@ -204,7 +204,7 @@ You specify how many versions to keep.")))
|
||||
(FNS FB.EXPUNGECOMMAND FB.NEWPATTERNCOMMAND FB.NEWINFOCOMMAND FB.DEPTHCOMMAND
|
||||
FB.SHAPECOMMAND FB.REMOVE.FILE FB.COUNT.FILE.CHANGE FB.SETNEWPATTERN
|
||||
FB.GET.NEWPATTERN FB.OPTIONSCOMMAND))
|
||||
(COMS (* \; "window functions")
|
||||
(COMS (* \; "window functions")
|
||||
(FNS FB.INFOMENU.SHADEINITIALSELECTIONS FB.INFO.ITEM.NAMED)
|
||||
(FNS FB.MAKECOUNTERWINDOW FB.COUNTERW.REDISPLAYFN FB.UPDATE.COUNTERS
|
||||
FB.DISPLAY.COUNTERS FB.COUNTER.STRING)
|
||||
@@ -253,7 +253,7 @@ You specify how many versions to keep.")))
|
||||
(FILESLOAD ATTACHEDWINDOW ICONW TABLEBROWSER)
|
||||
|
||||
|
||||
(* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")
|
||||
(* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")
|
||||
|
||||
|
||||
(MOVD? 'NILL 'TOTOPW.MODERNIZE)
|
||||
@@ -295,7 +295,7 @@ You specify how many versions to keep.")))
|
||||
(FB.BROWSER.DIRECTORY.FONT BOLDFONT))
|
||||
|
||||
|
||||
(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")
|
||||
(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")
|
||||
|
||||
|
||||
(FONTSET (FONTSET))
|
||||
@@ -1684,84 +1684,49 @@ Your deletions are thus ignored.")))
|
||||
ELSE (FB.FASTSEECOMMAND BROWSER KEY ITEM MENU)))))
|
||||
|
||||
(FB.EDITCOMMAND.ONEFILE
|
||||
(LAMBDA (BROWSER FILE OPTION ITEM MENU) (* \; "Edited 8-Aug-2021 11:16 by rmk:")
|
||||
(* \; "Edited 27-Feb-2021 20:07 by rmk:")
|
||||
(* \; "Edited 1-Feb-88 19:00 by bvm:")
|
||||
(LAMBDA (BROWSER FILE OPTION ITEM MENU) (* \; "Edited 19-Sep-2021 18:07 by rmk:")
|
||||
(* \; "Edited 27-Feb-2021 20:07 by rmk:")
|
||||
(* \; "Edited 1-Feb-88 19:00 by bvm:")
|
||||
|
||||
(* |;;| "Called when we know that FILE is a file, not a directory, and that TEDIT exists. If OPTION is READONLY, we don't want to edit, just view. If FILE is a lisp sourcefile, we execute the font changes by COPY.TEXT.TO.IMAGE.")
|
||||
(* |;;| "Called when we know that FILE is a file, not a directory, and that TEDIT exists. If OPTION is READONLY, we don't want to edit, just view. .")
|
||||
|
||||
(* |;;| "We clear the shade stuff here because we don't want the FB to come up on top of our see/edit region. We don't factor it to the top because we want to do whatever heavy lifting (copying files) before. Don't factor to the end because then it is too late--the TEDIT window was up and then buried. (If TEDIT had a don'topen option, we could set things up, then change the shade, then open. We could also do the manufactured title on the window before it shows.")
|
||||
(* |;;| "We clear the shade stuff here because we don't want the FB to come up on top of our see/edit region. Don't factor to the end because then it is too late--the TEDIT window was up and then buried. (If TEDIT had a don'topen option, we could set things up, then change the shade, then open. We could also do the manufactured title on the window before it shows.")
|
||||
|
||||
(CL:UNLESS OPTION (SETQ OPTION FB.DEFAULT.EDITOR))
|
||||
(CL:MULTIPLE-VALUE-BIND
|
||||
(IGNORE CONDITION)
|
||||
(IGNORE-ERRORS
|
||||
(LET ((ENV (LISPSOURCEFILEP FILE)))
|
||||
(IF ENV
|
||||
THEN (SELECTQ OPTION
|
||||
((LISP NIL TEDIT)
|
||||
(* |;;|
|
||||
"Asks to load prop and edits the coms. We really don't want to use a text editor on a source file.")
|
||||
(CL:UNLESS OPTION (SETQ OPTION FB.DEFAULT.EDITOR)) (* \; "Default editor is TEDIT. ")
|
||||
|
||||
|
||||
(* |;;| "The FUNCALL at the bottom is concerning.")
|
||||
(* |;;| "Unshade the item before we create the TEDIT window, and tell FB.FINISH.COMMAND that we did that. That way, the FB window won't pop up on top.")
|
||||
|
||||
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
|
||||
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
|
||||
(FB.EDITLISPFILE FILE BROWSER))
|
||||
(READONLY (* \; "READONLY on call from SEE")
|
||||
(CL:WITH-OPEN-FILE
|
||||
(STREAM FILE :DIRECTION :INPUT)
|
||||
(LET ((NSTR (OPENTEXTSTREAM)))
|
||||
(\\EXTERNALFORMAT STREAM ENV)
|
||||
(COPY.TEXT.TO.IMAGE STREAM NSTR)
|
||||
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
|
||||
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
|
||||
|
||||
(* |;;| "Unshade the item before we create the TEDIT window, and tell FB.FINISH.COMMAND that we did that. That way, the FB window won't pop up on top.")
|
||||
(* |;;| "The particular item may be a subitem of the EDIT or SEE menu item, in which case we want to unshade that too. Seems a little bruteforce")
|
||||
|
||||
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
|
||||
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM
|
||||
(CL:UNLESS (MEMBER ITEM (FETCH (MENU ITEMS) OF MENU))
|
||||
(FOR I IN (FETCH (MENU ITEMS) OF MENU)
|
||||
WHEN (MEMBER ITEM (CDR (SASSOC 'SUBITEMS I))) DO (SHADEITEM I MENU
|
||||
FB.ITEMUNSELECTEDSHADE)
|
||||
(PUTMENUPROP MENU 'ITEMSHADE
|
||||
(CONS I
|
||||
FB.ITEMUNSELECTEDSHADE
|
||||
))
|
||||
(WINDOWPROP (WFROMDS (TEXTSTREAM
|
||||
(TEDIT NSTR NIL NIL
|
||||
'(READONLY T))))
|
||||
'TITLE
|
||||
(CONCAT "SEE window for " (FULLNAME STREAM))))))
|
||||
(CL:FUNCALL OPTION (MKATOM FILE)))
|
||||
ELSE (SELECTQ OPTION
|
||||
(READONLY
|
||||
))))
|
||||
(CL:MULTIPLE-VALUE-BIND (IGNORE CONDITION)
|
||||
(IGNORE-ERRORS (SELECTQ OPTION
|
||||
(READONLY (TEDIT-SEE FILE))
|
||||
(LISP (* \;
|
||||
"Original code allowed OPTION=NIL in thie branch, but NIL should have been coerced to TEDIT above.")
|
||||
|
||||
(* |;;| "From SEE command. We want to be able to scroll around in the content, can't do that if it isn't random access. So in that case we do a secret NODIRCORE copy and look at that.")
|
||||
(* |;;| "Asks to load prop and edits the coms, presumably with SEDIT. We really don't want to use a text editor on a source file.")
|
||||
|
||||
(CL:WITH-OPEN-FILE
|
||||
(STREAM FILE :DIRECTION :INPUT)
|
||||
(LET ((NSTR))
|
||||
(CL:UNLESS (RANDACCESSP STREAM)
|
||||
(SETQ NSTR (OPENSTREAM
|
||||
'{NODIRCORE}
|
||||
'BOTH
|
||||
'NEW NIL (LIST (LIST 'TYPE
|
||||
(GETFILEINFO
|
||||
STREAM
|
||||
'TYPE)))))
|
||||
(COPYBYTES STREAM NSTR))
|
||||
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
|
||||
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM
|
||||
FB.ITEMUNSELECTEDSHADE))
|
||||
(WINDOWPROP (WFROMDS (TEXTSTREAM (TEDIT (OR NSTR STREAM)
|
||||
NIL NIL
|
||||
'(READONLY T))))
|
||||
'TITLE
|
||||
(CONCAT "SEE window for " (FULLNAME STREAM))))))
|
||||
((TEDIT NIL)
|
||||
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
|
||||
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
|
||||
(TEDIT (MKATOM FILE)))
|
||||
(LISP (FB.PROMPTW.FORMAT BROWSER
|
||||
"Failed because not a Lisp source file"))
|
||||
(CL:FUNCALL OPTION (MKATOM FILE))))))
|
||||
(|if| CONDITION
|
||||
|then| (FB.PROMPTW.FORMAT BROWSER "Failed because ~A" CONDITION)))))
|
||||
(IF (LISPSOURCEFILEP FILE)
|
||||
THEN (FB.EDITLISPFILE FILE BROWSER)
|
||||
ELSE (FB.PROMPTW.FORMAT BROWSER
|
||||
"Failed because not a Lisp source file")))
|
||||
(PROGN
|
||||
(* |;;| "Might just be a call to TEDIT (if OPTION = TEDIT)")
|
||||
|
||||
(CL:FUNCALL OPTION (MKATOM FILE)))))
|
||||
(|if| CONDITION
|
||||
|then| (FB.PROMPTW.FORMAT BROWSER "Failed because ~A" CONDITION)))))
|
||||
|
||||
(FB.EDITLISPFILE
|
||||
(LAMBDA (FILE BROWSER) (* \; "Edited 21-Feb-2021 17:29 by rmk:")
|
||||
@@ -3838,26 +3803,26 @@ then click Recompute"))))
|
||||
|
||||
(RECORD INFOFIELD (INFONAME INFOLABEL INFOWIDTH INFOFORMAT INFOPROTOTYPE))
|
||||
|
||||
(DATATYPE FBFILEDATA ((FILENAME POINTER) (* \; "Full name of this file")
|
||||
(FILEINFO POINTER) (* \; "Plist of attributes")
|
||||
(VERSIONLESSNAME POINTER) (* \; "FILENAME sans version")
|
||||
(DIRECTORYP FLAG) (* \; "True if it's a directory line")
|
||||
(HASDIRPREFIX FLAG) (* \;
|
||||
"True if it has a directory prefix beyond that in common to all the files")
|
||||
(DIRECTORYFILEP FLAG) (* \;
|
||||
"True if the \"file\" in this item is actually a subdirectory")
|
||||
(SIZE POINTER) (* \; "Size of file, for stats")
|
||||
(FILEDEPTH BYTE) (* \;
|
||||
"Number of levels of subdirectory beneath the main pattern--zero for files at that level")
|
||||
(SORTVALUE POINTER) (* \;
|
||||
"Cached value by which we are sorting the dir.")
|
||||
(SUBDIREND WORD) (* \;
|
||||
"Index of last char in subdirectory, or zero if HASDIRPREFIX is false")
|
||||
(STARTOFPNAME WORD) (* \;
|
||||
"Start of name for printing purposes. Same as STARTOFNAME when browser sorted by name")
|
||||
(VERSION WORD) (* \; "Version, or zero if none")
|
||||
(STARTOFNAME WORD) (* \;
|
||||
"Index beyond all directory fields")
|
||||
(DATATYPE FBFILEDATA ((FILENAME POINTER) (* \; "Full name of this file")
|
||||
(FILEINFO POINTER) (* \; "Plist of attributes")
|
||||
(VERSIONLESSNAME POINTER) (* \; "FILENAME sans version")
|
||||
(DIRECTORYP FLAG) (* \; "True if it's a directory line")
|
||||
(HASDIRPREFIX FLAG) (* \;
|
||||
"True if it has a directory prefix beyond that in common to all the files")
|
||||
(DIRECTORYFILEP FLAG) (* \;
|
||||
"True if the \"file\" in this item is actually a subdirectory")
|
||||
(SIZE POINTER) (* \; "Size of file, for stats")
|
||||
(FILEDEPTH BYTE) (* \;
|
||||
"Number of levels of subdirectory beneath the main pattern--zero for files at that level")
|
||||
(SORTVALUE POINTER) (* \;
|
||||
"Cached value by which we are sorting the dir.")
|
||||
(SUBDIREND WORD) (* \;
|
||||
"Index of last char in subdirectory, or zero if HASDIRPREFIX is false")
|
||||
(STARTOFPNAME WORD) (* \;
|
||||
"Start of name for printing purposes. Same as STARTOFNAME when browser sorted by name")
|
||||
(VERSION WORD) (* \; "Version, or zero if none")
|
||||
(STARTOFNAME WORD) (* \;
|
||||
"Index beyond all directory fields")
|
||||
DUMMY)
|
||||
(ACCESSFNS FBFILEDATA ((PRINTNAME (SUBSTRING (FETCH (FBFILEDATA FILENAME
|
||||
)
|
||||
@@ -3872,85 +3837,85 @@ then click Recompute"))))
|
||||
) OF
|
||||
DATUM))))))
|
||||
|
||||
(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG) (* \;
|
||||
"True if we don't want separate subdirectory lines -- subdirs then included in name")
|
||||
(NSPATTERN? FLAG) (* \; "True if host is an ns host")
|
||||
(SHOWUNDELETED? FLAG) (* \;
|
||||
"True if counter window should show `Undeleted' rather than `Total' counts")
|
||||
(PATTERNPARSED? FLAG) (* \;
|
||||
"True if PREPAREDPATTERN, NAMESTART, DIRECTORYSTART are valid")
|
||||
(SORTBYDATE FLAG) (* \;
|
||||
"True if SORTATTRIBUTE is one of the date attributes")
|
||||
(FBREADY FLAG) (* \; "False while FB is enumerating.")
|
||||
(ABORTING FLAG) (* \;
|
||||
"True if enumeration is being aborted")
|
||||
(FIXEDTITLE FLAG) (* \; "True if caller supplied title")
|
||||
(FBCOMPUTEDDEPTH BYTE) (* \;
|
||||
"Depth at the time we enumerated directory (zero for infinite)")
|
||||
(FBDISPLAYEDDEPTH BYTE) (* \;
|
||||
"Depth we are currently displaying (zero for infinite)")
|
||||
(TABLEBROWSER POINTER) (* \;
|
||||
"Pointer to TABLEBROWSER object controlling the browser")
|
||||
(BROWSERWINDOW POINTER) (* \; "Main window")
|
||||
(COUNTERWINDOW POINTER) (* \;
|
||||
"Window that counts files, pages, deletions")
|
||||
(HEADINGWINDOW POINTER) (* \;
|
||||
"Window with headings for browser columns")
|
||||
(INFOMENUW POINTER) (* \;
|
||||
"Window containing choices for info to be displayed, or NIL if none yet")
|
||||
(PROMPTWINDOW POINTER) (* \; "GETPROMPTWINDOW BROWSERWINDOW")
|
||||
(INFODISPLAYED POINTER) (* \;
|
||||
"List of attribute specs to be displayed")
|
||||
(PATTERN POINTER) (* \;
|
||||
"Directory pattern being enumerated")
|
||||
(PREPAREDPATTERN POINTER) (* \; "DIRECTORY.MATCH.SETUP of same")
|
||||
(SEEWINDOW POINTER) (* \;
|
||||
"Primary window used by FAST SEE command")
|
||||
(BROWSERFONT POINTER) (* \; "Font of BROWSERWINDOW")
|
||||
(SORTBY POINTER) (* \;
|
||||
"Sorting function or NIL for default sort")
|
||||
(NAMESTART WORD) (* \;
|
||||
"Index of first character in file name beyond the common prefix shared by all")
|
||||
(DIRECTORYSTART WORD) (* \;
|
||||
"Index of first character of directory in file names")
|
||||
(INFOSTART WORD) (* \;
|
||||
"X position in browser where first col of info is displayed")
|
||||
(NAMEOVERHEAD WORD) (* \;
|
||||
"This plus width of name gives is how much to allow before INFOSTART")
|
||||
(OVERFLOWSPACING WORD) (* \;
|
||||
"Increment between sizes considered for INFOSTART")
|
||||
(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG) (* \;
|
||||
"True if we don't want separate subdirectory lines -- subdirs then included in name")
|
||||
(NSPATTERN? FLAG) (* \; "True if host is an ns host")
|
||||
(SHOWUNDELETED? FLAG) (* \;
|
||||
"True if counter window should show `Undeleted' rather than `Total' counts")
|
||||
(PATTERNPARSED? FLAG) (* \;
|
||||
"True if PREPAREDPATTERN, NAMESTART, DIRECTORYSTART are valid")
|
||||
(SORTBYDATE FLAG) (* \;
|
||||
"True if SORTATTRIBUTE is one of the date attributes")
|
||||
(FBREADY FLAG) (* \; "False while FB is enumerating.")
|
||||
(ABORTING FLAG) (* \;
|
||||
"True if enumeration is being aborted")
|
||||
(FIXEDTITLE FLAG) (* \; "True if caller supplied title")
|
||||
(FBCOMPUTEDDEPTH BYTE) (* \;
|
||||
"Depth at the time we enumerated directory (zero for infinite)")
|
||||
(FBDISPLAYEDDEPTH BYTE) (* \;
|
||||
"Depth we are currently displaying (zero for infinite)")
|
||||
(TABLEBROWSER POINTER) (* \;
|
||||
"Pointer to TABLEBROWSER object controlling the browser")
|
||||
(BROWSERWINDOW POINTER) (* \; "Main window")
|
||||
(COUNTERWINDOW POINTER) (* \;
|
||||
"Window that counts files, pages, deletions")
|
||||
(HEADINGWINDOW POINTER) (* \;
|
||||
"Window with headings for browser columns")
|
||||
(INFOMENUW POINTER) (* \;
|
||||
"Window containing choices for info to be displayed, or NIL if none yet")
|
||||
(PROMPTWINDOW POINTER) (* \; "GETPROMPTWINDOW BROWSERWINDOW")
|
||||
(INFODISPLAYED POINTER) (* \;
|
||||
"List of attribute specs to be displayed")
|
||||
(PATTERN POINTER) (* \;
|
||||
"Directory pattern being enumerated")
|
||||
(PREPAREDPATTERN POINTER) (* \; "DIRECTORY.MATCH.SETUP of same")
|
||||
(SEEWINDOW POINTER) (* \;
|
||||
"Primary window used by FAST SEE command")
|
||||
(BROWSERFONT POINTER) (* \; "Font of BROWSERWINDOW")
|
||||
(SORTBY POINTER) (* \;
|
||||
"Sorting function or NIL for default sort")
|
||||
(NAMESTART WORD) (* \;
|
||||
"Index of first character in file name beyond the common prefix shared by all")
|
||||
(DIRECTORYSTART WORD) (* \;
|
||||
"Index of first character of directory in file names")
|
||||
(INFOSTART WORD) (* \;
|
||||
"X position in browser where first col of info is displayed")
|
||||
(NAMEOVERHEAD WORD) (* \;
|
||||
"This plus width of name gives is how much to allow before INFOSTART")
|
||||
(OVERFLOWSPACING WORD) (* \;
|
||||
"Increment between sizes considered for INFOSTART")
|
||||
(DIGITWIDTH WORD)
|
||||
(TOTALFILES WORD) (* \;
|
||||
"Total number of files, deleted files, pages, deleted pages at the moment")
|
||||
(TOTALFILES WORD) (* \;
|
||||
"Total number of files, deleted files, pages, deleted pages at the moment")
|
||||
(DELETEDFILES WORD)
|
||||
(TOTALPAGES POINTER)
|
||||
(DELETEDPAGES POINTER)
|
||||
(PAGECOUNT? POINTER) (* \;
|
||||
"True if INFOCHOICES includes SIZE or LENGTH, so that we can count pages")
|
||||
(COUNTERPOSITIONS POINTER) (* \;
|
||||
"List of pairs (left right) describing regions where the values of the counters are displayed")
|
||||
(COUNTERPAGESTRING POINTER) (* \;
|
||||
"String to print after file/page count")
|
||||
(OVERFLOWWIDTHS POINTER) (* \;
|
||||
"List of (xpos occurrences) describing files whose names exceed default INFOSTART")
|
||||
(INFOMENUCHOICES POINTER) (* \;
|
||||
"Selections user has made in Info window, not necessarily the info currently displayed")
|
||||
(UPDATEPROC POINTER) (* \;
|
||||
"Process doing an Update (Recompute)")
|
||||
(DEFAULTDIR POINTER) (* \;
|
||||
"Default directory for destination of Copy/Rename")
|
||||
(SORTATTRIBUTE POINTER) (* \;
|
||||
"Attribute being sorted on, or NIL if by name")
|
||||
(PAGECOUNT? POINTER) (* \;
|
||||
"True if INFOCHOICES includes SIZE or LENGTH, so that we can count pages")
|
||||
(COUNTERPOSITIONS POINTER) (* \;
|
||||
"List of pairs (left right) describing regions where the values of the counters are displayed")
|
||||
(COUNTERPAGESTRING POINTER) (* \;
|
||||
"String to print after file/page count")
|
||||
(OVERFLOWWIDTHS POINTER) (* \;
|
||||
"List of (xpos occurrences) describing files whose names exceed default INFOSTART")
|
||||
(INFOMENUCHOICES POINTER) (* \;
|
||||
"Selections user has made in Info window, not necessarily the info currently displayed")
|
||||
(UPDATEPROC POINTER) (* \;
|
||||
"Process doing an Update (Recompute)")
|
||||
(DEFAULTDIR POINTER) (* \;
|
||||
"Default directory for destination of Copy/Rename")
|
||||
(SORTATTRIBUTE POINTER) (* \;
|
||||
"Attribute being sorted on, or NIL if by name")
|
||||
(SORTMENU POINTER)
|
||||
(FBLOCK POINTER) (* \;
|
||||
"Lock acquired by filebrowser operations")
|
||||
(SORTINDEX WORD) (* \;
|
||||
"Index (zero-based) in file info of the sort attribute")
|
||||
(SIZEINDEX WORD) (* \; "Index of size attribute")
|
||||
(FBDEPTH POINTER) (* \;
|
||||
"Enumeration depth, or NIL for default")
|
||||
(ABORTWINDOW POINTER) (* \;
|
||||
"Dotted pair of (abortwindow . menuw) for this browser's abort window.")
|
||||
(FBLOCK POINTER) (* \;
|
||||
"Lock acquired by filebrowser operations")
|
||||
(SORTINDEX WORD) (* \;
|
||||
"Index (zero-based) in file info of the sort attribute")
|
||||
(SIZEINDEX WORD) (* \; "Index of size attribute")
|
||||
(FBDEPTH POINTER) (* \;
|
||||
"Enumeration depth, or NIL for default")
|
||||
(ABORTWINDOW POINTER) (* \;
|
||||
"Dotted pair of (abortwindow . menuw) for this browser's abort window.")
|
||||
DUMMY))
|
||||
)
|
||||
|
||||
@@ -4253,35 +4218,35 @@ FB.UNDELETEALLCOMMAND 69511 . 69790) (FB.UNDELETE.FILE 69792 . 70537)) (70540 94
|
||||
FB.COPY/RENAME.ONE 72023 . 74345) (FB.COPY/RENAME.MANY 74347 . 80567) (FB.MERGE.DIRECTORIES 80569 .
|
||||
80987) (FB.GREATEST.PREFIX 80989 . 82345) (FB.MAYBE.INSERT.FILE 82347 . 89787) (FB.GET.NEW.FILE.SPEC
|
||||
89789 . 93620) (FB.CANONICAL.DIRECTORY 93622 . 94719)) (94722 102506 (FB.HARDCOPYCOMMAND 94732 . 95862
|
||||
) (FB.HARDCOPY.TOFILE 95864 . 102504)) (102507 114945 (FB.EDITCOMMAND 102517 . 103318) (
|
||||
FB.EDITCOMMAND.ONEFILE 103320 . 109161) (FB.EDITLISPFILE 109163 . 110202) (FB.BROWSECOMMAND 110204 .
|
||||
114943)) (114946 126739 (FB.FASTSEECOMMAND 114956 . 118406) (FB.FASTSEE.ONEFILE 118408 . 121437) (
|
||||
FB.SEEFULLFN 121439 . 125570) (FB.SEEBUTTONFN 125572 . 126737)) (126740 128486 (FB.LOADCOMMAND 126750
|
||||
. 127257) (FB.COMPILECOMMAND 127259 . 127797) (FB.OPERATE.ON.FILES 127799 . 128484)) (128487 176145 (
|
||||
FB.UPDATECOMMAND 128497 . 128722) (FB.FIX-DIRECTORY-DATES 128724 . 129331) (FB.MAYBE.EXPUNGE 129333 .
|
||||
130328) (FB.UPDATEBROWSERITEMS 130330 . 143545) (FB.DATE 143547 . 144288) (FB.ADJUST.DATE.WIDTH 144290
|
||||
. 147258) (FB.SET.BROWSER.TITLE 147260 . 148117) (FB.MAYBE.WIDEN.NAMES 148119 . 150238) (
|
||||
FB.SET.DEFAULT.NAME.WIDTH 150240 . 151604) (FB.CREATE.FILEBUCKET 151606 . 158826) (
|
||||
FB.CHECK.NAME.LENGTH 158828 . 161249) (FB.ADD.FILEGROUP 161251 . 162778) (FB.INSERT.DIRECTORY 162780
|
||||
. 163018) (FB.MAKE.SUBDIRECTORY.ITEM 163020 . 164429) (FB.ADD.FILE 164431 . 165044) (FB.INSERT.FILE
|
||||
165046 . 168458) (FB.ANALYZE.PATTERN 168460 . 173724) (FB.CANONICALIZE.PATTERN 173726 . 175038) (
|
||||
FB.GETALLFILEINFO 175040 . 176143)) (176146 184305 (FB.SORT.VERSIONS 176156 . 178927) (
|
||||
FB.DECREASING.VERSION 178929 . 179598) (FB.INCREASING.VERSION 179600 . 180221) (
|
||||
FB.NAMES.DECREASING.VERSION 180223 . 181258) (FB.NAMES.INCREASING.VERSION 181260 . 182257) (
|
||||
FB.DECREASING.NUMERIC.ATTR 182259 . 182939) (FB.INCREASING.NUMERIC.ATTR 182941 . 183615) (
|
||||
FB.ALPHABETIC.ATTR 183617 . 184303)) (184306 194148 (FB.SORTCOMMAND 184316 . 191146) (
|
||||
FB.INSERT.SUBDIRECTORIES 191148 . 191945) (FB.GET.SORT.MENU 191947 . 194146)) (194149 210238 (
|
||||
FB.EXPUNGECOMMAND 194159 . 196678) (FB.NEWPATTERNCOMMAND 196680 . 197078) (FB.NEWINFOCOMMAND 197080 .
|
||||
199846) (FB.DEPTHCOMMAND 199848 . 201623) (FB.SHAPECOMMAND 201625 . 204967) (FB.REMOVE.FILE 204969 .
|
||||
206790) (FB.COUNT.FILE.CHANGE 206792 . 208237) (FB.SETNEWPATTERN 208239 . 209409) (FB.GET.NEWPATTERN
|
||||
209411 . 209995) (FB.OPTIONSCOMMAND 209997 . 210236)) (210273 211285 (
|
||||
FB.INFOMENU.SHADEINITIALSELECTIONS 210283 . 210930) (FB.INFO.ITEM.NAMED 210932 . 211283)) (211286
|
||||
220752 (FB.MAKECOUNTERWINDOW 211296 . 212758) (FB.COUNTERW.REDISPLAYFN 212760 . 213347) (
|
||||
FB.UPDATE.COUNTERS 213349 . 215421) (FB.DISPLAY.COUNTERS 215423 . 220483) (FB.COUNTER.STRING 220485 .
|
||||
220750)) (220753 225396 (FB.MAKEHEADINGWINDOW 220763 . 222311) (FB.HEADINGW.REDISPLAYFN 222313 .
|
||||
222579) (FB.HEADINGW.RESHAPEFN 222581 . 222957) (FB.HEADINGW.DISPLAY 222959 . 225394)) (225397 229580
|
||||
(FB.ICONFN 225407 . 225754) (FB.INFOMENU.WHENSELECTEDFN 225756 . 226486) (FB.CLOSEFN 226488 . 227691)
|
||||
(FB.EXPUNGE?.MENU 227693 . 228105) (FB.AFTERCLOSEFN 228107 . 228468) (FB.CLOSE&EXPUNGE 228470 . 229578
|
||||
)) (229581 241639 (FB.HARDCOPY.DIRECTORY 229591 . 239948) (FB.HARDCOPY.PRINT.TITLE 239950 . 240276) (
|
||||
FB.HARDCOPY.MAXWIDTH 240278 . 241637)))))
|
||||
) (FB.HARDCOPY.TOFILE 95864 . 102504)) (102507 112384 (FB.EDITCOMMAND 102517 . 103318) (
|
||||
FB.EDITCOMMAND.ONEFILE 103320 . 106600) (FB.EDITLISPFILE 106602 . 107641) (FB.BROWSECOMMAND 107643 .
|
||||
112382)) (112385 124178 (FB.FASTSEECOMMAND 112395 . 115845) (FB.FASTSEE.ONEFILE 115847 . 118876) (
|
||||
FB.SEEFULLFN 118878 . 123009) (FB.SEEBUTTONFN 123011 . 124176)) (124179 125925 (FB.LOADCOMMAND 124189
|
||||
. 124696) (FB.COMPILECOMMAND 124698 . 125236) (FB.OPERATE.ON.FILES 125238 . 125923)) (125926 173584 (
|
||||
FB.UPDATECOMMAND 125936 . 126161) (FB.FIX-DIRECTORY-DATES 126163 . 126770) (FB.MAYBE.EXPUNGE 126772 .
|
||||
127767) (FB.UPDATEBROWSERITEMS 127769 . 140984) (FB.DATE 140986 . 141727) (FB.ADJUST.DATE.WIDTH 141729
|
||||
. 144697) (FB.SET.BROWSER.TITLE 144699 . 145556) (FB.MAYBE.WIDEN.NAMES 145558 . 147677) (
|
||||
FB.SET.DEFAULT.NAME.WIDTH 147679 . 149043) (FB.CREATE.FILEBUCKET 149045 . 156265) (
|
||||
FB.CHECK.NAME.LENGTH 156267 . 158688) (FB.ADD.FILEGROUP 158690 . 160217) (FB.INSERT.DIRECTORY 160219
|
||||
. 160457) (FB.MAKE.SUBDIRECTORY.ITEM 160459 . 161868) (FB.ADD.FILE 161870 . 162483) (FB.INSERT.FILE
|
||||
162485 . 165897) (FB.ANALYZE.PATTERN 165899 . 171163) (FB.CANONICALIZE.PATTERN 171165 . 172477) (
|
||||
FB.GETALLFILEINFO 172479 . 173582)) (173585 181744 (FB.SORT.VERSIONS 173595 . 176366) (
|
||||
FB.DECREASING.VERSION 176368 . 177037) (FB.INCREASING.VERSION 177039 . 177660) (
|
||||
FB.NAMES.DECREASING.VERSION 177662 . 178697) (FB.NAMES.INCREASING.VERSION 178699 . 179696) (
|
||||
FB.DECREASING.NUMERIC.ATTR 179698 . 180378) (FB.INCREASING.NUMERIC.ATTR 180380 . 181054) (
|
||||
FB.ALPHABETIC.ATTR 181056 . 181742)) (181745 191587 (FB.SORTCOMMAND 181755 . 188585) (
|
||||
FB.INSERT.SUBDIRECTORIES 188587 . 189384) (FB.GET.SORT.MENU 189386 . 191585)) (191588 207677 (
|
||||
FB.EXPUNGECOMMAND 191598 . 194117) (FB.NEWPATTERNCOMMAND 194119 . 194517) (FB.NEWINFOCOMMAND 194519 .
|
||||
197285) (FB.DEPTHCOMMAND 197287 . 199062) (FB.SHAPECOMMAND 199064 . 202406) (FB.REMOVE.FILE 202408 .
|
||||
204229) (FB.COUNT.FILE.CHANGE 204231 . 205676) (FB.SETNEWPATTERN 205678 . 206848) (FB.GET.NEWPATTERN
|
||||
206850 . 207434) (FB.OPTIONSCOMMAND 207436 . 207675)) (207712 208724 (
|
||||
FB.INFOMENU.SHADEINITIALSELECTIONS 207722 . 208369) (FB.INFO.ITEM.NAMED 208371 . 208722)) (208725
|
||||
218191 (FB.MAKECOUNTERWINDOW 208735 . 210197) (FB.COUNTERW.REDISPLAYFN 210199 . 210786) (
|
||||
FB.UPDATE.COUNTERS 210788 . 212860) (FB.DISPLAY.COUNTERS 212862 . 217922) (FB.COUNTER.STRING 217924 .
|
||||
218189)) (218192 222835 (FB.MAKEHEADINGWINDOW 218202 . 219750) (FB.HEADINGW.REDISPLAYFN 219752 .
|
||||
220018) (FB.HEADINGW.RESHAPEFN 220020 . 220396) (FB.HEADINGW.DISPLAY 220398 . 222833)) (222836 227019
|
||||
(FB.ICONFN 222846 . 223193) (FB.INFOMENU.WHENSELECTEDFN 223195 . 223925) (FB.CLOSEFN 223927 . 225130)
|
||||
(FB.EXPUNGE?.MENU 225132 . 225544) (FB.AFTERCLOSEFN 225546 . 225907) (FB.CLOSE&EXPUNGE 225909 . 227017
|
||||
)) (227020 239078 (FB.HARDCOPY.DIRECTORY 227030 . 237387) (FB.HARDCOPY.PRINT.TITLE 237389 . 237715) (
|
||||
FB.HARDCOPY.MAXWIDTH 237717 . 239076)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
107
library/TEDIT
107
library/TEDIT
@@ -1,14 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "19-Apr-2018 12:22:03" {DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDIT.;2 140045
|
||||
(FILECREATED "19-Sep-2021 17:08:56" {DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;2 141945
|
||||
|
||||
changes to%: (VARS TEDITCOMS)
|
||||
|
||||
previous date%: "21-Jun-99 20:00:16"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDIT.;1)
|
||||
previous date%: "19-Apr-2018 12:22:03"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1995, 1999, 2018 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT TEDITCOMS)
|
||||
@@ -24,40 +24,40 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(TEDIT.DEFAULT.PROPS NIL)
|
||||
(TEDIT.STARTUP.MONITORLOCK (CREATE.MONITORLOCK 'TEDIT.STARTUP))
|
||||
(TEDIT.RESTART.MENU (\CREATE.TEDIT.RESTART.MENU))
|
||||
(* ;
|
||||
"Original was (CREATE MENU ITEMS _ '(NewEditProcess)).")
|
||||
(* ;
|
||||
"Changed by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
(* ;
|
||||
"Original was (CREATE MENU ITEMS _ '(NewEditProcess)).")
|
||||
(* ;
|
||||
"Changed by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
)
|
||||
(GLOBALVARS TEDIT.TENTATIVE TEDIT.DEFAULT.PROPS)
|
||||
(FNS \TEDIT2 COERCETEXTOBJ TEDIT TEDIT.CHARWIDTH TEDIT.COPY TEDIT.DELETE
|
||||
(FNS \TEDIT2 COERCETEXTOBJ TEDIT TEDIT-SEE TEDIT.CHARWIDTH TEDIT.COPY TEDIT.DELETE
|
||||
TEDIT.DO.BLUEPENDINGDELETE TEDIT.INSERT TEDIT.KILL TEDIT.MAPLINES TEDIT.MAPPIECES
|
||||
TEDIT.MOVE TEDIT.QUIT TEDIT.STRINGWIDTH TEDIT.\INSERT TEXTOBJ TEXTSTREAM \TEDIT.INCLUDE
|
||||
\TEDIT.INSERT.PIECES \TEDIT.MOVE.PIECEMAPFN \TEDIT.OBJECT.SHOWSEL \TEDIT.RESTARTFN
|
||||
\TEDIT.CHARDELETE \TEDIT.COPY.PIECEMAPFN \TEDIT.DELETE \TEDIT.DIFFUSE.PARALOOKS
|
||||
\TEDIT.FOREIGN.COPY? \TEDIT.QUIT \TEDIT.WORDDELETE \TEDIT1)
|
||||
(P (MOVD? 'NILL 'OBJECTOUTOFTEDIT))
|
||||
(* ;
|
||||
"HOOK for looked-string copy, etc. Used in \TEDIT.FOREIGN.COPY?.")
|
||||
(* ;
|
||||
"HOOK for looked-string copy, etc. Used in \TEDIT.FOREIGN.COPY?.")
|
||||
(COMS (FNS \CREATE.TEDIT.RESTART.MENU))
|
||||
(* ;
|
||||
"Added by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
(COMS (* ; "Debugging functions")
|
||||
(* ;
|
||||
"Added by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
(COMS (* ; "Debugging functions")
|
||||
(FNS PLCHAIN PRINTLINE SEEFILE))
|
||||
(COMS (* ; "Object-oriented editing")
|
||||
(COMS (* ; "Object-oriented editing")
|
||||
(FNS TEDIT.INSERT.OBJECT TEDIT.EDIT.OBJECT TEDIT.FIND.OBJECT TEDIT.FIND.OBJECT.SUBTREE
|
||||
TEDIT.PUT.OBJECT TEDIT.GET.OBJECT TEDIT.OBJECT.CHANGED))
|
||||
(FILES TEDITFIND TEDITHISTORY TEDITFILE TEDITWINDOW TEDITSELECTION IMAGEOBJ TFBRAVO TEDITHCPY
|
||||
TEDITPAGE TEDITMENU TEDITFNKEYS)
|
||||
(COMS (* ; "TEDIT Support information")
|
||||
(COMS (* ; "TEDIT Support information")
|
||||
(E (SETQ TEDITSYSTEMDATE (DATE)))
|
||||
(VARS TEDITSYSTEMDATE (TEDITSUPPORT "TEditSupport.PA"))
|
||||
(FNS MAKETEDITFORM)
|
||||
(P (ADDTOVAR LAFITESPECIALFORMS ("TEdit Report" 'MAKETEDITFORM
|
||||
"Report a problem with TEdit"))
|
||||
(SETQ LAFITEFORMSMENU NIL)))
|
||||
(COMS (* ;
|
||||
"LISTFILES Interface, so the system can decide if a file is a TEdit file.")
|
||||
(COMS (* ;
|
||||
"LISTFILES Interface, so the system can decide if a file is a TEdit file.")
|
||||
(ADDVARS (PRINTFILETYPES (TEDIT (TEST \TEDIT.FORMATTEDP1)
|
||||
(EXTENSION (TEDIT])
|
||||
|
||||
@@ -327,6 +327,43 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(TTY.PROCESS PROC)))
|
||||
(RETURN PROC])
|
||||
|
||||
(TEDIT-SEE
|
||||
[LAMBDA (FILE WINDOW) (* ; "Edited 19-Sep-2021 09:40 by rmk:")
|
||||
(* ; "Edited 27-Feb-2021 20:07 by rmk:")
|
||||
(* ; "Edited 1-Feb-88 19:00 by bvm:")
|
||||
|
||||
(* ;; "See FILE in a scrollable READONLY TEDIT window. If FILE is a LISP source file, copy first to a temporary NODIRCORE image file that interpretes the fontchange characters rather than showing black boxes.")
|
||||
|
||||
(CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
|
||||
(LET ((SEESTREAM STREAM)
|
||||
ENV TSTREAM)
|
||||
|
||||
(* ;; "No need to fiddle with a TEDIT file")
|
||||
|
||||
(IF (\TEDIT.FORMATTEDP1 STREAM)
|
||||
ELSEIF (SETQ ENV (LISPSOURCEFILEP STREAM))
|
||||
THEN
|
||||
|
||||
(* ;; "Lisp source file")
|
||||
|
||||
(\EXTERNALFORMAT STREAM ENV)
|
||||
(SETQ SEESTREAM (OPENTEXTSTREAM))
|
||||
(COPY.TEXT.TO.IMAGE STREAM SEESTREAM)
|
||||
ELSE
|
||||
|
||||
(* ;; "Not a Lisp source file and not a Tedit file. If it is not random access, we copy it so we can scroll around.")
|
||||
|
||||
(CL:UNLESS (RANDACCESSP STREAM)
|
||||
[SETQ SEESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW
|
||||
`([TYPE ,(GETFILEINFO STREAM 'TYPE]
|
||||
(FORMAT ,(\EXTERNALFORMAT STREAM]
|
||||
(COPYBYTES STREAM SEESTREAM)))
|
||||
[SETQ TSTREAM (TEXTSTREAM (TEDIT SEESTREAM WINDOW NIL '(READONLY T]
|
||||
(WINDOWPROP (WFROMDS TSTREAM)
|
||||
'TITLE
|
||||
(CONCAT "SEE window for " (FULLNAME STREAM)))
|
||||
(FULLNAME STREAM])
|
||||
|
||||
(TEDIT.CHARWIDTH
|
||||
[LAMBDA (CH FONT TERMSA) (* jds "22-OCT-83 19:32")
|
||||
|
||||
@@ -2192,7 +2229,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(* ; "TEDIT Support information")
|
||||
|
||||
|
||||
(RPAQQ TEDITSYSTEMDATE "19-Apr-2018 12:22:04")
|
||||
(RPAQQ TEDITSYSTEMDATE "19-Sep-2021 17:08:56")
|
||||
|
||||
(RPAQ TEDITSUPPORT "TEditSupport.PA")
|
||||
(DEFINEQ
|
||||
@@ -2216,21 +2253,21 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(ADDTOVAR PRINTFILETYPES (TEDIT (TEST \TEDIT.FORMATTEDP1)
|
||||
(EXTENSION (TEDIT))))
|
||||
(PUTPROPS TEDIT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991
|
||||
1992 1993 1995 1999 2018))
|
||||
1992 1993 1995 1999 2018 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4382 115216 (\TEDIT2 4392 . 7143) (COERCETEXTOBJ 7145 . 15921) (TEDIT 15923 . 20892) (
|
||||
TEDIT.CHARWIDTH 20894 . 22918) (TEDIT.COPY 22920 . 31356) (TEDIT.DELETE 31358 . 32048) (
|
||||
TEDIT.DO.BLUEPENDINGDELETE 32050 . 35117) (TEDIT.INSERT 35119 . 40649) (TEDIT.KILL 40651 . 42208) (
|
||||
TEDIT.MAPLINES 42210 . 43609) (TEDIT.MAPPIECES 43611 . 44567) (TEDIT.MOVE 44569 . 54353) (TEDIT.QUIT
|
||||
54355 . 56355) (TEDIT.STRINGWIDTH 56357 . 57028) (TEDIT.\INSERT 57030 . 59055) (TEXTOBJ 59057 . 60182)
|
||||
(TEXTSTREAM 60184 . 61799) (\TEDIT.INCLUDE 61801 . 65701) (\TEDIT.INSERT.PIECES 65703 . 75618) (
|
||||
\TEDIT.MOVE.PIECEMAPFN 75620 . 77699) (\TEDIT.OBJECT.SHOWSEL 77701 . 81330) (\TEDIT.RESTARTFN 81332 .
|
||||
83327) (\TEDIT.CHARDELETE 83329 . 87291) (\TEDIT.COPY.PIECEMAPFN 87293 . 90518) (\TEDIT.DELETE 90520
|
||||
. 98038) (\TEDIT.DIFFUSE.PARALOOKS 98040 . 100804) (\TEDIT.FOREIGN.COPY? 100806 . 104533) (
|
||||
\TEDIT.QUIT 104535 . 107681) (\TEDIT.WORDDELETE 107683 . 112516) (\TEDIT1 112518 . 115214)) (115330
|
||||
115446 (\CREATE.TEDIT.RESTART.MENU 115340 . 115444)) (115545 119234 (PLCHAIN 115555 . 115829) (
|
||||
PRINTLINE 115831 . 118595) (SEEFILE 118597 . 119232)) (119275 138918 (TEDIT.INSERT.OBJECT 119285 .
|
||||
128362) (TEDIT.EDIT.OBJECT 128364 . 130620) (TEDIT.FIND.OBJECT 130622 . 131515) (
|
||||
TEDIT.FIND.OBJECT.SUBTREE 131517 . 132323) (TEDIT.PUT.OBJECT 132325 . 133984) (TEDIT.GET.OBJECT 133986
|
||||
. 137185) (TEDIT.OBJECT.CHANGED 137187 . 138916)) (139196 139559 (MAKETEDITFORM 139206 . 139557)))))
|
||||
(FILEMAP (NIL (4327 117111 (\TEDIT2 4337 . 7088) (COERCETEXTOBJ 7090 . 15866) (TEDIT 15868 . 20837) (
|
||||
TEDIT-SEE 20839 . 22787) (TEDIT.CHARWIDTH 22789 . 24813) (TEDIT.COPY 24815 . 33251) (TEDIT.DELETE
|
||||
33253 . 33943) (TEDIT.DO.BLUEPENDINGDELETE 33945 . 37012) (TEDIT.INSERT 37014 . 42544) (TEDIT.KILL
|
||||
42546 . 44103) (TEDIT.MAPLINES 44105 . 45504) (TEDIT.MAPPIECES 45506 . 46462) (TEDIT.MOVE 46464 .
|
||||
56248) (TEDIT.QUIT 56250 . 58250) (TEDIT.STRINGWIDTH 58252 . 58923) (TEDIT.\INSERT 58925 . 60950) (
|
||||
TEXTOBJ 60952 . 62077) (TEXTSTREAM 62079 . 63694) (\TEDIT.INCLUDE 63696 . 67596) (\TEDIT.INSERT.PIECES
|
||||
67598 . 77513) (\TEDIT.MOVE.PIECEMAPFN 77515 . 79594) (\TEDIT.OBJECT.SHOWSEL 79596 . 83225) (
|
||||
\TEDIT.RESTARTFN 83227 . 85222) (\TEDIT.CHARDELETE 85224 . 89186) (\TEDIT.COPY.PIECEMAPFN 89188 .
|
||||
92413) (\TEDIT.DELETE 92415 . 99933) (\TEDIT.DIFFUSE.PARALOOKS 99935 . 102699) (\TEDIT.FOREIGN.COPY?
|
||||
102701 . 106428) (\TEDIT.QUIT 106430 . 109576) (\TEDIT.WORDDELETE 109578 . 114411) (\TEDIT1 114413 .
|
||||
117109)) (117225 117341 (\CREATE.TEDIT.RESTART.MENU 117235 . 117339)) (117440 121129 (PLCHAIN 117450
|
||||
. 117724) (PRINTLINE 117726 . 120490) (SEEFILE 120492 . 121127)) (121170 140813 (TEDIT.INSERT.OBJECT
|
||||
121180 . 130257) (TEDIT.EDIT.OBJECT 130259 . 132515) (TEDIT.FIND.OBJECT 132517 . 133410) (
|
||||
TEDIT.FIND.OBJECT.SUBTREE 133412 . 134218) (TEDIT.PUT.OBJECT 134220 . 135879) (TEDIT.GET.OBJECT 135881
|
||||
. 139080) (TEDIT.OBJECT.CHANGED 139082 . 140811)) (141091 141454 (MAKETEDITFORM 141101 . 141452)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "28-Jun-2021 12:35:45"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;2 105754
|
||||
(FILECREATED "20-Sep-2021 11:12:06"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;4 105838
|
||||
|
||||
changes to%: (FNS \TEDIT.HARDCOPY.FORMATLINE)
|
||||
changes to%: (FNS TEDIT.HARDCOPYFN)
|
||||
(VARS TEDITHCPYCOMS)
|
||||
|
||||
previous date%: "25-Aug-94 10:54:07"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;1)
|
||||
previous date%: "20-Sep-2021 11:06:37"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;3)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -14,41 +15,40 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(PRETTYCOMPRINT TEDITHCPYCOMS)
|
||||
|
||||
(RPAQQ TEDITHCPYCOMS
|
||||
(RPAQQ TEDITHCPYCOMS
|
||||
((FILES TEDITDCL)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
|
||||
(FILES (LOADCOMP)
|
||||
TEDITDCL))
|
||||
(COMS
|
||||
(* ;; "Generic interface functions and common code")
|
||||
(* ;; "Generic interface functions and common code")
|
||||
|
||||
(FNS TEDIT.HARDCOPY TEDIT.HCPYFILE \TEDIT.HARDCOPY.DISPLAYLINE
|
||||
\TEDIT.HARDCOPY.FORMATLINE \DOFORMATTING.HARDCOPY \TEDIT.HARDCOPY.MODIFYLOOKS
|
||||
\TEDIT.HCPYLOOKS.UPDATE \TEDIT.HCPYFMTSPEC \TEDIT.INTEGER.IMAGEBOX))
|
||||
(COMS
|
||||
(* ;; "Functions for scaling distances and regions as needed during hardcopy.")
|
||||
(* ;; "Functions for scaling distances and regions as needed during hardcopy.")
|
||||
|
||||
(FNS \TEDIT.SCALE \TEDIT.SCALEREGION))
|
||||
(COMS
|
||||
(* ;; "PRESS-specific code")
|
||||
(* ;; "PRESS-specific code")
|
||||
|
||||
(VARS (TEDIT.DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 23495)))
|
||||
(* ;
|
||||
"0.75 inches from bottom, 1 from top")
|
||||
(* ;
|
||||
"0.75 inches from bottom, 1 from top")
|
||||
)
|
||||
[COMS
|
||||
(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.")
|
||||
(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.")
|
||||
|
||||
(FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPY \TEDIT.PRESS.HARDCOPY)
|
||||
(P (LISTPUT (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES))
|
||||
'TEDIT
|
||||
(FUNCTION \TEDIT.HARDCOPY)))
|
||||
[P (LET [(IPVALUES (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES]
|
||||
(COND (IPVALUES (* ;
|
||||
"Only install INTERPRESS printing if INTERPRESS is loaded.")
|
||||
(LISTPUT IPVALUES 'TEDIT (FUNCTION \TEDIT.HARDCOPY]
|
||||
(P (LET [(PRESSVALUES (ASSOC 'CONVERSION (ASSOC 'PRESS PRINTFILETYPES]
|
||||
(COND (PRESSVALUES (* ;
|
||||
"Only install PRESS printing if PRESS is loaded.")
|
||||
(LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY]
|
||||
(COND (PRESSVALUES (LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY]
|
||||
(COMS
|
||||
(* ;; "vars for Japanese Line Break")
|
||||
(* ;; "vars for Japanese Line Break")
|
||||
|
||||
[VARS (TEDIT.DONT.BREAK.CHARS '(8482 8483 8491 8492 8508 8525 8539 8537 8535 9249 9251
|
||||
9253 9255 9257 9283 9315 9317 9319 9326 9505 9507
|
||||
@@ -56,7 +56,7 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
|
||||
(TEDIT.DONT.LAST.CHARS '(8524 8538 8536 8534]
|
||||
(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS))
|
||||
(COMS
|
||||
(* ;; "Support for hardcopying several files as one document")
|
||||
(* ;; "Support for hardcopying several files as one document")
|
||||
|
||||
(FNS TEDIT-BOOK))))
|
||||
|
||||
@@ -1512,22 +1512,22 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.HARDCOPYFN
|
||||
[LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 12-Jun-90 18:35 by mitani")
|
||||
[LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 20-Sep-2021 11:12 by rmk:")
|
||||
|
||||
(* ;;
|
||||
"This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.")
|
||||
(* ;;
|
||||
"This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.")
|
||||
|
||||
(PROG ((TEXTOBJ (TEXTOBJ WINDOW))
|
||||
(TEXTSTREAM (TEXTSTREAM WINDOW)))
|
||||
|
||||
(* ;; "TEXTSTREAM is bound here so we don't drop the steam on the floor if the window goes away, since the TEXTOBJ only has an XPOINTER to the stream in it. Please don't remove this binding!")
|
||||
(* ;; "TEXTSTREAM is bound here so we don't drop the steam on the floor if the window goes away, since the TEXTOBJ only has an XPOINTER to the stream in it. Please don't remove this binding!")
|
||||
|
||||
(RESETLST
|
||||
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
|
||||
'(AND (\TEDIT.MARKINACTIVE OLDVALUE]
|
||||
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with 'Hardcopy)
|
||||
(TEDIT.FORMAT.HARDCOPY TEXTOBJ IMAGESTREAM))) (* ; "Build the hardcopy")
|
||||
])
|
||||
(* ; "Build the hardcopy")
|
||||
(TEDIT.FORMAT.HARDCOPY TEXTOBJ IMAGESTREAM))])
|
||||
|
||||
(\TEDIT.HARDCOPY
|
||||
[LAMBDA (FILE PFILE) (* ; "Edited 12-Jun-90 18:35 by mitani")
|
||||
@@ -1562,24 +1562,24 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
|
||||
PFILE)])
|
||||
)
|
||||
|
||||
(LISTPUT (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES))
|
||||
'TEDIT
|
||||
(FUNCTION \TEDIT.HARDCOPY))
|
||||
[LET [(IPVALUES (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES]
|
||||
(COND
|
||||
(IPVALUES (* ;
|
||||
"Only install INTERPRESS printing if INTERPRESS is loaded.")
|
||||
(LISTPUT IPVALUES 'TEDIT (FUNCTION \TEDIT.HARDCOPY]
|
||||
|
||||
[LET [(PRESSVALUES (ASSOC 'CONVERSION (ASSOC 'PRESS PRINTFILETYPES]
|
||||
(COND
|
||||
(PRESSVALUES (* ;
|
||||
"Only install PRESS printing if PRESS is loaded.")
|
||||
(LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY]
|
||||
(PRESSVALUES (LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY]
|
||||
|
||||
|
||||
|
||||
(* ;; "vars for Japanese Line Break")
|
||||
|
||||
|
||||
(RPAQQ TEDIT.DONT.BREAK.CHARS (8482 8483 8491 8492 8508 8525 8539 8537 8535 9249 9251 9253 9255
|
||||
9257 9283 9315 9317 9319 9326 9505 9507 9509 9511 9513 9539
|
||||
9571 9573 9575 9582))
|
||||
(RPAQQ TEDIT.DONT.BREAK.CHARS
|
||||
(8482 8483 8491 8492 8508 8525 8539 8537 8535 9249 9251 9253 9255 9257 9283 9315 9317 9319
|
||||
9326 9505 9507 9509 9511 9513 9539 9571 9573 9575 9582))
|
||||
|
||||
(RPAQQ TEDIT.DONT.LAST.CHARS (8524 8538 8536 8534))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
@@ -1612,11 +1612,11 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
|
||||
(PUTPROPS TEDITHCPY COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
|
||||
1991 1992 1993 1994 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3088 99806 (TEDIT.HARDCOPY 3098 . 4349) (TEDIT.HCPYFILE 4351 . 6425) (
|
||||
\TEDIT.HARDCOPY.DISPLAYLINE 6427 . 20572) (\TEDIT.HARDCOPY.FORMATLINE 20574 . 67896) (
|
||||
\DOFORMATTING.HARDCOPY 67898 . 81191) (\TEDIT.HARDCOPY.MODIFYLOOKS 81193 . 83600) (
|
||||
\TEDIT.HCPYLOOKS.UPDATE 83602 . 94210) (\TEDIT.HCPYFMTSPEC 94212 . 99232) (\TEDIT.INTEGER.IMAGEBOX
|
||||
99234 . 99804)) (99895 100979 (\TEDIT.SCALE 99905 . 100199) (\TEDIT.SCALEREGION 100201 . 100977)) (
|
||||
101222 103719 (TEDIT.HARDCOPYFN 101232 . 102083) (\TEDIT.HARDCOPY 102085 . 102994) (
|
||||
\TEDIT.PRESS.HARDCOPY 102996 . 103717)) (104701 105604 (TEDIT-BOOK 104711 . 105602)))))
|
||||
(FILEMAP (NIL (3137 99855 (TEDIT.HARDCOPY 3147 . 4398) (TEDIT.HCPYFILE 4400 . 6474) (
|
||||
\TEDIT.HARDCOPY.DISPLAYLINE 6476 . 20621) (\TEDIT.HARDCOPY.FORMATLINE 20623 . 67945) (
|
||||
\DOFORMATTING.HARDCOPY 67947 . 81240) (\TEDIT.HARDCOPY.MODIFYLOOKS 81242 . 83649) (
|
||||
\TEDIT.HCPYLOOKS.UPDATE 83651 . 94259) (\TEDIT.HCPYFMTSPEC 94261 . 99281) (\TEDIT.INTEGER.IMAGEBOX
|
||||
99283 . 99853)) (99944 101028 (\TEDIT.SCALE 99954 . 100248) (\TEDIT.SCALEREGION 100250 . 101026)) (
|
||||
101271 103822 (TEDIT.HARDCOPYFN 101281 . 102186) (\TEDIT.HARDCOPY 102188 . 103097) (
|
||||
\TEDIT.PRESS.HARDCOPY 103099 . 103820)) (104785 105688 (TEDIT-BOOK 104795 . 105686)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "24-Aug-2021 23:30:39"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;3 185251
|
||||
(FILECREATED "19-Sep-2021 23:11:04"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;10 186372
|
||||
|
||||
changes to%: (FNS \TEDIT.BUTTONEVENTFN TEXTSTREAM.TITLE \TEDIT.ORIGINAL.WINDOW.TITLE)
|
||||
changes to%: (FNS \TEDIT.SCROLLFN)
|
||||
|
||||
previous date%: "21-Jun-99 20:00:42"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;1)
|
||||
previous date%: "19-Sep-2021 22:58:18"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;9)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -29,29 +29,29 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
\TEDIT.UNSPLITCURSOR \TEDIT.MAKESPLITCURSOR)
|
||||
(INITVARS (TEDIT.DEFAULT.WINDOW NIL))
|
||||
(GLOBALVARS TEDIT.DEFAULT.WINDOW)
|
||||
(COMS (* ;
|
||||
"User-level %"is this a TEdit window?%" function.")
|
||||
(COMS (* ;
|
||||
"User-level %"is this a TEdit window?%" function.")
|
||||
(FNS TEDITWINDOWP))
|
||||
(COMS (* ; "User-typein support")
|
||||
(COMS (* ; "User-typein support")
|
||||
(FNS TEDIT.GETINPUT \TEDIT.MAKEFILENAME))
|
||||
(COMS (* ; "Attached Prompt window support.")
|
||||
(COMS (* ; "Attached Prompt window support.")
|
||||
(FNS TEDIT.PROMPTPRINT TEDIT.PROMPTFLASH \TEDIT.PROMPT.PAGEFULLFN)
|
||||
(INITVARS (TEDIT.PROMPT.FONT (FONTCREATE 'GACHA 10))
|
||||
(TEDIT.PROMPTWINDOW.HEIGHT NIL))
|
||||
(GLOBALVARS TEDIT.PROMPT.FONT TEDIT.PROMPTWINDOW.HEIGHT))
|
||||
(COMS (* ; "Title creation and update")
|
||||
(COMS (* ; "Title creation and update")
|
||||
(FNS TEXTSTREAM.TITLE \TEDIT.ORIGINAL.WINDOW.TITLE \TEDIT.WINDOW.TITLE
|
||||
\TEXTSTREAM.FILENAME))
|
||||
(COMS (* ; "Screen updating utilities")
|
||||
(COMS (* ; "Screen updating utilities")
|
||||
(FNS TEDIT.DEACTIVATE.WINDOW \TEDIT.REPAINTFN \TEDIT.RESHAPEFN \TEDIT.SCROLLFN))
|
||||
(COMS (* ; "Process-world interfaces")
|
||||
(COMS (* ; "Process-world interfaces")
|
||||
(FNS \TEDIT.PROCIDLEFN \TEDIT.PROCENTRYFN \TEDIT.PROCEXITFN))
|
||||
(COMS (INITVARS (\CARETRATE 333))
|
||||
(* ;
|
||||
"Caret handler; stolen from CHAT.")
|
||||
(* ;
|
||||
"Caret handler; stolen from CHAT.")
|
||||
(FNS \EDIT.DOWNCARET \EDIT.FLIPCARET TEDIT.FLASHCARET \EDIT.UPCARET
|
||||
TEDIT.NORMALIZECARET \SETCARET \TEDIT.CARET))
|
||||
[COMS (* ; "Menu interfacing")
|
||||
[COMS (* ; "Menu interfacing")
|
||||
(FNS TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENUFN TEDIT.REMOVE.MENUITEM \TEDIT.CREATEMENU
|
||||
\TEDIT.MENU.WHENHELDFN \TEDIT.MENU.WHENSELECTEDFN)
|
||||
(GLOBALVARS TEDIT.DEFAULT.MENU)
|
||||
@@ -79,21 +79,21 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
'(TEdit '(TEDIT)
|
||||
"Opens a TEdit window for use."]
|
||||
(SETQ BackgroundMenu NIL]
|
||||
(COMS (* ; "titled icon info")
|
||||
(COMS (* ; "titled icon info")
|
||||
(FILES ICONW)
|
||||
(BITMAPS TEDITICON TEDITMASK)
|
||||
(INITVARS (TEDIT.ICON.FONT (FONTCREATE 'HELVETICA 8 'BOLD))
|
||||
[TEDIT.ICON.TITLE.REGION (CONS 16 (CONS 4 (CONS 64 (CONS 77 NIL]
|
||||
(* ;
|
||||
"Original was (create REGION BOTTOM _ 4 LEFT _ 16 WIDTH _ 64 HEIGHT _ 77).")
|
||||
(* ;
|
||||
"Changed by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
(* ;
|
||||
"Original was (create REGION BOTTOM _ 4 LEFT _ 16 WIDTH _ 64 HEIGHT _ 77).")
|
||||
(* ;
|
||||
"Changed by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
[TEDIT.TITLED.ICON.TEMPLATE (CONS TEDITICON (CONS TEDITMASK (CONS
|
||||
TEDIT.ICON.TITLE.REGION
|
||||
NIL]
|
||||
(* ; "Original was (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION).")
|
||||
(* ;
|
||||
"Changed by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
(* ; "Original was (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION).")
|
||||
(* ;
|
||||
"Changed by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
])
|
||||
|
||||
(FILESLOAD TEDITDCL)
|
||||
@@ -454,342 +454,345 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
(PROCESSP (WINDOWPROP W 'PROCESS])
|
||||
|
||||
(\TEDIT.BUTTONEVENTFN
|
||||
[LAMBDA (W STREAM) (* ; "Edited 24-Aug-2021 23:30 by rmk:")
|
||||
[LAMBDA (W STREAM) (* ; "Edited 19-Sep-2021 22:58 by rmk:")
|
||||
|
||||
(* ;; "Handle button events for a TEdit window")
|
||||
(* ;; "Handle button events for a TEdit window. If no button is down, we got control on button-up transition, so ignore it.")
|
||||
|
||||
(AND STREAM (SETQ STREAM (TEXTOBJ STREAM)))
|
||||
(PROG* ((OSEL NIL)
|
||||
(SEL NIL)
|
||||
[TEXTOBJ (OR STREAM (WINDOWPROP W 'TEXTOBJ]
|
||||
(DS (WINDOWPROP W 'DSP))
|
||||
USERFN
|
||||
(GLOBALSEL TEDIT.SELECTION)
|
||||
(X (LASTMOUSEX W))
|
||||
(Y (LASTMOUSEY W))
|
||||
(CLIPREGION (DSPCLIPPINGREGION NIL W))
|
||||
(SELOPERATION 'NORMAL)
|
||||
(SELFN (TEXTPROP TEXTOBJ 'SELFN))
|
||||
(EXTENDFLG NIL)
|
||||
(OLDX -32000)
|
||||
(OLDY -32000)
|
||||
SELFINALFN PROC NOSEL)
|
||||
(COND
|
||||
((NOT (MOUSESTATE (OR LEFT MIDDLE RIGHT))) (* ;
|
||||
"No button is down -- we got control on button-up transition, so ignore it.")
|
||||
(RETURN))
|
||||
(TEDIT.SELPENDING (* ;
|
||||
"There is already a selection in progress. Don't allow another to interfere.")
|
||||
(RETURN)))
|
||||
(replace (SELECTION CH#) of TEDIT.SCRATCHSELECTION with 0)
|
||||
(* ;
|
||||
"Mark the user-visible scratch selection fresh, so changes can be detected...")
|
||||
(COND
|
||||
[[OR (NOT TEXTOBJ)
|
||||
(fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)
|
||||
(AND (NOT (WINDOWPROP W 'PROCESS))
|
||||
(NOT (TEXTPROP TEXTOBJ 'READONLY))
|
||||
(NOT (SHIFTDOWNP 'SHIFT))
|
||||
(NOT (SHIFTDOWNP 'CTRL))
|
||||
(NOT (SHIFTDOWNP 'META))
|
||||
(NOT (KEYDOWNP 'MOVE))
|
||||
(NOT (KEYDOWNP 'COPY] (* ; "There's no edit session behind this window. You can only do window ops, or re-establish a session.")
|
||||
(TOTOPW W)
|
||||
(COND
|
||||
((\TEDIT.MOUSESTATE RIGHT) (* ;
|
||||
"Right button gets the window command menu")
|
||||
(DOWINDOWCOM W))
|
||||
((AND TEXTOBJ (NOT (TEXTPROP TEXTOBJ 'READONLY))
|
||||
(NOT (TEXTPROP TEXTOBJ 'SELECTONLY))
|
||||
[NOT (PROCESSP (WINDOWPROP W 'PROCESS]
|
||||
(\TEDIT.MOUSESTATE MIDDLE)) (* ;
|
||||
"Middle button on a dead window gives a menu for re-starting TEDIT")
|
||||
(COND
|
||||
((EQ (MENU TEDIT.RESTART.MENU)
|
||||
'NewEditProcess)
|
||||
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL)
|
||||
(TEDIT (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
|
||||
W]
|
||||
[(IGREATERP Y (fetch TOP of CLIPREGION))
|
||||
(* ;
|
||||
"It's not inside the window's REAL region, so call on a menu.")
|
||||
(TOTOPW W)
|
||||
(TOTOPW W)
|
||||
|
||||
(* ;; "RMK: This comment was originally just after the DON'T below, which generated a value-of-comment used message.")
|
||||
(* ;; "RMK: 2021/9 TOTOPW was in (almost) all the conditional branches, I moved it up so that it always happens, even if the click is perhaps in a menu. There were cases where a second click in the window was needed to bring it above an overlapping window that it was under. I think perhaps it was because the mouse button may not have been seen as down on the first click, so it would return before it raised the window. But that was really bizarre--maybe the click was to see what was obscured by the overlapping window.")
|
||||
|
||||
(* ;; "HAD BEEN: (COND ((AND (SETQ PROC (WINDOWPROP W 'PROCESS)) (PROCESSP PROC)) ; This window has a live process behind it; go evaluate the button fn there. (PROCESS.APPLY PROC USERFN (LIST W))) (T ; Otherwise, create a new process to handle the menu. (ADD.PROCESS (LIST USERFN (KWOTE W)))))")
|
||||
(CL:WHEN (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT))
|
||||
(NOT TEDIT.SELPENDING))
|
||||
|
||||
(COND
|
||||
((\TEDIT.MOUSESTATE RIGHT)
|
||||
(DOWINDOWCOM W))
|
||||
((MOUSESTATE (OR LEFT MIDDLE))
|
||||
(AND TEXTOBJ (SETQ USERFN (WINDOWPROP W 'TEDIT.TITLEMENUFN))
|
||||
(NEQ USERFN 'DON'T)
|
||||
(ADD.PROCESS (LIST USERFN (KWOTE W]
|
||||
((AND TEXTOBJ (EQ (fetch (TEXTOBJ MOUSEREGION) of TEXTOBJ)
|
||||
'WINDOW)) (* ;
|
||||
"We're in the window-ops region of the window. Do a window split or something")
|
||||
(\TEDIT.WINDOW.OPS TEXTOBJ W))
|
||||
((AND TEXTOBJ (NOT (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ)))
|
||||
(* ;
|
||||
"Usual case -- he's really selecting something. And there's nothing else going on now.")
|
||||
(TOTOPW W) (* ;
|
||||
"Move the editing window to the top, so he can select wherever he wants.")
|
||||
(\CARET.DOWN) (* ;
|
||||
"Make sure the caret isn't being displayed.")
|
||||
(RESETLST
|
||||
(RESETSAVE TEDIT.SELPENDING TEXTOBJ)
|
||||
(* ;; "(RMK: old comment): Bail out if the mouse isn't down or there is a pending selection--don't want another selection to interfere.")
|
||||
|
||||
(* ;; "Tell all TEdits not to run, since there is a selection in progress. This is reset to NIL on return from here, to re-enable TEdit runs.")
|
||||
(AND STREAM (SETQ STREAM (TEXTOBJ STREAM)))
|
||||
[LET* ((OSEL NIL)
|
||||
(SEL NIL)
|
||||
[TEXTOBJ (OR STREAM (WINDOWPROP W 'TEXTOBJ]
|
||||
(DS (WINDOWPROP W 'DSP))
|
||||
USERFN
|
||||
(GLOBALSEL TEDIT.SELECTION)
|
||||
(X (LASTMOUSEX W))
|
||||
(Y (LASTMOUSEY W))
|
||||
(CLIPREGION (DSPCLIPPINGREGION NIL W))
|
||||
(SELOPERATION 'NORMAL)
|
||||
(SELFN (TEXTPROP TEXTOBJ 'SELFN))
|
||||
(EXTENDFLG NIL)
|
||||
(OLDX -32000)
|
||||
(OLDY -32000)
|
||||
SELFINALFN PROC NOSEL)
|
||||
(replace (SELECTION CH#) of TEDIT.SCRATCHSELECTION with 0)
|
||||
(* ;
|
||||
"Mark the user-visible scratch selection fresh, so changes can be detected...")
|
||||
(COND
|
||||
[[OR (NOT TEXTOBJ)
|
||||
(fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)
|
||||
(AND (NOT (WINDOWPROP W 'PROCESS))
|
||||
(NOT (TEXTPROP TEXTOBJ 'READONLY))
|
||||
(NOT (SHIFTDOWNP 'SHIFT))
|
||||
(NOT (SHIFTDOWNP 'CTRL))
|
||||
(NOT (SHIFTDOWNP 'META))
|
||||
(NOT (KEYDOWNP 'MOVE))
|
||||
(NOT (KEYDOWNP 'COPY] (* ; "There's no edit session behind this window. You can only do window ops, or re-establish a session.")
|
||||
(COND
|
||||
((\TEDIT.MOUSESTATE RIGHT) (* ;
|
||||
"Right button gets the window command menu")
|
||||
(DOWINDOWCOM W))
|
||||
((AND TEXTOBJ (NOT (TEXTPROP TEXTOBJ 'READONLY))
|
||||
(NOT (TEXTPROP TEXTOBJ 'SELECTONLY))
|
||||
[NOT (PROCESSP (WINDOWPROP W 'PROCESS]
|
||||
(\TEDIT.MOUSESTATE MIDDLE)) (* ;
|
||||
"Middle button on a dead window gives a menu for re-starting TEDIT")
|
||||
(COND
|
||||
((EQ (MENU TEDIT.RESTART.MENU)
|
||||
'NewEditProcess)
|
||||
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL)
|
||||
(TEDIT (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
|
||||
W]
|
||||
[(IGREATERP Y (fetch TOP of CLIPREGION))
|
||||
(* ;
|
||||
"It's not inside the window's REAL region, so call on a menu.")
|
||||
|
||||
(RESETSAVE (for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ)
|
||||
do (replace TCCARET of CARET with (\CARET.CREATE
|
||||
BXHICARET)))
|
||||
(LIST '\TEDIT.CARET (fetch (TEXTOBJ CARET) of TEXTOBJ)))
|
||||
(* ;
|
||||
"Then make the caret be the special, tall one so he can see it.")
|
||||
(COND
|
||||
((KEYDOWNP 'COPY) (* ;
|
||||
"In a read-only document, you can only copy.")
|
||||
(SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
|
||||
(SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))
|
||||
(SETQ SELOPERATION 'COPY))
|
||||
((AND (KEYDOWNP 'MOVE)
|
||||
(NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)))
|
||||
(* ;
|
||||
"The MOVE key is down, so set MOVE mode.")
|
||||
(SETQ GLOBALSEL TEDIT.MOVESELECTION)
|
||||
(SETQ OSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))
|
||||
(SETQ SELOPERATION 'MOVE))
|
||||
[(SHIFTDOWNP 'SHIFT) (* ;
|
||||
"the SHIFT key is down; mark this selection for COPY or MOVE.")
|
||||
(COND
|
||||
((AND (SHIFTDOWNP 'CTRL)
|
||||
(NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)))
|
||||
(* ; "CTRL-SHIFT select means MOVE.")
|
||||
(SETQ GLOBALSEL TEDIT.MOVESELECTION)
|
||||
(SETQ OSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))
|
||||
(SETQ SELOPERATION 'MOVE))
|
||||
(T (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
|
||||
(SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))
|
||||
(SETQ SELOPERATION 'COPY]
|
||||
((SHIFTDOWNP 'META) (* ;
|
||||
"He's holding the meta key down , do a copylooks selection")
|
||||
(SETQ GLOBALSEL TEDIT.COPYLOOKSSELECTION)
|
||||
(SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))
|
||||
(SETQ SELOPERATION 'COPYLOOKS))
|
||||
((AND (SHIFTDOWNP 'CTRL)
|
||||
(NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)))
|
||||
(* ;
|
||||
"He's holding the control key down; note the fact.")
|
||||
(\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
|
||||
NIL NIL)
|
||||
(SETQ GLOBALSEL TEDIT.DELETESELECTION)
|
||||
[COND
|
||||
((fetch (SELECTION SET) of (fetch (TEXTOBJ DELETESEL)
|
||||
of TEXTOBJ))
|
||||
(* ;
|
||||
"There's a pending delete selection. Use it, and turn off the existing normal selection.")
|
||||
)
|
||||
(T (* ;
|
||||
"No existing delete selection. Use the normal selection as a starting point.")
|
||||
(\COPYSEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
|
||||
(fetch (TEXTOBJ DELETESEL) of TEXTOBJ]
|
||||
(replace (SELECTION SET) of (fetch (TEXTOBJ SEL) of TEXTOBJ)
|
||||
with NIL)
|
||||
(* ;; "RMK: This comment was originally just after the DON'T below, which generated a value-of-comment used message.")
|
||||
|
||||
(* ;; "Remember to turn off the normal selection, since we'll be moving it to a new spot after the deletion.")
|
||||
(* ;; "HAD BEEN: (COND ((AND (SETQ PROC (WINDOWPROP W 'PROCESS)) (PROCESSP PROC)) ; This window has a live process behind it; go evaluate the button fn there. (PROCESS.APPLY PROC USERFN (LIST W))) (T ; Otherwise, create a new process to handle the menu. (ADD.PROCESS (LIST USERFN (KWOTE W)))))")
|
||||
|
||||
(SETQ OSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ))
|
||||
(SETQ SELOPERATION 'DELETE)
|
||||
(TEDIT.SET.SEL.LOOKS OSEL 'DELETE)
|
||||
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with NIL))
|
||||
(T (SETQ OSEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with NIL)
|
||||
(* ; "Reset the pending-delete flag.")
|
||||
))
|
||||
(\COPYSEL OSEL GLOBALSEL)
|
||||
(bind (OSELOP _ SELOPERATION)
|
||||
while [OR (SHIFTDOWNP 'SHIFT)
|
||||
(SHIFTDOWNP 'CTRL)
|
||||
(SHIFTDOWNP 'META)
|
||||
(KEYDOWNP 'MOVE)
|
||||
(KEYDOWNP 'COPY)
|
||||
(NOT (ZEROP (LOGAND LASTMOUSEBUTTONS 7]
|
||||
do (* ;
|
||||
"Poll the selection & display its current state")
|
||||
[COND
|
||||
((ZEROP (LOGAND LASTMOUSEBUTTONS 7))
|
||||
(* ;
|
||||
"No mouse buttons are down; don't try anything.")
|
||||
(SETQ OLDX -32000) (* ;
|
||||
"However, remember that pushing a mouse button is a change of status that we should notice.")
|
||||
)
|
||||
((KEYDOWNP 'MOVE) (* ;
|
||||
"the MOVE key is down; mark this selection for MOVE.")
|
||||
(SETQ SELOPERATION 'MOVE))
|
||||
[(OR (SHIFTDOWNP 'SHIFT)
|
||||
(KEYDOWNP 'COPY)) (* ;
|
||||
"the SHIFT key is down; mark this selection for COPY or MOVE.")
|
||||
(COND
|
||||
((SHIFTDOWNP 'CTRL) (* ;
|
||||
"He's holding down both ctrl and shift -- do a move.")
|
||||
(SETQ SELOPERATION 'MOVE))
|
||||
(T (* ;
|
||||
"Just the SHIFT key. It's a COPY")
|
||||
(SETQ SELOPERATION 'COPY]
|
||||
((SHIFTDOWNP 'META) (* ;
|
||||
"He's holding the meta key down; note the fact.")
|
||||
(SETQ SELOPERATION 'COPYLOOKS))
|
||||
((SHIFTDOWNP 'CTRL) (* ;
|
||||
"He's holding only the CTRL key -- mark the selection for deletion.")
|
||||
(SETQ SELOPERATION 'DELETE))
|
||||
(T (* ;
|
||||
"No key being held down; revert to normal selection.")
|
||||
(SETQ SELOPERATION 'NORMAL]
|
||||
(COND
|
||||
[(AND (OR [NOT (IEQP OLDX (SETQ X (LASTMOUSEX DS]
|
||||
[NOT (IEQP OLDY (SETQ Y (LASTMOUSEY DS]
|
||||
(NEQ OSELOP SELOPERATION))
|
||||
(INSIDEP CLIPREGION X Y))
|
||||
(COND
|
||||
((\TEDIT.MOUSESTATE RIGHT)
|
||||
(DOWINDOWCOM W))
|
||||
((MOUSESTATE (OR LEFT MIDDLE))
|
||||
(AND TEXTOBJ (SETQ USERFN (WINDOWPROP W 'TEDIT.TITLEMENUFN))
|
||||
(NEQ USERFN 'DON'T)
|
||||
(ADD.PROCESS (LIST USERFN (KWOTE W]
|
||||
((AND TEXTOBJ (EQ (fetch (TEXTOBJ MOUSEREGION) of TEXTOBJ)
|
||||
'WINDOW)) (* ;
|
||||
"We're in the window-ops region of the window. Do a window split or something")
|
||||
(\TEDIT.WINDOW.OPS TEXTOBJ W))
|
||||
((AND TEXTOBJ (NOT (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ)))
|
||||
(* ;
|
||||
"Usual case -- he's really selecting something. And there's nothing else going on now.")
|
||||
(\CARET.DOWN) (* ;
|
||||
"Make sure the caret isn't being displayed.")
|
||||
(RESETLST
|
||||
(RESETSAVE TEDIT.SELPENDING TEXTOBJ)
|
||||
|
||||
(* ;; "Only do selection if (1) the mouse is inside the window proper and (2) the mouse has moved, or the kind of selection has changed")
|
||||
(* ;; "Tell all TEdits not to run, since there is a selection in progress. This is reset to NIL on return from here, to re-enable TEdit runs.")
|
||||
|
||||
(* ;; "Must precede the scroll-region test, so that we don't try to scroll while the mouse is inside the main window, even if the scroll bar overlaps the window (at left edge of screen, say)")
|
||||
(RESETSAVE (for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ)
|
||||
do (replace TCCARET of CARET with (\CARET.CREATE
|
||||
BXHICARET)))
|
||||
(LIST '\TEDIT.CARET (fetch (TEXTOBJ CARET) of TEXTOBJ)))
|
||||
(* ;
|
||||
"Then make the caret be the special, tall one so he can see it.")
|
||||
(COND
|
||||
((KEYDOWNP 'COPY) (* ;
|
||||
"In a read-only document, you can only copy.")
|
||||
(SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
|
||||
(SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))
|
||||
(SETQ SELOPERATION 'COPY))
|
||||
((AND (KEYDOWNP 'MOVE)
|
||||
(NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)))
|
||||
(* ;
|
||||
"The MOVE key is down, so set MOVE mode.")
|
||||
(SETQ GLOBALSEL TEDIT.MOVESELECTION)
|
||||
(SETQ OSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))
|
||||
(SETQ SELOPERATION 'MOVE))
|
||||
[(SHIFTDOWNP 'SHIFT) (* ;
|
||||
"the SHIFT key is down; mark this selection for COPY or MOVE.")
|
||||
(COND
|
||||
((AND (SHIFTDOWNP 'CTRL)
|
||||
(NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)))
|
||||
(* ; "CTRL-SHIFT select means MOVE.")
|
||||
(SETQ GLOBALSEL TEDIT.MOVESELECTION)
|
||||
(SETQ OSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))
|
||||
(SETQ SELOPERATION 'MOVE))
|
||||
(T (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
|
||||
(SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))
|
||||
(SETQ SELOPERATION 'COPY]
|
||||
((SHIFTDOWNP 'META) (* ;
|
||||
"He's holding the meta key down , do a copylooks selection")
|
||||
(SETQ GLOBALSEL TEDIT.COPYLOOKSSELECTION)
|
||||
(SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))
|
||||
(SETQ SELOPERATION 'COPYLOOKS))
|
||||
((AND (SHIFTDOWNP 'CTRL)
|
||||
(NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)))
|
||||
(* ;
|
||||
"He's holding the control key down; note the fact.")
|
||||
(\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
|
||||
NIL NIL)
|
||||
(SETQ GLOBALSEL TEDIT.DELETESELECTION)
|
||||
[COND
|
||||
((fetch (SELECTION SET) of (fetch (TEXTOBJ DELETESEL)
|
||||
of TEXTOBJ))
|
||||
(* ;
|
||||
"There's a pending delete selection. Use it, and turn off the existing normal selection.")
|
||||
)
|
||||
(T (* ;
|
||||
"No existing delete selection. Use the normal selection as a starting point.")
|
||||
(\COPYSEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
|
||||
(fetch (TEXTOBJ DELETESEL) of TEXTOBJ]
|
||||
(replace (SELECTION SET) of (fetch (TEXTOBJ SEL) of TEXTOBJ
|
||||
) with NIL)
|
||||
|
||||
(SETQ OLDX X)
|
||||
(SETQ OLDY Y)
|
||||
[COND
|
||||
((\TEDIT.MOUSESTATE LEFT) (* ;
|
||||
"Left button is character selection")
|
||||
(SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch (TEXTOBJ
|
||||
MOUSEREGION
|
||||
)
|
||||
of TEXTOBJ)
|
||||
NIL SELOPERATION W))
|
||||
(SETQ EXTENDFLG NIL))
|
||||
((\TEDIT.MOUSESTATE MIDDLE)
|
||||
(* ; "Middle button is word selection")
|
||||
(SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch (TEXTOBJ
|
||||
MOUSEREGION
|
||||
)
|
||||
of TEXTOBJ)
|
||||
T SELOPERATION W))
|
||||
(SETQ EXTENDFLG NIL))
|
||||
[(\TEDIT.MOUSESTATE RIGHT)(* ; "RIght button extends selections")
|
||||
(COND
|
||||
((NEQ SELOPERATION OSELOP)
|
||||
(* ;; "Remember to turn off the normal selection, since we'll be moving it to a new spot after the deletion.")
|
||||
|
||||
(* ;; "Things changed since the last selection. Grab the prior selection info, so that the extension is taken from the selection NOW being made, rather than the last existing old-type selection.")
|
||||
|
||||
(\COPYSEL OSEL GLOBALSEL)))
|
||||
(COND
|
||||
((fetch (SELECTION SET) of GLOBALSEL)
|
||||
(AND TEDIT.EXTEND.PENDING.DELETE (EQ SELOPERATION
|
||||
'NORMAL)
|
||||
(SETQ SELOPERATION 'PENDINGDEL)
|
||||
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ
|
||||
with T)) (* ;
|
||||
"If TeditBluePendingDelete flag is set, then simulate Laurel's blue-pending-delete feature.")
|
||||
(SETQ SEL (TEDIT.EXTEND.SEL X Y GLOBALSEL TEXTOBJ
|
||||
SELOPERATION W))
|
||||
(SETQ EXTENDFLG T]
|
||||
(T (* ;
|
||||
"The mouse buttons are up, leaving us with a pro-tem 'permanent' selection")
|
||||
(\COPYSEL OSEL GLOBALSEL)
|
||||
(* ;
|
||||
"And SEL is NOT SET ANY LONGER, so it won't get copied into OSEL down below")
|
||||
(AND SEL (replace (SELECTION SET) of SEL with
|
||||
NIL]
|
||||
[COND
|
||||
((AND SEL (fetch (SELECTION SET) of SEL)
|
||||
SELFN) (* ;
|
||||
"The selection was set, but there's a SELFN that has veto authority")
|
||||
(COND
|
||||
((EQ (APPLY* SELFN TEXTOBJ SEL SELOPERATION 'TENTATIVE)
|
||||
'DON'T) (* ;
|
||||
"The selfn vetoed this selection, so mark it un-set.")
|
||||
(replace (SELECTION SET) of SEL with NIL]
|
||||
(COND
|
||||
((\TEDIT.SEL.CHANGED? SEL OSEL OSELOP SELOPERATION)
|
||||
(* ;
|
||||
"Something interesting about the selection changed. We have to re-display its image.")
|
||||
(COND
|
||||
((OR (EQ SELOPERATION 'NORMAL)
|
||||
(EQ SELOPERATION 'PENDINGDEL))
|
||||
(* ;
|
||||
"For a normal selection, set the 'window last selected in' for the TEXTOBJ")
|
||||
(replace (TEXTOBJ SELWINDOW) of TEXTOBJ with
|
||||
W)))
|
||||
(SETQ OSEL (\TEDIT.REFRESH.SHOWSEL TEXTOBJ SEL OSEL OSELOP
|
||||
SELOPERATION EXTENDFLG))
|
||||
(SETQ OSELOP SELOPERATION))
|
||||
([AND OSEL (fetch (SELECTION SET) of OSEL)
|
||||
(EQ (fetch (SELECTION SELKIND) of OSEL)
|
||||
'VOLATILE)
|
||||
(OR (NOT SEL)
|
||||
(NOT (fetch (SELECTION SET) of SEL]
|
||||
|
||||
(* ;; "There is an old selection around, but it is VOLATILE -- i.e., it shouldn't last longer than something is pointing at it. Turn it off.")
|
||||
|
||||
(\SHOWSEL OSEL NIL NIL)
|
||||
(replace (SELECTION SET) of OSEL with NIL]
|
||||
((IN/SCROLL/BAR? W LASTMOUSEX LASTMOUSEY)
|
||||
(* ;
|
||||
"If he moves to the scroll bar, let him scroll without trouble")
|
||||
(SCROLL.HANDLER W)))
|
||||
(BLOCK) (* ; "Give other processes a chance")
|
||||
(GETMOUSESTATE) (* ; "And get the new mouse info")
|
||||
(TEDIT.CURSORMOVEDFN W))
|
||||
(\COPYSEL OSEL GLOBALSEL)
|
||||
(COND
|
||||
((fetch (SELECTION SET) of OSEL)
|
||||
(* ;
|
||||
"Only if a selection REALLY got made should we do this....")
|
||||
(SELECTQ SELOPERATION
|
||||
(COPY (* ;
|
||||
"A COPY selection -- set the copy flag, and see if this is a copy to a non-TEdit window")
|
||||
(SETQ TEDIT.COPY.PENDING T)
|
||||
(replace (SELECTION SET) of OSEL with NIL)
|
||||
(* ;
|
||||
"And turn off OSEL, to avoid spurious highlighting")
|
||||
(\TEDIT.FOREIGN.COPY? GLOBALSEL)
|
||||
(* ;
|
||||
"Maybe copy into the SYSBUF, if the recipient isn't a TEdit window.")
|
||||
)
|
||||
(COPYLOOKS (* ; "A COPYLOOKS selection")
|
||||
(SETQ TEDIT.COPYLOOKS.PENDING T)
|
||||
(* ;
|
||||
"And turn off OSEL, to avoid spurious highlighting")
|
||||
(replace (SELECTION SET) of OSEL with NIL))
|
||||
(MOVE (* ;
|
||||
"A MOVE selection -- set the flag to signal the TEdit command loop,")
|
||||
(SETQ TEDIT.MOVE.PENDING T) (* ;
|
||||
"And turn off OSEL, to avoid spurious highlighting")
|
||||
(replace (SELECTION SET) of OSEL with NIL))
|
||||
(DELETE (SETQ TEDIT.DEL.PENDING T)
|
||||
(replace (SELECTION SET) of OSEL with NIL)
|
||||
(* ;
|
||||
"And turn off OSEL, to avoid spurious highlighting")
|
||||
(SETQ OSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ))
|
||||
(SETQ SELOPERATION 'DELETE)
|
||||
(TEDIT.SET.SEL.LOOKS OSEL 'DELETE)
|
||||
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with NIL))
|
||||
(T (SETQ OSEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with NIL)
|
||||
(* ; "Reset the pending-delete flag.")
|
||||
))
|
||||
(\COPYSEL OSEL GLOBALSEL)
|
||||
(bind (OSELOP _ SELOPERATION)
|
||||
while [OR (SHIFTDOWNP 'SHIFT)
|
||||
(SHIFTDOWNP 'CTRL)
|
||||
(SHIFTDOWNP 'META)
|
||||
(KEYDOWNP 'MOVE)
|
||||
(KEYDOWNP 'COPY)
|
||||
(NOT (ZEROP (LOGAND LASTMOUSEBUTTONS 7]
|
||||
do (* ;
|
||||
"Poll the selection & display its current state")
|
||||
[COND
|
||||
((ZEROP (LOGAND LASTMOUSEBUTTONS 7))
|
||||
(* ;
|
||||
"No mouse buttons are down; don't try anything.")
|
||||
(SETQ OLDX -32000) (* ;
|
||||
"However, remember that pushing a mouse button is a change of status that we should notice.")
|
||||
)
|
||||
(NORMAL (* ;
|
||||
"This is a normal selection; set the caret looks")
|
||||
(replace (TEXTOBJ CARETLOOKS) of TEXTOBJ
|
||||
with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ OSEL)))
|
||||
NIL)))
|
||||
(AND SELFN (APPLY* SELFN TEXTOBJ GLOBALSEL SELOPERATION 'FINAL))
|
||||
(* ;
|
||||
"Give a user exit routine control, perhaps for logging of selections.")
|
||||
(for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ)
|
||||
do (OR (fetch TCUP of CARET)
|
||||
(\EDIT.FLIPCARET CARET T))))
|
||||
(AND OSEL (fetch (SELECTION SET) of OSEL)
|
||||
(fetch (SELECTION SELOBJ) of OSEL)
|
||||
(SETQ SELFINALFN (IMAGEOBJPROP (fetch (SELECTION SELOBJ) of OSEL)
|
||||
'WHENOPERATEDONFN))
|
||||
(APPLY* SELFINALFN (fetch (SELECTION SELOBJ) of OSEL)
|
||||
(WINDOWPROP W 'DSP)
|
||||
'SELECTED OSEL (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ])
|
||||
((KEYDOWNP 'MOVE) (* ;
|
||||
"the MOVE key is down; mark this selection for MOVE.")
|
||||
(SETQ SELOPERATION 'MOVE))
|
||||
[(OR (SHIFTDOWNP 'SHIFT)
|
||||
(KEYDOWNP 'COPY)) (* ;
|
||||
"the SHIFT key is down; mark this selection for COPY or MOVE.")
|
||||
(COND
|
||||
((SHIFTDOWNP 'CTRL) (* ;
|
||||
"He's holding down both ctrl and shift -- do a move.")
|
||||
(SETQ SELOPERATION 'MOVE))
|
||||
(T (* ;
|
||||
"Just the SHIFT key. It's a COPY")
|
||||
(SETQ SELOPERATION 'COPY]
|
||||
((SHIFTDOWNP 'META) (* ;
|
||||
"He's holding the meta key down; note the fact.")
|
||||
(SETQ SELOPERATION 'COPYLOOKS))
|
||||
((SHIFTDOWNP 'CTRL) (* ;
|
||||
"He's holding only the CTRL key -- mark the selection for deletion.")
|
||||
(SETQ SELOPERATION 'DELETE))
|
||||
(T (* ;
|
||||
"No key being held down; revert to normal selection.")
|
||||
(SETQ SELOPERATION 'NORMAL]
|
||||
(COND
|
||||
[(AND (OR [NOT (IEQP OLDX (SETQ X (LASTMOUSEX DS]
|
||||
[NOT (IEQP OLDY (SETQ Y (LASTMOUSEY DS]
|
||||
(NEQ OSELOP SELOPERATION))
|
||||
(INSIDEP CLIPREGION X Y))
|
||||
|
||||
(* ;; "Only do selection if (1) the mouse is inside the window proper and (2) the mouse has moved, or the kind of selection has changed")
|
||||
|
||||
(* ;; "Must precede the scroll-region test, so that we don't try to scroll while the mouse is inside the main window, even if the scroll bar overlaps the window (at left edge of screen, say)")
|
||||
|
||||
(SETQ OLDX X)
|
||||
(SETQ OLDY Y)
|
||||
[COND
|
||||
((\TEDIT.MOUSESTATE LEFT)
|
||||
(* ;
|
||||
"Left button is character selection")
|
||||
(SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch (TEXTOBJ
|
||||
MOUSEREGION
|
||||
)
|
||||
of TEXTOBJ)
|
||||
NIL SELOPERATION W))
|
||||
(SETQ EXTENDFLG NIL))
|
||||
((\TEDIT.MOUSESTATE MIDDLE)
|
||||
(* ; "Middle button is word selection")
|
||||
(SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch (TEXTOBJ
|
||||
MOUSEREGION
|
||||
)
|
||||
of TEXTOBJ)
|
||||
T SELOPERATION W))
|
||||
(SETQ EXTENDFLG NIL))
|
||||
[(\TEDIT.MOUSESTATE RIGHT)
|
||||
(* ; "RIght button extends selections")
|
||||
(COND
|
||||
((NEQ SELOPERATION OSELOP)
|
||||
|
||||
(* ;; "Things changed since the last selection. Grab the prior selection info, so that the extension is taken from the selection NOW being made, rather than the last existing old-type selection.")
|
||||
|
||||
(\COPYSEL OSEL GLOBALSEL)))
|
||||
(COND
|
||||
((fetch (SELECTION SET) of GLOBALSEL)
|
||||
(AND TEDIT.EXTEND.PENDING.DELETE (EQ SELOPERATION
|
||||
'NORMAL)
|
||||
(SETQ SELOPERATION 'PENDINGDEL)
|
||||
(replace (TEXTOBJ BLUEPENDINGDELETE) of
|
||||
TEXTOBJ
|
||||
with T))
|
||||
(* ;
|
||||
"If TeditBluePendingDelete flag is set, then simulate Laurel's blue-pending-delete feature.")
|
||||
(SETQ SEL (TEDIT.EXTEND.SEL X Y GLOBALSEL TEXTOBJ
|
||||
SELOPERATION W))
|
||||
(SETQ EXTENDFLG T]
|
||||
(T (* ;
|
||||
"The mouse buttons are up, leaving us with a pro-tem 'permanent' selection")
|
||||
(\COPYSEL OSEL GLOBALSEL)
|
||||
(* ;
|
||||
"And SEL is NOT SET ANY LONGER, so it won't get copied into OSEL down below")
|
||||
(AND SEL (replace (SELECTION SET) of SEL
|
||||
with NIL]
|
||||
[COND
|
||||
((AND SEL (fetch (SELECTION SET) of SEL)
|
||||
SELFN) (* ;
|
||||
"The selection was set, but there's a SELFN that has veto authority")
|
||||
(COND
|
||||
((EQ (APPLY* SELFN TEXTOBJ SEL SELOPERATION 'TENTATIVE)
|
||||
'DON'T) (* ;
|
||||
"The selfn vetoed this selection, so mark it un-set.")
|
||||
(replace (SELECTION SET) of SEL with NIL]
|
||||
(COND
|
||||
((\TEDIT.SEL.CHANGED? SEL OSEL OSELOP SELOPERATION)
|
||||
(* ;
|
||||
"Something interesting about the selection changed. We have to re-display its image.")
|
||||
(COND
|
||||
((OR (EQ SELOPERATION 'NORMAL)
|
||||
(EQ SELOPERATION 'PENDINGDEL))
|
||||
(* ;
|
||||
"For a normal selection, set the 'window last selected in' for the TEXTOBJ")
|
||||
(replace (TEXTOBJ SELWINDOW) of TEXTOBJ
|
||||
with W)))
|
||||
(SETQ OSEL (\TEDIT.REFRESH.SHOWSEL TEXTOBJ SEL OSEL OSELOP
|
||||
SELOPERATION EXTENDFLG))
|
||||
(SETQ OSELOP SELOPERATION))
|
||||
([AND OSEL (fetch (SELECTION SET) of OSEL)
|
||||
(EQ (fetch (SELECTION SELKIND) of OSEL)
|
||||
'VOLATILE)
|
||||
(OR (NOT SEL)
|
||||
(NOT (fetch (SELECTION SET) of SEL]
|
||||
|
||||
(* ;; "There is an old selection around, but it is VOLATILE -- i.e., it shouldn't last longer than something is pointing at it. Turn it off.")
|
||||
|
||||
(\SHOWSEL OSEL NIL NIL)
|
||||
(replace (SELECTION SET) of OSEL with NIL]
|
||||
((IN/SCROLL/BAR? W LASTMOUSEX LASTMOUSEY)
|
||||
(* ;
|
||||
"If he moves to the scroll bar, let him scroll without trouble")
|
||||
(SCROLL.HANDLER W)))
|
||||
(BLOCK) (* ; "Give other processes a chance")
|
||||
(GETMOUSESTATE) (* ; "And get the new mouse info")
|
||||
(TEDIT.CURSORMOVEDFN W))
|
||||
(\COPYSEL OSEL GLOBALSEL)
|
||||
(COND
|
||||
((fetch (SELECTION SET) of OSEL)
|
||||
(* ;
|
||||
"Only if a selection REALLY got made should we do this....")
|
||||
(SELECTQ SELOPERATION
|
||||
(COPY (* ;
|
||||
"A COPY selection -- set the copy flag, and see if this is a copy to a non-TEdit window")
|
||||
(SETQ TEDIT.COPY.PENDING T)
|
||||
(replace (SELECTION SET) of OSEL with NIL)
|
||||
(* ;
|
||||
"And turn off OSEL, to avoid spurious highlighting")
|
||||
(\TEDIT.FOREIGN.COPY? GLOBALSEL)
|
||||
(* ;
|
||||
"Maybe copy into the SYSBUF, if the recipient isn't a TEdit window.")
|
||||
)
|
||||
(COPYLOOKS (* ; "A COPYLOOKS selection")
|
||||
(SETQ TEDIT.COPYLOOKS.PENDING T)
|
||||
(* ;
|
||||
"And turn off OSEL, to avoid spurious highlighting")
|
||||
(replace (SELECTION SET) of OSEL with NIL))
|
||||
(MOVE (* ;
|
||||
"A MOVE selection -- set the flag to signal the TEdit command loop,")
|
||||
(SETQ TEDIT.MOVE.PENDING T)
|
||||
(* ;
|
||||
"And turn off OSEL, to avoid spurious highlighting")
|
||||
(replace (SELECTION SET) of OSEL with NIL))
|
||||
(DELETE (SETQ TEDIT.DEL.PENDING T)
|
||||
(replace (SELECTION SET) of OSEL with NIL)
|
||||
(* ;
|
||||
"And turn off OSEL, to avoid spurious highlighting")
|
||||
)
|
||||
(NORMAL (* ;
|
||||
"This is a normal selection; set the caret looks")
|
||||
(replace (TEXTOBJ CARETLOOKS) of TEXTOBJ
|
||||
with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ OSEL)))
|
||||
NIL)))
|
||||
(AND SELFN (APPLY* SELFN TEXTOBJ GLOBALSEL SELOPERATION 'FINAL))
|
||||
(* ;
|
||||
"Give a user exit routine control, perhaps for logging of selections.")
|
||||
(for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ)
|
||||
do (OR (fetch TCUP of CARET)
|
||||
(\EDIT.FLIPCARET CARET T))))
|
||||
(AND OSEL (fetch (SELECTION SET) of OSEL)
|
||||
(fetch (SELECTION SELOBJ) of OSEL)
|
||||
(SETQ SELFINALFN (IMAGEOBJPROP (fetch (SELECTION SELOBJ) of OSEL)
|
||||
'WHENOPERATEDONFN))
|
||||
(APPLY* SELFINALFN (fetch (SELECTION SELOBJ) of OSEL)
|
||||
(WINDOWPROP W 'DSP)
|
||||
'SELECTED OSEL (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ])])
|
||||
|
||||
(\TEDIT.WINDOW.OPS
|
||||
[LAMBDA (TEXTOBJ WINDOWTOSPLIT) (* ; "Edited 30-May-91 23:33 by jds")
|
||||
@@ -1922,9 +1925,10 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
])
|
||||
|
||||
(\TEDIT.SCROLLFN
|
||||
[LAMBDA (W DX DY) (* ; "Edited 31-May-91 13:32 by jds")
|
||||
[LAMBDA (W DX DY) (* ; "Edited 19-Sep-2021 23:10 by rmk:")
|
||||
(* Handle scrolling of the edit
|
||||
window)
|
||||
(TOTOPW W)
|
||||
(PROG* (WHEIGHT (TEXTOBJ (WINDOWPROP W 'TEXTOBJ))
|
||||
(PRIORCR 0)
|
||||
SELWASON SHIFTEDSELWASON MOVESELWASON DELETESELWASON (WREG (DSPCLIPPINGREGION
|
||||
@@ -2826,25 +2830,25 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
(PUTPROPS TEDITWINDOW COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988
|
||||
1989 1990 1991 1993 1994 1999 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (7165 91937 (TEDIT.CREATEW 7175 . 8311) (\TEDIT.CREATEW.FROM.REGION 8313 . 9297) (
|
||||
TEDIT.CURSORMOVEDFN 9299 . 19951) (TEDIT.CURSOROUTFN 19953 . 20488) (TEDIT.WINDOW.SETUP 20490 . 22299)
|
||||
(TEDIT.MINIMAL.WINDOW.SETUP 22301 . 30090) (\TEDIT.ACTIVE.WINDOWP 30092 . 31073) (
|
||||
\TEDIT.BUTTONEVENTFN 31075 . 54913) (\TEDIT.WINDOW.OPS 54915 . 58718) (\TEDIT.EXPANDFN 58720 . 59123)
|
||||
(\TEDIT.MAINW 59125 . 60414) (\TEDIT.PRIMARYW 60416 . 61628) (\TEDIT.COPYINSERTFN 61630 . 62601) (
|
||||
\TEDIT.NEWREGIONFN 62603 . 65070) (\TEDIT.SET.WINDOW.EXTENT 65072 . 71174) (\TEDIT.SHRINK.ICONCREATE
|
||||
71176 . 73448) (\TEDIT.SHRINKFN 73450 . 74025) (\TEDIT.SPLITW 74027 . 80128) (\TEDIT.UNSPLITW 80130 .
|
||||
85824) (\TEDIT.WINDOW.SETUP 85826 . 91546) (\SAFE.FIRST 91548 . 91935)) (93083 93990 (TEDITWINDOWP
|
||||
93093 . 93988)) (94027 96523 (TEDIT.GETINPUT 94037 . 96020) (\TEDIT.MAKEFILENAME 96022 . 96521)) (
|
||||
96572 103023 (TEDIT.PROMPTPRINT 96582 . 99486) (TEDIT.PROMPTFLASH 99488 . 101443) (
|
||||
\TEDIT.PROMPT.PAGEFULLFN 101445 . 103021)) (103258 107320 (TEXTSTREAM.TITLE 103268 . 103889) (
|
||||
\TEDIT.ORIGINAL.WINDOW.TITLE 103891 . 105936) (\TEDIT.WINDOW.TITLE 105938 . 106608) (
|
||||
\TEXTSTREAM.FILENAME 106610 . 107318)) (107363 152087 (TEDIT.DEACTIVATE.WINDOW 107373 . 114522) (
|
||||
\TEDIT.REPAINTFN 114524 . 117381) (\TEDIT.RESHAPEFN 117383 . 123003) (\TEDIT.SCROLLFN 123005 . 152085)
|
||||
) (152129 154178 (\TEDIT.PROCIDLEFN 152139 . 153488) (\TEDIT.PROCENTRYFN 153490 . 153783) (
|
||||
\TEDIT.PROCEXITFN 153785 . 154176)) (154257 165257 (\EDIT.DOWNCARET 154267 . 154948) (\EDIT.FLIPCARET
|
||||
154950 . 156485) (TEDIT.FLASHCARET 156487 . 157601) (\EDIT.UPCARET 157603 . 158056) (
|
||||
TEDIT.NORMALIZECARET 158058 . 164009) (\SETCARET 164011 . 164931) (\TEDIT.CARET 164933 . 165255)) (
|
||||
165291 179046 (TEDIT.ADD.MENUITEM 165301 . 167216) (TEDIT.DEFAULT.MENUFN 167218 . 176485) (
|
||||
TEDIT.REMOVE.MENUITEM 176487 . 177488) (\TEDIT.CREATEMENU 177490 . 177943) (\TEDIT.MENU.WHENHELDFN
|
||||
177945 . 178715) (\TEDIT.MENU.WHENSELECTEDFN 178717 . 179044)))))
|
||||
(FILEMAP (NIL (7117 93041 (TEDIT.CREATEW 7127 . 8263) (\TEDIT.CREATEW.FROM.REGION 8265 . 9249) (
|
||||
TEDIT.CURSORMOVEDFN 9251 . 19903) (TEDIT.CURSOROUTFN 19905 . 20440) (TEDIT.WINDOW.SETUP 20442 . 22251)
|
||||
(TEDIT.MINIMAL.WINDOW.SETUP 22253 . 30042) (\TEDIT.ACTIVE.WINDOWP 30044 . 31025) (
|
||||
\TEDIT.BUTTONEVENTFN 31027 . 56017) (\TEDIT.WINDOW.OPS 56019 . 59822) (\TEDIT.EXPANDFN 59824 . 60227)
|
||||
(\TEDIT.MAINW 60229 . 61518) (\TEDIT.PRIMARYW 61520 . 62732) (\TEDIT.COPYINSERTFN 62734 . 63705) (
|
||||
\TEDIT.NEWREGIONFN 63707 . 66174) (\TEDIT.SET.WINDOW.EXTENT 66176 . 72278) (\TEDIT.SHRINK.ICONCREATE
|
||||
72280 . 74552) (\TEDIT.SHRINKFN 74554 . 75129) (\TEDIT.SPLITW 75131 . 81232) (\TEDIT.UNSPLITW 81234 .
|
||||
86928) (\TEDIT.WINDOW.SETUP 86930 . 92650) (\SAFE.FIRST 92652 . 93039)) (94187 95094 (TEDITWINDOWP
|
||||
94197 . 95092)) (95131 97627 (TEDIT.GETINPUT 95141 . 97124) (\TEDIT.MAKEFILENAME 97126 . 97625)) (
|
||||
97676 104127 (TEDIT.PROMPTPRINT 97686 . 100590) (TEDIT.PROMPTFLASH 100592 . 102547) (
|
||||
\TEDIT.PROMPT.PAGEFULLFN 102549 . 104125)) (104362 108424 (TEXTSTREAM.TITLE 104372 . 104993) (
|
||||
\TEDIT.ORIGINAL.WINDOW.TITLE 104995 . 107040) (\TEDIT.WINDOW.TITLE 107042 . 107712) (
|
||||
\TEXTSTREAM.FILENAME 107714 . 108422)) (108467 153208 (TEDIT.DEACTIVATE.WINDOW 108477 . 115626) (
|
||||
\TEDIT.REPAINTFN 115628 . 118485) (\TEDIT.RESHAPEFN 118487 . 124107) (\TEDIT.SCROLLFN 124109 . 153206)
|
||||
) (153250 155299 (\TEDIT.PROCIDLEFN 153260 . 154609) (\TEDIT.PROCENTRYFN 154611 . 154904) (
|
||||
\TEDIT.PROCEXITFN 154906 . 155297)) (155378 166378 (\EDIT.DOWNCARET 155388 . 156069) (\EDIT.FLIPCARET
|
||||
156071 . 157606) (TEDIT.FLASHCARET 157608 . 158722) (\EDIT.UPCARET 158724 . 159177) (
|
||||
TEDIT.NORMALIZECARET 159179 . 165130) (\SETCARET 165132 . 166052) (\TEDIT.CARET 166054 . 166376)) (
|
||||
166412 180167 (TEDIT.ADD.MENUITEM 166422 . 168337) (TEDIT.DEFAULT.MENUFN 168339 . 177606) (
|
||||
TEDIT.REMOVE.MENUITEM 177608 . 178609) (\TEDIT.CREATEMENU 178611 . 179064) (\TEDIT.MENU.WHENHELDFN
|
||||
179066 . 179836) (\TEDIT.MENU.WHENSELECTEDFN 179838 . 180165)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
50
lispusers/BACKGROUND-YIELD
Normal file
50
lispusers/BACKGROUND-YIELD
Normal file
@@ -0,0 +1,50 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "20-Sep-2021 11:37:28" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;3 1644
|
||||
|
||||
changes to%: (FNS BACKGROUND-YIELD)
|
||||
(VARS BACKGROUND-YIELDCOMS)
|
||||
|
||||
previous date%: "19-Sep-2021 13:37:10" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT BACKGROUND-YIELDCOMS)
|
||||
|
||||
(RPAQQ BACKGROUND-YIELDCOMS (
|
||||
(* ;;
|
||||
" Add a call to BACKGROUNDFNS to yield when not otherwise busy")
|
||||
|
||||
(FNS BACKGROUND-YIELD INIT-YIELD)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INIT-YIELD T)))
|
||||
(VARS BACKGROUND-YIELD)))
|
||||
|
||||
|
||||
|
||||
(* ;; " Add a call to BACKGROUNDFNS to yield when not otherwise busy")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(BACKGROUND-YIELD
|
||||
[LAMBDA NIL (* ; "Edited 20-Sep-2021 11:37 by larry")
|
||||
(IF (FIXP BACKGROUND-YIELD)
|
||||
THEN (SUBRCALL YIELD BACKGROUND-YIELD)
|
||||
(SUBRCALL CAUSE-INTERRUPT])
|
||||
|
||||
(INIT-YIELD
|
||||
[LAMBDA (ONP) (* ; "Edited 19-Sep-2021 13:32 by larry")
|
||||
(SETQ BACKGROUNDFNS (REMOVE 'BACKGROUND-YIELD BACKGROUNDFNS))
|
||||
(if [AND ONP (CCODEP (GETD 'BACKGROUND-YIELD]
|
||||
then
|
||||
|
||||
(* ;; " add to end")
|
||||
|
||||
(SETQ BACKGROUNDFNS (APPEND BACKGROUNDFNS '(BACKGROUND-YIELD])
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(INIT-YIELD T)
|
||||
)
|
||||
|
||||
(RPAQQ BACKGROUND-YIELD 8333330)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (879 1528 (BACKGROUND-YIELD 889 . 1144) (INIT-YIELD 1146 . 1526)))))
|
||||
STOP
|
||||
BIN
lispusers/BACKGROUND-YIELD.LCOM
Normal file
BIN
lispusers/BACKGROUND-YIELD.LCOM
Normal file
Binary file not shown.
@@ -5,18 +5,30 @@ Alternatively, you can pick up the medley release, and build your own maiko.
|
||||
|
||||
Get the Maiko release [here](https://github.com/Interlisp/maiko/releases).
|
||||
|
||||
The medley release comes in two parts:
|
||||
1. The "loadups" (download `$tag-loadups.tgz` below)
|
||||
2. The "runtime" (download `$tag-runtime.tgz` below)
|
||||
|
||||
You won't need the "runtime" if you clone medley; it's just a subset.
|
||||
|
||||
To download both using 'gh' GitHub command line:
|
||||
```
|
||||
gh release download -R Interlisp/medley -p "*"
|
||||
```
|
||||
|
||||
To use (from a shell/terminal window):
|
||||
|
||||
1. Unpack the medley tar file
|
||||
```
|
||||
tar -xvfz $tag.tgz
|
||||
```
|
||||
|
||||
2. Unpack the maiko file for your operating system and CPU type,e.g.,
|
||||
|
||||
1. Unpack the medley tar file(s)
|
||||
```
|
||||
tar -xvfz $tag-loadups.tgz
|
||||
tar -xvfz $tag-runtime.tgz
|
||||
```
|
||||
|
||||
2. Unpack the maiko file for your operating system and CPU type, e.g.,
|
||||
|
||||
```
|
||||
tar -xvfz maiko-210823.linux.x86_64.tgz
|
||||
```
|
||||
```
|
||||
|
||||
3. This should leave you with two directories, `medley` and `maiko`.
|
||||
Then you can
|
||||
|
||||
103
run-medley
103
run-medley
@@ -1,16 +1,18 @@
|
||||
#!/bin/sh
|
||||
# Run Medley
|
||||
#
|
||||
# Syntax: run-medley [--dimensions WIDTHxHEIGHT] \ sets both -g -sc
|
||||
# [-g WIDTHxHEIGHT] \
|
||||
# [-sc WIDTHxHEIGHT] \
|
||||
# [--display X_DISPLAY] \
|
||||
# [--vmem | --vmfile FILE] \
|
||||
# [--nogreet | --greet FILE] \
|
||||
# [-n | -nl |
|
||||
# [URL_OR_FILE]
|
||||
# Syntax: run-medley [--dimensions WIDTHxHEIGHT] # sets both -g -sc
|
||||
# [-g WIDTHxHEIGHT]
|
||||
# [-sc WIDTHxHEIGHT]
|
||||
# [--display X_DISPLAY] # defaults to $DISPLAY or :0
|
||||
# [-prog LDEFILE]
|
||||
# [--vmem | --vmfile FILE]
|
||||
# [--nogreet | --greet FILE |
|
||||
# --loadup FILE ] # will separate from GREET
|
||||
# [-n | -nl | -full | -lisp |
|
||||
# [SYSOUTFILE]
|
||||
|
||||
# Directory variables are accessible from Lisp via UNIX-GETENV
|
||||
# Variables accessible from Lisp via UNIX-GETENV
|
||||
# LDESRCESYSOUT SYSOUT full-file name you want to run
|
||||
# LDEDESTSYSOUT name for destination of SaveVM/LOGOUT
|
||||
# MEDLEYDIR used by init file to set other path variables
|
||||
@@ -53,8 +55,17 @@ export LDEKBDTYPE=x
|
||||
|
||||
while [ "$#" -ne 0 ]; do
|
||||
case "$1" in
|
||||
"-loadup")
|
||||
export MEDLEYLOADUP="$2"
|
||||
export LDEINIT="$2"
|
||||
shift
|
||||
;;
|
||||
"-nogreet" | "--nogreet")
|
||||
export LDEINIT=""
|
||||
# Keep (GREET) from finding an init file
|
||||
mkdir -p $MEDLEYDIR/tmp/logindir
|
||||
export HOME=$MEDLEYDIR/tmp/logindir
|
||||
export LOGINDIR=$MEDLEYDIR/tmp/logindir
|
||||
export LDEINIT="$MEDLEYDIR/greetfiles/NOGREET"
|
||||
;;
|
||||
"-greet" | "--greet")
|
||||
export LDEINIT="$2"
|
||||
@@ -120,8 +131,6 @@ while [ "$#" -ne 0 ]; do
|
||||
shift
|
||||
done
|
||||
|
||||
# not set on command line
|
||||
|
||||
if [ -z "$LDESRCESYSOUT" ] ; then
|
||||
if [ -f "$LDEDESTSYSOUT" ] ; then
|
||||
export LDESRCESYSOUT="$LDEDESTSYSOUT"
|
||||
@@ -136,45 +145,39 @@ if [ -z "$geometry" ] ; then
|
||||
screensize="-sc 1440x900"
|
||||
fi
|
||||
|
||||
case "$LDESRCSYSOUT" in
|
||||
"http:*" | "https:*")
|
||||
echo URL not supported yet
|
||||
exit 1
|
||||
esac
|
||||
|
||||
inferred_maikodir=false
|
||||
|
||||
if [ -z "$MAIKODIR" ] ; then
|
||||
# here we try two options relative to MEDLEYDIR: ./maiko and ../maiko
|
||||
# this is highly imperfect, but the user can always set the env variables
|
||||
export MAIKODIR="$MEDLEYDIR/../maiko"
|
||||
if [ ! -d "$MAIKODIR" ] ; then
|
||||
export MAIKODIR="$MEDLEYDIR/maiko"
|
||||
fi
|
||||
inferred_maikodir=true
|
||||
fi
|
||||
|
||||
if [ ! -d "$MAIKODIR/bin" ] ; then
|
||||
echo "MAIKODIR has no bin: $MAIKODIR"
|
||||
if [ inferred_maikodir = true ] ; then
|
||||
echo "I tried to infer it based on your working directory, but that didn't work."
|
||||
echo "Try setting the MAIKODIR environment variable to the right location."
|
||||
fi
|
||||
exit 1
|
||||
fi
|
||||
|
||||
|
||||
oldpath="$PATH"
|
||||
|
||||
export PATH=.:"$PATH"
|
||||
cd "$MAIKODIR"/bin
|
||||
export PATH="$MAIKODIR"/`osversion`.`machinetype`:"$oldpath"
|
||||
|
||||
cd "$OLDPWD"
|
||||
|
||||
if ! command -v "$prog" > /dev/null 2>&1; then
|
||||
echo "$prog" not found
|
||||
exit 1
|
||||
# if lde is already on path, don't reset it
|
||||
# otherwise check for MAIKODIR
|
||||
|
||||
if [ -z "$MAIKODIR" ] ; then
|
||||
# try two options relative to MEDLEYDIR: ./maiko and ../maiko
|
||||
MAIKODIR="$MEDLEYDIR/../maiko"
|
||||
if ! command -v "$MAIKODIR/bin/osversion" > /dev/null 2>&1; then
|
||||
MAIKODIR="$MEDLEYDIR/maiko"
|
||||
fi
|
||||
fi
|
||||
|
||||
if ! command -v "$MAIKODIR/bin/osversion" > /dev/null 2>&1; then
|
||||
echo "Could not find 'lde' on PATH"
|
||||
echo "nor MAIKODIR with 'bin/osversion' (to look for it)"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
oldpath="$PATH"
|
||||
oldpwd=`pwd`
|
||||
PATH=.:"$PATH"
|
||||
cd "$MAIKODIR"/bin
|
||||
osv=`osversion`
|
||||
mct=`machinetype`
|
||||
newpath="$MAIKODIR"/"$osv.$mct"
|
||||
PATH="$newpath":"$oldpath"
|
||||
cd "$oldpwd"
|
||||
if ! command -v $prog > /dev/null 2>&1; then
|
||||
echo $prog not found in $newpath
|
||||
echo osversion = $osv
|
||||
echo machinetype = $mct
|
||||
exit 1
|
||||
fi
|
||||
fi
|
||||
|
||||
echo "running: $prog $geometry $screensize $mem $passthrough_args $LDESRCESYSOUT"
|
||||
|
||||
@@ -7,10 +7,6 @@ if [ ! -x run-medley ] ; then
|
||||
exit 1
|
||||
fi
|
||||
|
||||
# set timestamp
|
||||
mkdir -p ./tmp
|
||||
touch ./tmp/loadup.timestamp
|
||||
|
||||
./scripts/loadup-init.sh && \
|
||||
./scripts/loadup-mid-from-init.sh && \
|
||||
./scripts/loadup-lisp-from-mid.sh && \
|
||||
|
||||
@@ -9,10 +9,15 @@ fi
|
||||
|
||||
touch tmp/loadup.timestamp
|
||||
|
||||
# Keep (GREET) from finding an init file
|
||||
mkdir -p $MEDLEYDIR/tmp/logindir
|
||||
export HOME=$MEDLEYDIR/tmp/logindir
|
||||
export LOGINDIR=$MEDLEYDIR/tmp/logindir
|
||||
|
||||
scr="-sc 1024x768 -g 1042x790"
|
||||
|
||||
echo '" (IL:MEDLEY-INIT-VARS)(IL:LOAD(QUOTE MEDLEY-UTILS))(IL:MAKE-EXPORTS-ALL)(IL:MAKE-WHEREIS-HASH)(IL:LOGOUT T)"' > tmp/loadup-aux.cm
|
||||
./run-medley $scr -greet "$MEDLEYDIR"/tmp/loadup-aux.cm tmp/full.sysout
|
||||
./run-medley $scr -loadup "$MEDLEYDIR"/tmp/loadup-aux.cm tmp/full.sysout
|
||||
|
||||
if [ tmp/whereis.hash -nt tmp/loadup.timestamp ]; then
|
||||
|
||||
|
||||
@@ -10,7 +10,12 @@ scr="-sc 1024x768 -g 1042x790"
|
||||
|
||||
touch tmp/loadup.timestamp
|
||||
|
||||
./run-medley $scr -greet "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/tmp/lisp.sysout"
|
||||
# Keep (GREET) from finding an init file
|
||||
mkdir -p $MEDLEYDIR/tmp/logindir
|
||||
export HOME=$MEDLEYDIR/tmp/logindir
|
||||
export LOGINDIR=$MEDLEYDIR/tmp/logindir
|
||||
|
||||
./run-medley $scr -loadup "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/tmp/lisp.sysout"
|
||||
|
||||
if [ tmp/full.sysout -nt tmp/loadup.timestamp ]; then
|
||||
|
||||
|
||||
@@ -6,11 +6,17 @@ if [ ! -x run-medley ] ; then
|
||||
echo must run from MEDLEYDIR ;
|
||||
exit 1 ;
|
||||
fi
|
||||
|
||||
# Keep (GREET) from finding an init file
|
||||
mkdir -p $MEDLEYDIR/tmp/logindir
|
||||
export HOME=$MEDLEYDIR/tmp/logindir
|
||||
export LOGINDIR=$MEDLEYDIR/tmp/logindir
|
||||
|
||||
scr="-sc 1024x768 -g 1042x790"
|
||||
|
||||
touch tmp/loadup.timestamp
|
||||
|
||||
./run-medley $scr -greet "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/loadups/lisp.sysout"
|
||||
./run-medley $scr -loadup "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/loadups/lisp.sysout"
|
||||
|
||||
if [ tmp/full.sysout -nt tmp/loadup.timestamp ]; then
|
||||
|
||||
|
||||
@@ -9,10 +9,14 @@ fi
|
||||
|
||||
scr="-sc 1024x768 -g 1042x790"
|
||||
|
||||
mkdir -p "$MEDLEYDIR/tmp"
|
||||
# Keep (GREET) from finding an init file
|
||||
mkdir -p $MEDLEYDIR/tmp/logindir
|
||||
export HOME=$MEDLEYDIR/tmp/logindir
|
||||
export LOGINDIR=$MEDLEYDIR/tmp/logindir
|
||||
|
||||
touch tmp/loadup.timestamp
|
||||
|
||||
./run-medley $scr -greet "$MEDLEYDIR"/sources/LOADUP-INIT.LISP loadups/starter.sysout
|
||||
./run-medley $scr -loadup "$MEDLEYDIR"/sources/LOADUP-INIT.LISP loadups/starter.sysout
|
||||
|
||||
if [ tmp/init.dlinit -nt tmp/loadup.timestamp ]; then
|
||||
|
||||
|
||||
@@ -12,7 +12,7 @@ touch tmp/loadup.timestamp
|
||||
scr="-sc 1024x768 -g 1042x790"
|
||||
|
||||
|
||||
./run-medley $scr -greet "$MEDLEYDIR/sources/LOADUP-LISP.CM" tmp/init-mid.sysout
|
||||
./run-medley $scr -loadup "$MEDLEYDIR/sources/LOADUP-LISP.CM" tmp/init-mid.sysout
|
||||
|
||||
if [ tmp/lisp.sysout -nt tmp/loadup.timestamp ]; then
|
||||
|
||||
|
||||
@@ -12,7 +12,7 @@ touch tmp/loadup.timestamp
|
||||
|
||||
scr="-sc 1024x768 -g 1042x790"
|
||||
|
||||
./run-medley -prog ldeinit -greet $MEDLEYDIR/sources/XREM.CM $scr -vmem tmp/init-mid.sysout tmp/init.dlinit
|
||||
./run-medley -prog ldeinit -loadup $MEDLEYDIR/sources/XREM.CM $scr -vmem tmp/init-mid.sysout tmp/init.dlinit
|
||||
|
||||
|
||||
echo
|
||||
|
||||
@@ -1,4 +1,5 @@
|
||||
#!/bin/sh
|
||||
|
||||
export MEDLEYDIR=`pwd`
|
||||
if [ ! -x run-medley ] ; then
|
||||
echo run from MEDLEYDIR
|
||||
@@ -13,18 +14,24 @@ fi
|
||||
|
||||
cd ..
|
||||
|
||||
echo making medley zip $tag
|
||||
echo making $tag-loadups.tgz
|
||||
|
||||
tar cfz medley/tmp/$tag.tgz \
|
||||
tar cfz medley/tmp/$tag-loadups.tgz \
|
||||
medley/loadups/lisp.sysout \
|
||||
medley/loadups/full.sysout \
|
||||
medley/loadups/whereis.hash \
|
||||
medley/library/exports.all \
|
||||
medley/library/RDSYS medley/library/RDSYS.LCOM
|
||||
|
||||
echo making $tag-runtime.tgz
|
||||
|
||||
tar cfz medley/tmp/$tag-runtime.tgz \
|
||||
--exclude "*~" --exclude "*#*" \
|
||||
medley/docs/dinfo \
|
||||
medley/docs/Documentation\ Tools \
|
||||
medley/greetfiles/SIMPLE-INIT \
|
||||
medley/run-medley \
|
||||
medley/scripts \
|
||||
medley/loadups/lisp.sysout \
|
||||
medley/loadups/full.sysout \
|
||||
medley/loadups/whereis.hash \
|
||||
medley/fonts/displayfonts medley/fonts/altofonts \
|
||||
medley/fonts/postscriptfonts \
|
||||
medley/library/ \
|
||||
@@ -33,12 +40,13 @@ tar cfz medley/tmp/$tag.tgz \
|
||||
medley/sources/ \
|
||||
medley/internal/library \
|
||||
|
||||
|
||||
cd medley
|
||||
|
||||
echo making release
|
||||
sed s/'$tag'/$tag/g < release-notes.md > tmp/release-notes.md
|
||||
gh release create $tag -F tmp/release-notes.md -p -t $tag
|
||||
|
||||
echo uploaded $tag.tgz
|
||||
gh release upload $tag tmp/$tag.tgz --clobber
|
||||
echo uploading
|
||||
gh release upload $tag tmp/$tag-loadups.tgz tmp/$tag-runtime.tgz --clobber
|
||||
|
||||
|
||||
35
sources/AOFD
35
sources/AOFD
@@ -1,10 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 5-Sep-2021 08:26:16" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>AOFD.;7 38270
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 9-Aug-2021 23:30:19" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>AOFD.;5 38301
|
||||
|
||||
changes to%: (FNS \BASEBYTES.IO.INIT \STRINGSTREAM.INIT)
|
||||
changes to%: (VARS AOFDCOMS)
|
||||
(FNS \STRINGSTREAM.INIT)
|
||||
|
||||
previous date%: " 9-Aug-2021 23:30:19"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>AOFD.;6)
|
||||
previous date%: " 8-Aug-2021 00:11:00"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>AOFD.;4)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -803,16 +804,16 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS AOFD COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1990 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2584 3691 (\ADD-OPEN-STREAM 2594 . 2871) (\GENERIC-UNREGISTER-STREAM 2873 . 3689)) (
|
||||
3732 10989 (CLOSEALL 3742 . 4447) (CLOSEF 4449 . 5645) (EOFCLOSEF 5647 . 5943) (INPUT 5945 . 6717) (
|
||||
OPENP 6719 . 7118) (OUTPUT 7120 . 7894) (POSITION 7896 . 8708) (RANDACCESSP 8710 . 9185) (\IOMODEP
|
||||
9187 . 9824) (WHENCLOSE 9826 . 10987)) (10990 11112 (STREAMADDPROP 11000 . 11110)) (12276 25157 (
|
||||
\BASEBYTES.IO.INIT 12286 . 15482) (\MAKEBASEBYTESTREAM 15484 . 18796) (\MBS.OUTCHARFN 18798 . 19186) (
|
||||
\BASEBYTES.NAME.FROM.STREAM 19188 . 19651) (\BASEBYTES.BOUT 19653 . 20370) (\BASEBYTES.SETFILEPTR
|
||||
20372 . 20993) (\BASEBYTES.READP 20995 . 21631) (\BASEBYTES.BIN 21633 . 22164) (\BASEBYTES.PEEKBIN
|
||||
22166 . 22997) (\BASEBYTES.TRUNCATEFN 22999 . 23503) (\BASEBYTES.OPENFN 23505 . 23995) (
|
||||
\BASEBYTES.BLOCKIO 23997 . 25155)) (25280 28589 (OPENSTRINGSTREAM 25290 . 27007) (MAKE-STRING-FORMAT
|
||||
27009 . 28587)) (28861 33522 (\STRINGSTREAM.INIT 28871 . 33520)) (33599 37171 (GETSTREAM 33609 . 33832
|
||||
) (\ADDOFD 33834 . 34121) (\CLEAROFD 34123 . 34404) (\DELETEOFD 34406 . 34557) (\GETSTREAM 34559 .
|
||||
36723) (\SEARCHOPENFILES 36725 . 37169)))))
|
||||
(FILEMAP (NIL (2615 3722 (\ADD-OPEN-STREAM 2625 . 2902) (\GENERIC-UNREGISTER-STREAM 2904 . 3720)) (
|
||||
3763 11020 (CLOSEALL 3773 . 4478) (CLOSEF 4480 . 5676) (EOFCLOSEF 5678 . 5974) (INPUT 5976 . 6748) (
|
||||
OPENP 6750 . 7149) (OUTPUT 7151 . 7925) (POSITION 7927 . 8739) (RANDACCESSP 8741 . 9216) (\IOMODEP
|
||||
9218 . 9855) (WHENCLOSE 9857 . 11018)) (11021 11143 (STREAMADDPROP 11031 . 11141)) (12307 25188 (
|
||||
\BASEBYTES.IO.INIT 12317 . 15513) (\MAKEBASEBYTESTREAM 15515 . 18827) (\MBS.OUTCHARFN 18829 . 19217) (
|
||||
\BASEBYTES.NAME.FROM.STREAM 19219 . 19682) (\BASEBYTES.BOUT 19684 . 20401) (\BASEBYTES.SETFILEPTR
|
||||
20403 . 21024) (\BASEBYTES.READP 21026 . 21662) (\BASEBYTES.BIN 21664 . 22195) (\BASEBYTES.PEEKBIN
|
||||
22197 . 23028) (\BASEBYTES.TRUNCATEFN 23030 . 23534) (\BASEBYTES.OPENFN 23536 . 24026) (
|
||||
\BASEBYTES.BLOCKIO 24028 . 25186)) (25311 28620 (OPENSTRINGSTREAM 25321 . 27038) (MAKE-STRING-FORMAT
|
||||
27040 . 28618)) (28892 33553 (\STRINGSTREAM.INIT 28902 . 33551)) (33630 37202 (GETSTREAM 33640 . 33863
|
||||
) (\ADDOFD 33865 . 34152) (\CLEAROFD 34154 . 34435) (\DELETEOFD 34437 . 34588) (\GETSTREAM 34590 .
|
||||
36754) (\SEARCHOPENFILES 36756 . 37200)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "23-May-91 14:25:00" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>ASTACK.;4| 43099
|
||||
(FILECREATED "11-Sep-2021 12:54:19" {DSK}<home>larry>medley>sources>ASTACK.;2 43098
|
||||
|
||||
changes to%: (FNS \STKARG)
|
||||
changes to%: (FNS STKARGNAME)
|
||||
|
||||
previous date%: "20-Feb-91 13:47:06" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>ASTACK.;3|)
|
||||
previous date%: "23-May-91 14:25:00" {DSK}<home>larry>medley>sources>ASTACK.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1982-1987, 1990-1991 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT ASTACKCOMS)
|
||||
@@ -501,7 +501,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Co
|
||||
(T (LISPERROR "ILLEGAL STACK ARG" N])
|
||||
|
||||
(STKARGNAME
|
||||
[LAMBDA (N POS) (* ; "Edited 18-Feb-91 16:55 by jds")
|
||||
[LAMBDA (N POS NOERROR) (* ; "Edited 11-Sep-2021 12:51 by larry")
|
||||
|
||||
(* ;; "Given an interpreted frame and an argument number, return the name of that argument (actually, just the n-th NameTable entry)")
|
||||
|
||||
@@ -552,6 +552,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Co
|
||||
WORDSPERCELL]
|
||||
(RETURN)))
|
||||
(MAKE-NTENTRY PVARCODE (SUB1 NTENTRY)))
|
||||
(NOERROR (RETURN))
|
||||
(T (LISPERROR "ILLEGAL STACK ARG" N]
|
||||
(RETURN (for NT1 from (fetch (FNHEADER OVERHEADWORDS) of T)
|
||||
by (CONSTANT (WORDSPERNAMEENTRY)) as NT2
|
||||
@@ -789,13 +790,13 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Co
|
||||
)
|
||||
(PUTPROPS ASTACK COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1991))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1519 4724 (ARG 1529 . 1688) (SETARG 1690 . 1874) (\ARG 1876 . 2111) (\ARGPTR 2113 .
|
||||
4455) (\SETARG 4457 . 4722)) (4725 8940 (\RETURN 4735 . 5093) (\STACKARGPTR 5095 . 8938)) (8985 12362
|
||||
(STKNTH 8995 . 9893) (STKNTHNAME 9895 . 10782) (STKNAME 10784 . 10929) (SETSTKNAME 10931 . 12360)) (
|
||||
12363 16138 (STKPOS 12373 . 13294) (STKSCAN 13296 . 13942) (RETFROM 13944 . 14298) (RETTO 14300 .
|
||||
14575) (RESUME 14577 . 15950) (\RESUME 15952 . 16136)) (16139 42186 (STKARG 16149 . 16484) (\STKARG
|
||||
16486 . 21189) (SETSTKARG 21191 . 25374) (STKARGNAME 25376 . 29599) (\SPREADFRAMEP 29601 . 30142) (
|
||||
SETSTKARGNAME 30144 . 33435) (STKNARGS 33437 . 35846) (FRAMESCAN 35848 . 36298) (\INTERPFRAMENT 36300
|
||||
. 36700) (\FRAMESCAN 36702 . 39755) (\VAROFFSET 39757 . 42184)) (42228 42781 (\RECLAIMSTACKP 42238 .
|
||||
42779)))))
|
||||
(FILEMAP (NIL (1470 4675 (ARG 1480 . 1639) (SETARG 1641 . 1825) (\ARG 1827 . 2062) (\ARGPTR 2064 .
|
||||
4406) (\SETARG 4408 . 4673)) (4676 8891 (\RETURN 4686 . 5044) (\STACKARGPTR 5046 . 8889)) (8936 12313
|
||||
(STKNTH 8946 . 9844) (STKNTHNAME 9846 . 10733) (STKNAME 10735 . 10880) (SETSTKNAME 10882 . 12311)) (
|
||||
12314 16089 (STKPOS 12324 . 13245) (STKSCAN 13247 . 13893) (RETFROM 13895 . 14249) (RETTO 14251 .
|
||||
14526) (RESUME 14528 . 15901) (\RESUME 15903 . 16087)) (16090 42185 (STKARG 16100 . 16435) (\STKARG
|
||||
16437 . 21140) (SETSTKARG 21142 . 25325) (STKARGNAME 25327 . 29598) (\SPREADFRAMEP 29600 . 30141) (
|
||||
SETSTKARGNAME 30143 . 33434) (STKNARGS 33436 . 35845) (FRAMESCAN 35847 . 36297) (\INTERPFRAMENT 36299
|
||||
. 36699) (\FRAMESCAN 36701 . 39754) (\VAROFFSET 39756 . 42183)) (42227 42780 (\RECLAIMSTACKP 42237 .
|
||||
42778)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,10 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 5-Sep-2021 08:25:38" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATERM.;5 57504
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 7-Aug-2021 12:47:09" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATERM.;3 57513
|
||||
|
||||
changes to%: (FNS \INITBCPLDISPLAY)
|
||||
changes to%: (FNS \FILLBUFFER)
|
||||
|
||||
previous date%: " 7-Aug-2021 12:47:09"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATERM.;4)
|
||||
previous date%: "23-Jun-2021 12:31:16"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATERM.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -1142,18 +1142,18 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS ATERM COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2983 31940 (BKLINBUF 2993 . 3468) (CLEARBUF 3470 . 4802) (LINBUF 4804 . 4990) (
|
||||
PAGEFULLFN 4992 . 6473) (SETLINELENGTH 6475 . 6671) (SYSBUF 6673 . 6859) (TERMCHARWIDTH 6861 . 7278) (
|
||||
TERMINAL-INPUT 7280 . 7848) (TERMINAL-OUTPUT 7850 . 8436) (\CHDEL1 8438 . 8707) (\CLOSELINE 8709 .
|
||||
8998) (\DECPARENCOUNT 9000 . 10583) (\ECHOCHAR 10585 . 11277) (\FILLBUFFER 11279 . 24270) (
|
||||
\FILLBUFFER.WORDSEPRP 24272 . 24517) (\FILLBUFFER.BACKUP 24519 . 24698) (\GETCHAR 24700 . 25089) (
|
||||
\INCPARENCOUNT 25091 . 27703) (\RESETLINE 27705 . 28029) (\RESETTERMINAL 28031 . 28795) (\SAVELINEBUF
|
||||
28797 . 30768) (\STOPSCROLL? 30770 . 31938)) (32151 36007 (\DSCCOUT 32161 . 35301) (\INITBCPLDISPLAY
|
||||
35303 . 36005)) (36200 37450 (VIDEOCOLOR 36210 . 37448)) (38282 44136 (\PEEKREFILL 38292 . 42403) (
|
||||
\READREFILL 42405 . 42999) (\RATOM/RSTRING-REFILL 43001 . 43579) (\READCREFILL 43581 . 44134)) (44137
|
||||
45966 (DRIBBLE 44147 . 45748) (DRIBBLEFILE 45750 . 45964)) (45967 52642 (\SETUP.DEFAULT.LINEBUF 45977
|
||||
. 48434) (\CREATELINEBUFFER 48436 . 50858) (\LINEBUF.READP 50860 . 51209) (\LINEBUF.EOFP 51211 .
|
||||
51550) (\LINEBUF.PEEKBIN 51552 . 51759) (\OPENLINEBUF 51761 . 52640)) (52717 53956 (LINEBUFFER-EOFP
|
||||
52727 . 53185) (LINEBUFFER-SKIPSEPRS 53187 . 53954)) (54313 54587 (\INTERMP 54323 . 54454) (\OUTTERMP
|
||||
54456 . 54585)))))
|
||||
(FILEMAP (NIL (2992 31949 (BKLINBUF 3002 . 3477) (CLEARBUF 3479 . 4811) (LINBUF 4813 . 4999) (
|
||||
PAGEFULLFN 5001 . 6482) (SETLINELENGTH 6484 . 6680) (SYSBUF 6682 . 6868) (TERMCHARWIDTH 6870 . 7287) (
|
||||
TERMINAL-INPUT 7289 . 7857) (TERMINAL-OUTPUT 7859 . 8445) (\CHDEL1 8447 . 8716) (\CLOSELINE 8718 .
|
||||
9007) (\DECPARENCOUNT 9009 . 10592) (\ECHOCHAR 10594 . 11286) (\FILLBUFFER 11288 . 24279) (
|
||||
\FILLBUFFER.WORDSEPRP 24281 . 24526) (\FILLBUFFER.BACKUP 24528 . 24707) (\GETCHAR 24709 . 25098) (
|
||||
\INCPARENCOUNT 25100 . 27712) (\RESETLINE 27714 . 28038) (\RESETTERMINAL 28040 . 28804) (\SAVELINEBUF
|
||||
28806 . 30777) (\STOPSCROLL? 30779 . 31947)) (32160 36016 (\DSCCOUT 32170 . 35310) (\INITBCPLDISPLAY
|
||||
35312 . 36014)) (36209 37459 (VIDEOCOLOR 36219 . 37457)) (38291 44145 (\PEEKREFILL 38301 . 42412) (
|
||||
\READREFILL 42414 . 43008) (\RATOM/RSTRING-REFILL 43010 . 43588) (\READCREFILL 43590 . 44143)) (44146
|
||||
45975 (DRIBBLE 44156 . 45757) (DRIBBLEFILE 45759 . 45973)) (45976 52651 (\SETUP.DEFAULT.LINEBUF 45986
|
||||
. 48443) (\CREATELINEBUFFER 48445 . 50867) (\LINEBUF.READP 50869 . 51218) (\LINEBUF.EOFP 51220 .
|
||||
51559) (\LINEBUF.PEEKBIN 51561 . 51768) (\OPENLINEBUF 51770 . 52649)) (52726 53965 (LINEBUFFER-EOFP
|
||||
52736 . 53194) (LINEBUFFER-SKIPSEPRS 53196 . 53963)) (54322 54596 (\INTERMP 54332 . 54463) (\OUTTERMP
|
||||
54465 . 54594)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
346
sources/BSP
346
sources/BSP
@@ -1,59 +1,58 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 5-Sep-2021 08:26:22" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BSP.;2 149423
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "19-Jan-93 10:23:19" {DSK}<python>lde>lispcore>sources>BSP.;3 149048
|
||||
|
||||
changes to%: (FNS \BSPINIT)
|
||||
changes to%: (RECORDS BSPSOC ACKPUP BSPSTREAM)
|
||||
|
||||
previous date%: "19-Jan-93 10:23:19"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BSP.;1)
|
||||
previous date%: " 4-Jan-93 17:24:25" {DSK}<python>lde>lispcore>sources>BSP.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982-1983, 1900, 1984-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
|
||||
Copyright (c) 1982, 1983, 1900, 1984, 1985, 1986, 1987, 1990, 1993 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT BSPCOMS)
|
||||
|
||||
(RPAQQ BSPCOMS
|
||||
((DECLARE%: EVAL@COMPILE DONTCOPY (* ;
|
||||
"This socket record has both RTP and BSP state info")
|
||||
(RPAQQ BSPCOMS
|
||||
((DECLARE%: EVAL@COMPILE DONTCOPY (* ;
|
||||
"This socket record has both RTP and BSP state info")
|
||||
(RECORDS BSPSOC ACKPUP BSPSTREAM)
|
||||
(CONSTANTS * RTPSTATES)
|
||||
(CONSTANTS * RTPEVENTS)
|
||||
(CONSTANTS (WORDSPERPORT 3))
|
||||
(MACROS RTP.OTHERFN BSP.OTHERFN BSP.INPUT.ERROR BSP.OUTPUT.ERROR \BSPINCFILEPTR))
|
||||
(COMS (* ;
|
||||
"User-level RTP socket manipulation")
|
||||
(COMS (* ;
|
||||
"User-level RTP socket manipulation")
|
||||
(FNS OPENRTPSOCKET CLOSERTPSOCKET \INIT.RTPPROCESS))
|
||||
(COMS (* ; "RTP process")
|
||||
(COMS (* ; "RTP process")
|
||||
(FNS \RTP.SOCKET.PROCESS \RTP.HANDLE.INPUT \RTP.HANDLE.PUP \RTP.HANDLE.RFC \RTP.CLEANUP
|
||||
\RTP.ACTION \RTP.ERROR \RTP.SHOW.FAILURE \RTP.FILTER \SEND.ABORT
|
||||
\SEND.ANSWERING.RFC \SEND.END \SEND.ENDREPLY \SEND.RFC \FILLRTPPUP \SETRTPPORTS)
|
||||
(FNS \BSPINIT \BSPEVENTFN \BSP.CLOSE.OPEN.SOCKETS))
|
||||
(COMS (* ; "Creating BSP stream")
|
||||
(COMS (* ; "Creating BSP stream")
|
||||
(FNS OPENBSPSTREAM \SMASHBSPSTREAM BSPOUTPUTSTREAM BSPINPUTSTREAM BSPFRNADDRESS
|
||||
CLOSEBSPSTREAM \BSP.FLUSHINPUT BSPOPENP GETBSPUSERINFO SETBSPUSERINFO)
|
||||
(FNS CREATEBSPSTREAM ENDBSPSTREAM))
|
||||
(COMS (* ; "BSP stream functions")
|
||||
(COMS (* ; "BSP stream functions")
|
||||
(FNS BSPBIN \BSP.GETNEXTBUFFER BSPPEEKBIN BSPREADP BSPEOFP \BSPBACKFILEPTR
|
||||
\BSP.PREPARE.INPUT \BSP.GETFILEPTR \BSP.DECLARE.FILEPTR \BSP.SETFILEPTR
|
||||
\BSP.SKIPBYTES \BSP.CLEANUP.INPUT BSPBOUT \BSP.OTHERBOUT \BSPWRITEBLOCK
|
||||
BSPFORCEOUTPUT \BSP.SENDBUFFER \BSP.PREPARE.OUTPUT BSPGETMARK BSPPUTMARK
|
||||
BSP.PUTINTERRUPT))
|
||||
(COMS (* ; "BSP pup handler")
|
||||
(COMS (* ; "BSP pup handler")
|
||||
(FNS \BSP.HANDLE.INPUT \BSP.HANDLE.ACK \BSP.HANDLE.DATA \BSP.HANDLE.ERROR
|
||||
\BSP.HANDLE.INTERRUPT \BSP.HANDLE.INTERRUPTREPLY \SEND.ACK \SEARCH.OUTPUTQ
|
||||
\SETBSPTIMEOUT \TRANSMIT.STRATEGY))
|
||||
(COMS (* ; "BSP utilities")
|
||||
(COMS (* ; "BSP utilities")
|
||||
(FNS \BSP.DEFAULT.ERROR.HANDLER \BSP.TIMERFN \BSP.FLUSH.SOCKET.QUEUES \FILLBSPPUP
|
||||
BSPHELP))
|
||||
[COMS (* ; "debugging")
|
||||
[COMS (* ; "debugging")
|
||||
(FNS PPSOC PPSOC.CURRENT PRINTTIMER PRINTPUPQUEUE BSPPRINTPUP \RTP.INFO.HOOK)
|
||||
(DECLARE%: DONTCOPY (ALISTS (PUPPRINTMACROS 8 9 16 17 18 20]
|
||||
(INITRECORDS BSPSOC)
|
||||
(SYSRECORDS BSPSOC)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\BSPINIT)))
|
||||
(COMS (* ;
|
||||
"Some of these may want to be constants")
|
||||
(COMS (* ;
|
||||
"Some of these may want to be constants")
|
||||
(INITVARS (\BSPSOCKETS)
|
||||
(\RFC.TIMEOUT 2000)
|
||||
(\RTP.DALLY.TIMEOUT 5000)
|
||||
@@ -79,84 +78,84 @@ Copyright (c) 1982-1983, 1900, 1984-1987, 1990, 1993, 2021 by Venue & Xerox Corp
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE BSPSOC ((FRNPORT WORD)
|
||||
(FRNSOCKET FIXP) (* ; "Net,host,socket of partner")
|
||||
(FRNSOCKET FIXP) (* ; "Net,host,socket of partner")
|
||||
(LCLPORT WORD)
|
||||
(LCLSOCKET FIXP) (* ; "Net,host,socket of us")
|
||||
(RTPSTATE BYTE) (* ;
|
||||
"The current state of the RTP connection, see RTPSTATES")
|
||||
(RTPPROCESS POINTER) (* ; "Process handle for RTP demon")
|
||||
(RTPEVENT POINTER) (* ; "Notified when RTPSTATE changes")
|
||||
(PUPSOC POINTER) (* ;
|
||||
"The packet-level socket used by us")
|
||||
(CONNID POINTER) (* ;
|
||||
"A large integer, the connection ID")
|
||||
(RTPTIMER POINTER) (* ;
|
||||
"Timer used for timing out some RTP steps")
|
||||
(RTPTIMEOUT WORD) (* ;
|
||||
"Timeout for current RTP op, or zero if none")
|
||||
(BSPINPUTHANDLER POINTER) (* ;
|
||||
"Function that is the top-level loop of the watcher process")
|
||||
(LCLSOCKET FIXP) (* ; "Net,host,socket of us")
|
||||
(RTPSTATE BYTE) (* ;
|
||||
"The current state of the RTP connection, see RTPSTATES")
|
||||
(RTPPROCESS POINTER) (* ; "Process handle for RTP demon")
|
||||
(RTPEVENT POINTER) (* ; "Notified when RTPSTATE changes")
|
||||
(PUPSOC POINTER) (* ;
|
||||
"The packet-level socket used by us")
|
||||
(CONNID POINTER) (* ;
|
||||
"A large integer, the connection ID")
|
||||
(RTPTIMER POINTER) (* ;
|
||||
"Timer used for timing out some RTP steps")
|
||||
(RTPTIMEOUT WORD) (* ;
|
||||
"Timeout for current RTP op, or zero if none")
|
||||
(BSPINPUTHANDLER POINTER) (* ;
|
||||
"Function that is the top-level loop of the watcher process")
|
||||
|
||||
(* ;; "The rest of this structure is dedicated to handling the BSP")
|
||||
(* ;; "The rest of this structure is dedicated to handling the BSP")
|
||||
|
||||
(BSPINPUTSTREAM POINTER) (* ; "Pointer back to STREAM object")
|
||||
(BSPTIMER POINTER) (* ; "Timer for BSP use")
|
||||
(BSPINPUTSTREAM POINTER) (* ; "Pointer back to STREAM object")
|
||||
(BSPTIMER POINTER) (* ; "Timer for BSP use")
|
||||
(BSPTIMEOUT WORD)
|
||||
(BSPFAILUREREASON POINTER) (* ;
|
||||
"Why connection was broken or not opened")
|
||||
(BSPOTHERPUPFN POINTER) (* ;
|
||||
"Called on error, interrupt and non-bsp pups")
|
||||
(BSPERRORHANDLER POINTER) (* ; "Called for bsp errors")
|
||||
(BSPIOTIMEOUT POINTER) (* ;
|
||||
"if non-zero will cause prepare.output and prepare.input to timeout")
|
||||
(RCVBYTEID POINTER) (* ; "ID of as far as we have acked")
|
||||
(RCVINTERRUPTID POINTER) (* ; "ID of next incoming interrupt")
|
||||
(BSPINPUTQ POINTER) (* ;
|
||||
"Queue of all pups we have received")
|
||||
(%#UNREADPUPS WORD) (* ;
|
||||
"How many pups do we have before first hole in input")
|
||||
(XMITBYTEID POINTER) (* ; "Id of next outgoing pup")
|
||||
(XMITINTERRUPTID POINTER) (* ; "id of next outgoing interrupt")
|
||||
(LASTACKID POINTER) (* ;
|
||||
"Id of last ack, i.e. how far our partner has read us")
|
||||
(BSPFAILUREREASON POINTER) (* ;
|
||||
"Why connection was broken or not opened")
|
||||
(BSPOTHERPUPFN POINTER) (* ;
|
||||
"Called on error, interrupt and non-bsp pups")
|
||||
(BSPERRORHANDLER POINTER) (* ; "Called for bsp errors")
|
||||
(BSPIOTIMEOUT POINTER) (* ;
|
||||
"if non-zero will cause prepare.output and prepare.input to timeout")
|
||||
(RCVBYTEID POINTER) (* ; "ID of as far as we have acked")
|
||||
(RCVINTERRUPTID POINTER) (* ; "ID of next incoming interrupt")
|
||||
(BSPINPUTQ POINTER) (* ;
|
||||
"Queue of all pups we have received")
|
||||
(%#UNREADPUPS WORD) (* ;
|
||||
"How many pups do we have before first hole in input")
|
||||
(XMITBYTEID POINTER) (* ; "Id of next outgoing pup")
|
||||
(XMITINTERRUPTID POINTER) (* ; "id of next outgoing interrupt")
|
||||
(LASTACKID POINTER) (* ;
|
||||
"Id of last ack, i.e. how far our partner has read us")
|
||||
(%#UNACKEDPUPS WORD)
|
||||
(%#UNACKEDBYTES WORD) (* ;
|
||||
"how many pups/bytes have we sent that haven't been acked")
|
||||
(BSPOUTPUTQ POINTER) (* ;
|
||||
"Queue of sent but not acked pups")
|
||||
(BYTESPERPUP WORD) (* ;
|
||||
"Maximum size we are allowed to grow pups")
|
||||
(PUPALLOC WORD) (* ;
|
||||
"Remaining outgoing pup allocation, i.e. partner's allocation less #UNACKEDPUPS")
|
||||
(BYTEALLOC WORD) (* ;
|
||||
"Remaining outgoing byte allocation")
|
||||
(%#UNACKEDBYTES WORD) (* ;
|
||||
"how many pups/bytes have we sent that haven't been acked")
|
||||
(BSPOUTPUTQ POINTER) (* ;
|
||||
"Queue of sent but not acked pups")
|
||||
(BYTESPERPUP WORD) (* ;
|
||||
"Maximum size we are allowed to grow pups")
|
||||
(PUPALLOC WORD) (* ;
|
||||
"Remaining outgoing pup allocation, i.e. partner's allocation less #UNACKEDPUPS")
|
||||
(BYTEALLOC WORD) (* ;
|
||||
"Remaining outgoing byte allocation")
|
||||
(MAXPUPALLOC WORD)
|
||||
(PUPALLOCCOUNT WORD)
|
||||
(ADATACOUNT WORD) (* ; "incremented once per AData sent")
|
||||
(LASTADATATIME POINTER) (* ; "Time last ADATA was sent")
|
||||
(ADATATIMEOUT WORD) (* ;
|
||||
"Timeout currently in use for AData")
|
||||
(INACTIVITYTIMER POINTER) (* ;
|
||||
"Time of last incoming pup on this connection")
|
||||
(LISTENING FLAG) (* ;
|
||||
"if socket was opened as a server rather than user")
|
||||
(INTERRUPTOUT FLAG) (* ;
|
||||
"an unacked interrupt is outstanding")
|
||||
(INTERRUPTIN FLAG) (* ; "an interrupt has been received")
|
||||
(ACKPENDING FLAG) (* ;
|
||||
"Adata was received, we need to ack")
|
||||
(ACKREQUESTED FLAG) (* ;
|
||||
"We have sent an Adata, are waiting for ack")
|
||||
(SENTZEROALLOC FLAG) (* ; "Need to send gratuitous ack")
|
||||
(BSPNOACTIVITY FLAG) (* ;
|
||||
"True if BSPINACTIVITYTIMEOUT has passed with no sign of life from other side")
|
||||
(BSPUSERSTATE POINTER) (* ;
|
||||
"For applications use to do as it pleases")
|
||||
(NIL WORD) (* ; "No longer used")
|
||||
(IOTIMEOUTFN POINTER) (* ;
|
||||
"function to be called when prepare.* timeout")
|
||||
(BSPWHENCLOSEDFN POINTER) (* ;
|
||||
"Called when connection is closed")
|
||||
(ADATACOUNT WORD) (* ; "incremented once per AData sent")
|
||||
(LASTADATATIME POINTER) (* ; "Time last ADATA was sent")
|
||||
(ADATATIMEOUT WORD) (* ;
|
||||
"Timeout currently in use for AData")
|
||||
(INACTIVITYTIMER POINTER) (* ;
|
||||
"Time of last incoming pup on this connection")
|
||||
(LISTENING FLAG) (* ;
|
||||
"if socket was opened as a server rather than user")
|
||||
(INTERRUPTOUT FLAG) (* ;
|
||||
"an unacked interrupt is outstanding")
|
||||
(INTERRUPTIN FLAG) (* ; "an interrupt has been received")
|
||||
(ACKPENDING FLAG) (* ;
|
||||
"Adata was received, we need to ack")
|
||||
(ACKREQUESTED FLAG) (* ;
|
||||
"We have sent an Adata, are waiting for ack")
|
||||
(SENTZEROALLOC FLAG) (* ; "Need to send gratuitous ack")
|
||||
(BSPNOACTIVITY FLAG) (* ;
|
||||
"True if BSPINACTIVITYTIMEOUT has passed with no sign of life from other side")
|
||||
(BSPUSERSTATE POINTER) (* ;
|
||||
"For applications use to do as it pleases")
|
||||
(NIL WORD) (* ; "No longer used")
|
||||
(IOTIMEOUTFN POINTER) (* ;
|
||||
"function to be called when prepare.* timeout")
|
||||
(BSPWHENCLOSEDFN POINTER) (* ;
|
||||
"Called when connection is closed")
|
||||
(BSPINPUTEVENT POINTER)
|
||||
(BSPLOCK POINTER)
|
||||
(BSPINITTIMER POINTER)
|
||||
@@ -175,7 +174,7 @@ Copyright (c) 1982-1983, 1900, 1984-1987, 1990, 1993, 2021 by Venue & Xerox Corp
|
||||
(LCLPUPADDRESS (CONS (fetch LCLPORT of DATUM)
|
||||
(fetch LCLSOCKET of DATUM]
|
||||
|
||||
(* ;; "Note: I assume record pkg does not break up the first six words (the two ports). I hope I don't have to force it")
|
||||
(* ;; "Note: I assume record pkg does not break up the first six words (the two ports). I hope I don't have to force it")
|
||||
|
||||
RTPTIMER _ (CREATECELL \FIXP)
|
||||
BSPTIMER _ (CREATECELL \FIXP)
|
||||
@@ -186,25 +185,25 @@ Copyright (c) 1982-1983, 1900, 1984-1987, 1990, 1993, 2021 by Venue & Xerox Corp
|
||||
|
||||
(BLOCKRECORD ACKPUP ((ACKBYTESPERPUP WORD)
|
||||
(ACKPUPS WORD)
|
||||
(ACKBYTES WORD)) (* ;
|
||||
"body of ACK pup, giving partner's allocation")
|
||||
(ACKBYTES WORD)) (* ;
|
||||
"body of ACK pup, giving partner's allocation")
|
||||
)
|
||||
|
||||
(ACCESSFNS BSPSTREAM [(BSPSOC (fetch F1 of DATUM)
|
||||
(replace F1 of DATUM with NEWVALUE))
|
||||
(* ; "BSPSOC object")
|
||||
(* ; "BSPSOC object")
|
||||
(BSPOUTPUTSTREAM (fetch F2 of DATUM)
|
||||
(replace F2 of DATUM with NEWVALUE))
|
||||
(* ;
|
||||
"If this stream is the input side, gives output side")
|
||||
(* ;
|
||||
"If this stream is the input side, gives output side")
|
||||
(BSPCURRENTPUP (fetch F3 of DATUM)
|
||||
(replace F3 of DATUM with NEWVALUE))
|
||||
(* ;
|
||||
"PUP whose body is the current buffer. Could be redundant")
|
||||
(* ;
|
||||
"PUP whose body is the current buffer. Could be redundant")
|
||||
(MARKPENDING (fetch F4 of DATUM)
|
||||
(replace F4 of DATUM with NEWVALUE))
|
||||
(* ;
|
||||
"On input, true if next byte is a mark")
|
||||
(* ;
|
||||
"On input, true if next byte is a mark")
|
||||
(BSPFILEPTRHI (fetch FW6 of DATUM)
|
||||
(replace FW6 of DATUM with NEWVALUE))
|
||||
(BSPFILEPTRLO (fetch FW7 of DATUM)
|
||||
@@ -318,17 +317,16 @@ Copyright (c) 1982-1983, 1900, 1984-1987, 1990, 1993, 2021 by Venue & Xerox Corp
|
||||
)
|
||||
|
||||
|
||||
(RPAQQ RTPEVENTS
|
||||
((\EVENT.OPEN 0)
|
||||
(\EVENT.OPENLISTENING 1)
|
||||
(\EVENT.OPENIMMEDIATE 2)
|
||||
(\EVENT.CLOSE 3)
|
||||
(\EVENT.FORCECLOSE 4)
|
||||
(\EVENT.RFC 5)
|
||||
(\EVENT.ABORT 6)
|
||||
(\EVENT.END 7)
|
||||
(\EVENT.ENDREPLY 8)
|
||||
(\EVENT.TIMEOUT 9)))
|
||||
(RPAQQ RTPEVENTS ((\EVENT.OPEN 0)
|
||||
(\EVENT.OPENLISTENING 1)
|
||||
(\EVENT.OPENIMMEDIATE 2)
|
||||
(\EVENT.CLOSE 3)
|
||||
(\EVENT.FORCECLOSE 4)
|
||||
(\EVENT.RFC 5)
|
||||
(\EVENT.ABORT 6)
|
||||
(\EVENT.END 7)
|
||||
(\EVENT.ENDREPLY 8)
|
||||
(\EVENT.TIMEOUT 9)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \EVENT.OPEN 0)
|
||||
@@ -374,47 +372,44 @@ Copyright (c) 1982-1983, 1900, 1984-1987, 1990, 1993, 2021 by Venue & Xerox Corp
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS RTP.OTHERFN MACRO ((PUP SOCKET)
|
||||
(SELECTQ (fetch OTHERPUPFN of SOCKET)
|
||||
(RELEASE.PUP (RELEASE.PUP PUP))
|
||||
(\BSP.PUPHANDLER
|
||||
(\BSP.PUPHANDLER PUP SOCKET))
|
||||
(APPLY* (fetch OTHERPUPFN of SOCKET)
|
||||
PUP SOCKET))))
|
||||
[PUTPROPS RTP.OTHERFN MACRO ((PUP SOCKET)
|
||||
(SELECTQ (fetch OTHERPUPFN of SOCKET)
|
||||
(RELEASE.PUP (RELEASE.PUP PUP))
|
||||
(\BSP.PUPHANDLER
|
||||
(\BSP.PUPHANDLER PUP SOCKET))
|
||||
(APPLY* (fetch OTHERPUPFN of SOCKET)
|
||||
PUP SOCKET]
|
||||
|
||||
(PUTPROPS BSP.OTHERFN MACRO [(PUP SOCKET)
|
||||
(SELECTQ (fetch BSPOTHERPUPFN of SOCKET)
|
||||
(RELEASE.PUP (RELEASE.PUP PUP))
|
||||
(APPLY* (fetch BSPOTHERPUPFN of SOCKET)
|
||||
PUP
|
||||
(fetch BSPINPUTSTREAM of SOCKET])
|
||||
[PUTPROPS BSP.OTHERFN MACRO ((PUP SOCKET)
|
||||
(SELECTQ (fetch BSPOTHERPUPFN of SOCKET)
|
||||
(RELEASE.PUP (RELEASE.PUP PUP))
|
||||
(APPLY* (fetch BSPOTHERPUPFN of SOCKET)
|
||||
PUP
|
||||
(fetch BSPINPUTSTREAM of SOCKET]
|
||||
|
||||
(PUTPROPS BSP.INPUT.ERROR MACRO (OPENLAMBDA (STREAM ERRCODE)
|
||||
(APPLY* (fetch BSPERRORHANDLER
|
||||
of (fetch BSPSOC of STREAM))
|
||||
STREAM ERRCODE)))
|
||||
(PUTPROPS BSP.INPUT.ERROR MACRO (OPENLAMBDA (STREAM ERRCODE)
|
||||
(APPLY* (fetch BSPERRORHANDLER
|
||||
of (fetch BSPSOC of STREAM))
|
||||
STREAM ERRCODE)))
|
||||
|
||||
(PUTPROPS BSP.OUTPUT.ERROR MACRO (OPENLAMBDA (STREAM ERRCODE)
|
||||
(APPLY* (fetch BSPERRORHANDLER
|
||||
of (fetch BSPSOC of STREAM))
|
||||
STREAM ERRCODE)))
|
||||
(PUTPROPS BSP.OUTPUT.ERROR MACRO (OPENLAMBDA (STREAM ERRCODE)
|
||||
(APPLY* (fetch BSPERRORHANDLER
|
||||
of (fetch BSPSOC of STREAM))
|
||||
STREAM ERRCODE)))
|
||||
|
||||
(PUTPROPS \BSPINCFILEPTR MACRO [(STREAM N)
|
||||
(PROG (NEWLO)
|
||||
(replace BSPFILEPTRLO of STREAM
|
||||
with (COND
|
||||
((IGREATERP (SETQ NEWLO
|
||||
(IPLUS (fetch
|
||||
BSPFILEPTRLO
|
||||
of STREAM)
|
||||
N))
|
||||
MAX.SMALL.INTEGER)
|
||||
(add (fetch BSPFILEPTRHI
|
||||
of STREAM)
|
||||
1)
|
||||
(SUB1 (IDIFFERENCE NEWLO
|
||||
MAX.SMALL.INTEGER)))
|
||||
(T NEWLO])
|
||||
[PUTPROPS \BSPINCFILEPTR MACRO ((STREAM N)
|
||||
(PROG (NEWLO)
|
||||
(replace BSPFILEPTRLO of STREAM
|
||||
with (COND
|
||||
((IGREATERP (SETQ NEWLO
|
||||
(IPLUS (fetch BSPFILEPTRLO
|
||||
of STREAM)
|
||||
N))
|
||||
MAX.SMALL.INTEGER)
|
||||
(add (fetch BSPFILEPTRHI of STREAM)
|
||||
1)
|
||||
(SUB1 (IDIFFERENCE NEWLO MAX.SMALL.INTEGER)))
|
||||
(T NEWLO]
|
||||
)
|
||||
)
|
||||
|
||||
@@ -2667,34 +2662,33 @@ Copyright (c) 1982-1983, 1900, 1984-1987, 1990, 1993, 2021 by Venue & Xerox Corp
|
||||
\BSP.MIN.ADATA.TIMEOUT \BSP.MAX.ADATA.TIMEOUT \BSP.INACTIVITY.TIMEOUT
|
||||
\BSP.NO.INACTIVITY.TIMEOUT)
|
||||
)
|
||||
(PUTPROPS BSP COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1900 1984 1985 1986 1987 1990 1993 2021
|
||||
))
|
||||
(PUTPROPS BSP COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1900 1984 1985 1986 1987 1990 1993))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (22186 30354 (OPENRTPSOCKET 22196 . 27464) (CLOSERTPSOCKET 27466 . 29656) (
|
||||
\INIT.RTPPROCESS 29658 . 30352)) (30383 56738 (\RTP.SOCKET.PROCESS 30393 . 31244) (\RTP.HANDLE.INPUT
|
||||
31246 . 32231) (\RTP.HANDLE.PUP 32233 . 33765) (\RTP.HANDLE.RFC 33767 . 36259) (\RTP.CLEANUP 36261 .
|
||||
37305) (\RTP.ACTION 37307 . 47779) (\RTP.ERROR 47781 . 48247) (\RTP.SHOW.FAILURE 48249 . 49686) (
|
||||
\RTP.FILTER 49688 . 51153) (\SEND.ABORT 51155 . 52073) (\SEND.ANSWERING.RFC 52075 . 53820) (\SEND.END
|
||||
53822 . 54034) (\SEND.ENDREPLY 54036 . 54258) (\SEND.RFC 54260 . 55632) (\FILLRTPPUP 55634 . 56317) (
|
||||
\SETRTPPORTS 56319 . 56736)) (56739 59996 (\BSPINIT 56749 . 58588) (\BSPEVENTFN 58590 . 58929) (
|
||||
\BSP.CLOSE.OPEN.SOCKETS 58931 . 59994)) (60033 74318 (OPENBSPSTREAM 60043 . 67019) (\SMASHBSPSTREAM
|
||||
67021 . 68392) (BSPOUTPUTSTREAM 68394 . 68750) (BSPINPUTSTREAM 68752 . 68986) (BSPFRNADDRESS 68988 .
|
||||
69205) (CLOSEBSPSTREAM 69207 . 71911) (\BSP.FLUSHINPUT 71913 . 72464) (BSPOPENP 72466 . 73745) (
|
||||
GETBSPUSERINFO 73747 . 74007) (SETBSPUSERINFO 74009 . 74316)) (74319 74780 (CREATEBSPSTREAM 74329 .
|
||||
74625) (ENDBSPSTREAM 74627 . 74778)) (74818 99611 (BSPBIN 74828 . 74960) (\BSP.GETNEXTBUFFER 74962 .
|
||||
76639) (BSPPEEKBIN 76641 . 76792) (BSPREADP 76794 . 77994) (BSPEOFP 77996 . 78776) (\BSPBACKFILEPTR
|
||||
78778 . 79212) (\BSP.PREPARE.INPUT 79214 . 83634) (\BSP.GETFILEPTR 83636 . 83932) (
|
||||
\BSP.DECLARE.FILEPTR 83934 . 84109) (\BSP.SETFILEPTR 84111 . 84728) (\BSP.SKIPBYTES 84730 . 85518) (
|
||||
\BSP.CLEANUP.INPUT 85520 . 86554) (BSPBOUT 86556 . 86777) (\BSP.OTHERBOUT 86779 . 87035) (
|
||||
\BSPWRITEBLOCK 87037 . 87296) (BSPFORCEOUTPUT 87298 . 88335) (\BSP.SENDBUFFER 88337 . 91173) (
|
||||
\BSP.PREPARE.OUTPUT 91175 . 95052) (BSPGETMARK 95054 . 95531) (BSPPUTMARK 95533 . 97142) (
|
||||
BSP.PUTINTERRUPT 97144 . 99609)) (99644 129131 (\BSP.HANDLE.INPUT 99654 . 102515) (\BSP.HANDLE.ACK
|
||||
102517 . 111645) (\BSP.HANDLE.DATA 111647 . 116579) (\BSP.HANDLE.ERROR 116581 . 117781) (
|
||||
\BSP.HANDLE.INTERRUPT 117783 . 119293) (\BSP.HANDLE.INTERRUPTREPLY 119295 . 120756) (\SEND.ACK 120758
|
||||
. 122678) (\SEARCH.OUTPUTQ 122680 . 124159) (\SETBSPTIMEOUT 124161 . 126045) (\TRANSMIT.STRATEGY
|
||||
126047 . 129129)) (129162 133566 (\BSP.DEFAULT.ERROR.HANDLER 129172 . 129586) (\BSP.TIMERFN 129588 .
|
||||
132024) (\BSP.FLUSH.SOCKET.QUEUES 132026 . 132905) (\FILLBSPPUP 132907 . 133428) (BSPHELP 133430 .
|
||||
133564)) (133593 143408 (PPSOC 133603 . 138899) (PPSOC.CURRENT 138901 . 139240) (PRINTTIMER 139242 .
|
||||
139724) (PRINTPUPQUEUE 139726 . 142001) (BSPPRINTPUP 142003 . 142675) (\RTP.INFO.HOOK 142677 . 143406)
|
||||
(FILEMAP (NIL (21817 29985 (OPENRTPSOCKET 21827 . 27095) (CLOSERTPSOCKET 27097 . 29287) (
|
||||
\INIT.RTPPROCESS 29289 . 29983)) (30014 56369 (\RTP.SOCKET.PROCESS 30024 . 30875) (\RTP.HANDLE.INPUT
|
||||
30877 . 31862) (\RTP.HANDLE.PUP 31864 . 33396) (\RTP.HANDLE.RFC 33398 . 35890) (\RTP.CLEANUP 35892 .
|
||||
36936) (\RTP.ACTION 36938 . 47410) (\RTP.ERROR 47412 . 47878) (\RTP.SHOW.FAILURE 47880 . 49317) (
|
||||
\RTP.FILTER 49319 . 50784) (\SEND.ABORT 50786 . 51704) (\SEND.ANSWERING.RFC 51706 . 53451) (\SEND.END
|
||||
53453 . 53665) (\SEND.ENDREPLY 53667 . 53889) (\SEND.RFC 53891 . 55263) (\FILLRTPPUP 55265 . 55948) (
|
||||
\SETRTPPORTS 55950 . 56367)) (56370 59627 (\BSPINIT 56380 . 58219) (\BSPEVENTFN 58221 . 58560) (
|
||||
\BSP.CLOSE.OPEN.SOCKETS 58562 . 59625)) (59664 73949 (OPENBSPSTREAM 59674 . 66650) (\SMASHBSPSTREAM
|
||||
66652 . 68023) (BSPOUTPUTSTREAM 68025 . 68381) (BSPINPUTSTREAM 68383 . 68617) (BSPFRNADDRESS 68619 .
|
||||
68836) (CLOSEBSPSTREAM 68838 . 71542) (\BSP.FLUSHINPUT 71544 . 72095) (BSPOPENP 72097 . 73376) (
|
||||
GETBSPUSERINFO 73378 . 73638) (SETBSPUSERINFO 73640 . 73947)) (73950 74411 (CREATEBSPSTREAM 73960 .
|
||||
74256) (ENDBSPSTREAM 74258 . 74409)) (74449 99242 (BSPBIN 74459 . 74591) (\BSP.GETNEXTBUFFER 74593 .
|
||||
76270) (BSPPEEKBIN 76272 . 76423) (BSPREADP 76425 . 77625) (BSPEOFP 77627 . 78407) (\BSPBACKFILEPTR
|
||||
78409 . 78843) (\BSP.PREPARE.INPUT 78845 . 83265) (\BSP.GETFILEPTR 83267 . 83563) (
|
||||
\BSP.DECLARE.FILEPTR 83565 . 83740) (\BSP.SETFILEPTR 83742 . 84359) (\BSP.SKIPBYTES 84361 . 85149) (
|
||||
\BSP.CLEANUP.INPUT 85151 . 86185) (BSPBOUT 86187 . 86408) (\BSP.OTHERBOUT 86410 . 86666) (
|
||||
\BSPWRITEBLOCK 86668 . 86927) (BSPFORCEOUTPUT 86929 . 87966) (\BSP.SENDBUFFER 87968 . 90804) (
|
||||
\BSP.PREPARE.OUTPUT 90806 . 94683) (BSPGETMARK 94685 . 95162) (BSPPUTMARK 95164 . 96773) (
|
||||
BSP.PUTINTERRUPT 96775 . 99240)) (99275 128762 (\BSP.HANDLE.INPUT 99285 . 102146) (\BSP.HANDLE.ACK
|
||||
102148 . 111276) (\BSP.HANDLE.DATA 111278 . 116210) (\BSP.HANDLE.ERROR 116212 . 117412) (
|
||||
\BSP.HANDLE.INTERRUPT 117414 . 118924) (\BSP.HANDLE.INTERRUPTREPLY 118926 . 120387) (\SEND.ACK 120389
|
||||
. 122309) (\SEARCH.OUTPUTQ 122311 . 123790) (\SETBSPTIMEOUT 123792 . 125676) (\TRANSMIT.STRATEGY
|
||||
125678 . 128760)) (128793 133197 (\BSP.DEFAULT.ERROR.HANDLER 128803 . 129217) (\BSP.TIMERFN 129219 .
|
||||
131655) (\BSP.FLUSH.SOCKET.QUEUES 131657 . 132536) (\FILLBSPPUP 132538 . 133059) (BSPHELP 133061 .
|
||||
133195)) (133224 143039 (PPSOC 133234 . 138530) (PPSOC.CURRENT 138532 . 138871) (PRINTTIMER 138873 .
|
||||
139355) (PRINTPUPQUEUE 139357 . 141632) (BSPPRINTPUP 141634 . 142306) (\RTP.INFO.HOOK 142308 . 143037)
|
||||
))))
|
||||
STOP
|
||||
|
||||
BIN
sources/BSP.LCOM
BIN
sources/BSP.LCOM
Binary file not shown.
@@ -1,95 +1,104 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED " 5-Sep-2021 08:24:05"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CLSTREAMS.;2| 52344
|
||||
(FILECREATED " 3-Apr-91 15:11:53" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>CLSTREAMS.;4| 54013
|
||||
|
||||
|changes| |to:| (FNS %INITIALIZE-CLSTREAM-TYPES)
|
||||
|changes| |to:| (FUNCTIONS CL:WITH-INPUT-FROM-STRING)
|
||||
|
||||
|previous| |date:| " 3-Apr-91 15:11:53"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CLSTREAMS.;1|)
|
||||
|previous| |date:| "27-Feb-91 20:05:55" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>CLSTREAMS.;3|)
|
||||
|
||||
|
||||
; Copyright (c) 1985-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
|
||||
; Copyright (c) 1985, 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All rights reserved.
|
||||
|
||||
(PRETTYCOMPRINT CLSTREAMSCOMS)
|
||||
|
||||
(RPAQQ CLSTREAMSCOMS
|
||||
(
|
||||
(RPAQQ CLSTREAMSCOMS (
|
||||
|
||||
(* |;;;| "Implements a number of stream functions from CommonLisp. See CLtL chapter 21")
|
||||
(* |;;;| "Implements a number of stream functions from CommonLisp. See CLtL chapter 21")
|
||||
|
||||
(COMS
|
||||
(* |;;| "documented functions and macros")
|
||||
(COMS
|
||||
(* |;;| "documented functions and macros")
|
||||
|
||||
(FUNCTIONS OPEN CL:CLOSE CL:STREAM-EXTERNAL-FORMAT)
|
||||
(FUNCTIONS CL:STREAM-ELEMENT-TYPE CL:INPUT-STREAM-P CL:OUTPUT-STREAM-P
|
||||
XCL:OPEN-STREAM-P)
|
||||
(COMS (FUNCTIONS FILE-STREAM-POSITION)
|
||||
(SETFS FILE-STREAM-POSITION))
|
||||
(FUNCTIONS CL:MAKE-SYNONYM-STREAM XCL:SYNONYM-STREAM-P XCL:SYNONYM-STREAM-SYMBOL
|
||||
XCL:FOLLOW-SYNONYM-STREAMS)
|
||||
(FUNCTIONS CL:MAKE-BROADCAST-STREAM XCL:BROADCAST-STREAM-P XCL:BROADCAST-STREAM-STREAMS
|
||||
)
|
||||
(FUNCTIONS CL:MAKE-CONCATENATED-STREAM XCL:CONCATENATED-STREAM-P
|
||||
XCL:CONCATENATED-STREAM-STREAMS)
|
||||
(FUNCTIONS CL:MAKE-TWO-WAY-STREAM XCL:TWO-WAY-STREAM-P XCL:TWO-WAY-STREAM-OUTPUT-STREAM
|
||||
XCL:TWO-WAY-STREAM-INPUT-STREAM)
|
||||
(FUNCTIONS CL:MAKE-ECHO-STREAM XCL:ECHO-STREAM-P XCL:ECHO-STREAM-INPUT-STREAM
|
||||
XCL:ECHO-STREAM-OUTPUT-STREAM)
|
||||
(FUNCTIONS CL:MAKE-STRING-INPUT-STREAM MAKE-CONCATENATED-STRING-INPUT-STREAM)
|
||||
(FUNCTIONS %MAKE-INITIAL-STRING-STREAM-CONTENTS)
|
||||
(FUNCTIONS CL:WITH-OPEN-STREAM CL:WITH-INPUT-FROM-STRING CL:WITH-OUTPUT-TO-STRING
|
||||
CL:WITH-OPEN-FILE)
|
||||
(FUNCTIONS CL:MAKE-STRING-OUTPUT-STREAM MAKE-FILL-POINTER-OUTPUT-STREAM
|
||||
CL:GET-OUTPUT-STREAM-STRING \\STRING-STREAM-OUTCHARFN
|
||||
\\ADJUSTABLE-STRING-STREAM-OUTCHARFN))
|
||||
(COMS
|
||||
(* |;;| "helpers")
|
||||
(FUNCTIONS OPEN CL:CLOSE CL:STREAM-EXTERNAL-FORMAT)
|
||||
(FUNCTIONS CL:STREAM-ELEMENT-TYPE CL:INPUT-STREAM-P
|
||||
CL:OUTPUT-STREAM-P XCL:OPEN-STREAM-P)
|
||||
(COMS (FUNCTIONS FILE-STREAM-POSITION)
|
||||
(SETFS FILE-STREAM-POSITION))
|
||||
(FUNCTIONS CL:MAKE-SYNONYM-STREAM XCL:SYNONYM-STREAM-P
|
||||
XCL:SYNONYM-STREAM-SYMBOL XCL:FOLLOW-SYNONYM-STREAMS)
|
||||
(FUNCTIONS CL:MAKE-BROADCAST-STREAM XCL:BROADCAST-STREAM-P
|
||||
XCL:BROADCAST-STREAM-STREAMS)
|
||||
(FUNCTIONS CL:MAKE-CONCATENATED-STREAM XCL:CONCATENATED-STREAM-P
|
||||
XCL:CONCATENATED-STREAM-STREAMS)
|
||||
(FUNCTIONS CL:MAKE-TWO-WAY-STREAM XCL:TWO-WAY-STREAM-P
|
||||
XCL:TWO-WAY-STREAM-OUTPUT-STREAM
|
||||
XCL:TWO-WAY-STREAM-INPUT-STREAM)
|
||||
(FUNCTIONS CL:MAKE-ECHO-STREAM XCL:ECHO-STREAM-P
|
||||
XCL:ECHO-STREAM-INPUT-STREAM XCL:ECHO-STREAM-OUTPUT-STREAM)
|
||||
(FUNCTIONS CL:MAKE-STRING-INPUT-STREAM
|
||||
MAKE-CONCATENATED-STRING-INPUT-STREAM)
|
||||
(FUNCTIONS %MAKE-INITIAL-STRING-STREAM-CONTENTS)
|
||||
(FUNCTIONS CL:WITH-OPEN-STREAM CL:WITH-INPUT-FROM-STRING
|
||||
CL:WITH-OUTPUT-TO-STRING CL:WITH-OPEN-FILE)
|
||||
(FUNCTIONS CL:MAKE-STRING-OUTPUT-STREAM
|
||||
MAKE-FILL-POINTER-OUTPUT-STREAM CL:GET-OUTPUT-STREAM-STRING
|
||||
\\STRING-STREAM-OUTCHARFN \\ADJUSTABLE-STRING-STREAM-OUTCHARFN
|
||||
))
|
||||
(COMS
|
||||
(* |;;| "helpers")
|
||||
|
||||
(FUNCTIONS %NEW-FILE PREDICT-NAME)
|
||||
(DECLARE\: EVAL@COMPILE DONTCOPY (FUNCTIONS INTERLISP-ACCESS)))
|
||||
(COMS
|
||||
(* |;;| "methods for the special devices")
|
||||
(FUNCTIONS %NEW-FILE PREDICT-NAME)
|
||||
(DECLARE\: EVAL@COMPILE DONTCOPY (FUNCTIONS INTERLISP-ACCESS)))
|
||||
(COMS
|
||||
(* |;;| "methods for the special devices")
|
||||
|
||||
(FNS %BROADCAST-STREAM-DEVICE-BOUT %BROADCAST-STREAM-DEVICE-OUTCHARFN
|
||||
%BROADCAST-STREAM-DEVICE-CLOSEFILE %BROADCAST-STREAM-DEVICE-FORCEOUTPUT)
|
||||
(FUNCTIONS %BROADCAST-STREAM-DEVICE-CHARSETFN)
|
||||
(FNS %CONCATENATED-STREAM-DEVICE-BIN %CONCATENATED-STREAM-DEVICE-CLOSEFILE
|
||||
%CONCATENATED-STREAM-DEVICE-EOFP %CONCATENATED-STREAM-DEVICE-PEEKBIN
|
||||
%CONCATENATED-STREAM-DEVICE-BACKFILEPTR)
|
||||
(FUNCTIONS %CONCATENATED-STREAM-DEVICE-CHARSETFN)
|
||||
(FNS %ECHO-STREAM-DEVICE-BIN)
|
||||
(FUNCTIONS %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM)
|
||||
(FNS %SYNONYM-STREAM-DEVICE-BIN %SYNONYM-STREAM-DEVICE-BOUT
|
||||
%SYNONYM-STREAM-DEVICE-OUTCHARFN %SYNONYM-STREAM-DEVICE-CLOSEFILE
|
||||
%SYNONYM-STREAM-DEVICE-EOFP %SYNONYM-STREAM-DEVICE-FORCEOUTPUT
|
||||
%SYNONYM-STREAM-DEVICE-GETFILEINFO %SYNONYM-STREAM-DEVICE-PEEKBIN
|
||||
%SYNONYM-STREAM-DEVICE-READP %SYNONYM-STREAM-DEVICE-BACKFILEPTR
|
||||
%SYNONYM-STREAM-DEVICE-SETFILEINFO %SYNONYM-STREAM-DEVICE-CHARSETFN)
|
||||
(FNS %TWO-WAY-STREAM-DEVICE-BIN %TWO-WAY-STREAM-DEVICE-INPUTSTREAM
|
||||
%TWO-WAY-STREAM-DEVICE-BOUT %TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM
|
||||
%TWO-WAY-STREAM-DEVICE-OUTCHARFN %TWO-WAY-STREAM-DEVICE-CLOSEFILE
|
||||
%TWO-WAY-STREAM-DEVICE-EOFP %TWO-WAY-STREAM-DEVICE-READP
|
||||
%TWO-WAY-STREAM-DEVICE-BACKFILEPTR %TWO-WAY-STREAM-DEVICE-FORCEOUTPUT
|
||||
%TWO-WAY-STREAM-DEVICE-PEEKBIN %TWO-WAY-STREAM-DEVICE-CHARSETFN)
|
||||
(FUNCTIONS %FILL-POINTER-STREAM-DEVICE-CLOSEFILE %FILL-POINTER-STREAM-DEVICE-GETFILEPTR
|
||||
)
|
||||
(GLOBALVARS %SYNONYM-STREAM-DEVICE %BROADCAST-STREAM-DEVICE %CONCATENATED-STREAM-DEVICE
|
||||
%TWO-WAY-STREAM-DEVICE %ECHO-STREAM-DEVICE \\FILL-POINTER-STREAM-DEVICE))
|
||||
(COMS
|
||||
(* |;;| "helper stuff")
|
||||
(FNS %BROADCAST-STREAM-DEVICE-BOUT %BROADCAST-STREAM-DEVICE-OUTCHARFN
|
||||
%BROADCAST-STREAM-DEVICE-CLOSEFILE
|
||||
%BROADCAST-STREAM-DEVICE-FORCEOUTPUT)
|
||||
(FUNCTIONS %BROADCAST-STREAM-DEVICE-CHARSETFN)
|
||||
(FNS %CONCATENATED-STREAM-DEVICE-BIN
|
||||
%CONCATENATED-STREAM-DEVICE-CLOSEFILE
|
||||
%CONCATENATED-STREAM-DEVICE-EOFP
|
||||
%CONCATENATED-STREAM-DEVICE-PEEKBIN
|
||||
%CONCATENATED-STREAM-DEVICE-BACKFILEPTR)
|
||||
(FUNCTIONS %CONCATENATED-STREAM-DEVICE-CHARSETFN)
|
||||
(FNS %ECHO-STREAM-DEVICE-BIN)
|
||||
(FUNCTIONS %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM)
|
||||
(FNS %SYNONYM-STREAM-DEVICE-BIN %SYNONYM-STREAM-DEVICE-BOUT
|
||||
%SYNONYM-STREAM-DEVICE-OUTCHARFN
|
||||
%SYNONYM-STREAM-DEVICE-CLOSEFILE %SYNONYM-STREAM-DEVICE-EOFP
|
||||
%SYNONYM-STREAM-DEVICE-FORCEOUTPUT
|
||||
%SYNONYM-STREAM-DEVICE-GETFILEINFO
|
||||
%SYNONYM-STREAM-DEVICE-PEEKBIN %SYNONYM-STREAM-DEVICE-READP
|
||||
%SYNONYM-STREAM-DEVICE-BACKFILEPTR
|
||||
%SYNONYM-STREAM-DEVICE-SETFILEINFO
|
||||
%SYNONYM-STREAM-DEVICE-CHARSETFN)
|
||||
(FNS %TWO-WAY-STREAM-DEVICE-BIN %TWO-WAY-STREAM-DEVICE-INPUTSTREAM
|
||||
%TWO-WAY-STREAM-DEVICE-BOUT %TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM
|
||||
%TWO-WAY-STREAM-DEVICE-OUTCHARFN
|
||||
%TWO-WAY-STREAM-DEVICE-CLOSEFILE %TWO-WAY-STREAM-DEVICE-EOFP
|
||||
%TWO-WAY-STREAM-DEVICE-READP %TWO-WAY-STREAM-DEVICE-BACKFILEPTR
|
||||
%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT
|
||||
%TWO-WAY-STREAM-DEVICE-PEEKBIN %TWO-WAY-STREAM-DEVICE-CHARSETFN)
|
||||
(FUNCTIONS %FILL-POINTER-STREAM-DEVICE-CLOSEFILE
|
||||
%FILL-POINTER-STREAM-DEVICE-GETFILEPTR)
|
||||
(GLOBALVARS %SYNONYM-STREAM-DEVICE %BROADCAST-STREAM-DEVICE
|
||||
%CONCATENATED-STREAM-DEVICE %TWO-WAY-STREAM-DEVICE
|
||||
%ECHO-STREAM-DEVICE \\FILL-POINTER-STREAM-DEVICE))
|
||||
(COMS
|
||||
(* |;;| "helper stuff")
|
||||
|
||||
(FNS %SYNONYM-STREAM-DEVICE-GET-STREAM))
|
||||
(COMS
|
||||
(* |;;| "module initialization")
|
||||
(FNS %SYNONYM-STREAM-DEVICE-GET-STREAM))
|
||||
(COMS
|
||||
(* |;;| "module initialization")
|
||||
|
||||
(VARIABLES *DEBUG-IO* *QUERY-IO* *TERMINAL-IO* *ERROR-OUTPUT* *STANDARD-OUTPUT*
|
||||
*STANDARD-INPUT*)
|
||||
(FUNCTIONS %INITIALIZE-STANDARD-STREAMS)
|
||||
(FNS %INITIALIZE-CLSTREAM-TYPES)
|
||||
(DECLARE\: DONTEVAL@LOAD DOCOPY (* \; "initialization")
|
||||
(P (%INITIALIZE-CLSTREAM-TYPES)
|
||||
(%INITIALIZE-STANDARD-STREAMS))))
|
||||
(PROP FILETYPE CLSTREAMS)))
|
||||
(VARIABLES *DEBUG-IO* *QUERY-IO* *TERMINAL-IO* *ERROR-OUTPUT*
|
||||
*STANDARD-OUTPUT* *STANDARD-INPUT*)
|
||||
(FUNCTIONS %INITIALIZE-STANDARD-STREAMS)
|
||||
(FNS %INITIALIZE-CLSTREAM-TYPES)
|
||||
(DECLARE\: DONTEVAL@LOAD DOCOPY
|
||||
(* \; "initialization")
|
||||
(P (%INITIALIZE-CLSTREAM-TYPES)
|
||||
(%INITIALIZE-STANDARD-STREAMS))))
|
||||
(PROP FILETYPE CLSTREAMS)))
|
||||
|
||||
|
||||
|
||||
@@ -107,7 +116,7 @@
|
||||
(IF-DOES-NOT-EXIST NIL DOES-NOT-EXIST-P)
|
||||
(EXTERNAL-FORMAT :DEFAULT))
|
||||
|
||||
(* |;;;| "Return a stream which reads from or writes to Filename. Defined keywords: :direction (one of :input, :output or :probe :element-type), Type of object to read or write, default String-Char, :if-exists (one of :error, :new-version, :overwrite, :append or nil), :if-does-not-exist (one of :error, :create or nil). :external-format (one of :DEFAULT, :EUC, :JIS, :W-MS, :MS or :XCCS). The specification of :external-format is based on the JEIDA proposal. See the manual for details.")
|
||||
(* |;;;| "Return a stream which reads from or writes to Filename. Defined keywords: :direction (one of :input, :output or :probe :element-type), Type of object to read or write, default String-Char, :if-exists (one of :error, :new-version, :overwrite, :append or nil), :if-does-not-exist (one of :error, :create or nil). :external-format (one of :DEFAULT, :EUC, :JIS, :W-MS, :MS or :XCCS). The specification of :external-format is based on the JEIDA proposal. See the manual for details.")
|
||||
|
||||
(CL:UNLESS (MEMQ DIRECTION '(:INPUT :OUTPUT :IO :PROBE))
|
||||
(CL:ERROR "~S isn't a valid direction for open." DIRECTION))
|
||||
@@ -133,14 +142,14 @@
|
||||
ELSE 'TEXT))
|
||||
(STREAM NIL))
|
||||
|
||||
(* |;;;| "Do hairy defaulting of :if-exists and :if-does-not-exist keywords.")
|
||||
(* |;;;| "Do hairy defaulting of :if-exists and :if-does-not-exist keywords.")
|
||||
|
||||
(CL:UNLESS EXISTS-P
|
||||
(SETQ IF-EXISTS (CL:IF (EQ (CL:PATHNAME-VERSION PATHNAME)
|
||||
:NEWEST)
|
||||
:NEW-VERSION
|
||||
:ERROR))) (* \;
|
||||
"If the file does not exist, it is OK to have :if-exists :overwrite. ")
|
||||
:ERROR))) (* \;
|
||||
"If the file does not exist, it is OK to have :if-exists :overwrite. ")
|
||||
(CL:UNLESS DOES-NOT-EXIST-P
|
||||
(SETQ IF-DOES-NOT-EXIST (COND
|
||||
((OR (EQ IF-EXISTS :APPEND)
|
||||
@@ -149,16 +158,16 @@
|
||||
((EQ DIRECTION :PROBE)
|
||||
NIL)
|
||||
(T :CREATE))))
|
||||
(CL:LOOP (* \;
|
||||
"See if the file exists and handle the existential keywords.")
|
||||
(CL:LOOP (* \;
|
||||
"See if the file exists and handle the existential keywords.")
|
||||
(LET* ((NAME (PREDICT-NAME PATHNAME))
|
||||
(CL:NAMESTRING (MKSTRING NAME)))
|
||||
(IF NAME
|
||||
THEN (* \; "file exists")
|
||||
THEN (* \; "file exists")
|
||||
(IF FOR-OUTPUT
|
||||
THEN
|
||||
|
||||
(* |;;| "open for output/both")
|
||||
(* |;;| "open for output/both")
|
||||
|
||||
(CASE IF-EXISTS
|
||||
(:ERROR
|
||||
@@ -180,15 +189,15 @@
|
||||
(RETURN NIL))
|
||||
(:APPEND
|
||||
(IF (EQ DIRECTION :OUTPUT)
|
||||
THEN (* \;
|
||||
"if the direction is output it is the same as interlisp append")
|
||||
THEN (* \;
|
||||
"if the direction is output it is the same as interlisp append")
|
||||
(SETQ STREAM (OPENSTREAM CL:NAMESTRING 'APPEND
|
||||
'OLD
|
||||
`((TYPE ,FILE-TYPE)
|
||||
(EXTERNALFORMAT
|
||||
,EXTERNAL-FORMAT))))
|
||||
ELSE (* \;
|
||||
"if direction is io it opens the file for both and goes to the end of the file")
|
||||
ELSE (* \;
|
||||
"if direction is io it opens the file for both and goes to the end of the file")
|
||||
(SETQ STREAM (OPENSTREAM CL:NAMESTRING 'BOTH
|
||||
'OLD
|
||||
`((TYPE ,FILE-TYPE)
|
||||
@@ -201,7 +210,7 @@
|
||||
|elseif| FOR-INPUT
|
||||
|then|
|
||||
|
||||
(* |;;| "open for input/both")
|
||||
(* |;;| "open for input/both")
|
||||
|
||||
(SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS 'OLD
|
||||
`((TYPE ,FILE-TYPE)
|
||||
@@ -209,14 +218,14 @@
|
||||
(RETURN NIL)
|
||||
|else|
|
||||
|
||||
(* |;;| "open for probe")
|
||||
(* |;;| "open for probe")
|
||||
|
||||
(SETQ STREAM (|create| STREAM
|
||||
FULLFILENAME _ (FULLNAME CL:NAMESTRING)))
|
||||
(RETURN NIL))
|
||||
|else|
|
||||
|
||||
(* |;;| "file does not exist")
|
||||
(* |;;| "file does not exist")
|
||||
|
||||
(|if| FOR-OUTPUT
|
||||
|then| (CASE IF-DOES-NOT-EXIST
|
||||
@@ -244,28 +253,28 @@
|
||||
((NIL) (CL:RETURN-FROM OPEN NIL))
|
||||
(T (CL:ERROR "~S is not a valid value for :if-does-not-exist."
|
||||
IF-DOES-NOT-EXIST)))
|
||||
|else| (* \; "Open for probe.")
|
||||
|else| (* \; "Open for probe.")
|
||||
(RETURN NIL)))))
|
||||
(STREAMPROP STREAM :FILE-STREAM-P T)
|
||||
STREAM))
|
||||
|
||||
(CL:DEFUN CL:CLOSE (STREAM &KEY ABORT)
|
||||
|
||||
(* |;;;| "Close a stream. If ABORT, then don't keep the file")
|
||||
(* |;;;| "Close a stream. If ABORT, then don't keep the file")
|
||||
|
||||
(|if| (STREAMP STREAM)
|
||||
|then| (|if| (OPENP STREAM)
|
||||
|then|
|
||||
|
||||
(* |;;|
|
||||
"determine 'deletability' of stream's file before closing, as that trashes the info")
|
||||
(* |;;|
|
||||
"determine 'deletability' of stream's file before closing, as that trashes the info")
|
||||
|
||||
(LET ((ABORTABLE (AND (DIRTYABLE STREAM)
|
||||
(NOT (APPENDONLY STREAM)))))
|
||||
(CLOSEF STREAM)
|
||||
(|if| (AND ABORT ABORTABLE)
|
||||
|then| (* \;
|
||||
"eventually we will change device CLOSEF methods to take an ABORT arg. For now, simulate it.")
|
||||
|then| (* \;
|
||||
"eventually we will change device CLOSEF methods to take an ABORT arg. For now, simulate it.")
|
||||
(DELFILE (CL:NAMESTRING STREAM)))))
|
||||
|else| (ERROR "Closing a non-stream" STREAM))
|
||||
T)
|
||||
@@ -280,7 +289,7 @@
|
||||
(CL:WHEN (NOT (STREAMP STREAM))
|
||||
(\\ILLEGAL.ARG STREAM))
|
||||
|
||||
(* |;;| "we return T instead of the stream because Symbolics does")
|
||||
(* |;;| "we return T instead of the stream because Symbolics does")
|
||||
|
||||
(AND (\\IOMODEP STREAM 'INPUT T)
|
||||
T))
|
||||
@@ -289,14 +298,14 @@
|
||||
(CL:WHEN (NOT (STREAMP STREAM))
|
||||
(\\ILLEGAL.ARG STREAM))
|
||||
|
||||
(* |;;| "we return T instead of the stream because Symbolics does")
|
||||
(* |;;| "we return T instead of the stream because Symbolics does")
|
||||
|
||||
(AND (\\IOMODEP STREAM 'OUTPUT T)
|
||||
T))
|
||||
|
||||
(CL:DEFUN XCL:OPEN-STREAM-P (STREAM)
|
||||
|
||||
(* |;;| "is stream an open stream?")
|
||||
(* |;;| "is stream an open stream?")
|
||||
|
||||
(AND (STREAMP STREAM)
|
||||
(OPENED STREAM)))
|
||||
@@ -308,7 +317,7 @@
|
||||
|
||||
(CL:DEFUN CL:MAKE-SYNONYM-STREAM (CL:SYMBOL)
|
||||
|
||||
(* |;;| "A CommonLisp function for shadowing a stream. See CLtL p. 329")
|
||||
(* |;;| "A CommonLisp function for shadowing a stream. See CLtL p. 329")
|
||||
|
||||
(LET ((STREAM (|create| STREAM
|
||||
DEVICE _ %SYNONYM-STREAM-DEVICE
|
||||
@@ -319,7 +328,7 @@
|
||||
OUTCHARFN _ (FUNCTION %SYNONYM-STREAM-DEVICE-OUTCHARFN))))
|
||||
(STREAMPROP STREAM 'XCL:SYNONYM-STREAM-P T)
|
||||
|
||||
(* |;;| "save the synonym stream in the OPENFILELST field of %SYNONYM-STREAM-DEVICE")
|
||||
(* |;;| "save the synonym stream in the OPENFILELST field of %SYNONYM-STREAM-DEVICE")
|
||||
|
||||
(|replace| (FDEV OPENFILELST) |of| %SYNONYM-STREAM-DEVICE
|
||||
|with| (CONS STREAM (|fetch| (FDEV OPENFILELST) |of| %SYNONYM-STREAM-DEVICE)))
|
||||
@@ -334,7 +343,7 @@
|
||||
|
||||
(CL:DEFUN XCL:FOLLOW-SYNONYM-STREAMS (STREAM)
|
||||
|
||||
(* |;;;| "Return the non-synonym stream at the heart of STREAM.")
|
||||
(* |;;;| "Return the non-synonym stream at the heart of STREAM.")
|
||||
|
||||
(CL:IF (XCL:SYNONYM-STREAM-P STREAM)
|
||||
(XCL:FOLLOW-SYNONYM-STREAMS (CL:SYMBOL-VALUE (XCL:SYNONYM-STREAM-SYMBOL STREAM)))
|
||||
@@ -342,7 +351,7 @@
|
||||
|
||||
(CL:DEFUN CL:MAKE-BROADCAST-STREAM (&REST STREAMS)
|
||||
|
||||
(* |;;| "CommonLisp function that makes a broadcast stream. See CLtL p329")
|
||||
(* |;;| "CommonLisp function that makes a broadcast stream. See CLtL p329")
|
||||
|
||||
(IF (FOR STREAM? IN STREAMS ALWAYS (STREAMP STREAM?))
|
||||
THEN (LET ((STREAM (|create| STREAM
|
||||
@@ -357,20 +366,20 @@
|
||||
|
||||
(CL:DEFUN XCL:BROADCAST-STREAM-P (STREAM)
|
||||
|
||||
(* |;;| "is stream a broadcast stream?")
|
||||
(* |;;| "is stream a broadcast stream?")
|
||||
|
||||
(STREAMPROP STREAM 'XCL:BROADCAST-STREAM-P))
|
||||
|
||||
(CL:DEFUN XCL:BROADCAST-STREAM-STREAMS (STREAM)
|
||||
|
||||
(* |;;| "return all of the streams that STREAM broadcasts to")
|
||||
(* |;;| "return all of the streams that STREAM broadcasts to")
|
||||
|
||||
(AND (XCL:BROADCAST-STREAM-P STREAM)
|
||||
(FETCH (STREAM F1) OF STREAM)))
|
||||
|
||||
(CL:DEFUN CL:MAKE-CONCATENATED-STREAM (&REST STREAMS)
|
||||
|
||||
(* |;;| "CommonLisp function that creates a concatenated stream. See CLtL p. 329")
|
||||
(* |;;| "CommonLisp function that creates a concatenated stream. See CLtL p. 329")
|
||||
|
||||
(IF (FOR STREAM? IN STREAMS ALWAYS (STREAMP STREAM?))
|
||||
THEN (LET ((STREAM (|create| STREAM
|
||||
@@ -387,14 +396,14 @@
|
||||
|
||||
(CL:DEFUN XCL:CONCATENATED-STREAM-STREAMS (STREAM)
|
||||
|
||||
(* |;;| "return all of STREAM's concatenated streams")
|
||||
(* |;;| "return all of STREAM's concatenated streams")
|
||||
|
||||
(AND (XCL:CONCATENATED-STREAM-P STREAM)
|
||||
(FETCH (STREAM F1) OF STREAM)))
|
||||
|
||||
(CL:DEFUN CL:MAKE-TWO-WAY-STREAM (CL::INPUT-STREAM CL::OUTPUT-STREAM)
|
||||
|
||||
(* |;;| "A CommonLisp function for splicing together two streams. See CLtL p. 329")
|
||||
(* |;;| "A CommonLisp function for splicing together two streams. See CLtL p. 329")
|
||||
|
||||
(CL:UNLESS (STREAMP CL::INPUT-STREAM)
|
||||
(\\ILLEGAL.ARG CL::INPUT-STREAM))
|
||||
@@ -409,7 +418,7 @@
|
||||
OUTCHARFN _ (FUNCTION %TWO-WAY-STREAM-DEVICE-OUTCHARFN))))
|
||||
(STREAMPROP STREAM 'XCL:TWO-WAY-STREAM-P T)
|
||||
|
||||
(* |;;| "save STREAM in the OPENFILELST field of %TWO-WAY-STREAM-DEVICE")
|
||||
(* |;;| "save STREAM in the OPENFILELST field of %TWO-WAY-STREAM-DEVICE")
|
||||
|
||||
(|replace| (FDEV OPENFILELST) |of| %TWO-WAY-STREAM-DEVICE
|
||||
|with| (CONS STREAM (|fetch| (FDEV OPENFILELST) |of| %TWO-WAY-STREAM-DEVICE)))
|
||||
@@ -417,7 +426,7 @@
|
||||
|
||||
(CL:DEFUN XCL:TWO-WAY-STREAM-P (STREAM)
|
||||
|
||||
(* |;;| "is STREAM a two-way stream?")
|
||||
(* |;;| "is STREAM a two-way stream?")
|
||||
|
||||
(STREAMPROP STREAM 'XCL:TWO-WAY-STREAM-P))
|
||||
|
||||
@@ -431,7 +440,7 @@
|
||||
|
||||
(CL:DEFUN CL:MAKE-ECHO-STREAM (CL::INPUT-STREAM CL::OUTPUT-STREAM)
|
||||
|
||||
(* |;;| "A CommonLisp function for making an echo stream. See CLtL p. 329")
|
||||
(* |;;| "A CommonLisp function for making an echo stream. See CLtL p. 329")
|
||||
|
||||
(CL:UNLESS (STREAMP CL::INPUT-STREAM)
|
||||
(\\ILLEGAL.ARG CL::INPUT-STREAM))
|
||||
@@ -446,7 +455,7 @@
|
||||
OUTCHARFN _ (FUNCTION %TWO-WAY-STREAM-DEVICE-OUTCHARFN))))
|
||||
(STREAMPROP STREAM 'XCL:ECHO-STREAM-P T)
|
||||
|
||||
(* |;;| "save STREAM in the OPENFILELST field of %ECHO-STREAM-DEVICE")
|
||||
(* |;;| "save STREAM in the OPENFILELST field of %ECHO-STREAM-DEVICE")
|
||||
|
||||
(|replace| (FDEV OPENFILELST) |of| %ECHO-STREAM-DEVICE
|
||||
|with| (CONS STREAM (|fetch| (FDEV OPENFILELST) |of| %ECHO-STREAM-DEVICE)))
|
||||
@@ -454,7 +463,7 @@
|
||||
|
||||
(CL:DEFUN XCL:ECHO-STREAM-P (STREAM)
|
||||
|
||||
(* |;;| "is stream an echo stream?")
|
||||
(* |;;| "is stream an echo stream?")
|
||||
|
||||
(STREAMPROP STREAM 'XCL:ECHO-STREAM-P))
|
||||
|
||||
@@ -469,13 +478,13 @@
|
||||
(CL:DEFUN CL:MAKE-STRING-INPUT-STREAM (STRING &OPTIONAL (CL::START 0)
|
||||
(CL::END NIL))
|
||||
|
||||
(* |;;;| "A CommonLisp function for producing a stream from a string. See CLtL p. 330")
|
||||
(* |;;;| "A CommonLisp function for producing a stream from a string. See CLtL p. 330")
|
||||
|
||||
(OPENSTRINGSTREAM (|if| (OR (NOT (CL:ZEROP CL::START))
|
||||
(NOT (NULL CL::END)))
|
||||
|then|
|
||||
|
||||
(* |;;| "A displaced array is ok here because the stream's uses GETBASEBYTE directly and doesn't go through the array code at all. ")
|
||||
(* |;;| "A displaced array is ok here because the stream's uses GETBASEBYTE directly and doesn't go through the array code at all. ")
|
||||
|
||||
(SUBSTRING STRING (CL:1+ CL::START)
|
||||
CL::END)
|
||||
@@ -522,11 +531,11 @@
|
||||
,@CL::DECLS
|
||||
,@(CL:IF CL::INDEXP
|
||||
|
||||
(* |;;| "This exists as a fudge for the fat string problem. It WILL GO AWAY when STRINGSTREAMS HAVE THEIR OWN DEVICE.")
|
||||
(* |;;| "This exists as a fudge for the fat string problem. It WILL GO AWAY when STRINGSTREAMS HAVE THEIR OWN DEVICE.")
|
||||
|
||||
`((CL:MULTIPLE-VALUE-PROG1 (PROGN ,@CL::BODY)
|
||||
|
||||
(* |;;| "(IF (FASL::FAT-STRING-P $STRING$) (SETF ,INDEX (+ $START$ (IL:IQUOTIENT (IL:GETFILEPTR ,VAR) 2))) (SETF ,INDEX (+ $START$ (IL:GETFILEPTR ,VAR))))")
|
||||
(* |;;| "(IF (FASL::FAT-STRING-P $STRING$) (SETF ,INDEX (+ $START$ (IL:IQUOTIENT (IL:GETFILEPTR ,VAR) 2))) (SETF ,INDEX (+ $START$ (IL:GETFILEPTR ,VAR))))")
|
||||
|
||||
(CL:SETF ,CL::INDEX (+ CL::$START$ (GETFILEPTR ,CL::VAR)))))
|
||||
CL::BODY))))
|
||||
@@ -546,7 +555,7 @@
|
||||
&BODY
|
||||
(FORMS DECLS))
|
||||
|
||||
(* |;;;| "The file whose name is File-Name is opened using the OPEN-ARGS and bound to the variable VAR. The Forms are executed, and when they terminate, normally or otherwise, the file is closed.")
|
||||
(* |;;;| "The file whose name is File-Name is opened using the OPEN-ARGS and bound to the variable VAR. The Forms are executed, and when they terminate, normally or otherwise, the file is closed.")
|
||||
|
||||
(LET ((ABORTP (GENSYM)))
|
||||
`(LET ((,VAR (OPEN ,@OPEN-ARGS))
|
||||
@@ -559,7 +568,7 @@
|
||||
|
||||
(DEFINLINE CL:MAKE-STRING-OUTPUT-STREAM ()
|
||||
|
||||
(* |;;;| "A function for producing a string stream. See also the function get-output-stream-string. Also, see CLtL p. 330")
|
||||
(* |;;;| "A function for producing a string stream. See also the function get-output-stream-string. Also, see CLtL p. 330")
|
||||
|
||||
(MAKE-FILL-POINTER-OUTPUT-STREAM))
|
||||
|
||||
@@ -574,8 +583,8 @@
|
||||
F1 _ STRING
|
||||
ACCESS _ 'OUTPUT
|
||||
OTHERPROPS _ '(STRING-OUTPUT-STREAM T))))
|
||||
(* \;
|
||||
"give it a canned property list to save some consing.")
|
||||
(* \;
|
||||
"give it a canned property list to save some consing.")
|
||||
(|replace| (STREAM OUTCHARFN) |of| STREAM
|
||||
|with| (|if| (EXTENDABLE-ARRAY-P STRING)
|
||||
|then| (FUNCTION \\ADJUSTABLE-STRING-STREAM-OUTCHARFN)
|
||||
@@ -586,7 +595,7 @@
|
||||
|
||||
(CL:DEFUN CL:GET-OUTPUT-STREAM-STRING (STRING-OUTPUT-STREAM)
|
||||
|
||||
(* |;;;| "A CommonLisp function for getting the contents of the buffer created by a call to make-string-output-stream. See CLtL p. 330")
|
||||
(* |;;;| "A CommonLisp function for getting the contents of the buffer created by a call to make-string-output-stream. See CLtL p. 330")
|
||||
|
||||
(|if| (NOT (STREAMPROP STRING-OUTPUT-STREAM 'STRING-OUTPUT-STREAM))
|
||||
|then| (ERROR "Stream not a string-output-stream" STRING-OUTPUT-STREAM)
|
||||
@@ -615,7 +624,7 @@
|
||||
ELSE (ADD (FETCH (STREAM CHARPOSITION) OF STREAM)
|
||||
1))
|
||||
|
||||
(* |;;| "Do the equivalent of VECTOR-PUSH-EXTEND inline to save the significant! overhead of calculating the new length at each character.")
|
||||
(* |;;| "Do the equivalent of VECTOR-PUSH-EXTEND inline to save the significant! overhead of calculating the new length at each character.")
|
||||
|
||||
(CL:UNLESS (CL:VECTOR-PUSH CH STRING)
|
||||
(LET ((CURRENT-LENGTH (CL:ARRAY-TOTAL-SIZE STRING)))
|
||||
@@ -680,7 +689,7 @@
|
||||
|
||||
(CL:DEFUN %BROADCAST-STREAM-DEVICE-CHARSETFN (STREAM NEWVALUE)
|
||||
|
||||
(* |;;| "charset function for broadcast streams. Not clear what the value should be, so we arbitrarily return the value of the last stream.")
|
||||
(* |;;| "charset function for broadcast streams. Not clear what the value should be, so we arbitrarily return the value of the last stream.")
|
||||
|
||||
(FOR S IN (FETCH (STREAM F1) OF STREAM) DO (SETQ $$VAL (ACCESS-CHARSET S
|
||||
NEWVALUE))))
|
||||
@@ -709,7 +718,7 @@
|
||||
|
||||
(CL:DEFUN %CONCATENATED-STREAM-DEVICE-CHARSETFN (STREAM NEWVALUE)
|
||||
|
||||
(* |;;| "the charset method for concatenated stream devices")
|
||||
(* |;;| "the charset method for concatenated stream devices")
|
||||
|
||||
(LET ((STREAMS (FETCH (STREAM F1) OF STREAM)))
|
||||
(IF STREAMS
|
||||
@@ -725,7 +734,7 @@
|
||||
|
||||
(CL:DEFUN %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM (SYNONYM-STREAM)
|
||||
|
||||
(* |;;| "given a synonym-stream, find out what it is currently tracking")
|
||||
(* |;;| "given a synonym-stream, find out what it is currently tracking")
|
||||
|
||||
(CL:SYMBOL-VALUE (XCL:SYNONYM-STREAM-SYMBOL SYNONYM-STREAM)))
|
||||
(DEFINEQ
|
||||
@@ -880,7 +889,7 @@
|
||||
|
||||
(CL:DEFUN %FILL-POINTER-STREAM-DEVICE-CLOSEFILE (STREAM &OPTIONAL ABORTFLAG)
|
||||
|
||||
(* |;;;| "the CLOSEFILE method for the fill-pointer-string-stream device")
|
||||
(* |;;;| "the CLOSEFILE method for the fill-pointer-string-stream device")
|
||||
|
||||
(|replace| F1 |of| STREAM |with| NIL)
|
||||
STREAM)
|
||||
@@ -923,8 +932,8 @@
|
||||
|
||||
(CL:DEFUN %INITIALIZE-STANDARD-STREAMS ()
|
||||
|
||||
(* |;;|
|
||||
"Called when CLSTREAMS is loaded. Almost everything is same as *TERMINAL-IO* to start with.")
|
||||
(* |;;|
|
||||
"Called when CLSTREAMS is loaded. Almost everything is same as *TERMINAL-IO* to start with.")
|
||||
|
||||
(CL:SETQ *QUERY-IO* (CL:MAKE-TWO-WAY-STREAM (CL:MAKE-SYNONYM-STREAM '\\LINEBUF.OFD)
|
||||
(CL:MAKE-SYNONYM-STREAM '\\TERM.OFD)))
|
||||
@@ -944,51 +953,27 @@
|
||||
(%INITIALIZE-STANDARD-STREAMS)
|
||||
)
|
||||
|
||||
(PUTPROPS CLSTREAMS FILETYPE CL:COMPILE-FILE)
|
||||
(PUTPROPS CLSTREAMS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991 2021))
|
||||
(PUTPROPS CLSTREAMS FILETYPE CL:COMPILE-FILE)
|
||||
(PUTPROPS CLSTREAMS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (5231 14534 (OPEN 5231 . 14534)) (14536 15482 (CL:CLOSE 14536 . 15482)) (15484 15562 (
|
||||
CL:STREAM-EXTERNAL-FORMAT 15484 . 15562)) (15564 15631 (CL:STREAM-ELEMENT-TYPE 15564 . 15631)) (15633
|
||||
15867 (CL:INPUT-STREAM-P 15633 . 15867)) (15869 16105 (CL:OUTPUT-STREAM-P 15869 . 16105)) (16107 16244
|
||||
(XCL:OPEN-STREAM-P 16107 . 16244)) (16246 16313 (FILE-STREAM-POSITION 16246 . 16313)) (16365 17285 (
|
||||
CL:MAKE-SYNONYM-STREAM 16365 . 17285)) (17287 17376 (XCL:SYNONYM-STREAM-P 17287 . 17376)) (17378 17516
|
||||
(XCL:SYNONYM-STREAM-SYMBOL 17378 . 17516)) (17518 17796 (XCL:FOLLOW-SYNONYM-STREAMS 17518 . 17796)) (
|
||||
17798 18585 (CL:MAKE-BROADCAST-STREAM 17798 . 18585)) (18587 18730 (XCL:BROADCAST-STREAM-P 18587 .
|
||||
18730)) (18732 18947 (XCL:BROADCAST-STREAM-STREAMS 18732 . 18947)) (18949 19658 (
|
||||
CL:MAKE-CONCATENATED-STREAM 18949 . 19658)) (19660 19759 (XCL:CONCATENATED-STREAM-P 19660 . 19759)) (
|
||||
19761 19974 (XCL:CONCATENATED-STREAM-STREAMS 19761 . 19974)) (19976 21057 (CL:MAKE-TWO-WAY-STREAM
|
||||
19976 . 21057)) (21059 21196 (XCL:TWO-WAY-STREAM-P 21059 . 21196)) (21198 21343 (
|
||||
XCL:TWO-WAY-STREAM-OUTPUT-STREAM 21198 . 21343)) (21345 21489 (XCL:TWO-WAY-STREAM-INPUT-STREAM 21345
|
||||
. 21489)) (21491 22547 (CL:MAKE-ECHO-STREAM 21491 . 22547)) (22549 22678 (XCL:ECHO-STREAM-P 22549 .
|
||||
22678)) (22680 22818 (XCL:ECHO-STREAM-INPUT-STREAM 22680 . 22818)) (22820 22959 (
|
||||
XCL:ECHO-STREAM-OUTPUT-STREAM 22820 . 22959)) (22961 23696 (CL:MAKE-STRING-INPUT-STREAM 22961 . 23696)
|
||||
) (23698 24147 (MAKE-CONCATENATED-STRING-INPUT-STREAM 23698 . 24147)) (24149 24309 (
|
||||
%MAKE-INITIAL-STRING-STREAM-CONTENTS 24149 . 24309)) (27401 28823 (MAKE-FILL-POINTER-OUTPUT-STREAM
|
||||
27401 . 28823)) (28825 29564 (CL:GET-OUTPUT-STREAM-STRING 28825 . 29564)) (29566 30059 (
|
||||
\\STRING-STREAM-OUTCHARFN 29566 . 30059)) (30061 31951 (\\ADJUSTABLE-STRING-STREAM-OUTCHARFN 30061 .
|
||||
31951)) (31980 32062 (%NEW-FILE 31980 . 32062)) (32064 32209 (PREDICT-NAME 32064 . 32209)) (32450
|
||||
33638 (%BROADCAST-STREAM-DEVICE-BOUT 32460 . 32683) (%BROADCAST-STREAM-DEVICE-OUTCHARFN 32685 . 33136)
|
||||
(%BROADCAST-STREAM-DEVICE-CLOSEFILE 33138 . 33377) (%BROADCAST-STREAM-DEVICE-FORCEOUTPUT 33379 .
|
||||
33636)) (33640 34053 (%BROADCAST-STREAM-DEVICE-CHARSETFN 33640 . 34053)) (34054 36113 (
|
||||
%CONCATENATED-STREAM-DEVICE-BIN 34064 . 34469) (%CONCATENATED-STREAM-DEVICE-CLOSEFILE 34471 . 34784) (
|
||||
%CONCATENATED-STREAM-DEVICE-EOFP 34786 . 35150) (%CONCATENATED-STREAM-DEVICE-PEEKBIN 35152 . 35627) (
|
||||
%CONCATENATED-STREAM-DEVICE-BACKFILEPTR 35629 . 36111)) (36115 36450 (
|
||||
%CONCATENATED-STREAM-DEVICE-CHARSETFN 36115 . 36450)) (36451 36670 (%ECHO-STREAM-DEVICE-BIN 36461 .
|
||||
36668)) (36672 36897 (%SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM 36672 . 36897)) (36898 40243 (
|
||||
%SYNONYM-STREAM-DEVICE-BIN 36908 . 37096) (%SYNONYM-STREAM-DEVICE-BOUT 37098 . 37299) (
|
||||
%SYNONYM-STREAM-DEVICE-OUTCHARFN 37301 . 38008) (%SYNONYM-STREAM-DEVICE-CLOSEFILE 38010 . 38594) (
|
||||
%SYNONYM-STREAM-DEVICE-EOFP 38596 . 38787) (%SYNONYM-STREAM-DEVICE-FORCEOUTPUT 38789 . 39027) (
|
||||
%SYNONYM-STREAM-DEVICE-GETFILEINFO 39029 . 39266) (%SYNONYM-STREAM-DEVICE-PEEKBIN 39268 . 39491) (
|
||||
%SYNONYM-STREAM-DEVICE-READP 39493 . 39604) (%SYNONYM-STREAM-DEVICE-BACKFILEPTR 39606 . 39752) (
|
||||
%SYNONYM-STREAM-DEVICE-SETFILEINFO 39754 . 40003) (%SYNONYM-STREAM-DEVICE-CHARSETFN 40005 . 40241)) (
|
||||
40244 44569 (%TWO-WAY-STREAM-DEVICE-BIN 40254 . 40427) (%TWO-WAY-STREAM-DEVICE-INPUTSTREAM 40429 .
|
||||
40620) (%TWO-WAY-STREAM-DEVICE-BOUT 40622 . 40794) (%TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 40796 . 40986)
|
||||
(%TWO-WAY-STREAM-DEVICE-OUTCHARFN 40988 . 41850) (%TWO-WAY-STREAM-DEVICE-CLOSEFILE 41852 . 43275) (
|
||||
%TWO-WAY-STREAM-DEVICE-EOFP 43277 . 43453) (%TWO-WAY-STREAM-DEVICE-READP 43455 . 43648) (
|
||||
%TWO-WAY-STREAM-DEVICE-BACKFILEPTR 43650 . 43786) (%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 43788 . 44017) (
|
||||
%TWO-WAY-STREAM-DEVICE-PEEKBIN 44019 . 44232) (%TWO-WAY-STREAM-DEVICE-CHARSETFN 44234 . 44567)) (44571
|
||||
44796 (%FILL-POINTER-STREAM-DEVICE-CLOSEFILE 44571 . 44796)) (44798 44917 (
|
||||
%FILL-POINTER-STREAM-DEVICE-GETFILEPTR 44798 . 44917)) (45157 45396 (%SYNONYM-STREAM-DEVICE-GET-STREAM
|
||||
45167 . 45394)) (45627 46101 (%INITIALIZE-STANDARD-STREAMS 45627 . 46101)) (46102 52065 (
|
||||
%INITIALIZE-CLSTREAM-TYPES 46112 . 52063)))))
|
||||
(FILEMAP (NIL (34128 35316 (%BROADCAST-STREAM-DEVICE-BOUT 34138 . 34361) (
|
||||
%BROADCAST-STREAM-DEVICE-OUTCHARFN 34363 . 34814) (%BROADCAST-STREAM-DEVICE-CLOSEFILE 34816 . 35055) (
|
||||
%BROADCAST-STREAM-DEVICE-FORCEOUTPUT 35057 . 35314)) (35732 37791 (%CONCATENATED-STREAM-DEVICE-BIN
|
||||
35742 . 36147) (%CONCATENATED-STREAM-DEVICE-CLOSEFILE 36149 . 36462) (%CONCATENATED-STREAM-DEVICE-EOFP
|
||||
36464 . 36828) (%CONCATENATED-STREAM-DEVICE-PEEKBIN 36830 . 37305) (
|
||||
%CONCATENATED-STREAM-DEVICE-BACKFILEPTR 37307 . 37789)) (38129 38348 (%ECHO-STREAM-DEVICE-BIN 38139 .
|
||||
38346)) (38576 41921 (%SYNONYM-STREAM-DEVICE-BIN 38586 . 38774) (%SYNONYM-STREAM-DEVICE-BOUT 38776 .
|
||||
38977) (%SYNONYM-STREAM-DEVICE-OUTCHARFN 38979 . 39686) (%SYNONYM-STREAM-DEVICE-CLOSEFILE 39688 .
|
||||
40272) (%SYNONYM-STREAM-DEVICE-EOFP 40274 . 40465) (%SYNONYM-STREAM-DEVICE-FORCEOUTPUT 40467 . 40705)
|
||||
(%SYNONYM-STREAM-DEVICE-GETFILEINFO 40707 . 40944) (%SYNONYM-STREAM-DEVICE-PEEKBIN 40946 . 41169) (
|
||||
%SYNONYM-STREAM-DEVICE-READP 41171 . 41282) (%SYNONYM-STREAM-DEVICE-BACKFILEPTR 41284 . 41430) (
|
||||
%SYNONYM-STREAM-DEVICE-SETFILEINFO 41432 . 41681) (%SYNONYM-STREAM-DEVICE-CHARSETFN 41683 . 41919)) (
|
||||
41922 46247 (%TWO-WAY-STREAM-DEVICE-BIN 41932 . 42105) (%TWO-WAY-STREAM-DEVICE-INPUTSTREAM 42107 .
|
||||
42298) (%TWO-WAY-STREAM-DEVICE-BOUT 42300 . 42472) (%TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 42474 . 42664)
|
||||
(%TWO-WAY-STREAM-DEVICE-OUTCHARFN 42666 . 43528) (%TWO-WAY-STREAM-DEVICE-CLOSEFILE 43530 . 44953) (
|
||||
%TWO-WAY-STREAM-DEVICE-EOFP 44955 . 45131) (%TWO-WAY-STREAM-DEVICE-READP 45133 . 45326) (
|
||||
%TWO-WAY-STREAM-DEVICE-BACKFILEPTR 45328 . 45464) (%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 45466 . 45695) (
|
||||
%TWO-WAY-STREAM-DEVICE-PEEKBIN 45697 . 45910) (%TWO-WAY-STREAM-DEVICE-CHARSETFN 45912 . 46245)) (46835
|
||||
47074 (%SYNONYM-STREAM-DEVICE-GET-STREAM 46845 . 47072)) (47780 53743 (%INITIALIZE-CLSTREAM-TYPES
|
||||
47790 . 53741)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,15 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 5-Sep-2021 08:25:40"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>COREIO.;2 55065
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED " 4-Oct-2018 14:13:06" {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>COREIO.;4 55097
|
||||
|
||||
changes to%: (FNS \CREATECOREDEVICE)
|
||||
changes to%: (FNS \CORE.GETFILEINFO)
|
||||
|
||||
previous date%: " 4-Oct-2018 14:13:06"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>COREIO.;1)
|
||||
previous date%: "28-Jun-99 16:15:28"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>COREIO.;3)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1981-1988, 1990, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT COREIOCOMS)
|
||||
@@ -953,18 +952,18 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018, 2021 by Venue & Xerox Corporati
|
||||
)
|
||||
)
|
||||
(PUTPROPS COREIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990
|
||||
1993 1999 2018 2021))
|
||||
1993 1999 2018))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1718 43242 (\CORE.CLOSEFILE 1728 . 2501) (\CORE.DELETEFILE 2503 . 4489) (
|
||||
\CORE.DIRECTORYNAMEP 4491 . 4752) (\CORE.FINDPAGE 4754 . 7983) (\CORE.GENERATEFILES 7985 . 10572) (
|
||||
\CORE.NEXTFILEFN 10574 . 11073) (\CORE.FILEINFOFN 11075 . 11304) (\CORE.GETFILEHANDLE 11306 . 13460) (
|
||||
\CORE.GETFILEINFO 13462 . 14425) (\CORE.GETFILEINFO.FROM.INFOBLOCK 14427 . 15964) (\CORE.GETFILENAME
|
||||
15966 . 18255) (\CORE.GETINFOBLOCK 18257 . 20880) (\CORE.NAMESCAN 20882 . 22649) (\CORE.NAMESEGMENT
|
||||
22651 . 23088) (\CORE.OPENFILE 23090 . 26209) (\COREFILE.SETPARAMETERS 26211 . 28392) (
|
||||
\CORE.PACKFILENAME 28394 . 28789) (\CORE.RELEASEPAGES 28791 . 29392) (\CORE.SETFILEPTR 29394 . 30493)
|
||||
(\CORE.UPDATEOF 30495 . 32124) (\CORE.BACKFILEPTR 32126 . 34334) (\CORE.SETEOFPTR 34336 . 36205) (
|
||||
\CORE.SETACCESSTIME 36207 . 36832) (\CORE.SETFILEINFO 36834 . 38025) (\CORE.GETNEXTBUFFER 38027 .
|
||||
41983) (\CORE.UNPACKFILENAME 41985 . 43240)) (43243 46876 (COREDEVICE 43253 . 43424) (
|
||||
\CREATECOREDEVICE 43426 . 46874)) (46877 49178 (\NODIRCOREFDEV 46887 . 47484) (\NODIRCORE.OPENFILE
|
||||
47486 . 49176)))))
|
||||
(FILEMAP (NIL (1755 43279 (\CORE.CLOSEFILE 1765 . 2538) (\CORE.DELETEFILE 2540 . 4526) (
|
||||
\CORE.DIRECTORYNAMEP 4528 . 4789) (\CORE.FINDPAGE 4791 . 8020) (\CORE.GENERATEFILES 8022 . 10609) (
|
||||
\CORE.NEXTFILEFN 10611 . 11110) (\CORE.FILEINFOFN 11112 . 11341) (\CORE.GETFILEHANDLE 11343 . 13497) (
|
||||
\CORE.GETFILEINFO 13499 . 14462) (\CORE.GETFILEINFO.FROM.INFOBLOCK 14464 . 16001) (\CORE.GETFILENAME
|
||||
16003 . 18292) (\CORE.GETINFOBLOCK 18294 . 20917) (\CORE.NAMESCAN 20919 . 22686) (\CORE.NAMESEGMENT
|
||||
22688 . 23125) (\CORE.OPENFILE 23127 . 26246) (\COREFILE.SETPARAMETERS 26248 . 28429) (
|
||||
\CORE.PACKFILENAME 28431 . 28826) (\CORE.RELEASEPAGES 28828 . 29429) (\CORE.SETFILEPTR 29431 . 30530)
|
||||
(\CORE.UPDATEOF 30532 . 32161) (\CORE.BACKFILEPTR 32163 . 34371) (\CORE.SETEOFPTR 34373 . 36242) (
|
||||
\CORE.SETACCESSTIME 36244 . 36869) (\CORE.SETFILEINFO 36871 . 38062) (\CORE.GETNEXTBUFFER 38064 .
|
||||
42020) (\CORE.UNPACKFILENAME 42022 . 43277)) (43280 46913 (COREDEVICE 43290 . 43461) (
|
||||
\CREATECOREDEVICE 43463 . 46911)) (46914 49215 (\NODIRCOREFDEV 46924 . 47521) (\NODIRCORE.OPENFILE
|
||||
47523 . 49213)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
108
sources/DEBUGGER
108
sources/DEBUGGER
@@ -1,14 +1,14 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "DEBUGGER" (PREFIX-NAME "DBG") (NICKNAMES
|
||||
"DBG")))
|
||||
(IL:FILECREATED "16-Aug-91 17:38:56" IL:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>DEBUGGER.;3| 84381
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "DEBUGGER" (PREFIX-NAME "DBG") (NICKNAMES "DBG")) READTABLE
|
||||
"XCL" BASE 10)
|
||||
(IL:FILECREATED "11-Sep-2021 12:57:01" IL:|{DSK}<home>larry>medley>sources>DEBUGGER.;2| 84311
|
||||
|
||||
IL:|changes| IL:|to:| (IL:FUNCTIONS DEBUGGER-EVAL)
|
||||
IL:|changes| IL:|to:| (IL:FUNCTIONS STACK-FRAME-PROPERTIES)
|
||||
|
||||
IL:|previous| IL:|date:| "16-May-90 15:26:02" IL:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>DEBUGGER.;2|
|
||||
IL:|previous| IL:|date:| "16-Aug-91 17:38:56" IL:|{DSK}<home>larry>medley>sources>DEBUGGER.;1|
|
||||
)
|
||||
|
||||
|
||||
; Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All rights reserved.
|
||||
; Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:DEBUGGERCOMS)
|
||||
|
||||
@@ -520,14 +520,13 @@
|
||||
|
||||
(DEFVAR IL:LASTPOS)
|
||||
|
||||
(XCL:DEFCOMMAND ("@" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV)
|
||||
(XCL:DEFCOMMAND ("@" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV)
|
||||
"Set debugger stack pointer to location specified by PLACE (or default)"
|
||||
(FORMAT T "@ = ~S~%" (IL:STKNAME (FIND-DEBUGGER-STACK-FRAME IL:PLACE IL:ENV)))
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("REVERT" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV) (DECLARE (SPECIAL
|
||||
IL:BRKVALUES)
|
||||
)
|
||||
(XCL:DEFCOMMAND ("REVERT" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV)
|
||||
(DECLARE (SPECIAL IL:BRKVALUES))
|
||||
"Unwind to specified frame (or LASTPOS) and enter breakpoint"
|
||||
|
||||
(IL:* IL:|;;| "Find the stack frame that the user asked to unwind to , if any:")
|
||||
@@ -561,7 +560,8 @@
|
||||
(IL:RELSTK IL:POS))))))))
|
||||
(THROW 'DEBUGGER-EXIT NIL)))
|
||||
|
||||
(XCL:DEFCOMMAND ("?=" :DEBUGGER) NIL "Show arguments"
|
||||
(XCL:DEFCOMMAND ("?=" :DEBUGGER) ()
|
||||
"Show arguments"
|
||||
(MULTIPLE-VALUE-BIND (IL:NAME IL:DEFN)
|
||||
(FIND-ORIGINAL-NAME-AND-DEFINITION IL:LASTPOS)
|
||||
(MULTIPLE-VALUE-BIND (IL:LAMBDA-CAR IL:ARGLIST)
|
||||
@@ -589,7 +589,7 @@
|
||||
0 T))))))
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("EVAL" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL IL:EXPRESSION-PROVIDED?))
|
||||
(XCL:DEFCOMMAND ("EVAL" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL IL:EXPRESSION-PROVIDED?))
|
||||
(DECLARE (SPECIAL IL:BRKENV IL:BRKVALUES))
|
||||
"Evaluate expression in debugged context"
|
||||
(XCL:CONDITION-CASE (IF IL:EXPRESSION-PROVIDED?
|
||||
@@ -600,14 +600,15 @@
|
||||
(SI::DEBUGGER-EVAL-ABORTED (IL:C)
|
||||
(VALUES :ABORTED (SI::DEBUGGER-EVAL-ABORTED-CONDITION IL:C)))))
|
||||
|
||||
(XCL:DEFCOMMAND ("VALUE" :DEBUGGER :QUIET) NIL
|
||||
(XCL:DEFCOMMAND ("VALUE" :DEBUGGER :QUIET) ()
|
||||
"Show value from previous evaluation of debug expression"
|
||||
(IF IL:BRKVALUES
|
||||
(VALUES-LIST (CDR IL:BRKVALUES))
|
||||
(PROGN (FORMAT T "Not yet evaluated~&")
|
||||
(VALUES))))
|
||||
|
||||
(XCL:DEFCOMMAND ("UB" :DEBUGGER) (&OPTIONAL (IL:FN IL:BRKFN)) "Unbreak function with breakpoint"
|
||||
(XCL:DEFCOMMAND ("UB" :DEBUGGER) (&OPTIONAL (IL:FN IL:BRKFN))
|
||||
"Unbreak function with breakpoint"
|
||||
(DECLARE (SPECIAL IL:BRKFN))
|
||||
(IL:EVAL (LIST 'XCL:UNBREAK IL:FN)))
|
||||
|
||||
@@ -882,26 +883,32 @@
|
||||
(return nil))))
|
||||
)
|
||||
|
||||
(XCL:DEFCOMMAND ("BT" :DEBUGGER) NIL "Print backtrace of external frames"
|
||||
(XCL:DEFCOMMAND ("BT" :DEBUGGER) ()
|
||||
"Print backtrace of external frames"
|
||||
(PRINT-BACKTRACE :FROM IL:LASTPOS :TEST 'XCL::INTERESTING-FRAME-P)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("BT!" :DEBUGGER) NIL "Print backtrace of all frames"
|
||||
(XCL:DEFCOMMAND ("BT!" :DEBUGGER) ()
|
||||
"Print backtrace of all frames"
|
||||
(PRINT-BACKTRACE :FROM IL:LASTPOS :TEST NIL)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("BTV" :DEBUGGER) NIL "Print backtrace of frames and special bindings"
|
||||
(XCL:DEFCOMMAND ("BTV" :DEBUGGER) ()
|
||||
"Print backtrace of frames and special bindings"
|
||||
(PRINT-BACKTRACE :FROM IL:LASTPOS :PRINT-VARIABLES T)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("BTV!" :DEBUGGER) NIL "Print backtrace of all frame information"
|
||||
(XCL:DEFCOMMAND ("BTV!" :DEBUGGER) ()
|
||||
"Print backtrace of all frame information"
|
||||
(PRINT-BACKTRACE :FROM IL:LASTPOS :PRINT-VARIABLES T :PRINT-JUNK T)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("DBT" :DEBUGGER) NIL (ATTACH-BACKTRACE-MENU NIL T)
|
||||
(XCL:DEFCOMMAND ("DBT" :DEBUGGER) ()
|
||||
(ATTACH-BACKTRACE-MENU NIL T)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("DBT!" :DEBUGGER) NIL (ATTACH-BACKTRACE-MENU)
|
||||
(XCL:DEFCOMMAND ("DBT!" :DEBUGGER) ()
|
||||
(ATTACH-BACKTRACE-MENU)
|
||||
(VALUES))
|
||||
|
||||
(DEFUN ATTACH-BACKTRACE-MENU (&OPTIONAL IL:TTYWINDOW IL:SKIP)
|
||||
@@ -1209,7 +1216,7 @@
|
||||
0
|
||||
IL:AS I IL:|from| (1+ NUM-ARGS) IL:|to| TOTAL-SLOTS
|
||||
IL:|when| (AND (IL:NEQ NOVALUE (IL:STKARG I POS NOVALUE))
|
||||
(OR (SETF ARGNAME (IL:STKARGNAME I POS))
|
||||
(OR (SETF ARGNAME (IL:STKARGNAME I POS T))
|
||||
(AND LOTS? (SETQ ARGNAME (FORMAT NIL "local ~D" PVAR))
|
||||
))) IL:|collect| (LIST ARGNAME I))))
|
||||
(AND SLOTS (CONS '("locals")
|
||||
@@ -1345,16 +1352,19 @@
|
||||
(T 0)))
|
||||
OUTPUT))
|
||||
|
||||
(XCL:DEFCOMMAND ("STOP" :DEBUGGER :QUIET) NIL "Exit this debugger level"
|
||||
(XCL:DEFCOMMAND ("STOP" :DEBUGGER :QUIET) ()
|
||||
"Exit this debugger level"
|
||||
(IL:SETQ IL:BRKVALUES '(IL:ERROR!))
|
||||
(THROW 'DEBUGGER-EXIT NIL))
|
||||
|
||||
(XCL:DEFCOMMAND ("^" :DEBUGGER :QUIET) NIL "Abort out of debugger"
|
||||
(XCL:DEFCOMMAND ("^" :DEBUGGER :QUIET) ()
|
||||
"Abort out of debugger"
|
||||
(IL:SETQ IL:BRKVALUES '(IL:ERROR!))
|
||||
(THROW 'DEBUGGER-EXIT NIL))
|
||||
|
||||
(XCL:DEFCOMMAND ("RETURN" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL)
|
||||
&ENVIRONMENT IL:ENV) "Return value from debugger"
|
||||
(XCL:DEFCOMMAND ("RETURN" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL)
|
||||
&ENVIRONMENT IL:ENV)
|
||||
"Return value from debugger"
|
||||
(XCL:CONDITION-CASE (PROGN (IL:SETQ IL:BRKVALUES (LIST 'RETURN (MULTIPLE-VALUE-LIST (
|
||||
DEBUGGER-EVAL
|
||||
IL:EXPRESSION
|
||||
@@ -1364,20 +1374,23 @@
|
||||
(SI::DEBUGGER-EVAL-ABORTED (IL:C)
|
||||
(VALUES :ABORTED (SI::DEBUGGER-EVAL-ABORTED-CONDITION IL:C)))))
|
||||
|
||||
(XCL:DEFCOMMAND ("PR" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER) "Select and invoke a proceed case."
|
||||
(ESCAPE-FROM-DEBUGGER T IL:NAME-OR-NUMBER)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("PR!" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER) "Select and invoke a proceed case."
|
||||
(ESCAPE-FROM-DEBUGGER NIL IL:NAME-OR-NUMBER)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("PROCEED" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
|
||||
(XCL:DEFCOMMAND ("PR" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
|
||||
"Select and invoke a proceed case."
|
||||
(ESCAPE-FROM-DEBUGGER T IL:NAME-OR-NUMBER)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("OK" :DEBUGGER :QUIET) NIL (DECLARE (SPECIAL IL:BRKENV))
|
||||
(XCL:DEFCOMMAND ("PR!" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
|
||||
"Select and invoke a proceed case."
|
||||
(ESCAPE-FROM-DEBUGGER NIL IL:NAME-OR-NUMBER)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("PROCEED" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
|
||||
"Select and invoke a proceed case."
|
||||
(ESCAPE-FROM-DEBUGGER T IL:NAME-OR-NUMBER)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("OK" :DEBUGGER :QUIET) ()
|
||||
(DECLARE (SPECIAL IL:BRKENV))
|
||||
"Exit/proceed from debugger"
|
||||
(XCL:CONDITION-CASE (PROGN (WHEN (TYPEP IL:BRKCOND 'SI::BREAKPOINT)
|
||||
|
||||
@@ -1530,6 +1543,27 @@
|
||||
)
|
||||
(IL:PUTPROPS XCL:DEBUGGER IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL (18680 18967 (IL:WBREAK 18693 . 18965)) (42297 47159 (IL:BAKTRACE 42310 . 45094) (
|
||||
IL:BAKTRACE1 45096 . 47157)) (81689 83655 (IL:FIND-STACK-FRAME 81702 . 83653)))))
|
||||
(IL:FILEMAP (NIL (4639 6450 (XCL:ENTER-DEBUGGER-P 4639 . 6450)) (6452 13574 (XCL:DEBUGGER 6452 . 13574
|
||||
)) (13576 13890 (EMERGENCY-PANIC-LOOP 13576 . 13890)) (13892 15347 (IL:FIND-DEBUGGER-ENTRY-FRAME 13892
|
||||
. 15347)) (15349 16038 (PRINT-ENTRY-MESSAGE 15349 . 16038)) (16040 16341 (SIMPLE-REPORT-CONDITION
|
||||
16040 . 16341)) (16343 18083 (XCL::INTERESTING-FRAME-P 16343 . 18083)) (18668 18955 (IL:WBREAK 18681
|
||||
. 18953)) (19068 20177 (REUSE-CURRENT-WINDOW 19068 . 20177)) (20179 21483 (CREATE-DEBUGGER-WINDOW
|
||||
20179 . 21483)) (21485 22437 (SET-UP-DEBUGGER-WINDOW 21485 . 22437)) (22439 23454 (
|
||||
CLOSE-DEBUGGER-WINDOW 22439 . 23454)) (23456 23942 (RELEASE-DEBUGGER-WINDOW 23456 . 23942)) (23944
|
||||
24881 (NEAR-BY-REGION 23944 . 24881)) (24883 25993 (DEBUGGER-BUTTON-EVENT 24883 . 25993)) (25995 26932
|
||||
(DEBUGGER-MENU-HELP 25995 . 26932)) (31872 33690 (DEBUGGER-EVAL 31872 . 33690)) (33692 38041 (
|
||||
FIND-DEBUGGER-STACK-FRAME 33692 . 38041)) (38043 38782 (FIND-NAMED-STACK-POSITION 38043 . 38782)) (
|
||||
38784 39416 (FIND-ORIGINAL-NAME-AND-DEFINITION 38784 . 39416)) (39418 39552 (STKPTR-CCODE 39418 .
|
||||
39552)) (42143 47005 (IL:BAKTRACE 42156 . 44940) (IL:BAKTRACE1 44942 . 47003)) (47841 54770 (
|
||||
ATTACH-BACKTRACE-MENU 47841 . 54770)) (54772 57983 (REGION-NEXT-TO 54772 . 57983)) (57985 59428 (
|
||||
BACKTRACE-MENU-BUTTONEVENTFN 57985 . 59428)) (59430 63704 (BACKTRACE-ITEM-SELECTED 59430 . 63704)) (
|
||||
63706 67543 (STACK-FRAME-PROPERTIES 63706 . 67543)) (67545 68555 (STACK-FRAME-FETCHFN 67545 . 68555))
|
||||
(68557 69744 (STACK-FRAME-STOREFN 68557 . 69744)) (69746 70321 (STACK-FRAME-VALUE-COMMAND 69746 .
|
||||
70321)) (70323 70733 (STACK-FRAME-PROPERTY 70323 . 70733)) (70735 72720 (MAKE-FRAME-INSPECT-WINDOW
|
||||
70735 . 72720)) (72722 72919 (%RELEASE-STACK-DATUM 72722 . 72919)) (72921 73627 (PRINT-BACKTRACE 72921
|
||||
. 73627)) (76856 76950 (EXIT-DEBUGGER 76856 . 76950)) (76952 77271 (INVOKE-ESCAPE-FROM-MENU 76952 .
|
||||
77271)) (77273 78696 (ESCAPE-FROM-DEBUGGER 77273 . 78696)) (78698 79076 (MENU-FROM-ESCAPE-LIST 78698
|
||||
. 79076)) (79078 80237 (KEYLIST-FROM-ESCAPE-LIST 79078 . 80237)) (80239 81247 (COLLECT-ACTIVE-ESCAPES
|
||||
80239 . 81247)) (81249 81618 (IL:FIND-LEXICAL-ENVIRONMENT 81249 . 81618)) (81619 83585 (
|
||||
IL:FIND-STACK-FRAME 81632 . 83583)))))
|
||||
IL:STOP
|
||||
|
||||
Binary file not shown.
531
sources/FILEIO
531
sources/FILEIO
@@ -1,12 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 5-Sep-2021 08:26:24"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;90 178473
|
||||
(FILECREATED " 6-Sep-2021 15:54:14"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;92 178421
|
||||
|
||||
changes to%: (FNS \FDEVINSTANCE \NULLDEVICE)
|
||||
(RECORDS FDEV)
|
||||
changes to%: (RECORDS FDEV)
|
||||
|
||||
previous date%: " 5-Sep-2021 08:17:18"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;89)
|
||||
previous date%: "13-Aug-2021 18:39:18"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;91)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -19,14 +18,14 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
[(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
|
||||
FILEIO)
|
||||
|
||||
(* ;; "Device independent IO. This file is used by VAX")
|
||||
(* ;; "Device independent IO. This file is used by VAX")
|
||||
|
||||
(COMS
|
||||
(* ;; "STREAM, FDEV declarations")
|
||||
(* ;; "STREAM, FDEV declarations")
|
||||
|
||||
(DECLARE%: FIRST DOCOPY
|
||||
|
||||
(* ;; "The microcode relies on STREAM being of a particular type, viz. the first type declared in the initial loadup (after VMEMPAGEP)")
|
||||
(* ;; "The microcode relies on STREAM being of a particular type, viz. the first type declared in the initial loadup (after VMEMPAGEP)")
|
||||
|
||||
(INITRECORDS STREAM))
|
||||
(SYSRECORDS STREAM)
|
||||
@@ -39,12 +38,12 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
OVERWRITEABLE READABLE READONLY WRITEABLE)
|
||||
(CONSTANTS * EOLCONVENTIONS)))
|
||||
(FNS STREAMPROP GETSTREAMPROP PUTSTREAMPROP STREAMP)
|
||||
[COMS (* ; "make streams print pretty")
|
||||
[COMS (* ; "make streams print pretty")
|
||||
(FNS \DEFPRINT.BY.NAME \STREAM.DEFPRINT \FDEV.DEFPRINT)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (DEFPRINT 'STREAM (FUNCTION \STREAM.DEFPRINT))
|
||||
(DEFPRINT 'FDEV (FUNCTION \FDEV.DEFPRINT]
|
||||
(COMS (* ;
|
||||
"Needed because of STREAM initialization")
|
||||
(COMS (* ;
|
||||
"Needed because of STREAM initialization")
|
||||
(INITVARS (FILELINELENGTH 102)
|
||||
(\STREAM.DEFAULT.MAXBUFFERS 3)))
|
||||
(FNS \GETACCESS \SETACCESS)
|
||||
@@ -52,8 +51,8 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
(RECORDS FDEV FILEGENOBJ)))
|
||||
(INITRECORDS FDEV)
|
||||
(SYSRECORDS FDEV))
|
||||
[COMS (* ;
|
||||
"EXTERNALFORMAT declaration and related functions")
|
||||
[COMS (* ;
|
||||
"EXTERNALFORMAT declaration and related functions")
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (RECORDS EXTERNALFORMAT)))
|
||||
(FNS MAKE-EXTERNALFORMAT)
|
||||
(INITRECORDS EXTERNALFORMAT)
|
||||
@@ -66,7 +65,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
(COMS (FNS \CREATE.THROUGH.EXTERNALFORMAT \THROUGHIN \THROUGHBACKCCODE
|
||||
\THROUGHOUTCHARFN)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.THROUGH.EXTERNALFORMAT]
|
||||
(COMS (* ; "Device operations")
|
||||
(COMS (* ; "Device operations")
|
||||
(FNS \DEFINEDEVICE \GETDEVICEFROMNAME \GETDEVICEFROMHOSTNAME \REMOVEDEVICE
|
||||
\REMOVEDEVICE.NAMES)
|
||||
(INITVARS (STREAM-AFTER-OPEN-FNS NIL))
|
||||
@@ -75,7 +74,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
\RENAMEFILE \REVALIDATEFILE \PAGED.REVALIDATEFILELST \PAGED.REVALIDATEFILES
|
||||
\PAGED.REVALIDATEFILE \BUFFERED.REVALIDATEFILE \BUFFERED.REVALIDATEFILELST
|
||||
\PRINT-REVALIDATION-RESULT \TRUNCATEFILE \FILE-CONFLICT)
|
||||
(COMS (* ; "Generic enumerator")
|
||||
(COMS (* ; "Generic enumerator")
|
||||
(FNS \GENERATENOFILES \NULLFILEGENERATOR \NOFILESNEXTFILEFN \NOFILESINFOFN)
|
||||
(DECLARE%: DONTCOPY (RECORDS NOFILEGENSTATE)))
|
||||
(FNS \FILE.NOT.OPEN \FILE.WONT.OPEN \ILLEGAL.DEVICEOP \IS.NOT.RANDACCESSP
|
||||
@@ -83,16 +82,16 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
(ADDVARS (\FILEDEVICES)
|
||||
(\FILEDEVICENAMES)
|
||||
(\DEVICENAMETODEVICE))
|
||||
(COMS (* ; "Device instances")
|
||||
(COMS (* ; "Device instances")
|
||||
(FNS \FDEVINSTANCE)
|
||||
(MACROS \INHERITFDEVOP.D \INHERITFDEVOP.S))
|
||||
(INITVARS (LOGINHOST/DIR '{DSK})
|
||||
(\CONNECTED.DIRECTORY '{DSK}))
|
||||
(GLOBALVARS LOGINHOST/DIR \CONNECTED.DIRECTORY \FILEDEVICES \FILEDEVICENAMES
|
||||
\DEVICENAMETODEVICE))
|
||||
(COMS (* ; "Directory defaulting")
|
||||
(COMS (* ; "Directory defaulting")
|
||||
(FNS CNDIR DIRECTORYNAME DIRECTORYNAMEP HOSTNAMEP \ADD.CONNECTED.DIR))
|
||||
[COMS (* ; "Binary I/O Public functions")
|
||||
[COMS (* ; "Binary I/O Public functions")
|
||||
(FNS \BACKFILEPTR \BACKPEEKBIN \BACKBIN BIN \BIN \BINS BOUT \BOUT \BOUTS COPYBYTES
|
||||
COPYCHARS COPYFILE \COPYOPENFILE \INFER.FILE.TYPE EOFP FORCEOUTPUT
|
||||
\FLUSH.OPEN.STREAMS CHARSET ACCESS-CHARSET GETEOFPTR GETFILEINFO
|
||||
@@ -100,7 +99,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
BIN16)
|
||||
(PROP (DOPCODE)
|
||||
BOUT)
|
||||
(* ; "Generic functions")
|
||||
(* ; "Generic functions")
|
||||
(FNS \GENERIC.BINS \GENERIC.BOUTS \GENERIC.RENAMEFILE \GENERIC.OPENP \GENERIC.READP
|
||||
\GENERIC.CHARSET)
|
||||
(FNS \MAP-OPEN-STREAMS)
|
||||
@@ -117,7 +116,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
(PUTD (CADR PAIR)
|
||||
(GETD (CAR PAIR))
|
||||
T]
|
||||
(COMS (* ; "Internal functions")
|
||||
(COMS (* ; "Internal functions")
|
||||
(FNS \EOF.ACTION \EOSERROR \GETEOFPTR \INCFILEPTR \PEEKBIN \SETCLOSEDFILELENGTH
|
||||
\SETEOFPTR \SETFILEPTR)
|
||||
(FNS \FIXPOUT \FIXPIN)
|
||||
@@ -131,10 +130,10 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
[CONSTANTS (\MAXFILEPTR (SUB1 (LLSH 1 30]
|
||||
(RECORDS BYTEPTR))
|
||||
(CONSTANTS MaxChar)))
|
||||
(COMS (* ; "Buffered IO")
|
||||
(COMS (* ; "Buffered IO")
|
||||
(FNS \BUFFERED.BIN \BUFFERED.PEEKBIN \BUFFERED.BOUT \BUFFERED.BINS \BUFFERED.BOUTS
|
||||
\BUFFERED.COPYBYTES))
|
||||
[COMS (* ; "NULL device")
|
||||
[COMS (* ; "NULL device")
|
||||
(FNS \NULLDEVICE \NULL.OPENFILE)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\NULLDEVICE]
|
||||
(LOCALVARS . T)
|
||||
@@ -283,58 +282,58 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
|
||||
(DATATYPE STREAM
|
||||
(
|
||||
(* ;; "First 8 words are fixed for BIN, BOUT opcodes. Used to require length of whole datatype be multiple of 4, but Dolphin dead now.")
|
||||
(* ;; "First 8 words are fixed for BIN, BOUT opcodes. Used to require length of whole datatype be multiple of 4, but Dolphin dead now.")
|
||||
|
||||
(COFFSET WORD) (* ;
|
||||
"Offset in CPPTR of next bin or bout")
|
||||
(CBUFSIZE WORD) (* ;
|
||||
"Offset past last byte in that buffer")
|
||||
(PEEKEDCHARP FLAG) (* ;
|
||||
"if true, PEEKEDCHAR contains value of recent call to unread-char")
|
||||
(ACCESSBITS BITS 3) (* ;
|
||||
"What kind of access file is open for (read, write, append)")
|
||||
(CBUFPTR POINTER) (* ; "Pointer to current buffer")
|
||||
(BYTESIZE BYTE) (* ;
|
||||
"Byte size of stream, always 8 for now")
|
||||
(CHARSET BYTE) (* ; "the current character set for this stream. If 255, stream is not runcoded, so read-char consumes two bytes every time")
|
||||
(PEEKEDCHAR WORD) (* ; "value of unread-char call")
|
||||
(CHARPOSITION WORD) (* ; "Used by POSITION etc.")
|
||||
(CBUFMAXSIZE WORD) (* ;
|
||||
"on output, the size of the physical buffer--can't extend beyond this")
|
||||
(COFFSET WORD) (* ;
|
||||
"Offset in CPPTR of next bin or bout")
|
||||
(CBUFSIZE WORD) (* ;
|
||||
"Offset past last byte in that buffer")
|
||||
(PEEKEDCHARP FLAG) (* ;
|
||||
"if true, PEEKEDCHAR contains value of recent call to unread-char")
|
||||
(ACCESSBITS BITS 3) (* ;
|
||||
"What kind of access file is open for (read, write, append)")
|
||||
(CBUFPTR POINTER) (* ; "Pointer to current buffer")
|
||||
(BYTESIZE BYTE) (* ;
|
||||
"Byte size of stream, always 8 for now")
|
||||
(CHARSET BYTE) (* ; "the current character set for this stream. If 255, stream is not runcoded, so read-char consumes two bytes every time")
|
||||
(PEEKEDCHAR WORD) (* ; "value of unread-char call")
|
||||
(CHARPOSITION WORD) (* ; "Used by POSITION etc.")
|
||||
(CBUFMAXSIZE WORD) (* ;
|
||||
"on output, the size of the physical buffer--can't extend beyond this")
|
||||
|
||||
(* ;; "-------- Above fields (8 words) potentially known to microcode. --------")
|
||||
(* ;; "-------- Above fields (8 words) potentially known to microcode. --------")
|
||||
|
||||
(NONDEFAULTDATEFLG FLAG)
|
||||
(REVALIDATEFLG FLAG)
|
||||
(MULTIBUFFERHINT FLAG) (* ;
|
||||
"True if stream likes to read and write more than one buffer at a time")
|
||||
(USERCLOSEABLE FLAG) (* ;
|
||||
"Can be closed by CLOSEF; NIL for terminal, dribble...")
|
||||
(FULLFILENAME POINTER) (* ;
|
||||
"Name by which file is known to user")
|
||||
(BINABLE FLAG) (* ; "BIN punts unless this bit on")
|
||||
(BOUTABLE FLAG) (* ; "BOUT punts unless this bit on")
|
||||
(EXTENDABLE FLAG) (* ;
|
||||
"BOUT punts when COFFSET ge CBUFFSIZE unless this bit set and COFFSET lt 512")
|
||||
(CBUFDIRTY FLAG) (* ;
|
||||
"true if BOUT has sullied the current buffer")
|
||||
(DEVICE POINTER) (* ; "FDEV of this guy")
|
||||
(USERVISIBLE FLAG) (* ;
|
||||
"Listed by OPENP; NIL for terminal, dribble ...")
|
||||
(EOLCONVENTION BITS 2) (* ; "End-of-line convention")
|
||||
(NIL FLAG) (* ; "Was NOTXCCS.")
|
||||
(VALIDATION POINTER) (* ;
|
||||
"A number somehow identifying file, used to determine if file has changed in our absence")
|
||||
(CPAGE POINTER) (* ;
|
||||
"CPAGE,,COFFSET constitutes current file pointer for most randaccess streams")
|
||||
(MULTIBUFFERHINT FLAG) (* ;
|
||||
"True if stream likes to read and write more than one buffer at a time")
|
||||
(USERCLOSEABLE FLAG) (* ;
|
||||
"Can be closed by CLOSEF; NIL for terminal, dribble...")
|
||||
(FULLFILENAME POINTER) (* ;
|
||||
"Name by which file is known to user")
|
||||
(BINABLE FLAG) (* ; "BIN punts unless this bit on")
|
||||
(BOUTABLE FLAG) (* ; "BOUT punts unless this bit on")
|
||||
(EXTENDABLE FLAG) (* ;
|
||||
"BOUT punts when COFFSET ge CBUFFSIZE unless this bit set and COFFSET lt 512")
|
||||
(CBUFDIRTY FLAG) (* ;
|
||||
"true if BOUT has sullied the current buffer")
|
||||
(DEVICE POINTER) (* ; "FDEV of this guy")
|
||||
(USERVISIBLE FLAG) (* ;
|
||||
"Listed by OPENP; NIL for terminal, dribble ...")
|
||||
(EOLCONVENTION BITS 2) (* ; "End-of-line convention")
|
||||
(NIL FLAG) (* ; "Was NOTXCCS.")
|
||||
(VALIDATION POINTER) (* ;
|
||||
"A number somehow identifying file, used to determine if file has changed in our absence")
|
||||
(CPAGE POINTER) (* ;
|
||||
"CPAGE,,COFFSET constitutes current file pointer for most randaccess streams")
|
||||
(EPAGE POINTER)
|
||||
(EOFFSET WORD) (* ; "Page, byte offset of eof")
|
||||
(LINELENGTH WORD) (* ;
|
||||
"LINELENGTH of stream, or -1 for no line length")
|
||||
(EOFFSET WORD) (* ; "Page, byte offset of eof")
|
||||
(LINELENGTH WORD) (* ;
|
||||
"LINELENGTH of stream, or -1 for no line length")
|
||||
|
||||
(* ;; "----Following are device-specific fields----")
|
||||
(* ;; "----Following are device-specific fields----")
|
||||
|
||||
(* ;; "Available for device-specific uses, NOT for application use.")
|
||||
(* ;; "Available for device-specific uses, NOT for application use.")
|
||||
|
||||
(F1 POINTER)
|
||||
(F2 POINTER)
|
||||
@@ -347,54 +346,54 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
(FW9 WORD)
|
||||
(F10 POINTER)
|
||||
|
||||
(* ;; "----Following only filled in for open streams----")
|
||||
(* ;; "----Following only filled in for open streams----")
|
||||
|
||||
(STRMBINFN POINTER) (* ;
|
||||
"Either the BIN fn from the FDEV, or a trap")
|
||||
(STRMBOUTFN POINTER) (* ;
|
||||
"Either the BIN fn from the FDEV, or a trap")
|
||||
(OUTCHARFN POINTER) (* ;
|
||||
"Called by \OUTCHAR, the normal character printer.")
|
||||
(ENDOFSTREAMOP POINTER) (* ;
|
||||
"Called if EOF and we try to read.")
|
||||
(OTHERPROPS POINTER) (* ;
|
||||
"PROP LIST for holding other info.")
|
||||
(IMAGEOPS POINTER) (* ; "Image operations vector")
|
||||
(IMAGEDATA POINTER) (* ;
|
||||
"Image instance variables--format depends on IMAGEOPS value")
|
||||
(BUFFS POINTER) (* ;
|
||||
"Buffer chain for pmapped streams")
|
||||
(MAXBUFFERS WORD) (* ;
|
||||
"Max # of buffers the system will allocate.")
|
||||
(LASTCCODE WORD) (* ; "After READ, RATOM, etc, the charcode that will be returned (as a character) by LASTC. If there is none, this field is 65535.")
|
||||
(EXTRASTREAMOP POINTER) (* ;
|
||||
"For use of applications programs, not devices")
|
||||
(INCCODEFN POINTER) (* ; "Set by \EXTERNALFORMAT")
|
||||
(STRMBINFN POINTER) (* ;
|
||||
"Either the BIN fn from the FDEV, or a trap")
|
||||
(STRMBOUTFN POINTER) (* ;
|
||||
"Either the BIN fn from the FDEV, or a trap")
|
||||
(OUTCHARFN POINTER) (* ;
|
||||
"Called by \OUTCHAR, the normal character printer.")
|
||||
(ENDOFSTREAMOP POINTER) (* ;
|
||||
"Called if EOF and we try to read.")
|
||||
(OTHERPROPS POINTER) (* ;
|
||||
"PROP LIST for holding other info.")
|
||||
(IMAGEOPS POINTER) (* ; "Image operations vector")
|
||||
(IMAGEDATA POINTER) (* ;
|
||||
"Image instance variables--format depends on IMAGEOPS value")
|
||||
(BUFFS POINTER) (* ;
|
||||
"Buffer chain for pmapped streams")
|
||||
(MAXBUFFERS WORD) (* ;
|
||||
"Max # of buffers the system will allocate.")
|
||||
(LASTCCODE WORD) (* ; "After READ, RATOM, etc, the charcode that will be returned (as a character) by LASTC. If there is none, this field is 65535.")
|
||||
(EXTRASTREAMOP POINTER) (* ;
|
||||
"For use of applications programs, not devices")
|
||||
(INCCODEFN POINTER) (* ; "Set by \EXTERNALFORMAT")
|
||||
(PEEKCCODEFN POINTER)
|
||||
(BACKCCODEFN POINTER)
|
||||
(EXTERNALFORMAT POINTER))
|
||||
(BLOCKRECORD STREAM ((NIL 2 WORD)
|
||||
(UCODEFLAGS1 BITS 1)
|
||||
|
||||
(* ;; "respecification of access bits:")
|
||||
(* ;; "respecification of access bits:")
|
||||
|
||||
(RANDOMWRITEABLE FLAG) (* ;
|
||||
"File open for output (access = OUTPUT or BOTH)")
|
||||
(APPENDABLE FLAG) (* ;
|
||||
"File open for append (OUTPUT or APPEND or BOTH)")
|
||||
(READABLE FLAG) (* ;
|
||||
"File open for read (READ or BOTH)")
|
||||
(RANDOMWRITEABLE FLAG) (* ;
|
||||
"File open for output (access = OUTPUT or BOTH)")
|
||||
(APPENDABLE FLAG) (* ;
|
||||
"File open for append (OUTPUT or APPEND or BOTH)")
|
||||
(READABLE FLAG) (* ;
|
||||
"File open for read (READ or BOTH)")
|
||||
(NIL POINTER)))
|
||||
(BLOCKRECORD STREAM ((NIL 4 WORD)
|
||||
(NIL BITS 14)
|
||||
|
||||
(* ;;
|
||||
"JIS character encoding format specific, overrides CHARSET field.")
|
||||
(* ;;
|
||||
"JIS character encoding format specific, overrides CHARSET field.")
|
||||
|
||||
(IN.KANJIIN FLAG) (* ;
|
||||
"True if input stream is in Kanji-in mode.")
|
||||
(OUT.KANJIIN FLAG) (* ;
|
||||
"True if output stream is in Kanji-in mode.")
|
||||
(IN.KANJIIN FLAG) (* ;
|
||||
"True if input stream is in Kanji-in mode.")
|
||||
(OUT.KANJIIN FLAG) (* ;
|
||||
"True if output stream is in Kanji-in mode.")
|
||||
))
|
||||
[ACCESSFNS STREAM ((ACCESS \GETACCESS \SETACCESS)
|
||||
(FULLNAME (OR (fetch (STREAM FULLFILENAME) of DATUM)
|
||||
@@ -810,138 +809,138 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE FDEV ((RESETABLE FLAG) (* ; "Obsolete")
|
||||
(DATATYPE FDEV ((RESETABLE FLAG) (* ; "Obsolete")
|
||||
(RANDOMACCESSP FLAG)
|
||||
(NODIRECTORIES FLAG)
|
||||
(PAGEMAPPED FLAG) (* ;
|
||||
"True if i/o handled by pmap routines")
|
||||
(FDBINABLE FLAG) (* ;
|
||||
"Copied as a microcode flag for INPUT streams formed on this device")
|
||||
(PAGEMAPPED FLAG) (* ;
|
||||
"True if i/o handled by pmap routines")
|
||||
(FDBINABLE FLAG) (* ;
|
||||
"Copied as a microcode flag for INPUT streams formed on this device")
|
||||
(FDBOUTABLE FLAG)
|
||||
(FDEXTENDABLE FLAG)
|
||||
(BUFFERED FLAG) (* ; "True implies that the device supports the BIN & BOUT uCode conventions, and implements the GETNEXTBUFFER method")
|
||||
(DEVICENAME POINTER) (* ; "Identifying name somehow")
|
||||
(REMOTEP FLAG) (* ;
|
||||
"true if device not local to machine")
|
||||
(SUBDIRECTORIES FLAG) (* ;
|
||||
"true if device has real subdirectories")
|
||||
(INPUT-INDIRECTED FLAG) (* ;
|
||||
"True for devices that indirect their input stream. Method INPUTSTREAM fetches it")
|
||||
(OUTPUT-INDIRECTED FLAG) (* ;
|
||||
"True for devices that indirect their output stream. Method OUTPUTSTREAM fetches it")
|
||||
(DEVICEINFO POINTER) (* ;
|
||||
"arbitrary device-specific info stored here")
|
||||
(OPENFILELST POINTER) (* ;
|
||||
"Default place to keep list of streams open on this device")
|
||||
(BUFFERED FLAG) (* ; "True implies that the device supports the BIN & BOUT uCode conventions, and implements the GETNEXTBUFFER method")
|
||||
(DEVICENAME POINTER) (* ; "Identifying name somehow")
|
||||
(REMOTEP FLAG) (* ;
|
||||
"true if device not local to machine")
|
||||
(SUBDIRECTORIES FLAG) (* ;
|
||||
"true if device has real subdirectories")
|
||||
(INPUT-INDIRECTED FLAG) (* ;
|
||||
"True for devices that indirect their input stream. Method INPUTSTREAM fetches it")
|
||||
(OUTPUT-INDIRECTED FLAG) (* ;
|
||||
"True for devices that indirect their output stream. Method OUTPUTSTREAM fetches it")
|
||||
(DEVICEINFO POINTER) (* ;
|
||||
"arbitrary device-specific info stored here")
|
||||
(OPENFILELST POINTER) (* ;
|
||||
"Default place to keep list of streams open on this device")
|
||||
|
||||
(* ;; "-----Rest of record consists of device %"methods%"-----")
|
||||
(* ;; "-----Rest of record consists of device %"methods%"-----")
|
||||
|
||||
(* ;; "-----Following fields required of all devices-----")
|
||||
(* ;; "-----Following fields required of all devices-----")
|
||||
|
||||
(HOSTNAMEP POINTER) (* ; "(hostname {device}) => T if hostname is valid. If device is given, return a FDEV for this {new} host, or T to use existing device")
|
||||
(EVENTFN POINTER) (* ;
|
||||
"(device event), called before/after logout, sysout, makesys")
|
||||
(HOSTNAMEP POINTER) (* ; "(hostname {device}) => T if hostname is valid. If device is given, return a FDEV for this {new} host, or T to use existing device")
|
||||
(EVENTFN POINTER) (* ;
|
||||
"(device event), called before/after logout, sysout, makesys")
|
||||
|
||||
(* ;;
|
||||
"-----Following fields required of all named devices, e.g., ones that open files-----")
|
||||
(* ;;
|
||||
"-----Following fields required of all named devices, e.g., ones that open files-----")
|
||||
|
||||
(DIRECTORYNAMEP POINTER) (* ;
|
||||
"(host/dir) => true if directory exists on host")
|
||||
(OPENFILE POINTER) (* ;
|
||||
"(name access recog otherinfo device) => new stream open on this device, or NIL if name not found")
|
||||
(CLOSEFILE POINTER) (* ;
|
||||
"(stream) => closes stream, returns it")
|
||||
(REOPENFILE POINTER) (* ; "(name access recog otherinfo device stream) like openfile, but called after logout to revalidate file, so optionally uses info in old stream to keep this opening like the previous")
|
||||
(GETFILENAME POINTER) (* ;
|
||||
"(name recog device) => full file name")
|
||||
(DELETEFILE POINTER) (* ;
|
||||
"(name) => deletes file so named, returning name, or NIL on failure. RECOG=OLDEST")
|
||||
(GENERATEFILES POINTER) (* ; "(device pattern) => generator object for files matching pattern. Car of object is generator function, cdr is arbitrary state. Generator fn returns next file, or NIL when finished")
|
||||
(RENAMEFILE POINTER) (* ; "(olddevice oldfile newdevice newfile) to rename file on this (olddevice) to a potentially different device.")
|
||||
(OPENP POINTER) (* ;
|
||||
"(name access dev) => stream if name is open for access, or all open streams if name = NIL")
|
||||
(REGISTERFILE POINTER) (* ;
|
||||
"(stream dev) => registers stream on its device")
|
||||
(UNREGISTERFILE POINTER) (* ;
|
||||
"(stream dev) => unregisters a stream from its device")
|
||||
(FREEPAGECOUNT POINTER) (* ;
|
||||
"(host/dir dev) => # of free pages on host/dir")
|
||||
(MAKEDIRECTORY POINTER) (* ; "(host/dir dev)")
|
||||
(CHECKFILENAME POINTER) (* ;
|
||||
"(name dev) => name if it is well-formed file name for dev")
|
||||
(HOSTALIVEP POINTER) (* ;
|
||||
"(host dev) => true if host is alive, i.e., responsive; only defined if REMOTEP is true")
|
||||
(BREAKCONNECTION POINTER) (* ;
|
||||
"(host fastp dev) => closes connections to host")
|
||||
(DIRECTORYNAMEP POINTER) (* ;
|
||||
"(host/dir) => true if directory exists on host")
|
||||
(OPENFILE POINTER) (* ;
|
||||
"(name access recog otherinfo device) => new stream open on this device, or NIL if name not found")
|
||||
(CLOSEFILE POINTER) (* ;
|
||||
"(stream) => closes stream, returns it")
|
||||
(REOPENFILE POINTER) (* ; "(name access recog otherinfo device stream) like openfile, but called after logout to revalidate file, so optionally uses info in old stream to keep this opening like the previous")
|
||||
(GETFILENAME POINTER) (* ;
|
||||
"(name recog device) => full file name")
|
||||
(DELETEFILE POINTER) (* ;
|
||||
"(name) => deletes file so named, returning name, or NIL on failure. RECOG=OLDEST")
|
||||
(GENERATEFILES POINTER) (* ; "(device pattern) => generator object for files matching pattern. Car of object is generator function, cdr is arbitrary state. Generator fn returns next file, or NIL when finished")
|
||||
(RENAMEFILE POINTER) (* ; "(olddevice oldfile newdevice newfile) to rename file on this (olddevice) to a potentially different device.")
|
||||
(OPENP POINTER) (* ;
|
||||
"(name access dev) => stream if name is open for access, or all open streams if name = NIL")
|
||||
(REGISTERFILE POINTER) (* ;
|
||||
"(stream dev) => registers stream on its device")
|
||||
(UNREGISTERFILE POINTER) (* ;
|
||||
"(stream dev) => unregisters a stream from its device")
|
||||
(FREEPAGECOUNT POINTER) (* ;
|
||||
"(host/dir dev) => # of free pages on host/dir")
|
||||
(MAKEDIRECTORY POINTER) (* ; "(host/dir dev)")
|
||||
(CHECKFILENAME POINTER) (* ;
|
||||
"(name dev) => name if it is well-formed file name for dev")
|
||||
(HOSTALIVEP POINTER) (* ;
|
||||
"(host dev) => true if host is alive, i.e., responsive; only defined if REMOTEP is true")
|
||||
(BREAKCONNECTION POINTER) (* ;
|
||||
"(host fastp dev) => closes connections to host")
|
||||
|
||||
(* ;;
|
||||
"-----The following are required methods for operating on open streams-----")
|
||||
(* ;;
|
||||
"-----The following are required methods for operating on open streams-----")
|
||||
|
||||
(BIN POINTER) (* ; "(stream) => next byte of input")
|
||||
(BOUT POINTER) (* ;
|
||||
"(stream byte) output byte to stream")
|
||||
(PEEKBIN POINTER) (* ;
|
||||
"(stream) => next byte without advancing position in stream")
|
||||
(NIL POINTER) (* ;
|
||||
"Was READCHAR, replaced by READCHARCODE")
|
||||
(NIL POINTER) (* ;
|
||||
"Was WRITECHAR (stream char) => writes char to stream")
|
||||
(NIL POINTER) (* ; "Was PEEKCHAR")
|
||||
(NIL POINTER) (* ; "Was UNREADCHAR")
|
||||
(READP POINTER) (* ;
|
||||
"(stream flag) => T if there is input available from stream right now")
|
||||
(EOFP POINTER) (* ;
|
||||
"(stream) => T if BIN would signal eof.")
|
||||
(BLOCKIN POINTER) (* ;
|
||||
"(stream buffer byteoffset nbytes)")
|
||||
(BLOCKOUT POINTER) (* ;
|
||||
"(stream buffer byteoffset nbytes)")
|
||||
(FORCEOUTPUT POINTER) (* ;
|
||||
"(stream waitForFinish) flushes out to device anything that is buffered awaiting transmission")
|
||||
(GETFILEINFO POINTER) (* ;
|
||||
"(stream/name attribute device) => value of attribute for open stream or name of closed file")
|
||||
(SETFILEINFO POINTER) (* ;
|
||||
"(stream/name attribute newvalue device) sets attribute of open stream or closed file of given name")
|
||||
(CHARSETFN POINTER) (* ; "(stream charset) => access function for the charset slot, for benefit of indirect streams. See IMCHARSET for changing it on a file.")
|
||||
(INPUTSTREAM POINTER) (* ;
|
||||
"(stream) => indirected input stream")
|
||||
(OUTPUTSTREAM POINTER) (* ;
|
||||
"(stream) => indirected output stream")
|
||||
(BIN POINTER) (* ; "(stream) => next byte of input")
|
||||
(BOUT POINTER) (* ;
|
||||
"(stream byte) output byte to stream")
|
||||
(PEEKBIN POINTER) (* ;
|
||||
"(stream) => next byte without advancing position in stream")
|
||||
(NIL POINTER) (* ;
|
||||
"Was READCHAR, replaced by READCHARCODE")
|
||||
(NIL POINTER) (* ;
|
||||
"Was WRITECHAR (stream char) => writes char to stream")
|
||||
(NIL POINTER) (* ; "Was PEEKCHAR")
|
||||
(NIL POINTER) (* ; "Was UNREADCHAR")
|
||||
(READP POINTER) (* ;
|
||||
"(stream flag) => T if there is input available from stream right now")
|
||||
(EOFP POINTER) (* ;
|
||||
"(stream) => T if BIN would signal eof.")
|
||||
(BLOCKIN POINTER) (* ;
|
||||
"(stream buffer byteoffset nbytes)")
|
||||
(BLOCKOUT POINTER) (* ;
|
||||
"(stream buffer byteoffset nbytes)")
|
||||
(FORCEOUTPUT POINTER) (* ;
|
||||
"(stream waitForFinish) flushes out to device anything that is buffered awaiting transmission")
|
||||
(GETFILEINFO POINTER) (* ;
|
||||
"(stream/name attribute device) => value of attribute for open stream or name of closed file")
|
||||
(SETFILEINFO POINTER) (* ;
|
||||
"(stream/name attribute newvalue device) sets attribute of open stream or closed file of given name")
|
||||
(CHARSETFN POINTER) (* ; "(stream charset) => access function for the charset slot, for benefit of indirect streams. See IMCHARSET for changing it on a file.")
|
||||
(INPUTSTREAM POINTER) (* ;
|
||||
"(stream) => indirected input stream")
|
||||
(OUTPUTSTREAM POINTER) (* ;
|
||||
"(stream) => indirected output stream")
|
||||
|
||||
(* ;; "-----Following are required of random-access streams-----")
|
||||
(* ;; "-----Following are required of random-access streams-----")
|
||||
|
||||
(GETFILEPTR POINTER)
|
||||
(GETEOFPTR POINTER)
|
||||
(SETFILEPTR POINTER)
|
||||
(BACKFILEPTR POINTER) (* ; "(stream) backs up `fileptr' by one. Stream is only required to be able to do this once, i.e. one-character buffer suffices")
|
||||
(SETEOFPTR POINTER) (* ;
|
||||
"(stream length) => truncates or lengthens stream to indicated length")
|
||||
(LASTC POINTER) (* ;
|
||||
"Should be possible only if RANDOMACCESSP")
|
||||
(BACKFILEPTR POINTER) (* ; "(stream) backs up `fileptr' by one. Stream is only required to be able to do this once, i.e. one-character buffer suffices")
|
||||
(SETEOFPTR POINTER) (* ;
|
||||
"(stream length) => truncates or lengthens stream to indicated length")
|
||||
(LASTC POINTER) (* ;
|
||||
"Should be possible only if RANDOMACCESSP")
|
||||
|
||||
(* ;; "-----Following used for buffered streams-----")
|
||||
(* ;; "-----Following used for buffered streams-----")
|
||||
|
||||
(GETNEXTBUFFER POINTER) (* ; "(stream whatfor noerrorflg) => Disposes of current buffer and optionally reads next. whatfor is READ or WRITE. Can cause EOF error unless noerrorflg")
|
||||
(RELEASEBUFFER POINTER) (* ;
|
||||
"(stream) => Does whatever appropriate when CBUFPTR is released")
|
||||
(GETNEXTBUFFER POINTER) (* ; "(stream whatfor noerrorflg) => Disposes of current buffer and optionally reads next. whatfor is READ or WRITE. Can cause EOF error unless noerrorflg")
|
||||
(RELEASEBUFFER POINTER) (* ;
|
||||
"(stream) => Does whatever appropriate when CBUFPTR is released")
|
||||
|
||||
(* ;; "-----Following used for pagemapped streams-----")
|
||||
(* ;; "-----Following used for pagemapped streams-----")
|
||||
|
||||
(READPAGES POINTER) (* ; "(stream firstpage# buflist) => # of bytes read, starting at firstpage#, reading into buflist, a list of buffers or a single buffer (the usual case)")
|
||||
(WRITEPAGES POINTER) (* ;
|
||||
"(stream firstpage# buflist) writes from buflist to stream starting at firstpage# of stream")
|
||||
(TRUNCATEFILE POINTER) (* ;
|
||||
"(stream page offset) make stream's eof be at page,offset, discarding anything after it")
|
||||
(READPAGES POINTER) (* ; "(stream firstpage# buflist) => # of bytes read, starting at firstpage#, reading into buflist, a list of buffers or a single buffer (the usual case)")
|
||||
(WRITEPAGES POINTER) (* ;
|
||||
"(stream firstpage# buflist) writes from buflist to stream starting at firstpage# of stream")
|
||||
(TRUNCATEFILE POINTER) (* ;
|
||||
"(stream page offset) make stream's eof be at page,offset, discarding anything after it")
|
||||
|
||||
(* ;; "-----For window system, argh-----")
|
||||
(* ;; "-----For window system, argh-----")
|
||||
|
||||
(WINDOWOPS POINTER) (* ; "window system operations")
|
||||
(WINDOWDATA POINTER) (* ; "data for window systems")
|
||||
(WINDOWOPS POINTER) (* ; "window system operations")
|
||||
(WINDOWDATA POINTER) (* ; "data for window systems")
|
||||
|
||||
(* ;; "-----For any stream (here to not recompile everything)-----")
|
||||
(* ;; "-----For any stream (here to not recompile everything)-----")
|
||||
|
||||
(DEFAULTEXTERNALFORMAT POINTER) (* ;
|
||||
"Was READCHARCODE. Read a character code from the stream (cf BIN for bytes).")
|
||||
(DEFAULTEXTERNALFORMAT POINTER) (* ;
|
||||
"Was READCHARCODE. Read a character code from the stream (cf BIN for bytes).")
|
||||
)
|
||||
DIRECTORYNAMEP _ (FUNCTION NILL)
|
||||
HOSTNAMEP _ (FUNCTION NILL)
|
||||
@@ -1188,22 +1187,22 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* ; "If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream. (Can't test EOL because it is always something)")
|
||||
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* ; "If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream. (Can't test EOL because it is always something)")
|
||||
(EOL BITS 2)
|
||||
(NIL BITS 1)
|
||||
(INCCODEFN POINTER) (* ;
|
||||
"Called with STREAM and 2 optional arguments, BYTECOUNTVAR and BYTECOUNTVAL")
|
||||
(PEEKCCODEFN POINTER) (* ;
|
||||
"Called with three arguments -- STREAM, NOERROR, and EOL")
|
||||
(BACKCCODEFN POINTER) (* ;
|
||||
"Called with STREAM and optional BYTECOUNTVAR and BYTECOUNTVAL")
|
||||
(OUTCHARFN POINTER) (* ;
|
||||
"Called with two arguments -- STREAM and CHARCODE")
|
||||
(NAME POINTER) (* ;
|
||||
"keyword name of this format, provided to \INSTALL.EXTERNALFORMAT")
|
||||
(FORMATBYTESTREAMFN POINTER) (* ; "Function to copy the format state of a given stream to an IO stream that allows formatted byte sequences to be examined")
|
||||
(EF1 POINTER) (* ;
|
||||
"Extra fields for use of particular formats. Possibly to hold standardized translation tables")
|
||||
(INCCODEFN POINTER) (* ;
|
||||
"Called with STREAM and 2 optional arguments, BYTECOUNTVAR and BYTECOUNTVAL")
|
||||
(PEEKCCODEFN POINTER) (* ;
|
||||
"Called with three arguments -- STREAM, NOERROR, and EOL")
|
||||
(BACKCCODEFN POINTER) (* ;
|
||||
"Called with STREAM and optional BYTECOUNTVAR and BYTECOUNTVAL")
|
||||
(OUTCHARFN POINTER) (* ;
|
||||
"Called with two arguments -- STREAM and CHARCODE")
|
||||
(NAME POINTER) (* ;
|
||||
"keyword name of this format, provided to \INSTALL.EXTERNALFORMAT")
|
||||
(FORMATBYTESTREAMFN POINTER) (* ; "Function to copy the format state of a given stream to an IO stream that allows formatted byte sequences to be examined")
|
||||
(EF1 POINTER) (* ;
|
||||
"Extra fields for use of particular formats. Possibly to hold standardized translation tables")
|
||||
(EF2 POINTER)))
|
||||
)
|
||||
|
||||
@@ -2949,8 +2948,8 @@ update the map")
|
||||
|
||||
(PUTPROPS \CONVERT-PATHNAME DMACRO (OPENLAMBDA (PATHNAME?)
|
||||
|
||||
(* ;;
|
||||
"Coerce pathnames to Interlisp strings, for the benefit of antediluvian Interlisp-D file fns")
|
||||
(* ;;
|
||||
"Coerce pathnames to Interlisp strings, for the benefit of antediluvian Interlisp-D file fns")
|
||||
|
||||
(CL:TYPECASE PATHNAME?
|
||||
(PATHNAME (INTERLISP-NAMESTRING PATHNAME?))
|
||||
@@ -3397,44 +3396,44 @@ update the map")
|
||||
(PUTPROPS FILEIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989
|
||||
1990 1991 1992 1993 1999 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (28448 31938 (STREAMPROP 28458 . 28892) (GETSTREAMPROP 28894 . 29367) (PUTSTREAMPROP
|
||||
29369 . 31786) (STREAMP 31788 . 31936)) (31981 34500 (\DEFPRINT.BY.NAME 31991 . 33143) (
|
||||
\STREAM.DEFPRINT 33145 . 34193) (\FDEV.DEFPRINT 34195 . 34498)) (34758 39799 (\GETACCESS 34768 . 35222
|
||||
) (\SETACCESS 35224 . 39797)) (63184 64437 (MAKE-EXTERNALFORMAT 63194 . 64435)) (65670 73499 (
|
||||
\INSTALL.EXTERNALFORMAT 65680 . 67129) (\REMOVE.EXTERNALFORMAT 67131 . 67962) (FIND-FORMAT 67964 .
|
||||
68781) (\EXTERNALFORMAT 68783 . 73497)) (73822 75685 (\CREATE.THROUGH.EXTERNALFORMAT 73832 . 74634) (
|
||||
\THROUGHIN 74636 . 75060) (\THROUGHBACKCCODE 75062 . 75333) (\THROUGHOUTCHARFN 75335 . 75683)) (75793
|
||||
81762 (\DEFINEDEVICE 75803 . 78119) (\GETDEVICEFROMNAME 78121 . 78594) (\GETDEVICEFROMHOSTNAME 78596
|
||||
. 79640) (\REMOVEDEVICE 79642 . 80765) (\REMOVEDEVICE.NAMES 80767 . 81760)) (81802 106462 (\CLOSEFILE
|
||||
81812 . 82637) (\DELETEFILE 82639 . 82933) (\DEVICEEVENT 82935 . 84705) (\GENERATEFILES 84707 . 85185
|
||||
) (\GENERATENEXTFILE 85187 . 85838) (\GENERATEFILEINFO 85840 . 86301) (\GETFILENAME 86303 . 86692) (
|
||||
\GENERIC.OUTFILEP 86694 . 87164) (\OPENFILE 87166 . 89744) (\DO.PARAMS.AT.OPEN 89746 . 92299) (
|
||||
\RENAMEFILE 92301 . 92725) (\REVALIDATEFILE 92727 . 95329) (\PAGED.REVALIDATEFILELST 95331 . 96889) (
|
||||
\PAGED.REVALIDATEFILES 96891 . 98610) (\PAGED.REVALIDATEFILE 98612 . 100895) (\BUFFERED.REVALIDATEFILE
|
||||
100897 . 103183) (\BUFFERED.REVALIDATEFILELST 103185 . 104369) (\PRINT-REVALIDATION-RESULT 104371 .
|
||||
104786) (\TRUNCATEFILE 104788 . 105179) (\FILE-CONFLICT 105181 . 106460)) (106498 111161 (
|
||||
\GENERATENOFILES 106508 . 108604) (\NULLFILEGENERATOR 108606 . 108850) (\NOFILESNEXTFILEFN 108852 .
|
||||
110843) (\NOFILESINFOFN 110845 . 111159)) (111280 113188 (\FILE.NOT.OPEN 111290 . 111803) (
|
||||
\FILE.WONT.OPEN 111805 . 112133) (\ILLEGAL.DEVICEOP 112135 . 112417) (\IS.NOT.RANDACCESSP 112419 .
|
||||
112865) (\STREAM.NOT.OPEN 112867 . 113186)) (113323 115621 (\FDEVINSTANCE 113333 . 115619)) (117171
|
||||
124545 (CNDIR 117181 . 118486) (DIRECTORYNAME 118488 . 122671) (DIRECTORYNAMEP 122673 . 123289) (
|
||||
HOSTNAMEP 123291 . 124098) (\ADD.CONNECTED.DIR 124100 . 124543)) (124590 151977 (\BACKFILEPTR 124600
|
||||
. 124788) (\BACKPEEKBIN 124790 . 125151) (\BACKBIN 125153 . 125504) (BIN 125506 . 125723) (\BIN
|
||||
125725 . 126002) (\BINS 126004 . 126290) (BOUT 126292 . 126654) (\BOUT 126656 . 126971) (\BOUTS 126973
|
||||
. 127284) (COPYBYTES 127286 . 130618) (COPYCHARS 130620 . 134286) (COPYFILE 134288 . 135085) (
|
||||
\COPYOPENFILE 135087 . 138160) (\INFER.FILE.TYPE 138162 . 139116) (EOFP 139118 . 139415) (FORCEOUTPUT
|
||||
139417 . 139664) (\FLUSH.OPEN.STREAMS 139666 . 140022) (CHARSET 140024 . 141688) (ACCESS-CHARSET
|
||||
141690 . 141907) (GETEOFPTR 141909 . 142159) (GETFILEINFO 142161 . 145354) (\TYPE.FROM.FILETYPE 145356
|
||||
. 145826) (\FILETYPE.FROM.TYPE 145828 . 146007) (GETFILEPTR 146009 . 146261) (SETFILEINFO 146263 .
|
||||
149876) (SETFILEPTR 149878 . 151597) (BOUT16 151599 . 151784) (BIN16 151786 . 151975)) (152080 157285
|
||||
(\GENERIC.BINS 152090 . 152370) (\GENERIC.BOUTS 152372 . 152637) (\GENERIC.RENAMEFILE 152639 . 154470)
|
||||
(\GENERIC.OPENP 154472 . 155787) (\GENERIC.READP 155789 . 156830) (\GENERIC.CHARSET 156832 . 157283))
|
||||
(157286 157625 (\MAP-OPEN-STREAMS 157296 . 157623)) (159495 161575 (\EOF.ACTION 159505 . 159756) (
|
||||
\EOSERROR 159758 . 159951) (\GETEOFPTR 159953 . 160135) (\INCFILEPTR 160137 . 160487) (\PEEKBIN 160489
|
||||
. 160680) (\SETCLOSEDFILELENGTH 160682 . 161016) (\SETEOFPTR 161018 . 161206) (\SETFILEPTR 161208 .
|
||||
161573)) (161576 162118 (\FIXPOUT 161586 . 161886) (\FIXPIN 161888 . 162116)) (162119 162685 (\BOUTEOL
|
||||
162129 . 162683)) (165777 175641 (\BUFFERED.BIN 165787 . 166639) (\BUFFERED.PEEKBIN 166641 . 167423)
|
||||
(\BUFFERED.BOUT 167425 . 168285) (\BUFFERED.BINS 168287 . 171972) (\BUFFERED.BOUTS 171974 . 173775) (
|
||||
\BUFFERED.COPYBYTES 173777 . 175639)) (175670 178022 (\NULLDEVICE 175680 . 177698) (\NULL.OPENFILE
|
||||
177700 . 178020)))))
|
||||
(FILEMAP (NIL (28396 31886 (STREAMPROP 28406 . 28840) (GETSTREAMPROP 28842 . 29315) (PUTSTREAMPROP
|
||||
29317 . 31734) (STREAMP 31736 . 31884)) (31929 34448 (\DEFPRINT.BY.NAME 31939 . 33091) (
|
||||
\STREAM.DEFPRINT 33093 . 34141) (\FDEV.DEFPRINT 34143 . 34446)) (34706 39747 (\GETACCESS 34716 . 35170
|
||||
) (\SETACCESS 35172 . 39745)) (63132 64385 (MAKE-EXTERNALFORMAT 63142 . 64383)) (65618 73447 (
|
||||
\INSTALL.EXTERNALFORMAT 65628 . 67077) (\REMOVE.EXTERNALFORMAT 67079 . 67910) (FIND-FORMAT 67912 .
|
||||
68729) (\EXTERNALFORMAT 68731 . 73445)) (73770 75633 (\CREATE.THROUGH.EXTERNALFORMAT 73780 . 74582) (
|
||||
\THROUGHIN 74584 . 75008) (\THROUGHBACKCCODE 75010 . 75281) (\THROUGHOUTCHARFN 75283 . 75631)) (75741
|
||||
81710 (\DEFINEDEVICE 75751 . 78067) (\GETDEVICEFROMNAME 78069 . 78542) (\GETDEVICEFROMHOSTNAME 78544
|
||||
. 79588) (\REMOVEDEVICE 79590 . 80713) (\REMOVEDEVICE.NAMES 80715 . 81708)) (81750 106410 (\CLOSEFILE
|
||||
81760 . 82585) (\DELETEFILE 82587 . 82881) (\DEVICEEVENT 82883 . 84653) (\GENERATEFILES 84655 . 85133
|
||||
) (\GENERATENEXTFILE 85135 . 85786) (\GENERATEFILEINFO 85788 . 86249) (\GETFILENAME 86251 . 86640) (
|
||||
\GENERIC.OUTFILEP 86642 . 87112) (\OPENFILE 87114 . 89692) (\DO.PARAMS.AT.OPEN 89694 . 92247) (
|
||||
\RENAMEFILE 92249 . 92673) (\REVALIDATEFILE 92675 . 95277) (\PAGED.REVALIDATEFILELST 95279 . 96837) (
|
||||
\PAGED.REVALIDATEFILES 96839 . 98558) (\PAGED.REVALIDATEFILE 98560 . 100843) (\BUFFERED.REVALIDATEFILE
|
||||
100845 . 103131) (\BUFFERED.REVALIDATEFILELST 103133 . 104317) (\PRINT-REVALIDATION-RESULT 104319 .
|
||||
104734) (\TRUNCATEFILE 104736 . 105127) (\FILE-CONFLICT 105129 . 106408)) (106446 111109 (
|
||||
\GENERATENOFILES 106456 . 108552) (\NULLFILEGENERATOR 108554 . 108798) (\NOFILESNEXTFILEFN 108800 .
|
||||
110791) (\NOFILESINFOFN 110793 . 111107)) (111228 113136 (\FILE.NOT.OPEN 111238 . 111751) (
|
||||
\FILE.WONT.OPEN 111753 . 112081) (\ILLEGAL.DEVICEOP 112083 . 112365) (\IS.NOT.RANDACCESSP 112367 .
|
||||
112813) (\STREAM.NOT.OPEN 112815 . 113134)) (113271 115569 (\FDEVINSTANCE 113281 . 115567)) (117119
|
||||
124493 (CNDIR 117129 . 118434) (DIRECTORYNAME 118436 . 122619) (DIRECTORYNAMEP 122621 . 123237) (
|
||||
HOSTNAMEP 123239 . 124046) (\ADD.CONNECTED.DIR 124048 . 124491)) (124538 151925 (\BACKFILEPTR 124548
|
||||
. 124736) (\BACKPEEKBIN 124738 . 125099) (\BACKBIN 125101 . 125452) (BIN 125454 . 125671) (\BIN
|
||||
125673 . 125950) (\BINS 125952 . 126238) (BOUT 126240 . 126602) (\BOUT 126604 . 126919) (\BOUTS 126921
|
||||
. 127232) (COPYBYTES 127234 . 130566) (COPYCHARS 130568 . 134234) (COPYFILE 134236 . 135033) (
|
||||
\COPYOPENFILE 135035 . 138108) (\INFER.FILE.TYPE 138110 . 139064) (EOFP 139066 . 139363) (FORCEOUTPUT
|
||||
139365 . 139612) (\FLUSH.OPEN.STREAMS 139614 . 139970) (CHARSET 139972 . 141636) (ACCESS-CHARSET
|
||||
141638 . 141855) (GETEOFPTR 141857 . 142107) (GETFILEINFO 142109 . 145302) (\TYPE.FROM.FILETYPE 145304
|
||||
. 145774) (\FILETYPE.FROM.TYPE 145776 . 145955) (GETFILEPTR 145957 . 146209) (SETFILEINFO 146211 .
|
||||
149824) (SETFILEPTR 149826 . 151545) (BOUT16 151547 . 151732) (BIN16 151734 . 151923)) (152028 157233
|
||||
(\GENERIC.BINS 152038 . 152318) (\GENERIC.BOUTS 152320 . 152585) (\GENERIC.RENAMEFILE 152587 . 154418)
|
||||
(\GENERIC.OPENP 154420 . 155735) (\GENERIC.READP 155737 . 156778) (\GENERIC.CHARSET 156780 . 157231))
|
||||
(157234 157573 (\MAP-OPEN-STREAMS 157244 . 157571)) (159443 161523 (\EOF.ACTION 159453 . 159704) (
|
||||
\EOSERROR 159706 . 159899) (\GETEOFPTR 159901 . 160083) (\INCFILEPTR 160085 . 160435) (\PEEKBIN 160437
|
||||
. 160628) (\SETCLOSEDFILELENGTH 160630 . 160964) (\SETEOFPTR 160966 . 161154) (\SETFILEPTR 161156 .
|
||||
161521)) (161524 162066 (\FIXPOUT 161534 . 161834) (\FIXPIN 161836 . 162064)) (162067 162633 (\BOUTEOL
|
||||
162077 . 162631)) (165725 175589 (\BUFFERED.BIN 165735 . 166587) (\BUFFERED.PEEKBIN 166589 . 167371)
|
||||
(\BUFFERED.BOUT 167373 . 168233) (\BUFFERED.BINS 168235 . 171920) (\BUFFERED.BOUTS 171922 . 173723) (
|
||||
\BUFFERED.COPYBYTES 173725 . 175587)) (175618 177970 (\NULLDEVICE 175628 . 177646) (\NULL.OPENFILE
|
||||
177648 . 177968)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,103 +1,103 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "28-Jun-99 22:10:46" {DSK}<project>medley3.5>sources>FONTPROFILE.;2 29960
|
||||
(FILECREATED " 6-Sep-2021 19:11:32"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FONTPROFILE.;4 30288
|
||||
|
||||
changes to%: (VARS FONTPROFILECOMS)
|
||||
(ALISTS (FONTDEFS NS)
|
||||
(FONTDEFS BIGGERNS))
|
||||
changes to%: (ALISTS (FONTDEFS BIGGERNS))
|
||||
|
||||
previous date%: " 9-Jul-91 18:38:04" {DSK}<project>medley3.5>sources>FONTPROFILE.;1)
|
||||
previous date%: " 6-Sep-2021 15:52:13"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FONTPROFILE.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1988, 1990, 1991, 1999 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1986, 1988, 1990-1991, 1999, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT FONTPROFILECOMS)
|
||||
|
||||
(RPAQQ FONTPROFILECOMS
|
||||
(
|
||||
(* ;; "FONT")
|
||||
(* ;; "FONT")
|
||||
|
||||
(ALISTS (FONTDEFS HUGE BIG MEDIUM STANDARD BIGGER NS BIGGERNS))
|
||||
(ADDVARS (CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu))
|
||||
[VARS (FONTVARS '(
|
||||
(* ;; "standard size fonts. Assumes only DEFAULTFONT set")
|
||||
(* ;; "standard size fonts. Assumes only DEFAULTFONT set")
|
||||
|
||||
(BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD))
|
||||
(* ; "default BOLD")
|
||||
(* ; "default BOLD")
|
||||
(ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC))
|
||||
(LITTLEFONT DEFAULTFONT)
|
||||
(* ; " should usually be smaller")
|
||||
(* ; " should usually be smaller")
|
||||
(TINYFONT LITTLEFONT)
|
||||
(* ; "and this one smaller still")
|
||||
(* ; "and this one smaller still")
|
||||
(BIGFONT BOLDFONT)
|
||||
(* ; "should be bigger still")
|
||||
(* ; "should be bigger still")
|
||||
(TEXTFONT DEFAULTFONT)
|
||||
(* ; "default for text")
|
||||
(* ; "default for text")
|
||||
(TEXTBOLDFONT BOLDFONT)
|
||||
(* ; "default for bold text")
|
||||
(* ; "default for bold text")
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for window system, processes")
|
||||
(* ;; "Fonts for window system, processes")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
(MENUFONT DEFAULTFONT T)
|
||||
(BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD))
|
||||
(* ; "if not supplied")
|
||||
(* ; "if not supplied")
|
||||
(INTERRUPTMENUFONT DEFAULTFONT T)
|
||||
(* ; "used by control-B")
|
||||
(* ; "used by control-B")
|
||||
(DEFAULTICONFONT MENUFONT)
|
||||
(* ; "for shrinking windows")
|
||||
(* ; "for shrinking windows")
|
||||
(BACKTRACEFONT TINYFONT T)
|
||||
(* ; " for backtrace in debugger")
|
||||
(* ; " for backtrace in debugger")
|
||||
(WINDOWTITLEFONT MENUFONT)
|
||||
((WINDOWTITLEFONT WINDOWTITLEFONT)
|
||||
NIL)
|
||||
(* ; " used for titles of all windows")
|
||||
(* ; " used for titles of all windows")
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for Exec")
|
||||
(* ;; "Fonts for Exec")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
(PROMPTFONT LITTLEFONT)
|
||||
(* ; "for printing out prompts")
|
||||
(* ; "for printing out prompts")
|
||||
(INPUTFONT BOLDFONT)
|
||||
(* ; "for user typein in Exec")
|
||||
(* ; "for user typein in Exec")
|
||||
(PRINTOUTFONT DEFAULTFONT)
|
||||
(* ; " for intermediate typin in Exec")
|
||||
(* ; " for intermediate typin in Exec")
|
||||
(TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT))
|
||||
(VALUEFONT DEFAULTFONT)
|
||||
(* ;
|
||||
" for printing out values returned in Exec")
|
||||
(* ;
|
||||
" for printing out values returned in Exec")
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for prettyprinting")
|
||||
(* ;; "Fonts for prettyprinting")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
(COMMENTFONT LITTLEFONT)
|
||||
(* ; "for comments ")
|
||||
(* ; "for comments ")
|
||||
(PRETTYCOMFONT BOLDFONT)
|
||||
(* ; " for words being defined")
|
||||
(* ; " for words being defined")
|
||||
(CLISPFONT BOLDFONT)
|
||||
(* ; " for keywords & CLISP")
|
||||
(* ; " for keywords & CLISP")
|
||||
(SYSTEMFONT DEFAULTFONT)
|
||||
(* ; " for %"system%" words(?)")
|
||||
(* ; " for %"system%" words(?)")
|
||||
(LAMBDAFONT BIGFONT)
|
||||
(* ; "for words being defined")
|
||||
(* ; "for words being defined")
|
||||
(USERFONT BOLDFONT)
|
||||
(* ; " for %"user%" defined words")]
|
||||
(* ; " for %"user%" defined words")]
|
||||
(P (MOVD? 'NILL 'WINDOWTITLEFONT))
|
||||
(FNS FONTSET FONTPROFILE FONTPROFILE.ADDDEVICE)
|
||||
(INITVARS (FONTESCAPECHAR (CHARACTER 6))
|
||||
@@ -242,7 +242,11 @@ Copyright (c) 1986, 1988, 1990, 1991, 1999 by Venue & Xerox Corporation. All ri
|
||||
(MODERN 8 MIR))
|
||||
(BIGFONT 4 (MODERN 12 BRR)
|
||||
(MODERN 10 BRR)
|
||||
(MODERN 10 BRR]
|
||||
(MODERN 10 BRR))
|
||||
(MENUFONT 5 (MODERN 10))
|
||||
(COMMENTFONT 6 (MODERN 8)
|
||||
(MODERN 6 MIR)
|
||||
(MODERN 8 MIR]
|
||||
[BIGGERNS (FONTCHANGEFLG . ALL)
|
||||
(FILELINELENGTH . 102)
|
||||
(COMMENTLINELENGTH 116 . 126)
|
||||
@@ -263,89 +267,93 @@ Copyright (c) 1986, 1988, 1990, 1991, 1999 by Venue & Xerox Corporation. All ri
|
||||
(MODERN 8 MIR))
|
||||
(BIGFONT 4 (MODERN 14 BRR)
|
||||
(MODERN 10 BRR)
|
||||
(MODERN 10 BRR])
|
||||
(MODERN 10 BRR))
|
||||
(MENUFONT 5 (MODERN 12))
|
||||
(COMMENTFONT 6 (MODERN 10)
|
||||
(MODERN 8 MIR)
|
||||
(MODERN 10 MIR])
|
||||
|
||||
(ADDTOVAR CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu)
|
||||
|
||||
(RPAQQ FONTVARS
|
||||
(
|
||||
(* ;; "standard size fonts. Assumes only DEFAULTFONT set")
|
||||
(* ;; "standard size fonts. Assumes only DEFAULTFONT set")
|
||||
|
||||
(BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD))
|
||||
(* ; "default BOLD")
|
||||
(* ; "default BOLD")
|
||||
(ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC))
|
||||
(LITTLEFONT DEFAULTFONT)
|
||||
(* ; " should usually be smaller")
|
||||
(* ; " should usually be smaller")
|
||||
(TINYFONT LITTLEFONT)
|
||||
(* ; "and this one smaller still")
|
||||
(* ; "and this one smaller still")
|
||||
(BIGFONT BOLDFONT)
|
||||
(* ; "should be bigger still")
|
||||
(* ; "should be bigger still")
|
||||
(TEXTFONT DEFAULTFONT)
|
||||
(* ; "default for text")
|
||||
(* ; "default for text")
|
||||
(TEXTBOLDFONT BOLDFONT)
|
||||
(* ; "default for bold text")
|
||||
(* ; "default for bold text")
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for window system, processes")
|
||||
(* ;; "Fonts for window system, processes")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
(MENUFONT DEFAULTFONT T)
|
||||
(BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD))
|
||||
(* ; "if not supplied")
|
||||
(* ; "if not supplied")
|
||||
(INTERRUPTMENUFONT DEFAULTFONT T)
|
||||
(* ; "used by control-B")
|
||||
(* ; "used by control-B")
|
||||
(DEFAULTICONFONT MENUFONT)
|
||||
(* ; "for shrinking windows")
|
||||
(* ; "for shrinking windows")
|
||||
(BACKTRACEFONT TINYFONT T)
|
||||
(* ; " for backtrace in debugger")
|
||||
(* ; " for backtrace in debugger")
|
||||
(WINDOWTITLEFONT MENUFONT)
|
||||
((WINDOWTITLEFONT WINDOWTITLEFONT)
|
||||
NIL)
|
||||
(* ; " used for titles of all windows")
|
||||
(* ; " used for titles of all windows")
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for Exec")
|
||||
(* ;; "Fonts for Exec")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
(PROMPTFONT LITTLEFONT)
|
||||
(* ; "for printing out prompts")
|
||||
(* ; "for printing out prompts")
|
||||
(INPUTFONT BOLDFONT)
|
||||
(* ; "for user typein in Exec")
|
||||
(* ; "for user typein in Exec")
|
||||
(PRINTOUTFONT DEFAULTFONT)
|
||||
(* ; " for intermediate typin in Exec")
|
||||
(* ; " for intermediate typin in Exec")
|
||||
(TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT))
|
||||
(VALUEFONT DEFAULTFONT)
|
||||
(* ;
|
||||
" for printing out values returned in Exec")
|
||||
(* ;
|
||||
" for printing out values returned in Exec")
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for prettyprinting")
|
||||
(* ;; "Fonts for prettyprinting")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
(COMMENTFONT LITTLEFONT)
|
||||
(* ; "for comments ")
|
||||
(* ; "for comments ")
|
||||
(PRETTYCOMFONT BOLDFONT)
|
||||
(* ; " for words being defined")
|
||||
(* ; " for words being defined")
|
||||
(CLISPFONT BOLDFONT)
|
||||
(* ; " for keywords & CLISP")
|
||||
(* ; " for keywords & CLISP")
|
||||
(SYSTEMFONT DEFAULTFONT)
|
||||
(* ; " for %"system%" words(?)")
|
||||
(* ; " for %"system%" words(?)")
|
||||
(LAMBDAFONT BIGFONT)
|
||||
(* ; "for words being defined")
|
||||
(* ; "for words being defined")
|
||||
(USERFONT BOLDFONT)
|
||||
(* ; " for %"user%" defined words")))
|
||||
(* ; " for %"user%" defined words")))
|
||||
|
||||
(MOVD? 'NILL 'WINDOWTITLEFONT)
|
||||
(DEFINEQ
|
||||
@@ -591,8 +599,8 @@ Copyright (c) 1986, 1988, 1990, 1991, 1999 by Venue & Xerox Corporation. All ri
|
||||
|
||||
(SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
|
||||
1 FILERDTBL)
|
||||
(PUTPROPS FONTPROFILE COPYRIGHT ("Venue & Xerox Corporation" 1986 1988 1990 1991 1999))
|
||||
(PUTPROPS FONTPROFILE COPYRIGHT ("Venue & Xerox Corporation" 1986 1988 1990 1991 1999 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (16000 27584 (FONTSET 16010 . 22351) (FONTPROFILE 22353 . 24702) (FONTPROFILE.ADDDEVICE
|
||||
24704 . 27582)) (27820 29719 (FONTMAPARRAY 27830 . 29717)))))
|
||||
(FILEMAP (NIL (16323 27907 (FONTSET 16333 . 22674) (FONTPROFILE 22676 . 25025) (FONTPROFILE.ADDDEVICE
|
||||
25027 . 27905)) (28143 30042 (FONTMAPARRAY 28153 . 30040)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,608 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "12-Mar-93 11:02:28" {DSK}<project>medley2.0>patches>FONTPROFILEPATCH.;4 30621
|
||||
|
||||
changes to%: (ALISTS (FONTDEFS HUGE)
|
||||
(FONTDEFS BIG)
|
||||
(FONTDEFS MEDIUM)
|
||||
(FONTDEFS STANDARD)
|
||||
(FONTDEFS BIGGER)
|
||||
(FONTDEFS BIGGERNS)
|
||||
(FONTDEFS NS))
|
||||
|
||||
previous date%: "11-Mar-93 11:51:49" {DSK}<project>medley2.0>patches>FONTPROFILEPATCH.;3)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1993 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT FONTPROFILEPATCHCOMS)
|
||||
|
||||
(RPAQQ FONTPROFILEPATCHCOMS
|
||||
(
|
||||
(* ;; "FONT")
|
||||
|
||||
(ALISTS (FONTDEFS HUGE BIG MEDIUM STANDARD BIGGER BIGGERNS NS))
|
||||
(ADDVARS (CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu))
|
||||
[VARS (FONTVARS '(
|
||||
(* ;; "standard size fonts. Assumes only DEFAULTFONT set")
|
||||
|
||||
(BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD))
|
||||
(* ; "default BOLD")
|
||||
(ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC))
|
||||
(LITTLEFONT DEFAULTFONT)
|
||||
(* ; " should usually be smaller")
|
||||
(TINYFONT LITTLEFONT)
|
||||
(* ; "and this one smaller still")
|
||||
(BIGFONT BOLDFONT)
|
||||
(* ; "should be bigger still")
|
||||
(TEXTFONT DEFAULTFONT)
|
||||
(* ; "default for text")
|
||||
(TEXTBOLDFONT BOLDFONT)
|
||||
(* ; "default for bold text")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for window system, processes")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(MENUFONT DEFAULTFONT T)
|
||||
(BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD))
|
||||
(* ; "if not supplied")
|
||||
(INTERRUPTMENUFONT DEFAULTFONT T)
|
||||
(* ; "used by control-B")
|
||||
(DEFAULTICONFONT MENUFONT)
|
||||
(* ; "for shrinking windows")
|
||||
(BACKTRACEFONT TINYFONT T)
|
||||
(* ; " for backtrace in debugger")
|
||||
(WINDOWTITLEFONT MENUFONT)
|
||||
((WINDOWTITLEFONT WINDOWTITLEFONT)
|
||||
NIL)
|
||||
(* ; " used for titles of all windows")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for Exec")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(PROMPTFONT LITTLEFONT)
|
||||
(* ; "for printing out prompts")
|
||||
(INPUTFONT BOLDFONT)
|
||||
(* ; "for user typein in Exec")
|
||||
(PRINTOUTFONT DEFAULTFONT)
|
||||
(* ; " for intermediate typin in Exec")
|
||||
(TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT))
|
||||
(VALUEFONT DEFAULTFONT)
|
||||
(* ;
|
||||
" for printing out values returned in Exec")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for prettyprinting")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(COMMENTFONT LITTLEFONT)
|
||||
(* ; "for comments ")
|
||||
(PRETTYCOMFONT BOLDFONT)
|
||||
(* ; " for words being defined")
|
||||
(CLISPFONT BOLDFONT)
|
||||
(* ; " for keywords & CLISP")
|
||||
(SYSTEMFONT DEFAULTFONT)
|
||||
(* ; " for %"system%" words(?)")
|
||||
(LAMBDAFONT BIGFONT)
|
||||
(* ; "for words being defined")
|
||||
(USERFONT BOLDFONT)
|
||||
(* ; " for %"user%" defined words")]
|
||||
(P (MOVD? 'NILL 'WINDOWTITLEFONT))
|
||||
(FNS FONTSET FONTPROFILE FONTPROFILE.ADDDEVICE)
|
||||
(INITVARS (FONTESCAPECHAR (CHARACTER 6))
|
||||
(FONTFNS)
|
||||
(FONTWORDS))
|
||||
[DECLARE%: DONTEVAL@LOAD DOCOPY (P (FONTSET 'STANDARD]
|
||||
(GLOBALVARS FONTPROFILE FONTESCAPECHAR FONTDEFS)
|
||||
(FNS FONTMAPARRAY)
|
||||
(INITVARS (\FONTMAPCACHE))
|
||||
(P (SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
|
||||
1 FILERDTBL))))
|
||||
|
||||
|
||||
|
||||
(* ;; "FONT")
|
||||
|
||||
|
||||
(ADDTOVAR FONTDEFS
|
||||
[HUGE (FONTPROFILE (DEFAULTFONT 1 (MODERN 24)
|
||||
NIL
|
||||
(TERMINAL 8))
|
||||
(BOLDFONT 2 (MODERN 24 BRR)
|
||||
NIL
|
||||
(MODERN 8 BRR))
|
||||
(LITTLEFONT 3 (MODERN 18 MRR)
|
||||
NIL
|
||||
(MODERN 8 MIR))
|
||||
(BIGFONT 4 (MODERN 36 BRR)
|
||||
NIL
|
||||
(MODERN 10 BRR))
|
||||
(TEXTFONT 5 (CLASSIC 24)
|
||||
NIL
|
||||
(CLASSIC 10))
|
||||
(TEXTBOLDFONT 7 (CLASSIC 24 BRR)
|
||||
NIL
|
||||
(CLASSIC 10 BRR]
|
||||
[BIG (FONTPROFILE (DEFAULTFONT 1 (MODERN 18)
|
||||
NIL
|
||||
(TERMINAL 8))
|
||||
(TEXTFONT 5 (CLASSIC 18)
|
||||
NIL
|
||||
(CLASSIC 10))
|
||||
(BOLDFONT 2 (MODERN 18 BRR)
|
||||
NIL
|
||||
(MODERN 8 BRR))
|
||||
(LITTLEFONT 3 (MODERN 12 MRR)
|
||||
NIL
|
||||
(MODERN 8 MIR))
|
||||
(BIGFONT 4 (MODERN 24 BRR)
|
||||
NIL
|
||||
(MODERN 10 BRR))
|
||||
(TEXTBOLDFONT 7 (CLASSIC 18 BRR)
|
||||
NIL
|
||||
(CLASSIC 10 BRR]
|
||||
[MEDIUM (FONTPROFILE (DEFAULTFONT 1 (MODERN 14)
|
||||
NIL
|
||||
(TERMINAL 8))
|
||||
(BOLDFONT 2 (MODERN 14 BRR)
|
||||
NIL
|
||||
(MODERN 8 BRR))
|
||||
(LITTLEFONT 3 (MODERN 10)
|
||||
NIL
|
||||
(MODERN 8 MIR))
|
||||
(BIGFONT 4 (MODERN 18)
|
||||
NIL
|
||||
(MODERN 10 BRR))
|
||||
(TEXTFONT 5 (CLASSIC 14)
|
||||
NIL
|
||||
(CLASSIC 10))
|
||||
(TEXTBOLDFONT 7 (CLASSIC 14 BRR)
|
||||
NIL
|
||||
(CLASSIC 10 BRR]
|
||||
[STANDARD (FONTCHANGEFLG . ALL)
|
||||
(FILELINELENGTH . 102)
|
||||
(FONTPROFILE (DEFAULTFONT 1 (GACHA 10)
|
||||
(GACHA 8)
|
||||
(TERMINAL 8))
|
||||
(ITALICFONT 1 (HELVETICA 10 MIR)
|
||||
(GACHA 8 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(BOLDFONT 2 (HELVETICA 10 BRR)
|
||||
(HELVETICA 8 BRR)
|
||||
(MODERN 8 BRR))
|
||||
(LITTLEFONT 3 (HELVETICA 8)
|
||||
(HELVETICA 6 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(TINYFONT 6 (GACHA 8)
|
||||
(GACHA 6)
|
||||
(TERMINAL 6))
|
||||
(BIGFONT 4 (HELVETICA 12 BRR)
|
||||
NIL
|
||||
(MODERN 10 BRR))
|
||||
(MENUFONT 5 (HELVETICA 10))
|
||||
(COMMENTFONT 6 (HELVETICA 10)
|
||||
(HELVETICA 8)
|
||||
(MODERN 8))
|
||||
(TEXTFONT 7 (TIMESROMAN 10)
|
||||
NIL
|
||||
(CLASSIC 10]
|
||||
[BIGGER (FONTPROFILE (DEFAULTFONT 1 (GACHA 12)
|
||||
NIL
|
||||
(TERMINAL 8))
|
||||
(ITALICFONT 1 (HELVETICA 12 MIR)
|
||||
(GACHA 8 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(BOLDFONT 2 (HELVETICA 12 BRR)
|
||||
(HELVETICA 8 BRR)
|
||||
(MODERN 8 BRR))
|
||||
(LITTLEFONT 3 (HELVETICA 10)
|
||||
(HELVETICA 6 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(TINYFONT 6 (GACHA 10)
|
||||
(GACHA 6)
|
||||
(TERMINAL 6))
|
||||
(BIGFONT 4 (HELVETICA 14 BRR)
|
||||
NIL
|
||||
(MODERN 10 BRR))
|
||||
(MENUFONT 5 (HELVETICA 12))
|
||||
(COMMENTFONT 6 (HELVETICA 12)
|
||||
(HELVETICA 8)
|
||||
(MODERN 8))
|
||||
(TEXTFONT 7 (TIMESROMAN 12)
|
||||
NIL
|
||||
(CLASSIC 10]
|
||||
[BIGGERNS (FONTCHANGEFLG . ALL)
|
||||
(FILELINELENGTH . 102)
|
||||
(COMMENTLINELENGTH 116 . 126)
|
||||
(FIRSTCOL . 60)
|
||||
(PRETTYLCOM . 25)
|
||||
(FONTESCAPECHAR . %)
|
||||
(FONTPROFILE (DEFAULTFONT 1 (TERMINAL 12)
|
||||
(TERMINAL 8)
|
||||
(TERMINAL 8))
|
||||
(ITALICFONT 1 (MODERN 12 BIR)
|
||||
(MODERN 8 BIR)
|
||||
(MODERN 8 BIR))
|
||||
(BOLDFONT 2 (MODERN 12 BRR)
|
||||
(MODERN 8 BRR)
|
||||
(MODERN 8 BRR))
|
||||
(LITTLEFONT 3 (MODERN 10)
|
||||
(MODERN 6 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(BIGFONT 4 (MODERN 14 BRR)
|
||||
(MODERN 10 BRR)
|
||||
(MODERN 10 BRR]
|
||||
[NS (FONTCHANGEFLG . ALL)
|
||||
(FILELINELENGTH . 102)
|
||||
(COMMENTLINELENGTH 116 . 126)
|
||||
(FIRSTCOL . 60)
|
||||
(PRETTYLCOM . 25)
|
||||
(FONTESCAPECHAR . %)
|
||||
(FONTPROFILE (DEFAULTFONT 1 (TERMINAL 10)
|
||||
(TERMINAL 8)
|
||||
(TERMINAL 8))
|
||||
(ITALICFONT 1 (MODERN 10 BIR)
|
||||
(MODERN 8 BIR)
|
||||
(MODERN 8 BIR))
|
||||
(BOLDFONT 2 (MODERN 10 BRR)
|
||||
(MODERN 8 BRR)
|
||||
(MODERN 8 BRR))
|
||||
(LITTLEFONT 3 (MODERN 8)
|
||||
(MODERN 6 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(BIGFONT 4 (MODERN 12 BRR)
|
||||
(MODERN 10 BRR)
|
||||
(MODERN 10 BRR])
|
||||
|
||||
(ADDTOVAR CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu)
|
||||
|
||||
(RPAQQ FONTVARS
|
||||
(
|
||||
(* ;; "standard size fonts. Assumes only DEFAULTFONT set")
|
||||
|
||||
(BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD))
|
||||
(* ; "default BOLD")
|
||||
(ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC))
|
||||
(LITTLEFONT DEFAULTFONT)
|
||||
(* ; " should usually be smaller")
|
||||
(TINYFONT LITTLEFONT)
|
||||
(* ; "and this one smaller still")
|
||||
(BIGFONT BOLDFONT)
|
||||
(* ; "should be bigger still")
|
||||
(TEXTFONT DEFAULTFONT)
|
||||
(* ; "default for text")
|
||||
(TEXTBOLDFONT BOLDFONT)
|
||||
(* ; "default for bold text")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for window system, processes")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(MENUFONT DEFAULTFONT T)
|
||||
(BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD))
|
||||
(* ; "if not supplied")
|
||||
(INTERRUPTMENUFONT DEFAULTFONT T)
|
||||
(* ; "used by control-B")
|
||||
(DEFAULTICONFONT MENUFONT)
|
||||
(* ; "for shrinking windows")
|
||||
(BACKTRACEFONT TINYFONT T)
|
||||
(* ; " for backtrace in debugger")
|
||||
(WINDOWTITLEFONT MENUFONT)
|
||||
((WINDOWTITLEFONT WINDOWTITLEFONT)
|
||||
NIL)
|
||||
(* ; " used for titles of all windows")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for Exec")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(PROMPTFONT LITTLEFONT)
|
||||
(* ; "for printing out prompts")
|
||||
(INPUTFONT BOLDFONT)
|
||||
(* ; "for user typein in Exec")
|
||||
(PRINTOUTFONT DEFAULTFONT)
|
||||
(* ; " for intermediate typin in Exec")
|
||||
(TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT))
|
||||
(VALUEFONT DEFAULTFONT)
|
||||
(* ;
|
||||
" for printing out values returned in Exec")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for prettyprinting")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(COMMENTFONT LITTLEFONT)
|
||||
(* ; "for comments ")
|
||||
(PRETTYCOMFONT BOLDFONT)
|
||||
(* ; " for words being defined")
|
||||
(CLISPFONT BOLDFONT)
|
||||
(* ; " for keywords & CLISP")
|
||||
(SYSTEMFONT DEFAULTFONT)
|
||||
(* ; " for %"system%" words(?)")
|
||||
(LAMBDAFONT BIGFONT)
|
||||
(* ; "for words being defined")
|
||||
(USERFONT BOLDFONT)
|
||||
(* ; " for %"user%" defined words")))
|
||||
|
||||
(MOVD? 'NILL 'WINDOWTITLEFONT)
|
||||
(DEFINEQ
|
||||
|
||||
(FONTSET
|
||||
[LAMBDA (NAME CHANGE-WINDOWS?) (* ; "Edited 23-Jun-88 10:46 by jds")
|
||||
(COND
|
||||
[NAME
|
||||
(LET
|
||||
[(TEM (FASSOC NAME FONTDEFS))
|
||||
(OLDDEFAULT (FONTCREATE DEFAULTFONT NIL NIL NIL 'DISPLAY]
|
||||
(OR TEM (ERROR NAME "not a defined font configuration"))
|
||||
|
||||
(* ;; "Looks up NAME on FONTSLST and sets apropriate parameters. entries are added to fontslst by FONTNAME.")
|
||||
|
||||
(for X in FONTVARS when (AND (CL:SYMBOLP (CAR X))
|
||||
(NEQ (CAR X)
|
||||
'*)
|
||||
(NEQ (CAR X)
|
||||
(CADR X))) do (SETTOPVAL (CAR X)))
|
||||
[MAPC (CDR TEM)
|
||||
(FUNCTION (LAMBDA (X)
|
||||
(/SETTOPVAL (CAR X)
|
||||
(CDR X]
|
||||
[PROG (BASICCLASSES)
|
||||
(for X in FONTPROFILE
|
||||
do (PROG (SEEN (NAME (CAR X))
|
||||
(FONTS X))
|
||||
LP [COND
|
||||
((MEMB (CAR FONTS)
|
||||
SEEN)
|
||||
(ERROR "Circular font profile specification" X))
|
||||
(T (push SEEN (CAR FONTS]
|
||||
[SETQ FONTS (CDR (COND
|
||||
((OR (NULL (CADR FONTS))
|
||||
(LISTP (CADR FONTS)))
|
||||
(*)
|
||||
(* ;
|
||||
"This skips over the now-defunct NIL or list-of-escape sequence")
|
||||
(CDR FONTS))
|
||||
(T FONTS]
|
||||
(COND
|
||||
((OR (NLISTP FONTS)
|
||||
(LITATOM (CAR FONTS)))(* ;
|
||||
"Indirect thru another's font spec")
|
||||
(AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS))
|
||||
((NIL DEFAULTFONT)
|
||||
(* ;
|
||||
"Don't let DEFAULTFONT loop thru itself")
|
||||
(AND (NOT (MEMB 'DEFAULTFONT SEEN
|
||||
))
|
||||
'DEFAULTFONT))
|
||||
(CAR FONTS))
|
||||
FONTPROFILE))
|
||||
(GO LP)))
|
||||
(T [push BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS
|
||||
'DISPLAY]
|
||||
(* ;
|
||||
"Now we have a font class datastructure")
|
||||
))
|
||||
(AND NAME (/SETTOPVAL NAME FONTS))
|
||||
|
||||
(* ;; "NIL for the class-name means just establish the font-correspondences but don't connect them up with a pretty class name.")
|
||||
|
||||
))
|
||||
(AND BASICCLASSES (FONTMAPARRAY BASICCLASSES 'DISPLAY]
|
||||
[for X in FONTVARS when (NEQ (CAR X)
|
||||
'*)
|
||||
do (COND
|
||||
((LISTP (CAR X))
|
||||
(EVAL (CAR X)))
|
||||
[(CADDR X)
|
||||
(SET (CAR X)
|
||||
(FONTCREATE (OR (GETTOPVAL (CAR X))
|
||||
(EVAL (CADR X))
|
||||
DEFAULTFONT)
|
||||
NIL NIL NIL 'DISPLAY]
|
||||
(T (OR (GETTOPVAL (CAR X))
|
||||
(AND (CADR X)
|
||||
(SET (CAR X)
|
||||
(EVAL (CADR X]
|
||||
(CL:WHEN CHANGE-WINDOWS?
|
||||
(CL:WHEN (NEQ OLDDEFAULT (FONTCREATE DEFAULTFONT NIL NIL NIL 'DISPLAY))
|
||||
(for X in (OPENWINDOWS) when (EQ OLDDEFAULT (DSPFONT NIL X))
|
||||
do (DSPFONT DEFAULTFONT X)))
|
||||
(DSPFONT WINDOWTITLEFONT WindowTitleDisplayStream)
|
||||
(SETQ MaxValueLeftMargin (ITIMES 35 (STRINGWIDTH 'A DEFAULTFONT)))
|
||||
(MAPC CACHEDMENUS 'SET)
|
||||
[for W in (OPENWINDOWS) do [COND
|
||||
[(OR (EQ (WINDOWPROP W 'RESHAPEFN)
|
||||
'DONT)
|
||||
(WINDOWPROP W 'MAINWINDOW]
|
||||
(T
|
||||
(* ;;
|
||||
"don't reshape if can't or if this window is attached to another.")
|
||||
|
||||
(SHAPEW W (WINDOWREGION W]
|
||||
(COND
|
||||
((AND (NEQ (WINDOWPROP W 'WINDOWENTRYFN)
|
||||
(FUNCTION \TEDIT.PROCIDLEFN))
|
||||
(WINDOWPROP W 'REPAINTFN))
|
||||
(REDISPLAYW W])
|
||||
|
||||
(* ;; "Set the new font profile name, and return the old one, so he can restore later.")
|
||||
|
||||
(PROG1 FONTNAME (SETQ FONTNAME NAME]
|
||||
(T (* ;
|
||||
"He passed in NIL, so return font profile name in effect.")
|
||||
FONTNAME])
|
||||
|
||||
(FONTPROFILE
|
||||
[LAMBDA (PROFILE) (* lmm "10-Sep-86 12:33")
|
||||
[PROG (BASICCLASSES)
|
||||
(for X in PROFILE
|
||||
do (PROG (SEEN (NAME (CAR X))
|
||||
(FONTS X))
|
||||
LP [COND
|
||||
((MEMB (CAR FONTS)
|
||||
SEEN)
|
||||
(ERROR "Circular font profile specification" X))
|
||||
(T (push SEEN (CAR FONTS]
|
||||
[SETQ FONTS (CDR (COND
|
||||
((OR (NULL (CADR FONTS))
|
||||
(LISTP (CADR FONTS)))
|
||||
(* ;
|
||||
"This skips over the now-defunct NIL or list-of-escape sequence")
|
||||
(CDR FONTS))
|
||||
(T FONTS]
|
||||
(COND
|
||||
((OR (NLISTP FONTS)
|
||||
(LITATOM (CAR FONTS))) (* Indirect thru another's font spec)
|
||||
(AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS))
|
||||
((NIL DEFAULTFONT)
|
||||
(* Don't let DEFAULTFONT loop thru
|
||||
itself)
|
||||
(AND (NOT (MEMB 'DEFAULTFONT SEEN))
|
||||
'DEFAULTFONT))
|
||||
(CAR FONTS))
|
||||
PROFILE))
|
||||
(GO LP)))
|
||||
(T [push BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS 'DISPLAY]
|
||||
(* Now we have a font class
|
||||
datastructure)
|
||||
))
|
||||
(AND NAME (/SETATOMVAL NAME FONTS))
|
||||
|
||||
(* NIL for the class-name means just establish the font-correspondences but
|
||||
don't connect them up with a pretty class name.)
|
||||
|
||||
))
|
||||
(AND BASICCLASSES (FONTMAPARRAY BASICCLASSES 'DISPLAY]
|
||||
T])
|
||||
|
||||
(FONTPROFILE.ADDDEVICE
|
||||
[LAMBDA (NEWDEVICE OLDDEVICE) (* ; "Edited 3-Mar-93 14:46 by rmk:")
|
||||
|
||||
(* ;; "Fills in all fontprofile specifications so that an entry for NEWDEVICE is present for each fontclass. Nothing is changed if the entry is already there, otherwise the specification for the class currently provided for OLDDEVICE will be used for NEWDEVICE.")
|
||||
|
||||
(DECLARE (USEDFREE FONTDEFS FONTNAME))
|
||||
(SETQ NEWDEVICE (U-CASE NEWDEVICE))
|
||||
(SETQ OLDDEVICE (U-CASE OLDDEVICE))
|
||||
[FOR FD IN FONTDEFS
|
||||
DO (FOR FC OLDSPEC IN (CDR (ASSOC 'FONTPROFILE (CDR FD)))
|
||||
UNLESS (LITATOM (CADR FC))
|
||||
DO (SETQ FC (CDR FC)) (* ; "Skip over name")
|
||||
(CL:WHEN [SETQ OLDSPEC (SELECTQ OLDDEVICE
|
||||
(DISPLAY (CADR FC))
|
||||
(INTERPRESS (CADDDR FC))
|
||||
(PRESS (CADDR FC))
|
||||
(CADR (ASSOC OLDDEVICE (CDDDDR FC]
|
||||
[SETQ FC (OR (CDR FC)
|
||||
(CDR (RPLACD FC (CONS]
|
||||
(* ;
|
||||
"Fill in NIL's for missing DISPLAY, PRESS, or INTERPRESS")
|
||||
[SELECTQ NEWDEVICE
|
||||
(DISPLAY (OR (CAR FC)
|
||||
(RPLACA FC OLDSPEC)))
|
||||
(INTERPRESS (OR (CADDR FC)
|
||||
(RPLACA [PROGN [SETQ FC (OR (CDR FC)
|
||||
(CDR (RPLACD FC (CONS]
|
||||
(OR (CDR FC)
|
||||
(CDR (RPLACD FC (CONS]
|
||||
OLDSPEC)))
|
||||
(PRESS (OR (CADDR FC)
|
||||
(RPLACA [OR (CDR FC)
|
||||
(CDR (RPLACD FC (CONS]
|
||||
OLDSPEC)))
|
||||
(OR (CADR (ASSOC NEWDEVICE (CDDDR FC)))
|
||||
(PROGN (PROGN [SETQ FC (OR (CDR FC)
|
||||
(CDR (RPLACD FC (CONS]
|
||||
[SETQ FC (OR (CDR FC)
|
||||
(CDR (RPLACD FC (CONS]
|
||||
(PUSH (CDR FC)
|
||||
(LIST NEWDEVICE OLDSPEC])]
|
||||
(FONTSET FONTNAME])
|
||||
)
|
||||
|
||||
(RPAQ? FONTESCAPECHAR (CHARACTER 6))
|
||||
|
||||
(RPAQ? FONTFNS )
|
||||
|
||||
(RPAQ? FONTWORDS )
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(FONTSET 'STANDARD)
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS FONTPROFILE FONTESCAPECHAR FONTDEFS)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(FONTMAPARRAY
|
||||
[LAMBDA (FONTCLASSES) (* lmm "28-Sep-86 14:23")
|
||||
|
||||
(* ;; "Makes a font array from a font-mapping list of fontclasses. The array provides a fast map from font# to font classes/descriptors. This function caches the last array. If IMAGETYPES is given, then the FD's are pre-computed for the imagetypes it. Otherwise, the first use of the fontclass for that imagetype would cause the fontcreate to be done.")
|
||||
|
||||
(PROG (FA (MAXFONT 0)
|
||||
(MINFONT 100))
|
||||
[COND
|
||||
((NULL \FONTMAPCACHE))
|
||||
((OR (NULL FONTCLASSES)
|
||||
(EQUAL FONTCLASSES (CAR \FONTMAPCACHE)))
|
||||
(RETURN (CDR \FONTMAPCACHE]
|
||||
[for F PRETTYFONT# in FONTCLASSES do (SETQ PRETTYFONT# (fetch (FONTCLASS
|
||||
PRETTYFONT#)
|
||||
of F))
|
||||
(COND
|
||||
((IGREATERP PRETTYFONT# MAXFONT)
|
||||
(SETQ MAXFONT PRETTYFONT#)))
|
||||
(COND
|
||||
((ILESSP PRETTYFONT# 1)
|
||||
(ERROR "Invalid font number"
|
||||
PRETTYFONT# F))
|
||||
((ILESSP PRETTYFONT# MINFONT)
|
||||
(SETQ MINFONT PRETTYFONT#]
|
||||
(SETQ FA (ARRAY MAXFONT))
|
||||
(for F in FONTCLASSES do (SETA FA (fetch (FONTCLASS PRETTYFONT#)
|
||||
of F)
|
||||
F))
|
||||
(for I from 1 to MAXFONT unless (ELT FA I)
|
||||
do (SETA FA I (ELT FA MINFONT)))
|
||||
(SETQ \FONTMAPCACHE (CONS (COPY FONTCLASSES)
|
||||
FA))
|
||||
(RETURN FA])
|
||||
)
|
||||
|
||||
(RPAQ? \FONTMAPCACHE )
|
||||
|
||||
(SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
|
||||
1 FILERDTBL)
|
||||
(PUTPROPS FONTPROFILEPATCH COPYRIGHT ("Xerox Corporation" 1993))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (16158 27897 (FONTSET 16168 . 22509) (FONTPROFILE 22511 . 25015) (FONTPROFILE.ADDDEVICE
|
||||
25017 . 27895)) (28133 30403 (FONTMAPARRAY 28143 . 30401)))))
|
||||
STOP
|
||||
Binary file not shown.
119
sources/HARDCOPY
119
sources/HARDCOPY
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 5-May-2021 19:41:55"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley2>sources>HARDCOPY.;9 103663
|
||||
(FILECREATED "20-Sep-2021 10:59:58"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HARDCOPY.;2 103730
|
||||
|
||||
changes to%: (FNS COPY.TEXT.TO.IMAGE)
|
||||
changes to%: (VARS HARDCOPYCOMS)
|
||||
|
||||
previous date%: "16-Apr-2018 22:15:08"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley2>sources>HARDCOPY.;8)
|
||||
previous date%: " 5-May-2021 19:41:55"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HARDCOPY.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -15,46 +15,47 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(PRETTYCOMPRINT HARDCOPYCOMS)
|
||||
|
||||
(RPAQQ HARDCOPYCOMS
|
||||
[(COMS (* ; "exported functionality")
|
||||
[(COMS (* ; "exported functionality")
|
||||
(FNS HARDCOPY.SOMEHOW HARDCOPYIMAGEW HARDCOPYIMAGEW.TOFILE HARDCOPYIMAGEW.TOPRINTER
|
||||
HARDCOPYREGION.TOFILE HARDCOPYREGION.TOPRINTER COPY.WINDOW.TO.BITMAP)
|
||||
(* ; "user interface jazz")
|
||||
(* ; "user interface jazz")
|
||||
(INITVARS (ChangeDefaultPrinter))
|
||||
(FNS MakeMenuOfPrinters PRINTERS.WHENSELECTEDFN MakeMenuOfImageTypes
|
||||
GetNewPrinterFromUser PopUpWindowAndGetAtom PopUpWindowAndGetList NewPrinter
|
||||
GetPrinterName GetImageFile FetchDefaultPrinter)
|
||||
(* ; "filename diddlers")
|
||||
(* ; "filename diddlers")
|
||||
(FNS ExtensionForPrintFileType PRINTFILETYPE.FROM.EXTENSION))
|
||||
(COMS (* ;
|
||||
"Interface for PRINTERS and IMAGEFILES")
|
||||
(COMS (* ;
|
||||
"Interface for PRINTERS and IMAGEFILES")
|
||||
(FNS DEFAULTPRINTER CAN.PRINT.DIRECTLY CONVERT.FILE.TO.TYPE.FOR.PRINTER EMPRESS
|
||||
HARDCOPYW LISTFILES1 PRINTER.BITMAPFILE PRINTER.BITMAPSCALE PRINTER.SCRATCH.FILE
|
||||
PRINTERPROP PRINTERSTATUS PRINTERTYPE PRINTERNAME PRINTFILEPROP PRINTFILETYPE
|
||||
\EXPECTED.FILE.TYPE SEND.FILE.TO.PRINTER)
|
||||
(FNS PRINTERDEVICE)
|
||||
[DECLARE%: DONTEVAL@LOAD DOCOPY (P (PRINTERDEVICE 'LPT]
|
||||
(P (* ; "for backward compatibility")
|
||||
(P (* ; "for backward compatibility")
|
||||
(MOVD? 'NILL 'PRINTERMODE))
|
||||
(INITVARS (DEFAULTPRINTINGHOST)
|
||||
(DEFAULTPRINTERTYPE 'INTERPRESS)
|
||||
(EMPRESS.SCRATCH)
|
||||
(EMPRESS#SIDES T))
|
||||
(EMPRESS#SIDES T)
|
||||
(PRINTFILETYPES NIL))
|
||||
(GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES
|
||||
PRINTFILETYPES))
|
||||
(COMS (* ;
|
||||
"Converting text files to imagestreams")
|
||||
(COMS (* ;
|
||||
"Converting text files to imagestreams")
|
||||
(INITVARS (TEXTDEFAULTTABS (LIST 20320))
|
||||
(TEXTDEFAULTPAGEREGION (CREATEREGION 2794 1905 18415 24765)))
|
||||
(* ;
|
||||
"TEXTDEFAULTTABS Hack, mica equivalent of 8 inches")
|
||||
(* ;
|
||||
"TEXTDEFAULTTABS Hack, mica equivalent of 8 inches")
|
||||
(GLOBALVARS TEXTDEFAULTTABS TEXTDEFAULTPAGEREGION)
|
||||
(FNS TEXTTOIMAGEFILE COPY.TEXT.TO.IMAGE))
|
||||
(COMS (FNS \BLTSHADE.GENERICPRINTER)
|
||||
(* ;
|
||||
"hack for printers that can't really BLTSHADE")
|
||||
(* ;
|
||||
"hack for printers that can't really BLTSHADE")
|
||||
)
|
||||
[COMS (* ;
|
||||
"stuff to support hardcopy streams on the display.")
|
||||
[COMS (* ;
|
||||
"stuff to support hardcopy streams on the display.")
|
||||
(FNS MAKEHARDCOPYSTREAM UNMAKEHARDCOPYSTREAM HARDCOPYSTREAMTYPE \CHARWIDTH.HDCPYDISPLAY
|
||||
\DSPFONT.HDCPYDISPLAY \DSPRIGHTMARGIN.HDCPYDISPLAY \DSPXPOSITION.HDCPYDISPLAY
|
||||
\DSPYPOSITION.HDCPYDISPLAY \STRINGWIDTH.HDCPYDISPLAY \STRINGWIDTH.HCPYDISPLAYAUX
|
||||
@@ -65,8 +66,8 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(IMICASPERPT 35]
|
||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (FUNCTIONS \MICASTOPTS)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\HDCPYDISPLAYINIT]
|
||||
[COMS (* ;
|
||||
"Stuff to support MICA-unit hardcopy streams on the display")
|
||||
[COMS (* ;
|
||||
"Stuff to support MICA-unit hardcopy streams on the display")
|
||||
(FNS MAKEHARDCOPYMODESTREAM UNMAKEHARDCOPYMODESTREAM \BLTSHADE.HCPYMODE
|
||||
\BITBLT.HCPYMODE \BRUSHCONVERT.HCPYMODE \CHANGECHARSET.HCPYMODE
|
||||
\DASHINGCONVERT.HCPYMODE \CHARWIDTH.HCPYMODE \DRAWLINE.HCPYMODE
|
||||
@@ -649,7 +650,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(PRINTERDEVICE 'LPT)
|
||||
)
|
||||
|
||||
(* ; "for backward compatibility")
|
||||
(* ; "for backward compatibility")
|
||||
|
||||
(MOVD? 'NILL 'PRINTERMODE)
|
||||
|
||||
@@ -660,6 +661,8 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(RPAQ? EMPRESS.SCRATCH )
|
||||
|
||||
(RPAQ? EMPRESS#SIDES T)
|
||||
|
||||
(RPAQ? PRINTFILETYPES NIL)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES PRINTFILETYPES)
|
||||
@@ -1085,39 +1088,39 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(PUTPROPS HARDCOPY COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1992
|
||||
1993 1999 2018 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6141 10325 (HARDCOPY.SOMEHOW 6151 . 7509) (HARDCOPYIMAGEW 7511 . 7663) (
|
||||
HARDCOPYIMAGEW.TOFILE 7665 . 7973) (HARDCOPYIMAGEW.TOPRINTER 7975 . 8640) (HARDCOPYREGION.TOFILE 8642
|
||||
. 8940) (HARDCOPYREGION.TOPRINTER 8942 . 9564) (COPY.WINDOW.TO.BITMAP 9566 . 10323)) (10397 20947 (
|
||||
MakeMenuOfPrinters 10407 . 11632) (PRINTERS.WHENSELECTEDFN 11634 . 13376) (MakeMenuOfImageTypes 13378
|
||||
. 13896) (GetNewPrinterFromUser 13898 . 14326) (PopUpWindowAndGetAtom 14328 . 15713) (
|
||||
PopUpWindowAndGetList 15715 . 17281) (NewPrinter 17283 . 18231) (GetPrinterName 18233 . 18513) (
|
||||
GetImageFile 18515 . 20802) (FetchDefaultPrinter 20804 . 20945)) (20982 21520 (
|
||||
ExtensionForPrintFileType 20992 . 21185) (PRINTFILETYPE.FROM.EXTENSION 21187 . 21518)) (21575 37959 (
|
||||
DEFAULTPRINTER 21585 . 21745) (CAN.PRINT.DIRECTLY 21747 . 21903) (CONVERT.FILE.TO.TYPE.FOR.PRINTER
|
||||
21905 . 22949) (EMPRESS 22951 . 23264) (HARDCOPYW 23266 . 26226) (LISTFILES1 26228 . 26401) (
|
||||
PRINTER.BITMAPFILE 26403 . 26650) (PRINTER.BITMAPSCALE 26652 . 26917) (PRINTER.SCRATCH.FILE 26919 .
|
||||
27042) (PRINTERPROP 27044 . 27227) (PRINTERSTATUS 27229 . 27418) (PRINTERTYPE 27420 . 29729) (
|
||||
PRINTERNAME 29731 . 30033) (PRINTFILEPROP 30035 . 30226) (PRINTFILETYPE 30228 . 32172) (
|
||||
\EXPECTED.FILE.TYPE 32174 . 32956) (SEND.FILE.TO.PRINTER 32958 . 37957)) (37960 42942 (PRINTERDEVICE
|
||||
37970 . 42940)) (43725 51926 (TEXTTOIMAGEFILE 43735 . 45925) (COPY.TEXT.TO.IMAGE 45927 . 51924)) (
|
||||
51927 53062 (\BLTSHADE.GENERICPRINTER 51937 . 53060)) (53190 71942 (MAKEHARDCOPYSTREAM 53200 . 54204)
|
||||
(UNMAKEHARDCOPYSTREAM 54206 . 54890) (HARDCOPYSTREAMTYPE 54892 . 55171) (\CHARWIDTH.HDCPYDISPLAY 55173
|
||||
. 55604) (\DSPFONT.HDCPYDISPLAY 55606 . 57011) (\DSPRIGHTMARGIN.HDCPYDISPLAY 57013 . 57590) (
|
||||
\DSPXPOSITION.HDCPYDISPLAY 57592 . 57853) (\DSPYPOSITION.HDCPYDISPLAY 57855 . 58116) (
|
||||
\STRINGWIDTH.HDCPYDISPLAY 58118 . 58625) (\STRINGWIDTH.HCPYDISPLAYAUX 58627 . 60959) (\HDCPYBLTCHAR
|
||||
60961 . 63496) (\HDCPYDISPLAY.FIX.XPOS 63498 . 63918) (\HDCPYDISPLAY.FIX.YPOS 63920 . 64340) (
|
||||
\HDCPYDISPLAYINIT 64342 . 65119) (\HDCPYDSPPRINTCHAR 65121 . 67281) (\SLOWHDCPYBLTCHAR 67283 . 70786)
|
||||
(\CHANGECHARSET.HDCPYDISPLAY 70788 . 71940)) (72664 102961 (MAKEHARDCOPYMODESTREAM 72674 . 74583) (
|
||||
UNMAKEHARDCOPYMODESTREAM 74585 . 75663) (\BLTSHADE.HCPYMODE 75665 . 76112) (\BITBLT.HCPYMODE 76114 .
|
||||
76736) (\BRUSHCONVERT.HCPYMODE 76738 . 76975) (\CHANGECHARSET.HCPYMODE 76977 . 78744) (
|
||||
\DASHINGCONVERT.HCPYMODE 78746 . 79009) (\CHARWIDTH.HCPYMODE 79011 . 79298) (\DRAWLINE.HCPYMODE 79300
|
||||
. 79612) (\DRAWCURVE.HCPYMODE 79614 . 80043) (\DRAWCIRCLE.HCPYMODE 80045 . 80440) (
|
||||
\DRAWELLIPSE.HCPYMODE 80442 . 80954) (\DSPFONT.HCPYMODE 80956 . 82112) (\DSPLEFTMARGIN.HCPYMODE 82114
|
||||
. 82698) (\DSPLINEFEED.HCPYMODE 82700 . 83110) (\DSPRIGHTMARGIN.HCPYMODE 83112 . 83741) (
|
||||
\DSPSPACEFACTOR.HCPYMODE 83743 . 84264) (\DSPXPOSITION.HCPYMODE 84266 . 84847) (\DSPYPOSITION.HCPYMODE
|
||||
84849 . 85254) (\MOVETO.HCPYMODE 85256 . 85408) (\FONTCREATE.HCPYMODE.PRESS 85410 . 86422) (
|
||||
\CREATECHARSET.HCPYMODE.PRESS 86424 . 87395) (\FONTCREATE.HCPYMODE.INTERPRESS 87397 . 88431) (
|
||||
\CREATECHARSET.HCPYMODE.INTERPRESS 88433 . 89421) (\STRINGWIDTH.HCPYMODE 89423 . 89857) (
|
||||
\HCPYMODEBLTCHAR 89859 . 92828) (\HCPYMODEDISPLAYINIT 92830 . 95761) (\HCPYMODEDSPPRINTCHAR 95763 .
|
||||
97944) (\SLOWHCPYMODEBLTCHAR 97946 . 101460) (\SFFixY.HCPYMODE 101462 . 102959)))))
|
||||
(FILEMAP (NIL (6176 10360 (HARDCOPY.SOMEHOW 6186 . 7544) (HARDCOPYIMAGEW 7546 . 7698) (
|
||||
HARDCOPYIMAGEW.TOFILE 7700 . 8008) (HARDCOPYIMAGEW.TOPRINTER 8010 . 8675) (HARDCOPYREGION.TOFILE 8677
|
||||
. 8975) (HARDCOPYREGION.TOPRINTER 8977 . 9599) (COPY.WINDOW.TO.BITMAP 9601 . 10358)) (10432 20982 (
|
||||
MakeMenuOfPrinters 10442 . 11667) (PRINTERS.WHENSELECTEDFN 11669 . 13411) (MakeMenuOfImageTypes 13413
|
||||
. 13931) (GetNewPrinterFromUser 13933 . 14361) (PopUpWindowAndGetAtom 14363 . 15748) (
|
||||
PopUpWindowAndGetList 15750 . 17316) (NewPrinter 17318 . 18266) (GetPrinterName 18268 . 18548) (
|
||||
GetImageFile 18550 . 20837) (FetchDefaultPrinter 20839 . 20980)) (21017 21555 (
|
||||
ExtensionForPrintFileType 21027 . 21220) (PRINTFILETYPE.FROM.EXTENSION 21222 . 21553)) (21610 37994 (
|
||||
DEFAULTPRINTER 21620 . 21780) (CAN.PRINT.DIRECTLY 21782 . 21938) (CONVERT.FILE.TO.TYPE.FOR.PRINTER
|
||||
21940 . 22984) (EMPRESS 22986 . 23299) (HARDCOPYW 23301 . 26261) (LISTFILES1 26263 . 26436) (
|
||||
PRINTER.BITMAPFILE 26438 . 26685) (PRINTER.BITMAPSCALE 26687 . 26952) (PRINTER.SCRATCH.FILE 26954 .
|
||||
27077) (PRINTERPROP 27079 . 27262) (PRINTERSTATUS 27264 . 27453) (PRINTERTYPE 27455 . 29764) (
|
||||
PRINTERNAME 29766 . 30068) (PRINTFILEPROP 30070 . 30261) (PRINTFILETYPE 30263 . 32207) (
|
||||
\EXPECTED.FILE.TYPE 32209 . 32991) (SEND.FILE.TO.PRINTER 32993 . 37992)) (37995 42977 (PRINTERDEVICE
|
||||
38005 . 42975)) (43792 51993 (TEXTTOIMAGEFILE 43802 . 45992) (COPY.TEXT.TO.IMAGE 45994 . 51991)) (
|
||||
51994 53129 (\BLTSHADE.GENERICPRINTER 52004 . 53127)) (53257 72009 (MAKEHARDCOPYSTREAM 53267 . 54271)
|
||||
(UNMAKEHARDCOPYSTREAM 54273 . 54957) (HARDCOPYSTREAMTYPE 54959 . 55238) (\CHARWIDTH.HDCPYDISPLAY 55240
|
||||
. 55671) (\DSPFONT.HDCPYDISPLAY 55673 . 57078) (\DSPRIGHTMARGIN.HDCPYDISPLAY 57080 . 57657) (
|
||||
\DSPXPOSITION.HDCPYDISPLAY 57659 . 57920) (\DSPYPOSITION.HDCPYDISPLAY 57922 . 58183) (
|
||||
\STRINGWIDTH.HDCPYDISPLAY 58185 . 58692) (\STRINGWIDTH.HCPYDISPLAYAUX 58694 . 61026) (\HDCPYBLTCHAR
|
||||
61028 . 63563) (\HDCPYDISPLAY.FIX.XPOS 63565 . 63985) (\HDCPYDISPLAY.FIX.YPOS 63987 . 64407) (
|
||||
\HDCPYDISPLAYINIT 64409 . 65186) (\HDCPYDSPPRINTCHAR 65188 . 67348) (\SLOWHDCPYBLTCHAR 67350 . 70853)
|
||||
(\CHANGECHARSET.HDCPYDISPLAY 70855 . 72007)) (72731 103028 (MAKEHARDCOPYMODESTREAM 72741 . 74650) (
|
||||
UNMAKEHARDCOPYMODESTREAM 74652 . 75730) (\BLTSHADE.HCPYMODE 75732 . 76179) (\BITBLT.HCPYMODE 76181 .
|
||||
76803) (\BRUSHCONVERT.HCPYMODE 76805 . 77042) (\CHANGECHARSET.HCPYMODE 77044 . 78811) (
|
||||
\DASHINGCONVERT.HCPYMODE 78813 . 79076) (\CHARWIDTH.HCPYMODE 79078 . 79365) (\DRAWLINE.HCPYMODE 79367
|
||||
. 79679) (\DRAWCURVE.HCPYMODE 79681 . 80110) (\DRAWCIRCLE.HCPYMODE 80112 . 80507) (
|
||||
\DRAWELLIPSE.HCPYMODE 80509 . 81021) (\DSPFONT.HCPYMODE 81023 . 82179) (\DSPLEFTMARGIN.HCPYMODE 82181
|
||||
. 82765) (\DSPLINEFEED.HCPYMODE 82767 . 83177) (\DSPRIGHTMARGIN.HCPYMODE 83179 . 83808) (
|
||||
\DSPSPACEFACTOR.HCPYMODE 83810 . 84331) (\DSPXPOSITION.HCPYMODE 84333 . 84914) (\DSPYPOSITION.HCPYMODE
|
||||
84916 . 85321) (\MOVETO.HCPYMODE 85323 . 85475) (\FONTCREATE.HCPYMODE.PRESS 85477 . 86489) (
|
||||
\CREATECHARSET.HCPYMODE.PRESS 86491 . 87462) (\FONTCREATE.HCPYMODE.INTERPRESS 87464 . 88498) (
|
||||
\CREATECHARSET.HCPYMODE.INTERPRESS 88500 . 89488) (\STRINGWIDTH.HCPYMODE 89490 . 89924) (
|
||||
\HCPYMODEBLTCHAR 89926 . 92895) (\HCPYMODEDISPLAYINIT 92897 . 95828) (\HCPYMODEDSPPRINTCHAR 95830 .
|
||||
98011) (\SLOWHCPYMODEBLTCHAR 98013 . 101527) (\SFFixY.HCPYMODE 101529 . 103026)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 5-Sep-2021 08:24:49"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IMAGEIO.;6 79647
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 2-Aug-2021 19:41:35"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IMAGEIO.;4 79616
|
||||
|
||||
changes to%: (FNS \DISPLAYINIT \4DISPLAYINIT \8DISPLAYINIT \24DISPLAYINIT)
|
||||
changes to%: (FNS \DISPLAYINIT)
|
||||
|
||||
previous date%: " 2-Aug-2021 19:41:35"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IMAGEIO.;5)
|
||||
previous date%: "28-Jun-99 16:33:59"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IMAGEIO.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -1509,24 +1509,24 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
|
||||
(PUTPROPS IMAGEIO COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991
|
||||
1993 1994 1999 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3384 12141 (IMAGESTREAMP 3394 . 4226) (IMAGESTREAMTYPE 4228 . 4441) (IMAGESTREAMTYPEP
|
||||
4443 . 5078) (OPENIMAGESTREAM 5080 . 10034) (\GOOD.DASHLST 10036 . 12139)) (12176 14473 (
|
||||
DRAWDASHEDLINE 12186 . 14471)) (14474 21814 (DSPBACKCOLOR 14484 . 14856) (DSPBOTTOMMARGIN 14858 .
|
||||
15243) (DSPCOLOR 15245 . 15609) (DSPCLIPPINGREGION 15611 . 16316) (DSPRESET 16318 . 16598) (DSPFONT
|
||||
16600 . 16964) (DSPLEFTMARGIN 16966 . 17347) (DSPLINEFEED 17349 . 17649) (DSPOPERATION 17651 . 18028)
|
||||
(DSPRIGHTMARGIN 18030 . 18413) (DSPTOPMARGIN 18415 . 18794) (DSPSCALE 18796 . 19163) (DSPSPACEFACTOR
|
||||
19165 . 19558) (DSPXPOSITION 19560 . 19865) (DSPYPOSITION 19867 . 20172) (DSPROTATE 20174 . 20469) (
|
||||
DSPPUSHSTATE 20471 . 20717) (DSPPOPSTATE 20719 . 20962) (DSPDEFAULTSTATE 20964 . 21216) (DSPSCALE2
|
||||
21218 . 21509) (DSPTRANSLATE 21511 . 21812)) (21815 30616 (DSPNEWPAGE 21825 . 22517) (DRAWBETWEEN
|
||||
22519 . 23221) (DRAWCIRCLE 23223 . 23719) (DRAWARC 23721 . 24238) (DRAWCURVE 24240 . 24917) (
|
||||
DRAWELLIPSE 24919 . 25705) (DRAWLINE 25707 . 26097) (DRAWPOLYGON 26099 . 26554) (DRAWPOINT 26556 .
|
||||
26975) (FILLPOLYGON 26977 . 27543) (DRAWTO 27545 . 27963) (FILLCIRCLE 27965 . 28188) (MOVETO 28190 .
|
||||
28554) (RELDRAWTO 28556 . 29473) (BITMAPIMAGESIZE 29475 . 29646) (SCALEDBITBLT 29648 . 30614)) (30617
|
||||
37656 (\DRAWPOINT.GENERIC 30627 . 30974) (\DRAWPOLYGON.GENERIC 30976 . 33284) (\DRAWCIRCLE.GENERIC
|
||||
33286 . 34944) (\DRAWELLIPSE.GENERIC 34946 . 37654)) (37657 43043 (\IMAGEIOINIT 37667 . 41800) (
|
||||
\NOIMAGE.DSPFONT 41802 . 42877) (\UNIMPIMAGEOP 42879 . 43041)) (43166 46290 (INSURE.BRUSH 43176 .
|
||||
44550) (BRUSHP 44552 . 45342) (\POSSIBLECOLOR 45344 . 45895) (NEGSHADE 45897 . 46288)) (46846 47530 (
|
||||
DASHINGP 46856 . 47186) (INSURE.DASHING 47188 . 47528)) (58011 78460 (\DisplayEventFn 58021 . 58531) (
|
||||
\DISPLAYINIT 58533 . 64212) (\4DISPLAYINIT 64214 . 68851) (\8DISPLAYINIT 68853 . 73492) (
|
||||
\24DISPLAYINIT 73494 . 78201) (\DISPLAYSTREAMTYPEBPP 78203 . 78458)))))
|
||||
(FILEMAP (NIL (3353 12110 (IMAGESTREAMP 3363 . 4195) (IMAGESTREAMTYPE 4197 . 4410) (IMAGESTREAMTYPEP
|
||||
4412 . 5047) (OPENIMAGESTREAM 5049 . 10003) (\GOOD.DASHLST 10005 . 12108)) (12145 14442 (
|
||||
DRAWDASHEDLINE 12155 . 14440)) (14443 21783 (DSPBACKCOLOR 14453 . 14825) (DSPBOTTOMMARGIN 14827 .
|
||||
15212) (DSPCOLOR 15214 . 15578) (DSPCLIPPINGREGION 15580 . 16285) (DSPRESET 16287 . 16567) (DSPFONT
|
||||
16569 . 16933) (DSPLEFTMARGIN 16935 . 17316) (DSPLINEFEED 17318 . 17618) (DSPOPERATION 17620 . 17997)
|
||||
(DSPRIGHTMARGIN 17999 . 18382) (DSPTOPMARGIN 18384 . 18763) (DSPSCALE 18765 . 19132) (DSPSPACEFACTOR
|
||||
19134 . 19527) (DSPXPOSITION 19529 . 19834) (DSPYPOSITION 19836 . 20141) (DSPROTATE 20143 . 20438) (
|
||||
DSPPUSHSTATE 20440 . 20686) (DSPPOPSTATE 20688 . 20931) (DSPDEFAULTSTATE 20933 . 21185) (DSPSCALE2
|
||||
21187 . 21478) (DSPTRANSLATE 21480 . 21781)) (21784 30585 (DSPNEWPAGE 21794 . 22486) (DRAWBETWEEN
|
||||
22488 . 23190) (DRAWCIRCLE 23192 . 23688) (DRAWARC 23690 . 24207) (DRAWCURVE 24209 . 24886) (
|
||||
DRAWELLIPSE 24888 . 25674) (DRAWLINE 25676 . 26066) (DRAWPOLYGON 26068 . 26523) (DRAWPOINT 26525 .
|
||||
26944) (FILLPOLYGON 26946 . 27512) (DRAWTO 27514 . 27932) (FILLCIRCLE 27934 . 28157) (MOVETO 28159 .
|
||||
28523) (RELDRAWTO 28525 . 29442) (BITMAPIMAGESIZE 29444 . 29615) (SCALEDBITBLT 29617 . 30583)) (30586
|
||||
37625 (\DRAWPOINT.GENERIC 30596 . 30943) (\DRAWPOLYGON.GENERIC 30945 . 33253) (\DRAWCIRCLE.GENERIC
|
||||
33255 . 34913) (\DRAWELLIPSE.GENERIC 34915 . 37623)) (37626 43012 (\IMAGEIOINIT 37636 . 41769) (
|
||||
\NOIMAGE.DSPFONT 41771 . 42846) (\UNIMPIMAGEOP 42848 . 43010)) (43135 46259 (INSURE.BRUSH 43145 .
|
||||
44519) (BRUSHP 44521 . 45311) (\POSSIBLECOLOR 45313 . 45864) (NEGSHADE 45866 . 46257)) (46815 47499 (
|
||||
DASHINGP 46825 . 47155) (INSURE.DASHING 47157 . 47497)) (57980 78429 (\DisplayEventFn 57990 . 58500) (
|
||||
\DISPLAYINIT 58502 . 64181) (\4DISPLAYINIT 64183 . 68820) (\8DISPLAYINIT 68822 . 73461) (
|
||||
\24DISPLAYINIT 73463 . 78170) (\DISPLAYSTREAMTYPEBPP 78172 . 78427)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
440
sources/LEAF
440
sources/LEAF
@@ -1,26 +1,26 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 5-Sep-2021 08:25:29" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LEAF.;2 744110Q
|
||||
(FILECREATED "19-Jan-93 10:41:31" {DSK}<python>lde>lispcore>sources>LEAF.;2 745474Q
|
||||
|
||||
changes to%: (FNS \LEAF.DEVICEP \LEAFINIT)
|
||||
changes to%: (RECORDS SEQUINPACKET SEQUIN LOOKUPFILEDATA LEAFDATA LEAFERRORDATA LEAFPARAMSDATA
|
||||
LEAFPACKET LEAFINFOBLOCK LEAFSTREAM LEAFDEVICE PUPFILESERVER)
|
||||
|
||||
previous date%: "19-Jan-93 10:41:31"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LEAF.;1)
|
||||
previous date%: " 4-Jan-93 23:36:15" {DSK}<python>lde>lispcore>sources>LEAF.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LEAFCOMS)
|
||||
|
||||
(RPAQQ LEAFCOMS
|
||||
(RPAQQ LEAFCOMS
|
||||
(
|
||||
|
||||
(* ;;; "Support for the Leaf random-access filing protocol")
|
||||
(* ;;; "Support for the Leaf random-access filing protocol")
|
||||
|
||||
(E (RESETSAVE (RADIX 8)))
|
||||
(COMS
|
||||
(* ;; "SEQUIN protocol")
|
||||
(* ;; "SEQUIN protocol")
|
||||
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (COMS * SEQUINCOMS)
|
||||
(FILES (LOADCOMP)
|
||||
@@ -33,7 +33,7 @@ Copyright (c) 1983-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
\SEQUIN.OUT.OF.THE.BLUE \SEQUIN.HANDLE.ACK \SEQUIN.RETRANSMIT
|
||||
\SEQUIN.RETRANSMITNEXT))
|
||||
(COMS
|
||||
(* ;; "LEAF device operations")
|
||||
(* ;; "LEAF device operations")
|
||||
|
||||
(FNS \LEAF.CLOSEFILE \LEAF.DELETEFILE \LEAF.DEVICEP \LEAF.RECONNECT
|
||||
\LEAF.DIRECTORYNAMEP \LEAF.GENERATEFILES \LEAF.GETFILE \PARSE.REMOTE.FILENAME
|
||||
@@ -45,18 +45,18 @@ Copyright (c) 1983-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
\LEAF.SETFILEINFO \LEAF.SETFILETYPE \LEAF.SETVALIDATION \LEAF.TRUNCATEFILE
|
||||
\LEAF.WRITEPAGES))
|
||||
(COMS
|
||||
(* ;; "Main routing point for LEAF pups")
|
||||
(* ;; "Main routing point for LEAF pups")
|
||||
|
||||
(FNS \SENDLEAF))
|
||||
(COMS
|
||||
(* ;; "Managing LEAF connections")
|
||||
(* ;; "Managing LEAF connections")
|
||||
|
||||
(FNS \OPENLEAFCONNECTION \LEAF.BREAKCONNECTION \CLOSELEAFCONNECTION \LEAF.EVENTFN)
|
||||
(* ;
|
||||
"This generic fn ought to be on FILEIO")
|
||||
(* ;
|
||||
"This generic fn ought to be on FILEIO")
|
||||
(FNS BREAKCONNECTION))
|
||||
(COMS
|
||||
(* ;; "Functions called when various SEQUIN events occur")
|
||||
(* ;; "Functions called when various SEQUIN events occur")
|
||||
|
||||
(FNS \LEAF.ACKED \LEAF.FIX.BROKEN.SEQUIN \LEAF.REPAIR.BROKEN.PUP
|
||||
\LEAF.USE.NEW.CONNECTION \LEAF.RESENDPUPS \LEAF.HANDLE.INPUT
|
||||
@@ -65,14 +65,14 @@ Copyright (c) 1983-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
\LEAF.MAYBE.FLUSH.CACHE \LEAF.WHENCLOSED \LEAF.IDLE?))
|
||||
(ADDVARS (NETWORKOSTYPES))
|
||||
(COMS
|
||||
(* ;; "Miscellaneous and error handling")
|
||||
(* ;; "Miscellaneous and error handling")
|
||||
|
||||
(FNS \ADDLEAFSTRING \FIXPASSWORD \GETLEAFSTRING \IFSERRORSTRING \LEAF.ERROR
|
||||
\LEAF.DIRECTORYNAMEONLY GETHOSTINFO GETOSTYPE EXPANDING-PAGEFULLFN)
|
||||
(VARS (DEFAULT.OSTYPE 'IFS))
|
||||
(GLOBALVARS DEFAULT.OSTYPE))
|
||||
(COMS
|
||||
(* ;; "LookUpFile stuff")
|
||||
(* ;; "LookUpFile stuff")
|
||||
|
||||
(FNS \IFS.LOOKUPFILE)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (COMS * LOOKUPFILECOMS)))
|
||||
@@ -111,120 +111,119 @@ Copyright (c) 1983-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(RPAQQ SEQUINCOMS
|
||||
((RECORDS SEQUINPACKET SEQUIN)
|
||||
(CONSTANTS * SEQUINOPS)
|
||||
(CONSTANTS * SEQUINSTATES)
|
||||
(CONSTANTS (\SC.EQUAL 0)
|
||||
(\SC.PREVIOUS 1)
|
||||
(\SC.DUPLICATE 2)
|
||||
(\SC.AHEAD 3)
|
||||
(\SC.OUTOFRANGE 4)
|
||||
(\PT.SEQUIN 260Q)
|
||||
(\SS.NOSOCKET 10Q)
|
||||
(\SEQUIN.DEFAULT.ALLOCATION 12Q)
|
||||
(\SEQUIN.DEFAULT.RETRANSMITMAX 5))
|
||||
(MACROS SEQUINOP)))
|
||||
(RPAQQ SEQUINCOMS ((RECORDS SEQUINPACKET SEQUIN)
|
||||
(CONSTANTS * SEQUINOPS)
|
||||
(CONSTANTS * SEQUINSTATES)
|
||||
(CONSTANTS (\SC.EQUAL 0)
|
||||
(\SC.PREVIOUS 1)
|
||||
(\SC.DUPLICATE 2)
|
||||
(\SC.AHEAD 3)
|
||||
(\SC.OUTOFRANGE 4)
|
||||
(\PT.SEQUIN 260Q)
|
||||
(\SS.NOSOCKET 10Q)
|
||||
(\SEQUIN.DEFAULT.ALLOCATION 12Q)
|
||||
(\SEQUIN.DEFAULT.RETRANSMITMAX 5))
|
||||
(MACROS SEQUINOP)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS SEQUINPACKET ((SEQUINSTART (fetch PUPBASE of DATUM)))
|
||||
(BLOCKRECORD SEQUINSTART ((NIL 2 WORD)
|
||||
(* ; "Pup length, typeword")
|
||||
(* ; "Pup length, typeword")
|
||||
(ALLOCATE BYTE)
|
||||
(RECEIVESEQ BYTE)
|
||||
(SEQCONTROL BYTE)
|
||||
(SENDSEQ BYTE)
|
||||
(* ;
|
||||
"Sequin uses ID fields of PUP for control info")
|
||||
(* ;
|
||||
"Sequin uses ID fields of PUP for control info")
|
||||
)))
|
||||
|
||||
(DATATYPE SEQUIN (
|
||||
(* ;; "First: stuff used by SEQUIN level")
|
||||
(* ;; "First: stuff used by SEQUIN level")
|
||||
|
||||
(SEQNAME POINTER) (* ; "Name of partner")
|
||||
(SEQFRNPORT POINTER) (* ; "Foreign socket")
|
||||
(SEQSOCKET POINTER) (* ; "Local socket")
|
||||
(SEQSTATE BYTE) (* ; "Sequin connection state")
|
||||
(MYSENDSEQ BYTE) (* ;
|
||||
"Number I will next send. These must be byte fields so that they will wrap around correctly!")
|
||||
(MYRECEIVESEQ BYTE) (* ;
|
||||
"Number I next expect to receive, i.e. Partner's Send number of first unacked packet")
|
||||
(LASTACKEDSEQ BYTE) (* ;
|
||||
"Last Receive seq from partner: all packets with sequence numbers before this one have been acked")
|
||||
(SEQOUTALLOC WORD) (* ;
|
||||
"Output allocation: the number of packets I may send without their being acked")
|
||||
(SEQINALLOC WORD) (* ;
|
||||
"Input allocation: what I tell my partner")
|
||||
(SEQMAXALLOC WORD) (* ;
|
||||
"The largest I will let output allocation get")
|
||||
(%#UNACKEDSEQS WORD) (* ;
|
||||
"Number of data packets we have sent for which no acks have been received")
|
||||
(SEQINPUTQLENGTH WORD) (* ;
|
||||
"Number of packets in input (done) queue")
|
||||
(SEQTIMEOUT WORD) (* ; "Timeout before retransmission")
|
||||
(SEQBASETIMEOUT WORD) (* ;
|
||||
"Timeout for this connection in general")
|
||||
(SEQRETRANSMITMAX WORD) (* ;
|
||||
"How many times to retransmit before complaining")
|
||||
(%#SEQRESTARTS WORD) (* ; "Some statistical info...")
|
||||
(SEQNAME POINTER) (* ; "Name of partner")
|
||||
(SEQFRNPORT POINTER) (* ; "Foreign socket")
|
||||
(SEQSOCKET POINTER) (* ; "Local socket")
|
||||
(SEQSTATE BYTE) (* ; "Sequin connection state")
|
||||
(MYSENDSEQ BYTE) (* ;
|
||||
"Number I will next send. These must be byte fields so that they will wrap around correctly!")
|
||||
(MYRECEIVESEQ BYTE) (* ;
|
||||
"Number I next expect to receive, i.e. Partner's Send number of first unacked packet")
|
||||
(LASTACKEDSEQ BYTE) (* ;
|
||||
"Last Receive seq from partner: all packets with sequence numbers before this one have been acked")
|
||||
(SEQOUTALLOC WORD) (* ;
|
||||
"Output allocation: the number of packets I may send without their being acked")
|
||||
(SEQINALLOC WORD) (* ;
|
||||
"Input allocation: what I tell my partner")
|
||||
(SEQMAXALLOC WORD) (* ;
|
||||
"The largest I will let output allocation get")
|
||||
(%#UNACKEDSEQS WORD) (* ;
|
||||
"Number of data packets we have sent for which no acks have been received")
|
||||
(SEQINPUTQLENGTH WORD) (* ;
|
||||
"Number of packets in input (done) queue")
|
||||
(SEQTIMEOUT WORD) (* ; "Timeout before retransmission")
|
||||
(SEQBASETIMEOUT WORD) (* ;
|
||||
"Timeout for this connection in general")
|
||||
(SEQRETRANSMITMAX WORD) (* ;
|
||||
"How many times to retransmit before complaining")
|
||||
(%#SEQRESTARTS WORD) (* ; "Some statistical info...")
|
||||
(%#SEQRETRANSMITS WORD)
|
||||
(%#SEQDUPLICATES WORD)
|
||||
(%#SEQTIMEOUTS WORD)
|
||||
(%#SEQTURNOVERS WORD)
|
||||
(SEQRETRANSMITQ POINTER) (* ; "Sequin output queue")
|
||||
(SEQRETRANSMITQ POINTER) (* ; "Sequin output queue")
|
||||
(SEQTIMER POINTER)
|
||||
(SEQPROCESS POINTER)
|
||||
(SEQIGNOREDUPLICATES FLAG)
|
||||
(SEQRETRANSMITTING FLAG)
|
||||
(SEQCLOSEME FLAG)
|
||||
(SEQCLOSEDFORLOGOUT FLAG)
|
||||
(SEQLASTRESTARTTIMER POINTER) (* ;
|
||||
"Allows for some aging of the connection timeout")
|
||||
(SEQLASTRESTARTTIMER POINTER) (* ;
|
||||
"Allows for some aging of the connection timeout")
|
||||
(SEQLASTRESTART POINTER)
|
||||
(SEQRETRANSMITNEXT POINTER)
|
||||
(SEQEVENT POINTER) (* ;
|
||||
"Signaled when there is input, state changed, or allocation changed")
|
||||
(SEQLOCK POINTER) (* ; "Monitor lock for this structure")
|
||||
(SEQEVENT POINTER) (* ;
|
||||
"Signaled when there is input, state changed, or allocation changed")
|
||||
(SEQLOCK POINTER) (* ; "Monitor lock for this structure")
|
||||
|
||||
(* ;; "Second-level functions invoked by SEQUIN")
|
||||
(* ;; "Second-level functions invoked by SEQUIN")
|
||||
|
||||
(SEQACKED POINTER) (* ;
|
||||
"(PUP SEQUIN) called when PUP is acked")
|
||||
(SEQINPUT POINTER) (* ;
|
||||
"(PUP SEQUIN) called when PUP arrives as input data")
|
||||
(SEQBROKEN POINTER) (* ; "(SEQUIN PUP) called when a BROKEN sequin arrives (PUP = NIL) or attempt to send PUP on broken connection")
|
||||
(SEQABORTED POINTER) (* ;
|
||||
"(SEQUIN) called when PUP arrives with outlandish sequence numbers")
|
||||
(SEQTIMEDOUT POINTER) (* ;
|
||||
"(SEQUIN) called when about to retransmit SEQRETRANSMITMAX times")
|
||||
(SEQCLOSED POINTER) (* ;
|
||||
"(SEQUIN) called when a connection is flushed, but before its retransmit queue is flushed")
|
||||
(SEQIDLETIMEOUTCOMPUTER POINTER) (* ; "Computes timeout before calling SEQIDLEFN when no activity on connection. T means forever, NIL means don't")
|
||||
(SEQIDLEFN POINTER) (* ;
|
||||
"Called when nothing otherwise is happening, after timeout of SEQIDLETIMEOUT")
|
||||
(SEQACKED POINTER) (* ;
|
||||
"(PUP SEQUIN) called when PUP is acked")
|
||||
(SEQINPUT POINTER) (* ;
|
||||
"(PUP SEQUIN) called when PUP arrives as input data")
|
||||
(SEQBROKEN POINTER) (* ; "(SEQUIN PUP) called when a BROKEN sequin arrives (PUP = NIL) or attempt to send PUP on broken connection")
|
||||
(SEQABORTED POINTER) (* ;
|
||||
"(SEQUIN) called when PUP arrives with outlandish sequence numbers")
|
||||
(SEQTIMEDOUT POINTER) (* ;
|
||||
"(SEQUIN) called when about to retransmit SEQRETRANSMITMAX times")
|
||||
(SEQCLOSED POINTER) (* ;
|
||||
"(SEQUIN) called when a connection is flushed, but before its retransmit queue is flushed")
|
||||
(SEQIDLETIMEOUTCOMPUTER POINTER) (* ; "Computes timeout before calling SEQIDLEFN when no activity on connection. T means forever, NIL means don't")
|
||||
(SEQIDLEFN POINTER) (* ;
|
||||
"Called when nothing otherwise is happening, after timeout of SEQIDLETIMEOUT")
|
||||
|
||||
(* ;; "Stuff used by clients of SEQUIN, in particular, LEAF")
|
||||
(* ;; "Stuff used by clients of SEQUIN, in particular, LEAF")
|
||||
|
||||
(SEQDONEQ POINTER) (* ;
|
||||
"Sequins acked but kept around for further handling")
|
||||
(SEQDONEQ POINTER) (* ;
|
||||
"Sequins acked but kept around for further handling")
|
||||
(NIL POINTER)
|
||||
(NIL POINTER)
|
||||
(LEAFCACHEDFILE POINTER) (* ;
|
||||
"Last file accessed, to speed up repeated lookups of same name")
|
||||
(LEAFCACHETIMER POINTER) (* ; "To timeout the cache")
|
||||
(LEAFCACHEDFILE POINTER) (* ;
|
||||
"Last file accessed, to speed up repeated lookups of same name")
|
||||
(LEAFCACHETIMER POINTER) (* ; "To timeout the cache")
|
||||
(LEAFCACHEHITS WORD)
|
||||
(LEAFCACHEMISSES WORD)
|
||||
(LEAFTIMEOUTCOUNT WORD)
|
||||
(LEAFCLOSING FLAG)
|
||||
(LEAFOPENCLOSELOCK POINTER) (* ;
|
||||
"Monitor lock to keep GETFILE and CLOSEFILE from stepping on each other")
|
||||
(LEAFOPENCLOSELOCK POINTER) (* ;
|
||||
"Monitor lock to keep GETFILE and CLOSEFILE from stepping on each other")
|
||||
(LEAFABORTBUTTONWINDOW POINTER)
|
||||
(LEAFABORTSTATUS POINTER)
|
||||
(LEAFTIMEOUTSTATUS POINTER)
|
||||
(SEQTIMEDIN POINTER)
|
||||
(NIL POINTER)
|
||||
(SEQOPENERRORHANDLER POINTER) (* ;
|
||||
"(SEQUIN PUP) called on errors trying to open connection")
|
||||
(SEQOPENERRORHANDLER POINTER) (* ;
|
||||
"(SEQUIN PUP) called on errors trying to open connection")
|
||||
)
|
||||
SEQSTATE _ \SS.UNOPENED SEQOUTALLOC _ 1 SEQINALLOC _ \SEQUIN.DEFAULT.ALLOCATION
|
||||
SEQRETRANSMITMAX _ \SEQUIN.DEFAULT.RETRANSMITMAX SEQRETRANSMITQ _
|
||||
@@ -309,18 +308,17 @@ Copyright (c) 1983-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
(SEQUIN 116Q POINTER))
|
||||
'120Q)
|
||||
|
||||
(RPAQQ SEQUINOPS
|
||||
((\SEQUIN.DATA 0)
|
||||
(\SEQUIN.ACK 1)
|
||||
(\SEQUIN.NOOP 2)
|
||||
(\SEQUIN.RESTART 3)
|
||||
(\SEQUIN.OPEN 5)
|
||||
(\SEQUIN.BREAK 6)
|
||||
(\SEQUIN.OBSOLETE.CLOSE 7)
|
||||
(\SEQUIN.DESTROY 11Q)
|
||||
(\SEQUIN.DALLYING 12Q)
|
||||
(\SEQUIN.QUIT 13Q)
|
||||
(\SEQUIN.BROKEN 14Q)))
|
||||
(RPAQQ SEQUINOPS ((\SEQUIN.DATA 0)
|
||||
(\SEQUIN.ACK 1)
|
||||
(\SEQUIN.NOOP 2)
|
||||
(\SEQUIN.RESTART 3)
|
||||
(\SEQUIN.OPEN 5)
|
||||
(\SEQUIN.BREAK 6)
|
||||
(\SEQUIN.OBSOLETE.CLOSE 7)
|
||||
(\SEQUIN.DESTROY 11Q)
|
||||
(\SEQUIN.DALLYING 12Q)
|
||||
(\SEQUIN.QUIT 13Q)
|
||||
(\SEQUIN.BROKEN 14Q)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \SEQUIN.DATA 0)
|
||||
@@ -432,8 +430,8 @@ Copyright (c) 1983-1988, 1990-1993, 2021 by Venue & Xerox Corporation.
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS SEQUINOP MACRO ((SEQ OP . ARGS)
|
||||
(APPLY* (fetch (SEQUIN OP) of SEQ) . ARGS)))
|
||||
[PUTPROPS SEQUINOP MACRO ((SEQ OP . ARGS)
|
||||
(APPLY* (fetch (SEQUIN OP) of SEQ) . ARGS]
|
||||
)
|
||||
|
||||
|
||||
@@ -3855,7 +3853,7 @@ This shouldn't happen: Lisp and the server have different ideas about which file
|
||||
(RPAQ? *UPPER-CASE-FILE-NAMES* T)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(RPAQQ LEAFCOMPILETIMECOMS
|
||||
(RPAQQ LEAFCOMPILETIMECOMS
|
||||
((RECORDS LEAFDATA LEAFERRORDATA LEAFPARAMSDATA LEAFPACKET LEAFINFOBLOCK LEAFSTREAM LEAFDEVICE
|
||||
PUPFILESERVER)
|
||||
(MACROS .NAMEORSTREAM. .PAGE.IS.AFTER.EOF. INCLEAFSTAT)
|
||||
@@ -3915,8 +3913,8 @@ This shouldn't happen: Lisp and the server have different ideas about which file
|
||||
(HANDLE WORD)
|
||||
(FILEADDRESS FIXP)
|
||||
(DATALENGTH WORD)
|
||||
(LEAFFIRSTDATAWORD WORD)) (* ;
|
||||
"Format of typical file operation request.")
|
||||
(LEAFFIRSTDATAWORD WORD)) (* ;
|
||||
"Format of typical file operation request.")
|
||||
(BLOCKRECORD LEAFDATA ((LEAFOPCODE BITS 5)
|
||||
(ANSWERBIT BITS 1)
|
||||
(LEAFLENGTH BITS 12Q)
|
||||
@@ -3926,45 +3924,45 @@ This shouldn't happen: Lisp and the server have different ideas about which file
|
||||
(NIL BITS 2)
|
||||
(JUSTHIADDR BITS 13Q)
|
||||
(LOADDR WORD))
|
||||
(* ;
|
||||
"Details of the file address format")
|
||||
(* ;
|
||||
"Details of the file address format")
|
||||
(SYNONYM LEAFOPCODE (OPCODE)))
|
||||
(BLOCKRECORD LEAFDATA ((NIL 2 WORD)
|
||||
(SIGNEXTEND BITS 5)
|
||||
(NIL BITS 33Q))
|
||||
(* ; "more details")
|
||||
(* ; "more details")
|
||||
)
|
||||
(BLOCKRECORD LEAFDATA ((NIL 2 WORD)
|
||||
(OPENMODE WORD))
|
||||
(* ; "format of OPEN file request")
|
||||
(* ; "format of OPEN file request")
|
||||
)
|
||||
(BLOCKRECORD LEAFDATA ((NIL 5 WORD)
|
||||
(LEAFFILETYPE WORD)
|
||||
(LEAFBYTESIZE WORD))
|
||||
(* ; "For accessing the file's TYPE")
|
||||
(* ; "For accessing the file's TYPE")
|
||||
)
|
||||
(BLOCKRECORD LEAFDATA ((NIL 5 WORD)
|
||||
(LEAFFILEDATE FIXP))
|
||||
(* ;
|
||||
"Format of SETFILEINFO of CREATIONDATE request")
|
||||
(* ;
|
||||
"Format of SETFILEINFO of CREATIONDATE request")
|
||||
))
|
||||
|
||||
(BLOCKRECORD LEAFERRORDATA ((NIL WORD)
|
||||
(LEAFERRORCODE WORD) (* ; "Error subcode in ERROR leafop")
|
||||
(LEAFERROROPCODE BITS 5) (* ;
|
||||
"The OPCODE in the Leaf packet provoking the error")
|
||||
(LEAFERRORCODE WORD) (* ; "Error subcode in ERROR leafop")
|
||||
(LEAFERROROPCODE BITS 5) (* ;
|
||||
"The OPCODE in the Leaf packet provoking the error")
|
||||
(NIL BITS 13Q)
|
||||
(LEAFERRORHANDLE WORD) (* ; "The handle in the provoking op")
|
||||
(LEAFERRORMSG WORD) (* ;
|
||||
"Actually IFSSTRING starting here")
|
||||
(LEAFERRORHANDLE WORD) (* ; "The handle in the provoking op")
|
||||
(LEAFERRORMSG WORD) (* ;
|
||||
"Actually IFSSTRING starting here")
|
||||
))
|
||||
|
||||
(BLOCKRECORD LEAFPARAMSDATA ((NIL WORD)
|
||||
(LEAFPMAXDATALENGTH WORD)
|
||||
(LEAFPLOCKTIMEOUT WORD) (* ;
|
||||
"File Lock timeout, in units of 5 seconds")
|
||||
(LEAFPCONNTIMEOUT WORD) (* ;
|
||||
"Overall connection timeout, same units")
|
||||
(LEAFPLOCKTIMEOUT WORD) (* ;
|
||||
"File Lock timeout, in units of 5 seconds")
|
||||
(LEAFPCONNTIMEOUT WORD) (* ;
|
||||
"Overall connection timeout, same units")
|
||||
))
|
||||
|
||||
(ACCESSFNS LEAFPACKET ((LEAFSTATUS (fetch EPUSERFIELD of DATUM)
|
||||
@@ -3980,14 +3978,14 @@ This shouldn't happen: Lisp and the server have different ideas about which file
|
||||
|
||||
(BLOCKRECORD LEAFINFOBLOCK ((LFCREATIONDATE FIXP)
|
||||
(LFWRITEDATE FIXP)
|
||||
(LFREADDATE FIXP)) (* ; "just like leader page")
|
||||
(LFREADDATE FIXP)) (* ; "just like leader page")
|
||||
(BLOCKRECORD LEAFINFOBLOCK ((HICREATE WORD)
|
||||
(LOCREATE WORD)
|
||||
(HIWRITE WORD)
|
||||
(LOWRITE WORD)
|
||||
(HIREAD WORD)
|
||||
(LOREAD WORD))
|
||||
(* ; "for VALIDATION use")
|
||||
(* ; "for VALIDATION use")
|
||||
)
|
||||
(CREATE (\ALLOCBLOCK 3)))
|
||||
|
||||
@@ -4010,25 +4008,25 @@ This shouldn't happen: Lisp and the server have different ideas about which file
|
||||
(replace DEVICEINFO of DATUM with NEWVALUE))))
|
||||
|
||||
(DATATYPE PUPFILESERVER (
|
||||
(* ;; "Info common to various pup protocols used on a file server, independent of whether a connection is now open")
|
||||
(* ;; "Info common to various pup protocols used on a file server, independent of whether a connection is now open")
|
||||
|
||||
(NIL BYTE)
|
||||
(PFSNAME POINTER)
|
||||
(PFSADDRESS POINTER) (* ; "Pup address")
|
||||
(PFSADDRESS POINTER) (* ; "Pup address")
|
||||
(PFSOSTYPE POINTER)
|
||||
(PFSLEAFFLG POINTER) (* ;
|
||||
"Indicates something about whether LEAF is available")
|
||||
(PFSLEAFSEQUIN POINTER) (* ;
|
||||
"Pointer to SEQUIN for open leaf connection")
|
||||
(PFSLEAFTIMER POINTER) (* ;
|
||||
"Timeout for handling dead servers")
|
||||
(PFSLOOKUPFILESOCKET POINTER) (* ;
|
||||
"The Pup socket for LookupFile requests")
|
||||
(PFSLOOKUPFILELOCK POINTER) (* ; "Lock to secure it")
|
||||
(PFSLOOKUPFAILCNT POINTER) (* ;
|
||||
"Counter used until we know the service exists")
|
||||
(PFSKNOWNDIRS POINTER) (* ;
|
||||
"List of directories known to exist on this host (for DIRECTORYNAMEP)")
|
||||
(PFSLEAFFLG POINTER) (* ;
|
||||
"Indicates something about whether LEAF is available")
|
||||
(PFSLEAFSEQUIN POINTER) (* ;
|
||||
"Pointer to SEQUIN for open leaf connection")
|
||||
(PFSLEAFTIMER POINTER) (* ;
|
||||
"Timeout for handling dead servers")
|
||||
(PFSLOOKUPFILESOCKET POINTER) (* ;
|
||||
"The Pup socket for LookupFile requests")
|
||||
(PFSLOOKUPFILELOCK POINTER) (* ; "Lock to secure it")
|
||||
(PFSLOOKUPFAILCNT POINTER) (* ;
|
||||
"Counter used until we know the service exists")
|
||||
(PFSKNOWNDIRS POINTER) (* ;
|
||||
"List of directories known to exist on this host (for DIRECTORYNAMEP)")
|
||||
(NIL POINTER)))
|
||||
)
|
||||
|
||||
@@ -4049,36 +4047,35 @@ This shouldn't happen: Lisp and the server have different ideas about which file
|
||||
'30Q)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS .NAMEORSTREAM. MACRO (OPENLAMBDA (FILENAME)
|
||||
(COND
|
||||
((type? STREAM FILENAME)
|
||||
(fetch FULLFILENAME of FILENAME))
|
||||
(T FILENAME))))
|
||||
[PUTPROPS .NAMEORSTREAM. MACRO (OPENLAMBDA (FILENAME)
|
||||
(COND
|
||||
((type? STREAM FILENAME)
|
||||
(fetch FULLFILENAME of FILENAME))
|
||||
(T FILENAME]
|
||||
|
||||
(PUTPROPS .PAGE.IS.AFTER.EOF. MACRO [OPENLAMBDA (STREAM PAGE#)
|
||||
(AND (IGEQ PAGE# (fetch EPAGE of STREAM))
|
||||
(OR (NOT (IEQP (fetch EPAGE of STREAM)
|
||||
PAGE#))
|
||||
(EQ (fetch EOFFSET of STREAM)
|
||||
0])
|
||||
[PUTPROPS .PAGE.IS.AFTER.EOF. MACRO (OPENLAMBDA (STREAM PAGE#)
|
||||
(AND (IGEQ PAGE# (fetch EPAGE of STREAM))
|
||||
(OR (NOT (IEQP (fetch EPAGE of STREAM)
|
||||
PAGE#))
|
||||
(EQ (fetch EOFFSET of STREAM)
|
||||
0]
|
||||
|
||||
(PUTPROPS INCLEAFSTAT MACRO ((X)
|
||||
(change X (IPLUS16 DATUM 1))))
|
||||
[PUTPROPS INCLEAFSTAT MACRO ((X)
|
||||
(change X (IPLUS16 DATUM 1]
|
||||
)
|
||||
|
||||
(RPAQQ LEAFOPCODES
|
||||
((\LEAFOP.ERROR 0)
|
||||
(\LEAFOP.OPEN 1)
|
||||
(\LEAFOP.CLOSE 2)
|
||||
(\LEAFOP.DELETE 3)
|
||||
(\LEAFOP.LENGTH 4)
|
||||
(\LEAFOP.TRUNCATE 5)
|
||||
(\LEAFOP.READ 6)
|
||||
(\LEAFOP.WRITE 7)
|
||||
(\LEAFOP.RESET 10Q)
|
||||
(\LEAFOP.NOOP 11Q)
|
||||
(\LEAFOP.TELNET 12Q)
|
||||
(\LEAFOP.PARAMS 13Q)))
|
||||
(RPAQQ LEAFOPCODES ((\LEAFOP.ERROR 0)
|
||||
(\LEAFOP.OPEN 1)
|
||||
(\LEAFOP.CLOSE 2)
|
||||
(\LEAFOP.DELETE 3)
|
||||
(\LEAFOP.LENGTH 4)
|
||||
(\LEAFOP.TRUNCATE 5)
|
||||
(\LEAFOP.READ 6)
|
||||
(\LEAFOP.WRITE 7)
|
||||
(\LEAFOP.RESET 10Q)
|
||||
(\LEAFOP.NOOP 11Q)
|
||||
(\LEAFOP.TELNET 12Q)
|
||||
(\LEAFOP.PARAMS 13Q)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \LEAFOP.ERROR 0)
|
||||
@@ -4120,24 +4117,23 @@ This shouldn't happen: Lisp and the server have different ideas about which file
|
||||
(\LEAFOP.PARAMS 13Q))
|
||||
)
|
||||
|
||||
(RPAQQ IFSERRORS
|
||||
((\IFSERROR.BAD.CHARACTER 312Q)
|
||||
(\IFSERROR.MALFORMED '(311Q 312Q))
|
||||
(\IFSERROR.FILE.NOT.FOUND 317Q)
|
||||
(\IFSERROR.PROTECTION 320Q)
|
||||
(\IFSERROR.BUSY 321Q)
|
||||
(\IFSERROR.INVALID.DIRECTORY 322Q)
|
||||
(\IFSERROR.ALLOCATION 323Q)
|
||||
(\IFSERROR.USERNAME 330Q)
|
||||
(\IFSERROR.PASSWORD 331Q)
|
||||
(\IFSERROR.NO.LOGIN 332Q)
|
||||
(\PASSWORD.ERRORS '(330Q 331Q 332Q 337Q))
|
||||
(\IFSERROR.CONNECTNAME 333Q)
|
||||
(\IFSERROR.CONNECTPASSWORD 334Q)
|
||||
(\CONNECT.PASSWORD.ERRORS '(333Q 334Q))
|
||||
(\IFSERROR.NEED.USERNAME 337Q)
|
||||
(\IFS.ERROR.BROKEN.LEAF 1751Q)
|
||||
(\IFSERROR.BAD.HANDLE 1763Q)))
|
||||
(RPAQQ IFSERRORS ((\IFSERROR.BAD.CHARACTER 312Q)
|
||||
(\IFSERROR.MALFORMED '(311Q 312Q))
|
||||
(\IFSERROR.FILE.NOT.FOUND 317Q)
|
||||
(\IFSERROR.PROTECTION 320Q)
|
||||
(\IFSERROR.BUSY 321Q)
|
||||
(\IFSERROR.INVALID.DIRECTORY 322Q)
|
||||
(\IFSERROR.ALLOCATION 323Q)
|
||||
(\IFSERROR.USERNAME 330Q)
|
||||
(\IFSERROR.PASSWORD 331Q)
|
||||
(\IFSERROR.NO.LOGIN 332Q)
|
||||
(\PASSWORD.ERRORS '(330Q 331Q 332Q 337Q))
|
||||
(\IFSERROR.CONNECTNAME 333Q)
|
||||
(\IFSERROR.CONNECTPASSWORD 334Q)
|
||||
(\CONNECT.PASSWORD.ERRORS '(333Q 334Q))
|
||||
(\IFSERROR.NEED.USERNAME 337Q)
|
||||
(\IFS.ERROR.BROKEN.LEAF 1751Q)
|
||||
(\IFSERROR.BAD.HANDLE 1763Q)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \IFSERROR.BAD.CHARACTER 312Q)
|
||||
@@ -4371,41 +4367,41 @@ This shouldn't happen: Lisp and the server have different ideas about which file
|
||||
(NIL POINTER)))
|
||||
)
|
||||
(PUTPROPS LEAF COPYRIGHT ("Venue & Xerox Corporation" 3677Q 3700Q 3701Q 3702Q 3703Q 3704Q 3706Q 3707Q
|
||||
3710Q 3711Q 3745Q))
|
||||
3710Q 3711Q))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (55030Q 70126Q (CLOSESEQUIN 55042Q . 56061Q) (INITSEQUIN 56063Q . 61167Q) (GETSEQUIN
|
||||
61171Q . 62702Q) (PUTSEQUIN 62704Q . 70124Q)) (70127Q 153532Q (\SEQUIN.CONTROL 70141Q . 71412Q) (
|
||||
\SEQUIN.PUT 71414Q . 76437Q) (\SEQUIN.PROCESS 76441Q . 113715Q) (\SEQUIN.CLOSE 113717Q . 114604Q) (
|
||||
\SEQUIN.FLUSH.CONNECTION 114606Q . 116617Q) (\SEQUIN.CLEANUP 116621Q . 117752Q) (
|
||||
\SEQUIN.FLUSH.RETRANSMIT 117754Q . 121211Q) (\SEQUIN.COMPARE 121213Q . 122352Q) (\SEQUIN.HANDLE.INPUT
|
||||
122354Q . 140331Q) (\SEQUIN.OUT.OF.THE.BLUE 140333Q . 141156Q) (\SEQUIN.HANDLE.ACK 141160Q . 145412Q)
|
||||
(\SEQUIN.RETRANSMIT 145414Q . 150762Q) (\SEQUIN.RETRANSMITNEXT 150764Q . 153530Q)) (153603Q 417505Q (
|
||||
\LEAF.CLOSEFILE 153615Q . 166666Q) (\LEAF.DELETEFILE 166670Q . 172453Q) (\LEAF.DEVICEP 172455Q .
|
||||
207444Q) (\LEAF.RECONNECT 207446Q . 211363Q) (\LEAF.DIRECTORYNAMEP 211365Q . 214676Q) (
|
||||
\LEAF.GENERATEFILES 214700Q . 215312Q) (\LEAF.GETFILE 215314Q . 251753Q) (\PARSE.REMOTE.FILENAME
|
||||
251755Q . 261161Q) (\LEAF.STRIP.QUOTES 261163Q . 262654Q) (\LEAF.GETFILEDATES 262656Q . 265051Q) (
|
||||
\LEAF.GETFILEINFO 265053Q . 270430Q) (\LEAF.GETFILEINFO.OPEN 270432Q . 277251Q) (\LEAF.GETFILENAME
|
||||
277253Q . 301470Q) (\LEAF.OPENFILE 301472Q . 315543Q) (\LEAF.READFILENAME 315545Q . 321456Q) (
|
||||
\LEAF.ADD.QUOTES 321460Q . 324102Q) (\LEAF.READFILEPROP 324104Q . 327153Q) (\LEAF.READPAGES 327155Q .
|
||||
336312Q) (\LEAF.REQUESTPAGE 336314Q . 345224Q) (\LEAF.LOOKUPCACHE 345226Q . 352162Q) (CLEAR.LEAF.CACHE
|
||||
352164Q . 354134Q) (LEAF.ASSURE.FINISHED 354136Q . 361267Q) (\LEAF.FORCEOUTPUT 361271Q . 361563Q) (
|
||||
\LEAF.FLUSH.CACHE 361565Q . 362771Q) (\LEAF.RENAMEFILE 362773Q . 363745Q) (\LEAF.REOPENFILE 363747Q .
|
||||
371322Q) (\LEAF.CREATIONDATE 371324Q . 372161Q) (\LEAF.SETCREATIONDATE 372163Q . 375676Q) (
|
||||
\LEAF.SETFILEINFO 375700Q . 377562Q) (\LEAF.SETFILETYPE 377564Q . 404346Q) (\LEAF.SETVALIDATION
|
||||
404350Q . 406705Q) (\LEAF.TRUNCATEFILE 406707Q . 412102Q) (\LEAF.WRITEPAGES 412104Q . 417503Q)) (
|
||||
417570Q 425677Q (\SENDLEAF 417602Q . 425675Q)) (425753Q 456434Q (\OPENLEAFCONNECTION 425765Q . 450073Q
|
||||
) (\LEAF.BREAKCONNECTION 450075Q . 451701Q) (\CLOSELEAFCONNECTION 451703Q . 452543Q) (\LEAF.EVENTFN
|
||||
452545Q . 456432Q)) (456523Q 461306Q (BREAKCONNECTION 456535Q . 461304Q)) (461412Q 573776Q (
|
||||
\LEAF.ACKED 461424Q . 462133Q) (\LEAF.FIX.BROKEN.SEQUIN 462135Q . 502075Q) (\LEAF.REPAIR.BROKEN.PUP
|
||||
502077Q . 506171Q) (\LEAF.USE.NEW.CONNECTION 506173Q . 522016Q) (\LEAF.RESENDPUPS 522020Q . 522430Q) (
|
||||
\LEAF.HANDLE.INPUT 522432Q . 531742Q) (\LEAF.OPENERRORHANDLER 531744Q . 533367Q) (\LEAF.TIMEDIN
|
||||
533371Q . 534354Q) (\LEAF.TIMEDOUT 534356Q . 542671Q) (\LEAF.NOT.RESPONDING 542673Q . 544243Q) (
|
||||
\LEAF.TIMEDOUT.EXCESSIVE 544245Q . 556712Q) (\LEAF.ABORT.FROMMENU 556714Q . 557643Q) (
|
||||
\LEAF.STREAM.IN.QUEUE 557645Q . 564240Q) (\LEAF.IDLE 564242Q . 566302Q) (\LEAF.MAYBE.FLUSH.CACHE
|
||||
566304Q . 567375Q) (\LEAF.WHENCLOSED 567377Q . 572565Q) (\LEAF.IDLE? 572567Q . 573774Q)) (574121Q
|
||||
627734Q (\ADDLEAFSTRING 574133Q . 600001Q) (\FIXPASSWORD 600003Q . 602140Q) (\GETLEAFSTRING 602142Q .
|
||||
602672Q) (\IFSERRORSTRING 602674Q . 611061Q) (\LEAF.ERROR 611063Q . 616362Q) (\LEAF.DIRECTORYNAMEONLY
|
||||
616364Q . 617105Q) (GETHOSTINFO 617107Q . 624405Q) (GETOSTYPE 624407Q . 624626Q) (EXPANDING-PAGEFULLFN
|
||||
624630Q . 627732Q)) (630141Q 654726Q (\IFS.LOOKUPFILE 630153Q . 654724Q)) (656667Q 661016Q (\LEAFINIT
|
||||
656701Q . 661014Q)) (661074Q 674131Q (PRINTLEAF 661106Q . 674127Q)))))
|
||||
(FILEMAP (NIL (55721Q 71017Q (CLOSESEQUIN 55733Q . 56752Q) (INITSEQUIN 56754Q . 62060Q) (GETSEQUIN
|
||||
62062Q . 63573Q) (PUTSEQUIN 63575Q . 71015Q)) (71020Q 154423Q (\SEQUIN.CONTROL 71032Q . 72303Q) (
|
||||
\SEQUIN.PUT 72305Q . 77330Q) (\SEQUIN.PROCESS 77332Q . 114606Q) (\SEQUIN.CLOSE 114610Q . 115475Q) (
|
||||
\SEQUIN.FLUSH.CONNECTION 115477Q . 117510Q) (\SEQUIN.CLEANUP 117512Q . 120643Q) (
|
||||
\SEQUIN.FLUSH.RETRANSMIT 120645Q . 122102Q) (\SEQUIN.COMPARE 122104Q . 123243Q) (\SEQUIN.HANDLE.INPUT
|
||||
123245Q . 141222Q) (\SEQUIN.OUT.OF.THE.BLUE 141224Q . 142047Q) (\SEQUIN.HANDLE.ACK 142051Q . 146303Q)
|
||||
(\SEQUIN.RETRANSMIT 146305Q . 151653Q) (\SEQUIN.RETRANSMITNEXT 151655Q . 154421Q)) (154474Q 420376Q (
|
||||
\LEAF.CLOSEFILE 154506Q . 167557Q) (\LEAF.DELETEFILE 167561Q . 173344Q) (\LEAF.DEVICEP 173346Q .
|
||||
210335Q) (\LEAF.RECONNECT 210337Q . 212254Q) (\LEAF.DIRECTORYNAMEP 212256Q . 215567Q) (
|
||||
\LEAF.GENERATEFILES 215571Q . 216203Q) (\LEAF.GETFILE 216205Q . 252644Q) (\PARSE.REMOTE.FILENAME
|
||||
252646Q . 262052Q) (\LEAF.STRIP.QUOTES 262054Q . 263545Q) (\LEAF.GETFILEDATES 263547Q . 265742Q) (
|
||||
\LEAF.GETFILEINFO 265744Q . 271321Q) (\LEAF.GETFILEINFO.OPEN 271323Q . 300142Q) (\LEAF.GETFILENAME
|
||||
300144Q . 302361Q) (\LEAF.OPENFILE 302363Q . 316434Q) (\LEAF.READFILENAME 316436Q . 322347Q) (
|
||||
\LEAF.ADD.QUOTES 322351Q . 324773Q) (\LEAF.READFILEPROP 324775Q . 330044Q) (\LEAF.READPAGES 330046Q .
|
||||
337203Q) (\LEAF.REQUESTPAGE 337205Q . 346115Q) (\LEAF.LOOKUPCACHE 346117Q . 353053Q) (CLEAR.LEAF.CACHE
|
||||
353055Q . 355025Q) (LEAF.ASSURE.FINISHED 355027Q . 362160Q) (\LEAF.FORCEOUTPUT 362162Q . 362454Q) (
|
||||
\LEAF.FLUSH.CACHE 362456Q . 363662Q) (\LEAF.RENAMEFILE 363664Q . 364636Q) (\LEAF.REOPENFILE 364640Q .
|
||||
372213Q) (\LEAF.CREATIONDATE 372215Q . 373052Q) (\LEAF.SETCREATIONDATE 373054Q . 376567Q) (
|
||||
\LEAF.SETFILEINFO 376571Q . 400453Q) (\LEAF.SETFILETYPE 400455Q . 405237Q) (\LEAF.SETVALIDATION
|
||||
405241Q . 407576Q) (\LEAF.TRUNCATEFILE 407600Q . 412773Q) (\LEAF.WRITEPAGES 412775Q . 420374Q)) (
|
||||
420461Q 426570Q (\SENDLEAF 420473Q . 426566Q)) (426644Q 457325Q (\OPENLEAFCONNECTION 426656Q . 450764Q
|
||||
) (\LEAF.BREAKCONNECTION 450766Q . 452572Q) (\CLOSELEAFCONNECTION 452574Q . 453434Q) (\LEAF.EVENTFN
|
||||
453436Q . 457323Q)) (457414Q 462177Q (BREAKCONNECTION 457426Q . 462175Q)) (462303Q 574667Q (
|
||||
\LEAF.ACKED 462315Q . 463024Q) (\LEAF.FIX.BROKEN.SEQUIN 463026Q . 502766Q) (\LEAF.REPAIR.BROKEN.PUP
|
||||
502770Q . 507062Q) (\LEAF.USE.NEW.CONNECTION 507064Q . 522707Q) (\LEAF.RESENDPUPS 522711Q . 523321Q) (
|
||||
\LEAF.HANDLE.INPUT 523323Q . 532633Q) (\LEAF.OPENERRORHANDLER 532635Q . 534260Q) (\LEAF.TIMEDIN
|
||||
534262Q . 535245Q) (\LEAF.TIMEDOUT 535247Q . 543562Q) (\LEAF.NOT.RESPONDING 543564Q . 545134Q) (
|
||||
\LEAF.TIMEDOUT.EXCESSIVE 545136Q . 557603Q) (\LEAF.ABORT.FROMMENU 557605Q . 560534Q) (
|
||||
\LEAF.STREAM.IN.QUEUE 560536Q . 565131Q) (\LEAF.IDLE 565133Q . 567173Q) (\LEAF.MAYBE.FLUSH.CACHE
|
||||
567175Q . 570266Q) (\LEAF.WHENCLOSED 570270Q . 573456Q) (\LEAF.IDLE? 573460Q . 574665Q)) (575012Q
|
||||
630625Q (\ADDLEAFSTRING 575024Q . 600672Q) (\FIXPASSWORD 600674Q . 603031Q) (\GETLEAFSTRING 603033Q .
|
||||
603563Q) (\IFSERRORSTRING 603565Q . 611752Q) (\LEAF.ERROR 611754Q . 617253Q) (\LEAF.DIRECTORYNAMEONLY
|
||||
617255Q . 617776Q) (GETHOSTINFO 620000Q . 625276Q) (GETOSTYPE 625300Q . 625517Q) (EXPANDING-PAGEFULLFN
|
||||
625521Q . 630623Q)) (631032Q 655617Q (\IFS.LOOKUPFILE 631044Q . 655615Q)) (657560Q 661707Q (\LEAFINIT
|
||||
657572Q . 661705Q)) (661765Q 675022Q (PRINTLEAF 661777Q . 675020Q)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 5-Sep-2021 08:25:49"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;9 268917
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 8-Aug-2021 00:19:22"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;7 268927
|
||||
|
||||
changes to%: (FNS \CREATEDISPLAY)
|
||||
changes to%: (FNS READBITMAP)
|
||||
|
||||
previous date%: " 8-Aug-2021 00:19:22"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;8)
|
||||
previous date%: " 1-Aug-2021 23:41:37"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;6)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -4528,42 +4528,42 @@ Copyright (c) 1981-1990, 1993-1994, 2021 by Venue & Xerox Corporation.
|
||||
(PUTPROPS LLDISPLAY COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988
|
||||
1989 1990 1993 1994 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (20534 23202 (\FBITMAPBIT 20544 . 21004) (\FBITMAPBIT.UFN 21006 . 22025) (
|
||||
\NEWPAGE.DISPLAY 22027 . 22162) (INITBITMASKS 22164 . 23200)) (25247 25756 (\CreateCursorBitMap 25257
|
||||
. 25754)) (25873 84961 (BITBLT 25883 . 36273) (BLTSHADE 36275 . 37053) (\BITBLTSUB 37055 . 47190) (
|
||||
\GETPILOTBBTSCRATCHBM 47192 . 47807) (BITMAPCOPY 47809 . 48385) (BITMAPCREATE 48387 . 49947) (
|
||||
BITMAPBIT 49949 . 58336) (BLTCHAR 58338 . 58954) (\BLTCHAR 58956 . 59458) (\MEDW.BLTCHAR 59460 . 64338
|
||||
) (\CHANGECHARSET.DISPLAY 64340 . 67298) (\INDICATESTRING 67300 . 68496) (\SLOWBLTCHAR 68498 . 75594)
|
||||
(TEXTUREP 75596 . 75866) (INVERT.TEXTURE 75868 . 76142) (INVERT.TEXTURE.BITMAP 76144 . 77679) (
|
||||
BITMAPWIDTH 77681 . 78053) (READBITMAP 78055 . 80565) (\INSUREBITSPERPIXEL 80567 . 80862) (
|
||||
MAXIMUMCOLOR 80864 . 81005) (OPPOSITECOLOR 81007 . 81186) (MAXIMUMSHADE 81188 . 81399) (OPPOSITESHADE
|
||||
81401 . 81580) (\MEDW.BITBLT 81582 . 84959)) (84963 90278 (FINISH-READING-BITMAP 84963 . 90278)) (
|
||||
91541 92022 (BITMAPBIT.EXPANDER 91551 . 92020)) (92023 140557 (\BITBLT.DISPLAY 92033 . 115272) (
|
||||
\BITBLT.BITMAP 115274 . 124373) (\BITBLT.MERGE 124375 . 126628) (\BLTSHADE.DISPLAY 126630 . 133730) (
|
||||
\BLTSHADE.BITMAP 133732 . 140555)) (140558 149878 (\BITBLT.BITMAP.SLOW 140568 . 149876)) (149879
|
||||
166260 (\PUNT.BLTSHADE.BITMAP 149889 . 156985) (\PUNT.BITBLT.BITMAP 156987 . 166258)) (166261 169701 (
|
||||
\SCALEDBITBLT.DISPLAY 166271 . 167904) (\BACKCOLOR.DISPLAY 167906 . 169699)) (174019 176292 (
|
||||
DISPLAYSTREAMP 174029 . 174637) (DSPSOURCETYPE 174639 . 175648) (DSPXOFFSET 175650 . 175969) (
|
||||
DSPYOFFSET 175971 . 176290)) (176293 192594 (DSPCREATE 176303 . 178407) (DSPDESTINATION 178409 .
|
||||
181512) (DSPTEXTURE 181514 . 181676) (\DISPLAYSTREAMINCRXPOSITION 181678 . 181965) (\SFFixDestination
|
||||
181967 . 183145) (\SFFixClippingRegion 183147 . 185319) (\SFFixFont 185321 . 186371) (\SFFIXLINELENGTH
|
||||
186373 . 187869) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 187871 . 189684) (\SFFixY 189686 . 192592))
|
||||
(192595 194789 (\MEDW.XOFFSET 192605 . 193746) (\MEDW.YOFFSET 193748 . 194787)) (194790 202716 (
|
||||
\DSPCLIPPINGREGION.DISPLAY 194800 . 195546) (\DSPFONT.DISPLAY 195548 . 197918) (\DISPLAY.PILOTBITBLT
|
||||
197920 . 198069) (\DSPLINEFEED.DISPLAY 198071 . 198642) (\DSPLEFTMARGIN.DISPLAY 198644 . 199375) (
|
||||
\DSPOPERATION.DISPLAY 199377 . 200401) (\DSPRIGHTMARGIN.DISPLAY 200403 . 201248) (
|
||||
\DSPXPOSITION.DISPLAY 201250 . 202107) (\DSPYPOSITION.DISPLAY 202109 . 202714)) (207486 212522 (
|
||||
TTYDISPLAYSTREAM 207496 . 212520)) (212841 213871 (DSPSCROLL 212851 . 213551) (PAGEHEIGHT 213553 .
|
||||
213869)) (213916 216938 (\DSPRESET.DISPLAY 213926 . 216936)) (217498 238136 (\DSPPRINTCHAR 217508 .
|
||||
225346) (\DSPPRINTCR/LF 225348 . 238134)) (238137 238729 (\TTYBACKGROUND 238147 . 238727)) (238730
|
||||
242017 (DSPBACKUP 238740 . 242015)) (242201 242457 (COLORDISPLAYP 242211 . 242455)) (242458 244529 (
|
||||
DISPLAYBEFOREEXIT 242468 . 243294) (DISPLAYAFTERENTRY 243296 . 244527)) (244909 249441 (
|
||||
\DSPCLIPTRANSFORMX 244919 . 245508) (\DSPCLIPTRANSFORMY 245510 . 246235) (\DSPTRANSFORMREGION 246237
|
||||
. 246769) (\DSPUNTRANSFORMY 246771 . 247031) (\DSPUNTRANSFORMX 247033 . 247293) (
|
||||
\OFFSETCLIPPINGREGION 247295 . 249439)) (250747 253334 (UPDATESCREENDIMENSIONS 250757 . 251386) (
|
||||
\CreateScreenBitMap 251388 . 253332)) (253893 267052 (\CoerceToDisplayDevice 253903 . 254316) (
|
||||
\CREATEDISPLAY 254318 . 256158) (DISPLAYSTREAMINIT 256160 . 259304) (\STARTDISPLAY 259306 . 262217) (
|
||||
\MOVE.WINDOWS.ONTO.SCREEN 262219 . 264411) (\UPDATE.PBT.RASTERWIDTHS 264413 . 266195) (\STOPDISPLAY
|
||||
266197 . 266689) (\DEFINEDISPLAYINFO 266691 . 267050)) (267660 268421 (INITIALIZEDISPLAYSTREAMS 267670
|
||||
. 268419)))))
|
||||
(FILEMAP (NIL (20544 23212 (\FBITMAPBIT 20554 . 21014) (\FBITMAPBIT.UFN 21016 . 22035) (
|
||||
\NEWPAGE.DISPLAY 22037 . 22172) (INITBITMASKS 22174 . 23210)) (25257 25766 (\CreateCursorBitMap 25267
|
||||
. 25764)) (25883 84971 (BITBLT 25893 . 36283) (BLTSHADE 36285 . 37063) (\BITBLTSUB 37065 . 47200) (
|
||||
\GETPILOTBBTSCRATCHBM 47202 . 47817) (BITMAPCOPY 47819 . 48395) (BITMAPCREATE 48397 . 49957) (
|
||||
BITMAPBIT 49959 . 58346) (BLTCHAR 58348 . 58964) (\BLTCHAR 58966 . 59468) (\MEDW.BLTCHAR 59470 . 64348
|
||||
) (\CHANGECHARSET.DISPLAY 64350 . 67308) (\INDICATESTRING 67310 . 68506) (\SLOWBLTCHAR 68508 . 75604)
|
||||
(TEXTUREP 75606 . 75876) (INVERT.TEXTURE 75878 . 76152) (INVERT.TEXTURE.BITMAP 76154 . 77689) (
|
||||
BITMAPWIDTH 77691 . 78063) (READBITMAP 78065 . 80575) (\INSUREBITSPERPIXEL 80577 . 80872) (
|
||||
MAXIMUMCOLOR 80874 . 81015) (OPPOSITECOLOR 81017 . 81196) (MAXIMUMSHADE 81198 . 81409) (OPPOSITESHADE
|
||||
81411 . 81590) (\MEDW.BITBLT 81592 . 84969)) (84973 90288 (FINISH-READING-BITMAP 84973 . 90288)) (
|
||||
91551 92032 (BITMAPBIT.EXPANDER 91561 . 92030)) (92033 140567 (\BITBLT.DISPLAY 92043 . 115282) (
|
||||
\BITBLT.BITMAP 115284 . 124383) (\BITBLT.MERGE 124385 . 126638) (\BLTSHADE.DISPLAY 126640 . 133740) (
|
||||
\BLTSHADE.BITMAP 133742 . 140565)) (140568 149888 (\BITBLT.BITMAP.SLOW 140578 . 149886)) (149889
|
||||
166270 (\PUNT.BLTSHADE.BITMAP 149899 . 156995) (\PUNT.BITBLT.BITMAP 156997 . 166268)) (166271 169711 (
|
||||
\SCALEDBITBLT.DISPLAY 166281 . 167914) (\BACKCOLOR.DISPLAY 167916 . 169709)) (174029 176302 (
|
||||
DISPLAYSTREAMP 174039 . 174647) (DSPSOURCETYPE 174649 . 175658) (DSPXOFFSET 175660 . 175979) (
|
||||
DSPYOFFSET 175981 . 176300)) (176303 192604 (DSPCREATE 176313 . 178417) (DSPDESTINATION 178419 .
|
||||
181522) (DSPTEXTURE 181524 . 181686) (\DISPLAYSTREAMINCRXPOSITION 181688 . 181975) (\SFFixDestination
|
||||
181977 . 183155) (\SFFixClippingRegion 183157 . 185329) (\SFFixFont 185331 . 186381) (\SFFIXLINELENGTH
|
||||
186383 . 187879) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 187881 . 189694) (\SFFixY 189696 . 192602))
|
||||
(192605 194799 (\MEDW.XOFFSET 192615 . 193756) (\MEDW.YOFFSET 193758 . 194797)) (194800 202726 (
|
||||
\DSPCLIPPINGREGION.DISPLAY 194810 . 195556) (\DSPFONT.DISPLAY 195558 . 197928) (\DISPLAY.PILOTBITBLT
|
||||
197930 . 198079) (\DSPLINEFEED.DISPLAY 198081 . 198652) (\DSPLEFTMARGIN.DISPLAY 198654 . 199385) (
|
||||
\DSPOPERATION.DISPLAY 199387 . 200411) (\DSPRIGHTMARGIN.DISPLAY 200413 . 201258) (
|
||||
\DSPXPOSITION.DISPLAY 201260 . 202117) (\DSPYPOSITION.DISPLAY 202119 . 202724)) (207496 212532 (
|
||||
TTYDISPLAYSTREAM 207506 . 212530)) (212851 213881 (DSPSCROLL 212861 . 213561) (PAGEHEIGHT 213563 .
|
||||
213879)) (213926 216948 (\DSPRESET.DISPLAY 213936 . 216946)) (217508 238146 (\DSPPRINTCHAR 217518 .
|
||||
225356) (\DSPPRINTCR/LF 225358 . 238144)) (238147 238739 (\TTYBACKGROUND 238157 . 238737)) (238740
|
||||
242027 (DSPBACKUP 238750 . 242025)) (242211 242467 (COLORDISPLAYP 242221 . 242465)) (242468 244539 (
|
||||
DISPLAYBEFOREEXIT 242478 . 243304) (DISPLAYAFTERENTRY 243306 . 244537)) (244919 249451 (
|
||||
\DSPCLIPTRANSFORMX 244929 . 245518) (\DSPCLIPTRANSFORMY 245520 . 246245) (\DSPTRANSFORMREGION 246247
|
||||
. 246779) (\DSPUNTRANSFORMY 246781 . 247041) (\DSPUNTRANSFORMX 247043 . 247303) (
|
||||
\OFFSETCLIPPINGREGION 247305 . 249449)) (250757 253344 (UPDATESCREENDIMENSIONS 250767 . 251396) (
|
||||
\CreateScreenBitMap 251398 . 253342)) (253903 267062 (\CoerceToDisplayDevice 253913 . 254326) (
|
||||
\CREATEDISPLAY 254328 . 256168) (DISPLAYSTREAMINIT 256170 . 259314) (\STARTDISPLAY 259316 . 262227) (
|
||||
\MOVE.WINDOWS.ONTO.SCREEN 262229 . 264421) (\UPDATE.PBT.RASTERWIDTHS 264423 . 266205) (\STOPDISPLAY
|
||||
266207 . 266699) (\DEFINEDISPLAYINFO 266701 . 267060)) (267670 268431 (INITIALIZEDISPLAYSTREAMS 267680
|
||||
. 268429)))))
|
||||
STOP
|
||||
|
||||
@@ -1,10 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 5-Sep-2021 08:25:49" ("compiled on "
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;9) " 5-Sep-2021 08:04:36"
|
||||
"COMPILE-FILEd" in "FULL 5-Sep-2021 ..." dated " 5-Sep-2021 08:04:43")
|
||||
(FILECREATED " 5-Sep-2021 08:25:49" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;9
|
||||
268917 changes to%: (FNS \CREATEDISPLAY) previous date%: " 8-Aug-2021 00:19:22"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;8)
|
||||
(FILECREATED " 6-Sep-2021 16:23:29" ("compiled on "
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;10) " 6-Sep-2021 15:59:15"
|
||||
"COMPILE-FILEd" in "FULL 6-Sep-2021 ..." dated " 6-Sep-2021 15:59:21")
|
||||
(FILECREATED " 8-Aug-2021 00:19:22" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;7
|
||||
268927 changes to%: (FNS READBITMAP) previous date%: " 1-Aug-2021 23:41:37"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;6)
|
||||
(RPAQQ LLDISPLAYCOMS ((DECLARE%: DONTCOPY (EXPORT (RECORDS PILOTBBT \DISPLAYDATA DISPLAYSTATE
|
||||
DISPLAYINFO) (MACROS \GETDISPLAYDATA))) (* ;
|
||||
"User-visible records are on ADISPLAY --- must be init'ed here") (INITRECORDS BITMAP PILOTBBT REGION
|
||||
@@ -187,7 +187,7 @@ BLTCHAR :D8
|
||||
| ||||