diff --git a/.github/ISSUE_TEMPLATE/documentation.md b/.github/ISSUE_TEMPLATE/documentation.md new file mode 100644 index 00000000..646b38ba --- /dev/null +++ b/.github/ISSUE_TEMPLATE/documentation.md @@ -0,0 +1,17 @@ +--- +name: Documentation problem +about: Problems with this web site? +title: '' +labels: '' + +--- + +**Errors happen. Please tell us the URL** + + +**What does it say?** + + +**What should it say?** + +**Screen shot** diff --git a/.github/ISSUE_TEMPLATE/what_people_are_saying.yml b/.github/ISSUE_TEMPLATE/what_people_are_saying.yml new file mode 100644 index 00000000..f4ccb337 --- /dev/null +++ b/.github/ISSUE_TEMPLATE/what_people_are_saying.yml @@ -0,0 +1,32 @@ +name: "New entry for **What People Are Saying**" +description: "Suggest a new entry for the **What People are Saying** page" +title: "What People are Saying suggestion" +body: + - type: dropdown + id: contentType + attributes: + label: "What type of entry?" + options: + - Blog + - Tweet + - Email + - Other + validations: + required: true + - type: input + id: entryLink + attributes: + label: Link to entry + description: "What is the link to the item we should add to the **What People are Saying** page?" + validations: + required: true + - type: textarea + id: additionalInformation + attributes: + label: Additional information + description: "Use this space to supply any addiitonal information on the suggested item." + validations: + required: false + - type: markdown + attributes: + value: "## Thank you for your suggestion!" diff --git a/.github/workflows/buildLoadup.yml b/.github/workflows/buildLoadup.yml index efae66d6..30699042 100644 --- a/.github/workflows/buildLoadup.yml +++ b/.github/workflows/buildLoadup.yml @@ -56,8 +56,8 @@ on: defaults: run: shell: bash - - + + jobs: ###################################################################################### @@ -83,7 +83,7 @@ jobs: echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT; echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT; fi - + ###################################################################################### @@ -97,7 +97,7 @@ jobs: outputs: release_not_built: ${{ steps.check.outputs.release_not_built }} - steps: + steps: # Checkout the actions for this repo owner - name: Checkout Actions uses: actions/checkout@v3 @@ -107,7 +107,7 @@ jobs: - run: mv ./Actions_${{ github.sha }}/actions ../actions && rm -rf ./Actions_${{ github.sha }} # Check if build already run for this commit - - name: Build already completed? + - name: Build already completed? id: check continue-on-error: true uses: ./../actions/check-sentry-action @@ -135,7 +135,7 @@ jobs: if: | needs.sentry.outputs.release_not_built == 'true' || needs.inputs.outputs.force == 'true' - + steps: # Checkout the actions for this repo owner - name: Checkout Actions @@ -162,7 +162,7 @@ jobs: with: owner: ${{ github.repository_owner }} repo: maiko - + # Setup environment variables & establish job outputs - name: Setup Environment Variables run: | @@ -198,7 +198,7 @@ jobs: token: ${{ secrets.GITHUB_TOKEN }} latest: true out-file-path: ${{ env.TARBALL_DIR }} - fileName: "${{ env.MAIKO_RELEASE_TAG }}-linux.*.tgz" + fileName: "${{ env.MAIKO_RELEASE_TAG }}-linux.*.tgz" - name: Untar Maiko Release for use in loadup run: | @@ -224,9 +224,9 @@ jobs: run: | Xvnc -geometry 1280x720 :0 & export DISPLAY=":0" - PATH="$PWD/maiko:$PATH" + PATH="$PWD/maiko:$PATH" scripts/loadup-all.sh -apps - + - name: Build loadups release tar run: | cd .. @@ -236,8 +236,8 @@ jobs: medley/loadups/full.sysout \ medley/loadups/apps.sysout \ medley/loadups/whereis.hash \ - medley/library/exports.all - + medley/loadups/exports.all + - name: Build runtime release tar run: | cd .. @@ -258,6 +258,7 @@ jobs: medley/fonts/altofonts \ medley/fonts/adobe \ medley/fonts/postscriptfonts \ + medley/fonts/ipfonts \ medley/library \ medley/lispusers \ medley/sources \ @@ -277,13 +278,13 @@ jobs: - name: Delete existing release with same tag (if any) uses: cb80/delrel@latest with: - tag: ${{ env.MEDLEY_RELEASE_TAG }} + tag: ${{ env.MEDLEY_RELEASE_TAG }} continue-on-error: true - name: Push the release id: push_release uses: ncipollo/release-action@v1 - with: + with: allowUpdates: true artifacts: ${{ env.TARBALL_DIR }}/${{ env.MEDLEY_RELEASE_TAG }}-loadups.tgz, @@ -335,7 +336,7 @@ jobs: $url = "https://sourceforge.net/projects/tigervnc/files/stable/1.12.0/vncviewer64-1.12.0.exe" $output = "installers\win\vncviewer64-1.12.0.exe" (New-Object System.Net.WebClient).DownloadFile($url, $output) - + # Run iscc.exe to compile the installer - name: Compile medley.iss shell: powershell @@ -348,7 +349,7 @@ jobs: - name: Upload windows installer to release id: push uses: ncipollo/release-action@v1 - with: + with: allowUpdates: true artifacts: installers/win/${{ env.INSTALLER_FILENAME }} tag: ${{ env.MEDLEY_RELEASE_TAG }} @@ -381,7 +382,7 @@ jobs: else remote_filename="${local_filename%.html}" remote_manname="man_medley.html" - fi + fi remote_filepath="/srv/oio/static/${remote_filename}" remote_manpath="/srv/oio/static/${remote_manname}" # Fill in downloads page template @@ -403,7 +404,7 @@ jobs: sftp -o StrictHostKeyChecking=no -b batch ubuntu@online.interlisp.org env: SSH_KEY: ${{ secrets.OIO_SSH_KEY }} - + ###################################################################################### @@ -420,7 +421,7 @@ jobs: needs: [inputs, sentry, loadup, windows_installer] - steps: + steps: # Checkout the actions for this repo owner - name: Checkout Actions uses: actions/checkout@v3 @@ -440,7 +441,7 @@ jobs: id: output run: | echo "build_successful='true'" >> $GITHUB_OUTPUT - + ###################################################################################### diff --git a/docs/ReleaseNote/APPENDIXA-THEEXEC.TEDIT b/docs/ReleaseNote/APPENDIXA-THEEXEC.TEDIT new file mode 100644 index 00000000..07693336 Binary files /dev/null and b/docs/ReleaseNote/APPENDIXA-THEEXEC.TEDIT differ diff --git a/docs/ReleaseNote/APPENDIXB-SEDIT.TEDIT b/docs/ReleaseNote/APPENDIXB-SEDIT.TEDIT new file mode 100644 index 00000000..a4496af2 Binary files /dev/null and b/docs/ReleaseNote/APPENDIXB-SEDIT.TEDIT differ diff --git a/docs/ReleaseNote/APPENDIXC-ICONW.TEDIT b/docs/ReleaseNote/APPENDIXC-ICONW.TEDIT new file mode 100644 index 00000000..db124542 Binary files /dev/null and b/docs/ReleaseNote/APPENDIXC-ICONW.TEDIT differ diff --git a/docs/ReleaseNote/APPENDIXD-FREEMENU.TEDIT b/docs/ReleaseNote/APPENDIXD-FREEMENU.TEDIT new file mode 100644 index 00000000..ed50cc09 Binary files /dev/null and b/docs/ReleaseNote/APPENDIXD-FREEMENU.TEDIT differ diff --git a/docs/ReleaseNote/APPENDIXE-ERRSYS.TEDIT b/docs/ReleaseNote/APPENDIXE-ERRSYS.TEDIT new file mode 100644 index 00000000..b695b9fa --- /dev/null +++ b/docs/ReleaseNote/APPENDIXE-ERRSYS.TEDIT @@ -0,0 +1,148 @@ +1 LISP RELEASE NOTES, MEDLEY RELEASE, ERROR SYSTEM 1 LISP RELEASE NOTES, MEDLEY RELEASE, ERROR SYSTEM APPENDIX E - ERROR SYSTEM 1 APPENDIX E - ERROR SYSTEM 1 APPENDIX E. ERROR SYSTEM 6 This appendix replaces Chapter 24, Error System, of Common Lisp Implementation Notes, Lyric Release, which replaced most of Chapter 24, Errors, of Common Lisp, the Language. Text shown with StrikeThru is that text from the Lyric release that no longer applies in Medley. Enhancements added in Medley are indicated with revision bars in the right margin. The XCL error system has been updated to reflect the current ANSI Common Lisp error system proposal. This version seems to be gaining wide use in other Common Lisp implementations, so no further major changes are anticipated. The Common Lisp error system is based on proposal number 18 for the Common Lisp error system. Deviations from this proposal are noted. Since the Common Lisp error system has not yet been standardized, this system may change in future releases to accommodate the final version of the Common Lisp error system. If you have access to the ARPANet, a copy of this (ERROR% SYSTEM% PROPOSAL NIL Error% system% proposal NIL (E) 1)proposal may be retrieved from MIT-AI.ARPA as the file "COMMON;COND18 TXT". All symbols(SYMBOLS NIL Symbols NIL (E) 1 SUBNAME IN% ERROR% SYSTEM% SUBTEXT in% Error% system% ) described in the error system proposal that are not already in the "LISP" package are exported from the "CONDITIONS" package. In addition, the "XEROX-COMMON-LISP" package exports these symbols, so you can make them available either by using "XCL" or using "CONDITIONS", whichever is appropriate to your application. The distinction is made so that XCL extensions of the Common Lisp error system will be clear. All unqualified symbols are assumed to be in the "LISP" package. 2 Summary of Error System Changes 1 The semantics of HANDLER-BIND where multiple bindings are set up or mutiple condition types are being handled are slightly (ERROR% SYSTEM% NIL Error% system NIL (E) 1 SUBNAME DIFFERENCES% BETWEEN% OLD% AND% NEW% % SUBTEXT differences% between% old% and% new% )different. Old code that used this will probably not behave as expected. HANDLER-BIND and HANDLER-CASE (a.k.a. CONDITION-CASE) now always take a typespec instead of a list of condition types to indicate the conditions to be handled. Old code that uses this will only handle the first condition type in the list. The function, CONDITIONS::CONVERT-HANDLER-CASE is provided to aid in converting old code(CONVERTING% OLD% CODE NIL Converting% old% code NIL (E) 1 SUBNAME FOR% USE% WITH% NEW% ERROR% SYSTEM% SUBTEXT for% use% with% new% Error% system% ). It may be used as a mutation function in SEdit. HANDLER-CASE now supports a :NO-ERROR option that is executed if none of the other clauses are taken. This is handy for writing code that depends on the normal completion of some operation, for example, creating auxilliary files if a particular stream is successfully opened. SERIOUS-CONDITION no longer forces entry to the debugger. The function used to signal the condition now determines what happens if the condition is not handled. This means that SERIOUS-CONDITION has no more interesting properties and is likely to be removed in the final version of the error standard. Several new condition types have been defined. Others have moved in the hierarchy. For example, ILLEGAL-GO is now a subtype of PROGRAM-ERROR. No standard condition type has a default handler. The standard debugger entry point is now called INVOKE-DEBUGGER instead of DEBUG. The syntax of DEFINE-CONDITION has been changed to make it more like CLOS' DEFCLASS. The function CONDITIONS::CONVERT-OLD-DEFINE-CONDITION is provided to aid in converting old code. It may be used as a mutation function in SEdit. Several DEFINE-CONDITION options have been merged, while others have been removed. In particular, there are no more "instant variables." PROCEED-CASE has been replaced by RESTART-CASE. The semantics of restarts have been cleaned up and several new features added. Related functions, such as COMPUTE-PROCEED-CASES, have been renamed appropriately. INVOKE-PROCEED-CASE has been renamed to INVOKE-RESTART. DEFINE-PROCEED-FUNCTION has been removed, although XCL will continue to support it for compatibility. The arguments to a restart's report function are different. Old code that used something other than a string for the report method will not work correctly. A distinction is now made between invoking a restart interactively and simply invoking one. To this end, there is the function INVOKE-RESTART-INTERACTIVELY and the :INTERACTIVE option to RESTART-CASE. RESTART-BIND, in analogy to HANDLER-BIND, has been added. A new variable, *BREAK-ON-SIGNALS* exists to aid in debugging. It is a generalization of *BREAK-ON-WARNINGS*. The latter has been retained for compatibility. The proceed function PROCEED has been changed to CONTINUE. Old compiled code will continue to work except in the following cases, some of which have been mentioned above: A proceed case's report function was not a simple string. Such code can cause stack overflow trying to report the condition (*STANDARD-OUTPUT* ends up being bound to NIL). Such code should be rewritten. A handler binding is made to a list of condition types. Only the first type in the list will be handled. Multiple handler bindings were created by the same HANDLER-BIND or HANDLER-CASE. Such code will work as expected, but if recompiled in Medley, will not. To get the effect of the current semantics, you must use nested HANDLER-BINDs. Under the new error system, use-value and store-value no longer prompt for a value. 2 Introduction to Error System Terminology 1 (CONDITION NIL condition NIL (E) 3)condition A condition is a kind of object which is created when an exceptional situation arises in order to represent the relevant features of that situation. (SIGNALLING% CONDITIONS NIL Signalling% conditions NIL (E) 3)signal, (HANDLING% CONDITIONS% NIL Handling% conditions% NIL (E) 3)handlers Once a condition is created, it is common to signal it. When a condition is signaled, a set of handlers are tried in some pre-defined order until one decides to handle the condition or until no more handlers are found. A condition is said to have been handled if a handler performs a non-local transfer of control to exit the signalling process. (RESTARTING% COMPUTATIONS NIL Restarting% computations NIL (E) 3)restart Although such transfers of control may be done directly using traditional Lisp mechanisms such as catch and throw, block and return, or tagbody and go, the condition system also provides a more structured way to restart a computation. Among other things, the use of these structured primitives for restarting allows a better and more integrated relationship between the user program and the interactive debugger. serious conditions It is not necessary that all conditions be handled. Some conditions are trivial enough that a failure to handle them may be disregarded. Others, which we will call serious conditions must be handled in order to assure correct program behavior. If a serious condition is signalled but no handler is found, the debugger will be entered so that the user may interactively specify how to proceed. errors(ERRORS NIL Errors NIL (E) 3 SUBNAME DEFINITION% OF% SUBTEXT definition% of% ) conditions which result from incorrect programs or data are called errors. Not all conditions are errors, however. Storage conditions are examples of conditions that are not errors. For example, the control stack may legitimately overflow without a program being in error. Even though a stack overflow is not necessarily a program error, it is serious enough to warrant entry to the debugger if the condition goes unhandled. Some types of conditions are predefined by the system. All types of conditions are subtypes of conditions:condition. That is, (typep c 'conditions:condition) is true if c is a condition. creating conditions(CREATING% CONDITIONS NIL Creating% conditions NIL (E) 4) The only standard way to define a new condition type is conditions:define-condition. The only standard way to instantiate a condition is conditions:make-condition. When a condition object is created, the most common operation to be performed upon it is to signal it (although there may be applications in which this does not happen, or does not happen immediately). When a condition is signaled, the system tries to locate the most appropriate handler for the condition and invoke that handler. Handlers are located according to the following rules: (BOUND% NIL bound% NIL (E) 4)bound f Check for (LOCALLY% DEFINED% HANDLER% NIL Locally% defined% handler% NIL (E) 4)locally defined (ie, bound) handlers. f If no appropriate bound handler is found, check first for the default handler of the signaled type and then of each of its superiors. (DECLINING% BY% CONDITION% HANDLER% NIL Declining% by% Condition% handler% NIL (E) 4)decline If an appropriate handler is found, the handler may decline by simply returning without performing a non-local transfer of control. In such cases, the search for an appropriate handler is picked up where it left off, as if the called handler had never been present. When a handler is running, the "handler binding stack" is popped back to just below the binding that caused that handler to be invoked. This is done to avoid infinite recursion in the case that a handler also signals a condition. conditions:handler-bind(CONDITIONS:HANDLER-BIND (Macro) conditions:handler-bind NIL (E) 4) When a condition is signaled, handlers are searched for in the dynamic environment of the signaller. Handlers can be (ESTABLISHING% HANDLERS% WITHIN% DYNAMIC% CONTEXT% NIL Establishing% handlers% within% dynamic% context NIL (E) 4)established within a dynamic context by use of conditions:handler-bind and other forms based on it. (HANDLER (Function) handler NIL (E) 4)handler A handler is a function of one argument, the condition to be handled. The handler may inspect the object (using primitives described in another section) to be sure it is interested in handling the condition. After inspecting the condition, the handler must take one of the following actions: f It may decline to handle the condition by simply returning. When this happens, any returned values are ignored and the effect on the signaling process is the same as if the handler had not run. The next handler in line will be tried, or if no such handler exists, the default action for the given condition will be taken. A default handler may also decline, in which case the condition will go unhandled. What happens then depends on which function was used to signal the condition (xcl:signal, error, cerror, warn). f It may perform some non-local transfer of control using go, return, throw, abort, or conditions:invoke-restart. f It may signal another condition. f It may invoke the debugger. conditions:restart-case(CONDITIONS:RESTART-CASE (Function) conditions:restart-case NIL (E) 5) When a condition is signalled, a facility is available for use by handlers to transfer control to an outer dynamic contour of the program. The form which creates contours that may be returned to is conditions:restart-case. Each contour is set up by a conditions:restart-case clause, and is called a restart. The function that transfers control to a (RESTARTING% CONDITIONS% NIL Restarting% conditions NIL (E) 5)restart is conditions:invoke-restart(CONDITIONS:INVOKE-RESTART (Function) conditions:invoke-restart NIL (E) 5). proceed function Also, control may be transferred along with parameters to a named xcl:proceed-case clause by invoking a proceed function of that name. Proceed functions are created with the macro xcl:define-proceed-function. restart type(RESTART% TYPE NIL Restart% type NIL (E) 5) A restart with a particular name is sometimes called a restart type. (REPORTING% A% CONDITION% OR% RESTART NIL Reporting% a% condition% or% restart NIL (E) 5)report In some cases, it may be useful to report a condition or a restart to a user or a log file of some sort. When the printer is invoked on a condition or proceed case and *print-escape* is nil, the report function for that object is invoked. In particular, this means that an expression like (princ condition) will invoke condition's report function. Because of this, no special function is provided for invoking the report function of a condition or a restart. 2 Program Interface to the Condition System 1 Defining and Creating Conditions 1 conditions:define-condition(CONDITIONS:DEFINE-CONDITION (Macro) conditions:define-condition NIL (E) 5) name (parent-type) [({slot}*) {option}*] [Macro] Defines a new condition type with the given name, making it a subtype of the given parent-type. Except as otherwise noted, the arguments are not evaluated. The valid options(OPTIONS NIL options NIL (E) 5) are: (:documentation doc-string) doc-string should be a string which describes the purpose of the condition type or NIL. If this option is omitted, NIL is assumed. (documentation name 'type) will retrieve this information. (:conc-name symbol-or-string) As in defstruct, this sets up automatic prefixing of the names of slot accessors. Also as in defstruct if no prefix is specified the default behavior for automatic prefixing is to use the name of the new type followed by a hyphen interned in the package which is current at the time that the conditions:define-condition is processed. :report-function expression expression should be a suitable argument to the function special form, e.g., a symbol or a lambda expression. It designates a function of two arguments, a condition and a stream, which prints the condition to the stream when *print-escape* is nil. The :report-function describes the condition in a human-sensible form. This item is somewhat different than a structure's :print-function in that it is only used if *print-escape* is nil. (:report exp) This option specifies the report function for this condition type. Report function are inherited, so if a particular condition type does not have one, the report function of its parent will be used. If exp is a string, it is a shorthand for (:report (lambda (condition stream) (declare (ignore conditions)) (princ exp stream))) If exp is not a string, (function exp) will be evaluated in the current lexical environment. This should return a function of two arguments, a condition and a stream. It will be called when a condition of this type is to be printed and *print-escape* is nil. The report function will be called with the condition to be reported and the stream to which the report is to be made. :handler-function expression expression should be a suitable argument to the function special form. It designates a function of one argument, a condition, which may handle that condition if no dynamically-bound handler did. (:handle exp) This option specifies a default handler for conditions of this type. (function exp) will be evaluated in the current lexical context. This should result in a function of one argument, a condition, to be used as the default handler for this condition type. Each slot is a defstruct slot-description. In addition to those specified, the slots of the parent-type are also available. No slot-options are allowed, only an optional default-value expression. Condition objects are immutable, i.e., all of their slots are automatically declared to be :read-only. conditions:make-condition(CONDITIONS:MAKE-CONDITION (Function) conditions:make-condition NIL (E) 6) will accept keywords with the same name as any of the slots, and will initialize the corresponding slots in conditions it creates. Accessors are created according to the same rules as used by defstruct. For example: (conditions:define-condition bad-food-color (food-lossage) (food color) (:report (lambda (c s) (format s "The food ~A was ~A" (bad-food-color-food c) (bad-food-color-color c))))) defines a condition of type bad-food-color which inherits from the food-lossage condition type. The new type has slots food and color so that conditions:make-condition will accept :food and :color keywords and accessors bad-food-color-food and bad-food-color-color will apply to objects of this type. The report function for a condition will be implicitly called any time a condition is printed with *print-escape* being nil. Hence, (princ condition) is a way to invoke the condition's report function. Here are some examples of defining condition types. This form defines a condition called machine-error which inherits from error: (conditions:define-condition machine-error (error) (machine-name) (:report (lambda (c s) (format s "There is a problem with ~A." (machine-error-machine-name c)))) ) The following defines a new error condition (a subtype of machine-error) for use when machines are not available: (conditions:define-condition machine-not-available-error (machine-error) (machine-name) (:report (lambda (c s) (format s "The machine ~A is not available." (machine-error-machine-name c)))) ) The following defines a still more specific condition, built upon machine-not-available-error, which provides a default for machine-name but which does not provide any new slots: (conditions:define-condition my-favorite-machine-not-available-error (machine-not-available-error) ((machine-name "Tesuji:AISDev"))) This gives the machine-name slot a default initialization. Since no :report clause was given, the information supplied in the definition of machine-not-available-error will be used if a condition of this type is printed while *print-escape* is nil. xcl:condition-reporter type(XCL:CONDITION-REPORTER% (Macro) xcl:condition-reporter NIL (E) 7) [Macro] Returns the object used to report conditions of the given type. This will be either a string, a function of two arguments (condition and stream) or nil if there is no report function. setf may be used with this form to change the report function for a condition type. xcl:condition-handler type(XCL:CONDITION-HANDLER (Macro) xcl:condition-handler NIL (E) 7) [Macro] Returns the default handler for conditions of the given type. This will be a function of one argument or nil if there is no default handler. setf may be used with this form to change the default handler for a condition type. conditions:make-condition type &rest slot-initializations(CONDITIONS:MAKE-CONDITION (Function) conditions:make-condition% NIL (E) 8) [Function] Calls the appropriate constructor function for the given type, passing along the given slot initializations to the constructor, and returning an instantiated condition. The slot-initializations are given in alternating keyword/value pairs. eg, (conditions:make-condition 'bad-food-color :food my-food :color my-color) This function is provided mainly for writing subroutines that manufacture a condition to be signaled. Since all of the condition signalling functions can take a type and slot-initializations, it is usually easier to call them directly. Signalling Conditions 1 xcl:*current-condition*(XCL:*CURRENT-CONDITION* (Variable) xcl:*current-condition* NIL (E) 8) [Variable] This variable is bound by condition-signalling forms (conditions:signal, error, cerror, and warn) to the condition being signaled. This is especially useful in restart filters. The top-level value of xcl:*current-condition* is nil. conditions:signal datum &rest arguments(CONDITIONS:SIGNAL% (Function) conditions:signal NIL (E) 8) [Function] Invokes the signal facility on a condition. If the condition is not handled, conditions:signal returns the condition object that was signaled. If datum is a condition then that condition is used directly. In this case, it is an error for arguments to be non-nil. If datum is a condition type, then the condition used is the result of doing (apply #'conditions:make-condition datum arguments) If datum is a string, then the condition used is the result of doing (conditions:make-condition 'conditions:simple-condition :format-string datum :format-arguments arguments). If the condition is of type xcl:serious-condition, then xcl:signal will behave exactly like error, i.e., it will call xcl:debug if the condition isn't handled, and will never return to its caller. If (typep condition conditions:*break-on-signals*) is true, then the debugger will be entered prior to the signalling process. This is true for all other functions and macros that signal conditions, such as warn, error, cerror, assert and check-type. conditions:*break-on-signals*(CONDITIONS:*BREAK-ON-SIGNALS* (Variable) conditions:*break-on-signals* NIL (E) 9) [Variable] This flag is primarily for use when debugging programs that do signaling. Its value is a type specifier. When (typep condition conditions:*break-on-signals*) is true, then calls to conditions:signal and other functions that implicitly call conditions:signal will enter the debugger prior to signalling the condition. The conditions:continue restart may be used to continue with the normal signalling process. The default value of this variable is nil. Note: the variable *break-on-warnings* continues to be supported for compatibility, but conditions:*break-on-signals* offers that power and more. New code should not use *break-on-warnings*. error datum &rest arguments(ERROR% (Function) error% NIL (E) 9) [Function] Like conditions:signal except if the condition is not handled, the debugger is called with the given condition, and error never returns. datum is treated as in conditions:signal. If datum is a string, a conditon of type conditions:simple-error is made. This form is compatible with that described in Steele's Common Lisp, the Language. cerror proceed-format-string datum &rest arguments(CERROR% (Function) cerror NIL (E) 9) [Function] Like error, if the condition is not handled the debugger is called with the given condition. However, cerror enables the restart conditions:continue, which will simply return the condition being signalled from cerror. datum is treated as in error. If datum is a condition, then that condition is used directly. In this case, arguments will be used only with the proceed-format-string and will not be used to initialize datum. The proceed-format-string must be a string. Note that if datum is not a string, then the format arguments used by the proceed-format-string will still be the arguments (in the keyword format as specified). In this case, some care may be necessary to set up the proceed-format-string correctly. The format directive ~* may be particularly useful in this situation. The value returned by cerror is the condition which was signaled. See Steele's Common Lisp, the Language, page 430 for examples of the use of cerror. (WARN (Function) warn NIL (E) 10)warn datum &rest arguments [Function] Invokes the signal facility on a condition. If the condition is not handled, then the text of the warning is printed on *error-output*. If the variable *break-on-warnings* is true, then in addition to printing the warning, the debugger is entered using the function break. The value returned by warn is the condition that was signalled. If datum is a condition, then that condition is used directly. In this case, if the condition is not of type conditions:warning or arguments is non-null, then an error of type conditions:type-error is signalled. If datum is a condition type, then the condition used is the result of doing (apply #'conditions:make-conditions datum arguments). This result must be of type conditions:warning or an error of type conditions:type-error is signalled. If datum is a string, then the condition used is the result of (conditions:make-conditions 'conditions:simple-warning :format-string datum :format-arguments arguments). The precise mechanism for warning is as follows: 1) If *break-on-warnings* is true, the debugger will be entered. This feature is primarily for compatibility with old code: use of conditions:*break-on-signals* is preferred. If the break is continued using the conditions:continue restart, warn proceeds with step 2. 2) The warning condition is signalled. While it is being signalled, the conditions:muffle-warning restart is established for use by a handler to bypass further action by warn, i.e., to cause warn to immediately return. 3) The warning condition is reported to *error-output* by the warn function. Note that warn will indicate that the condition being signalled is a warning when it reports it, so there is no need for the condition to do so in its report method. *break-on-warnings*(*BREAK-ON-WARNINGS* (Variable) *break-on-warnings* NIL (E) 10) [Variable] check-type(CHECK-TYPE (Macro) check-type NIL (E) 10) [Macro] (ECASE (Macro) ecase NIL (E) 10)ecase [Macro] (CCASE (Macro) ccase NIL (E) 10)ccase [Macro] (ETYPECASE (Macro) etypecase NIL (E) 10)etypecase [Macro] (CTYPECASE (Macro) ctypecase NIL (E) 10)ctypecase [Macro] (ASSERT (Macro) assert NIL (E) 10)assert [Macro] All of the above behave as described in Common Lisp: the Language. The default clauses of ecase and ccase forms signal conditions:simple-error conditions. The default clauses of etypecase and ctypecase forms signal conditions:type-error conditions. assert signals the xcl:assertion-failed condition. ccase and ctypecase set up a conditions:store-value restart. Handling Conditions 1 conditions:handler-bind(CONDITIONS:HANDLER-BIND (Macro) conditions:handler-bind NIL (E) 11) bindings &rest forms [Macro] Executes the forms in a dynamic context where the given local handler bindings are in effect. The elements of bindings must take the form (type-spec handler). The handlers are bound in the order they are given, i.e., when searching for a handler, the error system will consider the leftmost binding in a particular conditions:handler-bind form first. However, while one of these handlers is running, none of the bindings established by the conditions:handler-bind will be in effect. type must be a type specifier. To make a binding for several condition types, use (or type1 type2 ...). handler should evaluate to a function of one argument, a condition, to be used to handle a signalled condition during execution of the forms. An example of the use of conditions:handler-bind appears at the end of the conditions:restart-case macro description. conditions:handler-case(CONDITIONS:HANDLER-CASE (Macro) conditions:handler-case NIL (E) 11) form &rest cases [Macro] xcl:condition-case(XCL:CONDITION-CASE (Macro) xcl:condition-case NIL (E) 11) form &rest cases [Macro] Executes the given form. Each case has the form (type ([var]) . body) If a condition is signalled (and not handled by an intervening handler) during the execution of the form, and there is an appropriate clause%i.e., one for which (typep condition 'type) is true%then control is transferred to the body of the relevant clause, binding var, if present, to the condition that was signaled. If no condition is signalled, then the values resulting from the form are returned by the xcl:condition-case. If the condition is not needed, var may be omitted. Earlier clauses will be considered first by the error system. I.e., (xcl:condition-case form (cond1 ...) (cond2 ...)) is equivalent to (xcl:condition-case (xcl:condition-case form (cond1 ...)) (cond2 ...)) type may also be a list of types, in which case it will catch conditions of any of the specified types. One may also specify an action to be taken if execution of form completes normally. This may be done by specifying a clause that has :no-error as its type. Such a clause, if provided, must be last. A :no-error clause looks like: (:no-error lambda-list . body) If execution of the form completes normally and there is a :no-error clause, the values produced by the form will be bound to variables in the clause's lambda-list and the body will be executed with none of the handler bindings in effect. In this case the value of the xcl:condition-case form is the value returned by the last form of the body of its :no-error clause. Having a :no-error clause is equivalent to wrapping (mutiple-value-call #'(lambda lambda-list . body) ...) around the xcl:condition-case form. conditions:handler-case is synonymous with xcl:condition-case. Examples: (xcl:condition-case (/ x y) (division-by-zero () nil)) (xcl:condition-case (open *the-file* :direction :input) (file-error (condition) (format t "~&Open failed: ~A~%" condition))) (xcl:condition-case (some-user-function) (file-error (condition) condition) (division-by-zero () 0) ((or unbound-variable undefined-function) () 'unbound)) (xcl:condition-case (open my-file) (file-error () (format *error-output* "Couldn't open ~S." my-file)) (:no-error (stream) (open-more-files my-file stream) stream))) Note the difference between xcl:condition-case and conditions:handler-bind. In conditions:handler-bind, you are specifying functions that will be called in the dynamic context of the condition signalling form. In xcl:condition-case, you are specifying continuations to be used instead of the original form if a condition of a particular type is signaled. These continuations will be executed in the same dynamic context as the original form. conditions:ignore-errors(CONDITIONS:IGNORE-ERRORS (Macro) conditions:ignore-errors NIL (E) 12) &body forms [Macro] Executes the forms in a context that handles conditions of type error by returning control to this form. If no error is signaled, all values returned by the last form are returned by conditions:ignore-errors. Otherwise, the form returns the two values nil and the condition that was signaled. Synonym for (xcl:condition-case (progn . forms) (error (condition) (values nil condition)). xcl:debug &optional datum &rest arguments [Function] Enters the debugger with a given condition without signalling that condition. When the debugger is entered, it will announce the condition by invoking the condition's report function. datum is treated the same as for xcl:signal except if datum is not specified, it defaults to "Call to DEBUG". This function will never directly return to its caller. Return can occur only by a special transfer of control, such as to a catch, block, tagbody, xcl:proceed-case or xcl:catch-abort. conditions:invoke-debugger(CONDITIONS:INVOKE-DEBUGGER (Function) conditions:invoke-debugger NIL (E) 13) condition [Function] Invokes the debugger with the given condition. This is intended to be used as a portable entry point to the debugger. For finer control over the debugging state, see the function xcl:debugger. break &optional(BREAK (Function) break NIL (E) 13) format-string &rest format-arguments [Function] Enters the debugger with a simple condition with the given arguments. If no format-string is provided, it defaults to "Break." Computation may be continued by invoking the conditions:continue restart. If continued, break returns nil. break is approximately: (defun break (&optional (format-string "Break") &rest format-arguments) (conditions:restart-case (conditions:invoke-debugger (conditions:make-conditions 'conditions:simple-condition :format-string format-string :format-arguments format-arguments) (conditions:continue () :report "Return from BREAK." nil))) Restarts 1 conditions:restart-case(CONDITIONS:RESTART-CASE (Macro) conditions:restart-case NIL (E) 13) expression {(case-name arglist {keyword value}* {form}*)}* [Macro] The expression is evaluated in a dynamic context where the case clauses have special meanings as points to which control may be transferred. If expression runs to completion, all values returned by the form are simply returned by the conditions:restart-case form. On the other hand, the computation of expression may choose to transfer control to one of the restart clauses. If a transfer to a clause occurs, the forms in the body of that clause will be evaluated in the same dynamic context as the conditions:restart-case form, and any values returned by the last such form will be returned by the conditions:restart-case form. A restart clause has the form given above: (case-name arglist {keyword value}* {form}*) The case-name may be nil or any symbol. The arglist is a normal lambda list that will be bound and evaluated in the dynamic context of the conditions:restart-case form. They will use whatever values were provided by conditions:invoke-restart or conditions:invoke-restart-interactively. Definitions of these two functions appear later in this section. The valid keyword/value pairs are: :filter expression expression should be suitable as an argument to the function special form. It defines a predicate of no arguments that determines if this clause is visible to conditions:find-restart. Default = true. :condition type Shorthand for a common special case of :filter. The following two key/value pairs are equivalent: :condition foo :filter (lambda () (typep xcl:*current-condition* 'foo)) :interactive expression The expression must be a form suitable as an argument to function. (function expression) will be evaluated in the current lexical and dynamic environments. The result should be a function of no arguments which returns a list of values to be used by conditions:invoke-restart-interactively. This function will be called in the dynamic environment available prior to any restart attempt. Any interaction with the user should be done here and not in the body of the restart. If there is no :interactive option specified and the restart is invoked interactively, no arguments will be supplied. :report expression The expression can either be a constant string or a form suitable as an argument to function. If expression is not a string, (function expression) will be evaluated in the current lexical and dynamic environment. The result should be a function of one argument, a stream, which will be called to report that restart. This function should print a short summary of the action that restart will take if invoked. If expression is a string, it is a shorthand for (lambda (s) (format s expression)). Only one of :condition or :filter may be specified. If no :report is specified, the case-name will be used. It is an error to have a null case name and no report function. Examples: (loop (conditions:restart-case (return (apply function some-args)) (new-function (new-fn) :report "Use a different function." :interactive (lambda () (list (prompt-for 'function "Function: "))) (setq function new-fn)))) (loop (conditions:restart-case (return (apply function some-args)) (nil (new-fn) :report "Use a different function." :interactive (lambda () (list (prompt-for 'function "Function: "))) (setq function new-fn)))) (conditions:restart-case (a-command-loop) (return-from-command-level () :report (lambda (stream) (format stream "Return from command level ~D." level)) nil)) (loop (conditions:restart-case (another-computation) (conditions:continue () nil))) The first and second examples are equivalent from the point of view of someone using the interactive debugger, but differ in one important aspect for non-interactive handling. If a handler "knows about" restart names, as in: (when (conditions:find-restart 'new-function) (conditions:invoke-restart 'new-function the-replacement)) then only the first example, and not the second, will have control transferred to its correction clause. Here's a more complete example: (let ((my-food 'milk) (my-color 'greenish-blue)) (do () ((not (food-colorable-p my-food my-color))) (conditions:restart-case (error 'bad-food-color :food my-food :color my-color) (use-food (new-food) :report "Use another food." (setf my-food new-food)) (use-color (new-color) :report "Use another color." (setf my-color new-color)))) ;; We won't get to here until my-food ;; and my-color are compatible. (list my-food my-color)) Assuming that use-food and use-color have been defined as (defun use-food (new-food) (invoke-restart 'use-food new-food)) (defun use-color (new-color) (invoke-restart 'use-color new-color)) then a handler can proceed from the error in either of two ways. It may correct the color or correct the food. For example: #'(lambda (condition) ... ;; Corrects color (use-color 'white) ...) or #'(lambda (condition) ... ;; Corrects food (use-food 'cheese) ...) Here is an example using conditions:handler-bind and conditions:restart-case. (conditions:handler-bind ((foo-error #'(lambda (condition) (conditions:use-value 7)))) (conditions:restart-case (error 'foo-error) (conditions:use-value (x) (* x x)))) The above form returns 49. xcl:define-proceed-function name [Macro] {keyword value}* {variable}* Valid keyword/value pairs are the same as those which are defined for the xcl:proceed-case special form. That is, :filter, :filter-function, :condition, :report, and :report-function. The filter and report functions specified in a xcl:define-proceed-function form will be used for xcl:proceed-case clauses with the same name that do not specify their own filter or report functions, respectively. This form defines a function called name which will invoke a proceed case with the same name. The proceed function takes optional arguments which are given by the variables specification. The parameter list for the proceed function will look like (&optional . variables) The only thing that a proceed function really does is collect values to be passed on to a proceed case clause. Each element of variables has the form variable-name or (variable-name initial-value). If initial-value is not supplied, it defaults to nil. For example, here are some possible proceed functions which might be useful in conjunction with the bad-food-color error we used as an example earlier: (xcl:define-proceed-function use-food :report "Use another food." (food (read-typed-object 'food "Food to use instead: "))) (xcl:define-proceed-function use-color :report "Change the food's color." (color (read-typed-object 'food "Color to make the food: "))) (defun maybe-use-water (condition) ;; A sample handler (when (eq (bad-food-color-food condition) 'milk) (use-food 'water))) (xcl:handler-bind ((bad-food-color #'maybe-use-water)) ...) If a named proceed function is invoked in a context in which there is no active proceed case by that name, the proceed function simply returns nil. So, for example, in each of the following pairs of handlers, the first is equivalent to the second but less efficient: #'(lambda (condition) ; OK, but slow (when (xcl:find-proceed-case 'use-food) (use-food 'milk))) #'(lambda (condition) ; Preferred (use-food 'milk)) #'(lambda (condition) (cond ((xcl:find-proceed-case 'use-food) (use-food 'chocolate)) ((xcl:find-proceed-case 'use-color) (use-color 'orange)))) #'(lambda (condition) (use-food 'chocolate) (use-color 'orange)) conditions:restart-bind(CONDITIONS:RESTART-BIND (Macro) conditions:restart-bind NIL (E) 17) ({(name function {keyword value}*)}* {form}* [Macro] Executes the forms in a dynamic context where the given restart bindings are in effect. name may be nil to indicate an anonymous restart, or some other symbol to indicate a named restart. function will be evaluated in the current lexical and dynamic contexts and should produce a function of no arguments to be used to perform the restart. This function will be called when that restart is activated by conditions:invoke-restart or conditions:invoke-restart-interactively. Note that unlike conditions:restart-case, invoking the restart does not automatically transfer control back to the contour in which it was established. If that is appropriate for that restart it is up to the individual restart function to do this. The valid keyword/value pairs are: :interactive-function form form will be evaluated in the current lexical and dynamic environments and should produce a function of no arguments that will construct the list of values to be used by conditions:invoke-restart-interactively. :report-function form form will be evaluated in the current lexical and dynamic environments and should produce a function of one argument, a stream, that will be used to report that restart. :filter-function form form will be evaluated in the current lexical and dynamic environments and should produce a function of no arguments that will be used to determine if the given restart is currently active. This form is a more primitive way of establishing restarts than conditions:restart-case. It is expected that conditions:restart-case will be sufficient for most uses of the restart facility. An example of where the more general facility provided by conditions:restart-bind may be useful is: (conditions:restart-bind ((nil #'(lambda () (expunge-directory the-dir)) :report-function #'(lambda (stream) (format stream "Expunge ~A." (directory-namestring the-dir))))) (cerror "Try this file operation again." 'directory-full :directory the-dir)) In this case, a restart is provided that allows the user to expunge the full directory and return to the debugger after doing so. He can then try some other restart, such as conditions:continue to retry the failed operation. conditions:compute-restarts(CONDITIONS:COMPUTE-RESTARTS (Function) conditions:compute-restarts NIL (E) 18) [Function] Uses the dynamic state of the program to compute a list of restarts. Each restart object represents a point in the current dynamic state of the program to which control may be transferred. The only operations that Lisp defines for such objects are: conditions:restart-name, conditions:find-restart, conditions:invoke-restart, conditions:invoke-restart-interactively, princ, and prin1, to identify an object as a restart using (typep x 'conditions:restart), and standard Lisp operations that work for all objects, such as eq, eql, describe, etc. The list which results from a call to conditions:compute-restarts is ordered so that the innermost (ie, more-recently established) restarts are nearer the head of the list. Note also that conditions:compute-restarts returns all valid restarts, even if some of them have the same name as others and therefore would not be found by conditions:find-restart. It is an error to modify the list returned by conditions:compute-restarts. conditions:restart-name(CONDITIONS:RESTART-NAME (Function) conditions:restart-name NIL (E) 19) restart [Function] Returns the name of the given restart, or nil if it is not named. xcl:default-proceed-test proceed-case-name [Macro] Returns the default filter function for proceed cases with the given proceed-case-name. May be used with setf to change it. xcl:default-proceed-report proceed-case-name [Macro] Returns the default report function for proceed cases with the given proceed-case-name. This may be a string or a function just as for condition types. May be used with setf to change it. conditions:find-restart(CONDITIONS:FIND-RESTART (Function) conditions:find-restart NIL (E) 19) identifier [Function] Searches for a restart by the given identifier which is in the current dynamic environment. If identifier is a symbol, then the innermost (ie, most recently established) restart with that name that is active is returned. nil is returned if no such restart is found. If identifier is a restart object, then it is simply returned unless it is not currently valid for use. In that case, nil is returned. When searching for a matching restart, the filter function, if any, of potential matches will be called to see if they are active. If it returns nil, then the restart is considered to not have been seen and the search for a match continues. Although anonymous restarts have a name of nil, it is an error for the symbol nil to be given as an identifier to this function. If it is approriate to search for anonymous restarts, you should use conditions:compute-restarts instead. conditions:invoke-restart(CONDITIONS:INVOKE-RESTART (Function) conditions:invoke-restart NIL (E) 20) restart &rest values [Function] Calls the function associated with the given restart, passing the values as arguments. The restart must be a restart object or the non-null name of a restart which is valid in the current dynamic context. If an argument is not valid, an error of type conditions:control-error will be signalled. If the argument is a named proceed case that has a corresponding proceed function, xcl:invoke-proceed-case will do the optional argument resolution specified by that function before transferring control to the proceed case. conditions:invoke-restart-interactively(CONDITIONS:INVOKE-RESTART-INTERACTIVELY (Function) conditions:invoke-restart-interactively NIL (E) 20) restart [Function] Calls the function associated with the given restart, providing for any necessary arguments. The restart must be a restart object or the non-null name or a restart which is valid in the current dynamic context. If the restart is not valid, an error of type conditions:control-error will be signalled. conditions:invoke-restart-interactively will first call the restart's interactive function as specified by the :interactive keyword of conditions:restart-case or the :interactive-function keyword of conditions:restart-bind. The interactive function should return a list of values to be passed as arguments to the restart. This list must be at least as long as the number of required arguments that the restart has. If the restart has no interactive function, no arguments will be passed to the restart function. It is an error for a restart to require arguments but not have an interactive function. Once the arguments have been determined, conditions:invoke-restart-interactively will simply do (apply #'conditions:invoke-restart restart arguments). conditions:with-simple-restart(CONDITIONS:WITH-SIMPLE-RESTART (Macro) conditions:with-simple-restart NIL (E) 20) (name format-string {format-arguments}*) {form}* [Macro] This is a shorthand for one of the most common uses of conditions:restart-case. If the restart designated by name is not invoked while executing the forms, all values produced by the last form are returned. If the restart established by conditions:with-simple-restart is invoked, control is transferred to the conditions:with-simple-restart form, which immediately returns the two values nil and t. It is permissible for name to be nil. In that case, an anonymous restart is established. conditions:with-simple-restart is essentially: (defmacro conditions:with-simple-restart ((restart-name format-string &rest format-arguments) &body forms) `(conditions:restart-case (progn ,@forms) (,restart-name () :report (lambda (stream) (format stream ,format-string ,@format-arguments)) (values nil t)))) Example: (defun read-eval-print-loop (level) (conditions:with-simple-restart (conditions:abort "Exit command level ~D." level) (loop (conditions:with-simple-restart (conditions:abort "Return to command level ~D." level) (print (eval (read))))))) xcl:catch-abort(XCL:CATCH-ABORT (Macro) xcl:catch-abort NIL (E) 21) print-form &body forms [Macro] Like conditions:with-simple-restart, but always uses the name conditions:abort . xcl:catch-abort could be defined by: (defmacro xcl:catch-abort (print-form &body forms) (conditions:with-simple-restart (conditions:abort ,print-form) ,@forms)) conditions:abort(CONDITIONS:ABORT (Function) conditions:abort NIL (E) 21) [Function] This function transfers control to the nearest active restart named conditions:abort. If there is none, this function signals an error of type conditions:control-error. xcl:abort could be defined by: (define-proceed-function xcl:abort :report "Abort") conditions:continue(CONDITIONS:CONTINUE (Function) conditions:continue NIL (E) 21) [Function] This function transfers control to the nearest active restart named conditions:continue. If none exists it simply returns nil. The conditions:continue restart is generally part of simple protocols where there is a single "obvious" way to continue, such as in break and cerror. NB: conditions:continue replaces xcl:proceed. xcl:proceed &optional condition [Function] This is a predefined proceed function. It is used by such functions as break, cerror, etc. conditions:muffle-warning(CONDITIONS:MUFFLE-WARNING (Function) conditions:muffle-warning NIL (E) 22) [Function] This function transfers control to the nearest active restart named conditions:muffle-warning. If none exists, an error of type conditions:control-error is signalled. warn sets up this restart so that handlers of conditions:warning conditions have a way to tell warn that the warning has been dealt with and that no further action is warranted. conditions:use-value(CONDITIONS:USE-VALUE (Function) conditions:use-value NIL (E) 22) new-value [Function] This function transfers control (and one value) to the nearest active restart named conditions:use-value. If no such restart exists, this function simply returns nil. The conditions:use-value restart is generally used by handlers trying to recover from errors of types such as conditions:cell-error, where the handler may wish to supply a replacement datum for one-time use. conditions:store-value(CONDITIONS:STORE-VALUE (Function) conditions:store-value NIL (E) 22) new-value [Function] This function transfers control (and one value) to the nearest active restart named conditions:store-value. If no such restart exists, this function simply returns nil. The conditions:use-value restart is generally used by handlers trying to recover from errors of types such as conditions:cell-error, where the handler may wish to supply a replacement datum to be stored in the offending cell. [This page intentionally left blank](LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "E-" "") STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "E-" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (TEXT NIL NIL (54 54 504 723) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "E-" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "E-" "")) (54 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "E-" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "E-" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE RECTOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL)))))G3HT4&TT4 +TT3 +T-T2.TT3HH T3T-T2&3&T- +T3&T-T,-2T-T-T,53T3T3T-T3 +T-TTT3 +T-T-T-T-T3HH T6 T- T2 &, ,2 5 2HH5 2222 &2HH , 2,2 +22,,22 +,,222 &2 &2&-T222,F PAGEHEADING VERSOHEADF PAGEHEADING RECTOHEADE PAGEHEADINGFOOTINGVE PAGEHEADINGFOOTINGRMODERN +MODERN +TITAN +MODERN +TITAN + TITAN + TITAN +TITAN +MODERN + MODERN + MODERN + +TIMESROMAN TERMINAL  +TIMESROMAN MODERN +TIMESROMANMODERN +MODERNMODERN +G HRULE.GETFNMODERN +G3F HRULE.GETFNMODERN +F1EE HRULE.GETFNMODERN +DD HRULE.GETFNMODERN + HRULE.GETFNMODERN3#  .  + :2?IM.INDEX.GETFNN WIM.INDEX.GETFN HRULE.GETFNMODERN  HRULE.GETFNMODERN{IM.INDEX.GETFNIGIM.INDEX.GETFN2.3R8f:;pi  !6 HRULE.GETFNMODERN2)5 HRULE.GETFNMODERN * #IM.INDEX.GETFN  * =IM.INDEX.GETFN =IM.INDEX.GETFN - , : " AIM.INDEX.GETFN b> *  +  + " OIM.INDEX.GETFN B  #_  8 * 9IM.INDEX.GETFN 860\ h0( IM.INDEX.GETFN  GIM.INDEX.GETFN '* WIM.INDEX.GETFN 5 *CIM.INDEX.GETFNusIM.INDEX.GETFN/* &IM.INDEX.GETFN  ' +';'#'"FIM.INDEX.GETFN +?IM.INDEX.GETFN JIM.INDEX.GETFN*  +B   + % +  " +IM.INDEX.GETFN8 * YIM.INDEX.GETFN # d&8  4 HRULE.GETFNMODERNA*A HRULE.GETFNMODERN3!A HRULE.GETFNMODERN +KIM.INDEX.GETFNTITAN +  , # 1<1 + IM.INDEX.GETFN +  + I  !  9 N C + +9 + +&    9 f        I} $$% +  + zC + + 9 + +&    E + 8   3  :JIM.INDEX.GETFN:= >8 (  %:c ++4:Y 8: +8B  *8 )A;/CIM.INDEX.GETFN8: V!Q?IM.INDEX.GETFN8 -!P/LIM.INDEX.GETFN 88 3=P8  .@A HRULE.GETFNMODERN +/FIM.INDEX.GETFNTITAN + 86k/ <IM.INDEX.GETFN 8M18 W 8 E=*  8 ==;< < 8  +  F   +!RIM.INDEX.GETFNTITAN + H$ *@E&25/ &IM.INDEX.GETFN 8^8  !C / &IM.INDEX.GETFN R +>8  E  $ 8  8  ^  /8% 8  % !IM.INDEX.GETFNTITAN +  x_' e $ E$  7F  1j3 +HI(/?IM.INDEX.GETFNTITAN + ) +*IM.INDEX.GETFNTITAN +) IM.INDEX.GETFNTITAN +) IM.INDEX.GETFNTITAN +)(IM.INDEX.GETFNTITAN + )(IM.INDEX.GETFNTITAN +  )"IM.INDEX.GETFNTITAN + ( % +      +  +  HRULE.GETFNMODERN +DIM.INDEX.GETFNTITAN + F    f N  8  8/DIM.INDEX.GETFNTITAN + /:IM.INDEX.GETFNTITAN + 8  8   88 +  8J s "7D=   7=0   7 +d ; E :   ; T  ]4  <   7 +$$:.....#007Z/FIM.INDEX.GETFNTITAN +7@r/2= 5 + +  7 + +  +"  7}      !MIM.INDEX.GETFNTITAN +   !#IM.INDEX.GETFNTITAN +  L . `B A HRULE.GETFNMODERN +DIM.INDEX.GETFNTITAN +  #  + P. + M+       X7'G +    +  + *c  ' O  +  + + + + ' [  +  + F + +  + $ +   + OC +   *  *  A     *  *  A   y Q  ],,--k,,i,C $A$j$0 $$$'$$$)0};;O0;MC;$C/ +  + +  + 7  +  +7    +  1  e 7$ | +K 7  + 7o 7 + +  + + +!  7d & ;$$$$$$$[7 x $0$.$$,$$$$/$%$/$%$$$!DIM.INDEX.GETFNTITAN +    G U ' +     '      @  u  7/OIM.INDEX.GETFNTITAN + 7; 77'7) B7&l7  g./GIM.INDEX.GETFNTITAN + 7 / + 7E  +  / + 7E  +V  !GIM.INDEX.GETFNTITAN + + $ + / + t* + i]+  + X +KIM.INDEX.GETFNTITAN +-   7S u !'gIM.INDEX.GETFNTITAN + - / r ' ,   [ R  )'#  !RIM.INDEX.GETFNTITAN + !7  $ # -+0 5*!,""$* F8 +&A"/4IM.INDEX.GETFNTITAN + +Q '!9IM.INDEX.GETFNTITAN + D;7  ;;6!?IM.INDEX.GETFNTITAN + D#m +  + + G   !KIM.INDEX.GETFNTITAN + D#*O!AIM.INDEX.GETFNTITAN + + T:VM!EIM.INDEX.GETFNTITAN +  T:V_77?$>z \ No newline at end of file diff --git a/docs/ReleaseNote/ENVOSCOVERSHEET.TEDIT b/docs/ReleaseNote/ENVOSCOVERSHEET.TEDIT new file mode 100644 index 00000000..be64dd0b Binary files /dev/null and b/docs/ReleaseNote/ENVOSCOVERSHEET.TEDIT differ diff --git a/docs/ReleaseNote/Indexfinal.tedit b/docs/ReleaseNote/Indexfinal.tedit new file mode 100644 index 00000000..d26c423c --- /dev/null +++ b/docs/ReleaseNote/Indexfinal.tedit @@ -0,0 +1,138 @@ +1 LISP RELEASE NOTES, MEDLEY RELEASE, INDEX 1 LISP RELEASE NOTES, MEDLEY RELEASE, INDEX INDEX 1 INDEX 1 INDEX 6 A Abort (Editor Command) B-7 ACCESS 3-38 Add-Command (Function) B-14 add.process (Function) 4-12; 7-12 ADDMENU (Function) 4-24 ADDTOSCRATCHLIST (Function) 4-1 ADVICE (File Manager Command) 3-15 ADVINFOLST (Variable) 3-14 ADVISE (File Manager Command) 3-15 ADVISE (Function) 3-13,15 ADVISEDFNS (Variable) 3-14 ADVISEDUMP (Function) 3-14 Advising 3-14; 7-9 AFTERDOMAKESYS 4-7 AFTERDOSAVEVM 4-7 AFTERDOSYSOUT 4-7 AFTERLOGOUT 4-7 AFTERLOGOUTFORMS 4-7 AFTERMAKESYS 4-7 AFTERSAVEVM 4-7 AFTERSYSOUT 4-7 AGAIN (Editor Command) B-8 ALL (Event Address) A-5 ALLOWED-LOGINS 4-6 append (Function) with non-list argument 7-8 Application Menus D-1 APPLY-format input A-3 ARCHIVEFLG (Variable) 3-9 ARCHIVEFN (Variable) 3-9 Arglist (Editor Command) B-9 AROUNDEXITFNS (Variable) 4-7 array reference 7-4 arrays 3-3 ASKUSER (Function) 4-16 assert (Macro) E-10 Attach Menu (Editor Command) B-11 Attached Windows 4-28 AUTHENTICATE 4-6 AUTHENTICATION.NET.HINT (Variable) 4-33 AUTOHARDRESETFLG 4-5 B back-quote facility 3-49 BACKGROUND (FreeMenu Group Property) D-8 BACKGROUND (FreeMenu Item Property) D-10 BACKGROUNDFNS (Variable) 4-12 BACKSPACE (Editing Command) A-21 BCOMPL (Function) 3-22,25; 4-10 BEEPON (Function) 4-31 BEFORELOGOUT 4-7 BEFOREMAKESYS 4-7 BEFORESAVEVM 4-7 BEFORESYSOUT 4-7 BEFORESYSOUTFORMS 4-7 BITMAP (FreeMenu System Property) D-10 BKSYSBUF (Function) 4-30 BKSYSCHARCODE (Function) 4-30 BLOCKRECORD (Record Type) 4-3 BOTTOM (FreeMenu Group Property) D-7 bound E-4 BOUNDP (Function) 3-2 BOX (FreeMenu Group Property) D-5,8 BOX (FreeMenu Item Property) D-10 BOXSHADE (FreeMenu Group Property) D-8 BOXSHADE (FreeMenu Item Property) D-10 BOXSPACE (FreeMenu Group Property) D-8 BOXSPACE (FreeMenu Item Property) D-10 break (Function) 3-13; E-13 break commands 3-13 Break packages 3-9 BREAK0 (Function) 3-13 BREAK1 (Function) 3-9 BREAKCONNECTION (Function) 4-14 BREAKIN (Function) 3-13 breaking 7-9 BREAKREGIONSPEC (Variable) 4-8 BRECOMPILE (Function) 3-22,25 BRKINFOLST (Variable) 3-13 BROKENFNS (Variable) 3-13 bulk data transfer 4-34 C Catch errors 3-10 ccase (Macro) E-10 cerror (Function) E-9 Change Print Base (Editor Command) B-11 CHANGEBACKGROUND (Function) 4-31 CHANGEFONT (Function) 4-23 CHANGESLICE (Function) A-11,17 CHANGESTATE (FreeMenu Item Property) D-11 changing a standard readtable 3-22 characters 3-3 CHARCODE (Function) 3-3 CHCON (Function) 3-42 check-type (Macro) E-10 CL Exec 3-7 CL:* (Variable) A-10 CL:** (Variable) A-10 CL:*** (Variable) A-10 CL:+ (Variable) A-10 CL:++ (Variable) A-10 CL:+++ (Variable) A-10 CL:- (Variable) A-10 CL:/ (Variable) A-10 CL:// (Variable) A-10 CL:/// (Variable) A-10 CL:BREAK (Function) 3-13 CL:CATCH (Function) 3-5 CL:CODE-CHAR (Function) 3 CL:COMPILE-FILE (Function) 3-24-25; 4-10 CL:DEFCONSTANT (Variable) 3-20 CL:DEFINE-MODIFY-MACRO (Function) 3-20 CL:DEFMACRO (Function) 3-20 CL:DEFMACRO (Macro) 3-29 CL:DEFPARAMETER (Macro) 3-26,29 CL:DEFPARAMETER (Variable) 3-20 CL:DEFUN (Function) 3-20 CL:DEFUN (Macro) 3-29 CL:DEFVAR (Macro) 3-29 CL:DEFVAR (Variable) 3-20 CL:ERROR 3-10 CL:EVAL-WHEN (File Package Command) 3-31 CL:GENSYM (Function) 3-2 CL:LOAD (Function) 3-24 CL:MAKE-HASH-TABLE (Function) 3-4 CL:MAPHASH (Function) 3-4 CL:PRIN1 (Function) 3-41-42 CL:PRINC (Function) 3-41 CL:READ (Function) 3-40 CL:READ-PRESERVING-WHITESPACE (Function) 3-41 CL:THROW (Function) 3-5,11 CL:UNWIND-PROTECT 3-6 CL:UNWIND-PROTECT (Function) 3-11 CL:WITH-INPUT-FROM-STRING 3-37 CL:WRITE (Function) 3-41 CLEANUP (Function) 3-25 cleanup forms 3-6 CLEARCLISPARRAY (Function) 4-10 CLEARSTK (Function) 4-5 CLEARSTKLST (Variable) 4-5 CLISP infix forms 3-33 CLISPARRAY 4-2 CLOSEALL (Function) 3-38 closure 7-8 coerce (Function) 7-12 COERCE-TO-NSADDRESS (Function) 4-33 collect (Macro) 7-6 collecting objects macros for 7-6 COLLECTION (FreeMenu Item Property) D-12 COLLECTION property 4-26 COLUMN (FreeMenu Group Property) D-7 COLUMNSPACE (FreeMenu Group Property) D-7 Comment Out Selection (Editor Command) B-9 comment treated as declaration 3-32 Comments in SEdit B-6 Common Lisp strings 3-3 Common Lisp Symbols 3-1 COMMONNUMSYNTAX 3-44 compile-definer (Definer) 7-2 compile-form (Definer) 7-2 compiler behavior with FLETed lexical functions 7-12 behavior with recursion 7-12 ignoring TEdit formatting 7-12 retaining special arguments 7-12 complex numbers 3-4 coms 7-11 condition E-3 conditions:*break-on-signals* (Variable) E-9 conditions:abort (Function) E-21 conditions:compute-restarts (Function) E-18 conditions:continue (Function) E-21 conditions:define-condition (Macro) E-5 conditions:find-restart (Function) E-19 conditions:handler-bind (Macro) E-4,11 conditions:handler-case (Macro) E-11 conditions:ignore-errors (Macro) E-12 conditions:invoke-debugger (Function) E-13 conditions:invoke-restart (Function) E-5,20 conditions:invoke-restart-interactively (Function) E-20 conditions:make-condition (Function) E-6,8 conditions:muffle-warning (Function) E-22 conditions:restart-bind (Macro) E-17 conditions:restart-case (Function) E-5 conditions:restart-case (Macro) E-13 conditions:restart-name (Function) E-19 conditions:signal (Function) E-8 conditions:store-value (Function) E-22 conditions:use-value (Function) E-22 conditions:with-simple-restart (Macro) E-20 CONN (Exec Command) A-7 CONTROL-A (Editing Command) A-21 Control-C (Editor Command) B-7 Control-L (Editor Command) B-7 Control-Meta-; (Editor Command) B-9 Control-Meta-F (Editor Command) B-8 Control-Meta-O (Editor Command) B-7 Control-P 4-29 CONTROL-Q (Editing Command) A-21 CONTROL-R (Editing Command) A-21 Control-T 4-29 CONTROL-W (Editing Command) A-21 Control-W (Editor Command) B-7 CONTROL-X (Editing Command) A-21 Control-X (Editor Command) B-7 Convert Comments (Editor Command) B-9 Convert-Upgrade (Variable) B-14 converting characters 3-3 Converting old code for use with new Error system E-1 COORDINATES (FreeMenu Group Property) D-7 COPY (Function) 3-49 COPYBYTES (Function) 4-16 COPYDEF (Function) 4-4 COPYFILE (Function) 3-38 COPYREADTABLE (Function) 3-46 COS (Function) 4-3 COURIER.CALL (Function) 4-34 COURIER.OPEN (Function) 4-34 Creating an Exec process A-18 Creating conditions E-4 Creating icons with ICONW C-1 CTRLUFLG 4-18 ctypecase (Macro) E-10 CUHOTSPOTX 4-30 CUHOTSPOTY 4-30 CUIMAGE 4-30 current package 3-45 CURSOR 4-30 Cursor Movement Commands A-22 CURSORBITMAP 4-30 CURSORCREATE (Function) 4-30 CURSORHOTSPOTX 4-30 CURSORHOTSPOTY 4-30 D DA (Exec Command) A-7 DAUGHTERS (FreeMenu Group Property) D-8 DC (Function) 3-18 Declining by Condition handler E-4 DEdit 3-15 Default handlers 3-10 Default-Commands (Function) B-15 DEFAULT.OSTYPE (Variable) 4-15 DEFAULTFONT (Variable) D-7 DEFAULTICONFN (Variable) 4-25 DEFAULTTEXTICON (Variable) C-3 deferredconstant (Function) 7-12 define-file-environment (Definer) 7-2 define-record (Definer) 7-3 Defining New Terms A-11 DEFMACRO (Macro) 3-5 defstruct (Macro) 7-4 warning 7-6 DELDEF (Function) 3-28 Delete Selection (Editor Command) B-7 Delete Structure (Editor Command) B-8 Delete Word (Editor Command) B-7 DELFILE (Function) 3-38 DESELECT (FreeMenu Item Property) D-12 DF (Function) 3-18 DFASL files 2-1 DFNFLG (Variable) 3-27 DIR (Exec Command) A-7 DISPLAY (FreeMenu Item) D-6-7,14 Display icons C-1 DISPLAY item 4-26 DISPLAYFONTDIRECTORIES (Variable) 4-23 DMACRO (Property) 3-5 DMACROs 2-1 DO-EVENTS (Exec Command) A-8 DOCOLLECT (Function) 4-1 DOSHAPEFN (Window Property) 4-25 DOWNFN (FreeMenu Mouse Property) D-10 DP (Function) 3-18 DRAWARC (Function) 4-19 DRAWLINE (Function) 4-19 DRAWPOLYGON (Function) 4-20 DSPCLEOL (Function) 4-18 DSPFONT 4-16 DSPRUBOUTCHAR (Function) 4-18 DSPSCALE 4-19 dummy definitions 3-17 DV (Function) 3-18 DWIMIFYCOMPFLG (Variable) 3-34 E ecase (Macro) E-10 ECHOCHAR (FreeMenu Item Property) D-13 ED (Function) 3-16 Edit (Editor Command) B-9 EDIT (FreeMenu Item) 4-27; D-13 Edit caret in SEdit B-2 Edit Interface 3-18 EDITBM (Function) 4-18 EDITCALLERS (Function) 3-19 Editing Exec Input A-20 Editing Lisp Code in Memory B-1 Editing VALUES 3-18 EDITMODE (Function) 3-16 EDITSTART (FreeMenu Item) 4-27; D-14 END-OF-FILE (Error Type) 3-12 ENDCOLLECT (Function) 4-1 Ending an SEdit session B-2 ENDOFSTREAMOP 3-38 ENVAPPLY 3-6 ENVEVAL 3-6 EQUAL (Function) 3-26 EQUALALL (Function) 4-3 ERROR (Function) 3-10 error (Function) E-9 Error conditions 3-10 error system 3-10 Error system differences between old and new E-1 Error system proposal E-1 Error type mapping 3-11 Error type name 3-11 Error type number 3-11 ERROR! (Function) 3-10 ERRORMESS (Function) 3-10 ERRORMESS1 (Function) 3-10 ERRORN (Function) 2-2; 3-10 Errors definition of E-3 ERRORSET 3-10 ERRORSTRING (Function) 3-10 ERRORTYPELIST 3-10 ERRORTYPELIST (Variable) 2-2 ERSETQ (Function) 3-10; 4-8 ERXM 3-10 ESCAPE (Editing Command) A-21 Escape in SEdit B-6 Establishing handlers within dynamic context E-4 etypecase (Macro) E-10 Eval (Editor Command) B-9 EVAL-format input A-2 Exec Editing Commands A-22 Exec type A-4 EXEC-EVAL (Function) 3-9 EXPAND (Editor Command) B-9 EXPANDBITMAP (Function) 4-18 EXPANDMACRO (Function) 3-5 EXPANDREGIONFN (Window Property) 4-24 EXPLICIT (FreeMenu Group Property) D-7 export (Function) 7-9 Extract (Editor Command) B-9 F F (Event Address) A-5 features new Common Lisp 7-1 FETCH 3-33 File Manager 3-19 file-reading functions 3-20 FILEPKGCOM (Function) 4-9 FILEPKGTYPE (Function) 4-9 FILEPKGTYPES (Variable) 3-16 FILEPOS (Function) 4-16 FILERDTBL 3-22 files containing bitmaps 3-31 FILES? (Function) 3-28 FILETYPE (Property) 3-25 FILLPOLYGON (Function) 4-19-20 FIND (Editor Command) B-8 Find Gap (Editor Command) B-8 FIND-READTABLE (Function) 3-45 FINDCALLERS (Function) 3-19 FIX (Exec Command) A-8 FIXP (Predicate) 3-4 flet (Special form) 7-4 floating point 3-4 FLOATP (Predicate) 3-4 FM.BACKGROUND (FreeMenu Window Property) D-15 FM.CHANGELABEL (FreeMenu Function) D-16 FM.CHANGELABEL (Function) 4-27-28 FM.CHANGESTATE (FreeMenu Function) D-16 FM.CHANGESTATE (Function) 4-28 FM.DONTRESHAPE (FreeMenu Window Property) D-15 FM.EDITITEM (FreeMenu Function) D-17 FM.EDITP (FreeMenu Function) D-17 FM.ENDEDIT (FreeMenu Function) D-17 FM.FIXSHAPE (Function) 4-28 FM.FORMATMENU (Function) 4-26-27 FM.GETITEM (Function) 4-27 FM.GETITEM (FreeMenu Function) D-15 FM.GETSTATE (FreeMenu Function) D-16 FM.GETSTATE (Function) 4-27 FM.GROUPPROP (FreeMenu Macro) D-7,18 FM.HIGHLIGHTITEM (FreeMenu Function) D-17 FM.HIGHLIGHTITEM (Function) 4-28 FM.ITEMFROMID (Function) 4-27 FM.ITEMPROP (FreeMenu Macro) D-18 FM.MAKEMENU (Function) 4-26-27 FM.MENUPROP (FreeMenu Macro) D-7,19 FM.NWAYPROP (FreeMenu Macro) D-19 FM.NWAYPROPS (Macro) 4-27 FM.PROMPTWINDOW (FreeMenu Window Property) D-15 FM.READSTATE (Function) 4-27 FM.REDISPLAYITEM (FreeMenu Function) D-18 FM.REDISPLAYMENU (FreeMenu Function) D-18 FM.RESETGROUPS (FreeMenu Function) D-17 FM.RESETMENU (FreeMenu Function) D-17 FM.RESETSHAPE (FreeMenu Function) D-17 FM.RESETSHAPE (Function) 4-28 FM.RESETSTATE (FreeMenu Function) D-17 FM.SHADE (FreeMenu Function) D-18 FM.SHADE (Function) 4-28 FM.SHADEITEM (Function) 4-28 FM.SHADEITEMBM (Function) 4-28 FM.SKIPNEXT (FreeMenu Function) D-17 FM.TOPGROUPID (FreeMenu Function) D-18 FM.WHICHITEM (FreeMenu Function) D-18 FONT (FreeMenu Group Property) D-7 FONT (FreeMenu Item Property) D-9 font descriptor 4-22 FONTCHANGEFLG (Variable) 4-23 FONTCREATE (Function) 4-22 FONTSAVAILABLE 4-21 FOR 3-33 FOR (Exec Command) A-6 FORGET 4-6 FORGET (Exec Command) A-8 FORMAT (FreeMenu Group Property) D-4,7 Free Menu How to make a D-1 Free Menu format D-2 Free Menu layout D-1 FREEMENU (FreeMenu Function) D-15 FREEMENU (Function) 4-26-27 FROM (Event Address) A-5 FULLNAME (Function) 3-37 FUNARG 4-4 G Gaps in SEdit B-4 garbage collector 4-11 gensym (Function) 3-2; 7-12 GET-ENVIRONMENT-AND-FILEMAP (Function) 3-23 Get-Prompt-Window (Function) B-15 Get-Selection (Function) B-16 Get-Window-Region (Function) B-13 GETDEF (Function) 3-28 GETFILEINFO (Function) 3-38; 4-13 GETPROMPTWINDOW (Function) 4-28 GETREADTABLE (Function) 3-39 GETSYNTAX 3-45 global macro shadowing 7-4 GROUP (FreeMenu Group Property) D-7 GROUPID (FreeMenu System Property) D-10 H handler (Function) E-4 Handling conditions E-3 HARDCOPYW (Function) 4-29 HARDRESET (Function) 4-4 HASDEF (Function) 3-26,28; 4-9 hash arrays 3-4 HASHARRAY 3-4 HASHARRAY (Function) 4-2 HELDFN (FreeMenu Mouse Property) D-10 HELP (Editor Command) B-9 HELP (Function) 3-10 Help Menu Commands B-11 HIGHLIGHT (FreeMenu Item Property) D-9,14 History list A-16 HISTORYSAVEFORMS (Variable) 3-9 HJUSTIFY (FreeMenu Item Property) D-4,9 HORRIBLEVARS 4-9,15 HPRINT (Function) 4-15 I ICONW (Function) C-1 ICONW windows from an image defined by a mask C-1 with titles C-1 ICONW.SHADE (Function) C-2 ICONW.TITLE (Function) C-2 ID (FreeMenu Group Property) D-7 ID (FreeMenu Item Property) D-9 IDLE-PROFILE 4-6 IDLE-RESETVARS (Variable) 4-6 IDLE-SUSPEND-PROCESS.NAMES (Variable) 4-7 IEEE 802-3 specification 4-34 IF 3-33 IL Exec 3-7 IL:IT (Variable) A-9 IL:LOAD (Function) 3-24 IL:MAPHASH (Function) 3-4 IL:PRIN1 (Function) 3-41 IL:PRIN2 (Function) 3-41 IL:READ (Function) 3-40 ILLEGAL-GO (Error Type) 3-11 ILLEGAL-RETURN (Error Type) 3-11 ILLEGAL-STACK-ARG (Error Type) 3-12 IN (Exec Command) A-6 in-package (Function) 7-8 INFILEP (Function) 3-37 INFINITEWIDTH (FreeMenu Item Property) D-13 INITSTATE (FreeMenu Item Prop) 4-26 INITSTATE (FreeMenu Item Property) D-9,12 INPUT (Function) 3-37 INPUTFONT (Variable) A-10 Inspect (Editor Command) B-10 INTEGERLENGTH (Function) 4-3 integers 3-4 Interlisp Compiler 3-31 INTERLISP-ERROR (Error Type) 3-12 INTERPRESSFONTDIRECTORIES (Variable) 4-22 INTERRUPTCHAR (Function) 4-29 INVALID-ARGUMENT-LIST (Error Type) 3-12 ITEMS (FreeMenu Group Property) D-8 J Join (Editor Command) B-10 K Keep-Window-Region (Variable) B-13 KEYACTION (Function) 4-31 KEYDOWNP (Function) 4-31 L LABEL (FreeMenu Item Property) D-9 LABELS construct warning 7-10 LASTC (Function) 4-15 Layout of Free Menu D-1 LCOM files 2-1 ldflg 7-11 LEFT (FreeMenu Group Property) D-7 LEFT and BOTTOM (FreeMenu Item Property) D-9 Left mouse button in SEdit B-3 lexical bindings 3-33 Library modules summary of changes 5-1 LIMITCHARS (FreeMenu Item Property) D-3,13 LINKS (FreeMenu Item Property) D-10,15 LISP 3-47 Lisp structures SEdit gaps for B-4 LISPSOURCEFILEP (Function) 4-10 LISPXEVAL (Function) 3-9 LISPXFNS (Variable) A-15 LISPXHISTORY (Variable) A-16 LISPXHISTORYMACROS (Variable) 3-9 LISPXMACROS 3-8 LISPXMACROS (Variable) 3-9 LISPXREADFN (Function) 4-8 LISPXUNREAD (Function) 3-9 LISPXUSERFN (Variable) 3-9 LIST (Function) 3-49 Lists in SEdit B-5 LOAD (Function) 3-20 loadflg (Argument) 7-11 load-time expression 7-4 LOADCOMP (Function) 3-25 LOADFNS (Function) 3-20,25 LOADFROM (Function) 3-25 loading compiled files 3-32 loading Medley files into Lyric 4-10 LOADVARS (Function) 3-25 Locally defined handler E-4 LOCALVARS 3-2 LOGIN.TIMEOUT 4-6 LOGOUT (Function) 4-7 long-site-name (Variable) 7-3 M MACHINETYPE (Function) 4-7 MAKE-READER-ENVIRONMENT (Function) 3-23 MAKEFILE (Function) 3-20,25,43,49 MAKEFILE-ENVIRONMENT (Property) 3-21 MAKESYS (Function) 4-7 MAKETITLEBARICON 4-25 map (Function) 7-11 MAPATOMS (Function) 3-2-3 MAX (Function) 4-2 MAX.INTEGER (Variable) 4-2 MAXHEIGHT (FreeMenu Item Property) D-9 MAXREGION (FreeMenu System Property) D-11 MAXWIDTH (FreeMenu Item Property) D-7,9,13 Medley on Sun workstations 1-1 on Xerox workstations 1-1 Medley compiled files 2-1 Medley enhancements summary 1-1 MENU (FreeMenu Group Property) D-7 MENUFONT (FreeMenu Item Property) D-12 MENUITEMS (FreeMenu Item Property) D-6,12 MENUTITLE (FreeMenu Item Property) D-12 MESSAGE (FreeMenu Item Property) D-9 Meta- ( (Editor Command) B-10 Meta- ) (Editor Command) B-10 Meta- / (Editor Command) B-9 Meta-9 (Editor Command) B-10 Meta-; (Editor Command) B-9 Meta-A (Editor Command) B-7 Meta-B (Editor Command) B-11 Meta-Control-C (Editor Command) B-7 Meta-Control-S (Editor Command) B-8 Meta-Control-X (Editor Command) B-7 Meta-E (Editor Command) B-9 Meta-F (Editor Command) B-8 Meta-H (Editor Command) B-9 Meta-I (Editor Command) B-10 Meta-J (Editor Command) B-10 Meta-M (Editor Command) B-11 Meta-N (Editor Command) B-8 Meta-O (Editor Command) B-9 Meta-P (Editor Command) B-11 Meta-R (Editor Command) B-8 Meta-Return (Editor Command) B-10 Meta-S (Editor Command) B-8 Meta-Space (Editor Command) B-10 Meta-U (Editor Command) B-7 Meta-X (Editor Command) B-9 Meta-Z (Editor Command) B-10 Middle mouse button in SEdit B-3 MIN (Function) 4-2 MIN.INTEGER (Variable) 4-2 minimum window size 4-24 MKSTRING (Function) 3-42 MOMENTARY (FreeMenu Item) D-11 MOTHER (FreeMenu Group Property) D-8 Mouse buttons in SEdit B-3 MOVD (Function) 4-4 MOVEDFN (FreeMenu Mouse Property) D-10 multiple escape character 3-42 Multiple Execs A-4 multiple streams 3-37 MULTIPLE-ESCAPE 3-45 Mutate (Editor Command) B-10 N NAME (Exec Command) A-8 NCHARS (Function) 3-42 NCHOOSE item 4-26 NDIR (Exec Command) A-8 Nesting Free Menu Groups D-2 NETWORKOSTYPES (Variable) 4-15 NEW (MAKEFILE Option) 3-21 NLAMBDA 3-5 NLSETQ (Function) 3-10; 4-8 NOBIND 3-2 NOCLEARSTKLST (Variable) 4-5 NODIRCORE (File Device) 4-13 Normalize Selection (Editor Command) B-10 notational conventions 18 NSADDRESS 4-32 NSNAME 4-32 NSNET.DISTANCE (Function) 4-35 NUMBER (FreeMenu Item) D-14 NUMBERP (Predicate) 3-4 NUMBERTYPE (FreeMenu Item Property) D-14 NWAY (FreeMenu Item) 4-26; D-6; 12 NWAYPROPS (FreeMenu Item Prop) 4-27 NWAYPROPS (FreeMenu Item Property) D-6,12 O OLD-INTERLISP-FILE 3-47 OLD-INTERLISP-T 3-48 once-only (Macro) 7-7 OPENFILE (Function) 3-37 OPENFN (Window Property) 4-25 OPENP (Function) 3-38 OPENSTREAM (Function) 3-11,37 OPENSTRINGSTREAM (Function) 3-37; 4-16 options E-5 ORIG 3-46 OUTPUT (Function) 3-37 P package delimiter 2-2 PACKAGEDELIM 3-47 packages 3-19 PARSE-NSADDRESS (Function) 4-33 PAT (Event Address) A-5 pattern matching 3-6 PEEKC (Function) 4-15 pkg-goto (Function) 7-8 PL (Exec Command) A-8 PLVLFILEFLG 3-42 PP (Exec Command) A-9 PRETTYDEF (Function) 4-9 PRIN1 4-30 PRIN2 4-30 PRINT (Function) 3-20,48 PRINTLEVEL 4-29 PRINTNUM (Function) 4-15 PRINTOUT 3-43 PRINTOUTFONT (Variable) A-11 PRINTSERVICE (Variable) 4-19 process status window 4-12 PROCESS.APPLY (Function) 4-12 PROCESS.EVAL (Function) 4-12 Programmer's interface to SEdit B-12 PROMPT#FLG (Variable) 3-9 PROMPTFONT (Variable) A-10 PROMTPCHARFORMS (Variable) 3-9 PROTECTION 4-13 PRXFLG 3-42 PUTDEF (Function) 3-28 Q Quote (Editor Command) B-10 Quoted structures in SEdit B-5 R RADIX (Function) 3-44 ratios 3-4 READ (Function) 3-20,48 read-eval-print A-1 read/print consistency 3-44 READBUF (Variable) 3-9 READC (Function) 3-41 READER 4-13 READER-ENVIRONMENT 3-20 READLINE (Function) 4-8 READMACROS 4-16 READSYS (Function) 4-35 READTABLEPROP (Function) 3-45 READVISE (Function) 3-14 REALFRAMEP (Function) 4-5 REBREAK (Function) 3-14 RECOMPILE (Function) 3-22,25 record-create (Macro) 7-4 record-fetch (Macro) 7-4 record-ffetch (Macro) 7-4 Redisplay (Editor Command) B-7 Redo (Editor Command) B-8 REDO (Exec Command) A-6 REGION (FreeMenu Group Property) D-8 REGION (FreeMenu System Property) D-11 RELDRAWTO (Function) 4-19 Release Notes organization of 17 REMEMBER (Exec Command) A-8 REMPROP (Function) 3-2 RENAMEFILE (Function) 3-38 REPAINTFN 4-24 REPAINTFN (Window Property) 4-25 REPEATUNTIL 4-3 Replace-Selection (Function) B-16 Reporting a condition or restart E-5 Reset (Function) 3-10; B-14 Reset-Commands (Function) B-15 RESETFORM 3-40 RESETFORM 3-39 RESETFORMS (Variable) 3-9 RESETLST 3-6 Resetting system state 3-11 RESETVARS 4-6 RESHAPEFN 4-24 Restart type E-5 Restarting computations E-3 Restarting conditions E-5 RETAPPLY 3-6 RETEVAL 3-6 RETFROM 3-6 RETFROM (Function) 3-11 RETRY (Exec Command) A-6 RETTO 3-6 RETURN 3-13; 4-5 Reverse Find (Editor Command) B-8 Right mouse button in SEdit B-3 ROTATE-BITMAP (Function) 4-18 ROW (FreeMenu Group Property) D-7 row-major-aref (Function) 7-4 ROWSPACE (FreeMenu Group Property) D-7 RS232 or TTY ports 3-38 S Save-Window-Region (Function) B-13 SAVEVM (Function) 4-7 SCRATCHLIST 4-1 SEdit 3-15 SEdit (Function) B-16 SEdit Command Menu B-12 SEE (Exec Command) A-9 SEE* (Exec Command) A-9 SELECTEDFN (FreeMenu Mouse Property) D-10 Set Package (Editor Command) B-11 SETERRORN (Function) 3-10 SETFILEINFO (Function) 3-38; 4-13 SETREADTABLE (Function) 3-48 SETSTKARGNAME (Function) 4-5 SETSYNTAX 3-45,49 SHAPEW (Function) 4-24 SHH (Exec Command) A-8 SHIFT-FIND (Editor Command) B-8 short-site-name (Variable) 7-3 SHOULDCOMPILEMACROATOMS (Variable) 4-4 SHOULDNT (Function) 3-10 SHOWPARENFLG (Variable) A-25 SHRINKBITMAP (Function) 4-18 SHRINKFN (Window Property) 4-24 SIDE effects of event A-18 Signalling conditions E-3 SIN (Function) 4-3 Sketch summary of changes 6-10 SKIP-NEXT (Editor Command) B-8 SKREAD (Function) 3-41 SORT (Function) 4-1 Special characters in SEdit B-5 Specifying event addresses A-4 Specifying Free Menu Items D-2 stack manipulations 3-5 STACK OVERFLOW (Error Type) 4-4 Stack pointers 3-5 STACK-OVERFLOW (Error Type) 3-11 STACK-POINTER-RELEASED (Error Type) 3-12 Starting an SEdit session B-2 STATE 4-26 STATE (FreeMenu Item) D-7,11 STATE (FreeMenu Item Property) D-12 STATE (FreeMenu System Property) D-10 STKARG (Function) 4-5 STKNARGS (Function) 4-5 STKPOS (Function) 4-5 STOP (Function) 4-10 STOP-UNDOABLY (Macro) A-13 strings 3-3 in SEdit B-6 STRINGWIDTH (Function) 3-42; 4-22 Structure caret in SEdit B-2 Structure editor 3-15 Substitute (Editor Command) B-8 SUCHTHAT (Event Address) A-5 SUSPEND-PROCESS.NAMES 4-7 Switching between editors 3-16 Symbols 3-1,6 in Error system E-1 symbols in the INTERLISP package 3-20 SYSDOWNFN (FreeMenu System Property) D-11 sysload 3-24; 7-11 SYSMOVEDFN (FreeMenu System Property) D-11 SYSOUT (Function) 4-7 SYSPRETTYFLG (Variable) 3-9 SYSSELECTEDFN (FreeMenu System Property) D-11 T TABLE (FreeMenu Group Property) D-7 TCOMPL (Function) 3-22,25; 4-10 TEdit summary of changes 6-1 TeleRaid Library module 4-35 TEXTICON (Function) 4-25; C-3 TIME (Exec Command) A-9 TIME (Function) 3-36 TIME (Macro) 3-36 TITLE (FreeMenu Item) 4-27 titled icons 4-25 TITLEDICONW (Function) C-1 TOGGLE (FreeMenu Item) D-11 TOO-MANY-ARGUMENTS (Error Type) 3-12 TRACE (Function) 3-13-14 TTYBACKGROUNDFNS (Variable) 4-12 TTYDISPLAYSTREAM (Function) 4-25 TTYIN display typein editor 4-16 TTYIN Editor from Exec A-20 TY (Exec Command) A-9 TYPE (Exec Command) A-9 TYPE (FreeMenu Item Property) D-9 U UGLYVARS 3-43; 4-9,15 UNBOUND-VARIABLE (Error Type) 3-12 UNBREAK (Function) 3-14 UNBREAKIN (Function) 3-13 UNDEFINED-CAR-OF-FORM (Error Type) 3-12 UNDEFINED-FUNCTION-IN-APPLY (Error Type) 3-12 UNDO (Editor Command) B-7 UNDO (Exec Command) A-4,8,13 UNDO key (Editing Command) A-21 UNDOABLY-MAKUNBOUND (Function) 3-29 UNDOABLY-SETQ (Function) A-15 Undoing in Functions A-14 Undoing In Programs A-13 Undoing out of order A-16 UNDOSAVE (Function) A-15 UNIXFTPFLG (Variable) 4-14 UNPACKFILENAME (Function) 3-37 UNSAFEMACROATOMS (Variable) 4-4 UNTIL 4-3 USE (Exec Command) A-6 USERDATA (FreeMenu System Property) D-11 USERDATA LIST D-14 USEREXEC (Function) 3-9 USERNAME 4-6 USERWORDS (Variable) A-25 USESILPACKAGE 3-45 Using Execs 3-7 V VALUEFONT (Variable) A-11 VARS 4-15 version delimiter 2-2 VIDEORATE (Function) 4-31 VJUSTIFY (FreeMenu Item Property) D-9 W warn (Function) E-10 WHENCHANGED 4-9 WINDOWPROP (Function) 4-26 WINDOWPROPS 4-26 with-collection (Macro) 7-6 with-input-from-string (Macro) 7-13 with-output-to-string (Macro) 7-13 WITH-READER-ENVIRONMENT (Macro) 3-23 write-string (Function) 7-12 WRITESTRIKEFONTFILE (Function) 4-22 writing macros macros for 7-7 Writing your own SEdit commands B-14 X XCL 3-47 XCL Compiler 3-31 XCL Exec 3-7 XCL readtable 3-21 xcl:*current-condition* (Variable) E-8 XCL:*DEBUGGER-PROMPT* (Variable) A-19 XCL:*EVAL-FUNCTION* (Variable) A-19 XCL:*EXEC-PROMPT* (Variable) A-19 XCL:*PER-EXEC-VARIABLES* (Variable) A-18 XCL:ABORT (Function) 3-10 XCL:ADD-EXEC (Function) A-18 XCL:ARGLIST (Variable) 3-15 XCL:ARRAY-SPACE-FULL (Error Type) 3-12 XCL:ATTEMPT-TO-CHANGE-CONSTANT (Error Type) 3-11-12 XCL:ATTEMPT-TO-RPLAC-NIL (Error Type) 3-11 XCL:CATCH-ABORT 3-10 xcl:catch-abort (Macro) E-21 XCL:CONDITION 3-10 xcl:condition-case (Macro) E-11 xcl:condition-handler (Macro) E-8 xcl:condition-reporter (Macro) E-7 XCL:CONTROL-E-INTERRUPT (Error Type) 3-12 XCL:DATA-TYPES-EXHAUSTED (Error Type) 3-12 XCL:DEF-DEFINE-TYPE (Macro) 3-27-28 XCL:DEFCOMMAND 3-8 XCL:DEFCOMMAND (Macro) A-11 XCL:DEFDEFINER (Function) 3-20 XCL:DEFDEFINER (Macro) 3-29 XCL:DEFGLOBALPARAMETER (Variable) 3-20 XCL:DEFGLOBALVAR (Variable) 3-20 XCL:DEFINE-PROCEED-FUNCTION (Function) 3-20 XCL:DEFINLINE (Function) 3-20 XCL:DEFOPTIMIZER 3-32 XCL:DEFOPTIMIZER (Macro) 3-5 XCL:EXEC (Function) A-18 XCL:EXEC-EVAL (Function) A-19 XCL:EXEC-FORMAT (Function) A-19 XCL:FILE-NOT-FOUND (Error Type) 3-12 XCL:FILE-WONT-OPEN (Error Type) 3-11 XCL:FLOATING-OVERFLOW (Error Type) 3-12 XCL:FLOATING-UNDERFLOW (Error Type) 3-12 XCL:FS-PROTECTION-VIOLATION (Error Type) 3-12 XCL:FS-RESOURCES-EXCEEDED (Error Type) 3-12 XCL:HASH-TABLE-FULL (Error Type) 3-12 XCL:INVALID-PATHNAME (Error Type) 3-12 XCL:SET-DEFAULT-EXEC-TYPE (Function) A-20 XCL:SET-EXEC-TYPE (Function) A-20 XCL:SIMPLE-DEVICE-ERROR (Error Type) 3-11 XCL:SIMPLE-TYPE-ERROR (Error Type) 3-11 XCL:STORAGE-EXHAUSTED (Error Type) 3-12 XCL:STREAM-NOT-OPEN (Error Type) 3-11 XCL:SYMBOL-HT-FULL (Error Type) 3-11 XCL:SYMBOL-NAME-TOO-LONG (Error Type) 3-11 XCL:UNDOABLY (Macro) A-13 XCL:UNDOABLY-SETF (Macro) A-15 1 10MB Ethernet encapsulation types 4-34 1108 User's Guide summary of changes 6-14 1186 User's Guide summary of changes 6-16 3 3STATE (FreeMenu Item) 4-26; D-11 \ \#UNDOSAVES (Variable) A-15 \10MBTYPE-3TO10 (Variable) 4-34 \10MBTYPE-PUP (Variable) 4-34 ~ ~C (Format directive) 7-13 ! !EVAL 2-2 * *break-on-warnings* (Variable) E-10 *Clear-Linear-On-Completion* (Variable) B-14 *Compile-Fn* (Variable) B-16 *COMPILED-EXTENSIONS* (Variable) 3-25 *DEFAULT-CLEANUP-COMPILER* (Variable) 3-25 *DEFAULT-MAKEFILE-ENVIRONMENT* (Variable) 3-21 *Edit-Fn* (Variable) B-16 *ERROR-OUTPUT* (Variable) 3-10 *Fetch-Definition-Error-Break-Flag* (Variable) B-16 *Getdef-Error-Fn* (Variable) B-16 *Getdef-Fn* (Variable) B-16 *LAST-CONDITION* (Variable) 3-10 *LISPXPRINT* (Property) A-18 *NSADDRESS-FORMAT* (Variable) 4-32 *PACKAGE* (Variable) 3-20,45-46; A-1 *PRINT-ARRAY* (Variable) 3-43 *PRINT-BASE* (Variable) 3-39,42,44 *PRINT-BASE* vs RADIX 3-39 *PRINT-CASE* (Variable) 3-44 *PRINT-ESCAPE* (Variable) 3-41,44 *PRINT-LENGTH* (Variable) 4-22 *PRINT-LEVEL* (Variable) 4-22 *PRINT-LEVEL* & *PRINT-LENGTH* vs PRINTLEVEL 3-39 *PRINT-LEVEL* or *PRINT-LENGTH* is exceeded 3-45 *PRINT-RADIX* (Variable) 3-39,44 *READ-BASE* (Variable) 3-20,44 *READ-SUPPRESS* (Variable) 3-41 *READTABLE* (Variable) 3-39,41-42,48 *READTABLE* vs SETREADTABLE 3-39 *REMOVE-INTERLISP-COMMENTS* (Variable) 3-29-30 *STANDARD-INPUT* (Variable) 3-37 *STANDARD-INPUT* vs INPUT 3-39 *STANDARD-OUTPUT* (Variable) 3-37 *STANDARD-OUTPUT* vs OUTPUT 3-39 *Wrap-Parens* (Variable) B-13 *Wrap-Search* (Variable) B-14 : :fast-accessors (Defstruct option) 7-5 :inline (Defstruct option) 7-5 :template (Defstruct option) 7-5 :type (Defstruct option) 7-5 = = (Event Address) A-5 ? ? (Exec Command) A-7 ?? (Exec Command) A-7 ?ACTIVATEFLG (Variable) A-24 (LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "INDEX-" "") STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "INDEX-" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (TEXT NIL NIL (54 54 240 723) NIL) (TEXT NIL NIL (318 54 240 723) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "INDEX-" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "INDEX-" "")) (54 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 240 684) NIL) (TEXT NIL NIL (318 54 240 684) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "INDEX-" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "INDEX-" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE RECTOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 240 684) NIL) (TEXT NIL NIL (318 54 240 684) NIL))))) ,K,K-K T5x6xT,K-K T2,F PAGEHEADING VERSOHEADF PAGEHEADING RECTOHEADE PAGEHEADINGFOOTINGVE PAGEHEADINGFOOTINGRMODERN +MODERN +MODERN +MODERN +MODERN +MODERN +MODERNMODERN +  HRULE.GETFNMODERN + .  HRULE.GETFNMODERN + -   HRULE.GETFNMODERN + + + HRULE.GETFNMODERN +  HRULE.GETFNMODERN                + +              +          +                   +        +        +    + +            +  +         + +  +  + +  +   +        +  +     +   +     +     +       +   ! +    +)      +  + + +  )    +  +      +                   +       +  +      !          +  + +        +              +    +    +   +       +       +   +   "       + +     + .  +          +          +    +                    +    +          +  +     +            +                   !        +      +  +                +      +  +        +                +  +    + " +        +                   +           +      +     +           + +         +   +       +  +                   +      +        + + +      + +       "        +   +     +                       +    +       +    +  +     + "  +       +  +  +      +  +     +   +       +  +             + + + +   "             + + + + + +  +     + +      + +#                %                /-              x5z \ No newline at end of file diff --git a/docs/ReleaseNote/LOT.tedit b/docs/ReleaseNote/LOT.tedit new file mode 100644 index 00000000..8fa75057 Binary files /dev/null and b/docs/ReleaseNote/LOT.tedit differ diff --git a/docs/ReleaseNote/PREFACE.TEDIT b/docs/ReleaseNote/PREFACE.TEDIT new file mode 100644 index 00000000..dd8c96df Binary files /dev/null and b/docs/ReleaseNote/PREFACE.TEDIT differ diff --git a/docs/ReleaseNote/PRINTINGSPEC.TEDIT b/docs/ReleaseNote/PRINTINGSPEC.TEDIT new file mode 100644 index 00000000..0d3cea2f Binary files /dev/null and b/docs/ReleaseNote/PRINTINGSPEC.TEDIT differ diff --git a/docs/ReleaseNote/SEC1-INTRODUCTION.TEDIT b/docs/ReleaseNote/SEC1-INTRODUCTION.TEDIT new file mode 100644 index 00000000..c69de86f Binary files /dev/null and b/docs/ReleaseNote/SEC1-INTRODUCTION.TEDIT differ diff --git a/docs/ReleaseNote/SEC2-NOTES-AND-CAUTIONS.TEDIT b/docs/ReleaseNote/SEC2-NOTES-AND-CAUTIONS.TEDIT new file mode 100644 index 00000000..36d058bc Binary files /dev/null and b/docs/ReleaseNote/SEC2-NOTES-AND-CAUTIONS.TEDIT differ diff --git a/docs/ReleaseNote/SEC3-IRMFEATURES-I.TEDIT b/docs/ReleaseNote/SEC3-IRMFEATURES-I.TEDIT new file mode 100644 index 00000000..fc9ff4c3 Binary files /dev/null and b/docs/ReleaseNote/SEC3-IRMFEATURES-I.TEDIT differ diff --git a/docs/ReleaseNote/SEC3-IRMFEATURES-II.TEDIT b/docs/ReleaseNote/SEC3-IRMFEATURES-II.TEDIT new file mode 100644 index 00000000..867b9bd7 Binary files /dev/null and b/docs/ReleaseNote/SEC3-IRMFEATURES-II.TEDIT differ diff --git a/docs/ReleaseNote/SEC3-IRMFEATURES-III.TEDIT b/docs/ReleaseNote/SEC3-IRMFEATURES-III.TEDIT new file mode 100644 index 00000000..6cf967cf Binary files /dev/null and b/docs/ReleaseNote/SEC3-IRMFEATURES-III.TEDIT differ diff --git a/docs/ReleaseNote/SEC4-IRMERRATA.TEDIT b/docs/ReleaseNote/SEC4-IRMERRATA.TEDIT new file mode 100644 index 00000000..f7cd082d Binary files /dev/null and b/docs/ReleaseNote/SEC4-IRMERRATA.TEDIT differ diff --git a/docs/ReleaseNote/SEC5-LIBRARY-MODULES.TEDIT b/docs/ReleaseNote/SEC5-LIBRARY-MODULES.TEDIT new file mode 100644 index 00000000..394c5a00 Binary files /dev/null and b/docs/ReleaseNote/SEC5-LIBRARY-MODULES.TEDIT differ diff --git a/docs/ReleaseNote/SEC6-USERS-GUIDES.TEDIT b/docs/ReleaseNote/SEC6-USERS-GUIDES.TEDIT new file mode 100644 index 00000000..b06d1e34 Binary files /dev/null and b/docs/ReleaseNote/SEC6-USERS-GUIDES.TEDIT differ diff --git a/docs/ReleaseNote/SEC7-CLIMPLMNTN.TEDIT b/docs/ReleaseNote/SEC7-CLIMPLMNTN.TEDIT new file mode 100644 index 00000000..4b01bb72 Binary files /dev/null and b/docs/ReleaseNote/SEC7-CLIMPLMNTN.TEDIT differ diff --git a/docs/ReleaseNote/TABS2L.SKETCH b/docs/ReleaseNote/TABS2L.SKETCH new file mode 100644 index 00000000..4f638dd0 Binary files /dev/null and b/docs/ReleaseNote/TABS2L.SKETCH differ diff --git a/docs/ReleaseNote/TABSINFOP.SKETCH b/docs/ReleaseNote/TABSINFOP.SKETCH new file mode 100644 index 00000000..95fdb9b0 --- /dev/null +++ b/docs/ReleaseNote/TABSINFOP.SKETCH @@ -0,0 +1,2 @@ +((SKETCH %{ERIS%}MEDLEY>RELNOTES>TABSINFOP.SKETCH;4 VERSION 3 PRIRANGE (217 . 0) SKETCHCONTEXT ((ROUND 1 BLACK) (MODERN 10 (BOLD REGULAR REGULAR)) (CENTER BASELINE) (CURVE 18.0 8) NIL NIL (CENTER CENTER) (NIL NIL NIL) T NIL NIL 1 NIL)) ((0.03847551 11.54265 (PRI 1)) (TEXT (110.9365 . 707.4918) ("") 0.7695101 (CENTER BASELINE) (MODERN 14 (BOLD ITALIC REGULAR)) ((110.8095 703.717 0.0 11.54265)) BLACK)) ((0.03847551 14.62069 (PRI 2)) (TEXT (295.0091 . 736.6715) ("") 0.7695101 (CENTER BASELINE) (MODERN 18 (MEDIUM REGULAR REGULAR)) ((294.7224 732.1889 0.0 14.62069)) BLACK)) ((0.0538657 20.468966 (PRI 3)) (TEXT (279.6189 . 736.6715) ("TABS FOR MEDLEY RELEASE NOTES MANUAL (2-1/4%" BINDER)") 1.077314 (CENTER BASELINE) (MODERN 18 (BOLD REGULAR REGULAR)) ((2.693285 730.9576 554.8167 20.468966)) BLACK)) ((0.05 12.0 (PRI 4)) (TEXT (264.0 . 448.0) ("Table of Contents ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((219.5 445.0 89 12)) BLACK)) ((0.05 13.0 (PRI 5)) (TEXT (204.0 . 400.0) (" ") 1 (CENTER BASELINE) (MODERN 10 (MEDIUM REGULAR REGULAR)) ((202.0 396.5 4 13)) BLACK)) ((0.05 12.0 (PRI 6)) (TEXT (220.0 . 376.0) (" ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((219.0 373.0 2 12)) BLACK)) ((0.05 12.0 (PRI 7)) (TEXT (296.0 . 396.0) (" 1. Introduction ") 1 (RIGHT BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((217.0 393.0 79 12)) BLACK)) ((0.05 12.0 (PRI 8)) (TEXT (288.0 . 344.0) ("3. Integration of Languages ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((220.0 341.0 136 12)) BLACK)) ((0.05 12.0 (PRI 9)) (TEXT (284.0 . 292.0) ("4. Changes to Interlisp-D ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((223.0 289.0 122 12)) BLACK)) ((0.05 12.0 (PRI 10)) (TEXT (264.0 . 244.0) ("6. User's Guides ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((223.5 241.0 81 12)) BLACK)) ((0.05 12.0 (PRI 11)) (TEXT (304.0 . 216.0) ("7. Common Lisp Implementation ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((225.0 213.0 158 12)) BLACK)) ((0.05 12.0 (PRI 12)) (TEXT (248.0 . 140.0) ("B. SEdit ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((226.0 137.0 44 12)) BLACK)) ((0.05 12.0 (PRI 13)) (TEXT (252.0 . 116.0) ("C. ICONW ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((226.5 113.0 51 12)) BLACK)) ((0.05 12.0 (PRI 14)) (TEXT (272.0 . 268.0) ("5. Library Modules ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((224.5 265.0 95 12)) BLACK)) ((0.05 15.0 (PRI 15)) (TEXT (105.0 . 703.0) ("TYPE: MAJOR") 1 (CENTER BASELINE) (MODERN 14 (BOLD ITALIC REGULAR)) ((59.0 698.5 92 15)) BLACK)) ((0.05 15.0 (PRI 16)) (TEXT (113.0 . 687.0) ("TAB SIZE: 2-3/8%"") 1 (CENTER BASELINE) (MODERN 14 (BOLD ITALIC REGULAR)) ((58.5 682.5 109 15)) BLACK)) ((0.05 15.0 (PRI 17)) (TEXT (125.0 . 671.0) ("NO. TABS PER BANK: 5") 1 (CENTER BASELINE) (MODERN 14 (BOLD ITALIC REGULAR)) ((49.5 666.5 151 15)) BLACK)) ((0.05 15.0 (PRI 18)) (TEXT (113.0 . 656.0) ("NO. OF BANKS: 3") 1 (CENTER BASELINE) (MODERN 14 (BOLD ITALIC REGULAR)) ((56.0 651.5 114 15)) BLACK)) ((0.05 15.0 (PRI 19)) (TEXT (200.0 . 636.0) ("COLOR OF TABS: GREEN background, BLACK lettering ") 1 (CENTER BASELINE) (MODERN 14 (BOLD ITALIC REGULAR)) ((17.0 631.5 366 15)) BLACK)) ((0.05 12.0 (PRI 20)) (TEXT (264.0 . 92.0) ("D. Free Menu ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((228.0 89.0 72 12)) BLACK)) ((0.05 12.0 (PRI 21)) (TEXT (268.0 . 68.0) ("E. Error System ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((228.0 65.0 80 12)) BLACK)) ((0.05 12.0 (PRI 22)) (TEXT (256.0 . 192.0) ("A. The Exec ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((226.0 189.0 60 12)) BLACK)) ((0.05 13.0 (PRI 23)) (TEXT (328 . 664) ("Point size: 10 " "Font : Modern ") 1 (CENTER BASELINE) (MODERN 12 (BOLD ITALIC REGULAR)) ((289.0 667.0 78 13) (285.0 654.0 86 13)) BLACK)) ((0.05 12.0 (PRI 24)) (TEXT (240.0 . 420.0) ("Preface ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((221.0 417.0 38 12)) BLACK)) ((0.05 12.0 (PRI 25)) (TEXT (272 . 372) ("2. Notes and Cautions ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((220.5 369.0 103 12)) BLACK)) ((0.05 12.0 (PRI 26)) (TEXT (244.0 . 40.0) ("Index ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((229.5 37.0 29 12)) BLACK)) ((0.03847551 11.54265 (PRI 27)) (TEXT (110.9365 . 707.4918) ("") 0.7695101 (CENTER BASELINE) (MODERN 14 (BOLD ITALIC REGULAR)) ((110.8095 703.717 0.0 11.54265)) BLACK)) ((0.038475506 10.773141 (PRI 28)) (TEXT (149.7169 . 319.9311) ("BANK 2") 0.7695101 (CENTER BASELINE) (MODERN 12 (MEDIUM REGULAR REGULAR)) ((132.35573 317.80768 35.397465 10.773141)) BLACK)) ((0.05 13.0 (PRI 29)) (TEXT (212.0 . 312.0) (" ") 1 (CENTER BASELINE) (MODERN 10 (MEDIUM REGULAR REGULAR)) ((210.0 308.5 4 13)) BLACK)) ((0.05 12.0 (PRI 30)) (TEXT (228.0 . 288.0) (" ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((227.0 285.0 2 12)) BLACK)) ((0.12 64.0 (PRI 31)) (BOX (88.0 184.0 120.0 128.0) (ROUND 1 BLACK) NIL 1 (NIL NIL NIL))) ((0.0 52.0 (PRI 32)) (WIRE ((208.0 . 288.0) (192.0 . 288.0) (192.0 . 184.0)) (ROUND 1 BLACK) NIL NIL 1 (191.0 183.0 18.0 106.0) NIL)) ((0.0 8.0 (PRI 33)) (WIRE ((192.0 . 264.0) (208.0 . 264.0)) (ROUND 1 BLACK) NIL NIL 1 (191.0 263.0 18.0 2.0) NIL)) ((0.0 8.0 (PRI 34)) (WIRE ((192.0 . 240.0) (208.0 . 240.0)) (ROUND 1 BLACK) NIL NIL 1 (191.0 239.0 18.0 2.0) NIL)) ((0.0 8.0 (PRI 35)) (WIRE ((192.0 . 216.0) (208.0 . 216.0)) (ROUND 1 BLACK) NIL NIL 1 (191.0 215.0 18.0 2.0) NIL)) ((0.05 15.0 (PRI 36)) (TEXT (105.0 . 703.0) ("TYPE: MAJOR") 1 (CENTER BASELINE) (MODERN 14 (BOLD ITALIC REGULAR)) ((59.0 698.5 92 15)) BLACK)) ((0.05 15.0 (PRI 37)) (TEXT (113.0 . 687.0) ("TAB SIZE: 2-3/8%"") 1 (CENTER BASELINE) (MODERN 14 (BOLD ITALIC REGULAR)) ((58.5 682.5 109 15)) BLACK)) ((0.05 15.0 (PRI 38)) (TEXT (125.0 . 671.0) ("NO. TABS PER BANK: 5") 1 (CENTER BASELINE) (MODERN 14 (BOLD ITALIC REGULAR)) ((49.5 666.5 151 15)) BLACK)) ((0.05 15.0 (PRI 39)) (TEXT (113.0 . 656.0) ("NO. OF BANKS: 1") 1 (CENTER BASELINE) (MODERN 14 (BOLD ITALIC REGULAR)) ((56.0 651.5 114 15)) BLACK)) ((0.05 15.0 (PRI 40)) (TEXT (200.0 . 636.0) ("COLOR OF TABS: GREEN background, BLACK lettering ") 1 (CENTER BASELINE) (MODERN 14 (BOLD ITALIC REGULAR)) ((17.0 631.5 366 15)) BLACK)) ((0.05 13.0 (PRI 41)) (TEXT (116 . 608) ("Point size: 10 " "Font : Modern ") 1 (CENTER BASELINE) (MODERN 12 (BOLD ITALIC REGULAR)) ((77.0 611.0 78 13) (73.0 598.0 86 13)) BLACK)) ((0.05 12.0 (PRI 42)) (TEXT (196 . 540) ("Tick marks indicate hole placement: " "3-hole punch, 5/16%" diameter holes " " " "1st hole centered: 1 3/16%" from top of page, 7/16%" in from side " "2nd hole centered: 5 7/16%" from top of page, 7/16%" in from side") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((111.5 561.0 169 12) (112.5 549.0 167 12) (196.0 537.0 0 12) (50.0 525.0 292 12) (44.0 513.0 304 12)) BLACK)) ((0.05 12.0 (PRI 43)) (TEXT (200.0 . 512.0) ("" "3rd hole centered: 9 11/16%" from top of page, 7/16%" in from side ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((200.0 515.0 0 12) (47.0 503.0 306 12)) BLACK)) ((0.05 12.0 (PRI 44)) (TEXT (344.0 . 528.0) ("" "" "") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((344.0 537.0 0 12) (344.0 525.0 0 12) (344.0 513.0 0 12)) BLACK)) ((0.05 12.0 (PRI 45)) (TEXT (44.0 . 516.0) ("" "") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((44.0 519.0 0 12) (44.0 507.0 0 12)) BLACK)) ((0.05 12.0 (PRI 46)) (TEXT (104 . 248) ("x") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((101.0 245.0 6 12)) BLACK)) ((0.05 12.0 (PRI 47)) (TEXT (104 . 296) ("x") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((101.0 293.0 6 12)) BLACK)) ((0.05 12.0 (PRI 48)) (TEXT (104 . 204) ("x") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((101.0 201.0 6 12)) BLACK)) ((0.05 12.0 (PRI 49)) (TEXT (100.0 . 248.0) (" ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((97.0 245.0 6 12)) BLACK)) ((0.05 12.0 (PRI 50)) (TEXT (96 . 564) ("x") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((93.0 561.0 6 12)) BLACK)) ((0.12 64.0 (PRI 51)) (BOX (88.0 32.0 120.0 128.0) (ROUND 1 BLACK) NIL 1 (NIL NIL NIL))) ((0.05 12.0 (PRI 52)) (TEXT (104.0 . 96.0) ("x") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((101.0 93.0 6 12)) BLACK)) ((0.05 12.0 (PRI 53)) (TEXT (104.0 . 144.0) ("x") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((101.0 141.0 6 12)) BLACK)) ((0.05 12.0 (PRI 54)) (TEXT (104.0 . 52.0) ("x") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((101.0 49.0 6 12)) BLACK)) ((0.05 12.0 (PRI 55)) (TEXT (100.0 . 96.0) (" ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((97.0 93.0 6 12)) BLACK)) ((0.038475506 10.773141 (PRI 56)) (TEXT (148.0 . 168.0) ("BANK 3") 0.7695101 (CENTER BASELINE) (MODERN 12 (MEDIUM REGULAR REGULAR)) ((130.04721 165.44467 35.397465 10.773141)) BLACK)) ((0.0 52.0 (PRI 57)) (WIRE ((208.0 . 136.0) (192.0 . 136.0) (192.0 . 32.0)) (ROUND 1 BLACK) NIL NIL 1 (191.0 31.0 18.0 106.0) NIL)) ((0.0 8.0 (PRI 58)) (WIRE ((192.0 . 112.0) (208.0 . 112.0)) (ROUND 1 BLACK) NIL NIL 1 (191.0 111.0 18.0 2.0) NIL)) ((0.0 8.0 (PRI 59)) (WIRE ((192.0 . 88.0) (208.0 . 88.0)) (ROUND 1 BLACK) NIL NIL 1 (191.0 87.0 18.0 2.0) NIL)) ((0.0 8.0 (PRI 60)) (WIRE ((192.0 . 64.0) (208.0 . 64.0)) (ROUND 1 BLACK) NIL NIL 1 (191.0 63.0 18.0 2.0) NIL)) ((0.03847551 10.77314 (PRI 61)) (TEXT (149.7169 . 471.9311) ("BANK 1") 0.7695101 (CENTER BASELINE) (MODERN 12 (MEDIUM REGULAR REGULAR)) ((133.49548 469.7497 33.08893 10.77314)) BLACK)) ((0.12 64.0 (PRI 62)) (BOX (88.0 336.0 120.0 128.0) (ROUND 1 BLACK) NIL 1 (NIL NIL NIL))) ((0.0 52.0 (PRI 63)) (WIRE ((208.0 . 440.0) (192.0 . 440.0) (192.0 . 336.0)) (ROUND 1 BLACK) NIL NIL 1 (191.0 335.0 18.0 106.0) NIL)) ((0.0 8.0 (PRI 64)) (WIRE ((192.0 . 416.0) (208.0 . 416.0)) (ROUND 1 BLACK) NIL NIL 1 (191.0 415.0 18.0 2.0) NIL)) ((0.0 8.0 (PRI 65)) (WIRE ((192.0 . 392.0) (208.0 . 392.0)) (ROUND 1 BLACK) NIL NIL 1 (191.0 391.0 18.0 2.0) NIL)) ((0.0 8.0 (PRI 66)) (WIRE ((192.0 . 368.0) (208.0 . 368.0)) (ROUND 1 BLACK) NIL NIL 1 (191.0 367.0 18.0 2.0) NIL)) ((0.05 12.0 (PRI 67)) (TEXT (104.0 . 400.0) ("x") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((101.0 397.0 6 12)) BLACK)) ((0.05 12.0 (PRI 68)) (TEXT (104.0 . 448.0) ("x") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((101.0 445.0 6 12)) BLACK)) ((0.05 12.0 (PRI 69)) (TEXT (104.0 . 356.0) ("x") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((101.0 353.0 6 12)) BLACK)) ((0.05 12.0 (PRI 70)) (TEXT (100.0 . 400.0) (" ") 1 (CENTER BASELINE) (MODERN 10 (BOLD REGULAR REGULAR)) ((97.0 397.0 6 12)) BLACK))) (0.0 174.0 728.0 583.0) 1.0 4 (PAGE NIL (PAPERSIZE NIL) (0 0 612 792) ((TEXT NIL NIL (0 0 612 792) NIL))),?1(DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8)) +-o SKIO.GETFN.2-oz \ No newline at end of file diff --git a/docs/ReleaseNote/TABSLAYOUTL.SKETCH b/docs/ReleaseNote/TABSLAYOUTL.SKETCH new file mode 100644 index 00000000..22f5510c Binary files /dev/null and b/docs/ReleaseNote/TABSLAYOUTL.SKETCH differ diff --git a/docs/ReleaseNote/TABSPEC.TEDIT b/docs/ReleaseNote/TABSPEC.TEDIT new file mode 100644 index 00000000..e7c8ba7f Binary files /dev/null and b/docs/ReleaseNote/TABSPEC.TEDIT differ diff --git a/docs/ReleaseNote/TOC.TEDIT b/docs/ReleaseNote/TOC.TEDIT new file mode 100644 index 00000000..fdffa162 Binary files /dev/null and b/docs/ReleaseNote/TOC.TEDIT differ diff --git a/docs/ReleaseNote/Tab-Replacements.tedit b/docs/ReleaseNote/Tab-Replacements.tedit new file mode 100644 index 00000000..6c2819dc Binary files /dev/null and b/docs/ReleaseNote/Tab-Replacements.tedit differ diff --git a/docs/ReleaseNote/Titlepage.tedit b/docs/ReleaseNote/Titlepage.tedit new file mode 100644 index 00000000..493131a0 Binary files /dev/null and b/docs/ReleaseNote/Titlepage.tedit differ diff --git a/docs/ReleaseNote/bindercover.sketch b/docs/ReleaseNote/bindercover.sketch new file mode 100644 index 00000000..3ca844ee Binary files /dev/null and b/docs/ReleaseNote/bindercover.sketch differ diff --git a/docs/ReleaseNote/indexbase.tedit b/docs/ReleaseNote/indexbase.tedit new file mode 100644 index 00000000..7097b145 --- /dev/null +++ b/docs/ReleaseNote/indexbase.tedit @@ -0,0 +1,146 @@ + 1 1 1 1 INDEX 1 INDEX 1 1 INDEX 1 INDEX INDEX 6 A Abort (Editor Command) B.7 ACCESS 3.38 Add-Command (Function) B.14 add.process (Function) 4.12; 7.12 ADDMENU (Function) 4.24 ADDTOSCRATCHLIST (Function) 4.1 ADVICE (File Manager Command) 3.15 ADVINFOLST (Variable) 3.14 ADVISE (File Manager Command) 3.15 ADVISE (Function) 3.13,15 ADVISEDFNS (Variable) 3.14 ADVISEDUMP (Function) 3.14 Advising 3.14; 7.9 AFTERDOMAKESYS 4.7 AFTERDOSAVEVM 4.7 AFTERDOSYSOUT 4.7 AFTERLOGOUT 4.7 AFTERLOGOUTFORMS 4.7 AFTERMAKESYS 4.7 AFTERSAVEVM 4.7 AFTERSYSOUT 4.7 AGAIN (Editor Command) B.8 ALL (Event Address) A-5 ALLOWED.LOGINS 4.6 append (Function) with non-list argument 7.8 Application Menus D.1 APPLY-format input A-3 ARCHIVEFLG (Variable) 3.9 ARCHIVEFN (Variable) 3.9 Arglist (Editor Command) B.9 AROUNDEXITFNS (Variable) 4.7 array reference 7.4 arrays 3.3 ASKUSER (Function) 4.16 assert (Macro) E.10 Attach Menu (Editor Command) B.11 Attached Windows 4.28 AUTHENTICATE 4.6 AUTHENTICATION.NET.HINT (Variable) 4.33 AUTOHARDRESETFLG 4.5 B back-quote facility 3.49 BACKGROUND (FreeMenu Group Property) D.8 BACKGROUND (FreeMenu Item Property) D.10 BACKGROUNDFNS (Variable) 4.12 BACKSPACE (Editing Command) A-21 BCOMPL (Function) 3.22,25; 4.10 BEEPON (Function) 4.31 BEFORELOGOUT 4.7 BEFOREMAKESYS 4.7 BEFORESAVEVM 4.7 BEFORESYSOUT 4.7 BEFORESYSOUTFORMS 4.7 BITMAP (FreeMenu System Property) D.10 BKSYSBUF (Function) 4.30 BKSYSCHARCODE (Function) 4.30 BLOCKRECORD (Record Type) 4.3 BOTTOM (FreeMenu Group Property) D.7 bound E.4 BOUNDP (Function) 3.2 BOX (FreeMenu Group Property) D.5,8 BOX (FreeMenu Item Property) D.10 BOXSHADE (FreeMenu Group Property) D.8 BOXSHADE (FreeMenu Item Property) D.10 BOXSPACE (FreeMenu Group Property) D.8 BOXSPACE (FreeMenu Item Property) D.10 break (Function) 3.13; E.13 break commands 3.13 Break packages 3.9 BREAK0 (Function) 3.13 BREAK1 (Function) 3.9 BREAKCONNECTION (Function) 4.14 BREAKIN (Function) 3.13 breaking 7.9 BREAKREGIONSPEC (Variable) 4.8 BRECOMPILE (Function) 3.22,25 BRKINFOLST (Variable) 3.13 BROKENFNS (Variable) 3.13 bulk data transfer 4.34 C Catch errors 3.10 ccase (Macro) E.10 cerror (Function) E.9 Change Print Base (Editor Command) B.11 CHANGEBACKGROUND (Function) 4.31 CHANGEFONT (Function) 4.23 CHANGESLICE (Function) A-11,17 CHANGESTATE (FreeMenu Item Property) D.11 changing a standard readtable 3.22 characters 3.3 CHARCODE (Function) 3.3 CHCON (Function) 3.42 check-type (Macro) E.10 CL Exec 3.7 CL:* (Variable) A-10 CL:** (Variable) A-10 CL:*** (Variable) A-10 CL:+ (Variable) A-10 CL:++ (Variable) A-10 CL:+++ (Variable) A-10 CL:- (Variable) A-10 CL:/ (Variable) A-10 CL:// (Variable) A-10 CL:/// (Variable) A-10 CL:BREAK (Function) 3.13 CL:CATCH (Function) 3.5 CL:CODE-CHAR (Function) 3 CL:COMPILE-FILE (Function) 3.24-25; 4.10 CL:DEFCONSTANT (Variable) 3.20 CL:DEFINE-MODIFY-MACRO (Function) 3.20 CL:DEFMACRO (Function) 3.20 CL:DEFMACRO (Macro) 3.29 CL:DEFPARAMETER (Macro) 3.26,29 CL:DEFPARAMETER (Variable) 3.20 CL:DEFUN (Function) 3.20 CL:DEFUN (Macro) 3.29 CL:DEFVAR (Macro) 3.29 CL:DEFVAR (Variable) 3.20 CL:ERROR 3.10 CL:EVAL-WHEN (File Package Command) 3.31 CL:GENSYM (Function) 3.2 CL:LOAD (Function) 3.24 CL:MAKE-HASH-TABLE (Function) 3.4 CL:MAPHASH (Function) 3.4 CL:PRIN1 (Function) 3.41-42 CL:PRINC (Function) 3.41 CL:READ (Function) 3.40 CL:READ-PRESERVING-WHITESPACE (Function) 3.41 CL:THROW (Function) 3.5,11 CL:UNWIND-PROTECT 3.6 CL:UNWIND-PROTECT (Function) 3.11 CL:WITH-INPUT-FROM-STRING 3.37 CL:WRITE (Function) 3.41 CLEANUP (Function) 3.25 cleanup forms 3.6 CLEARCLISPARRAY (Function) 4.10 CLEARSTK (Function) 4.5 CLEARSTKLST (Variable) 4.5 CLISP infix forms 3.33 CLISPARRAY 4.2 CLOSEALL (Function) 3.38 closure 7.8 coerce (Function) 7.12 COERCE-TO-NSADDRESS (Function) 4.33 collect (Macro) 7.6 collecting objects macros for 7.6 COLLECTION (FreeMenu Item Property) D.12 COLLECTION property 4.26 COLUMN (FreeMenu Group Property) D.7 COLUMNSPACE (FreeMenu Group Property) D.7 Comment Out Selection (Editor Command) B.9 comment treated as declaration 3.32 Comments in SEdit B.6 Common Lisp strings 3.3 Common Lisp Symbols 3.1 COMMONNUMSYNTAX 3.44 compile-definer (Definer) 7.2 compile-form (Definer) 7.2 compiler behavior with FLETed lexical functions 7.12 behavior with recursion 7.12 ignoring TEdit formatting 7.12 retaining special arguments 7.12 complex numbers 3.4 coms 7.11 condition E.3 conditions:*break-on-signals* (Variable) E.9 conditions:abort (Function) E.21 conditions:compute-restarts (Function) E.18 conditions:continue (Function) E.21 conditions:define-condition (Macro) E.5 conditions:find-restart (Function) E.19 conditions:handler-bind (Macro) E.4,11 conditions:handler-case (Macro) E.11 conditions:ignore-errors (Macro) E.12 conditions:invoke-debugger (Function) E.13 conditions:invoke-restart (Function) E.5,20 conditions:invoke-restart-interactively (Function) E.20 conditions:make-condition (Function) E.6,8 conditions:muffle-warning (Function) E.22 conditions:restart-bind (Macro) E.17 conditions:restart-case (Function) E.5 conditions:restart-case (Macro) E.13 conditions:restart-name (Function) E.19 conditions:signal (Function) E.8 conditions:store-value (Function) E.22 conditions:use-value (Function) E.22 conditions:with-simple-restart (Macro) E.20 CONN (Exec Command) A-7 CONTROL-A (Editing Command) A-21 Control-C (Editor Command) B.7 Control-L (Editor Command) B.7 Control-Meta-; (Editor Command) B.9 Control-Meta-F (Editor Command) B.8 compiler behavior with FLETed lexical functions 7.12 behavior with recursion 7.12 ignoring TEdit formatting 7.12 retaining special arguments 7.12 complex numbers 3.4 coms 7.11 condition E.3 conditions:*break-on-signals* (Variable) E.9 conditions:abort (Function) E.21 conditions:compute-restarts (Function) E.18 conditions:continue (Function) E.21 conditions:define-condition (Macro) E.5 conditions:find-restart (Function) E.19 conditions:handler-bind (Macro) E.4,11 conditions:handler-case (Macro) E.11 conditions:ignore-errors (Macro) E.12 conditions:invoke-debugger (Function) E.13 conditions:invoke-restart (Function) E.5,20 conditions:invoke-restart-interactively (Function) E.20 conditions:make-condition (Function) E.6,8 conditions:muffle-warning (Function) E.22 conditions:restart-bind (Macro) E.17 conditions:restart-case (Function) E.5 conditions:restart-case (Macro) E.13 conditions:restart-name (Function) E.19 conditions:signal (Function) E.8 conditions:store-value (Function) E.22 conditions:use-value (Function) E.22 conditions:with-simple-restart (Macro) E.20 CONN (Exec Command) A-7 CONTROL-A (Editing Command) A-21 Control-C (Editor Command) B.7 Control-L (Editor Command) B.7 Control-Meta-; (Editor Command) B.9 Control-Meta-F (Editor Command) B.8 Control-Meta-O (Editor Command) B.7 Control-P 4.29 CONTROL-Q (Editing Command) A-21 CONTROL-R (Editing Command) A-21 Control-T 4.29 CONTROL-W (Editing Command) A-21 Control-W (Editor Command) B.7 CONTROL-X (Editing Command) A-21 Control-X (Editor Command) B.7 Convert Comments (Editor Command) B.9 Convert-Upgrade (Variable) B.14 converting characters 3.3 Converting old code for use with new Error system E.1 COORDINATES (FreeMenu Group Property) D.7 COPY (Function) 3.49 COPYBYTES (Function) 4.16 COPYDEF (Function) 4.4 COPYFILE (Function) 3.38 COPYREADTABLE (Function) 3.46 COS (Function) 4.3 COURIER.CALL (Function) 4.34 COURIER.OPEN (Function) 4.34 Creating an Exec process A-18 Creating conditions E.4 Creating icons with ICONW C.1 CTRLUFLG 4.18 ctypecase (Macro) E.10 CUHOTSPOTX 4.30 CUHOTSPOTY 4.30 CUIMAGE 4.30 current package 3.45 CURSOR 4.30 Cursor Movement Commands A-22 CURSORBITMAP 4.30 CURSORCREATE (Function) 4.30 CURSORHOTSPOTX 4.30 CURSORHOTSPOTY 4.30 D DA (Exec Command) A-7 DAUGHTERS (FreeMenu Group Property) D.8 DC (Function) 3.18 Declining by Condition handler E.4 DEdit 3.15 Default handlers 3.10 Default-Commands (Function) B.15 DEFAULT.OSTYPE (Variable) 4.15 DEFAULTFONT (Variable) D.7 DEFAULTICONFN (Variable) 4.25 DEFAULTTEXTICON (Variable) C.3 deferredconstant (Function) 7.12 define-file-environment (Definer) 7.2 define-record (Definer) 7.3 Defining New Terms A-11 DEFMACRO (Macro) 3.5 defstruct (Macro) 7.4 warning 7.6 DELDEF (Function) 3.28 Delete Selection (Editor Command) B.7 Delete Structure (Editor Command) B.8 Delete Word (Editor Command) B.7 DELFILE (Function) 3.38 DESELECT (FreeMenu Item Property) D.12 DF (Function) 3.18 DFASL files 2.1 DFNFLG (Variable) 3.27 DIR (Exec Command) A-7 DISPLAY (FreeMenu Item) D.6-7,14 Display icons C.1 DISPLAY item 4.26 DISPLAYFONTDIRECTORIES (Variable) 4.23 DMACRO (Property) 3.5 DMACROs 2.1 DO-EVENTS (Exec Command) A-8 DOCOLLECT (Function) 4.1 DOSHAPEFN (Window Property) 4.25 DOWNFN (FreeMenu Mouse Property) D.10 DP (Function) 3.18 DRAWARC (Function) 4.19 DRAWLINE (Function) 4.19 DRAWPOLYGON (Function) 4.20 DSPCLEOL (Function) 4.18 DSPFONT 4.16 DSPRUBOUTCHAR (Function) 4.18 DSPSCALE 4.19 dummy definitions 3.17 DV (Function) 3.18 DWIMIFYCOMPFLG (Variable) 3.34 E ecase (Macro) E.10 ECHOCHAR (FreeMenu Item Property) D.13 ED (Function) 3.16 Edit (Editor Command) B.9 EDIT (FreeMenu Item) 4.27; D.13 Edit caret in SEdit B.2 Edit Interface 3.18 EDITBM (Function) 4.18 EDITCALLERS (Function) 3.19 Editing Exec Input A-20 Editing Lisp Code in Memory B.1 Editing VALUES 3.18 EDITMODE (Function) 3.16 EDITSTART (FreeMenu Item) 4.27; D.14 END-OF-FILE (Error Type) 3.12 ENDCOLLECT (Function) 4.1 Ending an SEdit session B.2 ENDOFSTREAMOP 3.38 ENVAPPLY 3.6 ENVEVAL 3.6 EQUAL (Function) 3.26 EQUALALL (Function) 4.3 ERROR (Function) 3.10 error (Function) E.9 Error conditions 3.10 error system 3.10 Error system differences between old and new E.1 Error system proposal E.1 Error type mapping 3.11 Error type name 3.11 Error type number 3.11 ERROR! (Function) 3.10 ERRORMESS (Function) 3.10 ERRORMESS1 (Function) 3.10 ERRORN (Function) 2.2; 3.10 Errors definition of E.3 ERRORSET 3.10 ERRORSTRING (Function) 3.10 ERRORTYPELIST 3.10 ERRORTYPELIST (Variable) 2.2 ERSETQ (Function) 3.10; 4.8 ERXM 3.10 ESCAPE (Editing Command) A-21 Escape in SEdit B.6 Establishing handlers within dynamic context E.4 etypecase (Macro) E.10 Eval (Editor Command) B.9 EVAL-format input A-2 Exec Editing Commands A-22 Exec type A-4 EXEC-EVAL (Function) 3.9 EXPAND (Editor Command) B.9 EXPANDBITMAP (Function) 4.18 EXPANDMACRO (Function) 3.5 EXPANDREGIONFN (Window Property) 4.24 EXPLICIT (FreeMenu Group Property) D.7 export (Function) 7.9 Extract (Editor Command) B.9 F F (Event Address) A-5 features new Common Lisp 7.1 FETCH 3.33 File Manager 3.19 file-reading functions 3.20 FILEPKGCOM (Function) 4.9 FILEPKGTYPE (Function) 4.9 FILEPKGTYPES (Variable) 3.16 FILEPOS (Function) 4.16 FILERDTBL 3.22 files containing bitmaps 3.31 FILES? (Function) 3.28 FILETYPE (Property) 3.25 FILLPOLYGON (Function) 4.19-20 FIND (Editor Command) B.8 Find Gap (Editor Command) B.8 FIND-READTABLE (Function) 3.45 FINDCALLERS (Function) 3.19 FIX (Exec Command) A-8 FIXP (Predicate) 3.4 flet (Special form) 7.4 floating point 3.4 FLOATP (Predicate) 3.4 FM.BACKGROUND (FreeMenu Window Property) D.15 FM.CHANGELABEL (FreeMenu Function) D.16 FM.CHANGELABEL (Function) 4.27-28 FM.CHANGESTATE (FreeMenu Function) D.16 FM.CHANGESTATE (Function) 4.28 FM.DONTRESHAPE (FreeMenu Window Property) D.15 FM.EDITITEM (FreeMenu Function) D.17 FM.EDITP (FreeMenu Function) D.17 FM.ENDEDIT (FreeMenu Function) D.17 FM.FIXSHAPE (Function) 4.28 FM.FORMATMENU (Function) 4.26-27 FM.GETITEM (Function) 4.27 FM.GETITEM (FreeMenu Function) D.15 FM.GETSTATE (FreeMenu Function) D.16 FM.GETSTATE (Function) 4.27 FM.GROUPPROP (FreeMenu Macro) D.7,18 FM.HIGHLIGHTITEM (FreeMenu Function) D.17 FM.HIGHLIGHTITEM (Function) 4.28 FM.ITEMFROMID (Function) 4.27 FM.ITEMPROP (FreeMenu Macro) D.18 FM.MAKEMENU (Function) 4.26-27 FM.MENUPROP (FreeMenu Macro) D.7,19 FM.NWAYPROP (FreeMenu Macro) D.19 FM.NWAYPROPS (Macro) 4.27 FM.PROMPTWINDOW (FreeMenu Window Property) D.15 FM.READSTATE (Function) 4.27 FM.REDISPLAYITEM (FreeMenu Function) D.18 FM.REDISPLAYMENU (FreeMenu Function) D.18 FM.RESETGROUPS (FreeMenu Function) D.17 FM.RESETMENU (FreeMenu Function) D.17 FM.RESETSHAPE (FreeMenu Function) D.17 FM.RESETSHAPE (Function) 4.28 FM.RESETSTATE (FreeMenu Function) D.17 FM.SHADE (FreeMenu Function) D.18 FM.SHADE (Function) 4.28 FM.SHADEITEM (Function) 4.28 FM.SHADEITEMBM (Function) 4.28 FM.SKIPNEXT (FreeMenu Function) D.17 FM.TOPGROUPID (FreeMenu Function) D.18 FM.WHICHITEM (FreeMenu Function) D.18 FONT (FreeMenu Group Property) D.7 FONT (FreeMenu Item Property) D.9 font descriptor 4.22 FONTCHANGEFLG (Variable) 4.23 FONTCREATE (Function) 4.22 FONTSAVAILABLE 4.21 FOR 3.33 FOR (Exec Command) A-6 FORGET 4.6 FORGET (Exec Command) A-8 FORMAT (FreeMenu Group Property) D.4,7 Free Menu How to make a D.1 Free Menu format D.2 Free Menu layout D.1 FREEMENU (FreeMenu Function) D.15 FREEMENU (Function) 4.26-27 FROM (Event Address) A-5 FULLNAME (Function) 3.37 FUNARG 4.4 G Gaps in SEdit B.4 garbage collector 4.11 gensym (Function) 3.2; 7.12 GET-ENVIRONMENT-AND-FILEMAP (Function) 3.23 Get-Prompt-Window (Function) B.15 Get-Selection (Function) B.16 Get-Window-Region (Function) B.13 GETDEF (Function) 3.28 GETFILEINFO (Function) 3.38; 4.13 GETPROMPTWINDOW (Function) 4.28 GETREADTABLE (Function) 3.39 GETSYNTAX 3.45 global macro shadowing 7.4 GROUP (FreeMenu Group Property) D.7 GROUPID (FreeMenu System Property) D.10 H handler (Function) E.4 Handling conditions E.3 HARDCOPYW (Function) 4.29 HARDRESET (Function) 4.4 HASDEF (Function) 3.26,28; 4.9 hash arrays 3.4 HASHARRAY 3.4 HASHARRAY (Function) 4.2 HELDFN (FreeMenu Mouse Property) D.10 HELP (Editor Command) B.9 HELP (Function) 3.10 Help Menu Commands B.11 HIGHLIGHT (FreeMenu Item Property) D.9,14 History list A-16 HISTORYSAVEFORMS (Variable) 3.9 HJUSTIFY (FreeMenu Item Property) D.4,9 HORRIBLEVARS 4.9,15 HPRINT (Function) 4.15 I ICONW (Function) C.1 ICONW windows from an image defined by a mask C.1 with titles C.1 ICONW.SHADE (Function) C.2 ICONW.TITLE (Function) C.2 ID (FreeMenu Group Property) D.7 ID (FreeMenu Item Property) D.9 IDLE.PROFILE 4.6 IDLE.RESETVARS (Variable) 4.6 IDLE.SUSPEND.PROCESS.NAMES (Variable) 4.7 IEEE 802.3 specification 4.34 IF 3.33 IL Exec 3.7 IL:IT (Variable) A-9 IL:LOAD (Function) 3.24 IL:MAPHASH (Function) 3.4 IL:PRIN1 (Function) 3.41 IL:PRIN2 (Function) 3.41 IL:READ (Function) 3.40 ILLEGAL-GO (Error Type) 3.11 ILLEGAL-RETURN (Error Type) 3.11 ILLEGAL-STACK-ARG (Error Type) 3.12 IN (Exec Command) A-6 in-package (Function) 7.8 INFILEP (Function) 3.37 INFINITEWIDTH (FreeMenu Item Property) D.13 INITSTATE (FreeMenu Item Prop) 4.26 INITSTATE (FreeMenu Item Property) D.9,12 INPUT (Function) 3.37 INPUTFONT (Variable) A-10 Inspect (Editor Command) B.10 INTEGERLENGTH (Function) 4.3 integers 3.4 Interlisp Compiler 3.31 INTERLISP-ERROR (Error Type) 3.12 INTERPRESSFONTDIRECTORIES (Variable) 4.22 INTERRUPTCHAR (Function) 4.29 INVALID-ARGUMENT-LIST (Error Type) 3.12 ITEMS (FreeMenu Group Property) D.8 J Join (Editor Command) B.10 K Keep-Window-Region (Variable) B.13 KEYACTION (Function) 4.31 KEYDOWNP (Function) 4.31 L LABEL (FreeMenu Item Property) D.9 LABELS construct warning 7.10 LASTC (Function) 4.15 Layout of Free Menu D.1 LCOM files 2.1 ldflg 7.11 LEFT (FreeMenu Group Property) D.7 LEFT and BOTTOM (FreeMenu Item Property) D.9 Left mouse button in SEdit B.3 lexical bindings 3.33 Library modules summary of changes 5.1 LIMITCHARS (FreeMenu Item Property) D.3,13 LINKS (FreeMenu Item Property) D.10,15 LISP 3.47 Lisp structures SEdit gaps for B.4 LISPSOURCEFILEP (Function) 4.10 LISPXEVAL (Function) 3.9 LISPXFNS (Variable) A-15 LISPXHISTORY (Variable) A-16 LISPXHISTORYMACROS (Variable) 3.9 LISPXMACROS 3.8 LISPXMACROS (Variable) 3.9 LISPXREADFN (Function) 4.8 LISPXUNREAD (Function) 3.9 LISPXUSERFN (Variable) 3.9 LIST (Function) 3.49 Lists in SEdit B.5 LOAD (Function) 3.20 loadflg (Argument) 7.11 load-time expression 7.4 LOADCOMP (Function) 3.25 LOADFNS (Function) 3.20,25 LOADFROM (Function) 3.25 loading compiled files 3.32 loading Medley files into Lyric 4.10 LOADVARS (Function) 3.25 Locally defined handler E.4 LOCALVARS 3.2 LOGIN.TIMEOUT 4.6 LOGOUT (Function) 4.7 long-site-name (Variable) 7.3 M MACHINETYPE (Function) 4.7 MAKE-READER-ENVIRONMENT (Function) 3.23 MAKEFILE (Function) 3.20,25,43,49 MAKEFILE-ENVIRONMENT (Property) 3.21 MAKESYS (Function) 4.7 MAKETITLEBARICON 4.25 map (Function) 7.11 MAPATOMS (Function) 3.2-3 MAX (Function) 4.2 MAX.INTEGER (Variable) 4.2 MAXHEIGHT (FreeMenu Item Property) D.9 MAXREGION (FreeMenu System Property) D.11 MAXWIDTH (FreeMenu Item Property) D.7,9,13 Medley on Sun workstations 1.1 on Xerox workstations 1.1 Medley compiled files 2.1 Medley enhancements summary 1.1 MENU (FreeMenu Group Property) D.7 MENUFONT (FreeMenu Item Property) D.12 MENUITEMS (FreeMenu Item Property) D.6,12 MENUTITLE (FreeMenu Item Property) D.12 MESSAGE (FreeMenu Item Property) D.9 Meta- ( (Editor Command) B.10 Meta- ) (Editor Command) B.10 Meta- / (Editor Command) B.9 Meta-9 (Editor Command) B.10 Meta-; (Editor Command) B.9 Meta-A (Editor Command) B.7 Meta-B (Editor Command) B.11 Meta-Control-C (Editor Command) B.7 Meta-Control-S (Editor Command) B.8 Meta-Control-X (Editor Command) B.7 Meta-E (Editor Command) B.9 Meta-F (Editor Command) B.8 Meta-H (Editor Command) B.9 Meta-I (Editor Command) B.10 Meta-J (Editor Command) B.10 Meta-M (Editor Command) B.11 Meta-N (Editor Command) B.8 Meta-O (Editor Command) B.9 Meta-P (Editor Command) B.11 Meta-R (Editor Command) B.8 Meta-Return (Editor Command) B.10 Meta-S (Editor Command) B.8 Meta-Space (Editor Command) B.10 Meta-U (Editor Command) B.7 Meta-X (Editor Command) B.9 Meta-Z (Editor Command) B.10 Middle mouse button in SEdit B.3 MIN (Function) 4.2 MIN.INTEGER (Variable) 4.2 minimum window size 4.24 MKSTRING (Function) 3.42 MOMENTARY (FreeMenu Item) D.11 MOTHER (FreeMenu Group Property) D.8 Mouse buttons in SEdit B.3 MOVD (Function) 4.4 MOVEDFN (FreeMenu Mouse Property) D.10 multiple escape character 3.42 Multiple Execs A-4 multiple streams 3.37 MULTIPLE-ESCAPE 3.45 Mutate (Editor Command) B.10 N NAME (Exec Command) A-8 NCHARS (Function) 3.42 NCHOOSE item 4.26 NDIR (Exec Command) A-8 Nesting Free Menu Groups D.2 NETWORKOSTYPES (Variable) 4.15 NEW (MAKEFILE Option) 3.21 NLAMBDA 3.5 NLSETQ (Function) 3.10; 4.8 NOBIND 3.2 NOCLEARSTKLST (Variable) 4.5 NODIRCORE (File Device) 4.13 Normalize Selection (Editor Command) B.10 notational conventions 18 NSADDRESS 4.32 NSNAME 4.32 NSNET.DISTANCE (Function) 4.35 NUMBER (FreeMenu Item) D.14 NUMBERP (Predicate) 3.4 NUMBERTYPE (FreeMenu Item Property) D.14 NWAY (FreeMenu Item) 4.26; D.6; 12 NWAYPROPS (FreeMenu Item Prop) 4.27 NWAYPROPS (FreeMenu Item Property) D.6,12 O OLD-INTERLISP-FILE 3.47 OLD-INTERLISP-T 3.48 once-only (Macro) 7.7 OPENFILE (Function) 3.37 OPENFN (Window Property) 4.25 OPENP (Function) 3.38 OPENSTREAM (Function) 3.11,37 OPENSTRINGSTREAM (Function) 3.37; 4.16 options E.5 ORIG 3.46 OUTPUT (Function) 3.37 P package delimiter 2.2 PACKAGEDELIM 3.47 packages 3.19 PARSE-NSADDRESS (Function) 4.33 PAT (Event Address) A-5 pattern matching 3.6 PEEKC (Function) 4.15 pkg-goto (Function) 7.8 PL (Exec Command) A-8 PLVLFILEFLG 3.42 PP (Exec Command) A-9 PRETTYDEF (Function) 4.9 PRIN1 4.30 PRIN2 4.30 PRINT (Function) 3.20,48 PRINTLEVEL 4.29 PRINTNUM (Function) 4.15 PRINTOUT 3.43 PRINTOUTFONT (Variable) A-11 PRINTSERVICE (Variable) 4.19 process status window 4.12 PROCESS.APPLY (Function) 4.12 PROCESS.EVAL (Function) 4.12 Programmer's interface to SEdit B.12 PROMPT#FLG (Variable) 3.9 PROMPTFONT (Variable) A-10 PROMTPCHARFORMS (Variable) 3.9 PROTECTION 4.13 PRXFLG 3.42 PUTDEF (Function) 3.28 Q Quote (Editor Command) B.10 Quoted structures in SEdit B.5 R RADIX (Function) 3.44 ratios 3.4 READ (Function) 3.20,48 read-eval-print A-1 read/print consistency 3.44 READBUF (Variable) 3.9 READC (Function) 3.41 READER 4.13 READER-ENVIRONMENT 3.20 READLINE (Function) 4.8 READMACROS 4.16 READSYS (Function) 4.35 READTABLEPROP (Function) 3.45 READVISE (Function) 3.14 REALFRAMEP (Function) 4.5 REBREAK (Function) 3.14 RECOMPILE (Function) 3.22,25 record-create (Macro) 7.4 record-fetch (Macro) 7.4 record-ffetch (Macro) 7.4 Redisplay (Editor Command) B.7 Redo (Editor Command) B.8 REDO (Exec Command) A-6 REGION (FreeMenu Group Property) D.8 REGION (FreeMenu System Property) D.11 RELDRAWTO (Function) 4.19 Release Notes organization of 17 REMEMBER (Exec Command) A-8 REMPROP (Function) 3.2 RENAMEFILE (Function) 3.38 REPAINTFN 4.24 REPAINTFN (Window Property) 4.25 REPEATUNTIL 4.3 Replace-Selection (Function) B.16 Reporting a condition or restart E.5 Reset (Function) 3.10; B.14 Reset-Commands (Function) B.15 RESETFORM 3.40 RESETFORM 3.39 RESETFORMS (Variable) 3.9 RESETLST 3.6 Resetting system state 3.11 RESETVARS 4.6 RESHAPEFN 4.24 Restart type E.5 Restarting computations E.3 Restarting conditions E.5 RETAPPLY 3.6 RETEVAL 3.6 RETFROM 3.6 RETFROM (Function) 3.11 RETRY (Exec Command) A-6 RETTO 3.6 RETURN 3.13; 4.5 Reverse Find (Editor Command) B.8 Right mouse button in SEdit B.3 ROTATE-BITMAP (Function) 4.18 ROW (FreeMenu Group Property) D.7 row-major-aref (Function) 7.4 ROWSPACE (FreeMenu Group Property) D.7 RS232 or TTY ports 3.38 S Save-Window-Region (Function) B.13 SAVEVM (Function) 4.7 SCRATCHLIST 4.1 SEdit 3.15 SEdit (Function) B.16 SEdit Command Menu B.12 SEE (Exec Command) A-9 SEE* (Exec Command) A-9 SELECTEDFN (FreeMenu Mouse Property) D.10 Set Package (Editor Command) B.11 SETERRORN (Function) 3.10 SETFILEINFO (Function) 3.38; 4.13 SETREADTABLE (Function) 3.48 SETSTKARGNAME (Function) 4.5 SETSYNTAX 3.45,49 SHAPEW (Function) 4.24 SHH (Exec Command) A-8 SHIFT-FIND (Editor Command) B.8 short-site-name (Variable) 7.3 SHOULDCOMPILEMACROATOMS (Variable) 4.4 SHOULDNT (Function) 3.10 SHOWPARENFLG (Variable) A-25 SHRINKBITMAP (Function) 4.18 SHRINKFN (Window Property) 4.24 SIDE effects of event A-18 Signalling conditions E.3 SIN (Function) 4.3 Sketch summary of changes 6.10 SKIP-NEXT (Editor Command) B.8 SKREAD (Function) 3.41 SORT (Function) 4.1 Special characters in SEdit B.5 Specifying event addresses A-4 Specifying Free Menu Items D.2 stack manipulations 3.5 STACK OVERFLOW (Error Type) 4.4 Stack pointers 3.5 STACK-OVERFLOW (Error Type) 3.11 STACK-POINTER-RELEASED (Error Type) 3.12 Starting an SEdit session B.2 STATE 4.26 STATE (FreeMenu Item) D.7,11 STATE (FreeMenu Item Property) D.12 STATE (FreeMenu System Property) D.10 STKARG (Function) 4.5 STKNARGS (Function) 4.5 STKPOS (Function) 4.5 STOP (Function) 4.10 STOP-UNDOABLY (Macro) A-13 strings 3.3 in SEdit B.6 STRINGWIDTH (Function) 3.42; 4.22 Structure caret in SEdit B.2 Structure editor 3.15 Substitute (Editor Command) B.8 SUCHTHAT (Event Address) A-5 SUSPEND.PROCESS.NAMES 4.7 Switching between editors 3.16 Symbols 3.1,6 in Error system E.1 symbols in the INTERLISP package 3.20 SYSDOWNFN (FreeMenu System Property) D.11 sysload 3.24; 7.11 SYSMOVEDFN (FreeMenu System Property) D.11 SYSOUT (Function) 4.7 SYSPRETTYFLG (Variable) 3.9 SYSSELECTEDFN (FreeMenu System Property) D.11 T TABLE (FreeMenu Group Property) D.7 TCOMPL (Function) 3.22,25; 4.10 TEdit summary of changes 6.1 TeleRaid Library module 4.35 TEXTICON (Function) 4.25; C.3 TIME (Exec Command) A-9 TIME (Function) 3.36 TIME (Macro) 3.36 TITLE (FreeMenu Item) 4.27 titled icons 4.25 TITLEDICONW (Function) C.1 TOGGLE (FreeMenu Item) D.11 TOO-MANY-ARGUMENTS (Error Type) 3.12 TRACE (Function) 3.13-14 TTYBACKGROUNDFNS (Variable) 4.12 TTYDISPLAYSTREAM (Function) 4.25 TTYIN display typein editor 4.16 TTYIN Editor from Exec A-20 TY (Exec Command) A-9 TYPE (Exec Command) A-9 TYPE (FreeMenu Item Property) D.9 U UGLYVARS 3.43; 4.9,15 UNBOUND-VARIABLE (Error Type) 3.12 UNBREAK (Function) 3.14 UNBREAKIN (Function) 3.13 UNDEFINED-CAR-OF-FORM (Error Type) 3.12 UNDEFINED-FUNCTION-IN-APPLY (Error Type) 3.12 UNDO (Editor Command) B.7 UNDO (Exec Command) A-4,8,13 UNDO key (Editing Command) A-21 UNDOABLY-MAKUNBOUND (Function) 3.29 UNDOABLY-SETQ (Function) A-15 Undoing in Functions A-14 Undoing In Programs A-13 Undoing out of order A-16 UNDOSAVE (Function) A-15 UNIXFTPFLG (Variable) 4.14 UNPACKFILENAME (Function) 3.37 UNSAFEMACROATOMS (Variable) 4.4 UNTIL 4.3 USE (Exec Command) A-6 USERDATA (FreeMenu System Property) D.11 USERDATA LIST D.14 USEREXEC (Function) 3.9 USERNAME 4.6 USERWORDS (Variable) A-25 USESILPACKAGE 3.45 Using Execs 3.7 V VALUEFONT (Variable) A-11 VARS 4.15 version delimiter 2.2 VIDEORATE (Function) 4.31 VJUSTIFY (FreeMenu Item Property) D.9 W warn (Function) E.10 WHENCHANGED 4.9 WINDOWPROP (Function) 4.26 WINDOWPROPS 4.26 with-collection (Macro) 7.6 with-input-from-string (Macro) 7.13 with-output-to-string (Macro) 7.13 WITH-READER-ENVIRONMENT (Macro) 3.23 write-string (Function) 7.12 WRITESTRIKEFONTFILE (Function) 4.22 writing macros macros for 7.7 Writing your own SEdit commands B.14 X XCL 3.47 XCL Compiler 3.31 XCL Exec 3.7 XCL readtable 3.21 xcl:*current-condition* (Variable) E.8 XCL:*DEBUGGER-PROMPT* (Variable) A-19 XCL:*EVAL-FUNCTION* (Variable) A-19 XCL:*EXEC-PROMPT* (Variable) A-19 XCL:*PER-EXEC-VARIABLES* (Variable) A-18 XCL:ABORT (Function) 3.10 XCL:ADD-EXEC (Function) A-18 XCL:ARGLIST (Variable) 3.15 XCL:ARRAY-SPACE-FULL (Error Type) 3.12 XCL:ATTEMPT-TO-CHANGE-CONSTANT (Error Type) 3.11-12 XCL:ATTEMPT-TO-RPLAC-NIL (Error Type) 3.11 XCL:CATCH-ABORT 3.10 xcl:catch-abort (Macro) E.21 XCL:CONDITION 3.10 xcl:condition-case (Macro) E.11 xcl:condition-handler (Macro) E.8 xcl:condition-reporter (Macro) E.7 XCL:CONTROL-E-INTERRUPT (Error Type) 3.12 XCL:DATA-TYPES-EXHAUSTED (Error Type) 3.12 XCL:DEF-DEFINE-TYPE (Macro) 3.27-28 XCL:DEFCOMMAND 3.8 XCL:DEFCOMMAND (Macro) A-11 XCL:DEFDEFINER (Function) 3.20 XCL:DEFDEFINER (Macro) 3.29 XCL:DEFGLOBALPARAMETER (Variable) 3.20 XCL:DEFGLOBALVAR (Variable) 3.20 XCL:DEFINE-PROCEED-FUNCTION (Function) 3.20 XCL:DEFINLINE (Function) 3.20 XCL:DEFOPTIMIZER 3.32 XCL:DEFOPTIMIZER (Macro) 3.5 XCL:EXEC (Function) A-18 XCL:EXEC-EVAL (Function) A-19 XCL:EXEC-FORMAT (Function) A-19 XCL:FILE-NOT-FOUND (Error Type) 3.12 XCL:FILE-WONT-OPEN (Error Type) 3.11 XCL:FLOATING-OVERFLOW (Error Type) 3.12 XCL:FLOATING-UNDERFLOW (Error Type) 3.12 XCL:FS-PROTECTION-VIOLATION (Error Type) 3.12 XCL:FS-RESOURCES-EXCEEDED (Error Type) 3.12 XCL:HASH-TABLE-FULL (Error Type) 3.12 XCL:INVALID-PATHNAME (Error Type) 3.12 XCL:SET-DEFAULT-EXEC-TYPE (Function) A-20 XCL:SET-EXEC-TYPE (Function) A-20 XCL:SIMPLE-DEVICE-ERROR (Error Type) 3.11 XCL:SIMPLE-TYPE-ERROR (Error Type) 3.11 XCL:STORAGE-EXHAUSTED (Error Type) 3.12 XCL:STREAM-NOT-OPEN (Error Type) 3.11 XCL:SYMBOL-HT-FULL (Error Type) 3.11 XCL:SYMBOL-NAME-TOO-LONG (Error Type) 3.11 XCL:UNDOABLY (Macro) A-13 XCL:UNDOABLY-SETF (Macro) A-15 \ \#UNDOSAVES (Variable) A-15 \10MBTYPE.3TO10 (Variable) 4.34 \10MBTYPE.PUP (Variable) 4.34 ~ ~C (Format directive) 7.13 ! !EVAL 2.2 " "numeric" print names 3.43 * *break-on-warnings* (Variable) E.10 *Clear-Linear-On-Completion* (Variable) B.14 *Compile-Fn* (Variable) B.16 *COMPILED-EXTENSIONS* (Variable) 3.25 *DEFAULT-CLEANUP-COMPILER* (Variable) 3.25 *DEFAULT-MAKEFILE-ENVIRONMENT* (Variable) 3.21 *Edit-Fn* (Variable) B.16 *ERROR-OUTPUT* (Variable) 3.10 *Fetch-Definition-Error-Break-Flag* (Variable) B.16 *Getdef-Error-Fn* (Variable) B.16 *Getdef-Fn* (Variable) B.16 *LAST-CONDITION* (Variable) 3.10 *LISPXPRINT* (Property) A-18 *NSADDRESS-FORMAT* (Variable) 4.32 *PACKAGE* (Variable) 3.20,45-46; A-1 *PRINT-ARRAY* (Variable) 3.43 *PRINT-BASE* (Variable) 3.39,42,44 *PRINT-BASE* vs RADIX 3.39 *PRINT-CASE* (Variable) 3.44 *PRINT-ESCAPE* (Variable) 3.41,44 *PRINT-LENGTH* (Variable) 4.22 *PRINT-LEVEL* (Variable) 4.22 *PRINT-LEVEL* & *PRINT-LENGTH* vs PRINTLEVEL 3.39 *PRINT-LEVEL* or *PRINT-LENGTH* is exceeded 3.45 *PRINT-RADIX* (Variable) 3.39,44 *READ-BASE* (Variable) 3.20,44 *READ-SUPPRESS* (Variable) 3.41 *READTABLE* (Variable) 3.39,41-42,48 *READTABLE* vs SETREADTABLE 3.39 *REMOVE-INTERLISP-COMMENTS* (Variable) 3.29-30 *STANDARD-INPUT* (Variable) 3.37 *STANDARD-INPUT* vs INPUT 3.39 *STANDARD-OUTPUT* (Variable) 3.37 *STANDARD-OUTPUT* vs OUTPUT 3.39 *Wrap-Parens* (Variable) B.13 *Wrap-Search* (Variable) B.14 . .FONT 4.16 1 10MB Ethernet encapsulation types 4.34 1108 User's Guide summary of changes 6.14 1186 User's Guide summary of changes 6.16 3 3STATE (FreeMenu Item) 4.26; D.11 : :fast-accessors (Defstruct option) 7.5 :inline (Defstruct option) 7.5 :template (Defstruct option) 7.5 :type (Defstruct option) 7.5 = = (Event Address) A-5 ? ? (Exec Command) A-7 ?? (Exec Command) A-7 ?ACTIVATEFLG (Variable) A-24 (SEQUENCE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE NIL) (0 0 612 792) ((HEADING NIL (HEADINGTYPE RECTOFOOT) (58 22 554 36) NIL) (HEADING NIL (HEADINGTYPE RECTOFOOTRULE) (58 30 554 36) NIL) (HEADING NIL (HEADINGTYPE DRAFTMESSAGE) (200 5 412 36) NIL) (HEADING NIL (HEADINGTYPE TITLEHEAD) (58 761 554 36) NIL) (HEADING NIL (HEADINGTYPE TITLEHEADRULE) (58 757 554 36) NIL) (TEXT NIL NIL (58 54 241 594) NIL) (TEXT NIL NIL (317 54 241 594) NIL))) (ALTERNATE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE NIL) (0 0 612 792) ((HEADING NIL (HEADINGTYPE DRAFTMESSAGE) (200 775 412 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (58 761 554 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEADRULE) (58 757 554 36) NIL) (HEADING NIL (HEADINGTYPE VERSOFOOT) (58 22 554 36) NIL) (HEADING NIL (HEADINGTYPE VERSOFOOTRULE) (58 30 554 36) NIL) (HEADING NIL (HEADINGTYPE DRAFTMESSAGE) (200 5 412 36) NIL) (TEXT NIL NIL (58 54 241 684) NIL) (TEXT NIL NIL (317 54 241 684) NIL))) (PAGE NIL (PAPERSIZE NIL) (0 0 612 792) ((HEADING NIL (HEADINGTYPE DRAFTMESSAGE) (200 775 412 36) NIL) (HEADING NIL (HEADINGTYPE RECTOHEAD) (58 761 554 36) NIL) (HEADING NIL (HEADINGTYPE RECTOHEADRULE) (58 757 554 36) NIL) (HEADING NIL (HEADINGTYPE RECTOFOOT) (58 22 554 36) NIL) (HEADING NIL (HEADINGTYPE RECTOFOOTRULE) (58 30 554 36) NIL) (HEADING NIL (HEADINGTYPE DRAFTMESSAGE) (200 5 412 36) NIL) (TEXT NIL NIL (58 54 241 684) NIL) (TEXT NIL NIL (317 54 241 684) NIL))))))),K-K TJ PAGEHEADING TITLEHEADRULEF PAGEHEADING TITLEHEADC PAGEHEADING DRAFTMESSAGEF PAGEHEADING RECTOFOOTD PAGEHEADING RECTOFOOTRULEF PAGEHEADING VERSOFOOTD PAGEHEADING VERSOFOOTRULED PAGEHEADING RECTOHEADRULE@ PAGEHEADING RECTOHEADD PAGEHEADING VERSOHEADRULE@ PAGEHEADING VERSOHEAD,KMODERN +MODERN +MODERNMODERNMODERN +  HRULE.GETFN  + HRULE.GETFNMODERN +  HRULE.GETFNMODERN +CREATE.FOLIO.OBJECTMODERN HRULE.GETFNMODERN +CREATE.FOLIO.OBJECT   HRULE.GETFNMODERN +  + HRULE.GETFNMODERN +  HRULE.GETFNMODERN +CREATE.FOLIO.OBJECTMODERN HRULE.GETFNMODERN +CREATE.FOLIO.OBJECT HRULE.GETFNMODERN +                + +              +          +                   +        +        +    + +            +  +         + +  +  + +  +   +        +  +     +   +     +     +       +   ! +    +)      +  + + +  )    +  +      +    +)      +  + + +  )    +  +      +                   +       +  +      !          +  + +        +              +    +    +   +       +       +   +   "       + +     + .  +          +          +    +                    +    +          +  +     +            +                   !        +      +  +                +      +  +        +                +  +    + " +        +                   +           +      +     +           + +         +   +       +  +                   +      +        + + +      + +       "        +   +     +                       +    +       +    +  +     + "  +       +  +  +      +  +     +   +       +  +             + + + +   "             + + + + + +  +     + +      + +              %                /-           #     }z \ No newline at end of file diff --git a/library/000docs/000-COVER.TEDIT b/library/000docs/000-COVER.TEDIT new file mode 100644 index 00000000..a8a18660 Binary files /dev/null and b/library/000docs/000-COVER.TEDIT differ diff --git a/library/000docs/001-TITLEPAGE.TEDIT b/library/000docs/001-TITLEPAGE.TEDIT new file mode 100644 index 00000000..c8d4ba69 Binary files /dev/null and b/library/000docs/001-TITLEPAGE.TEDIT differ diff --git a/library/000docs/002-TOC.TEDIT b/library/000docs/002-TOC.TEDIT new file mode 100644 index 00000000..4ea2f8d5 Binary files /dev/null and b/library/000docs/002-TOC.TEDIT differ diff --git a/library/000docs/003-LOF.TEDIT b/library/000docs/003-LOF.TEDIT new file mode 100644 index 00000000..dbba8ad9 Binary files /dev/null and b/library/000docs/003-LOF.TEDIT differ diff --git a/library/000docs/004-PREFACE.TEDIT b/library/000docs/004-PREFACE.TEDIT new file mode 100644 index 00000000..f7a9c57f Binary files /dev/null and b/library/000docs/004-PREFACE.TEDIT differ diff --git a/library/000docs/005-INTRO.TEDIT b/library/000docs/005-INTRO.TEDIT new file mode 100644 index 00000000..80e20b3d Binary files /dev/null and b/library/000docs/005-INTRO.TEDIT differ diff --git a/library/000docs/006-INDEX.TEDIT b/library/000docs/006-INDEX.TEDIT new file mode 100644 index 00000000..980b40e7 --- /dev/null +++ b/library/000docs/006-INDEX.TEDIT @@ -0,0 +1,91 @@ +1 Lisp Library Modules, Medley Release 2.0 1 Lisp Library Modules, Medley Release 2.0 INDEX 1 INDEX 1 INDEX 6 A Abort a Print Job 101,102 Aborting Commands 76 Access Functions 251 Add New Keyboards to the List 310 add-form (Function) 299 ADD.BORDER.TO.BITMAP (Function) 65 ADD.PROCESS (Function) 266 Adding FileBrowser Commands 92 Address space of the internetwork 261 ADJUSTCOLORMAP (Function) 37 Administrator Commands for NSMaintain 206 ADVISE (Function) 283 Aliases 203 ALLOCATE.ETHERPACKET (Function) 270 Analyzing user Functions 157 Application layer 261 ARPANET 253 Array Functions 193 Array operations 29 Assignments 189 B BACKWARD FIND (Command) 288 BEGINDST (Variable) 199 BIN (Function) 222 BIT.IN.COLUMN (Function) 65 BIT.IN.ROW (Function) 65 BITBLT (Function) 116 BITMAPCREATE WIDTH HEIGHT BITSPERPIXEL (Function) 38 BITSPERPIXEL BITMAP (Function) 38 BOUT (Function) 222 BREAK (Function) 283 Broadcast address 262 Browser 111 describe window 12 printout window 12 BROWSER window 74 BROWSERBOXING (Variable) 12 BROWSERFORMAT (Variable) 12 C C-Shell 303 C4 printed circuit board 1 CACHE/NODE/LABEL/BITMAPS (Variable) 116 Call graph 233 Call stack 233 Calling the Keyboard Editor 150 CALLS (Function) 175 CALLSCCODE (Function) 175 Cash-File 15 Centronics 17 cable 17 port 1 CENTRONICS.RESET (Function) 17 CH.DEFAULT.DOMAIN (Variable) 206 CH.DEFAULT.ORGANIZATION (Variable) 206 Changing an Existing Keyboard 150 Character framing errors 224 CharCodeTables 19 Chat 21,303 CHAT (Function) 22,303 Chat connections 22 Chat Menu 23 Chat window 146 CHAT.ALLHOSTS (Variable) 25 CHAT.DISPLAYTYPES (Variable) 24 CHAT.EMACSCOMMANDS (Variable) 25 CHAT.FONT (Variable) 25 CHAT.IN.EMACS? (Variable) 26 CHAT.INTERRUPTS (Variable) 24 CHAT.KEYACTIONS (Variable) 24 CHAT.PROTOCOLTYPES (Variable) 26 CHAT.TTY.PROCESS (Variable) 25 CHAT.WINDOW.REGION (Variable) 25 CHAT.WINDOW.SIZE (Variable) 25 Chatting to a host 258 CHECKSAMEDIR (Function) 231 Clean-Up After Copying Files 46 Clearinghouse 26 Clearinghouse service 203 CLOSE (Function) 305 close-hash-file (Function) 134 CLOSECHATWINDOWFLG (Variable) 25 CLOSEF (Function) 9,222 CLOSEHASHFILE (Function) 128 CmlFloatArray 29 CMYCOLORMAP (Function) 36 COLLECTINUSE (Function) 108 COLLISIONS (Function) 108 COLORDISPLAY (Function) 33 COLORDISPLAYP (Function) 33 COLORIZEBITMAP (Function) 44 COLORLEVEL (Function) 37 COLORMAPCOPY (Function) 36 COLORMAPCREATE (Function) 36 COLORNAMES (Association List) 34 COLORNUMBERP (Function) 35 COLORSCREEN (Function) 39 COLORSCREENBITMAP (Function) 38 COMMAND menu 74 Common Lisp 288 COMPILE (Command) 86 Conjunctions of Sets 168 Connecting to a host 258 Control-E (Command) 76 Control-F (Command) 53 Control-O (Command) 139 Control-P (Command) 280 Control-Q (Command) 75,87 Control-S (Command) 53 Control-Z (Command) 53 Conversation Mode 45 convert-loaded-files (Variable) 292 COPY (Command) 78 Copy-Selection 53, 77 COPYFILE (Function) 46,267 CopyFiles 45 COPYFILES (Function) 45 COPYHASHFILE (Function) 130 CPE FP 17 CPE-FP upgrade 1 Create a Key Pad for Repeated Use 216 CREATE-PROCESS-STREAM (Function) 305 CREATE.NUMBERPAD.READER (Function) 216 CREATEHASHFILE (Function) 128 CREATEW (Function) 41 Creating 4045XLP Master Files 4 a graph 112 a key pad 215 a new bitmap 64 a new keyboard 149 a TableBrowser 247 horizontal rules 139 HOST.TXT file 254 new keyboard configurations 153 objects 206 the local IP.INIT file 256 Creation dates 46 Cumulative mode 238 CURSORPOSITION (Function) 44 CURSORSCREEN (Function) 44 Customizing Chat 24 FileBrowser 89 Cyclic graphs 111 D DataBaseFns 49 Databases 313 using 313,314 Datamedia 2500 21 Daughter 114 Debuggee 279 Debugger 279 DECREASING.FONT. LIST (Variable) 125 DEdit 51,307 Command menu 54 Functions 54 idioms 59 parameters 57 window 52 DEDITLINGER (Variable) 57 DEDITTYPEINCOMS (Variable) 57 DEFAULT-CLEANUP-COMPILER (Variable) 86 DEFAULT.GRAPH.WINDOWSIZE (Variable) 117 DEFAULTCHATHOST (Variable) 22,25 DEFAULTPRINTERTYPE (Variable) 2 DEFAULTPRINTINGHOST (Variable) 2,213 defdefiner-macros (Variable) 292 DEFINEKEYBOARD (Function) 311 Defining a Virtual Keyboard 310 DEGREES-TO-RADIANS (Function) 196 DELETE (Command) 77 Deleting objects 206 Device Errors 17 Differences between TExec and TEdit 287 Digital VT100 21 Directed acyclic graph 113 DIRECTORIES (Variable) 2,258 Directory-only lines 75 DIRECTORYNAME (Function) 231 Display-Only a Keyboard 309 Displayer 233 DISPLAYFONTDIRECTORIES (Variable) 100 DISPLAYGRAPH (Function) 117 Displaying a graph 116 a stack 280 Displaystream graphics 288 DM2500 Chat 27 DODIP.HOSTP (Function) 272 Domain 203 manipulating 208 DOMAIN.GRAPH (Function) 276 DOMAIN.INIT (Function) 276 DOMAIN.LOOKUP (Function) 276 DOMAIN.LOOKUP ADDRESS (Function) 276 DOMAIN.LOOKUP NAMESERVER (Function) 276 DOMAIN.TRACE (Function) 276 DRAWBETWEEN (Function) 43 DRAWLINE (Function) 43 DRAWTO (Function) 43 DSPBACKCOLOR (Function) 42 DSPCOLOR (Function) 42 DT.EDITMACROS (Variable) 58 DUMPDATABASE (Function) 177 DUMPDB (Function) 50 DUMPGRAPH (Function) 121 Dvorak keyboard 311 Dynamic structure 233 E E-30 option kit 1 E30 option 219 EDIT (Command) 84 Edit buffer window 52 EDIT.BITMAP (Function) 61 EditBitMap 61 sub-menu 62 window 62 EDITBM (Function) 61 EDITCOLORMAP (Function) 37 EDITCONFIGURATION (Function) 154 EDITEMBEDTOKEN (Variable) 57 EDITGRAPH (Function) 121 EDITGRAPHMENU 119 EDITGRAPHMENUCOMMANDS (Variable) 119 Editing a bitmap in a document 64 editing a graph 117 existing bitmap 63 keyboard configuration 154 EDITKEYBOARD (Function) 150 EDITMODE (Function) 52 EDITMODE (Variable) 84 Effecting MasterScope Analysis 171 Element patterns 185 Embedding and extracting 59 ENDDST (Variable) 199 Entering DEdit Commands 54 Environmental and Lisp mappings 95 EOLCONVENTION (Variable) 272 Error Condition Reporting 224 ERRORPUP (record) 70 ERRORXIP (record) 69 Establishing a Connection 143 et FX-80 Fast Mode 101 ETHERHOSTNUMBER (Variable) 4,280 Ethernet 260 Ethernet packet 264 EtherRecords 69 EVALUATE-POLYNOMIAL (Function) 31 expr definitions of Functions 171 EXPUNGE (Command) 86 Extend the selection 75 Extended Processor board 17 Extended processor option 29 External Communication Service 27 F FASSOC (Function) 121 Fast mode FX-80 101 FASTFX80-DEFAULT-DESTINATION (Variable) 100 FB (Command) 90 FB.ALLOW.ABORT (Function) 94 FB.BROWSERFONT (Variable) 92 FB.DEFAULT.EDITOR (Variable) 84,92 FB.DEFAULT.INFO (Variable) 87,90 FB.DEFAULT.NAME.WIDTH (Variable) 91 FB.FETCHFILENAME (Function) 93 FB.HARDCOPY.DIRECTORY.FONT (Variable) 92 FB.HARDCOPY.FONT (Variable) 92 FB.ICONFONT (Variable) 91 FB.INFO.FIELDS (Variable) 91 FB.INFO.MENU.ITEMS (Variable) 91 FB.MENU.ITEMS (Variable) 92 FB.PROMPTFONT (Variable) 92 FB.PROMPTLINES (Variable) 92 FB.PROMPTW.FORMAT (Function) 93 FB.PROMPTWPRINT (Function) 93 FB.PROMTFORINPUT (Function) 94 FB.SELECTEDFILES (Function) 93 FB.TABLEBROWSER (Function) 93 File Manager functions, changed 313 File name translation Function 269 File transfer using RS232 226 FILEBROWSE (Command) 84 FileBrowser 71 Functions 89 Variables 90 FILEBROWSER (Function) 89 filecom-specifier (Function) 299 Filing operations 267 FILING.ENUMERATION.DEPTH (Variable) 92 FIND-ARRAY-ELEMENT-INDEX (Function) 31 FINDPOINTER (Function) 109 FINDPOINTERS.OF.TYPE (Function) 109 FLIPNODE (Function) 120 Floating-point vector 29 FNT.DISPLOOK (Function) 96 FNT.DISPTBLE (Function) 96 FNT.MAKEBOOK (Function) 95 Font mappings 95 FontSample 95 FORCEOUTPUT (Function) 222 Forest 113 form-specifier (Function) 299 FORWARD FIND (Command) 288 FREEVARS (Function) 175 FROM.SCREEN.BITMAP (Function) 66 FTP service 268 FTPDEBUG (Function) 268 FTPserver 97 FTPSERVER (Function) 4,97 FTPSERVER.DEFAULT.HOST (Variable) 97 Function-calling structures 111 Functions for saving work 283 Functions for writing routines 176 FX Printer Compatibility 102 FX-80 DIP Switch Settings 100 driver 99 family 99 serial Interface 99 FX80-PRINT (Function) 102 G GapTelnet 26 Garbage collector 284 Gateway Access Protocol 26 GCHax 105 General Purpose Records 69 Get, Set Parameters via Inspector Window 7 get-cash-file (Function) 15 GETBOXSCREENPOSITION (Function) 40 GETBOXSCREENREGION (Function) 41 GETFILEINFO (Function) 267 GETHASHTEXT (Function) 129 GETHASHVILE (Function) 129 GETRELATION (Function) 176 GETSCREENPOSITION (Function) 40 GETTEMPLATE (Function) 174 GETTERMTABLE (Function) 288 Getting Hardcopy Directory Listings 77 Ghost boxes 238 Graph 11 data structure 120 nodes 111 GRAPH (record) 121 GRAPH/HARDCOPY/FORMAT (Variable) 117 Grapher 111,233 Grapher image objects 120 GRAPHEROBJ (Function) 120 GRAPHERPROP (Function) 121 Graphics interface 99 GRAPHNODE (record) 122 GRAPHREGION (Function) 120 GraphZoom 125 GRAYCOLORMAP (Function) 36 Groups 207 H HANZON Universal Card 99 HARDCOPY (Command) 81 HARDCOPYGRAPH (Function) 117 Hash tables 178 Hash-File 133 HASHFILEDEFAULTSIZE (Variable) 130 HASHFILEDTBL (Variable) 130 HASHFILENAME (Function) 129 HASHFILEP (Function) 129 HASHFILEPLST (Function) 130 HASHFILEPROP (Function) 129 HASHLOADFACTOR (Variable) 130 HFGROWTHFACTOR (Variable) 131 HLS (Record) 35 HLSP (Function) 35 HOST&DIRECTORYFIELD (Function) 231 HOSTS.TEXT.DIRECTORIES (Variable) 276 HOSTS.TXT files, parsing 276 HPRINT (Function) 121 HQFX80-DEFAULT-DESTINATION (Variable) 100 HQFX80-FONT-DIRECTORIES (Variable) 100 HRule 139 HRULE.CREATE (Function) 139 HTE.READ.FILE (Function) 276 Hue$Lightness$Saturation Triples 35 I I/O processor 226 IDENTITY-3-BY-3 (Function) 194 IDENTITY-4-BY-4 (Function) 194 il:typesof (Function) 313 il:whereis (Function) 313 Imagestream 5 Include all files, both deleted and undeleted 75 Individual mode 239 INFO menu 74 Info Options window 87 Input conventions for FileBrowser commands 75 Inserting a segment 59 install-form (Function) 299 INTENSITIESFROM (Function) 36 INTERACT&ADD.BORDER.TO.BITMAP (Function) 66 INTERACT&SHIFT.BITMAP.DOWN (Function) 66 INTERACT&SHIFT.BITMAP.LEFT (Function) 66 INTERACT&SHIFT.BITMAP.RIGHT (Function) 66 Interactive File Transfers With Kermit or Modem 146 Interactive Terminal Service 27 Internal fields 241 Internet layer 260 INTERPRESSFONTDIRECTORIES (Variable) 19 Interpreter 239 Interrupt character 234 INVERT.BITMAP.B/W (Function) 65 INVERT.BITMAP.DIAGONALLY (Function) 65 INVERT.BITMAP.HORIZONTALLY (Function) 65 INVERT.BITMAP.VERTICALLY (Function) 65 Invisible characters 288 IP addresses 262 networks primer 261 packet building 274 packet sending 275 socket access 272 IP.ADD.PROTOCOL (Function) 273 IP.APPEND.BYTE (Function) 275 IP.APPEND.CELL (Function) 275 IP.APPEND.STRING (Function) 275 IP.APPEND.WORD (Function) 275 IP.CLOSE.SOCKET (Function) 274 IP.DELETE.PROTOCOL (Function) 274 IP.OPEN.SOCKET (Function) 274 IP.SETUPIP (Function) 275 IP.TRANSMIT (Function) 275 IPHOSTNAME (Function) 273 IPINIT (Function) 272 IPTRACE (Function) 273 Iterative statement operator 177 J join-comments (Variable) 292 K Kermit 144,226 Kermit menu 146 KERMIT.RECEIVE (Function) 145 KERMIT.SEND (Function) 144 KEYACTION (Function) 153 Keyboard editor menus 150 KeyboardEditor 149 L Landscape mode 1 Landscape printing 103 Lattices 111 Laying out a graph for display 112 LAYOUTGRAPH (Function) 112 LAYOUTSEXPR (Function) 115 LDESHELL (Variable) 303 Library module changes 5-9 summary 5-9 Library module dependencies 9 Linguistic tree 120 Link layer 260 Lisp interrupts 22 LISPUSERSDIRECTORIES (Variable) 258 LISPXREAD (Function) 53 List of nodes 112 List structure editor 51 LISTFILES (Function) 3,213 LOAD (Command) 84 LOAD (Function) 49 Load New Keyboards 310 load-textmodule (Function) 290 LOADDB (Function) 50 LOADDBFLG (Variable) 50 LOADFROM (Function) 49,85 Loading TCP 258 LOOKUPHASHFILE (Function) 129 Lost characters 224 Low-level TCP Functions 272 M Macro 177 Macro Expansion 170 MAINSCREEN (Function) 39 Maintenance panel halt 279 make-cash-file (Function) 15 make-hash-file (Function) 133 MAKE-HOMOGENEOUS-3-BY-3 (Function) 193 MAKE-HOMOGENEOUS-3-VECTOR (Function) 193 MAKE-HOMOGENEOUS-4-VECTOR (Function) 194 MAKE-HOMOGENEOUS-N-BY-3 (Function) 193 MAKE-HOMOGENEOUS-N-BY-4 (Function) 194 make-specifier (Function) 297 make-textmodule (Function) 291 MAKEFILE (Function) 49,78,231 MAKEFILEFORMS (Function) 231 Making a sysout that contains TCP-IP 259 Manipulating domains 208 groups 207 remote Vmem 284 MAP-ARRAY (Function) 29 MAPGC (Function) 110 MAPHASHFILE (Function) 130 MAPOFACOLOR (Function) 37 MAPRELATION (Function) 176 MASTERSCOPE (Function) 175 MasterScope 11,49,157 Commands 158 database 157 entries 175 relations 161 set specifications 164 templates 164 Match 183 MatMult 193 MATMULT-133 (Function) 195 MATMULT-144 (Function) 195 MATMULT-331 (Function) 195 MATMULT-333 (Function) 195 MATMULT-441 (Function) 195 MATMULT-444 (Function) 196 MATMULT-N33 (Function) 195 MATMULT-N44 (Function) 196 Matrix Creation Functions 193 Matrix multiplication 193 Matrix Multiplication Functions 195 Merged node 237 MIGRATIONS (Variable) 231 MiniServe 199 mlFloatArray 196 Modem 145,226 MODEM.RECEIVE (Function) 145 MODEM.SEND (Function) 145 Moving an expression 59 MSMACROPROPS (Variable) 170 MSMARKCHANGED (Function) 177 MSNEEDUNSAVE (Function) 176 Multiple DEdit commands 58 Multiple streams 9 MY.NSHOSTNUMBER (Variable) 200 N Network addresses 261 Network protocols 21,26 NETWORKOSTYPES (Variable) 257 NEW INFO FileBrowser Command 87 NODECREATE (Function) 112 Notecards 9 Noticing changes that require recompiling 177 NS characters 213 NS Chat 26 NS Records 69 NS.TO.PUP.ALIST (Variable) 200 NS.TO.PUP.FILE (Variable) 200 NSHOSTNUMBER (record) 69 NSMaintain 203 NSMAINTAIN (Function) 204 NSTIMESERVER (Function) 199 NTERACT&SHIFT.BITMAP.UP (Function) 66 NUMBERPAD.READ (Function) 216 O Objects 203 creating 206 deleting 206 Obtaining information in NSMaintain 204 Obtaining network addresses 254 open-hash-file (Function) 133 OPENHASHFILE (Function) 128 OPENIMAGESTREAM (Function) 9,101 Opening a 4045 Stream 7 a Centronics Stream 17 a Chat Connection 22 OPENP (Function) 222 OPENSTREAM (Function) 222 OPENWINDOWS (Function) 42 Operations on Multiple Items 249 Organization 203 OVERFLOWS (Function) 108 P Packages 124, 286 Parents 114 parity errors 224 PARSERELATION (Function) 176 PATLISPCHECK (Variable) 184 Pattern elements 185 match compiler 184 match expressions 185 PATVARDEFAULT (Variable) 185 PERSPECTIVE-4-BY-4 (Function) 195 Place Markers 189 Portrait mode 1 PORTSTRING (Function) 4,280 PPTCB (Function) 266 Press 213 PRESSFONTWIDTHFILES (Variable) 213 Primitive relationship 178 PRIMTERMTABLE (Variable) 288 PRIN3 (Function) 124 Print a file 101,102 source code in high-quality mode 103 source code on fast FX-80 103 TEdit file in fast FX-80 mode 103 TEdit file in high-quality mode 104 text and graphics in high-quality mode 103 print-filecom (Function) 299 Printer drivers 99 Printer's point 139 Printing in fast mode 101 in high-quality mode 102 source or TEdit Files 3 speed 9 via FTPserver 4 windows 4 Programmer's Assistant 288 PROJECT-AND-FIX-3-VECTOR (Function) 196 PROJECT-AND-FIX-4-VECTOR (Function) 196 PROJECT-AND-FIX-N-BY-3 (Function) 196 PROJECT-AND-FIX-N-BY-4 (Function) 196 PROMPT window 73 Properties 203 Protocol number 273 PUP (record) 70 PUP Chat 26 FTP 97,232 ID service 200 records 70 time service 200 PUP.ID.SERVER (Function) 199 PUPADDRESS (record) 70 PUPNUMBER (Variable) 200 PUPTIMESERVER (Function) 199 PUTHASHFILE (Function) 128 PUTHASHTEXT (Function) 129 Q QABLEITEM (record) 69 Query Mode 45 Queue multiple arguments 60 Quick-scrolling 74 Quitting the FileBrowser 76 R RANDACCESSP (Function) 272 READ-BYTE (Function) 219 READ-CHAR (Function) 219 READGRAPH (Function) 121 Reading the Remote Vmem 284 ReadNumber 215 ReadNumber window 66 READP (Function) 222 READSYS (Function) 284 REALFRAMEP (Function) 239 RECOMPILEDEFAULT (Variable) 178 RECOMPUTE (Command) 86 Reconstruction 190 Record declaration 177 Recursive loads 97 Redefine Existing Keyboards 310 REDUCE-ARRAY (Function) 30 Red$Green$Blue Triples 34 REFCNT (Function) 108 Reference counting 284 REHASHFILE (Function) 130 REHASHGAG (Variable) 131 Relations between sets 157 RELDRAWTO (Function) 43 Remote Kermit in Server Mode 144 Kermit not in Server Mode 144 system administration 27 system executive 27 Removing Keyboards From the Menu 310 RENAME (Command) 81 REPACKFILENAME.NEW.TRANSLATION (Function) 269 REPACKFILENAME.OSTYPE.TABLE (Variable) 269 REPACKFILENAME.STRING (Function) 268 Replace All Known Keyboards 310 Replacements 190 RESET/NODE/BORDER (Function) 120 RESET/NODE/LABELSHADE (Function) 120 RESETDEDIT (Function) 54 Resetting 4045XLPstream 8 Restarting MiniServe 201 RGB (Record) 34 RGBCOLORMAP (Function) 36 RGBP (Function) 35 RNUMBER (Function) 215 Ross referencing user programs 157 ROTATE-3-BY-3 (Function) 194 ROTATE-4-BY-4-ABOUT-X (Function) 194 ROTATE-4-BY-4-ABOUT-Y (Function) 194 ROTATE-4-BY-4-ABOUT-Z (Function) 194 ROTATE.BITMAP.LEFT (Function) 65 ROTATE.BITMAP.RIGHT (Function) 65 ROTATECOLORMAP (Function) 37 RS232 143,219 RS232 Chat 27 port 219 RS232C port 1 RS232C.CLOSE-STREAM (Function) 222 RS232C.DEFAULT.INIT.INFO (Variable) 220 RS232C.ERROR.STREAM (Variable) 224 RS232C.GET.PARAMETERS (Function) 221 RS232C.INIT (Function) 220 RS232C.OTHER.STREAM (Function) 222 RS232C.OUTPUT.PACKET.LENGTH (Function) 222 RS232C.READP.EVENT (Function) 223 RS232C.REPORT.STATUS (Function) 224 RS232C.SET.PARAMETERS (Function) 220 RS232C.SHUTDOWN (Function) 221 RS232CHAT 225 RS232CMENU 225,228 RS232MODEMCONTROL (Function) 223 RS232MODEMHANGUP (Function) 224 RS232MODEMSTATUSP (Function) 223 RS232MODIFYMODEMCONTROL (Function) 223 RS232SENDBREAK (Function) 223 RS232TRACE 224 S S-expression 115 SameDir 231 Sampler 233 SAVEDBFLG (Variable) 50 Scale factors 9 SCALE-3-BY-3 (Function) 194 SCALE-4-BY-4 (Function) 195 SCALEDBITBLT (Function) 9 SCREENBITMAP (Function) 39 SCREENCOLORMAP (Function) 36 SCREENPOSITION (Record) 39 SCREENREGION (Record) 39 Scroll bar 74 SEE (Command) 82 Segment Patterns 186 Segment selection and manipulation 59 Selecting Files 74 Selecting Objects and Lists 52 Selection stack 53 Send text output to fast FX-80 103 SEND.FILE.TO.PRINTER (Function) 3,213 Serial interface card 99 Server mode 144 SET DEPTH (Command) 88 Set destination 102 determiners 167 FX-80 Destination 101 FX-80 Page Size 101 HQ Mode 102 page Size 102 specifications by Blocktypes 167 specifications by Relation 166 types 167 SETCOLORINTENSITY (Function) 37 SETSYNONYM (Function) 175 SETTEMPLATE (Function) 174 SETTIME (Function) 199 SHIFT.BITMAP.DOWN (Function) 65 SHIFT.BITMAP.LEFT (Function) 66 SHIFT.BITMAP.RIGHT (Function) 66 SHIFT.BITMAP.UP (Function) 66 SHOW PATHS 180 SHOW PATHS (Command) 169 SHOW PATHS (Function) 11 SHOW.CLOSED.WINDOWS (Function) 110 SHOWCIRCULARITY (Function) 110 SHOWCOLORTESTPATTERN (Function) 44 SHOWCOMMONCSETS (Function) 20 SHOWCSET (Function) 20 SHOWCSETLIST (Function) 20 SHOWCSETRANGE (Function) 20 SHOWGC (Function) 107 SHOWGRAPH (Function) 116,125 SHOWZOOMGRAPH (Function) 125 Simple item operations 248 SINGLEFILEINDEX (Function) 10 Sketch 10 SORT (Command) 89 Special characters 307 specifiers (Variable) 297 Specifying the files to browse 72 Spy 233 SPY.BORDERS (Variable) 239 SPY.BUTTON (Function) 234 SPY.END (Function) 234 SPY.FONT (Variable) 239 SPY.FREQUENCY (Variable) 239 SPY.LEGEND (Function) 239 SPY.MAXLINES (Variable) 239 SPY.NOMERGEFNS (Variable) 239 SPY.START (Function) 234 SPY.TOGGLE (Function) 234 SPY.TREE (Function) 235 SPY.TREE (Variable) 239 Stack 280 Stack architecture 58 Stacking several rules in a single object 140 Starting FileBrowser 71 Starting TExec 287 STARTMINISERVE (Function) 199 Static structure 233 stderr 305 stdin 305 stdout 305 STOPIP (Function) 272 STORAGE (Function) 105 Store keyboards 309 SUBNETMASK (Variable) 262 Subnetworks 262 Sun,TCP to a 254 SunOS, interface to 305 Switch & Display a Keyboard 308 Switch A-2 2 Switch Keyboards 308 Switch settings 2 SWITCHKEYBOARDS (Function) 311 SysEdit 241 SYSHASHFILE (Variable) 131 SYSHASHFILELST (Variable) 131 System sources 241 T TableBrowser 243 TABLEBROWSER (record) 244 TABLEITEM (record) 243 Tally window 73 Target-source-Command 59 TB.BROWSER.BUSY (Function) 248 TB.CLEAR.LINE (Function) 249 TB.COLLECT.ITEMS (Function) 250 TB.DELETE.ITEM (Function) 248 TB.FIND.ITEM (Function) 250 TB.FINISH.CLOSE (Function) 248 TB.INSERT.ITEM (Function) 249 TB.ITEM.DELETED? (Function) 251 TB.ITEM.SELECTED? (Function) 251 TB.MAKE.BROWSER (Function) 247 TB.MAP.DELETED.ITEMS (Function) 250 TB.MAP.ITEMS (Function) 250 TB.MAP.SELECTED.ITEMS (Function) 250 TB.NORMALIZE.ITEM (Function) 249 TB.NTH.ITEM (Function) 250 TB.NUMBER.OF.ITEMS (Function) 249 TB.REDISPLAY.ITEMS (Function) 249 TB.REMOVE.ITEM (Function) 249 TB.REPLACE.ITEMS (Function) 248 TB.SELECT.ITEM (Function) 248 TB.SET.FONT (Function) 248 TB.UNDELETE.ITEM (Function) 248 TB.USERDATA (Function) 251 TB.WINDOW (Function) 251 TCP and directory enumeration 254 Chat 27 debugging aids 277 segment 264 TCP-IP 253 protocol 47 protocol layers 260 TCP.BYE (Function) 268 TCP.CLOSE.SENDER (Function) 265 TCP.DEFAULT.RECEIVE.WINDOW (Variable) 265 TCP.DEFAULT.USER.TIMEOUT (Variable) 265 TCP.DEFAULTFILETYPE (Variable) 267 TCP.ECHO.SERVER (Function) 266 TCP.ECHOTEST (Function) 266 TCP.FAUCET (Function) 267 TCP.INIT (Function) 265 TCP.OPEN (Function) 264 TCP.OTHER.STREAM (Function) 265 TCP.SINK.SERVER (Function) 266 TCP.STOP (Function) 265 TCP.URGENT.EVENT (Function) 265 TCP.URGENT.MARK (Function) 265 TCP.URGENTP (Function) 265 TCPCHAT.TELNET.TTY.TYPES (Variable) 269 TCPCHAT.TRACEFILE (Variable) 269 TCPCHAT.TRACEFLG (Variable) 269 TCPFTP.DEFAULT.FILETYPES (Variable) 267 TCPFTP.EOL.CONVENTION 267 TCPFTP.INIT (Function) 268 TCPFTP.SERVER (Function) 268 TCPFTP.SERVER.USE.TOPS20.SYNTAX (Variable) 268 TCPTRACE (Function) 266 TEdit 9,21,139,287,307 TEdit Chat 28 TeleRaid 279 TELERAID (Function) 280 TeleRaid Commands 280 Teletype editor 51 TELNET protocol 261,269 Ten-key calculator pad 215 Terminal emulators 21 Testing the connection between two Xerox Lisp machines 228 TESTRELATION (Function) 176 TExec 287 TEXEC (Function) 287 TEXTMODULES 289 TFTP.CLOSEFILE (Function) 272 TFTP.GET (Function) 272 TFTP.OPENFILE (Function) 272 TFTP.PUT (Function) 271 TFTP.SERVER (Function) 272 Thumbing 74 TIMEZONECOMP (Variable) 200 Tracing and test Functions 265 Trailer encapsulation 277 Transferring files 143,258 TRANSLATE-3-BY-3 (Function) 195 TRANSLATE-4-BY-4 (Function) 195 Translating between the file-naming conventions 268 Transport layer 260 Transport control protocol 264 Trees 111 TRIM.BITMAP (Function) 66 Trivial file transfer protocol 271 Troubleshooting Problems With FileBrowser 94 TTY port 1,219 TTY.DEFAULT.INIT.INFO (Variable) 226 TTY.GET.PARAMETERS (Function) 228 TTY.INIT (Function) 226 TTY.SET.PARAMETERS (Function) 227 TTY.SHUTDOWN (Function) 228 TTYCHAT 228 Typing Characters to DEdit 53 U UDP.APPEND.BYTE (Function) 271 UDP.APPEND.CELL (Function) 271 UDP.APPEND.STRING (Function) 271 UDP.APPEND.WORD (Function) 271 UDP.CLOSE.SOCKET (Function) 270 UDP.EXCHANGE (Function) 271 UDP.GET (Function) 270 UDP.INIT (Function) 270 UDP.OPEN.SOCKET (Function) 270 UDP.SEND (Function) 271 UDP.SETUP (Function) 270 UDP.SOCKET.EVENT (Function) 270 UDP.SOCKET.NUMBER (Function) 270 UDP.STOP (Function) 270 UNCOLORIZEBITMAP (Function) 44 UNDELETE (Command) 77 Unechoed input mode 288 UNIX 232,272 UNIX-STREAM-CLOSE (Function) 305 UNIXChat 303 UNIXComm 305 Unread 54 UNSAVEFNS (Function) 177 UPDATECHANGED (Function) 177 UPDATEFN (Function) 177 Updating the MasterScope Data Base 174 upgrade-semicolon-comments (Variable) 292 User Commands for NSMaintain 204 User datagram protocol 270 USERWORDS (Function) 288 Using 4045XLP stream 8 4045 as a default printing host 3 FileBrowser window 73 Keyboard editor 150 modems 223 RS232 streams 222 TExec 288 TTY port 226 TTY streams 228 V Verifying TCP connections 258 Version Control 46 VFIND.PACKAGE (Function) 286 VFIND.SYMBOL (Function) 286 VGETBASE0 (Function) 285 VGETDEFN (Function) 285 VGETPROPLIST (Function) 285 VGETTOPVAL (Function) 285 VGETVAL (Function) 285 Viewing an existing bitmap 64 frames from a stack 281 system stack 282 Violation of the IP standard 262 Virtual graph nodes 113 Virtual memory 279 Virtual terminal I/O 269 VirtualKeyboards 149,307 VKBD.CONFIGURATIONS (Variable) 154 VKBD.KNOWN-KEYBOARDS (Variable) 311 VLOADFNS (Function) 283 VLOADVAR (Function) 283 VPUTBASE0 (Function) 286 VRAID (Function) 284 VSAVEWORK (Function) 283 VSETTOPVAL (Function) 285 VT100 Chat 28 VTYPENAME (Function) 285 VUNSAVEDEF (Function) 283 VVAG2 (Function) 285 VYANKDEF (Function) 283 V\COPY (Function) 285 V\UNCOPY (Function) 285 W Weitek floating-point chip set 29 When To Copy 46 Where-Is 313 Wild cards 72 WINDOWPROP (Function) 42 WORPCURSOR (Function) 43 Wrapper Functions 193 X XCVR interface cable 253 Xerox 2700-II laser printer 1 Xerox 4045 Laser CP 1 Xerox Character Codes 19 Xerox/Diablo 630 1 XIP (record) 69 XNS host number 200 XNS Time Service 199 ( (GETSCREENREGION (Function) 40 (MAKE-HOMOGENEOUS-4-BY-4 (Function) 194 4 4045 configuration cartridge 2 4045 Emulation Mode Selection 2 4045 Fonts 9 4045 Parameter Names and Values 5 4045 Port Initialization 3 4045 Port Selection 2 4045 PROM and Software Compatibility 1 4045XLP.CHANGE.MODE (Function) 5 4045XLP.DEFAULTS (Variable) 5 4045XLP.GET.PARAMETERS (Function) 7 4045XLP.PARAMETERS (record) 5 4045XLP.SET.PARAMETERS (Function) 6 4045XLPStream 1 4045XLPstream Options 5 4045XLPSTREAM.VERSION (Variable) 1 (LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "INDEX-" "") STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "INDEX-" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE TITLEHEAD) (54 762 558 36) NIL) (HEADING NIL (HEADINGTYPE TITLEHEADRULE) (54 753 558 36) NIL) (TEXT NIL NIL (54 54 241 666) NIL) (TEXT NIL NIL (320 54 241 666) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "INDEX-" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "INDEX-" "")) (54 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 241 684) NIL) (TEXT NIL NIL (320 54 241 684) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "INDEX-" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "INDEX-" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE RECTOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 241 684) NIL) (TEXT NIL NIL (319 54 241 684) NIL)))))-KT-KT,K2$$-KTJ PAGEHEADING TITLEHEADRULEF PAGEHEADING TITLEHEADF PAGEHEADING VERSOHEADF PAGEHEADING RECTOHEADE PAGEHEADINGFOOTINGVE PAGEHEADINGFOOTINGR,K-K T,KMODERN +MODERN +CLASSIC + HELVETICA HELVETICA +OPTIMA +CLASSIC +MODERN +  HRULE.GETFNMODERN + ( + HRULE.GETFNCLASSIC + +)   HRULE.GETFNCLASSIC + HRULE.GETFNCLASSIC + HRULE.GETFNOPTIMA +  +    # '       +      (                                                                             +     #      + +  +       + + +                 %        + +       +  + +      +    +                       +  +   !  +  +   +                           "               +          +    +        +   *               %               +                      +  + D" + " + _"* 9*"    1                               +      +  +             +               +  + & +              +   +                   !               +             + +%            +               # "*  + +        +                              : + 0)119!D  @                                                      $      +                      +                   +           +  + +                                             +            +  +    +            !  +   + + 8     +   +    +   1   + +   +             +   +      +   +   + +    + $   "       +          +  +               +   +   +         !&      tz \ No newline at end of file diff --git a/library/BROWSER b/library/BROWSER index 53640727..5ca7aee9 100644 --- a/library/BROWSER +++ b/library/BROWSER @@ -1,17 +1,17 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Feb-2022 14:06:19" {DSK}kaplan>Local>medley3.5>my-medley>library>BROWSER.;3 26344 +(FILECREATED "26-Apr-2023 12:41:36" {DSK}larry>il>medley>library>BROWSER.;6 29801 - :CHANGES-TO (VARS BROWSERCOMS) - (FNS GET.BROWSE.PP.WINDOW NUMSPATHS) + :EDIT-BY "lmm" - :PREVIOUS-DATE "25-Mar-94 13:43:20" -{DSK}kaplan>Local>medley3.5>my-medley>library>BROWSER.;1) + :CHANGES-TO (FNS BROWSER.LEFTFN NUMSPATHS STBROWSER MSPATHS.DISPATCH BROWSER + BROWSER.WHENFNSCHANGED BRPATHS1 GET.BROWSE.PP.WINDOW + GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN DESCRIBEREPAINTFN + BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP REDRAWBROWSEGRAPH) + (VARS BROWSERCOMS BROWSER.BORDERS) + :PREVIOUS-DATE "15-Apr-2023 18:55:36" {DSK}larry>il>medley>library>BROWSER.;1) -(* ; " -Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation. -") (PRETTYCOMPRINT BROWSERCOMS) @@ -20,27 +20,26 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) GRAPHER) (CONSTANTS (CHANGEDSHADE 8840))) - (FNS NUMSPATHS BROWSER BROWSER.WHENFNSCHANGED BRPATHS1 BROWSER.LEFTFN GET.BROWSE.PP.WINDOW - GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN DESCRIBEREPAINTFN - BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP REDRAWBROWSEGRAPH STBROWSER) + (FNS MSPATHS.DISPATCH NUMSPATHS BROWSER BROWSER.WHENFNSCHANGED BRPATHS1 BROWSER.LEFTFN + GET.BROWSE.PP.WINDOW GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN + DESCRIBEREPAINTFN BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP + REDRAWBROWSEGRAPH STBROWSER) (GLOBALRESOURCES BROWSEHASH) (DECLARE%: DONTCOPY (RECORDS BROWSEWIN PATHSARGS)) - [VARS (BROWSERBOXING) - (BROWSERFORMAT) - (BROWSERWINDOWS) - (NODESELECTIONWINDOW) - (PFWINDOW) - (BROWSER.DESCRIBE.WINDOW) - (BrowserPPWindowWidth 750) - (BROWSERFONT '(GACHA 8] - [P (MOVD? 'MSPATHS 'OLDMSPATHS) - (MOVD? 'NILL 'MODERNWINDOW) - (PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED] - (OR (MEMB 'BROWSER.WHENFNSCHANGED WC) - (FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC] - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (SELECTQ (SYSTEMTYPE) - (D (BROWSER T)) - NIL]) + [INITVARS (BROWSER T) + (BROWSERBOXING) + (BROWSERFORMAT) + (BROWSERWINDOWS) + (NODESELECTIONWINDOW) + (PFWINDOW) + (BROWSER.DESCRIBE.WINDOW) + (BrowserPPWindowWidth 750) + (BROWSERMAX 10) + (BROWSERFONT '(GACHA 8] + (P (MOVD? 'NILL 'MODERNWINDOW)) + (VARS BROWSER.BORDERS) + (GLOBALVARS BROWSER.BORDERS BROWSERWINDOWS) + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (BROWSER T]) (FILESLOAD MASTERSCOPE GRAPHER) (DECLARE%: EVAL@COMPILE DONTCOPY @@ -58,64 +57,74 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation ) (DEFINEQ -(NUMSPATHS +(MSPATHS.DISPATCH [LAMBDA (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING) - (* ; "Edited 7-Feb-2022 13:57 by rmk") - (* ; "Edited 11-Apr-88 11:08 by jrb:") - (COND - [(AND (WINDOWWORLD) + (* ; "Edited 15-Apr-2023 11:33 by lmm") + (IF (AND (GETD 'NUMSPATHS) + (WINDOWWORLD) (EQ (OUTPUT) T)) - [OR AVOIDING (SETQ AVOIDING '(NIL (NIL NIL . FNS) - APPLY LAMBDA (X) - (GETPROP X 'AVOID] - (RESETVARS ((MSPRINTFLG)) - (AND INVERTED (UPDATECHANGED)) - (STBROWSER - [GLOBALRESOURCE - BROWSEHASH - (PROG [X NAMED TEM (UNDONE (MSLISTSET FROM T)) - ROOTS GRAPHNODE.LIST (SEEN BROWSEHASH) - (CALLRELATION (PARSERELATION 'CALL] - (DECLARE (SPECVARS SEEN UNDONE GRAPHNODE.LIST)) - (CLRHASH SEEN) - (for X in UNDONE do (PUTHASH X (COND - ((AND NOTRACE (MSMEMBSET X NOTRACE)) - -1) - (T 0)) - SEEN) - (OR INVERTED (UPDATEFN X NIL 0))) - [do (COND - (NAMED (PUTHASH (CAR NAMED) - 0 SEEN) - [push ROOTS (fetch (GRAPHNODE NODEID) - of (BRPATHS1 (CAR NAMED] - (SETQ NAMED (CDR NAMED))) - (UNDONE [COND - ([OR (NULL (SETQ TEM (GETHASH (CAR UNDONE) - SEEN))) - (EQ TEM 0) - (AND (LISTP TEM) - (NULL (CAR TEM] - (PUTHASH (CAR UNDONE) - (LIST NIL) - SEEN) - (SETQ NAMED (LIST (CAR UNDONE] - (SETQ UNDONE (CDR UNDONE))) - (T (RETURN] - (RETURN (LAYOUTFOREST GRAPHNODE.LIST ROOTS BROWSERFORMAT BROWSERBOXING] - (PROG1 (LIST FROM TO INVERTED AVOIDING SEPARATE NOTRACE) - (* ; - "this LIST is actually an 'instance' of PATHSARGS") - ] - (T (OLDMSPATHS FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING]) + THEN (NUMSPATHS FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING) + ELSE (OLDMSPATHS FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING]) + +(NUMSPATHS + [LAMBDA (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING DEPTH) + (DECLARE (SPECVARS INVERTED GRAPHNODE.LIST)) (* ; "Edited 26-Apr-2023 09:12 by lmm") + (* ; "Edited 15-Apr-2023 18:43 by lmm") + (* ; "Edited 7-Feb-2022 13:57 by rmk") + (* ; "Edited 11-Apr-88 11:08 by jrb:") + [OR AVOIDING (SETQ AVOIDING '(NIL (NIL NIL . FNS) + APPLY LAMBDA (X) + (GETPROP X 'AVOID] + (AND INVERTED (UPDATECHANGED)) + (OR DEPTH (SETQ DEPTH BROWSERMAX)) + (WITH-RESOURCES BROWSEHASH (PROG [NAMED TEM (UNDONE (MSLISTSET FROM T)) + ROOTS GRAPHNODE.LIST (SEEN BROWSEHASH) + (CALLRELATION (PARSERELATION 'CALL] + (DECLARE (SPECVARS SEEN GRAPHNODE.LIST CALLRELATION)) + (CLRHASH SEEN) + (for X in UNDONE do (PUTHASH X (COND + ((AND NOTRACE (MSMEMBSET + X NOTRACE)) + -1) + (T 0)) + SEEN) + (OR INVERTED (UPDATEFN X NIL 0))) + [do (COND + (NAMED (PUTHASH (CAR NAMED) + 0 SEEN) + (PUSH ROOTS (fetch (GRAPHNODE NODEID) + of (BRPATHS1 (CAR NAMED) + DEPTH))) + (SETQ NAMED (CDR NAMED))) + (UNDONE [COND + ([OR (NULL (SETQ TEM (GETHASH (CAR UNDONE) + SEEN))) + (EQ TEM 0) + (AND (LISTP TEM) + (NULL (CAR TEM] + (PUTHASH (CAR UNDONE) + (LIST NIL) + SEEN) + (SETQ NAMED (LIST (CAR UNDONE] + (SETQ UNDONE (CDR UNDONE))) + (T (RETURN] + (RETURN (STBROWSER (LAYOUTGRAPH GRAPHNODE.LIST ROOTS + (APPEND BROWSERFORMAT BROWSERBOXING)) + (LIST FROM TO INVERTED AVOIDING SEPARATE NOTRACE + MARKING DEPTH]) (BROWSER - [LAMBDA (DISPLAYFLG) (* rmk%: "16-Dec-83 15:39") - (COND - (DISPLAYFLG (SETQ BROWSERFONT (FONTCREATE BROWSERFONT)) - (MOVD 'NUMSPATHS 'MSPATHS)) - (T (MOVD 'OLDMSPATHS 'MSPATHS]) + [LAMBDA (DISPLAYFLG) (* ; "Edited 15-Apr-2023 14:55 by lmm") + (* rmk%: "16-Dec-83 15:39") + (MOVD? 'MSPATHS 'OLDMSPATHS) + (MOVD 'MSPATHS.DISPATCH 'MSPATHS) + (SETQ BROWSER DISPLAYFLG) + (OR (FONTP BROWSERFONT) + (SETQ BROWSERFONT (FONTCREATE BROWSERFONT))) + (PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED] + (OR (MEMB 'BROWSER.WHENFNSCHANGED WC) + (FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC]) (BROWSER.WHENFNSCHANGED [LAMBDA (FNNAME TYPE REASON) (* DECLARATIONS%: (RECORDS BROWSEWIN)) @@ -134,78 +143,122 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation FNNAME)) (BROWSERDESCRIBE FNNAME BROWSER.DESCRIBE.WINDOW))) (for X in BROWSERWINDOWS do (COND - ((find GRAPHNODE - in (fetch (GRAPH GRAPHNODES) - of (fetch (BROWSEWIN GRAPH) - of X)) - suchthat (EQ (fetch (GRAPHNODE NODELABEL) - of GRAPHNODE) - FNNAME)) - (COND - ((fetch (BROWSEWIN GRAPH) of X) - (DSPFILL NIL CHANGEDSHADE 'PAINT - (fetch (BROWSEWIN WINDOW) of - X)) - (WINDOWPROP (fetch (BROWSEWIN WINDOW) - of X) - 'BUTTONEVENTFN - (FUNCTION REDRAWBROWSEGRAPH)) - (replace (BROWSEWIN GRAPH) of X - with NIL]) + ((find GRAPHNODE in (fetch (GRAPH GRAPHNODES) + of (fetch (BROWSEWIN GRAPH) of X)) + suchthat (EQ (fetch (GRAPHNODE NODELABEL) of GRAPHNODE) + FNNAME)) + (COND + ((fetch (BROWSEWIN GRAPH) of X) + (DSPFILL NIL CHANGEDSHADE 'PAINT (fetch (BROWSEWIN WINDOW) + of X)) + (WINDOWPROP (fetch (BROWSEWIN WINDOW) of X) + 'BUTTONEVENTFN + (FUNCTION REDRAWBROWSEGRAPH)) + (replace (BROWSEWIN GRAPH) of X with NIL]) (BRPATHS1 - [LAMBDA (FROM) (* ; "Edited 11-Apr-88 11:27 by jrb:") - (DECLARE (GLOBALVARS BROWSERFONT)) - (PROG (TEM) + [LAMBDA (FROM DEPTH) (* ; "Edited 25-Apr-2023 10:59 by lmm") + (* ; "Edited 11-Apr-88 11:27 by jrb:") + (DECLARE (SPECVARS INVERTED) + (GLOBALVARS BROWSERFONT MISSING.GRAPH.NODEBORDER)) + (PROG (TEM ENTRY TOFNS) (MSPATHS2 FROM) (COND ((EQ (SETQ TEM (GETHASH FROM SEEN)) -1) (* ; - "on NOPATHS list - create a node for it with no subs") + "on NOPATHS list - create a node for it with no subs") (SETQ TEM (create GRAPHNODE NODEID _ FROM NODELABEL _ FROM NODEFONT _ BROWSERFONT TONODES _ NIL)) - (push GRAPHNODE.LIST TEM) + (PUAH GRAPHNODE.LIST TEM) (PUTHASH FROM TEM SEEN) (RETURN TEM)) ((NEQ TEM 0) (* ; "already expanded into a list") (RETURN TEM)) - (T (RETURN (PROG ((ENTRY (create GRAPHNODE - NODEID _ FROM - NODELABEL _ FROM - NODEFONT _ BROWSERFONT))) - (push GRAPHNODE.LIST ENTRY) - (PUTHASH FROM ENTRY SEEN) - (replace (GRAPHNODE TONODES) of ENTRY - with (for X - in (for Y - in (COND - ((NOT INVERTED) - (GETRELATION FROM CALLRELATION)) - (T (GETRELATION FROM CALLRELATION T) - )) when (MSPATHS2 Y) - collect Y) when (SETQ X (BRPATHS1 - X)) - collect (fetch (GRAPHNODE NODEID) of X))) - (RETURN ENTRY]) + (T [SETQ TOFNS (COND + ((NOT INVERTED) + (GETRELATION FROM CALLRELATION)) + (T (GETRELATION FROM CALLRELATION T] + (SETQ ENTRY (create GRAPHNODE + NODEID _ FROM + NODELABEL _ FROM + NODEFONT _ BROWSERFONT)) + (PUSH GRAPHNODE.LIST ENTRY) + (PUTHASH FROM ENTRY SEEN) + (IF (AND TOFNS (<= DEPTH 0)) + THEN (REPLACE (GRAPHNODE NODEBORDER) OF ENTRY WITH (CDDR (ASSOC 'ENDOFLINE + BROWSER.BORDERS)) + ) + (RETURN ENTRY)) + (replace (GRAPHNODE TONODES) of ENTRY with (for X + in (for Y in TOFNS + when (MSPATHS2 Y) collect Y) + when (SETQ X (BRPATHS1 X + (- DEPTH 1))) + collect (fetch (GRAPHNODE NODEID) + of X))) + (RETURN ENTRY]) (BROWSER.LEFTFN - [LAMBDA (NODE NWINDOW) (* ; "Edited 31-Mar-87 11:16 by jop") + [LAMBDA (NODE NWINDOW) (* ; "Edited 26-Apr-2023 12:41 by lmm") + (* ; "Edited 31-Mar-87 11:16 by jop") (* ;  "function that is applied upon selection of a node.") - (COND - ((NULL NODE)) - ((EQ (fetch NODELABEL of NODE) - (WINDOWPROP (GET.BROWSE.PP.WINDOW) - 'FNBROWSED)) - (BROWSERDESCRIBE (fetch NODELABEL of NODE) - (GET.BROWSE.DESCRIBE.WINDOW))) - (T (* ; - "if first time touched, pretty print it.") - (BROWSEPP (fetch NODELABEL of NODE) - (GET.BROWSE.PP.WINDOW]) + (PROG (FN SELECTION) + (IF (NULL NODE) + THEN (RETURN) + (MOVEW NWINDOW) (* ; + " really want to just drag the content around") + (RETURN)) + (IF (NULL (SETQ FN (FETCH NODELABEL OF NODE))) + THEN (RETURN)) + [SETQ SELECTION (MENU (CREATE MENU + ITEMS _ '(CallsFrom CallsTo Edit Show InspectCode] + + (* ;; "Mot implemented: Ignore Avoid") + + (DESTRUCTURING-BIND (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING DEPTH) + (FOR BW IN BROWSERWINDOWS WHEN (EQ (FETCH (BROWSEWIN WINDOW) OF BW) + NWINDOW) DO (RETURN (FETCH (BROWSEWIN ARGS) + OF BW)) + FINALLY (PROMPTPRINT "No browser window found for" FN) + (RETURN)) + + (* ;; "Now we have the arguments to MSPATHS .. insert this node?") + + (SELECTQ SELECTION + ((NIL) + (RETURN)) + ((CallsFrom CallsTo) + (* ;; "new graph, FN at the root") + + (NUMSPATHS (CREATE SENTENCE + SUBJECT _ '(NIL NIL . FNS) + MSPRED _ 'QUOTE + OTHERSTUFF _ (LIST FN)) + (IF INVERTED + THEN TO + ELSE FROM) + INVERTED AVOIDING NIL NOTRACE MARKING DEPTH)) + NIL + (Ignore (* ; "local ignore")) + (Avoid (* ; " global ignore")) + (Edit (ED FN (IF (HASDEF FN 'FNS) + THEN 'FNS + ELSEIF (HASDEF FN 'FUNCTIONS) + THEN 'FUNCTIONS + ELSE (PROMPTPRINT FN "no definition") + NIL))) + (Show (CL:UNLESS (EQ FN (WINDOWPROP (GET.BROWSE.PP.WINDOW) + 'FNBROWSED)) + (BROWSEPP FN (GET.BROWSE.PP.WINDOW)))) + (Describe (BROWSERDESCRIBE FN (GET.BROWSE.DESCRIBE.WINDOW))) + (InspectCode (IF (NOT (CCODEP FN)) + THEN (PROMPTPRINT FN "not compiled") + ELSE (INSPECTCODE FN))) + (HELP]) (GET.BROWSE.PP.WINDOW [LAMBDA NIL (* ; "Edited 7-Feb-2022 14:01 by rmk") @@ -253,9 +306,9 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation BOTTOM]) (PPREPAINTFN - [LAMBDA (WINDOW REGION RESHAPE) (* ; "Edited 11-Jun-90 14:11 by mitani") + [LAMBDA (WINDOW REGION RESHAPE) (* ; "Edited 11-Jun-90 14:11 by mitani") - (* ;; "repaints the browser pp window WINDOW. Returns the width of the image so that caller can set the EXTENT.") + (* ;; "repaints the browser pp window WINDOW. Returns the width of the image so that caller can set the EXTENT.") (PROG ((FN (WINDOWPROP WINDOW 'FNBROWSED)) (EXTENT (WINDOWPROP WINDOW 'EXTENT)) @@ -265,25 +318,23 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation (MOVETOUPPERLEFT WINDOW EXTENT) (printout WINDOW .FONT DEFAULTFONT) (COND - ((for FPTYPE in MSFNTYPES - when (SETQ DEF (GETDEF FN (ffetch (MSANALYZABLE FILEPKGNAME) - of FPTYPE) - NIL - 'NOERROR)) - do (SETQ FNTYPE (ffetch (MSANALYZABLE FILEPKGNAME) - of FPTYPE)) - (RETURN DEF) finally NIL) - (* ; - "set up linelength characteristics.") + ((for FPTYPE in MSFNTYPES when (SETQ DEF (GETDEF FN (ffetch (MSANALYZABLE + FILEPKGNAME) + of FPTYPE) + NIL + 'NOERROR)) + do (SETQ FNTYPE (ffetch (MSANALYZABLE FILEPKGNAME) of FPTYPE)) + (RETURN DEF) finally NIL) (* ; + "set up linelength characteristics.") (RESETLST (RESETSAVE (OUTPUT WINDOW)) (RESETSAVE (SETREADTABLE T)) (RESETSAVE **COMMENT**FLG) (if (EQ FNTYPE 'FNS) - then (printout WINDOW "(" .FONT LAMBDAFONT |.P2| FN .FONT - DEFAULTFONT T)) - (DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION - NIL WINDOW)) + then (printout WINDOW "(" .FONT LAMBDAFONT .P2 FN .FONT + DEFAULTFONT T)) + (DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION NIL + WINDOW)) WINDOW) (PRINTDEF DEF (AND (EQ FNTYPE 'FNS) 2) @@ -291,19 +342,19 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation (if (EQ FNTYPE 'FNS) then (PRIN1 ")" WINDOW))) (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL WINDOW))) - (T (* ; - "set right margin out so wouldn't clip.") + (T (* ; + "set right margin out so wouldn't clip.") (DSPRIGHTMARGIN 5000 WINDOW) (APPLY* (FUNCTION PF*) FN NIL (GETSTREAM WINDOW)) - (DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION - NIL WINDOW)) + (DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION NIL WINDOW + )) WINDOW) BrowserPPWindowWidth))) (T 0]) (PPRESHAPEFN - [LAMBDA (WINDOW) (* lmm "20-Jul-84 15:48") + [LAMBDA (WINDOW) (* lmm "20-Jul-84 15:48") (BROWSEPP (WINDOWPROP WINDOW 'FNBROWSED) WINDOW]) @@ -314,17 +365,18 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation (PROG [(FN (WINDOWPROP WIN 'FNBROWSED)) (EXTENT (WINDOWPROP WIN 'EXTENT] (COND - (FN (RESETLST (RESETSAVE MSPRINTFLG NIL) - (RESETSAVE (OUTPUT WIN)) - (DSPSCROLL 'OFF WIN) - (COND - (EXTENT (MOVETOUPPERLEFT WIN EXTENT))) - (MSDESCRIBE FN]) + (FN (RESETLST + (RESETSAVE MSPRINTFLG NIL) + (RESETSAVE (OUTPUT WIN)) + (DSPSCROLL 'OFF WIN) + (COND + (EXTENT (MOVETOUPPERLEFT WIN EXTENT))) + (MSDESCRIBE FN))]) (BROWSERDESCRIBE [LAMBDA (FN WIN) (* ; "Edited 31-Mar-87 11:15 by jop") - - (* ;; "puts the masterscope DESCRIBE information in the window DS. Keeps tracks of which fn so if it changes the window can be updated.") + + (* ;; "puts the masterscope DESCRIBE information in the window DS. Keeps tracks of which fn so if it changes the window can be updated.") (WINDOWPROP WIN 'FNBROWSED FN) (CLEARW WIN) @@ -337,9 +389,9 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation (DSPYPOSITION NIL WIN]) (BROWSER.MIDDLEFN - [LAMBDA (NODE NWINDOW) (* ; "Edited 25-Mar-94 13:25 by jds") + [LAMBDA (NODE NWINDOW) (* ; "Edited 25-Mar-94 13:25 by jds") (* ; - "called when yellow selection from browser. Call display editor on the function.") + "called when yellow selection from browser. Call display editor on the function.") (COND ((NULL NODE)) [(THIS.PROCESS) (* ; "processes are running.") @@ -352,7 +404,7 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation " " "into the Dedit " "window then selecting 'Edit'.")) (T (ADD.PROCESS `(ED ',(fetch NODELABEL of NODE]) ((SEDIT SEDIT:SEDIT) (* ; - "SEdit doesn't have to worry about this stuff") + "SEdit doesn't have to worry about this stuff") (ED (fetch NODELABEL of NODE) ':DONTWAIT)) (ED (fetch NODELABEL of NODE] @@ -360,8 +412,8 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation (DEDITPROCESSRUNNINGP [LAMBDA NIL (* ; "Edited 31-Mar-87 11:27 by jop") - - (* ;; "is there a dedit process running?") + + (* ;; "is there a dedit process running?") (AND (EQ (EDITMODE) 'DEDIT) @@ -369,73 +421,69 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation (REDRAWBROWSEGRAPH [LAMBDA (WINDOW) (* DECLARATIONS%: (RECORDS BROWSEWIN)) + (* ; "Edited 15-Apr-2023 16:12 by lmm") (* ; "Edited 31-Mar-87 11:24 by jop") - (PROG [(WN (find X in BROWSERWINDOWS suchthat (EQ (fetch (BROWSEWIN WINDOW) - of X) - WINDOW] - (AND WN (APPLY 'NUMSPATHS (fetch (BROWSEWIN ARGS) of WN))) - (* ; "(OR WN (SHOULDNT))") + (PROG [(WN (find X in BROWSERWINDOWS suchthat (EQ (fetch (BROWSEWIN WINDOW) of X) + WINDOW] + (AND WN (APPLY (FUNCTION NUMSPATHS) + (fetch (BROWSEWIN ARGS) of WN))) (* ; "(OR WN (SHOULDNT))") (WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION APPLYTOSELECTEDNODE)) (APPLYTOSELECTEDNODE WINDOW]) (STBROWSER [LAMBDA (GRAPH ARGS) (* DECLARATIONS%: (RECORDS BROWSEWIN)) + (* ; "Edited 25-Apr-2023 21:05 by lmm") (* ; "Edited 31-Mar-87 11:18 by jop") (* ;; "puts a browser graph for the args FROMFN in a window. If a similar graph is already a window, that window is reused; otherwise a new window is created.") - (WINDOWADDPROP (bind TMP for W in BROWSERWINDOWS - when (EQUAL (fetch (PATHSARGS DISCRIMINANT) of ARGS) - (fetch (PATHSARGS DISCRIMINANT) of (fetch - (BROWSEWIN ARGS) - of W))) + (WINDOWADDPROP (bind TMP for W in BROWSERWINDOWS when (EQUAL (fetch (PATHSARGS DISCRIMINANT) + of ARGS) + (fetch (PATHSARGS DISCRIMINANT) + of (fetch (BROWSEWIN ARGS) + of W))) do (replace (BROWSEWIN ARGS) of W with ARGS) - (replace (BROWSEWIN GRAPH) of W with GRAPH) - (SHOWGRAPH GRAPH (SETQ W (fetch (BROWSEWIN WINDOW) of W)) - (FUNCTION BROWSER.LEFTFN) - (FUNCTION BROWSER.MIDDLEFN)) - (RETURN W) + (replace (BROWSEWIN GRAPH) of W with GRAPH) + (SHOWGRAPH GRAPH (SETQ W (fetch (BROWSEWIN WINDOW) of W)) + (FUNCTION BROWSER.LEFTFN) + (FUNCTION BROWSER.MIDDLEFN)) + (RETURN W) finally (SETQ W (SHOWGRAPH GRAPH (CONCAT "PATHS" - (COND - ((SETQ TMP (fetch - (PATHSARGS FROM) - of ARGS)) + (COND + ((SETQ TMP (fetch (PATHSARGS FROM) + of ARGS)) + (CONCAT (COND + ((CADR (CADR TMP)) + " FROM ") + (T " TO ")) + (CADDDR TMP))) + (T "")) + (COND + ((SETQ TMP (fetch (PATHSARGS TO) + of ARGS)) (* ; - "CADDDR here gets the thing that looks like it might be a function name.") - (CONCAT (COND - ((CADR (CADR TMP)) - " FROM ") - (T " TO ")) - (CADDDR TMP))) - (T "")) - (COND - ((SETQ TMP (fetch - (PATHSARGS TO) - of ARGS)) - (* ; - "CADDDR here gets the thing that looks like it might be a function name.") - (CONCAT (COND - ((CADR (CADR TMP)) - " FROM ") - (T " TO ")) - (CADDDR TMP))) - (T ""))) - (FUNCTION BROWSER.LEFTFN) - (FUNCTION BROWSER.MIDDLEFN))) + "CADDDR here gets the thing that looks like it might be a function name.") + (CONCAT (COND + ((CADR (CADR TMP)) + " FROM ") + (T " TO ")) + (CADDDR TMP))) + (T ""))) + (FUNCTION BROWSER.LEFTFN) + (FUNCTION BROWSER.MIDDLEFN))) (push BROWSERWINDOWS - (create BROWSEWIN - ARGS _ ARGS - GRAPH _ GRAPH - WINDOW _ W)) + (create BROWSEWIN + ARGS _ ARGS + GRAPH _ GRAPH + WINDOW _ W)) (RETURN W)) 'CLOSEFN (FUNCTION (LAMBDA (WINDOW) (* ; - "The closing function for browser windows. removes it from BROWSERWINDOWS") + "The closing function for browser windows. removes it from BROWSERWINDOWS") (SETQ BROWSERWINDOWS (DREMOVE (for X in BROWSERWINDOWS when (EQ (fetch (BROWSEWIN WINDOW) - of X) - WINDOW) - do (RETURN X)) + of X) + WINDOW) do (RETURN X)) BROWSERWINDOWS]) ) (DECLARE%: DONTCOPY @@ -457,41 +505,49 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation ) ) -(RPAQQ BROWSERBOXING NIL) +(RPAQ? BROWSER T) -(RPAQQ BROWSERFORMAT NIL) +(RPAQ? BROWSERBOXING ) -(RPAQQ BROWSERWINDOWS NIL) +(RPAQ? BROWSERFORMAT ) -(RPAQQ NODESELECTIONWINDOW NIL) +(RPAQ? BROWSERWINDOWS ) -(RPAQQ PFWINDOW NIL) +(RPAQ? NODESELECTIONWINDOW ) -(RPAQQ BROWSER.DESCRIBE.WINDOW NIL) +(RPAQ? PFWINDOW ) -(RPAQQ BrowserPPWindowWidth 750) +(RPAQ? BROWSER.DESCRIBE.WINDOW ) -(RPAQQ BROWSERFONT (GACHA 8)) +(RPAQ? BrowserPPWindowWidth 750) -(MOVD? 'MSPATHS 'OLDMSPATHS) +(RPAQ? BROWSERMAX 10) + +(RPAQ? BROWSERFONT '(GACHA 8)) (MOVD? 'NILL 'MODERNWINDOW) -[PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED] - (OR (MEMB 'BROWSER.WHENFNSCHANGED WC) - (FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC] +(RPAQQ BROWSER.BORDERS + ((NORMAL "Normal" 2 -1) + (GHOST "Shown elsewhere" 2 8840) + (RECURSIVEGHOST "End of recursive chain" 2 0 -1) + (MERGED "Includes other branches" 4 42405) + (SELFRECURSIVE "Includes self-recursive calls" 2 61375) + (RECURSIVE "Head of recursive chain" 4 28086) + (ENDOFLINE "exceeded depth limit" 6 64510))) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS BROWSER.BORDERS BROWSERWINDOWS) +) (DECLARE%: DONTEVAL@LOAD DOCOPY -(SELECTQ (SYSTEMTYPE) - (D (BROWSER T)) - NIL) +(BROWSER T) ) -(PUTPROPS BROWSER COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1987 1988 1990 1993 1994)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2054 25148 (NUMSPATHS 2064 . 5246) (BROWSER 5248 . 5511) (BROWSER.WHENFNSCHANGED 5513 - . 7812) (BRPATHS1 7814 . 10080) (BROWSER.LEFTFN 10082 . 10940) (GET.BROWSE.PP.WINDOW 10942 . 11767) ( -GET.BROWSE.DESCRIBE.WINDOW 11769 . 12517) (BROWSEPP 12519 . 13393) (PPREPAINTFN 13395 . 16529) ( -PPRESHAPEFN 16531 . 16711) (DESCRIBEREPAINTFN 16713 . 17409) (BROWSERDESCRIBE 17411 . 18169) ( -BROWSER.MIDDLEFN 18171 . 19478) (DEDITPROCESSRUNNINGP 19480 . 19751) (REDRAWBROWSEGRAPH 19753 . 20516) - (STBROWSER 20518 . 25146))))) + (FILEMAP (NIL (2085 28437 (MSPATHS.DISPATCH 2095 . 2569) (NUMSPATHS 2571 . 6158) (BROWSER 6160 . 6731) + (BROWSER.WHENFNSCHANGED 6733 . 8518) (BRPATHS1 8520 . 11171) (BROWSER.LEFTFN 11173 . 14599) ( +GET.BROWSE.PP.WINDOW 14601 . 15426) (GET.BROWSE.DESCRIBE.WINDOW 15428 . 16176) (BROWSEPP 16178 . 17052 +) (PPREPAINTFN 17054 . 20180) (PPRESHAPEFN 20182 . 20358) (DESCRIBEREPAINTFN 20360 . 21064) ( +BROWSERDESCRIBE 21066 . 21808) (BROWSER.MIDDLEFN 21810 . 23125) (DEDITPROCESSRUNNINGP 23127 . 23382) ( +REDRAWBROWSEGRAPH 23384 . 24148) (STBROWSER 24150 . 28435))))) STOP diff --git a/library/BROWSER.LCOM b/library/BROWSER.LCOM index bdffbde2..d242ec04 100644 Binary files a/library/BROWSER.LCOM and b/library/BROWSER.LCOM differ diff --git a/library/BROWSER.TEDIT b/library/BROWSER.TEDIT new file mode 100644 index 00000000..a9d492a7 Binary files /dev/null and b/library/BROWSER.TEDIT differ diff --git a/library/CENTRONICS.TEDIT b/library/CENTRONICS.TEDIT new file mode 100644 index 00000000..f9a46a4f Binary files /dev/null and b/library/CENTRONICS.TEDIT differ diff --git a/library/CHARCODETABLES.TEDIT b/library/CHARCODETABLES.TEDIT new file mode 100644 index 00000000..6edbd364 Binary files /dev/null and b/library/CHARCODETABLES.TEDIT differ diff --git a/library/CHAT.TEDIT b/library/CHAT.TEDIT new file mode 100644 index 00000000..279b2ef7 --- /dev/null +++ b/library/CHAT.TEDIT @@ -0,0 +1,107 @@ +1 Lisp Library Modules, Medley Release 1.15, CHAT 1 Lisp Library Modules, Medley Release 1.15, CHAT CHAT 1 CHAT 1 CHAT 6 Chat(CHAT NIL Chat NIL NIL 21) is a remote terminal facility that allows you to communicate with other machines while inside Lisp. Chat sets up a Chat connection to a remote machine, so that everything you type is sent to the remote machine, and everything the remote machine prints is displayed in a Chat window. Chat is an extensible terminal emulation facility. Its core supplies both terminal- and network-protocol- independent functionality; new terminal types and new Chat protocols, based on this core, can be added to Chat at any time. You can choose any terminal type to be used with any network protocol type. There are currently terminal emulators for the following terminals: Datamedia 2500(DATAMEDIA% 2500 NIL Datamedia% 2500 NIL NIL 21) DEC VT100(DIGITAL% VT100 NIL Digital% VT100 NIL NIL 21) TEdit(TEDIT NIL TEdit NIL NIL 21) (this is actually a TEdit-based Chat window, supporting scrolling and copy-select operations as in standard TEdit). A number of different network protocol interfaces can be used with Chat. The following protocols are available: PUP Chat NS Chat (using the GAP protocol) TCP (ARPANET) TELNET RS232 Chat (using either the RS232 or TTY ports of the 1108 and 1186 processors) Each of these is available by loading the corresponding module. Requirements 1 DMCHAT CHATTERMINAL One of the network protocols:(NETWORK% PROTOCOLS NIL network% protocols NIL NIL 21) PUPCHAT or NSCHAT or RS232CHAT or TTYCHAT or TCPCHAT. One of the terminal emulators:(TERMINAL% EMULATORS NIL terminal% emulators NIL NIL 21) DMCHAT or VTCHAT or TEDITCHAT. The applicable file dependencies enumerated in the Introduction of this manual. Installation 1 Load CHAT.LCOM from the library. In addition, you must load at least one of the Chat network protocol modules. If you want a terminal emulator different from the default DM2500, you must also load it. User Interface 1 Chat prompts for a new window for each new connection. It saves the first window to reuse once the connection in that window is closed (other windows just go away when their connections are closed). Multiple, simultaneous Chat connections(CHAT% CONNECTIONS NIL Chat% connections NIL NIL 22) are possible. To switch between typing to different Chat connections, press the left button within the Chat window you want to use. Opening a Chat Connection(OPENING% A% CHAT% CONNECTION NIL Opening% a% Chat% Connection NIL NIL 22) The simplest way to open a Chat connection is to select the CHAT option of the right-button (background) menu. The first time you do this, you are prompted in the system's prompt window for the name of a host to which to connect. Subsequently, you are prompted with a menu of all hosts to which you have opened Chat connections; the last entry in this menu is OTHER, and provides a way for you to connect to new Chat hosts. The other method of opening a Chat connection is to call the CHAT function directly: (CHAT(CHAT (function) NIL NIL NIL 22) HOST LOGOPTION INITSTREAM WINDOW) [Function] Opens a Chat connection to HOST, or to the value of DEFAULTCHATHOST(DEFAULTCHATHOST (variable) NIL NIL NIL 22). If HOST requires login, Chat supplies a login sequence. You may alternatively specify one of the following values for LOGOPTION: Login Always perform a login. Attach Always perform an attach (this is likely to be useful only when opening Chat connections to hosts running the Tops-20 or Tenex operating systems). This fails if you do not have exactly one detached job. None Do not attempt to log in or attach. Note: It is important that you supply information about the types of hosts to which you chat by setting the variable NETWORKOSTYPES (see IRM) or DEFAULT.OSTYPE (see Lisp Release Notes), as CHAT uses that information to determine whether and how to log in. An incorrect login sequence can inadvertantly expose your password. If INITSTREAM is supplied, it is either a string or the name of a file whose contents are read as type-in. When the string/file is exhausted, input is taken from the keyboard. If WINDOW is supplied, it is the window to use for the connection; otherwise, you are prompted for a window. While Chat is in control, all Lisp interrupts(LISP% INTERRUPTS NIL Lisp% interrupts NIL NIL 22) are turned off, so that control characters can be transmitted to the remote host. Chat does not turn off interrupt characters until after creating the Chat window, so you can abort the call to Chat by typing Control-E while specifying the Chat window region. If you press the left button in an Executive window, the system's focus-of-attention is switched to that window. At the same time, keyboard interrupts, such as Control-E, are reenabled. Whenever you select an open Chat window, the focus-of-attention is returned to the Chat window, and keyboard interrupts are disabled. Chat Menu(CHAT% MENU NIL Chat% Menu NIL NIL 23) Commands can be given to an active Chat connection by pressing the middle mouse button in the Chat window to get a command menu. Note: The left mouse button, when pressed inside an active Chat window, holds output as long as the button is down. Holding down the middle button coincidentally does this too, but not on purpose; since the menu handler does not yield control to other processes, it is possible to kill the connection by keeping the menu up too long. CLOSE Closes this connection. Once the connection is closed, control is handed over to the main Lisp Executive window. Closes the Chat window unless it is the primary Chat window. SUSPEND Same as CLOSE, but always leaves the window open. NEW Closes the current connection and prompts for a new host to which to open a connection in the same window. FREEZE Holds type-out from this Chat window. Pressing a mouse button in the window in any way releases the hold. This is most useful if you want to switch to another, overlapping window and there is type-out in this window that would compete for screen space. DRIBBLE Opens a typescript file for this Chat connection (closing any previous dribble file for the window). You are prompted for a file name. If you want to close an open dribble file (without opening a new one), just type a carriage return. INPUT Prompts for a file from which to take input. When the end of the file is reached, input reverts to the keyboard. CLEAR Clears the window and resets the simulated terminal to its default state. This is useful if undesired terminal commands have been received from the remote host that place the simulated terminal into an indeterminate state. EMACS Turns on or off the Chat EMACS feature, which provides a convenient way to use the workstation's mouse to move the cursor on the remote machine when using the EMACS text editor. When this feature is turned on, pressing the left mouse button in the Chat window causes a sequence of commands to be sent to the remote machine that cause EMACS to move its cursor to the mouse location. Use of this feature assumes you know the keystrokes to perform cursor-moving commands; see CHAT.EMACSCOMMANDS if your EMACS does not use the standard ones. Also, it assumes that you are pointing where there is actually text in your document (not white space beyond the end of a line) and that there are no tabs in your text; otherwise, the cursor position may not be where you expect. RECONNECT In an inactive Chat window, pressing the middle mouse button brings up a menu of one item, RECONNECT, whose selection reopens a connection to the same host as was last in the window. This is the primary motivation for the SUSPEND menu command. MODE The Chat menu also contains a command of this form for each terminal emulator that you have loaded. The MODE commands are intended to let you dynamically switch between terminal emulators. However, this feature is currently defective and should not be used. You must also choose your emulator type, by setting CHAT.DISPLAYTYPES, before opening the Chat connection. Customizing Chat(CUSTOMIZING% CHAT NIL Customizing% Chat NIL NIL 24) 1 CHAT.DISPLAYTYPES(CHAT.DISPLAYTYPES (variable) NIL NIL NIL 24) [Variable] This variable contains a list that assigns the terminal emulators to be used with the hosts. Each entry on the list is of the form: () HostName When Chat opens a connection, it scans CHAT.DISPLAYTYPES to find an entry whose HostName field matches the name of the Chat host. If no matching entry is found, it scans the list again, looking for an entry whose HostName field is NIL. TerminalTypeNumber Is only important when the Chat protocol in use is PUP Chat. This number identifies the terminal type to the Chat host's operating system. Currently, only Tops-20 and Tenex hosts make use of this facility; if the Chat host does not support this feature, the number in the TerminalTypeNumber field is ignored. TerminalEmulator Chat uses this field of the entry it finds to choose which terminal type to emulate. Typical terminal emulator names are DM2500, VT100, and TEDIT. CHAT.KEYACTIONS(CHAT.KEYACTIONS (variable) NIL NIL NIL 24) [Variable] This variable controls the remapping of the keyboard when the system's focus-of-attention is an active Chat window. The format of this list is: ((KEYNAME . ACTIONS) (KEYNAME . ACTIONS) ... ) For example, if you prefer the backspace key to send the rubout character (octal 177), you would set CHAT.KEYACTIONS to be: ((BS (177Q 177Q NOLOCKSHIFT) . IGNORE)) The key actions are assigned when a Chat process is initiated; i.e., changing CHAT.KEYACTIONS only affects new Chat connections. CHAT.INTERRUPTS(CHAT.INTERRUPTS (variable) NIL NIL NIL 24) [Variable] A list of interrupts to pass to INTERRUPTCHAR to assign keyboard interrupts; e.g., ((177Q. HELP)) causes the DELETE character (code 177) to run the HELP interrupt. Like CHAT.KEYACTIONS, this variable only affects new Chat connections. CHAT.ALLHOSTS(CHAT.ALLHOSTS (variable) NIL NIL NIL 25) [Variable] A list of host names, as uppercase symbols, to which you want to chat. Chatting to a host not on the list adds it to the list. These names are placed in the menu used by the background Chat command prompts. CLOSECHATWINDOWFLG(CLOSECHATWINDOWFLG (variable) NIL NIL NIL 25) [Variable] If true, every Chat window is closed on exit. If NIL, the initial setting, then the primary Chat window is not closed. DEFAULTCHATHOST(DEFAULTCHATHOST (variable) NIL NIL NIL 25) [Variable] The host to which CHAT connects when it is called with no HOST argument. CHAT.FONT(CHAT.FONT (variable) NIL NIL NIL 25) [Variable] If non-NIL, the font used to create Chat windows. If CHAT.FONT is NIL, Chat windows are created with (DEFAULTFONT 'DISPLAY). Note: To work well with the DM2500 and VT100 terminal emulators, you should use fixed$width fonts (e.g., Gacha or Terminal). CHAT.WINDOW.SIZE(CHAT.WINDOW.SIZE (variable) NIL NIL NIL 25) [Variable] This variable is either NIL or a dotted pair of (WIDTH . HEIGHT). The value of the WIDTH field indicates the desired width of the Chat window, in pixels. The value of the HEIGHT field indicates the desired HEIGHT of the window, also in pixels. Note: Before a new value of CHAT.WINDOW.SIZE is used, CHAT.WINDOW must be set to NIL or NOBIND. If CHAT.WINDOW.SIZE is changed after chat has already been called, and chat is then called, the window is not changed because the information is cached. CHAT.WINDOW must be set to NIL and the window recreated anew before this takes place. CHAT.WINDOW.REGION(CHAT.WINDOW.REGION (variable) NIL NIL NIL 25) [Variable] This variable is either NIL or an instance of a REGION. When CHAT.WINDOW.REGION is non-NIL, its value is used as the region in which to create the first Chat window. Subsequent windows are created by prompting for the position of a window of CHAT.WINDOW.SIZE dimensions, or, if that variable is NIL, for an arbitrary window region. CHAT.TTY.PROCESS(CHAT.TTY.PROCESS (variable) NIL NIL NIL 25) [Variable] When you start up CHAT, it takes the TTY immediately if the value is T. (The initial value is T.) CHAT.EMACSCOMMANDS(CHAT.EMACSCOMMANDS (variable) NIL NIL NIL 25) [Variable] A list of five character codes; initially the value of (CHARCODE (^U ^P ^N ^F ^A)). These character codes are used by the EMACS Argument command in changing the position of the cursor: Up one line Down one line Forward one character Backward one character Beginning of line CHAT.IN.EMACS?(CHAT.IN.EMACS? (variable) NIL NIL NIL 26) [Variable] The initial state of the EMACS feature when a Chat connection is started. Initially NIL, meaning the feature is off. CHAT.PROTOCOLTYPES(CHAT.PROTOCOLTYPES (variable) NIL NIL NIL 26) [Variable] Each Chat emulator (TTYCHAT, RS232CHAT, PUPCHAT ...) adds an entry onto CHAT.PROTOCOLTYPES which recognizes host names for the appropriate protocol. For example, loading PUPCHAT adds an entry (PUP . PUPCHAT.HOST.FILTER) and TCPCHAT adds an entry (TCP . TCP.HOST.FILTER). Site administrators of complex networks may want to reorganize these entries when there are hosts which are running multiple servers, each running different protocols. Network Protocols(NETWORK% PROTOCOLS NIL Network% Protocols NIL NIL 26) 1 For the most part, you should not notice too many differences in the behavior of Chat when using one network protocol versus another. The following are unique features of each of the Chat network protocols. PUP Chat(PUP% CHAT NIL PUP% Chat NIL NIL 26) PUP Chat is in the file PUPCHAT.LCOM. Implementations of PUP Chat servers exist for Tops-20, Tenex, VAX/UNIX, and VAX/VMS operating systems. The PUP Chat protocol contains provisions for automatically setting your terminal type, width, and height whenever you establish a connection or reshape your Chat window. NS Chat(NS% CHAT NIL NS% Chat NIL NIL 26) The NS Chat protocol (also known as GAP, or Gateway Access Protocol(GATEWAY% ACCESS% PROTOCOL NIL Gateway% Access% Protocol NIL NIL 26)) is used to communicate with hosts running GapTelnet(GAPTELNET NIL GapTelnet NIL NIL 26) service, including VAX/UNIX and the VAX/VMS service XNS/DEC VAX, and also with Xerox 8000-series network services such as 8040 print servers or 8030 file servers. This protocol is contained on the file NSCHAT.LCOM. The NS Chat protocol differentiates among a number of virtual terminal services. When you chat to an NS host, the NS Chat module queries the Clearinghouse(CLEARINGHOUSE NIL Clearinghouse NIL NIL 26) for information about the specified host. This information permits the NS Chat module to determine which of the following virtual terminal services are appropriate for the host. The NS Chat module uses a small set of heuristics to choose which virtual terminal service to invoke, based on information returned by the Clearinghouse. If the Clearinghouse information indicates that only one service type is possible, NS Chat opens a connection to the Chat host and invokes the proper virtual terminal service. If the Clearinghouse returns information indicating that more than one virtual terminal service is supported by the specified host, you are prompted to choose a service from a menu of the possible service types. If NS Chat guesses an incorrect service type, or you choose an incorrect service type, you are prompted to choose a service from a menu of all known virtual service types. If this fails, NS Chat abandons its attempts to connect to the specified host. Remote System Administration(REMOTE% SYSTEM% ADMINISTRATION NIL Remote% System% Administration NIL NIL 27) This service lets you log onto print servers and clearinghouse servers, and issue appropriate commands. NS Chat automatically chooses this service when the specified host is registered in the Clearinghouse as any type of server machine. Remote System Executive(REMOTE% SYSTEM% EXECUTIVE NIL Remote% System% Executive NIL NIL 27) This service is currently supported by VAX/VMS systems running XNS/DEC VAX, by UNIX systems running GapTelnet service, by Lisp workstations running CHATSERVER from the library, and by XDE workstations. Interactive Terminal Service(INTERACTIVE% TERMINAL% SERVICE NIL Interactive% Terminal% Service NIL NIL 27) The ITS is a TTY-based interface to NS mail. External Communication Service(EXTERNAL% COMMUNICATION% SERVICE NIL External% Communication% Service NIL NIL 27) The External Communication Service (ECS) enables Chat connections to external hosts accessible only by use of a modem. When you open a Chat connection to an ECS, you are prompted for a telephone number; the ECS dials that number and completes the connection if a compatible modem answers. ECS hosts typically support a variety of modem connection characteristics (specific combinations of parity, character length, baud rate, and flow control settings). Each connection type is known by a different Chat host name; check with your system administrator to determine the Chat host name you should use to connect to a particular external host. TCP Chat(TCP% CHAT NIL TCP% Chat NIL NIL 27) TCPCHAT.LCOM is the interface to the TCP-based TELNET protocol, which is the protocol in use throughout the ARPANET. It loads and initializes the TCP-IP module, if necessary. Read the TCP-IP module in this manual for more information. RS232 Chat(RS232% CHAT NIL RS232% Chat NIL NIL 27) RS232 Chat is contained on the files RS232CHAT.LCOM and TTYCHAT.LCOM. RS232 Chat enables use of the 1108, 1185, and 1186 RS232 ports; TTY Chat enables use of the 1108, 1185, and 1186 TTY ports. Read the RS232 module in this manual for more information. Terminal Emulators 1 DM2500 Chat(DM2500% CHAT NIL DM2500% Chat NIL NIL 27) The Datamedia 2500 terminal emulator is contained in DMCHAT.LCOM. To use it, load DMCHAT.LCOM and add entries to CHAT.DISPLAYTYPES in the form: ( DM2500) VT100 Chat(VT100% CHAT NIL VT100% Chat NIL NIL 28) The VT100 emulator is contained in VTCHAT. To use it, load VTCHAT.DFASL and add entries to CHAT.DISPLAYTYPES in the form: ( VT100) Currently, the VT100 emulator does not emulate the following features of the actual Digital VT100 terminal: Dual-width or dual-height characters Graphics character set Remotely initiated switching between 80- and 132-column mode TEdit Chat(TEDIT% CHAT NIL TEdit% Chat NIL NIL 28) TEdit Chat supplies a glass TTY terminal emulator with a TEdit stream storing all characters received during the Chat session. As a result, you can scroll back and forth through a transcript of your session, and you can use the standard TEdit copy-select command to copy blocks of characters from the Chat window to another TEdit window, a Lisp Executive, etc. To use TEdit Chat, load TEDITCHAT.LCOM, and add entries to CHAT.DISPLAYTYPES in the form: ( TEDIT) Note that since TEdit already uses the middle mouse button, you must click in the window's title bar in order to get the usual Chat menu. [This page intentionally left blank] (LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "" "") STARTINGPAGE# 21) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (TEXT NIL NIL (54 54 504 702) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (54 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE RECTOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL)))))&-$$T-HHT3HH +T6T5.$$TT-T,,5H2Hll52ll2l,,,ll2,,$$ +,HH,$$2HH +2$$l2HH +l2lll2HHl,HH,HH +3T22-T-TF PAGEHEADING VERSOHEADF PAGEHEADING RECTOHEADE PAGEHEADINGFOOTINGVE PAGEHEADINGFOOTINGR HELVETICA HELVETICA +TITAN TITAN +CLASSIC +CLASSIC + HELVETICA  HELVETICAMODERN +MODERN +MODERNMODERNMODERN +MODERN & HRULE.GETFNTITAN +&/% HRULE.GETFNTITAN +%0$$ HRULE.GETFNTITAN +## HRULE.GETFNTITAN + HRULE.GETFNMODERN IM.INDEX.GETFN5E0IM.INDEX.GETFN +.IM.INDEX.GETFNIM.INDEX.GETFNwr "R@  HRULE.GETFNMODERN  6IM.INDEX.GETFN78IM.INDEX.GETFN"O   HRULE.GETFNMODERN  OY  HRULE.GETFNMODERN '4IM.INDEX.GETFNJIM.INDEX.GETFN<*;= IM.INDEX.GETFNMODERN +    +IM.INDEX.GETFNMODERN + + 3=   + + + + + + + + +$ t +  + + +   b -2IM.INDEX.GETFNB &IM.INDEX.GETFN P   + +$ + + +k + + + +  r + + + +] + +Z + { +  + + +g + +P +z$ + 4IM.INDEX.GETFN HRULE.GETFNMODERN -IM.INDEX.GETFNMODERN +   4  + +& + + +  +8  + + ++IM.INDEX.GETFNMODERN +   0 d   * N #+IM.INDEX.GETFNMODERN + +  ! &D 3 )IM.INDEX.GETFNMODERN + +  .IM.INDEX.GETFNMODERN +  2C+IM.INDEX.GETFNMODERN + + +  %  %IM.INDEX.GETFNMODERN + +  6   UQ,IM.INDEX.GETFNMODERN + +   T  + +   + + + + + +  + +7.IM.INDEX.GETFNMODERN +     LK + +$",IM.INDEX.GETFNMODERN + + /   .IM.INDEX.GETFNMODERN + + 6  &: *IM.INDEX.GETFNMODERN + + T  .IM.INDEX.GETFNMODERN +  +H<,6IM.INDEX.GETFN HRULE.GETFNMODERN $IM.INDEX.GETFN "IM.INDEX.GETFNCDIM.INDEX.GETFN5$IM.INDEX.GETFN ,IM.INDEX.GETFNKNIM.INDEX.GETFN DIM.INDEX.GETFN  +,NIM.INDEX.GETFN -RIM.INDEX.GETFN "a$IM.INDEX.GETFN  +(IM.INDEX.GETFN%    HRULE.GETFNMODERN  *IM.INDEX.GETFN5  ) +(IM.INDEX.GETFN= )l%= +(IM.INDEX.GETFNn)"%! +!Kz \ No newline at end of file diff --git a/library/CLIPBOARD.TEDIT b/library/CLIPBOARD.TEDIT new file mode 100644 index 00000000..47123a52 Binary files /dev/null and b/library/CLIPBOARD.TEDIT differ diff --git a/library/CMLFLOATARRAY.TEDIT b/library/CMLFLOATARRAY.TEDIT new file mode 100644 index 00000000..ab11f077 Binary files /dev/null and b/library/CMLFLOATARRAY.TEDIT differ diff --git a/library/COLOR1.TEDIT b/library/COLOR1.TEDIT new file mode 100644 index 00000000..061cc10c Binary files /dev/null and b/library/COLOR1.TEDIT differ diff --git a/library/COLOR2.TEDIT b/library/COLOR2.TEDIT new file mode 100644 index 00000000..2a80139e --- /dev/null +++ b/library/COLOR2.TEDIT @@ -0,0 +1,236 @@ +1 KALEIDOSCOPE MANUAL - 16-JAN-89 - Dev. Draft 1 KALEIDOSCOPE MANUAL - 16-JAN-89 - Dev. Draft COLOR 1 ENVOS KALEIDOSCOPE 1 COLOR 6 2 Introduction 1 This document describes software for driving color displays. In order to run COLOR, you need either a Sun (3 or 4) with CG4 color hardware and display, a Dorado (Xerox 1132) with attached color display, or a Dandelion (Xerox 1108) with attached BusMaster and color display. The color software which is distributed among a number of files can be divided into a machine independent group of files that all users can usefully load and a machine dependent group containing files that work for particular combinations of hardware. The machine independent color graphics code is stored in the library files LLCOLOR.LCOM and COLOR.LCOM. LOADing COLOR.LCOM causes LLCOLOR.LCOM to be LOADed. The machine dependent portions of Xerox Lisp color software is stored in files such as MAIKOCOLOR.LCOM, DORADOCOLOR.LCOM, or COLORNNCC.LCOM. The user LOADs one of these files according to what kind of machine and color card the user is using. The Sun color driver resides in the file MAIKOCOLOR.LCOM which loads LLCOLOR.LCOM and COLOR.LCOM. The CG4 device suppports 8 bpp at 1152 by 900 resolution. The user must be running ldecolor, the special color capable emulator. The physical display monitor is shared by both the monochrome and color screens (described below) . The Dorado color driver resides in the file DORADOCOLOR.LCOM which loads LLCOLOR.LCOM and COLOR.LCOM. The Dorado color board supports four or eight bits per pixel (bpp) at 640 by 480 resolution. (The board supports 24 bpp also, but Xerox Lisp doesn't yet.) The Dandelion color drivers reside in the files DANDELIONUFO.LCOM, DANDELIONUFO4096.LCOM, and COLORNNCC.LCOM, one package for each of three different kinds of boards. The user should load one of these packages on a Dandelion attached to a BusMaster and color display. The DANDELIONUFO and DANDELIONUFO4096 packages drive 4 bpp at 640 by 400 resolution color boards used inside Xerox which have been made obsolete by COLORNNCC. The COLORNNCC package drives an 8 bpp color at 512 by 480 resolution board, the Revolution 512 x 8, made by Number Nine Computer Corporation. The Revolution 512 x 8 is available both inside and outside Xerox through Number Nine. 2 Hardware Displays and Software Screens 1 On some workstations (such as the Dorado and Dandelion), there may be physically two separate displays. On most Suns, there is a single physical display, which additionally may be shared by two Unix devices. One device is monochrome (b/w), and the other is color. To support the various hardware configurations and external display devices, the software has a special datatype, a "screen". There are two distinct instances of screens, a b/w screen, and a color screen. A screen represents and controls a physical hardware display, and contains windows, icons, and tracks the mouse. On workstations with physically two separate hardware displays, each display is represented by a corresponding screen data structure. On workstations with a single hardware display, the display is shared by both the b/w screen and the color screen. In all cases, before initialization only the b/w screen (and thus display) is visible and active. After initialization both screens are active (can contain screen images), although on single displays, only one screen is visible at a time. Since each screen logically controls a display, we will henceforth use the terms "screen" and "display" interchangeably. Screens are discussed in greater detail below. 2 Turning the Color Display Software On and Off 1 The color display software can be turned on and off. While the color display software is on, the memory used for the color display screen bitmap is locked down, and a small amount of processing time is used to drive the color display. (COLORDISPLAYP) [Function] returns T if the color display is on; otherwise it returns NIL. (COLORDISPLAYONOFF TYPE) [Function] turns off the color display if ONOFF is 'OFF. If ONOFF is 'ON, it turns on the color display allocating memory for the color screen bitmap. TYPE should be one of 'MAIKOCOLOR, 'DORADOCOLOR, 'DANDELIONUFO, 'DANDELIONUFO4096, or 'COLORNNCC. The usual sequence of events for the user is to LOAD the software needed to drive a particular color card and then to call COLORDISPLAY with the appropriate TYPE to turn the software on. For example, (LOAD 'COLOR.LCOM) (LOAD 'COLORNNCC.LCOM) (COLORDISPLAY 'ON 'REV512X8) will turn on the software needed to drive the Number Nine Computer Corporation's Revolution 512 x 8 card with 1108 and BusMaster. Besides initializing or reinitializing a color card that has been powered off, COLORDISPLAY allocates memory for the color screen bitmap. Turning on the color display requires allocating and locking down the memory necessary to hold the color display screen bitmap. Turning off the color display frees this memory. 2 Colors 1 The number of bits per pixel determines the number of different colors that can be displayed at one time. When there are 4 bpp, 16 colors can be displayed at once. When there are 8 bpp, 256 colors can be displayed at once. A table called a color map determines what color actually appears for each pixel value. A color map gives the color in terms of how much of the three primary colors (red, green, and blue) is displayed on the screen for each possible pixel value. A color can be represented as a number, an atom, or a triple of numbers. Colors are ultimately given their final interpretation into how much red, blue, and green they represent through a color map. A color map maps a color number ([0 . . . 2nbits-1]) into the intensities of the three color guns (primary colors red, green, and blue). Each entry in the color map has eight bits for each of the primary colors, allowing 256 levels per primary or 224 possible colors (not all of which are distinct to the human eye). Within Xerox Lisp programs, colors can be manipulated as numbers, red-green-blue triples, names, or hue-lightness-saturation triples. Any function that takes a color accepts any of the different representations. If a number is given, it is the color number used in the operation. It must be valid for the color bitmap used in the operation. (Since all of the routines that use a color need to determine its number, it is fastest to use numbers for colors. COLORNUMBERP, described below, provides a way to translate into numbers from the other representations.) Red Green Blue Triples 1 A red green blue (RGB) triple is a list of three numbers between 0 and 255. The first element gives the intensity for red, the second for green, and the third for blue. When an RGB triple is used, the current color map is searched to find the color with the correct intensities. If none is found, an error is generated. (That is, no attempt is made by the system to assign color numbers to intensities automatically.) An example of an RGB triple is (255 255 255), which gives the color white. RGB [Record] is a record that is defined as (RED GREEN BLUE); it can be used to manipulate RGB triples. COLORNAMES [Association list] maps names into colors. The CDR of the color name's entry is used as the color corresponding to the color name. This can be any of the other representations. (Note: It can even be another color name. Loops in the name space such as would be caused by putting '(RED . CRIMSON) and '(CRIMSON . RED) on COLORNAMES are not checked for by the system.) Some color names are available in the initial system and are intended to allow color programs written by different users to coexist. These are: Name RGB Number in default color maps BLACK (0 0 0) 15 255 BLUE (0 0 255) 14 252 GREEN (0 255 0) 13 227 CYAN (0 255 255) 12 224 RED (255 0 0) 3 31 MAGENTA (255 0 255) 2 28 YELLOW (255 255 0) 1 3 WHITE (255 255 255) 0 0 Hue Lightness Saturation Triples 1 A hue lightness saturation triple is a list of three numbers. The first number (HUE) is an integer between 0 and 355 and indicates a position in degrees on a color wheel (blue at 0, red at 120, and green at 240). The second (LIGHTNESS) is a real number between zero and one that indicates how much total intensity is in the color. The third (SATURATION) is a real number between zero and one that indicates how disparate the three primary levels are. HLS [Record] is a record defined as (HUE LIGHTNESS SATURATION); it is provided to manipulate HLS triples. Example: the color blue is represented in HLS notation by (0 .5 1.0). (COLORNUMBERP COLOR BITSPERPIXEL NOERRFLG) [Function] returns the color number (offset into the screen color map) of COLOR. COLOR is one of the following: A positive number less than the maximum number of colors, A color name, AN RGB triple, or An HLS triple. If COLOR is one of the above and is found in the screen color map, its color number in the screen color map is returned. If not, an error is generated unless NOERRFLG is non-NIL, in which case NIL is returned. (RGBP X) [Function] returns X if X is an RGB triple; NIL otherwise. (HLSP X) [Function] returns X if X is an HLS triple; NIL otherwise. 2 Color Maps 1 The screen color map holds the information about what color is displayed on the color screen for each pixel value in the color screen bitmap. The values in the current screen color map may be changed, and this change is reflected in the colors displayed at the next vertical retrace (approximately 1/30 of a second). The color map can be changed to obtain dramatic effects. (SCREENCOLORMAP NEWCOLORMAP) [Function] reads and sets the color map that is used by the color display. If NEWCOLORMAP is non-NIL, it should be a color map, and SCREENCOLORMAP sets the system color map to be that color map. The value returned is the value of the screen color map before SCREENCOLORMAP was called. If NEWCOLORMAP is NIL, the current screen color map is returned without change. (CMYCOLORMAP CYANBITS MAGENTABITS YELLOWBITS BITSPERPIXEL) [Function] Returns a color map that assumes the BITSPERPIXEL bits are to be treated as three separate color planes with CYANBITS bits being in the cyan plane, MAGENTABITS bits being in the magenta plane, and YELLOWBITS bits being in the yellow plane. Within each plane, the colors are uniformly distributed over the intensity range 0 to 255. White is 0 and black is 255. (RGBCOLORMAP REDBITS GREENBITS BLUEBITS BITSPERPIXEL) [Function] Returns a color map that assumes the BITSPERPIXEL bits are to be treated as three separate color planes with REDBITS bits being in the red plane, GREENBITS bits being in the green plane, and BLUEBITS bits being in the blue plane. Within each plane, the colors are uniformly distributed over the intensity range 0 to 255. White is 255 and black is 0. (GRAYCOLORMAP BITSPERPIXEL) [Function] Returns a color map containing shades of gray. White is 0 and black is 255. (COLORMAPCREATE INTENSITIES BITSPERPIXEL) [Function] creates a color map for a screen that has BITSPERPIXEL bits per pixel. If BITSPERPIXEL is NIL, the number of bits per pixel is taken from the current color display setting. INTENSITIES specifies the initial colors that should be in the map. If INTENSITIES is not NIL, it should be a list of color specifications other than color numbers, e.g., the list of RGB triples returned by the function INTENSITIESFROMCOLOR MAP. (INTENSITIESFROMCOLORMAP COLORMAP) [Function] returns a list of the intensity levels of COLORMAP (default is (SCREENCOLORMAP)) in a form accepted by COLORMAPCREATE. This list can be written on file and thus provides a way of saving color map specifications. (COLORMAPCOPY COLORMAP BITSPERPIXEL) [Function] returns a color map that contains the same color intensities as COLORMAP if COLORMAP is a color map. Otherwise, it returns a color map with default color values. (MAPOFACOLOR PRIMARIES) [Function] returns a color map that is different shades of one or more of the primary colors. For example, (MAPOFACOLOR '(RED GREEN BLUE)) gives a color map of different shades of gray; (MAPOFACOLOR 'RED) gives different shades of red. Changing Color Maps 1 The following functions are provided to access and change the intensity levels in a color map. (SETCOLORINTENSITY COLORMAP COLORNUMBER COLORSPEC) [Function] sets the primary intensities of color number COLORNUMBER in the color map COLORMAP to the ones specified by COLORSPEC. COLORSPEC can be either an RGB triple, an HLS triple, or a color name. The value returned is NIL. (COLORLEVEL COLORMAP COLORNUMBER PRIMARY NEWLEVEL) [Function] sets and reads the intensity level of the primary color PRIMARY (RED, GREEN, or BLUE) for the color number COLORNUMBER in the color map COLORMAP. If NEWLEVEL is a number between 0 and 255, it is set. The previous value of the intensity of PRIMARY is returned. (ADJUSTCOLORMAP PRIMARY DELTA COLORMAP) [Function] adds DELTA to the intensity of the PRIMARY color value (RED, GREEN, or BLUE) for every color number in COLORMAP. (ROTATECOLORMAP STARTCOLOR THRUCOLOR) [Function] rotates a sequence of colors in the SCREENCOLORMAP. The rotation moves the intensity values of color number STARTCOLOR into color number STARTCOLOR+1, the intensity values of color number STARTCOLOR+1 into color number STARTCOLOR+2, etc., and THRUCOLOR's values into STARTCOLOR. (EDITCOLORMAP VAR NOQFLG) [Function] allows interactive editing of a color map. If VAR is an atom whose value is a color map, its value is edited. Otherwise a new color map is created and edited. The color map being edited is made the screen color map while the editing takes place so that its effects can be observed. The edited color map is returned as the value. If NOQFLG is NIL and the color display is on, you are asked if you want a test pattern of colors. A yes response causes the function SHOWCOLORTESTPATTERN to be called, which displays a test pattern with blocks of each of the possible colors. You are prompted for the location of a color control window to be placed on the black-and-white display. This window allows the value of any of the colors to be changed. The number of the color being edited is in the upper left part of the window. Six bars are displayed. The right three bars give the color intensities for the three primary colors of the current color number. The left three bars give the value of the color's Hue, Lightness, and Saturation parameters. These levels can be changed by positioning the mouse cursor in one of the bars and pressing the left mouse button. While the left button is down, the value of that parameter tracks the Y position of the cursor. When the left button is released, the color tracking stops. The color being edited is changed by pressing the middle mouse button while the cursor is in the interior of the edit window. This brings up a menu of color numbers. Selecting one sets the current color to the selected color. The color being edited can also be changed by selecting the menu item "PickPt." This switches the cursor onto the color screen and allows you to select a point from the color screen. It then edits the color of the selected point. To stop the editing, move the cursor into the title of the editing window and press the middle button. This brings up a menu. Select Stop to quit. 2 Color Bitmaps 1 A color bitmap is actually a bitmap that has more than one bit per pixel. To test whether a bitmap is a color bitmap, the function BITSPERPIXEL can be used. (BITSPERPIXEL BITMAP) [Function] returns the bits per pixel of BITMAP; if this does not equal one, BITMAP is a color bitmap. In multiple-bit-per-pixel bitmaps, the bits that represent a pixel are stored contiguously. BITMAPCREATE is passed a BITSPERPIXEL argument to create multiple-bit-per-pixel bitmaps. (BITMAPCREATE WIDTH HEIGHT BITSPERPIXEL) [Function] creates a color bitmap that is WIDTH pixels wide by HEIGHT pixels high allowing BITSPERPIXEL bits per pixel. Currently any value of BITSPERPIXEL except one, four, eight, or NIL (defaults to one) causes an error. A four-bit-per-pixel color screen bitmap uses approximately 76K words of storage, and an eight-bit-per-pixel one uses approximately 153K words. There is only one such bitmap. The following function provides access to it. (COLORSCREENBITMAP) [Function] returns the bitmap that is being or will be displayed on the color display. This is NIL if the color display has never been turned on (see COLORDISPLAY below). 2 2 Screens, Screenpositions, and Screenregions 1 In addition to positions and regions, the user needs to be aware of screens, screenpositions, and screenregions in the presence of multiple screens. Screens 1 SCREEN [Datatype] There are generally two screen datatype instances in existence when working with color. This is because the user is attached to two displays, a black and white display and a color display. (MAINSCREEN) [Function] returns the screen datatype instance that represents the black and white screen. This will be something like {SCREEN}#74,24740. (COLORSCREEN) [Function] returns the screen datatype instance that represents the color screen. Screens appear as part of screenpositions and screenregions, serving as the extra information needed to make clear whether a particular position or region should be viewed as lying on the black and white display or the color display. (SCREENBITMAP SCREEN) [Function] returns the bitmap destination of SCREEN. If SCREEN=NIL, returns the black and white screen bitmap. Screenpositions 1 SCREENPOSITION [Record] Somewhat like a position, a screenposition denotes a point in an X,Y coordinate system on a particular screen. Screenpositions have been defined according to the following record declaration: (RECORD SCREENPOSITION (SCREEN . POSITION) (SUBRECORD POSITION)) A SCREENPOSITION is an instance of a record with fields XCOORD, YCOORD, and SCREEN and is manipulated with the standard record package facilities. For example, (create SCREENPOSITION XCOORD _ 10 YCOORD _ 20 SCREEN _ (COLORSCREEN)) creates a screenposition representing the point (10,20) on the color display. The user can extract the position of a screenposition by fetching its POSITION. For example, (fetch (SCREENPOSITION POSITION) of SP12). Screenregions 1 SCREENREGION [Record] Somewhat like a region, a screenregion denotes a rectangular area in a coordinate system. Screenregions have been defined according to the following record declaration: (RECORD SCREENREGION (SCREEN . REGION) (SUBRECORD REGION)) Screenregions are characterized by the coordinates of their bottom left corner and their width and height. A SCREENREGION is a record with fields LEFT, BOTTOM, WIDTH, HEIGHT, and SCREEN. It can be manipulated with the standard record package facilities. There are access functions for the REGION record that return the TOP and RIGHT of the region. The user can extract the region of a screenregion by fetching its REGION. For example, (fetch (SCREENREGION REGION) of SR8). Screenposition and Screenregion Prompting 1 The following functions can be used by programs to allow the user to interactively specify screenpositions or screenregions on a display screen. (GETSCREENPOSITION WINDOW CURSOR) [Function] 1 Similar to GETPOSITION. Returns a SCREENPOSITION that is specified by the user. GETSCREENPOSITION waits for the user to press and release the left button of the mouse and returns the cursor screenposition at the time of release. If WINDOW is a WINDOW, the screenposition will be on the same screen as WINDOW and in the coordinate system of WINDOW's display stream. If WINDOW is NIL, the position will be in screen coordinates. 1 (GETBOXSCREENPOSITION BOXWIDTH BOXHEIGHT ORGX ORGY WINDOW PROMPTMSG) [Function] 1 Similar to GETBOXPOSITION. Returns a SCREENPOSITION that is specified by the user. Allows the user to position a "ghost" region of size BOXWIDTH by BOXHEIGHT on a screen, and returns the SCREENPOSITION of the lower left corner of the screenregion chosen. A ghost region is locked to the cursor so that if the cursor is moved, the ghost region moves with it. The user can change to another corner by holding down the right button. With the right button down, the cursor can be moved across a screen or to other screens without effect on the ghost region frame. When the right button is released, the mouse will snap to the nearest corner, which will then become locked to the cursor. (The held corner can be changed after the left or middle button is down by holding both the original button and the right button down while the cursor is moved to the desired new corner, then letting up just the right button.) When the left or middle button is pressed and released, the lower left corner of the screenregion chosen at the time of release is returned. If WINDOW is a WINDOW, the screenposition will be on the same screen as WINDOW and in the coordinate system of WINDOW's display stream. If WINDOW is NIL, the position will be in screen coordinates.its lower left corner in screen coordinates. 1 (GETSCREENREGION MINWIDTH MINHEIGHT OLDREGION NEWREGIONFN NEWREGIONFNARG INITCORNERS) [Function] 1 Similar to GETREGION. Returns a SCREENREGION that is specified by the user. Lets the user specify a new screenregion and returns that screenregion. GETSCREENREGION prompts for a screenregion by displaying a four-pronged box next to the cursor arrow at one corner of a "ghost" region: $$ . If the user presses the left button, the corner of a "ghost" screenregion opposite the cursor is locked where it is. Once one corner has been fixed, the ghost screenregion expands as the cursor moves. To specify a screenregion: (1) Move the ghost box so that the corner opposite the cursor is at one corner of the intended screenregion. (2) Press the left button. (3) Move the cursor to the screenposition of the opposite corner of the intended screenregion while holding down the left button. (4) Release the left button. Before one corner has been fixed, one can switch the cursor to another corner of the ghost screenregion by holding down the right button. With the right button down, the cursor changes to a "forceps" ( 9)@9p``) and the cursor can be moved across a screen or to other screens without effect on the ghost screenregion frame. When the right button is released, the cursor will snap to the nearest corner of the ghost screenregion. After one corner has been fixed, one can still switch to another corner. To change to another corner, continue to hold down the left button and hold down the right button also. With both buttons down, the cursor can be moved across a screen or to other screens without effect on the ghost screenregion frame. When the right button is released, the cursor will snap to the nearest corner, which will become the moving corner. In this way, the screenregion may be moved all over a screen and to other screens, before its size and screenposition is finalized. The size of the initial ghost screenregion is controlled by the MINWIDTH, MINHEIGHT, OLDREGION, and INITCORNERS arguments. 1 (GETBOXSCREENREGION WIDTH HEIGHT ORGX ORGY WINDOW PROMPTMSG) [Function] 1 Similar to GETBOXREGION. Returns a SCREENREGION that is specified by the user. Performs the same prompting as GETBOXSCREENPOSITION and returns the SCREENREGION specified by the user instead of the SCREENPOSITION of its lower left corner. 1 2 Color Windows and Menus 1 The Xerox Lisp window system provides both interactive and programmatic constructs for creating, moving, reshaping, overlapping, and destroying windows in such a way that a program can use a window in a relatively transparent fashion (see ("Windows" . TERM)). Menus are a special type of window provided by the window system, used for displaying a set of items to the user, and having the user select one using the mouse and cursor. The menu facility also allows users to create and use menus in interactive programs (see ("Menus" . TERM)). As of the LUTE release of Xerox Lisp, it is possible for the user to create and use windows and menus on the color display. (CREATEW REGION TITLE BORDERSIZE NOOPENFLG) [Function] 1 Creates a new window. REGION indicates where and how large the window should be by specifying the exterior screenregion of the window. In a user environment with multiple screens, such as a black and white screen and color screen both connected to the same machine, there is a new special problem in indicating which screen the REGION is supposed to be a region of. This problem is solved by allowing CREATEW to take screenregion arguments as REGION. For example, (SETQ FOO (CREATEW (CREATE SCREENREGION SCREEN _ (COLORSCREEN) LEFT _ 20 BOTTOM _ 210 WIDTH _ 290 HEIGHT _ 170) "FOO WINDOW")) creates a window titled "FOO WINDOW" on the color screen. To create a window on the black and white screen, the user should use SCREEN _ (MAINSCREEN) in the CREATE SCREENREGION expression. Note that it is still perfectly legal to pass in a REGION that is a region, not a screenregion, to CREATEW, but it is preferable to be passing screenregions rather than regions to CREATEW. This is because when REGION is a region, REGION is disambiguated in a somewhat arbitrary manner that may not always turn out to be what the user was hoping for. When REGION is a region, REGION is disambiguated by coercing REGION to be a screenregion on the screen which currently contains the cursor. This is so that software calling CREATEW with regions instead of screenregions tends to do the right thing in a user environment with multiple screens. 1 (WINDOWPROP WINDOW PROP NEWVALUE) [NoSpread Function] 1 If PROP='SCREEN, then WINDOWPROP returns the screen WINDOW is on. If NEWVALUE is given, (even if given as NIL), with PROP='SCREEN, then WINDOWPROP will generate an error. Any other PROP name is handled in the usual way. 1 (OPENWINDOWS SCREEN) [Function] 1 Returns a list of all open windows on SCREEN if SCREEN is a screen datatype such as (MAINSCREEN) or (COLORSCREEN). If SCREEN=NIL, then SCREEN will default to the screen containing the cursor. If SCREEN=T, then a list of all open windows on all screens is returned. 1 2 Color Fonts 1 The user can create color fonts and specify in the font profile that certain color fonts be used when printing in color. Color Font Creation 1 The user can create and manipulate color fonts through the same functions that are used to create and manipulate black and white fonts. This is made possible in some cases by there being new ways to call familiar font functions. (FONTCREATE FAMILY SIZE FACE ROTATION DEVICE NOERRORFLG CHARSET) [Function] 1 In addition to creating black and white fonts, FONTCREATE can be used to create color fonts. For example, (FONTCREATE 'GACHA 10 '(BOLD REGULAR REGULAR YELLOW BLUE) 0 '8DISPLAY) will create an 8 bit per pixel font with blue letters on a yellow background. The user indicates the color and bits per pixel of the font by the FACE and DEVICE arguments passed to FONTCREATE. DEVICE='8DISPLAY means to create an 8bpp font and DEVICE='4DISPLAY means to create a 4bpp font. A color font face is a 5 tuple, (WEIGHT SLOPE EXPANSION BACKCOLOR FORECOLOR) whereas a black and white font face is just a 3 tuple, (WEIGHT SLOPE EXPANSION) The FORECOLOR is the color of the characters of the font and the BACKCOLOR is the color of the background behind the characters that gets printed along with the characters. Both BACKCOLOR and FORECOLOR are allowed to a color name, color number, or any other legal color representation. A color font face can also be represented as a LITATOM. A three character atom such as MRR or any of the special atoms STANDARD, ITALIC, BOLD, BOLDITALIC can optionally be continued by hyphenating on BACKCOLOR and FORECOLOR suffixes. For example, MRR-YELLOW-BLUE BOLD-YELLOW-RED ITALIC-90-200 BRR-100-53 are acceptable color font faces. Hence, (FONTCREATE 'GACHA 10 'BOLD-YELLOW-BLUE 0 '8DISPLAY) will create a color font. LITATOM FACE arguments fall into one of the following patterns: wse wse-backcolor-forecolor STANDARD STANDARD-backcolor-forecolor ITALIC ITALIC-backcolor-forecolor BOLD BOLD-backcolor-forecolor BOLDITALIC BOLDITALIC-backcolor-forecolor where w=B, M, or L; s=I or R; e=R, C, or E; backcolor=a color name or color number; and forecolor=a color name or color number. 1 (FONTPROP FONT PROP) [Function] 1 Returns the value of the PROP property of font FONT. Besides black and white font properties, the following font properties are recognized: FORECOLOR The color of the characters of the font, represented as a color number. This is the color in which the characters of the font will print. BACKCOLOR The color of the background of the characters of the font, represented as a color number. This is the color in which the the background of characters of the font will print. A font with red characters on a yellow background would have a red FORECOLOR and a yellow BACKCOLOR. Color Font Profiles 1 Font profiles are the facility PRETTYPRINT uses to print different elements (user functions, system functions, clisp words, comments, etc.) in different fonts to emphasize (or deemphasize) their importance, and in general to provide for a more pleasing appearance. The user can specify that different colors of fonts be used for different kinds of elements when printing in color. A well chosen font profile will allows user to DEDIT functions, PP functions, and SEE source files in color, for example. A FONTPROFILE such as ((DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8) (4DISPLAY (GACHA 10 MRR-WHITE-RED)) (8DISPLAY (GACHA 10 MRR-WHITE-RED))) (BOLDFONT 2 (HELVETICA 10 BRR) (HELVETICA 8 BRR) (MODERN 8 BRR) (4DISPLAY (HELVETICA 10 BRR-WHITE-MAGENTA)) (8DISPLAY (HELVETICA 10 BRR-WHITE-MAGENTA))) (LITTLEFONT 3 (HELVETICA 8) (HELVETICA 6 MIR) (MODERN 8 MIR) (4DISPLAY (HELVETICA 8 MRR-WHITE-GREEN)) (8DISPLAY (HELVETICA 8 MRR-WHITE-GREEN))) (BIGFONT 4 (HELVETICA 12 BRR) (HELVETICA 10 BRR) (MODERN 10 BRR) (4DISPLAY (HELVETICA 12 BRR-WHITE-BLUE)) (8DISPLAY (HELVETICA 12 BRR-WHITE-BLUE))) (USERFONT BOLDFONT) (COMMENTFONT LITTLEFONT) (LAMBDAFONT BIGFONT) (SYSTEMFONT) (CLISPFONT BOLDFONT) ...) would have comments print in green and clisp words print in blue while ordinairy atoms would print in red. Not all combinations of fonts will be aesthetically pleasing and the user may have to experiment to find a compatible set. The user should indicate what font is to be used for each font class by calling the function FONTPROFILE: (FONTPROFILE PROFILE) [Function] 1 Sets up the font classes as determined by PROFILE, a list of elements which defines the correspondence between font classes and specific fonts. Each element of PROFILE is a list of the form: (FONTCLASS FONT# DISPLAYFONT PRESSFONT INTERPRESSFONT (OTHERDEVICE1 OTHERFONT1) ... (OTHERDEVICEn OTHERFONTn)) FONTCLASS is the font class name and FONT# is the font number for that class. DISPLAYFONT, PRESSFONT, and INTERPRESSFONT are font specifications (of the form accepted by FONTCREATE) for the fonts to use when printing to the black and white display and to Press and Interpress printers respectively. The appearance of color fonts can be affected by including an (OTHERDEVICEi OTHERFONTi) entry where OTHERDEVICEi is either 4DISPLAY or 8DISPLAY for a 4 bits per pixel or 8 bits per pixel color font and OTHERFONTi is a color font specification such as (GACHA 10 MRR-WHITE-RED). 1 FONTPROFILE [Variable] 1 This is the variable used to store the current font profile, in the form accepted by the function FONTPROFILE. Note that simply editing this value will not change the fonts used for the various font classes; it is necessary to execute (FONTPROFILE FONTPROFILE) to install the value of this variable. 1 2 Using Color 1 The current color implementation allows display streams to operate on color bitmaps. The two functions DSPCOLOR and DSPBACKCOLOR set the color in which a stream draws when the user defaults a color argument to a drawing function. (DSPCOLOR COLOR STREAM) [Function] sets the foreground color of a stream. It returns the previous foreground color. If COLOR is NIL, it returns the current foreground color without changing anything. The default foreground color is MINIMUMCOLOR=0, which is white in the default color maps. (DSPBACKCOLOR COLOR STREAM) [Function] sets the background color of a stream. It returns the previous background color. If COLOR is NIL, it returns the current background color without changing anything. The default background color is (MAXIMUMCOLOR BITSPERPIXEL)=15 or 255, which is black in the default color maps. The BITBLT, line-drawing routines, and curve-drawing routines routines know how to operate on a color-capable stream. Following are some notes about them. 2 BITBLTing in Color 1 If BITBLTing from a color bitmap onto another color bitmap of the same bpp, the operations PAINT, INVERT, and ERASE are done on a bit level, not on a pixel level. Thus painting color 3 onto color 10 results in color 11. If BITBLTing from a black-and-white bitmap onto a color bitmap, the one bits appear in the DSPCOLOR, and the zero bits in DSPBACKCOLOR. BLTing from black-and-white to color is fairly expensive; if the same bitmap is going to be put up several times in the same color, it is faster to create a color copy and then BLT the color copy. If the source type is TEXTURE and the destination bitmap is a color bitmap, the Texture argument is taken to be a color. Thus to fill an area with the color BLUE assuming COLORSTR is a stream whose destination is the color screen, use (BITBLT NIL NIL NIL COLORSTR 50 75 100 200 'TEXTURE 'REPLACE 'BLUE). 2 Drawing Curves and Lines in Color 1 For the functions DRAWCIRCLE, DRAWELLIPSE, and DRAWCURVE, the notion of a brush has been extended to include a color. A BRUSH is now (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR). Also, a brush can be a bitmap (which can be a color bitmap). Line-drawing routines take a color argument which is the color the line is to appear in if the destination of the display stream is a color bitmap. (DRAWLINE X1 Y1 X2 Y2 WIDTH OPERATION STREAM COLOR) [Function] (DRAWTO X Y WIDTH OPERATION STREAM COLOR) [Function] (RELDRAWTO X Y WIDTH OPERATION STREAM COLOR) [Function] (DRAWBETWEEN POS1 POS2 WIDTH OPERATION STREAM COLOR) [Function] If the COLOR argument is NIL, the DSPCOLOR of the stream is used. 2 Printing in Color 1 Printing only works in REPLACE mode. The characters have a background color and a foreground color determined by the font face of the font the characters are being printed with. Example of printing to an 8bpp color screen: (SETQ FOO (CREATEW (CREATE SCREENREGION SCREEN _ (COLORSCREEN) LEFT _ 20 BOTTOM _ 210 WIDTH _ 290 HEIGHT _ 170) "FOO WINDOW")) (DSPFONT (FONTCREATE 'GACHA 10 'MRR-YELLOW-GREEN 0 '8DISPLAY) FOO) (PRINT 'HELLO FOO) ; will print in green against a yellow background. 2 Operating the Cursor on the Color Screen 1 The cursor can be moved to the color screen. The cursor can be moved to the color screen by sliding the cursor off the left or right edge of the black and white screen on to the color screen or by calling function CURSORPOSITION or CURSORSCREEN. (CURSORPOSITION NEWPOSITION - -) [Function] 1 NEWPOSITION can be a position or a screenposition. (CURSORSCREEN SCREEN XCOORD YCOORD) [Function] 1 Moves the cursor to the screenposition determined by SCREEN, XCOORD, and YCOORD. SCREEN should be the value of either (COLORSCREEN) or (MAINSCREEN). While on the color screen, the cursor is placed by doing BITBLTs in software rather than with microcode and hardware as with the black and white cursor. It is automatically taken down whenever an operation is performed that changes any bits on the color screen. The speed of the color cursor compares well with that of the black and white cursor but there can be a noticeable flicker when there is much input/output to the color screen. While the cursor is on the color screen, the black-and-white cursor is cleared giving the appearance that there is never more than one cursor at a given time. 2 Miscellaneous Color Functions 1 (COLORIZEBITMAP BITMAP 0COLOR 1COLOR BITSPERPIXEL) [Function] creates a color bitmap from a black and white bitmap. The returned bitmap has color number 1COLOR in those pixels of BITMAP that were one and 0COLOR in those pixels of BITMAP that were zero. This provides a way of producing a color bitmap from a black and white bitmap. (UNCOLORIZEBITMAP BITMAP COLORMAP) [Function] creates a black and white bitmap from a color bitmap. (SHOWCOLORTESTPATTERN BARSIZE) [Function] displays a pattern of colors on the color display. This is useful when editing a color map. The pattern has squares of the 16 possible colors laid out in two rows at the top of the screen. Colors 0 through 7 are in the top row, and colors 8 through 15 are in the next row. The bottom part of the screen is filled with bars of BARSIZE width with consecutive color numbers. The pattern is designed so that every color has a border with every other color (unless BARSIZE is too large to allow room for every color%about 20). (LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 2) (0 0 612 792) ((FOLIO NIL ( PARALOOKS (QUAD LEFT) CHARLOOKS (SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF SLOPE REGULAR WEIGHT MEDIUM) FORMATINFO (ARABIC)) (54 12 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) ( 54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 618) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF SLOPE REGULAR WEIGHT MEDIUM) FORMATINFO (ARABIC)) (558 12 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE RECTOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL))) ( PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF SLOPE REGULAR WEIGHT MEDIUM) FORMATINFO (ARABIC)) (54 12 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) ( HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL)))))7 8 T(1()KKT/KT(5 nT/T/T/T/T/ T/2T/T/T/T.. /T/2T.. < PAGEHEADING VERSOHEAD< PAGEHEADING RECTOHEAD; PAGEHEADINGFOOTINGV; PAGEHEADINGFOOTINGR ?1(DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8)) +MODERNMODERN MODERNMODERNMODERN +MODERN +MODERN +MODERN + HRULE.GETFNMODERN +   HRULE.GETFNMODERN +    HRULE.GETFNMODERN +   HRULE.GETFNMODERN +    HRULE.GETFNMODERN HRULE.GETFNMODERN  HRULE.GETFNMODERN    f   f +  HRULE.GETFNMODERN. HRULE.GETFNMODERN   @   +   W  (   "  =  HRULE.GETFNMODERN  HRULE.GETFNMODERN   `   HRULE.GETFNMODERN     + ]  + >   &           HRULE.GETFNMODERN     +      ?   =          "      "  HRULE.GETFNMODERN  HRULE.GETFNMODERNy    D + q  B  -  i  (  _    L    *  X =     *     ?  N      HRULE.GETFNMODERN _    +8 -   + Z    +& 8 ,   S       =     m + +) + +  +   + /     ;    HRULE.GETFNMODERN HRULE.GETFNMODERN      v 4       ) E      HRULE.GETFNMODERN HRULE.GETFN, HRULE.GETFNMODERN  HRULE.GETFNMODERN       2  "  1  HRULE.GETFNMODERN +  + +    HRULE.GETFNMODERN  +  ' )  ) HRULE.GETFNMODERN    HRULE.GETFNMODERN +  ? "  4  HRULE.GETFNMODERN + -  HRULE.GETFNMODERN +    ? "  a  HRULE.GETFNMODERN + C  HRULE.GETFNMODERN +  ( BMOBJ.GETFN3 H  , BMOBJ.GETFN3 1 @      HRULE.GETFNMODERN + '  HRULE.GETFNMODERN +   HRULE.GETFNMODERN +  HRULE.GETFNMODERN HRULE.GETFNMODERN ). Menus are a special type of window provided by the window system, used for displaying a set of items to the user, and having the user select one using the mouse and cursor. The menu facility also allows users to create and use menus in interactive programs (see ("Menus" . TERM)). As of the LUTE release of Xerox Lisp, it is possible for the user to create and use windows and menus on the color display. (CREATEW REGION TITLE BORDERSIZE NOOPENFLG) [Function] 1 Creates a new window. REGION indicates where and how large the window should be by specifying the exterior screenregion of the window. In a user environment with multiple screens, such as a black and white screen and color screen both connected to the same machine, there is a new special problem in indicating which screen the REGION is supposed to be a region of. This problem is solved by allowing CREATEW to take screenregion arguments as REGION. For example, (SETQ FOO (CREATEW (CREATE SCREENREGION SCREEN _ (COLORSCREEN) LEFT _ 20 BOTTOM _ 210 WIDTH _ 290 HEIGHT _ 170) "FOO WINDOW")) creates a window titled "FOO WINDOW" on the color screen. To create a window on the black and white screen, the user should use SCREEN _ (MAINSCREEN) in the CREATE SCREENREGION expression. Note that it is still perfectly legal to pass in a REGION that is a region, not a screenregion, to CREATEW, but it is preferable to be passing screenregions rather than regions to CREATEW. This is because when REGION is a region, REGION is disambiguated in a somewhat arbitrary manner that may not always turn out to be what the user was hoping for. When REGION is a region, REGION is disambiguated by coercing REGION to be a screenregion on the screen which currently contains the cursor. This is so that software calling CREATEW with regions instead of screenregions tends to do the right thing in a user environment with multiple screens. 1 (WINDOWPROP WINDOW PROP NEWVALUE) [NoSpread Function] 1 If PROP='SCREEN, then WINDOWPROP returns the screen WINDOW is on. If NEWVALUE is given, (even if given as NIL), with PROP='SCREEN, then WINDOWPROP will generate an error. Any other PROP name is handled in the usual way. 1 (OPENWINDOWS SCREEN) [Function] 1 Returns a list of all open windows on SCREEN if SCREEN is a screen datatype such as (MAINSCREEN) or (COLORSCREEN). If SCREEN=NIL, then SCREEN will default to the screen containing the cursor. If SCREEN=T, then a list of all open windows on all screens is returned. 1 2 Color Fonts 1 The user can create color fonts and specify in the font profile that certain color fonts be used when printing in color. Color Font Creation 1 The user can create and manipulate color fonts through the same functions that are used to create and manipulate black and white fonts. This is made possible in some cases by there being new ways to call familiar font functions. (FONTCREATE FAMILY SIZE FACE ROTATION DEVICE NOERRORFLG CHARSET) [Function] 1 In addition to creating black and white fonts, FONTCREATE can be used to create color fonts. For example, (FONTCREATE 'GACHA 10 '(BOLD REGULAR REGULAR YELLOW BLUE) 0 '8DISPLAY) will create an 8 bit per pixel font with blue letters on a yellow background. The user indicates the color and bits per pixel of the font by the FACE and DEVICE arguments passed to FONTCREATE. DEVICE='8DISPLAY means to create an 8bpp font and DEVICE='4DISPLAY means to create a 4bpp font. A color font face is a 5 tuple, (WEIGHT SLOPE EXPANSION BACKCOLOR FORECOLOR) whereas a black and white font face is just a 3 tuple, (WEIGHT SLOPE EXPANSION) The FORECOLOR is the color of the characters of the font and the BACKCOLOR is the color of the background behind the characters that gets printed along with the characters. Both BACKCOLOR and FORECOLOR are allowed to a color name, color number, or any other legal color representation. A color font face can also be represented as a LITATOM. A three character atom such as MRR or any of the special atoms STANDARD, ITALIC, BOLD, BOLDITALIC can optionally be continued by hyphenating on BACKCOLOR and FORECOLOR suffixes. For example, MRR-YELLOW-BLUE BOLD-YELLOW-RED ITALIC-90-200 BRR-100-53 are acceptable color font faces. Hence, (FONTCREATE 'GACHA 10 'BOLD-YELLOW-BLUE 0 '8DISPLAY) will create a color font. LITATOM FACE arguments fall into one of the following patterns: wse wse-backcolor-forecolor STANDARD STANDARD-backcolor-forecolor ITALIC ITALIC-backcolor-forecolor BOLD BOLD-backcolor-forecolor BOLDITALIC BOLDITALIC-backcolor-forecolor where w=B, M, or L; s=I or R; e=R, C, or E; backcolor=a color name or color number; and forecolor=a color name or color number. 1 (FONTPROP FONT PROP) [Function] 1 Returns the value of the PROP property of font FONT. Besides black and white font properties, the following font properties are recognized: FORECOLOR The color of the characters of the font, represented as a color number. This is the color in which the characters of the font will print. BACKCOLOR The color of the background of the characters of the font, represented as a color number. This is the color in which the the background of characters of the font will print. A font with red characters on a yellow background would have a red FORECOLOR and a yellow BACKCOLOR. Color Font Profiles 1 Font profiles are the facility PRETTYPRINT uses to print different elements (user functions, system functions, clisp words, comments, etc.) in different fonts to emphasize (or deemphasize) their importance, and in general to provide for a more pleasing appearance. The user can specify that different colors of fonts be used for different kinds of elements when printing in color. A well chosen font profile will allows user to DEDIT functions, PP functions, and SEE source files in color, for example. A FONTPROFILE such as ((DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8) (4DISPLAY (GACHA 10 MRR-WHITE-RED)) (8DISPLAY (GACHA 10 MRR-WHITE-RED))) (BOLDFONT 2 (HELVETICA 10 BRR) (HELVETICA 8 BRR) (MODERN 8 BRR) (4DISPLAY (HELVETICA 10 BRR-WHITE-MAGENTA)) (8DISPLAY (HELVETICA 10 BRR-WHITE-MAGENTA))) (LITTLEFONT 3 (HELVETICA 8) (HELVETICA 6 MIR) (MODERN 8 MIR) (4DISPLAY (HELVETICA 8 MRR-WHITE-GREEN)) (8DISPLAY (HELVETICA 8 MRR-WHITE-GREEN))) (BIGFONT 4 (HELVETICA 12 BRR) (HELVETICA 10 BRR) (MODERN 10 BRR) (4DISPLAY (HELVETICA 12 BRR-WHITE-BLUE)) (8DISPLAY (HELVETICA 12 BRR-WHITE-BLUE))) (USERFONT BOLDFONT) (COMMENTFONT LITTLEFONT) (LAMBDAFONT BIGFONT) (SYSTEMFONT) (CLISPFONT BOLDFONT) ...) would have comments print in green and clisp words print in blue while ordinairy atoms would print in red. Not all combinations of fonts will be aesthetically pleasing and the user may have to experiment to find a compatible set. The user should indicate what font is to be used for each font class by calling the function FONTPROFILE: (FONTPROFILE PROFILE) [Function] 1 Sets up the font classes as determined by PROFILE, a list of elements which defines the correspondence between font classes and specific fonts. Each element of PROFILE is a list of the form: (FONTCLASS FONT# DISPLAYFONT PRESSFONT INTERPRESSFONT (OTHERDEVICE1 OTHERFONT1) ... (OTHERDEVICEn OTHERFONTn)) FONTCLASS is the font class name and FONT# is the font number for that class. DISPLAYFONT, PRESSFONT, and INTERPRESSFONT are font specifications (of the form accepted by FONTCREATE) for the fonts to use when printing to the black and white display and to Press and Interpress printers respectively. The appearance of color fonts can be affected by including an (OTHERDEVICEi OTHERFONTi) entry where OTHERDEVICEi is either 4DISPLAY or 8DISPLAY for a 4 bits per pixel or 8 bits per pixel color font and OTHERFONTi is a color font specification such as (GACHA 10 MRR-WHITE-RED). 1 FONTPROFILE [Variable] 1 This is the variable used to store the current font profile, in the form accepted by the function FONTPROFILE. Note that simply editing this value will not change the fonts used for the various font classes; it is necessary to execute (FONTPROFILE FONTPROFILE) to install the value of this variable. 1 2 Using Color 1 The current color implementation allows display streams to operate on color bitmaps. The two functions DSPCOLOR and DSPBACKCOLOR set the color in which a stream draws when the user defaults a color argument to a drawing function. (DSPCOLOR COLOR STREAM) [Function] sets the foreground color of a stream. It returns the previous foreground color. If COLOR is NIL, it returns the current foreground color without changing anything. The default foreground color is MINIMUMCOLOR=0, which is white in the default color maps. (DSPBACKCOLOR COLOR STREAM) [Function] sets the background color of a stream. It returns the previous background color. If COLOR is NIL, it returns the current background color without changing anything. The default background color is (MAXIMUMCOLOR BITSPERPIXEL)=15 or 255, which is black in the default color maps. The BITBLT, line-drawing routines, and curve-drawing routines routines know how to operate on a color-capable stream. Following are some notes about them. 2 BITBLTing in Color 1 If BITBLTing from a color bitmap onto another color bitmap of the same bpp, the operations PAINT, INVERT, and ERASE are done on a bit level, not on a pixel level. Thus painting color 3 onto color 10 results in color 11. If BITBLTing from a black-and-white bitmap onto a color bitmap, the one bits appear in the DSPCOLOR, and the zero bits in DSPBACKCOLOR. BLTing from black-and-white to color is fairly expensive; if the same bitmap is going to be put up several times in the same color, it is faster to create a color copy and then BLT the color copy. If the source type is TEXTURE and the destination bitmap is a color bitmap, the Texture argument is taken to be a color. Thus to fill an area with the color BLUE assuming COLORSTR is a stream whose destination is the color screen, use (BITBLT NIL NIL NIL COLORSTR 50 75 100 200 'TEXTURE 'REPLACE 'BLUE). 2 Drawing Curves and Lines in Color 1 For the functions DRAWCIRCLE, DRAWELLIPSE, and DRAWCURVE, the notion of a brush has been extended to include a color. A BRUSH is now (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR). Also, a brush can be a bitmap (which can be a color bitmap). Line-drawing routines take a color argument which is the color the line is to appear in if the destination of the display stream is a color bitmap. (DRAWLINE X1 Y1 X2 Y2 WIDTH OPERATION STREAM COLOR) [Function] (DRAWTO X Y WIDTH OPERATION STREAM COLOR) [Function] (RELDRAWTO X Y WIDTH OPERATION STREAM COLOR) [Function] (DRAWBETWEEN POS1 POS2 WIDTH OPERATION STREAM COLOR) [Function] If the COLOR argument is NIL, the DSPCOLOR of the stream is used. 2 Printing in Color 1 Printing only works in REPLACE mode. The characters have a background color and a foreground color determined by the font face of the font the characters are being printed with. Example of printing to an 8bpp color screen: (SETQ FOO (CREATEW (CREATE SCREENREGION SCREEN _ (COLORSCREEN) LEFT _ 20 BOTTOM _ 210 WIDTH _ 290 HEIGHT _ 170) "FOO WINDOW")) (DSPFONT (FONTCREATE 'GACHA 10 'MRR-YELLOW-GREEN 0 '8DISPLAY) FOO) (PRINT 'HELLO FOO) ; will print in green against a yellow background. 2 Operating the Cursor on the Color Screen 1 The cursor can be moved to the color screen. The cursor can be moved to the color screen by sliding the cursor off the left or right edge of the black and white screen on to the color screen or by calling function CURSORPOSITION or CURSORSCREEN. (CURSORPOSITION NEWPOSITION - -) [Function] 1 NEWPOSITION can be a position or a screenposition. (CURSORSCREEN SCREEN XCOORD YCOORD) [Function] 1 Moves the cursor to the screenposition determined by SCREEN, XCOORD, and YCOORD. SCREEN should be the value of either (COLORSCREEN) or (MAINSCREEN). While on the color screen, the cursor is placed by doing BITBLTs in software rather than with microcode and hardware as with the black and white cursor. It is automatically taken down whenever an operation is performed that changes any bits on the color screen. The speed of the color cursor compares well with that of the black and white cursor but there can be a noticeable flicker when there is much input/output to the color screen. While the cursor is on the color screen, the black-and-white cursor is cleared giving the appearance that there is never more than one cursor at a given time. 2 Miscellaneous Color Functions 1 (COLORIZEBITMAP BITMAP 0COLOR 1COLOR BITSPERPIXEL) [Function] creates a color bitmap from a black and white bitmap. The returned bitmap has color number 1COLOR in those pixels of BITMAP that were one and 0COLOR in those pixels of BITMAP that were zero. This provides a way of producing a color bitmap from a black and white bitmap. (UNCOLORIZEBITMAP BITMAP COLORMAP) [Function] creates a black and white bitmap from a color bitmap. (SHOWCOLORTESTPATTERN BARSIZE) [Function] displays a pattern of colors on the color display. This is useful when editing a color map. The pattern has squares of the 16 possible colors laid out in two rows at the top of the screen. Colors 0 through 7 are in the top row, and colors 8 through 15 are in the next row. The bottom part of the screen is filled with bars of BARSIZE width with consecutive color numbers. The pattern is designed so that every color has a border with every other color (unless BARSIZE is too large to allow room for every color%about 20). (LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 2) (0 0 612 792) ((FOLIO NIL ( PARALOOKS (QUAD LEFT) CHARLOOKS (SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF SLOPE REGULAR WEIGHT MEDIUM) FORMATINFO (ARABIC)) (54 12 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) ( 54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 618) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF SLOPE REGULAR WEIGHT MEDIUM) FORMATINFO (ARABIC)) (558 12 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE RECTOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL))) ( PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF SLOPE REGULAR WEIGHT MEDIUM) FORMATINFO (ARABIC)) (54 12 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) ( HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL)))))7 8 T(1()KKT/KT(5 nT/T/T/T/T/ T/2T/T/T/T.. /T/2T.. < PAGEHEADING VERSOHEAD< PAGEHEADING RECTOHEAD; PAGEHEADINGFOOTINGV; PAGEHEADINGFOOTINGR ?1(DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8)) +MODERNMODERN MODERNMODERNMODERN +MODERN +MODERN +MODERN + HRULE.GETFNMODERN +   HRULE.GETFNMODERN +    HRULE.GETFNMODERN +   HRULE.GETFNMODERN +    HRULE.GETFNMODERN HRULE.GETFNMODERN  HRULE.GETFNMODERN    f   f +  HRULE.GETFNMODERN. HRULE.GETFNMODERN   @   +   W  (   "  =  HRULE.GETFNMODERN  HRULE.GETFNMODERN   `   HRULE.GETFNMODERN     + ]  + >   &           HRULE.GETFNMODERN     +      ?   =          "      "  HRULE.GETFNMODERN  HRULE.GETFNMODERNy    D + q  B  -  i  (  _    L    *  X =     *     ?  N      HRULE.GETFNMODERN _    +8 -   + Z    +& 8 ,   S       =     m + +) + +  +   + /     ;    HRULE.GETFNMODERN HRULE.GETFNMODERN      v 4       ) E      HRULE.GETFNMODERN HRULE.GETFN, HRULE.GETFNMODERN  HRULE.GETFNMODERN       2  "  1  HRULE.GETFNMODERN +  + +    HRULE.GETFNMODERN  +  ' )  ) HRULE.GETFNMODERN    HRULE.GETFNMODERN +  ? "  4  HRULE.GETFNMODERN + -  HRULE.GETFNMODERN +    ? "  a  HRULE.GETFNMODERN + C  HRULE.GETFNMODERN +  ( BMOBJ.GETFN3 H  , BMOBJ.GETFN3 1 @      HRULE.GETFNMODERN + '  HRULE.GETFNMODERN +   HRULE.GETFNMODERN +  HRULE.GETFNMODERN HRULE.GETFNMODERN  IRM.GET.CREF ). As of the LUTE release of Xerox Lisp, it is possible for the user to create and use windows and menus on the color display. (CREATEW REGION TITLE BORDERSIZE NOOPENFLG) [Function] 1 Creates a new window. REGION indicates where and how large the window should be by specifying the exterior screenregion of the window. In a user environment with multiple screens, such as a black and white screen and color screen both connected to the same machine, there is a new special problem in indicating which screen the REGION is supposed to be a region of. This problem is solved by allowing CREATEW to take screenregion arguments as REGION. For example, (SETQ FOO (CREATEW (CREATE SCREENREGION SCREEN _ (COLORSCREEN) LEFT _ 20 BOTTOM _ 210 WIDTH _ 290 HEIGHT _ 170) "FOO WINDOW")) creates a window titled "FOO WINDOW" on the color screen. To create a window on the black and white screen, the user should use SCREEN _ (MAINSCREEN) in the CREATE SCREENREGION expression. Note that it is still perfectly legal to pass in a REGION that is a region, not a screenregion, to CREATEW, but it is preferable to be passing screenregions rather than regions to CREATEW. This is because when REGION is a region, REGION is disambiguated in a somewhat arbitrary manner that may not always turn out to be what the user was hoping for. When REGION is a region, REGION is disambiguated by coercing REGION to be a screenregion on the screen which currently contains the cursor. This is so that software calling CREATEW with regions instead of screenregions tends to do the right thing in a user environment with multiple screens. 1 (WINDOWPROP WINDOW PROP NEWVALUE) [NoSpread Function] 1 If PROP='SCREEN, then WINDOWPROP returns the screen WINDOW is on. If NEWVALUE is given, (even if given as NIL), with PROP='SCREEN, then WINDOWPROP will generate an error. Any other PROP name is handled in the usual way. 1 (OPENWINDOWS SCREEN) [Function] 1 Returns a list of all open windows on SCREEN if SCREEN is a screen datatype such as (MAINSCREEN) or (COLORSCREEN). If SCREEN=NIL, then SCREEN will default to the screen containing the cursor. If SCREEN=T, then a list of all open windows on all screens is returned. 1 2 Color Fonts 1 The user can create color fonts and specify in the font profile that certain color fonts be used when printing in color. Color Font Creation 1 The user can create and manipulate color fonts through the same functions that are used to create and manipulate black and white fonts. This is made possible in some cases by there being new ways to call familiar font functions. (FONTCREATE FAMILY SIZE FACE ROTATION DEVICE NOERRORFLG CHARSET) [Function] 1 In addition to creating black and white fonts, FONTCREATE can be used to create color fonts. For example, (FONTCREATE 'GACHA 10 '(BOLD REGULAR REGULAR YELLOW BLUE) 0 '8DISPLAY) will create an 8 bit per pixel font with blue letters on a yellow background. The user indicates the color and bits per pixel of the font by the FACE and DEVICE arguments passed to FONTCREATE. DEVICE='8DISPLAY means to create an 8bpp font and DEVICE='4DISPLAY means to create a 4bpp font. A color font face is a 5 tuple, (WEIGHT SLOPE EXPANSION BACKCOLOR FORECOLOR) whereas a black and white font face is just a 3 tuple, (WEIGHT SLOPE EXPANSION) The FORECOLOR is the color of the characters of the font and the BACKCOLOR is the color of the background behind the characters that gets printed along with the characters. Both BACKCOLOR and FORECOLOR are allowed to a color name, color number, or any other legal color representation. A color font face can also be represented as a LITATOM. A three character atom such as MRR or any of the special atoms STANDARD, ITALIC, BOLD, BOLDITALIC can optionally be continued by hyphenating on BACKCOLOR and FORECOLOR suffixes. For example, MRR-YELLOW-BLUE BOLD-YELLOW-RED ITALIC-90-200 BRR-100-53 are acceptable color font faces. Hence, (FONTCREATE 'GACHA 10 'BOLD-YELLOW-BLUE 0 '8DISPLAY) will create a color font. LITATOM FACE arguments fall into one of the following patterns: wse wse-backcolor-forecolor STANDARD STANDARD-backcolor-forecolor ITALIC ITALIC-backcolor-forecolor BOLD BOLD-backcolor-forecolor BOLDITALIC BOLDITALIC-backcolor-forecolor where w=B, M, or L; s=I or R; e=R, C, or E; backcolor=a color name or color number; and forecolor=a color name or color number. 1 (FONTPROP FONT PROP) [Function] 1 Returns the value of the PROP property of font FONT. Besides black and white font properties, the following font properties are recognized: FORECOLOR The color of the characters of the font, represented as a color number. This is the color in which the characters of the font will print. BACKCOLOR The color of the background of the characters of the font, represented as a color number. This is the color in which the the background of characters of the font will print. A font with red characters on a yellow background would have a red FORECOLOR and a yellow BACKCOLOR. Color Font Profiles 1 Font profiles are the facility PRETTYPRINT uses to print different elements (user functions, system functions, clisp words, comments, etc.) in different fonts to emphasize (or deemphasize) their importance, and in general to provide for a more pleasing appearance. The user can specify that different colors of fonts be used for different kinds of elements when printing in color. A well chosen font profile will allows user to DEDIT functions, PP functions, and SEE source files in color, for example. A FONTPROFILE such as ((DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8) (4DISPLAY (GACHA 10 MRR-WHITE-RED)) (8DISPLAY (GACHA 10 MRR-WHITE-RED))) (BOLDFONT 2 (HELVETICA 10 BRR) (HELVETICA 8 BRR) (MODERN 8 BRR) (4DISPLAY (HELVETICA 10 BRR-WHITE-MAGENTA)) (8DISPLAY (HELVETICA 10 BRR-WHITE-MAGENTA))) (LITTLEFONT 3 (HELVETICA 8) (HELVETICA 6 MIR) (MODERN 8 MIR) (4DISPLAY (HELVETICA 8 MRR-WHITE-GREEN)) (8DISPLAY (HELVETICA 8 MRR-WHITE-GREEN))) (BIGFONT 4 (HELVETICA 12 BRR) (HELVETICA 10 BRR) (MODERN 10 BRR) (4DISPLAY (HELVETICA 12 BRR-WHITE-BLUE)) (8DISPLAY (HELVETICA 12 BRR-WHITE-BLUE))) (USERFONT BOLDFONT) (COMMENTFONT LITTLEFONT) (LAMBDAFONT BIGFONT) (SYSTEMFONT) (CLISPFONT BOLDFONT) ...) would have comments print in green and clisp words print in blue while ordinairy atoms would print in red. Not all combinations of fonts will be aesthetically pleasing and the user may have to experiment to find a compatible set. The user should indicate what font is to be used for each font class by calling the function FONTPROFILE: (FONTPROFILE PROFILE) [Function] 1 Sets up the font classes as determined by PROFILE, a list of elements which defines the correspondence between font classes and specific fonts. Each element of PROFILE is a list of the form: (FONTCLASS FONT# DISPLAYFONT PRESSFONT INTERPRESSFONT (OTHERDEVICE1 OTHERFONT1) ... (OTHERDEVICEn OTHERFONTn)) FONTCLASS is the font class name and FONT# is the font number for that class. DISPLAYFONT, PRESSFONT, and INTERPRESSFONT are font specifications (of the form accepted by FONTCREATE) for the fonts to use when printing to the black and white display and to Press and Interpress printers respectively. The appearance of color fonts can be affected by including an (OTHERDEVICEi OTHERFONTi) entry where OTHERDEVICEi is either 4DISPLAY or 8DISPLAY for a 4 bits per pixel or 8 bits per pixel color font and OTHERFONTi is a color font specification such as (GACHA 10 MRR-WHITE-RED). 1 FONTPROFILE [Variable] 1 This is the variable used to store the current font profile, in the form accepted by the function FONTPROFILE. Note that simply editing this value will not change the fonts used for the various font classes; it is necessary to execute (FONTPROFILE FONTPROFILE) to install the value of this variable. 1 2 Using Color 1 The current color implementation allows display streams to operate on color bitmaps. The two functions DSPCOLOR and DSPBACKCOLOR set the color in which a stream draws when the user defaults a color argument to a drawing function. (DSPCOLOR COLOR STREAM) [Function] sets the foreground color of a stream. It returns the previous foreground color. If COLOR is NIL, it returns the current foreground color without changing anything. The default foreground color is MINIMUMCOLOR=0, which is white in the default color maps. (DSPBACKCOLOR COLOR STREAM) [Function] sets the background color of a stream. It returns the previous background color. If COLOR is NIL, it returns the current background color without changing anything. The default background color is (MAXIMUMCOLOR BITSPERPIXEL)=15 or 255, which is black in the default color maps. The BITBLT, line-drawing routines, and curve-drawing routines routines know how to operate on a color-capable stream. Following are some notes about them. 2 BITBLTing in Color 1 If BITBLTing from a color bitmap onto another color bitmap of the same bpp, the operations PAINT, INVERT, and ERASE are done on a bit level, not on a pixel level. Thus painting color 3 onto color 10 results in color 11. If BITBLTing from a black-and-white bitmap onto a color bitmap, the one bits appear in the DSPCOLOR, and the zero bits in DSPBACKCOLOR. BLTing from black-and-white to color is fairly expensive; if the same bitmap is going to be put up several times in the same color, it is faster to create a color copy and then BLT the color copy. If the source type is TEXTURE and the destination bitmap is a color bitmap, the Texture argument is taken to be a color. Thus to fill an area with the color BLUE assuming COLORSTR is a stream whose destination is the color screen, use (BITBLT NIL NIL NIL COLORSTR 50 75 100 200 'TEXTURE 'REPLACE 'BLUE). 2 Drawing Curves and Lines in Color 1 For the functions DRAWCIRCLE, DRAWELLIPSE, and DRAWCURVE, the notion of a brush has been extended to include a color. A BRUSH is now (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR). Also, a brush can be a bitmap (which can be a color bitmap). Line-drawing routines take a color argument which is the color the line is to appear in if the destination of the display stream is a color bitmap. (DRAWLINE X1 Y1 X2 Y2 WIDTH OPERATION STREAM COLOR) [Function] (DRAWTO X Y WIDTH OPERATION STREAM COLOR) [Function] (RELDRAWTO X Y WIDTH OPERATION STREAM COLOR) [Function] (DRAWBETWEEN POS1 POS2 WIDTH OPERATION STREAM COLOR) [Function] If the COLOR argument is NIL, the DSPCOLOR of the stream is used. 2 Printing in Color 1 Printing only works in REPLACE mode. The characters have a background color and a foreground color determined by the font face of the font the characters are being printed with. Example of printing to an 8bpp color screen: (SETQ FOO (CREATEW (CREATE SCREENREGION SCREEN _ (COLORSCREEN) LEFT _ 20 BOTTOM _ 210 WIDTH _ 290 HEIGHT _ 170) "FOO WINDOW")) (DSPFONT (FONTCREATE 'GACHA 10 'MRR-YELLOW-GREEN 0 '8DISPLAY) FOO) (PRINT 'HELLO FOO) ; will print in green against a yellow background. 2 Operating the Cursor on the Color Screen 1 The cursor can be moved to the color screen. The cursor can be moved to the color screen by sliding the cursor off the left or right edge of the black and white screen on to the color screen or by calling function CURSORPOSITION or CURSORSCREEN. (CURSORPOSITION NEWPOSITION - -) [Function] 1 NEWPOSITION can be a position or a screenposition. (CURSORSCREEN SCREEN XCOORD YCOORD) [Function] 1 Moves the cursor to the screenposition determined by SCREEN, XCOORD, and YCOORD. SCREEN should be the value of either (COLORSCREEN) or (MAINSCREEN). While on the color screen, the cursor is placed by doing BITBLTs in software rather than with microcode and hardware as with the black and white cursor. It is automatically taken down whenever an operation is performed that changes any bits on the color screen. The speed of the color cursor compares well with that of the black and white cursor but there can be a noticeable flicker when there is much input/output to the color screen. While the cursor is on the color screen, the black-and-white cursor is cleared giving the appearance that there is never more than one cursor at a given time. 2 Miscellaneous Color Functions 1 (COLORIZEBITMAP BITMAP 0COLOR 1COLOR BITSPERPIXEL) [Function] creates a color bitmap from a black and white bitmap. The returned bitmap has color number 1COLOR in those pixels of BITMAP that were one and 0COLOR in those pixels of BITMAP that were zero. This provides a way of producing a color bitmap from a black and white bitmap. (UNCOLORIZEBITMAP BITMAP COLORMAP) [Function] creates a black and white bitmap from a color bitmap. (SHOWCOLORTESTPATTERN BARSIZE) [Function] displays a pattern of colors on the color display. This is useful when editing a color map. The pattern has squares of the 16 possible colors laid out in two rows at the top of the screen. Colors 0 through 7 are in the top row, and colors 8 through 15 are in the next row. The bottom part of the screen is filled with bars of BARSIZE width with consecutive color numbers. The pattern is designed so that every color has a border with every other color (unless BARSIZE is too large to allow room for every color%about 20). (LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 2) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF SLOPE REGULAR WEIGHT MEDIUM) FORMATINFO (ARABIC)) (54 12 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 618) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF SLOPE REGULAR WEIGHT MEDIUM) FORMATINFO (ARABIC)) (558 12 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE RECTOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF SLOPE REGULAR WEIGHT MEDIUM) FORMATINFO (ARABIC)) (54 12 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL))))); < T,5,-KKT3KT,9 nT3T3T3T3T3 T32T3T3T3T22 3T32T22 @ PAGEHEADING VERSOHEAD@ PAGEHEADING RECTOHEAD? PAGEHEADINGFOOTINGV? PAGEHEADINGFOOTINGR ?1(DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8)) +MODERNMODERN MODERNMODERNMODERN +MODERN +MODERN +MODERN + HRULE.GETFNMODERN +   HRULE.GETFNMODERN +    HRULE.GETFNMODERN +   HRULE.GETFNMODERN +    HRULE.GETFNMODERN HRULE.GETFNMODERN  HRULE.GETFNMODERN    K f    HRULE.GETFNMODERN' HRULE.GETFNMODERN + @    HRULE.GETFNMODERN. HRULE.GETFNMODERN   @   +   W  (   "  =  HRULE.GETFNMODERN  HRULE.GETFNMODERN +    `   HRULE.GETFNMODERN     + ]  + >   &           HRULE.GETFNMODERN     +      ?   =          "      "  HRULE.GETFNMODERN  HRULE.GETFNMODERNy    D + q  B  -  i  (  _    L    *  X =     *     ?  N      HRULE.GETFNMODERN _    +8 -   + Z    +& 8 ,   S       =     m + +) + +  +   + /     ;    HRULE.GETFNMODERN HRULE.GETFNMODERN      v 4       ) E      HRULE.GETFNMODERN HRULE.GETFN, HRULE.GETFNMODERN  HRULE.GETFNMODERN       2  "  1  HRULE.GETFNMODERN +  + +    HRULE.GETFNMODERN  +  ' )  ) HRULE.GETFNMODERN    HRULE.GETFNMODERN +  ? "  4  HRULE.GETFNMODERN + -  HRULE.GETFNMODERN +    ? "  a  HRULE.GETFNMODERN + C  HRULE.GETFNMODERN +  ( BMOBJ.GETFN3 H  , BMOBJ.GETFN3 1 @      HRULE.GETFNMODERN + '  HRULE.GETFNMODERN +   HRULE.GETFNMODERN +  HRULE.GETFNMODERN HRULE.GETFNMODERN a). Menus are a special type of window provided by the window system, used for displaying a set of items to the user, and having the user select one using the mouse and cursor. The menu facility also allows users to create and use menus in interactive programs (see ("Menus" . TERM)). As of the LUTE release of Xerox Lisp, it is possible for the user to create and use windows and menus on the color display. (CREATEW REGION TITLE BORDERSIZE NOOPENFLG) [Function] 1 Creates a new window. REGION indicates where and how large the window should be by specifying the exterior screenregion of the window. In a user environment with multiple screens, such as a black and white screen and color screen both connected to the same machine, there is a new special problem in indicating which screen the REGION is supposed to be a region of. This problem is solved by allowing CREATEW to take screenregion arguments as REGION. For example, (SETQ FOO (CREATEW (CREATE SCREENREGION SCREEN _ (COLORSCREEN) LEFT _ 20 BOTTOM _ 210 WIDTH _ 290 HEIGHT _ 170) "FOO WINDOW")) creates a window titled "FOO WINDOW" on the color screen. To create a window on the black and white screen, the user should use SCREEN _ (MAINSCREEN) in the CREATE SCREENREGION expression. Note that it is still perfectly legal to pass in a REGION that is a region, not a screenregion, to CREATEW, but it is preferable to be passing screenregions rather than regions to CREATEW. This is because when REGION is a region, REGION is disambiguated in a somewhat arbitrary manner that may not always turn out to be what the user was hoping for. When REGION is a region, REGION is disambiguated by coercing REGION to be a screenregion on the screen which currently contains the cursor. This is so that software calling CREATEW with regions instead of screenregions tends to do the right thing in a user environment with multiple screens. 1 (WINDOWPROP WINDOW PROP NEWVALUE) [NoSpread Function] 1 If PROP='SCREEN, then WINDOWPROP returns the screen WINDOW is on. If NEWVALUE is given, (even if given as NIL), with PROP='SCREEN, then WINDOWPROP will generate an error. Any other PROP name is handled in the usual way. 1 (OPENWINDOWS SCREEN) [Function] 1 Returns a list of all open windows on SCREEN if SCREEN is a screen datatype such as (MAINSCREEN) or (COLORSCREEN). If SCREEN=NIL, then SCREEN will default to the screen containing the cursor. If SCREEN=T, then a list of all open windows on all screens is returned. 1 2 Color Fonts 1 The user can create color fonts and specify in the font profile that certain color fonts be used when printing in color. Color Font Creation 1 The user can create and manipulate color fonts through the same functions that are used to create and manipulate black and white fonts. This is made possible in some cases by there being new ways to call familiar font functions. (FONTCREATE FAMILY SIZE FACE ROTATION DEVICE NOERRORFLG CHARSET) [Function] 1 In addition to creating black and white fonts, FONTCREATE can be used to create color fonts. For example, (FONTCREATE 'GACHA 10 '(BOLD REGULAR REGULAR YELLOW BLUE) 0 '8DISPLAY) will create an 8 bit per pixel font with blue letters on a yellow background. The user indicates the color and bits per pixel of the font by the FACE and DEVICE arguments passed to FONTCREATE. DEVICE='8DISPLAY means to create an 8bpp font and DEVICE='4DISPLAY means to create a 4bpp font. A color font face is a 5 tuple, (WEIGHT SLOPE EXPANSION BACKCOLOR FORECOLOR) whereas a black and white font face is just a 3 tuple, (WEIGHT SLOPE EXPANSION) The FORECOLOR is the color of the characters of the font and the BACKCOLOR is the color of the background behind the characters that gets printed along with the characters. Both BACKCOLOR and FORECOLOR are allowed to a color name, color number, or any other legal color representation. A color font face can also be represented as a LITATOM. A three character atom such as MRR or any of the special atoms STANDARD, ITALIC, BOLD, BOLDITALIC can optionally be continued by hyphenating on BACKCOLOR and FORECOLOR suffixes. For example, MRR-YELLOW-BLUE BOLD-YELLOW-RED ITALIC-90-200 BRR-100-53 are acceptable color font faces. Hence, (FONTCREATE 'GACHA 10 'BOLD-YELLOW-BLUE 0 '8DISPLAY) will create a color font. LITATOM FACE arguments fall into one of the following patterns: wse wse-backcolor-forecolor STANDARD STANDARD-backcolor-forecolor ITALIC ITALIC-backcolor-forecolor BOLD BOLD-backcolor-forecolor BOLDITALIC BOLDITALIC-backcolor-forecolor where w=B, M, or L; s=I or R; e=R, C, or E; backcolor=a color name or color number; and forecolor=a color name or color number. 1 (FONTPROP FONT PROP) [Function] 1 Returns the value of the PROP property of font FONT. Besides black and white font properties, the following font properties are recognized: FORECOLOR The color of the characters of the font, represented as a color number. This is the color in which the characters of the font will print. BACKCOLOR The color of the background of the characters of the font, represented as a color number. This is the color in which the the background of characters of the font will print. A font with red characters on a yellow background would have a red FORECOLOR and a yellow BACKCOLOR. Color Font Profiles 1 Font profiles are the facility PRETTYPRINT uses to print different elements (user functions, system functions, clisp words, comments, etc.) in different fonts to emphasize (or deemphasize) their importance, and in general to provide for a more pleasing appearance. The user can specify that different colors of fonts be used for different kinds of elements when printing in color. A well chosen font profile will allows user to DEDIT functions, PP functions, and SEE source files in color, for example. A FONTPROFILE such as ((DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8) (4DISPLAY (GACHA 10 MRR-WHITE-RED)) (8DISPLAY (GACHA 10 MRR-WHITE-RED))) (BOLDFONT 2 (HELVETICA 10 BRR) (HELVETICA 8 BRR) (MODERN 8 BRR) (4DISPLAY (HELVETICA 10 BRR-WHITE-MAGENTA)) (8DISPLAY (HELVETICA 10 BRR-WHITE-MAGENTA))) (LITTLEFONT 3 (HELVETICA 8) (HELVETICA 6 MIR) (MODERN 8 MIR) (4DISPLAY (HELVETICA 8 MRR-WHITE-GREEN)) (8DISPLAY (HELVETICA 8 MRR-WHITE-GREEN))) (BIGFONT 4 (HELVETICA 12 BRR) (HELVETICA 10 BRR) (MODERN 10 BRR) (4DISPLAY (HELVETICA 12 BRR-WHITE-BLUE)) (8DISPLAY (HELVETICA 12 BRR-WHITE-BLUE))) (USERFONT BOLDFONT) (COMMENTFONT LITTLEFONT) (LAMBDAFONT BIGFONT) (SYSTEMFONT) (CLISPFONT BOLDFONT) ...) would have comments print in green and clisp words print in blue while ordinairy atoms would print in red. Not all combinations of fonts will be aesthetically pleasing and the user may have to experiment to find a compatible set. The user should indicate what font is to be used for each font class by calling the function FONTPROFILE: (FONTPROFILE PROFILE) [Function] 1 Sets up the font classes as determined by PROFILE, a list of elements which defines the correspondence between font classes and specific fonts. Each element of PROFILE is a list of the form: (FONTCLASS FONT# DISPLAYFONT PRESSFONT INTERPRESSFONT (OTHERDEVICE1 OTHERFONT1) ... (OTHERDEVICEn OTHERFONTn)) FONTCLASS is the font class name and FONT# is the font number for that class. DISPLAYFONT, PRESSFONT, and INTERPRESSFONT are font specifications (of the form accepted by FONTCREATE) for the fonts to use when printing to the black and white display and to Press and Interpress printers respectively. The appearance of color fonts can be affected by including an (OTHERDEVICEi OTHERFONTi) entry where OTHERDEVICEi is either 4DISPLAY or 8DISPLAY for a 4 bits per pixel or 8 bits per pixel color font and OTHERFONTi is a color font specification such as (GACHA 10 MRR-WHITE-RED). 1 FONTPROFILE [Variable] 1 This is the variable used to store the current font profile, in the form accepted by the function FONTPROFILE. Note that simply editing this value will not change the fonts used for the various font classes; it is necessary to execute (FONTPROFILE FONTPROFILE) to install the value of this variable. 1 2 Using Color 1 The current color implementation allows display streams to operate on color bitmaps. The two functions DSPCOLOR and DSPBACKCOLOR set the color in which a stream draws when the user defaults a color argument to a drawing function. (DSPCOLOR COLOR STREAM) [Function] sets the foreground color of a stream. It returns the previous foreground color. If COLOR is NIL, it returns the current foreground color without changing anything. The default foreground color is MINIMUMCOLOR=0, which is white in the default color maps. (DSPBACKCOLOR COLOR STREAM) [Function] sets the background color of a stream. It returns the previous background color. If COLOR is NIL, it returns the current background color without changing anything. The default background color is (MAXIMUMCOLOR BITSPERPIXEL)=15 or 255, which is black in the default color maps. The BITBLT, line-drawing routines, and curve-drawing routines routines know how to operate on a color-capable stream. Following are some notes about them. 2 BITBLTing in Color 1 If BITBLTing from a color bitmap onto another color bitmap of the same bpp, the operations PAINT, INVERT, and ERASE are done on a bit level, not on a pixel level. Thus painting color 3 onto color 10 results in color 11. If BITBLTing from a black-and-white bitmap onto a color bitmap, the one bits appear in the DSPCOLOR, and the zero bits in DSPBACKCOLOR. BLTing from black-and-white to color is fairly expensive; if the same bitmap is going to be put up several times in the same color, it is faster to create a color copy and then BLT the color copy. If the source type is TEXTURE and the destination bitmap is a color bitmap, the Texture argument is taken to be a color. Thus to fill an area with the color BLUE assuming COLORSTR is a stream whose destination is the color screen, use (BITBLT NIL NIL NIL COLORSTR 50 75 100 200 'TEXTURE 'REPLACE 'BLUE). 2 Drawing Curves and Lines in Color 1 For the functions DRAWCIRCLE, DRAWELLIPSE, and DRAWCURVE, the notion of a brush has been extended to include a color. A BRUSH is now (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR). Also, a brush can be a bitmap (which can be a color bitmap). Line-drawing routines take a color argument which is the color the line is to appear in if the destination of the display stream is a color bitmap. (DRAWLINE X1 Y1 X2 Y2 WIDTH OPERATION STREAM COLOR) [Function] (DRAWTO X Y WIDTH OPERATION STREAM COLOR) [Function] (RELDRAWTO X Y WIDTH OPERATION STREAM COLOR) [Function] (DRAWBETWEEN POS1 POS2 WIDTH OPERATION STREAM COLOR) [Function] If the COLOR argument is NIL, the DSPCOLOR of the stream is used. 2 Printing in Color 1 Printing only works in REPLACE mode. The characters have a background color and a foreground color determined by the font face of the font the characters are being printed with. Example of printing to an 8bpp color screen: (SETQ FOO (CREATEW (CREATE SCREENREGION SCREEN _ (COLORSCREEN) LEFT _ 20 BOTTOM _ 210 WIDTH _ 290 HEIGHT _ 170) "FOO WINDOW")) (DSPFONT (FONTCREATE 'GACHA 10 'MRR-YELLOW-GREEN 0 '8DISPLAY) FOO) (PRINT 'HELLO FOO) ; will print in green against a yellow background. 2 Operating the Cursor on the Color Screen 1 The cursor can be moved to the color screen. The cursor can be moved to the color screen by sliding the cursor off the left or right edge of the black and white screen on to the color screen or by calling function CURSORPOSITION or CURSORSCREEN. (CURSORPOSITION NEWPOSITION - -) [Function] 1 NEWPOSITION can be a position or a screenposition. (CURSORSCREEN SCREEN XCOORD YCOORD) [Function] 1 Moves the cursor to the screenposition determined by SCREEN, XCOORD, and YCOORD. SCREEN should be the value of either (COLORSCREEN) or (MAINSCREEN). While on the color screen, the cursor is placed by doing BITBLTs in software rather than with microcode and hardware as with the black and white cursor. It is automatically taken down whenever an operation is performed that changes any bits on the color screen. The speed of the color cursor compares well with that of the black and white cursor but there can be a noticeable flicker when there is much input/output to the color screen. While the cursor is on the color screen, the black-and-white cursor is cleared giving the appearance that there is never more than one cursor at a given time. 2 Miscellaneous Color Functions 1 (COLORIZEBITMAP BITMAP 0COLOR 1COLOR BITSPERPIXEL) [Function] creates a color bitmap from a black and white bitmap. The returned bitmap has color number 1COLOR in those pixels of BITMAP that were one and 0COLOR in those pixels of BITMAP that were zero. This provides a way of producing a color bitmap from a black and white bitmap. (UNCOLORIZEBITMAP BITMAP COLORMAP) [Function] creates a black and white bitmap from a color bitmap. (SHOWCOLORTESTPATTERN BARSIZE) [Function] displays a pattern of colors on the color display. This is useful when editing a color map. The pattern has squares of the 16 possible colors laid out in two rows at the top of the screen. Colors 0 through 7 are in the top row, and colors 8 through 15 are in the next row. The bottom part of the screen is filled with bars of BARSIZE width with consecutive color numbers. The pattern is designed so that every color has a border with every other color (unless BARSIZE is too large to allow room for every color%about 20). (LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 2) (0 0 612 792) ((FOLIO NIL ( PARALOOKS (QUAD LEFT) CHARLOOKS (SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF SLOPE REGULAR WEIGHT MEDIUM) FORMATINFO (ARABIC)) (54 12 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) ( 54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 618) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF SLOPE REGULAR WEIGHT MEDIUM) FORMATINFO (ARABIC)) (558 12 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE RECTOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL))) ( PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF SLOPE REGULAR WEIGHT MEDIUM) FORMATINFO (ARABIC)) (54 12 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) ( HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL)))))7 8 T(1()KKT/KT(5 nT/T/T/T/T/ T/2T/T/T/T.. /T/2T.. < PAGEHEADING VERSOHEAD< PAGEHEADING RECTOHEAD; PAGEHEADINGFOOTINGV; PAGEHEADINGFOOTINGR ?1(DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8)) +MODERNMODERN MODERNMODERNMODERN +MODERN +MODERN +MODERN + HRULE.GETFNMODERN +   HRULE.GETFNMODERN +    HRULE.GETFNMODERN +   HRULE.GETFNMODERN +    HRULE.GETFNMODERN HRULE.GETFNMODERN  HRULE.GETFNMODERN    f   f +  HRULE.GETFNMODERN. HRULE.GETFNMODERN   @   +   W  (   "  =  HRULE.GETFNMODERN  HRULE.GETFNMODERN   `   HRULE.GETFNMODERN     + ]  + >   &           HRULE.GETFNMODERN     +      ?   =          "      "  HRULE.GETFNMODERN  HRULE.GETFNMODERNy    D + q  B  -  i  (  _    L    *  X =     *     ?  N      HRULE.GETFNMODERN _    +8 -   + Z    +& 8 ,   S       =     m + +) + +  +   + /     ;    HRULE.GETFNMODERN HRULE.GETFNMODERN      v 4       ) E      HRULE.GETFNMODERN HRULE.GETFN, HRULE.GETFNMODERN  HRULE.GETFNMODERN       2  "  1  HRULE.GETFNMODERN +  + +    HRULE.GETFNMODERN  +  ' )  ) HRULE.GETFNMODERN    HRULE.GETFNMODERN +  ? "  4  HRULE.GETFNMODERN + -  HRULE.GETFNMODERN +    ? "  a  HRULE.GETFNMODERN + C  HRULE.GETFNMODERN +  ( BMOBJ.GETFN3 H  , BMOBJ.GETFN3 1 @      HRULE.GETFNMODERN + '  HRULE.GETFNMODERN +   HRULE.GETFNMODERN +  HRULE.GETFNMODERN HRULE.GETFNMODERN  IRM.GET.CREF ). As of the LUTE release of Xerox Lisp, it is possible for the user to create and use windows and menus on the color display. (CREATEW REGION TITLE BORDERSIZE NOOPENFLG) [Function] 1 Creates a new window. REGION indicates where and how large the window should be by specifying the exterior screenregion of the window. In a user environment with multiple screens, such as a black and white screen and color screen both connected to the same machine, there is a new special problem in indicating which screen the REGION is supposed to be a region of. This problem is solved by allowing CREATEW to take screenregion arguments as REGION. For example, (SETQ FOO (CREATEW (CREATE SCREENREGION SCREEN _ (COLORSCREEN) LEFT _ 20 BOTTOM _ 210 WIDTH _ 290 HEIGHT _ 170) ""FOO WINDOW")) creates a window titled "FOO WINDOW" on the color screen. To create a window on the black and white screen, the user should use SCREEN _ (MAINSCREEN) in the0CREATE SCREENREGION expression. Note that it is still perfectly legal to pass in a REGION that is a region, not a screenregion, to CREATEW, but it is preferable to be passing screenregions rather than regions to CREATEW. This is because when REGION is a region, REGION is disambiguated in a somewhat arbitrary manner that may not always turn out to be what the user was hoping for. When REGION is a region, REGION is disambiguated by coercing REGION to be a screenregion on the screen which currently contains the cursor. This is so that software calling CREATEW with regions instead of screenregions tends to do the right thing in a user environment with multiple screens. 1 (WINDOWPROP WINDOW PROP NEWVALUE) [NoSpread Function] 1 If PROP='SCREEN, then WINDOWPROP returns the screen WINDOW is on. If NEWVALUE is given, (even if given as NIL), with PROP='SCREEN, then WINDOWPROP will generate an error. Any other PROP name is handled in the usual way. 1 (OPENWINDOWS SCREEN) [Function] 1 Returns a list of all open windows on SCREEN if SCREEN is a screen datatype such as (MAINSCREEN) or (COLORSCREEN). If SCREEN=NIL, then SCREEN will default to the screen containing the cursor. If SCREEN=T, then a list of all open windows on all screens is returned. 1 2 Color Fonts 1 The user can create color fonts and specify in the font profile that certain color fonts be used when printing in color. Color Font Creation 1 The user can create and manipulate color fonts through the same functions that are used to create and manipulate black and white fonts. This is made possible in some cases by there being new ways to call familiar font functions. (FONTCREATE FAMILY SIZE FACE ROTATION DEVICE NOERRORFLG CHARSET) [Function] 1 In addition to creating black and white fonts, FONTCREATE can be used to create color fonts. For example, (FONTCREATE 'GACHA 10 '(BOLD REGULAR REGULAR YELLOW BLUE) 0 '8DISPLAY) will create an 8 bit per pixel font with blue letters on a yellow background. The user indicates the color and bits per pixel of the font by the FACE and DEVICE arguments passed to FONTCREATE. DEVICE='8DISPLAY means to create an 8bpp font and DEVICE='4DISPLAY means to create a 4bpp font. A color font face is a 5 tuple, (WEIGHT SLOPE EXPANSION BACKCOLOR FORECOLOR) whereas a black and white font face is just a 3 tuple, (WEIGHT SLOPE EXPANSION) The FORECOLOR is the color of the characters of the font and the BACKCOLOR is the color of the background behind the characters that gets printed along with the characters. Both BACKCOLOR and FORECOLOR are allowed to a color name, color number, or any other legal color representation. A color font face can also be represented as a LITATOM. A three character atom such as MRR or any of the special atoms STANDARD, ITALIC, BOLD, BOLDITALIC can optionally be continued by hyphenating on BACKCOLOR and FORECOLOR suffixes. For example, MRR-YELLOW-BLUE BOLD-YELLOW-RED ITALIC-90-200 BRR-100-53 are acceptable color font faces. Hence, (FONTCREATE 'GACHA 10 'BOLD-YELLOW-BLUE 0 '8DISPLAY) will create a color font. LITATOM FACE arguments fall into one of the following patterns: wse wse-backcolor-forecolor STANDARD STANDARD-backcolor-forecolor ITALIC ITALIC-backcolor-forecolor BOLD BOLD-backcolor-forecolor BOLDITALIC BOLDITALIC-backcolor-forecolor where w=B, M, or L; s=I or R; e=R, C, or E; backcolor=a color name or color number; and forecolor=a color name or color number. 1 (FONTPROP FONT PROP) [Function] 1 Returns the value of the PROP property of font FONT. Besides black and white font properties, the following font properties are recognized: FORECOLOR The color of the characters of the font, represented as a color number. This is the color in which the characters of the font will print. BACKCOLOR The color of the background of the characters of the font, represented as a color number. This is the color in which the the background of characters of the font will print. A font with red characters on a yellow background would have a red FORECOLOR and a yellow BACKCOLOR. Color Font Profiles 1 Font profiles are the facility PRETTYPRINT uses to print different elements (user functions, system functions, clisp words, comments, etc.) in different fonts to emphasize (or deemphasize) their importance, and in general to provide for a more pleasing appearance. The user can specify that different colors of fonts be used for different kinds of elements when printing in color. A well chosen font profile will allows user to DEDIT functions, PP functions, and SEE source files in color, for example. A FONTPROFILE such as ((DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8) (4DISPLAY (GACHA 10 MRR-WHITE-RED)) (8DISPLAY (GACHA 10 MRR-WHITE-RED))) (BOLDFONT 2 (HELVETICA 10 BRR) (HELVETICA 8 BRR) (MODERN 8 BRR) (4DISPLAY (HELVETICA 10 BRR-WHITE-MAGENTA)) (8DISPLAY (HELVETICA 10 BRR-WHITE-MAGENTA))) (LITTLEFONT 3 (HELVETICA 8) (HELVETICA 6 MIR) (MODERN 8 MIR) (4DISPLAY (HELVETICA 8 MRR-WHITE-GREEN)) (8DISPLAY (HELVETICA 8 MRR-WHITE-GREEN))) (BIGFONT 4 (HELVETICA 12 BRR) (HELVETICA 10 BRR) (MODERN 10 BRR) (4DISPLAY (HELVETICA 12 BRR-WHITE-BLUE)) (8DISPLAY (HELVETICA 12 BRR-WHITE-BLUE))) (USERFONT BOLDFONT) (COMMENTFONT LITTLEFONT) (LAMBDAFONT BIGFONT) (SYSTEMFONT) (CLISPFONT BOLDFONT) ...) would have comments print in green and clisp words print in blue while ordinairy atoms would print in red. Not all combinations of fonts will be aesthetically pleasing and the user may have to experimL to find a compatible set. The user should indicate what font is to be used for each font class by calling the function FONTPROFILE: (FONTPROFILE PROFILE) [Function] 1 Sets up the font classes as determined by PROFILE, a list of elements which defines the correspondence between font classes and specific fonts. Each element of PROFILE is a list of the form: (FONTCLASS FONT# DISPLAYFONT PRESSFONT INTERPRESSFONT (OTHERDEVICE1 OTHERFONT1) ... (OTHERDEVICEn OTHERFONTn)) FONTCLASS is the font class name and FONT# is the font number for that class. DISPLAYFONT, PRESSFONT, and INTERPRESSFONT are font specifications (of the form accepted by FONTCREATE) for the fonts to use when printing to the black and white display and to Press and Interpress printers respectively. The appearance of color fonts can be affected by including an (OTHERDEVICEi OTHERFONTi) entry where OTHERDEVICEi is either 4DISPLAY or 8DISPLAY for a 4 bits per pixel or 8 bits per pixel color font and OTHERFONTi is a color font specification such as (GACHA 10 MRR-WHITE-RED). 1 FONTPROFILE [Variable] 1 This is the variable used to store the current font profile, in the form accepted by the function FONTPROFILE. Note that simply editing this value will not change the fonts used for the various font classes; it is necessary to execute (FONTPROFILE FONTPROFILE) to install the value of this variable. 1 2 Using Color 1 The current color implementation allows display streams to operate on color bitmaps. The two functions DSPCOLOR and DSPBACKCOLOR set the color in which a stream draws when the user defaults a color argument to a drawing function. (DSPCOLOR COLOR STREAM) [Function] sets the foreground color of a stream. It returns the previous foreground color. If COLOR is NIL, it returns the current foreground color without changing anything. The default foreground color is MINIMUMCOLOR=0, which is white in the default color maps. (DSPBACKCOLOR COLOR STREAM) [Function] sets the background color of a stream. It returns the previous background color. If COLOR is NIL, it returns the current background color without changing anything. The default background color is (MAXIMUMCOLOR BITSPERPIXEL)=15 or 255, which is black in the default color maps. The BITBLT, line-drawing routines, and curve-drawing routines routines know how to operate on a color-capable stream. Following are some notes about them. 2 BITBLTing in Color 1 If BITBLTing from a color bitmap onto another color bitmap of the same bpp, the operations PAINT, INVERT, and ERASE are done on a bit level, not on a pixel level. Thus painting color 3 onto color 10 results in color 11. If BITBLTing from a black-and-white bitmap onto a color bitmap, the one bits appear in the DSPCOLOR, and the zero bits in DSPBACKCOLOR. BLTing from black-and-white to color is fairly expensive; if the same bitmap is going to be put up several times in the same color, it is faster to create a color copy and then BLT the color copy. If the source type is TEXTURE and the destination bitmap is a color bitmap, the Texture argument is taken to be a color. Thus to fill an area with the color BLUE assuming COLORSTR is a stream whose destination is the color screen, use (BITBLT NIL NIL NIL COLORSTR 50 75 100 200 'TEXTURE 'REPLACE 'BLUE). 2 Drawing Curves and Lines in Color 1 For the functions DRAWCIRCLE, DRAWELLIPSE, and DRAWCURVE, the notion of a brush has been extended to include a color. A BRUSH is now (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR). Also, a brush can be a bitmap (which can be a color bitmap). Line-drawing routines take a color argument which is the color the line is to appear in if the destination of the display stream is a color bitmap. (DRAWLINE X1 Y1 X2 Y2 WIDTH OPERATION STREAM COLOR) [Function] (DRAWTO X Y WIDTH OPERATION STREAM COLOR) [Function] (RELDRAWTO X Y WIDTH OPERATION STREAM COLOR) [Function] (DRAWBETWEEN POS1 POS2 WIDTH OPERATION STREAM COLOR) [Function] If the COLOR argument is NIL, the DSPCOLOR of the stream is used. 2 Printing in Color 1 Printing only works in REPLACE mode. The characters have a background color and a foreground color determined by the font face of the font the characters are being printed with. Example of printing to an 8bpp color screen: (SETQ FOO (CREATEW (CREATE SCREENREGION SCREEN _ (COLORSCREEN) @# tCcCcwCc  D + q  B  -  i  (  _    L    *  X =     *     ?  N      HRULE.GETFNMODERN _    +8 -   + Z    +& 8 ,   S       =     m + +) + +  +   + /     ;    HRULE.GETFNMODERN HRULE.GETFNMODERN      v 4       ) E      HRULE.GETFNMODERN HRULE.GETFN, HRULE.GETFNMODERN  HRULE.GETFNMODERN       2  "  1  HRULE.GETFNMODERN +  + +    HRULE.GETFNMODERN  +  ' )  ) HRULE.GETFNMODERN    HRULE.GETFNMODERN +  ? "  4  HRULE.GETFNMODERN + -  HRULE.GETFNMODERN +    ? "  a IOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF SLOPE REGULAR WEIGHT MEDIUM) FORMATINFO (ARABIC)) (54 12 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL))))); < T,5,-KKT3KT,9 nT3T3T3T3T3 T32T3T3T3T22 3T32T22 @ PAGEHEADING VERSOHEAD@ PAGEHEADING RECTOHEAD? PAGEHEADINGFOOTINGV? PAGEHEADINGFOOTINGR ?1(DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8)) +MODERNMODERN MODERNMODERNMODERN +MODERN +MODERN +MODERN + HRULE.GETFNMODERN +   HRULE.GETFNMODERN +    HRULE.GETFNMODERN +   HRULE.GETFNMODERN +    HRULE.GETFNMODERN HRULE.GETFNMODERN  HRULE.GETFNMODERN    K f    HRULE.GETFNMODERN' HRULE.GETFNMODERN + @    HRULE.GETFNMODERN. HRULE.GETFNMODERN   @   +   W  (   "  =  HRULE.GETFNMODERN  HRULE.GETFNMODERN +    `   HRULE.GETFNMODERN     + ]  + >   &           HRULE.GETFNMODERN     +      ?   =          "      "  HRULE.GETFNMODERN  HRULE.GETFNMODERNy    D + q  B  -  i  (  _    L    *  X =     *     ?  N      HRULE.GETFNMODERN _    +8 -   + Z    +& 8 ,   S       =     m + +) + +  +   + /     ;    HRULE.GETFNMODERN HRULE.GETFNMODERN      v 4       ) E      HRULE.GETFNMODERN HRULE.GETFN, HRULE.GETFNMODERN  HRULE.GETFNMODERN       2  "  1  HRULE.GETFNMODERN +  + +    HRULE.GETFNMODERN  +  ' )  ) HRULE.GETFNMODERN    HRULE.GETFNMODERN +  ? "  4  HRULE.GETFNMODERN + -  HRULE.GETFNMODERN +    ? "  a  HRULE.GETFNMODERN + C  HRULE.GETFNMODERN +  ( BMOBJ.GETFN3 H  , BMOBJ.GETFN3 1 @      HRULE.GETFNMODERN + '  HRULE.GETFNMODERN +   HRULE.GETFNMODERN +  HRULE.GETFNMODERN HRULE.GETFNMODERN a IRM.GET.CREF ` ). As of the LUTE release of Xerox Lisp, it is possible for the user to create and use windows and menus on the color display. (CREATEW REGION TITLE BORDERSIZE NOOPENFLG) [Function] 1 Creates a new window. REGION indicates where and how large the window should be by specifying the exterior screenregion of the window. In a user environment with multiple screens, such as a black and white screen and color screen both connected to the same machine, there is a new special problem in indicating which screen the REGION is supposed to be a region of. This problem is solved by allowing CREATEW to take screenregion arguments as REGION. For example, (SETQ FOO (CREATEW (CREATE SCREENREGION SCREEN _ (COLORSCREEN) LEFT _ 20 BOTTOM _ 210 WIDTH _ 290 HEIGHT _ 170) "FOO WINDOW")) creates a window titled "FOO WINDOW" on the color screen. To create a window on the black and white screen, the user should use SCREEN _ (MAINSCREEN) in the CREATE SCREENREGION expression. Note that it is still perfectly legal to pass in a REGION that is a region, not a screenregion, to CREATEW, but it is preferable to be passing screenregions rather than regions to CREATEW. This is because when REGION is a region, REGION is disambiguated in a somewhat arbitrary manner that may not always turn out to be what the user was hoping for. When REGION is a region, REGION is disambiguated by coercing REGION to be a screenregion on the screen which currently contains the cursor. This is so that software calling CREATEW with regions instead of screenregions tends to do the right thing in a user environment with multiple screens. 1 (WINDOWPROP WINDOW PROP NEWVALUE) [NoSpread Function] 1 If PROP='SCREEN, then WINDOWPROP returns the screen WINDOW is on. If NEWVALUE is given, (even if given as NIL), with PROP='SCREEN, then WINDOWPROP will generate an error. Any other PROP name is handled in the usual way. 1 (OPENWINDOWS SCREEN) [Function] 1 Returns a list of all open windows on SCREEN if SCREEN is a screen datatype such as (MAINSCREEN) or (COLORSCREEN). If SCREEN=NIL, then SCREEN will default to the screen containing the cursor. If SCREEN=T, then a list of all open windows on all screens is returned. 1 2 Color Fonts 1 The user can create color fonts and specify in the font profile that certain color fonts be used when printing in color. Color Font Creation 1 The user can create and manipulate color fonts through the same functions that are used to create and manipulate black and white fonts. This is made possible in some cases by there being new ways to call familiar font functions. (FONTCREATE FAMILY SIZE FACE ROTATION DEVICE NOERRORFLG CHARSET) [Function] 1 In addition to creating black and white fonts, FONTCREATE can be used to create color fonts. For example, (FONTCREATE 'GACHA 10 '(BOLD REGULAR REGULAR YELLOW BLUE) 0 '8DISPLAY) will create an 8 bit per pixel font with blue letters on a yellow background. The user indicates the color and bits per pixel of the font by the FACE and DEVICE arguments passed to FONTCREATE. DEVICE='8DISPLAY means to create an 8bpp font and DEVICE='4DISPLAY means to create a 4bpp font. A color font face is a 5 tuple, (WEIGHT SLOPE EXPANSION BACKCOLOR FORECOLOR) whereas a black and white font face is just a 3 tuple, (WEIGHT SLOPE EXPANSION) The FORECOLOR is the color of the characters of the font and the BACKCOLOR is the color of the background behind the characters that gets printed along with the characters. Both BACKCOLOR and FORECOLOR are allowed to a color name, color number, or any other legal color representation. A color font face can also be represented as a LITATOM. A three character atom such as MRR or any of the special atoms STANDARD, ITALIC, BOLD, BOLDITALIC can optionally be continued by hyphenating on BACKCOLOR and FORECOLOR suffixes. For example, MRR-YELLOW-BLUE BOLD-YELLOW-RED ITALIC-90-200 BRR-100-53 are acceptable color font faces. Hence, (FONTCREATE 'GACHA 10 'BOLD-YELLOW-BLUE 0 '8DISPLAY) will create a color font. LITATOM FACE arguments fall into one of the following patterns: wse wse-backcolor-forecolor STANDARD STANDARD-backcolor-forecolor ITALIC ITALIC-backcolor-forecolor BOLD BOLD-backcolor-forecolor BOLDITALIC BOLDITALIC-backcolor-forecolor where w=B, M, or L; s=I or R; e=R, C, or E; backcolor=a color name or color number; and forecolor=a color name or color number. 1 (FONTPROP FONT PROP) [Function] 1 Returns the value of the PROP property of font FONT. Besides black and white font properties, the following font properties are recognized: FORECOLOR The color of the characters of the font, represented as a color number. This is the color in which the characters of the font will print. BACKCOLOR The color of the background of the characters of the font, represented as a color number. This is the color in which the the background of characters of the font will print. A font with red characters on a yellow background would have a red FORECOLOR and a yellow BACKCOLOR. Color Font Profiles 1 Font profiles are the facility PRETTYPRINT uses to print different elements (user functions, system functions, clisp words, comments, etc.) in different fonts to emphasize (or deemphasize) their importance, and in general to provide for a more pleasing appearance. The user can specify that different colors of fonts be used for different kinds of elements when printing in color. A well chosen font profile will allows user to DEDIT functions, PP functions, and SEE source files in color, for example. A FONTPROFILE such as ((DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8) (4DISPLAY (GACHA 10 MRR-WHITE-RED)) (8DISPLAY (GACHA 10 MRR-WHITE-RED))) (BOLDFONT 2 (HELVETICA 10 BRR) (HELVETICA 8 BRR) (MODERN 8 BRR) (4DISPLAY (HELVETICA 10 BRR-WHITE-MAGENTA)) (8DISPLAY (HELVETICA 10 BRR-WHITE-MAGENTA))) (LITTLEFONT 3 (HELVETICA 8) (HELVETICA 6 MIR) (MODERN 8 MIR) (4DISPLAY (HELVETICA 8 MRR-WHITE-GREEN)) (8DISPLAY (HELVETICA 8 MRR-WHITE-GREEN))) (BIGFONT 4 (HELVETICA 12 BRR) (HELVETICA 10 BRR) (MODERN 10 BRR) (4DISPLAY (HELVETICA 12 BRR-WHITE-BLUE)) (8DISPLAY (HELVETICA 12 BRR-WHITE-BLUE))) (USERFONT BOLDFONT) (COMMENTFONT LITTLEFONT) (LAMBDAFONT BIGFONT) (SYSTEMFONT) (CLISPFONT BOLDFONT) ...) would have comments print in green and clisp words print in blue while ordinairy atoms would print in red. Not all combinations of fonts will be aesthetically pleasing and the user may have to experiment to find a compatible set. The user should indicate what font is to be used for each font class by calling the function FONTPROFILE: (FONTPROFILE PROFILE) [Function] 1 Sets up the font classes as determined by PROFILE, a list of elements which defines the correspondence between font classes and specific fonts. Each element of PROFILE is a list of the form: (FONTCLASS FONT# DISPLAYFONT PRESSFONT INTERPRESSFONT (OTHERDEVICE1 OTHERFONT1) ... (OTHERDEVICEn OTHERFONTn)) FONTCLASS is the font class name and FONT# is the font number for that class. DISPLAYFONT, PRESSFONT, and INTERPRESSFONT are font specifications (of the form accepted by FONTCREATE) for the fonts to use when printing to the black and white display and to Press and Interpress printers respectively. The appearance of color fonts can be affected by including an (OTHERDEVICEi OTHERFONTi) entry where OTHERDEVICEi is either 4DISPLAY or 8DISPLAY for a 4 bits per pixel or 8 bits per pixel color font and OTHERFONTi is a color font specification such as (GACHA 10 MRR-WHITE-RED). 1 FONTPROFILE [Variable] 1 This is the variable used to store the current font profile, in the form accepted by the function FONTPROFILE. Note that simply editing this value will not change the fonts used for the various font classes; it is necessary to execute (FONTPROFILE FONTPROFILE) to install the value of this variable. 1 2 Using Color 1 The current color implementation allows display streams to operate on color bitmaps. The two functions DSPCOLOR and DSPBACKCOLOR set the color in which a stream draws when the user defaults a color argument to a drawing function. (DSPCOLOR COLOR STREAM) [Function] sets the foreground color of a stream. It returns the previous foreground color. If COLOR is NIL, it returns the current foreground color without changing anything. The default foreground color is MINIMUMCOLOR=0, which is white in the default color maps. (DSPBACKCOLOR COLOR STREAM) [Function] sets the background color of a stream. It returns the previous background color. If COLOR is NIL, it returns the current background color without changing anything. The default background color is (MAXIMUMCOLOR BITSPERPIXEL)=15 or 255, which is black in the default color maps. The BITBLT, line-drawing routines, and curve-drawing routines routines know how to operate on a color-capable stream. Following are some notes about them. 2 BITBLTing in Color 1 If BITBLTing from a color bitmap onto another color bitmap of the same bpp, the operations PAINT, INVERT, and ERASE are done on a bit level, not on a pixel level. Thus painting color 3 onto color 10 results in color 11. If BITBLTing from a black-and-white bitmap onto a color bitmap, the one bits appear in the DSPCOLOR, and the zero bits in DSPBACKCOLOR. BLTing from black-and-white to color is fairly expensive; if the same bitmap is going to be put up several times in the same color, it is faster to create a color copy and then BLT the color copy. If the source type is TEXTURE and the destination bitmap is a color bitmap, the Texture argument is taken to be a color. Thus to fill an area with the color BLUE assuming COLORSTR is a stream whose destination is the color screen, use (BITBLT NIL NIL NIL COLORSTR 50 75 100 200 'TEXTURE 'REPLACE 'BLUE). 2 Drawing Curves and Lines in Color 1 For the functions DRAWCIRCLE, DRAWELLIPSE, and DRAWCURVE, the notion of a brush has been extended to include a color. A BRUSH is now (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR). Also, a brush can be a bitmap (which can be a color bitmap). Line-drawing routines take a color argument which is the color the line is to appear in if the destination of the display stream is a color bitmap. (DRAWLINE X1 Y1 X2 Y2 WIDTH OPERATION STREAM COLOR) [Function] (DRAWTO X Y WIDTH OPERATION STREAM COLOR) [Function] (RELDRAWTO X Y WIDTH OPERATION STREAM COLOR) [Function] (DRAWBETWEEN POS1 POS2 WIDTH OPERATION STREAM COLOR) [Function] If the COLOR argument is NIL, the DSPCOLOR of the stream is used. 2 Printing in Color 1 Printing only works in REPLACE mode. The characters have a background color and a foreground color determined by the font face of the font the characters are being printed with. Example of printing to an 8bpp color screen: (SETQ FOO (CREATEW (CREATE SCREENREGION SCREEN _ (COLORSCREEN) LEFT _ 20 BOTTOM _ 210 WIDTH _ 290 HEIGHT _ 170) "FOO WINDOW")) (DSPFONT (FONTCREATE 'GACHA 10 'MRR-YELLOW-GREEN 0 '8DISPLAY) FOO) (PRINT 'HELLO FOO) ; will print in green against a yellow background. 2 Operating the Cursor on the Color Screen 1 The cursor can be moved to the color screen. The cursor can be moved to the color screen by sliding the cursor off the left or right edge of the black and white screen on to the color screen or by calling function CURSORPOSITION or CURSORSCREEN. (CURSORPOSITION NEWPOSITION - -) [Function] 1 NEWPOSITION can be a position or a screenposition. (CURSORSCREEN SCREEN XCOORD YCOORD) [Function] 1 Moves the cursor to the screenposition determined by SCREEN, XCOORD, and YCOORD. SCREEN should be the value of either (COLORSCREEN) or (MAINSCREEN). While on the color screen, the cursor is placed by doing BITBLTs in software rather than with microcode and hardware as with the black and white cursor. It is automatically taken down whenever an operation is performed that changes any bits on the color screen. The speed of the color cursor compares well with that of the black and white cursor but there can be a noticeable flicker when there is much input/output to the color screen. While the cursor is on the color screen, the black-and-white cursor is cleared giving the appearance that there is never more than one cursor at a given time. 2 Miscellaneous Color Functions 1 (COLORIZEBITMAP BITMAP 0COLOR 1COLOR BITSPERPIXEL) [Function] creates a color bitmap from a black and white bitmap. The returned bitmap has color number 1COLOR in those pixels of BITMAP that were one and 0COLOR in those pixels of BITMAP that were zero. This provides a way of producing a color bitmap from a black and white bitmap. (UNCOLORIZEBITMAP BITMAP COLORMAP) [Function] creates a black and white bitmap from a color bitmap. (SHOWCOLORTESTPATTERN BARSIZE) [Function] displays a pattern of colors on the color display. This is useful when editing a color map. The pattern has squares of the 16 possible colors laid out in two rows at the top of the screen. Colors 0 through 7 are in the top row, and colors 8 through 15 are in the next row. The bottom part of the screen is filled with bars of BARSIZE width with consecutive color numbers. The pattern is designed so that every color has a border with every other color (unless BARSIZE is too large to allow room for every color%about 20). (LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 2) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF SLOPE REGULAR WEIGHT MEDIUM) FORMATINFO (ARABIC)) (54 12 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 618) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF SLOPE REGULAR WEIGHT MEDIUM) FORMATINFO (ARABIC)) (558 12 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE RECTOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF SLOPE REGULAR WEIGHT MEDIUM) FORMATINFO (ARABIC)) (54 12 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL))))); < T,5,-KKT3KT,9 nT3T3T3T3T3 T32T3T3T3T22 3T32T22 @ PAGEHEADING VERSOHEAD@ PAGEHEADING RECTOHEAD? PAGEHEADINGFOOTINGV? PAGEHEADINGFOOTINGROPTIMA OPTIMAOPTIMA +OPTIMA +OPTIMA +OPTIMAOPTIMAOPTIMA + HRULE.GETFNOPTIMA +- HRULE.GETFNOPTIMA +- HRULE.GETFNOPTIMA + HRULE.GETFNOPTIMA +   HRULE.GETFNOPTIMA HRULE.GETFNOPTIMA  HRULE.GETFNOPTIMAKf HRULE.GETFNOPTIMA' HRULE.GETFNOPTIMA +@ HRULE.GETFNOPTIMA. HRULE.GETFNOPTIMA  @  + W("= HRULE.GETFNOPTIMA  HRULE.GETFNOPTIMA +` HRULE.GETFNOPTIMA   +] +> & HRULE.GETFNOPTIMA   +  ?=  "  " HRULE.GETFNOPTIMA  HRULE.GETFNOPTIMAy   D +q B - k ( a   N  *  X =    *  ? N    HRULE.GETFNOPTIMA _  +8 -  + Z  +&8, S  =  m + +) + +   +  + /; HRULE.GETFNOPTIMA HRULE.GETFNOPTIMA  v 4   ) E   HRULE.GETFNOPTIMA HRULE.GETFN, HRULE.GETFNOPTIMA HRULE.GETFNOPTIMA     2 "1 HRULE.GETFNOPTIMA +++  HRULE.GETFNOPTIMA  +')) HRULE.GETFNOPTIMA  HRULE.GETFNOPTIMA +?"4 HRULE.GETFNOPTIMA +- HRULE.GETFNOPTIMA + ?"a HRULE.GETFNOPTIMA +C HRULE.GETFNOPTIMA +( BMOBJ.GETFN3H, BMOBJ.GETFN31@     HRULE.GETFNOPTIMA +' HRULE.GETFNOPTIMA + HRULE.GETFNOPTIMA + HRULE.GETFNOPTIMA HRULE.GETFNOPTIMA#4 IRM.GET.CREF ? IRM.GET.CREF ! HRULE.GETFNOPTIMA +-n(`SVUWEs HRULE.GETFNOPTIMA +  HRULE.GETFNOPTIMA +- (=" HRULE.GETFNOPTIMA +  HRULE.GETFNOPTIMA +&A 7@ HRULE.GETFNOPTIMA + HRULE.GETFNOPTIMA  HRULE.GETFNOPTIMAy HRULE.GETFNOPTIMA  3 HRULE.GETFNOPTIMA +kK4D27):[81863 HRULE.GETFNOPTIMA + +  HRULE.GETFNOPTIMA +Z   HRULE.GETFNOPTIMA     78%"<="$!;<$"89 k{k  HRULE.GETFNOPTIMA +*p    %    [ +C HRULE.GETFNOPTIMA +  HRULE.GETFNOPTIMA + E HRULE.GETFNOPTIMA + HRULE.GETFNOPTIMA  HRULE.GETFNOPTIMA  V W HRULE.GETFNOPTIMA HRULE.GETFNOPTIMANP HRULE.GETFNOPTIMA" HRULE.GETFNOPTIMA  +&     + +-   +5 5 HRULE.GETFNOPTIMA HRULE.GETFNOPTIMA-(`SVUWE=M=GF HRULE.GETFNOPTIMA) HRULE.GETFNOPTIMA  HRULE.GETFNOPTIMA + ( HRULE.GETFNOPTIMA +5>W HRULE.GETFNOPTIMA HRULE.GETFNOPTIMA ! \a  6  J+}z \ No newline at end of file diff --git a/library/COPYFILES.TEDIT b/library/COPYFILES.TEDIT new file mode 100644 index 00000000..a2682989 Binary files /dev/null and b/library/COPYFILES.TEDIT differ diff --git a/library/DATABASEFNS.TEDIT b/library/DATABASEFNS.TEDIT new file mode 100644 index 00000000..0df4e70f Binary files /dev/null and b/library/DATABASEFNS.TEDIT differ diff --git a/library/DEDIT.TEDIT b/library/DEDIT.TEDIT new file mode 100644 index 00000000..9dd91f7a Binary files /dev/null and b/library/DEDIT.TEDIT differ diff --git a/library/EDITBITMAP.TEDIT b/library/EDITBITMAP.TEDIT new file mode 100644 index 00000000..0830a2cd Binary files /dev/null and b/library/EDITBITMAP.TEDIT differ diff --git a/library/ETHERRECORDS.TEDIT b/library/ETHERRECORDS.TEDIT new file mode 100644 index 00000000..a920cb46 Binary files /dev/null and b/library/ETHERRECORDS.TEDIT differ diff --git a/library/FILEBROWSER b/library/FILEBROWSER index 13e9a48f..2b93aaab 100644 --- a/library/FILEBROWSER +++ b/library/FILEBROWSER @@ -1,13 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED " 4-Aug-2022 09:32:02" |{DSK}larry>medley>library>FILEBROWSER.;2| 266567 +(FILECREATED "18-Jul-2023 22:19:30" |{WMEDLEY}FILEBROWSER.;24| 266436 - :CHANGES-TO (VARS FILEBROWSERCOMS) + :EDIT-BY |rmk| - :PREVIOUS-DATE " 2-Dec-2021 19:33:12" |{DSK}larry>medley>library>FILEBROWSER.;1|) + :CHANGES-TO (FNS FB.COPYFN) + :PREVIOUS-DATE " 4-Aug-2022 09:32:02" |{WMEDLEY}FILEBROWSER.;23|) -; Copyright (c) 1983-1991, 1993-1994, 1999-2001, 2021 by Venue & Xerox Corporation. (PRETTYCOMPRINT FILEBROWSERCOMS) @@ -463,8 +463,7 @@ Your deletions are thus ignored."))) (* \; "Entries") -(DEFCOMMAND "fb" (&REST PAT&PROPS) - (APPLY 'FB PAT&PROPS)) +(DEFCOMMAND "fb" (&REST PAT&PROPS) (APPLY 'FB PAT&PROPS)) (DEFINEQ (FB @@ -943,8 +942,9 @@ Your deletions are thus ignored."))) (AND OLDFONT (DSPFONT OLDFONT STREAM))))) (FB.COPYFN - (LAMBDA (TBROWSER ITEM) (* |bvm:| "13-Oct-85 17:44") - (BKSYSBUF (|fetch| (FBFILEDATA FILENAME) |of| (|fetch| TIDATA |of| ITEM))))) + (LAMBDA (TBROWSER ITEM) (* \; "Edited 18-Jul-2023 22:19 by rmk") + (* |bvm:| "13-Oct-85 17:44") + (COPYINSERT (|fetch| (FBFILEDATA FILENAME) |of| (|fetch| TIDATA |of| ITEM))))) ) @@ -4253,54 +4253,52 @@ then click Recompute")))) (ADDTOVAR LAMA FB.PROMPTW.FORMAT FB.PROMPTWPRINT) ) -(PUTPROPS FILEBROWSER COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 -1991 1993 1994 1999 2000 2001 2021)) (DECLARE\: DONTCOPY - (FILEMAP (NIL (32375 55256 (FB 32385 . 33520) (FB.COPYBINARYCOMMAND 33522 . 33868) (FB.COPYTEXTCOMMAND - 33870 . 34212) (FILEBROWSER 34214 . 47320) (FB.TABLEBROWSER 47322 . 47539) (FB.SELECTEDFILES 47541 . -48178) (FB.FETCHFILENAME 48180 . 48572) (FB.DIRECTORYP 48574 . 48968) (FB.PROMPTWPRINT 48970 . 50016) -(FB.PROMPTW.FORMAT 50018 . 50755) (FB.PROMPTFORINPUT 50757 . 53009) (FB.YES-OR-NO-P 53011 . 54045) ( -FB.ALLOW.ABORT 54047 . 54901) (\\FB.HARDCOPY.TOFILE.EXTENSION 54903 . 55254)) (55280 56233 (FB.STARTUP - 55290 . 55805) (FB.MAKERIGIDWINDOW 55807 . 56231)) (56234 61606 (FB.PRINTFN 56244 . 61397) (FB.COPYFN - 61399 . 61604)) (61656 67996 (FB.MENU.WHENSELECTEDFN 61666 . 62024) (FB.COMMANDSELECTEDFN 62026 . -63565) (FB.SUBITEMP 63567 . 64168) (FB.MAKE.BROWSER.BUSY 64170 . 64974) (FB.FINISH.COMMAND 64976 . -67007) (FB.HANDLE.ABORT.BUTTON 67009 . 67994)) (67997 73513 (FB.DELETECOMMAND 68007 . 68288) ( -FB.DELVERCOMMAND 68290 . 71483) (FB.IS.NOT.SUBDIRECTORY.ITEM 71485 . 71666) (FB.DELVER.FILES 71668 . -72757) (FB.DELETE.FILE 72759 . 73511)) (73514 74839 (FB.UNDELETECOMMAND 73524 . 73809) ( -FB.UNDELETEALLCOMMAND 73811 . 74090) (FB.UNDELETE.FILE 74092 . 74837)) (74840 99021 (FB.COPYCOMMAND -74850 . 75119) (FB.RENAMECOMMAND 75121 . 75396) (FB.COPY/RENAME.COMMAND 75398 . 76321) ( -FB.COPY/RENAME.ONE 76323 . 78645) (FB.COPY/RENAME.MANY 78647 . 84867) (FB.MERGE.DIRECTORIES 84869 . -85287) (FB.GREATEST.PREFIX 85289 . 86645) (FB.MAYBE.INSERT.FILE 86647 . 94087) (FB.GET.NEW.FILE.SPEC -94089 . 97920) (FB.CANONICAL.DIRECTORY 97922 . 99019)) (99022 106806 (FB.HARDCOPYCOMMAND 99032 . -100162) (FB.HARDCOPY.TOFILE 100164 . 106804)) (106807 117006 (FB.EDITCOMMAND 106817 . 107684) ( -FB.EDITCOMMAND.ONEFILE 107686 . 111090) (FB.EDITLISPFILE 111092 . 112197) (FB.BROWSECOMMAND 112199 . -117004)) (117007 128928 (FB.FASTSEECOMMAND 117017 . 120467) (FB.FASTSEE.ONEFILE 120469 . 123626) ( -FB.SEEFULLFN 123628 . 127759) (FB.SEEBUTTONFN 127761 . 128926)) (128929 130675 (FB.LOADCOMMAND 128939 - . 129446) (FB.COMPILECOMMAND 129448 . 129986) (FB.OPERATE.ON.FILES 129988 . 130673)) (130676 178861 ( -FB.UPDATECOMMAND 130686 . 130911) (FB.FIX-DIRECTORY-DATES 130913 . 131936) (FB.MAYBE.EXPUNGE 131938 . -132999) (FB.UPDATEBROWSERITEMS 133001 . 146216) (FB.DATE 146218 . 146859) (FB.ADJUST.DATE.WIDTH 146861 - . 149829) (FB.SET.BROWSER.TITLE 149831 . 150833) (FB.MAYBE.WIDEN.NAMES 150835 . 152954) ( -FB.SET.DEFAULT.NAME.WIDTH 152956 . 154320) (FB.CREATE.FILEBUCKET 154322 . 161542) ( -FB.CHECK.NAME.LENGTH 161544 . 163965) (FB.ADD.FILEGROUP 163967 . 165494) (FB.INSERT.DIRECTORY 165496 - . 165734) (FB.MAKE.SUBDIRECTORY.ITEM 165736 . 167145) (FB.ADD.FILE 167147 . 167760) (FB.INSERT.FILE -167762 . 171174) (FB.ANALYZE.PATTERN 171176 . 176440) (FB.CANONICALIZE.PATTERN 176442 . 177754) ( -FB.GETALLFILEINFO 177756 . 178859)) (178862 187021 (FB.SORT.VERSIONS 178872 . 181643) ( -FB.DECREASING.VERSION 181645 . 182314) (FB.INCREASING.VERSION 182316 . 182937) ( -FB.NAMES.DECREASING.VERSION 182939 . 183974) (FB.NAMES.INCREASING.VERSION 183976 . 184973) ( -FB.DECREASING.NUMERIC.ATTR 184975 . 185655) (FB.INCREASING.NUMERIC.ATTR 185657 . 186331) ( -FB.ALPHABETIC.ATTR 186333 . 187019)) (187022 196864 (FB.SORTCOMMAND 187032 . 193862) ( -FB.INSERT.SUBDIRECTORIES 193864 . 194661) (FB.GET.SORT.MENU 194663 . 196862)) (196865 213086 ( -FB.EXPUNGECOMMAND 196875 . 199460) (FB.NEWPATTERNCOMMAND 199462 . 199860) (FB.NEWINFOCOMMAND 199862 . -202694) (FB.DEPTHCOMMAND 202696 . 204471) (FB.SHAPECOMMAND 204473 . 207815) (FB.REMOVE.FILE 207817 . -209638) (FB.COUNT.FILE.CHANGE 209640 . 211085) (FB.SETNEWPATTERN 211087 . 212257) (FB.GET.NEWPATTERN -212259 . 212843) (FB.OPTIONSCOMMAND 212845 . 213084)) (213121 214174 (FB.GETWINDOW 213131 . 214172)) ( -214175 215187 (FB.INFOMENU.SHADEINITIALSELECTIONS 214185 . 214832) (FB.INFO.ITEM.NAMED 214834 . 215185 -)) (215188 224720 (FB.MAKECOUNTERWINDOW 215198 . 216726) (FB.COUNTERW.REDISPLAYFN 216728 . 217315) ( -FB.UPDATE.COUNTERS 217317 . 219389) (FB.DISPLAY.COUNTERS 219391 . 224451) (FB.COUNTER.STRING 224453 . -224718)) (224721 229430 (FB.MAKEHEADINGWINDOW 224731 . 226345) (FB.HEADINGW.REDISPLAYFN 226347 . -226613) (FB.HEADINGW.RESHAPEFN 226615 . 226991) (FB.HEADINGW.DISPLAY 226993 . 229428)) (229431 233614 -(FB.ICONFN 229441 . 229788) (FB.INFOMENU.WHENSELECTEDFN 229790 . 230520) (FB.CLOSEFN 230522 . 231725) -(FB.EXPUNGE?.MENU 231727 . 232139) (FB.AFTERCLOSEFN 232141 . 232502) (FB.CLOSE&EXPUNGE 232504 . 233612 -)) (233615 245673 (FB.HARDCOPY.DIRECTORY 233625 . 243982) (FB.HARDCOPY.PRINT.TITLE 243984 . 244310) ( -FB.HARDCOPY.MAXWIDTH 244312 . 245671))))) + (FILEMAP (NIL (32272 55153 (FB 32282 . 33417) (FB.COPYBINARYCOMMAND 33419 . 33765) (FB.COPYTEXTCOMMAND + 33767 . 34109) (FILEBROWSER 34111 . 47217) (FB.TABLEBROWSER 47219 . 47436) (FB.SELECTEDFILES 47438 . +48075) (FB.FETCHFILENAME 48077 . 48469) (FB.DIRECTORYP 48471 . 48865) (FB.PROMPTWPRINT 48867 . 49913) +(FB.PROMPTW.FORMAT 49915 . 50652) (FB.PROMPTFORINPUT 50654 . 52906) (FB.YES-OR-NO-P 52908 . 53942) ( +FB.ALLOW.ABORT 53944 . 54798) (\\FB.HARDCOPY.TOFILE.EXTENSION 54800 . 55151)) (55177 56130 (FB.STARTUP + 55187 . 55702) (FB.MAKERIGIDWINDOW 55704 . 56128)) (56131 61614 (FB.PRINTFN 56141 . 61294) (FB.COPYFN + 61296 . 61612)) (61664 68004 (FB.MENU.WHENSELECTEDFN 61674 . 62032) (FB.COMMANDSELECTEDFN 62034 . +63573) (FB.SUBITEMP 63575 . 64176) (FB.MAKE.BROWSER.BUSY 64178 . 64982) (FB.FINISH.COMMAND 64984 . +67015) (FB.HANDLE.ABORT.BUTTON 67017 . 68002)) (68005 73521 (FB.DELETECOMMAND 68015 . 68296) ( +FB.DELVERCOMMAND 68298 . 71491) (FB.IS.NOT.SUBDIRECTORY.ITEM 71493 . 71674) (FB.DELVER.FILES 71676 . +72765) (FB.DELETE.FILE 72767 . 73519)) (73522 74847 (FB.UNDELETECOMMAND 73532 . 73817) ( +FB.UNDELETEALLCOMMAND 73819 . 74098) (FB.UNDELETE.FILE 74100 . 74845)) (74848 99029 (FB.COPYCOMMAND +74858 . 75127) (FB.RENAMECOMMAND 75129 . 75404) (FB.COPY/RENAME.COMMAND 75406 . 76329) ( +FB.COPY/RENAME.ONE 76331 . 78653) (FB.COPY/RENAME.MANY 78655 . 84875) (FB.MERGE.DIRECTORIES 84877 . +85295) (FB.GREATEST.PREFIX 85297 . 86653) (FB.MAYBE.INSERT.FILE 86655 . 94095) (FB.GET.NEW.FILE.SPEC +94097 . 97928) (FB.CANONICAL.DIRECTORY 97930 . 99027)) (99030 106814 (FB.HARDCOPYCOMMAND 99040 . +100170) (FB.HARDCOPY.TOFILE 100172 . 106812)) (106815 117014 (FB.EDITCOMMAND 106825 . 107692) ( +FB.EDITCOMMAND.ONEFILE 107694 . 111098) (FB.EDITLISPFILE 111100 . 112205) (FB.BROWSECOMMAND 112207 . +117012)) (117015 128936 (FB.FASTSEECOMMAND 117025 . 120475) (FB.FASTSEE.ONEFILE 120477 . 123634) ( +FB.SEEFULLFN 123636 . 127767) (FB.SEEBUTTONFN 127769 . 128934)) (128937 130683 (FB.LOADCOMMAND 128947 + . 129454) (FB.COMPILECOMMAND 129456 . 129994) (FB.OPERATE.ON.FILES 129996 . 130681)) (130684 178869 ( +FB.UPDATECOMMAND 130694 . 130919) (FB.FIX-DIRECTORY-DATES 130921 . 131944) (FB.MAYBE.EXPUNGE 131946 . +133007) (FB.UPDATEBROWSERITEMS 133009 . 146224) (FB.DATE 146226 . 146867) (FB.ADJUST.DATE.WIDTH 146869 + . 149837) (FB.SET.BROWSER.TITLE 149839 . 150841) (FB.MAYBE.WIDEN.NAMES 150843 . 152962) ( +FB.SET.DEFAULT.NAME.WIDTH 152964 . 154328) (FB.CREATE.FILEBUCKET 154330 . 161550) ( +FB.CHECK.NAME.LENGTH 161552 . 163973) (FB.ADD.FILEGROUP 163975 . 165502) (FB.INSERT.DIRECTORY 165504 + . 165742) (FB.MAKE.SUBDIRECTORY.ITEM 165744 . 167153) (FB.ADD.FILE 167155 . 167768) (FB.INSERT.FILE +167770 . 171182) (FB.ANALYZE.PATTERN 171184 . 176448) (FB.CANONICALIZE.PATTERN 176450 . 177762) ( +FB.GETALLFILEINFO 177764 . 178867)) (178870 187029 (FB.SORT.VERSIONS 178880 . 181651) ( +FB.DECREASING.VERSION 181653 . 182322) (FB.INCREASING.VERSION 182324 . 182945) ( +FB.NAMES.DECREASING.VERSION 182947 . 183982) (FB.NAMES.INCREASING.VERSION 183984 . 184981) ( +FB.DECREASING.NUMERIC.ATTR 184983 . 185663) (FB.INCREASING.NUMERIC.ATTR 185665 . 186339) ( +FB.ALPHABETIC.ATTR 186341 . 187027)) (187030 196872 (FB.SORTCOMMAND 187040 . 193870) ( +FB.INSERT.SUBDIRECTORIES 193872 . 194669) (FB.GET.SORT.MENU 194671 . 196870)) (196873 213094 ( +FB.EXPUNGECOMMAND 196883 . 199468) (FB.NEWPATTERNCOMMAND 199470 . 199868) (FB.NEWINFOCOMMAND 199870 . +202702) (FB.DEPTHCOMMAND 202704 . 204479) (FB.SHAPECOMMAND 204481 . 207823) (FB.REMOVE.FILE 207825 . +209646) (FB.COUNT.FILE.CHANGE 209648 . 211093) (FB.SETNEWPATTERN 211095 . 212265) (FB.GET.NEWPATTERN +212267 . 212851) (FB.OPTIONSCOMMAND 212853 . 213092)) (213129 214182 (FB.GETWINDOW 213139 . 214180)) ( +214183 215195 (FB.INFOMENU.SHADEINITIALSELECTIONS 214193 . 214840) (FB.INFO.ITEM.NAMED 214842 . 215193 +)) (215196 224728 (FB.MAKECOUNTERWINDOW 215206 . 216734) (FB.COUNTERW.REDISPLAYFN 216736 . 217323) ( +FB.UPDATE.COUNTERS 217325 . 219397) (FB.DISPLAY.COUNTERS 219399 . 224459) (FB.COUNTER.STRING 224461 . +224726)) (224729 229438 (FB.MAKEHEADINGWINDOW 224739 . 226353) (FB.HEADINGW.REDISPLAYFN 226355 . +226621) (FB.HEADINGW.RESHAPEFN 226623 . 226999) (FB.HEADINGW.DISPLAY 227001 . 229436)) (229439 233622 +(FB.ICONFN 229449 . 229796) (FB.INFOMENU.WHENSELECTEDFN 229798 . 230528) (FB.CLOSEFN 230530 . 231733) +(FB.EXPUNGE?.MENU 231735 . 232147) (FB.AFTERCLOSEFN 232149 . 232510) (FB.CLOSE&EXPUNGE 232512 . 233620 +)) (233623 245681 (FB.HARDCOPY.DIRECTORY 233633 . 243990) (FB.HARDCOPY.PRINT.TITLE 243992 . 244318) ( +FB.HARDCOPY.MAXWIDTH 244320 . 245679))))) STOP diff --git a/library/FILEBROWSER.LCOM b/library/FILEBROWSER.LCOM index d6b6eea5..7dbfd6f5 100644 Binary files a/library/FILEBROWSER.LCOM and b/library/FILEBROWSER.LCOM differ diff --git a/library/FILEBROWSER.TEDIT b/library/FILEBROWSER.TEDIT new file mode 100644 index 00000000..2ba2aa6c Binary files /dev/null and b/library/FILEBROWSER.TEDIT differ diff --git a/library/FONTSAMPLE.TEDIT b/library/FONTSAMPLE.TEDIT new file mode 100644 index 00000000..12d3aa87 Binary files /dev/null and b/library/FONTSAMPLE.TEDIT differ diff --git a/library/FTPSERVER.TEDIT b/library/FTPSERVER.TEDIT new file mode 100644 index 00000000..24a66ab3 Binary files /dev/null and b/library/FTPSERVER.TEDIT differ diff --git a/library/GCHAX.TEDIT b/library/GCHAX.TEDIT new file mode 100644 index 00000000..5b176019 Binary files /dev/null and b/library/GCHAX.TEDIT differ diff --git a/library/GRAPHER.TEDIT b/library/GRAPHER.TEDIT new file mode 100644 index 00000000..42086735 Binary files /dev/null and b/library/GRAPHER.TEDIT differ diff --git a/library/GRAPHZOOM.TEDIT b/library/GRAPHZOOM.TEDIT new file mode 100644 index 00000000..c19eaa2e Binary files /dev/null and b/library/GRAPHZOOM.TEDIT differ diff --git a/library/HASH.TEDIT b/library/HASH.TEDIT new file mode 100644 index 00000000..477561a0 --- /dev/null +++ b/library/HASH.TEDIT @@ -0,0 +1,33 @@ + 1 Lisp Library Modules, Medley Release 1.0, HASH 1 Lisp Library Modules, Medley Release 1.0, HASH HASH 1 HASH 1 HASH 6 Note: This module is provided for backwards compatibility. New applications should use the HASH-FILE Library Module instead of this module. Hash permits information associated with string or atom keys to be stored on and retrieved from files. The information (or values) associated with the keys in a file may be numbers, strings, or arbitary Lisp expressions. The associates are maintained by a hashing scheme that minimizes the number of file operations it takes to access a value from its key. Information is saved in a hash file, which is analogous to a hash array. Actually, a hash file can be either the file itself, or the handle on that file which is used by the Hash module. The latter, of data type HashFile, is the datum returned by CREATEHASHFILE or OPENHASHFILE, currently an array record containing the hash file name, the number of slots in the file, the used slots, and other details. All other functions with hash file arguments use this datum. In older implementations (e.g., for Interlisp-10), hash files came in several varieties, according to the types of value stored in them. The EMYCIN system provided even more flexibility. This system only supports the most general EXPR type of hash files and EMYCIN-style TEXT entries, in the same file. The VALUETYPE and ITEMLENGTH arguments are for the most part ignored. Two-key hashing is supported in this system, but it is discouraged as it is only used in EMYCIN, not in the Interlisp-10 system. The functions GETPAGE, DELPAGE, and GETPNAME, which manipulate secret pages, do not exist in this implementation. However, it is permissible to write data at the end of a hash file. That data will be ignored by the Hash module, and can be used to store additional data. The Hash module views files as a sequence of bytes, randomly accessible. No notice is made of pages, and it is assumed that the host computer buffers I/O sufficiently. Hash files consist of a short header section (8 bytes), a layer of pointers (4*HASHFILE:Size bytes), followed by ASCII data. Pointers are 3 bytes wide, preceded by a status byte. The pointers point to key PNAMES in the data section, where each key is followed by its value. Deleted key pointers are reused but deleted data space is not, so rehashing is required if many items have been replaced. The data section starts at 4*HASHFILE: Size + 9, and consists of alternating keys and values. As deleted data is not rewritten, not all data in the data section is valid. When a key hashes into a used slot, a probe value is added to it to find the next slot to search. The probe value is a small prime derived from the original hash key. Requirements 1 Hash files must reside on a random-access device (not a TCP/IP file server). Installation 1 Load HASH.LCOM from the Library. Functions 1 Creating a Hash File (CREATEHASHFILE(CREATEHASHFILE (Function) NIL NIL NIL 128) FILE VALUETYPE ITEMLENGTH #ENTRIES SMASH COPYFN) [Function] Creates a new hash file named FILE. All other arguments are optional. VALUETYPE is ignored in this implementation; any hash file can accommodate both Lisp expressions and text. ITEMLENGTH is not used by the system but is currently saved on the file (if less than 256) for future use. #ENTRIES is an estimate of the number of entries the file will have. (This should be a realistic guess.) SMASH is a hash file datum to reuse. COPYFN is a function to be applied to entries when the file is rehashed (see the description of REHASHFILE below). Opening and Closing Hash Files Before you can use a hashfile with this module, you have to open it using the following function. (OPENHASHFILE(OPENHASHFILE (Function) NIL NIL NIL 128) FILE ACCESS ITEMLENGTH #ENTRIES SMASH) [Function] Reopens the previously existing hash file FILE. Access may be INPUT (or NIL), in which case FILE is opened for reading only, or BOTH, in which case FILE is open for both input and output. Causes the error "not a hashfile" if FILE is not recognized as a hash file. ITEM LENGTH and #ENTRIES are for backward compatibility with EMYCIN where OPENHASHFILE also created new hash files; these arguments should be avoided. SMASH is a hash file datum to reuse. If ACCESS is BOTH and FILE is a hash file open for reading only, OPENHASHFILE attempts to close it and reopen it for writing. Otherwise, if FILE designates an already open hash file, OPENHASHFILE is a no-op. OPENHASHFILE returns a hash file datum. (CLOSEHASHFILE(CLOSEHASHFILE (Function) NIL NIL NIL 128) HASHFILE REOPEN) [Function] Closes HASHFILE (when you are finished using a hash file, you should close it). If REOPEN is non-NIL, it should be one of the accepted access types. In this case, the file is closed and then immediately reopened with ACCESS = REOPEN. This is used to make sure the hash file is valid on the disk. Storing and Retrieving Data (PUTHASHFILE(PUTHASHFILE (Function) NIL NIL NIL 128) KEY VALUE HASHFILE KEY2) [Function] Puts VALUE under KEY in HASHFILE. If VALUE is NIL, any previous entry for KEY is deleted. KEY2 is for EMYCIN two-key hashing; KEY2 is internally appended to KEY and they are treated as a single key. (GETHASHVILE(GETHASHVILE (Function) NIL NIL NIL 129) KEY HASHFILE KEY2) [Function] Gets the value stored under KEY in HASHFILE. KEY2 is necessary if it was supplied to PUTHASHFILE. (LOOKUPHASHFILE(LOOKUPHASHFILE (Function) NIL NIL NIL 129) KEY VALUE HASHFILE CALLTYPE KEY2) [Function] A generalized entry for inserting and retrieving values; provides certain options not available with GETHASHFILE or PUTHASHFILE. LOOKUPHASHFILE looks up KEY in HASHFILE. CALLTYPE is an atom or a list of atoms. The keywords are interpreted as follows: RETRIEVE If KEY is found, then if CALLTYPE is or contains RETRIEVE the old value is returned from LOOKUPHASHFILE; otherwise returns T. DELETE If CALLTYPE is or contains DELETE, the value associated with KEY is deleted from the file. REPLACE If CALLTYPE is or contains REPLACE, the old value is replaced with VALUE. INSERT If CALLTYPE is or contains INSERT, LOOKUPHASHFILE inserts VALUE as the value associated with KEY. Combinations are possible. For example, (RETRIEVE DELETE) deletes a key and returns the old value. (PUTHASHTEXT(PUTHASHTEXT (Function) NIL NIL NIL 129) KEY SRCFIL HASHFILE START END) [Function] Puts text from stream SRCFIL onto HASHFILE under KEY. START and END are passed directly to COPYBYTES. (GETHASHTEXT(GETHASHTEXT (Function) NIL NIL NIL 129) KEY HASHFILE DSTFIL) [Function] Uses COPYBYTES to retrieve text stored under KEY on HASHFILE. The bytes are output to the stream DSTFIL. Functions for Manipulating Hash Files (HASHFILEP(HASHFILEP (Function) NIL NIL NIL 129) HASHFILE WRITE?) [Function] Returns HASHFILE if it is a valid, open hash file datum, or returns the hash file datum associated with HASHFILE if it is the name of an open hash file. If WRITE? is non-NIL, HASHFILE must also be open for write access. (HASHFILEPROP(HASHFILEPROP (Function) NIL NIL NIL 129) HASHFILE PROPERTY) [Function] Returns the value of a PROPERTY of a HASHFILE datum. Currently accepted properties are: NAME, ACCESS, VALUETYPE, ITEMLENGTH, SIZE, #ENTRIES, COPYFN and STREAM. (HASHFILENAME(HASHFILENAME (Function) NIL NIL NIL 129) HASHFILE) [Function] Same as (HASHFILEPROP HASHFILE 'NAME). (MAPHASHFILE(MAPHASHFILE (Function) NIL NIL NIL 130) HASHFILE MAPFN DOUBLE) [Function] Maps over HASHFILE applying MAPFN. If MAPFN takes two arguments, it is applied to KEY and VALUE. If MAPFN only takes one argument, it is only applied to KEY and saves the cost of reading the value from the file. If DOUBLE is non-NIL, then MAPFN is applied to (KEY1 KEY2 VALUE), or (KEY1 KEY2) if the MAPFN only takes two arguments. (REHASHFILE(REHASHFILE (Function) NIL NIL NIL 130) HASHFILE NEWNAME) [Function] As keys are replaced, space in the data section of the file is not reused (through space in the key section is). Eventually the file may need rehashing to reclaim the wasted data space. REHASHFILE is really a special case of COPYHASHFILE, and creates a new file. If NEWNAME is non-NIL, it is taken as the name of the rehashed file. The system automatically rehashes files when 7/8 of the key section is filled. The system prints a message when automatically rehashing a file if the global variable REHASHGAG is non-NIL. Certain applications save data outside Hash's normal framework. Hash files for those applications need a custom COPYFN (supplied in the call to CREATEHASHFILE), which is used to copy data during the rehasing process. The COPYFN is used as the FN argument to COPYHASHFILE during the rehashing. (COPYHASHFILE(COPYHASHFILE (Function) NIL NIL NIL 130) HASHFILE NEWNAME FN VALUETYPE LEAVEOPEN) [Function] Makes a copy of HASHFILE under NEWNAME. Each key and value pair is moved individually, and, if FN is supplied, is applied to (KEY VALUE HASHFILE NEWHASHFILE). What is returned is used as the value of the key in the new hash file. (This lets you intervene, perhaps to copy out-of-bank data associated with VALUE.) VALUETYPE is a no-op. If LEAVEOPEN is non-NIL, the new hash file datum is returned open. Otherwise, the new hash file is closed and the name is returned. (HASHFILEPLST(HASHFILEPLST (Function) NIL NIL NIL 130) HASHFILE XWORD) [Function] Returns a Lisp generator for the keys in HASHFILE, usable with the spelling corrector. If XWORD is supplied, only keys starting with the prefix in XWORD are generated. Global Variables of Hash HASHFILEDEFAULTSIZE(HASHFILEDEFAULTSIZE (Variable) NIL NIL NIL 130) [Variable] Size used when #ENTRIES is omitted or is too small. Default is 512. HASHFILEDTBL(HASHFILEDTBL (Variable) NIL NIL NIL 130) [Variable] The hash file read table. Default is ORIG. HASHLOADFACTOR(HASHLOADFACTOR (Variable) NIL NIL NIL 130) [Variable] The ration, used slots/total slots, at which the system rehashes the file. Default is A. HFGROWTHFACTOR(HFGROWTHFACTOR (Variable) NIL NIL NIL 131) [Variable] The ratio of total slots to used slots when a hash file is created. Default is 3. REHASHGAG(REHASHGAG (Variable) NIL NIL NIL 131) [Variable] Flags whether to print message when rehashing; initially off. Default is NIL. SYSHASHFILE(SYSHASHFILE (Variable) NIL NIL NIL 131) [Variable] The current hash file. Default is NIL. SYSHASHFILELST(SYSHASHFILELST (Variable) NIL NIL NIL 131) [Variable] An Alist of open hash files. Default is NIL. Limitations 1 The system currently is able to manipulate files on CORE, DSK, FLOPPY, and over the network, via leaf servers. Hash files can be used with NS servers only if they support random access files. Due to the pointer size, only hash files of less than 6 million initial entries can be created, though these can grow to 14 million entries before automatic rehashing exceeds the pointer limit. The total file length is limited to 16 milion bytes. No range checking is done for these limits. Two-key files operate on pnames only, without regard to packages. [This page intentionally left blank](LIST ((PAGE NIL (PAPERSIZE LETTER FOLIOINFO (ARABIC "" "") STARTINGPAGE# 127) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (TEXT NIL NIL (54 54 504 702) NIL))) (PAGE NIL (PAPERSIZE LETTER FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (54 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL))) (PAGE NIL (PAPERSIZE LETTER FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE RECTOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL)))))3H` +T3H` +T2l2Hll2HH2HH +3T,ll2H` +,$$3T,HH +,HH-T-TF PAGEHEADING VERSOHEADF PAGEHEADING RECTOHEADE PAGEHEADINGFOOTINGVE PAGEHEADINGFOOTINGR  HELVETICA + HELVETICA TITAN +CLASSIC HELVETICA HELVETICACLASSIC +CLASSIC +TERMINAL +MODERN MODERNMODERNMODERN +  HRULE.GETFN 0 HRULE.GETFNMODERN + / HRULE.GETFNMODERN +  HRULE.GETFNMODERN +  HRULE.GETFNMODERN  g    y  +   M   z      HRULE.GETFNMODERN  M  HRULE.GETFNMODERN     + HRULE.GETFNMODERN  + +IM.INDEX.GETFN / % c +ab Z +  + b )IM.INDEX.GETFN& * 7# 2 B ' @'    *IM.INDEX.GETFNTvA + + (IM.INDEX.GETFN !&  (IM.INDEX.GETFN  $  +IM.INDEX.GETFN  e   +J ! )* (IM.INDEX.GETFN    (IM.INDEX.GETFN   & +% + +&IM.INDEX.GETFN  X-% )IM.INDEX.GETFN  ,  + )IM.INDEX.GETFN     (IM.INDEX.GETFN   + +'0<  'IM.INDEX.GETFN   + 0 qA  )IM.INDEX.GETFN ' 7   n )IM.INDEX.GETFN  )*4 + + 0IM.INDEX.GETFN ) )IM.INDEX.GETFN & +IM.INDEX.GETFN W +IM.INDEX.GETFN P &IM.INDEX.GETFN J (IM.INDEX.GETFN # +IM.INDEX.GETFN )  HRULE.GETFNMODERN %A $+qkz \ No newline at end of file diff --git a/library/HASHFILE.TEDIT b/library/HASHFILE.TEDIT new file mode 100644 index 00000000..0dd707aa Binary files /dev/null and b/library/HASHFILE.TEDIT differ diff --git a/library/MASTERSCOPE.TEDIT b/library/MASTERSCOPE.TEDIT new file mode 100644 index 00000000..4e14e8b9 --- /dev/null +++ b/library/MASTERSCOPE.TEDIT @@ -0,0 +1,116 @@ +1 Lisp Library Modules, Medley Release 1.15, MASTERSCOPE 1 Lisp Library Modules, Medley Release 1.15, MASTERSCOPE MASTERSCOPE 1 MASTERSCOPE 1 MASTERSCOPE 6 MasterScope(MASTERSCOPE NIL MasterScope NIL NIL 157) is an interactive program for analyzing and cross referencing user programs(ROSS% REFERENCING% USER% PROGRAMS NIL ross% referencing% user% programs NIL NIL 157). It contains facilities for analyzing user functions(ANALYZING% USER% FUNCTIONS NIL analyzing% user% functions NIL NIL 157) to determine what other functions are called; how and where variables are bound, set, or referenced; and which functions use particular record declarations. MasterScope can analyze definitions directly from a file as well as in-memory definitions. MasterScope maintains a database of the results of the analyses it performs. Via a simple command language, you may interrogate the database, call the editor on those expressions in functions that were analyzed which use variables or functions in a particular way, or display the tree structure of function calls among any set of functions. MasterScope is interfaced with the editor and file manager so that when a function is edited or a new definition loaded in, MasterScope knows that it must reanalyze that function. With the Medley release, MasterScope now understands Common Lisp defun, defmacro, and defvar. Requirements 1 MSANALYZE, MSPARSE, MSCOMMON, MS-PACKAGE You may also want to make use of Browser, DataBaseFns, and SEdit or DEdit. Installation 1 Load MASTERSCOPE.DFASL and the other .DFASL files from the library. MasterScope Command Language 1 You communicate with MasterScope using an English-like command language, e.g., WHO CALLS PRINT. With these commands, you can direct that functions be analyzed, interrogate the MasterScope database(MASTERSCOPE% DATABASE NIL MasterScope% database NIL NIL 157), and perform other operations. The commands deal with sets of functions, variables, etc., and relations between them (e.g., call, bind). Sets correspond to English nouns; relations correspond to verbs. A set of atoms can be specified in a variety of ways, either explicitly, e.g., FUNCTIONS ON FIE specifies the atoms in (FILEFNSLST 'FIE), or implicitly, e.g., NOT CALLING Y, where the meaning must be determined in the context of the rest of the command. Such sets of atoms are the basic building blocks with which the command language deals. MasterScope also deals with relations between sets(RELATIONS% BETWEEN% SETS NIL relations% between% sets NIL NIL 157). For example, the relation CALL relates functions and other functions; the relations BIND and USE FREELY relate functions and variables. These relations get stored in the MasterScope database when functions are analyzed. In addition, MasterScope "knows" about file manager conventions; CONTAIN relates files and various types of objects (functions, variables). Sets and relations are used (along with a few additional words) to form sentence-like commands. For example, the command WHO ON 'FOO USE 'X FREELY prints out the list of functions contained in the file FOO which use the variable X freely. The command EDIT WHERE ANY CALLS 'ERROR calls EDITF (see IRM) on those functions which have previously been analyzed that directly call ERROR, pointing at each successive expression where the call to ERROR actually occurs. MasterScope Commands(MASTERSCOPE% COMMANDS NIL MasterScope% Commands NIL NIL 158) The normal mode of communication with MasterScope is via commands. These are sentences in the MasterScope command language which direct MasterScope to answer questions or perform various operations. MasterScope commands are typed into the Executive window, preceded by a period (.) to distinguish them from other commands to the Exec. MasterScope keywords can be in any package, so MasterScope commands can be issued in any type of Exec. The commands may be typed uppercase or lowercase. To use a keyword as a variable or function name, you must use a single quote in front of it, e.g., .WHO SETS 'SETS. Note: Any MasterScope command may be followed by OUTPUT FILENAME to send output tothe given file rather than the terminal, e.g., .WHO CALLS WHO OUTPUT CROSSREF. ANALYZE SET [MasterScope command] Analyzes the functions in SET (and any functions called by them) and includes the information gathered in the database. MasterScope does not reanalyze a function if it thinks it already has valid information about that function in its database. You may use the command REANALYZE to force reanalysis. Note that whenever a function is referred to in a command as a subject of one of the relations, it is automatically analyzed; you need not give an explicit ANALYZE command. Thus, WHO IN MYFNS CALLS FIE automatically analyzes the functions in MYFNS if they have not already been analyzed. Note also that only EXPR definitions are analyzed; that is, MasterScope does not analyze compiled code. If necessary, the definition is DWIMIFYed before analysis. If there is no in-core definition for a function (either in the function definition cell or an EXPR property), MasterScope attempts to read in the definition from a file. Files which have been explicitly mentioned previously in some command are searched first. If the definition cannot be found on any of those files, MasterScope looks among the files on FILELST for a definition. If a function is found in this manner, MasterScope prints a message "(reading from FILENAME)". If no definition can be found at all, MasterScope prints a message "FN can't be analyzed". If the function previously was known, the message "FN disappeared!" is printed. REANALYZE SET [MasterScope command] Causes MasterScope to reanalyze the functions in SET (and any functions called by them) even if it already has valid information in its database. This would be necessary if you had disabled or subverted the file manager; e.g., performed PUTD's to change the definition of functions. ERASE SET [MasterScope command] Erases all information about the functions in SET from the database. ERASE by itself clears the entire database. SHOW PATHS PATHOPTIONS [MasterScope command] Displays a tree of function calls. This is described fully in "SHOW PATHS" below. SET RELATION SET [MasterScope command] SET IS SET [MasterScope command] SET ARE SET [MasterScope command] These commands have the same format as an English sentence with a subject (the first SET), a verb (RELATION or IS or ARE), and an object (the second SET). Any of the SETs within the command may be preceded by the question determiners WHICH or WHO (or just WHO alone). For example, WHICH FUNCTIONS CALL X prints the list of functions that call the function X. RELATION may be one of the relation words in present tense (CALL, BIND, TEST, SMASH, etc.) or used as a passive (e.g., WHO IS CALLED BY WHO). Other variants are allowed, e.g., WHO DOES X CALL, IS FOO CALLED BY FIE, etc. The interpretation of the command depends on the number of question elements present: If there is no question element, the command is treated as an assertion and MasterScope returns either T or NIL, depending on whether that assertion is true. Thus, ANY IN MYFNS CALL HELP prints T if any function in MYFNS call the function HELP, and NIL otherwise. If there is one question element, MasterScope returns the list of items for which the assertion would be true. For example, MYFN BINDS WHO USED FREELY BY YOURFN prints the list of variables bound by MYFN which are also used freely by YOURFN. If there are two question elements, MasterScope prints a doubly indexed list: _. WHO CALLS WHO IN /FNS RECORDSTATEMENT -- /RPLNODE RECORDECL1 -- /NCONC, /RPLACD, /RPLNODE RECREDECLARE1 -- /PUTHASH UNCLISPTRAN -- /PUTHASH, /RPLNODE2 RECORDWORD -- /RPLACA RECORD1 -- /RPLACA, /SETTOPVAL EDITREC -- /SETTOPVAL EDIT WHERE SET RELATION SET [- EDITCOMS] [MasterScope command] (WHERE may be omitted.) The first SET refers to a set of functions. The EDIT command calls the editor on each expression where the RELATION actually occurs. For example, EDIT WHERE ANY CALL ERROR calls EDITF on each (analyzed) function which calls ERROR stopping within a TTY: at each call to ERROR. Currently you cannot EDIT WHERE a file which CONTAINS a datum, nor where one function CALLS another SOMEHOW. EDITCOMS, if given, is a list of commands passed to EDITF to be performed at each expression. For example, EDIT WHERE ANY CALLS MYFN DIRECTLY - (SW 2 3) P switches the first and second arguments to MYFN in every call to MYFN and prints the result. EDIT WHERE ANY ON MYFILE CALL ANY NOT @ GETD calls the editor on any expression involving a call to an undefined function. Note that EDIT WHERE X SETS Y points only at those expressions where Y is actually set, and skips over places where Y is otherwise mentioned. SHOW WHERE SET RELATION SET [MasterScope command] Like the EDIT command except merely prints out the expressions without calling the editor. EDIT SET [- EDITCOMS] [MasterScope command] Calls EDITF on each function in SET. EDITCOMS, if given, is passed as a list of editor commands to be Executed. For example, EDIT ANY CALLING FN1 - (R FN1 FN2) replaces FN1 by FN2 in those functions that call FN1. DESCRIBE SET [MasterScope command] Prints the BIND, USE FREELY and CALL information about the functions in SET. For example, the command DESCRIBE PRINTARGS might print out: PRINTARGS[N,FLG] binds: TEM,LST,X calls: MSRECORDFILE,SPACES,PRIN1 called by: PRINTSENTENCE,MSHELP,CHECKER This shows that PRINTARGS has two arguments, N and FLG; binds internally the variables TEM, LST and X; calls MSRECORDFILE, SPACES and PRIN1; and is called by PRINTSENTENCE, MSHELP, and CHECKER. You can specify additional information to be included in the description. DESCRIBELST is a list each of whose elements is a list containing a descriptive string and a form. The form is evaluated (it can refer to the name of the funtion being described by the free variable FN). If it returns a non-NIL value, the description string is printed followed by the value. If the value is a list, its elements are printed with commas between them. For example, the entry ("types: " (GETRELATION FN '(USE TYPE) T) would include a listing of the types used by each function. CHECK SET [MasterScope command] Checks for various anomalous conditions (mainly in the compiler declarations) for the files in SET (if SET is not given, FILELST is used). For example, this command warns about: f Variables which are bound but never referenced f Functions in BLOCKS declarations which aren't on the file containing the declaration f Functions declared as ENTRIES but not in the block f Variables which may not need to be declared SPECVARS because they are not used freely below the places where they are bound FOR VARIABLE SET I.S.TAIL [MasterScope command] This command provides a way of combining CLISP iterative statements with MasterScope. An iterative statement is constructed in which VARIABLE is iteratively assigned to each element of SET, and then the iterative statement tail I.S.TAIL is executed. For example, FOR X CALLED BY FOO WHEN CCODEP DO (PRINTOUT T X ,,, (ARGLIST X) T) prints out the name and argument list of all of the compiled functions which are called by FOO. MasterScope Relations(MASTERSCOPE% RELATIONS NIL MasterScope% Relations NIL NIL 161) A relation is specified by one of the keywords below. Some of these "verbs" accept modifiers. For example, USE, SET, SMASH and REFERENCE all may be modified by FREELY. The modifier may occur anywhere within the command. If there is more than one verb, any modifier between two verbs is assumed to modify the first one. For example, in USING ANY FREELY OR SETTING X, FREELY modifies USING but not SETTING. The entire phrase is interpreted as the set of all functions which either use any variable freely or set the variable X, whether or not X is set freely. Verbs can occur in the present tense (e.g., USE, CALLS, BINDS, USES) or as present or past participles (e.g., CALLING, BOUND, TESTED). The relations (with their modifiers) recognized by MasterScope are: CALL [MasterScope relation] Function F1 calls F2 if the definition of F1 contains a form (F2 --). The CALL relation also includes any instance where a function uses a name as a function, as in (APPLY (QUOTE F2) --), (FUNCTION F2), etc. (CALL and CALLS are equivalent.) CALL SOMEHOW [MasterScope relation] One function calls another SOMEHOW if there is some path from the first to the other. That is, if F1 calls F2, and F2 calls F3, then F1 CALLS F3 SOMEHOW. This information is not stored directly in the database; instead, MasterScope stores only information about direct function calls, and (re)computes the CALL SOMEHOW relation as necessary. USE [MasterScope relation] If unmodified, the relation USE denotes variable usage in any way; it is the union of the relations SET, SMASH, TEST, and REFERENCE. SET [MasterScope relation] A function SETs a variable if the function contains a form (SETQ var --), (SETQQ var --), etc. SMASH [MasterScope relation] A function SMASHes a variable if the function calls a destructive list operation (RPLACA, RPLACD, DREMOVE, SORT, etc.) on the value of that variable. MasterScope also finds instances where the operation is performed on a part of the value of the variable. For example, if a function contains a form (RPLACA (NTH X 3) T), it is noted as SMASHing X. If the function contains a sequence (SETQ Y X), (RPLACA Y T), then Y is noted as being SMASHed, but not X. TEST [MasterScope relation] A variable is TESTed by a function if its value is only distinguished between NIL and non-NIL. For example, the form (COND ((AND X --) --)) tests the value of X. REFERENCE [MasterScope relation] This relation includes all variable usage except for SET. Note: The verbs USE, SET, SMASH, TEST and REFERENCE may be modified by the words FREELY or LOCALLY. A variable is used FREELY if it is not bound in the function at the place of its use. It is used LOCALLY if the use occurs within a PROG or LAMBDA that binds the variable. MasterScope also distinguishes between CALL DIRECTLY and CALL INDIRECTLY. A function is called directly if it occurs as CAR-of-form in a normal evaluation context. A function is called indirectly if its name appears in a context which does not imply its immediate evaluation, for example (SETQ Y (LIST (FUNCTION FOO) 3)). The distinction is whether or not the compiled code of the caller would contain a direct call to the callee. Note that an occurrence of (FUNCTION FOO) as the functional argument to one of the built-in mapping functions which compile open is considered to be a direct call. In addition, CALL FOR EFFECT (where the value of the function is not used) is distinguished from CALL FOR VALUE. BIND [MasterScope relation] The BIND relation between functions and variables includes both variables bound as function arguments and those bound in an internal PROG or LAMBDA expression. USE AS A FIELD [MasterScope relation] MasterScope notes all uses of record field names within FETCH, REPLACE or CREATE expressions. FETCH [MasterScope relation] Use of a field within a FETCH expression. REPLACE [MasterScope relation] Use of a record field name within a REPLACE or CREATE expression. USE AS A RECORD [MasterScope relation] MasterScope notes all uses of record names within CREATE or TYPE? expressions. Additionally, in (fetch (FOO FIE) of X), FOO is used as a record name. CREATE [MasterScope relation] Use of a record name within a CREATE expression. USE AS A PROPERTY NAME [MasterScope relation] MasterScope notes the property names used in expressions such as GETPROP, PUTPROP, GETLIS, etc., if the name is quoted; e.g. if a function contains a form (GETPROP X (QUOTE INTERP)), then that function USEs INTERP as a property name. USE AS A CLISP WORD [MasterScope relation] MasterScope notes all iterative statement operators and user defined CLISP words as being used as a CLISP word. CONTAIN [MasterScope relation] Files CONTAIN functions, records, and variables. This relation is not stored in the database but is computed using the file manager. DECLARE AS LOCALVAR [MasterScope relation] DECLARE AS SPECVAR [MasterScope relation] MasterScope notes internal calls to DECLARE from within functions. ACCEPT [MasterScope relation] SPECIFY [MasterScope relation] KEYCALL [MasterScope relation] MasterScope notes keyword arguments of Common Lisp functions when they are analyzed and when they are called. FOO ACCEPTS :BAR is true if FOO is a Common Lisp function that accepts the keyword :BAR. FOO ACCEPTS &ALLOW-OTHER-KEYS is true if FOO has &ACCEPT-OTHER-KEYS in its lambda list. FOO SPECIFIES :BAR is true if FOO is a function that calls any function with the keyword :BAR; the function in question must ACCEPT :BAR. FOO KEYCALLS BAR is true if FOO is a function and calls BAR with one or more keywords it ACCEPTS. FLET [MasterScope relation] LABEL [MasterScope relation] MACROLET [MasterScope relation] LOCAL-DEFINE [MasterScope relation] MasterScope tracks uses of Common Lisp local definition forms (it currently does not expand them while analyzing them, however). FOO FLETS BAR is true of FOO is a function with a FLET defining BAR local to FOO. LABELS and MACROLETS are similar. LOCAL-DECLARES is the union of FLETS, LABELS, and MACROLETS. Abbreviations The following abbreviations are recognized: FREE=FREELY LOCAL=LOCALLY PROP=PROPERTY REF=REFERENCE Also, the words A, AN and NAME (after AS) are "noise" words and may be omitted. MasterScope Templates(MASTERSCOPE% TEMPLATES NIL MasterScope% Templates NIL NIL 164) MasterScope uses templates (see "Effecting MasterScope Analysis" below) to decide which relations hold between functions and their arguments. For example, the information that SORT SMASHes its first argument is contained in the template for SORT. MasterScope initially contains templates for most system functions which set variables, test their arguments, or perform destructive operations. You may change existing templates or insert new ones in MasterScope's tables via the SETTEMPLATE function (below). MasterScope also constructs templates to handle Common Lisp functions with keyword arguments. These constructed templates are noticed by FILES? and can be saved if desired, or MasterScope can recreate them by analyzing the functions again. MasterScope Set Specifications(MASTERSCOPE% SET% SPECIFICATIONS NIL MasterScope% Set% Specifications NIL NIL 164) A set is a collection of things (functions, variables, etc.). A set is specified by a set phrase, consisting of a determiner (e.g., ANY, WHICH, WHO) followed by a type (e.g., FUNCTIONS, VARIABLES) followed by a specification (e.g., IN MYFNS). The determiner, type and specification may be used alone or in combination. For example, ANY FUNCTIONS IN MYFNS, VARIABLES IN GLOBALVARS, and WHO are all acceptable set phrases. Note: Sets may also be specified with relative clauses introduced by the word THAT, e.g. THE FUNCTIONS THAT BIND 'X. 'ATOM [MasterScope set specification] The simplest way to specify a set consisting of a single thing is by the name of that thing. For example, in the command WHO CALLS 'ERROR, the function ERROR is referred to by its name. Although the ' (apostrophe) can be left out, to resolve possible ambiguities names should usually be quoted; e.g., WHO CALLS 'CALLS returns the list of functions which call the function CALLS. 'LIST [MasterScope set specification] Sets consisting of several atoms may be specified by naming the atoms. For example, the command WHO USES '(A B) returns the list of functions that use the variables A or B. IN EXPRESSION [MasterScope set specification] The form EXPRESSION is evaluated, and its value is treated as a list of the elements of a set. For example, IN GLOBALVARS specifies the list of variables in the value of the variable GLOBALVARS. @ PREDICATE [MasterScope set specification] A set may also be specified by giving a predicate which the elements of that set must satisfy. PREDICATE is either a function name, a LAMBDA expression, or an expression in terms of the variable X. The specification @ PREDICATE represents all atoms for which the value of PREDICATE is non-NIL. For example, @ EXPRP specifies all those atoms which have EXPR definitions; @ (STRPOSL X CLISPCHARRAY) specifies those atoms which contain CLISP characters. The universe to be searched is either determined by the context within the command (e.g., in WHO IN FOOFNS CALLS ANY NOT @ GETD, the predicate is only applied to functions which are called by any functions in the list FOOFNS), or in the extreme case, the universe defaults to the entire set of things which have been noticed by MasterScope, as in the command WHO IS @ EXPRP. LIKE ATOM [MasterScope set specification] ATOM may contain ESCapes; it is used as a pattern to be matched, as in the editor. For example, WHO LIKE /R$ IS CALLED BY ANY would find both /RPLACA and /RPLNODE. (The ESC character prints out as a $; it is a wildcard for any number of characters.) FIELDS OF SET [MasterScope set specification] SET is a set of records. This denotes the field names of those records. For example, the command WHO USES ANY FIELDS OF BRECORD returns the list of all functions which do a fetch or replace with any of the field names declared in the record declaration of BRECORD. KNOWN [MasterScope set specification] The set of all functions which have been analyzed. For example, the command WHO IS KNOWN prints out the list of functions which have been analyzed. THOSE [MasterScope set specification] The set of things printed out by the last MasterScope question. For example, following the command WHO IS USED FREELY BY PARSE you could ask WHO BINDS THOSE to find out where those variables are bound. ON PATH PATHOPTIONS [MasterScope set specification] Refers to the set of functions which would be printed by the command SHOW PATHS PATHOPTIONS. For example, IS FOO BOUND BY ANY ON PATH TO 'PARSE tests whether FOO might be bound above the function PARSE (that is, whether FOO is bound in any function that is higher up in the calling tree than PARSE is) . SHOW PATHS is explained in detail below. Set Specifications by Relation(SET% SPECIFICATIONS% BY% RELATION NIL Set% Specifications% by% Relation NIL NIL 166) A set may also be specified by giving a relation its members must have with the members of another set: RELATIONING SET [MasterScope set specification] RELATIONING is used here generically to mean any of the relation words in the present participle form (possibly with a modifier), e.g., USING, SETTING, CALLING, BINDING. RELATIONING SET specifies the set of all objects which have that relation with some element of SET. For example, CALLING X specifies the set of functions which call the function X; USING ANY IN FOOVARS FREELY specifies the set of functions which uses freely any variable in the value of FOOVARS. RELATIONED BY SET [MasterScope set specification] RELATIONED IN SET [MasterScope set specification] This is similar to the RELATIONING construction. For example, CALLED BY ANY IN FOOFNS represents the set of functions which are called by any element of FOOFNS; USED FREELY BY ANY CALLING ERROR is the set of variables which are used freely by any function which also calls the function ERROR. Set Specifications by Blocktypes(SET% SPECIFICATIONS% BY% BLOCKTYPES NIL Set% Specifications% by% Blocktypes NIL NIL 167) BLOCKTYPE OF FUNCTIONS [MasterScope set specification] BLOCKTYPE ON FILES [MasterScope set specification] These phrases allow you to ask about BLOCKS declarations on files (see IRM). BLOCKTYPE is one of LOCALVARS, SPECVARS, GLOBALVARS, ENTRIES, BLKFNS, BLKAPPLYFNS, or RETFNS. BLOCKTYPE OF FUNCTIONS specifies the names which are declared to be BLOCKTYPE in any blocks declaration which contain any of FUNCTIONS (a "set" of functions). The "functions" in FUNCTIONS can either be block names or just functions in a block. For example, WHICH ENTRIES OF ANY CALLING 'Y BIND ANY GLOBALVARS ON 'FOO. BLOCKTYPE ON FILES specifies all names which are declared to be BLOCKTYPE on any of the given FILES (a "set" of files). Set Determiners(SET% DETERMINERS NIL Set% Determiners NIL NIL 167) Set phrases may be preceded by a determiner, which is one of the words THE, ANY, WHO or WHICH. The question determiners (WHO and WHICH) are meaningful in only some of the commands, namely those that take the form of questions. ANY and WHO (or WHOM) can be used alone; they are wild-card elements, e.g., the command WHO USES ANY FREELY, prints out the names of all (known) functions which use any variable freely. If the determiner is omitted, ANY is assumed; e.g., the command WHO CALLS '(PRINT PRIN1 PRIN2) prints the list of functions which call any of PRINT, PRIN1, PRIN2. THE is also allowed, e.g., WHO USES THE RECORD FIELD FIELDX. Set Types(SET% TYPES NIL Set% Types NIL NIL 167) Any set phrase has a type; that is, a set may specify either functions, variables, files, record names, record field names or property names. The type may be determined by the context within the command (e.g., in CALLED BY ANY ON FOO, the set ANY ON FOO is interpreted as meaning the functions on FOO since only functions can be CALLED), or you may give the type explicitly (e.g., FUNCTIONS ON FIE). The following types are recognized: FUNCTIONS, VARIABLES, FILES, PROPERTY NAMES, RECORDS, FIELDS, I.S.OPRS. Also, the abbreviations FNS, VARS, PROPNAMES or the singular forms FUNCTION, FN, VARIABLE, VAR, FILE, PROPNAME, RECORD, FIELD are recognized. Note that most of these types correspond to built-in file manager types (see IRM). The type is used by MasterScope in a variety of ways when interpreting the set phrase: 1. Set types are used to disambiguate possible parsings. For example, both commands WHO SETS ANY BOUND IN X OR USED BY Y WHO SETS ANY BOUND IN X OR CALLED BY Y have the same general form. However, the first case is parsed as WHO SETS ANY (BOUND BY X OR USED BY Y) since both BOUND BY X and USED BY Y refer to variables; while the second case is parsed as WHO SETS ANY BOUND IN (X OR CALLED BY Y), since CALLED BY Y and X must refer to functions. Note that parentheses may be used to group phrases. 2. The type is used to determine the modifier for USE: FOO USES WHICH RECORDS is equivalent to FOO USES WHO AS A RECORD FIELD. 3. The interpretation of CONTAIN depends on the type of its object: the command WHAT FUNCTIONS ARE CONTAINED IN MYFILE prints the list of functions in MYFILE. WHAT RECORDS ARE ON MYFILE prints the list of records. 4. The implicit universe in which a set expression is interpreted depends on the type: ANY VARIABLES @ GETD is interpreted as the set of all variables which have been noticed by MasterScope (i.e., bound or used in any function which has been analyzed) that also have a definition. ANY FUNCTIONS @ (NEQ (GETTOPVAL X) 'NOBIND) is interpreted as the set of all functions which have been noticed (either analyzed or called by a function which has been analyzed) that also have a top-level value. Conjunctions of Sets(CONJUNCTIONS% OF% SETS NIL Conjunctions% of% Sets NIL NIL 168) Sets may be joined by the conjunctions AND and OR or preceded by NOT to form new sets. AND is always interpreted as meaning intersection; OR as union; NOT as complement. For example, the set CALLING X AND NOT CALLED BY Y specifies the set of all functions which call the function X but are not called by Y. Note: MasterScope's interpretation of AND and OR follow Lisp conventions rather than the conventional English interpretation. "Calling X and Y" would, in English, be interpreted as the intersection of (CALLING X) and (CALLING Y); but MasterScope interprets CALLING X AND Y as CALLING ('X AND 'Y), which is the null set. Only sets may be joined with conjunctions. Joining modifiers, as in USING X AS A RECORD FIELD OR PROPERTY NAME is not allowed; in this case, you must type USING X AS A RECORD FIELD OR USING X AS A PROPERTY NAME As described above, the type of set is used to disambiguate parsings. The algorithm used is to first try to match the type of the phrases being joined and then try to join with the longest preceding phrase. In any case, you may group phrases with parentheses to specify the manner in which conjunctions should be parsed. SHOW PATHS(SHOW% PATHS (command) NIL NIL NIL 169) 1 In trying to work with large programs, you can lose track of the hierarchy of functions. The MasterScope SHOW PATHS command aids you by providing a map showing the calling structure of a set of functions. SHOW PATHS prints out a tree structure showing which functions call which other functions. Loading the Browser library module modifies the SHOW PATHS command so the command's output is displayed as an undirected graph. The SHOW PATHS command takes the form: SHOW PATHS followed by some combination of the following path options: FROM SET [MasterScope path option] Display the function calls from the elements of SET. TO SET [MasterScope path option] Display the function calls leading to elements of SET. If TO is given before FROM (or no FROM is given), the tree is inverted and a message (inverted tree) is printed to warn you that if FN1 appears after FN2 it is because FN1 is called by FN2. Note: When both FROM and TO are given, the first one indicates a set of functions to be displayed, while the second restricts the paths to be traced; i.e., the command SHOW PATHS FROM X TO Y traces the elements of the set CALLED SOMEHOW BY X AND CALLING Y SOMEHOW. If TO is not given, TO KNOWN OR NOT @ GETD is assumed; that is, only functions which have been analyzed or which are undefined will be included. Note that MasterScope analyzes a function while printing out the tree if that function has not previously been seen and it currently has an EXPR definition. Thus, any function which can be analyzed will be displayed. AVOIDING SET [MasterScope path option] Do not display any function in SET. AMONG is recognized as a synonym for AVOIDING NOT. For example, SHOW PATHS TO ERROR AVOIDING ON FILE2 does not display (or trace) any function on FILE2. NOTRACE SET [MasterScope path option] Do not trace from any element of SET. NOTRACE differs from AVOIDING in that a function which is marked NOTRACE is printed, but the tree beyond it is not expanded. The functions in an AVOIDING set are not printed at all. For example, SHOW PATHS FROM ANY ON FILE1 NOTRACE ON FILE2 displays the tree of calls eminating from FILE1, but does not expand any function on FILE2. SEPARATE SET [MasterScope path option] Give each element of SET a separate tree. Note: FROM and TO only insure that the designated functions are displayed. SEPARATE can be used to guarantee that certain functions begin new tree structures. SEPARATE functions are displayed in the same manner as overflow lines; i.e., when one of the functions indicated by SEPARATE is found, it is printed followed by a forward reference (a lowercase letter in braces) and the tree for that function is then expanded below. LINELENGTH N [MasterScope path option] Resets LINELENGTH to N before displaying the tree. The linelength is used to determine when a part of the tree should "overflow" and be expanded lower. Error Messages 1 When you give MasterScope a command, the command is first parsed, i.e. translated to an internal representation, and then the internal representation is interpreted. If a command cannot be parsed, e.g. if you typed SHOW WHERE CALLED BY X MasterScope would reply Sorry, I can't parse that! and generate an error. If the command is of the correct form but cannot be interpreted (e.g., the command EDIT WHERE ANY CONTAINS ANY) MasterScope prints the message Sorry, that isn't implemented! and generates an error. If the command requires some functions having been analyzed (e.g., the command WHO CALLS X) and the database is empty, MasterScope prints the message Sorry, no functions have been analyzed! and generates an error. Macro Expansion(MACRO% EXPANSION NIL Macro% Expansion NIL NIL 170) 1 As part of analysis, MasterScope expands the macro definition of called functions if they are not otherwise defined (see IRM). MasterScope always expands Common Lisp DEFMACRO definitions (unless it finds a template for the macro). MasterScope Interlisp macro expansion is controlled by a variable: MSMACROPROPS(MSMACROPROPS (variable) NIL NIL NIL 170) [Variable] Value is an ordered list of macro-property names that MasterScope searches to find a macro definition. Only the kinds of macros that appear on MSMACROPROPS are expanded. All others are treated as function calls and left unexpanded. Initially (MACRO). Note: MSMACROPROPS initially contains only MACRO (not 10MACRO, DMACRO, etc.) on the assumption that the machine-dependent macro definitions are more likely "optimizers". If you edit a macro, MasterScope knows to reanalyze the functions which call that macro. Note: If your macro is of the "computed-macro" style, and it calls functions which you edit, MasterScope does not notice. You must be careful to tell masterscope to REANALYZE the appropriate functions (e.g., if you edit FOOEXPANDER which is used to expand FOO macros, you have to REANALYZE ANY CALLING FOO. Effecting MasterScope Analysis(EFFECTING% MASTERSCOPE% ANALYSIS NIL Effecting% MasterScope% Analysis NIL NIL 171) 1 MasterScope analyzes the EXPR definition of a function,(EXPR% DEFINITIONS% OF% FUNCTIONS NIL expr% definitions% of% functions NIL NIL 171) and notes in its database the relations that this function has with other functions and with variables. To perform this analysis, MasterScope uses templates which describe the behavior of functions. For example, the information that SORT destructively modifies its first argument is contained in the template for SORT. MasterScope initially contains templates for most system functions that set variables, test their arguments, or perform destructive operations. A template is a list structure containing any of the following atoms: PPE [in MasterScope template] If an expression appears in this location, there is most likely a parenthesis error. MasterScope notes this as a call to the function ppe (lowercase). Therefore, SHOW WHERE ANY CALLS ppe prints out all possible parenthesis errors. When MasterScope finds a possible parenthesis error in the course of analyzing a function definition, rather than printing the usual ".", it prints out a "?" instead. MasterScope notes functions called with keywords they do not accept as calls to ppe. NIL [in MasterScope template] The expression occuring at this location is not evaluated. SET [in MasterScope template] A variable appearing at this place is set. SMASH [in MasterScope template] The value of this expression is smashed. TEST [in MasterScope template] Is used as a predicate (that is, the only use of the value of the expression is whether it is NIL or non-NIL). PROP [in MasterScope template] Is used as a property name. If the value of this expression is of the form (QUOTE ATOM), MasterScope notes that ATOM is USED AS A PROPERTY NAME. For example, the template for GETPROP is (EVAL PROP . PPE). KEYWORD key1... [in MasterScope template] Must appear at the end of a template followed by the keywords the templated function accepts. For example, the template for CL:MEMBER is (EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY). FUNCTION [in MasterScope template] The expression at this point is used as a functional argument. For example, the template for MAPC is (SMASH FUNCTION FUNCTION . PPE) FUNCTIONAL [in MasterScope template] The expression at this point is used as a functional argument. This is like FUNCTION, except that MasterScope distinguishes between functional arguments to functions which compile open from those that do not. For the latter (e.g. SORT and APPLY), FUNCTIONAL should be used rather than FUNCTION. EVAL [in MasterScope template] The expression at this location is evaluated (but not set, smashed, tested, used as a functional argument, etc.). RETURN [in MasterScope template] The value of the function (of which this is the template) is the value of this expression. TESTRETURN [in MasterScope template] A combination of TEST and RETURN: If the value of the function is non-NIL, then it is returned. For instance, a one-element COND clause is this way. EFFECT [in MasterScope template] The expression at this location is evaluated, but the value is not used. (That is, it is evaluated for its side effect only.) FETCH [in MasterScope template] An atom at this location is a field which is fetched. REPLACE [in MasterScope template] An atom at this location is a field which is replaced. RECORD [in MasterScope template] An atom at this location is used as a record name. CREATE [in MasterScope template] An atom at this location is a record which is created. BIND [in MasterScope template] An atom at this location is a variable which is bound. CALL [in MasterScope template] An atom at this location is a function which is called. CLISP [in MasterScope template] An atom at this location is used as a CLISP word. ! [in MasterScope template] This atom, which can only occur as the first element of a template, allows you to specify a template for the CAR of the function form. If ! doesn't appear, the CAR of the form is treated as if it had a CALL specified for it. In other words, the templates (.. EVAL) and (! CALL .. EVAL) are equivalent. If the next atom after a ! is NIL, this specifies that the function name should not be remembered. For example, the template for AND is (! NIL .. TEST RETURN), which means that if you see an AND, don't remember it as being called. This keeps the MasterScope database from being cluttered by too many uninteresting relations. MasterScope also throws away relations for COND, CAR, CDR, and a couple of others. Special Forms In addition to the above atoms that occur in templates, there are some special forms which are lists keyed by their CAR. .. TEMPLATE [in MasterScope template] Any part of a template may be preceded by the atom .. (two periods) which specifies that the template should be repeated an indefinite number (N>=0) of times to fill out the expression. For example, the template for COND might be (.. (TEST .. EFFECT RETURN)) while the template for SELECTQ is (EVAL .. (NIL .. EFFECT RETURN) RETURN). (Although MasterScope "throws away" the relations for COND, it makes sense to template COND because there may be important information within the arguments of COND.) (BOTH TEMPLATE1 TEMPLATE2) [in MasterScope template] Analyze the current expression twice, using the each of the templates in turn. (IF EXPRESSION TEMPLATE1 TEMPLATE2) [in MasterScope template] Evaluate EXPRESSION at analysis time (the variable EXPR is bound to the expression which corresponds to the IF), and if the result is non-NIL, use TEMPLATE1, otherwise TEMPLATE2. If EXPRESSION is a literal atom, it is APPLYd to EXPR. For example, (IF LISTP (RECORD FETCH) FETCH) specifies that if the current expression is a list, then the first element is a record name and the second element a field name, otherwise it is a field name. (@ EXPRFORM TEMPLATEFORM) [in MasterScope template] Evaluate EXPRFORM giving EXPR, evaluate TEMPLATEFORM giving TEMPLATE. Then analyze EXPR with TEMPLATE. @ lets you compute on the fly both a template and an expression to analyze with it. The forms can use the variable EXPR, which is bound to the current expression. (MACRO . MACRO) [in MasterScope template] MACRO is interpreted in the same way as macros (see IRM) and the resulting form is analyzed. If the template is the atom MACRO alone, MasterScope uses the MACRO property of the function itself. This is useful when analyzing code which contains calls to user-defined macros. If you change a macro property (e.g., by editing it) of an atom which has template of MACRO, MasterScope marks any function which used that macro as needing to be reanalyzed. Some examples of templates: Function Template DREVERSE (SMASH . PPE) AND (! NIL TEST .. RETURN) MAPCAR (EVAL FUNCTION FUNCTION) COND (! NIL .. (IF CDR (TEST .. EFFECT RETURN) (TESTRETURN . PPE))) Templates may be changed and new templates defined using the following functions: (GETTEMPLATE(GETTEMPLATE (function) NIL NIL NIL 174) FN) [Function] Returns the current template of FN. (SETTEMPLATE(SETTEMPLATE (function) NIL NIL NIL 174) FN TEMPLATE) [Function] Changes the template for the function FN and returns the old value. If any functions in the database are marked as calling FN, they are marked as needing reanalysis. Updating the MasterScope Database(UPDATING% THE% MASTERSCOPE% DATA% BASE NIL Updating% the% MasterScope% Data% Base NIL NIL 174) 1 MasterScope is interfaced to the editor and file manager so that it notes whenever a function has been changed, either through editing or loading in a new definition. Whenever a command is given which requires knowing the information about a specific function, if that function has been noted as being changed, the function is automatically reanalyzed before the command is interpreted. If the command requires that all the information in the database be consistent (e.g., you ask WHO CALLS X) then all functions which have been marked as changed are reanalyzed. MasterScope Entries(MASTERSCOPE% ENTRIES NIL MasterScope% Entries NIL NIL 175) 1 (MASTERSCOPE(MASTERSCOPE (function) NIL NIL NIL 175) COMMAND%) [Function] Top level entry to MasterScope. If COMMAND is NIL, enters into an Executive in which you may enter commands. If COMMAND is not NIL, the command is interpreted and MASTERSCOPE returns the value that would be printed by the command. Note that only the question commands return meaningful values. (CALLS(CALLS (function) NIL NIL NIL 175) FN USEDATABASE%) [Function] FN can be a function name, a definition, or a form. Note: CALLS also works on compiled code. CALLS returns a list of four elements: f Functions called by FN f Variables bound in FN f Variables used freely in FN f Variables used globally in FN For the purpose of CALLS, variables used freely which are on GLOBALVARS or have a property GLOBALVAR value T are considered to be used globally. If USEDATABASE is NIL (or FN is not a symbol), CALLS performs a one-time analysis of FN. Otherwise (i.e., if USEDATABASE is non-NIL and FN a function name), CALLS uses the information in MasterScope's database (FN is analyzed first if necessary). (CALLSCCODE(CALLSCCODE (function) NIL NIL NIL 175) FN %) [Function] The subfunction of CALLS which analyzes compiled code. CALLSCCODE returns a list of elements: f Functions called via "linked" function calls (not implemented in Interlisp-D) f Functions called regularly f Variables bound in FN f Variables used freely f Variables used globally (FREEVARS(FREEVARS (function) NIL NIL NIL 175) FN USEDATABASE) [Function] Equivalent to (CADDR (CALLS FN USEDATABASE)). Returns the list of variables used freely within FN. (SETSYNONYM(SETSYNONYM (function) NIL NIL NIL 175) PHRASE MEANING%) [Function] Defines a new synonym for MasterScope's parser. Both OLDPHRASE and NEWPHRASE are words or lists of words; anywhere OLDPHRASE is seen in a command, NEWPHRASE is substituted. For example, (SETSYNONYM 'GLOBALS '(VARS IN GLOBALVARS OR @(GETPROP X 'GLOBALVAR))) would allow you to refer with the single word GLOBALS to the set of variables which are either in GLOBALVARS or have a GLOBALVAR property. Functions for Writing Routines(FUNCTIONS% FOR% WRITING% ROUTINES NIL Functions% for% Writing% Routines NIL NIL 176) The following functions are provided for users who wish to write their own routines using MasterScope's database: (PARSERELATION(PARSERELATION (function) NIL NIL NIL 176) RELATION) [Function] RELATION is a relation phrase; e.g., (PARSERELATION '(USE FREELY)). PARSERELATION returns an internal representation for RELATION. For use in conjunction with GETRELATION. (GETRELATION(GETRELATION (function) NIL NIL NIL 176) ITEM RELATION INVERTED) [Function] RELATION is an internal representation as returned by PARSERELATION (if not, GETRELATION first performs (PARSERELATION RELATION)). ITEM is an atom. GETRELATION returns the list of all atoms which have the given relation to ITEM. For example, (GETRELATION 'X '(USE FREELY)) returns the list of variables that X uses freely. If INVERTED is T, the inverse relation is used; e.g. (GETRELATION 'X '(USE FREELY) T) returns the list of functions which use X freely. If ITEM is NIL, GETRELATION returns the list of atoms which have RELATION with any other item; i.e., it answers the question WHO RELATIONS ANY. Note that GETRELATION does not check to see if ITEM has been analyzed, or that other functions that have been changed have been reanalyzed. (TESTRELATION(TESTRELATION (function) NIL NIL NIL 176) ITEM RELATION ITEM2 INVERTED) [Function] Is equivalent to (MEMB ITEM2 (GETRELATION ITEM RELATION INVERTED)); that is, it tests if ITEM and ITEM2 are related via RELATION. If ITEM2 is NIL, the call is equivalent to (NOT (NULL (GETRELATION ITEM RELATION INVERTED))) i.e., TESTRELATION tests if ITEM has the given RELATION with any other item. (MAPRELATION(MAPRELATION (function) NIL NIL NIL 176) RELATION MAPFN) [Function] Calls the function MAPFN on every pair of items related via RELATION. If (NARGS MAPFN) is 1, then MAPFN is called on every item which has the given RELATION to any other item. (MSNEEDUNSAVE(MSNEEDUNSAVE (function) NIL NIL NIL 176) FNS MSG MARKCHANGEFLG) [Function] Used to mark functions which depend on a changed record declaration (or macro, etc.), and which must be LOADed or UNSAVEd (see below). FNS is a list of functions to be marked, and MSG is a string describing the records, macros, etc. on which they depend. If MARKCHANGEFLG is non-NIL, each function in the list is marked as needing reanalysis. (UPDATEFN(UPDATEFN (function) NIL NIL NIL 177) FN EVENIFVALID %) [Function] Equivalent to the command ANALYZE 'FN; that is, UPDATEFN analyzes FN if FN has not been analyzed before or if it has been changed since the time it was analyzed. If EVENIFVALID is non-NIL, UPDATEFN reanalyzes FN even if MasterScope thinks it has a valid analysis in the database. (UPDATECHANGED(UPDATECHANGED (function) NIL NIL NIL 177)) [Function] Performs (UPDATEFN FN) on every function which has been marked as changed. (MSMARKCHANGED(MSMARKCHANGED (function) NIL NIL NIL 177) NAME TYPE REASON) [Function] Mark that NAME has been changed and needs to be reanalyzed. See MARKASCHANGED in the IRM. (DUMPDATABASE(DUMPDATABASE (function) NIL NIL NIL 177) FNLST) [Function] Dumps the current MasterScope database on the current output file in a LOADable form. If FNLST is not NIL, DUMPDATABASE only dumps the information for the list of functions in FNLST. The variable DATABASECOMS is initialized to ((E (DUMPDATABASE))) Thus, you may merely perform (MAKEFILE 'DATABASE.EXTENSION) to save the current MasterScope database. If a MasterScope database already exists when a DATABASE file is loaded, the database on the file is merged with the one in memory. Note: Functions whose definitions are different from their definition when the database was made must be REANALYZEd if their new definitions are to be noticed. Note: The DataBaseFns library module provides a more convenient way of saving databases along with the source files to which they correspond. Noticing Changes that Require Recompiling(NOTICING% CHANGES% THAT% REQUIRE% RECOMPILING NIL Noticing% Changes% that% Require% Recompiling NIL NIL 177) 1 When a record declaration(RECORD% DECLARATION NIL record% declaration NIL NIL 177), iterative statement operator(ITERATIVE% STATEMENT% OPERATOR NIL iterative% statement% operator NIL NIL 177) or macro(MACRO NIL macro NIL NIL 177) is changed, and MasterScope has noticed a use of that declaration or macro (i.e., it is used by some function known about in the database), MasterScope alerts you about those functions which might need to be recompiled (e.g., they do not currently have EXPR definitions). Extra functions may be noticed. For example, if FOO contains (fetch (REC X) --), and some declaration other than REC which contains X is changed, MasterScope still thinks that FOO needs to be loaded/unsaved. The functions which need recompiling are added to the list MSNEEDUNSAVE and a message is printed out: The functions FN1, FN2,... use macros which have changed. Call UNSAVEFNS() to load and/or unsave them. In this situation, the following function is useful: (UNSAVEFNS(UNSAVEFNS (function) NIL NIL NIL 177) %) [Function] Uses LOADFNS or UNSAVEDEF to make sure that all functions in the list MSNEEDUNSAVE have EXPR definitions, and then sets MSNEEDUNSAVE to NIL. Note: If RECOMPILEDEFAULT(RECOMPILEDEFAULT (variable) NIL NIL NIL 178) (see IRM) is set to CHANGES, UNSAVEFNS prints out "WARNING: you must set RECOMPILEDEFAULT to EXPRS in order to have these functions recompiled automatically." Implementation Notes 1 MasterScope keeps a database of the relations noticed when functions are analyzed. The relations are intersected to form primitive relationships such that there is little or no overlap of any of the primitives. For example, the relation SET is stored as the union of SET LOCAL and SET FREE. The BIND relation is divided into BIND AS ARG, BIND AND NOT USE, and SET LOCAL, SMASH LOCAL, etc. Splitting the relations in this manner reduces the size of the database considerably, to the point where it is reasonable to maintain a MasterScope database for a large system of functions during a normal debugging session. Each primitive relationship(PRIMITIVE% RELATIONSHIP NIL primitive% relationship NIL NIL 178) is stored in a pair of hash tables, one for the forward direction and one for the reverse. For example, there are two hash tables, USE AS PROPERTY and USED AS PROPERTY. To retrieve the information from the database, MasterScope performs unions of the hash values. For example, to answer FOO BINDS WHO, MasterScope looks in all of the tables which make up the BIND relation. The internal representation returned by PARSERELATION is a list of dotted pairs of hash tables. To perform GETRELATION requires only mapping down that list, doing GETHASHs on the appropriate hash tables and UNIONing the result. Hash tables(HASH% TABLES NIL Hash% tables NIL NIL 178) are used for a variety of reasons: storage space is smaller; it is not necessary to maintain separate lists of which functions have been analyzed (a special table, DOESN'T DO ANYTHING is maintained for functions which neither call other functions nor bind or use any variables); and accessing is relatively fast. Within any of the tables, if the hash value is a list of one atom, then the atom itself, rather than the list, is stored as the hash value. This also reduces the size of the database significantly. Example 1 Sample Session The following illustrates some of the MasterScope facilities. 50_. ANALYZE FUNCTIONS ON RECORD ............................... NIL 51_. WHO CALLS RECFIELDLOOK (RECFIELDLOOK ACCESSDEF ACCESSDEF2 EDITREC) 52_. EDIT WHERE ANY CALL RECFIELDLOOK RECFIELDLOOK : (RECFIELDLOOK (CDR Y) FIELD) tty: 5*OK ACCESSDEF : (RECFIELDLOOK DECLST FIELD VAR1) 6*OK (RECFIELDLOOK USERRECLST FIELD) 7*N VAR1 8*OK ACCESSDEF2 : (RECFIELDLOOK (RECORD.SUBDECS TRAN) FIELD) tty: (RECFIELDLOOK (RECORD.SUBDECS TRAN) FIELD) 9*N (CAR TAIL] 10*OK EDITREC : (RECFIELDLOOK USERRECLST (CAR EDITRECX)) 11*OK NIL 53_. WHO CALLS ERROR .. (EDITREC) 54_. SHOW PATHS TO RECFIELDLOOK FROM ACCESSDEF (inverted tree) 1. RECFIELDLOOK RECFIELDLOOK 2. ACCESSDEF 3. ACCESSDEF2 ACCESSDEF2 4. ACCESSDEF 5. RECORDCHAIN ACCESSDEF NIL 55_. WHO CALLS WHO IN /FNS RECORDSTATEMENT -- /RPLNODE RECORDECL1 -- /NCONC, /RPLACD, /RPLNODE RECREDECLARE1 -- /PUTHASH UNCLISPTRAN -- /PUTHASH, /RPLNODE2 RECORDWORD -- /RPLACA RECORD1 -- /RPLACA, /SETTOPVAL EDITREC -- /SETTOPVAL Event 50 You direct that the functions on file RECORD be analyzed. The leading period and space specify that this line is a MasterScope command. MasterScope prints a greeting and prompts with _. Within the top-level Executive of MasterScope, you may issue MasterScope commands, programmer's assistant commands, (e.g., REDO, FIX), or run programs. You can exit from the MasterScope Executive by typing OK. The function "." is defined as a Nlambda NoSpread function which interprets its argument as a MasterScope command, Executes the command and returns. MasterScope prints a"." whenever it (re)analyzes a function, to let you know what it is happening. The feedback when MasterScope analyzes a function is controlled by the flag MSPRINTFLG: if MSPRINTFLG is the atom ".", MasterScope prints out a period. (If an error in the function is detected, "?" is printed instead.) If MSPRINTFLG is a number N, MasterScope prints the name of the function it is analyzing every Nth function. If MSPRINTFLG is NIL, MasterScope won't print anything. Initial setting is ".". Note that the function name is printed when MasterScope starts analyzing, and the comma is printed when it finishes. Event 51 You ask which functions call RECFIELDLOOK. MasterScope responds with the list. Statement 52 You ask to edit the expressions where the function RECFIELDLOOK is called. MasterScope calls EDITF on the functions it had analyzed that call RECFIELDLOOK, directing the editor to the appropriate expressions. You then edit some of those expressions. In this example, the teletype editor is used. If DEdit is enabled as the primary editor, it would be called to edit the appropriate functions. Statement 53 Next you ask which functions call ERROR. Since some of the functions in the database have been changed, MasterScope reanalyzes the changed definitions (and prints out .'s for each function it analyzes). MasterScope responds that EDITREC is the only analyzed function that calls ERROR. Statement 54 You ask to see a map of the ways in which RECFIELDLOOK is called from ACCESSDEF. A tree structure of the calls is displayed. Statement 55 You then ask to see which functions call which functions in the list /FNS. MasterScope responds with a structured printout of these relations. SHOW PATHS(SHOW% PATHS NIL NIL NIL NIL 180) The command SHOW PATHS FROM MSPARSE prints out the structure of MasterScope's parser: 1.MSPARSE MSINIT MSMARKINVALID 2. | MSINITH MSINITH 3. MSINTERPRET MSRECORDFILE 4. | MSPRINTWORDS 5. | PARSECOMMAND GETNEXTWORD CHECKADV 6. | | PARSERELATION {a} 7. | | PARSESET {b} 8. | | PARSEOPTIONS {c} 9. | | MERGECONJ GETNEXTWORD {5} 10. | GETNEXTWORD {5} 11. | FIXUPTYPES SUBJTYPE 12. | | OBJTYPE 13. | FIXUPCONJUNCTIONS MERGECONJ {9} 14. | MATCHSCORE 15. MSPRINTSENTENCE ------------------------------------------------------ overflow - a 16.PARSERELATION GETNEXTWORD {5} 17. CHECKADV ------------------------------------------------------ overflow - b 19.PARSESET PARSESET 20. GETNEXTWORD {5} 21. PARSERELATION {6} 22. SUBPARSE GETNEXTWORD {5} ------------------------------------------------------ overflow - c 23.PARSEOPTIONS GETNEXTWORD {5} 24. PARSESET {19} This example shows that the function MSPARSE calls MSINIT, MSINTERPRET, and MSPRINTSENTENCE. MSINTERPRET in turn calls MSRECORDFILE, MSPRINTWORDS, PARSECOMMAND, GETNEXTWORD, FIXUPTYPES, and FIXUPCONJUNCTIONS. The numbers in braces {} after a function name are backward references: they indicate that the tree for that function was expanded on a previous line. The lowercase letters in braces are forward references: they indicate that the tree for that function will be expanded below, since there is no more room on the line. The vertical bar is used to keep the output aligned. [This page intentionally left blank] (LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "" "") STARTINGPAGE# 157) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (TEXT NIL NIL (54 54 504 702) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (54 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE RECTOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL)))))F0llT1$$TT/$$3H` +T1TT3H` +T2lxx26T2lll2HH +l2```2``x2H``2HH +2Hll-llT2HH2ll-llT3$$(T3(T3(T0$$T-$$T2HHl-HH +T-T-T5lxx5l5ll2ll/HH2HH +2ll/HH +/ll2l2l,ll2(//$$5 +2$$2HH +2H`2H` +2Hll/,,/,HH +,HH,HH-T- T,,,,-T-TF PAGEHEADING VERSOHEADF PAGEHEADING RECTOHEADE PAGEHEADINGFOOTINGVE PAGEHEADINGFOOTINGR5 HELVETICA +TITAN +CLASSIC +TITAN +CLASSIC +CLASSIC +TITAN +CLASSIC +CLASSIC HELVETICA TITAN +CLASSIC + HELVETICA HELVETICAMODERN +MODERNMODERN +TERMINAL +MODERN MODERNMODERNMODERN +E HRULE.GETFNMODERN +E8D HRULE.GETFNMODERN +D8C C HRULE.GETFNMODERN +B B HRULE.GETFNMODERN +: : HRULE.GETFNMODERN9 )IM.INDEX.GETFNL UIM.INDEX.GETFN6 GIM.INDEX.GETFN 8V 8 8C     5 4 HRULE.GETFNMODERN7* 8J  5 4 HRULE.GETFNMODERN7      6 3 HRULE.GETFNMODERN7O  g =IM.INDEX.GETFN 8O     82 CIM.INDEX.GETFN 8  6   +  D 8b 8  8           L  U  +=IM.INDEX.GETFN7 8P  8f   21   B   1   !   !    *  ) !  q  t    g I I  1  !1  1  !.   & 1 +   !S 1   0    0    !U      A    +  !  5   !4        $  & %  !V !          !q !  ' !&     !N   .  (  (  1  + !   #  7  !    )  (   +   !    !,  & ! 1   +     , P ! +  (  .   1 +   !  N 1   + !    D ! % !       1   !   +   $  !     * - !     !                 !K    ! - !<     _     '  2    C      .  H 1  !)  X , (  ! F ![   ?IM.INDEX.GETFN_ 8         8 " 8    =        +      H 1  )        X    )       )  A             )  1  )d        1  )< % 1  )  B              )$ +        1  )  <    )     1  )5   )               I  D )'   1  ! p )  } )  E     )  1  )8       1  )  1  )$    1  )2         1  )  1  )A      B       1  )E     1  )  x 1  0  )$   1   0   0   )p )  6 $     )  9  !  )       1   0   0   0  ) )     +  +   )           +/-             (  +?IM.INDEX.GETFN +/ " + 7     f  +SIM.INDEX.GETFN +/        %  Q        N     1 # )_ )    +  e  7   1 # )I )  6     1  +# ) +N ) > +  1  # )` [     -    )  &      %  k " [    1  # )  A )       )  N 1  # )G )     # )4 ) < 1 # )A )$  )  . 1  # )E +   ) )( )  #    E   +   +UIM.INDEX.GETFN +h 1  #            P   8    R   1  # 0  #       D   ]    +YIM.INDEX.GETFN +1    # 0    # %        +           . 0 - ;  ( =     .    +3IM.INDEX.GETFN +7G            ^      D  n    0           +'IM.INDEX.GETFN +7  + + ,    .   8$                                  8M  8W ;    '  )  A  )  +  9  ,       4 2      !   1  )        X     .   +?IM.INDEX.GETFN +7'        0    8  <     2 8K       8F , 8. 9 8 8q   + 'IM.INDEX.GETFNMODERN* HRULE.GETFNMODERN j + [ + S 80 + F 8 +  + = 1    +0      +2 %  ^         (     )      g   J 1        % -   1   !     $  J     -  *  &        (    ;  M  l  1 +    +      HRULE.GETFNMODERN 2    S      O < )   3IM.INDEX.GETFNMODERN HRULE.GETFNMODERN y ,  ; C 1 )IM.INDEX.GETFNCLASSIC +  Y   (       e Z ( .        SIM.INDEX.GETFN  HRULE.GETFNMODERN%   SIM.INDEX.GETFN ""  L  "F 1  $U $1         _   1  $; 1  $+ 1  $) 1  $^     1  $K        $       $b $  +  1  $@ $   $! 1 +  $M     )   1  $r 1  $[ 1 +  $    &  3   1  $ 1  $6 1  $7 1  $3 1  $7 1  $7   $8 1  $&   1  $m  1  '  2    $    D $    !        #y 1  $ , $  + $ $   $* $6    D   1    $O 1    & +  5       +      $" & 1   &        s  , 1   &/ C     T &          #  L &R 1 (IM.INDEX.GETFN   &  1 (IM.INDEX.GETFN   && T (  ! _IM.INDEX.GETFN  HRULE.GETFNMODERN7 F   ;IM.INDEX.GETFN  HRULE.GETFNMODERN1 (IM.INDEX.GETFNCLASSIC +  &&   @   e &A 1 "IM.INDEX.GETFNCLASSIC +   &2 '    #             &  % +    )      !       1 " 1 'IM.INDEX.GETFNCLASSIC +   &  +   Q          1 %IM.INDEX.GETFNCLASSIC +   &    4  1 'IM.INDEX.GETFNCLASSIC +   &8  '   & 'K &.  - + UIM.INDEX.GETFN%r 1 *IM.INDEX.GETFNCLASSIC +  &   (   1 (IM.INDEX.GETFNCLASSIC +   &. +      & @  & $! &4 &   % $# &(  &    &  +      & +  Y 1 )IM.INDEX.GETFNCLASSIC +   $            &    $  & +   1 (IM.INDEX.GETFNCLASSIC +   & $        -   1 )IM.INDEX.GETFNCLASSIC +   &h     * L   = 1 %IM.INDEX.GETFNCLASSIC +   &   +  \     E 1 *IM.INDEX.GETFN )   5 1 *IM.INDEX.GETFNCLASSIC +   ) + 3   1 )IM.INDEX.GETFNCLASSIC +   )G      9   ( )   \  L (i . (  6) mIM.INDEX.GETFN * HRULE.GETFNMODERN7 9IM.INDEX.GETFN OIM.INDEX.GETFN IM.INDEX.GETFN  2 8  +  "    +  Y 8$8, 8/  1 &IM.INDEX.GETFNTITAN +   )   _    (  -IM.INDEX.GETFNCLASSIC +    (n + * HRULE.GETFNMODERN7 88          8 AIM.INDEX.GETFN^ 8(    c 8 ;  4 7 -  %   8 +IM.INDEX.GETFN  H + : HRULE.GETFNMODERN, +;> >! > > > >, >& > > > > > >! > > > > > >+ > >+ > > > + >) > > > > > + >/ > > > > >+ >1 >= > > > >. > >( > >( > -0   ~    K    -  +   P   + D  +   9   -w -' ' -A   , -0   >  *   -8  . -S  G . +!IM.INDEX.GETFN/  3 =! <   <$ <   <  - <    <    <    <   & <   <   <    <  + <  ( < <D <! < <D < < < <% <D < < ?/%             +     \ A% @FFN z \ No newline at end of file diff --git a/library/MATMULT.TEDIT b/library/MATMULT.TEDIT new file mode 100644 index 00000000..8fe06821 --- /dev/null +++ b/library/MATMULT.TEDIT @@ -0,0 +1,31 @@ +1 Lisp Library Modules, Medley Release 1.0, MATMULT 1 Lisp Library Modules, Medley Release 1.0, MATMULT MATMULT 1 MATMULT 1 MATMULT 6 Two dimensional graphical transformations, such as rotations, scalings, and translations are conveniently represented as homogeneous 3-by-3 matrices, which operate on homogeneous 3-vectors. Similarly, three dimensional graphical transformations are conveniently represented as homogeneous 4-by-4 matrices, which operate on homogeneous 4-vectors. MatMult(MATMULT NIL MatMult NIL NIL 193) provides utilities for creating and manipulating such matrices and vectors, and takes advantage of microcode support for high-speed 3-by-3 and 4-by-4 matrix multiplication(MATRIX% MULTIPLICATION NIL matrix% multiplication NIL NIL 193). All matrices and vectors in MatMult are represented as Common Lisp arrays of element type single-float, so the Common Lisp array functions(ARRAY% FUNCTIONS NIL array% functions NIL NIL 193) are sufficient to create and access individual elements of these specialized arrays. However, MatMult provides convenient wrapper functions(WRAPPER% FUNCTIONS NIL wrapper% functions NIL NIL 193) for most common operations on these arrays. All the following functions that return arrays accept optional array arguments. If given a result argument, these functions alter the contents of that argument rather then allocating new storage. It is an error for the optional array argument to be not of element type single-float, or to have incorrect dimensions. Requirements 1 MatMult should be run on an 1109 with a Weitek floating point chip set, but is also quite efficient on an 1186. Installation 1 Load MATMULT.LCOM from the library. Matrix Creation Functions(MATRIX% CREATION% FUNCTIONS NIL Matrix% Creation% Functions NIL NIL 193) 1 (MAKE-HOMOGENEOUS-3-VECTOR(MAKE-HOMOGENEOUS-3-VECTOR (function) NIL NIL NIL 193) X Y) [Function] Returns a 3-vector of element type single-float. If X or Y is provided, then the corresponding element of the vector is set appropriately, otherwise it defaults to 0.0. The third element of the vector is always initialized to 1.0. Note: Throughout this text, "set" is used to emphasize that the value of the result element is altered and that no new storage is allocated to it. (MAKE-HOMOGENEOUS-3-BY-3(MAKE-HOMOGENEOUS-3-BY-3 (function) NIL NIL NIL 193) &KEY A00 A01 A10 A20 A21) [Function] Returns a 3-by-3 matrix of element type single-float. If a keyword argument is provided, the corresponding element of the matrix is set appropriately, otherwise entries default to 0.0. The (2 ,2) is always initialized to 1.0. (MAKE-HOMOGENEOUS-N-BY-3(MAKE-HOMOGENEOUS-N-BY-3 (function) NIL NIL NIL 193) N &KEY INITIAL-ELEMENT) [Function] Returns an N-by-3 matrix of element type single-float. If the keyword argument is provided, all the elements in the first two columns are set appropriately, otherwise they default to 0.0. The third column is always initialized to 1.0. (MAKE-HOMOGENEOUS-4-VECTOR(MAKE-HOMOGENEOUS-4-VECTOR (function) NIL NIL NIL 194) X Y Z) [Function] Returns a 4-vector of element type single-float. If X, Y or Z is provided then the corresponding element of the vector is set appropriately, otherwise it defaults to 0.0. The forth element of the vector is always initialized to 1.0. (MAKE-HOMOGENEOUS-4-BY-4(%(MAKE-HOMOGENEOUS-4-BY-4 (function) NIL NIL NIL 194) &KEY A00 A01 A02 A03 A10 A11 A12 A13 A20 A21 A22 A23 A30 A31 A32) [Function] Returns a 4-by-4 matrix of element type single-float. If a keyword arguments is provided, the corresponding element of the matrix is set appropriately, otherwise entries default to 0.0. The (3 ,3) is always initialized to 1.0. (MAKE-HOMOGENEOUS-N-BY-4(MAKE-HOMOGENEOUS-N-BY-4 (function) NIL NIL NIL 194) N &KEY INITIAL-ELEMENT) [Function] Returns an N-by-4 matrix of element type single-float. If the keyword argument is provided, all the elements in the first three columns are set appropriately, otherwise they default to 0.0. The forth column is always initialized to 1.0. (IDENTITY-3-BY-3(IDENTITY-3-BY-3 (function) NIL NIL NIL 194) RESULT) [Function] Returns a 3-by-3 identity matrix. If RESULT is supplied, it is side effected and returned. (That is, the storage associated with the optional result argument is reused for the result, rather than allocating new storage for the result.) (IDENTITY-4-BY-4(IDENTITY-4-BY-4 (function) NIL NIL NIL 194) RESULT) [Function] Returns a 4-by-4 identity matrix. If RESULT is supplied, it is side effected and returned. (ROTATE-3-BY-3 (ROTATE-3-BY-3% (function) NIL NIL NIL 194)RADIANS RESULT) [Function] Returns a 3-by-3 rotation matrix specified by a counter-clockwise rotation of RADIANS radians. If RESULT is supplied, it is set and returned. (ROTATE-4-BY-4-ABOUT-X(ROTATE-4-BY-4-ABOUT-X (function) NIL NIL NIL 194) RADIANS RESULT) [Function] Returns a 4-by-4 rotation matrix specified by a positive right-handed rotation of RADIANS radians about the X axis. If RESULT is supplied, it is set and returned. (ROTATE-4-BY-4-ABOUT-Y(ROTATE-4-BY-4-ABOUT-Y (function) NIL NIL NIL 194) RADIANS RESULT) [Function] Returns a 4-by-4 rotation matrix specified by a positive right-handed rotation of RADIANS radians about the Y axis. If RESULT is supplied, it is set and returned. (ROTATE-4-BY-4-ABOUT-Z(ROTATE-4-BY-4-ABOUT-Z (function) NIL NIL NIL 194) RADIANS RESULT) [Function] Returns a 4-by-4 rotation matrix specified by a positive right-handed rotation of RADIANS radians about the Z axis. If RESULT is supplied, it is set and returned. (SCALE-3-BY-3(SCALE-3-BY-3 (function) NIL NIL NIL 194) SX SY RESULT) [Function] Returns a 3-by-3 homogeneous scaling transformation that scales by a factor of SX along the X-axis and SY along the Y-axis. If RESULT is supplied, it is set and returned. (SCALE-4-BY-4(SCALE-4-BY-4 (function) NIL NIL NIL 195) SX SY SZ RESULT) [Function] Returns a 4-by-4 homogeneous scaling transformation that scales by a factor of SX along the X-axis, SY along the Y-axis, and SZ along the Z axis. If RESULT is supplied, it is set and returned. (TRANSLATE-3-BY-3(TRANSLATE-3-BY-3 (function) NIL NIL NIL 195) TX TY RESULT) [Function] Returns a 3-by-3 homogeneous translation that translates by TX along the X-axis and TY along the Y-axis. If RESULT is supplied, it is set and returned. (TRANSLATE-4-BY-4(TRANSLATE-4-BY-4 (function) NIL NIL NIL 195) TX TY TZ RESULT) [Function] Returns a 4-by-4 homogeneous translation that translates by TX along the X-axis, TY along the Y-axis and TZ along the Z axis. If RESULT is supplied, it is set and returned. (PERSPECTIVE-4-BY-4(PERSPECTIVE-4-BY-4 (function) NIL NIL NIL 195) PX PY PZ RESULT) [Function] Returns a 4-by-4 homogeneous perspective transformation defined by PX, PY, and PZ. If RESULT is supplied, it is set and returned. Matrix Multiplication Functions(MATRIX% MULTIPLICATION% FUNCTIONS NIL Matrix% Multiplication% Functions NIL NIL 195) 1 If run on workstations equipped with the extended processor option, these functions make good use of the hardware floating-point unit. The three digits at the end of each function's name describe the dimensions of their arguments. Note: The results of the following matrix multiplication functions are not guaranteed to be correct unless the matrix arguments are all different (Not EQ). (MATMULT-133(MATMULT-133 (function) NIL NIL NIL 195) VECTOR MATRIX RESULT) [Function] Returns the inner product of a 3-vector, VECTOR, and a 3-by-3 matrix, MATRIX. If RESULT is supplied, it is set and returned. (MATMULT-331(MATMULT-331 (function) NIL NIL NIL 195) MATRIX VECTOR RESULT) [Function] Returns the inner product of a 3-by-3 matrix, MATRIX, and a 3-vector, VECTOR. If RESULT is supplied, it is set and returned. (MATMULT-333(MATMULT-333 (function) NIL NIL NIL 195) MATRIX-1 MATRIX-2 RESULT) [Function] Returns the inner product of a 3-by-3 matrix, MATRIX-1, and another 3-by-3 matrix, MATRIX-2. If RESULT is supplied, it is set and returned. (MATMULT-N33(MATMULT-N33 (function) NIL NIL NIL 195) MATRIX-1 MATRIX-2 RESULT) [Function] Returns the inner product of an N-by-3 matrix, MATRIX-1, and a 3-by-3 matrix, MATRIX-2. If RESULT is supplied, it is set and returned. (MATMULT-144(MATMULT-144 (function) NIL NIL NIL 195) VECTOR MATRIX RESULT) [Function] Returns the inner product of a 4-vector, VECTOR, and a 4-by-4 matrix, MATRIX. If RESULT is supplied, it is set and returned. (MATMULT-441(MATMULT-441 (function) NIL NIL NIL 195) MATRIX VECTOR RESULT) [Function] Returns the inner product of a 4-by-4 matrix, MATRIX, and a 4-vector, VECTOR. If RESULT is supplied, it is set and returned. (MATMULT-444(MATMULT-444 (function) NIL NIL NIL 196) MATRIX-1 MATRIX-2 RESULT) [Function] Returns the inner product of a 4-by-4 matrix, MATRIX-1, and another 4-by-4 matrix, MATRIX-2. If RESULT is supplied, it is set and returned. (MATMULT-N44(MATMULT-N44 (function) NIL NIL NIL 196) MATRIX-1 MATRIX-2 RESULT) [Function] Returns the inner product of an N-by-4 matrix, MATRIX-1, and a 4-by-4 matrix, MATRIX-2. If RESULT is supplied, it is set and returned. Miscellaneous Functions 1 (PROJECT-AND-FIX-3-VECTOR(PROJECT-AND-FIX-3-VECTOR (function) NIL NIL NIL 196) 3-VECTOR 2-VECTOR) [Function] The homogeneous 3-VECTOR is projected onto the X-Y plane, coerced to integer coordinates (rounding by truncation) and returned. If 2-VECTOR is supplied, it is set and returned. (PROJECT-AND-FIX-N-BY-3(PROJECT-AND-FIX-N-BY-3 (function) NIL NIL NIL 196) N-3-MATRIX N-2-MATRIX) [Function] The homogeneous N-by-3 matrix, N-3-MATRIX, is projected onto the X-Y plane row-by-row, coerced to integer coordinates (rounding by truncation) and returned. If N-2-MATRIX is supplied, it is set and returned. (PROJECT-AND-FIX-4-VECTOR(PROJECT-AND-FIX-4-VECTOR (function) NIL NIL NIL 196) 4-VECTOR 2-VECTOR) [Function] The homogeneous 4-vector, 4-VECTOR, is projected onto the X-Y plane, coerced to integer coordinates (rounding by truncation) and returned. If 2-VECTOR is supplied, it is set and returned. (PROJECT-AND-FIX-N-BY-4(PROJECT-AND-FIX-N-BY-4 (function) NIL NIL NIL 196) N-4-MATRIX N-2-MATRIX) [Function] The homogeneous N-by-4 MATRIX, N-3-MATRIX, is projected onto the X-Y plane row-by-row, coerced to integer coordinates (rounding by truncation) and returned. If N-2-MATRIX is supplied, it is set and returned. (DEGREES-TO-RADIANS(DEGREES-TO-RADIANS (function) NIL NIL NIL 196) DEGREES) [Function] Returns DEGREES converted to radians. Limitations 1 MatMult is not intended as a general matrix manipulation package; it is specialized for the 3-by-3 and 4-by-4 cases. Use CmlFloatArray(MLFLOATARRAY NIL mlFloatArray NIL NIL 196) for more general floating point array facilities. Example 1 (* ; "Try (spiral)") (CL:DEFUN SPIRAL (&OPTIONAL (WINDOW (CREATEW)) &AUX (WIDTH (WINDOWPROP WINDOW 'WIDTH)) (HALF-WIDTH (QUOTIENT WIDTH 2)) (HEIGHT (WINDOWPROP WINDOW 'HEIGHT)) (HALF-HEIGHT (QUOTIENT HEIGHT 2)) (SCALE-FACTOR (CL:EXP (QUOTIENT (CL:LOG (QUOTIENT (MIN WIDTH HEIGHT) 2.0)) 1440.0)))) (LET ((LINE-1 (MAKE-HOMOGENEOUS-3-VECTOR 1.0 0.0)) (LINE-2 (MAKE-HOMOGENEOUS-3-VECTOR)) (TEMP (MAKE-HOMOGENEOUS-3-VECTOR)) (POINTS (CL:MAKE-ARRAY 2)) (TRANSFORM (MATMULT-333 (ROTATE-3-BY-3 (DEGREES-TO-RADIANS 2.5)) (SCALE-3-BY-3 SCALE-FACTOR SCALE-FACTOR))) (TRANSLATION (TRANSLATE-3-BY-3 HALF-WIDTH HALF-HEIGHT))) (CL:DO ((L-1 LINE-1) (L-2 LINE-2) (I 0 (CL:1+ I))) ((EQ I 1728)) (MATMULT-133 L-1 TRANSFORM L-2) (MATMULT-133 L-2 TRANSLATION TEMP) (PROJECT-AND-FIX-3-VECTOR TEMP POINTS) (DRAWLINE HALF-WIDTH HALF-HEIGHT (CL:AREF POINTS 0) (CL:AREF POINTS 1) 1 'REPLACE WINDOW) (CL:ROTATEF L-1 L-2)))) [This page intentionally left blank] (LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "" "") STARTINGPAGE# 193) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (TEXT NIL NIL (54 54 504 702) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (54 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE RECTOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL))))).TT3HT +T3T,HH,HH2l,ll2HT +2Hll,HH +3T-T,-T-TF PAGEHEADING VERSOHEADF PAGEHEADING RECTOHEADE PAGEHEADINGFOOTINGVE PAGEHEADINGFOOTINGR TITAN +CLASSIC +TITAN +CLASSICCLASSIC + HELVETICA HELVETICA HELVETICA +TERMINAL +MODERN +MODERNMODERNMODERN + HRULE.GETFNMODERN + +2 HRULE.GETFNMODERN + +2 HRULE.GETFNMODERN + + HRULE.GETFNMODERN + + HRULE.GETFNMODERN c!IM.INDEX.GETFN?IM.INDEX.GETFN3IM.INDEX.GETFN7IM.INDEX.GETFN->   HRULE.GETFNMODERN  +o   HRULE.GETFNMODERN  +  IIM.INDEX.GETFN  HRULE.GETFNMODERN 6IM.INDEX.GETFN 44IM.INDEX.GETFN 4IM.INDEX.GETFN 6IM.INDEX.GETFN 46IM.INDEX.GETFNA 4IM.INDEX.GETFN ,IM.INDEX.GETFN #1,IM.INDEX.GETFN %0,IM.INDEX.GETFN N &2IM.INDEX.GETFN R&2IM.INDEX.GETFN R&2IM.INDEX.GETFN R& )IM.INDEX.GETFN  N& )IM.INDEX.GETFN O&-IM.INDEX.GETFN  <&-IM.INDEX.GETFN <& /IM.INDEX.GETFN C% UIM.INDEX.GETFN  HRULE.GETFNMODERN  +  (IM.INDEX.GETFN )& (IM.INDEX.GETFN .& (IM.INDEX.GETFN .& (IM.INDEX.GETFN 0& (IM.INDEX.GETFN )& (IM.INDEX.GETFN .& (IM.INDEX.GETFN /& (IM.INDEX.GETFN 0$%   HRULE.GETFNMODERN 5IM.INDEX.GETFN k&3IM.INDEX.GETFN  +w +&5IM.INDEX.GETFN l&3IM.INDEX.GETFN  +w +&/IM.INDEX.GETFN    HRULE.GETFNMODERN  +u ++IM.INDEX.GETFN2  HRULE.GETFNMODERN   +      /  ; 8 = : 9 ; 6 . , $ J F B   !  / 2 6 C )  ' '% +/ Uz \ No newline at end of file diff --git a/library/READNUMBER.TEDIT b/library/READNUMBER.TEDIT new file mode 100644 index 00000000..a882984d Binary files /dev/null and b/library/READNUMBER.TEDIT differ diff --git a/library/SYSEDIT b/library/SYSEDIT index 0670ab15..d7393b8e 100644 --- a/library/SYSEDIT +++ b/library/SYSEDIT @@ -1,12 +1,10 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "17-Apr-2023 14:19:03" {DSK}larry>il>medley>library>SYSEDIT.;2 1238 - - :EDIT-BY "lmm" +(FILECREATED "18-Jul-2023 12:07:08" {DSK}frank>il>medley>gmedley>library>SYSEDIT.;2 1397 :CHANGES-TO (VARS SYSEDITCOMS) - :PREVIOUS-DATE "25-Jun-2022 18:22:01" {DSK}larry>il>medley>library>SYSEDIT.;1) + :PREVIOUS-DATE "29-Apr-2023 16:15:10" {DSK}frank>il>medley>gmedley>library>SYSEDIT.;1) (PRETTYCOMPRINT SYSEDITCOMS) @@ -20,9 +18,11 @@ (CLISPIFTRANFLG T) (CROSSCOMPILING 'ASK) (*REPLACE-OLD-EDIT-DATES* NIL) - (COPYRIGHTFLG 'NEVER)) - (P (RESETVARS ((CROSSCOMPILING T)) - (FILESLOAD (SOURCE) + (COPYRIGHTFLG 'NEVER) + (MSRECORDTRANFLG T)) + (P (MOVD? 'APPLY* 'SPREADAPPLY*X) + (RESETVARS ((CROSSCOMPILING T)) + (FILESLOAD (SOURCE FROM LOADUPS) EXPORTS.ALL]) (RPAQQ CLISPIFYPRETTYFLG NIL) @@ -43,8 +43,12 @@ (RPAQQ COPYRIGHTFLG NEVER) +(RPAQQ MSRECORDTRANFLG T) + +(MOVD? 'APPLY* 'SPREADAPPLY*X) + (RESETVARS ((CROSSCOMPILING T)) - (FILESLOAD (SOURCE) + (FILESLOAD (SOURCE FROM LOADUPS) EXPORTS.ALL)) (DECLARE%: DONTCOPY (FILEMAP (NIL))) diff --git a/library/TCPIP.TEDIT b/library/TCPIP.TEDIT new file mode 100644 index 00000000..11c83753 Binary files /dev/null and b/library/TCPIP.TEDIT differ diff --git a/library/TELERAID.TEDIT b/library/TELERAID.TEDIT new file mode 100644 index 00000000..cb459e86 Binary files /dev/null and b/library/TELERAID.TEDIT differ diff --git a/library/TEXEC.TEDIT b/library/TEXEC.TEDIT new file mode 100644 index 00000000..7d2fde4f Binary files /dev/null and b/library/TEXEC.TEDIT differ diff --git a/library/TEXTMODULES.TEDIT b/library/TEXTMODULES.TEDIT new file mode 100644 index 00000000..9bcdf989 Binary files /dev/null and b/library/TEXTMODULES.TEDIT differ diff --git a/library/UNIXCHAT.TEDIT b/library/UNIXCHAT.TEDIT new file mode 100644 index 00000000..748a0f94 Binary files /dev/null and b/library/UNIXCHAT.TEDIT differ diff --git a/library/UNIXCOMM.TEDIT b/library/UNIXCOMM.TEDIT new file mode 100644 index 00000000..ceafe3a6 Binary files /dev/null and b/library/UNIXCOMM.TEDIT differ diff --git a/library/VIRTUAL.TEDIT b/library/VIRTUAL.TEDIT new file mode 100644 index 00000000..2b62ebbf Binary files /dev/null and b/library/VIRTUAL.TEDIT differ diff --git a/library/WHERE-IS b/library/WHERE-IS index b3df0941..30f6fd09 100644 --- a/library/WHERE-IS +++ b/library/WHERE-IS @@ -1,13 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "XEROX-COMMON-LISP" READTABLE "XCL" BASE 10) -(IL:FILECREATED "11-Mar-2022 22:40:32"  -IL:|{DSK}kaplan>Local>medley3.5>my-medley>library>WHERE-IS.;2| 17501 +(IL:FILECREATED "30-Apr-2023 13:54:00" IL:|{DSK}larry>il>medley>library>WHERE-IS.;2| 17396 - :PREVIOUS-DATE "13-Jun-90 01:24:39" -IL:|{DSK}kaplan>Local>medley3.5>my-medley>library>WHERE-IS.;1|) + :EDIT-BY "lmm" + :CHANGES-TO (IL:FUNCTIONS ADD-WHERE-IS-DATABASE) + + :PREVIOUS-DATE "11-Mar-2022 22:40:32" IL:|{DSK}larry>il>medley>library>WHERE-IS.;1|) -; Copyright (c) 1987-1988, 1990 by Venue & Xerox Corporation. (IL:PRETTYCOMPRINT IL:WHERE-ISCOMS) @@ -379,15 +379,14 @@ IL:|{DSK}kaplan>Local>medley3.5>my-medley>library>WHERE-IS.;1|) (IL:PUTPROPS IL:WHERE-IS IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "XCL")) (IL:PUTPROPS IL:WHERE-IS IL:FILETYPE :COMPILE-FILE) -(IL:PUTPROPS IL:WHERE-IS IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1990)) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (1758 2090 (HASH-FILE-WHERE-IS 1758 . 2090)) (2092 2485 (HASH-FILE-TYPES-OF 2092 . -2485)) (2487 4652 (GET-WHERE-IS-ENTRIES 2487 . 4652)) (4654 5169 (WHERE-IS-READ-FN 4654 . 5169)) (5171 - 5327 (ADD-WHERE-IS-DATABASES 5171 . 5327)) (5329 5716 (ADD-WHERE-IS-DATABASE 5329 . 5716)) (5718 6197 - (DEL-WHERE-IS-DATABASE 5718 . 6197)) (6199 7351 (SAME-WHERE-IS-DATABASE 6199 . 7351)) (7353 8560 ( -CLOSE-WHERE-IS-FILES 7353 . 8560)) (8818 12235 (WHERE-IS-NOTICE 8818 . 12235)) (12237 12981 ( -WHERE-IS-NOTICE-INTERNAL 12237 . 12981)) (12983 13719 (WHERE-IS-FILES 12983 . 13719)) (13721 14086 ( -WHERE-IS-DEFAULT-DEFINE-TYPES 13721 . 14086)) (14088 14507 (WHERE-IS-NAMESTRING 14088 . 14507)) (14509 - 16521 (WHERE-IS-READ-COMS 14509 . 16521)) (16523 16794 (WHERE-IS-SET-WRITE-DATE 16523 . 16794)) ( -16796 17046 (WHERE-IS-GET-WRITE-DATE 16796 . 17046))))) + (IL:FILEMAP (NIL (1737 2069 (HASH-FILE-WHERE-IS 1737 . 2069)) (2071 2464 (HASH-FILE-TYPES-OF 2071 . +2464)) (2466 4631 (GET-WHERE-IS-ENTRIES 2466 . 4631)) (4633 5148 (WHERE-IS-READ-FN 4633 . 5148)) (5150 + 5306 (ADD-WHERE-IS-DATABASES 5150 . 5306)) (5308 5695 (ADD-WHERE-IS-DATABASE 5308 . 5695)) (5697 6176 + (DEL-WHERE-IS-DATABASE 5697 . 6176)) (6178 7330 (SAME-WHERE-IS-DATABASE 6178 . 7330)) (7332 8539 ( +CLOSE-WHERE-IS-FILES 7332 . 8539)) (8797 12214 (WHERE-IS-NOTICE 8797 . 12214)) (12216 12960 ( +WHERE-IS-NOTICE-INTERNAL 12216 . 12960)) (12962 13698 (WHERE-IS-FILES 12962 . 13698)) (13700 14065 ( +WHERE-IS-DEFAULT-DEFINE-TYPES 13700 . 14065)) (14067 14486 (WHERE-IS-NAMESTRING 14067 . 14486)) (14488 + 16500 (WHERE-IS-READ-COMS 14488 . 16500)) (16502 16773 (WHERE-IS-SET-WRITE-DATE 16502 . 16773)) ( +16775 17025 (WHERE-IS-GET-WRITE-DATE 16775 . 17025))))) IL:STOP diff --git a/library/WHERE-IS.DFASL b/library/WHERE-IS.DFASL index 92cbcd27..8abe17d1 100644 Binary files a/library/WHERE-IS.DFASL and b/library/WHERE-IS.DFASL differ diff --git a/library/WHERE-IS.TEDIT b/library/WHERE-IS.TEDIT new file mode 100644 index 00000000..a123d500 Binary files /dev/null and b/library/WHERE-IS.TEDIT differ diff --git a/lispusers/CALENDAR b/lispusers/CALENDAR index be6b68b6..1ecaa0ce 100644 --- a/lispusers/CALENDAR +++ b/lispusers/CALENDAR @@ -1,11 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 1-Feb-2022 17:14:32" {DSK}kaplan>Local>medley3.5>my-medley>lispusers>CALENDAR.;2 173369 +(FILECREATED " 5-May-2023 22:14:14" {WMEDLEY}CALENDAR.;4 173398 - :CHANGES-TO (FNS CALTEDITSTRING) + :EDIT-BY rmk - :PREVIOUS-DATE "21-Aug-90 09:16:22" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>CALENDAR.;1) + :CHANGES-TO (FNS PACKDATE CALTEDITSTRING) + + :PREVIOUS-DATE " 1-Feb-2022 17:14:32" {WMEDLEY}CALENDAR.;2) (* ; " @@ -1118,7 +1119,8 @@ Copyright (c) 1985-1990 by Xerox Corporation. 'Abort]) (CALTEDITSTRING - [LAMBDA (STRING M D YR) (* ; "Edited 1-Feb-2022 17:13 by rmk") + [LAMBDA (STRING M D YR) (* ; "Edited 5-May-2023 21:56 by rmk") + (* ; "Edited 1-Feb-2022 17:13 by rmk") (* ; "Edited 14-Oct-88 12:48 by MJD") (* T.Bigham "12-Nov-84 11:03") @@ -1165,7 +1167,7 @@ Copyright (c) 1985-1990 by Xerox Corporation. (CHARACTER 13) "Message: >>Any text<<"))) NIL NIL NIL '(QUITFN T] - (TEDIT.SETSEL STREAM 24 12 NIL T) + (TEDIT.NEXT STREAM) (SPAWN.MOUSE) [SETQ RESULT (TEDIT STREAM CALTEDITWINDOW T '(QUITFN T] (IF (EQ RESULT 'Abort) @@ -1897,26 +1899,22 @@ Copyright (c) 1985-1990 by Xerox Corporation. W H]) (PACKDATE - [LAMBDA (MTIME M D YR) (* MJD "15-May-87 09:38") - - (* Takes a time, M, D, and YR, and packs them into a formatted date which is - returned.) - - (* If MTIME = 0, then this is an untimed rem., so store NIL in the time field.) + [LAMBDA (MTIME M D YR) (* ; "Edited 5-May-2023 22:10 by rmk") + (* MJD "15-May-87 09:38") + + (* Takes a time, M, D, and YR, and packs them into a formatted date which is + returned.) + + (* If MTIME = 0, then this is an untimed rem., so store NIL in the time field.) (CONCAT (if (IGEQ D 10) then D else (CONCAT " " D)) "-" (MONTHABBR M) - "-" - (if (IGREATERP YR 1999) - then YR - else (IDIFFERENCE YR 1900)) - " " - (if (EQ MTIME 0) - then NIL - else MTIME]) + "-" YR " " (if (EQ MTIME 0) + then NIL + else MTIME]) (PARSETIME [LAMBDA (TSTRING) (* MJD "22-Oct-85 12:06") @@ -3044,28 +3042,28 @@ Copyright (c) 1985-1990 by Xerox Corporation. FREEMENU TABLEBROWSER) (PUTPROPS CALENDAR COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1989 1990)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (8660 168249 (CALADDEVENT 8670 . 15774) (CALCREATEREM 15776 . 18369) (CALDELETEREM 18371 - . 21281) (CALDISPEVENT 21283 . 29466) (CALDOOPTIONS 29468 . 31251) (CALENDAR 31253 . 34327) ( -CALENDARWATCHER 34329 . 34606) (CALEXTENDSEL 34608 . 36556) (CALLOADFILE 36558 . 46400) (CALMAKEKEY -46402 . 46603) (CALMONTHBEF 46605 . 47698) (CALMONTHICONFN 47700 . 48207) (CALMONTHRBF 48209 . 49001) -(CALOPTIONMENU 49003 . 51258) (CALPEEKNEWMAIL 51260 . 54451) (CALPRINTREM 54453 . 56071) (CALREMDEF -56073 . 56314) (CALTBCLOSEFN 56316 . 56718) (CALTBCOPYFN 56720 . 59088) (CALTBNULLFN 59090 . 59316) ( -CALTBSELECTEDFN 59318 . 59715) (CALTEDITEXIT 59717 . 60010) (CALTEDITSTRING 60012 . 63568) ( -CALUPDATEFILE 63570 . 70525) (CALUPDATEINIT 70527 . 73896) (CALYEARICONFN 73898 . 74381) ( -CALYEARINRANGE 74383 . 74657) (CIRCLETODAY 74659 . 78136) (CLEARDAY 78138 . 79661) (CLOSEMONTH 79663 - . 80232) (DAYABBR 80234 . 80496) (DAYNAME 80498 . 80691) (DAYOF 80693 . 81725) (DAYPLUS 81727 . 82024 -) (DAYSIN 82026 . 82858) (DERIVENEWDATE 82860 . 86599) (DOREMINDER 86601 . 90935) (FMNWAYITEM 90937 . -91338) (GETREMDEF 91340 . 91652) (INVERTGROUP 91654 . 91922) (LISPDATEDAY 91924 . 92202) ( -LISPDATEMONTH 92204 . 92352) (LISPDATEYEAR 92354 . 92718) (MDMENUITEMREGION 92720 . 93184) (MENUITEM -93186 . 93377) (MENUREGIONITEM 93379 . 93747) (MONTHABBR 93749 . 93926) (MONTHNAME 93928 . 94167) ( -MONTHNUM 94169 . 94375) (MONTHOFDAYPLUS 94377 . 94605) (MONTHPLUS 94607 . 94912) (MONTHYEARPLUS 94914 - . 95202) (NEWPARSETIME 95204 . 100855) (NEXTMDISPLAYREGION 100857 . 103428) (PACKDATE 103430 . 104145 -) (PARSETIME 104147 . 105274) (PICKFONTSIZE 105276 . 105930) (POM 105932 . 108586) (POMDAYS 108588 . -109929) (PRINTMONTH 109931 . 113797) (REMINDERSOF 113799 . 114717) (REMINDERTIME 114719 . 114961) ( -REMINDERTIMELT 114963 . 115662) (REMSINMONTH 115664 . 115853) (REPAINTMONTH 115855 . 116257) ( -REPAINTYEAR 116259 . 116589) (SAMEDAYAS 116591 . 116994) (SAMEMONTHAS 116996 . 117281) (SCALEBITMAP -117283 . 126335) (SHOWDAY 126337 . 134583) (SHOWMONTH 134585 . 154663) (SHOWMONTHSMALL 154665 . 155801 -) (SHOWMOON 155803 . 158742) (SHOWREMSINDAY 158744 . 160234) (SHOWREMSINMONTH 160236 . 162686) ( -SHOWYEAR 162688 . 166202) (SHRINKMONTH 166204 . 166630) (SHRINKYEAR 166632 . 167161) (TIMEDREMP 167163 - . 167287) (TPLUS 167289 . 167823) (WEEKOF 167825 . 168079) (YNCONVERT 168081 . 168247))))) + (FILEMAP (NIL (8620 168278 (CALADDEVENT 8630 . 15734) (CALCREATEREM 15736 . 18329) (CALDELETEREM 18331 + . 21241) (CALDISPEVENT 21243 . 29426) (CALDOOPTIONS 29428 . 31211) (CALENDAR 31213 . 34287) ( +CALENDARWATCHER 34289 . 34566) (CALEXTENDSEL 34568 . 36516) (CALLOADFILE 36518 . 46360) (CALMAKEKEY +46362 . 46563) (CALMONTHBEF 46565 . 47658) (CALMONTHICONFN 47660 . 48167) (CALMONTHRBF 48169 . 48961) +(CALOPTIONMENU 48963 . 51218) (CALPEEKNEWMAIL 51220 . 54411) (CALPRINTREM 54413 . 56031) (CALREMDEF +56033 . 56274) (CALTBCLOSEFN 56276 . 56678) (CALTBCOPYFN 56680 . 59048) (CALTBNULLFN 59050 . 59276) ( +CALTBSELECTEDFN 59278 . 59675) (CALTEDITEXIT 59677 . 59970) (CALTEDITSTRING 59972 . 63623) ( +CALUPDATEFILE 63625 . 70580) (CALUPDATEINIT 70582 . 73951) (CALYEARICONFN 73953 . 74436) ( +CALYEARINRANGE 74438 . 74712) (CIRCLETODAY 74714 . 78191) (CLEARDAY 78193 . 79716) (CLOSEMONTH 79718 + . 80287) (DAYABBR 80289 . 80551) (DAYNAME 80553 . 80746) (DAYOF 80748 . 81780) (DAYPLUS 81782 . 82079 +) (DAYSIN 82081 . 82913) (DERIVENEWDATE 82915 . 86654) (DOREMINDER 86656 . 90990) (FMNWAYITEM 90992 . +91393) (GETREMDEF 91395 . 91707) (INVERTGROUP 91709 . 91977) (LISPDATEDAY 91979 . 92257) ( +LISPDATEMONTH 92259 . 92407) (LISPDATEYEAR 92409 . 92773) (MDMENUITEMREGION 92775 . 93239) (MENUITEM +93241 . 93432) (MENUREGIONITEM 93434 . 93802) (MONTHABBR 93804 . 93981) (MONTHNAME 93983 . 94222) ( +MONTHNUM 94224 . 94430) (MONTHOFDAYPLUS 94432 . 94660) (MONTHPLUS 94662 . 94967) (MONTHYEARPLUS 94969 + . 95257) (NEWPARSETIME 95259 . 100910) (NEXTMDISPLAYREGION 100912 . 103483) (PACKDATE 103485 . 104174 +) (PARSETIME 104176 . 105303) (PICKFONTSIZE 105305 . 105959) (POM 105961 . 108615) (POMDAYS 108617 . +109958) (PRINTMONTH 109960 . 113826) (REMINDERSOF 113828 . 114746) (REMINDERTIME 114748 . 114990) ( +REMINDERTIMELT 114992 . 115691) (REMSINMONTH 115693 . 115882) (REPAINTMONTH 115884 . 116286) ( +REPAINTYEAR 116288 . 116618) (SAMEDAYAS 116620 . 117023) (SAMEMONTHAS 117025 . 117310) (SCALEBITMAP +117312 . 126364) (SHOWDAY 126366 . 134612) (SHOWMONTH 134614 . 154692) (SHOWMONTHSMALL 154694 . 155830 +) (SHOWMOON 155832 . 158771) (SHOWREMSINDAY 158773 . 160263) (SHOWREMSINMONTH 160265 . 162715) ( +SHOWYEAR 162717 . 166231) (SHRINKMONTH 166233 . 166659) (SHRINKYEAR 166661 . 167190) (TIMEDREMP 167192 + . 167316) (TPLUS 167318 . 167852) (WEEKOF 167854 . 168108) (YNCONVERT 168110 . 168276))))) STOP diff --git a/lispusers/CALENDAR.LCOM b/lispusers/CALENDAR.LCOM index 8ec96be6..21c21fcc 100644 Binary files a/lispusers/CALENDAR.LCOM and b/lispusers/CALENDAR.LCOM differ diff --git a/lispusers/COMPAREDIRECTORIES.TEDIT b/lispusers/COMPAREDIRECTORIES.TEDIT index e9a311b1..9bc20226 100644 --- a/lispusers/COMPAREDIRECTORIES.TEDIT +++ b/lispusers/COMPAREDIRECTORIES.TEDIT @@ -3,40 +3,21 @@ XEROX COMPAREDIRECTORIES 2 1 COMPAREDIRECTORIES 1 4 - By: Larry Masinter and Ron Kaplan This document edited on December 2, 1987 December 28, 1998 (Ron Kaplan) April 7, 2018 (Ron Kaplan) Rewritten December, 2021 (Ron Kaplan) COMPAREDIRECTORIES compares the contents of two directories, identifying files according to their creation dates and lengths. It is called using the function (COMPAREDIRECTORIES DIR1 DIR2 SELECT INCLUDEDFILES EXCLUDEDFILES USEDIRECTORYDATES OUTPUTFILE ALLVERSIONS) [Function] Compares the creation dates of files with matching names in the lists that CDFILES returns for DIR1 and DIR2. Collects or prints CDENTRIES for those files that meet the SELECT criteria. May also collect or print entries for relevant files that exist in DIR1 or DIR2 but not both. -SELECT specifies the match/mismatch criteria for filtering the output. If SELECT is or contains AFTER or >: select entries where file1 has a later date than file2 BEFORE or <: select entries where file1 has an earlier date than file2 SAMEDATE or =: select entries where file1 and file2 have the same date -*: exclude entries where file1 does not exist *-: exclude entries where file2 does not exist ~=: exclude entries where file1 and file2 are byte-equivalent SELECT = NIL is equivalent to (< > -* *-). Excludes files with matching dates, a useful default for identifying files that may require further attention. SELECT = T is equivalent to (= < > -* *-). Includes all files for processing by other functions or later filtering by CDSUBSET (below). SELECT may also contain the token AUTHOR to indicate that authors should be provided in the printed output (see CDPRINT below). Unless USEDIRECTORYDATES, the FILECREATED date is used for the date comparison of Lisp source and compiled files, otherwise the file-system CREATIONDATE is used. If OUTPUTFILE=NIL, then the value is a CDVALUE structure with fields (CDPARAMETERS . CDENTRIES). CDPARAMETERS records the parameters in the call to COMPAREDIRECTORIES and CDENTRIES is the list of per-file comparison results. CDPARAMETERS has fields - CDDIR1 CDDIR2 CDCOMPAREDATE CDSELECT. -CDENTRIES contains one entry for each of the file-comparisons that meets the SELECT criteria. Each entry is a CDENTRY record with fields MATCHNAME INFO1 DATERULE INFO2 EQUIV where MATCHNAME is the name.extension shared by the two files, and each file info is either NIL (for nonexistent files) or a CDINFO record with fields (FULLNAME DATE LENGTH AUTHOR TYPE EOL) TYPE is SOURCE for Lisp source (filecreated) files, COMPILED for Lisp compiled files, otherwise the PRINTFILETYPE (TEXT, TEDIT...) or NIL. EOL is CR, LF, CRLF, or NIL. When both files exist, the date relation is one of <, =, or >. Otherwise, the date relation is * if only one file exists. -EQUIV is T for files that contain the same bytes. In that case, the date of the earlier file is assumed to be more accurate, it replaces the CREATIONDATE of the earlier file, and the date relation is changed to =. If OUTPUTFILE is not NIL, then it is a filename or open stream on which selected entries will be printed (T for the terminal) by CDPRINT. COMPAREDIRECTORIES always sets the variable LASTCDVALUE to the CDVALUE data structure. This is used by the functions below if their CDENTRIES is NIL. (CDPRINT CDVALUE FILE COLHEADINGS PRINTAUTHOR ) [Function] Prints CDVALUE on FILE, with one line for each entry. The line for each entry is of the form FILE1 (AUTHOR) SIZE DATE DATEREL DATE FILE2 (AUTHOR) SIZE For example ACE.;1 (Joe) 235 2-May-1985 18:03:54 < 30-Sep-1985 11:14:48 ACE.;3 (Sam) 396 The line for byte-equivalent files is prefixed with ==. If the files are equivalent except for a difference in end-of-line conventions, the equivalence prefix will indicate the convention for each file (C for CR, L, for LF, 2 for CRLF). Thus C2 indicates that the files are equivalent except that file1 marks line ends with CR and file2 with CRLF. -COLHEADINGS can be a pair (col1 col2) of strings to be printed as column headings. Note that because COMPAREDIRECTORIES sets LASTCDVALUE, evaluating (CDPRINT) after COMPAREDIRECTORIES prints the results of the last comparision. For conciseness, authors are included only if PRINTAUTHOR or if AUTHOR is included in the CDSELECT parameter of CDVALUE. Also, redundant file-name hosts/directories are not printed. - -(CDTEDIT CDVALUE TITLE COLHEADINGS PRINTAUTHOR) [Function] -Produces the CDPRINT output in a read-only TEDIT window, with TITLE if given. - -(CDBROWSER CDVALUE TITLE COLHEADINGS BROWSERPROPS SEPARATEDIRECTIONS MENUITEMS PRINTAUTHOR) [Function] -Produce the CDPRINT output in a TABLEBROWSER window with menu commands for comparing the contents of individual files, viewing files in read-only TEDIT windows, copying files from one directory to another, etc. Lisp source files are compared with COMPARESOURCES, text files with COMPARETEXT. If SEPARATEDIRECTIONS, the entry lines are grouped according to whether the date relation is < or >. -(CDFILES DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH) [Function] Returns a list of full filenames for files in directory DIR (NIL=T=the connected directory) that match the other file-name filtering criteria. Files are excluded if: Their name does not match a pattern in INCLUDEDFILES (NIL = *.*). Dotted files are excluded unless FILEPATTERNS includes .* and files in subdirectories are excluded if the number of subdirectories exceeds DEPTH (below). They do not match patterns on the list EXCLUDEDFILES. *.* excludes all extensions, *.COM or just COM excludes extentsions on *COMPILED-EXTENSIONS*. EXCLUDEDFILES contains .* to suppress dotted files unless .* also appears in INCLUDEDFILES. They are not the highest version unless ALLVERSIONS=T. DEPTH controls the depth of subdirectory exploration. T means all levels, NIL means no subdirectories. Otherwise the maximum number of > or / characters below the starting DIR in the fullname of files. (CDFILES) produces all the newest, undotted files in the immediate connected directory. (CDMERGE CDVALUES) [Function] -Merges all subsets of CDVALUES that have the same CDSELECT into a single CDVALUE with the union of their CDENTRIES. The CDCOMPAREDATE of the merger will be the latest of the dates, and the directories and match names will be adjusted to reflect the original subdirectory sources. - (CDMAP CDVALUE FN) [Function] (CDSUBSET CDVALUE FN) [Function] CDMAP and CDSUBSET both apply FN to each CDENTRY in CDVALUE, perhaps modifying the information in the entry. CDSUBSET returns a new cdvalue structure whose entries are the subset of the entries (perhaps modified) for which FN is non-NIL. For convenience, at each invocation the variables MATCHNAME INFO1 DATEREL INFO2 and EQUIV are bound to the corresponding fields and can be used freely by FN. USEFUL UTILITIES (FIX-DIRECTORY-DATES FILES) [Function] For every file included in or specified by FILES, if it is a Lisp source or compiled whose directory creation date is more than 30 seconds later than its internal filecreated date (presumably because of copying), then its directory date is reset to match the internal date. FILES can be a list of file names or a pattern interpretable by FILDIR. Returns a list of files whose dates have been changed. (FIX-EQUIV-DATES CDVALUE) [Function] If there is an entry in CDVALUE whose files are EQUIVALENT but with different directory creation dates, the directory date of the file with the later date (presumably a copy) is reset to match the date of the earlier file. In the end all equivalent files will have the same (earliest) date. Returns a list of files whose dates have been changed. (COPY-MISSING-FILES CDVALUE TARGET MATCHNAMES) [Function] Target is 1 or 2, indicating the direction of potential copies. If an entry with a source file but no target file has a matchname in MATCHNAMES, the source file is copied to the target directory. All target-absent files are copied if MATCNAMES is NIL. Source properties (including version number) are preserved in the target. (COPY-COMPARED-FILES CDVALUE TARGET MATCHNAMES) [Function] TARGET is 1 or 2, indicating the direction of potential copies. If an entry with both source and target files has a matchname in MATCHNAMES, the source file is copied to a new version of the target file. All files are copied if MATCHNAMES is NIL. (COMPILED-ON-SAME-SOURCE CDVALUE) [Function] Returns the subset of entries with Lisp compiled files (dfasl or lcom) that are compiled on the same source, according to SOURCE-FOR-COMPILED-P below. Presumably one should be removed to avoid confusion. (FIND-SOURCE-FILES CFILES SDIRS DFASLMARGIN) [Function] Returns (CFILE . SFILES) pairs where CFILE is a Lisp compiled file in CFILES and SFILES is list of files in SDIRS that CFILE was compiled on according to SOURCE-FOR-COMPILED-P. This suggests that at least one of SFILES should be copied to CFILE's location (or vice versa). (FIND-COMPILED-FILES SFILES CDIRS DFASLMARGIN) [Function] Returns (CFILE . SFILES) pairs where SFILE is a Lisp source file in SFILES and CFILES are files in CDIRS that are compiled on SFILE according to SOURCE-FOR-COMPILED-P. This suggests that at least one of CFILES should be copied to SFILE's location. (FIND-UNCOMPILED-FILES FILES DFASLMARGIN COMPILEXTS) [Function] Returns a list of elements each of which corresponds to a source file in FILES for which no appropriate compiled file can be found. An appropriate compiled file is a file in the same location with extension in COMPILEEXTS (defaulting to *COMPILED-EXTENSIONS*) that satisfies SOURCE-FOR-COMPILED-P. Each element is a list of the form (sourcefile . cfiles) cfiles contains compiled files that were compiled on a different version of sourcefile, NIL if no such files exist. Each cfile item is a pair (cfile timediff) where timediff is the time difference (in minutes) between the creation date of the compiled-file's source and the creation date of sourcefile (positive if the cfile was compiled later, as should be the case). FILES can be an explicit list of files, or a file specification interpretable by FILDIR; in that case only the newest source-file versions are processed. (FIND-UNSOURCED-FILES CFILES DFASLMARGIN COMPILEXTS) [Function] Returns the subset of the compiled files specified by CFILES for which a corresponding source file according to SOURCE-FOR-COMPILED-P cannot be found in the same directory. CFILES can be a list of files or a pattern that FILDIR can interpret. COMPILEEXTS can be one or more explicit compile-file extensions, defaulting to *COMPILED-EXTENSIONS*. (SOURCE-FOR-COMPILED-P SOURCE COMPILED DFASLMARGIN) [Function] Returns T if it can confirm that Lisp COMPILED file was compiled on Lisp SOURCE file. SOURCE and COMPILED can be provided as CREATED-AS values, to avoid repetitive computation. This compares the information in the filecreated expressions, original file names and original dates, and not the current directory names and dates. It appears that the times in DFASL files may differ from the filecreated source dates by a few minutes. The DFASLMARGIN can be provided to loosen up the date matching criterion. DFASLMARGIN is a pair (max min) and a DFASL COMPILED is deemed to be compiled on SOURCE if the compiled's source date is no more than max and no less than min minutes after the source date. A negative min allows for the possibility that the compiled-source date is earlier than the candidate source date. DFASLMARGIN defaults to (20 0). A single positive number x is coerced to (x 0). A single negative number is coerced to (-x x) (compiled file is no more than x minutes later or earlier). T is infinity in either direction. Examples: (T 0): COMPILED compiled on source later than SOURCE (0 T): COMPILED compiled on source earlier than SOURCE (odd) - 12: COMPILED compiled on source later than SOURCE by no more than 12 minutes -12: COMPILED compiled on source 12 minutes before or after SOURCE (FIND-MULTICOMPILED-FILES FILES SHOWINFO) [Function] Returns a list of files in FILES that have more than one type of compiled file (e.g. LCOM and DFASL). FILES is interpretable by FILDIR. If SHOWINFO, then the value contains a list for each file of the form (rootname loaded-version . CREATED-AS information for each compile-type) Otherwise just the rootname of the source is returns. (CREATED-AS FILE) [Function] If FILE is a Lisp source or compiled file, returns a record of its original filename and filecreated dates, and for compiled files, also the original compiled-on name and date. The return for a source file is a pair (sfullname sfilecreateddate) The return for a compiled file is a quadruple (cfullname cfilecreated sfullname sfilecreateddate) where sfullname and sourcefilecreated are extracted from the file's compiled-on information. The return is (fullname NIL) for a non-Lisp file. (EOLTYPE FILE SHOWCONTEXT) [Function] Returns the EOLTYPE of FILE (CR, LF, CRLF) if the type is unmistakable: contains at least one instance of one type and no instances of any others. Returns NIL if there is evidence of inconsistent types. If SHOWCONTEXT is an integer, it is the number of bytes for EOLTYPE to display before and after an instance of an inconsistent type. At each instance, the user is asked whether to continue scanning for other instances. SHOWCONTEXT = T is interpreted as 100. (BINCOMP FILE1 FILE2 EOLDIFFOK) [Function] Returns T if FILE1 and FILE2 are byte-identical. If EOLDIFFOK and FILE1 and FILE2 differ only in their eol conventions, the value is a list of the form (EOL1 EOL2), e.g. (CR CRLF). Otherwise the value is NIL. (LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))) -444 4.4..8.8J PAGEHEADING RUNNINGHEADMODERNTERMINALMODERN -TERMINAL + By: Larry Masinter and Ron Kaplan This document edited on December 2, 1987 December 28, 1998 (Ron Kaplan) April 7, 2018 (Ron Kaplan) Rewritten August 25, 2020 (Ron Kaplan) COMPAREDIRECTORIES compares the contents of two directories, identifying files according to their creation dates and lengths. It is called using the function (COMPAREDIRECTORIES DIR1 DIR2 SELECT FILEPATTERNS EXTENSIONSTOAVOID USEDIRECTORYDATES OUTPUTFILE ALLVERSIONS) [Function] Compares the creation dates of files with matching names in the lists that CDFILES returns for DIR1 and DIR2. Collects or prints CDENTRIES for those files that meet the SELECT criteria. May also collect or print entries for relevant files that exist in DIR1 or DIR2 but not both. SELECT specifies which the match/mismatch criteria for filtering the output. If SELECT is or contains AFTER or >: select entries where file1 has a later date than file2 BEFORE or <: select entries where file1 has an earlier date than file2 SAMEDATE or =: select entries where file1 and file2 have the same date -*: exclude entries where file1 does not exist *-: exclude entries where file2 does not exist ~=: exclude entries where file1 and file2 are byte-equivalent SELECT = NIL is equivalent to (< > -* *-). Excludes files with matching dates, a useful default for identifying files that may require further attention. SELECT = T is equivalent to (= < > -* *-). Includes all files for processing by other functions or later filtering by CDSUBSET (below). SELECT may also contain the token AUTHOR to indicate that authors should be provided in the printed output (see CDPRINT below). Unless USEDIRECTORYDATES, the FILECREATED date is used for the date comparison of Lisp source and compiled files, otherwise the file-system CREATIONDATE is used. If OUTPUTFILE=NIL, then a list of the form (Parameters . entries) is returned. Parameters is a list (DIR1 DIR2 SELECT DATE) that records the parameters of the comparison. Entries contains one entry for each of the file-comparisons that meets the SELECT criteria. Each entry is a CDENTRY record with fields (matchname info1 daterel info2 equiv) where matchname is the name.extension shared by the two files, and each file info is either NIL (for nonexistent files) or a CDINFO record with fields (FULLNAME DATE LENGTH AUTHOR TYPE EOL) TYPE is SOURCE for Lisp source (filecreated) files, COMPILED for Lisp compiled files, otherwise the PRINTFILETYPE (TEXT, TEDIT...) or NIL. EOL is CR, LF, CRLF, or NIL. When both files exist, the date relation is one of <, =, or >. Otherwise, the date relation is * if only one file exists. EQUIV is EQUIVALENT for files with different dates but exactly the same bytes, otherwise NIL. If OUTPUTFILE is not NIL, then it is a filename or open stream on which selected entries will be printed (T for the terminal) by CDPRINT. COMPAREDIRECTORIES sets the variable LASTCDENTRIES is set to the selected entries. This is used by the functions below if their CDENTRIES is NIL. (CDFILES DIR FILEPATTERNS EXTENSIONSTOAVOID ALLVERSIONS DEPTH) [Function] Returns a list of full filenames for files in directory DIR (NIL=T=the connected directory) that match the other file-name filtering criteria. Files are excluded if: Their name does not match a pattern in FILEPATTERNS (NIL = *). Dotted files are excluded unless FILEPATTERNS includes .* and files in subdirectories are excluded if the number of subdirectories exceeds DEPTH (below). Their extension is in the list EXTENSIONSTOAVOID (* excludes all extensions). They are not the highest version unless ALLVERSIONS=T. DEPTH controls the depth of subdirectory exploration. T means all levels, NIL means no subdirectories. Otherwise the maximum number of ">" characters below the starting DIR in the fullname of files. (CDFILES) produces all the newest, undotted files in the immediate connected directory. (CDPRINT CDENTRIES FILE PRINTAUTHOR) [Function] Prints CDENTRIES on FILE, with one line for each entry. The line for each entry is of the form FILE1 (AUTHOR) SIZE DATE relation DATE FILE2 (AUTHOR) SIZE For example ACE.;1 (Joe) 4035 2-May-1985 18:03:54 < 30-Sep-1985 11:14:48 ACE.;3 (Sam) 5096. The line for byte-equivalent files is prefixed with ==. If the files are equivalent except for a difference in end-of-line conventions, the equivalence prefix will indicate the convention for each file (C for CR, L, for LF, 2 for CRLF). Thus C2 indicates that the files are equivalent except that file1 marks line ends with CR and file2 with CRLF. Note that because of the setting of LASTCDENTRIES, evaluating (CDPRINT) after COMPAREDIRECTORIES prints the results of the last comparision. For conciseness, authors are included only if PRINTAUTHOR or if AUTHOR is included in the SELECT parameter of CDENTRIES. Also, the redundant file-name hosts/directories are not printed. (CDMAP CDENTRIES FN) [Function] (CDSUBSET CDENTRIES FN) [Function] CDMAP applies FN to each CDENTRY in CDENTRIES. CDSUBSET applies FN and also returns the subset of CDENTRIES for which FN is non-NIL and preserves in the value the parameters of CDENTRIES. For convenience, at each invocation the variables MATCHNAME INFO1 DATEREL INFO2 and EQUIV are bound to the corresponding fields and can be used freely by FN. USEFUL UTILITIES (FIX-DIRECTORY-DATES FILES) [Function] For every file included in or specified by FILES, if it is a Lisp source or compiled whose directory creation date is more than 30 seconds later than its internal filecreated date (presumably because of copying), then its directory date is reset to match the internal date. FILES can be a list of file names or a pattern interpretable by FILDIR. Returns a list of files whose dates have been changed. (FIX-EQUIV-DATES CDENTRIES) [Function] If there is an entry in CDENTRIES whose files are EQUIVALENT but with different directory creation dates, the directory date of the file with the later date (presumably a copy) is reset to match the date of the earlier file. In the end all equivalent files will have the same (earliest) date. Returns a list of files whose dates have been changed. (COPY-MISSING-FILES CDENTRIES TARGET MATCHNAMES) [Function] Target is 1 or 2, indicating the direction of potential copies. If an entry with a source file but no target file has a matchname in MATCHNAMES, the source file is copied to the target directory. All target-absent files are copied if MATCNAMES is NIL. Source properties (including version number) are preserved in the target. (COPY-COMPARED-FILES CDENTRIES TARGET MATCHNAMES) [Function] Target is 1 or 2, indicating the direction of potential copies. If an entry with both source and target files has a matchname in MATCHNAMES, the source file is copied to a new version of the target file. All files are copied if MATCHNAMES is NIL. (COMPARE-ENTRY-SOURCE-FILES CDENTRY LISTSTREAM EXAMINE DW?) [Function] This is a simple wrapper for calling COMPARESOURCES if the CDENTRY files are Lisp source files. The function (CDENTRY MATCHNAME CDENTRIES is useful for extracting a particular entry, with CDENTRIES defaulting to LASTCDENTRIES. (COMPILED-ON-SAME-SOURCE CDENTRIES) [Function] Returns the subset of entries with Lisp compiled files (dfasl or lcom) that are compiled on the same source, according to SOURCE-FOR-COMPILED-P below. Presumably one should be removed to avoid confusion. (FIND-SOURCE-FILES CFILES SDIRS DFASLMARGIN) [Function] Returns (CFILE . SFILES) pairs where CFILE is a Lisp compiled file in CFILES and SFILES is list of files in SDIRS that CFILE was compiled on according to SOURCE-FOR-COMPILED-P. This suggests that at least one of SFILES should be copied to CFILE's location (or vice versa). (FIND-COMPILED-FILES SFILES CDIRS DFASLMARGIN) [Function] Returns (SFILE . CFILES) pairs where SFILE is a Lisp source file in SFILES and CFILES are files in CDIRS that are compiled on SFILE according to SOURCE-FOR-COMPILED-P. This suggests that at least one of CFILES should be copied to SFILE's location. (FIND-UNCOMPILED-FILES FILES DFASLMARGIN COMPILEXTS) [Function] Returns a list of elements each of which corresponds to a source file in FILES for which no appropriate compiled file can be found. An appropriate compiled file is a file in the same location with extension in COMPILEEXTS (defaulting to *COMPILED-EXTENSIONS*) that satisfies SOURCE-FOR-COMPILED-P. Each element is a list of the form (sourcefile . cfiles) cfiles contains compiled files that were compiled on a different version of sourcefile, NIL if no such files exist. Each cfile item is a pair (cfile timediff) where timediff is the time difference (in minutes) between the creation date of the compiled-file's source and the creation date of sourcefile (positive if the cfile was compiled later, as should be the case). FILES can be an explicit list of files, or a file specification interpretable by FILDIR; in that case only the newest source-file versions are processed. (FIND-UNSOURCED-FILES CFILES DFASLMARGIN COMPILEXTS) [Function] Returns the subset of the compiled files specified by CFILES for which a corresponding source file according to SOURCE-FOR-COMPILED-P cannot be found in the same directory. CFILES can be a list of files or a pattern that FILDIR can interpret. COMPILEEXTS can be one or more explicit compile-file extensions, defaulting to *COMPILED-EXTENSIONS*. (SOURCE-FOR-COMPILED-P SOURCE COMPILED DFASLMARGIN) [Function] Returns T if it can confirm that Lisp COMPILED file was compiled on Lisp SOURCE file. SOURCE and COMPILED can be provided as CREATED-AS values, to avoid repetitive computation. This compares the information in the filecreated expressions, original file names and original dates, and not the current directory names and dates. It appears that the times in DFASL files may differ from the filecreated source dates by a few minutes. The DFASLMARGIN can be provided to loosen up the date matching criterion. DFASLMARGIN is a pair (max min) and a DFASL COMPILED is deemed to be compiled on SOURCE if the compiled's source date is no more than max and no less than min minutes after the source date. A negative min allows for the possibility that the compiled-source date is earlier than the candidate source date. DFASLMARGIN defaults to (20 0). A single positive number x is coerced to (x 0). A single negative number is coerced to (-x x) (compiled file is no more than x minutes later or earlier). T is infinity in either direction. Examples: (T 0): COMPILED compiled on source later than SOURCE (0 T): COMPILED compiled on source earlier than SOURCE (odd) 12: COMPILED compiled on source later than SOURCE by no more than 12 minutes -12: COMPILED compiled on source 12 minutes before or after SOURCE (FIND-MULTICOMPILED-FILES FILES SHOWINFO) [Function] Returns a list of files in FILES that have more than one type of compiled file (e.g. LCOM and DFASL). FILES is interpretable by FILDIR. If SHOWINFO, then the value contains a list for each file of the form !(rootname loaded-version . CREATED-AS information for each compile-type) Otherwise just the rootname of the source is returns. (CREATED-AS FILE) [Function] If FILE is a Lisp source or compiled file, returns a record of its original filename and filecreated dates, and for compiled files, also the original compiled-on name and date. The return for a source file is a pair (sfullname sfilecreateddate) The return for a compiled file is a quadruple (cfullname cfilecreated sfullname sfilecreateddate) where sfullname and sourcefilecreated are extracted from the file's compiled-on information. The return is (fullname NIL) for a non-Lisp file. (EOLTYPE FILE SHOWCONTEXT) [Function] Returns the EOLTYPE of FILE (CR, LF, CRLF) if the type is unmistakable: contains at least one instance of one type and no instances of any others. Returns NIL if there is evidence of inconsistent types. If SHOWCONTEXT is an integer, it is the number of bytes for EOLTYPE to display before and after an instance of an inconsistent type. At each instance, the user is asked whether to continue scanning for other instances. SHOWCONTEXT = T is interpreted as 100. (BINCOMP FILE1 FILE2 EOLDIFFOK) [Function] Returns T if FILE1 and FILE2 are byte-identical. If EOLDIFFOK and FILE1 and FILE2 differ only in their eol conventions, the value is a list of the form (EOL1 EOL2), e.g. (CR CRLF). Otherwise the value is NIL. (LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))) 4$40$4 $1$4@$4$1$18$18$J$ PAGEHEADING RUNNINGHEAD1$ +GACHA +TERMINALMODERN +MODERN +TERMINAL MODERN MODERN -LOGOMODERN +MODERNLOGOMODERN  - - +   HRULE.GETFNMODERN -  HRULE.GETFNMODERN -  HRULE.GETFNMODERN - HRULE.GETFNMODERN   HRULE.GETFNMODERN #!'o K  OO@A?44C  m -H  c   ' .   $ D( o*&m{ = -~ ?  -<G@ L]  .   .. @@ * m    H= 8k' / ^ '    -! (  O"3A _A'+c& -!< -\ T=| -Z - .z=: %< &AI %A64)* D@& -K <    ! &/65;  -$7".9'  . -  G  5Wz \ No newline at end of file +  HRULE.GETFNMODERN +  HRULE.GETFNMODERN + HRULE.GETFNMODERN   HRULE.GETFNMODERN #!( + +[ + +fJLL44C6)*KN7X1_A P]  Z#  ]0 I1 ; # , . 4 O4 [3 H:BRJ) I7 ".9    + 1.-z \ No newline at end of file diff --git a/lispusers/EVALOBJ b/lispusers/EVALOBJ index 28be07a3..954f0d27 100644 --- a/lispusers/EVALOBJ +++ b/lispusers/EVALOBJ @@ -1,22 +1,19 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED "11-May-2018 08:22:13"  -{DSK}kaplan>Local>medley3.5>lispcore>lispusers>EVALOBJ.;2 15206 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (VARS EVALOBJCOMS) +(FILECREATED "18-Jul-2023 12:27:33" {DSK}frank>il>medley>gmedley>lispusers>EVALOBJ.;2 15110 - previous date%: " 6-May-2000 09:24:45" -{DSK}kaplan>Local>medley3.5>lispcore>lispusers>EVALOBJ.;1) + :CHANGES-TO (VARS EVALOBJCOMS) + :PREVIOUS-DATE "11-May-2018 08:22:13" {DSK}frank>il>medley>gmedley>lispusers>EVALOBJ.;1 +) -(* ; " -Copyright (c) 1997, 1998, 1999, 2000, 2018 by Xerox Corporation. All rights reserved. -") (PRETTYCOMPRINT EVALOBJCOMS) (RPAQQ EVALOBJCOMS [(FILES IMOBJAPPLICATION) - (DECLARE%: DOEVAL@LOAD DONTCOPY (FILES EXPORTS.ALL)) + (DECLARE%: DOEVAL@LOAD DONTCOPY (FILES (FROM LOADUPS) + EXPORTS.ALL)) (FNS EVALOBJ.BUTTONEVENTINFN EVALOBJ.DISPLAYFN EVALOBJ.IMAGEBOXFN EVALOBJ.COPYFN EVALOBJ.CREATE EVALOBJ.GETFN EVALOBJ.PUTFN) (FNS PARAMS TEXTSTREAMPARAM) @@ -51,7 +48,8 @@ Copyright (c) 1997, 1998, 1999, 2000, 2018 by Xerox Corporation. All rights res (FILESLOAD IMOBJAPPLICATION) (DECLARE%: DOEVAL@LOAD DONTCOPY -(FILESLOAD EXPORTS.ALL) +(FILESLOAD (FROM LOADUPS) + EXPORTS.ALL) ) (DEFINEQ @@ -264,7 +262,7 @@ Copyright (c) 1997, 1998, 1999, 2000, 2018 by Xerox Corporation. All rights res SELECTION ) ( - EVALOBJ.SELTOOBJ + EVALOBJ.SELTOOBJ TEXTSTREAM SELECTION 'CREATE/LOAD] @@ -291,11 +289,10 @@ Copyright (c) 1997, 1998, 1999, 2000, 2018 by Xerox Corporation. All rights res (ADDTOVAR LAMA ) ) -(PUTPROPS EVALOBJ COPYRIGHT ("Xerox Corporation" 1997 1998 1999 2000 2018)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3038 9319 (EVALOBJ.BUTTONEVENTINFN 3048 . 4241) (EVALOBJ.DISPLAYFN 4243 . 5418) ( -EVALOBJ.IMAGEBOXFN 5420 . 6963) (EVALOBJ.COPYFN 6965 . 7188) (EVALOBJ.CREATE 7190 . 8606) ( -EVALOBJ.GETFN 8608 . 9009) (EVALOBJ.PUTFN 9011 . 9317)) (9320 11885 (PARAMS 9330 . 11261) ( -TEXTSTREAMPARAM 11263 . 11883)) (11886 13031 (EVALOBJ.DISMANTLEFN 11896 . 12179) (EVALOBJ.SELTOOBJ -12181 . 13029))))) + (FILEMAP (NIL (3016 9297 (EVALOBJ.BUTTONEVENTINFN 3026 . 4219) (EVALOBJ.DISPLAYFN 4221 . 5396) ( +EVALOBJ.IMAGEBOXFN 5398 . 6941) (EVALOBJ.COPYFN 6943 . 7166) (EVALOBJ.CREATE 7168 . 8584) ( +EVALOBJ.GETFN 8586 . 8987) (EVALOBJ.PUTFN 8989 . 9295)) (9298 11863 (PARAMS 9308 . 11239) ( +TEXTSTREAMPARAM 11241 . 11861)) (11864 13009 (EVALOBJ.DISMANTLEFN 11874 . 12157) (EVALOBJ.SELTOOBJ +12159 . 13007))))) STOP diff --git a/lispusers/EVALOBJ.LCOM b/lispusers/EVALOBJ.LCOM index 21408e2c..cc59731c 100644 Binary files a/lispusers/EVALOBJ.LCOM and b/lispusers/EVALOBJ.LCOM differ diff --git a/lispusers/EXAMINEDEFS.TEDIT b/lispusers/EXAMINEDEFS.TEDIT index a0390404..50aa5cef 100644 Binary files a/lispusers/EXAMINEDEFS.TEDIT and b/lispusers/EXAMINEDEFS.TEDIT differ diff --git a/lispusers/FILEWATCH b/lispusers/FILEWATCH index c372c341..ff49ce1f 100644 Binary files a/lispusers/FILEWATCH and b/lispusers/FILEWATCH differ diff --git a/lispusers/FILEWATCH.LCOM b/lispusers/FILEWATCH.LCOM index 7b719978..d3112d27 100644 Binary files a/lispusers/FILEWATCH.LCOM and b/lispusers/FILEWATCH.LCOM differ diff --git a/lispusers/HELPSYS b/lispusers/HELPSYS index da4c6f01..6794db81 100644 --- a/lispusers/HELPSYS +++ b/lispusers/HELPSYS @@ -1,17 +1,14 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "13-Jan-2023 10:46:39" {DSK}larry>il>medley>lispusers>HELPSYS.;2 87610 +(FILECREATED "16-Jun-2023 14:38:33" {DSK}larry>il>medley>lispusers>HELPSYS.;11 87625 + + :EDIT-BY "lmm" :CHANGES-TO (VARS HELPSYSCOMS) - (FNS REPO.LOOKUP) - :PREVIOUS-DATE "12-Oct-2022 18:33:26" {DSK}larry>il>medley>lispusers>HELPSYS.;1) + :PREVIOUS-DATE "13-Jan-2023 10:46:39" {DSK}larry>il>medley>lispusers>HELPSYS.;10) -(* ; " -Copyright (c) 1985-1987, 2020, 2022-2023 by Xerox Corporation. -") - (PRETTYCOMPRINT HELPSYSCOMS) (RPAQQ HELPSYSCOMS @@ -20,7 +17,7 @@ Copyright (c) 1985-1987, 2020, 2022-2023 by Xerox Corporation. (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) DINFO HASH)) [COMS (COMMANDS "man") - (FNS HELPSYS IRM.LOOKUP GENERIC.MAN.LOOKUP IRM.RESET) + (FNS HELPSYS IRM.LOOKUP GENERIC.MAN.LOOKUP IRM.SMART.LOOKUP IRM.RESET) (INITVARS (IRM.HOST&DIR) (IRM.HASHFILE.NAME)) (GLOBALVARS IRM.HOST&DIR IRM.HASHFILE.NAME) @@ -97,7 +94,8 @@ Copyright (c) 1985-1987, 2020, 2022-2023 by Xerox Corporation. DINFO HASH) ) -(DEFCOMMAND "man" (ENTRY) "Lookup ENTRY in the IRM." +(DEFCOMMAND "man" (ENTRY) + "Lookup ENTRY in the IRM." (GENERIC.MAN.LOOKUP ENTRY)) (DEFINEQ @@ -197,6 +195,10 @@ Copyright (c) 1985-1987, 2020, 2022-2023 by Xerox Corporation. else (APPEND (IRM.LOOKUP KEYWORD TYPE GRAPH T) (REPO.LOOKUP KEYWORD]) +(IRM.SMART.LOOKUP + [LAMBDA (KEYWORD GRAPH) (* drc%: " 6-Jan-86 14:50") + (IRM.LOOKUP KEYWORD NIL GRAPH T]) + (IRM.RESET [LAMBDA NIL (* drc%: "27-Jan-86 11:19") (if (type? DINFOGRAPH IRM.DINFOGRAPH) @@ -1697,15 +1699,15 @@ Copyright (c) 1985-1987, 2020, 2022-2023 by Xerox Corporation. (ADDTOVAR AROUNDEXITFNS \IRM.AROUND-EXIT) (PUTPROPS HELPSYS FILETYPE :FAKE-COMPILE-FILE) -(PUTPROPS HELPSYS COPYRIGHT ("Xerox Corporation" 1985 1986 1987 2020 2022 2023)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4671 10246 (HELPSYS 4681 . 6522) (IRM.LOOKUP 6524 . 8162) (GENERIC.MAN.LOOKUP 8164 . -9833) (IRM.RESET 9835 . 10244)) (10503 17450 (CLHS.INDEX 10513 . 13211) (CLHS.LOOKUP 13213 . 15113) ( -CLHS.OPENER 15115 . 16438) (REPO.LOOKUP 16440 . 17448)) (70538 72056 (IRM.GET.DINFOGRAPH 70548 . 71423 -) (IRM.DISPLAY.REF 71425 . 72054)) (72058 72420 (IRM.LOAD-GRAPH 72058 . 72420)) (72745 78249 ( -IRM.DISPLAY.CREF 72755 . 74469) (IRM.CREF.BOX 74471 . 75298) (IRM.PUT.CREF 75300 . 75525) ( -IRM.GET.CREF 75527 . 75898) (IRM.CREF.BUTTONEVENTFN 75900 . 78247)) (78804 87110 (\IRM.GET.REF 78814 - . 80145) (\IRM.SMART.REF 80147 . 82074) (\IRM.CHOOSE.REF 82076 . 83327) (\IRM.WILD.REF 83329 . 84584) - (\IRM.WILDCARD 84586 . 84952) (\IRM.WILD.MATCH 84954 . 86184) (\IRM.GET.HASHFILE 86186 . 86649) ( -\IRM.GET.KEYWORDS 86651 . 87108)) (87247 87403 (\IRM.AROUND-EXIT 87247 . 87403))))) + (FILEMAP (NIL (4609 10342 (HELPSYS 4619 . 6460) (IRM.LOOKUP 6462 . 8100) (GENERIC.MAN.LOOKUP 8102 . +9771) (IRM.SMART.LOOKUP 9773 . 9929) (IRM.RESET 9931 . 10340)) (10599 17546 (CLHS.INDEX 10609 . 13307) + (CLHS.LOOKUP 13309 . 15209) (CLHS.OPENER 15211 . 16534) (REPO.LOOKUP 16536 . 17544)) (70634 72152 ( +IRM.GET.DINFOGRAPH 70644 . 71519) (IRM.DISPLAY.REF 71521 . 72150)) (72154 72516 (IRM.LOAD-GRAPH 72154 + . 72516)) (72841 78345 (IRM.DISPLAY.CREF 72851 . 74565) (IRM.CREF.BOX 74567 . 75394) (IRM.PUT.CREF +75396 . 75621) (IRM.GET.CREF 75623 . 75994) (IRM.CREF.BUTTONEVENTFN 75996 . 78343)) (78900 87206 ( +\IRM.GET.REF 78910 . 80241) (\IRM.SMART.REF 80243 . 82170) (\IRM.CHOOSE.REF 82172 . 83423) ( +\IRM.WILD.REF 83425 . 84680) (\IRM.WILDCARD 84682 . 85048) (\IRM.WILD.MATCH 85050 . 86280) ( +\IRM.GET.HASHFILE 86282 . 86745) (\IRM.GET.KEYWORDS 86747 . 87204)) (87343 87499 (\IRM.AROUND-EXIT +87343 . 87499))))) STOP diff --git a/lispusers/HELPSYS.LCOM b/lispusers/HELPSYS.LCOM index 9f8375a4..e10cac9c 100644 Binary files a/lispusers/HELPSYS.LCOM and b/lispusers/HELPSYS.LCOM differ diff --git a/lispusers/OBJECTWINDOW.TEDIT b/lispusers/OBJECTWINDOW.TEDIT index e8fad1bb..108c65d3 100644 Binary files a/lispusers/OBJECTWINDOW.TEDIT and b/lispusers/OBJECTWINDOW.TEDIT differ diff --git a/lispusers/PSEUDOHOSTS b/lispusers/PSEUDOHOSTS index 0f02b0ce..74b9f2ad 100644 --- a/lispusers/PSEUDOHOSTS +++ b/lispusers/PSEUDOHOSTS @@ -1,10 +1,16 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "31-Oct-2022 23:32:43" {WMEDLEY}PSEUDOHOSTS.;151 27537 +(FILECREATED "18-Jul-2023 13:12:35" {DSK}frank>il>medley>gmedley>lispusers>PSEUDOHOSTS.;2 28158 - :CHANGES-TO (FNS OPENFILE.PH) + :CHANGES-TO (VARS PSEUDOHOSTSCOMS) + (FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEFILENAME PSEUDOFILENAME + EXPAND.PH CONTRACT.PH SLASHIT UNSLASHIT GETHOSTINFO.PH OPENFILE.PH + GETFILENAME.PH DIRECTORYNAMEP.PH CLOSEFILE.PH REOPENFILE.PH DELETEFILE.PH + OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH + SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH) - :PREVIOUS-DATE "14-Jul-2022 17:54:43" {WMEDLEY}PSEUDOHOSTS.;150) + :PREVIOUS-DATE "31-Oct-2022 23:32:43" +{DSK}frank>il>medley>gmedley>lispusers>PSEUDOHOSTS.;1) (PRETTYCOMPRINT PSEUDOHOSTSCOMS) @@ -27,7 +33,8 @@ (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE) (MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL) (P (CL:UNLESS (GETP 'EXPORTS.ALL 'FILE) - (LOAD 'EXPORTS.ALL))]) + (FILESLOAD (FROM LOADUPS) + EXPORTS.ALL))]) @@ -53,8 +60,8 @@ (CHARCODE })) (SETQ HOST (SUBSTRING HOST 1 -2))) (SETQ HOST (U-CASE (MKATOM HOST))) - [IF PREFIX - THEN (CL:WHEN (PSEUDOHOSTP HOST) (* ; + [if PREFIX + then (CL:WHEN (PSEUDOHOSTP HOST) (* ;  "Redefining: first clear out the previous one") (PSEUDOHOST HOST NIL)) [LET (TARGETHOST TARGETDEVICE PREFIXHOST) @@ -85,8 +92,8 @@ (* ;; "Save the last directory marker to pack on if needed.") (\DEFINEDEVICE HOST - (CREATE FDEV - USING TARGETDEVICE DEVICENAME _ HOST FDEV1 _ TARGETDEVICE FDEV2 _ PREFIX + (create FDEV + using TARGETDEVICE DEVICENAME _ HOST FDEV1 _ TARGETDEVICE FDEV2 _ PREFIX OPENFILELST _ NIL OPENFILE _ (FUNCTION OPENFILE.PH) GETFILENAME _ (FUNCTION GETFILENAME.PH) DIRECTORYNAMEP _ (FUNCTION DIRECTORYNAMEP.PH) @@ -103,7 +110,7 @@ (* ;; "The ultimate target device keeps a map of prefixes and the hostnames they map to. The longest matching prefix is chosen when a name that expands to the target device is contracted.") - (CHANGE (FETCH (TARGETDEVICE PREFIXMAP) OF TARGETDEVICE) + (change (fetch (TARGETDEVICE PREFIXMAP) OF TARGETDEVICE) (SORT (CONS (LIST PREFIX HOST (CL:IF (EQ (CHARCODE /) (NTHCHARCODE PREFIX -1)) '/ @@ -112,12 +119,12 @@ (FUNCTION (LAMBDA (P1 P2) (IGREATERP (NCHARS (CAR P1)) (NCHARS (CAR P2] - ELSEIF (SETQ PREFIX (CADR (PSEUDOHOSTP HOST))) - THEN + elseif (SETQ PREFIX (CADR (PSEUDOHOSTP HOST))) + then (* ;; "\DEFINEDEVICE removes the name-mapping but doesn't remove the device. Maybe that's on purpose for other devices, but not here.") (LET* ((PHHOST (\GETDEVICEFROMNAME HOST \FILEDEVICES)) - (TARGETDEV (FETCH (PHDEVICE TARGETDEV) OF PHHOST))) + (TARGETDEV (fetch (PHDEVICE TARGETDEV) OF PHHOST))) (UNINTERRUPTABLY (CL:WHEN TARGETDEV (* ;  "Don't want to fail uninterruptably") @@ -132,13 +139,13 @@ [LAMBDA (HOST) (* ; "Edited 24-Feb-2022 23:51 by rmk") (* ; "Edited 18-Jan-2022 11:29 by rmk") (LET ((DEV (\GETDEVICEFROMNAME HOST T T))) - (CL:WHEN (AND DEV (TYPE? FDEV (FETCH (PHDEVICE TARGETDEV) OF DEV))) + (CL:WHEN (AND DEV (type? FDEV (fetch (PHDEVICE TARGETDEV) OF DEV))) (LIST (FETCH (FDEV DEVICENAME) OF DEV) (FETCH (PHDEVICE PREFIX) DEV)))]) (PSEUDOHOSTS - [LAMBDA NIL (* ; "Edited 17-Jan-2022 18:15 by rmk") + [LAMBDA NIL (* ; "Edited 17-Jan-2022 18:15 by rmk") (FOR DEV IN \FILEDEVICES WHEN (TYPE? FDEV (FETCH (PHDEVICE TARGETDEV) OF DEV)) COLLECT (LIST (FETCH (FDEV DEVICENAME) OF DEV) (FETCH (PHDEVICE PREFIX) OF DEV]) @@ -401,7 +408,7 @@ STREAM]) (GENERATEFILES.PH - [LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* ; "Edited 17-Jan-2022 20:46 by rmk") + [LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* ; "Edited 17-Jan-2022 20:46 by rmk") (* ;; "FDEV is the pseudohost. We will generate from the target directory using its GENFILESTATE, but fiddle the output so that it looks like it is coming from the pseudo host.") @@ -428,7 +435,7 @@ (PSEUDOHOST.TARGETVAL SETFILEINFO (STREAM ATTRIBUTE VALUE DEVICE]) (NEXTFILEFN.PH - [LAMBDA (GENFILESTATE NAMEONLY) (* ; "Edited 17-Jan-2022 21:27 by rmk") + [LAMBDA (GENFILESTATE NAMEONLY) (* ; "Edited 17-Jan-2022 21:27 by rmk") (LET* ((TARGETGENOBJ (CADR GENFILESTATE)) (TARGETGENFILESTATE (FETCH GENFILESTATE OF TARGETGENOBJ)) (FILENAME (APPLY* (FETCH NEXTFILEFN OF TARGETGENOBJ) @@ -439,13 +446,13 @@ FILENAME]) (FILEINFOFN.PH - [LAMBDA (GENFILESTATE ATTRIBUTE) (* ; "Edited 17-Jan-2022 20:52 by rmk") + [LAMBDA (GENFILESTATE ATTRIBUTE) (* ; "Edited 17-Jan-2022 20:52 by rmk") (APPLY* (FETCH FILEINFOFN OF (CADR GENFILESTATE)) (FETCH GENFILESTATE OF (CADR GENFILESTATE)) ATTRIBUTE]) (RENAMEFILE.PH - [LAMBDA (OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME) (* ; "Edited 18-Jan-2022 09:52 by rmk") + [LAMBDA (OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME) (* ; "Edited 18-Jan-2022 09:52 by rmk") (LET ((OLDTARGETDEV (FETCH (PHDEVICE TARGETDEV) OF OLD-DEVICE)) (NEWTARGETDEV (FETCH (PHDEVICE TARGETDEV) OF NEW-DEVICE)) (NEWTARGETNAME NEW-NAME) @@ -520,16 +527,17 @@ (CL:UNLESS (GETP 'EXPORTS.ALL 'FILE) - (LOAD 'EXPORTS.ALL)) + (FILESLOAD (FROM LOADUPS) + EXPORTS.ALL)) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1268 9300 (PSEUDOHOST 1278 . 6837) (PSEUDOHOSTP 6839 . 7352) (PSEUDOHOSTS 7354 . 7711) -(TARGETHOST 7713 . 7987) (TRUEFILENAME 7989 . 8676) (PSEUDOFILENAME 8678 . 9298)) (9328 16867 ( -EXPAND.PH 9338 . 10591) (CONTRACT.PH 10593 . 13258) (SLASHIT 13260 . 14828) (UNSLASHIT 14830 . 16576) -(GETHOSTINFO.PH 16578 . 16865)) (16868 24872 (OPENFILE.PH 16878 . 17951) (GETFILENAME.PH 17953 . 18242 -) (DIRECTORYNAMEP.PH 18244 . 18868) (CLOSEFILE.PH 18870 . 19337) (REOPENFILE.PH 19339 . 19904) ( -DELETEFILE.PH 19906 . 20190) (OPENP.PH 20192 . 20487) (UNREGISTERFILE.PH 20489 . 21031) ( -REGISTERFILE.PH 21033 . 21567) (GENERATEFILES.PH 21569 . 22609) (GETFILEINFO.PH 22611 . 22913) ( -SETFILEINFO.PH 22915 . 23114) (NEXTFILEFN.PH 23116 . 23658) (FILEINFOFN.PH 23660 . 23931) ( -RENAMEFILE.PH 23933 . 24870))))) + (FILEMAP (NIL (1835 9871 (PSEUDOHOST 1845 . 7404) (PSEUDOHOSTP 7406 . 7919) (PSEUDOHOSTS 7921 . 8282) +(TARGETHOST 8284 . 8558) (TRUEFILENAME 8560 . 9247) (PSEUDOFILENAME 9249 . 9869)) (9899 17438 ( +EXPAND.PH 9909 . 11162) (CONTRACT.PH 11164 . 13829) (SLASHIT 13831 . 15399) (UNSLASHIT 15401 . 17147) +(GETHOSTINFO.PH 17149 . 17436)) (17439 25459 (OPENFILE.PH 17449 . 18522) (GETFILENAME.PH 18524 . 18813 +) (DIRECTORYNAMEP.PH 18815 . 19439) (CLOSEFILE.PH 19441 . 19908) (REOPENFILE.PH 19910 . 20475) ( +DELETEFILE.PH 20477 . 20761) (OPENP.PH 20763 . 21058) (UNREGISTERFILE.PH 21060 . 21602) ( +REGISTERFILE.PH 21604 . 22138) (GENERATEFILES.PH 22140 . 23184) (GETFILEINFO.PH 23186 . 23488) ( +SETFILEINFO.PH 23490 . 23689) (NEXTFILEFN.PH 23691 . 24237) (FILEINFOFN.PH 24239 . 24514) ( +RENAMEFILE.PH 24516 . 25457))))) STOP diff --git a/lispusers/PSEUDOHOSTS.LCOM b/lispusers/PSEUDOHOSTS.LCOM index 22acb128..62acc97a 100644 Binary files a/lispusers/PSEUDOHOSTS.LCOM and b/lispusers/PSEUDOHOSTS.LCOM differ diff --git a/lispusers/PSEUDOHOSTS.TEDIT b/lispusers/PSEUDOHOSTS.TEDIT index e8568cef..1c8e3d76 100644 Binary files a/lispusers/PSEUDOHOSTS.TEDIT and b/lispusers/PSEUDOHOSTS.TEDIT differ diff --git a/lispusers/REGIONMANAGER.TEDIT b/lispusers/REGIONMANAGER.TEDIT index e0bd0452..a53f7e02 100644 --- a/lispusers/REGIONMANAGER.TEDIT +++ b/lispusers/REGIONMANAGER.TEDIT @@ -1,10 +1,9 @@ -Medley REGIONMANAGER2 +Medley REGIONMANAGER 2 4 1 REGIONMANAGER 1 4 - By: - Ron Kaplan This document created in December 2021. + By Ron Kaplan This document created in December 2021. Medley comes equipped with a core set of functions for specifying regions and creating the windows that occupy those regions on the screen. But it can be disruptive if not irritating to have to draw out a new ghost region for every invocation of a particular application. Thus the common applications (e.g. TEDIT, SEDIT, DINFO...) implement particular strategies to reduce the number of times that a user has to sweep out a new region. They instead default to regions that were allocated for earlier invocations that are no longer active. TEDIT for example recycles the region of a session that was recently shut down, SEDIT allocates from a list of previous regions, DINFO always uses the same region, but FILEBROWSER always prompts for a new one. Applications that do recycle their regions tend to do so indiscrimately, without regard to the current arrangement of other windows on the screen or the role that those windows may play in higher-level applications. The REGIONMANAGER package provides simple extensions to the core region and window functions. These are aimed at giving users and application implementors more flexible and systematic control over the specification and reuse of screen regions. It introduces three new notions: A "typed region" allows the regions of particular applications to be specified, classified, and recycled according to their types. @@ -17,7 +16,7 @@ The REGION/INITREGION arguments may now be region-type atoms in addition to eith A typed-region is marked as "inuse" and therefore unavailable when CREATEW assigns it to a window, and the extended CLOSEW marks it as again available when the window is closed. An example of how an application can take advantage of this facility is the TEDIT-PF-SEE package. This provides lightweight alternatives to the PF and SEE commands that print their output to scrollable read-only Tedit windows, specifying PF-TEDIT and SEE-TEDIT as their region types. The user can predefine a preference-ordered sequence of recyclable regions that bring up multiple output windows in a predictable tiled arrangement, without region-prompting for each invocation. The global variable TYPED-REGIONS is an alist that maintains the relationship between atomic type-names and the list of regions that belong to each type. The list is ordered according to preferences set by the user, and a type-atom is always resolved to the first unused region in its list. If the user is asked to sweep out a new region, that region is added at the end, as the least preferable. The function SET-TYPED-REGIONS is provided to add or replace TYPED-REGION entries. -(SET-TYPED-REGIONS TYPELISTS REPLACE) [Function] +(SET-TYPED-REGIONS TYPELISTS REPLACE) [Function] TYPELISTS is an alist of the form ((type1 . regions1)(type2 . regions2)...) where each regioni is a possibly empty list of regions. For convenience, if TYPELISTS is just a literal type-atom, it is interpreted as ((type)), and if it is a list (type . regions) begining with an atom, it is interpreted as ((type . regions). The new regions replace preexisting regions if REPLACE, otherwise they are added at the front. @@ -25,13 +24,13 @@ Typically, a call to SET-TYPED-REGIONS would be placed in a user's INIT file to Relative regions Two functions are provided to make it easy to create regions relative and oriented with respect to a specified reference point. These may be useful for constructing an application that includes a constellation of windows arranged in a particular relative way. -(RELCREATEREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY ONSCREEN) [Function] +(RELCREATEREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY ONSCREEN) [Function] RELCREATEREGION creates a region of dimensions WIDTH and HEIGHT. One of its corners is identified by CORNERX and CORNERY and that corner will be aligned with a reference screen-point determined by REFX and REFY. If ONSCREEN, the WIDTH or HEIGHT will be adjusted with respect to that alignment so that the resulting region is entirely within the screen. WIDTH and HEIGHT can be given as absolute (natural) numbers) or specified relative to the WIDTH and HEIGHT of another region or of the screen. The possibilities are interpreted as follows: natural number: the number of screen points list of the form (anchor fraction adjustment), where anchor is a region, window, or an atom SCREEN or TTY. The corres-ponding dimension of the anchor is mutiplied by fraction and adjustment is added to the result. For example, specifying ( .5 -1) results in a WIDTH that is one point smaller than half the width of window's region. Fraction and adjustment default to 1 and 0 respectively. region/window/SCREEN/TTY: equivalent to (region/window/SCREEN/TTY 1 0). -CORNERX can be LEFT, RIGHT, or NIL=LEFT, CORNERY can be BOTTOM, TOP, or NIL=BOTTOM. If LEFT/TOP are specified, for example, the region will be splayed down and to the right of the reference point. If RIGHT/BOTTOM, then up and to the left. +CORNERX can be LEFT, RIGHT, or NIL=LEFT, CORNERY can be BOTTOM, TOP, or NIL=BOTTOM. If LEFT/TOP are specified, for example, the region will be displayed down and to the right of the reference point. If RIGHT/BOTTOM, then up and to the left. The reference-point arguments REFX and REFY are interpreted as follows: NIL: LASTMOUSEX/LASTMOUSEY natural number: an absolute screen coordinate @@ -39,9 +38,9 @@ natural number: an absolute screen coordinate For convenience, if REFX is a position and REFY is NIL, then the XCOORD and YCOORD of REFX are taken as absolute values for REFX and REFY. Also for convenience, if WIDTH is a potentially a list of RELCREATEREGION arguments, then the elements of that list are spread out in a recursive call. -(RELGETREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY MINSIZE) [Function] +(RELGETREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY MINSIZE) [Function] Calls GETREGION with an initial ghost region as created by RELCREATEREGION. CORNERX and CORNERY determine the ghost region's fixed corner, and the cursor starts at the region's diagonally opposite corner. If MINSIZE is true, then WIDTH and HEIGHT are taken as the minimum sizes of the region, except for adjustments that may be needed to ensure that all corners of the ghost region are initially visible on the screen. -(RELCREATEPOSITION REFX REFY) [Function] +(RELCREATEPOSITION REFX REFY) [Function] Creates a position with X and Y coordinates specified by REFX and REFY references as above. Constellation regions @@ -53,62 +52,29 @@ REGIONMANAGER provides an overlay veneer for ATTACHWINDOW that implements this s This behavior is also triggered if the UNDERCONSTRUCTION property of the central window is true. Thus, a constellation can be set up by creating all of the satellites and the central window, marking the central window as under construction, and then doing the sequence of attachments. The property can be reset to NIL when the construction is complete, so the central window does not shrink if other other attachments (e.g. expanded menus) by later user actions. A somewhat weaker form of a constellation is a collection of windows that are not attached around a central window but stand in a parent-child relationship at least with respect to closing and moving. A parent windows spawns children that respond independently to ordinary window commands (move, shape, close). But the children close when the parent closes, and the children move when the parent moves so that they continue to appear in the same relative positions. These primitives allow the construction of a tree of windows that are dependent in this way. -(CLOSEWITH CHILDREN PARENT) [Function] +(CLOSEWITH CHILDREN PARENT [Function] Establishes a link between the PARENT window and any number of CHILDREN windows such that all CHILDREN will close when PARENT closes. The closing is accomplished by CLOSEWITH.DOIT: -(CLOSEWITH.DOIT PARENT) [Function] +(CLOSEWITH.DOIT PARENT) [Function] Closes the close-with children of PARENT. -(MOVEWITH CHILDREN PARENT) [Function] +(MOVEWITH CHILDREN PARENT) [Function] Establishes a link between the PARENT window and any number of CHILDREN windows such that all CHILDREN will move when PARENT closes. The closing is accomplished by MOVEWITH.DOIT: -(MOVEWITH.DOIT PARENT NEWPOS) [Function] +(MOVEWITH.DOIT PARENT NEWPOS) [Function] If NEWPOS is the new position of PARENT, moves each of the move-children so that they stand in the same relation to PARENT after it moves as before. -(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL)))))444444. $. .4..8.8J PAGEHEADING RUNNINGHEADTERMINALTERMINAL +(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))) 4$4$4$4$4$1 $$1 $4$1$18$18$J$ PAGEHEADING RUNNINGHEADTERMINALTERMINAL TIMESROMAN$TERMINALMODERN MODERN - HRULE.GETFN  HRULE.GETFNMODERN -  HRULE.GETFNMODERN -   HRULE.GETFNMODERN   HRULE.GETFNMODERN    -( - - - -} - +   HRULE.GETFNMODERN +   HRULE.GETFNMODERN +  HRULE.GETFNMODERN +  -/  -[  -Ch -T  -  -? -  + HRULE.GETFNMODERN   HRULE.GETFNMODERN   (}/ [ ChT  %    -; 3o) - M - -A - &Mm -JS-f= +; 3o) MA  &MmJS-f= 3E -" +"  - -j  -/3 -t2C  - " -O - = - , l -. -9 - - - - S -~  -- 4!U - -' - -2(*"+( *M.iz \ No newline at end of file +0: /3 +t2C  "O= + , l 9 S~ - 4!U'2  " (  M.U}z \ No newline at end of file diff --git a/lispusers/TEDIT-PF-SEE.TEDIT b/lispusers/TEDIT-PF-SEE.TEDIT index 56fd8934..d8de5635 100644 Binary files a/lispusers/TEDIT-PF-SEE.TEDIT and b/lispusers/TEDIT-PF-SEE.TEDIT differ diff --git a/lispusers/WHEELSCROLL.TEDIT b/lispusers/WHEELSCROLL.TEDIT new file mode 100644 index 00000000..891e09dc Binary files /dev/null and b/lispusers/WHEELSCROLL.TEDIT differ diff --git a/lispusers/WHEELSCROLL.TXT b/lispusers/WHEELSCROLL.TXT deleted file mode 100644 index 1262a1da..00000000 --- a/lispusers/WHEELSCROLL.TXT +++ /dev/null @@ -1,33 +0,0 @@ -lispusers/WHEELSCROLL - -Written by Ron Kaplan, February 2021. - -This small file adds the ability to scroll (scrollable) windows by rotating the wheel on a wheel mouse or by moving (2?) fingers on a track pad. - -The capability is enabled when WHEELSCROLL.LCOM is loaded. - -It is toggled on and off by - -(ENABLEWHEELSCROLL ON) (initially (ENABLEWHEELSCROLL T)) - -The vertical scrolling speed is controlled by the variable - -WHEELSCROLLDELTA (initially 20) - The number of points to scroll for each click of the wheel. Higher values give faster scrolling. A negative value reverses the scrolling direction. - -HWHEELSCROLLDELTA (initial NIL) - If non-NIL, then this is the delta used for horizontal scrolling. - -Implementation: - -Lisp receives a key transition on PAD1 or PAD2 for vertical scrolling when the wheel rotates and no other keys are down. (ENABLEWHEELSCROLL T) modifies the keyaction table so that it maps these transitions to characters 156 and 157. Those characters are defined as interrupts that invoke the vertical scrolling action. For horizontal scrolling sideways pushes of a wheel (if it has that) produce transitions on PAD4 and PAD5, which map to interrupt-characters 158 and 159. (156-159 are the highest right-panel characters of character-set 0 that correspond to left-panel control characters, so typically have no other conflicting meaning.) - -(ENABLEWHEELSCROLL NIL) causes PAD1, PAD2, PAD4, and PAD5 to be ignored. - -Current negative features: - -1. When the wheel is depressed for middle-button effect (and no other keys are down), an accidental rotation of the wheel during the transition (up and/or down) may cause unintended scrolling. - -We need to develop a strategy, either in Lisp, Maiko, or X, to discriminate intended middle-button pushes from intended scrolling. This is not an issue for track-pad scrolling. - -2. When the wheel is rotated over a window that partially occludes a Tedit window with a caret blinking in its unoccluded region, both the target window and the partially obscured Tedit window may scroll. diff --git a/lispusers/tmax/TMAX b/lispusers/tmax/TMAX index 752cefc6..e37fada6 100644 --- a/lispusers/tmax/TMAX +++ b/lispusers/tmax/TMAX @@ -1,17 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "17-Mar-2022 23:12:47" {DSK}kaplan>Local>medley3.5>my-medley>lispusers>TMAX.;3 25981 +(FILECREATED "18-Jul-2023 12:34:39" {DSK}frank>il>medley>gmedley>lispusers>tmax>TMAX.;2 25955 :CHANGES-TO (VARS TMAXCOMS) - :PREVIOUS-DATE "24-Oct-2021 23:45:20" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>TMAX.;2) + :PREVIOUS-DATE "17-Mar-2022 23:12:47" {DSK}frank>il>medley>gmedley>lispusers>tmax>TMAX.;1 +) -(* ; " -Copyright (c) 1987, 1997, 1999 by Stanford University. -") - (PRETTYCOMPRINT TMAXCOMS) (RPAQQ TMAXCOMS @@ -25,7 +21,8 @@ Copyright (c) 1987, 1997, 1999 by Stanford University. [DECLARE%: DONTCOPY (P (DOFILESLOAD (LIST* '(SOURCE) TMAX.FILE.LIST))) (DECLARE%: EVAL@COMPILE DONTCOPY (P (OR (GETPROP 'EXPORTS.ALL 'FILE) - (LOAD 'EXPORTS.ALL] + (FILESLOAD (FROM LOADUPS) + EXPORTS.ALL] (P (DOFILESLOAD TMAX.FILE.LIST)) @@ -103,7 +100,8 @@ Copyright (c) 1987, 1997, 1999 by Stanford University. (DECLARE%: EVAL@COMPILE DONTCOPY (OR (GETPROP 'EXPORTS.ALL 'FILE) - (LOAD 'EXPORTS.ALL)) + (FILESLOAD (FROM LOADUPS) + EXPORTS.ALL)) ) ) @@ -560,16 +558,15 @@ Copyright (c) 1987, 1997, 1999 by Stanford University. "Displays number-group menu"] (TSP.FUNCTION.HOOKS) -(PUTPROPS TMAX COPYRIGHT ("Stanford University" 1987 1997 1999)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (8231 15446 (TSP.DISPLAY.FMMENU 8241 . 8806) (TSP.SETUP.FILENAMES 8808 . 10059) ( -TSP.SETUP.FMMENU 10061 . 10521) (TSP.FMMENU 10523 . 11709) (TSP.FM.APPLY 11711 . 12030) (UPDATE.ALL -12032 . 12704) (DOWNDATE.ALL 12706 . 13076) (TSP.FUNCTION.HOOKS 13078 . 14508) (TSP.GETFN 14510 . -15070) (TSP.PUTFN 15072 . 15444)) (15492 17741 (AutoUpdate.TOGGLE 15502 . 15738) (UPDATE? 15740 . -15885) (NGROUP.Menu.TOGGLE 15887 . 16269) (NGROUPMENU.ENABLED? 16271 . 16507) ( -NGROUP.Text-Before.TOGGLE 16509 . 16759) (TEXTBEFORE.ENABLED? 16761 . 16924) (NGROUP.Text-After.TOGGLE - 16926 . 17174) (TEXTAFTER.ENABLED? 17176 . 17337) (Manual.Index.TOGGLE 17339 . 17578) ( -MANUALINDEX.ENABLED? 17580 . 17739)) (17775 23248 (GET.TSP.FONT 17785 . 18949) (GET.TSP.FONT.FAMILY -18951 . 19799) (GET.TSP.FONT.SIZE 19801 . 20289) (GET.TSP.FONT.FACE 20291 . 20990) (ABBREVIATE.FONT -20992 . 22492) (TMAX.SHADEOBJ 22494 . 23246)) (23288 24504 (TSP.LIST.OF.OBJECTS 23298 . 24502))))) + (FILEMAP (NIL (8270 15485 (TSP.DISPLAY.FMMENU 8280 . 8845) (TSP.SETUP.FILENAMES 8847 . 10098) ( +TSP.SETUP.FMMENU 10100 . 10560) (TSP.FMMENU 10562 . 11748) (TSP.FM.APPLY 11750 . 12069) (UPDATE.ALL +12071 . 12743) (DOWNDATE.ALL 12745 . 13115) (TSP.FUNCTION.HOOKS 13117 . 14547) (TSP.GETFN 14549 . +15109) (TSP.PUTFN 15111 . 15483)) (15531 17780 (AutoUpdate.TOGGLE 15541 . 15777) (UPDATE? 15779 . +15924) (NGROUP.Menu.TOGGLE 15926 . 16308) (NGROUPMENU.ENABLED? 16310 . 16546) ( +NGROUP.Text-Before.TOGGLE 16548 . 16798) (TEXTBEFORE.ENABLED? 16800 . 16963) (NGROUP.Text-After.TOGGLE + 16965 . 17213) (TEXTAFTER.ENABLED? 17215 . 17376) (Manual.Index.TOGGLE 17378 . 17617) ( +MANUALINDEX.ENABLED? 17619 . 17778)) (17814 23287 (GET.TSP.FONT 17824 . 18988) (GET.TSP.FONT.FAMILY +18990 . 19838) (GET.TSP.FONT.SIZE 19840 . 20328) (GET.TSP.FONT.FACE 20330 . 21029) (ABBREVIATE.FONT +21031 . 22531) (TMAX.SHADEOBJ 22533 . 23285)) (23327 24543 (TSP.LIST.OF.OBJECTS 23337 . 24541))))) STOP diff --git a/lispusers/tmax/TMAX.LCOM b/lispusers/tmax/TMAX.LCOM index 65364f60..37df82b8 100644 Binary files a/lispusers/tmax/TMAX.LCOM and b/lispusers/tmax/TMAX.LCOM differ diff --git a/internal/ABC b/obsolete/internal/ABC similarity index 100% rename from internal/ABC rename to obsolete/internal/ABC diff --git a/internal/ABC.LCOM b/obsolete/internal/ABC.LCOM similarity index 100% rename from internal/ABC.LCOM rename to obsolete/internal/ABC.LCOM diff --git a/scripts/copy-all.sh b/scripts/copy-all.sh index 348e879b..3c208166 100755 --- a/scripts/copy-all.sh +++ b/scripts/copy-all.sh @@ -15,7 +15,7 @@ fi ./scripts/cpv tmp/full.sysout loadups ./scripts/cpv tmp/lisp.sysout loadups ./scripts/cpv tmp/whereis.hash loadups -./scripts/cpv tmp/exports.all library +./scripts/cpv tmp/exports.all loadups if [ "${1}" = "-apps" ]; then ./scripts/cpv tmp/apps.sysout loadups fi diff --git a/sources/ADISPLAY b/sources/ADISPLAY index 7e3bd10d..28b9736e 100644 --- a/sources/ADISPLAY +++ b/sources/ADISPLAY @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "13-Jun-2021 14:03:35"  -{DSK}kaplan>Local>medley3.5>git-medley>sources>ADISPLAY.;10 248693 - changes to%: (FNS \DRAWLINE.DISPLAY) - (VARS ADISPLAYCOMS) +(FILECREATED " 1-Mar-2023 07:49:03" {DSK}larry>il>medley>sources>ADISPLAY.;2 245335 - previous date%: "15-Sep-94 17:07:04" -{DSK}kaplan>Local>medley3.5>git-medley>sources>ADISPLAY.;8) + :EDIT-BY "lmm" + + :CHANGES-TO (FNS \DRAWLINE.DISPLAY) + + :PREVIOUS-DATE "28-Feb-2023 06:37:11" {DSK}larry>il>medley>sources>ADISPLAY.;1) (* ; " @@ -16,11 +16,11 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (PRETTYCOMPRINT ADISPLAYCOMS) (RPAQQ ADISPLAYCOMS - [(COMS (* ; "COMPILE SUPPORT") + [(COMS (* ; "COMPILE SUPPORT") (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) WINDOW))) (P (MOVD? 'NILL 'BIGBITMAPP)) - (COMS (* ; "Interlisp-D dependent stuff.") + (COMS (* ; "Interlisp-D dependent stuff.") (EXPORT (RECORDS REGION BITMAP BITMAPWORD POSITION CURSOR MOUSEEVENT SCREENREGION SCREENPOSITION)) (SYSRECORDS PILOTBBT \DISPLAYDATA) @@ -30,21 +30,19 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (P (DEFPRINT 'BITMAP 'PRINT-BITMAPS-NICELY)) (FNS \GETINTEGERPART \CONVERTTOFRACTION) (CONSTANTS (INTEGERBITS 12))) - [COMS (* ; - "cursor functions not on LLDISPLAY") + [COMS (* ; "cursor functions not on LLDISPLAY") (FNS CURSORP CURSORBITMAP CreateCursorBitMap) (EXPORT (MACROS CURSORBITMAP) (CONSTANTS (HARDCURSORHEIGHT 16) (HARDCURSORWIDTH 16)) (DECLARE%: EVAL@COMPILE (ADDVARS (GLOBALVARS CursorBitMap] (COMS * CARETCOMS) - (COMS (* ; "Region functions") + (COMS (* ; "Region functions") (FNS CREATEREGION REGIONP INTERSECTREGIONS UNIONREGIONS REGIONSINTERSECTP SUBREGIONP EXTENDREGION EXTENDREGIONBOTTOM EXTENDREGIONLEFT EXTENDREGIONRIGHT EXTENDREGIONTOP INSIDEP STRINGREGION)) - (COMS (* ; "line and spline drawing.") - (COMS (* ; - "Brushes and brush initialization") + (COMS (* ; "line and spline drawing.") + (COMS (* ; "Brushes and brush initialization") (GLOBALRESOURCES \BRUSHBBT) (FNS \BRUSHBITMAP \GETBRUSH \GETBRUSHBBT \InitCurveBrushes \BrushFromWidth) (FNS \MAKEBRUSH.DIAGONAL \MAKEBRUSH.HORIZONTAL \MAKEBRUSH.VERTICAL @@ -56,29 +54,29 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (RECORDS BRUSHITEM) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\InitCurveBrushes))) (DECLARE%: DONTCOPY (GLOBALVARS \BrushAList KNOWN.BRUSHES))) - (* ; "Lines") + (* ; "Lines") (FNS \DRAWLINE.DISPLAY RELMOVETO MOVETOUPPERLEFT) (FNS \CLIPANDDRAWLINE \CLIPANDDRAWLINE1 \CLIPCODE \LEASTPTAT \GREATESTPTAT \DRAWLINE1 \DRAWLINE.UFN) (DECLARE%: DONTCOPY (MACROS .DRAWLINEX. .DRAWLINEY.)) - (* ; "Curves") + (* ; "Curves") (FNS \DRAWCIRCLE.DISPLAY \DRAWARC.DISPLAY \DRAWARC.GENERIC \COMPUTE.ARC.POINTS \DRAWELLIPSE.DISPLAY \DRAWCURVE.DISPLAY \DRAWPOINT.DISPLAY \DRAWPOLYGON.DISPLAY \LINEWITHBRUSH) (FNS LOADPOLY PARAMETRICSPLINE \CURVE \CURVE2 \CURVEEND \CURVESLOPE \CURVESTART \FDIFS/FROM/DERIVS) - (DECLARE%: DONTCOPY (* ; "Used by drawcurve") + (DECLARE%: DONTCOPY (* ; "Used by drawcurve") (EXPORT (RECORDS POLYNOMIAL SPLINE))) (DECLARE%: DONTCOPY (EXPORT (MACROS HALF \FILLCIRCLEBLT)) (MACROS \CURVEPT .SETUP.FOR.\BBTCURVEPT. \CIRCLEPTS \CURVESMOOTH)) (FNS \FILLCIRCLE.DISPLAY \LINEBLT)) - [COMS (* ; "making and copying bitmaps") + [COMS (* ; "making and copying bitmaps") (FNS SCREENBITMAP BITMAPP BITMAPHEIGHT BITSPERPIXEL) (EXPORT (FILEPKGCOMS BITMAPS CURSORS)) (DECLARE%: EVAL@COMPILE (EXPORT (ADDVARS (GLOBALVARS SCREENHEIGHT SCREENWIDTH ScreenBitMap] - [COMS (* ; - "Display stream functions that are not needed in the primitive system") + [COMS (* ; + "Display stream functions that are not needed in the primitive system") (FNS DSPFILL INVERTW) (FNS \DSPCOLOR.DISPLAY \DSPBACKCOLOR.DISPLAY DSPEOLFN) (EXPORT (CONSTANTS (BLACKSHADE 65535) @@ -87,7 +85,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (ADDVARS (GLOBALVARS GRAYSHADE))) (MACROS DSPRUBOUTCHAR) (FNS DSPCLEOL DSPRUBOUTCHAR \DSPMOVELR) - (COMS (* ; "for cursor") + (COMS (* ; "for cursor") (BITMAPS \DefaultCursor) (FNS \CURSOR.DEFPRINT) [DECLARE%: DONTEVAL@LOAD DOCOPY (INITVARS (DEFAULTCURSOR (CURSORCREATE @@ -97,8 +95,8 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (SETQ \CURRENTCURSOR DEFAULTCURSOR))) (DEFPRINT 'CURSOR '\CURSOR.DEFPRINT] (DECLARE%: DONTCOPY (GLOBALVARS DEFAULTCURSOR] - [COMS (* ; - "stuff to interpret colors as textures which is needed even in system that don't have color.") + [COMS (* ; + "stuff to interpret colors as textures which is needed even in system that don't have color.") (FNS TEXTUREOFCOLOR \PRIMARYTEXTURE \LEVELTEXTURE INSURE.B&W.TEXTURE INSURE.RGB.COLOR \LOOKUPCOLORNAME RGBP HLSP HLSTORGB \HLSVALUEFN) (VARS COLORNAMES) @@ -107,7 +105,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation WHITESHADE16 REDTEXTURE GREENTEXTURE BLUETEXTURE)) (UGLYVARS BLACKSHADE16 DARKGRAY16 MEDIUMGRAY16 LIGHTGRAY16 WHITESHADE16 REDTEXTURE GREENTEXTURE BLUETEXTURE) - (DECLARE%: DONTCOPY (* ; "Used by drawcurve") + (DECLARE%: DONTCOPY (* ; "Used by drawcurve") (EXPORT (RECORDS HLS RGB] (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) @@ -133,62 +131,62 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (RECORD REGION (LEFT BOTTOM WIDTH HEIGHT) - LEFT _ -16383 BOTTOM _ -16383 WIDTH _ 32767 HEIGHT _ 32767 - [ACCESSFNS ((TOP (IPLUS (fetch (REGION BOTTOM) of DATUM) - (fetch (REGION HEIGHT) of DATUM) - -1)) - (PTOP (IPLUS (fetch (REGION BOTTOM) of DATUM) - (fetch (REGION HEIGHT) of DATUM))) - (RIGHT (IPLUS (fetch (REGION LEFT) of DATUM) - (fetch (REGION WIDTH) of DATUM) - -1)) - (PRIGHT (IPLUS (fetch (REGION LEFT) of DATUM) - (fetch (REGION WIDTH) of DATUM] - [TYPE? (AND (EQLENGTH DATUM 4) - (EVERY DATUM (FUNCTION NUMBERP] - (SYSTEM)) + LEFT _ -16383 BOTTOM _ -16383 WIDTH _ 32767 HEIGHT _ 32767 + [ACCESSFNS ((TOP (IPLUS (fetch (REGION BOTTOM) of DATUM) + (fetch (REGION HEIGHT) of DATUM) + -1)) + (PTOP (IPLUS (fetch (REGION BOTTOM) of DATUM) + (fetch (REGION HEIGHT) of DATUM))) + (RIGHT (IPLUS (fetch (REGION LEFT) of DATUM) + (fetch (REGION WIDTH) of DATUM) + -1)) + (PRIGHT (IPLUS (fetch (REGION LEFT) of DATUM) + (fetch (REGION WIDTH) of DATUM] + [TYPE? (AND (EQLENGTH DATUM 4) + (EVERY DATUM (FUNCTION NUMBERP] + (SYSTEM)) (DATATYPE BITMAP ((BITMAPBASE POINTER) - (BITMAPRASTERWIDTH WORD) - (BITMAPHEIGHT WORD) - (BITMAPWIDTH WORD) - (BITMAPBITSPERPIXEL WORD)) - BITMAPBITSPERPIXEL _ 1 (BLOCKRECORD BITMAP ((BitMapHiLoc WORD) - (BitMapLoLoc WORD)) - (* ; "overlay initial pointer") - ) - (SYSTEM)) + (BITMAPRASTERWIDTH WORD) + (BITMAPHEIGHT WORD) + (BITMAPWIDTH WORD) + (BITMAPBITSPERPIXEL WORD)) + BITMAPBITSPERPIXEL _ 1 (BLOCKRECORD BITMAP ((BitMapHiLoc WORD) + (BitMapLoLoc WORD)) + (* ; "overlay initial pointer") + ) + (SYSTEM)) (BLOCKRECORD BITMAPWORD ((BITS WORD)) - (SYSTEM)) + (SYSTEM)) (RECORD POSITION (XCOORD . YCOORD) - [TYPE? (AND (LISTP DATUM) - (NUMBERP (CAR DATUM)) - (NUMBERP (CDR DATUM] - (SYSTEM)) + [TYPE? (AND (LISTP DATUM) + (NUMBERP (CAR DATUM)) + (NUMBERP (CDR DATUM] + (SYSTEM)) (DATATYPE CURSOR (CUIMAGE CUMASK CUHOTSPOTX CUHOTSPOTY CUDATA) - [ACCESSFNS ((CUBITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL) - of (fetch (CURSOR CUIMAGE) of DATUM] - (SYSTEM)) + [ACCESSFNS ((CUBITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL) + of (fetch (CURSOR CUIMAGE) of DATUM] + (SYSTEM)) (RECORD MOUSEEVENT (MOUSEX MOUSEY MOUSEBUTTONS KEYBOARD MOUSETIME) - (SYSTEM)) + (SYSTEM)) (RECORD SCREENREGION (SCREEN . REGION) - (SUBRECORD REGION) - [TYPE? (AND (LISTP DATUM) - (type? SCREEN (CAR DATUM)) - (type? REGION (CDR DATUM] - (SYSTEM)) + (SUBRECORD REGION) + [TYPE? (AND (LISTP DATUM) + (type? SCREEN (CAR DATUM)) + (type? REGION (CDR DATUM] + (SYSTEM)) (RECORD SCREENPOSITION (SCREEN . POSITION) - (SUBRECORD POSITION) - [TYPE? (AND (LISTP DATUM) - (type? SCREEN (CAR DATUM)) - (type? POSITION (CDR DATUM] - (SYSTEM)) + (SUBRECORD POSITION) + [TYPE? (AND (LISTP DATUM) + (type? SCREEN (CAR DATUM)) + (type? POSITION (CDR DATUM] + (SYSTEM)) ) (/DECLAREDATATYPE 'BITMAP '(POINTER WORD WORD WORD WORD) @@ -212,17 +210,17 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (ADDTOVAR SYSTEMRECLST (DATATYPE PILOTBBT ((PBTDESTLO WORD) - (PBTDESTHI WORD) - (PBTDESTBIT WORD) - (PBTDESTBPL SIGNEDWORD) - (PBTSOURCELO WORD) - (PBTSOURCEHI WORD) - (PBTSOURCEBIT WORD) - (PBTSOURCEBPL SIGNEDWORD) - (PBTWIDTH WORD) - (PBTHEIGHT WORD) - (PBTFLAGS WORD) - (NIL 5 WORD))) + (PBTDESTHI WORD) + (PBTDESTBIT WORD) + (PBTDESTBPL SIGNEDWORD) + (PBTSOURCELO WORD) + (PBTSOURCEHI WORD) + (PBTSOURCEBIT WORD) + (PBTSOURCEBPL SIGNEDWORD) + (PBTWIDTH WORD) + (PBTHEIGHT WORD) + (PBTFLAGS WORD) + (NIL 5 WORD))) (DATATYPE \DISPLAYDATA (DDXPOSITION DDYPOSITION DDXOFFSET DDYOFFSET DDDestination DDClippingRegion DDFONT @@ -253,7 +251,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (\BBTCURVEPT [LAMBDA (X Y BBT LEFT BRUSHWIDTH LEFTMINUSBRUSH RIGHTPLUS1 NBITSRIGHTPLUS1 TOPMINUSBRUSH DestinationBitMap BRUSHHEIGHT BOTTOMMINUSBRUSH TOP BRUSHBASE DESTINATIONBASE RASTERWIDTH - BRUSHRASTERWIDTH COLORBRUSHBASE NBITS DISPLAYDATA) + BRUSHRASTERWIDTH COLORBRUSHBASE NBITS DISPLAYDATA) (* kbr%: "27-Aug-86 23:17") (* ;; "Called by \CURVEPT macro. Draws a brush point by bitblting BRUSHBM to point X,Y in DestinationBitMap. BBT is a BitBlt table where everything is already set except the source and destination addresses, width and height. In other words, only the easy stuff") @@ -261,99 +259,89 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation [PROG (CLIPPEDTOP STY) [COND [(ILEQ Y TOPMINUSBRUSH) (* ; - "the top part of the brush is visible") + "the top part of the brush is visible") (SETQ CLIPPEDTOP (IPLUS Y BRUSHHEIGHT)) (replace PBTSOURCE of BBT with BRUSHBASE) - (freplace PBTHEIGHT of BBT with (IMIN BRUSHHEIGHT (IDIFFERENCE Y - BOTTOMMINUSBRUSH] + (freplace PBTHEIGHT of BBT with (IMIN BRUSHHEIGHT (IDIFFERENCE Y BOTTOMMINUSBRUSH] (T (* ; "only the bottom is visible") (SETQ CLIPPEDTOP TOP) - [replace PBTSOURCE of BBT with (\ADDBASE BRUSHBASE - (ITIMES BRUSHRASTERWIDTH - (SETQ STY (IDIFFERENCE - Y TOPMINUSBRUSH] - (freplace PBTHEIGHT of BBT with (IDIFFERENCE (IMIN BRUSHHEIGHT - (IDIFFERENCE Y + [replace PBTSOURCE of BBT with (\ADDBASE BRUSHBASE (ITIMES BRUSHRASTERWIDTH + (SETQ STY (IDIFFERENCE + Y TOPMINUSBRUSH] + (freplace PBTHEIGHT of BBT with (IDIFFERENCE (IMIN BRUSHHEIGHT (IDIFFERENCE Y BOTTOMMINUSBRUSH )) - STY] + STY] (freplace PBTDEST of BBT with (\ADDBASE DESTINATIONBASE (ITIMES RASTERWIDTH - (\SFInvert - - DestinationBitMap - CLIPPEDTOP] + (\SFInvert DestinationBitMap + CLIPPEDTOP] [COND (COLORBRUSHBASE [COND [(ILESSP X LEFT) (* ; - "only the right part of the brush is visible") + "only the right part of the brush is visible") (* ; - "FOR NOW BRUTE FORCE WITH NBITS CHECK") + "FOR NOW BRUTE FORCE WITH NBITS CHECK") [freplace PBTDESTBIT of BBT with (COND - ((EQ NBITS 4) - (LLSH LEFT 2)) - (T (LLSH LEFT 3] + ((EQ NBITS 4) + (LLSH LEFT 2)) + (T (LLSH LEFT 3] (freplace PBTSOURCEBIT of BBT - with (IDIFFERENCE BRUSHWIDTH - (freplace PBTWIDTH of BBT - with (COND - ((EQ NBITS 4) - (LLSH (IDIFFERENCE X LEFTMINUSBRUSH) - 2)) - (T (LLSH (IDIFFERENCE X LEFTMINUSBRUSH) - 3] + with (IDIFFERENCE BRUSHWIDTH (freplace PBTWIDTH of BBT + with (COND + ((EQ NBITS 4) + (LLSH (IDIFFERENCE X + LEFTMINUSBRUSH) + 2)) + (T (LLSH (IDIFFERENCE X + LEFTMINUSBRUSH) + 3] (T (* ; "left edge is visible") - [freplace PBTDESTBIT of BBT with (SETQ X - (COND - ((EQ NBITS 4) - (LLSH X 2)) - (T (LLSH X 3] + [freplace PBTDESTBIT of BBT with (SETQ X (COND + ((EQ NBITS 4) + (LLSH X 2)) + (T (LLSH X 3] (freplace PBTSOURCEBIT of BBT with 0) (* ; - "set width to the amount that is visible") - (freplace PBTWIDTH of BBT with (IMIN BRUSHWIDTH - (IDIFFERENCE - NBITSRIGHTPLUS1 - X] + "set width to the amount that is visible") + (freplace PBTWIDTH of BBT with (IMIN BRUSHWIDTH (IDIFFERENCE + NBITSRIGHTPLUS1 X + ] (* ; - "if color brush is used, the ground must be cleared before the brush is put in.") + "if color brush is used, the ground must be cleared before the brush is put in.") (\SETPBTFUNCTION BBT (ffetch DDSOURCETYPE of DISPLAYDATA) 'ERASE) (\PILOTBITBLT BBT 0) (* ; - "reset the source to point to the color bitmap.") + "reset the source to point to the color bitmap.") [COND ((ILEQ Y TOPMINUSBRUSH) (* ; - "the top part of the brush is visible") + "the top part of the brush is visible") (freplace PBTSOURCE of BBT with COLORBRUSHBASE)) (T (* ; "only the bottom is visible") - (freplace PBTSOURCE of BBT with (\ADDBASE COLORBRUSHBASE - (ITIMES BRUSHRASTERWIDTH - (IDIFFERENCE Y - TOPMINUSBRUSH] + (freplace PBTSOURCE of BBT with (\ADDBASE COLORBRUSHBASE (ITIMES BRUSHRASTERWIDTH + (IDIFFERENCE + Y TOPMINUSBRUSH] (\SETPBTFUNCTION BBT (ffetch DDSOURCETYPE of DISPLAYDATA) 'PAINT)) (T (COND [(ILESSP X LEFT) (* ; - "only the right part of the brush is visible") + "only the right part of the brush is visible") (freplace PBTDESTBIT of BBT with LEFT) - (freplace PBTSOURCEBIT of BBT with (IDIFFERENCE BRUSHWIDTH - (freplace PBTWIDTH - of BBT - with (IDIFFERENCE X + (freplace PBTSOURCEBIT of BBT with (IDIFFERENCE BRUSHWIDTH (freplace PBTWIDTH + of BBT + with (IDIFFERENCE X LEFTMINUSBRUSH - ] + ] (T (* ; "left edge is visible") (freplace PBTDESTBIT of BBT with X) - (freplace PBTSOURCEBIT of BBT with 0) - (* ; - "set width to the amount that is visible") - (freplace PBTWIDTH of BBT with (IMIN BRUSHWIDTH (IDIFFERENCE RIGHTPLUS1 X - ] + (freplace PBTSOURCEBIT of BBT with 0) (* ; + "set width to the amount that is visible") + (freplace PBTWIDTH of BBT with (IMIN BRUSHWIDTH (IDIFFERENCE RIGHTPLUS1 X] (\PILOTBITBLT BBT 0]) ) (DEFINEQ (CREATETEXTUREFROMBITMAP - [LAMBDA (BITMAP) (* rrb "17-May-84 11:22") + [LAMBDA (BITMAP) (* rrb "17-May-84 11:22") (* ;; "creates a texture object from the lower left corner of a bitmap") @@ -367,31 +355,29 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (EQ W 4)) (OR (EQ H 2) (EQ H 4))) (* ; - "small texture will match bitmap exactly so use integer representation.") + "small texture will match bitmap exactly so use integer representation.") (SETQ TEXTURE 0) [for X from 0 to 3 do (for Y from 0 to 3 - do (COND - ([NOT (EQ 0 (BITMAPBIT BITMAP (IREMAINDER X W) - (IREMAINDER Y H] - (SETQ TEXTURE (LOGOR TEXTURE - (\BITMASK (IPLUS (ITIMES (IDIFFERENCE + do (COND + ([NOT (EQ 0 (BITMAPBIT BITMAP (IREMAINDER X W) + (IREMAINDER Y H] + (SETQ TEXTURE (LOGOR TEXTURE (\BITMASK (IPLUS (ITIMES (IDIFFERENCE 3 Y) 4) X] (RETURN TEXTURE)) ((AND (EQ W 16) (ILESSP H 17)) (* ; - "if it is already 16 by n n<=16, use it.") + "if it is already 16 by n n<=16, use it.") (RETURN BITMAP)) (T (* ; "make a 16 bit wide one.") (SETQ TEXTURE (BITMAPCREATE 16 (IMIN H 16))) - (for X from 0 by W to 16 - do (BITBLT BITMAP 0 0 TEXTURE X 0 W H 'INPUT 'REPLACE)) + (for X from 0 by W to 16 do (BITBLT BITMAP 0 0 TEXTURE X 0 W H 'INPUT 'REPLACE)) (RETURN TEXTURE]) (PRINTBITMAP - [LAMBDA (BITMAP FILE) (* ; "Edited 1-Dec-86 16:24 by Pavel") + [LAMBDA (BITMAP FILE) (* ; "Edited 1-Dec-86 16:24 by Pavel") (* ;;; "Writes a bitmap on a file such that READBITMAP will read it back in.") @@ -400,26 +386,26 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (COND ((type? BITMAP BITMAP)) ([AND (LITATOM BITMAP) - (type? BITMAP (SETQ BM (EVALV BITMAP] (* ; - "Coerce litatoms for compatibility with original specification") + (type? BITMAP (SETQ BM (EVALV BITMAP] (* ; + "Coerce litatoms for compatibility with original specification") ) (T (printout T "******** " BITMAP " is not a BITMAP." T) (RETURN NIL))) (printout FILE "(" .P2 (BITMAPWIDTH BM) - %, .P2 (BITMAPHEIGHT BM)) (* ; - "if the number of bits per pixel is not 1, write it out.") + %, .P2 (BITMAPHEIGHT BM)) (* ; + "if the number of bits per pixel is not 1, write it out.") (COND ((NEQ (BITSPERPIXEL BM) 1) (SPACES 1 FILE) (PRIN2 (BITSPERPIXEL BM) FILE))) (* ; - "Enclose in list so that compile-copying works.") - (\WRITEBITMAP BM FILE) (* ; "Now write out contents.") + "Enclose in list so that compile-copying works.") + (\WRITEBITMAP BM FILE) (* ; "Now write out contents.") (PRIN1 ")" FILE]) (PRINT-BITMAPS-NICELY - [LAMBDA (BITMAP STREAM) (* ; "Edited 20-Mar-87 17:06 by jop") + [LAMBDA (BITMAP STREAM) (* ; "Edited 20-Mar-87 17:06 by jop") (* ;;; "The syntax for bitmaps is") @@ -430,60 +416,57 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (* ;;; "This function %"observes%" *print-length*: it truncates after printing *print-length* characters in the bitmap's representation.") (if (OR (NULL STREAM) - (NULL *PRINT-ARRAY*)) + (NULL *PRINT-ARRAY*)) then + (* ;; "Let it be printed in the normal way, with an address.") - (* ;; "Let it be printed in the normal way, with an address.") - - NIL + NIL else + (* ;; "Print this bitmap in the preferred way.") - (* ;; "Print this bitmap in the preferred way.") - - (LET* ((WIDTH (BITMAPWIDTH BITMAP)) - (HEIGHT (BITMAPHEIGHT BITMAP)) - (BITS-PER-PIXEL (BITSPERPIXEL BITMAP)) - (BASE (fetch BITMAPBASE of BITMAP)) - (QUAD-CHARS-PER-ROW (FOLDHI (CL:* WIDTH BITS-PER-PIXEL) - 16)) - (CHARS-SO-FAR *PRINT-LENGTH*)) - (PRINTOUT STREAM "#*(" .P2 WIDTH " " .P2 HEIGHT) - (if (NEQ BITS-PER-PIXEL 1) - then (PRINTOUT STREAM " " .P2 BITS-PER-PIXEL)) - (PRINTOUT STREAM ")") - (PROG NIL - [CL:MACROLET [(ELIDE? NIL `(IF (AND CHARS-SO-FAR (EQ 0 (CL:DECF - CHARS-SO-FAR - ))) - THEN (PRINTOUT STREAM "...") - (GO OUT] - (CL:DOTIMES (ROW HEIGHT) - (CL:DOTIMES (QUAD QUAD-CHARS-PER-ROW) - (CL:WRITE-CHAR (CL:INT-CHAR (+ (LRSH (\GETBASEBYTE BASE 0) - 4) - (CL:CHAR-INT #\@))) - STREAM) - (ELIDE?) - (CL:WRITE-CHAR (CL:INT-CHAR (+ (LOGAND (\GETBASEBYTE BASE 0) - 15) - (CL:CHAR-INT #\@))) - STREAM) - (ELIDE?) - (CL:WRITE-CHAR (CL:INT-CHAR (+ (LRSH (\GETBASEBYTE BASE 1) - 4) - (CL:CHAR-INT #\@))) - STREAM) - (ELIDE?) - (CL:WRITE-CHAR (CL:INT-CHAR (+ (LOGAND (\GETBASEBYTE BASE 1) - 15) - (CL:CHAR-INT #\@))) - STREAM) - (ELIDE?) - (SETQ BASE (\ADDBASE BASE 1))))] - OUT (RETURN T]) + (LET* ((WIDTH (BITMAPWIDTH BITMAP)) + (HEIGHT (BITMAPHEIGHT BITMAP)) + (BITS-PER-PIXEL (BITSPERPIXEL BITMAP)) + (BASE (fetch BITMAPBASE of BITMAP)) + (QUAD-CHARS-PER-ROW (FOLDHI (CL:* WIDTH BITS-PER-PIXEL) + 16)) + (CHARS-SO-FAR *PRINT-LENGTH*)) + (PRINTOUT STREAM "#*(" .P2 WIDTH " " .P2 HEIGHT) + (if (NEQ BITS-PER-PIXEL 1) + then (PRINTOUT STREAM " " .P2 BITS-PER-PIXEL)) + (PRINTOUT STREAM ")") + (PROG NIL + [CL:MACROLET [(ELIDE? NIL `(IF (AND CHARS-SO-FAR (EQ 0 (CL:DECF CHARS-SO-FAR)) + ) + THEN (PRINTOUT STREAM "...") + (GO OUT] + (CL:DOTIMES (ROW HEIGHT) + (CL:DOTIMES (QUAD QUAD-CHARS-PER-ROW) + (CL:WRITE-CHAR (CL:INT-CHAR (+ (LRSH (\GETBASEBYTE BASE 0) + 4) + (CL:CHAR-INT #\@))) + STREAM) + (ELIDE?) + (CL:WRITE-CHAR (CL:INT-CHAR (+ (LOGAND (\GETBASEBYTE BASE 0) + 15) + (CL:CHAR-INT #\@))) + STREAM) + (ELIDE?) + (CL:WRITE-CHAR (CL:INT-CHAR (+ (LRSH (\GETBASEBYTE BASE 1) + 4) + (CL:CHAR-INT #\@))) + STREAM) + (ELIDE?) + (CL:WRITE-CHAR (CL:INT-CHAR (+ (LOGAND (\GETBASEBYTE BASE 1) + 15) + (CL:CHAR-INT #\@))) + STREAM) + (ELIDE?) + (SETQ BASE (\ADDBASE BASE 1))))] + OUT (RETURN T]) (PRINTCURSOR - [LAMBDA (VAR) (* ; "Edited 2-Dec-86 14:15 by Pavel") + [LAMBDA (VAR) (* ; "Edited 2-Dec-86 14:15 by Pavel") (* ;; "Writes an expression that will define the cursor value of VAR") @@ -495,13 +478,16 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (\CURSORBITSPERPIXEL CUR 1) (SETQ IMAGE (fetch (CURSOR CUIMAGE) of CUR)) (SETQ MASK (fetch (CURSOR CUMASK) of CUR)) - (PRINT `(RPAQ ,VAR (CURSORCREATE ',IMAGE ',(AND (NOT (EQ IMAGE MASK)) - MASK) - ,(fetch (CURSOR CUHOTSPOTX) of CUR) - ,(fetch (CURSOR CUHOTSPOTY) of CUR]) + (PRINT `(RPAQ (\, VAR) + (CURSORCREATE ',IMAGE ',(AND (NOT (EQ IMAGE MASK)) + MASK) + ,(fetch (CURSOR CUHOTSPOTX) + of CUR) + ,(fetch (CURSOR CUHOTSPOTY) + of CUR)))]) (\WRITEBITMAP - [LAMBDA (BITMAP FILE) (* ; "Edited 1-Dec-86 16:24 by Pavel") + [LAMBDA (BITMAP FILE) (* ; "Edited 1-Dec-86 16:24 by Pavel") (* ;;; "writes the contents of a bitmap onto the currently open output file.") @@ -513,18 +499,18 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (\BOUT OFD (CHARCODE %")) (SETQ LIM (\ADDBASE BASE W)) (until (EQ BASE LIM) do (\BOUT OFD (IPLUS (SUB1 (CHARCODE A)) - (LRSH (\GETBASEBYTE BASE 0) - 4))) - (\BOUT OFD (IPLUS (SUB1 (CHARCODE A)) - (LOGAND (\GETBASEBYTE BASE 0) - 15))) - (\BOUT OFD (IPLUS (SUB1 (CHARCODE A)) - (LRSH (\GETBASEBYTE BASE 1) - 4))) - (\BOUT OFD (IPLUS (SUB1 (CHARCODE A)) - (LOGAND (\GETBASEBYTE BASE 1) - 15))) - (SETQ BASE (\ADDBASE BASE 1))) + (LRSH (\GETBASEBYTE BASE 0) + 4))) + (\BOUT OFD (IPLUS (SUB1 (CHARCODE A)) + (LOGAND (\GETBASEBYTE BASE 0) + 15))) + (\BOUT OFD (IPLUS (SUB1 (CHARCODE A)) + (LRSH (\GETBASEBYTE BASE 1) + 4))) + (\BOUT OFD (IPLUS (SUB1 (CHARCODE A)) + (LOGAND (\GETBASEBYTE BASE 1) + 15))) + (SETQ BASE (\ADDBASE BASE 1))) (\BOUT OFD (CHARCODE %"]) ) @@ -532,7 +518,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DEFINEQ (\GETINTEGERPART - [LAMBDA (FRACT) (* JonL " 7-May-84 02:43") + [LAMBDA (FRACT) (* JonL " 7-May-84 02:43") (* ;; "gets the integer part of a fixed point number. The integer part has INTEGERBITS worth of significant bits the leftmost of which is sign.") @@ -551,13 +537,13 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (CONSTANT (IDIFFERENCE BITSPERWORD INTEGERBITS] (CONSTANT (EXPT 2 (SUB1 INTEGERBITS] (* ; - "the sign bit is on, make it negative.") + "the sign bit is on, make it negative.") (IDIFFERENCE (IDIFFERENCE HIPART (CONSTANT (EXPT 2 INTEGERBITS))) ROUNDER)) (T (IPLUS HIPART ROUNDER]) (\CONVERTTOFRACTION - [LAMBDA (FLOAT) (* rmk%: " 3-JUL-82 23:29") + [LAMBDA (FLOAT) (* rmk%: " 3-JUL-82 23:29") (* ;; "converts a floating point number into a fixed point number with INTEGERBITS worth of integer part. Always returns a large integer so that the box can be clobbered.") @@ -588,7 +574,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DEFINEQ (CURSORP - [LAMBDA (X) (* kbr%: " 5-Jul-85 17:54") + [LAMBDA (X) (* kbr%: " 5-Jul-85 17:54") (* ; "is X a cursor?") (type? CURSOR X]) @@ -596,14 +582,14 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation [LAMBDA NIL CursorBitMap]) (CreateCursorBitMap - [LAMBDA (ARRAY) (* rmk%: " 1-APR-82 22:20") + [LAMBDA (ARRAY) (* rmk%: " 1-APR-82 22:20") (* ; - "makes a bitmap out of an array of values.") + "makes a bitmap out of an array of values.") (PROG ((BM (BITMAPCREATE 16 16)) BASE) (SETQ BASE (ffetch BITMAPBASE of BM)) (for I from 0 to 15 do (\PUTBASE BASE I (LOGAND (ELT ARRAY (ADD1 I)) - WORDMASK))) + WORDMASK))) (RETURN BM]) ) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE @@ -632,16 +618,15 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation ((BITMAPS \DefaultCaret) (INITVARS (\CARET.UP NIL - (* ;; "global. NIL if no caret showing, otherwise a CARET1 record with CURSOR, stream, x, y, and RATE (= off rate)") + (* ;; "global. NIL if no caret showing, otherwise a CARET1 record with CURSOR, stream, x, y, and RATE (= off rate)") ) - (\CARET.DEFAULT NIL (* ; - "global = default caret to put up. An instance of CARET1 datatype") + (\CARET.DEFAULT NIL (* ; + "global = default caret to put up. An instance of CARET1 datatype") ) (\CARET.TIMER (SETUPTIMER 0) - (* ; "time for next caret action")) + (* ; "time for next caret action")) (DEFAULTCARET (CURSORCREATE \DefaultCaret NIL 3 4)) - (DEFAULTCARETRATE 333 (* ; "default rate for flashing caret") - ) + (DEFAULTCARETRATE 333 (* ; "default rate for flashing caret")) (\CARET.ON.RATE DEFAULTCARETRATE) (\CARET.OFF.RATE DEFAULTCARETRATE) (\CARET.FORCED.OFF.RATE 0)) @@ -651,7 +636,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (FNS CARET \CARET.CREATE \CARET.DOWN \CARET.FLASH? \CARET.SHOW CARETRATE \CARET.FLASH.AGAIN \CARET.FLASH.MULTIPLE \CARET.FLASH) (FNS \MEDW.CARET.SHOW) - (* ; "some declarations are on LLDISPLAY -- macro for \CHECKCARET and globalvar declaration for \CARET.UP") + (* ; "some declarations are on LLDISPLAY -- macro for \CHECKCARET and globalvar declaration for \CARET.UP") (GLOBALVARS \CARET.DEFAULT \CARET.ON.RATE \CARET.OFF.RATE DEFAULTCARET \CARET.TIMER \CARET.UP \CARET.FORCED.OFF.RATE) (DECLARE%: DONTEVAL@LOAD DOCOPY (ADDVARS (TTYBACKGROUNDFNS \CARET.FLASH?))) @@ -661,20 +646,19 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (RPAQQ \DefaultCaret #*(7 6)A@@@CH@@CH@@FL@@FL@@LF@@) (RPAQ? \CARET.UP NIL - (* ;; "global. NIL if no caret showing, otherwise a CARET1 record with CURSOR, stream, x, y, and RATE (= off rate)") + (* ;; "global. NIL if no caret showing, otherwise a CARET1 record with CURSOR, stream, x, y, and RATE (= off rate)") ) -(RPAQ? \CARET.DEFAULT NIL (* ; - "global = default caret to put up. An instance of CARET1 datatype") +(RPAQ? \CARET.DEFAULT NIL (* ; + "global = default caret to put up. An instance of CARET1 datatype") ) (RPAQ? \CARET.TIMER (SETUPTIMER 0) - (* ; "time for next caret action")) + (* ; "time for next caret action")) (RPAQ? DEFAULTCARET (CURSORCREATE \DefaultCaret NIL 3 4)) -(RPAQ? DEFAULTCARETRATE 333 (* ; "default rate for flashing caret") -) +(RPAQ? DEFAULTCARETRATE 333 (* ; "default rate for flashing caret")) (RPAQ? \CARET.ON.RATE DEFAULTCARETRATE) @@ -686,36 +670,36 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DECLARE%: DONTCOPY (DECLARE%: EVAL@COMPILE -(RECORD CARET1 (* ; - "a record that describes a SHOWING caret") - (STREAM (* ; - "the stream the caret is showing in") - STREAMX (* ; - "the X position stream relative that it was shown at") - STREAMY (* ; - "the Y position stream relative that it was shown at") - CURSOR (* ; - "the cursor bitmap + x and y that this caret represents") - RATE (* ; "the 'down rate' for this caret, in ticks. After comes down (when \CARET.TIMER expires), \CARET.TIMER will be rescheduled to put something up. This is the rate to use") - (* ; - "NEXT for threading carets together") - . NEXT)) +(RECORD CARET1 (* ; + "a record that describes a SHOWING caret") + (STREAM (* ; + "the stream the caret is showing in") + STREAMX (* ; + "the X position stream relative that it was shown at") + STREAMY (* ; + "the Y position stream relative that it was shown at") + CURSOR (* ; + "the cursor bitmap + x and y that this caret represents") + RATE (* ; "the 'down rate' for this caret, in ticks. After comes down (when \CARET.TIMER expires), \CARET.TIMER will be rescheduled to put something up. This is the rate to use") + (* ; + "NEXT for threading carets together") + . NEXT)) ) ) (DEFINEQ (CARET - [LAMBDA (NEWCARET) (* kbr%: " 6-Jul-85 16:13") + [LAMBDA (NEWCARET) (* kbr%: " 6-Jul-85 16:13") (* ; - "changes the 'system default' caret") + "changes the 'system default' caret") (PROG1 (COND (\CARET.DEFAULT (* ; - "merely stored as a 'cursor' record for simplicity") + "merely stored as a 'cursor' record for simplicity") (fetch (CARET1 CURSOR) of \CARET.DEFAULT)) (T 'OFF)) [COND (NEWCARET (\CHECKCARET) - (CARETRATE (CARETRATE)) (* ; "make sure the caret rate is set") + (CARETRATE (CARETRATE)) (* ; "make sure the caret rate is set") (SETQ \CARET.DEFAULT (SELECTQ NEWCARET (T (COND ((EQ DEFAULTCARET 'OFF) @@ -733,12 +717,12 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (T (LISPERROR "ILLEGAL ARG" NEWCARET])]) (\CARET.CREATE - [LAMBDA (CURSOR) (* jds "11-Jul-85 19:38") + [LAMBDA (CURSOR) (* jds "11-Jul-85 19:38") (create CARET1 CURSOR _ (OR CURSOR DEFAULTCARET]) (\CARET.DOWN - [LAMBDA (STREAM INTERVAL UNLESSOCCLUDED) (* lmm " 4-May-84 18:15") + [LAMBDA (STREAM INTERVAL UNLESSOCCLUDED) (* lmm " 4-May-84 18:15") (* ;; "take caret down if it is up. If you take it down, reschedule to put it back up in INTERVAL (or 0) --- often called thru \CHECKCARET macro") @@ -752,18 +736,17 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (fetch (WINDOW DSP) of STREAM)) (T STREAM] [while (UNINTERRUPTABLY - [COND - ((\CARET.SHOW \CARET.UP UNLESSOCCLUDED) + [COND + ((\CARET.SHOW \CARET.UP UNLESSOCCLUDED) (* ; - "take caret down and set global state") - (replace (CARET1 STREAM) of \CARET.UP with - NIL) - (SETQ \CARET.UP (fetch (CARET1 NEXT) of \CARET.UP])] + "take caret down and set global state") + (replace (CARET1 STREAM) of \CARET.UP with NIL) + (SETQ \CARET.UP (fetch (CARET1 NEXT) of \CARET.UP])] (SETUPTIMER (OR INTERVAL \CARET.FORCED.OFF.RATE) \CARET.TIMER]) (\CARET.FLASH? - [LAMBDA (STREAM CARET ONRATE OFFRATE X Y) (* AJB "17-Jul-85 12:47") + [LAMBDA (STREAM CARET ONRATE OFFRATE X Y) (* AJB "17-Jul-85 12:47") (* ;;; "Flashes the CARET at the ONRATE/OFFRATE at the X,Y position in the current TTY window. If CARET is NIL, uses \CARET.DEFAULT as the caret. Takes either a display stream or a textstream as the destination stream to flash the caret. The caret is not flashed on a shift-selection in a window") @@ -779,38 +762,35 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (TIMEREXPIRED? \CARET.TIMER) [OR [DISPLAYSTREAMP (OR STREAM (SETQ STREAM (TTYDISPLAYSTREAM] (AND (IMAGESTREAMTYPEP STREAM 'TEXT) - (SETQ STREAM (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ - STREAM))) + (SETQ STREAM (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ STREAM))) 'DSP] (\CARET.FLASH CARET STREAM OFFRATE (OR (KEYDOWNP 'LSHIFT) - (KEYDOWNP 'RSHIFT) - (KEYDOWNP 'COPY)) + (KEYDOWNP 'RSHIFT) + (KEYDOWNP 'COPY)) X Y)) (* ;; "\CARET.DEFAULT is NIL if by default the caret is OFF --- the KEYDOWNP clause is a hack to detect whether we are doing a copy-select") - (replace (CARET1 NEXT) of CARET with NIL)(* ; - "Since this function is displaying a new caret, destroy any chaining of multiple carets") + (replace (CARET1 NEXT) of CARET with NIL) (* ; + "Since this function is displaying a new caret, destroy any chaining of multiple carets") (SETUPTIMER (OR ONRATE \CARET.ON.RATE) \CARET.TIMER) T]) (\CARET.SHOW - [LAMBDA (CARET UNLESSOCCLUDED) (* ; "Edited 25-Feb-94 16:53 by sybalsky") + [LAMBDA (CARET UNLESSOCCLUDED) (* ; "Edited 25-Feb-94 16:53 by sybalsky") (* ;; "GENERIC caret flasher.") (LET (DS) (SETQ DS (fetch (CARET1 STREAM) of CARET)) - (WINDOWOP 'SCCARETFLASH (FETCH (WINDOW SCREEN) OF (FETCH (\DISPLAYDATA - XWINDOWHINT) - OF (FETCH (STREAM - IMAGEDATA) - OF DS))) + (WINDOWOP 'SCCARETFLASH (FETCH (WINDOW SCREEN) OF (FETCH (\DISPLAYDATA XWINDOWHINT) + OF (FETCH (STREAM IMAGEDATA) + OF DS))) CARET UNLESSOCCLUDED]) (CARETRATE - [LAMBDA (ONRATE OFFRATE) (* lmm " 3-May-84 11:35") + [LAMBDA (ONRATE OFFRATE) (* lmm " 3-May-84 11:35") (* ;; "sets the default caret rate (s) to be ONRATE/OFFRATE in milliseconds") @@ -827,50 +807,44 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation \CARET.ON.RATE])]) (\CARET.FLASH.AGAIN - [LAMBDA (CARET STREAM X Y) (* AJB "14-Aug-85 17:04") + [LAMBDA (CARET STREAM X Y) (* AJB "14-Aug-85 17:04") (LET ((OCARET \CARET.UP)) (COND ([AND OCARET CARET (DISPLAYSTREAMP (OR STREAM (SETQ STREAM (TTYDISPLAYSTREAM] (for (OC _ OCARET) by (fetch (CARET1 NEXT) of OC) do (COND - [(NULL OC) - (RETURN (COND - ((\CARET.FLASH CARET STREAM (fetch (CARET1 RATE) - of \CARET.UP) - (OR (KEYDOWNP 'LSHIFT) - (KEYDOWNP 'RSHIFT) - (KEYDOWNP 'COPY)) - X Y) (* ; "OK, showed this one") - (OR (EQ \CARET.UP CARET) - (SHOULDNT)) - (replace (CARET1 NEXT) of CARET with OCARET] - ((EQ OC CARET) (* ; "this CARET is already showing") - (RETURN]) + [(NULL OC) + (RETURN (COND + ((\CARET.FLASH CARET STREAM (fetch (CARET1 RATE) of \CARET.UP) + (OR (KEYDOWNP 'LSHIFT) + (KEYDOWNP 'RSHIFT) + (KEYDOWNP 'COPY)) + X Y) (* ; "OK, showed this one") + (OR (EQ \CARET.UP CARET) + (SHOULDNT)) + (replace (CARET1 NEXT) of CARET with OCARET] + ((EQ OC CARET) (* ; "this CARET is already showing") + (RETURN]) (\CARET.FLASH.MULTIPLE - [LAMBDA (STREAMS CARETS ONRATE OFFRATE) (* AJB "14-Aug-85 17:10") + [LAMBDA (STREAMS CARETS ONRATE OFFRATE) (* AJB "14-Aug-85 17:10") (* ; - "this is probably just a template for how to flash multiple carets") + "this is probably just a template for how to flash multiple carets") (COND ((\CARET.FLASH? (CAR STREAMS) (CAR CARETS) ONRATE OFFRATE) - (for STR in (CDR STREAMS) as CARET in (CDR CARETS) - do (\CARET.FLASH.AGAIN CARET STR]) + (for STR in (CDR STREAMS) as CARET in (CDR CARETS) do (\CARET.FLASH.AGAIN CARET STR]) (\CARET.FLASH - [LAMBDA (CARET STREAM RATE UNLESSOCCLUDED X Y) (* kbr%: " 5-Jul-85 17:51") + [LAMBDA (CARET STREAM RATE UNLESSOCCLUDED X Y) (* kbr%: " 5-Jul-85 17:51") (PROG (CURSOR ANSWER) (SETQ CURSOR (fetch (CARET1 CURSOR) of CARET)) (replace (CARET1 STREAM) of CARET with STREAM) - (replace (CARET1 STREAMX) of CARET with (IDIFFERENCE (OR X (DSPXPOSITION NIL - STREAM)) - (fetch (CURSOR CUHOTSPOTX) - of CURSOR))) - (replace (CARET1 STREAMY) of CARET with (IDIFFERENCE (OR Y (DSPYPOSITION NIL - STREAM)) - (fetch (CURSOR CUHOTSPOTY) - of CURSOR))) + (replace (CARET1 STREAMX) of CARET with (IDIFFERENCE (OR X (DSPXPOSITION NIL STREAM)) + (fetch (CURSOR CUHOTSPOTX) of CURSOR))) + (replace (CARET1 STREAMY) of CARET with (IDIFFERENCE (OR Y (DSPYPOSITION NIL STREAM)) + (fetch (CURSOR CUHOTSPOTY) of CURSOR))) (replace (CARET1 RATE) of CARET with (OR RATE \CARET.OFF.RATE)) (UNINTERRUPTABLY (COND @@ -882,8 +856,8 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DEFINEQ (\MEDW.CARET.SHOW - [LAMBDA (SCREEN CARET UNLESSOCCLUDED) (* ; - "Edited 17-Jan-94 10:28 by sybalsky:mv:envos") + [LAMBDA (SCREEN CARET UNLESSOCCLUDED) (* ; + "Edited 17-Jan-94 10:28 by sybalsky:mv:envos") (* ;; "MEDLEY-window-system specific version of \CARET.SHOW (vectored thru the screen). Flash the caret (by inverting its image). UNLESSOCCLUDED controls whether you bring the window to the top if the caret is under some other window.") @@ -903,7 +877,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (SETQ CARETBMWIDTH (fetch (BITMAP BITMAPWIDTH) of CARETBM)) (SETQ CARETBMHEIGHT (fetch (BITMAP BITMAPHEIGHT) of CARETBM)) (* ; - "calculate how much to reduce the caret region by do to the clipping region of the window.") + "calculate how much to reduce the caret region by do to the clipping region of the window.") (SETQ CLIPREG (fetch (\DISPLAYDATA DDClippingRegion) of DD)) (COND ((IGREATERP (SETQ CLIPVAR (fetch (REGION LEFT) of CLIPREG)) @@ -913,8 +887,8 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (SETQ CWX CLIPVAR))) (COND ((IGREATERP CARETBMWIDTH (SETQ CLIPVAR (IDIFFERENCE - (IPLUS CLIPVAR (fetch - (REGION WIDTH) + (IPLUS CLIPVAR (fetch (REGION + WIDTH) of CLIPREG)) CWX))) (SETQ CARETBMWIDTH CLIPVAR))) @@ -933,20 +907,19 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (SETQ CARETBMHEIGHT CLIPVAR))) (* note the time of the next change. This must be done without creating boxes - because happens during keyboard wait.) + because happens during keyboard wait.) (COND ((OR (ILESSP CARETBMWIDTH 1) - (ILESSP CARETBMHEIGHT 1)) (* caret isn't within clipping - region.) + (ILESSP CARETBMHEIGHT 1)) (* caret isn't within clipping region.) (RETURN T))) (* convert the base of the caret - location to screen coordinates.) + location to screen coordinates.) (SETQ CWX (\DSPTRANSFORMX CWX DD)) (SETQ CWY (\DSPTRANSFORMY CWY DD)) - (* having only this section uninterruptable leaves open the possibility that - the window moves or the timer is wrong but these will only mess up the display - and are low frequency events.) + (* having only this section uninterruptable leaves open the possibility that the + window moves or the timer is wrong but these will only mess up the display and + are low frequency events.) (COND [(AND (OPENWP CARETWIN) @@ -976,7 +949,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DEFINEQ (\AREAVISIBLE? - [LAMBDA (WIN LFT BTM RGHT TOP) (* kbr%: "18-Feb-86 18:05") + [LAMBDA (WIN LFT BTM RGHT TOP) (* kbr%: "18-Feb-86 18:05") (* ;; "is the area whose screen limits are LFT BTM RGHT and TOP eniretly visible within WIN,") @@ -985,7 +958,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (COND ((NOT (\AREAINREGIONP (fetch (WINDOW REG) of WIN) LFT BTM RGHT TOP)) (* ; - "if the caret region isn't completely within the window, forget it.") + "if the caret region isn't completely within the window, forget it.") (RETURN))) LP (COND ((EQ WPTR WIN) @@ -997,10 +970,10 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (GO LP]) (\REGIONOVERLAPAREAP - [LAMBDA (REG LFT BTM RGHT TOP) (* rrb "17-Feb-86 18:50") + [LAMBDA (REG LFT BTM RGHT TOP) (* rrb "17-Feb-86 18:50") (* ;; - "is there any overlap between the region REG and the area defined by left bottom right and top?") + "is there any overlap between the region REG and the area defined by left bottom right and top?") (NOT (OR (IGREATERP (fetch (REGION LEFT) of REG) RGHT) @@ -1010,7 +983,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (IGREATERP BTM (fetch (REGION TOP) of REG]) (\AREAINREGIONP - [LAMBDA (REGION LFT BTM RGHT TOP) (* rrb "14-OCT-83 15:32") + [LAMBDA (REGION LFT BTM RGHT TOP) (* rrb "14-OCT-83 15:32") (AND (IGEQ LFT (fetch LEFT of REGION)) (IGEQ BTM (fetch BOTTOM of REGION)) (IGEQ (fetch PRIGHT of REGION) @@ -1028,7 +1001,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DEFINEQ (CREATEREGION - [LAMBDA (LEFT BOTTOM WIDTH HEIGHT) (* rrb "17-JUN-83 08:56") + [LAMBDA (LEFT BOTTOM WIDTH HEIGHT) (* rrb "17-JUN-83 08:56") (* ; "creates a region structure.") (create REGION LEFT _ LEFT @@ -1037,12 +1010,12 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation HEIGHT _ HEIGHT]) (REGIONP - [LAMBDA (X) (* rrb "29-Jun-84 18:00") + [LAMBDA (X) (* rrb "29-Jun-84 18:00") (AND (type? REGION X) X]) (INTERSECTREGIONS - [LAMBDA REGIONS (* kbr%: "24-Jan-86 18:30") + [LAMBDA REGIONS (* kbr%: "24-Jan-86 18:30") (* ;; "returns the largest region that is contained in all of REGIONS") @@ -1065,32 +1038,22 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (SETQ BTTM (fetch (REGION BOTTOM) of REG)) [SETQ TP (SUB1 (IPLUS BTTM (fetch (REGION HEIGHT) of REG] [for I from 2 thru REGIONS do (SETQ REG (ARG REGIONS I)) - [COND - ((IGREATERP (fetch (REGION LEFT) - of REG) - LFT) - (SETQ LFT (fetch (REGION LEFT) - of REG] - [COND - ((IGREATERP (fetch (REGION BOTTOM - ) - of REG) - BTTM) - (SETQ BTTM (fetch (REGION BOTTOM - ) - of REG] - [COND - ((ILESSP (fetch (REGION RIGHT) - of REG) - RGHT) - (SETQ RGHT (fetch (REGION RIGHT) - of REG] - (COND - ((ILESSP (fetch (REGION TOP) - of REG) - TP) - (SETQ TP (fetch (REGION TOP) - of REG] + [COND + ((IGREATERP (fetch (REGION LEFT) of REG) + LFT) + (SETQ LFT (fetch (REGION LEFT) of REG] + [COND + ((IGREATERP (fetch (REGION BOTTOM) of REG) + BTTM) + (SETQ BTTM (fetch (REGION BOTTOM) of REG] + [COND + ((ILESSP (fetch (REGION RIGHT) of REG) + RGHT) + (SETQ RGHT (fetch (REGION RIGHT) of REG] + (COND + ((ILESSP (fetch (REGION TOP) of REG) + TP) + (SETQ TP (fetch (REGION TOP) of REG] (RETURN (COND ((AND (IGEQ RGHT LFT) (IGEQ TP BTTM)) @@ -1101,7 +1064,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation HEIGHT _ (ADD1 (IDIFFERENCE TP BTTM]) (UNIONREGIONS - [LAMBDA REGIONS (* rrb "30-Dec-85 17:07") + [LAMBDA REGIONS (* rrb "30-Dec-85 17:07") (* ;; "returns the smallest region that encloses all of REGIONS") @@ -1115,32 +1078,22 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (SETQ BTTM (fetch (REGION BOTTOM) of REG)) (SETQ TP (fetch (REGION PTOP) of REG)) [for I from 2 thru REGIONS do (SETQ REG (ARG REGIONS I)) - [COND - ((LESSP (fetch (REGION LEFT) - of REG) - LFT) - (SETQ LFT (fetch (REGION LEFT) - of REG] - [COND - ((LESSP (fetch (REGION BOTTOM) - of REG) - BTTM) - (SETQ BTTM (fetch (REGION BOTTOM - ) - of REG] - [COND - ((GREATERP (fetch (REGION PRIGHT) - of REG) - RGHT) - (SETQ RGHT (fetch (REGION PRIGHT - ) - of REG] - (COND - ((GREATERP (fetch (REGION PTOP) - of REG) - TP) - (SETQ TP (fetch (REGION PTOP) - of REG] + [COND + ((LESSP (fetch (REGION LEFT) of REG) + LFT) + (SETQ LFT (fetch (REGION LEFT) of REG] + [COND + ((LESSP (fetch (REGION BOTTOM) of REG) + BTTM) + (SETQ BTTM (fetch (REGION BOTTOM) of REG] + [COND + ((GREATERP (fetch (REGION PRIGHT) of REG) + RGHT) + (SETQ RGHT (fetch (REGION PRIGHT) of REG] + (COND + ((GREATERP (fetch (REGION PTOP) of REG) + TP) + (SETQ TP (fetch (REGION PTOP) of REG] (RETURN (create REGION LEFT _ LFT BOTTOM _ BTTM @@ -1148,7 +1101,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation HEIGHT _ (DIFFERENCE TP BTTM]) (REGIONSINTERSECTP - [LAMBDA (REGION1 REGION2) (* rrb "16-AUG-81 08:29") + [LAMBDA (REGION1 REGION2) (* rrb "16-AUG-81 08:29") (* ;; "determines if two regions intersect") @@ -1162,7 +1115,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (fetch TOP of REGION1]) (SUBREGIONP - [LAMBDA (LARGEREGION SMALLREGION) (* rrb "25-JUN-82 15:09") + [LAMBDA (LARGEREGION SMALLREGION) (* rrb "25-JUN-82 15:09") (* ;; "determines if small region is a subset of large region. (SUBREGIONP '(9 0 100 100) '(0 10 100 80))") @@ -1176,100 +1129,82 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (fetch PTOP of SMALLREGION]) (EXTENDREGION - [LAMBDA (REGION INCLUDEREGION) (* rrb " 5-FEB-82 09:25") + [LAMBDA (REGION INCLUDEREGION) (* rrb " 5-FEB-82 09:25") (* ;; "destructively extends REGION to include INCLUDEREGION") [COND ((IGREATERP (fetch (REGION LEFT) of REGION) (fetch (REGION LEFT) of INCLUDEREGION)) - (replace (REGION WIDTH) of REGION with (IDIFFERENCE (fetch (REGION PRIGHT) - of REGION) - (fetch (REGION LEFT) - of INCLUDEREGION))) - (replace (REGION LEFT) of REGION with (fetch (REGION LEFT) of - INCLUDEREGION - ] + (replace (REGION WIDTH) of REGION with (IDIFFERENCE (fetch (REGION PRIGHT) of REGION) + (fetch (REGION LEFT) of INCLUDEREGION))) + (replace (REGION LEFT) of REGION with (fetch (REGION LEFT) of INCLUDEREGION] [COND ((IGREATERP (fetch (REGION BOTTOM) of REGION) (fetch (REGION BOTTOM) of INCLUDEREGION)) - (replace (REGION HEIGHT) of REGION with (IDIFFERENCE (fetch (REGION PTOP) - of REGION) - (fetch (REGION BOTTOM) - of INCLUDEREGION))) - (replace (REGION BOTTOM) of REGION with (fetch (REGION BOTTOM) of - INCLUDEREGION - ] + (replace (REGION HEIGHT) of REGION with (IDIFFERENCE (fetch (REGION PTOP) of REGION) + (fetch (REGION BOTTOM) of INCLUDEREGION))) + (replace (REGION BOTTOM) of REGION with (fetch (REGION BOTTOM) of INCLUDEREGION] [COND ((IGREATERP (fetch (REGION RIGHT) of INCLUDEREGION) (fetch (REGION RIGHT) of REGION)) - (replace (REGION WIDTH) of REGION with (ADD1 (IDIFFERENCE (fetch (REGION - RIGHT) - of INCLUDEREGION - ) - (fetch (REGION LEFT) - of REGION] + (replace (REGION WIDTH) of REGION with (ADD1 (IDIFFERENCE (fetch (REGION RIGHT) of + INCLUDEREGION + ) + (fetch (REGION LEFT) of REGION] [COND ((IGREATERP (fetch (REGION TOP) of INCLUDEREGION) (fetch (REGION TOP) of REGION)) - (replace (REGION HEIGHT) of REGION with (ADD1 (IDIFFERENCE (fetch - (REGION TOP) - of + (replace (REGION HEIGHT) of REGION with (ADD1 (IDIFFERENCE (fetch (REGION TOP) of INCLUDEREGION - ) - (fetch (REGION BOTTOM) - of REGION] + ) + (fetch (REGION BOTTOM) of REGION] REGION]) (EXTENDREGIONBOTTOM - [LAMBDA (REG NEWBOTTOM) (* rrb "29-DEC-81 10:02") + [LAMBDA (REG NEWBOTTOM) (* rrb "29-DEC-81 10:02") (* ; "extends a region to the bottom") (PROG ((OLDBOTTOM (fetch (REGION BOTTOM) of REG))) [COND ((IGREATERP OLDBOTTOM NEWBOTTOM) (replace (REGION BOTTOM) of REG with NEWBOTTOM) - (replace (REGION HEIGHT) of REG with (IPLUS (fetch (REGION HEIGHT) - of REG) - (IDIFFERENCE OLDBOTTOM - NEWBOTTOM] + (replace (REGION HEIGHT) of REG with (IPLUS (fetch (REGION HEIGHT) of REG) + (IDIFFERENCE OLDBOTTOM NEWBOTTOM] (RETURN REG]) (EXTENDREGIONLEFT - [LAMBDA (REG NEWLEFT) (* rrb "29-DEC-81 09:37") + [LAMBDA (REG NEWLEFT) (* rrb "29-DEC-81 09:37") (* ; "extends a region to the left") (PROG ((OLDLEFT (fetch (REGION LEFT) of REG))) [COND ((IGREATERP OLDLEFT NEWLEFT) (replace (REGION LEFT) of REG with NEWLEFT) - (replace (REGION WIDTH) of REG with (IPLUS (fetch (REGION WIDTH) - of REG) - (IDIFFERENCE OLDLEFT NEWLEFT] + (replace (REGION WIDTH) of REG with (IPLUS (fetch (REGION WIDTH) of REG) + (IDIFFERENCE OLDLEFT NEWLEFT] (RETURN REG]) (EXTENDREGIONRIGHT - [LAMBDA (REG NEWRIGHT) (* rrb "29-DEC-81 10:06") + [LAMBDA (REG NEWRIGHT) (* rrb "29-DEC-81 10:06") (* ; "extends a region to the left") (PROG ((OLDRIGHT (fetch (REGION RIGHT) of REG))) [COND ((ILESSP OLDRIGHT NEWRIGHT) - (replace (REGION WIDTH) of REG with (IPLUS (fetch (REGION WIDTH) - of REG) - (IDIFFERENCE NEWRIGHT OLDRIGHT] + (replace (REGION WIDTH) of REG with (IPLUS (fetch (REGION WIDTH) of REG) + (IDIFFERENCE NEWRIGHT OLDRIGHT] (RETURN REG]) (EXTENDREGIONTOP - [LAMBDA (REG NEWTOP) (* rrb "29-DEC-81 10:07") + [LAMBDA (REG NEWTOP) (* rrb "29-DEC-81 10:07") (* ; "extends a region to the top") (PROG ((OLDTOP (fetch (REGION TOP) of REG))) [COND ((ILESSP OLDTOP NEWTOP) - (replace (REGION HEIGHT) of REG with (IPLUS (fetch (REGION HEIGHT) - of REG) - (IDIFFERENCE NEWTOP OLDTOP] + (replace (REGION HEIGHT) of REG with (IPLUS (fetch (REGION HEIGHT) of REG) + (IDIFFERENCE NEWTOP OLDTOP] (RETURN REG]) (INSIDEP - [LAMBDA (REGION POSORX Y) (* rrb "18-May-84 21:04") + [LAMBDA (REGION POSORX Y) (* rrb "18-May-84 21:04") (* ;; "returns T if the position X Y is inside the region REGION. If POSORX is a position, returns T if that position is inside of REGION") @@ -1289,7 +1224,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (T (\ILLEGAL.ARG POSORX]) (STRINGREGION - [LAMBDA (STR STREAM PRIN2FLG RDTBL) (* rmk%: "25-AUG-83 18:06") + [LAMBDA (STR STREAM PRIN2FLG RDTBL) (* rmk%: "25-AUG-83 18:06") (* ;; "returns the region taken up by STR if it were printed at the current position of STREAM") @@ -1321,10 +1256,9 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DEFINEQ (\BRUSHBITMAP - [LAMBDA (BRUSHSHAPE BRUSHWIDTH) (* rrb " 9-Sep-86 16:30") + [LAMBDA (BRUSHSHAPE BRUSHWIDTH) (* rrb " 9-Sep-86 16:30") -(* ;;; -"returns the bitmap for the brush of the shape and size. See comments on \InitCurveBrushes.") +(* ;;; "returns the bitmap for the brush of the shape and size. See comments on \InitCurveBrushes.") (DECLARE (GLOBALVARS \BrushAList)) (LET [(BRUSHES&METHOD (CDR (OR (FASSOC BRUSHSHAPE \BrushAList) @@ -1336,7 +1270,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (BITMAPCREATE 0 0)) [(ILESSP BRUSHWIDTH 17) (* ; - "lowest 16 brushes are stored. FIX them so ELT works.") + "lowest 16 brushes are stored. FIX them so ELT works.") (ELT (fetch (BRUSHITEM BRUSHARRAY) of BRUSHES&METHOD) (COND ((FIXP BRUSHWIDTH)) @@ -1351,11 +1285,11 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation BRUSHWIDTH))) (replace (BRUSHITEM BRUSHCACHE) of BRUSHES&METHOD with (CONS (CONS BRUSHWIDTH NEWBRUSHBM) - (fetch (BRUSHITEM BRUSHCACHE) of BRUSHES&METHOD))) + (fetch (BRUSHITEM BRUSHCACHE) of BRUSHES&METHOD))) NEWBRUSHBM]) (\GETBRUSH - [LAMBDA (BRUSH) (* rrb " 9-Sep-86 16:30") + [LAMBDA (BRUSH) (* rrb " 9-Sep-86 16:30") (COND ((type? BITMAP BRUSH) BRUSH) @@ -1365,7 +1299,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (T (\BRUSHBITMAP 'ROUND (OR BRUSH 1]) (\GETBRUSHBBT - [LAMBDA (BRUSHBM DISPLAYDATA BBT) (* kbr%: "18-Aug-85 12:46") + [LAMBDA (BRUSHBM DISPLAYDATA BBT) (* kbr%: "18-Aug-85 12:46") (* ;; "Initializes BBT for the BRUSHBM and DS and returns BBT, unless the BRUSHBM is a 1-point brush, in which case it returns NIL.") @@ -1376,25 +1310,17 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation 1) (EQ (BITMAPBIT BRUSHBM 0 0) 1)) (* ; - "special case of single point brush shape.") + "special case of single point brush shape.") NIL) (T (* ; - "update as many fields in the brush bitblt table as possible from DS.") - (replace (PILOTBBT PBTDESTBPL) of BBT with (UNFOLD (fetch (BITMAP - BITMAPRASTERWIDTH - ) - of - (fetch (\DISPLAYDATA - DDDestination - ) - of DISPLAYDATA)) - BITSPERWORD)) - (freplace (PILOTBBT PBTSOURCEBPL) of BBT with (UNFOLD (ffetch (BITMAP - - BITMAPRASTERWIDTH - ) - of BRUSHBM) - BITSPERWORD)) + "update as many fields in the brush bitblt table as possible from DS.") + (replace (PILOTBBT PBTDESTBPL) of BBT with (UNFOLD (fetch (BITMAP BITMAPRASTERWIDTH) + of (fetch (\DISPLAYDATA DDDestination + ) of DISPLAYDATA)) + BITSPERWORD)) + (freplace (PILOTBBT PBTSOURCEBPL) of BBT with (UNFOLD (ffetch (BITMAP BITMAPRASTERWIDTH) + of BRUSHBM) + BITSPERWORD)) (freplace (PILOTBBT PBTFLAGS) of BBT with 0) (freplace (PILOTBBT PBTDISJOINT) of BBT with T) (\SETPBTFUNCTION BBT (ffetch (\DISPLAYDATA DDSOURCETYPE) of DISPLAYDATA) @@ -1407,7 +1333,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation BBT]) (\InitCurveBrushes - [LAMBDA NIL (* ; "Edited 13-Oct-87 14:31 by jds") + [LAMBDA NIL (* ; "Edited 13-Oct-87 14:31 by jds") (* ;; "Set up the initial set of brush specs for curve drawing. \BrushAList is an association list from brush-shape-names to a spec which is an instance of the record BRUSHITEM.") @@ -1416,31 +1342,27 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (SETQ \SingleBitBitmap (BITMAPCREATE 1 1)) (BITMAPBIT \SingleBitBitmap 0 0 1) (for BRUSHNAME in \BrushNames do (SETQ BARRAY (ARRAY 16 'POINTER NIL 1)) - (SETQ CREATIONMETHOD (PACK* '\MAKEBRUSH. - BRUSHNAME)) - (SETA BARRAY 1 \SingleBitBitmap) - (for SIZE from 2 to 16 - do (SETA BARRAY SIZE (APPLY* - CREATIONMETHOD - SIZE))) - (INSTALLBRUSH BRUSHNAME CREATIONMETHOD - BARRAY]) + (SETQ CREATIONMETHOD (PACK* '\MAKEBRUSH. BRUSHNAME)) + (SETA BARRAY 1 \SingleBitBitmap) + (for SIZE from 2 to 16 + do (SETA BARRAY SIZE (APPLY* CREATIONMETHOD SIZE))) + (INSTALLBRUSH BRUSHNAME CREATIONMETHOD BARRAY]) (\BrushFromWidth - [LAMBDA (W) (* hdj " 5-Nov-84 16:47") + [LAMBDA (W) (* hdj " 5-Nov-84 16:47") (LIST 'ROUND W]) ) (DEFINEQ (\MAKEBRUSH.DIAGONAL - [LAMBDA (SIZE) (* kbr%: "18-Aug-85 12:51") + [LAMBDA (SIZE) (* kbr%: "18-Aug-85 12:51") (PROG (BM) (SETQ BM (BITMAPCREATE SIZE SIZE)) (for X from 0 to (SUB1 SIZE) do (BITMAPBIT BM X X 1)) (RETURN BM]) (\MAKEBRUSH.HORIZONTAL - [LAMBDA (SIZE) (* kbr%: "18-Aug-85 12:52") + [LAMBDA (SIZE) (* kbr%: "18-Aug-85 12:52") (* ;;; "create a brush that has a horizontal line across it halfway down") @@ -1451,7 +1373,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (RETURN BM]) (\MAKEBRUSH.VERTICAL - [LAMBDA (SIZE) (* kbr%: "18-Aug-85 12:53") + [LAMBDA (SIZE) (* kbr%: "18-Aug-85 12:53") (PROG (BM) (SETQ BM (BITMAPCREATE SIZE SIZE)) (BITBLT NIL NIL NIL BM (SUB1 (FOLDHI SIZE 2)) @@ -1459,16 +1381,16 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (RETURN BM]) (\MAKEBRUSH.SQUARE - [LAMBDA (SIZE) (* kbr%: "18-Aug-85 13:07") + [LAMBDA (SIZE) (* kbr%: "18-Aug-85 13:07") (PROG (BM) (SETQ BM (BITMAPCREATE SIZE SIZE)) (BITBLT NIL NIL NIL BM NIL NIL NIL NIL 'TEXTURE 'REPLACE BLACKSHADE) (RETURN BM]) (\MAKEBRUSH.ROUND - [LAMBDA (SIZE) (* rrb "15-Sep-86 14:32") + [LAMBDA (SIZE) (* rrb "15-Sep-86 14:32") (* ; - "special cased 8 so that it wouldn't have a width of 7. rrb") + "special cased 8 so that it wouldn't have a width of 7. rrb") (PROG (RADIUS BITMAP BASE) (SETQ RADIUS (SUB1 (HALF SIZE))) (SETQ BITMAP (BITMAPCREATE SIZE SIZE)) @@ -1503,22 +1425,22 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DEFINEQ (INSTALLBRUSH - [LAMBDA (BRUSHNAME BRUSHFN BRUSHARRAY) (* kbr%: "18-Jan-86 15:27") + [LAMBDA (BRUSHNAME BRUSHFN BRUSHARRAY) (* kbr%: "18-Jan-86 15:27") (DECLARE (GLOBALVARS \BrushAList)) (PROG (OLDENTRY) (SETQ OLDENTRY (FASSOC BRUSHNAME \BrushAList)) (COND - (OLDENTRY (AND BRUSHARRAY (replace (BRUSHITEM BRUSHARRAY) of (CDR OLDENTRY) - with BRUSHARRAY)) - (AND BRUSHFN (replace (BRUSHITEM CREATEMETHOD) of (CDR OLDENTRY) - with BRUSHFN))) + (OLDENTRY (AND BRUSHARRAY (replace (BRUSHITEM BRUSHARRAY) of (CDR OLDENTRY) with + BRUSHARRAY + )) + (AND BRUSHFN (replace (BRUSHITEM CREATEMETHOD) of (CDR OLDENTRY) with BRUSHFN))) (T [COND ((AND BRUSHFN (NOT (ARRAYP BRUSHARRAY))) (SETQ BRUSHARRAY (ARRAY 16 'POINTER NIL 1)) (for X from 1 to 16 do (SETA BRUSHARRAY X (APPLY* BRUSHFN X] (push \BrushAList (CONS BRUSHNAME (create BRUSHITEM - BRUSHARRAY _ BRUSHARRAY - CREATEMETHOD _ BRUSHFN))) + BRUSHARRAY _ BRUSHARRAY + CREATEMETHOD _ BRUSHFN))) (push KNOWN.BRUSHES BRUSHNAME]) ) @@ -1549,40 +1471,81 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DEFINEQ (\DRAWLINE.DISPLAY - [LAMBDA (DISPLAYSTREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING) - (* ; "Edited 13-Jun-2021 14:03 by rmk:") + [LAMBDA (DISPLAYSTREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING) + (* ; "Edited 1-Mar-2023 07:42 by lmm") + (* ; "Edited 29-Jan-91 14:59 by matsuda") - (* ;; "DISPLAYSTREAM is guaranteed to be a display-stream. Draws a line from x1,y1 to x2,y2 leaving the position at x2,y2") + (* ;; "DISPLAYSTREAM is guaranteed to be a display-stream. Draws a line from x1,y1 to x2,y2 leaving the position at x2,y2") - (* ;; "Added handling of brushes (I think, this is actually pretty tricky).") + (* ;; "Added handling of brushes (I think, this is actually pretty tricky).") - (DECLARE (LOCALVARS . T)) - (SELECTQ OPERATION - (NIL (ffetch DDOPERATION of (fetch IMAGEDATA of DISPLAYSTREAM))) - ((REPLACE PAINT INVERT ERASE) - OPERATION) - (\ILLEGAL.ARG OPERATION)) - (\INSURETOPWDS DISPLAYSTREAM) (* ; - "RMK: This was only in the no-dash case, oddly") - (IF (OR DASHING (BRUSHP WIDTH)) - THEN [LET ((BRUSH (INSURE.BRUSH WIDTH))) - (if COLOR - then (replace (BRUSH BRUSHCOLOR) of BRUSH with COLOR)) - (IF (BIGBITMAPP (ffetch DDDestination of (fetch IMAGEDATA - of DISPLAYSTREAM))) - THEN (\DRAWLINE.BIGBM.DASH DISPLAYSTREAM X1 Y1 X2 Y2 BRUSH DASHING - OPERATION) - ELSE (GLOBALRESOURCES \BRUSHBBT (\LINEWITHBRUSH X1 Y1 X2 Y2 BRUSH - (\GOOD.DASHLST DASHING BRUSH) - DISPLAYSTREAM \BRUSHBBT OPERATION] - ELSEIF (BIGBITMAPP (ffetch DDDestination of (fetch IMAGEDATA of - DISPLAYSTREAM - ))) - THEN (\DRAWLINE.BIGBM.NODASH DISPLAYSTREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR) - ELSE (LET ((DD (fetch IMAGEDATA of DISPLAYSTREAM))) + (DECLARE (LOCALVARS . T) + (GLOBALVARS \SCREENBITMAPS)) + [COND + [(OR DASHING (BRUSHP WIDTH)) + (GLOBALRESOURCE + \BRUSHBBT + (LET ((BBT \BRUSHBBT) + (BRUSH (INSURE.BRUSH WIDTH))) + (if COLOR + then (replace (BRUSH BRUSHCOLOR) of BRUSH with COLOR)) + (IF [NOT (type? BIGBM (ffetch DDDestination of (fetch IMAGEDATA of DISPLAYSTREAM] + THEN (\LINEWITHBRUSH X1 Y1 X2 Y2 BRUSH (\GOOD.DASHLST DASHING BRUSH) + DISPLAYSTREAM BBT (SELECTQ OPERATION + (NIL (ffetch DDOPERATION + of (fetch IMAGEDATA of DISPLAYSTREAM))) + ((REPLACE PAINT INVERT ERASE) + OPERATION) + (\ILLEGAL.ARG OPERATION))) + ELSE (PROG ((DD (fetch IMAGEDATA of DISPLAYSTREAM)) + BITMAP BIGBMLIST HEIGHT BOTTOM BM YY1 YY2 ClippingTop ClippingBottom CTop + CBottom) + (SETQ BITMAP (ffetch DDDestination of DD)) + (SETQ BIGBMLIST (fetch (BIGBM BIGBMLIST) of BITMAP)) + (SETQ HEIGHT (BITMAPHEIGHT BITMAP)) + (SETQ ClippingTop (ffetch DDClippingTop of DD)) + (SETQ ClippingBottom (ffetch DDClippingBottom of DD)) + (SETQ BM (GetNewFragment BIGBMLIST)) + (while (AND BM (IGREATERP HEIGHT ClippingBottom)) + do (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT BM))) + [SETQ CTop (COND + ((IGREATERP ClippingTop HEIGHT) + (IDIFFERENCE HEIGHT BOTTOM)) + (T (IDIFFERENCE ClippingTop BOTTOM] + (if (IGEQ CTop 0) + then [SETQ CBottom (COND + ((ILESSP ClippingBottom BOTTOM) + 0) + (T (IDIFFERENCE ClippingBottom BOTTOM] + (replace DDDestination of DD with BM) + (replace DDClippingTop of DD with CTop) + (replace DDClippingBottom of DD with CBottom) + (\LINEWITHBRUSH X1 (IDIFFERENCE Y1 BOTTOM) + X2 + (IDIFFERENCE Y2 BOTTOM) + BRUSH + (\GOOD.DASHLST DASHING BRUSH) + DISPLAYSTREAM BBT + (SELECTQ OPERATION + (NIL (ffetch DDOPERATION + of (fetch IMAGEDATA of DISPLAYSTREAM))) + ((REPLACE PAINT INVERT ERASE) + OPERATION) + (\ILLEGAL.ARG OPERATION))) + (SETQ BM (GetNewFragment BIGBMLIST)) + (SETQ HEIGHT BOTTOM))) + (freplace DDDestination of DD with BITMAP) + (freplace DDClippingTop of DD with ClippingTop) + (freplace DDClippingBottom of DD with ClippingBottom] + (T (PROG ((DD (fetch IMAGEDATA of DISPLAYSTREAM)) + BITMAP) + (\INSURETOPWDS DISPLAYSTREAM) (* ; "bring the window to the top") + (SETQ BITMAP (ffetch DDDestination of DD)) + (COND + ((NOT (type? BIGBM BITMAP)) (\CLIPANDDRAWLINE (\DSPTRANSFORMX (OR (FIXP X1) - (FIXR X1)) - DD) + (FIXR X1)) + DD) (\DSPTRANSFORMY (OR (FIXP Y1) (FIXR Y1)) DD) @@ -1597,18 +1560,71 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation 1) ((OR (FIXP WIDTH) (FIXR WIDTH] - OPERATION - (ffetch DDDestination of DD) + (SELECTQ OPERATION + (NIL (ffetch DDOPERATION of DD)) + ((REPLACE PAINT INVERT ERASE) + OPERATION) + (\ILLEGAL.ARG OPERATION)) + BITMAP (ffetch DDClippingLeft of DD) (SUB1 (ffetch DDClippingRight of DD)) (ffetch DDClippingBottom of DD) (SUB1 (ffetch DDClippingTop of DD)) - DISPLAYSTREAM COLOR))) (* ; - "the generic case of MOVETO is used so that the hardcopy streams get handled as well.") + DISPLAYSTREAM COLOR)) + (T (PROG ((BIGBMLIST (fetch (BIGBM BIGBMLIST) of BITMAP)) + (HEIGHT (BITMAPHEIGHT BITMAP)) + BOTTOM BM CTop CBottom (ClippingTop (ffetch DDClippingTop of DD)) + (ClippingBottom (ffetch DDClippingBottom of DD)) + (YY1 (\DSPTRANSFORMY (OR (FIXP Y1) + (FIXR Y1)) + DD)) + (YY2 (\DSPTRANSFORMY (OR (FIXP Y2) + (FIXR Y2)) + DD))) + (SETQ BM (GetNewFragment BIGBMLIST)) + (while (AND BM (IGREATERP HEIGHT ClippingBottom)) + do (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT BM))) + [SETQ CTop (COND + ((IGREATERP ClippingTop HEIGHT) + (IDIFFERENCE HEIGHT BOTTOM)) + (T (IDIFFERENCE ClippingTop BOTTOM] + (COND + ((IGEQ CTop 0) + [SETQ CBottom (COND + ((ILESSP ClippingBottom BOTTOM) + 0) + (T (IDIFFERENCE ClippingBottom BOTTOM] + (\CLIPANDDRAWLINE (\DSPTRANSFORMX (OR (FIXP X1) + (FIXR X1)) + DD) + (IDIFFERENCE YY1 BOTTOM) + (\DSPTRANSFORMX (OR (FIXP X2) + (FIXR X2)) + DD) + (IDIFFERENCE YY2 BOTTOM) + [COND + ((NULL WIDTH) + 1) + ((OR (FIXP WIDTH) + (FIXR WIDTH] + (SELECTQ OPERATION + (NIL (ffetch DDOPERATION of DD)) + ((REPLACE PAINT INVERT ERASE) + OPERATION) + (\ILLEGAL.ARG OPERATION)) + BM + (ffetch DDClippingLeft of DD) + (SUB1 (ffetch DDClippingRight of DD)) + CBottom + (SUB1 CTop) + DISPLAYSTREAM COLOR))) + (SETQ BM (GetNewFragment BIGBMLIST)) + (SETQ HEIGHT BOTTOM] (* ; + "the generic case of MOVETO is used so that the hardcopy streams get handled as well.") (MOVETO X2 Y2 DISPLAYSTREAM]) (RELMOVETO - [LAMBDA (DX DY STREAM) (* rmk%: "25-AUG-83 18:13") + [LAMBDA (DX DY STREAM) (* rmk%: "25-AUG-83 18:13") (* ; "moves the position by a vector") (DSPXPOSITION [IPLUS DX (DSPXPOSITION NIL (SETQ STREAM (\OUTSTREAMARG STREAM] STREAM) @@ -1616,7 +1632,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation STREAM]) (MOVETOUPPERLEFT - [LAMBDA (STREAM REGION) (* hdj " 5-Jul-85 12:19") + [LAMBDA (STREAM REGION) (* hdj " 5-Jul-85 12:19") (* ;; "moves the current position to the upper left corner so that the first line of text will all appear.") @@ -1650,7 +1666,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (COND ((NOT (EQ (fetch (BITMAP BITMAPBITSPERPIXEL) of BITMAP) 1)) (* ; - "make adjustments in case of color.") + "make adjustments in case of color.") (SETQ COLOR (COLORNUMBERP (OR COLOR (DSPCOLOR NIL DS)) (fetch (BITMAP BITMAPBITSPERPIXEL) of BITMAP))) (* ; "(COND ((EQ OPERATION 'ERASE) ; treat erase as AND of background (SETQ COLOR (OPPOSITECOLOR COLOR (fetch (BITMAP BITMAPBITSPERPIXEL) of BITMAP)))))") @@ -1687,8 +1703,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (ADD1 (IDIFFERENCE (IMIN MAX TOP) MIN)) 'TEXTURE OPERATION COLOR] - [(EQ Y1 Y2) (* ; - "special case of horizontal line.") + [(EQ Y1 Y2) (* ; "special case of horizontal line.") [COND ((IGREATERP WIDTH 2) (SETQ Y1 (SETQ Y2 (IDIFFERENCE Y1 (LRSH (SUB1 WIDTH) @@ -1714,7 +1729,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (\CLIPANDDRAWLINE1 X1 Y1 X2 Y2 OPERATION BITMAP LEFT RIGHT BOTTOM TOP DS COLOR)) ((IGREATERP (IABS (IDIFFERENCE X1 X2)) (IABS (IDIFFERENCE Y1 Y2))) (* ; - "slope is more horizontal, so make line grow in the positive y direction.") + "slope is more horizontal, so make line grow in the positive y direction.") [COND ((IGREATERP WIDTH 2) (PROG (HALFWIDTH) @@ -1723,10 +1738,9 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (SETQ Y1 (IDIFFERENCE Y1 HALFWIDTH)) (SETQ Y2 (IDIFFERENCE Y2 HALFWIDTH] (for I from Y1 to (SUB1 (IPLUS Y1 WIDTH)) as J from Y2 - do (\CLIPANDDRAWLINE1 X1 I X2 J OPERATION BITMAP LEFT RIGHT BOTTOM TOP DS - COLOR))) + do (\CLIPANDDRAWLINE1 X1 I X2 J OPERATION BITMAP LEFT RIGHT BOTTOM TOP DS COLOR))) (T (* ; - "slope is more vertical, so make line grow in the positive x direction.") + "slope is more vertical, so make line grow in the positive x direction.") [COND ((IGREATERP WIDTH 2) (PROG (HALFWIDTH) @@ -1735,11 +1749,10 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (SETQ X1 (IDIFFERENCE X1 HALFWIDTH)) (SETQ X2 (IDIFFERENCE X2 HALFWIDTH] (for I from X1 to (SUB1 (IPLUS X1 WIDTH)) as J from X2 - do (\CLIPANDDRAWLINE1 I Y1 J Y2 OPERATION BITMAP LEFT RIGHT BOTTOM TOP DS - COLOR]) + do (\CLIPANDDRAWLINE1 I Y1 J Y2 OPERATION BITMAP LEFT RIGHT BOTTOM TOP DS COLOR]) (\CLIPANDDRAWLINE1 - [LAMBDA (X1 Y1 X2 Y2 OPERATION BITMAP LEFT RIGHT BOTTOM TOP DS COLOR) + [LAMBDA (X1 Y1 X2 Y2 OPERATION BITMAP LEFT RIGHT BOTTOM TOP DS COLOR) (* JonL " 7-May-84 02:57") (* ;; "LEFT, RIGHT, BOTTOM, TOP are set to the boundaries of the clipping region") @@ -1749,14 +1762,14 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (PROG (DX DY YMOVEUP HALFDX HALFDY (BMRASTERWIDTH (fetch BITMAPRASTERWIDTH of BITMAP))) (COND ((IGREATERP X1 X2) (* ; - "switch points so DX is always positive.") + "switch points so DX is always positive.") (SETQ HALFDX X1) (SETQ X1 X2) (SETQ X2 HALFDX) (SETQ HALFDX Y1) (SETQ Y1 Y2) (SETQ Y2 HALFDX))) (* ; - "calculate differences and sign of Y movement.") + "calculate differences and sign of Y movement.") (SETQ HALFDX (LRSH (SETQ DX (IDIFFERENCE X2 X1)) 1)) (SETQ HALFDY (LRSH [SETQ DY (COND @@ -1775,7 +1788,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (IGEQ TOP Y1] (EQ (fetch (BITMAP BITMAPBITSPERPIXEL) of BITMAP) 1)) (* ; - "line is completely visible, fast case.") + "line is completely visible, fast case.") (.WHILE.TOP.DS. DS (\DRAWLINE1 X1 (SUB1 (\SFInvert BITMAP Y1)) DX DY DX DY (COND ((IGREATERP DX DY) @@ -1785,7 +1798,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation HALFDY)) (COND (YMOVEUP (* ; - "y is moving in positive direction but bits are stored inversely") + "y is moving in positive direction but bits are stored inversely") (IMINUS BMRASTERWIDTH)) (T BMRASTERWIDTH)) OPERATION @@ -1799,13 +1812,13 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (CA1 (\CLIPCODE X1 Y1 LEFT RIGHT TOP BOTTOM)) (CA2 (\CLIPCODE X2 Y2 LEFT RIGHT TOP BOTTOM))) (* ; - "save the original points for the clipping computation.") + "save the original points for the clipping computation.") (* ; - "determine the sectors in which the points fall.") + "determine the sectors in which the points fall.") CLIPLP [COND ((NOT (EQ 0 (LOGAND CA1 CA2))) (* ; - "line is entirely out of clipping region") + "line is entirely out of clipping region") (RETURN NIL)) ((EQ 0 (IPLUS CA1 CA2)) (* ; "line is completely visible") @@ -1838,7 +1851,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation DY))) (COND (YMOVEUP (* ; - "y is moving in positive direction but bits are stored inversely") + "y is moving in positive direction but bits are stored inversely") (IMINUS BMRASTERWIDTH)) (T BMRASTERWIDTH)) OPERATION @@ -1868,7 +1881,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation DY))) (COND (YMOVEUP (* ; - "y is moving in positive direction but bits are stored inversely") + "y is moving in positive direction but bits are stored inversely") (IMINUS BMRASTERWIDTH)) (T BMRASTERWIDTH)) OPERATION @@ -1885,7 +1898,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (COND ((IGREATERP CA1 7) (* ; "y1 less than bottom") (* ; - "calculate the least X for which Y will be at bottom.") + "calculate the least X for which Y will be at bottom.") [SETQ CX1 (IPLUS X1 (\LEASTPTAT DX DY (IDIFFERENCE BOTTOM Y1] (SETQ CY1 BOTTOM)) ((IGREATERP CA1 3) (* ; "y1 is greater than top") @@ -1893,14 +1906,12 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (SETQ CY1 TOP)) (T (* ; "x1 is less than left") [SETQ CY1 (COND - [YMOVEUP (IPLUS Y1 (\LEASTPTAT DY DX (IDIFFERENCE - LEFT X1] - (T (IDIFFERENCE Y1 (\LEASTPTAT DY DX (IDIFFERENCE - LEFT X1] + [YMOVEUP (IPLUS Y1 (\LEASTPTAT DY DX (IDIFFERENCE LEFT X1] + (T (IDIFFERENCE Y1 (\LEASTPTAT DY DX (IDIFFERENCE LEFT X1] (SETQ CX1 LEFT))) (SETQ CA1 (\CLIPCODE CX1 CY1 LEFT RIGHT TOP BOTTOM))) (T (* ; - "now move point CX2 CY2 so that one of the coordinates is on one of the boundaries") + "now move point CX2 CY2 so that one of the coordinates is on one of the boundaries") (COND ((IGREATERP CA2 7) (* ; "y2 less than bottom") [SETQ CX2 (IPLUS X1 (\GREATESTPTAT DX DY (IDIFFERENCE Y1 BOTTOM] @@ -1910,16 +1921,16 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (SETQ CY2 TOP)) (T (* ; "x2 is greater than right") [SETQ CY2 (COND - [YMOVEUP (IPLUS Y1 (\GREATESTPTAT DY DX - (IDIFFERENCE RIGHT X1] - (T (IDIFFERENCE Y1 (\GREATESTPTAT DY DX - (IDIFFERENCE RIGHT X1] + [YMOVEUP (IPLUS Y1 (\GREATESTPTAT DY DX (IDIFFERENCE + RIGHT X1] + (T (IDIFFERENCE Y1 (\GREATESTPTAT DY DX (IDIFFERENCE + RIGHT X1] (SETQ CX2 RIGHT))) (SETQ CA2 (\CLIPCODE CX2 CY2 LEFT RIGHT TOP BOTTOM] (GO CLIPLP]) (\CLIPCODE - [LAMBDA (X Y LEFT RIGHT TOP BOTTOM) (* rrb " 4-DEC-80 10:34") + [LAMBDA (X Y LEFT RIGHT TOP BOTTOM) (* rrb " 4-DEC-80 10:34") (* ;; "determines the sector code for a point wrt a region. Used to clip things quickly.") @@ -1950,7 +1961,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation 0]) (\LEASTPTAT - [LAMBDA (DA DB THISB) (* rrb " 7-JAN-82 11:56") + [LAMBDA (DA DB THISB) (* rrb " 7-JAN-82 11:56") (* ;; "determines the smallest value in the dimension A that would give a B coordinate of THISB if a line were drawn from the point (0,0) with a slope of DA/DB.") @@ -1965,7 +1976,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation DB]) (\GREATESTPTAT - [LAMBDA (DA DB THISB) (* rrb " 7-JAN-82 14:24") + [LAMBDA (DA DB THISB) (* rrb " 7-JAN-82 14:24") (* ;; "determines the largest value in the dimension A that would give a B coordinate of THISB if a line were drawn from the point (0,0) with a slope of DA/DB.") @@ -1981,7 +1992,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation DB]) (\DRAWLINE1 - [LAMBDA (X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH) + [LAMBDA (X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH) (* mpl " 2-Jan-84 18:00") (* ;; "this was changed to interface with the opcode for line drawing. It probably be incorporated into the places it is called.") @@ -1989,7 +2000,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (* ;; "draws a line starting at X0,Y0 at a slope of DX/DY until reaching either XLIMIT or YLIMIT with an initial overflow bucket size of CDL in MODE. Arranged so that the clipping routines can determine what the exact location of the end point of the clipped line is wrt line drawing coordinates eg. amount in overflow bucket. XLIMIT and YLIMIT are the number of points to be moved in that direction.") (\DRAWLINE.UFN (\ADDBASE BITMAPBASE (IPLUS (ITIMES Y0 RASTERWIDTH) - (FOLDLO X0 BITSPERWORD))) + (FOLDLO X0 BITSPERWORD))) (LOGAND X0 15) DX YINC DY (SELECTQ MODE (INVERT 2) @@ -2000,7 +2011,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (ADD1 YLIMIT]) (\DRAWLINE.UFN - [LAMBDA (FIRSTADDR FIRSTBIT XDELTA YINCR YDELTA OPERATIONCODE INITIALBUCKET PIXELSINX PIXELSINY) + [LAMBDA (FIRSTADDR FIRSTBIT XDELTA YINCR YDELTA OPERATIONCODE INITIALBUCKET PIXELSINX PIXELSINY) (* jds " 6-Jan-86 11:27") (* ;; "FIRSTADDR is the address of the word which contains the first point. FIRSTBIT is the address of the first bit in FIRSTADDR. XDELTA and YDELTA are how far the complete line has to move in X and Y respectively; both are positive quantities. YINCR is the amount the address should be incremented if the Y coordinate changes and can be either positive or negative. OPERATIONCODE is 0 for REPLACE, 1 for ERASE and 2 for INVERT. INITIALBUCKET is between 0 and the maximum of DX and DY and gives the starting amount of the bucket used to determine when to increment in the slower moving direction. PIXELSINX and PIXELSINY indicates how many pixels should be drawn in the X and Y direction.") @@ -2023,78 +2034,63 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DECLARE%: EVAL@COMPILE (PUTPROPS .DRAWLINEX. MACRO [(MODE) - (bind (NY _ 0) for PT from 1 to PIXELSINX - do (* ; "main loop") - [replace (BITMAPWORD BITS) of FIRSTADDR - with (SELECTQ MODE - (INVERT (LOGXOR MASK - (fetch (BITMAPWORD - BITS) - of FIRSTADDR))) - (ERASE (LOGAND (LOGXOR MASK WORDMASK) - (fetch (BITMAPWORD - BITS) - of FIRSTADDR))) - (PROGN - (* ; - "case is PAINT or REPLACE. Legality of OPERATION has been checked by \CLIPANDDRAWLINE1") - (LOGOR MASK (fetch - (BITMAPWORD BITS) - of FIRSTADDR] - [COND - ([NOT (IGREATERP XDELTA (SETQ INITIALBUCKET - (IPLUS INITIALBUCKET YDELTA - ] - (* ; "increment in the Y direction") - (COND - ((EQ (SETQ NY (ADD1 NY)) - PIXELSINY) - (RETURN))) - (SETQ INITIALBUCKET (IDIFFERENCE INITIALBUCKET - XDELTA)) - (SETQ FIRSTADDR (\ADDBASE FIRSTADDR YINCR] - (SETQ MASK (LRSH MASK 1)) - (COND - ((EQ 0 MASK)(* ; "crossed word boundary") - (SETQ FIRSTADDR (\ADDBASE FIRSTADDR 1)) - (SETQ MASK 32768]) + (bind (NY _ 0) for PT from 1 to PIXELSINX + do (* ; "main loop") + [replace (BITMAPWORD BITS) of FIRSTADDR + with (SELECTQ MODE + (INVERT (LOGXOR MASK (fetch (BITMAPWORD BITS) + of FIRSTADDR))) + (ERASE (LOGAND (LOGXOR MASK WORDMASK) + (fetch (BITMAPWORD BITS) of FIRSTADDR))) + (PROGN (* ; + "case is PAINT or REPLACE. Legality of OPERATION has been checked by \CLIPANDDRAWLINE1") + (LOGOR MASK (fetch (BITMAPWORD BITS) + of FIRSTADDR] + [COND + ([NOT (IGREATERP XDELTA (SETQ INITIALBUCKET (IPLUS + INITIALBUCKET + YDELTA] + (* ; "increment in the Y direction") + (COND + ((EQ (SETQ NY (ADD1 NY)) + PIXELSINY) + (RETURN))) + (SETQ INITIALBUCKET (IDIFFERENCE INITIALBUCKET XDELTA)) + (SETQ FIRSTADDR (\ADDBASE FIRSTADDR YINCR] + (SETQ MASK (LRSH MASK 1)) + (COND + ((EQ 0 MASK) (* ; "crossed word boundary") + (SETQ FIRSTADDR (\ADDBASE FIRSTADDR 1)) + (SETQ MASK 32768]) (PUTPROPS .DRAWLINEY. MACRO [(MODE) - (bind (NX _ 0) for PT from 1 to PIXELSINY - do (* ; "main loop") - [replace (BITMAPWORD BITS) of FIRSTADDR - with (SELECTQ MODE - (INVERT (LOGXOR MASK - (fetch (BITMAPWORD - BITS) - of FIRSTADDR))) - (ERASE (LOGAND (LOGXOR MASK WORDMASK) - (fetch (BITMAPWORD - BITS) - of FIRSTADDR))) - (PROGN - (* ; - "case is PAINT or REPLACE. Legality of OPERATION has been checked by \CLIPANDDRAWLINE1") - (LOGOR MASK (fetch - (BITMAPWORD BITS) - of FIRSTADDR] - [COND - ([NOT (IGREATERP YDELTA (SETQ INITIALBUCKET - (IPLUS INITIALBUCKET XDELTA - ] - (COND - ((EQ (SETQ NX (ADD1 NX)) - PIXELSINX) - (RETURN))) - (SETQ INITIALBUCKET (IDIFFERENCE INITIALBUCKET - YDELTA)) - (SETQ MASK (LRSH MASK 1)) - (COND - ((EQ 0 MASK) - (* ; "crossed word boundary") - (SETQ FIRSTADDR (\ADDBASE FIRSTADDR 1)) - (SETQ MASK 32768] - (SETQ FIRSTADDR (\ADDBASE FIRSTADDR YINCR]) + (bind (NX _ 0) for PT from 1 to PIXELSINY + do (* ; "main loop") + [replace (BITMAPWORD BITS) of FIRSTADDR + with (SELECTQ MODE + (INVERT (LOGXOR MASK (fetch (BITMAPWORD BITS) + of FIRSTADDR))) + (ERASE (LOGAND (LOGXOR MASK WORDMASK) + (fetch (BITMAPWORD BITS) of FIRSTADDR))) + (PROGN (* ; + "case is PAINT or REPLACE. Legality of OPERATION has been checked by \CLIPANDDRAWLINE1") + (LOGOR MASK (fetch (BITMAPWORD BITS) + of FIRSTADDR] + [COND + ([NOT (IGREATERP YDELTA (SETQ INITIALBUCKET (IPLUS + INITIALBUCKET + XDELTA] + (COND + ((EQ (SETQ NX (ADD1 NX)) + PIXELSINX) + (RETURN))) + (SETQ INITIALBUCKET (IDIFFERENCE INITIALBUCKET YDELTA)) + (SETQ MASK (LRSH MASK 1)) + (COND + ((EQ 0 MASK) (* ; "crossed word boundary") + (SETQ FIRSTADDR (\ADDBASE FIRSTADDR 1)) + (SETQ MASK 32768] + (SETQ FIRSTADDR (\ADDBASE FIRSTADDR YINCR]) ) ) @@ -2105,11 +2101,11 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DEFINEQ (\DRAWCIRCLE.DISPLAY - [LAMBDA (DISPLAYSTREAM CENTERX CENTERY RADIUS BRUSH DASHING) + [LAMBDA (DISPLAYSTREAM CENTERX CENTERY RADIUS BRUSH DASHING) (* kbr%: "15-Feb-86 22:24") (* ;; -"\DRAWCIRCLE.DISPLAY extended for color. Color is specified by either BRUSH or the DSPCOLOR of DS.") + "\DRAWCIRCLE.DISPLAY extended for color. Color is specified by either BRUSH or the DSPCOLOR of DS.") (DECLARE (LOCALVARS . T)) (COND @@ -2120,7 +2116,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation ((EQ RADIUS 0) (* ; "don't draw anything.") NIL) (DASHING (* ; - "draw it with the arc drawing code which does dashing. Slow but effective.") + "draw it with the arc drawing code which does dashing. Slow but effective.") (* ;; "the CDR removes the first point to work around a bug in curve drawing when closed and first and last points the same. AR 4623.0") @@ -2143,7 +2139,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (COND (USERFN (* ; - "if calling user fn, don't bother with set up and leave points in stream coordinates.") + "if calling user fn, don't bother with set up and leave points in stream coordinates.") (SETQ CX CENTERX) (SETQ CY CENTERY)) (T (.SETUP.FOR.\BBTCURVEPT.) @@ -2159,15 +2155,14 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (FOLDLO (LRSH BRUSHWIDTH 3) 2)) DISPLAYDATA))) - (24 (* ; - "I doubt that this will be right.") + (24 (* ; "I doubt that this will be right.") (SETQ CX (\DSPTRANSFORMX (IDIFFERENCE CENTERX (FOLDLO (IQUOTIENT BRUSHWIDTH 24 ) 2)) DISPLAYDATA))) (SHOULDNT)) (* ; - "take into account the brush thickness.") + "take into account the brush thickness.") (SETQ CY (\DSPTRANSFORMY (IDIFFERENCE CENTERY (FOLDLO BRUSHHEIGHT 2)) DISPLAYDATA)) @@ -2177,13 +2172,13 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation [COND ((EQ RADIUS 1) (* ; "put a single brush down.") (* ; - "draw the top and bottom most points.") + "draw the top and bottom most points.") [COND (USERFN (APPLY* USERFN CX CY DISPLAYSTREAM)) (T (.WHILE.TOP.DS. DISPLAYSTREAM (\CURVEPT CX CY] (RETURN)) (T (* ; - "draw the top and bottom most points.") + "draw the top and bottom most points.") (COND (USERFN (APPLY* USERFN CX (IPLUS CY RADIUS) DISPLAYSTREAM) @@ -2192,7 +2187,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (T (.WHILE.TOP.DS. DISPLAYSTREAM (\CURVEPT CX (IPLUS CY RADIUS)) (\CURVEPT CX (IDIFFERENCE CY RADIUS] LP (* ; - "(UNFOLD x 2) is used instead of (ITIMES x 2)") + "(UNFOLD x 2) is used instead of (ITIMES x 2)") [COND [(IGREATERP 0 D) (SETQ X (ADD1 X)) @@ -2254,17 +2249,16 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (\DRAWARC.GENERIC STREAM CENTERX CENTERY RADIUS STARTANGLE NDEGREES BRUSH DASHING]) (\DRAWARC.GENERIC - [LAMBDA (STREAM CENTERX CENTERY RADIUS STARTANGLE NDEGREES BRUSH DASHING) + [LAMBDA (STREAM CENTERX CENTERY RADIUS STARTANGLE NDEGREES BRUSH DASHING) (* rrb " 4-Oct-85 18:23") - (* ; - "draws an arc by drawing a curve.") + (* ; "draws an arc by drawing a curve.") (COND ((AND (GREATERP 360 NDEGREES) (LESSP -360 NDEGREES)) (DRAWCURVE (\COMPUTE.ARC.POINTS CENTERX CENTERY RADIUS STARTANGLE NDEGREES) NIL BRUSH DASHING STREAM)) (T (* ; - "use circle drawing which could be faster") + "use circle drawing which could be faster") (DRAWCIRCLE CENTERX CENTERY RADIUS BRUSH DASHING STREAM]) (\COMPUTE.ARC.POINTS @@ -2286,7 +2280,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (IMIN (IMAX (ABS (FIX (FQUOTIENT ANGLESIZE 10.0))) 5) (PROGN (* ; - "don't have more than a knot every 5 pts") + "don't have more than a knot every 5 pts") (IMAX (ABS (FIX (QUOTIENT (TIMES RADIUS 6.3 (QUOTIENT ANGLESIZE 360.0)) @@ -2295,14 +2289,11 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (* ;; "go from initial point to just past the last point. The just past (PLUS BETA (QUOTIENT ANGLEINCR 5.0)) picks up the case where the floating pt rounding error accumulates to be greater than the last point when it is very close to it.") - (RETURN (for ANGLE from STARTANGLE to (PLUS STARTANGLE ANGLESIZE - (QUOTIENT ANGLEINCR 5.0)) + (RETURN (for ANGLE from STARTANGLE to (PLUS STARTANGLE ANGLESIZE (QUOTIENT ANGLEINCR 5.0)) by ANGLEINCR collect (create POSITION - XCOORD _ [FIXR (PLUS CENTERX - (TIMES RADIUS + XCOORD _ [FIXR (PLUS CENTERX (TIMES RADIUS (COS ANGLE] - YCOORD _ (FIXR (PLUS CENTERY - (TIMES RADIUS + YCOORD _ (FIXR (PLUS CENTERY (TIMES RADIUS (SIN ANGLE]) (\DRAWELLIPSE.DISPLAY @@ -2371,11 +2362,11 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (COND (USERFN (* ; - "if calling user fn, don't bother with set up and leave points in window coordinates.") + "if calling user fn, don't bother with set up and leave points in window coordinates.") (SETQ CX CENTERX) (SETQ CY CENTERY)) (T (.SETUP.FOR.\BBTCURVEPT.) (* ; - "take into account the brush thickness.") + "take into account the brush thickness.") (SELECTQ NBITS (1 (SETQ CX (\DSPTRANSFORMX (IDIFFERENCE CENTERX (FOLDLO BRUSHWIDTH 2)) @@ -2554,7 +2545,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (GO DIAGONAL]) (\DRAWCURVE.DISPLAY - [LAMBDA (DISPLAYSTREAM KNOTS CLOSED BRUSH DASHING) (* ; "Edited 9-Jan-87 16:49 by rrb") + [LAMBDA (DISPLAYSTREAM KNOTS CLOSED BRUSH DASHING) (* ; "Edited 9-Jan-87 16:49 by rrb") (* ;; "draws a spline curve with a given brush.") @@ -2562,15 +2553,14 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DASHLST (\GOOD.DASHLST DASHING BRUSH))) (SELECTQ (LENGTH KNOTS) (0 (* ; - "No knots => empty curve rather than error?") + "No knots => empty curve rather than error?") NIL) (1 (* ; - "only one knot, put down a brush shape") + "only one knot, put down a brush shape") (OR (type? POSITION (CAR KNOTS)) (ERROR "bad knot" (CAR KNOTS))) (\DRAWPOINT.DISPLAY DISPLAYSTREAM (fetch XCOORD - of - (CAR KNOTS)) + of (CAR KNOTS)) (fetch YCOORD of (CAR KNOTS)) BRUSH)) (2 (OR (type? POSITION (CAR KNOTS)) @@ -2587,16 +2577,17 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (RETURN DISPLAYSTREAM]) (\DRAWPOINT.DISPLAY - [LAMBDA (DISPLAYSTREAM X Y BRUSH OPERATION) (* rrb "17-Sep-86 17:51") + [LAMBDA (DISPLAYSTREAM X Y BRUSH OPERATION) (* rrb "17-Sep-86 17:51") (* ;; "draws a brush point at position X Y") (* ;; "this is used in 4, 8, and 24 bit per pixel bitmaps as well. For these, it may be should call BITMAPWIDTH instead of fetching.") - (PROG ((BRUSHBM (\GETBRUSH BRUSH))) (* ; - "SUB1 is to put extra bit of even brush on the top or left.") - (RETURN (BITBLT BRUSHBM 0 0 DISPLAYSTREAM [IDIFFERENCE X (HALF (SUB1 (fetch - (BITMAP BITMAPWIDTH) + (PROG ((BRUSHBM (\GETBRUSH BRUSH))) (* ; + "SUB1 is to put extra bit of even brush on the top or left.") + (RETURN (BITBLT BRUSHBM 0 0 DISPLAYSTREAM [IDIFFERENCE X (HALF (SUB1 (fetch (BITMAP + BITMAPWIDTH + ) of BRUSHBM] [IDIFFERENCE Y (HALF (SUB1 (fetch (BITMAP BITMAPHEIGHT) of BRUSHBM] NIL NIL NIL (SELECTQ (OR OPERATION (DSPOPERATION NIL DISPLAYSTREAM)) @@ -2604,7 +2595,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation OPERATION]) (\DRAWPOLYGON.DISPLAY - [LAMBDA (STREAM POINTS CLOSED BRUSH DASHING) (* ; "Edited 13-Apr-88 14:14 by FS") + [LAMBDA (STREAM POINTS CLOSED BRUSH DASHING) (* ; "Edited 13-Apr-88 14:14 by FS") (* ;; "Somewhat less generic version of drawpolygon that calls \drawline.display. Brush must be a brush (guaranteed in DRAWPOLYGON) other users must also ensure.") @@ -2616,41 +2607,36 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation BRUSH) (T (create BRUSH using BRUSH BRUSHSHAPE _ 'ROUND] (SETQ COLOR (fetch (BRUSH BRUSHCOLOR) of PTBRUSH)) - (for PTAIL on POINTS while (CDR PTAIL) do (\DRAWLINE.DISPLAY - STREAM - (fetch (POSITION XCOORD) - of (CAR PTAIL)) - (ffetch (POSITION YCOORD) - of (CAR PTAIL)) - (fetch (POSITION XCOORD) - of (CADR PTAIL)) - (ffetch (POSITION YCOORD) - of (CADR PTAIL)) - (fetch (BRUSH BRUSHSIZE) - of BRUSH) - NIL COLOR DASHING) - (* ; - "put a brush between lines so it looks better. It's not mitered this way but better than not.") - (\DRAWPOINT.DISPLAY - STREAM - (fetch (POSITION XCOORD) - of (CADR POINTS)) - (fetch (POSITION YCOORD) - of (CADR POINTS)) - PTBRUSH - 'NIL) - finally (COND - ((AND CLOSED (CDDR POINTS)) (* ; "draw the closing line.") - (\DRAWLINE.DISPLAY STREAM (fetch (POSITION XCOORD) + (for PTAIL on POINTS while (CDR PTAIL) do (\DRAWLINE.DISPLAY STREAM (fetch (POSITION XCOORD + ) + of (CAR PTAIL)) + (ffetch (POSITION YCOORD) of (CAR PTAIL)) - (ffetch (POSITION YCOORD) of (CAR PTAIL)) - (fetch (POSITION XCOORD) of (CAR POINTS)) - (ffetch (POSITION YCOORD) of (CAR POINTS)) - (fetch (BRUSH BRUSHSIZE) of BRUSH) - NIL COLOR DASHING))) + (fetch (POSITION XCOORD) + of (CADR PTAIL)) + (ffetch (POSITION YCOORD) + of (CADR PTAIL)) + (fetch (BRUSH BRUSHSIZE) of BRUSH) + NIL COLOR DASHING) + (* ; + "put a brush between lines so it looks better. It's not mitered this way but better than not.") + (\DRAWPOINT.DISPLAY STREAM (fetch (POSITION + XCOORD) + of (CADR POINTS)) + (fetch (POSITION YCOORD) + of (CADR POINTS)) + PTBRUSH + 'NIL) + finally (COND + ((AND CLOSED (CDDR POINTS)) (* ; "draw the closing line.") + (\DRAWLINE.DISPLAY STREAM (fetch (POSITION XCOORD) of (CAR PTAIL)) + (ffetch (POSITION YCOORD) of (CAR PTAIL)) + (fetch (POSITION XCOORD) of (CAR POINTS)) + (ffetch (POSITION YCOORD) of (CAR POINTS)) + (fetch (BRUSH BRUSHSIZE) of BRUSH) + NIL COLOR DASHING))) (OR (NULL (CDR POINTS)) - (\DRAWPOINT.DISPLAY STREAM (fetch (POSITION XCOORD) - of (CAR POINTS)) + (\DRAWPOINT.DISPLAY STREAM (fetch (POSITION XCOORD) of (CAR POINTS)) (fetch (POSITION YCOORD) of (CAR POINTS)) PTBRUSH NIL]) @@ -2674,13 +2660,13 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (* ;; "many of these variables are used by the macro for \CURVEPT that passes them to \BBTCURVEPT and .SETUP.FOR.\BBTCURVEPT. sets them up.") (* ; - "move the display stream position before the coordinates are clobbered.") + "move the display stream position before the coordinates are clobbered.") (COND ((NOT USERFN) (.SETUP.FOR.\BBTCURVEPT.) (SELECTQ NBITS (1 (* ; - "SUB1 is so that the extra bit goes on the top and right as it is documented as doing for lines.") + "SUB1 is so that the extra bit goes on the top and right as it is documented as doing for lines.") (SETQ X1 (\DSPTRANSFORMX (IDIFFERENCE X1 (SETQ HALFBRUSHWIDTH (FOLDLO (SUB1 BRUSHWIDTH) 2))) @@ -2703,14 +2689,14 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation ) 2))) DISPLAYDATA)) (* ; - "take into account the brush thickness.") + "take into account the brush thickness.") (SETQ Y2 (\DSPTRANSFORMY (IDIFFERENCE Y2 HALFBRUSHHEIGHT) DISPLAYDATA)) (* ;; "Move the window to top while interruptable, but verify that it is still there uninterruptably with drawing points") (\INSURETOPWDS DISPLAYSTREAM))) (* ; - "arrange things so that dx is positive.") + "arrange things so that dx is positive.") (COND ((IGREATERP X1 X2) (* ; "switch points") (swap X1 X2) @@ -2724,18 +2710,70 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (IDIFFERENCE Y1 Y2] [SETQ CDL (HALF (COND ((IGREATERP DX DY) (* ; - "set up the bucket so that the ends will be the same.") + "set up the bucket so that the ends will be the same.") (IREMAINDER DX DY)) (T (IREMAINDER DY DX] [COND [USERFN (* ; - "if user function is being called, don't bother bringing window to top uninterruptably.") + "if user function is being called, don't bother bringing window to top uninterruptably.") (COND ((IGEQ DX DY) (* ; "X is the fastest mover.") (until (IGREATERP X1 X2) - do (* ; "main loop") + do (* ; "main loop") + (COND + (DASHON (APPLY* USERFN X1 Y1 DISPLAYSTREAM))) + [COND + (DASHTAIL (* ; "do dashing.") + (COND + ((EQ 0 (SETQ DASHCNT (SUB1 DASHCNT))) + (SETQ DASHON (NOT DASHON)) + (SETQ DASHTAIL (OR (LISTP (CDR DASHTAIL)) + DASHLST)) + (SETQ DASHCNT (CAR DASHTAIL] + [COND + ((NOT (IGREATERP DX (add CDL DY))) + (add Y1 YINC) + (COND + ((COND + ((EQ YINC -1) + (ILESSP Y1 Y2)) + ((IGREATERP Y1 Y2))) + (RETURN))) + (SETQ CDL (IDIFFERENCE CDL DX] + (add X1 1))) + (T (* ; "Y is the fastest mover.") + (until (COND + ((EQ YINC -1) + (ILESSP Y1 Y2)) + ((IGREATERP Y1 Y2))) + do (* ; "main loop") + (COND + (DASHON (APPLY* USERFN X1 Y1 DISPLAYSTREAM))) + [COND + (DASHTAIL (* ; "do dashing.") + (COND + ((EQ 0 (SETQ DASHCNT (SUB1 DASHCNT))) + (SETQ DASHON (NOT DASHON)) + (SETQ DASHTAIL (OR (LISTP (CDR DASHTAIL)) + DASHLST)) + (SETQ DASHCNT (CAR DASHTAIL] + [COND + ([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX] + (COND + ((IGREATERP (SETQ X1 (ADD1 X1)) + X2) + (RETURN))) + (SETQ CDL (IDIFFERENCE CDL DY] + (add Y1 YINC] + (T (* ; + "when we put the points down make it uninterruptable") + (.WHILE.TOP.DS. DISPLAYSTREAM + (COND + [(IGEQ DX DY) (* ; "X is the fastest mover.") + (until (IGREATERP X1 X2) + do (* ; "main loop") (COND - (DASHON (APPLY* USERFN X1 Y1 DISPLAYSTREAM))) + (DASHON (\CURVEPT X1 Y1))) [COND (DASHTAIL (* ; "do dashing.") (COND @@ -2745,8 +2783,8 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation DASHLST)) (SETQ DASHCNT (CAR DASHTAIL] [COND - ((NOT (IGREATERP DX (add CDL DY))) - (add Y1 YINC) + ([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY] + (SETQ Y1 (IPLUS Y1 YINC)) (COND ((COND ((EQ YINC -1) @@ -2754,15 +2792,15 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation ((IGREATERP Y1 Y2))) (RETURN))) (SETQ CDL (IDIFFERENCE CDL DX] - (add X1 1))) - (T (* ; "Y is the fastest mover.") - (until (COND - ((EQ YINC -1) - (ILESSP Y1 Y2)) - ((IGREATERP Y1 Y2))) - do (* ; "main loop") + (SETQ X1 (ADD1 X1] + (T (* ; "Y is the fastest mover.") + (until (COND + ((EQ YINC -1) + (ILESSP Y1 Y2)) + ((IGREATERP Y1 Y2))) + do (* ; "main loop") (COND - (DASHON (APPLY* USERFN X1 Y1 DISPLAYSTREAM))) + (DASHON (\CURVEPT X1 Y1))) [COND (DASHTAIL (* ; "do dashing.") (COND @@ -2778,65 +2816,13 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation X2) (RETURN))) (SETQ CDL (IDIFFERENCE CDL DY] - (add Y1 YINC] - (T (* ; - "when we put the points down make it uninterruptable") - (.WHILE.TOP.DS. DISPLAYSTREAM - (COND - [(IGEQ DX DY) (* ; "X is the fastest mover.") - (until (IGREATERP X1 X2) - do (* ; "main loop") - (COND - (DASHON (\CURVEPT X1 Y1))) - [COND - (DASHTAIL (* ; "do dashing.") - (COND - ((EQ 0 (SETQ DASHCNT (SUB1 DASHCNT))) - (SETQ DASHON (NOT DASHON)) - (SETQ DASHTAIL (OR (LISTP (CDR DASHTAIL)) - DASHLST)) - (SETQ DASHCNT (CAR DASHTAIL] - [COND - ([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY] - (SETQ Y1 (IPLUS Y1 YINC)) - (COND - ((COND - ((EQ YINC -1) - (ILESSP Y1 Y2)) - ((IGREATERP Y1 Y2))) - (RETURN))) - (SETQ CDL (IDIFFERENCE CDL DX] - (SETQ X1 (ADD1 X1] - (T (* ; "Y is the fastest mover.") - (until (COND - ((EQ YINC -1) - (ILESSP Y1 Y2)) - ((IGREATERP Y1 Y2))) - do (* ; "main loop") - (COND - (DASHON (\CURVEPT X1 Y1))) - [COND - (DASHTAIL (* ; "do dashing.") - (COND - ((EQ 0 (SETQ DASHCNT (SUB1 DASHCNT))) - (SETQ DASHON (NOT DASHON)) - (SETQ DASHTAIL (OR (LISTP (CDR DASHTAIL)) - DASHLST)) - (SETQ DASHCNT (CAR DASHTAIL] - [COND - ([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX] - (COND - ((IGREATERP (SETQ X1 (ADD1 X1)) - X2) - (RETURN))) - (SETQ CDL (IDIFFERENCE CDL DY] - (SETQ Y1 (IPLUS Y1 YINC] + (SETQ Y1 (IPLUS Y1 YINC] (RETURN NIL]) ) (DEFINEQ (LOADPOLY - [LAMBDA (POLY POLYPRIME A B C D) (* hdj "13-Mar-85 18:01") + [LAMBDA (POLY POLYPRIME A B C D) (* hdj "13-Mar-85 18:01") (replace (POLYNOMIAL A) of POLY with (FQUOTIENT A 6.0)) (replace (POLYNOMIAL B) of POLY with (FQUOTIENT B 2.0)) (replace (POLYNOMIAL C) of POLY with C) @@ -2846,7 +2832,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (replace (POLYNOMIAL C) of POLYPRIME with C]) (PARAMETRICSPLINE - [LAMBDA (KNOTS CLOSEDFLG SPLINE) (* rmk%: "30-Nov-84 17:02") + [LAMBDA (KNOTS CLOSEDFLG SPLINE) (* rmk%: "30-Nov-84 17:02") (* ;; "KNOTS is a non-NIL list of knots, CLOSEDFLG => closed curve") @@ -2863,11 +2849,10 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (SETQ DDDY (ARRAY %#KNOTS 0 0.0)) (SETQ X (ARRAY %#KNOTS 0 0.0)) (SETQ Y (ARRAY %#KNOTS 0 0.0)) - (for KNOT in KNOTS as I from 1 to %#KNOTS - do (OR (type? POSITION KNOT) - (ERROR "bad knot" KNOT)) - (SETA X I (CAR KNOT)) - (SETA Y I (CDR KNOT))) + (for KNOT in KNOTS as I from 1 to %#KNOTS do (OR (type? POSITION KNOT) + (ERROR "bad knot" KNOT)) + (SETA X I (CAR KNOT)) + (SETA Y I (CDR KNOT))) (SETQ A (ARRAY %#KNOTS 0 0.0)) (SETQ BX (ARRAY %#KNOTS 0 0.0)) (SETQ BY (ARRAY %#KNOTS 0 0.0)) @@ -2883,7 +2868,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (CLOSEDFLG (SETA C 1 1.0) (for I from 2 to (IDIFFERENCE %#KNOTS 2) do (SETA C I (FMINUS (FQUOTIENT (ELT C (SUB1 I)) - (ELT A (SUB1 I] + (ELT A (SUB1 I] [COND ((IGEQ %#KNOTS 3) (COND @@ -2895,19 +2880,19 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (ELT Y (SUB1 %#KNOTS] [for I from 2 to (IDIFFERENCE %#KNOTS 2) do [SETA BX I (FDIFFERENCE [FTIMES 6.0 - (FPLUS (ELT X (ADD1 I)) - (FMINUS (FTIMES 2.0 - (ELT X I))) - (ELT X (SUB1 I] - (FQUOTIENT (ELT BX (SUB1 I)) - (ELT A (SUB1 I] - (SETA BY I (FDIFFERENCE [FTIMES 6.0 - (FPLUS (ELT Y (ADD1 I)) - (FMINUS (FTIMES 2.0 - (ELT Y I))) - (ELT Y (SUB1 I] - (FQUOTIENT (ELT BY (SUB1 I)) - (ELT A (SUB1 I] + (FPLUS (ELT X (ADD1 I)) + (FMINUS (FTIMES 2.0 + (ELT X I))) + (ELT X (SUB1 I] + (FQUOTIENT (ELT BX (SUB1 I)) + (ELT A (SUB1 I] + (SETA BY I (FDIFFERENCE [FTIMES 6.0 + (FPLUS (ELT Y (ADD1 I)) + (FMINUS (FTIMES 2.0 + (ELT Y I))) + (ELT Y (SUB1 I] + (FQUOTIENT (ELT BY (SUB1 I)) + (ELT A (SUB1 I] (SETA R (SUB1 %#KNOTS) 1.0) (SETA SX (SUB1 %#KNOTS) @@ -2916,14 +2901,14 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation 0.0) (for I from (IDIFFERENCE %#KNOTS 2) to 1 by -1 do [SETA R I (FMINUS (FQUOTIENT (FPLUS (ELT R (ADD1 I)) - (ELT C I)) - (ELT A I] - (SETA SX I (FQUOTIENT (FDIFFERENCE (ELT BX I) - (ELT SX (ADD1 I))) - (ELT A I))) - (SETA SY I (FQUOTIENT (FDIFFERENCE (ELT BY I) - (ELT SY (ADD1 I))) - (ELT A I] + (ELT C I)) + (ELT A I] + (SETA SX I (FQUOTIENT (FDIFFERENCE (ELT BX I) + (ELT SX (ADD1 I))) + (ELT A I))) + (SETA SY I (FQUOTIENT (FDIFFERENCE (ELT BY I) + (ELT SY (ADD1 I))) + (ELT A I] (T [SETA BX 1 (FTIMES 6.0 (FPLUS (FDIFFERENCE (ELT X 3) (FTIMES 2.0 (ELT X 2))) (ELT X 1] @@ -2931,20 +2916,20 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (FTIMES 2.0 (ELT Y 2))) (ELT Y 1] (for I from 2 to (IDIFFERENCE %#KNOTS 2) - do [SETA BX I (FDIFFERENCE (FTIMES - 6.0 - (FPLUS [FDIFFERENCE (ELT X (IPLUS I 2)) - (FTIMES 2 (ELT X (ADD1 I] - (ELT X I))) - (FQUOTIENT (ELT BX (SUB1 I)) - (ELT A (SUB1 I] - (SETA BY I (FDIFFERENCE (FTIMES 6.0 - (FPLUS [FDIFFERENCE - (ELT Y (IPLUS I 2)) - (FTIMES 2 (ELT Y (ADD1 I] - (ELT Y I))) - (FQUOTIENT (ELT BY (SUB1 I)) - (ELT A (SUB1 I] + do [SETA BX I (FDIFFERENCE (FTIMES 6.0 + (FPLUS [FDIFFERENCE + (ELT X (IPLUS I 2)) + (FTIMES 2 (ELT X (ADD1 I] + (ELT X I))) + (FQUOTIENT (ELT BX (SUB1 I)) + (ELT A (SUB1 I] + (SETA BY I (FDIFFERENCE (FTIMES 6.0 + (FPLUS [FDIFFERENCE + (ELT Y (IPLUS I 2)) + (FTIMES 2 (ELT Y (ADD1 I] + (ELT Y I))) + (FQUOTIENT (ELT BY (SUB1 I)) + (ELT A (SUB1 I] [COND (CLOSEDFLG [SETQ D2X (FPLUS (ELT X %#KNOTS) [FMINUS (FTIMES 2.0 (ELT X (SUB1 %#KNOTS] @@ -2968,38 +2953,38 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation 4.0))) [for I from 1 to (IDIFFERENCE %#KNOTS 2) do [SETA DDX I (FPLUS (ELT SX I) - (FTIMES (ELT R I) - (ELT DDX (SUB1 %#KNOTS] - (SETA DDY I (FPLUS (ELT SY I) - (FTIMES (ELT R I) - (ELT DDY (SUB1 %#KNOTS] + (FTIMES (ELT R I) + (ELT DDX (SUB1 %#KNOTS] + (SETA DDY I (FPLUS (ELT SY I) + (FTIMES (ELT R I) + (ELT DDY (SUB1 %#KNOTS] (SETA DDX %#KNOTS (ELT DDX 1)) (SETA DDY %#KNOTS (ELT DDY 1))) (T (* ; "COMPUTE SECOND DERIVATIVES.") [SETA DDX 1 (SETA DDY 1 (SETA DDX %#KNOTS (SETA DDY %#KNOTS 0.0] (for I from (SUB1 %#KNOTS) to 2 by -1 do [SETA DDX I (FQUOTIENT (FDIFFERENCE (ELT BX (SUB1 I)) - (ELT DDX (ADD1 I))) - (ELT A (SUB1 I] - (SETA DDY I (FQUOTIENT (FDIFFERENCE (ELT BY (SUB1 I)) - (ELT DDY (ADD1 I))) - (ELT A (SUB1 I] + (ELT DDX (ADD1 I))) + (ELT A (SUB1 I] + (SETA DDY I (FQUOTIENT (FDIFFERENCE (ELT BY (SUB1 I)) + (ELT DDY (ADD1 I))) + (ELT A (SUB1 I] [for I from 1 to (SUB1 %#KNOTS) - do (* ; "COMPUTE 1ST & 3RD DERIVATIVES") - (SETA DX I (FDIFFERENCE (FDIFFERENCE (ELT X (ADD1 I)) - (ELT X I)) - (FQUOTIENT (FPLUS (FTIMES 2 (ELT DDX I)) - (ELT DDX (ADD1 I))) - 6.0))) - (SETA DY I (FDIFFERENCE (FDIFFERENCE (ELT Y (ADD1 I)) - (ELT Y I)) - (FQUOTIENT (FPLUS (FTIMES 2 (ELT DDY I)) - (ELT DDY (ADD1 I))) - 6.0))) - (SETA DDDX I (FDIFFERENCE (ELT DDX (ADD1 I)) - (ELT DDX I))) - (SETA DDDY I (FDIFFERENCE (ELT DDY (ADD1 I)) - (ELT DDY I] + do (* ; "COMPUTE 1ST & 3RD DERIVATIVES") + (SETA DX I (FDIFFERENCE (FDIFFERENCE (ELT X (ADD1 I)) + (ELT X I)) + (FQUOTIENT (FPLUS (FTIMES 2 (ELT DDX I)) + (ELT DDX (ADD1 I))) + 6.0))) + (SETA DY I (FDIFFERENCE (FDIFFERENCE (ELT Y (ADD1 I)) + (ELT Y I)) + (FQUOTIENT (FPLUS (FTIMES 2 (ELT DDY I)) + (ELT DDY (ADD1 I))) + 6.0))) + (SETA DDDX I (FDIFFERENCE (ELT DDX (ADD1 I)) + (ELT DDX I))) + (SETA DDDY I (FDIFFERENCE (ELT DDY (ADD1 I)) + (ELT DDY I] (SETQ SPLINE (create SPLINE %#KNOTS _ %#KNOTS @@ -3014,7 +2999,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (RETURN SPLINE]) (\CURVE - [LAMBDA (X0 Y0 X1 Y1 DX DY DDX DDY DDDX DDDY N BRUSHBM DISPLAYDATA BBT ENDING USERFN DISPLAYSTREAM) + [LAMBDA (X0 Y0 X1 Y1 DX DY DDX DDY DDDX DDDY N BRUSHBM DISPLAYDATA BBT ENDING USERFN DISPLAYSTREAM) (* rrb "30-Apr-85 12:44") (DECLARE (LOCALVARS . T)) @@ -3025,7 +3010,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation ((NEQ N 0) [COND (USERFN (* ; - "if there is a user fn, stay in his coordinates.") + "if there is a user fn, stay in his coordinates.") (SETQ OLDX X0) (SETQ OLDY Y0)) (T @@ -3038,7 +3023,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation 1)) DISPLAYDATA] (* ; "draw origin point") (\CURVESMOOTH OLDX OLDY USERFN DISPLAYSTREAM) (* ; - "convert the derivatives to fractional representation.") + "convert the derivatives to fractional representation.") (* ;; "\CONVERTTOFRACTION always returns a large number box. This uses 0.49 because 0.5 causes rounding up.") @@ -3050,45 +3035,37 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (SETQ DDY (\CONVERTTOFRACTION DDY)) (SETQ DDDX (\CONVERTTOFRACTION DDDX)) (SETQ DDDY (\CONVERTTOFRACTION DDDY)) - [for I from 1 to N do (* ; - "uses \BOXIPLUS to save box and also set the new value of the variable.") - (\BOXIPLUS X DX) - (\BOXIPLUS DX DDX) - (\BOXIPLUS DDX DDDX) - (\BOXIPLUS Y DY) - (\BOXIPLUS DY DDY) - (\BOXIPLUS DDY DDDY) - (SETQ OOLDX OLDX) - (SETQ OOLDY OLDY) - (SETQ DELTAX (IDIFFERENCE (SETQ OLDX ( - \GETINTEGERPART - X)) - OOLDX)) - (SETQ DELTAY (IDIFFERENCE (SETQ OLDY ( - \GETINTEGERPART - Y)) - OOLDY)) - (SETQ DELTA (IMAX (IABS DELTAX) - (IABS DELTAY))) - (COND - ((EQ DELTA 1) - (\CURVESMOOTH OLDX OLDY USERFN DISPLAYSTREAM)) - ) - (COND - ((IGREATERP DELTA 1) - (SETQ DELTAX (\CONVERTTOFRACTION - (FQUOTIENT DELTAX DELTA))) - (SETQ DELTAY (\CONVERTTOFRACTION - (FQUOTIENT DELTAY DELTA))) - (SETQ TX (\CONVERTTOFRACTION OOLDX)) - (SETQ TY (\CONVERTTOFRACTION OOLDY)) - (for I from 0 to DELTA - do (\CURVESMOOTH (\GETINTEGERPART - TX) - (\GETINTEGERPART TY) - USERFN DISPLAYSTREAM) - (\BOXIPLUS TX DELTAX) - (\BOXIPLUS TY DELTAY] + [for I from 1 to N do (* ; + "uses \BOXIPLUS to save box and also set the new value of the variable.") + (\BOXIPLUS X DX) + (\BOXIPLUS DX DDX) + (\BOXIPLUS DDX DDDX) + (\BOXIPLUS Y DY) + (\BOXIPLUS DY DDY) + (\BOXIPLUS DDY DDDY) + (SETQ OOLDX OLDX) + (SETQ OOLDY OLDY) + (SETQ DELTAX (IDIFFERENCE (SETQ OLDX (\GETINTEGERPART X)) + OOLDX)) + (SETQ DELTAY (IDIFFERENCE (SETQ OLDY (\GETINTEGERPART Y)) + OOLDY)) + (SETQ DELTA (IMAX (IABS DELTAX) + (IABS DELTAY))) + (COND + ((EQ DELTA 1) + (\CURVESMOOTH OLDX OLDY USERFN DISPLAYSTREAM))) + (COND + ((IGREATERP DELTA 1) + (SETQ DELTAX (\CONVERTTOFRACTION (FQUOTIENT DELTAX DELTA))) + (SETQ DELTAY (\CONVERTTOFRACTION (FQUOTIENT DELTAY DELTA))) + (SETQ TX (\CONVERTTOFRACTION OOLDX)) + (SETQ TY (\CONVERTTOFRACTION OOLDY)) + (for I from 0 to DELTA do (\CURVESMOOTH (\GETINTEGERPART + TX) + (\GETINTEGERPART TY) + USERFN DISPLAYSTREAM) + (\BOXIPLUS TX DELTAX) + (\BOXIPLUS TY DELTAY] (* ; "draw the end point") (COND (USERFN (\CURVESMOOTH X1 Y1 USERFN DISPLAYSTREAM)) @@ -3110,7 +3087,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (RETURN NIL]) (\CURVE2 - [LAMBDA (SPLINE BRUSH DASHLST BBT DISPLAYSTREAM) (* jds "26-Nov-85 12:21") + [LAMBDA (SPLINE BRUSH DASHLST BBT DISPLAYSTREAM) (* jds "26-Nov-85 12:21") (* ;;; "Given a spline curve, represented as a set of derivatives for each segment, draw it on DISPLAYSTREAM using the brush BRUSH, and dashing it according to DASHLST. For speed, use the bitblt table BBT.") @@ -3137,21 +3114,20 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation [COND (USERFN (* ; - "if calling user fn, don't bother with set up and leave points in window coordinates.") + "if calling user fn, don't bother with set up and leave points in window coordinates.") (\CURVESTART (ELT (fetch (SPLINE SPLINEX) of SPLINE) - 1) + 1) (ELT (fetch (SPLINE SPLINEY) of SPLINE) 1))) (T (.SETUP.FOR.\BBTCURVEPT.) (* ; - "Do it interruptably here to get set up, then uninterruptably when drawing points") + "Do it interruptably here to get set up, then uninterruptably when drawing points") (\INSURETOPWDS DISPLAYSTREAM) (* ; - "curve pts will be kept in screen coordinates, start smoothing values there.") - (\CURVESTART (\DSPTRANSFORMX (IDIFFERENCE (ELT (fetch (SPLINE SPLINEX) - of SPLINE) - 1) - (LRSH (SUB1 BRUSHWIDTH) - 1)) - DISPLAYDATA) + "curve pts will be kept in screen coordinates, start smoothing values there.") + (\CURVESTART (\DSPTRANSFORMX (IDIFFERENCE (ELT (fetch (SPLINE SPLINEX) of SPLINE) + 1) + (LRSH (SUB1 BRUSHWIDTH) + 1)) + DISPLAYDATA) (\DSPTRANSFORMY (IDIFFERENCE (ELT (fetch (SPLINE SPLINEY) of SPLINE) 1) (LRSH (SUB1 BRUSHHEIGHT) @@ -3159,135 +3135,131 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation DISPLAYDATA] [bind PERSEG for KNOT from 1 to (SUB1 (fetch %#KNOTS of SPLINE)) when (PROGN - (* ;; - "Loop thru the segments of the spline curve, drawing each in turn.") + (* ;; "Loop thru the segments of the spline curve, drawing each in turn.") - (SETQ X0 (ELT (fetch (SPLINE SPLINEX) of SPLINE) - KNOT)) (* ; - "Set up X0,Y0 -- the starting point of this segment") - (SETQ Y0 (ELT (fetch (SPLINE SPLINEY) of SPLINE) - KNOT)) - (SETQ X1 (ELT (fetch (SPLINE SPLINEX) of SPLINE) - (ADD1 KNOT))) (* ; "And X1,Y1 -- the ending point") - (SETQ Y1 (ELT (fetch (SPLINE SPLINEY) of SPLINE) - (ADD1 KNOT))) - (SETQ DX (ELT (fetch (SPLINE SPLINEDX) of SPLINE) - KNOT)) (* ; - "And the initial derivatives -- first") - (SETQ DY (ELT (fetch (SPLINE SPLINEDY) of SPLINE) - KNOT)) - (SETQ DDX (ELT (fetch SPLINEDDX of SPLINE) - KNOT)) (* ; "Second") - (SETQ DDY (ELT (fetch SPLINEDDY of SPLINE) - KNOT)) - (SETQ DDDX (ELT (fetch SPLINEDDDX of SPLINE) - KNOT)) (* ; "And third.") - (SETQ DDDY (ELT (fetch SPLINEDDDY of SPLINE) - KNOT)) - (SETQ NPOINTS (FOLDLO (ITIMES (IMAX (IABS (IDIFFERENCE X1 X0)) - (IABS (IDIFFERENCE Y1 Y0))) - 3) - 2)) + (SETQ X0 (ELT (fetch (SPLINE SPLINEX) of SPLINE) + KNOT)) (* ; + "Set up X0,Y0 -- the starting point of this segment") + (SETQ Y0 (ELT (fetch (SPLINE SPLINEY) of SPLINE) + KNOT)) + (SETQ X1 (ELT (fetch (SPLINE SPLINEX) of SPLINE) + (ADD1 KNOT))) (* ; "And X1,Y1 -- the ending point") + (SETQ Y1 (ELT (fetch (SPLINE SPLINEY) of SPLINE) + (ADD1 KNOT))) + (SETQ DX (ELT (fetch (SPLINE SPLINEDX) of SPLINE) + KNOT)) (* ; + "And the initial derivatives -- first") + (SETQ DY (ELT (fetch (SPLINE SPLINEDY) of SPLINE) + KNOT)) + (SETQ DDX (ELT (fetch SPLINEDDX of SPLINE) + KNOT)) (* ; "Second") + (SETQ DDY (ELT (fetch SPLINEDDY of SPLINE) + KNOT)) + (SETQ DDDX (ELT (fetch SPLINEDDDX of SPLINE) + KNOT)) (* ; "And third.") + (SETQ DDDY (ELT (fetch SPLINEDDDY of SPLINE) + KNOT)) + (SETQ NPOINTS (FOLDLO (ITIMES (IMAX (IABS (IDIFFERENCE X1 X0)) + (IABS (IDIFFERENCE Y1 Y0))) + 3) + 2)) - (* ;; "Establish an upper bound on the number of points we'll draw while painting this segment. We know that 3/2 the maximum DX or DY is the right amount.") + (* ;; "Establish an upper bound on the number of points we'll draw while painting this segment. We know that 3/2 the maximum DX or DY is the right amount.") - (NOT (ZEROP NPOINTS))) + (NOT (ZEROP NPOINTS))) do + (* ;; "NPOINTS can be zero if a knot is duplicated in the spline curve to produce a discontinuity. Skip over zero-length segments to avoid divide-by-zero trouble") - (* ;; "NPOINTS can be zero if a knot is duplicated in the spline curve to produce a discontinuity. Skip over zero-length segments to avoid divide-by-zero trouble") + (* ;; "To prevent round-off errors from accumulating, we'll draw this segment as runs of no more than 64 points each -- recomputing completely at the start of each run. This is a trade off of speed and accuracy.") - (* ;; "To prevent round-off errors from accumulating, we'll draw this segment as runs of no more than 64 points each -- recomputing completely at the start of each run. This is a trade off of speed and accuracy.") - - [COND - ((ILEQ NPOINTS 64) (* ; - "Fewer than 64 points to draw. Do it in one run.") - (SETQ NSEGS 1) - (SETQ POINTSPERSEG NPOINTS)) - (T (* ; - "Figure out how many runs to do it in.") - (SETQ NSEGS (FOLDLO NPOINTS 64)) - (SETQ POINTSPERSEG 64) - (SETQ NPOINTS (UNFOLD NSEGS 64] - (SETQ D1 (FQUOTIENT 1.0 NPOINTS)) (* ; - "Set up &Et, &Et**2 and &Et**3, for computing the next point.") - (SETQ D2 (FTIMES D1 D1)) - (SETQ D3 (FTIMES D2 D1)) - (SETQ D3X (FTIMES D3 DDDX)) - (SETQ D3Y (FTIMES D3 DDDY)) - (COND - [(EQ NSEGS 1) (* ; "Just one segment to draw.") - [SETQ DX (FPLUS (FTIMES D1 DX) - (FTIMES DDX D2 0.5) - (FTIMES DDDX D3 (CONSTANT (FQUOTIENT 1.0 6.0] - (SETQ D2X (FPLUS (FTIMES D2 DDX) - (FTIMES D3 DDDX))) - [SETQ DY (FPLUS (FTIMES D1 DY) - (FTIMES D2 DDY 0.5) - (FTIMES D3 DDDY (CONSTANT (FQUOTIENT 1.0 6.0] - (SETQ D2Y (FPLUS (FTIMES D2 DDY) - (FTIMES D3 DDDY))) - (COND - (USERFN (* ; - "Draw this run of points, using the user's supplied function.") + [COND + ((ILEQ NPOINTS 64) (* ; + "Fewer than 64 points to draw. Do it in one run.") + (SETQ NSEGS 1) + (SETQ POINTSPERSEG NPOINTS)) + (T (* ; + "Figure out how many runs to do it in.") + (SETQ NSEGS (FOLDLO NPOINTS 64)) + (SETQ POINTSPERSEG 64) + (SETQ NPOINTS (UNFOLD NSEGS 64] + (SETQ D1 (FQUOTIENT 1.0 NPOINTS)) (* ; + "Set up &Et, &Et**2 and &Et**3, for computing the next point.") + (SETQ D2 (FTIMES D1 D1)) + (SETQ D3 (FTIMES D2 D1)) + (SETQ D3X (FTIMES D3 DDDX)) + (SETQ D3Y (FTIMES D3 DDDY)) + (COND + [(EQ NSEGS 1) (* ; "Just one segment to draw.") + [SETQ DX (FPLUS (FTIMES D1 DX) + (FTIMES DDX D2 0.5) + (FTIMES DDDX D3 (CONSTANT (FQUOTIENT 1.0 6.0] + (SETQ D2X (FPLUS (FTIMES D2 DDX) + (FTIMES D3 DDDX))) + [SETQ DY (FPLUS (FTIMES D1 DY) + (FTIMES D2 DDY 0.5) + (FTIMES D3 DDDY (CONSTANT (FQUOTIENT 1.0 6.0] + (SETQ D2Y (FPLUS (FTIMES D2 DDY) + (FTIMES D3 DDDY))) + (COND + (USERFN (* ; + "Draw this run of points, using the user's supplied function.") + (\CURVE X0 Y0 X1 Y1 DX DY D2X D2Y D3X D3Y NPOINTS BRUSHBM DISPLAYDATA + BBT NIL USERFN DISPLAYSTREAM)) + (T (* ; + "Draw this run of points, using the brush.") + (.WHILE.TOP.DS. DISPLAYSTREAM (\CURVE X0 Y0 X1 Y1 DX DY D2X D2Y D3X D3Y NPOINTS BRUSHBM - DISPLAYDATA BBT NIL USERFN DISPLAYSTREAM)) - (T (* ; - "Draw this run of points, using the brush.") - (.WHILE.TOP.DS. DISPLAYSTREAM - (\CURVE X0 Y0 X1 Y1 DX DY D2X D2Y D3X D3Y NPOINTS BRUSHBM - DISPLAYDATA BBT NIL NIL DISPLAYSTREAM] - (T (* ; - "Have to do this segment in several runs.") - (SETQ PERSEG (FQUOTIENT 1.0 NSEGS)) - (LOADPOLY XPOLY X/PRIME/POLY DDDX DDX DX X0) - (LOADPOLY YPOLY Y/PRIME/POLY DDDY DDY DY Y0) - (bind (TT _ 0.0) - (DDDX/PER/SEG _ (FTIMES DDDX PERSEG)) - (DDDY/PER/SEG _ (FTIMES DDDY PERSEG)) - [D3XFACTOR _ (FTIMES D3 DDDX (CONSTANT (FQUOTIENT 1.0 6.0] - [D3YFACTOR _ (FTIMES D3 DDDY (CONSTANT (FQUOTIENT 1.0 6.0] - for I from 0 to (SUB1 NSEGS) - do + DISPLAYDATA BBT NIL NIL DISPLAYSTREAM] + (T (* ; + "Have to do this segment in several runs.") + (SETQ PERSEG (FQUOTIENT 1.0 NSEGS)) + (LOADPOLY XPOLY X/PRIME/POLY DDDX DDX DX X0) + (LOADPOLY YPOLY Y/PRIME/POLY DDDY DDY DY Y0) + (bind (TT _ 0.0) + (DDDX/PER/SEG _ (FTIMES DDDX PERSEG)) + (DDDY/PER/SEG _ (FTIMES DDDY PERSEG)) + [D3XFACTOR _ (FTIMES D3 DDDX (CONSTANT (FQUOTIENT 1.0 6.0] + [D3YFACTOR _ (FTIMES D3 DDDY (CONSTANT (FQUOTIENT 1.0 6.0] for I + from 0 to (SUB1 NSEGS) + do + (* ;; + "TT is the parameter, and runs from 0 to 1 as the curve segment runs from beginning to end.") - (* ;; - "TT is the parameter, and runs from 0 to 1 as the curve segment runs from beginning to end.") - - (SETQ TT (FPLUS TT PERSEG)) - (SETQ X1 (POLYEVAL TT XPOLY 3)) - (SETQ Y1 (POLYEVAL TT YPOLY 3)) - (SETQ DX (FPLUS (FTIMES D1 DX) - (FTIMES D2 DDX 0.5) - D3XFACTOR)) - (SETQ D2X (FPLUS (FTIMES D2 DDX) - (FTIMES D3 DDDX))) - (SETQ DY (FPLUS (FTIMES D1 DY) - (FTIMES D2 DDY 0.5) - D3YFACTOR)) - (SETQ D2Y (FPLUS (FTIMES D2 DDY) - (FTIMES D3 DDDY))) - [COND - (USERFN (\CURVE X0 Y0 X1 Y1 DX DY D2X D2Y D3X D3Y 64 BRUSHBM - DISPLAYDATA BBT NIL USERFN DISPLAYSTREAM)) - (T (.WHILE.TOP.DS. DISPLAYSTREAM - (\CURVE X0 Y0 X1 Y1 DX DY D2X D2Y D3X D3Y 64 - BRUSHBM DISPLAYDATA BBT NIL NIL DISPLAYSTREAM] - (SETQ X0 X1) - (SETQ Y0 Y1) - (SETQ DDX (FPLUS DDX DDDX/PER/SEG)) - (SETQ DDY (FPLUS DDY DDDY/PER/SEG)) - (SETQ DX (POLYEVAL TT X/PRIME/POLY 2)) - (SETQ DY (POLYEVAL TT Y/PRIME/POLY 2] + (SETQ TT (FPLUS TT PERSEG)) + (SETQ X1 (POLYEVAL TT XPOLY 3)) + (SETQ Y1 (POLYEVAL TT YPOLY 3)) + (SETQ DX (FPLUS (FTIMES D1 DX) + (FTIMES D2 DDX 0.5) + D3XFACTOR)) + (SETQ D2X (FPLUS (FTIMES D2 DDX) + (FTIMES D3 DDDX))) + (SETQ DY (FPLUS (FTIMES D1 DY) + (FTIMES D2 DDY 0.5) + D3YFACTOR)) + (SETQ D2Y (FPLUS (FTIMES D2 DDY) + (FTIMES D3 DDDY))) + [COND + (USERFN (\CURVE X0 Y0 X1 Y1 DX DY D2X D2Y D3X D3Y 64 BRUSHBM + DISPLAYDATA BBT NIL USERFN DISPLAYSTREAM)) + (T (.WHILE.TOP.DS. DISPLAYSTREAM + (\CURVE X0 Y0 X1 Y1 DX DY D2X D2Y D3X D3Y 64 BRUSHBM + DISPLAYDATA BBT NIL NIL DISPLAYSTREAM] + (SETQ X0 X1) + (SETQ Y0 Y1) + (SETQ DDX (FPLUS DDX DDDX/PER/SEG)) + (SETQ DDY (FPLUS DDY DDDY/PER/SEG)) + (SETQ DX (POLYEVAL TT X/PRIME/POLY 2)) + (SETQ DY (POLYEVAL TT Y/PRIME/POLY 2] (* ;; "Draw the final point on the curve.") (COND - (USERFN (\CURVE 0 0 0 0 0 0 0 0 0 0 0 BRUSHBM DISPLAYDATA BBT T USERFN DISPLAYSTREAM - )) + (USERFN (\CURVE 0 0 0 0 0 0 0 0 0 0 0 BRUSHBM DISPLAYDATA BBT T USERFN DISPLAYSTREAM)) (T (.WHILE.TOP.DS. DISPLAYSTREAM (\CURVE 0 0 0 0 0 0 0 0 0 0 0 BRUSHBM DISPLAYDATA BBT T NIL DISPLAYSTREAM]) (\CURVEEND - [LAMBDA NIL (* rrb " 5-JAN-82 17:24") + [LAMBDA NIL (* rrb " 5-JAN-82 17:24") (* ;; "Put out the last two points, using \CURVEPT, since they were held back for smoothing.") @@ -3296,10 +3268,10 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DX (IDIFFERENCE \CURX \OLDX)) (DY (IDIFFERENCE \CURY \OLDY))) (for I from 1 to 2 do (\CURVESMOOTH (SETQ X (IPLUS X DX)) - (SETQ Y (IPLUS Y DY]) + (SETQ Y (IPLUS Y DY]) (\CURVESLOPE - [LAMBDA (KNOTS ENDFLG) (* rrb "30-Nov-84 18:17") + [LAMBDA (KNOTS ENDFLG) (* rrb "30-Nov-84 18:17") (* ;; "returns a CONS of DX DY that gives the slope of the curve thru KNOTS. If ENDFLG is NIL, it is at the beginning. If ENDFLG is T, it is at the last point.") @@ -3312,29 +3284,29 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DIFFERENCE (fetch (POSITION YCOORD) of (CADR KNOTS)) (fetch (POSITION YCOORD) of (CAR KNOTS]) (PROGN [SETQ PARAMS (COND - [ENDFLG (PARAMETRICSPLINE (REVERSE - (NLEFT KNOTS - (IMIN %#KNOTS 4] + [ENDFLG (PARAMETRICSPLINE (REVERSE (NLEFT KNOTS + (IMIN %#KNOTS + 4] (T (PARAMETRICSPLINE (COND - ((EQ %#KNOTS 3) - (LIST (CAR KNOTS) - (CADR KNOTS) - (CADDR KNOTS))) - (T (LIST (CAR KNOTS) - (CADR KNOTS) - (CADDR KNOTS) - (CADDDR KNOTS] + ((EQ %#KNOTS 3) + (LIST (CAR KNOTS) + (CADR KNOTS) + (CADDR KNOTS))) + (T (LIST (CAR KNOTS) + (CADR KNOTS) + (CADDR KNOTS) + (CADDDR KNOTS] (SETQ DX (ELT (fetch (SPLINE SPLINEDX) of PARAMS) 1)) (SETQ DY (ELT (fetch (SPLINE SPLINEDY) of PARAMS) 1)) (if ENDFLG then (CONS (MINUS DX) - (MINUS DY)) + (MINUS DY)) else (CONS DX DY]) (\CURVESTART - [LAMBDA (X Y) (* jds "27-OCT-81 15:48") + [LAMBDA (X Y) (* jds "27-OCT-81 15:48") (* ;; "Set up the init vals for \OLDER* \OLD* \CUR*, for curve smoothing in \CURVEPT.") @@ -3346,7 +3318,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (SETQ \CURY Y]) (\FDIFS/FROM/DERIVS - [LAMBDA (DZ DDZ DDDZ RAD NSTEPS) (* rrb "12-MAY-81 10:59") + [LAMBDA (DZ DDZ DDDZ RAD NSTEPS) (* rrb "12-MAY-81 10:59") (* ;; "the derivatives of the function, plus a scale factor (radius for drawing circles) See 'Spline Curve Techniques' , equations 2.18.") @@ -3366,11 +3338,10 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (ARRAYRECORD POLYNOMIAL (A B C D) - (CREATE (ARRAY 4 'FLOATP)) - (SYSTEM)) + (CREATE (ARRAY 4 'FLOATP)) + (SYSTEM)) -(RECORD SPLINE (%#KNOTS SPLINEX SPLINEY SPLINEDX SPLINEDY SPLINEDDX SPLINEDDY SPLINEDDDX - SPLINEDDDY)) +(RECORD SPLINE (%#KNOTS SPLINEX SPLINEY SPLINEDX SPLINEDY SPLINEDDX SPLINEDDY SPLINEDDDX SPLINEDDDY)) ) (* "END EXPORTED DEFINITIONS") @@ -3380,21 +3351,20 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (PUTPROPS HALF MACRO ((X) - (LRSH X 1))) + (LRSH X 1))) -(PUTPROPS \FILLCIRCLEBLT MACRO (OPENLAMBDA (CX CY X Y) - (* ; - "calls bitblt twice to fill in one line of the circle.") - (\LINEBLT FCBBT (IDIFFERENCE CX X) - (IPLUS CY Y) - (IPLUS CX X) - DESTINATIONBASE RASTERWIDTH LEFT RIGHT BOTTOM TOP - GRAYWIDTH GRAYHEIGHT GRAYBASE NBITS) - (\LINEBLT FCBBT (IDIFFERENCE CX X) - (IDIFFERENCE CY Y) - (IPLUS CX X) - DESTINATIONBASE RASTERWIDTH LEFT RIGHT BOTTOM TOP - GRAYWIDTH GRAYHEIGHT GRAYBASE NBITS))) +(PUTPROPS \FILLCIRCLEBLT MACRO (OPENLAMBDA (CX CY X Y) (* ; + "calls bitblt twice to fill in one line of the circle.") + (\LINEBLT FCBBT (IDIFFERENCE CX X) + (IPLUS CY Y) + (IPLUS CX X) + DESTINATIONBASE RASTERWIDTH LEFT RIGHT BOTTOM TOP GRAYWIDTH + GRAYHEIGHT GRAYBASE NBITS) + (\LINEBLT FCBBT (IDIFFERENCE CX X) + (IDIFFERENCE CY Y) + (IPLUS CX X) + DESTINATIONBASE RASTERWIDTH LEFT RIGHT BOTTOM TOP GRAYWIDTH + GRAYHEIGHT GRAYBASE NBITS))) ) (* "END EXPORTED DEFINITIONS") @@ -3403,131 +3373,153 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DECLARE%: EVAL@COMPILE (PUTPROPS \CURVEPT MACRO [OPENLAMBDA (X Y) - (COND - ((OR (ILEQ X LEFTMINUSBRUSH) - (IGEQ X RIGHTPLUS1) - (ILEQ Y BOTTOMMINUSBRUSH) - (IGEQ Y TOP)) - NIL) - ((NULL BBT) - (\FBITMAPBIT DESTINATIONBASE X Y OPERATION HEIGHTMINUS1 - RASTERWIDTH)) - (T - (* ;; - "This should have been done in .SETUP.FOR.\BBTCURVEPT., under \GETBRUSHBBT.") + (COND + ((OR (ILEQ X LEFTMINUSBRUSH) + (IGEQ X RIGHTPLUS1) + (ILEQ Y BOTTOMMINUSBRUSH) + (IGEQ Y TOP)) + NIL) + ((NULL BBT) + (\FBITMAPBIT DESTINATIONBASE X Y OPERATION HEIGHTMINUS1 RASTERWIDTH)) + (T + (* ;; + "This should have been done in .SETUP.FOR.\BBTCURVEPT., under \GETBRUSHBBT.") - (* ;; - "Its a bug here, because brushes can't use operation REPLACE.") + (* ;; "Its a bug here, because brushes can't use operation REPLACE.") - (* ;; - "(\SETPBTFUNCTION BBT (ffetch DDSOURCETYPE of DISPLAYDATA) OPERATION)") + (* ;; + "(\SETPBTFUNCTION BBT (ffetch DDSOURCETYPE of DISPLAYDATA) OPERATION)") - (\BBTCURVEPT X Y BBT LEFT BRUSHWIDTH LEFTMINUSBRUSH - RIGHTPLUS1 NBITSRIGHTPLUS1 TOPMINUSBRUSH - DestinationBitMap BRUSHHEIGHT BOTTOMMINUSBRUSH TOP - BRUSHBASE DESTINATIONBASE RASTERWIDTH - BRUSHRASTERWIDTH COLORBRUSHBASE NBITS DISPLAYDATA]) + (\BBTCURVEPT X Y BBT LEFT BRUSHWIDTH LEFTMINUSBRUSH RIGHTPLUS1 + NBITSRIGHTPLUS1 TOPMINUSBRUSH DestinationBitMap BRUSHHEIGHT + BOTTOMMINUSBRUSH TOP BRUSHBASE DESTINATIONBASE RASTERWIDTH + BRUSHRASTERWIDTH COLORBRUSHBASE NBITS DISPLAYDATA]) -(PUTPROPS .SETUP.FOR.\BBTCURVEPT. MACRO - [NIL (PROGN (SETQ BOTTOM (ffetch (\DISPLAYDATA DDClippingBottom) of DISPLAYDATA)) - (SETQ TOP (ffetch (\DISPLAYDATA DDClippingTop) of DISPLAYDATA)) - (SETQ RIGHTPLUS1 (ffetch (\DISPLAYDATA DDClippingRight) of DISPLAYDATA) - ) - (SETQ LEFT (ffetch (\DISPLAYDATA DDClippingLeft) of DISPLAYDATA)) - (SETQ DestinationBitMap (ffetch (\DISPLAYDATA DDDestination) of - DISPLAYDATA - )) - (SETQ OPERATION (OR OPERATION (ffetch (\DISPLAYDATA DDOPERATION) - of DISPLAYDATA))) - (SETQ NBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of DestinationBitMap)) - [COND - [(NOT (EQ NBITS 1)) - (SETQ BRUSHBM (\GETCOLORBRUSH BRUSH (MAXIMUMCOLOR NBITS) - NBITS)) - [SETQ COLOR (COND - [(AND (LISTP BRUSH) - (CAR (LISTP (CDDR BRUSH] - ((DSPCOLOR NIL DISPLAYSTREAM)) - (T (MAXIMUMCOLOR NBITS] - [COND - ((EQ OPERATION 'ERASE) - (SETQ COLOR (OPPOSITECOLOR COLOR NBITS] - (SETQ COLORBRUSHBASE (fetch (BITMAP BITMAPBASE) - of (\GETCOLORBRUSH BRUSH COLOR NBITS] - (T (SETQ BRUSHBM (\GETBRUSH BRUSH] - (SETQ RASTERWIDTH (ffetch (BITMAP BITMAPRASTERWIDTH) of +(PUTPROPS .SETUP.FOR.\BBTCURVEPT. MACRO [NIL (PROGN (SETQ BOTTOM (ffetch (\DISPLAYDATA + DDClippingBottom) + of DISPLAYDATA)) + (SETQ TOP (ffetch (\DISPLAYDATA DDClippingTop) + of DISPLAYDATA)) + (SETQ RIGHTPLUS1 (ffetch (\DISPLAYDATA + DDClippingRight) + of DISPLAYDATA)) + (SETQ LEFT (ffetch (\DISPLAYDATA DDClippingLeft) + of DISPLAYDATA)) + (SETQ DestinationBitMap (ffetch (\DISPLAYDATA + DDDestination) + of DISPLAYDATA)) + (SETQ OPERATION (OR OPERATION (ffetch + (\DISPLAYDATA + DDOPERATION) + of DISPLAYDATA)) + ) + (SETQ NBITS (fetch (BITMAP BITMAPBITSPERPIXEL) + of DestinationBitMap)) + [COND + [(NOT (EQ NBITS 1)) + (SETQ BRUSHBM (\GETCOLORBRUSH BRUSH + (MAXIMUMCOLOR NBITS) + NBITS)) + [SETQ COLOR + (COND + [(AND (LISTP BRUSH) + (CAR (LISTP (CDDR BRUSH] + ((DSPCOLOR NIL DISPLAYSTREAM)) + (T (MAXIMUMCOLOR NBITS] + [COND + ((EQ OPERATION 'ERASE) + (SETQ COLOR (OPPOSITECOLOR COLOR NBITS] + (SETQ COLORBRUSHBASE + (fetch (BITMAP BITMAPBASE) + of (\GETCOLORBRUSH BRUSH COLOR NBITS] + (T (SETQ BRUSHBM (\GETBRUSH BRUSH] + (SETQ RASTERWIDTH (ffetch (BITMAP + BITMAPRASTERWIDTH + ) of DestinationBitMap - )) - (SETQ DESTINATIONBASE (ffetch (BITMAP BITMAPBASE) of DestinationBitMap) - ) - (SETQ BBT (\GETBRUSHBBT BRUSHBM DISPLAYDATA BBT)) - (SETQ BRUSHBASE (fetch (BITMAP BITMAPBASE) of BRUSHBM)) - (SETQ BRUSHRASTERWIDTH (ffetch (BITMAP BITMAPRASTERWIDTH) of BRUSHBM)) - [COND - ((NULL BBT) - (SETQ HEIGHTMINUS1 (SUB1 (ffetch (BITMAP BITMAPHEIGHT) of + )) + (SETQ DESTINATIONBASE (ffetch (BITMAP BITMAPBASE) + of DestinationBitMap)) + (SETQ BBT (\GETBRUSHBBT BRUSHBM DISPLAYDATA BBT)) + (SETQ BRUSHBASE (fetch (BITMAP BITMAPBASE) + of BRUSHBM)) + (SETQ BRUSHRASTERWIDTH (ffetch (BITMAP + BITMAPRASTERWIDTH + ) + of BRUSHBM)) + [COND + ((NULL BBT) + (SETQ HEIGHTMINUS1 (SUB1 (ffetch (BITMAP + + BITMAPHEIGHT + ) + of DestinationBitMap - ))) - (COND - ((EQ (ffetch (\DISPLAYDATA DDOPERATION) of DISPLAYDATA) - 'INVERT) - (SETQ OPERATION 'INVERT] - (SETQ BRUSHWIDTH (ffetch (BITMAP BITMAPWIDTH) of BRUSHBM)) - (SETQ BRUSHHEIGHT (ffetch (BITMAP BITMAPHEIGHT) of BRUSHBM)) - (SETQ LEFTMINUSBRUSH (IDIFFERENCE LEFT BRUSHWIDTH)) - (SETQ BOTTOMMINUSBRUSH (IDIFFERENCE BOTTOM BRUSHHEIGHT)) - (SETQ TOPMINUSBRUSH (IDIFFERENCE TOP BRUSHHEIGHT)) - (SETQ NBITSRIGHTPLUS1 (ITIMES RIGHTPLUS1 NBITS)) - (SETQ BRUSHWIDTH (ITIMES BRUSHWIDTH NBITS]) + ))) + (COND + ((EQ (ffetch (\DISPLAYDATA DDOPERATION) + of DISPLAYDATA) + 'INVERT) + (SETQ OPERATION 'INVERT] + (SETQ BRUSHWIDTH (ffetch (BITMAP BITMAPWIDTH) + of BRUSHBM)) + (SETQ BRUSHHEIGHT (ffetch (BITMAP BITMAPHEIGHT) + of BRUSHBM)) + (SETQ LEFTMINUSBRUSH (IDIFFERENCE LEFT BRUSHWIDTH + )) + (SETQ BOTTOMMINUSBRUSH (IDIFFERENCE BOTTOM + BRUSHHEIGHT)) + (SETQ TOPMINUSBRUSH (IDIFFERENCE TOP BRUSHHEIGHT) + ) + (SETQ NBITSRIGHTPLUS1 (ITIMES RIGHTPLUS1 NBITS)) + (SETQ BRUSHWIDTH (ITIMES BRUSHWIDTH NBITS]) (PUTPROPS \CIRCLEPTS MACRO (OPENLAMBDA (CX CY X Y) - (\CURVEPT (IPLUS CX X) - (IPLUS CY Y)) - (\CURVEPT (IDIFFERENCE CX X) - (IPLUS CY Y)) - (\CURVEPT (IPLUS CX X) - (IDIFFERENCE CY Y)) - (\CURVEPT (IDIFFERENCE CX X) - (IDIFFERENCE CY Y)))) + (\CURVEPT (IPLUS CX X) + (IPLUS CY Y)) + (\CURVEPT (IDIFFERENCE CX X) + (IPLUS CY Y)) + (\CURVEPT (IPLUS CX X) + (IDIFFERENCE CY Y)) + (\CURVEPT (IDIFFERENCE CX X) + (IDIFFERENCE CY Y)))) (PUTPROPS \CURVESMOOTH MACRO (OPENLAMBDA (NEWX NEWY USERFN DISPLAYSTREAM) - (PROG [(DX (IABS (IDIFFERENCE NEWX \OLDX))) - (DY (IABS (IDIFFERENCE NEWY \OLDY] + (PROG [(DX (IABS (IDIFFERENCE NEWX \OLDX))) + (DY (IABS (IDIFFERENCE NEWY \OLDY] + (COND + ((OR (IGREATERP DX 1) + (IGREATERP DY 1)) + [COND + ((NEQ [IPLUS (ADD1 (IDIFFERENCE \OLDX \OLDERX)) + (ITIMES 3 (ADD1 (IDIFFERENCE \OLDY \OLDERY] + 4) + [COND + (DASHON (COND + (USERFN (APPLY* USERFN \OLDX \OLDY + DISPLAYSTREAM)) + (T (.WHILE.TOP.DS. DISPLAYSTREAM + (\CURVEPT \OLDX \OLDY] (COND - ((OR (IGREATERP DX 1) - (IGREATERP DY 1)) - [COND - ((NEQ [IPLUS (ADD1 (IDIFFERENCE \OLDX \OLDERX)) - (ITIMES 3 (ADD1 (IDIFFERENCE \OLDY - \OLDERY] - 4) - [COND - (DASHON (COND - (USERFN (APPLY* USERFN \OLDX \OLDY - DISPLAYSTREAM)) - (T (.WHILE.TOP.DS. DISPLAYSTREAM - (\CURVEPT \OLDX \OLDY] - (COND - (DASHTAIL (COND - ((EQ 0 (SETQ DASHCNT - (SUB1 DASHCNT))) - (SETQ DASHON (NOT DASHON)) - (SETQ DASHTAIL - (OR (LISTP (CDR DASHTAIL)) - DASHLST)) - (SETQ DASHCNT (CAR DASHTAIL] - (SETQ \OLDERX \OLDX) - (SETQ \OLDERY \OLDY) - (SETQ \OLDX \CURX) - (SETQ \OLDY \CURY))) - (SETQ \CURX NEWX) - (SETQ \CURY NEWY)))) + (DASHTAIL (COND + ((EQ 0 (SETQ DASHCNT (SUB1 DASHCNT))) + (SETQ DASHON (NOT DASHON)) + (SETQ DASHTAIL + (OR (LISTP (CDR DASHTAIL)) + DASHLST)) + (SETQ DASHCNT (CAR DASHTAIL] + (SETQ \OLDERX \OLDX) + (SETQ \OLDERY \OLDY) + (SETQ \OLDX \CURX) + (SETQ \OLDY \CURY))) + (SETQ \CURX NEWX) + (SETQ \CURY NEWY)))) ) ) (DEFINEQ (\FILLCIRCLE.DISPLAY - [LAMBDA (DISPLAYSTREAM CENTERX CENTERY RADIUS TEXTURE) (* kbr%: "24-Jan-86 19:12") + [LAMBDA (DISPLAYSTREAM CENTERX CENTERY RADIUS TEXTURE) (* kbr%: "24-Jan-86 19:12") (* ;; "Fill in area bounded by circle DRAWCIRCLE would draw.") @@ -3548,45 +3540,42 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (SETQ LEFT (fetch (\DISPLAYDATA DDClippingLeft) of DISPLAYDATA)) (SETQ BOTTOM (fetch (\DISPLAYDATA DDClippingBottom) of DISPLAYDATA)) (SETQ TOP (SUB1 (fetch (\DISPLAYDATA DDClippingTop) of DISPLAYDATA))) - (SETQ RIGHT (SUB1 (fetch (\DISPLAYDATA DDClippingRight) of DISPLAYDATA - ))) + (SETQ RIGHT (SUB1 (fetch (\DISPLAYDATA DDClippingRight) of DISPLAYDATA))) (SETQ OPERATION (fetch (\DISPLAYDATA DDOPERATION) of DISPLAYDATA)) - (SETQ DestinationBitMap (fetch (\DISPLAYDATA DDDestination) of - DISPLAYDATA - )) + (SETQ DestinationBitMap (fetch (\DISPLAYDATA DDDestination) of DISPLAYDATA)) (SETQ NBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of DestinationBitMap)) [SETQ TEXTUREBM (COND ((BITMAPP TEXTURE)) [(NOT (EQ NBITS 1))(* ; - "color case, default texture differently") + "color case, default texture differently") (COND ((BITMAPP (COLORTEXTUREFROMCOLOR# - (COLORNUMBERP (OR TEXTURE - (DSPCOLOR NIL - DISPLAYSTREAM)) - NBITS T) - NBITS))) + (COLORNUMBERP (OR TEXTURE (DSPCOLOR NIL + DISPLAYSTREAM + )) + NBITS T) + NBITS))) [(AND (LISTP TEXTURE) (BITMAPP (COLORTEXTUREFROMCOLOR# - (COLORNUMBERP (CADR TEXTURE) - NBITS) - NBITS] + (COLORNUMBERP (CADR TEXTURE) + NBITS) + NBITS] (T (\ILLEGAL.ARG TEXTURE] ((LISTP TEXTURE) (* ; - "either a color or a list of (texture color)") + "either a color or a list of (texture color)") (INSURE.B&W.TEXTURE TEXTURE)) [(AND (NULL TEXTURE) - (BITMAPP (fetch (\DISPLAYDATA DDTexture) - of DISPLAYDATA] + (BITMAPP (fetch (\DISPLAYDATA DDTexture) of + DISPLAYDATA + ] ([OR (FIXP TEXTURE) (AND (NULL TEXTURE) (SETQ TEXTURE (fetch (\DISPLAYDATA DDTexture) of DISPLAYDATA] (* ; - "create bitmap for the texture. Could reuse a bitmap but for now this is good enough.") + "create bitmap for the texture. Could reuse a bitmap but for now this is good enough.") (SETQ TEXTUREBM (BITMAPCREATE 16 4)) - (SETQ GRAYBASE (fetch (BITMAP BITMAPBASE) of - TEXTUREBM)) + (SETQ GRAYBASE (fetch (BITMAP BITMAPBASE) of TEXTUREBM)) (\PUTBASE GRAYBASE 0 (\SFReplicate (LOGAND (LRSH TEXTURE 12) 15))) @@ -3600,36 +3589,32 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation TEXTUREBM) (T (\ILLEGAL.ARG TEXTURE] (SETQ GRAYBASE (fetch (BITMAP BITMAPBASE) of TEXTUREBM)) - (SETQ DESTINATIONBASE (fetch (BITMAP BITMAPBASE) of DestinationBitMap) - ) - (SETQ RASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH) of - DestinationBitMap - )) (* ; - "update as many fields in the brush bitblt table as possible from DS.") - (replace (PILOTBBT PBTFLAGS) of FCBBT with 0) - (replace (PILOTBBT PBTDESTBPL) of FCBBT with (UNFOLD RASTERWIDTH - BITSPERWORD)) + (SETQ DESTINATIONBASE (fetch (BITMAP BITMAPBASE) of DestinationBitMap)) + (SETQ RASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH) of DestinationBitMap)) (* ; - "clear gray information. PBTSOURCEBPL is used for gray information too.") + "update as many fields in the brush bitblt table as possible from DS.") + (replace (PILOTBBT PBTFLAGS) of FCBBT with 0) + (replace (PILOTBBT PBTDESTBPL) of FCBBT with (UNFOLD RASTERWIDTH BITSPERWORD)) + (* ; + "clear gray information. PBTSOURCEBPL is used for gray information too.") (replace (PILOTBBT PBTSOURCEBPL) of FCBBT with 0) (replace (PILOTBBT PBTUSEGRAY) of FCBBT with T) [replace (PILOTBBT PBTGRAYWIDTHLESSONE) of FCBBT - with (SUB1 (SETQ GRAYWIDTH (IMIN (fetch (BITMAP BITMAPWIDTH) - of TEXTUREBM) - 16] + with (SUB1 (SETQ GRAYWIDTH (IMIN (fetch (BITMAP BITMAPWIDTH) of TEXTUREBM) + 16] [replace (PILOTBBT PBTGRAYHEIGHTLESSONE) of FCBBT - with (SUB1 (SETQ GRAYHEIGHT (IMIN (fetch (BITMAP BITMAPHEIGHT) - of TEXTUREBM) - 16] + with (SUB1 (SETQ GRAYHEIGHT (IMIN (fetch (BITMAP BITMAPHEIGHT) of TEXTUREBM + ) + 16] (replace (PILOTBBT PBTDISJOINT) of FCBBT with T) (\SETPBTFUNCTION FCBBT 'TEXTURE OPERATION) (replace (PILOTBBT PBTHEIGHT) of FCBBT with 1) (* ; - "take into account the brush thickness.") + "take into account the brush thickness.") (SETQ CX (\DSPTRANSFORMX CENTERX DISPLAYDATA)) (SETQ CY (\DSPTRANSFORMY CENTERY DISPLAYDATA)) (* ; - "change Y TOP and BOTTOM to be in bitmap coordinates") + "change Y TOP and BOTTOM to be in bitmap coordinates") (SETQ CY (SUB1 (\SFInvert DestinationBitMap CY))) (SETQ TOP (SUB1 (\SFInvert DestinationBitMap TOP))) (SETQ BOTTOM (SUB1 (\SFInvert DestinationBitMap BOTTOM))) @@ -3640,13 +3625,13 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (COND ((EQ RADIUS 0) (* ; - "put a single point down. Use \LINEBLT to get proper texture. NIL") + "put a single point down. Use \LINEBLT to get proper texture. NIL") (.WHILE.TOP.DS. DISPLAYSTREAM - (\LINEBLT FCBBT CX CY CX DESTINATIONBASE RASTERWIDTH LEFT RIGHT + (\LINEBLT FCBBT CX CY CX DESTINATIONBASE RASTERWIDTH LEFT RIGHT BOTTOM TOP GRAYWIDTH GRAYHEIGHT GRAYBASE NBITS)) (RETURN))) LP (* ; - "(UNFOLD x 2) is used instead of (ITIMES x 2)") + "(UNFOLD x 2) is used instead of (ITIMES x 2)") [COND [(IGREATERP 0 D) (SETQ X (ADD1 X)) @@ -3670,7 +3655,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation 3] (COND ((EQ Y 0) (* ; - "draw the middle line differently to avoid duplication.") + "draw the middle line differently to avoid duplication.") (.WHILE.TOP.DS. DISPLAYSTREAM (\LINEBLT FCBBT (IDIFFERENCE CX X) CY @@ -3685,7 +3670,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (\LINEBLT [LAMBDA (BBT X Y XRIGHT DESTINATIONBASE RASTERWIDTH LEFT RIGHT BOTTOM TOP GRAYWIDTH GRAYHEIGHT - GRAYBASE NBITS) (* kbr%: "15-Feb-86 22:08") + GRAYBASE NBITS) (* kbr%: "15-Feb-86 22:08") (* ;; "fills in the changing fields of a bit blt tablt to draw one line of aan area.") @@ -3701,43 +3686,38 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (IGREATERP Y TOP) (IGREATERP BOTTOM Y)) (RETURN))) - (replace (PILOTBBT PBTDEST) of BBT with (\ADDBASE DESTINATIONBASE - (ITIMES RASTERWIDTH Y))) - [freplace (PILOTBBT PBTSOURCE) of BBT with (\ADDBASE GRAYBASE - (freplace (PILOTBBT - PBTGRAYOFFSET) + (replace (PILOTBBT PBTDEST) of BBT with (\ADDBASE DESTINATIONBASE (ITIMES RASTERWIDTH Y))) + [freplace (PILOTBBT PBTSOURCE) of BBT with (\ADDBASE GRAYBASE (freplace (PILOTBBT + PBTGRAYOFFSET + ) of BBT - with (MOD Y GRAYHEIGHT - ] + with (MOD Y GRAYHEIGHT] (SELECTQ NBITS (1 (freplace (PILOTBBT PBTDESTBIT) of BBT with X) (freplace (PILOTBBT PBTSOURCEBIT) of BBT with (MOD X GRAYWIDTH)) (freplace (PILOTBBT PBTWIDTH) of BBT with (ADD1 (IDIFFERENCE XRIGHT X)))) (4 (* ; - "color case, shift x values {which are in pixels} into bit values.") + "color case, shift x values {which are in pixels} into bit values.") (freplace (PILOTBBT PBTDESTBIT) of BBT with (SETQ X (LLSH X 2))) (* ; - "if TEXTURE is not a multiple of nbits wide this is probably garbage.") + "if TEXTURE is not a multiple of nbits wide this is probably garbage.") (freplace (PILOTBBT PBTSOURCEBIT) of BBT with (MOD X GRAYWIDTH)) - (freplace (PILOTBBT PBTWIDTH) of BBT with (IDIFFERENCE - (LLSH (ADD1 XRIGHT) + (freplace (PILOTBBT PBTWIDTH) of BBT with (IDIFFERENCE (LLSH (ADD1 XRIGHT) 2) - X))) + X))) (8 (* ; - "color case, shift x values {which are in pixels} into bit values.") + "color case, shift x values {which are in pixels} into bit values.") (freplace (PILOTBBT PBTDESTBIT) of BBT with (SETQ X (LLSH X 3))) (freplace (PILOTBBT PBTSOURCEBIT) of BBT with (MOD X GRAYWIDTH)) - (freplace (PILOTBBT PBTWIDTH) of BBT with (IDIFFERENCE - (LLSH (ADD1 XRIGHT) + (freplace (PILOTBBT PBTWIDTH) of BBT with (IDIFFERENCE (LLSH (ADD1 XRIGHT) 3) - X))) + X))) (24 (* ; - "color case, shift x values {which are in pixels} into bit values.") + "color case, shift x values {which are in pixels} into bit values.") (freplace (PILOTBBT PBTDESTBIT) of BBT with (SETQ X (ITIMES 24 X))) (freplace (PILOTBBT PBTSOURCEBIT) of BBT with (MOD X GRAYWIDTH)) - (freplace (PILOTBBT PBTWIDTH) of BBT with (IDIFFERENCE - (ITIMES 24 (ADD1 XRIGHT)) - X))) + (freplace (PILOTBBT PBTWIDTH) of BBT with (IDIFFERENCE (ITIMES 24 (ADD1 XRIGHT)) + X))) (SHOULDNT)) (\PILOTBITBLT BBT 0]) ) @@ -3749,7 +3729,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DEFINEQ (SCREENBITMAP - [LAMBDA (SCREEN) (* ; "Edited 20-Feb-87 14:57 by rrb") + [LAMBDA (SCREEN) (* ; "Edited 20-Feb-87 14:57 by rrb") (* ;; "Return bitmap destination of SCREEN.") @@ -3763,13 +3743,13 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (T (\ILLEGAL.ARG SCREEN]) (BITMAPP - [LAMBDA (X) (* rrb "25-JUN-82 15:21") + [LAMBDA (X) (* rrb "25-JUN-82 15:21") (* ; "is x a bitmap?") (AND (type? BITMAP X) X]) (BITMAPHEIGHT - [LAMBDA (BITMAP) (* kbr%: " 8-Jul-85 16:01") + [LAMBDA (BITMAP) (* kbr%: " 8-Jul-85 16:01") (* ;; "returns the height in pixels of a bitmap.") @@ -3781,7 +3761,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (T (\ILLEGAL.ARG BITMAP]) (BITSPERPIXEL - [LAMBDA (BITMAP) (* ; "Edited 15-Feb-94 16:10 by nilsson") + [LAMBDA (BITMAP) (* ; "Edited 15-Feb-94 16:10 by nilsson") (* ;; "returns the height in pixels of a bitmap.") @@ -3796,8 +3776,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (fetch (SCREEN SCBITSPERPIXEL) of BITMAP))) ((type? WINDOW BITMAP) (BITSPERPIXEL (fetch (WINDOW SCREEN) of BITMAP))) - ((ARRAYP BITMAP) (* ; - "Consider array to be a colormap.") + ((ARRAYP BITMAP) (* ; "Consider array to be a colormap.") (SELECTQ (ARRAYSIZE BITMAP) (256 8) (16 4) @@ -3826,7 +3805,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DEFINEQ (DSPFILL - [LAMBDA (REGION TEXTURE OPERATION STREAM) (* kbr%: " 8-Jul-85 15:40") + [LAMBDA (REGION TEXTURE OPERATION STREAM) (* kbr%: " 8-Jul-85 15:40") (* ;; "wipes a region of an imagestream with texture.") @@ -3842,7 +3821,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation OPERATION]) (INVERTW - [LAMBDA (WIN SHADE) (* rrb "18-May-84 21:52") + [LAMBDA (WIN SHADE) (* rrb "18-May-84 21:52") (* ;; "inverts a window and returns the window. Used in RESETFORMS.") @@ -3854,7 +3833,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DEFINEQ (\DSPCOLOR.DISPLAY - [LAMBDA (STREAM COLOR) (* ; "Edited 29-Jan-91 11:33 by matsuda") + [LAMBDA (STREAM COLOR) (* ; "Edited 29-Jan-91 11:33 by matsuda") (* ;; "sets and returns a display stream's background color.") @@ -3877,7 +3856,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (MAXIMUMCOLOR BITSPERPIXEL]) (\DSPBACKCOLOR.DISPLAY - [LAMBDA (STREAM COLOR) (* kbr%: "25-Aug-85 18:15") + [LAMBDA (STREAM COLOR) (* kbr%: "25-Aug-85 18:15") (* ;; "sets and returns a display stream's foreground color.") @@ -3886,9 +3865,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (SETQ COLORCELL (fetch (\DISPLAYDATA DDCOLOR) of DD)) (RETURN (COND (COLOR (SETQ DESTINATION (fetch (\DISPLAYDATA DDDestination) of DD)) - (SETQ BITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL) of - DESTINATION - )) + (SETQ BITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL) of DESTINATION)) (SETQ COLOR (COLORNUMBERP COLOR BITSPERPIXEL)) (PROG1 (COND (COLORCELL (PROG1 (CDR COLORCELL) @@ -3896,14 +3873,14 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (T (* ; "no color cell yet, make one.") (replace (\DISPLAYDATA DDCOLOR) of DD with (CONS (MAXIMUMCOLOR BITSPERPIXEL) - COLOR)) + COLOR)) 0)) (\SFFixFont STREAM DD))) (T (OR (CDR COLORCELL) 0]) (DSPEOLFN - [LAMBDA (EOLFN DISPLAYSTREAM) (* rrb "18-May-84 21:44") + [LAMBDA (EOLFN DISPLAYSTREAM) (* rrb "18-May-84 21:44") (* ;; "sets the end of line function for a displaystream. EOLFN will be called every EOL with the argument of the display stream. If EOLFN is 'OFF, the eolfn is cleared.") @@ -3915,9 +3892,9 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation [(LITATOM EOLFN) (replace (\DISPLAYDATA DDEOLFN) of DD with (COND - ((EQ EOLFN 'OFF) - NIL) - (T EOLFN] + ((EQ EOLFN 'OFF) + NIL) + (T EOLFN] (T (\ILLEGAL.ARG EOLFN])]) ) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE @@ -3940,17 +3917,16 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DECLARE%: EVAL@COMPILE (PUTPROPS DSPRUBOUTCHAR MACRO ((DS CHAR X Y TTBL) - (\DSPMOVELR DS CHAR X Y TTBL NIL T))) + (\DSPMOVELR DS CHAR X Y TTBL NIL T))) ) (DEFINEQ (DSPCLEOL - [LAMBDA (DISPLAYSTREAM XPOS YPOS HEIGHT) (* lmm " 3-May-84 10:31") + [LAMBDA (DISPLAYSTREAM XPOS YPOS HEIGHT) (* lmm " 3-May-84 10:31") (\CHECKCARET DISPLAYSTREAM) (PROG ((DD (\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM))) (RETURN (BITBLT NIL NIL NIL DISPLAYSTREAM (OR (FIXP XPOS) - (SETQ XPOS (ffetch DDLeftMargin - of DD))) + (SETQ XPOS (ffetch DDLeftMargin of DD))) [OR (FIXP YPOS) (IDIFFERENCE (ffetch DDYPOSITION of DD) (FONTPROP DISPLAYSTREAM 'DESCENT] @@ -3962,28 +3938,27 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation 'REPLACE]) (DSPRUBOUTCHAR - [LAMBDA (STREAM CHAR X Y TTBL) (* Pavel " 6-Oct-86 22:44") + [LAMBDA (STREAM CHAR X Y TTBL) (* Pavel " 6-Oct-86 22:44") (if (DISPLAYSTREAMP CHAR) then + (* ;; "Some older code may use the CHAR argument first.") - (* ;; "Some older code may use the CHAR argument first.") - - (swap STREAM CHAR) - (SETQ TTBL X) - (SETQ X) - (SETQ Y)) + (swap STREAM CHAR) + (SETQ TTBL X) + (SETQ X) + (SETQ Y)) (\GETDISPLAYDATA STREAM STREAM) (\DSPMOVELR STREAM CHAR X Y TTBL NIL T]) (\DSPMOVELR - [LAMBDA (DS CHAR X Y TTBL RIGHTWARDSFLG ERASEFLG) (* JonL " 7-May-84 02:47") + [LAMBDA (DS CHAR X Y TTBL RIGHTWARDSFLG ERASEFLG) (* JonL " 7-May-84 02:47") (* ;; "Moves the cursor 'leftwards' (or 'rightwards' if RIGHTWARDSFLG is non-null) over any main character and control or meta indicators. Returns NIL if the move can't be determined, such as trying to move left when already at the left margin. Effaces (or 'Rubs out') any bits moved over if ERASEFLG is non-null.") ([LAMBDA (DD) (* ;; - "Must do the \GETDISPLAYDATA first, since it may reset DS when it coerces to a DISPLAYSTREAM") + "Must do the \GETDISPLAYDATA first, since it may reset DS when it coerces to a DISPLAYSTREAM") (PROG [(WIDTH (\STREAMCHARWIDTH (COND ((CHARCODEP CHAR) @@ -3993,7 +3968,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DEFAULTPOS? (AND (NULL X) (NULL Y] (OR ERASEFLG DEFAULTPOS? (SHOULDNT)) (* ; - "CURSORLEFT and CURSORRIGHT commands aren't allowed to start from anywhere except current spot") + "CURSORLEFT and CURSORRIGHT commands aren't allowed to start from anywhere except current spot") (* ;; "Note that if CHAR is not specified and DS has a variable-pitch font, then the results may be somewhat random. Smart terminal drivers thus can work well only on fixed-pitch fonts.") @@ -4011,12 +3986,11 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (RIGHTWARDSFLG (IGREATERP (add X WIDTH) (ffetch DDRightMargin of DD))) (T (ILESSP (add X (IMINUS WIDTH)) - (ffetch DDLeftMargin of DD] - (* ; - "If we can't do the full backup, then return NIL to signal this fact") + (ffetch DDLeftMargin of DD] (* ; + "If we can't do the full backup, then return NIL to signal this fact") (RETURN))) (\CHECKCARET DS) (* ; - "Take down the caret, if there is one, just in case we are moving over it.") + "Take down the caret, if there is one, just in case we are moving over it.") [COND (ERASEFLG (* ; "And do the erasure if requested") ([LAMBDA (FONT) @@ -4025,7 +3999,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (COND ((NOT DEFAULTPOS?) (MOVETO X Y DS) (* ; - "Backup over the bits, and 'wipe' them out.") + "Backup over the bits, and 'wipe' them out.") )) (BITBLT NIL 0 0 DS X YPRIME WIDTH HEIGHT 'TEXTURE 'REPLACE) (* ; "wipe out some bits") @@ -4045,7 +4019,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DEFINEQ (\CURSOR.DEFPRINT - [LAMBDA (CURSOR STREAM) (* ; "Edited 15-Sep-94 16:13 by sybalsky") + [LAMBDA (CURSOR STREAM) (* ; "Edited 15-Sep-94 16:13 by sybalsky") (COND (*PRINT-ARRAY* (PRIN1 "#,(LET(image) (CURSORCREATE (SETQ image '" STREAM) (PRIN4 (fetch (CURSOR CUIMAGE) of CURSOR) @@ -4094,7 +4068,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (DEFINEQ (TEXTUREOFCOLOR - [LAMBDA (COLOR NOERRORFLG) (* rrb "30-Oct-85 19:43") + [LAMBDA (COLOR NOERRORFLG) (* rrb "30-Oct-85 19:43") (* ;; "returns a texture to represent a color on a black and white display") @@ -4117,7 +4091,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (RETURN TEX]) (\PRIMARYTEXTURE - [LAMBDA (PRIMARY LEVEL) (* rrb "30-Oct-85 19:25") + [LAMBDA (PRIMARY LEVEL) (* rrb "30-Oct-85 19:25") (* ;; "returns the 16x16 texture for a primary color level.") @@ -4131,7 +4105,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (RETURN TEXTURE]) (\LEVELTEXTURE - [LAMBDA (LEVEL) (* rrb "20-Aug-85 16:42") + [LAMBDA (LEVEL) (* rrb "20-Aug-85 16:42") (* ;; "returns a 16x16 texture which is merged so that only light bits on both go to light with a primary color pattern to get a level primary pattern.") @@ -4147,7 +4121,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (T WHITESHADE16]) (INSURE.B&W.TEXTURE - [LAMBDA (TEXTURE NOERRORFLG) (* rrb "30-Oct-85 19:47") + [LAMBDA (TEXTURE NOERRORFLG) (* rrb "30-Oct-85 19:47") (* ;; "coerces a TEXTURE argument to a 1 bit per pixel bitmap or small number") @@ -4161,7 +4135,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (LOGAND TEXTURE BLACKSHADE)) (BITMAP TEXTURE) (LISTP (* ; - "can be a list of (TEXTURE COLOR) or a list of levels rgb or hls.") + "can be a list of (TEXTURE COLOR) or a list of levels rgb or hls.") (COND ((TEXTUREOFCOLOR TEXTURE T)) ((CAR TEXTURE) @@ -4177,43 +4151,42 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (\ILLEGAL.ARG TEXTURE]) (INSURE.RGB.COLOR - [LAMBDA (COLOR NOERRFLG) (* rrb "30-Oct-85 19:34") + [LAMBDA (COLOR NOERRFLG) (* rrb "30-Oct-85 19:34") (* ; - "returns the RGB triple for a color.") + "returns the RGB triple for a color.") (PROG (LEVELS) (RETURN (COND [(FIXP COLOR) (* ; - "don't know what to do with color numbers so error") + "don't know what to do with color numbers so error") (COND (NOERRFLG NIL) (T (\ILLEGAL.ARG COLOR] [(LITATOM COLOR) (COND ((SETQ LEVELS (\LOOKUPCOLORNAME COLOR)) - (* ; - "recursively look up color number") + (* ; "recursively look up color number") (INSURE.RGB.COLOR (CDR LEVELS) NOERRFLG)) (NOERRFLG NIL) (T (ERROR "Unknown color name" COLOR] - ((HLSP COLOR) (* ; "HLS form convert to RGB") + ((HLSP COLOR) (* ; "HLS form convert to RGB") (HLSTORGB COLOR)) - ((RGBP COLOR) (* ; "check for RGB or HLS") + ((RGBP COLOR) (* ; "check for RGB or HLS") COLOR) (NOERRFLG NIL) (T (\ILLEGAL.ARG COLOR]) (\LOOKUPCOLORNAME - [LAMBDA (COLORNAME) (* rrb "13-DEC-82 13:14") + [LAMBDA (COLORNAME) (* rrb "13-DEC-82 13:14") (* ;; "looks up a prospective color name. Returns a list whose CAR is the name and whose CDR is a color spec.") (FASSOC COLORNAME COLORNAMES]) (RGBP - [LAMBDA (X) (* rrb "27-OCT-82 10:15") + [LAMBDA (X) (* rrb "27-OCT-82 10:15") (* ; - "return X if it is a red green blue triple.") + "return X if it is a red green blue triple.") (PROG (TMP) (RETURN (AND (LISTP X) (SMALLP (SETQ TMP (CAR X))) @@ -4228,7 +4201,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation X]) (HLSP - [LAMBDA (X) (* rrb "31-Oct-85 10:51") + [LAMBDA (X) (* rrb "31-Oct-85 10:51") (* ;; "return T if X is a hue lightness saturation triple.") @@ -4241,7 +4214,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation X]) (HLSTORGB - [LAMBDA (HLS) (* rrb "30-Oct-85 19:59") + [LAMBDA (HLS) (* rrb "30-Oct-85 19:59") (* ;; "converts from a hue saturation lightness triple into red green blue triple. HUE is in range 0 to 360, lightness and saturation are in the range 0 to 1.0") @@ -4264,7 +4237,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation BLUE _ (\HLSVALUEFN Min Max (IDIFFERENCE H 240]) (\HLSVALUEFN - [LAMBDA (MIN MAX HUE) (* rrb "25-OCT-82 10:47") + [LAMBDA (MIN MAX HUE) (* rrb "25-OCT-82 10:47") (* ;; "internal value function for converting from HLS to RGB.") @@ -4461,40 +4434,40 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation (PUTPROPS ADISPLAY COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991 1993 1994 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (12479 20536 (\BBTCURVEPT 12489 . 20534)) (20537 30595 (CREATETEXTUREFROMBITMAP 20547 . -22579) (PRINTBITMAP 22581 . 23910) (PRINT-BITMAPS-NICELY 23912 . 27929) (PRINTCURSOR 27931 . 28878) ( -\WRITEBITMAP 28880 . 30593)) (30638 33184 (\GETINTEGERPART 30648 . 32191) (\CONVERTTOFRACTION 32193 . -33182)) (33321 34207 (CURSORP 33331 . 33550) (CURSORBITMAP 33552 . 33598) (CreateCursorBitMap 33600 . -34205)) (38573 48435 (CARET 38583 . 40331) (\CARET.CREATE 40333 . 40511) (\CARET.DOWN 40513 . 41966) ( -\CARET.FLASH? 41968 . 43865) (\CARET.SHOW 43867 . 44623) (CARETRATE 44625 . 45283) (\CARET.FLASH.AGAIN - 45285 . 46560) (\CARET.FLASH.MULTIPLE 46562 . 47094) (\CARET.FLASH 47096 . 48433)) (48436 53536 ( -\MEDW.CARET.SHOW 48446 . 53534)) (53900 55731 (\AREAVISIBLE? 53910 . 54832) (\REGIONOVERLAPAREAP 54834 - . 55377) (\AREAINREGIONP 55379 . 55729)) (55780 71837 (CREATEREGION 55790 . 56126) (REGIONP 56128 . -56274) (INTERSECTREGIONS 56276 . 60099) (UNIONREGIONS 60101 . 63301) (REGIONSINTERSECTP 63303 . 63911) - (SUBREGIONP 63913 . 64558) (EXTENDREGION 64560 . 67780) (EXTENDREGIONBOTTOM 67782 . 68587) ( -EXTENDREGIONLEFT 68589 . 69292) (EXTENDREGIONRIGHT 69294 . 69931) (EXTENDREGIONTOP 69933 . 70559) ( -INSIDEP 70561 . 71329) (STRINGREGION 71331 . 71835)) (72082 78471 (\BRUSHBITMAP 72092 . 73816) ( -\GETBRUSH 73818 . 74129) (\GETBRUSHBBT 74131 . 76894) (\InitCurveBrushes 76896 . 78335) ( -\BrushFromWidth 78337 . 78469)) (78472 81537 (\MAKEBRUSH.DIAGONAL 78482 . 78762) ( -\MAKEBRUSH.HORIZONTAL 78764 . 79158) (\MAKEBRUSH.VERTICAL 79160 . 79472) (\MAKEBRUSH.SQUARE 79474 . -79751) (\MAKEBRUSH.ROUND 79753 . 81535)) (81538 82650 (INSTALLBRUSH 81548 . 82648)) (83051 87935 ( -\DRAWLINE.DISPLAY 83061 . 86650) (RELMOVETO 86652 . 87039) (MOVETOUPPERLEFT 87041 . 87933)) (87936 -111678 (\CLIPANDDRAWLINE 87946 . 94515) (\CLIPANDDRAWLINE1 94517 . 106387) (\CLIPCODE 106389 . 107763) - (\LEASTPTAT 107765 . 108363) (\GREATESTPTAT 108365 . 108993) (\DRAWLINE1 108995 . 110119) ( -\DRAWLINE.UFN 110121 . 111676)) (117836 164835 (\DRAWCIRCLE.DISPLAY 117846 . 126714) (\DRAWARC.DISPLAY - 126716 . 127006) (\DRAWARC.GENERIC 127008 . 127827) (\COMPUTE.ARC.POINTS 127829 . 130330) ( -\DRAWELLIPSE.DISPLAY 130332 . 145997) (\DRAWCURVE.DISPLAY 145999 . 148368) (\DRAWPOINT.DISPLAY 148370 - . 149455) (\DRAWPOLYGON.DISPLAY 149457 . 153399) (\LINEWITHBRUSH 153401 . 164833)) (164836 198066 ( -LOADPOLY 164846 . 165406) (PARAMETRICSPLINE 165408 . 175677) (\CURVE 175679 . 182223) (\CURVE2 182225 - . 194049) (\CURVEEND 194051 . 194549) (\CURVESLOPE 194551 . 197049) (\CURVESTART 197051 . 197375) ( -\FDIFS/FROM/DERIVS 197377 . 198064)) (208033 223185 (\FILLCIRCLE.DISPLAY 208043 . 219241) (\LINEBLT -219243 . 223183)) (223229 225285 (SCREENBITMAP 223239 . 223712) (BITMAPP 223714 . 223948) ( -BITMAPHEIGHT 223950 . 224326) (BITSPERPIXEL 224328 . 225283)) (225926 226919 (DSPFILL 225936 . 226619) - (INVERTW 226621 . 226917)) (226920 230721 (\DSPCOLOR.DISPLAY 226930 . 228223) (\DSPBACKCOLOR.DISPLAY -228225 . 229754) (DSPEOLFN 229756 . 230719)) (231162 235940 (DSPCLEOL 231172 . 232118) (DSPRUBOUTCHAR -232120 . 232558) (\DSPMOVELR 232560 . 235938)) (236070 237184 (\CURSOR.DEFPRINT 236080 . 237182)) ( -237596 246218 (TEXTUREOFCOLOR 237606 . 238868) (\PRIMARYTEXTURE 238870 . 239452) (\LEVELTEXTURE 239454 - . 239955) (INSURE.B&W.TEXTURE 239957 . 241350) (INSURE.RGB.COLOR 241352 . 242832) (\LOOKUPCOLORNAME -242834 . 243104) (RGBP 243106 . 243869) (HLSP 243871 . 244246) (HLSTORGB 244248 . 245388) (\HLSVALUEFN - 245390 . 246216))))) + (FILEMAP (NIL (12060 19421 (\BBTCURVEPT 12070 . 19419)) (19422 29238 (CREATETEXTUREFROMBITMAP 19432 . +21362) (PRINTBITMAP 21364 . 22715) (PRINT-BITMAPS-NICELY 22717 . 26568) (PRINTCURSOR 26570 . 27603) ( +\WRITEBITMAP 27605 . 29236)) (29281 31829 (\GETINTEGERPART 29291 . 30836) (\CONVERTTOFRACTION 30838 . +31827)) (31966 32838 (CURSORP 31976 . 32195) (CURSORBITMAP 32197 . 32243) (CreateCursorBitMap 32245 . +32836)) (37200 46243 (CARET 37210 . 38970) (\CARET.CREATE 38972 . 39150) (\CARET.DOWN 39152 . 40504) ( +\CARET.FLASH? 40506 . 42320) (\CARET.SHOW 42322 . 42891) (CARETRATE 42893 . 43551) (\CARET.FLASH.AGAIN + 43553 . 44719) (\CARET.FLASH.MULTIPLE 44721 . 45244) (\CARET.FLASH 45246 . 46241)) (46244 51316 ( +\MEDW.CARET.SHOW 46254 . 51314)) (51680 53515 (\AREAVISIBLE? 51690 . 52614) (\REGIONOVERLAPAREAP 52616 + . 53161) (\AREAINREGIONP 53163 . 53513)) (53564 66040 (CREATEREGION 53574 . 53910) (REGIONP 53912 . +54058) (INTERSECTREGIONS 54060 . 56830) (UNIONREGIONS 56832 . 58983) (REGIONSINTERSECTP 58985 . 59593) + (SUBREGIONP 59595 . 60240) (EXTENDREGION 60242 . 62399) (EXTENDREGIONBOTTOM 62401 . 63043) ( +EXTENDREGIONLEFT 63045 . 63664) (EXTENDREGIONRIGHT 63666 . 64219) (EXTENDREGIONTOP 64221 . 64762) ( +INSIDEP 64764 . 65532) (STRINGREGION 65534 . 66038)) (66285 71559 (\BRUSHBITMAP 66295 . 68012) ( +\GETBRUSH 68014 . 68325) (\GETBRUSHBBT 68327 . 70355) (\InitCurveBrushes 70357 . 71423) ( +\BrushFromWidth 71425 . 71557)) (71560 74627 (\MAKEBRUSH.DIAGONAL 71570 . 71850) ( +\MAKEBRUSH.HORIZONTAL 71852 . 72246) (\MAKEBRUSH.VERTICAL 72248 . 72560) (\MAKEBRUSH.SQUARE 72562 . +72839) (\MAKEBRUSH.ROUND 72841 . 74625)) (74628 75793 (INSTALLBRUSH 74638 . 75791)) (76194 87596 ( +\DRAWLINE.DISPLAY 76204 . 86311) (RELMOVETO 86313 . 86700) (MOVETOUPPERLEFT 86702 . 87594)) (87597 +111082 (\CLIPANDDRAWLINE 87607 . 94053) (\CLIPANDDRAWLINE1 94055 . 105803) (\CLIPCODE 105805 . 107179) + (\LEASTPTAT 107181 . 107779) (\GREATESTPTAT 107781 . 108409) (\DRAWLINE1 108411 . 109527) ( +\DRAWLINE.UFN 109529 . 111080)) (115612 161659 (\DRAWCIRCLE.DISPLAY 115622 . 124435) (\DRAWARC.DISPLAY + 124437 . 124727) (\DRAWARC.GENERIC 124729 . 125482) (\COMPUTE.ARC.POINTS 125484 . 127749) ( +\DRAWELLIPSE.DISPLAY 127751 . 143420) (\DRAWCURVE.DISPLAY 143422 . 145711) (\DRAWPOINT.DISPLAY 145713 + . 146909) (\DRAWPOLYGON.DISPLAY 146911 . 150439) (\LINEWITHBRUSH 150441 . 161657)) (161660 193352 ( +LOADPOLY 161670 . 162230) (PARAMETRICSPLINE 162232 . 172429) (\CURVE 172431 . 178033) (\CURVE2 178035 + . 189366) (\CURVEEND 189368 . 189850) (\CURVESLOPE 189852 . 192335) (\CURVESTART 192337 . 192661) ( +\FDIFS/FROM/DERIVS 192663 . 193350)) (205881 220217 (\FILLCIRCLE.DISPLAY 205891 . 216639) (\LINEBLT +216641 . 220215)) (220261 222261 (SCREENBITMAP 220271 . 220748) (BITMAPP 220750 . 220984) ( +BITMAPHEIGHT 220986 . 221362) (BITSPERPIXEL 221364 . 222259)) (222902 223895 (DSPFILL 222912 . 223595) + (INVERTW 223597 . 223893)) (223896 227539 (\DSPCOLOR.DISPLAY 223906 . 225203) (\DSPBACKCOLOR.DISPLAY +225205 . 226584) (DSPEOLFN 226586 . 227537)) (227972 232626 (DSPCLEOL 227982 . 228858) (DSPRUBOUTCHAR +228860 . 229292) (\DSPMOVELR 229294 . 232624)) (232756 233874 (\CURSOR.DEFPRINT 232766 . 233872)) ( +234286 242860 (TEXTUREOFCOLOR 234296 . 235558) (\PRIMARYTEXTURE 235560 . 236142) (\LEVELTEXTURE 236144 + . 236645) (INSURE.B&W.TEXTURE 236647 . 238042) (INSURE.RGB.COLOR 238044 . 239472) (\LOOKUPCOLORNAME +239474 . 239744) (RGBP 239746 . 240511) (HLSP 240513 . 240888) (HLSTORGB 240890 . 242030) (\HLSVALUEFN + 242032 . 242858))))) STOP diff --git a/sources/ADISPLAY.LCOM b/sources/ADISPLAY.LCOM index 997d6bed..f3094c84 100644 Binary files a/sources/ADISPLAY.LCOM and b/sources/ADISPLAY.LCOM differ diff --git a/sources/AOFD b/sources/AOFD index b60ee275..411e85aa 100644 --- a/sources/AOFD +++ b/sources/AOFD @@ -1,14 +1,10 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "11-May-2023 21:39:26" {DSK}c>Users>Larry>home>il>MEDLEY>SOURCES>AOFD.;2 36068 +(FILECREATED "17-May-2023 08:29:55" {DSK}larry>il>medley>sources>AOFD.;5 36263 :EDIT-BY "lmm" - :CHANGES-TO (VARS AOFDCOMS) - (FNS CLOSEF) - - :PREVIOUS-DATE "29-Apr-2023 05:38:34" -{DSK}c>Users>Larry>home>il>MEDLEY>SOURCES>AOFD.;1) + :PREVIOUS-DATE "17-May-2023 08:05:56" {DSK}larry>il>medley>sources>AOFD.;4) (PRETTYCOMPRINT AOFDCOMS) @@ -475,8 +471,14 @@ (fetch EOFFSET of STREAM]) (\BASEBYTES.OPENFN - [LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV) (* ; "Edited 17-Jan-87 16:08 by bvm:") - (if (fetch FULLFILENAME of NAME) + [LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV) (* ; "Edited 8-May-2023 14:05 by rmk") + (* ; "Edited 17-Jan-87 16:08 by bvm:") + (if (STREAMP NAME) + then (CL:UNLESS (\IOMODEP NAME ACCESS T) + (\SETACCESS NAME ACCESS)) + (\SETFILEPTR NAME 0) + NAME + elseif (fetch FULLFILENAME of NAME) then (OPENSTRINGSTREAM NAME ACCESS) else (\MAKEBASEBYTESTREAM (fetch CBUFPTR of NAME) (fetch BIASOFFST of NAME) @@ -759,15 +761,15 @@ (ADDTOVAR LAMA WHENCLOSE) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2464 3583 (\ADD-OPEN-STREAM 2474 . 2755) (\GENERIC-UNREGISTER-STREAM 2757 . 3581)) ( -3624 10688 (CLOSEALL 3634 . 4112) (CLOSEF 4114 . 5328) (EOFCLOSEF 5330 . 5630) (INPUT 5632 . 6402) ( -OPENP 6404 . 6807) (OUTPUT 6809 . 7581) (POSITION 7583 . 8391) (RANDACCESSP 8393 . 8783) (\IOMODEP -8785 . 9414) (WHENCLOSE 9416 . 10686)) (10689 10811 (STREAMADDPROP 10699 . 10809)) (11769 24326 ( -\BASEBYTES.IO.INIT 11779 . 14979) (\MAKEBASEBYTESTREAM 14981 . 17909) (\MBS.OUTCHARFN 17911 . 18311) ( -\BASEBYTES.NAME.FROM.STREAM 18313 . 18772) (\BASEBYTES.BOUT 18774 . 19528) (\BASEBYTES.SETFILEPTR -19530 . 20151) (\BASEBYTES.READP 20153 . 20797) (\BASEBYTES.BIN 20799 . 21306) (\BASEBYTES.PEEKBIN -21308 . 22138) (\BASEBYTES.TRUNCATEFN 22140 . 22648) (\BASEBYTES.OPENFN 22650 . 23148) ( -\BASEBYTES.BLOCKIO 23150 . 24324)) (24449 27753 (OPENSTRINGSTREAM 24459 . 26168) (MAKE-STRING-FORMAT -26170 . 27751)) (28025 32333 (\STRINGSTREAM.INIT 28035 . 32331)) (32410 35110 (GETSTREAM 32420 . 32651 -) (\CLEAROFD 32653 . 32946) (\GETSTREAM 32948 . 35108))))) + (FILEMAP (NIL (2363 3482 (\ADD-OPEN-STREAM 2373 . 2654) (\GENERIC-UNREGISTER-STREAM 2656 . 3480)) ( +3523 10587 (CLOSEALL 3533 . 4011) (CLOSEF 4013 . 5227) (EOFCLOSEF 5229 . 5529) (INPUT 5531 . 6301) ( +OPENP 6303 . 6706) (OUTPUT 6708 . 7480) (POSITION 7482 . 8290) (RANDACCESSP 8292 . 8682) (\IOMODEP +8684 . 9313) (WHENCLOSE 9315 . 10585)) (10588 10710 (STREAMADDPROP 10598 . 10708)) (11668 24521 ( +\BASEBYTES.IO.INIT 11678 . 14878) (\MAKEBASEBYTESTREAM 14880 . 17808) (\MBS.OUTCHARFN 17810 . 18210) ( +\BASEBYTES.NAME.FROM.STREAM 18212 . 18671) (\BASEBYTES.BOUT 18673 . 19427) (\BASEBYTES.SETFILEPTR +19429 . 20050) (\BASEBYTES.READP 20052 . 20696) (\BASEBYTES.BIN 20698 . 21205) (\BASEBYTES.PEEKBIN +21207 . 22037) (\BASEBYTES.TRUNCATEFN 22039 . 22547) (\BASEBYTES.OPENFN 22549 . 23343) ( +\BASEBYTES.BLOCKIO 23345 . 24519)) (24644 27948 (OPENSTRINGSTREAM 24654 . 26363) (MAKE-STRING-FORMAT +26365 . 27946)) (28220 32528 (\STRINGSTREAM.INIT 28230 . 32526)) (32605 35305 (GETSTREAM 32615 . 32846 +) (\CLEAROFD 32848 . 33141) (\GETSTREAM 33143 . 35303))))) STOP diff --git a/sources/AOFD.LCOM b/sources/AOFD.LCOM index 6e5f1abb..52305183 100644 Binary files a/sources/AOFD.LCOM and b/sources/AOFD.LCOM differ diff --git a/sources/CMLPATHNAME b/sources/CMLPATHNAME index b88e8ac2..ced67807 100644 --- a/sources/CMLPATHNAME +++ b/sources/CMLPATHNAME @@ -1,17 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Apr-2022 20:29:09"  -{DSK}kaplan>Local>medley3.5>my-medley>sources>CMLPATHNAME.;3 32421 +(FILECREATED " 1-May-2023 07:12:28" {DSK}larry>il>medley>sources>CMLPATHNAME.;5 30540 - :CHANGES-TO (VARS CMLPATHNAMECOMS) + :EDIT-BY "lmm" - :PREVIOUS-DATE "14-Jan-2022 11:40:58" -{DSK}kaplan>Local>medley3.5>my-medley>sources>CMLPATHNAME.;2) + :CHANGES-TO (FNS PATHNAME) + :PREVIOUS-DATE "30-Apr-2023 14:00:37" {DSK}larry>il>medley>sources>CMLPATHNAME.;4) -(* ; " -Copyright (c) 1986-1988, 1990 by Venue & Xerox Corporation. -") (PRETTYCOMPRINT CMLPATHNAMECOMS) @@ -213,8 +209,13 @@ Copyright (c) 1986-1988, 1990 by Venue & Xerox Corporation. (DEFINEQ (PATHNAME -(CL:LAMBDA (THING) (* hdj " 2-Apr-86 11:01") (* ;; "Turns Thing into a pathname. Thing may be a string, symbol, stream, or pathname.") (CL:VALUES (CL:PARSE-NAMESTRING THING))) -) + (CL:LAMBDA (THING) (* ; "Edited 1-May-2023 07:04 by lmm") + (* hdj " 2-Apr-86 11:01") + + (* ;; "Turns Thing into a pathname. Thing may be a string, symbol, stream, or pathname.") + + [CL:CHECK-TYPE THING (OR STRING STREAM PATHNAME (AND CL:SYMBOL (NOT NULL] + (CL:VALUES (CL:PARSE-NAMESTRING THING)))) (CL:MERGE-PATHNAMES (CL:LAMBDA (PATHNAME &OPTIONAL (DEFAULTS *DEFAULT-PATHNAME-DEFAULTS*) (DEFAULT-VERSION :NEWEST CL::VERSION-SPECIFIED-P)) (* ; "Edited 21-Aug-90 17:12 by nm") (* ;;; "Merge-Pathnames -- Public Returns a new pathname whose fields are the same as the fields in PATHNAME except that NIL fields are filled in from defaults. Type and Version field are only done if name field has to be done (see manual for explanation). Fills in unspecified slots of Pathname from Defaults (defaults to *default-pathname-defaults*). If the version remains unspecified, gets it from Default-Version.") (LET* ((PATH (PATHNAME PATHNAME)) (DEFAULT-PATH (PATHNAME DEFAULTS)) (HOST (OR (%%PATHNAME-HOST PATH) (%%PATHNAME-HOST DEFAULT-PATH))) (NAME (%%PATHNAME-NAME PATH)) (DEVICE (%%PATHNAME-DEVICE PATH)) (DIR (%%PATHNAME-DIRECTORY PATH)) (DEFAULT-DIR (%%PATHNAME-DIRECTORY DEFAULT-PATH)) DIREND DEFAULT-TYPE) (%%MAKE-PATHNAME HOST (OR DEVICE (%%PATHNAME-DEVICE DEFAULT-PATH)) (OR (AND DIR DEFAULT-DIR (CASE (%%DIRECTORY-COMPONENT-TYPE DIR) (:SUBDIRECTORY (CASE (SETQ DEFAULT-TYPE (%%DIRECTORY-COMPONENT-TYPE DEFAULT-DIR)) (:SUBDIRECTORY (* ; "Default is also a subdirectory, so explicit subdir overrides it") DIR) (T (* ; "Default is a full directory or a relative directory. Make sure to keep the type of the directory being same as the default one.") (CL:IF (EQ (%%DIRECTORY-COMPONENT-PATH DEFAULT-DIR) :WILD) (%%MAKE-DIRECTORY-COMPONENT :TYPE :RELATIVE :PATH (%%DIRECTORY-COMPONENT-PATH DIR)) (%%MAKE-DIRECTORY-COMPONENT :TYPE DEFAULT-TYPE :PATH (CL:CONCATENATE (QUOTE STRING) (%%DIRECTORY-COMPONENT-PATH DEFAULT-DIR) (CL:SECOND \FILENAME.SYNTAX) (%%DIRECTORY-COMPONENT-PATH DIR))))))) (T (CL:IF (NOT (EQ (%%DIRECTORY-COMPONENT-PATH DIR) :WILD)) DIR DEFAULT-DIR)))) DIR DEFAULT-DIR) (OR NAME (%%PATHNAME-NAME DEFAULT-PATH)) (OR (%%PATHNAME-TYPE PATH) (%%PATHNAME-TYPE DEFAULT-PATH)) (OR (%%PATHNAME-VERSION PATH) (CL:IF NAME (CL:IF CL::VERSION-SPECIFIED-P DEFAULT-VERSION :NEWEST) (OR (%%PATHNAME-VERSION DEFAULT-PATH) (CL:IF CL::VERSION-SPECIFIED-P DEFAULT-VERSION :NEWEST))))))) @@ -502,61 +503,18 @@ Copyright (c) 1986-1988, 1990 by Venue & Xerox Corporation. (ADDTOVAR LAMA CL:ENOUGH-NAMESTRING CL:HOST-NAMESTRING FILE-NAME CL:MERGE-PATHNAMES PATHNAME %%PRINT-DIRECTORY-COMPONENT CL:MAKE-PATHNAME %%PRINT-PATHNAME) ) -(PRETTYCOMPRINT CMLPATHNAMECOMS) - -(RPAQQ CMLPATHNAMECOMS - [ - (* ;; "Common Lisp pathname functions") - - (PROP FILETYPE CMLPATHNAME) - (COMS - (* ;; "useful macros") - - (FUNCTIONS %%WILD-NAME %%COMPONENT-STRING)) - (STRUCTURES PATHNAME DIRECTORY-COMPONENT) - (FNS %%PRINT-PATHNAME CL:MAKE-PATHNAME %%PRINT-DIRECTORY-COMPONENT) - (FUNCTIONS CL:PATHNAME-HOST CL:PATHNAME-DEVICE CL:PATHNAME-DIRECTORY CL:PATHNAME-NAME - CL:PATHNAME-TYPE CL:PATHNAME-VERSION) - (FNS PATHNAME CL:MERGE-PATHNAMES FILE-NAME CL:HOST-NAMESTRING CL:ENOUGH-NAMESTRING - %%NUMERIC-STRING-P) - (FUNCTIONS CL:NAMESTRING CL:PARSE-NAMESTRING CL:TRUENAME) - (FUNCTIONS %%MAKE-PATHNAME) - (FUNCTIONS %%PATHNAME-EQUAL %%DIRECTORY-COMPONENT-EQUAL) - (FUNCTIONS %%INITIALIZE-DEFAULT-PATHNAME) - (VARIABLES *DEFAULT-PATHNAME-DEFAULTS*) - (COMS - (* ;; "Interlisp-D compatibility") - - (FUNCTIONS INTERLISP-NAMESTRING UNPACKPATHNAME.STRING)) - (FUNCTIONS CL:FILE-NAMESTRING CL:DIRECTORY-NAMESTRING) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (%%INITIALIZE-DEFAULT-PATHNAME))) - (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) - (NLAML) - (LAMA - CL:ENOUGH-NAMESTRING - CL:MERGE-PATHNAMES - CL:MAKE-PATHNAME]) -(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS - -(ADDTOVAR NLAMA ) - -(ADDTOVAR NLAML ) - -(ADDTOVAR LAMA CL:ENOUGH-NAMESTRING CL:MERGE-PATHNAMES CL:MAKE-PATHNAME) -) -(PUTPROPS CMLPATHNAME COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2107 2238 (%%WILD-NAME 2107 . 2238)) (2240 2319 (%%COMPONENT-STRING 2240 . 2319)) (2924 - 8695 (%%PRINT-PATHNAME 2934 . 3095) (CL:MAKE-PATHNAME 3097 . 7847) (%%PRINT-DIRECTORY-COMPONENT 7849 - . 8693)) (8697 8890 (CL:PATHNAME-HOST 8697 . 8890)) (8892 9091 (CL:PATHNAME-DEVICE 8892 . 9091)) ( -9093 9301 (CL:PATHNAME-DIRECTORY 9093 . 9301)) (9303 9496 (CL:PATHNAME-NAME 9303 . 9496)) (9498 9691 ( -CL:PATHNAME-TYPE 9498 . 9691)) (9693 9895 (CL:PATHNAME-VERSION 9693 . 9895)) (9896 15220 (PATHNAME -9906 . 10098) (CL:MERGE-PATHNAMES 10100 . 12186) (FILE-NAME 12188 . 12329) (CL:HOST-NAMESTRING 12331 - . 12520) (CL:ENOUGH-NAMESTRING 12522 . 14987) (%%NUMERIC-STRING-P 14989 . 15218)) (15222 18975 ( -CL:NAMESTRING 15222 . 18975)) (18977 22448 (CL:PARSE-NAMESTRING 18977 . 22448)) (22450 23453 ( -CL:TRUENAME 22450 . 23453)) (23455 23647 (%%MAKE-PATHNAME 23455 . 23647)) (23649 24286 ( -%%PATHNAME-EQUAL 23649 . 24286)) (24288 24745 (%%DIRECTORY-COMPONENT-EQUAL 24288 . 24745)) (24747 -25370 (%%INITIALIZE-DEFAULT-PATHNAME 24747 . 25370)) (25460 25627 (INTERLISP-NAMESTRING 25460 . 25627) -) (25629 28522 (UNPACKPATHNAME.STRING 25629 . 28522)) (28524 29781 (CL:FILE-NAMESTRING 28524 . 29781)) - (29783 29981 (CL:DIRECTORY-NAMESTRING 29783 . 29981))))) + (FILEMAP (NIL (2012 2143 (%%WILD-NAME 2012 . 2143)) (2145 2224 (%%COMPONENT-STRING 2145 . 2224)) (2829 + 8600 (%%PRINT-PATHNAME 2839 . 3000) (CL:MAKE-PATHNAME 3002 . 7752) (%%PRINT-DIRECTORY-COMPONENT 7754 + . 8598)) (8602 8795 (CL:PATHNAME-HOST 8602 . 8795)) (8797 8996 (CL:PATHNAME-DEVICE 8797 . 8996)) ( +8998 9206 (CL:PATHNAME-DIRECTORY 8998 . 9206)) (9208 9401 (CL:PATHNAME-NAME 9208 . 9401)) (9403 9596 ( +CL:PATHNAME-TYPE 9403 . 9596)) (9598 9800 (CL:PATHNAME-VERSION 9598 . 9800)) (9801 15390 (PATHNAME +9811 . 10268) (CL:MERGE-PATHNAMES 10270 . 12356) (FILE-NAME 12358 . 12499) (CL:HOST-NAMESTRING 12501 + . 12690) (CL:ENOUGH-NAMESTRING 12692 . 15157) (%%NUMERIC-STRING-P 15159 . 15388)) (15392 19145 ( +CL:NAMESTRING 15392 . 19145)) (19147 22618 (CL:PARSE-NAMESTRING 19147 . 22618)) (22620 23623 ( +CL:TRUENAME 22620 . 23623)) (23625 23817 (%%MAKE-PATHNAME 23625 . 23817)) (23819 24456 ( +%%PATHNAME-EQUAL 23819 . 24456)) (24458 24915 (%%DIRECTORY-COMPONENT-EQUAL 24458 . 24915)) (24917 +25540 (%%INITIALIZE-DEFAULT-PATHNAME 24917 . 25540)) (25630 25797 (INTERLISP-NAMESTRING 25630 . 25797) +) (25799 28692 (UNPACKPATHNAME.STRING 25799 . 28692)) (28694 29951 (CL:FILE-NAMESTRING 28694 . 29951)) + (29953 30151 (CL:DIRECTORY-NAMESTRING 29953 . 30151))))) STOP diff --git a/sources/CMLPATHNAME.LCOM b/sources/CMLPATHNAME.LCOM index d40ce108..10da35bb 100644 Binary files a/sources/CMLPATHNAME.LCOM and b/sources/CMLPATHNAME.LCOM differ diff --git a/sources/FASL-SUPPORT b/sources/FASL-SUPPORT index 611c3a25..6afe5521 100644 --- a/sources/FASL-SUPPORT +++ b/sources/FASL-SUPPORT @@ -1,21 +1,21 @@ -(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "FASL") -(IL:FILECREATED "16-May-90 17:37:00" IL:|{DSK}local>lde>lispcore>sources>FASL-SUPPORT.;2| 1408 +(DEFINE-FILE-INFO PACKAGE "FASL" READTABLE "XCL" BASE 10) - IL:|changes| IL:|to:| (IL:VARS IL:FASL-SUPPORTCOMS) +(IL:FILECREATED "29-Apr-2023 17:09:01" IL:|{DSK}larry>il>medley>sources>FASL-SUPPORT.;2| 1257 - IL:|previous| IL:|date:| "15-Dec-86 16:23:56" -IL:|{DSK}local>lde>lispcore>sources>FASL-SUPPORT.;1|) + :EDIT-BY "lmm" + :CHANGES-TO (IL:VARS IL:FASL-SUPPORTCOMS) + + :PREVIOUS-DATE "16-May-90 17:37:00" IL:|{DSK}larry>il>medley>sources>FASL-SUPPORT.;1|) -; Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved. (IL:PRETTYCOMPRINT IL:FASL-SUPPORTCOMS) (IL:RPAQQ IL:FASL-SUPPORTCOMS ( - (IL:* IL:|;;| "Needed for compiling FASLOAD and FASDUMP") + (IL:* IL:|;;| "Needed for compiling FASLOAD and FASDUMP") - (IL:P (OR (GET 'IL:ABC 'IL:FILEDATES) + (IL:P (OR (GET 'IL:SYSEDIT 'IL:FILEDATES) (IL:FILESLOAD (IMPORT) IL:LLBASIC IL:LLCHAR IL:ADISPLAY IL:MODARITH IL:LLGC))) (IL:DEFINE-TYPES FASL-OPS) @@ -27,7 +27,7 @@ IL:|{DSK}local>lde>lispcore>sources>FASL-SUPPORT.;1|) (IL:* IL:|;;| "Needed for compiling FASLOAD and FASDUMP") -(OR (GET 'IL:ABC 'IL:FILEDATES) +(OR (GET 'IL:SYSEDIT 'IL:FILEDATES) (IL:FILESLOAD (IMPORT) IL:LLBASIC IL:LLCHAR IL:ADISPLAY IL:MODARITH IL:LLGC)) @@ -36,7 +36,6 @@ IL:|{DSK}local>lde>lispcore>sources>FASL-SUPPORT.;1|) (IL:PUTPROPS IL:FASL-SUPPORT IL:FILETYPE COMPILE-FILE) (IL:PUTPROPS IL:FASL-SUPPORT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "FASL")) -(IL:PUTPROPS IL:FASL-SUPPORT IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1990)) (IL:DECLARE\: IL:DONTCOPY (IL:FILEMAP (NIL))) IL:STOP diff --git a/sources/FASL-SUPPORT.LCOM b/sources/FASL-SUPPORT.LCOM index 159da071..0e49a0e2 100644 --- a/sources/FASL-SUPPORT.LCOM +++ b/sources/FASL-SUPPORT.LCOM @@ -1 +1,33 @@ -(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "FASL") (IL:FILECREATED "25-Jan-98 13:21:54" ("compiled on " IL:|{DSK}sources>FASL-SUPPORT.;1|) "30-Mar-95 20:33:04" IL:|bcompl'd| IL:|in| "Medley 14-Aug-95 ..." IL:|dated| "14-Aug-95 15:27:48") (IL:FILECREATED "16-May-90 17:37:00" IL:|{DSK}local>lde>lispcore>sources>FASL-SUPPORT.;2| 1408 IL:|changes| IL:|to:| (IL:VARS IL:FASL-SUPPORTCOMS) IL:|previous| IL:|date:| "15-Dec-86 16:23:56" IL:|{DSK}local>lde>lispcore>sources>FASL-SUPPORT.;1|) (IL:PRETTYCOMPRINT IL:FASL-SUPPORTCOMS) (IL:RPAQQ IL:FASL-SUPPORTCOMS ((IL:* IL:|;;| "Needed for compiling FASLOAD and FASDUMP") (IL:P (OR ( GET (QUOTE IL:ABC) (QUOTE IL:FILEDATES)) (IL:FILESLOAD (IMPORT) IL:LLBASIC IL:LLCHAR IL:ADISPLAY IL:MODARITH IL:LLGC))) (IL:DEFINE-TYPES FASL-OPS) (IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT) IL:FASL-SUPPORT))) (OR (GET (QUOTE IL:ABC) (QUOTE IL:FILEDATES)) (IL:FILESLOAD (IMPORT) IL:LLBASIC IL:LLCHAR IL:ADISPLAY IL:MODARITH IL:LLGC)) (XCL:DEF-DEFINE-TYPE FASL-OPS "FASL file opcodes") (IL:PUTPROPS IL:FASL-SUPPORT IL:FILETYPE COMPILE-FILE) (IL:PUTPROPS IL:FASL-SUPPORT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "FASL")) (IL:PUTPROPS IL:FASL-SUPPORT IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1990)) NIL \ No newline at end of file +(DEFINE-FILE-INFO PACKAGE "FASL" READTABLE "XCL" BASE 10) + +(IL:FILECREATED "29-Apr-2023 17:09:08" ("compiled on " +IL:|{DSK}larry>il>medley>sources>FASL-SUPPORT.;2|) "27-Apr-2023 05:47:56" "COMPILE-FILEd" IL:|in| + "Welcome to Fuller sysout 27-Apr-2023 ..." IL:|dated| "27-Apr-2023 05:53:17") +(IL:FILECREATED "29-Apr-2023 17:09:01" IL:|{DSK}larry>il>medley>sources>FASL-SUPPORT.;2| 1257 +:EDIT-BY "lmm" :CHANGES-TO (IL:VARS IL:FASL-SUPPORTCOMS) :PREVIOUS-DATE "16-May-90 17:37:00" +IL:|{DSK}larry>il>medley>sources>FASL-SUPPORT.;1|) +(IL:RPAQQ IL:FASL-SUPPORTCOMS ((IL:* IL:|;;| "Needed for compiling FASLOAD and FASDUMP") (IL:P (OR ( +GET (QUOTE IL:SYSEDIT) (QUOTE IL:FILEDATES)) (IL:FILESLOAD (IMPORT) IL:LLBASIC IL:LLCHAR IL:ADISPLAY +IL:MODARITH IL:LLGC))) (IL:DEFINE-TYPES FASL-OPS) (IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT) +IL:FASL-SUPPORT))) +(OR (GET (QUOTE IL:SYSEDIT) (QUOTE IL:FILEDATES)) (IL:FILESLOAD (IMPORT) IL:LLBASIC IL:LLCHAR +IL:ADISPLAY IL:MODARITH IL:LLGC)) +(IL:SET-DOCUMENTATION (QUOTE FASL-OPS) (QUOTE IL:DEFINE-TYPES) (QUOTE "FASL file opcodes")) +(IL:SETQ IL:PRETTYDEFMACROS (ADJOIN (QUOTE (FASL-OPS XCL::X (IL:P IL:* ( +XCL::%DEFINE-TYPE-FILE-DEFINITIONS (QUOTE FASL-OPS) (QUOTE XCL::X))))) IL:PRETTYDEFMACROS :TEST (QUOTE + EQUAL))) +(IL:SETQ IL:PRETTYTYPELST (ADJOIN (QUOTE (CHANGEDFASL-OPSLST FASL-OPS "FASL file opcodes")) +IL:PRETTYTYPELST :TEST (QUOTE EQUAL))) +(PROCLAIM (QUOTE (XCL:GLOBAL CHANGEDFASL-OPSLST))) +(OR (BOUNDP (QUOTE CHANGEDFASL-OPSLST)) (SETQ CHANGEDFASL-OPSLST NIL)) +(COND ((NOT (GETHASH (QUOTE FASL-OPS) XCL:*DEFINITION-HASH-TABLE*)) (CL::PUTHASH (QUOTE FASL-OPS) +XCL:*DEFINITION-HASH-TABLE* (MAKE-HASH-TABLE :TEST (QUOTE EQUAL) :SIZE 50 :REHASH-SIZE 50)))) +(IL:SETQ IL:FILEPKGTYPES (ADJOIN (QUOTE FASL-OPS) IL:FILEPKGTYPES)) +(IL:PUTPROP (QUOTE FASL-OPS) (QUOTE IL:GETDEF) (QUOTE XCL::%DEFINE-TYPE-GETDEF)) +(IL:PUTPROP (QUOTE FASL-OPS) (QUOTE IL:DELDEF) (QUOTE XCL::%DEFINE-TYPE-DELDEF)) +(IL:PUTPROP (QUOTE FASL-OPS) (QUOTE IL:PUTDEF) (QUOTE XCL::%DEFINE-TYPE-PUTDEF)) +(IL:PUTPROP (QUOTE FASL-OPS) (QUOTE IL:FILEGETDEF) (QUOTE XCL::%DEFINE-TYPE-FILEGETDEF)) +(IL:PUTPROP (QUOTE FASL-OPS) (QUOTE IL:FILEPKGCONTENTS) (QUOTE IL:NILL)) +(IL:PUTPROPS IL:FASL-SUPPORT IL:FILETYPE COMPILE-FILE) +(IL:PUTPROPS IL:FASL-SUPPORT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "FASL")) +NIL diff --git a/sources/FILEPKG b/sources/FILEPKG index 1c8358da..ff2f4b82 100644 --- a/sources/FILEPKG +++ b/sources/FILEPKG @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "31-Oct-2022 16:05:09" {WMEDLEY}FILEPKG.;47 274788 +(FILECREATED "18-Jul-2023 23:40:13" {WMEDLEY}FILEPKG.;50 274539 - :CHANGES-TO (FNS EDITCALLERS) + :EDIT-BY rmk - :PREVIOUS-DATE "22-Sep-2022 08:46:29" {WMEDLEY}FILEPKG.;45) + :CHANGES-TO (FNS GATHEREXPORTS) + + :PREVIOUS-DATE "13-Jul-2023 14:56:21" {WMEDLEY}FILEPKG.;48) (* ; " @@ -4300,8 +4302,9 @@ compiling " T) (DEFINEQ (FINDCALLERS - [LAMBDA (ATOMS FILES) (* lmm "30-SEP-78 01:36") - (PROG ((X (EDITCALLERS ATOMS FILES T))) + [LAMBDA (ATOMS FILES DEPTH) (* ; "Edited 13-Jul-2023 14:55 by rmk") + (* lmm "30-SEP-78 01:36") + (PROG ((X (EDITCALLERS ATOMS FILES T DEPTH))) (RETURN (NCONC (DREVERSE (CDR X)) (AND (CAR X) (LIST (CONS (COND @@ -4311,7 +4314,9 @@ compiling " T) (CAR X]) (EDITCALLERS - [LAMBDA (ATOMS FILES COMS) + [LAMBDA (ATOMS FILES COMS DEPTH) + + (* ;; "Edited 13-Jul-2023 14:56 by rmk") (* ;; "Edited 31-Oct-2022 16:04 by rmk") @@ -4342,7 +4347,7 @@ compiling " T) ((LISTP FILES) FILES) ((STRPOS "*" FILES) (* ; "Depth 2 for TMAX>TMAX") - (FILDIR FILES 2)) + (FILDIR FILES (OR DEPTH 2))) (T (LIST FILES))) unless (DIRECTORYNAMEP FILE) do (RESETLST @@ -4704,29 +4709,19 @@ compiling " T) (for FILE in FILES do (IMPORTFILE (CADR FILE]) (GATHEREXPORTS - [LAMBDA (FROMFILES TOFILE FLG) (* ; "Edited 23-Aug-2021 16:40 by rmk:") - (* ; - "Copies all exported definitions from FROMFILES to TOFILE.") + [LAMBDA (FROMFILES TOFILE FLG) (* ; "Edited 18-Jul-2023 23:39 by rmk") + (* ; "Edited 22-May-2021 00:01 by rmk:") + + (* ;; "Use PRETTYDEF so that EXPORTS.ALL is registered with the normal file properties, reader environment, etc.") + + (CL:UNLESS FLG (SETQ FLG T)) + (SETQ TOFILE (MKATOM TOFILE)) (* ; + "PRETTYDEF doesn't like strings--why?") (RESETLST - [RESETSAVE NIL (LIST (FUNCTION CLOSE-AND-MAYBE-DELETE) - (SETQ TOFILE (OPENSTREAM TOFILE 'OUTPUT] - (RESETSAVE (OUTPUT TOFILE)) - (LET ((ENV *DEFAULT-MAKEFILE-ENVIRONMENT*)) - (SETQ ENV (if ENV - then (\DO-DEFINE-FILE-INFO TOFILE ENV) - else *OLD-INTERLISP-READ-ENVIRONMENT*)) - (WITH-READER-ENVIRONMENT ENV - (PRINT-READER-ENVIRONMENT ENV) - (printout NIL "(LISPXPRIN1 %"EXPORTS GATHERED FROM " (DIRECTORYNAME T) - " ON " - (DATE) - "%" T)" T "(LISPXTERPRI T)" T) - (for F inside FROMFILES do (MAPC (IMPORTFILE F (OR FLG T)) - (FUNCTION PRINT)) - (TERPRI)) - (PRINT 'STOP) - (TERPRI) - (FULLNAME TOFILE))))]) + [PRETTYDEF NIL TOFILE `((E (MAPC (MKLIST FROMFILES) + (FUNCTION (LAMBDA (F) + (MAPC (IMPORTFILE F FLG) + (FUNCTION PRINT])]) (\DUMPEXPORTS [NLAMBDA COMS (* bvm%: "24-Oct-86 19:42") @@ -4866,46 +4861,46 @@ compiling " T) (PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1995 2018 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (18953 20626 (SEARCHPRETTYTYPELST 18963 . 19932) (PRETTYDEFMACROS 19934 . 20370) ( -FILEPKGCOMPROPS 20372 . 20624)) (21439 55731 (CLEANUP 21449 . 22839) (COMPILEFILES 22841 . 23117) ( -COMPILEFILES0 23119 . 23932) (CONTINUEDIT 23934 . 25311) (MAKEFILE 25313 . 37039) (FILECHANGES 37041 - . 39805) (FILEPKG.MERGECHANGES 39807 . 40442) (FILEPKG.CHANGEDFNS 40444 . 40756) (MAKEFILE1 40758 . -44970) (COMPILE-FILE? 44972 . 46559) (MAKEFILES 46561 . 48089) (ADDFILE 48091 . 50634) (ADDFILE0 50636 - . 54760) (LISTFILES 54762 . 55729)) (56403 89989 (FILEPKGCHANGES 56413 . 57592) (GETFILEPKGTYPE 57594 - . 60544) (MARKASCHANGED 60546 . 62177) (FILECOMS 62179 . 62563) (WHEREIS 62565 . 64094) ( -SMASHFILECOMS 64096 . 64324) (FILEFNSLST 64326 . 64492) (FILECOMSLST 64494 . 64980) (UPDATEFILES 64982 - . 69480) (INFILECOMS? 69482 . 71325) (INFILECOMTAIL 71327 . 72445) (INFILECOMS 72447 . 72608) ( -INFILECOM 72610 . 82628) (INFILECOMSVALS 82630 . 82937) (INFILECOMSVAL 82939 . 83947) (INFILECOMSPROP -83949 . 84742) (IFCPROPS 84744 . 85824) (IFCEXPRTYPE 85826 . 86442) (IFCPROPSCAN 86444 . 87405) ( -IFCDECLARE 87407 . 88666) (INFILEPAIRS 88668 . 88967) (INFILECOMSMACRO 88969 . 89987)) (90024 120710 ( -FILES? 90034 . 92145) (FILES?1 92147 . 92849) (FILES?PRINTLST 92851 . 93633) (ADDTOFILES? 93635 . -104178) (ADDTOFILE 104180 . 105096) (WHATIS 105098 . 107074) (ADDTOCOMS 107076 . 108614) (ADDTOCOM -108616 . 115103) (ADDTOCOM1 115105 . 116276) (ADDNEWCOM 116278 . 117328) (MAKENEWCOM 117330 . 119177) -(DEFAULTMAKENEWCOM 119179 . 120708)) (120780 123597 (MERGEINSERT 120790 . 123133) (MERGEINSERT1 123135 - . 123595)) (123751 125112 (ADDTOFILEKEYLST 123761 . 125110)) (125229 136030 (DELFROMFILES 125239 . -126069) (DELFROMCOMS 126071 . 127750) (DELFROMCOM 127752 . 133517) (DELFROMCOM1 133519 . 134318) ( -REMOVEITEM 134320 . 135196) (MOVETOFILE 135198 . 136028)) (136244 138615 (SAVEPUT 136254 . 138613)) ( -138740 146983 (UNMARKASCHANGED 138750 . 140234) (PREEDITFN 140236 . 142717) (POSTEDITPROPS 142719 . -145013) (POSTEDITALISTS 145015 . 146981)) (147128 166598 (ALISTS.GETDEF 147138 . 147517) ( -ALISTS.WHENCHANGED 147519 . 148165) (CLEARCLISPARRAY 148167 . 149345) (EXPRESSIONS.WHENCHANGED 149347 - . 149725) (MAKEALISTCOMS 149727 . 150742) (MAKEFILESCOMS 150744 . 152074) (MAKELISPXMACROSCOMS 152076 - . 154094) (MAKEPROPSCOMS 154096 . 154722) (MAKEUSERMACROSCOMS 154724 . 156541) (PROPS.WHENCHANGED -156543 . 157164) (FILEGETDEF.LISPXMACROS 157166 . 158465) (FILEGETDEF.ALISTS 158467 . 159058) ( -FILEGETDEF.RECORDS 159060 . 159987) (FILEGETDEF.PROPS 159989 . 160784) (FILEGETDEF.MACROS 160786 . -161668) (FILEGETDEF.VARS 161670 . 162273) (FILEGETDEF.FNS 162275 . 163515) (FILEPKGCOMS.PUTDEF 163517 - . 165459) (FILES.PUTDEF 165461 . 166329) (VARS.PUTDEF 166331 . 166474) (FILES.WHENCHANGED 166476 . -166596)) (168620 175851 (RENAME 168630 . 170075) (CHANGECALLERS 170077 . 175849)) (175852 223761 ( -SHOWDEF 175862 . 177059) (COPYDEF 177061 . 179809) (GETDEF 179811 . 182354) (GETDEFCOM 182356 . 183322 -) (GETDEFCOM0 183324 . 184517) (GETDEFCURRENT 184519 . 190831) (GETDEFERR 190833 . 192103) ( -GETDEFFROMFILE 192105 . 196334) (GETDEFSAVED 196336 . 197424) (PUTDEF 197426 . 198133) (EDITDEF 198135 - . 199118) (DEFAULT.EDITDEF 199120 . 201958) (EDITDEF.FILES 201960 . 202165) (LOADDEF 202167 . 202343) - (DWIMDEF 202345 . 203199) (DELDEF 203201 . 206095) (DELFROMLIST 206097 . 206601) (HASDEF 206603 . -212840) (GETFILEDEF 212842 . 213354) (SAVEDEF 213356 . 215044) (UNSAVEDEF 215046 . 215942) ( -COMPAREDEFS 215944 . 219750) (COMPARE 219752 . 220456) (TYPESOF 220458 . 223759)) (223911 232159 ( -FILEPKGCOM 223921 . 228697) (FILEPKGTYPE 228699 . 232157)) (244192 261485 (FINDCALLERS 244202 . 244717 -) (EDITCALLERS 244719 . 255369) (EDITFROMFILE 255371 . 260800) (FINDATS 260802 . 261074) (LOOKIN -261076 . 261483)) (261486 263157 (SEPRCASE 261496 . 263155)) (263674 269130 (IMPORTFILE 263684 . -264654) (IMPORTEVAL 264656 . 265542) (IMPORTFILESCAN 265544 . 265957) (CHECKIMPORTS 265959 . 267215) ( -GATHEREXPORTS 267217 . 268538) (\DUMPEXPORTS 268540 . 269128)) (269468 271538 (CLEARFILEPKG 269478 . -271536))))) + (FILEMAP (NIL (18975 20648 (SEARCHPRETTYTYPELST 18985 . 19954) (PRETTYDEFMACROS 19956 . 20392) ( +FILEPKGCOMPROPS 20394 . 20646)) (21461 55753 (CLEANUP 21471 . 22861) (COMPILEFILES 22863 . 23139) ( +COMPILEFILES0 23141 . 23954) (CONTINUEDIT 23956 . 25333) (MAKEFILE 25335 . 37061) (FILECHANGES 37063 + . 39827) (FILEPKG.MERGECHANGES 39829 . 40464) (FILEPKG.CHANGEDFNS 40466 . 40778) (MAKEFILE1 40780 . +44992) (COMPILE-FILE? 44994 . 46581) (MAKEFILES 46583 . 48111) (ADDFILE 48113 . 50656) (ADDFILE0 50658 + . 54782) (LISTFILES 54784 . 55751)) (56425 90011 (FILEPKGCHANGES 56435 . 57614) (GETFILEPKGTYPE 57616 + . 60566) (MARKASCHANGED 60568 . 62199) (FILECOMS 62201 . 62585) (WHEREIS 62587 . 64116) ( +SMASHFILECOMS 64118 . 64346) (FILEFNSLST 64348 . 64514) (FILECOMSLST 64516 . 65002) (UPDATEFILES 65004 + . 69502) (INFILECOMS? 69504 . 71347) (INFILECOMTAIL 71349 . 72467) (INFILECOMS 72469 . 72630) ( +INFILECOM 72632 . 82650) (INFILECOMSVALS 82652 . 82959) (INFILECOMSVAL 82961 . 83969) (INFILECOMSPROP +83971 . 84764) (IFCPROPS 84766 . 85846) (IFCEXPRTYPE 85848 . 86464) (IFCPROPSCAN 86466 . 87427) ( +IFCDECLARE 87429 . 88688) (INFILEPAIRS 88690 . 88989) (INFILECOMSMACRO 88991 . 90009)) (90046 120732 ( +FILES? 90056 . 92167) (FILES?1 92169 . 92871) (FILES?PRINTLST 92873 . 93655) (ADDTOFILES? 93657 . +104200) (ADDTOFILE 104202 . 105118) (WHATIS 105120 . 107096) (ADDTOCOMS 107098 . 108636) (ADDTOCOM +108638 . 115125) (ADDTOCOM1 115127 . 116298) (ADDNEWCOM 116300 . 117350) (MAKENEWCOM 117352 . 119199) +(DEFAULTMAKENEWCOM 119201 . 120730)) (120802 123619 (MERGEINSERT 120812 . 123155) (MERGEINSERT1 123157 + . 123617)) (123773 125134 (ADDTOFILEKEYLST 123783 . 125132)) (125251 136052 (DELFROMFILES 125261 . +126091) (DELFROMCOMS 126093 . 127772) (DELFROMCOM 127774 . 133539) (DELFROMCOM1 133541 . 134340) ( +REMOVEITEM 134342 . 135218) (MOVETOFILE 135220 . 136050)) (136266 138637 (SAVEPUT 136276 . 138635)) ( +138762 147005 (UNMARKASCHANGED 138772 . 140256) (PREEDITFN 140258 . 142739) (POSTEDITPROPS 142741 . +145035) (POSTEDITALISTS 145037 . 147003)) (147150 166620 (ALISTS.GETDEF 147160 . 147539) ( +ALISTS.WHENCHANGED 147541 . 148187) (CLEARCLISPARRAY 148189 . 149367) (EXPRESSIONS.WHENCHANGED 149369 + . 149747) (MAKEALISTCOMS 149749 . 150764) (MAKEFILESCOMS 150766 . 152096) (MAKELISPXMACROSCOMS 152098 + . 154116) (MAKEPROPSCOMS 154118 . 154744) (MAKEUSERMACROSCOMS 154746 . 156563) (PROPS.WHENCHANGED +156565 . 157186) (FILEGETDEF.LISPXMACROS 157188 . 158487) (FILEGETDEF.ALISTS 158489 . 159080) ( +FILEGETDEF.RECORDS 159082 . 160009) (FILEGETDEF.PROPS 160011 . 160806) (FILEGETDEF.MACROS 160808 . +161690) (FILEGETDEF.VARS 161692 . 162295) (FILEGETDEF.FNS 162297 . 163537) (FILEPKGCOMS.PUTDEF 163539 + . 165481) (FILES.PUTDEF 165483 . 166351) (VARS.PUTDEF 166353 . 166496) (FILES.WHENCHANGED 166498 . +166618)) (168642 175873 (RENAME 168652 . 170097) (CHANGECALLERS 170099 . 175871)) (175874 223783 ( +SHOWDEF 175884 . 177081) (COPYDEF 177083 . 179831) (GETDEF 179833 . 182376) (GETDEFCOM 182378 . 183344 +) (GETDEFCOM0 183346 . 184539) (GETDEFCURRENT 184541 . 190853) (GETDEFERR 190855 . 192125) ( +GETDEFFROMFILE 192127 . 196356) (GETDEFSAVED 196358 . 197446) (PUTDEF 197448 . 198155) (EDITDEF 198157 + . 199140) (DEFAULT.EDITDEF 199142 . 201980) (EDITDEF.FILES 201982 . 202187) (LOADDEF 202189 . 202365) + (DWIMDEF 202367 . 203221) (DELDEF 203223 . 206117) (DELFROMLIST 206119 . 206623) (HASDEF 206625 . +212862) (GETFILEDEF 212864 . 213376) (SAVEDEF 213378 . 215066) (UNSAVEDEF 215068 . 215964) ( +COMPAREDEFS 215966 . 219772) (COMPARE 219774 . 220478) (TYPESOF 220480 . 223781)) (223933 232181 ( +FILEPKGCOM 223943 . 228719) (FILEPKGTYPE 228721 . 232179)) (244214 261689 (FINDCALLERS 244224 . 244854 +) (EDITCALLERS 244856 . 255573) (EDITFROMFILE 255575 . 261004) (FINDATS 261006 . 261278) (LOOKIN +261280 . 261687)) (261690 263361 (SEPRCASE 261700 . 263359)) (263878 268881 (IMPORTFILE 263888 . +264858) (IMPORTEVAL 264860 . 265746) (IMPORTFILESCAN 265748 . 266161) (CHECKIMPORTS 266163 . 267419) ( +GATHEREXPORTS 267421 . 268289) (\DUMPEXPORTS 268291 . 268879)) (269219 271289 (CLEARFILEPKG 269229 . +271287))))) STOP diff --git a/sources/FILEPKG.LCOM b/sources/FILEPKG.LCOM index 27fcbbe9..ca33e989 100644 Binary files a/sources/FILEPKG.LCOM and b/sources/FILEPKG.LCOM differ diff --git a/sources/FILESETS b/sources/FILESETS index 3a7290e7..0aea357f 100644 --- a/sources/FILESETS +++ b/sources/FILESETS @@ -1,15 +1,9 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "11-Sep-2022 20:08:31" {DSK}larry>medley>sources>FILESETS.;2 6394 +(FILECREATED "23-May-2023 08:11:56" {DSK}larry>il>medley>sources>FILESETS.;24 + :EDIT-BY "lmm" - :CHANGES-TO (VARS EXPORTFILES) - - :PREVIOUS-DATE "17-Oct-2021 16:06:59" {DSK}larry>medley>sources>FILESETS.;1) - - -(* ; " -Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation. -") + :PREVIOUS-DATE " 1-Mar-2023 07:49:03" {DSK}larry>il>medley>sources>FILESETS.;23) (PRETTYCOMPRINT FILESETSCOMS) @@ -62,7 +56,7 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation. DSK UFS UFSCALLC PASSWORDS FONT LLDISPLAY APUTDQ COMPATIBILITY DMISC CMLMACROS CMLLIST CMLCHARACTER CMLREADTABLE MAIKOLOADUPFNS MAIKOBITBLT MAIKOINIT)) -(RPAQQ 2LISPSET (MACHINEINDEPENDENT POSTLOADUP)) +(RPAQQ 2LISPSET (MACHINEINDEPENDENT)) (RPAQQ 3LISPSET (MACROS DLAP BYTECOMPILER COMPILE)) @@ -71,7 +65,7 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation. LLCHAR LLSTK PMAP LLGC ATBL FILEIO EXTERNALFORMAT LLARITH LLFLOAT FONT LLKEY LLDISPLAY ADISPLAY AINTERRUPT RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER IMAGEIO PROC XCCS PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS LLETHER PUP UFS - DTDECLARE)) + DTDECLARE BIGBITMAPS)) (RPAQQ MAKEINITFILES (MAKEINIT MEM I-NEW)) @@ -162,8 +156,6 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation. (FPLUS2) (FTIMES2) (CREATECELL \CREATECELL))) -(PUTPROPS FILESETS COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 -1998 2021)) (DECLARE%: DONTCOPY (FILEMAP (NIL))) STOP diff --git a/sources/LLREAD b/sources/LLREAD index cebf3d84..606e9bd1 100644 --- a/sources/LLREAD +++ b/sources/LLREAD @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Jul-2022 23:36:54"  -{DSK}kaplan>local>medley3.5>working-medley>sources>LLREAD.;102 89980 +(FILECREATED "17-Jun-2023 13:12:06" {WMEDLEY}LLREAD.;104 90176 - :CHANGES-TO (FNS PEEKCCODE SKIPSEPRCODES \SUBREAD) + :EDIT-BY rmk - :PREVIOUS-DATE "10-Sep-2021 19:41:58" -{DSK}kaplan>local>medley3.5>working-medley>sources>LLREAD.;101) + :CHANGES-TO (VARS LLREADCOMS CHARACTERNAMES) + + :PREVIOUS-DATE "19-Jul-2022 23:36:54" {WMEDLEY}LLREAD.;102) (* ; " @@ -37,7 +37,10 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (COMS (* ; "Reading characters with #\") (FNS CHARACTER.READ CHARCODE.DECODE) (FNS HEXNUM? OCTALNUM?) - (VARS CHARACTERNAMES CHARACTERSETNAMES)) + (ALISTS (CHARACTERNAMES Page Form FF Rubout Del Null Escape Esc Bell Tab Backspace Bs + Newline CR EOL Return Tenexeol Space Sp Linefeed LF) + (CHARACTERSETNAMES Meta Function Greek Cyrillic Hira Hiragana Kata Katakana + Kanji))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (CONSTANTS * READTYPES) (MACROS .CALL.SUBREAD. FIXDOT RBCONTEXT PROPRB \RDCONC) (SPECVARS *READ-NEWLINE-SUPPRESS* \RefillBufferFn) @@ -1523,38 +1526,38 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. ELSE (RETURN NIL)) FINALLY (RETURN NUM]) ) -(RPAQQ CHARACTERNAMES - (("Page" 12) - ("Form" 12) - ("FF" 12) - ("Rubout" 127) - ("Del" 127) - ("Null" 0) - ("Escape" 27) - ("Esc" 27) - ("Bell" 7) - ("Tab" 9) - ("Backspace" 8) - ("Bs" 8) - ("Newline" 13) - ("CR" 13) - ("EOL" 13) - ("Return" 13) - ("Tenexeol" 31) - ("Space" 32) - ("Sp" 32) - ("Linefeed" 10) - ("LF" 10))) +(ADDTOVAR CHARACTERNAMES + (Page 12) + (Form 12) + (FF 12) + (Rubout 127) + (Del 127) + (Null 0) + (Escape 27) + (Esc 27) + (Bell 7) + (Tab 9) + (Backspace 8) + (Bs 8) + (Newline 13) + (CR 13) + (EOL 13) + (Return 13) + (Tenexeol 31) + (Space 32) + (Sp 32) + (Linefeed 10) + (LF 10)) -(RPAQQ CHARACTERSETNAMES (("Meta" 1) - ("Function" 2) - ("Greek" 38) - ("Cyrillic" 39) - ("Hira" 36) - ("Hiragana" 36) - ("Kata" 37) - ("Katakana" 37) - ("Kanji" 48))) +(ADDTOVAR CHARACTERSETNAMES (Meta 1) + (Function 2) + (Greek 38) + (Cyrillic 39) + (Hira 36) + (Hiragana 36) + (Kata 37) + (Katakana 37) + (Kanji 48)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (RPAQQ READTYPES (READ.RT RATOM.RT NOPROPRB.RT PROPRB.RT)) @@ -1660,17 +1663,17 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (PUTPROPS LLREAD COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 1991 1993 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3265 11709 (LASTC 3275 . 3581) (PEEKC 3583 . 3971) (PEEKCCODE 3973 . 4384) (RATOM 4386 - . 5467) (READ 5469 . 6029) (READC 6031 . 6672) (READCCODE 6674 . 7433) (READP 7435 . 7987) ( -SETREADMACROFLG 7989 . 8288) (SKIPSEPRCODES 8290 . 9370) (SKIPSEPRS 9372 . 9758) (SKREAD 9760 . 11707) -) (11755 20364 (CL:READ 11765 . 12314) (CL:READ-PRESERVING-WHITESPACE 12316 . 13038) ( -CL:READ-DELIMITED-LIST 13040 . 13955) (CL:PARSE-INTEGER 13957 . 20362)) (20457 32934 (RSTRING 20467 . -21199) (READ-EXTENDED-TOKEN 21201 . 25073) (\RSTRING2 25075 . 32932)) (32970 63584 (\TOP-LEVEL-READ -32980 . 34963) (\SUBREAD 34965 . 60000) (\SUBREADCONCAT 60002 . 60625) (\ORIG-READ.SYMBOL 60627 . -61695) (\ORIG-INVALID.SYMBOL 61697 . 62596) (\APPLYREADMACRO 62598 . 63014) (INREADMACROP 63016 . -63582)) (63743 63918 (READQUOTE 63753 . 63916)) (63943 75847 (READVBAR 63953 . 65284) (READHASHMACRO -65286 . 71096) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71098 . 71318) (DIGITBASEP 71320 . 72054) ( -READNUMBERINBASE 72056 . 73942) (ESTIMATE-DIMENSIONALITY 73944 . 74269) (SKIP.HASH.COMMENT 74271 . -75239) (CMLREAD.FEATURE.PARSER 75241 . 75845)) (75891 82235 (CHARACTER.READ 75901 . 77155) ( -CHARCODE.DECODE 77157 . 82233)) (82236 85406 (HEXNUM? 82246 . 84589) (OCTALNUM? 84591 . 85404))))) + (FILEMAP (NIL (3460 11904 (LASTC 3470 . 3776) (PEEKC 3778 . 4166) (PEEKCCODE 4168 . 4579) (RATOM 4581 + . 5662) (READ 5664 . 6224) (READC 6226 . 6867) (READCCODE 6869 . 7628) (READP 7630 . 8182) ( +SETREADMACROFLG 8184 . 8483) (SKIPSEPRCODES 8485 . 9565) (SKIPSEPRS 9567 . 9953) (SKREAD 9955 . 11902) +) (11950 20559 (CL:READ 11960 . 12509) (CL:READ-PRESERVING-WHITESPACE 12511 . 13233) ( +CL:READ-DELIMITED-LIST 13235 . 14150) (CL:PARSE-INTEGER 14152 . 20557)) (20652 33129 (RSTRING 20662 . +21394) (READ-EXTENDED-TOKEN 21396 . 25268) (\RSTRING2 25270 . 33127)) (33165 63779 (\TOP-LEVEL-READ +33175 . 35158) (\SUBREAD 35160 . 60195) (\SUBREADCONCAT 60197 . 60820) (\ORIG-READ.SYMBOL 60822 . +61890) (\ORIG-INVALID.SYMBOL 61892 . 62791) (\APPLYREADMACRO 62793 . 63209) (INREADMACROP 63211 . +63777)) (63938 64113 (READQUOTE 63948 . 64111)) (64138 76042 (READVBAR 64148 . 65479) (READHASHMACRO +65481 . 71291) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71293 . 71513) (DIGITBASEP 71515 . 72249) ( +READNUMBERINBASE 72251 . 74137) (ESTIMATE-DIMENSIONALITY 74139 . 74464) (SKIP.HASH.COMMENT 74466 . +75434) (CMLREAD.FEATURE.PARSER 75436 . 76040)) (76086 82430 (CHARACTER.READ 76096 . 77350) ( +CHARCODE.DECODE 77352 . 82428)) (82431 85601 (HEXNUM? 82441 . 84784) (OCTALNUM? 84786 . 85599))))) STOP diff --git a/sources/LLREAD.LCOM b/sources/LLREAD.LCOM index 3d0b8de0..7783332c 100644 Binary files a/sources/LLREAD.LCOM and b/sources/LLREAD.LCOM differ diff --git a/sources/LOADUP-LISP b/sources/LOADUP-LISP index a6cacd14..a2f54a70 100644 --- a/sources/LOADUP-LISP +++ b/sources/LOADUP-LISP @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "12-Aug-2022 12:29:57" |{DSK}larry>medley>sources>LOADUP-LISP.;2| 5250 +(FILECREATED "27-Feb-2023 17:15:53" |{DSK}larry>il>medley>sources>LOADUP-LISP.;2| 5263 - :CHANGES-TO (VARS LOADUP-LISPCOMS) + :EDIT-BY "lmm" - :PREVIOUS-DATE "13-Jul-2022 14:10:00" |{DSK}larry>medley>sources>LOADUP-LISP.;1|) + :CHANGES-TO (FNS LOADUP-LISP) + + :PREVIOUS-DATE "12-Aug-2022 12:29:57" |{DSK}larry>il>medley>sources>LOADUP-LISP.;1|) (PRETTYCOMPRINT LOADUP-LISPCOMS) @@ -17,10 +19,9 @@ (DEFINEQ (LOADUP-LISP - (LAMBDA NIL (* \; "Edited 13-Jul-2022 14:09 by rmk") + (LAMBDA NIL (* \; "Edited 26-Feb-2023 12:17 by lmm") + (* \; "Edited 13-Jul-2022 14:09 by rmk") (* \; "Edited 4-Mar-2022 19:13 by larry") - (* \; "Edited 2-Mar-2022 16:31 by larry") - (* \; "Edited 28-Feb-2022 15:02 by larry") (* \; "Edited 29-Apr-2021 22:30 by rmk:") (SETQQ COMPILE.EXT LCOM) (MEDLEY-INIT-VARS) (* \; "should be set earlier") @@ -99,6 +100,10 @@ (LOADUP '(CMLSMARTARGS)) (LOADUP '(IMPLICIT-KEY-HASH CLOSURE-CACHE)) + (* |;;| " not sure what this depends on, so putting it here") + + (LOADUP '(BIGBITMAPS)) + (* |;;| "Already enabled, but this time fixes tables that weren't defined in the init") (PACKAGE-ENABLE) @@ -119,5 +124,5 @@ (GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST) ) (DECLARE\: DONTCOPY - (FILEMAP (NIL (631 5044 (LOADUP-LISP 641 . 5042))))) + (FILEMAP (NIL (654 5057 (LOADUP-LISP 664 . 5055))))) STOP diff --git a/sources/LOADUP-LISP.LCOM b/sources/LOADUP-LISP.LCOM index 79019e09..8e01adf6 100644 Binary files a/sources/LOADUP-LISP.LCOM and b/sources/LOADUP-LISP.LCOM differ diff --git a/sources/MEDLEYDIR b/sources/MEDLEYDIR index 9f9369e9..33de3b4a 100644 --- a/sources/MEDLEYDIR +++ b/sources/MEDLEYDIR @@ -1,10 +1,10 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "22-Nov-2022 20:50:20" {DSK}frank>il>medley>wmedley>sources>MEDLEYDIR.;10 10271 +(FILECREATED "17-Jul-2023 16:13:10" {DSK}frank>il>medley>gmedley>sources>MEDLEYDIR.;2 9970 - :CHANGES-TO (FNS MEDLEY-INIT-VARS) + :CHANGES-TO (VARS MEDLEY-INIT-VARS) - :PREVIOUS-DATE "21-Nov-2022 17:31:30" {DSK}frank>il>medley>wmedley>sources>MEDLEYDIR.;9 + :PREVIOUS-DATE "22-Apr-2023 11:53:53" {DSK}frank>il>medley>gmedley>sources>MEDLEYDIR.;1 ) @@ -165,7 +165,7 @@ (RPAQQ MEDLEY-INIT-VARS - [[LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"] + ([LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"] [LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"] (LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES)) (IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo")) @@ -190,12 +190,10 @@ (USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM)) (CONS LOGINHOST/DIR '("INIT"] RESET) - (XCL::*WHERE-IS-CASH-FILES* (COND ((GETD 'XCL::ADD-WHERE-IS-DATABASE) - (SETQ XCL::*WHERE-IS-CASH-FILES* NIL) - (NLSETQ (XCL::ADD-WHERE-IS-DATABASE (MEDLEYDIR "loadups" - "WHEREIS.HASH" - NIL T))) - XCL::*WHERE-IS-CASH-FILES*]) + (XCL::*WHERE-IS-CASH-FILES* (MEDLEYDIR '("loadups") + "whereis.hash" NIL T)) + (LOADUPSDIRECTORIES (MEDLEYDIR '("loadups") + NIL NIL T)))) (DECLARE%: EVAL@COMPILE DOCOPY (ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES) diff --git a/sources/MEDLEYDIR.LCOM b/sources/MEDLEYDIR.LCOM index 7b1a1dae..89fb6db2 100644 Binary files a/sources/MEDLEYDIR.LCOM and b/sources/MEDLEYDIR.LCOM differ diff --git a/sources/SEDIT-LIST-FORMATS b/sources/SEDIT-LIST-FORMATS index e8be5b90..c02be5fa 100644 --- a/sources/SEDIT-LIST-FORMATS +++ b/sources/SEDIT-LIST-FORMATS @@ -1,14 +1,16 @@ (DEFINE-FILE-INFO PACKAGE "SEDIT" READTABLE "XCL" BASE 10) -(IL:FILECREATED "17-May-90 11:08:07" IL:|{DSK}local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;2| 9591 - IL:|changes| IL:|to:| (IL:FILES IL:SEDIT-INDENT) - (IL:VARS IL:SEDIT-LIST-FORMATSCOMS) +(IL:FILECREATED "17-Jun-2023 19:46:35" IL:|{WMEDLEY}SEDIT-LIST-FORMATS.;2| 9581 - IL:|previous| IL:|date:| "18-Nov-88 10:56:22" -IL:|{DSK}local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;1|) + :EDIT-BY IL:|rmk| + + :CHANGES-TO (IL:SEDIT-FORMATS IL:SELECTC) + (IL:VARS IL:SEDIT-LIST-FORMATSCOMS) + + :PREVIOUS-DATE "17-May-90 11:08:07" IL:|{WMEDLEY}SEDIT-LIST-FORMATS.;1|) -; Copyright (c) 1987, 1988, 1990 by Venue & Xerox Corporation. All rights reserved. +; Copyright (c) 1987-1988, 1990 by Venue & Xerox Corporation. (IL:PRETTYCOMPRINT IL:SEDIT-LIST-FORMATSCOMS) @@ -19,7 +21,7 @@ IL:|{DSK}local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;1|) (IL:SEDIT-FORMATS RETURN-FROM THROW BLOCK (IL:* IL:|;;| - "some handy formats under names we don't expect to find as CAR of form") + "some handy formats under names we don't expect to find as CAR of form") :DEFAULT :DATA :BINDING :BINDING-LIST :LAMBDA-LIST :FBINDING :FBINDING-LIST :COND-CLAUSE :CASE-CLAUSE :HORIZONTAL :HORIZONTAL-NOBREAK :VERTICAL @@ -36,9 +38,9 @@ IL:|{DSK}local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;1|) ECASE ERROR ETYPECASE EVAL-WHEN FLET FORMAT IF IGNORE-ERRORS LABELS LAMBDA IL:LAMBDA LET LET* LOCALLY LIST LIST* MACROLET MULTIPLE-VALUE-BIND MULTIPLE-VALUE-SETQ IL:NLAMBDA IL:OPENLAMBDA OR IL:P PROCEED-CASE PROG PROG* PROGN - PROGV RESTART-CASE IL:SELCHARQ IL:SELECTQ TAGBODY THE TYPECASE UNDOABLY UNLESS - UNWIND-PROTECT WHEN WITH-INPUT-FROM-STRING WITH-OUTPUT-TO-STRING WITH-OPEN-FILE - WITH-OPEN-STREAM IL:WITH.MONITOR IL:WITH.FAST.MONITOR IL:WITH.SPY))) + PROGV RESTART-CASE IL:SELCHARQ IL:SELECTQ IL:SELECTC TAGBODY THE TYPECASE UNDOABLY + UNLESS UNWIND-PROTECT WHEN WITH-INPUT-FROM-STRING WITH-OUTPUT-TO-STRING + WITH-OPEN-FILE WITH-OPEN-STREAM IL:WITH.MONITOR IL:WITH.FAST.MONITOR IL:WITH.SPY))) (IL:PUTPROPS IL:SEDIT-LIST-FORMATS IL:FILETYPE :COMPILE-FILE) @@ -148,7 +150,7 @@ IL:|{DSK}local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;1|) (DEF-LIST-FORMAT DEFCONSTANT DEFVAR) (DEF-LIST-FORMAT DEFDEFINER :INDENT ((2) - 1) + 1) :ARGS (:KEYWORD :CASE-CLAUSE NIL :LAMBDA-LIST NIL)) (DEF-LIST-FORMAT DEFUN :INDENT ((2)) @@ -309,6 +311,8 @@ IL:|{DSK}local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;1|) :ARGS (:KEYWORD NIL :CASE-CLAUSE) :LAST NIL) +(DEF-LIST-FORMAT IL:SELECTC IL:SELECTQ) + (DEF-LIST-FORMAT TAGBODY :INDENT (:TAGBODY :STEP 0) :ARGS (:KEYWORD NIL)) diff --git a/sources/SEDIT-LIST-FORMATS.DFASL b/sources/SEDIT-LIST-FORMATS.DFASL index a385b5f1..1fa4daba 100644 Binary files a/sources/SEDIT-LIST-FORMATS.DFASL and b/sources/SEDIT-LIST-FORMATS.DFASL differ diff --git a/sources/SEDIT-WINDOW b/sources/SEDIT-WINDOW index 3be6a4fb..79766069 100644 --- a/sources/SEDIT-WINDOW +++ b/sources/SEDIT-WINDOW @@ -1,18 +1,19 @@ -(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE SEDIT (USE LISP XCL))) -(IL:FILECREATED "14-May-2018 14:12:02"  -IL:|{DSK}kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;2| 84658 +(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE SEDIT (USE LISP XCL)) READTABLE "XCL" BASE 10) - IL:|changes| IL:|to:| (IL:FNS BUTTONEVENTFN) +(IL:FILECREATED "13-Jul-2023 14:28:53" IL:|{WMEDLEY}SEDIT-WINDOW.;6| 87869 - IL:|previous| IL:|date:| " 2-Apr-92 11:08:50" -IL:|{DSK}kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|) + :EDIT-BY IL:|rmk| + + :CHANGES-TO (IL:FNS BUTTONEVENTFN) + + :PREVIOUS-DATE "13-Jul-2023 14:06:39" IL:|{WMEDLEY}SEDIT-WINDOW.;5|) -; Copyright (c) 1986, 1987, 1988, 1990, 1991, 1992, 2018 by Venue & Xerox Corporation. All rights reserved. +; Copyright (c) 1986-1988, 1990-1992, 2018 by Venue & Xerox Corporation. (IL:PRETTYCOMPRINT IL:SEDIT-WINDOWCOMS) -(IL:RPAQQ IL:SEDIT-WINDOWCOMS +(IL:RPAQQ IL:SEDIT-WINDOWCOMS ((IL:PROP IL:FILETYPE IL:SEDIT-WINDOW) (IL:PROP IL:MAKEFILE-ENVIRONMENT IL:SEDIT-WINDOW) (IL:LOCALVARS . T) @@ -36,11 +37,11 @@ IL:|{DSK}kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|) SET-SELECTION-NOWHERE SHIFT-DOWN SHOW-CARET SHRINKFN STRING-OFFSET TRACK-EXTEND TRACK-SELECT UNDERLINE-SELECTION UPDATE-TITLE))) -(IL:PUTPROPS IL:SEDIT-WINDOW IL:FILETYPE :COMPILE-FILE) +(IL:PUTPROPS IL:SEDIT-WINDOW IL:FILETYPE :COMPILE-FILE) -(IL:PUTPROPS IL:SEDIT-WINDOW IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE - (DEFPACKAGE IL:SEDIT (:USE IL:LISP - IL:XCL)))) +(IL:PUTPROPS IL:SEDIT-WINDOW IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE + (DEFPACKAGE IL:SEDIT (:USE IL:LISP IL:XCL + )))) (IL:DECLARE\: IL:DOEVAL@COMPILE IL:DONTCOPY (IL:LOCALVARS . T) @@ -58,40 +59,64 @@ IL:|{DSK}kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|) (IL:RPAQQ ICON-TITLE-REGION (5 16 130 24)) -(IL:RPAQ TITLED-ICON (IL:CREATE IL:TITLEDICON IL:ICON IL:_ ICON IL:MASK IL:_ ICON-MASK - IL:TITLEREG IL:_ ICON-TITLE-REGION)) +(IL:RPAQ TITLED-ICON (IL:CREATE IL:TITLEDICON IL:ICON IL:_ ICON IL:MASK IL:_ ICON-MASK IL:TITLEREG + IL:_ ICON-TITLE-REGION)) (IL:RPAQQ KEEP-WINDOW-REGION T) (IL:DECLARE\: IL:DONTCOPY (IL:DECLARE\: IL:EVAL@COMPILE -(IL:PUTPROPS IN-TITLE-BAR IL:MACRO ((WINDOW) +(IL:PUTPROPS IN-TITLE-BAR IL:MACRO ((WINDOW) (NOT (IL:INSIDEP (IL:DSPCLIPPINGREGION NIL WINDOW) (IL:LASTMOUSEX WINDOW) (IL:LASTMOUSEY WINDOW))))) -(IL:PUTPROPS TRACK-BAR-IN-TRACK-SELECT IL:MACRO - (NIL (WHEN (OR (IL:NEQ POINT? (IL:|fetch| POINT-TYPE IL:|of| PENDING-CARET)) - (IL:NEQ BAR-X (IL:|fetch| POINT-X IL:|of| PENDING-CARET)) - (IL:NEQ BAR-LINE (IL:|fetch| POINT-LINE IL:|of| PENDING-CARET))) - (WHEN POINT? - (IL:BLTSHADE IL:BLACKSHADE WINDOW BAR-X BAR-Y 1 BAR-HEIGHT 'IL:INVERT)) - (WHEN (IL:SETQ POINT? (IL:|fetch| POINT-TYPE IL:|of| PENDING-CARET)) - (IL:SETQ BAR-X (IL:|fetch| POINT-X IL:|of| PENDING-CARET)) - (IL:SETQ BAR-LINE (IL:|fetch| POINT-LINE IL:|of| PENDING-CARET)) - (IL:SETQ BAR-HEIGHT (IL:IPLUS (IL:|fetch| LINE-ASCENT IL:|of| BAR-LINE) - (IL:|fetch| LINE-DESCENT IL:|of| BAR-LINE))) - (IL:SETQ BAR-Y (IL:IDIFFERENCE (IL:|fetch| YCOORD IL:|of| BAR-LINE) - (IL:IPLUS (IL:|fetch| LINE-SKIP IL:|of| BAR-LINE) - BAR-HEIGHT))) - (IL:BLTSHADE IL:BLACKSHADE WINDOW BAR-X BAR-Y 1 BAR-HEIGHT 'IL:INVERT))))) +(IL:PUTPROPS TRACK-BAR-IN-TRACK-SELECT IL:MACRO (NIL (WHEN (OR (IL:NEQ POINT? (IL:|fetch| POINT-TYPE + IL:|of| + PENDING-CARET) + ) + (IL:NEQ BAR-X (IL:|fetch| POINT-X + IL:|of| PENDING-CARET + )) + (IL:NEQ BAR-LINE (IL:|fetch| + POINT-LINE + IL:|of| + PENDING-CARET + ))) + (WHEN POINT? + (IL:BLTSHADE IL:BLACKSHADE WINDOW BAR-X + BAR-Y 1 BAR-HEIGHT 'IL:INVERT)) + (WHEN (IL:SETQ POINT? (IL:|fetch| POINT-TYPE + IL:|of| + PENDING-CARET + )) + (IL:SETQ BAR-X (IL:|fetch| POINT-X + IL:|of| PENDING-CARET) + ) + (IL:SETQ BAR-LINE (IL:|fetch| POINT-LINE + IL:|of| + PENDING-CARET + )) + (IL:SETQ BAR-HEIGHT + (IL:IPLUS (IL:|fetch| LINE-ASCENT + IL:|of| BAR-LINE) + (IL:|fetch| LINE-DESCENT + IL:|of| BAR-LINE))) + (IL:SETQ BAR-Y + (IL:IDIFFERENCE (IL:|fetch| YCOORD + IL:|of| BAR-LINE) + (IL:IPLUS (IL:|fetch| LINE-SKIP + IL:|of| BAR-LINE) + BAR-HEIGHT))) + (IL:BLTSHADE IL:BLACKSHADE WINDOW BAR-X + BAR-Y 1 BAR-HEIGHT 'IL:INVERT))))) ) ) (DEFUN SELECT-NODE-SEGMENT (CONTEXT NODE &OPTIONAL (START 1) - END) + END) -(IL:* IL:|;;;| "set the current selection to be a segment under this node") +(IL:* IL:|;;;| "set the current selection to be a segment under this node") (LET ((SELECTION (IL:FETCH SELECTION IL:OF CONTEXT)) (POINT (IL:FETCH CARET-POINT IL:OF CONTEXT))) @@ -100,7 +125,7 @@ IL:|{DSK}kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|) (IL:|replace| SELECT-END IL:|of| SELECTION IL:|with| END) (SELECT-SEGMENT SELECTION CONTEXT NODE) - (IL:* IL:|;;| "set point to be the selection. This should really be done by select-segment but it doesn't because it expects finalization code to be run after it cause it's generally called from the mouse tracking code which finalizes.") + (IL:* IL:|;;| "set point to be the selection. This should really be done by select-segment but it doesn't because it expects finalization code to be run after it cause it's generally called from the mouse tracking code which finalizes.") (PENDING-DELETE POINT SELECTION))) (IL:DEFINEQ @@ -182,9 +207,12 @@ IL:|{DSK}kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|) (IL:DSPRIGHTMARGIN 64000 DISPLAY-WINDOW)))) (BUTTONEVENTFN - (IL:LAMBDA (WINDOW) (IL:* IL:\; "Edited 23-Apr-2018 09:37 by rmk:") + (IL:LAMBDA (WINDOW) (IL:* IL:\; "Edited 13-Jul-2023 14:27 by rmk") + (IL:* IL:\; "Edited 20-Jun-2023 21:10 by rmk") + (IL:* IL:\; "Edited 17-Jun-2023 19:59 by rmk") + (IL:* IL:\; "Edited 23-Apr-2018 09:37 by rmk:") - (IL:* IL:|;;| "called by the window system whenever the user hits a mouse button in an SEdit window. allows selection and setting the caret point") + (IL:* IL:|;;| "called by the window system whenever the user hits a mouse button in an SEdit window. allows selection and setting the caret point") (LET* ((CONTEXT (IL:WINDOWPROP WINDOW 'EDIT-CONTEXT)) (LOCK (AND CONTEXT (IL:|fetch| CONTEXT-LOCK IL:|of| CONTEXT))) @@ -192,12 +220,12 @@ IL:|{DSK}kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|) (COND ((IL:LASTMOUSESTATE IL:UP) - (IL:* IL:|;;| "oops, no mouse buttons down. what are we doing here?") + (IL:* IL:|;;| "oops, no mouse buttons down. what are we doing here?") NIL) ((NOT (AND CONTEXT (IL:WINDOWPROP WINDOW 'IL:PROCESS))) - (IL:* IL:|;;| "this context or process is dead. make it a dead SEdit.") + (IL:* IL:|;;| "this context or process is dead. make it a dead SEdit.") (IL:|printout| (IL:GETPROMPTWINDOW WINDOW) T "This SEdit is dead.") @@ -209,21 +237,35 @@ IL:|{DSK}kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|) ((AND (IL:LASTMOUSESTATE IL:RIGHT) (IN-TITLE-BAR WINDOW)) - (IL:* IL:|;;| "right buttoning the title bar or window border gives the default menu of window commands. Not interlocked because want to be able to move window under a break that has the lock.") + (IL:* IL:|;;| "right buttoning the title bar or window border gives the default menu of window commands. Not interlocked because want to be able to move window under a break that has the lock.") (IL:\\CARET.DOWN) (IL:DOWINDOWCOM WINDOW)) ((AND (NOT (IL:TTY.PROCESSP (IL:WINDOWPROP WINDOW 'IL:PROCESS))) (NOT SHIFT-DOWN)) - (IL:* IL:|;;| "just grab the tty and don't change state") + (IL:* IL:|;;| "just grab the tty and don't change state") (IL:TOTOPW WINDOW) (IL:TTY.PROCESS (IL:WINDOWPROP WINDOW 'IL:PROCESS))) + ((AND (EQ SHIFT-DOWN 'COPY) + (IL:MOUSESTATE IL:LEFT) + (IN-TITLE-BAR WINDOW)) + + (IL:* IL:|;;| "RMK: copy-select in the title bar: return the thing being edited. Previous attempt was too immediate, did not conform to usual mouse-up conventions.") + + (IL:WHILE (EQ 'COPY (SHIFT-DOWN))) + (IL:GETMOUSESTATE) + (WHEN (IN-TITLE-BAR WINDOW) + (LET ((NAME (IL:LISTGET (IL:WINDOWPROP WINDOW 'TITLE-INFO) + :|name|))) + (WHEN NAME (IL:* IL:\; + "Not sure about FLG and RDTBL") + (IL:COPYINSERT NAME))))) ((OR (EQ SHIFT-DOWN 'COPY) (IL:OBTAIN.MONITORLOCK LOCK T)) - (IL:* IL:|;;| "at this point we must have the lock, unless we're shift selecting (Copy only: Move and Delete are non-passive operation and must lock)") + (IL:* IL:|;;| "at this point we must have the lock, unless we're shift selecting (Copy only: Move and Delete are non-passive operation and must lock)") (IL:\\CARET.DOWN) (IL:TOTOPW WINDOW) @@ -233,31 +275,27 @@ IL:|{DSK}kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|) (AND (IL:LASTMOUSESTATE IL:LEFT) (IL:KEYDOWNP 'IL:CTRL)))) - (IL:* IL:|;;| "popup help command menu here.") + (IL:* IL:|;;| "popup help command menu here.") - (IL:* IL:|;;| "RMK: CTRL-LEFT = MIDDLE") + (IL:* IL:|;;| "RMK: CTRL-LEFT = MIDDLE") (HELPMENU CONTEXT)) (T (WITH-PROFILE (IL:|fetch| PROFILE IL:|of| CONTEXT) (PROG NIL (CLOSE-OPEN-NODE CONTEXT) - (IL:* IL:|;;| "record that we're busy making a selection in this window, and make sure that variables we use for recording our temporary state are all ready for action. note that these are global vars, and hence all this code is nonrentrant. shouldn't be a problem, since there's only one mouse") + (IL:* IL:|;;| "record that we're busy making a selection in this window, and make sure that variables we use for recording our temporary state are all ready for action. note that these are global vars, and hence all this code is nonrentrant. shouldn't be a problem, since there's only one mouse") (IL:SETQ SELECTION-PENDING? CONTEXT) - (IL:SETQ PENDING-LAST-X (IL:|fetch| LAST-MOUSE-X IL:|of| - CONTEXT)) - (IL:SETQ PENDING-LAST-Y (IL:|fetch| LAST-MOUSE-Y IL:|of| - CONTEXT)) - (IL:SETQ PENDING-TYPE (IL:|fetch| LAST-MOUSE-TYPE IL:|of| - CONTEXT)) + (IL:SETQ PENDING-LAST-X (IL:|fetch| LAST-MOUSE-X IL:|of| CONTEXT)) + (IL:SETQ PENDING-LAST-Y (IL:|fetch| LAST-MOUSE-Y IL:|of| CONTEXT)) + (IL:SETQ PENDING-TYPE (IL:|fetch| LAST-MOUSE-TYPE IL:|of| CONTEXT)) (IL:SETQ PENDING-SHIFT SHIFT-DOWN) - (IL:|replace| SELECT-NODE IL:|of| PENDING-SELECTION - IL:|with| NIL) + (IL:|replace| SELECT-NODE IL:|of| PENDING-SELECTION IL:|with| NIL) (WHEN (NOT PENDING-SHIFT) - (IL:* IL:|;;| - "if they're setting a new selection take down the main selection") + (IL:* IL:|;;| + "if they're setting a new selection take down the main selection") (SELECTION-DOWN CONTEXT)) (IL:SETQ LAST-MOVE-CLOCK NIL) @@ -268,15 +306,15 @@ IL:|{DSK}kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|) (TRACK-SELECT CONTEXT WINDOW)) (IL:|until| (CHECK-SELECTION-SHIFT CONTEXT T) IL:|do| (WHEN (NOT (IL:MOUSESTATE IL:UP)) - (GO MOUSE-BUTTON-DOWN)) + (GO MOUSE-BUTTON-DOWN)) (WHEN (IL:IN/SCROLL/BAR? WINDOW IL:LASTMOUSEX IL:LASTMOUSEY - ) (IL:* IL:\; - "let them scroll while making a selection") + ) (IL:* IL:\; + "let them scroll while making a selection") (IL:SCROLL.HANDLER WINDOW)) (IL:BLOCK)) (IL:SETQ SELECTION-PENDING? NIL) - (IL:* IL:\; - "figure out what we should do") + (IL:* IL:\; + "figure out what we should do") (FINALIZE-MOUSE-SELECTION CONTEXT WINDOW))))) (OR (EQ SHIFT-DOWN 'COPY) (IL:RELEASE.MONITORLOCK LOCK))))))) @@ -781,22 +819,22 @@ IL:|{DSK}kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|) (IL:PUTPROPS IL:SEDIT-WINDOW IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 1992 2018)) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (9049 9957 (SELECT-NODE-SEGMENT 9049 . 9957)) (9958 84520 (BUILD-WINDOW 9971 . 15811) - (BUTTONEVENTFN 15813 . 21522) (CHECK-SELECTION 21524 . 23564) (CHECK-SELECTION-SHIFT 23566 . 24689) ( -CLOSEFN 24691 . 27694) (CONFLICTING-SELECTION? 27696 . 28457) (DISPLAY-SELECTION 28459 . 29486) ( -DRAW-HIGHLIGHT 29488 . 30618) (DRAW-OUTLINE 30620 . 31975) (DRAW-UNDERLINE 31977 . 32752) (EXPANDFN -32754 . 33261) (EXPANDREGIONFN 33263 . 33853) (EXTEND-SELECTION 33855 . 36432) ( -FINALIZE-MOUSE-SELECTION 36434 . 42980) (FIND-LINE-START 42982 . 43673) (FIND-NODE 43675 . 44950) ( -GET-DESTINATION-CONTEXT 44952 . 45504) (GRAY 45506 . 45893) (GROW-CLICK? 45895 . 47880) ( -GROW-SELECTION 47882 . 48225) (GROW-SELECTION-DEFAULT 48227 . 48598) (HIGHLIGHT-SELECTION 48600 . -48893) (ICON-COPYFN 48895 . 49239) (LESS-PROMPT-WINDOW 49241 . 49610) (NORMALIZE-SELECTION 49612 . -50978) (OUTLINE-SELECTION 50980 . 52118) (PENDING-DELETE 52120 . 52454) (PLACE-CARET-AND-SELECTION -52456 . 54016) (PUNT-SET-POINT 54018 . 54476) (PUNT-SET-SELECTION 54478 . 54927) (REPAINTFN 54929 . -56207) (RESHAPEFN 56209 . 58547) (SCAN-FOR-BOUNDS 58549 . 61092) (SELECT-NODE 61094 . 61464) ( -SELECT-SEGMENT 61466 . 61906) (SELECT-SEGMENT-DEFAULT 61908 . 63935) (SELECTION-DOWN 63937 . 64347) ( -SELECTION-UP 64349 . 64775) (SET-POINT 64777 . 65536) (SET-POINT-NOWHERE 65538 . 65797) ( -SET-POINT-UNKNOWN 65799 . 66420) (SET-SELECTION 66422 . 66855) (SET-SELECTION-ME 66857 . 67949) ( -SET-SELECTION-NOWHERE 67951 . 68149) (SHIFT-DOWN 68151 . 68692) (SHOW-CARET 68694 . 74252) (SHRINKFN -74254 . 76989) (STRING-OFFSET 76991 . 78351) (TRACK-EXTEND 78353 . 80409) (TRACK-SELECT 80411 . 82900) - (UNDERLINE-SELECTION 82902 . 83304) (UPDATE-TITLE 83306 . 84518))))) + (IL:FILEMAP (NIL (11430 12334 (SELECT-NODE-SEGMENT 11430 . 12334)) (12335 87731 (BUILD-WINDOW 12348 . +18188) (BUTTONEVENTFN 18190 . 24733) (CHECK-SELECTION 24735 . 26775) (CHECK-SELECTION-SHIFT 26777 . +27900) (CLOSEFN 27902 . 30905) (CONFLICTING-SELECTION? 30907 . 31668) (DISPLAY-SELECTION 31670 . 32697 +) (DRAW-HIGHLIGHT 32699 . 33829) (DRAW-OUTLINE 33831 . 35186) (DRAW-UNDERLINE 35188 . 35963) (EXPANDFN + 35965 . 36472) (EXPANDREGIONFN 36474 . 37064) (EXTEND-SELECTION 37066 . 39643) ( +FINALIZE-MOUSE-SELECTION 39645 . 46191) (FIND-LINE-START 46193 . 46884) (FIND-NODE 46886 . 48161) ( +GET-DESTINATION-CONTEXT 48163 . 48715) (GRAY 48717 . 49104) (GROW-CLICK? 49106 . 51091) ( +GROW-SELECTION 51093 . 51436) (GROW-SELECTION-DEFAULT 51438 . 51809) (HIGHLIGHT-SELECTION 51811 . +52104) (ICON-COPYFN 52106 . 52450) (LESS-PROMPT-WINDOW 52452 . 52821) (NORMALIZE-SELECTION 52823 . +54189) (OUTLINE-SELECTION 54191 . 55329) (PENDING-DELETE 55331 . 55665) (PLACE-CARET-AND-SELECTION +55667 . 57227) (PUNT-SET-POINT 57229 . 57687) (PUNT-SET-SELECTION 57689 . 58138) (REPAINTFN 58140 . +59418) (RESHAPEFN 59420 . 61758) (SCAN-FOR-BOUNDS 61760 . 64303) (SELECT-NODE 64305 . 64675) ( +SELECT-SEGMENT 64677 . 65117) (SELECT-SEGMENT-DEFAULT 65119 . 67146) (SELECTION-DOWN 67148 . 67558) ( +SELECTION-UP 67560 . 67986) (SET-POINT 67988 . 68747) (SET-POINT-NOWHERE 68749 . 69008) ( +SET-POINT-UNKNOWN 69010 . 69631) (SET-SELECTION 69633 . 70066) (SET-SELECTION-ME 70068 . 71160) ( +SET-SELECTION-NOWHERE 71162 . 71360) (SHIFT-DOWN 71362 . 71903) (SHOW-CARET 71905 . 77463) (SHRINKFN +77465 . 80200) (STRING-OFFSET 80202 . 81562) (TRACK-EXTEND 81564 . 83620) (TRACK-SELECT 83622 . 86111) + (UNDERLINE-SELECTION 86113 . 86515) (UPDATE-TITLE 86517 . 87729))))) IL:STOP diff --git a/sources/SEDIT-WINDOW.DFASL b/sources/SEDIT-WINDOW.DFASL index f1c9091f..35401b20 100644 Binary files a/sources/SEDIT-WINDOW.DFASL and b/sources/SEDIT-WINDOW.DFASL differ diff --git a/sources/XXGEOM b/sources/XXGEOM index 3c738f96..fba9c4ae 100644 --- a/sources/XXGEOM +++ b/sources/XXGEOM @@ -1,36 +1,30 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED "13-Jun-2021 14:39:29"  -{DSK}kaplan>Local>medley3.5>git-medley>sources>XXGEOM.;2 49841 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (VARS XXGEOMCOMS) - (RECORDS XXLINE) - (FNS MAKELINE LINE.LESSP) - (MACROS \GETLINEORIGY \GETLINEDIFFY) +(FILECREATED "14-May-2023 15:47:43" {DSK}larry>il>medley>sources>XXGEOM.;5 48712 - previous date%: "19-Jan-93 11:30:54" -{DSK}kaplan>Local>medley3.5>git-medley>sources>XXGEOM.;1) + :EDIT-BY "lmm" + :CHANGES-TO (MACROS GETLINEORIG) + + :PREVIOUS-DATE "13-Jun-2021 14:39:29" {DSK}larry>il>medley>sources>XXGEOM.;4) -(* ; " -Copyright (c) 1985-1987, 1990, 1993, 2021 by Venue & Xerox Corporation. -") (PRETTYCOMPRINT XXGEOMCOMS) (RPAQQ XXGEOMCOMS ( -(* ;;; "Integer Geometry Library") +(* ;;; "Integer Geometry Library") -(* ;;; "Scalar methods") +(* ;;; "Scalar methods") (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS \SGN)) (FNS \IRND) -(* ;;; "XYpt object and methods") +(* ;;; "XYpt object and methods") (RECORDS XYPT) (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS XYPT.X XYPT.Y)) @@ -39,7 +33,7 @@ Copyright (c) 1985-1987, 1990, 1993, 2021 by Venue & Xerox Corporation. MMLTLIST IMLTLIST XYPT.LESSP PATH.LESSP CONVEXP) -(* ;;; "Line object and methods") +(* ;;; "Line object and methods") (RECORDS XXLINE) (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS GETLINEDIFF GETLINEORIG \GETLINEDIFF \GETLINEORIGY @@ -48,24 +42,24 @@ Copyright (c) 1985-1987, 1990, 1993, 2021 by Venue & Xerox Corporation. (FNS LINEY MIDDX INITX TERMX SCANX XPROD) -(* ;;; "line segment methods") +(* ;;; "line segment methods") (FNS XYSECTLSEG) -(* ;;; "Bresenham line object and methods") +(* ;;; "Bresenham line object and methods") (RECORDS BRES) (FNS MAKEBRES) (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS BRESSTEP)) -(* ;;; "Debugging control panel") +(* ;;; "Debugging control panel") (DECLARE%: EVAL@COMPILE DONTCOPY (VARS \GEOM.PANEL)) -(* ;;; "Trapezoidal decomposition") +(* ;;; "Trapezoidal decomposition") (FNS TRAPLOOP TRAPMAKE) (VARS TRAP.DEBUG) @@ -84,11 +78,11 @@ Copyright (c) 1985-1987, 1990, 1993, 2021 by Venue & Xerox Corporation. (DECLARE%: EVAL@COMPILE (PUTPROPS \SGN DMACRO ((VAL) - (if (IGREATERP VAL 0) - then 1 - elseif (ILESSP VAL 0) - then -1 - else 0))) + (if (IGREATERP VAL 0) + then 1 + elseif (ILESSP VAL 0) + then -1 + else 0))) ) ) (DEFINEQ @@ -119,26 +113,26 @@ Copyright (c) 1985-1987, 1990, 1993, 2021 by Venue & Xerox Corporation. (DECLARE%: EVAL@COMPILE (PUTPROPS XYPT.X DMACRO ((PT) - (CAR PT))) + (CAR PT))) (PUTPROPS XYPT.Y DMACRO ((PT) - (CDR PT))) + (CDR PT))) ) ) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE (PUTPROPS HEADPT DMACRO ((PATH) - (CAR PATH))) + (CAR PATH))) (PUTPROPS NEXTPT DMACRO ((PATH) - (CADR PATH))) + (CADR PATH))) (PUTPROPS HEADPTY DMACRO ((PATH) - (CDAR PATH))) + (CDAR PATH))) (PUTPROPS NEXTPTY DMACRO ((PATH) - (CDADR PATH))) + (CDADR PATH))) ) ) (DEFINEQ @@ -587,35 +581,30 @@ Copyright (c) 1985-1987, 1990, 1993, 2021 by Venue & Xerox Corporation. (PUTPROPS GETLINEDIFF DMACRO [(SELF DX DY) - (* ;; "External method, get dx, dy from line") + (* ;; "External method, get dx, dy from line") - (WITH LINE SELF (SETQ DX (ffetch (XYPT X) of DIFF)) - (SETQ DY (ffetch (XYPT Y) OF DIFF]) + (WITH XXLINE SELF (SETQ DX (ffetch (XYPT X) of DIFF)) + (SETQ DY (ffetch (XYPT Y) OF DIFF]) (PUTPROPS GETLINEORIG DMACRO [(SELF OX OY) - (* ;; "External method, get dx, dy from line") + (* ;; "External method, get dx, dy from line") - (WITH LINE SELF (SETQ OX (ffetch (XYPT X) of ORIG)) - (SETQ OY (ffetch (XYPT Y) OF ORIG]) + (WITH XXLINE SELF (SETQ OX (ffetch (XYPT X) of ORIG)) + (SETQ OY (ffetch (XYPT Y) OF ORIG]) -(PUTPROPS \GETLINEDIFF DMACRO [(SELF DX DY) (* edited " 1-Jan-00 00:00") +(PUTPROPS \GETLINEDIFF DMACRO [(SELF DX DY) (* edited " 1-Jan-00 00:00") - (* ;; "Degenerate private method, get dx, dy from line") + (* ;; "Degenerate private method, get dx, dy from line") - (WITH LINE SELF (SETQ DX (FFETCH (XYPT X) OF - DIFF)) - (SETQ DY (FFETCH (XYPT T) OF DIFF]) + (WITH XXLINE SELF (SETQ DX (FFETCH (XYPT X) OF DIFF)) + (SETQ DY (FFETCH (XYPT T) OF DIFF]) (PUTPROPS \GETLINEORIGY DMACRO [(SELF YPTR) - (SETQ YPTR (FFETCH (XYPT Y) of (FFETCH - (XXLINE ORIG) - of SELF]) + (SETQ YPTR (FFETCH (XYPT Y) of (FFETCH (XXLINE ORIG) of SELF]) (PUTPROPS \GETLINEDIFFY DMACRO [(SELF YPTR) - (SETQ YPTR (FFETCH (XYPT Y) of (FFETCH - (XXLINE DIFF) - of SELF]) + (SETQ YPTR (FFETCH (XYPT Y) of (FFETCH (XXLINE DIFF) of SELF]) ) ) (DEFINEQ @@ -990,54 +979,53 @@ Copyright (c) 1985-1987, 1990, 1993, 2021 by Venue & Xerox Corporation. (PUTPROPS BRESSTEP DMACRO ((SELF SCANY INITX TERMX) - (* * Assume that this Y is exactly incremented by one from the last call, so - DDA can be used. Then passed parameter scany is not used.) + (* * Assume that this Y is exactly incremented by one from the last call, so DDA + can be used. Then passed parameter scany is not used.) - (* * (WITH BRES SELF (*) (SETQ INITX X) - (IF (EQ MAJOR (QUOTE X)) THEN (while (ILESSP P 0) do - (SETQ X (IPLUS X IX)) (SETQ P (IPLUS P IPX))) - (IF (ILEQ INITX X) THEN (SETQ TERMX X) ELSE - (SETQ TERMX INITX) (SETQ INITX X)) (SETQ X - (IPLUS X IX)) (SETQ P (IPLUS P IPY)) ELSE - (SETQ TERMX X) (if (ILESSP P 0) then (SETQ P - (IPLUS P IPY)) else (SETQ P (IPLUS P IPX)) - (SETQ X (IPLUS X IX)))))) + (* * (WITH BRES SELF (*) (SETQ INITX X) (IF + (EQ MAJOR (QUOTE X)) THEN (while (ILESSP P 0) do + (SETQ X (IPLUS X IX)) (SETQ P (IPLUS P IPX))) + (IF (ILEQ INITX X) THEN (SETQ TERMX X) ELSE + (SETQ TERMX INITX) (SETQ INITX X)) (SETQ X + (IPLUS X IX)) (SETQ P (IPLUS P IPY)) ELSE + (SETQ TERMX X) (if (ILESSP P 0) then (SETQ P + (IPLUS P IPY)) else (SETQ P (IPLUS P IPX)) + (SETQ X (IPLUS X IX)))))) - (LET (X0 DX D DDX DDY) + (LET (X0 DX D DDX DDY) - (* * (WITH BRES SELF (*) (SETQ X0 X) (SETQ DX IX) - (SETQ D P) (SETQ DDX IPX) (SETQ DDY IPY))) + (* * (WITH BRES SELF (*) (SETQ X0 X) (SETQ DX IX) + (SETQ D P) (SETQ DDX IPX) (SETQ DDY IPY))) - (SETQ D (FFETCH (BRES P) OF SELF)) - (SETQ X0 (FFETCH (BRES X) OF SELF)) - (SETQ DX (FFETCH (BRES IX) OF SELF)) - (SETQ DDX (FFETCH (BRES IPX) OF SELF)) - (SETQ DDY (FFETCH (BRES IPY) OF SELF)) + (SETQ D (FFETCH (BRES P) OF SELF)) + (SETQ X0 (FFETCH (BRES X) OF SELF)) + (SETQ DX (FFETCH (BRES IX) OF SELF)) + (SETQ DDX (FFETCH (BRES IPX) OF SELF)) + (SETQ DDY (FFETCH (BRES IPY) OF SELF)) - (* * Above faster than WITH form * *) + (* * Above faster than WITH form * *) - (SETQ INITX X0) - [IF (EQ (FFETCH (BRES MAJOR) OF SELF) - 'X) - THEN (while (ILESSP D 0) - do (SETQ X0 (IPLUS X0 DX)) - (SETQ D (IPLUS D DDX))) - (IF (ILEQ INITX X0) - THEN (SETQ TERMX X0) - ELSE (SETQ TERMX INITX) - (SETQ INITX X0)) - (SETQ X0 (IPLUS X0 DX)) - (SETQ D (IPLUS D DDY)) - ELSE (SETQ TERMX X0) - (if (ILESSP D 0) - then (SETQ D (IPLUS D DDY)) - else (SETQ D (IPLUS D DDX)) - (SETQ X0 (IPLUS X0 DX] + (SETQ INITX X0) + [IF (EQ (FFETCH (BRES MAJOR) OF SELF) + 'X) + THEN (while (ILESSP D 0) do (SETQ X0 (IPLUS X0 DX)) + (SETQ D (IPLUS D DDX))) + (IF (ILEQ INITX X0) + THEN (SETQ TERMX X0) + ELSE (SETQ TERMX INITX) + (SETQ INITX X0)) + (SETQ X0 (IPLUS X0 DX)) + (SETQ D (IPLUS D DDY)) + ELSE (SETQ TERMX X0) + (if (ILESSP D 0) + then (SETQ D (IPLUS D DDY)) + else (SETQ D (IPLUS D DDX)) + (SETQ X0 (IPLUS X0 DX] - (* * (WITH BRES SELF (*) (SETQ X X0) (SETQ P D))) + (* * (WITH BRES SELF (*) (SETQ X X0) (SETQ P D))) - (FREPLACE (BRES X) OF SELF with X0) - (FREPLACE (BRES P) OF SELF with D)))) + (FREPLACE (BRES X) OF SELF with X0) + (FREPLACE (BRES P) OF SELF with D)))) ) ) @@ -1223,15 +1211,14 @@ Copyright (c) 1985-1987, 1990, 1993, 2021 by Venue & Xerox Corporation. (PRINTOUT MYWIN "CONVEX: " (CONVEXP RLIST) T]) ) -(PUTPROPS XXGEOM COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990 1993 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2461 2894 (\IRND 2471 . 2892)) (3638 23250 (MAKEXYPT 3648 . 3879) (IRNDLIST 3881 . 4485 -) (NORMLOOP 4487 . 6115) (SLITLOOP 6117 . 7816) (PREPLOOP 7818 . 8483) (YMAPLIST 8485 . 10046) ( -IMAPLIST 10048 . 13607) (UNIQLIST 13609 . 14230) (MERGLIST 14232 . 16879) (MMLTLIST 16881 . 17694) ( -IMLTLIST 17696 . 18579) (XYPT.LESSP 18581 . 18950) (PATH.LESSP 18952 . 20278) (CONVEXP 20280 . 23248)) - (25235 30477 (MAKELINE 25245 . 25928) (MSECT 25930 . 26399) (XSECT 26401 . 26957) (YSECT 26959 . -27517) (XYSECT 27519 . 28260) (KNOTLINE 28262 . 29186) (KNOTLOOP 29188 . 30064) (LINE.LESSP 30066 . -30475)) (30478 34052 (LINEY 30488 . 30942) (MIDDX 30944 . 31447) (INITX 31449 . 32130) (TERMX 32132 . -32762) (SCANX 32764 . 33548) (XPROD 33550 . 34050)) (34092 35556 (XYSECTLSEG 34102 . 35554)) (36000 -38555 (MAKEBRES 36010 . 38553)) (42116 48478 (TRAPLOOP 42126 . 44868) (TRAPMAKE 44870 . 48476))))) + (FILEMAP (NIL (2192 2625 (\IRND 2202 . 2623)) (3321 22933 (MAKEXYPT 3331 . 3562) (IRNDLIST 3564 . 4168 +) (NORMLOOP 4170 . 5798) (SLITLOOP 5800 . 7499) (PREPLOOP 7501 . 8166) (YMAPLIST 8168 . 9729) ( +IMAPLIST 9731 . 13290) (UNIQLIST 13292 . 13913) (MERGLIST 13915 . 16562) (MMLTLIST 16564 . 17377) ( +IMLTLIST 17379 . 18262) (XYPT.LESSP 18264 . 18633) (PATH.LESSP 18635 . 19961) (CONVEXP 19963 . 22931)) + (24428 29670 (MAKELINE 24438 . 25121) (MSECT 25123 . 25592) (XSECT 25594 . 26150) (YSECT 26152 . +26710) (XYSECT 26712 . 27453) (KNOTLINE 27455 . 28379) (KNOTLOOP 28381 . 29257) (LINE.LESSP 29259 . +29668)) (29671 33245 (LINEY 29681 . 30135) (MIDDX 30137 . 30640) (INITX 30642 . 31323) (TERMX 31325 . +31955) (SCANX 31957 . 32741) (XPROD 32743 . 33243)) (33285 34749 (XYSECTLSEG 33295 . 34747)) (35193 +37748 (MAKEBRES 35203 . 37746)) (41075 47437 (TRAPLOOP 41085 . 43827) (TRAPMAKE 43829 . 47435))))) STOP diff --git a/sources/XXGEOM.LCOM b/sources/XXGEOM.LCOM index 07a53a2f..f1f974b4 100644 Binary files a/sources/XXGEOM.LCOM and b/sources/XXGEOM.LCOM differ