diff --git a/library/TEDITMENU b/library/TEDITMENU index 09d5306ae..964aaf871 100644 --- a/library/TEDITMENU +++ b/library/TEDITMENU @@ -1,11 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "29-Apr-2021 22:44:22"  -{DSK}kaplan>Local>medley3.5>git-medley>library>TEDITMENU.;5 275764 - changes to%: (FNS \TEDIT.MENU.INIT) +(FILECREATED "26-Oct-2021 08:44:02"  +{DSK}kaplan>Local>medley3.5>git-medley>library>TEDITMENU.;3 276285 - previous date%: "29-Apr-2021 22:40:33" -{DSK}kaplan>Local>medley3.5>git-medley>library>TEDITMENU.;4) + changes to%: (FNS \TEXTMENU.START) + + previous date%: "29-Apr-2021 22:44:22" +{DSK}kaplan>Local>medley3.5>git-medley>library>TEDITMENU.;1) (* ; " @@ -19,7 +20,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) TEDITDCL)) - [COMS (* ; "Simple Menu Button support") + [COMS (* ; "Simple Menu Button support") (FNS MB.BUTTONEVENTINFN MB.DISPLAY MB.SETIMAGE MB.SELFN MB.SIZEFN MB.WHENOPERATEDFN MB.COPYFN MB.GETFN MB.PUTFN MB.SHOWSELFN MBUTTON.CREATE MBUTTON.CHANGENAME MBUTTON.FIND.BUTTON MBUTTON.FIND.NEXT.BUTTON MBUTTON.FIND.NEXT.FIELD MBUTTON.INIT @@ -31,13 +32,13 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MBUTTON.INIT)) (ADDVARS (IMAGEOBJTYPES (TEditMenuButton FILE TEDITMENU GETFN MB.GETFN] [COMS - (* ;; - "Three-state (ON-OFF-NEUTRAL) menu buttons, for, e.g., character properties like BOLD") + (* ;; + "Three-state (ON-OFF-NEUTRAL) menu buttons, for, e.g., character properties like BOLD") (FNS MB.CREATE.THREESTATEBUTTON MB.THREESTATE.DISPLAY MB.THREESTATE.SHOWSELFN MB.THREESTATE.WHENOPERATEDFN MB.THREESTATEBUTTON.FN THREESTATE.INIT) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (THREESTATE.INIT] - [COMS (* ; "One-of-N Menu button sets") + [COMS (* ; "One-of-N Menu button sets") (FNS MB.CREATE.NWAYBUTTON MB.NB.DISPLAYFN MB.NB.WHENOPERATEDFN MB.NB.SIZEFN MB.NWAYBUTTON.SELFN MB.NWAYMENU.NEWBUTTON NWAYBUTTON.INIT MB.NB.PACKITEMS MB.NWAYBUTTON.ADDITEM) @@ -45,7 +46,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (DECLARE%: DONTEVAL@LOAD DOCOPY (P (NWAYBUTTON.INIT)) (ADDVARS (IMAGEOBJTYPES (NWayButton FILE TEDITMENU GETFN MB.GETFN] [COMS - (* ;; "Two-state, toggling menu buttons.") + (* ;; "Two-state, toggling menu buttons.") (FNS \TEXTMENU.TOGGLE.CREATE \TEXTMENU.TOGGLE.DISPLAY \TEXTMENU.TOGGLE.SHOWSELFN \TEXTMENU.TOGGLE.WHENOPERATEDFN \TEXTMENU.TOGGLEFN \TEXTMENU.TOGGLE.INIT @@ -54,7 +55,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEXTMENU.TOGGLE.INIT)) (ADDVARS (IMAGEOBJTYPES (ToggleButton FILE TEDITMENU GETFN MB.GETFN] [COMS - (* ;; "Margin Setting and display") + (* ;; "Margin Setting and display") (FNS DRAWMARGINSCALE MARGINBAR MARGINBAR.CREATE MB.MARGINBAR.SELFN MB.MARGINBAR.SIZEFN MB.MARGINBAR.DISPLAYFN MDESCALE MSCALE MB.MARGINBAR.SHOWTAB MB.MARGINBAR.TABTRACK @@ -66,11 +67,11 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MARGINBAR.INIT)) (ADDVARS (IMAGEOBJTYPES (MarginRuler FILE TEDITMENU GETFN MB.GETFN] (COMS - (* ;; "Text menu creation and support") + (* ;; "Text menu creation and support") (FNS \TEXTMENU.START \TEXTMENU.DOC.CREATE TEXTMENU.CLOSEFN) (BITMAPS TEXTMENUICON TEXTMENUICONMASK)) - [COMS (* ; "TEdit-specific support") + [COMS (* ; "TEdit-specific support") (FNS \TEDITMENU.CREATE \TEDIT.EXPANDED.MENU MB.DEFAULTBUTTON.FN \TEDITMENU.RECORD.UNFORMATTED MB.DEFAULTBUTTON.ACTIONFN) (FNS \TEDIT.CHARLOOKSMENU.CREATE \TEDIT.EXPANDEDCHARLOOKS.MENU \TEDIT.APPLY.BOLDNESS @@ -82,7 +83,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. \TEDIT.SHOW.PARALOOKS \TEDIT.NEUTRALIZE.PARALOOKS.MENU \TEDIT.RECORD.TABLEADERS) (FNS \TEDIT.SHOW.PAGEFORMATTING \TEDITPAGEMENU.CREATE \TEDIT.APPLY.PAGEFORMATTING TEDIT.UNPARSE.PAGEFORMAT) - (COMS (* ; "Initialization Code") + (COMS (* ; "Initialization Code") (GLOBALVARS TEDIT.EXPANDED.MENU TEDIT.EXPANDEDPARA.MENU TEDIT.CHARLOOKS.MENU TEDIT.MENUDIVIDER.SPEC TEDIT.EXPANDEDMENU.SPEC TEDIT.CHARLOOKSMENU.SPEC TEDIT.PARAMENU.SPEC TEDIT.PAGEMENU.SPEC TEDIT.EXPANDED.PAGEMENU) @@ -2067,11 +2068,14 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (DEFINEQ (\TEXTMENU.START - [LAMBDA (MENU MAINWINDOW TITLE HEIGHT) (* ; + [LAMBDA (MENU MAINWINDOW TITLE HEIGHT) (* ; "Edited 26-Oct-2021 08:43 by rmk:") + (* ;  "Edited 4-Jun-93 11:59 by sybalsky:mv:envos") (* ;; "Create a TEdit-based menu for a given main window.") + (* ;; "RMK: Add MAX/MINSIZE so menus don't grow vertically when the main window is reshaped. Not sure why HEIGHT is passed in or defaults to 133, but either way, the original window height should persist") + (PROG ([WREG (COND (MAINWINDOW (WINDOWPROP MAINWINDOW 'REGION)) (T (GETREGION] @@ -2104,6 +2108,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (* ;  "Mark this as a TEDIT MENU window") (ATTACHWINDOW MENUW MAINWINDOW 'TOP 'JUSTIFY 'LOCALCLOSE) + [SETQ HEIGHT (FETCH (REGION HEIGHT) OF (WINDOWPROP MENUW 'REGION] + (WINDOWPROP MENUW 'MAXSIZE (CONS 64000 HEIGHT)) + (WINDOWPROP MENUW 'MINSIZE (CONS 0 HEIGHT)) (SETQ MENUTEXT MENU) (replace (TEXTOBJ MENUFLG) of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) with T) @@ -4524,20 +4531,20 @@ MB.CREATE.NWAYBUTTON 43946 . 47914) (MB.NB.DISPLAYFN 47916 . 50188) (MB.NB.WHENO 85254 . 88164) (MB.MARGINBAR.SELFN 88166 . 100760) (MB.MARGINBAR.SIZEFN 100762 . 101124) ( MB.MARGINBAR.DISPLAYFN 101126 . 103811) (MDESCALE 103813 . 104252) (MSCALE 104254 . 104588) ( MB.MARGINBAR.SHOWTAB 104590 . 106761) (MB.MARGINBAR.TABTRACK 106763 . 108098) (\TEDIT.TABTYPE.SET -108100 . 110807) (MARGINBAR.INIT 110809 . 111696)) (112715 130317 (\TEXTMENU.START 112725 . 115917) ( -\TEXTMENU.DOC.CREATE 115919 . 127443) (TEXTMENU.CLOSEFN 127445 . 130315)) (130627 150691 ( -\TEDITMENU.CREATE 130637 . 130937) (\TEDIT.EXPANDED.MENU 130939 . 131643) (MB.DEFAULTBUTTON.FN 131645 - . 134517) (\TEDITMENU.RECORD.UNFORMATTED 134519 . 134857) (MB.DEFAULTBUTTON.ACTIONFN 134859 . 150689) -) (150692 178075 (\TEDIT.CHARLOOKSMENU.CREATE 150702 . 152842) (\TEDIT.EXPANDEDCHARLOOKS.MENU 152844 - . 153218) (\TEDIT.APPLY.BOLDNESS 153220 . 153505) (\TEDIT.APPLY.CHARLOOKS 153507 . 155438) ( -\TEDIT.APPLY.OLINE 155440 . 155721) (\TEDIT.SHOW.CHARLOOKS 155723 . 157636) ( -\TEDIT.NEUTRALIZE.CHARLOOKS 157638 . 158564) (\TEDIT.FILL.IN.CHARLOOKS.MENU 158566 . 166219) ( -\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 166221 . 169104) (\TEDIT.PARSE.CHARLOOKS.MENU 169106 . 177214) ( -\TEDIT.APPLY.SLOPE 177216 . 177499) (\TEDIT.APPLY.STRIKEOUT 177501 . 177788) (\TEDIT.APPLY.ULINE -177790 . 178073)) (178076 210142 (\TEDITPARAMENU.CREATE 178086 . 178466) (\TEDIT.EXPANDEDPARA.MENU -178468 . 178788) (\TEDIT.APPLY.PARALOOKS 178790 . 191020) (\TEDIT.SHOW.PARALOOKS 191022 . 202549) ( -\TEDIT.NEUTRALIZE.PARALOOKS.MENU 202551 . 208622) (\TEDIT.RECORD.TABLEADERS 208624 . 210140)) (210143 -248145 (\TEDIT.SHOW.PAGEFORMATTING 210153 . 226693) (\TEDITPAGEMENU.CREATE 226695 . 227738) ( -\TEDIT.APPLY.PAGEFORMATTING 227740 . 240111) (TEDIT.UNPARSE.PAGEFORMAT 240113 . 248143)) (248450 -275299 (\TEDIT.MENU.INIT 248460 . 275297))))) +108100 . 110807) (MARGINBAR.INIT 110809 . 111696)) (112715 130838 (\TEXTMENU.START 112725 . 116438) ( +\TEXTMENU.DOC.CREATE 116440 . 127964) (TEXTMENU.CLOSEFN 127966 . 130836)) (131148 151212 ( +\TEDITMENU.CREATE 131158 . 131458) (\TEDIT.EXPANDED.MENU 131460 . 132164) (MB.DEFAULTBUTTON.FN 132166 + . 135038) (\TEDITMENU.RECORD.UNFORMATTED 135040 . 135378) (MB.DEFAULTBUTTON.ACTIONFN 135380 . 151210) +) (151213 178596 (\TEDIT.CHARLOOKSMENU.CREATE 151223 . 153363) (\TEDIT.EXPANDEDCHARLOOKS.MENU 153365 + . 153739) (\TEDIT.APPLY.BOLDNESS 153741 . 154026) (\TEDIT.APPLY.CHARLOOKS 154028 . 155959) ( +\TEDIT.APPLY.OLINE 155961 . 156242) (\TEDIT.SHOW.CHARLOOKS 156244 . 158157) ( +\TEDIT.NEUTRALIZE.CHARLOOKS 158159 . 159085) (\TEDIT.FILL.IN.CHARLOOKS.MENU 159087 . 166740) ( +\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 166742 . 169625) (\TEDIT.PARSE.CHARLOOKS.MENU 169627 . 177735) ( +\TEDIT.APPLY.SLOPE 177737 . 178020) (\TEDIT.APPLY.STRIKEOUT 178022 . 178309) (\TEDIT.APPLY.ULINE +178311 . 178594)) (178597 210663 (\TEDITPARAMENU.CREATE 178607 . 178987) (\TEDIT.EXPANDEDPARA.MENU +178989 . 179309) (\TEDIT.APPLY.PARALOOKS 179311 . 191541) (\TEDIT.SHOW.PARALOOKS 191543 . 203070) ( +\TEDIT.NEUTRALIZE.PARALOOKS.MENU 203072 . 209143) (\TEDIT.RECORD.TABLEADERS 209145 . 210661)) (210664 +248666 (\TEDIT.SHOW.PAGEFORMATTING 210674 . 227214) (\TEDITPAGEMENU.CREATE 227216 . 228259) ( +\TEDIT.APPLY.PAGEFORMATTING 228261 . 240632) (TEDIT.UNPARSE.PAGEFORMAT 240634 . 248664)) (248971 +275820 (\TEDIT.MENU.INIT 248981 . 275818))))) STOP diff --git a/library/TEDITMENU.LCOM b/library/TEDITMENU.LCOM index 82a4450c9..cc706b99a 100644 Binary files a/library/TEDITMENU.LCOM and b/library/TEDITMENU.LCOM differ diff --git a/sources/CLSTREAMS b/sources/CLSTREAMS index 527c1c1db..9e8c01b68 100644 --- a/sources/CLSTREAMS +++ b/sources/CLSTREAMS @@ -1,104 +1,94 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED " 3-Apr-91 15:11:53" |{PELE:MV:ENVOS}SOURCES>CLSTREAMS.;4| 54013 - |changes| |to:| (FUNCTIONS CL:WITH-INPUT-FROM-STRING) +(FILECREATED "27-Nov-2021 13:30:46"  +|{DSK}kaplan>Local>medley3.5>my-medley>sources>CLSTREAMS.;3| 53235 - |previous| |date:| "27-Feb-91 20:05:55" |{PELE:MV:ENVOS}SOURCES>CLSTREAMS.;3|) + |previous| |date:| " 3-Apr-91 15:11:53" +|{DSK}kaplan>Local>medley3.5>my-medley>sources>CLSTREAMS.;2|) -; Copyright (c) 1985, 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All rights reserved. +; Copyright (c) 1985-1988, 1990-1991 by Venue & Xerox Corporation. (PRETTYCOMPRINT CLSTREAMSCOMS) -(RPAQQ CLSTREAMSCOMS ( +(RPAQQ CLSTREAMSCOMS + ( (* |;;;| "Implements a number of stream functions from CommonLisp. See CLtL chapter 21") - (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 %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 %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))) + (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 %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 %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))) @@ -111,10 +101,10 @@ (CL:DEFUN OPEN (FILENAME &KEY (DIRECTION :INPUT) - (ELEMENT-TYPE 'CL:STRING-CHAR) - (IF-EXISTS NIL EXISTS-P) - (IF-DOES-NOT-EXIST NIL DOES-NOT-EXIST-P) - (EXTERNAL-FORMAT :DEFAULT)) + (ELEMENT-TYPE 'CL:STRING-CHAR) + (IF-EXISTS NIL EXISTS-P) + (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.") @@ -134,10 +124,10 @@ (FOR-OUTPUT (MEMQ DIRECTION '(:IO :OUTPUT))) (ACCESS (INTERLISP-ACCESS DIRECTION)) (FILE-TYPE (IF (CL:MEMBER ELEMENT-TYPE '(CL:UNSIGNED-BYTE CL:SIGNED-BYTE (CL:UNSIGNED-BYTE - 8) - (CL:SIGNED-BYTE 8)) - :TEST - 'CL:EQUAL) + 8) + (CL:SIGNED-BYTE 8)) + :TEST + 'CL:EQUAL) THEN 'BINARY ELSE 'TEXT)) (STREAM NIL)) @@ -149,7 +139,7 @@ :NEWEST) :NEW-VERSION :ERROR))) (* \; - "If the file does not exist, it is OK to have :if-exists :overwrite. ") + "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) @@ -159,101 +149,98 @@ NIL) (T :CREATE)))) (CL:LOOP (* \; - "See if the file exists and handle the existential keywords.") + "See if the file exists and handle the existential keywords.") (LET* ((NAME (PREDICT-NAME PATHNAME)) (CL:NAMESTRING (MKSTRING NAME))) (IF NAME - THEN (* \; "file exists") - (IF FOR-OUTPUT - THEN - - (* |;;| "open for output/both") - - (CASE IF-EXISTS - (:ERROR - (CL:CERROR "write it anyway." "File ~A already exists." - CL:NAMESTRING) - (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS NIL - `((TYPE ,FILE-TYPE) - (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) - (RETURN NIL)) - ((:NEW-VERSION :SUPERSEDE :RENAME :RENAME-AND-DELETE) - (SETQ STREAM (OPENSTREAM PATHNAME ACCESS 'NEW - `((TYPE ,FILE-TYPE) - (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) - (RETURN NIL)) - (:OVERWRITE - (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS 'OLD - `((TYPE ,FILE-TYPE) - (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) - (RETURN NIL)) - (:APPEND - (IF (EQ DIRECTION :OUTPUT) - 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") - (SETQ STREAM (OPENSTREAM CL:NAMESTRING 'BOTH - 'OLD - `((TYPE ,FILE-TYPE) - (EXTERNALFORMAT ,EXTERNAL-FORMAT) - ))) - (SETFILEPTR STREAM -1)) - (RETURN NIL)) - ((NIL) (CL:RETURN-FROM OPEN NIL)) - (T (CL:ERROR "~S is not a valid value for :if-exists." IF-EXISTS))) - |elseif| FOR-INPUT - |then| - - (* |;;| "open for input/both") - - (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS 'OLD - `((TYPE ,FILE-TYPE) - (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) - (RETURN NIL) - |else| - - (* |;;| "open for probe") - - (SETQ STREAM (|create| STREAM - FULLFILENAME _ (FULLNAME CL:NAMESTRING))) - (RETURN NIL)) + THEN (* \; "file exists") + (IF FOR-OUTPUT + THEN + (* |;;| "open for output/both") + + (CASE IF-EXISTS + (:ERROR + (CL:CERROR "write it anyway." "File ~A already exists." + CL:NAMESTRING) + (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS NIL + `((TYPE ,FILE-TYPE) + (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) + (RETURN NIL)) + ((:NEW-VERSION :SUPERSEDE :RENAME :RENAME-AND-DELETE) + (SETQ STREAM (OPENSTREAM PATHNAME ACCESS 'NEW + `((TYPE ,FILE-TYPE) + (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) + (RETURN NIL)) + (:OVERWRITE + (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS 'OLD + `((TYPE ,FILE-TYPE) + (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) + (RETURN NIL)) + (:APPEND + (IF (EQ DIRECTION :OUTPUT) + 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") + (SETQ STREAM (OPENSTREAM CL:NAMESTRING 'BOTH 'OLD + `((TYPE ,FILE-TYPE) + (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) + (SETFILEPTR STREAM -1)) + (RETURN NIL)) + ((NIL) (CL:RETURN-FROM OPEN NIL)) + (T (CL:ERROR "~S is not a valid value for :if-exists." IF-EXISTS))) + |elseif| FOR-INPUT + |then| + + (* |;;| "open for input/both") + + (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS 'OLD + `((TYPE ,FILE-TYPE) + (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) + (RETURN NIL) + |else| + + (* |;;| "open for probe") + + (SETQ STREAM (|create| STREAM + FULLFILENAME _ (FULLNAME CL:NAMESTRING))) + (RETURN NIL)) |else| (* |;;| "file does not exist") (|if| FOR-OUTPUT |then| (CASE IF-DOES-NOT-EXIST - (:ERROR - (CL:CERROR "prompt for a new name." 'XCL:FILE-NOT-FOUND - :PATHNAME PATHNAME) - (CL:FORMAT *QUERY-IO* "~&New file name: ") - (SETQ PATHNAME (PATHNAME (CL:READ-LINE *QUERY-IO*)))) - (:CREATE - (SETQ STREAM (OPENSTREAM PATHNAME ACCESS 'NEW - `((TYPE ,FILE-TYPE) - (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) - (RETURN NIL)) - ((NIL) (CL:RETURN-FROM OPEN NIL)) - (T (CL:ERROR "~S is not a valid value for :if-does-not-exist." - IF-DOES-NOT-EXIST))) + (:ERROR + (CL:CERROR "prompt for a new name." 'XCL:FILE-NOT-FOUND + :PATHNAME PATHNAME) + (CL:FORMAT *QUERY-IO* "~&New file name: ") + (SETQ PATHNAME (PATHNAME (CL:READ-LINE *QUERY-IO*)))) + (:CREATE + (SETQ STREAM (OPENSTREAM PATHNAME ACCESS 'NEW + `((TYPE ,FILE-TYPE) + (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) + (RETURN NIL)) + ((NIL) (CL:RETURN-FROM OPEN NIL)) + (T (CL:ERROR "~S is not a valid value for :if-does-not-exist." + IF-DOES-NOT-EXIST))) |elseif| FOR-INPUT |then| (CASE IF-DOES-NOT-EXIST - (:ERROR - (CL:CERROR "prompt for a new name." 'XCL:FILE-NOT-FOUND - :PATHNAME PATHNAME) - (CL:FORMAT *QUERY-IO* "~&New file name: ") - (SETQ PATHNAME (PATHNAME (CL:READ-LINE *QUERY-IO*)))) - (:CREATE (%NEW-FILE PATHNAME)) - ((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.") + (:ERROR + (CL:CERROR "prompt for a new name." 'XCL:FILE-NOT-FOUND + :PATHNAME PATHNAME) + (CL:FORMAT *QUERY-IO* "~&New file name: ") + (SETQ PATHNAME (PATHNAME (CL:READ-LINE *QUERY-IO*)))) + (:CREATE (%NEW-FILE PATHNAME)) + ((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.") (RETURN NIL))))) (STREAMPROP STREAM :FILE-STREAM-P T) STREAM)) @@ -264,18 +251,18 @@ (|if| (STREAMP STREAM) |then| (|if| (OPENP STREAM) - |then| - - (* |;;| - "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.") - (DELFILE (CL:NAMESTRING STREAM))))) + |then| + + (* |;;| + "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.") + (DELFILE (CL:NAMESTRING STREAM))))) |else| (ERROR "Closing a non-stream" STREAM)) T) @@ -323,15 +310,19 @@ DEVICE _ %SYNONYM-STREAM-DEVICE ACCESS _ 'BOTH F1 _ CL:SYMBOL - LINELENGTH _ (|fetch| (STREAM LINELENGTH) |of| (CL:SYMBOL-VALUE - CL:SYMBOL)) + LINELENGTH _ (|fetch| (STREAM LINELENGTH) |of| (CL:SYMBOL-VALUE CL:SYMBOL)) 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") - (|replace| (FDEV OPENFILELST) |of| %SYNONYM-STREAM-DEVICE - |with| (CONS STREAM (|fetch| (FDEV OPENFILELST) |of| %SYNONYM-STREAM-DEVICE))) + (|replace| (FDEV OPENFILELST) |of| %SYNONYM-STREAM-DEVICE |with| (CONS STREAM + (|fetch| (FDEV + OPENFILELST + ) + |of| + %SYNONYM-STREAM-DEVICE + ))) STREAM)) (CL:DEFUN XCL:SYNONYM-STREAM-P (STREAM) @@ -355,14 +346,14 @@ (IF (FOR STREAM? IN STREAMS ALWAYS (STREAMP STREAM?)) THEN (LET ((STREAM (|create| STREAM - DEVICE _ %BROADCAST-STREAM-DEVICE - ACCESS _ 'OUTPUT - F1 _ STREAMS - OUTCHARFN _ (FUNCTION %BROADCAST-STREAM-DEVICE-OUTCHARFN)))) - (STREAMPROP STREAM 'XCL:BROADCAST-STREAM-P T) - STREAM) + DEVICE _ %BROADCAST-STREAM-DEVICE + ACCESS _ 'OUTPUT + F1 _ STREAMS + OUTCHARFN _ (FUNCTION %BROADCAST-STREAM-DEVICE-OUTCHARFN)))) + (STREAMPROP STREAM 'XCL:BROADCAST-STREAM-P T) + STREAM) ELSE (\\ILLEGAL.ARG (FOR STREAM? IN STREAMS WHEN (NOT (STREAMP STREAM?)) - DO (RETURN STREAM?))))) + DO (RETURN STREAM?))))) (CL:DEFUN XCL:BROADCAST-STREAM-P (STREAM) @@ -383,13 +374,13 @@ (IF (FOR STREAM? IN STREAMS ALWAYS (STREAMP STREAM?)) THEN (LET ((STREAM (|create| STREAM - DEVICE _ %CONCATENATED-STREAM-DEVICE - ACCESS _ 'INPUT - F1 _ STREAMS))) - (STREAMPROP STREAM 'XCL:CONCATENATED-STREAM-P T) - STREAM) + DEVICE _ %CONCATENATED-STREAM-DEVICE + ACCESS _ 'INPUT + F1 _ STREAMS))) + (STREAMPROP STREAM 'XCL:CONCATENATED-STREAM-P T) + STREAM) ELSE (\\ILLEGAL.ARG (FOR STREAM? IN STREAMS WHEN (NOT (STREAMP STREAM?)) - DO (RETURN STREAM?))))) + DO (RETURN STREAM?))))) (CL:DEFUN XCL:CONCATENATED-STREAM-P (STREAM) (STREAMPROP STREAM 'XCL:CONCATENATED-STREAM-P)) @@ -420,8 +411,13 @@ (* |;;| "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))) + (|replace| (FDEV OPENFILELST) |of| %TWO-WAY-STREAM-DEVICE |with| (CONS STREAM + (|fetch| (FDEV + OPENFILELST + ) + |of| + %TWO-WAY-STREAM-DEVICE + ))) STREAM)) (CL:DEFUN XCL:TWO-WAY-STREAM-P (STREAM) @@ -457,8 +453,13 @@ (* |;;| "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))) + (|replace| (FDEV OPENFILELST) |of| %ECHO-STREAM-DEVICE |with| (CONS STREAM + (|fetch| (FDEV + OPENFILELST + ) + |of| + %ECHO-STREAM-DEVICE + ))) STREAM)) (CL:DEFUN XCL:ECHO-STREAM-P (STREAM) @@ -476,12 +477,12 @@ (FETCH (STREAM F2) OF STREAM))) (CL:DEFUN CL:MAKE-STRING-INPUT-STREAM (STRING &OPTIONAL (CL::START 0) - (CL::END NIL)) + (CL::END NIL)) (* |;;;| "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))) + (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. ") @@ -497,9 +498,9 @@ NIL) ((NULL (CL:REST STRINGS)) (CL:MAKE-STRING-INPUT-STREAM (CL:FIRST STRINGS))) - (T (CL:APPLY 'CL:MAKE-CONCATENATED-STREAM (FOR STRING IN STRINGS - COLLECT (CL:MAKE-STRING-INPUT-STREAM - STRING)))))) + (T (CL:APPLY 'CL:MAKE-CONCATENATED-STREAM (FOR STRING IN STRINGS COLLECT ( + CL:MAKE-STRING-INPUT-STREAM + STRING)))))) (CL:DEFUN %MAKE-INITIAL-STRING-STREAM-CONTENTS () (CL:MAKE-ARRAY '(256) @@ -507,8 +508,8 @@ 'CL:STRING-CHAR :EXTENDABLE T :FILL-POINTER 0)) (DEFMACRO CL:WITH-OPEN-STREAM ((VAR STREAM) - &BODY - (BODY DECLS)) + &BODY + (BODY DECLS)) (LET ((ABORTP (GENSYM))) `(LET ((,VAR ,STREAM) (,ABORTP T)) @@ -519,15 +520,15 @@ (CL:CLOSE ,VAR :ABORT ,ABORTP))))) (DEFMACRO CL:WITH-INPUT-FROM-STRING ((CL::VAR STRING &KEY (CL::INDEX NIL CL::INDEXP) - (CL::START 0 CL::STARTP) - (CL::END NIL CL:ENDP)) - &BODY - (CL::BODY CL::DECLS)) + (CL::START 0 CL::STARTP) + (CL::END NIL CL:ENDP)) + &BODY + (CL::BODY CL::DECLS)) `(LET* ((CL::$STRING$ ,STRING) (CL::$START$ ,CL::START)) (DECLARE (LOCALVARS CL::$STRING$ CL::$START$)) - (CL:WITH-OPEN-STREAM (,CL::VAR (CL:MAKE-STRING-INPUT-STREAM CL::$STRING$ - CL::$START$ ,CL::END)) + (CL:WITH-OPEN-STREAM (,CL::VAR (CL:MAKE-STRING-INPUT-STREAM CL::$STRING$ CL::$START$ + ,CL::END)) ,@CL::DECLS ,@(CL:IF CL::INDEXP @@ -541,8 +542,8 @@ CL::BODY)))) (DEFMACRO CL:WITH-OUTPUT-TO-STRING ((VAR &OPTIONAL (STRING NIL ST-P)) - &BODY - (FORMS DECLS)) + &BODY + (FORMS DECLS)) (COND (ST-P `(CL:WITH-OPEN-STREAM (,VAR (MAKE-FILL-POINTER-OUTPUT-STREAM ,STRING)) ,@DECLS @@ -552,8 +553,8 @@ (PROGN ,@FORMS (CL:GET-OUTPUT-STREAM-STRING ,VAR)))))) (DEFMACRO CL:WITH-OPEN-FILE ((VAR &REST OPEN-ARGS) - &BODY - (FORMS DECLS)) + &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.") @@ -572,26 +573,26 @@ (MAKE-FILL-POINTER-OUTPUT-STREAM)) -(CL:DEFUN MAKE-FILL-POINTER-OUTPUT-STREAM (&OPTIONAL (STRING ( - %MAKE-INITIAL-STRING-STREAM-CONTENTS - ))) +(CL:DEFUN MAKE-FILL-POINTER-OUTPUT-STREAM (&OPTIONAL (STRING (%MAKE-INITIAL-STRING-STREAM-CONTENTS))) (DECLARE (GLOBALVARS \\FILL-POINTER-STREAM-DEVICE)) (|if| (NOT (CL:ARRAY-HAS-FILL-POINTER-P STRING)) |then| (\\ILLEGAL.ARG STRING) |else| (LET ((STREAM (|create| STREAM - DEVICE _ \\FILL-POINTER-STREAM-DEVICE - F1 _ STRING - ACCESS _ 'OUTPUT - OTHERPROPS _ '(STRING-OUTPUT-STREAM T)))) + DEVICE _ \\FILL-POINTER-STREAM-DEVICE + F1 _ STRING + ACCESS _ 'OUTPUT + OTHERPROPS _ '(STRING-OUTPUT-STREAM T)))) (* \; - "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) - |else| (FUNCTION \\STRING-STREAM-OUTCHARFN))) - (|replace| (STREAM STRMBOUTFN) |of| STREAM |with| - (FUNCTION \\OUTCHAR)) - STREAM))) + "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 + ) + |else| (FUNCTION + \\STRING-STREAM-OUTCHARFN + ))) + (|replace| (STREAM STRMBOUTFN) |of| STREAM |with| (FUNCTION \\OUTCHAR)) + STREAM))) (CL:DEFUN CL:GET-OUTPUT-STREAM-STRING (STRING-OUTPUT-STREAM) @@ -600,17 +601,17 @@ (|if| (NOT (STREAMPROP STRING-OUTPUT-STREAM 'STRING-OUTPUT-STREAM)) |then| (ERROR "Stream not a string-output-stream" STRING-OUTPUT-STREAM) |else| (PROG1 (|fetch| (STREAM F1) |of| STRING-OUTPUT-STREAM) - (|replace| (STREAM F1) |of| STRING-OUTPUT-STREAM |with| ( - %MAKE-INITIAL-STRING-STREAM-CONTENTS - ))))) + (|replace| (STREAM F1) |of| STRING-OUTPUT-STREAM |with| ( + %MAKE-INITIAL-STRING-STREAM-CONTENTS + ))))) (CL:DEFUN \\STRING-STREAM-OUTCHARFN (STREAM CHAR) (IF (OR (IEQP (FETCH (STREAM CHARPOSITION) OF STREAM) - (FETCH (STREAM LINELENGTH) OF STREAM)) - (EQ CHAR (CHARCODE EOL))) + (FETCH (STREAM LINELENGTH) OF STREAM)) + (EQ CHAR (CHARCODE EOL))) THEN (REPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) ELSE (ADD (FETCH (STREAM CHARPOSITION) OF STREAM) - 1)) + 1)) (CL:VECTOR-PUSH (CL:CHARACTER CHAR) (FETCH (STREAM F1) OF STREAM))) @@ -618,11 +619,11 @@ (LET ((STRING (FETCH (STREAM F1) OF STREAM)) (CH (CL:CHARACTER CHAR))) (IF (OR (IEQP (FETCH (STREAM CHARPOSITION) OF STREAM) - (FETCH (STREAM LINELENGTH) OF STREAM)) - (EQ CHAR (CHARCODE EOL))) + (FETCH (STREAM LINELENGTH) OF STREAM)) + (EQ CHAR (CHARCODE EOL))) THEN (REPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) ELSE (ADD (FETCH (STREAM CHARPOSITION) OF STREAM) - 1)) + 1)) (* |;;| "Do the equivalent of VECTOR-PUSH-EXTEND inline to save the significant! overhead of calculating the new length at each character.") @@ -630,17 +631,16 @@ (LET ((CURRENT-LENGTH (CL:ARRAY-TOTAL-SIZE STRING))) (IF (>= CURRENT-LENGTH (CL:1- CL:ARRAY-TOTAL-SIZE-LIMIT)) THEN (PROCEED-CASE (CL:ERROR 'END-OF-FILE :STREAM STREAM) - (SI::RETRY-OUTCHAR NIL :REPORT - "VECTOR-PUSH the character anyway" :CONDITION END-OF-FILE - (CL:VECTOR-PUSH CH (FETCH (STREAM F1) OF STREAM)) - )) + (SI::RETRY-OUTCHAR NIL :REPORT "VECTOR-PUSH the character anyway" + :CONDITION END-OF-FILE (CL:VECTOR-PUSH CH (FETCH (STREAM + F1) + OF STREAM)))) ELSE (CL:ADJUST-ARRAY STRING (MIN (CL:1- CL:ARRAY-TOTAL-SIZE-LIMIT) - (+ CURRENT-LENGTH (MAX (LRSH CURRENT-LENGTH - 1) - + (+ CURRENT-LENGTH (MAX (LRSH CURRENT-LENGTH 1) + *DEFAULT-PUSH-EXTENSION-SIZE* - )))) - (CL:VECTOR-PUSH CH STRING)))))) + )))) + (CL:VECTOR-PUSH CH STRING)))))) @@ -691,8 +691,7 @@ (* |;;| "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)))) + (FOR S IN (FETCH (STREAM F1) OF STREAM) DO (SETQ $$VAL (ACCESS-CHARSET S NEWVALUE)))) (DEFINEQ (%concatenated-stream-device-bin @@ -723,7 +722,7 @@ (LET ((STREAMS (FETCH (STREAM F1) OF STREAM))) (IF STREAMS THEN (ACCESS-CHARSET (CAR STREAMS) - NEWVALUE) + NEWVALUE) ELSE 0))) (DEFINEQ @@ -933,7 +932,7 @@ (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))) @@ -953,27 +952,51 @@ (%INITIALIZE-STANDARD-STREAMS) ) -(PUTPROPS CLSTREAMS FILETYPE CL:COMPILE-FILE) +(PUTPROPS CLSTREAMS FILETYPE CL:COMPILE-FILE) (PUTPROPS CLSTREAMS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991)) (DECLARE\: DONTCOPY - (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))))) + (FILEMAP (NIL (5167 14142 (OPEN 5167 . 14142)) (14144 15070 (CL:CLOSE 14144 . 15070)) (15072 15150 ( +CL:STREAM-EXTERNAL-FORMAT 15072 . 15150)) (15152 15219 (CL:STREAM-ELEMENT-TYPE 15152 . 15219)) (15221 +15455 (CL:INPUT-STREAM-P 15221 . 15455)) (15457 15693 (CL:OUTPUT-STREAM-P 15457 . 15693)) (15695 15832 + (XCL:OPEN-STREAM-P 15695 . 15832)) (15834 15901 (FILE-STREAM-POSITION 15834 . 15901)) (15953 17296 ( +CL:MAKE-SYNONYM-STREAM 15953 . 17296)) (17298 17387 (XCL:SYNONYM-STREAM-P 17298 . 17387)) (17389 17527 + (XCL:SYNONYM-STREAM-SYMBOL 17389 . 17527)) (17529 17807 (XCL:FOLLOW-SYNONYM-STREAMS 17529 . 17807)) ( +17809 18568 (CL:MAKE-BROADCAST-STREAM 17809 . 18568)) (18570 18713 (XCL:BROADCAST-STREAM-P 18570 . +18713)) (18715 18930 (XCL:BROADCAST-STREAM-STREAMS 18715 . 18930)) (18932 19617 ( +CL:MAKE-CONCATENATED-STREAM 18932 . 19617)) (19619 19718 (XCL:CONCATENATED-STREAM-P 19619 . 19718)) ( +19720 19933 (XCL:CONCATENATED-STREAM-STREAMS 19720 . 19933)) (19935 21519 (CL:MAKE-TWO-WAY-STREAM +19935 . 21519)) (21521 21658 (XCL:TWO-WAY-STREAM-P 21521 . 21658)) (21660 21805 ( +XCL:TWO-WAY-STREAM-OUTPUT-STREAM 21660 . 21805)) (21807 21951 (XCL:TWO-WAY-STREAM-INPUT-STREAM 21807 + . 21951)) (21953 23503 (CL:MAKE-ECHO-STREAM 21953 . 23503)) (23505 23634 (XCL:ECHO-STREAM-P 23505 . +23634)) (23636 23774 (XCL:ECHO-STREAM-INPUT-STREAM 23636 . 23774)) (23776 23915 ( +XCL:ECHO-STREAM-OUTPUT-STREAM 23776 . 23915)) (23917 24644 (CL:MAKE-STRING-INPUT-STREAM 23917 . 24644) +) (24646 25139 (MAKE-CONCATENATED-STRING-INPUT-STREAM 24646 . 25139)) (25141 25301 ( +%MAKE-INITIAL-STRING-STREAM-CONTENTS 25141 . 25301)) (28348 29874 (MAKE-FILL-POINTER-OUTPUT-STREAM +28348 . 29874)) (29876 30597 (CL:GET-OUTPUT-STREAM-STRING 29876 . 30597)) (30599 31078 ( +\\STRING-STREAM-OUTCHARFN 30599 . 31078)) (31080 32935 (\\ADJUSTABLE-STRING-STREAM-OUTCHARFN 31080 . +32935)) (32964 33046 (%NEW-FILE 32964 . 33046)) (33048 33193 (PREDICT-NAME 33048 . 33193)) (33434 +34622 (%BROADCAST-STREAM-DEVICE-BOUT 33444 . 33667) (%BROADCAST-STREAM-DEVICE-OUTCHARFN 33669 . 34120) + (%BROADCAST-STREAM-DEVICE-CLOSEFILE 34122 . 34361) (%BROADCAST-STREAM-DEVICE-FORCEOUTPUT 34363 . +34620)) (34624 34951 (%BROADCAST-STREAM-DEVICE-CHARSETFN 34624 . 34951)) (34952 37011 ( +%CONCATENATED-STREAM-DEVICE-BIN 34962 . 35367) (%CONCATENATED-STREAM-DEVICE-CLOSEFILE 35369 . 35682) ( +%CONCATENATED-STREAM-DEVICE-EOFP 35684 . 36048) (%CONCATENATED-STREAM-DEVICE-PEEKBIN 36050 . 36525) ( +%CONCATENATED-STREAM-DEVICE-BACKFILEPTR 36527 . 37009)) (37013 37344 ( +%CONCATENATED-STREAM-DEVICE-CHARSETFN 37013 . 37344)) (37345 37564 (%ECHO-STREAM-DEVICE-BIN 37355 . +37562)) (37566 37791 (%SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM 37566 . 37791)) (37792 41137 ( +%SYNONYM-STREAM-DEVICE-BIN 37802 . 37990) (%SYNONYM-STREAM-DEVICE-BOUT 37992 . 38193) ( +%SYNONYM-STREAM-DEVICE-OUTCHARFN 38195 . 38902) (%SYNONYM-STREAM-DEVICE-CLOSEFILE 38904 . 39488) ( +%SYNONYM-STREAM-DEVICE-EOFP 39490 . 39681) (%SYNONYM-STREAM-DEVICE-FORCEOUTPUT 39683 . 39921) ( +%SYNONYM-STREAM-DEVICE-GETFILEINFO 39923 . 40160) (%SYNONYM-STREAM-DEVICE-PEEKBIN 40162 . 40385) ( +%SYNONYM-STREAM-DEVICE-READP 40387 . 40498) (%SYNONYM-STREAM-DEVICE-BACKFILEPTR 40500 . 40646) ( +%SYNONYM-STREAM-DEVICE-SETFILEINFO 40648 . 40897) (%SYNONYM-STREAM-DEVICE-CHARSETFN 40899 . 41135)) ( +41138 45463 (%TWO-WAY-STREAM-DEVICE-BIN 41148 . 41321) (%TWO-WAY-STREAM-DEVICE-INPUTSTREAM 41323 . +41514) (%TWO-WAY-STREAM-DEVICE-BOUT 41516 . 41688) (%TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 41690 . 41880) + (%TWO-WAY-STREAM-DEVICE-OUTCHARFN 41882 . 42744) (%TWO-WAY-STREAM-DEVICE-CLOSEFILE 42746 . 44169) ( +%TWO-WAY-STREAM-DEVICE-EOFP 44171 . 44347) (%TWO-WAY-STREAM-DEVICE-READP 44349 . 44542) ( +%TWO-WAY-STREAM-DEVICE-BACKFILEPTR 44544 . 44680) (%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 44682 . 44911) ( +%TWO-WAY-STREAM-DEVICE-PEEKBIN 44913 . 45126) (%TWO-WAY-STREAM-DEVICE-CHARSETFN 45128 . 45461)) (45465 + 45690 (%FILL-POINTER-STREAM-DEVICE-CLOSEFILE 45465 . 45690)) (45692 45811 ( +%FILL-POINTER-STREAM-DEVICE-GETFILEPTR 45692 . 45811)) (46051 46290 (%SYNONYM-STREAM-DEVICE-GET-STREAM + 46061 . 46288)) (46521 46997 (%INITIALIZE-STANDARD-STREAMS 46521 . 46997)) (46998 52961 ( +%INITIALIZE-CLSTREAM-TYPES 47008 . 52959))))) STOP diff --git a/sources/CLSTREAMS.LCOM b/sources/CLSTREAMS.LCOM index da600d386..6e87e8270 100644 Binary files a/sources/CLSTREAMS.LCOM and b/sources/CLSTREAMS.LCOM differ diff --git a/sources/EDITINTERFACE b/sources/EDITINTERFACE index 79677383c..24af3d91c 100644 --- a/sources/EDITINTERFACE +++ b/sources/EDITINTERFACE @@ -1,13 +1,14 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Nov-91 18:15:13" |{PELE:MV:ENVOS}SOURCES>EDITINTERFACE.;6| 38377 - changes to%: (FUNCTIONS ED) +(FILECREATED "27-Nov-2021 13:28:18"  +{DSK}kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;2 37858 - previous date%: " 5-Feb-91 11:44:57" |{PELE:MV:ENVOS}SOURCES>EDITINTERFACE.;5|) + previous date%: " 7-Nov-91 18:15:13" +{DSK}kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;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. ") (PRETTYCOMPRINT EDITINTERFACECOMS) @@ -93,8 +94,8 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All ri ) -(RPAQQ DUMMY-EDIT-FUNCTION-BODY [LAMBDA (ARGS ...) - BODY]) +(RPAQQ DUMMY-EDIT-FUNCTION-BODY [LAMBDA (ARGS |...|) + BODY]) (CL:DEFVAR *ED-OFFERS-PROPERTY-LIST* T "Controls whether ED offers property list as an editable aspect") @@ -102,7 +103,7 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All ri (DEFGLOBALVAR XCL::ED-LAST-INFO NIL "used in ED to stash last call info so (ED NIL) will restart last edit") -(CL:DEFUN ED (CL::NAME CL::OPTIONS) (* ; "Edited 5-Jul-88 16:03 by woz") +(CL:DEFUN ED (CL::NAME CL::OPTIONS) (* ; "Edited 5-Jul-88 16:03 by woz") (* ;;; "Standard Common Lisp editor entry. CLtL say's ED does something reasonable when passed a pathname. We coerce name into something that might be the name of something with an IL:FILES definition, & try to edit that. Then save call info in ED-LAST-INFO, so (ED) will start last edit over again.") @@ -124,8 +125,7 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All ri (CL:MEMBER :DISPLAY CL::OPTIONS) (CL:MEMBER 'DISPLAY CL::OPTIONS))) (CL::GIVEN-TYPES (for X inside CL::OPTIONS when (NEQ X T) bind TYPE - when (CL:SETQ TYPE (GETFILEPKGTYPE X 'TYPES T CL::NAME)) - collect TYPE)) + when (CL:SETQ TYPE (GETFILEPKGTYPE X 'TYPES T CL::NAME)) collect TYPE)) [CL::TYPES-WITH-DEFNS (TYPESOF CL::NAME CL::GIVEN-TYPES NIL (CL:IF (OR (CL:MEMBER :CURRENT CL::OPTIONS) (CL:MEMBER 'CURRENT CL::OPTIONS)) @@ -138,9 +138,9 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All ri ([AND (NULL CL::GIVEN-TYPES) (CL:SYMBOLP CL::NAME) (NOT (NULL *ED-OFFERS-PROPERTY-LIST*)) - (find X on (GETPROPLIST CL::NAME) - by (CDDR X) suchthat (NULL (GET (CAR X) - 'PROPTYPE] + (find X on (GETPROPLIST CL::NAME) by (CDDR X) + suchthat (NULL (GET (CAR X) + 'PROPTYPE] (* ;; "if we're supposed to offer PROPERTY-LIST as an edit type, and this name has a property list with other than system properties on it, then add IL:PROPERTY-LIST to the possible types.") @@ -150,60 +150,55 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All ri (CL:WHEN (CL:MEMBER 'PROPERTY-LIST CL::OPTIONS) (* ;; - "this will allow PROPERTY-LIST to be specified as a fake filepkg type by the user (caller)") + "this will allow PROPERTY-LIST to be specified as a fake filepkg type by the user (caller)") (CL:SETQ CL::POSSIBLE-TYPES '(PROPERTY-LIST))) [CL:SETQ TYPE (if (CL:MEMBER :NEW CL::OPTIONS) then + (* ;; "if :NEW then install a blank definition first") - (* ;; "if :NEW then install a blank definition first") - - (OR (INSTALL-PROTOTYPE-DEFN CL::NAME (OR CL::TYPES-WITH-DEFNS - CL::GIVEN-TYPES) - :NEW) - (CL:RETURN-FROM ED NIL)) + (OR (INSTALL-PROTOTYPE-DEFN CL::NAME (OR CL::TYPES-WITH-DEFNS + CL::GIVEN-TYPES) + :NEW) + (CL:RETURN-FROM ED NIL)) elseif (CDR CL::POSSIBLE-TYPES) then + (* ;; "Many types were found/given. Ask the user which to use.") - (* ;; "Many types were found/given. Ask the user which to use.") - - (if CL::FROM-DISPLAY - then (OR (MENU (create MENU - ITEMS _ CL::POSSIBLE-TYPES - TITLE _ (CL:FORMAT NIL + (if CL::FROM-DISPLAY + then (OR (MENU (create MENU + ITEMS _ CL::POSSIBLE-TYPES + TITLE _ (CL:FORMAT NIL "Edit which definition of ~S ?" - CL::NAME))) - (CL:RETURN-FROM ED NIL)) - else (ASKUSER NIL (CAR CL::POSSIBLE-TYPES) - (CL:FORMAT NIL "Edit which ~A definition of ~S ? " - CL::POSSIBLE-TYPES CL::NAME) - CL::POSSIBLE-TYPES)) + CL::NAME))) + (CL:RETURN-FROM ED NIL)) + else (ASKUSER NIL (CAR CL::POSSIBLE-TYPES) + (CL:FORMAT NIL "Edit which ~A definition of ~S ? " + CL::POSSIBLE-TYPES CL::NAME) + CL::POSSIBLE-TYPES)) elseif (NOT (NULL CL::POSSIBLE-TYPES)) then - - (* ;; "Exactly one type was found.") - - (if CL::FROM-DISPLAY - then (* ; "prepare the prompt window") - (TERPRI PROMPTWINDOW)) - (CL:FORMAT (if CL::FROM-DISPLAY - then PROMPTWINDOW - else T) - "Editing ~A ~A ~S.~%%" - (CAR CL::POSSIBLE-TYPES) - (CL:IF (EQ (CAR CL::POSSIBLE-TYPES) - 'PROPERTY-LIST) - "of" - "definition of") - CL::NAME) - (CAR CL::POSSIBLE-TYPES) + (* ;; "Exactly one type was found.") + + (if CL::FROM-DISPLAY + then (* ; "prepare the prompt window") + (TERPRI PROMPTWINDOW)) + (CL:FORMAT (if CL::FROM-DISPLAY + then PROMPTWINDOW + else T) + "Editing ~A ~A ~S.~%%" + (CAR CL::POSSIBLE-TYPES) + (CL:IF (EQ (CAR CL::POSSIBLE-TYPES) + 'PROPERTY-LIST) + "of" + "definition of") + CL::NAME) + (CAR CL::POSSIBLE-TYPES) else + (* ;; "No types were found. Use the DefDefiner prototyping machinery.") - (* ;; - "No types were found. Use the DefDefiner prototyping machinery.") - - (OR (INSTALL-PROTOTYPE-DEFN CL::NAME CL::GIVEN-TYPES) - (CL:RETURN-FROM ED NIL] + (OR (INSTALL-PROTOTYPE-DEFN CL::NAME CL::GIVEN-TYPES) + (CL:RETURN-FROM ED NIL] (CL:IF (EQ TYPE 'PROPERTY-LIST) (EDITE (GETPROPLIST CL::NAME) NIL CL::NAME 'PROPLST NIL CL::OPTIONS) @@ -232,17 +227,16 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All ri PROTOTYPE-TYPE) (IF (AND NEW-DEFN-FLG TYPES-WITH-PROTOTYPES) THEN (IF (CDR TYPES-WITH-PROTOTYPES) - THEN (CL:FORMAT T "Installing new definition for ~S~%%" NAME) - ELSE (CL:FORMAT T "Installing new ~S definition for ~S~%%" (CAR - TYPES-WITH-PROTOTYPES - ) - NAME)) + THEN (CL:FORMAT T "Installing new definition for ~S~%%" NAME) + ELSE (CL:FORMAT T "Installing new ~S definition for ~S~%%" (CAR TYPES-WITH-PROTOTYPES + ) + NAME)) ELSEIF (NULL REQUESTED-TYPES) THEN (CL:FORMAT T "~S has no definitions.~%%" NAME) ELSEIF (NULL (CDR REQUESTED-TYPES)) THEN (CL:FORMAT T "~S has no ~A definition.~%%" NAME (CAR REQUESTED-TYPES)) - ELSE (CL:FORMAT T "~S has no definition of any of these types:~%% ~A~%%" NAME - REQUESTED-TYPES)) + ELSE (CL:FORMAT T "~S has no definition of any of these types:~%% ~A~%%" NAME REQUESTED-TYPES + )) [IF (NULL TYPES-WITH-PROTOTYPES) THEN (CL:RETURN-FROM INSTALL-PROTOTYPE-DEFN NIL) ELSEIF (NULL (CDR TYPES-WITH-PROTOTYPES)) @@ -258,13 +252,10 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All ri (APPEND [FOR TYPE IN TYPES-WITH-PROTOTYPES COLLECT `(,TYPE '(:TYPE ,TYPE) - "Displays a menu of definers for this type." - (SUBITEMS ,@(FOR DEFINER IN ( - XCL::PROTOTYPE-DEFINERS-FOR-TYPE - TYPE) - COLLECT `(,DEFINER '(:DEFINER ,TYPE - ,DEFINER) - ,DEFINER-HELP-STRING] + "Displays a menu of definers for this type." + (SUBITEMS ,@(FOR DEFINER IN (XCL::PROTOTYPE-DEFINERS-FOR-TYPE TYPE) + COLLECT `(,DEFINER '(:DEFINER ,TYPE ,DEFINER) + ,DEFINER-HELP-STRING] (LIST '("Don't make a dummy defn" NIL] (RESULT (MENU MENU))) (CL:ECASE (CL:FIRST RESULT) @@ -281,7 +272,7 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All ri (LIST '("Don't make a dummy defn" NIL] (IF DEFINER THEN (MAKE-AND-INSTALL PROTOTYPE-TYPE DEFINER) - PROTOTYPE-TYPE + PROTOTYPE-TYPE ELSE NIL]) (DEFINEQ @@ -745,10 +736,11 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All ri ) (PUTPROPS EDITINTERFACE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (14507 31290 (EDITDEF.FNS 14517 . 15853) (EDITF 15855 . 16735) (EDITFB 16737 . 17585) ( -EDITFNS 17587 . 18907) (EDITLOADFNS? 18909 . 22709) (EDITMODE 22711 . 24721) (EDITP 24723 . 25234) ( -EDITV 25236 . 25875) (DC 25877 . 26558) (DF 26560 . 27602) (DP 27604 . 28688) (DV 28690 . 29262) ( -EDITPROP 29264 . 29483) (EF 29485 . 29814) (EP 29816 . 29999) (EV 30001 . 30180) (EDITE 30182 . 31060) - (EDITL 31062 . 31288)) (31640 37712 (NEW/EDITDATE 31650 . 31872) (FIXEDITDATE 31874 . 33716) ( -EDITDATE? 33718 . 34896) (EDITDATE 34898 . 35715) (SETINITIALS 35717 . 37710))))) + (FILEMAP (NIL (3710 10009 (ED 3710 . 10009)) (10011 13987 (INSTALL-PROTOTYPE-DEFN 10011 . 13987)) ( +13988 30771 (EDITDEF.FNS 13998 . 15334) (EDITF 15336 . 16216) (EDITFB 16218 . 17066) (EDITFNS 17068 . +18388) (EDITLOADFNS? 18390 . 22190) (EDITMODE 22192 . 24202) (EDITP 24204 . 24715) (EDITV 24717 . +25356) (DC 25358 . 26039) (DF 26041 . 27083) (DP 27085 . 28169) (DV 28171 . 28743) (EDITPROP 28745 . +28964) (EF 28966 . 29295) (EP 29297 . 29480) (EV 29482 . 29661) (EDITE 29663 . 30541) (EDITL 30543 . +30769)) (31121 37193 (NEW/EDITDATE 31131 . 31353) (FIXEDITDATE 31355 . 33197) (EDITDATE? 33199 . 34377 +) (EDITDATE 34379 . 35196) (SETINITIALS 35198 . 37191))))) STOP diff --git a/sources/EDITINTERFACE.LCOM b/sources/EDITINTERFACE.LCOM index bb19669ca..c4ef88887 100644 Binary files a/sources/EDITINTERFACE.LCOM and b/sources/EDITINTERFACE.LCOM differ