Compare commits
8 Commits
lmm-delete
...
fgh_specif
| Author | SHA1 | Date | |
|---|---|---|---|
|
e66b434f98 | ||
|
|
d90358f410 | ||
|
|
dd793d9b3b | ||
|
|
dc26dd8dd9 | ||
|
1569a27209 | ||
|
|
1ff475a42c | ||
|
|
7904f9dd86 | ||
|
|
93a04227d8 |
58
.github/workflows/buildLoadup.yml
vendored
58
.github/workflows/buildLoadup.yml
vendored
@@ -20,18 +20,18 @@ name: Build/Push Medley Release
|
||||
on:
|
||||
workflow_dispatch:
|
||||
inputs:
|
||||
maiko_release:
|
||||
description: "What maiko release to use"
|
||||
type: string
|
||||
default: 'Latest'
|
||||
draft:
|
||||
description: "Mark this as a draft release"
|
||||
type: choice
|
||||
options:
|
||||
- 'false'
|
||||
- 'true'
|
||||
type: boolean
|
||||
default: false
|
||||
force:
|
||||
description: "Force build even if build already successfully completed for this commit"
|
||||
type: choice
|
||||
options:
|
||||
- 'false'
|
||||
- 'true'
|
||||
type: boolean
|
||||
default: false
|
||||
|
||||
workflow_call:
|
||||
outputs:
|
||||
@@ -39,16 +39,21 @@ on:
|
||||
description: "'True' if medley build completed successully"
|
||||
value: ${{ jobs.complete.outputs.build_successful }}
|
||||
inputs:
|
||||
maiko_release:
|
||||
description: "What maiko release to use"
|
||||
required: false
|
||||
type: string
|
||||
default: 'Latest'
|
||||
draft:
|
||||
description: "Mark this as a draft release"
|
||||
required: false
|
||||
type: string
|
||||
default: 'false'
|
||||
type: boolean
|
||||
default: false
|
||||
force:
|
||||
description: "Force build even if build already successfully completed for this commit"
|
||||
required: false
|
||||
type: string
|
||||
default: 'false'
|
||||
type: boolean
|
||||
default: false
|
||||
secrets:
|
||||
OIO_SSH_KEY:
|
||||
required: true
|
||||
@@ -110,7 +115,7 @@ jobs:
|
||||
needs: [sentry]
|
||||
if: |
|
||||
needs.sentry.outputs.release_not_built == 'true'
|
||||
|| inputs.force == 'true'
|
||||
|| inputs.force == true
|
||||
|
||||
steps:
|
||||
# Checkout the actions for this repo owner
|
||||
@@ -130,24 +135,21 @@ jobs:
|
||||
id: tag
|
||||
uses: ./../actions/release-tag-action
|
||||
|
||||
# Get Maiko release information, retrieves the name of the latest (draft)
|
||||
# Get Maiko release information, use maiko release tag from input or Latest
|
||||
# release. Used to download the correct Maiko release
|
||||
# Find latest release (draft or normal)
|
||||
- name: Get maiko release information
|
||||
id: maiko
|
||||
run: |
|
||||
tag=""
|
||||
if [ "${{ inputs.draft }}" = "true" ];
|
||||
then
|
||||
gh release list --repo ${{ github.repository_owner }}/maiko | grep Draft >/tmp/releases-$$
|
||||
if [ $? -eq 0 ];
|
||||
then
|
||||
tag=$(head -n 1 /tmp/releases-$$ | awk '{ print $3 }')
|
||||
fi
|
||||
fi
|
||||
if [ -z "${tag}" ];
|
||||
if [ "${{ inputs.maiko_release }}" = "Latest" ];
|
||||
then
|
||||
tag=$(gh release list --repo ${{ github.repository_owner }}/maiko | grep Latest | head -n 1 | awk '{ print $3 }')
|
||||
else
|
||||
tag=$(echo "${{ inputs.maiko_release }}" | sed 's/[[:space:]]//g')
|
||||
set +e
|
||||
gh release view ${tag} --repo ${{ github.repository_owner }}/maiko
|
||||
if [ $? -ne 0 ]; then echo "!!!!!!! Error: Cannot find Maiko release ${tag}. Exiting."; exit 1; fi
|
||||
set -e
|
||||
fi
|
||||
echo "maiko_tag=${tag}" >> ${GITHUB_OUTPUT}
|
||||
env:
|
||||
@@ -262,7 +264,7 @@ jobs:
|
||||
needs: [sentry, loadup]
|
||||
if: |
|
||||
needs.sentry.outputs.release_not_built == 'true'
|
||||
|| inputs.force == 'true'
|
||||
|| inputs.force == true
|
||||
|
||||
steps:
|
||||
|
||||
@@ -338,7 +340,7 @@ jobs:
|
||||
needs: [sentry, loadup]
|
||||
if: |
|
||||
needs.sentry.outputs.release_not_built == 'true'
|
||||
|| inputs.force == 'true'
|
||||
|| inputs.force == true
|
||||
# if: false
|
||||
|
||||
defaults:
|
||||
@@ -409,7 +411,7 @@ jobs:
|
||||
needs: [sentry, loadup, linux_installer]
|
||||
if: |
|
||||
needs.sentry.outputs.release_not_built == 'true'
|
||||
|| inputs.force == 'true'
|
||||
|| inputs.force == true
|
||||
|
||||
outputs:
|
||||
cygwin_installer: ${{ steps.compile_iss.outputs.CYGWIN_INSTALLER }}
|
||||
@@ -512,7 +514,7 @@ jobs:
|
||||
needs: [sentry, loadup, linux_installer, macos_installer, cygwin_installer]
|
||||
if: |
|
||||
needs.sentry.outputs.release_not_built == 'true'
|
||||
|| inputs.force == 'true'
|
||||
|| inputs.force == true
|
||||
|
||||
steps:
|
||||
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 8-Feb-2026 19:27:31" {DSK}<Users>larry>il>MEDLEY>LIBRARY>MASTERSCOPE.;3 197425
|
||||
(FILECREATED "16-Feb-2026 13:34:31" {WMEDLEY}<library>MASTERSCOPE.;41 197959
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS BUILDGETRELQ)
|
||||
:CHANGES-TO (FNS MSOUTPUT)
|
||||
|
||||
:PREVIOUS-DATE " 8-Feb-2026 18:47:30" {DSK}<Users>larry>il>MEDLEY>LIBRARY>MASTERSCOPE.;2)
|
||||
:PREVIOUS-DATE " 8-Feb-2026 22:38:50" {WMEDLEY}<library>MASTERSCOPE.;40)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MASTERSCOPECOMS)
|
||||
@@ -2566,7 +2566,7 @@
|
||||
(* ; "interactive routines")
|
||||
|
||||
|
||||
(RPAQ MASTERSCOPEDATE " 8-Feb-2026")
|
||||
(RPAQ MASTERSCOPEDATE "16-Feb-2026")
|
||||
|
||||
(ADDTOVAR HISTORYCOMS %.)
|
||||
(DEFINEQ
|
||||
@@ -3498,13 +3498,17 @@
|
||||
(ERROR!])
|
||||
|
||||
(MSOUTPUT
|
||||
[LAMBDA (FILE) (* ; "Edited 5-Apr-2025 11:48 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 16-Feb-2026 13:34 by rmk")
|
||||
(* ; "Edited 5-Feb-2026 01:01 by rmk")
|
||||
(* ; "Edited 18-Nov-2025 14:01 by rmk")
|
||||
(* ; "Edited 8-Nov-2025 23:21 by rmk")
|
||||
(* ; "Edited 5-Apr-2025 11:48 by rmk")
|
||||
(* ; "Edited 14-Jul-2024 08:41 by rmk")
|
||||
(* ; "Edited 5-Jul-2024 11:54 by rmk")
|
||||
(* ; "Edited 12-Jun-90 20:43 by teruuchi")
|
||||
(LET ((LLENGTH FILELINELENGTH))
|
||||
[COND
|
||||
((AND (LITATOM FILE)
|
||||
[(AND (LITATOM FILE)
|
||||
(MEMB (U-CASE FILE)
|
||||
'(TEDIT :TEDIT))
|
||||
(GETD (FUNCTION TEDIT)))
|
||||
@@ -3512,12 +3516,14 @@
|
||||
(* ;;
|
||||
"If no TEDIT, leave the current OUTPUT. The readtable for seprs etc is the current readtable.")
|
||||
|
||||
[SETQ FILE (TEXTSTREAM (TEDIT NIL 'Masterscope NIL `(LEAVETTY T TITLE Masterscope FONT
|
||||
,DEFAULTFONT BOUNDTABLE
|
||||
,(TEDIT.ATOMBOUND.READTABLE]
|
||||
[SETQ FILE (OPENTEXTSTREAM NIL NIL `(FONT ,DEFAULTFONT BOUNDTABLE ,(
|
||||
TEDIT.ATOMBOUND.READTABLE
|
||||
]
|
||||
(SETQ LLENGTH T)
|
||||
(TEDIT.DEFER.UPDATES FILE '(READONLY QUIET))
|
||||
(RESETSAVE NIL (LIST 'CLOSEF FILE)))
|
||||
(RESETSAVE NIL `(PROGN (CL:UNLESS RESETSTATE
|
||||
(TEDIT ,FILE 'Masterscope NIL
|
||||
'(TITLE Masterscope READONLY QUIET LEAVETTY T)))
|
||||
(CLOSEF? ,FILE]
|
||||
((OPENP FILE 'OUTPUT))
|
||||
(T (SETQ FILE (OPENSTREAM FILE 'OUTPUT))
|
||||
(RESETSAVE NIL (LIST 'CLOSEF FILE]
|
||||
@@ -3724,36 +3730,36 @@
|
||||
(ADDTOVAR LAMA MSEDITE MSEDITF)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3300 19547 (UPDATEFN 3310 . 4927) (MSGETDEF 4929 . 6335) (MSNOTICEFILE 6337 . 8730) (
|
||||
MSSHOWUSE 8732 . 14713) (MSUPDATEFN1 14715 . 15403) (MSUPDATE 15405 . 17831) (MSNLAMBDACHECK 17833 .
|
||||
18715) (MSCOLLECTDATA 18717 . 19545)) (19548 20447 (UPDATECHANGED 19558 . 19921) (UPDATECHANGED1 19923
|
||||
. 20445)) (21021 21444 (MSCLOSEFILES 21031 . 21442)) (22125 26557 (MSDESCRIBE 22135 . 24923) (
|
||||
MSDESCRIBE1 24925 . 25988) (FMAPRINT 25990 . 26555)) (26650 27090 (MSPRINTHELPFILE 26660 . 27088)) (
|
||||
27140 30278 (TEMPLATE 27150 . 28571) (GETTEMPLATE 28573 . 28708) (SETTEMPLATE 28710 . 30276)) (31148
|
||||
36072 (ADDTEMPLATEWORD 31158 . 31830) (MSADDANALYZE 31832 . 33330) (MSADDMODIFIER 33332 . 34413) (
|
||||
MSADDRELATION 34415 . 35162) (MSADDTYPE 35164 . 36070)) (37573 42669 (MSMARKCHANGE1 37583 . 38377) (
|
||||
MSINIT 38379 . 39560) (GETVERBTABLES 39562 . 40115) (MSSTOREDATA 40117 . 41671) (STORETABLE 41673 .
|
||||
42667)) (44071 49141 (PARSERELATION 44081 . 44681) (PARSERELATION1 44683 . 46138) (GETRELATION 46140
|
||||
. 47169) (MAPRELATION 47171 . 48305) (TESTRELATION 48307 . 49139)) (49142 50782 (ADDHASH 49152 .
|
||||
49630) (SUBHASH 49632 . 49860) (MAKEHASH 49862 . 50006) (MSREHASH 50008 . 50461) (EQMEMBHASH 50463 .
|
||||
50780)) (51121 57437 (MSVBTABLES 51131 . 57011) (MSUSERVBTABLES 57013 . 57435)) (57520 59823 (
|
||||
BUILDGETRELQ 57530 . 58728) (BUILDTESTRELQ 58730 . 59821)) (59994 60382 (MSERASE 60004 . 60380)) (
|
||||
60383 64843 (DUMPDATABASE 60393 . 62958) (DUMPDATABASE1 62960 . 63305) (READATABASE 63307 . 64841)) (
|
||||
65925 94984 (MSCHECKBLOCKS 65935 . 69755) (MSCHECKBLOCK 69757 . 78377) (MSCHECKFNINBLOCK 78379 . 81379
|
||||
) (MSCHECKBLOCKBASIC 81381 . 83801) (MSCHECKBOUNDFREE 83803 . 85702) (GLOBALVARP 85704 . 85871) (
|
||||
PRINTERROR 85873 . 89089) (MSCHECKVARS1 89091 . 92044) (UNECCSPEC 92046 . 92324) (NECCSPEC 92326 .
|
||||
92673) (SPECVARP 92675 . 93202) (SHORTLST 93204 . 93660) (DOERROR 93662 . 94372) (MSMSGPRINT 94374 .
|
||||
94982)) (96128 110956 (MSPATHS 96138 . 99540) (MSPATHS1 99542 . 103777) (MSPATHS2 103779 . 107189) (
|
||||
MSONPATH 107191 . 108419) (MSPATHS4 108421 . 109503) (DASHES 109505 . 110031) (DOTABS 110033 . 110274)
|
||||
(BELOWMARKER 110276 . 110739) (MSPATHSPRINTFN 110741 . 110954)) (111342 114766 (MSFIND 111352 .
|
||||
111627) (MSEDITF 111629 . 112629) (MSEDITE 112631 . 113668) (EDITGETDEF 113670 . 114764)) (115708
|
||||
124309 (MSMARKCHANGED 115718 . 117442) (CHANGEMACRO 117444 . 118149) (CHANGEVAR 118151 . 118467) (
|
||||
CHANGEI.S. 118469 . 119802) (CHANGERECORD 119804 . 120675) (MSNEEDUNSAVE 120677 . 121669) (UNSAVEFNS
|
||||
121671 . 124307)) (124742 128352 (%. 124752 . 124892) (MASTERSCOPE 124894 . 125420) (MASTERSCOPE1
|
||||
125422 . 126290) (MASTERSCOPEXEC 126292 . 128350)) (128391 168041 (MSINTERPRETSET 128401 . 156935) (
|
||||
MSINTERPA 156937 . 157471) (MSGETBLOCKDEC 157473 . 159986) (LISTHARD 159988 . 161206) (MSMEMBSET
|
||||
161208 . 161353) (MSLISTSET 161355 . 161720) (MSHASHLIST 161722 . 161889) (MSHASHLIST1 161891 . 162217
|
||||
) (CHECKPATHS 162219 . 162859) (ONFILE 162861 . 168039)) (168042 191603 (MSINTERPRET 168052 . 184107)
|
||||
(VERBNOTICELIST 184109 . 185219) (MSOUTPUT 185221 . 186731) (MSCHECKEMPTY 186733 . 187937) (
|
||||
CHECKFORCHANGED 187939 . 188459) (MSSOLVE 188461 . 191601)))))
|
||||
(FILEMAP (NIL (3260 19507 (UPDATEFN 3270 . 4887) (MSGETDEF 4889 . 6295) (MSNOTICEFILE 6297 . 8690) (
|
||||
MSSHOWUSE 8692 . 14673) (MSUPDATEFN1 14675 . 15363) (MSUPDATE 15365 . 17791) (MSNLAMBDACHECK 17793 .
|
||||
18675) (MSCOLLECTDATA 18677 . 19505)) (19508 20407 (UPDATECHANGED 19518 . 19881) (UPDATECHANGED1 19883
|
||||
. 20405)) (20981 21404 (MSCLOSEFILES 20991 . 21402)) (22085 26517 (MSDESCRIBE 22095 . 24883) (
|
||||
MSDESCRIBE1 24885 . 25948) (FMAPRINT 25950 . 26515)) (26610 27050 (MSPRINTHELPFILE 26620 . 27048)) (
|
||||
27100 30238 (TEMPLATE 27110 . 28531) (GETTEMPLATE 28533 . 28668) (SETTEMPLATE 28670 . 30236)) (31108
|
||||
36032 (ADDTEMPLATEWORD 31118 . 31790) (MSADDANALYZE 31792 . 33290) (MSADDMODIFIER 33292 . 34373) (
|
||||
MSADDRELATION 34375 . 35122) (MSADDTYPE 35124 . 36030)) (37533 42629 (MSMARKCHANGE1 37543 . 38337) (
|
||||
MSINIT 38339 . 39520) (GETVERBTABLES 39522 . 40075) (MSSTOREDATA 40077 . 41631) (STORETABLE 41633 .
|
||||
42627)) (44031 49101 (PARSERELATION 44041 . 44641) (PARSERELATION1 44643 . 46098) (GETRELATION 46100
|
||||
. 47129) (MAPRELATION 47131 . 48265) (TESTRELATION 48267 . 49099)) (49102 50742 (ADDHASH 49112 .
|
||||
49590) (SUBHASH 49592 . 49820) (MAKEHASH 49822 . 49966) (MSREHASH 49968 . 50421) (EQMEMBHASH 50423 .
|
||||
50740)) (51081 57397 (MSVBTABLES 51091 . 56971) (MSUSERVBTABLES 56973 . 57395)) (57480 59783 (
|
||||
BUILDGETRELQ 57490 . 58688) (BUILDTESTRELQ 58690 . 59781)) (59954 60342 (MSERASE 59964 . 60340)) (
|
||||
60343 64803 (DUMPDATABASE 60353 . 62918) (DUMPDATABASE1 62920 . 63265) (READATABASE 63267 . 64801)) (
|
||||
65885 94944 (MSCHECKBLOCKS 65895 . 69715) (MSCHECKBLOCK 69717 . 78337) (MSCHECKFNINBLOCK 78339 . 81339
|
||||
) (MSCHECKBLOCKBASIC 81341 . 83761) (MSCHECKBOUNDFREE 83763 . 85662) (GLOBALVARP 85664 . 85831) (
|
||||
PRINTERROR 85833 . 89049) (MSCHECKVARS1 89051 . 92004) (UNECCSPEC 92006 . 92284) (NECCSPEC 92286 .
|
||||
92633) (SPECVARP 92635 . 93162) (SHORTLST 93164 . 93620) (DOERROR 93622 . 94332) (MSMSGPRINT 94334 .
|
||||
94942)) (96088 110916 (MSPATHS 96098 . 99500) (MSPATHS1 99502 . 103737) (MSPATHS2 103739 . 107149) (
|
||||
MSONPATH 107151 . 108379) (MSPATHS4 108381 . 109463) (DASHES 109465 . 109991) (DOTABS 109993 . 110234)
|
||||
(BELOWMARKER 110236 . 110699) (MSPATHSPRINTFN 110701 . 110914)) (111302 114726 (MSFIND 111312 .
|
||||
111587) (MSEDITF 111589 . 112589) (MSEDITE 112591 . 113628) (EDITGETDEF 113630 . 114724)) (115668
|
||||
124269 (MSMARKCHANGED 115678 . 117402) (CHANGEMACRO 117404 . 118109) (CHANGEVAR 118111 . 118427) (
|
||||
CHANGEI.S. 118429 . 119762) (CHANGERECORD 119764 . 120635) (MSNEEDUNSAVE 120637 . 121629) (UNSAVEFNS
|
||||
121631 . 124267)) (124702 128312 (%. 124712 . 124852) (MASTERSCOPE 124854 . 125380) (MASTERSCOPE1
|
||||
125382 . 126250) (MASTERSCOPEXEC 126252 . 128310)) (128351 168001 (MSINTERPRETSET 128361 . 156895) (
|
||||
MSINTERPA 156897 . 157431) (MSGETBLOCKDEC 157433 . 159946) (LISTHARD 159948 . 161166) (MSMEMBSET
|
||||
161168 . 161313) (MSLISTSET 161315 . 161680) (MSHASHLIST 161682 . 161849) (MSHASHLIST1 161851 . 162177
|
||||
) (CHECKPATHS 162179 . 162819) (ONFILE 162821 . 167999)) (168002 192137 (MSINTERPRET 168012 . 184067)
|
||||
(VERBNOTICELIST 184069 . 185179) (MSOUTPUT 185181 . 187265) (MSCHECKEMPTY 187267 . 188471) (
|
||||
CHECKFORCHANGED 188473 . 188993) (MSSOLVE 188995 . 192135)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "15-Feb-2025 14:11:54" {WMEDLEY}<library>lafite>LAFITE-INDENT.;4 26926
|
||||
(FILECREATED "18-Feb-2026 15:47:08" {WMEDLEY}<library>LAFITE>LAFITE-INDENT.;2 26210
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT-INDENT-BREAK-LONG-LINES TEDIT-INDENT-SELECTION TEDIT-OPEN-LINE
|
||||
TEDIT-MAKE-LINES-EXPLICIT TEDIT-INDENT-SET-INDENT)
|
||||
|
||||
:PREVIOUS-DATE "15-Feb-2025 09:21:58" {WMEDLEY}<library>lafite>LAFITE-INDENT.;3)
|
||||
:PREVIOUS-DATE "22-Jan-87 01:34:36" {WMEDLEY}<library>LAFITE>LAFITE-INDENT.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LAFITE-INDENTCOMS)
|
||||
@@ -133,10 +130,14 @@
|
||||
max-length max-length])
|
||||
|
||||
(TEDIT-INDENT-BREAK-LONG-LINES
|
||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* ; "Edited 15-Feb-2025 14:07 by rmk")
|
||||
(* smL "21-Jan-87 16:03")
|
||||
|
||||
(* ;;; "Break the current selection into explicit lines, each having no more than *TEDIT-INDENT-LINE-LENGTH* characters. --- If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in the current selection are removed. --- This is intended to be used in Lafite, where one wants to indent a piece of a forwarded document, but can be used in any TEdit document")
|
||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* smL "21-Jan-87 16:03")
|
||||
|
||||
(* * Break the current selection into explicit lines, each having no more than
|
||||
*TEDIT-INDENT-LINE-LENGTH* characters. -
|
||||
If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in
|
||||
the current selection are removed. -
|
||||
This is intended to be used in Lafite, where one wants to indent a piece of a
|
||||
forwarded document, but can be used in any TEdit document)
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
(TEDIT-INDENT-REPLACE-SELECTION
|
||||
@@ -144,13 +145,11 @@
|
||||
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
|
||||
text-stream selection)
|
||||
explicit-paragraph-breaks?)
|
||||
bind [hanging-indent _ (AND [NOT (EQP (GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1)
|
||||
(TEDIT.SELPROP selection 'CH#]
|
||||
(DIFFERENCE (TEDIT.SELPROP selection
|
||||
'CH#)
|
||||
(GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1]
|
||||
bind [hanging-indent _
|
||||
(AND (NOT (EQP (fetch CHAR1 of (CAR (fetch L1 of selection)))
|
||||
(fetch CH# of selection)))
|
||||
(DIFFERENCE (fetch CH# of selection)
|
||||
(fetch CHAR1 of (CAR (fetch L1 of selection]
|
||||
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
|
||||
"" *TEDIT-INDENT-LINE-LENGTH* hanging-indent)
|
||||
*eol-string*)
|
||||
@@ -185,10 +184,15 @@
|
||||
'RIGHT])
|
||||
|
||||
(TEDIT-INDENT-SELECTION
|
||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* ; "Edited 15-Feb-2025 14:07 by rmk")
|
||||
(* smL "21-Jan-87 16:00")
|
||||
|
||||
(* ;;; "Indent the current selection by prefacing each line with the value of *TEDIT-INDENT-STRING*, and inserting line breaks after each *TEDIT-INDENT-LINE-LENGTH* characters. --- If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in the current selection are removed. --- This is intended to be used in Lafite, where one wants to indent a piece of a forwarded document, but can be used in any TEdit document")
|
||||
[LAMBDA (text-stream explicit-paragraph-breaks?) (* smL "21-Jan-87 16:00")
|
||||
|
||||
(* * Indent the current selection by prefacing each line with the value of
|
||||
*TEDIT-INDENT-STRING*, and inserting line breaks after each
|
||||
*TEDIT-INDENT-LINE-LENGTH* characters. -
|
||||
If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in
|
||||
the current selection are removed. -
|
||||
This is intended to be used in Lafite, where one wants to indent a piece of a
|
||||
forwarded document, but can be used in any TEdit document)
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
(TEDIT-INDENT-REPLACE-SELECTION
|
||||
@@ -196,13 +200,11 @@
|
||||
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
|
||||
text-stream selection)
|
||||
explicit-paragraph-breaks?)
|
||||
bind [hanging-indent _ (AND [NOT (EQP (GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1)
|
||||
(TEDIT.SELPROP selection 'CH#]
|
||||
(DIFFERENCE (TEDIT.SELPROP selection
|
||||
'CH#)
|
||||
(GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1]
|
||||
bind [hanging-indent _
|
||||
(AND (NOT (EQP (fetch CHAR1 of (CAR (fetch L1 of selection)))
|
||||
(fetch CH# of selection)))
|
||||
(DIFFERENCE (fetch CH# of selection)
|
||||
(fetch CHAR1 of (CAR (fetch L1 of selection]
|
||||
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
|
||||
*TEDIT-INDENT-STRING* *TEDIT-INDENT-LINE-LENGTH*
|
||||
hanging-indent)
|
||||
@@ -232,19 +234,18 @@
|
||||
else (\TEDIT-INDENT-SEPERATE-PARAGRAPHS string NIL])
|
||||
|
||||
(TEDIT-INDENT-SET-INDENT
|
||||
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 09:21 by rmk")
|
||||
(* smL "12-Sep-86 17:09")
|
||||
[LAMBDA (text-stream) (* smL "12-Sep-86 17:09")
|
||||
|
||||
(* * Prompt the user for a new indentation string)
|
||||
|
||||
(* ;;; "Prompt the user for a new indentation string")
|
||||
|
||||
(LET* ((window (\TEDIT.PRIMARYPANE text-stream))
|
||||
(LET* ((window (fetch \WINDOW of (TEXTOBJ text-stream)))
|
||||
(pwindow (if window
|
||||
then (GETPROMPTWINDOW (if (LISTP window)
|
||||
then (CAR window)
|
||||
else window))
|
||||
else PROMPTWINDOW)))
|
||||
(CLEARW pwindow)
|
||||
(SETQ *TEDIT-INDENT-STRING* (PROMPTFORWORD "New indent string: " *TEDIT-INDENT-STRING* NIL
|
||||
(SETQ *TEDIT-INDENT-STRING* (PROMPTFORWORD "New indent string: " *TEDIT-INDENT-STRING* NIL
|
||||
pwindow NIL NIL (LIST (CHARCODE EOL])
|
||||
|
||||
(TEDIT-INDENT-STRIP-INDENTATION
|
||||
@@ -269,34 +270,36 @@
|
||||
else string])
|
||||
|
||||
(TEDIT-MAKE-LINES-EXPLICIT
|
||||
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 09:20 by rmk")
|
||||
(* smL " 8-Sep-86 18:20")
|
||||
|
||||
(* ;;; "Take the current selection and replace all TEdit end-of-lines with explicit line breaks. --- This is intended to be used in Lafite, where it is sometimes nice to know that anyone receiving the msg will see the same line breaks that you see. see, but can be used in any TEdit document")
|
||||
[LAMBDA (text-stream) (* smL " 8-Sep-86 18:20")
|
||||
|
||||
(* * Take the current selection and replace all TEdit end-of-lines with
|
||||
explicit line breaks. -
|
||||
This is intended to be used in Lafite, where it is sometimes nice to know that
|
||||
anyone receiving the msg will see the same line breaks that you see.
|
||||
see, but can be used in any TEdit document)
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
[for i in (bind (this-line _ (CAR (GETSEL selection L1)))
|
||||
[last-line _ (CAR (LAST (GETSEL selection LN]
|
||||
repeatuntil (PROGN (SETQ this-line (GETLD this-line NEXTLINE))
|
||||
(EQ this-line last-line)) collect (GETLD this-line LCHARLIM)
|
||||
) do (TEDIT.SETSEL text-stream i 1 'LEFT T)
|
||||
(TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
|
||||
[for i in (bind (this-line _ (CAR (fetch L1 of selection)))
|
||||
[last-line _ (CAR (LAST (fetch LN of selection]
|
||||
repeatuntil (PROGN (SETQ this-line (fetch NEXTLINE of this-line))
|
||||
(EQ this-line last-line)) collect (fetch CHARLIM
|
||||
of this-line))
|
||||
do (TEDIT.SETSEL text-stream i 1 'LEFT T)
|
||||
(TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
|
||||
(TEDIT.SETSEL text-stream selection NIL 'RIGHT])
|
||||
|
||||
(TEDIT-OPEN-LINE
|
||||
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 14:09 by rmk")
|
||||
(* smL "17-Sep-86 11:13")
|
||||
|
||||
(* ;;; "Open a new line at the current position.")
|
||||
[LAMBDA (text-stream) (* smL "17-Sep-86 11:13")
|
||||
|
||||
(* * Open a new line at the current position.)
|
||||
|
||||
(LET ((selection (TEDIT.GETSEL text-stream)))
|
||||
(TEDIT.INSERT text-stream (CONCAT *eol-string* (ALLOCSTRING
|
||||
(DIFFERENCE (TEDIT.SELPROP selection
|
||||
'CH#)
|
||||
(GETLD (CAR (GETSEL selection L1))
|
||||
LCHAR1))
|
||||
" ")))
|
||||
(if (ZEROP (TEDIT.SELPROP selection 'LENGTH))
|
||||
(TEDIT.INSERT text-stream (CONCAT *eol-string*
|
||||
(ALLOCSTRING [DIFFERENCE (fetch CH# of selection)
|
||||
(fetch CHAR1
|
||||
of (CAR (fetch L1 of selection]
|
||||
" ")))
|
||||
(if (ZEROP (fetch DCH of selection))
|
||||
then (TEDIT.SETSEL text-stream selection])
|
||||
|
||||
(TEDIT-REMOVE-INDENT
|
||||
@@ -433,12 +436,12 @@
|
||||
"Break long lines by inserting explicit <RETURN>'s"
|
||||
]
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4363 24314 (TEDIT-INDENT-ADD-INDENTATION 4373 . 6941) (TEDIT-INDENT-BREAK-LINE 6943 .
|
||||
8876) (TEDIT-INDENT-BREAK-LONG-LINES 8878 . 10828) (TEDIT-INDENT-FIND-BREAKPOINT 10830 . 11653) (
|
||||
TEDIT-INDENT-REPLACE-SELECTION 11655 . 12212) (TEDIT-INDENT-SELECTION 12214 . 14283) (
|
||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 14285 . 14564) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 14566 .
|
||||
15295) (TEDIT-INDENT-SET-INDENT 15297 . 16143) (TEDIT-INDENT-STRIP-INDENTATION 16145 . 17365) (
|
||||
TEDIT-MAKE-LINES-EXPLICIT 17367 . 18517) (TEDIT-OPEN-LINE 18519 . 19453) (TEDIT-REMOVE-INDENT 19455 .
|
||||
20225) (\TEDIT-INDENT-COUNT-SPACES 20227 . 20828) (\TEDIT-INDENT-FIND-PARAGRAPH-END 20830 . 21801) (
|
||||
\TEDIT-INDENT-SEPERATE-LINES 21803 . 22601) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 22603 . 24312)))))
|
||||
(FILEMAP (NIL (4193 23598 (TEDIT-INDENT-ADD-INDENTATION 4203 . 6771) (TEDIT-INDENT-BREAK-LINE 6773 .
|
||||
8706) (TEDIT-INDENT-BREAK-LONG-LINES 8708 . 10475) (TEDIT-INDENT-FIND-BREAKPOINT 10477 . 11300) (
|
||||
TEDIT-INDENT-REPLACE-SELECTION 11302 . 11859) (TEDIT-INDENT-SELECTION 11861 . 13762) (
|
||||
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 13764 . 14043) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 14045 .
|
||||
14774) (TEDIT-INDENT-SET-INDENT 14776 . 15550) (TEDIT-INDENT-STRIP-INDENTATION 15552 . 16772) (
|
||||
TEDIT-MAKE-LINES-EXPLICIT 16774 . 17979) (TEDIT-OPEN-LINE 17981 . 18737) (TEDIT-REMOVE-INDENT 18739 .
|
||||
19509) (\TEDIT-INDENT-COUNT-SPACES 19511 . 20112) (\TEDIT-INDENT-FIND-PARAGRAPH-END 20114 . 21085) (
|
||||
\TEDIT-INDENT-SEPERATE-LINES 21087 . 21885) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 21887 . 23596)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,30 +1,28 @@
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED "19-Jan-87 23:56:51" {ERIS}<LISPUSERS>LISPCORE>LAFITEPRIVATEDL.;1 10080
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
previous date%: "19-Jan-87 23:47:54" {PHYLUM}<LISPUSERS>KOTO>LAFITEPRIVATEDL.;2)
|
||||
(FILECREATED "18-Feb-2026 15:50:14" {WMEDLEY}<library>lafite>LAFITE-PRIVATEDL.;2 9719
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \GV.PARSERECIPIENTS1 \GV.PARSE.PRIVATE.DISTRIBUTION.LIST))
|
||||
|
||||
|
||||
(* "
|
||||
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
(PRETTYCOMPRINT LAFITE-PRIVATEDLCOMS)
|
||||
|
||||
(PRETTYCOMPRINT LAFITEPRIVATEDLCOMS)
|
||||
|
||||
(RPAQQ LAFITEPRIVATEDLCOMS ((* * LAFITEDL.EXT is the default extension for dl files when no extension
|
||||
is specified)
|
||||
(* * LAFITEDLDIRECTORIES is a list of directories to be searched after
|
||||
the connected directory and the LAFITEDEFAULTHOST&DIR in order to
|
||||
locate a dl file when no host or directory is specified)
|
||||
(INITVARS (LAFITEDL.EXT 'DL)
|
||||
(LAFITEDLDIRECTORIES NIL))
|
||||
(* * no functions are user callable)
|
||||
(FNS \GV.PARSERECIPIENTS1 \GV.PARSE.PRIVATE.DISTRIBUTION.LIST)
|
||||
(* Lafite's readtable for parsing addresses needs to have CR as a
|
||||
SEPRCHAR so that lines from a text file can all be parsed at once.
|
||||
This has no effect on normal operation since before private dls no CR
|
||||
was ever passed to the parser)
|
||||
(P (SETSYNTAX (CHARCODE CR)
|
||||
'SEPRCHAR ADDRESSPARSERRDTBL))))
|
||||
(RPAQQ LAFITE-PRIVATEDLCOMS
|
||||
((* * LAFITEDL.EXT is the default extension for dl files when no extension is specified)
|
||||
(* * LAFITEDLDIRECTORIES is a list of directories to be searched after the connected
|
||||
directory and the LAFITEDEFAULTHOST&DIR in order to locate a dl file when no host or
|
||||
directory is specified)
|
||||
(INITVARS (LAFITEDL.EXT 'DL)
|
||||
(LAFITEDLDIRECTORIES NIL))
|
||||
(* * no functions are user callable)
|
||||
(FNS \GV.PARSERECIPIENTS1 \GV.PARSE.PRIVATE.DISTRIBUTION.LIST)
|
||||
(* Lafite's readtable for parsing addresses needs to have CR as a SEPRCHAR so that lines from
|
||||
a text file can all be parsed at once. This has no effect on normal operation since before
|
||||
private dls no CR was ever passed to the parser)
|
||||
(P (SETSYNTAX (CHARCODE CR)
|
||||
'SEPRCHAR ADDRESSPARSERRDTBL))))
|
||||
(* * LAFITEDL.EXT is the default extension for dl files when no extension is specified)
|
||||
|
||||
(* * LAFITEDLDIRECTORIES is a list of directories to be searched after the connected directory and the
|
||||
@@ -39,7 +37,7 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
(DEFINEQ
|
||||
|
||||
(\GV.PARSERECIPIENTS1
|
||||
[LAMBDA (FIELD REGISTRY INTERNALFLG EDITWINDOW) (* N.H.Briggs "19-Jan-87 23:44")
|
||||
[LAMBDA (FIELD REGISTRY INTERNALFLG EDITWINDOW) (* N.H.Briggs "19-Jan-87 23:44")
|
||||
|
||||
(* ;;; "INTERNALFLG = T means produce addresses to give Grapevine; NIL means give human-readable addresses")
|
||||
|
||||
@@ -73,8 +71,8 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
(CHARCODE %"))
|
||||
(HELP]
|
||||
(OR REGISTRY (SETQ REGISTRY DEFAULTREGISTRY))
|
||||
|
||||
(* ;; "first just collect all the atoms using a special readtable ")
|
||||
|
||||
(* ;; "first just collect all the atoms using a special readtable ")
|
||||
|
||||
(SETQ ADDRESSES (when (SETQ ADDR (until (OR (EOFP FIELDSTREAM)
|
||||
(EQ (SETQ TOKEN (READ FIELDSTREAM
|
||||
@@ -107,14 +105,13 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
(EQ (CADDR ADDRESS)
|
||||
';))
|
||||
then
|
||||
|
||||
(* ;; "it's a private dl --- foo:;")
|
||||
(* ;; "it's a private dl --- foo:;")
|
||||
|
||||
(\GV.PARSE.PRIVATE.DISTRIBUTION.LIST ADDRESS REGISTRY INTERNALFLG
|
||||
(\GV.PARSE.PRIVATE.DISTRIBUTION.LIST ADDRESS REGISTRY INTERNALFLG
|
||||
EDITWINDOW)
|
||||
else
|
||||
|
||||
(* ;; "ADDRESS will only get rebound if there is an address with <>'s in it ")
|
||||
(* ;;
|
||||
"ADDRESS will only get rebound if there is an address with <>'s in it ")
|
||||
|
||||
(SETQ VALIDRECIPIENT (\GV.PARSE.SINGLE.ADDRESS
|
||||
(COND
|
||||
@@ -128,8 +125,8 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
((OR T INTERNALFLG (NULL REALADDRESS))
|
||||
VALIDRECIPIENT)
|
||||
(T
|
||||
|
||||
(* ;; "Need to figure out how to make GETREGISTRY of this work, and remove duplicates in MAKEANSWERFORM before we can enable this")
|
||||
|
||||
(* ;; "Need to figure out how to make GETREGISTRY of this work, and remove duplicates in MAKEANSWERFORM before we can enable this")
|
||||
|
||||
(\GV.REPACKADDRESS (APPEND (LDIFF ADDRESS OPEN)
|
||||
(LIST '< VALIDRECIPIENT
|
||||
@@ -137,7 +134,7 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
(CDR CLOSE])
|
||||
|
||||
(\GV.PARSE.PRIVATE.DISTRIBUTION.LIST
|
||||
[LAMBDA (DL REGISTRY INTERNALFLG EDITWINDOW) (* N.H.Briggs "19-Jan-87 23:45")
|
||||
[LAMBDA (DL REGISTRY INTERNALFLG EDITWINDOW) (* N.H.Briggs "19-Jan-87 23:45")
|
||||
(LET* [(FILENAME (FINDFILE (PACKFILENAME.STRING 'BODY (CAR DL)
|
||||
'EXTENSION LAFITEDL.EXT)
|
||||
T
|
||||
@@ -162,10 +159,10 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
file can all be parsed at once. This has no effect on normal operation since before private dls no CR
|
||||
was ever passed to the parser)
|
||||
|
||||
|
||||
(SETSYNTAX (CHARCODE CR)
|
||||
'SEPRCHAR ADDRESSPARSERRDTBL)
|
||||
(PUTPROPS LAFITEPRIVATEDL COPYRIGHT ("Xerox Corporation" 1986 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1965 9682 (\GV.PARSERECIPIENTS1 1975 . 8562) (\GV.PARSE.PRIVATE.DISTRIBUTION.LIST 8564
|
||||
. 9680)))))
|
||||
(FILEMAP (NIL (1617 9389 (\GV.PARSERECIPIENTS1 1627 . 8273) (\GV.PARSE.PRIVATE.DISTRIBUTION.LIST 8275
|
||||
. 9387)))))
|
||||
STOP
|
||||
|
||||
BIN
library/lafite/LAFITE-PRIVATEDL.LCOM
Normal file
BIN
library/lafite/LAFITE-PRIVATEDL.LCOM
Normal file
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Feb-2026 17:02:37" {WMEDLEY}<library>tedit>TEDIT-FILE.;657 173103
|
||||
(FILECREATED "15-Feb-2026 23:45:51" {WMEDLEY}<library>tedit>TEDIT-FILE.;666 175062
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDITFROMLISPSOURCE)
|
||||
:CHANGES-TO (FNS \TEDIT.PUT.MCCS.SPLITPIECES \TEDIT.PUT.PCTB.NEXTNEW)
|
||||
(VARS TEDIT-FILECOMS)
|
||||
|
||||
:PREVIOUS-DATE "23-Oct-2025 08:49:06" {WMEDLEY}<library>tedit>TEDIT-FILE.;656)
|
||||
:PREVIOUS-DATE "14-Feb-2026 10:32:44" {WMEDLEY}<library>tedit>TEDIT-FILE.;659)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FILECOMS)
|
||||
@@ -50,8 +51,9 @@
|
||||
(* ;; "Putting pageframe functions are on TEDIT-PAGE)")
|
||||
|
||||
(FNS \TEDIT.PUT.PCTB \TEDIT.PUT.PCTB.PIECEDATA \TEDIT.PUT.TRAILER
|
||||
\TEDIT.PUT.PCTB.MERGEABLE \TEDIT.PUT.UTF8.SPLITPIECES \TEDIT.PUT.PCTB.NEXTNEW
|
||||
\TEDIT.INSERT.NEWPIECES \TEDIT.PUTRESET \ARBOUT \ATMOUT \DWOUT \STRINGOUT)
|
||||
\TEDIT.PUT.PCTB.MERGEABLE \TEDIT.PUT.UTF8.SPLITPIECES \TEDIT.PUT.MCCS.SPLITPIECES
|
||||
\TEDIT.PUT.PCTB.NEXTNEW \TEDIT.INSERT.NEWPIECES \TEDIT.PUTRESET \ARBOUT \ATMOUT
|
||||
\DWOUT \STRINGOUT)
|
||||
(FNS \TEDIT.PUT.CHARLOOKS.LIST \TEDIT.PUT.SINGLE.CHARLOOKS \TEDIT.PUT.CHARLOOKS
|
||||
\TEDIT.PUT.CHARLOOKS1 \TEDIT.PUT.OBJECT)
|
||||
(FNS \TEDIT.PUT.PARALOOKS.LIST \TEDIT.PUT.SINGLE.PARALOOKS \TEDIT.PUT.PARALOOKS))
|
||||
@@ -1830,6 +1832,7 @@
|
||||
|
||||
(\TEDIT.PUT.PCTB
|
||||
[LAMBDA (TEXTOBJ CHARSTREAM FORMATSTREAM CONTINUE KEEPSEPARATE)
|
||||
(* ; "Edited 14-Feb-2026 10:32 by rmk")
|
||||
(* ; "Edited 9-Sep-2025 21:32 by rmk")
|
||||
(* ; "Edited 26-Apr-2025 00:11 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
@@ -1922,10 +1925,10 @@
|
||||
|
||||
(* ;; "For MCCS, CHARSET will put out the char-shifting prefix bytes as needed. In format-version 3 all the file bytes belong to a piece, no skipping in the file. TEDIT.GET calls \TEDIT.INTERPRET.XCCS.SHIFTS to shave those bytes. NSHIFTBYTES is used here if the edit will continue.")
|
||||
|
||||
(CHARSET CHARSTREAM (CL:IF (MEMB (PTYPE PC)
|
||||
FAT.PTYPES)
|
||||
T
|
||||
0))
|
||||
(CHARSET CHARSTREAM (OR (AND (EQ EXTFORMAT :XCCS)
|
||||
(MEMB (PTYPE PC)
|
||||
FAT.PTYPES))
|
||||
(PCHARSET PC)))
|
||||
(SETQ NSHIFTBYTES (IDIFFERENCE (\GETFILEPTR CHARSTREAM)
|
||||
OLDBYTE#)))
|
||||
(do (\TEDIT.PUT.PCTB.PIECEDATA PC CHARSTREAM TEXTOBJ FORMATSTREAM OLDBYTE#)
|
||||
@@ -2152,8 +2155,35 @@
|
||||
(RETURN))))
|
||||
NIL])
|
||||
|
||||
(\TEDIT.PUT.MCCS.SPLITPIECES
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 15-Feb-2026 23:45 by rmk")
|
||||
|
||||
(* ;; "We are putting to a :MCCS format file, and MCCS doesn't support single-byte runs of non-charset 0 characters. This function splits fat pieces into subpieces with only charset-0 characters or no charset-0 characters. The former will be put out as THINFILE pieces, the latter as FATFILE2.")
|
||||
|
||||
(for PC FIRST0 FIRSTNON0 inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
|
||||
when [AND (MEMB (PTYPE PC)
|
||||
(CONSTANT (LIST FATSTRING.PTYPE FATFILE2.PTYPE UTF8.PTYPE)))
|
||||
(SETQ FIRST0 (find I from 0 to (PLAST PC)
|
||||
suchthat (EQ 0 (\CHARSET (\TEDIT.PIECE.NTHCHARCODE PC I]
|
||||
do (if [SETQ FIRSTNON0 (find I from (ADD1 FIRST0) to (PLAST PC)
|
||||
suchthat (NEQ 0 (\CHARSET (\TEDIT.PIECE.NTHCHARCODE PC I]
|
||||
then
|
||||
(* ;; "xxx000yyy --> xxx 000yyy or 000yyy --> 000 yyy")
|
||||
|
||||
(\TEDIT.SPLITPIECE PC (CL:IF (EQ FIRST0 0)
|
||||
FIRSTNON0
|
||||
FIRST0)
|
||||
TEXTOBJ) (* ; "Iterate to the residual piece")
|
||||
(SETQ PC (PREVPIECE PC))
|
||||
elseif (NEQ 0 FIRST0)
|
||||
then
|
||||
(* ;; "xxx000")
|
||||
|
||||
(\TEDIT.SPLITPIECE PC FIRST0 TEXTOBJ])
|
||||
|
||||
(\TEDIT.PUT.PCTB.NEXTNEW
|
||||
[LAMBDA (NEXTNEW PC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ EOLC NSHIFTBYTES)
|
||||
(* ; "Edited 15-Feb-2026 15:09 by rmk")
|
||||
(* ; "Edited 25-Apr-2025 08:48 by rmk")
|
||||
(* ; "Edited 26-Mar-2025 09:27 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
@@ -2202,7 +2232,7 @@
|
||||
"The file may have LF, but we want to restore EOL internally")
|
||||
(CL:WHEN [AND (EQ THINFILE.PTYPE (PTYPE NEXTNEW))
|
||||
(EQ (CHARCODE EOL)
|
||||
(\TEDIT.PIECE.NTHCHARCODE PC (PLEN PC]
|
||||
(\TEDIT.PIECE.NTHCHARCODE PC (PLAST PC]
|
||||
(if (EQ 1 (PLEN NEXTNEW))
|
||||
then (FSETPC NEXTNEW PTYPE THINSTRING.PTYPE)
|
||||
(FSETPC NEXTNEW PCONTENTS (ALLOCSTRING 1 (CHARCODE EOL)))
|
||||
@@ -2691,28 +2721,29 @@
|
||||
|
||||
(RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5304 35563 (TEDIT.GET 5314 . 11724) (TEDIT.FORMATTEDFILEP 11726 . 13042) (
|
||||
TEDIT.FILEDATE 13044 . 14353) (TEDIT.INCLUDE 14355 . 22384) (TEDIT.RAW.INCLUDE 22386 . 23194) (
|
||||
TEDIT.PUT 23196 . 31552) (TEDIT.PUT.STREAM 31554 . 35561)) (35564 56838 (\TEDIT.GET.FOREIGN.FILE 35574
|
||||
. 38999) (\TEDIT.GET.UNFORMATTED.FILE 39001 . 43307) (\TEDIT.GET.FORMATTED.FILE 43309 . 46952) (
|
||||
\TEDIT.FORMATTEDSTREAMP 46954 . 50085) (\ARBIN 50087 . 50807) (\ATMIN 50809 . 51346) (\DWIN 51348 .
|
||||
51727) (\STRINGIN 51729 . 52437) (\TEDIT.GET.TRAILER 52439 . 55307) (\TEDIT.CACHEFILE 55309 . 56836))
|
||||
(57004 73042 (\TEDIT.GET.PIECES3 57014 . 67977) (\TEDIT.GET.PROPS3 67979 . 71201) (
|
||||
\TEDIT.MAKE.STRINGPIECE 71203 . 73040)) (73043 86469 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 73053 . 79286)
|
||||
(\TEDIT.INTERPRET.MCCS.SHIFTS 79288 . 85533) (\TEDIT.CONVERT.XCCSTOMCCS 85535 . 86467)) (86491 92736 (
|
||||
\TEDIT.GET.UNFORMATTED.FILE.UTF8 86501 . 92734)) (92759 104101 (\TEDIT.GET.CHARLOOKS.LIST 92769 .
|
||||
93500) (\TEDIT.GET.SINGLE.CHARLOOKS 93502 . 100574) (\TEDIT.GET.CHARLOOKS 100576 . 102132) (
|
||||
\TEDIT.GET.PARALOOKS.INDEX 102134 . 102678) (\TEDIT.GET.CHARLOOKS.INDEX 102680 . 104099)) (104102
|
||||
111759 (\TEDIT.GET.PARALOOKS.LIST 104112 . 104734) (\TEDIT.GET.SINGLE.PARALOOKS 104736 . 111757)) (
|
||||
111760 115593 (\TEDIT.GET.OBJECT 111770 . 115591)) (115658 148921 (\TEDIT.PUT.PCTB 115668 . 125575) (
|
||||
\TEDIT.PUT.PCTB.PIECEDATA 125577 . 128775) (\TEDIT.PUT.TRAILER 128777 . 130105) (
|
||||
\TEDIT.PUT.PCTB.MERGEABLE 130107 . 133880) (\TEDIT.PUT.UTF8.SPLITPIECES 133882 . 138584) (
|
||||
\TEDIT.PUT.PCTB.NEXTNEW 138586 . 143082) (\TEDIT.INSERT.NEWPIECES 143084 . 146519) (\TEDIT.PUTRESET
|
||||
146521 . 146763) (\ARBOUT 146765 . 147489) (\ATMOUT 147491 . 148096) (\DWOUT 148098 . 148377) (
|
||||
\STRINGOUT 148379 . 148919)) (148922 161656 (\TEDIT.PUT.CHARLOOKS.LIST 148932 . 150604) (
|
||||
\TEDIT.PUT.SINGLE.CHARLOOKS 150606 . 156886) (\TEDIT.PUT.CHARLOOKS 156888 . 158227) (
|
||||
\TEDIT.PUT.CHARLOOKS1 158229 . 159280) (\TEDIT.PUT.OBJECT 159282 . 161654)) (161657 169296 (
|
||||
\TEDIT.PUT.PARALOOKS.LIST 161667 . 162569) (\TEDIT.PUT.SINGLE.PARALOOKS 162571 . 168155) (
|
||||
\TEDIT.PUT.PARALOOKS 168157 . 169294)) (169391 172796 (TEDITFROMLISPSOURCE 169401 . 172045) (
|
||||
SHELLSCRIPTP 172047 . 172276) (TEDITFROMSHELLSCRIPT 172278 . 172794)))))
|
||||
(FILEMAP (NIL (5423 35682 (TEDIT.GET 5433 . 11843) (TEDIT.FORMATTEDFILEP 11845 . 13161) (
|
||||
TEDIT.FILEDATE 13163 . 14472) (TEDIT.INCLUDE 14474 . 22503) (TEDIT.RAW.INCLUDE 22505 . 23313) (
|
||||
TEDIT.PUT 23315 . 31671) (TEDIT.PUT.STREAM 31673 . 35680)) (35683 56957 (\TEDIT.GET.FOREIGN.FILE 35693
|
||||
. 39118) (\TEDIT.GET.UNFORMATTED.FILE 39120 . 43426) (\TEDIT.GET.FORMATTED.FILE 43428 . 47071) (
|
||||
\TEDIT.FORMATTEDSTREAMP 47073 . 50204) (\ARBIN 50206 . 50926) (\ATMIN 50928 . 51465) (\DWIN 51467 .
|
||||
51846) (\STRINGIN 51848 . 52556) (\TEDIT.GET.TRAILER 52558 . 55426) (\TEDIT.CACHEFILE 55428 . 56955))
|
||||
(57123 73161 (\TEDIT.GET.PIECES3 57133 . 68096) (\TEDIT.GET.PROPS3 68098 . 71320) (
|
||||
\TEDIT.MAKE.STRINGPIECE 71322 . 73159)) (73162 86588 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 73172 . 79405)
|
||||
(\TEDIT.INTERPRET.MCCS.SHIFTS 79407 . 85652) (\TEDIT.CONVERT.XCCSTOMCCS 85654 . 86586)) (86610 92855 (
|
||||
\TEDIT.GET.UNFORMATTED.FILE.UTF8 86620 . 92853)) (92878 104220 (\TEDIT.GET.CHARLOOKS.LIST 92888 .
|
||||
93619) (\TEDIT.GET.SINGLE.CHARLOOKS 93621 . 100693) (\TEDIT.GET.CHARLOOKS 100695 . 102251) (
|
||||
\TEDIT.GET.PARALOOKS.INDEX 102253 . 102797) (\TEDIT.GET.CHARLOOKS.INDEX 102799 . 104218)) (104221
|
||||
111878 (\TEDIT.GET.PARALOOKS.LIST 104231 . 104853) (\TEDIT.GET.SINGLE.PARALOOKS 104855 . 111876)) (
|
||||
111879 115712 (\TEDIT.GET.OBJECT 111889 . 115710)) (115777 150880 (\TEDIT.PUT.PCTB 115787 . 125844) (
|
||||
\TEDIT.PUT.PCTB.PIECEDATA 125846 . 129044) (\TEDIT.PUT.TRAILER 129046 . 130374) (
|
||||
\TEDIT.PUT.PCTB.MERGEABLE 130376 . 134149) (\TEDIT.PUT.UTF8.SPLITPIECES 134151 . 138853) (
|
||||
\TEDIT.PUT.MCCS.SPLITPIECES 138855 . 140433) (\TEDIT.PUT.PCTB.NEXTNEW 140435 . 145041) (
|
||||
\TEDIT.INSERT.NEWPIECES 145043 . 148478) (\TEDIT.PUTRESET 148480 . 148722) (\ARBOUT 148724 . 149448) (
|
||||
\ATMOUT 149450 . 150055) (\DWOUT 150057 . 150336) (\STRINGOUT 150338 . 150878)) (150881 163615 (
|
||||
\TEDIT.PUT.CHARLOOKS.LIST 150891 . 152563) (\TEDIT.PUT.SINGLE.CHARLOOKS 152565 . 158845) (
|
||||
\TEDIT.PUT.CHARLOOKS 158847 . 160186) (\TEDIT.PUT.CHARLOOKS1 160188 . 161239) (\TEDIT.PUT.OBJECT
|
||||
161241 . 163613)) (163616 171255 (\TEDIT.PUT.PARALOOKS.LIST 163626 . 164528) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS 164530 . 170114) (\TEDIT.PUT.PARALOOKS 170116 . 171253)) (171350 174755 (
|
||||
TEDITFROMLISPSOURCE 171360 . 174004) (SHELLSCRIPTP 174006 . 174235) (TEDITFROMSHELLSCRIPT 174237 .
|
||||
174753)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "10-Feb-2026 11:07:12" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;465 155591
|
||||
(FILECREATED "16-Feb-2026 00:36:00" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;467 155443
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.CHANGE.CHARLOOKS \TEDIT.CHANGE.PARALOOKS)
|
||||
:CHANGES-TO (FNS \TEDIT.MCCS.TRANSLATE)
|
||||
|
||||
:PREVIOUS-DATE " 7-Dec-2025 16:32:32" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;460)
|
||||
:PREVIOUS-DATE "10-Feb-2026 11:07:12" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;465)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-LOOKSCOMS)
|
||||
@@ -924,7 +924,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.MCCS.TRANSLATE
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 6-Oct-2025 20:50 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 16-Feb-2026 00:35 by rmk")
|
||||
(* ; "Edited 6-Oct-2025 20:50 by rmk")
|
||||
(* ; "Edited 5-Oct-2025 10:57 by rmk")
|
||||
(* ; "Edited 25-Sep-2025 21:30 by rmk")
|
||||
(* ; "Edited 9-Sep-2025 21:48 by rmk")
|
||||
@@ -954,19 +955,17 @@
|
||||
(SETQ CLOOKS
|
||||
(PCHARLOOKS PC))
|
||||
CLFONT]
|
||||
do (for OFFSET OLDCODE STRING FAT from 1 to (PLEN PC) eachtime (SETQ OLDCODE
|
||||
(
|
||||
\TEDIT.PIECE.NTHCHARCODE
|
||||
PC OFFSET))
|
||||
do (for OFFSET OLDCODE STRING FAT from 0 to (PLAST PC)
|
||||
eachtime (SETQ OLDCODE (\TEDIT.PIECE.NTHCHARCODE PC OFFSET))
|
||||
unless (EQ OLDCODE (APPLY* TOMCCSFN OLDCODE))
|
||||
do
|
||||
(* ;; "This piece has recoded character. Start over to convert it to a string piece with necessary code conversions. (The logic to split the original piece at just the changes while still preserving the iteration would be very complicated).")
|
||||
|
||||
(SETQ STRING (ALLOCSTRING (PLEN PC)))
|
||||
[for OFFSET from 1 to (PLEN PC) do (RPLCHARCODE STRING OFFSET
|
||||
(APPLY* TOMCCSFN (
|
||||
[for I from 0 to (PLAST PC) do (RPLCHARCODE STRING (ADD1 I)
|
||||
(APPLY* TOMCCSFN (
|
||||
\TEDIT.PIECE.NTHCHARCODE
|
||||
PC OFFSET]
|
||||
PC I]
|
||||
(SETQ FAT (ffetch (STRINGP FATSTRINGP) of STRING))
|
||||
(FSETPC PC PTYPE (CL:IF FAT
|
||||
FATSTRING.PTYPE
|
||||
@@ -2465,26 +2464,26 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (22045 23987 (\TEDIT.CHARLOOKS.DEFPRINT 22055 . 23191) (\TEDIT.PARALOOKS.DEFPRINT 23193
|
||||
. 23985)) (24091 24477 (\TEDIT.CREATE.FACE.MENU 24101 . 24273) (\TEDIT.CREATE.SIZE.MENU 24275 . 24475
|
||||
)) (25481 27370 (\TEDIT.CHARLOOKS.FEATURE.CHECK 25491 . 27368)) (27642 52899 (
|
||||
\TEDIT.CHARLOOKS.FROM.FONT 27652 . 29936) (\TEDIT.EQCLOOKS 29938 . 32969) (\TEDIT.SAMECLOOKS 32971 .
|
||||
36142) (TEDIT.CARETLOOKS 36144 . 37690) (TEDIT.COPY.LOOKS 37692 . 40975) (
|
||||
\TEDIT.UNPARSE.CHARLOOKS.LIST 40977 . 44471) (\TEDIT.MODIFYLOOKS 44473 . 46633) (TEDIT.NEW.FONT 46635
|
||||
. 47082) (\TEDIT.CARETLOOKS.VERIFY 47084 . 47921) (\TEDIT.CARETPIECE 47923 . 48228) (
|
||||
\TEDIT.GET.INSERT.CHARLOOKS 48230 . 51277) (\TEDIT.GET.TERMSA.WIDTHS 51279 . 51695) (
|
||||
\TEDIT.PARSE.CHARLOOKS.LIST 51697 . 52897)) (52900 65027 (\TEDIT.MCCS.TRANSLATE 52910 . 58763) (
|
||||
\TEDIT.CONVERT.TO.FORMATTED 58765 . 65025)) (65899 73236 (\TEDIT.UNIQUIFY.CHARLOOKS 65909 . 67569) (
|
||||
\TEDIT.UNIQUIFY.PARALOOKS 67571 . 68838) (\TEDIT.UNIQUIFY.ALL 68840 . 70928) (
|
||||
\TEDIT.FLUSH.UNUSED.LOOKS 70930 . 73234)) (73269 85227 (TEDIT.LOOKS 73279 . 75668) (TEDIT.GET.LOOKS
|
||||
75670 . 78005) (TEDIT.SUBLOOKS 78007 . 82387) (TEDIT.FINDLOOKS 82389 . 85225)) (85228 115001 (
|
||||
\TEDIT.CHANGE.CHARLOOKS 85238 . 94139) (\TEDIT.CHANGE.CHARLOOKS.NEW 94141 . 97956) (
|
||||
\TEDIT.CHARLOOKS.CHANGE.FONT 97958 . 106265) (\TEDIT.FONT.NEXTSIZE 106267 . 107888) (\TEDIT.LOOKS
|
||||
107890 . 111219) (\TEDIT.FONTCOPY 111221 . 112722) (\TEDIT.COERCE.FONTCLASS 112724 . 113875) (
|
||||
\TEDIT.FONTCLASS.TO.FONT 113877 . 114999)) (115044 146933 (\TEDIT.EQFMTSPEC 115054 . 118269) (
|
||||
TEDIT.GET.PARALOOKS 118271 . 122318) (\TEDIT.PARSE.PARALOOKS.LIST 122320 . 130353) (TEDIT.PARALOOKS
|
||||
130355 . 131395) (\TEDIT.CHANGE.PARALOOKS 131397 . 138606) (\TEDIT.CHANGE.PARALOOKS.NEW 138608 .
|
||||
142591) (TEDIT.COPY.PARALOOKS 142593 . 145267) (\TEDIT.PARABOUNDS 145269 . 146931)) (146993 154709 (
|
||||
TEDIT.SUBPARALOOKS 147003 . 151105) (SAMEPARALOOKS 151107 . 154707)) (154710 155397 (
|
||||
\TEDIT.MARK.REVISION 154720 . 155395)))))
|
||||
(FILEMAP (NIL (22019 23961 (\TEDIT.CHARLOOKS.DEFPRINT 22029 . 23165) (\TEDIT.PARALOOKS.DEFPRINT 23167
|
||||
. 23959)) (24065 24451 (\TEDIT.CREATE.FACE.MENU 24075 . 24247) (\TEDIT.CREATE.SIZE.MENU 24249 . 24449
|
||||
)) (25455 27344 (\TEDIT.CHARLOOKS.FEATURE.CHECK 25465 . 27342)) (27616 52873 (
|
||||
\TEDIT.CHARLOOKS.FROM.FONT 27626 . 29910) (\TEDIT.EQCLOOKS 29912 . 32943) (\TEDIT.SAMECLOOKS 32945 .
|
||||
36116) (TEDIT.CARETLOOKS 36118 . 37664) (TEDIT.COPY.LOOKS 37666 . 40949) (
|
||||
\TEDIT.UNPARSE.CHARLOOKS.LIST 40951 . 44445) (\TEDIT.MODIFYLOOKS 44447 . 46607) (TEDIT.NEW.FONT 46609
|
||||
. 47056) (\TEDIT.CARETLOOKS.VERIFY 47058 . 47895) (\TEDIT.CARETPIECE 47897 . 48202) (
|
||||
\TEDIT.GET.INSERT.CHARLOOKS 48204 . 51251) (\TEDIT.GET.TERMSA.WIDTHS 51253 . 51669) (
|
||||
\TEDIT.PARSE.CHARLOOKS.LIST 51671 . 52871)) (52874 64879 (\TEDIT.MCCS.TRANSLATE 52884 . 58615) (
|
||||
\TEDIT.CONVERT.TO.FORMATTED 58617 . 64877)) (65751 73088 (\TEDIT.UNIQUIFY.CHARLOOKS 65761 . 67421) (
|
||||
\TEDIT.UNIQUIFY.PARALOOKS 67423 . 68690) (\TEDIT.UNIQUIFY.ALL 68692 . 70780) (
|
||||
\TEDIT.FLUSH.UNUSED.LOOKS 70782 . 73086)) (73121 85079 (TEDIT.LOOKS 73131 . 75520) (TEDIT.GET.LOOKS
|
||||
75522 . 77857) (TEDIT.SUBLOOKS 77859 . 82239) (TEDIT.FINDLOOKS 82241 . 85077)) (85080 114853 (
|
||||
\TEDIT.CHANGE.CHARLOOKS 85090 . 93991) (\TEDIT.CHANGE.CHARLOOKS.NEW 93993 . 97808) (
|
||||
\TEDIT.CHARLOOKS.CHANGE.FONT 97810 . 106117) (\TEDIT.FONT.NEXTSIZE 106119 . 107740) (\TEDIT.LOOKS
|
||||
107742 . 111071) (\TEDIT.FONTCOPY 111073 . 112574) (\TEDIT.COERCE.FONTCLASS 112576 . 113727) (
|
||||
\TEDIT.FONTCLASS.TO.FONT 113729 . 114851)) (114896 146785 (\TEDIT.EQFMTSPEC 114906 . 118121) (
|
||||
TEDIT.GET.PARALOOKS 118123 . 122170) (\TEDIT.PARSE.PARALOOKS.LIST 122172 . 130205) (TEDIT.PARALOOKS
|
||||
130207 . 131247) (\TEDIT.CHANGE.PARALOOKS 131249 . 138458) (\TEDIT.CHANGE.PARALOOKS.NEW 138460 .
|
||||
142443) (TEDIT.COPY.PARALOOKS 142445 . 145119) (\TEDIT.PARABOUNDS 145121 . 146783)) (146845 154561 (
|
||||
TEDIT.SUBPARALOOKS 146855 . 150957) (SAMEPARALOOKS 150959 . 154559)) (154562 155249 (
|
||||
\TEDIT.MARK.REVISION 154572 . 155247)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,14 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "28-Jul-2025 23:25:19"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-PCTREE.;249 69193
|
||||
(FILECREATED "14-Feb-2026 13:22:06" {WMEDLEY}<library>TEDIT>TEDIT-PCTREE.;251 68691
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.MAKEPCTB)
|
||||
:CHANGES-TO (VARS TEDIT-PCTREECOMS)
|
||||
(FNS \TEDIT.UNLINKPIECE \TEDIT.DELETEPIECES)
|
||||
|
||||
:PREVIOUS-DATE " 8-Feb-2025 20:56:54"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-PCTREE.;248)
|
||||
:PREVIOUS-DATE "28-Jul-2025 23:25:19" {WMEDLEY}<library>TEDIT>TEDIT-PCTREE.;249)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
|
||||
@@ -37,8 +36,8 @@
|
||||
(GLOBALVARS MULTIPLE-PIECE-TABLES)
|
||||
(FNS \TEDIT.MAKEPCTB \TEDIT.UPDATEPCNODES \TEDIT.FIRSTPIECE \TEDIT.DELETETREE
|
||||
\TEDIT.INSERTTREE \TEDIT.LASTPIECE \TEDIT.PCTOCH \TEDIT.CHTOPC \TEDIT.SET-TOTLEN
|
||||
\TEDIT.MAKE.VACANT.BTREESLOT \TEDIT.LINKNEWPIECE \TEDIT.UNLINKPIECE \TEDIT.SPLITPIECE
|
||||
\TEDIT.INSERTPIECE \TEDIT.INSERTPIECES \TEDIT.DELETEPIECES \TEDIT.ALIGNEDPIECE)
|
||||
\TEDIT.MAKE.VACANT.BTREESLOT \TEDIT.LINKNEWPIECE \TEDIT.SPLITPIECE \TEDIT.INSERTPIECE
|
||||
\TEDIT.INSERTPIECES \TEDIT.DELETEPIECES \TEDIT.ALIGNEDPIECE)
|
||||
(COMS (* ; "Debugging ")
|
||||
(FNS \TEDIT.BTVALIDATE \TEDIT.BTVALIDATE.PRINT \TEDIT.CHECK-BTREE \TEDIT.CHECK-BTREE1
|
||||
\TEDIT.BTFAIL \TEDIT.MATCHPCS)
|
||||
@@ -658,20 +657,6 @@
|
||||
(freplace (PIECE PREVPIECE) of NEXT with NEW))
|
||||
NEW])
|
||||
|
||||
(\TEDIT.UNLINKPIECE
|
||||
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 7-Feb-2025 08:04 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 21-Oct-2023 17:24 by rmk")
|
||||
(* ; "Edited 30-May-2023 00:31 by rmk")
|
||||
|
||||
(* ;; "Takes PC out of the piece chain, linking prev and next around it.")
|
||||
|
||||
(\TEDIT.THELP 'NOTCALLED?)
|
||||
(CL:WHEN PREV
|
||||
(freplace (PIECE NEXTPIECE) of PREV with (NEXTPIECE PC)))
|
||||
(freplace (PIECE PREVPIECE) of (OR (NEXTPIECE PC)
|
||||
(FGETTOBJ TEXTOBJ SUFFIXPIECE)) with PREV])
|
||||
|
||||
(\TEDIT.SPLITPIECE
|
||||
[LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:11 by rmk")
|
||||
@@ -838,7 +823,8 @@
|
||||
PIECES])
|
||||
|
||||
(\TEDIT.DELETEPIECES
|
||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 7-Feb-2025 08:08 by rmk")
|
||||
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 14-Feb-2026 13:20 by rmk")
|
||||
(* ; "Edited 7-Feb-2025 08:08 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 10:50 by rmk")
|
||||
(* ; "Edited 16-Mar-2024 10:00 by rmk")
|
||||
(* ; "Edited 25-Nov-2023 12:12 by rmk")
|
||||
@@ -859,6 +845,11 @@
|
||||
(* ;; "This may not be entirely safe against an interrupt, which only matters on the call from \INSERTSELPIECES (otherwise the data isn't yet visible). Although the tree is consistent with the remaining pieces after each deletion, the fact that we keep the SELPIECE links intact means that the remaining pieces point to pieces that are no longer in the tree. We could do a little more work to incrementally chain the deleted pieces together, one by one, as they are deleted--in the end they would all be out of the tree, and the deletion chain would have been reconnected. Alternatively, we can make the whole loop be uninterruptable. ")
|
||||
|
||||
(\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'BEFORE TEXTOBJ)
|
||||
(CL:WHEN (type? PIECE SELPIECES)
|
||||
(SETQ SELPIECES (create SELPIECES
|
||||
SPFIRST _ SELPIECES
|
||||
SPLAST _ SELPIECES
|
||||
SPLEN _ (PLEN SELPIECES))))
|
||||
(for PC PREV NEXT first (FSETTOBJ TEXTOBJ HINTPC NIL)
|
||||
(SETQ PREV (PREVPIECE (GETSPC SELPIECES SPFIRST)))
|
||||
(* ; "For incremental chain-update")
|
||||
@@ -1113,13 +1104,13 @@
|
||||
(GLOBALVARS BTVALIDATETAGS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (8767 56719 (\TEDIT.MAKEPCTB 8777 . 10670) (\TEDIT.UPDATEPCNODES 10672 . 12966) (
|
||||
\TEDIT.FIRSTPIECE 12968 . 14375) (\TEDIT.DELETETREE 14377 . 17651) (\TEDIT.INSERTTREE 17653 . 20398) (
|
||||
\TEDIT.LASTPIECE 20400 . 21207) (\TEDIT.PCTOCH 21209 . 23306) (\TEDIT.CHTOPC 23308 . 29485) (
|
||||
\TEDIT.SET-TOTLEN 29487 . 30275) (\TEDIT.MAKE.VACANT.BTREESLOT 30277 . 37007) (\TEDIT.LINKNEWPIECE
|
||||
37009 . 38598) (\TEDIT.UNLINKPIECE 38600 . 39420) (\TEDIT.SPLITPIECE 39422 . 44078) (
|
||||
\TEDIT.INSERTPIECE 44080 . 47352) (\TEDIT.INSERTPIECES 47354 . 50446) (\TEDIT.DELETEPIECES 50448 .
|
||||
54602) (\TEDIT.ALIGNEDPIECE 54604 . 56717)) (56747 69070 (\TEDIT.BTVALIDATE 56757 . 58298) (
|
||||
\TEDIT.BTVALIDATE.PRINT 58300 . 59665) (\TEDIT.CHECK-BTREE 59667 . 61994) (\TEDIT.CHECK-BTREE1 61996
|
||||
. 67627) (\TEDIT.BTFAIL 67629 . 68051) (\TEDIT.MATCHPCS 68053 . 69068)))))
|
||||
(FILEMAP (NIL (8731 56217 (\TEDIT.MAKEPCTB 8741 . 10634) (\TEDIT.UPDATEPCNODES 10636 . 12930) (
|
||||
\TEDIT.FIRSTPIECE 12932 . 14339) (\TEDIT.DELETETREE 14341 . 17615) (\TEDIT.INSERTTREE 17617 . 20362) (
|
||||
\TEDIT.LASTPIECE 20364 . 21171) (\TEDIT.PCTOCH 21173 . 23270) (\TEDIT.CHTOPC 23272 . 29449) (
|
||||
\TEDIT.SET-TOTLEN 29451 . 30239) (\TEDIT.MAKE.VACANT.BTREESLOT 30241 . 36971) (\TEDIT.LINKNEWPIECE
|
||||
36973 . 38562) (\TEDIT.SPLITPIECE 38564 . 43220) (\TEDIT.INSERTPIECE 43222 . 46494) (
|
||||
\TEDIT.INSERTPIECES 46496 . 49588) (\TEDIT.DELETEPIECES 49590 . 54100) (\TEDIT.ALIGNEDPIECE 54102 .
|
||||
56215)) (56245 68568 (\TEDIT.BTVALIDATE 56255 . 57796) (\TEDIT.BTVALIDATE.PRINT 57798 . 59163) (
|
||||
\TEDIT.CHECK-BTREE 59165 . 61492) (\TEDIT.CHECK-BTREE1 61494 . 67125) (\TEDIT.BTFAIL 67127 . 67549) (
|
||||
\TEDIT.MATCHPCS 67551 . 68566)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "14-Jan-2026 14:32:01" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;736 162073
|
||||
(FILECREATED "16-Feb-2026 00:38:33" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;738 162152
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.COPYSEL TEDIT.SELPROP)
|
||||
:CHANGES-TO (FNS \TEDIT.SELPIECES.CHARTRANSFORM)
|
||||
|
||||
:PREVIOUS-DATE "10-Jan-2026 12:33:26" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;735)
|
||||
:PREVIOUS-DATE "14-Jan-2026 14:32:01" {WMEDLEY}<library>tedit>TEDIT-SELECTION.;736)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-SELECTIONCOMS)
|
||||
@@ -2041,7 +2041,8 @@
|
||||
SPLASTCHAR _ (ffetch (SELPIECES SPLASTCHAR) of SP2])
|
||||
|
||||
(\TEDIT.SELPIECES.CHARTRANSFORM
|
||||
[LAMBDA (SELPIECES CHARFN OBJECTSTOO TSTREAM) (* ; "Edited 24-Apr-2025 16:02 by rmk")
|
||||
[LAMBDA (SELPIECES CHARFN OBJECTSTOO TSTREAM) (* ; "Edited 16-Feb-2026 00:38 by rmk")
|
||||
(* ; "Edited 24-Apr-2025 16:02 by rmk")
|
||||
(* ; "Edited 20-Apr-2025 23:23 by rmk")
|
||||
(* ; "Edited 16-Mar-2025 10:03 by rmk")
|
||||
(* ; "Edited 7-Nov-2024 21:50 by rmk")
|
||||
@@ -2066,10 +2067,10 @@
|
||||
|
||||
(* ;; "This assumes that no file piece has a PLEN greater than \MaxArrayLen characters. We rely on the piece-table reader and writer to guarantee this. If not, ALLOCSTRING will cause an error.")
|
||||
|
||||
[for I from 1 to (PLEN PC)
|
||||
do (RPLCHARCODE STR I (APPLY* CHARFN (\TEDIT.PIECE.NTHCHARCODE
|
||||
PC I)
|
||||
(add INDEX 1]
|
||||
[for I from 0 to (PLAST PC)
|
||||
do (RPLCHARCODE STR (ADD1 I)
|
||||
(APPLY* CHARFN (\TEDIT.PIECE.NTHCHARCODE PC I)
|
||||
(add INDEX 1]
|
||||
(if (fetch (STRINGP FATSTRINGP) of STR)
|
||||
then (FSETPC PC PTYPE FATSTRING.PTYPE)
|
||||
(FSETPC PC PBYTESPERCHAR 2)
|
||||
@@ -2570,26 +2571,26 @@
|
||||
(ADDTOVAR LAMA TEDIT.SELPROP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (15886 17707 (\TEDIT.SELECTION.DEFPRINT 15896 . 17705)) (17744 19249 (
|
||||
\TEDIT.SET.GLOBAL.SELECTIONS 17754 . 19247)) (19250 25471 (\TEDIT.SELECTED.PIECES 19260 . 20899) (
|
||||
\TEDIT.FIND.PROTECTED.END 20901 . 22695) (\TEDIT.FIND.PROTECTED.START 22697 . 24680) (
|
||||
\TEDIT.WORD.BOUND 24682 . 25469)) (25605 59712 (\TEDIT.EXTEND.SEL 25615 . 32855) (\TEDIT.SCAN.LINE
|
||||
32857 . 44530) (\TEDIT.SCAN.LINE.WORD 44532 . 49525) (\TEDIT.XYTOSEL 49527 . 56865) (\TEDIT.REGIONTYPE
|
||||
56867 . 57886) (\TEDIT.XYTOSEL.INLINEP 57888 . 58343) (\TEDIT.XYTOSEL.LINE 58345 . 59710)) (59713
|
||||
73258 (\TEDIT.FIXSEL 59723 . 69100) (\TEDIT.CHTOLINEX 69102 . 73256)) (73259 77463 (
|
||||
\TEDIT.RESET.EXTEND.PENDING.DELETE 73269 . 74547) (\TEDIT.SET.SEL.LOOKS 74549 . 77461)) (78400 99553 (
|
||||
\TEDIT.SHOWSEL 78410 . 83386) (\TEDIT.NOSEL 83388 . 83689) (\TEDIT.SEL.OFF 83691 . 84102) (
|
||||
\TEDIT.SEL.ON 84104 . 84520) (\TEDIT.SHOWSEL.HILIGHT 84522 . 89143) (\TEDIT.UPDATE.SEL 89145 . 93747)
|
||||
(\TEDIT.CARETLINE 93749 . 94463) (\TEDIT.SEL.L1 94465 . 95148) (\TEDIT.SEL.LN 95150 . 95833) (
|
||||
\TEDIT.SEL.DELETEDCHARS 95835 . 99551)) (99554 104436 (\TEDIT.COPYSEL 99564 . 102206) (
|
||||
\TEDIT.SEL.CHANGED? 102208 . 104434)) (104467 118126 (\TEDIT.SELECT.OBJECT 104477 . 109430) (
|
||||
\TEDIT.SHOWSEL.OBJECT 109432 . 111663) (\TEDIT.CLIP.OBJECT 111665 . 113669) (\TEDIT.OPERATE.OBJECT
|
||||
113671 . 118124)) (118154 137903 (\TEDIT.SELPIECES 118164 . 122445) (\TEDIT.SELPIECES.COPY 122447 .
|
||||
124936) (\TEDIT.SELPIECES.CONCAT 124938 . 126817) (\TEDIT.SELPIECES.CHARTRANSFORM 126819 . 130278) (
|
||||
\TEDIT.SELPIECES.FROM.STRING 130280 . 135538) (\TEDIT.SELPIECES.TO.STRING 135540 . 137901)) (137956
|
||||
161904 (TEDIT.XYTOCH 137966 . 140542) (TEDIT.SELPROP 140544 . 144821) (TEDIT.GETPOINT 144823 . 146743)
|
||||
(TEDIT.GETSEL 146745 . 147621) (TEDIT.GETSEL.PARA 147623 . 148572) (TEDIT.SCANSEL 148574 . 149522) (
|
||||
TEDIT.SET.SEL.LOOKS 149524 . 151009) (TEDIT.SETSEL 151011 . 155929) (TEDIT.SHOWSEL 155931 . 157795) (
|
||||
TEDIT.SEL.AS.STRING 157797 . 160282) (TEDIT.SEL.AS.SEXPR 160284 . 161570) (TEDIT.SELECTALL 161572 .
|
||||
161902)))))
|
||||
(FILEMAP (NIL (15888 17709 (\TEDIT.SELECTION.DEFPRINT 15898 . 17707)) (17746 19251 (
|
||||
\TEDIT.SET.GLOBAL.SELECTIONS 17756 . 19249)) (19252 25473 (\TEDIT.SELECTED.PIECES 19262 . 20901) (
|
||||
\TEDIT.FIND.PROTECTED.END 20903 . 22697) (\TEDIT.FIND.PROTECTED.START 22699 . 24682) (
|
||||
\TEDIT.WORD.BOUND 24684 . 25471)) (25607 59714 (\TEDIT.EXTEND.SEL 25617 . 32857) (\TEDIT.SCAN.LINE
|
||||
32859 . 44532) (\TEDIT.SCAN.LINE.WORD 44534 . 49527) (\TEDIT.XYTOSEL 49529 . 56867) (\TEDIT.REGIONTYPE
|
||||
56869 . 57888) (\TEDIT.XYTOSEL.INLINEP 57890 . 58345) (\TEDIT.XYTOSEL.LINE 58347 . 59712)) (59715
|
||||
73260 (\TEDIT.FIXSEL 59725 . 69102) (\TEDIT.CHTOLINEX 69104 . 73258)) (73261 77465 (
|
||||
\TEDIT.RESET.EXTEND.PENDING.DELETE 73271 . 74549) (\TEDIT.SET.SEL.LOOKS 74551 . 77463)) (78402 99555 (
|
||||
\TEDIT.SHOWSEL 78412 . 83388) (\TEDIT.NOSEL 83390 . 83691) (\TEDIT.SEL.OFF 83693 . 84104) (
|
||||
\TEDIT.SEL.ON 84106 . 84522) (\TEDIT.SHOWSEL.HILIGHT 84524 . 89145) (\TEDIT.UPDATE.SEL 89147 . 93749)
|
||||
(\TEDIT.CARETLINE 93751 . 94465) (\TEDIT.SEL.L1 94467 . 95150) (\TEDIT.SEL.LN 95152 . 95835) (
|
||||
\TEDIT.SEL.DELETEDCHARS 95837 . 99553)) (99556 104438 (\TEDIT.COPYSEL 99566 . 102208) (
|
||||
\TEDIT.SEL.CHANGED? 102210 . 104436)) (104469 118128 (\TEDIT.SELECT.OBJECT 104479 . 109432) (
|
||||
\TEDIT.SHOWSEL.OBJECT 109434 . 111665) (\TEDIT.CLIP.OBJECT 111667 . 113671) (\TEDIT.OPERATE.OBJECT
|
||||
113673 . 118126)) (118156 137982 (\TEDIT.SELPIECES 118166 . 122447) (\TEDIT.SELPIECES.COPY 122449 .
|
||||
124938) (\TEDIT.SELPIECES.CONCAT 124940 . 126819) (\TEDIT.SELPIECES.CHARTRANSFORM 126821 . 130357) (
|
||||
\TEDIT.SELPIECES.FROM.STRING 130359 . 135617) (\TEDIT.SELPIECES.TO.STRING 135619 . 137980)) (138035
|
||||
161983 (TEDIT.XYTOCH 138045 . 140621) (TEDIT.SELPROP 140623 . 144900) (TEDIT.GETPOINT 144902 . 146822)
|
||||
(TEDIT.GETSEL 146824 . 147700) (TEDIT.GETSEL.PARA 147702 . 148651) (TEDIT.SCANSEL 148653 . 149601) (
|
||||
TEDIT.SET.SEL.LOOKS 149603 . 151088) (TEDIT.SETSEL 151090 . 156008) (TEDIT.SHOWSEL 156010 . 157874) (
|
||||
TEDIT.SEL.AS.STRING 157876 . 160361) (TEDIT.SEL.AS.SEXPR 160363 . 161649) (TEDIT.SELECTALL 161651 .
|
||||
161981)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "26-Jan-2026 23:58:48" {WMEDLEY}<library>tedit>TEDIT-STREAM.;936 194450
|
||||
(FILECREATED "16-Feb-2026 12:40:44" {WMEDLEY}<library>tedit>TEDIT-STREAM.;944 193110
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDIT-STREAMCOMS)
|
||||
(FNS TEDIT.IMAGESTREAM.OPEN \TEDIT.STREAMINIT \TEDIT.TEXTINIT)
|
||||
:CHANGES-TO (FNS \TEDIT.STREAMINIT)
|
||||
|
||||
:PREVIOUS-DATE "14-Jan-2026 14:32:01" {WMEDLEY}<library>tedit>TEDIT-STREAM.;933)
|
||||
:PREVIOUS-DATE "16-Feb-2026 09:39:00" {WMEDLEY}<library>tedit>TEDIT-STREAM.;943)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-STREAMCOMS)
|
||||
@@ -15,8 +14,8 @@
|
||||
(RPAQQ TEDIT-STREAMCOMS
|
||||
[(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(EXPORT (RECORDS PIECE TEXTOBJ TEXTSTREAM)
|
||||
(MACROS NEXTPIECE PREVPIECE PLEN PTYPE PCONTENTS PCHARLOOKS PCHARSET PPARALOOKS
|
||||
PPARALAST PFPOS PBYTELEN PNEW PBINABLE PBYTESPERCHAR POBJ)
|
||||
(MACROS NEXTPIECE PREVPIECE PLEN PLAST PTYPE PCONTENTS PCHARLOOKS PCHARSET
|
||||
PPARALOOKS PPARALAST PFPOS PBYTELEN PNEW PBINABLE PBYTESPERCHAR POBJ)
|
||||
(MACROS SETPC FSETPC GETPC FGETPC)
|
||||
(MACROS THINPIECEP)
|
||||
(MACROS VISIBLEPIECEP \NEXT.VISIBLE.PIECE \PREV.VISIBLE.PIECE)
|
||||
@@ -72,10 +71,7 @@
|
||||
(MACROS \INSERTCH.EXTENDABLE))
|
||||
(FNS \TEDIT.DELETE.SELPIECES \TEDIT.INSERTCH \TEDIT.INSERTCH.HISTORY \TEDIT.INSERTEOL
|
||||
\TEDIT.INSERTCH.INSERTION \TEDIT.INSERTCH.EXTEND)
|
||||
(FNS \TEDIT.NEXTCHANGEABLE.CHNO \TEDIT.LASTCHANGEABLE.CHNO)
|
||||
(FNS \SETUPGETCH))
|
||||
(* ;
|
||||
"Deprecated, maybe still external callers")
|
||||
(FNS \TEDIT.NEXTCHANGEABLE.CHNO \TEDIT.LASTCHANGEABLE.CHNO))
|
||||
(FNS \TEDIT.INSTALL.PIECE)
|
||||
[COMS (* ; "Support for TEXTPROP")
|
||||
(FNS TEXTPROP GETTEXTPROP PUTTEXTPROP GETTEXTPROPS PUTTEXTPROPS TEXTPROP.ADD
|
||||
@@ -397,6 +393,9 @@
|
||||
(PUTPROPS PLEN MACRO ((PC)
|
||||
(ffetch (PIECE PLEN) of PC)))
|
||||
|
||||
(PUTPROPS PLAST MACRO ((PC)
|
||||
(SUB1 (PLEN PC))))
|
||||
|
||||
(PUTPROPS PTYPE MACRO ((PC)
|
||||
(ffetch (PIECE PTYPE) of PC)))
|
||||
|
||||
@@ -924,7 +923,8 @@
|
||||
else (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM])
|
||||
|
||||
(\TEDIT.TEXTBACKFILEPTR
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
[LAMBDA (TSTREAM) (* ; "Edited 16-Feb-2026 08:54 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:33 by rmk")
|
||||
(* ; "Edited 1-Feb-2024 11:25 by rmk")
|
||||
(* ; "Edited 5-Jan-2024 17:57 by rmk")
|
||||
(* ; "Edited 28-Dec-2023 13:34 by rmk")
|
||||
@@ -956,7 +956,7 @@
|
||||
then (CL:WHEN (SETQ PPC (\PREV.VISIBLE.PIECE PC))
|
||||
(* ;
|
||||
"Back up to last char of previous piece, if any.")
|
||||
(\TEDIT.INSTALL.PIECE TSTREAM PPC (SUB1 (PLEN PPC)))
|
||||
(\TEDIT.INSTALL.PIECE TSTREAM PPC (PLAST PPC))
|
||||
(SETQ PC PPC))
|
||||
elseif (AND (MEMB (PTYPE PC)
|
||||
FILE.PTYPES)
|
||||
@@ -1760,7 +1760,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.STREAMINIT
|
||||
[LAMBDA NIL (* ; "Edited 26-Jan-2026 16:06 by rmk")
|
||||
[LAMBDA NIL (* ; "Edited 16-Feb-2026 12:40 by rmk")
|
||||
(* ; "Edited 26-Jan-2026 16:06 by rmk")
|
||||
(* ; "Edited 23-Sep-2025 21:03 by rmk")
|
||||
(* ; "Edited 20-Sep-2025 08:48 by rmk")
|
||||
(* ; "Edited 18-Sep-2025 14:52 by rmk")
|
||||
@@ -1817,7 +1818,7 @@
|
||||
|
||||
(* ;; "Maybe more functions later. The INCODE and BACK functions possibly need to count. If \TEXTBACKFILEPTR takes a count variable, the extra level wouldn't be needed. But INCCODE wants to go through the BIN opcode")
|
||||
|
||||
(MAKE-EXTERNALFORMAT :TEXTSTREAM (FUNCTION \TEDIT.TEXTINCCODEFN)
|
||||
(MAKE-EXTERNALFORMAT :TEDIT (FUNCTION \TEDIT.TEXTINCCODEFN)
|
||||
(FUNCTION \TEDIT.TEXTPEEKBIN)
|
||||
(FUNCTION \TEDIT.TEXTBACKCCODEFN)
|
||||
(FUNCTION \TEDIT.TEXTOUTCHARFN)
|
||||
@@ -1860,8 +1861,7 @@
|
||||
FDEXTENDABLE _ NIL
|
||||
TRUNCATEFILE _ (FUNCTION NILL)
|
||||
WRITEPAGES _ (FUNCTION NILL)
|
||||
DEFAULTEXTERNALFORMAT _ :TEXTSTREAM))
|
||||
(* ;
|
||||
DEFAULTEXTERNALFORMAT _ :TEDIT)) (* ;
|
||||
"Only load once, not every time TEDIT-STREAM is loaded e.g. in development")
|
||||
(RPAQ? *TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN))
|
||||
(CL:SETF (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN)
|
||||
@@ -2256,7 +2256,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.NTHCHARCODE
|
||||
[LAMBDA (TSTREAM N) (* ; "Edited 24-Apr-2025 16:03 by rmk")
|
||||
[LAMBDA (TSTREAM N) (* ; "Edited 15-Feb-2026 14:40 by rmk")
|
||||
(* ; "Edited 24-Apr-2025 16:03 by rmk")
|
||||
(* ; "Edited 28-Mar-2025 18:31 by rmk")
|
||||
(* ; "Edited 7-Jul-2024 11:09 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 13:06 by rmk")
|
||||
@@ -2273,11 +2274,11 @@
|
||||
(CL:WHEN (AND (IGEQ N 1)
|
||||
(ILEQ N (FGETTOBJ TEXTOBJ TEXTLEN)))
|
||||
(\TEDIT.PIECE.NTHCHARCODE (\TEDIT.CHTOPC N TEXTOBJ T)
|
||||
(IDIFFERENCE (ADD1 N)
|
||||
START-OF-PIECE)))])
|
||||
(IDIFFERENCE N START-OF-PIECE)))])
|
||||
|
||||
(\TEDIT.PIECE.NTHCHARCODE
|
||||
[LAMBDA (PC OFFSET) (* ; "Edited 24-Apr-2025 16:04 by rmk")
|
||||
[LAMBDA (PC OFFSET) (* ; "Edited 15-Feb-2026 14:31 by rmk")
|
||||
(* ; "Edited 24-Apr-2025 16:04 by rmk")
|
||||
(* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 08:46 by rmk")
|
||||
(* ; "Edited 22-Mar-2024 00:02 by rmk")
|
||||
@@ -2289,24 +2290,24 @@
|
||||
(* ; "Edited 8-Nov-2023 08:43 by rmk")
|
||||
(* ; "Edited 5-Nov-2023 08:17 by rmk")
|
||||
|
||||
(* ;; "Returns the OFFSETth charcode of PC, NIL if OFFSET is out of bounds. For file pieces, ensures that the backing stream is restored to its original position, so that it remains comaptible with the values (buffer, offset) in the textstream.")
|
||||
(* ;; "Returns the OFFSETth charcode of PC, NIL if OFFSET is out of bounds. For file pieces, ensures that the backing stream is restored to its original position, so that it remains comaptible with the values (buffer, offset) in the textstream. OFFSET ranges from 0 to PLEN-1.")
|
||||
|
||||
(CL:WHEN (AND (IGEQ OFFSET 1)
|
||||
(ILEQ OFFSET (PLEN PC)))
|
||||
(CL:WHEN (AND (IGEQ OFFSET 0)
|
||||
(ILESSP OFFSET (PLEN PC)))
|
||||
[LET ((PCONTENTS (PCONTENTS PC))
|
||||
FILEPOS)
|
||||
(SELECTC (PTYPE PC)
|
||||
(STRING.PTYPES (NTHCHARCODE PCONTENTS OFFSET))
|
||||
(STRING.PTYPES (NTHCHARCODE PCONTENTS (ADD1 OFFSET)))
|
||||
(THINFILE.PTYPE
|
||||
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
||||
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
||||
(SUB1 OFFSET)))
|
||||
OFFSET))
|
||||
(PROG1 (BIN PCONTENTS)
|
||||
(\SETFILEPTR PCONTENTS FILEPOS)))
|
||||
(FATFILE1.PTYPE
|
||||
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
||||
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
||||
(SUB1 OFFSET)))
|
||||
OFFSET))
|
||||
(PROG1 (create WORD
|
||||
HIBYTE _ (PCHARSET PC)
|
||||
LOBYTE _ (BIN PCONTENTS))
|
||||
@@ -2314,14 +2315,12 @@
|
||||
(FATFILE2.PTYPE
|
||||
(SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
||||
(\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
||||
(UNFOLD (SUB1 OFFSET)
|
||||
2)))
|
||||
(UNFOLD OFFSET 2)))
|
||||
(PROG1 (\WIN PCONTENTS)
|
||||
(\SETFILEPTR PCONTENTS FILEPOS)))
|
||||
(UTF8.PTYPE (SETQ FILEPOS (\GETFILEPTR PCONTENTS))
|
||||
[\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC)
|
||||
(ITIMES (SUB1 OFFSET)
|
||||
(PBYTESPERCHAR PC]
|
||||
(ITIMES OFFSET (PBYTESPERCHAR PC]
|
||||
(PROG1 (UTF8.INCCODEFN PCONTENTS)
|
||||
(\SETFILEPTR PCONTENTS FILEPOS)))
|
||||
(OBJECT.PTYPE PCONTENTS)
|
||||
@@ -2334,7 +2333,8 @@
|
||||
(\TEDIT.THELP '\TEDIT.PIECE.NTHCHARCODE])])
|
||||
|
||||
(\TEDIT.RPLCHARCODE
|
||||
[LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "Edited 24-Apr-2025 17:24 by rmk")
|
||||
[LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "Edited 16-Feb-2026 08:37 by rmk")
|
||||
(* ; "Edited 24-Apr-2025 17:24 by rmk")
|
||||
(* ; "Edited 20-Apr-2025 13:25 by rmk")
|
||||
(* ; "Edited 28-Mar-2025 10:04 by rmk")
|
||||
|
||||
@@ -2350,16 +2350,17 @@
|
||||
(DECLARE (SPECVARS START-OF-PIECE))
|
||||
(replace (STREAM BINABLE) of TSTREAM with NIL)
|
||||
(SETQ OLDCHAR (\TEDIT.PIECE.RPLCHARCODE TEXTOBJ (\TEDIT.CHTOPC N TEXTOBJ T)
|
||||
(ADD1 (IDIFFERENCE N START-OF-PIECE))
|
||||
(IDIFFERENCE N START-OF-PIECE)
|
||||
NEWCHARCODE NEWCHARLOOKS))
|
||||
(\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :ReplaceCode N NIL NIL NIL
|
||||
(\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :ReplaceCode N 1 NIL NIL
|
||||
OLDCHAR))
|
||||
(CL:UNLESS (OR DONTDISPLAY (NOT (\TEDIT.PRIMARYPANE TEXTOBJ)))
|
||||
(\TEDIT.UPDATE.LINES TSTREAM 'CHANGED N 1))
|
||||
TSTREAM))])
|
||||
|
||||
(\TEDIT.PIECE.RPLCHARCODE
|
||||
[LAMBDA (TEXTOBJ PC OFFSET NEWCHARCODE NEWCHARLOOKS) (* ; "Edited 28-Jul-2025 23:38 by rmk")
|
||||
[LAMBDA (TEXTOBJ PC OFFSET NEWCHARCODE NEWCHARLOOKS) (* ; "Edited 16-Feb-2026 08:41 by rmk")
|
||||
(* ; "Edited 28-Jul-2025 23:38 by rmk")
|
||||
(* ; "Edited 24-Apr-2025 16:30 by rmk")
|
||||
(* ; "Edited 20-Apr-2025 13:25 by rmk")
|
||||
(* ; "Edited 28-Mar-2025 10:04 by rmk")
|
||||
@@ -2384,12 +2385,13 @@
|
||||
"Fast case: Smash a new character code into an existing string piece with same looks. ")
|
||||
|
||||
(SETQ OLDCHAR (NTHCHARCODE (PCONTENTS PC)
|
||||
OFFSET))
|
||||
(ADD1 OFFSET)))
|
||||
(RPLCHARCODE (PCONTENTS PC)
|
||||
OFFSET NEWCHARCODE) (* ;
|
||||
(ADD1 OFFSET)
|
||||
NEWCHARCODE) (* ;
|
||||
"May upgrade string from thin to fat")
|
||||
(CL:WHEN (AND (EQ THINSTRING.PTYPE (PTYPE PC))
|
||||
(IGREATERP NEWCHARCODE 255))
|
||||
(IGREATERP NEWCHARCODE \MAXTHINCHAR))
|
||||
(FSETPC PC PTYPE FATSTRING.PTYPE)
|
||||
(FSETPC PC PBINABLE NIL)
|
||||
(FSETPC PC PBYTESPERCHAR 2)
|
||||
@@ -2403,24 +2405,25 @@
|
||||
(FSETPC PC PCONTENTS NEWCHARCODE)
|
||||
else
|
||||
(* ;;
|
||||
"PC contained character OFFSET now becomes the suffix of characters after offset.")
|
||||
"The PC that contained character OFFSET now becomes the suffix of characters after offset.")
|
||||
|
||||
(CL:UNLESS (IEQP OFFSET (PLEN PC)) (* ; "No suffix for the last character")
|
||||
(CL:UNLESS (IEQP OFFSET (PLAST PC)) (* ; "No suffix for the last character")
|
||||
|
||||
(* ;;
|
||||
"Chop off the suffix (essentially (\TEDIT.ALIGNEDPIECE CHNO ..) but we already have the piece")
|
||||
|
||||
(\TEDIT.SPLITPIECE PC OFFSET TEXTOBJ)
|
||||
(\TEDIT.SPLITPIECE PC (ADD1 OFFSET)
|
||||
TEXTOBJ)
|
||||
(SETQ PC (PREVPIECE PC))) (* ;
|
||||
"Original PC holds the suffix, new PC ends with change position.")
|
||||
(CL:UNLESS (EQ OFFSET 1)
|
||||
(CL:UNLESS (EQ OFFSET 0)
|
||||
(SETQ PC (\TEDIT.SPLITPIECE PC (SUB1 OFFSET)
|
||||
TEXTOBJ))) (* ;
|
||||
"Chop off the prefix. PC is now the singleton target ")
|
||||
|
||||
(* ;; "OFFSET is now isolated into a one-character new piece which we smash. ")
|
||||
|
||||
(SETQ OLDCHAR (\TEDIT.PIECE.NTHCHARCODE PC 1))
|
||||
(SETQ OLDCHAR (\TEDIT.PIECE.NTHCHARCODE PC 0))
|
||||
(if (IMAGEOBJP NEWCHARCODE)
|
||||
then (FSETPC PC PBINABLE NIL)
|
||||
(FSETPC PC PCONTENTS NEWCHARCODE)
|
||||
@@ -2430,7 +2433,7 @@
|
||||
else (FSETPC PC PCONTENTS (MKSTRING (CHARACTER NEWCHARCODE)))
|
||||
(* ;
|
||||
"Use the extend-string in INSERTCH for repeated calls?")
|
||||
(if (IGREATERP NEWCHARCODE 255)
|
||||
(if (IGREATERP NEWCHARCODE \MAXTHINCHAR)
|
||||
then (FSETPC PC PTYPE FATSTRING.PTYPE)
|
||||
(FSETPC PC PBINABLE NIL)
|
||||
(FSETPC PC PBYTESPERCHAR 2)
|
||||
@@ -2817,7 +2820,8 @@
|
||||
else (SUB1 (\TEDIT.PCTOCH PC TEXTOBJ])
|
||||
|
||||
(\TEDIT.LASTCHANGEABLE.CHNO
|
||||
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 26-Nov-2024 00:00 by rmk")
|
||||
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 16-Feb-2026 08:53 by rmk")
|
||||
(* ; "Edited 26-Nov-2024 00:00 by rmk")
|
||||
|
||||
(* ;; "Returns the number of the first visible character at or before CHNO, NIL if the first visible character is protected. Almost always CHNO--PCTOCH is the unusual case.")
|
||||
|
||||
@@ -2826,46 +2830,11 @@
|
||||
CLPROTECTED) when (VISIBLEPIECEP PC)
|
||||
do (RETURN (if (EQ PC FIRSTPIECE)
|
||||
then CHNO
|
||||
else (IPLUS (SUB1 (PLEN PC))
|
||||
else (IPLUS (PLAST PC)
|
||||
(\TEDIT.PCTOCH PC TEXTOBJ])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\SETUPGETCH
|
||||
[LAMBDA (CH# TEXTOBJ) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 12:14 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
(* ; "Edited 23-Dec-2023 12:14 by rmk")
|
||||
(* ; "Edited 22-Aug-2022 13:04 by rmk")
|
||||
(* ; "Edited 10-Aug-2022 17:20 by rmk")
|
||||
(* ; "Edited 8-Aug-2022 15:07 by rmk")
|
||||
(* ; "Edited 31-Jul-2022 21:27 by rmk")
|
||||
(* ; "Edited 14-Apr-93 17:14 by jds")
|
||||
|
||||
(* ;;; "Set up TEXTOBJ so that the next \GETCH will retrieve character # CH#")
|
||||
|
||||
(* ;; "NB that 1st char in the textobj is #1.")
|
||||
|
||||
(* ;; "NOBODY CALLS IT WITH A PIECE. CALLS |INSTALL.PIECE INSTEAD")
|
||||
|
||||
(SETQ TEXTOBJ (TEXTOBJ))
|
||||
(LET ((TSTREAM (TEXTSTREAM TEXTOBJ)))
|
||||
(COND
|
||||
((TYPE? PIECE CH#)
|
||||
(\TEDIT.THELP "\SETUPGETCH CALLED WITH PIECE")
|
||||
(\TEDIT.INSTALL.PIECE TSTREAM CH# 0))
|
||||
(T (LET (START-OF-PIECE PC)
|
||||
(DECLARE (SPECVARS START-OF-PIECE))
|
||||
(SETQ PC (\TEDIT.CHTOPC CH# TEXTOBJ T))
|
||||
(\TEDIT.INSTALL.PIECE TSTREAM PC (- CH# START-OF-PIECE])
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ; "Deprecated, maybe still external callers")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.INSTALL.PIECE
|
||||
[LAMBDA (TSTREAM PC CHOFFSET) (* ; "Edited 21-Oct-2024 00:26 by rmk")
|
||||
(* ; "Edited 18-May-2024 22:39 by rmk")
|
||||
@@ -3158,34 +3127,33 @@
|
||||
(ADDTOVAR LAMA TEXTPROP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (36872 67731 (\TEDIT.TEXTBIN 36882 . 47675) (\TEDIT.TEXTPEEKBIN 47677 . 53227) (
|
||||
\TEDIT.TEXTBACKFILEPTR 53229 . 58902) (\TEDIT.TEXTBOUT 58904 . 63521) (\TEDIT.INSTALL.FILEBUFFER 63523
|
||||
. 67729)) (68629 72920 (\TEDIT.TEXTOUTCHARFN 68639 . 70195) (\TEDIT.TEXTINCCODEFN 70197 . 70936) (
|
||||
\TEDIT.TEXTBACKCCODEFN 70938 . 71530) (\TEDIT.TEXTFORMATBYTESTREAM 71532 . 72369) (
|
||||
\TEDIT.TEXTFORMATBYTESTRING 72371 . 72918)) (72967 85042 (OPENTEXTSTREAM 72977 . 79953) (
|
||||
COPYTEXTSTREAM 79955 . 84265) (TEDIT.STREAMCHANGEDP 84267 . 84569) (TXTFILE 84571 . 85040)) (85043
|
||||
108248 (\TEDIT.REOPENTEXTSTREAM 85053 . 86405) (\TEDIT.OPENTEXTSTREAM.PIECES 86407 . 91335) (
|
||||
\TEDIT.OPENTEXTSTREAM.PROPS 91337 . 92439) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92441 . 97891) (
|
||||
\TEDIT.OPENTEXTSTREAM.WINDOW 97893 . 100684) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100686 . 102625) (
|
||||
\TEDIT.OPENTEXTFILE 102627 . 104759) (\TEDIT.CREATE.TEXTSTREAM 104761 . 105908) (\TEDIT.REOPEN.STREAM
|
||||
105910 . 108246)) (108249 116436 (\TEDIT.STREAMINIT 108259 . 116253) (TEDIT.IMAGESTREAM.OPEN 116255 .
|
||||
116434)) (116624 117812 (\TEDIT.TTYBOUT 116634 . 117810)) (117930 139613 (\TEDIT.TEXTCLOSEF 117940 .
|
||||
119264) (\TEDIT.TEXTDSPFONT 119266 . 120464) (\TEDIT.TEXTEOFP 120466 . 122221) (\TEDIT.TEXTGETEOFPTR
|
||||
122223 . 122546) (\TEDIT.TEXTSETEOFPTR 122548 . 123835) (\TEDIT.TEXTGETFILEPTR 123837 . 126672) (
|
||||
\TEDIT.TEXTSETFILEINFO 126674 . 127182) (\TEDIT.TEXTOPENF 127184 . 128115) (\TEDIT.TEXTSETEOF 128117
|
||||
. 128733) (\TEDIT.TEXTSETFILEPTR 128735 . 130845) (\TEDIT.TEXTDSPXPOSITION 130847 . 133550) (
|
||||
\TEDIT.TEXTDSPYPOSITION 133552 . 134293) (\TEDIT.TEXTLEFTMARGIN 134295 . 134886) (\TEDIT.TEXTCOLOR
|
||||
134888 . 135471) (\TEDIT.TEXTRIGHTMARGIN 135473 . 138762) (\TEDIT.TEXTDSPCHARWIDTH 138764 . 139068) (
|
||||
\TEDIT.TEXTDSPSTRINGWIDTH 139070 . 139376) (\TEDIT.TEXTDSPLINEFEED 139378 . 139611)) (139651 152264 (
|
||||
\TEDIT.NTHCHARCODE 139661 . 141112) (\TEDIT.PIECE.NTHCHARCODE 141114 . 145024) (\TEDIT.RPLCHARCODE
|
||||
145026 . 146484) (\TEDIT.PIECE.RPLCHARCODE 146486 . 151909) (\TEDIT.NTHCHARLOOKS 151911 . 152262)) (
|
||||
153311 174405 (\TEDIT.DELETE.SELPIECES 153321 . 156946) (\TEDIT.INSERTCH 156948 . 164987) (
|
||||
\TEDIT.INSERTCH.HISTORY 164989 . 168453) (\TEDIT.INSERTEOL 168455 . 170280) (\TEDIT.INSERTCH.INSERTION
|
||||
170282 . 173119) (\TEDIT.INSERTCH.EXTEND 173121 . 174403)) (174406 175910 (\TEDIT.NEXTCHANGEABLE.CHNO
|
||||
174416 . 175131) (\TEDIT.LASTCHANGEABLE.CHNO 175133 . 175908)) (175911 177615 (\SETUPGETCH 175921 .
|
||||
177613)) (177673 182131 (\TEDIT.INSTALL.PIECE 177683 . 182129)) (182169 191635 (TEXTPROP 182179 .
|
||||
182526) (GETTEXTPROP 182528 . 182772) (PUTTEXTPROP 182774 . 183031) (GETTEXTPROPS 183033 . 183477) (
|
||||
PUTTEXTPROPS 183479 . 184383) (TEXTPROP.ADD 184385 . 184648) (\TEDIT.TEXTPROP 184650 . 191633)) (
|
||||
191636 194013 (\TEDIT.TEXTOBJ.PROPNAMES 191646 . 192905) (\TEDIT.TEXTOBJ.PROPFETCHFN 192907 . 193423)
|
||||
(\TEDIT.TEXTOBJ.PROPSTOREFN 193425 . 194011)))))
|
||||
(FILEMAP (NIL (36667 67629 (\TEDIT.TEXTBIN 36677 . 47470) (\TEDIT.TEXTPEEKBIN 47472 . 53022) (
|
||||
\TEDIT.TEXTBACKFILEPTR 53024 . 58800) (\TEDIT.TEXTBOUT 58802 . 63419) (\TEDIT.INSTALL.FILEBUFFER 63421
|
||||
. 67627)) (68527 72818 (\TEDIT.TEXTOUTCHARFN 68537 . 70093) (\TEDIT.TEXTINCCODEFN 70095 . 70834) (
|
||||
\TEDIT.TEXTBACKCCODEFN 70836 . 71428) (\TEDIT.TEXTFORMATBYTESTREAM 71430 . 72267) (
|
||||
\TEDIT.TEXTFORMATBYTESTRING 72269 . 72816)) (72865 84940 (OPENTEXTSTREAM 72875 . 79851) (
|
||||
COPYTEXTSTREAM 79853 . 84163) (TEDIT.STREAMCHANGEDP 84165 . 84467) (TXTFILE 84469 . 84938)) (84941
|
||||
108146 (\TEDIT.REOPENTEXTSTREAM 84951 . 86303) (\TEDIT.OPENTEXTSTREAM.PIECES 86305 . 91233) (
|
||||
\TEDIT.OPENTEXTSTREAM.PROPS 91235 . 92337) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92339 . 97789) (
|
||||
\TEDIT.OPENTEXTSTREAM.WINDOW 97791 . 100582) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100584 . 102523) (
|
||||
\TEDIT.OPENTEXTFILE 102525 . 104657) (\TEDIT.CREATE.TEXTSTREAM 104659 . 105806) (\TEDIT.REOPEN.STREAM
|
||||
105808 . 108144)) (108147 116372 (\TEDIT.STREAMINIT 108157 . 116189) (TEDIT.IMAGESTREAM.OPEN 116191 .
|
||||
116370)) (116560 117748 (\TEDIT.TTYBOUT 116570 . 117746)) (117866 139549 (\TEDIT.TEXTCLOSEF 117876 .
|
||||
119200) (\TEDIT.TEXTDSPFONT 119202 . 120400) (\TEDIT.TEXTEOFP 120402 . 122157) (\TEDIT.TEXTGETEOFPTR
|
||||
122159 . 122482) (\TEDIT.TEXTSETEOFPTR 122484 . 123771) (\TEDIT.TEXTGETFILEPTR 123773 . 126608) (
|
||||
\TEDIT.TEXTSETFILEINFO 126610 . 127118) (\TEDIT.TEXTOPENF 127120 . 128051) (\TEDIT.TEXTSETEOF 128053
|
||||
. 128669) (\TEDIT.TEXTSETFILEPTR 128671 . 130781) (\TEDIT.TEXTDSPXPOSITION 130783 . 133486) (
|
||||
\TEDIT.TEXTDSPYPOSITION 133488 . 134229) (\TEDIT.TEXTLEFTMARGIN 134231 . 134822) (\TEDIT.TEXTCOLOR
|
||||
134824 . 135407) (\TEDIT.TEXTRIGHTMARGIN 135409 . 138698) (\TEDIT.TEXTDSPCHARWIDTH 138700 . 139004) (
|
||||
\TEDIT.TEXTDSPSTRINGWIDTH 139006 . 139312) (\TEDIT.TEXTDSPLINEFEED 139314 . 139547)) (139587 152583 (
|
||||
\TEDIT.NTHCHARCODE 139597 . 141123) (\TEDIT.PIECE.NTHCHARCODE 141125 . 145033) (\TEDIT.RPLCHARCODE
|
||||
145035 . 146593) (\TEDIT.PIECE.RPLCHARCODE 146595 . 152228) (\TEDIT.NTHCHARLOOKS 152230 . 152581)) (
|
||||
153630 174724 (\TEDIT.DELETE.SELPIECES 153640 . 157265) (\TEDIT.INSERTCH 157267 . 165306) (
|
||||
\TEDIT.INSERTCH.HISTORY 165308 . 168772) (\TEDIT.INSERTEOL 168774 . 170599) (\TEDIT.INSERTCH.INSERTION
|
||||
170601 . 173438) (\TEDIT.INSERTCH.EXTEND 173440 . 174722)) (174725 176332 (\TEDIT.NEXTCHANGEABLE.CHNO
|
||||
174735 . 175450) (\TEDIT.LASTCHANGEABLE.CHNO 175452 . 176330)) (176333 180791 (\TEDIT.INSTALL.PIECE
|
||||
176343 . 180789)) (180829 190295 (TEXTPROP 180839 . 181186) (GETTEXTPROP 181188 . 181432) (PUTTEXTPROP
|
||||
181434 . 181691) (GETTEXTPROPS 181693 . 182137) (PUTTEXTPROPS 182139 . 183043) (TEXTPROP.ADD 183045
|
||||
. 183308) (\TEDIT.TEXTPROP 183310 . 190293)) (190296 192673 (\TEDIT.TEXTOBJ.PROPNAMES 190306 . 191565
|
||||
) (\TEDIT.TEXTOBJ.PROPFETCHFN 191567 . 192083) (\TEDIT.TEXTOBJ.PROPSTOREFN 192085 . 192671)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "14-Jan-2026 14:50:53"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;248 52743
|
||||
(FILECREATED "16-Feb-2026 08:56:58"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;249 52790
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "10-Jan-2026 23:04:09" {WMEDLEY}<library>TEDIT>tedit-exports.all;247)
|
||||
:PREVIOUS-DATE "14-Jan-2026 14:50:53" {WMEDLEY}<library>TEDIT>tedit-exports.all;248)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION
|
||||
@@ -17,7 +17,7 @@ PRINT))))))))
|
||||
(PUTPROPS FTEXTOBJ MACRO ((X) (TEXTOBJ! (CL:IF (type? TEXTOBJ X) X (GETTSTR X TEXTOBJ)))))
|
||||
(GLOBALVARS CHECK-TEDIT-ASSERTIONS)
|
||||
(RPAQ? CHECK-TEDIT-ASSERTIONS T)
|
||||
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "10-Jan-2026 01:39:21"))
|
||||
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE " 4-Feb-2026 16:02:02"))
|
||||
(RPAQQ \BTREEWORDSPERSLOT 4)
|
||||
(RPAQQ \BTREEMAXCOUNT 8)
|
||||
(CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
|
||||
@@ -51,7 +51,7 @@ DLEN1 DOWN2 DLEN2 DOWN3 DLEN3 DOWN4 DLEN4 DOWN5 DLEN5 DOWN6 DLEN6 DOWN7 DLEN7 DO
|
||||
(\DTEST (OR (NEXTPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
|
||||
(I.S.OPR (QUOTE backpieces) NIL (QUOTE (first (SETQ I.V. (\DTEST (OR BODY (GO $$OUT)) (QUOTE PIECE)))
|
||||
by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
|
||||
(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "28-Jul-2025 23:25:19"))
|
||||
(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "14-Feb-2026 13:22:06"))
|
||||
(DATATYPE SELECTION ((* ;;
|
||||
"Description of a piece of selected text for TEdit. Text has to be selected before it can be operated on by the user. The caret is to the left of CH# if POINT is LEFT, to the keft of CHLIM if POINT is RIGHT."
|
||||
) (* ;; "If DCH > 0, highlighting goes from CH# to (SUB1 CHLIM = (SUB1 (IPLUS CH# DCH)).") (* ;;
|
||||
@@ -128,7 +128,7 @@ TSTREAM ONLYPANE DONTFIX)))
|
||||
(PUTPROPS \TEDIT.SEL.OFF MACRO ((TSTREAM SEL ONLYPANE) (* ;
|
||||
"Takes down SEL in TSTREAM, where SEL defaults to the current selection") (\TEDIT.SHOWSEL SEL NIL
|
||||
TSTREAM ONLYPANE)))
|
||||
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "14-Jan-2026 14:32:01"))
|
||||
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "16-Feb-2026 00:38:33"))
|
||||
(RECORD TAB (TABX . TABKIND))
|
||||
(RECORD TABSPEC (DEFAULTTAB . TABS))
|
||||
(DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ;
|
||||
@@ -259,7 +259,7 @@ NEXTAVAILABLECHARSLOT) of THISLINE))) (T $$STARTSLOT))) (SETQ $$CHARSLOTLIMIT (F
|
||||
) by (PREVCHARSLOT I.V.) eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (
|
||||
CHARSLOT CHARW) of I.V.)) (SETQ CHARCL (fetch (CHARSLOT CHARCL) of I.V.)) repeatuntil (EQ I.V.
|
||||
$$CHARSLOTLIMIT))))) T)
|
||||
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "31-Dec-2025 23:10:18"))
|
||||
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE " 5-Feb-2026 00:39:54"))
|
||||
(DATATYPE PIECE ((* ;
|
||||
"The piece describes either a string or part of a file. , or a generalized OBJECT.") PCONTENTS (* ;
|
||||
"The background source of data for this piece (stream, string, block, object, depending on the PTYPE)."
|
||||
@@ -372,6 +372,7 @@ IMAGEDATA _ NIL)))
|
||||
(PUTPROPS NEXTPIECE MACRO ((PC) (ffetch (PIECE NEXTPIECE) of PC)))
|
||||
(PUTPROPS PREVPIECE MACRO ((PC) (ffetch (PIECE PREVPIECE) of PC)))
|
||||
(PUTPROPS PLEN MACRO ((PC) (ffetch (PIECE PLEN) of PC)))
|
||||
(PUTPROPS PLAST MACRO ((PC) (SUB1 (PLEN PC))))
|
||||
(PUTPROPS PTYPE MACRO ((PC) (ffetch (PIECE PTYPE) of PC)))
|
||||
(PUTPROPS PCONTENTS MACRO ((PC) (ffetch (PIECE PCONTENTS) of PC)))
|
||||
(PUTPROPS PCHARLOOKS MACRO ((PC) (ffetch (PIECE PCHARLOOKS) of PC)))
|
||||
@@ -440,7 +441,7 @@ UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE F
|
||||
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
|
||||
THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))
|
||||
(GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
|
||||
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "14-Jan-2026 14:32:01"))
|
||||
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "16-Feb-2026 08:56:40"))
|
||||
(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* ;;
|
||||
"Test to see if only the specified mouse button is down. DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it was called."
|
||||
) (SELECTQ (CAR BUTTON) (LEFT (QUOTE (EQ LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (EQ LASTMOUSEBUTTONS 1))
|
||||
@@ -454,7 +455,7 @@ I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (
|
||||
\BIN STREAM)) BITSPERWORD)))
|
||||
(PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) (* ; "Signed smallp, unlike \WOUT") (\BOUT STREAM (
|
||||
LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
|
||||
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "23-Oct-2025 08:49:06"))
|
||||
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "15-Feb-2026 23:45:51"))
|
||||
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE " 8-Sep-2025 22:10:10"))
|
||||
(DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.")
|
||||
(* ;; "NOTE: If fields change EQCLOOKS should change too.") CLFONT (* ;
|
||||
@@ -537,7 +538,7 @@ LINELEAD _ 0)
|
||||
(PUTPROPS FSETPLOOKS MACRO ((PLOOKS FIELD NEWVALUE) (freplace (PARALOOKS FIELD) of PLOOKS with
|
||||
NEWVALUE)))
|
||||
(PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE PARALOOKS))))
|
||||
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 7-Dec-2025 16:32:32"))
|
||||
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "16-Feb-2026 00:36:00"))
|
||||
(PUTPROP (QUOTE TEDIT-STYLES) (QUOTE IMPORTDATE) (IDATE "28-Jul-2025 23:25:43"))
|
||||
(DATATYPE TEDITCARET (TCNOWTIME (* Used to hold the current time, when checking to see if a transition
|
||||
is due) TCTHENTIME (* Time when the next transition is to take place) TCFORCEDDOWN (* TCFORCEDOWN = T
|
||||
@@ -600,9 +601,9 @@ OR (CL:IF (TYPENAMEP $$BODY (QUOTE TEXTOBJ)) (FGETTOBJ $$BODY PRIMARYPANE) $$BOD
|
||||
GETPANEPROP (PANEPROPS P) NEXTPANE))) (GO $$OUT))) by (OR (GETPANEPROP (PANEPROPS I.V.) PREVPANE) (GO
|
||||
$$OUT)))))
|
||||
(PUTPROPS ALLBUTTONSUP MACRO (NIL (ZEROP (LOGAND 7 LASTMOUSEBUTTONS))))
|
||||
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "14-Jan-2026 14:32:01"))
|
||||
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "19-Oct-2025 10:44:18"))
|
||||
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "12-Dec-2025 00:01:26"))
|
||||
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE " 7-Feb-2026 18:53:22"))
|
||||
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "25-Jan-2026 09:14:04"))
|
||||
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE " 9-Feb-2026 09:10:43"))
|
||||
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 22:42:57"))
|
||||
(RPAQQ \TEDIT.TTCCODES ((NONE . 0) (CHARDELETE . 1) (:CHARDELETE.BACKWARD . 1) (WORDDELETE . 2) (
|
||||
:WORDDELETE.BACKWORD . 2) (DELETE . 3) (:DELETE . 3) (FN . 4) (REDO . 5) (:REDO . 5) (UNDO . 6) (:UNDO
|
||||
@@ -610,8 +611,8 @@ $$OUT)))))
|
||||
(:CHARDELETE.FORWARD . 10) (:WORDDELETE.FORWARD . 11) (PUNCT . 20) (TEXT . 21) (WHITESPACE . 22)))
|
||||
(CONSTANTS \TEDIT.TTCCODES)
|
||||
(PUTPROPS \TEDIT.TTC MACRO ((ACTION) (CONSTANT (GETMULTI \TEDIT.TTCCODES (QUOTE ACTION)))))
|
||||
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "24-Nov-2025 08:40:56"))
|
||||
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "24-Dec-2025 11:16:22"))
|
||||
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE " 8-Feb-2026 19:54:41"))
|
||||
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "15-Jan-2026 11:08:15"))
|
||||
(DATATYPE TEDITHISTORYEVENT ((* ;; "Describes one event on the TEdit edit history list.") THACTION (*
|
||||
; "A keyword specifying what the event was") THPOINT (* ; "Was the selection to the left or right?")
|
||||
THLEN (* ; "The # of chars involved") THCH# (* ; "The starting ch#") THFIRSTPIECE (* ;
|
||||
@@ -660,9 +661,9 @@ REGIONPARENT FULLXPOINTER) (* ; "The parent node for this box, for sub-boxes") R
|
||||
$$VALUES)) (PROG1 (CAR $$VALUES) (\,@ (FOR V IN (CAR ARGS) collect (COND (V (BQUOTE (SETQ (\, V) (POP
|
||||
$$VALUES)))) (T (BQUOTE (SETQ $$VALUES (CDR $$VALUES))))))))))))
|
||||
(PUTPROPS TEDIT.VALUES MACRO (ARGS (BQUOTE (LIST (\,@ ARGS)))))
|
||||
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "25-Dec-2025 15:07:57"))
|
||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "13-Jan-2026 17:51:55"))
|
||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE " 7-Sep-2025 11:11:43"))
|
||||
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "27-Jan-2026 10:30:27"))
|
||||
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "23-Jan-2026 15:49:26"))
|
||||
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "21-Jan-2026 12:15:57"))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
@@ -1,18 +1,17 @@
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED "31-Jan-87 18:09:00" {ERIS}<LISPUSERS>LYRIC>BACKGROUNDMENU.;1 7367
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
previous date%: "31-Jan-86 11:36:13" {ERIS}<LISP>KOTO>LISPUSERS>BACKGROUNDMENU.;1)
|
||||
(FILECREATED "18-Feb-2026 16:20:10" {WMEDLEY}<lispusers>BACKGROUNDMENU.;2 7230
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "31-Jan-87 18:09:00" {WMEDLEY}<lispusers>BACKGROUNDMENU.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT BACKGROUNDMENUCOMS)
|
||||
|
||||
(RPAQQ BACKGROUNDMENUCOMS ((INITVARS BackgroundMenuFixupMode BackgroundMenuSuperItem
|
||||
BackgroundMenuTopLevelItems)
|
||||
(FNS BkgMenu.add.item BkgMenu.fixup BkgMenu.move.item BkgMenu.remove.item
|
||||
(FNS BkgMenu.add.item BkgMenu.fixup BkgMenu.move.item BkgMenu.remove.item
|
||||
BkgMenu.rename.item BkgMenu.reorder.items BkgMenu.subitems
|
||||
\BkgMenu.locate \BkgMenu.locater \BkgMenu.remove.item
|
||||
\BkgMenu.scan.item.list \BkgMenu.unremove.item)))
|
||||
@@ -153,11 +152,10 @@ Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
else (SETQ BackgroundMenuCommands (CONS (CAR item)
|
||||
BackgroundMenuCommands])
|
||||
)
|
||||
(PUTPROPS BACKGROUNDMENU COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1008 7271 (BkgMenu.add.item 1018 . 1910) (BkgMenu.fixup 1912 . 3131) (BkgMenu.move.item
|
||||
3133 . 3557) (BkgMenu.remove.item 3559 . 3834) (BkgMenu.rename.item 3836 . 4128) (
|
||||
BkgMenu.reorder.items 4130 . 4505) (BkgMenu.subitems 4507 . 4907) (\BkgMenu.locate 4909 . 5520) (
|
||||
\BkgMenu.locater 5522 . 6089) (\BkgMenu.remove.item 6091 . 6378) (\BkgMenu.scan.item.list 6380 . 6877)
|
||||
(\BkgMenu.unremove.item 6879 . 7269)))))
|
||||
(FILEMAP (NIL (944 7207 (BkgMenu.add.item 954 . 1846) (BkgMenu.fixup 1848 . 3067) (BkgMenu.move.item
|
||||
3069 . 3493) (BkgMenu.remove.item 3495 . 3770) (BkgMenu.rename.item 3772 . 4064) (
|
||||
BkgMenu.reorder.items 4066 . 4441) (BkgMenu.subitems 4443 . 4843) (\BkgMenu.locate 4845 . 5456) (
|
||||
\BkgMenu.locater 5458 . 6025) (\BkgMenu.remove.item 6027 . 6314) (\BkgMenu.scan.item.list 6316 . 6813)
|
||||
(\BkgMenu.unremove.item 6815 . 7205)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,95 +1,88 @@
|
||||
(DEFINE-FILE-INFO §PACKAGE "INTERLISP" §READTABLE "INTERLISP" §BASE 10)
|
||||
(FILECREATED " 2-Apr-87 17:06:05" {ERIS}<LISPUSERS>LYRIC>COMMWINDOW.;3 49786
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (VARS REMOTE-CURSOR COMMWINDOWCOMS)
|
||||
(COURIERPROGRAMS COMMWINDOW)
|
||||
(FNS CLOSE-FRAME START-GET-BITS SEND-BITS FRAME-EVENT MAKE-FRAME)
|
||||
(FUNCTIONS \PILOTBITBLT)
|
||||
(FILECREATED "18-Feb-2026 16:21:29" {WMEDLEY}<lispusers>COMMWINDOW.;2 48680
|
||||
|
||||
previous date%: " 2-Apr-87 16:54:24" {ERIS}<LISPUSERS>LYRIC>COMMWINDOW.;2)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE " 2-Apr-87 17:06:05" {WMEDLEY}<lispusers>COMMWINDOW.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT COMMWINDOWCOMS)
|
||||
|
||||
(RPAQQ COMMWINDOWCOMS (
|
||||
(RPAQQ COMMWINDOWCOMS
|
||||
(
|
||||
|
||||
(* ;;; "Viewer end")
|
||||
|
||||
(FNS CLOSE-FRAME GET-BITS START-GET-BITS)
|
||||
(FILES COURIERSERVE)
|
||||
|
||||
(FNS CLOSE-FRAME GET-BITS START-GET-BITS)
|
||||
(FILES COURIERSERVE)
|
||||
|
||||
|
||||
(* ;;; "Sender end")
|
||||
|
||||
(FNS SEND-BITS SEND-TILE LISTEN-TO-VIEWER MAPTILES SHUT-DOWN-VIEWER
|
||||
CHANGE-SENDER-UPDATE-MODE)
|
||||
(FUNCTIONS INCR \PILOTBITBLT)
|
||||
|
||||
|
||||
(* ;; "Controling update schemes")
|
||||
(FNS SEND-BITS SEND-TILE LISTEN-TO-VIEWER MAPTILES SHUT-DOWN-VIEWER CHANGE-SENDER-UPDATE-MODE
|
||||
)
|
||||
(FUNCTIONS INCR \PILOTBITBLT)
|
||||
|
||||
(* ;; "Controling update schemes")
|
||||
|
||||
(INITVARS (COMM.DEFAULT.TRANSMIT.TYPE 'SQUARE)
|
||||
(COMM.SEND.UNCHANGED.TILES T)
|
||||
(COMM.UPDATE.MOUSE.POSITION 'Sender))
|
||||
(GLOBALVARS COMM.DEFAULT.TRANSMIT.TYPE COMM.UPDATE.MOUSE.POSITION
|
||||
COMM.SEND.UNCHANGED.TILES)
|
||||
|
||||
(INITVARS (COMM.DEFAULT.TRANSMIT.TYPE 'SQUARE)
|
||||
(COMM.SEND.UNCHANGED.TILES T)
|
||||
(COMM.UPDATE.MOUSE.POSITION 'Sender))
|
||||
(GLOBALVARS COMM.DEFAULT.TRANSMIT.TYPE COMM.UPDATE.MOUSE.POSITION COMM.SEND.UNCHANGED.TILES)
|
||||
|
||||
|
||||
(* ;;; "Pruning out unchanged screen tiles")
|
||||
|
||||
(FNS PACKET-EQUAL GET-CACHED-PACKET PUT-CACHED-PACKET)
|
||||
|
||||
(FNS PACKET-EQUAL GET-CACHED-PACKET PUT-CACHED-PACKET)
|
||||
|
||||
|
||||
(* ;;; "Low level packet exchange code")
|
||||
|
||||
(CONSTANTS COMM.BAND.PACKET.TYPE COMM.CURSOR.PACKET.TYPE
|
||||
COMM.CURSOR.CLOSE.PACKET.TYPE COMM.SHUT.DOWN.PACKET.TYPE)
|
||||
(VARIABLES MAX-PACKET-BITS)
|
||||
(RECORDS COMM.XFER.PACKET)
|
||||
|
||||
(CONSTANTS COMM.BAND.PACKET.TYPE COMM.CURSOR.PACKET.TYPE COMM.CURSOR.CLOSE.PACKET.TYPE
|
||||
COMM.SHUT.DOWN.PACKET.TYPE)
|
||||
(VARIABLES MAX-PACKET-BITS)
|
||||
(RECORDS COMM.XFER.PACKET)
|
||||
|
||||
|
||||
(* ;;; "Packing and unpacking bitmaps into etherpackets")
|
||||
|
||||
(FNS BMTOPACKET PACKETTOBM)
|
||||
|
||||
(FNS BMTOPACKET PACKETTOBM)
|
||||
|
||||
|
||||
(* ;;; "Displaying the viewing machine's cursor")
|
||||
|
||||
(VARS REMOTE-CURSOR)
|
||||
(INITVARS (CURSORICON NIL))
|
||||
|
||||
(VARS REMOTE-CURSOR)
|
||||
(INITVARS (CURSORICON NIL))
|
||||
|
||||
|
||||
(* ;;; "Manipulating the frame that outlines the region being viewed")
|
||||
|
||||
(INITVARS (*FRAME-SHADE* GRAYSHADE))
|
||||
(FNS FRAME-EVENT MAKE-FRAME MOVE-FRAME SHAPE-FRAME SET-FRAME-TITLE)
|
||||
|
||||
(INITVARS (*FRAME-SHADE* GRAYSHADE))
|
||||
(FNS FRAME-EVENT MAKE-FRAME MOVE-FRAME SHAPE-FRAME SET-FRAME-TITLE)
|
||||
|
||||
|
||||
(* ;;; "Changing the system parameters")
|
||||
|
||||
(FNS MAKE-MENUS-WINDOW MODE-MENU)
|
||||
(VARS COMM-MODES)
|
||||
|
||||
(FNS MAKE-MENUS-WINDOW MODE-MENU)
|
||||
(VARS COMM-MODES)
|
||||
|
||||
|
||||
(* ;;; "Initialization")
|
||||
|
||||
(P (COURIER.START.SERVER))
|
||||
|
||||
(P (COURIER.START.SERVER))
|
||||
|
||||
|
||||
(* ;;; "Unused stuff, as far as I can tell")
|
||||
|
||||
(FNS FASTBITBLT)
|
||||
|
||||
(FNS FASTBITBLT)
|
||||
|
||||
|
||||
(* ;;; "System file dependencies")
|
||||
|
||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE (FILES (LOADCOMP)
|
||||
LLDISPLAY LLETHER LLNS))
|
||||
(COURIERPROGRAMS COMMWINDOW)))
|
||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE (FILES (LOADCOMP)
|
||||
LLDISPLAY LLETHER LLNS))
|
||||
(COURIERPROGRAMS COMMWINDOW)))
|
||||
|
||||
|
||||
|
||||
@@ -236,6 +229,7 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
|
||||
(LIST 'RETURN (LIST (NSOCKETNUMBER NS)
|
||||
(USERNAME])
|
||||
)
|
||||
|
||||
(FILESLOAD COURIERSERVE)
|
||||
|
||||
|
||||
@@ -446,19 +440,18 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
|
||||
(SETQ COMM.DEFAULT.TRANSMIT.TYPE NEW-MODE)))
|
||||
)
|
||||
|
||||
(DEFMACRO INCR (VAR START HEIGHT REPEATS UNTIL &REST FORMS)
|
||||
(DEFMACRO INCR (VAR START HEIGHT REPEATS UNTIL &REST FORMS)
|
||||
`(CL:DO ((REPEAT-COUNT 0 (+ REPEAT-COUNT 1)))
|
||||
((>= REPEAT-COUNT ,REPEATS))
|
||||
(CL:DO [(,VAR (+ ,START (CL:* REPEAT-COUNT ,HEIGHT))
|
||||
(+ ,VAR (CL:* ,REPEATS ,HEIGHT]
|
||||
(,UNTIL)
|
||||
,@FORMS)))
|
||||
|
||||
|
||||
(DEFMACRO \PILOTBITBLT (XCL-USER::TABLE &OPTIONAL (XCL-USER::N 0)) (CL:ASSERT (EQL XCL-USER::N 0))
|
||||
`((OPCODES PILOTBITBLT)
|
||||
,XCL-USER::TABLE 0))
|
||||
(CL:DO [(,VAR (+ ,START (CL:* REPEAT-COUNT ,HEIGHT))
|
||||
(+ ,VAR (CL:* ,REPEATS ,HEIGHT]
|
||||
(,UNTIL)
|
||||
,@FORMS)))
|
||||
|
||||
(DEFMACRO \PILOTBITBLT (XCL-USER::TABLE &OPTIONAL (XCL-USER::N 0))
|
||||
(CL:ASSERT (EQL XCL-USER::N 0))
|
||||
`((OPCODES PILOTBITBLT)
|
||||
,XCL-USER::TABLE 0))
|
||||
|
||||
|
||||
|
||||
@@ -525,12 +518,12 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
|
||||
|
||||
(RPAQQ COMM.SHUT.DOWN.PACKET.TYPE 4246)
|
||||
|
||||
|
||||
(CONSTANTS COMM.BAND.PACKET.TYPE COMM.CURSOR.PACKET.TYPE COMM.CURSOR.CLOSE.PACKET.TYPE
|
||||
COMM.SHUT.DOWN.PACKET.TYPE)
|
||||
)
|
||||
|
||||
(CL:DEFCONSTANT MAX-PACKET-BITS (CL:* 400 8) )
|
||||
|
||||
(CL:DEFCONSTANT MAX-PACKET-BITS (CL:* 400 8))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS COMM.XFER.PACKET ((COMMPACKET (fetch (XIP XIPCONTENTS) of DATUM)))
|
||||
@@ -807,6 +800,7 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
|
||||
|
||||
(* ;;; "Initialization")
|
||||
|
||||
|
||||
(COURIER.START.SERVER)
|
||||
|
||||
|
||||
@@ -862,6 +856,7 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
|
||||
(* ;;; "System file dependencies")
|
||||
|
||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE
|
||||
|
||||
(FILESLOAD (LOADCOMP)
|
||||
LLDISPLAY LLETHER LLNS)
|
||||
)
|
||||
@@ -885,14 +880,14 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
|
||||
ERRORS
|
||||
((ERROR 1 (STRING))
|
||||
(USE.COURIER 2 NIL)))
|
||||
(PUTPROPS COMMWINDOW COPYRIGHT ("Xerox Corporation" 1986 1900 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3203 13134 (CLOSE-FRAME 3213 . 3364) (GET-BITS 3366 . 11655) (START-GET-BITS 11657 .
|
||||
13132)) (13189 26236 (SEND-BITS 13199 . 16020) (SEND-TILE 16022 . 19145) (LISTEN-TO-VIEWER 19147 .
|
||||
20450) (MAPTILES 20452 . 25175) (SHUT-DOWN-VIEWER 25177 . 26046) (CHANGE-SENDER-UPDATE-MODE 26048 .
|
||||
26234)) (27219 29090 (PACKET-EQUAL 27229 . 28632) (GET-CACHED-PACKET 28634 . 28949) (PUT-CACHED-PACKET
|
||||
28951 . 29088)) (30529 34252 (BMTOPACKET 30539 . 32500) (PACKETTOBM 32502 . 34250)) (34556 38865 (
|
||||
FRAME-EVENT 34566 . 35224) (MAKE-FRAME 35226 . 37008) (MOVE-FRAME 37010 . 37280) (SHAPE-FRAME 37282 .
|
||||
38672) (SET-FRAME-TITLE 38674 . 38863)) (38915 45792 (MAKE-MENUS-WINDOW 38925 . 41284) (MODE-MENU
|
||||
41286 . 45790)) (45968 48955 (FASTBITBLT 45978 . 48953)))))
|
||||
(FILEMAP (NIL (2306 12237 (CLOSE-FRAME 2316 . 2467) (GET-BITS 2469 . 10758) (START-GET-BITS 10760 .
|
||||
12235)) (12293 25340 (SEND-BITS 12303 . 15124) (SEND-TILE 15126 . 18249) (LISTEN-TO-VIEWER 18251 .
|
||||
19554) (MAPTILES 19556 . 24279) (SHUT-DOWN-VIEWER 24281 . 25150) (CHANGE-SENDER-UPDATE-MODE 25152 .
|
||||
25338)) (25342 25656 (INCR 25342 . 25656)) (25658 25816 (\PILOTBITBLT 25658 . 25816)) (26181 28052 (
|
||||
PACKET-EQUAL 26191 . 27594) (GET-CACHED-PACKET 27596 . 27911) (PUT-CACHED-PACKET 27913 . 28050)) (
|
||||
29490 33213 (BMTOPACKET 29500 . 31461) (PACKETTOBM 31463 . 33211)) (33517 37826 (FRAME-EVENT 33527 .
|
||||
34185) (MAKE-FRAME 34187 . 35969) (MOVE-FRAME 35971 . 36241) (SHAPE-FRAME 36243 . 37633) (
|
||||
SET-FRAME-TITLE 37635 . 37824)) (37876 44753 (MAKE-MENUS-WINDOW 37886 . 40245) (MODE-MENU 40247 .
|
||||
44751)) (44930 47917 (FASTBITBLT 44940 . 47915)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
116
lispusers/CROCK
116
lispusers/CROCK
@@ -1,43 +1,43 @@
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED " 2-Apr-87 00:37:46" {ERIS}<LISPUSERS>LYRIC>CROCK.;2 17791
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
previous date%: "11-Jan-86 19:46:27" {PHYLUM}<LISPUSERS>LYRIC>CROCK.;1)
|
||||
(FILECREATED "18-Feb-2026 16:26:31" {WMEDLEY}<lispusers>CROCK.;2 17189
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE " 2-Apr-87 00:37:46" {WMEDLEY}<lispusers>CROCK.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1984, 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT CROCKCOMS)
|
||||
|
||||
(RPAQQ CROCKCOMS ((* CROCK -- By Kelly Roach *)
|
||||
(FNS CROCK CROCK.BUTTONEVENTFN CROCK.CHANGE.STYLE CROCK.CLOSEFN CROCK.PROCESS
|
||||
CROCK.RESHAPEFN CROCK.ALARM CROCK.RING.ALARM CROCK.INIT)
|
||||
(INITVARS (CROCK.DEFAULT.STYLE '(HANDS T TIMES NIL RINGS NIL NUMBERS T))
|
||||
(CROCK.STYLE.MENU)
|
||||
(CROCK.ALARMS)
|
||||
(CROCK.DATEFORMAT '(DATEFORMAT NO.SECONDS))
|
||||
[CROCK.TUNE '((1000 . 1000)
|
||||
(800 . 1000)
|
||||
(600 . 1000)
|
||||
(500 . 1000)
|
||||
(400 . 1000)
|
||||
(NIL . 500)
|
||||
(440 . 1000)
|
||||
(484 . 1000)
|
||||
(540 . 1000)
|
||||
(600 . 1000)
|
||||
(2000 . 1000)
|
||||
(1600 . 1000)
|
||||
(1200 . 1000)
|
||||
(1000 . 1000)
|
||||
(800 . 1000)
|
||||
(NIL . 500)
|
||||
(880 . 1000)
|
||||
(968 . 1000)
|
||||
(1080 . 1000)
|
||||
(1188 . 1000]
|
||||
(CROCKWINDOW))))
|
||||
(RPAQQ CROCKCOMS
|
||||
((* CROCK -- By Kelly Roach *)
|
||||
(FNS CROCK CROCK.BUTTONEVENTFN CROCK.CHANGE.STYLE CROCK.CLOSEFN CROCK.PROCESS CROCK.RESHAPEFN
|
||||
CROCK.ALARM CROCK.RING.ALARM CROCK.INIT)
|
||||
(INITVARS (CROCK.DEFAULT.STYLE '(HANDS T TIMES NIL RINGS NIL NUMBERS T))
|
||||
(CROCK.STYLE.MENU)
|
||||
(CROCK.ALARMS)
|
||||
(CROCK.DATEFORMAT '(DATEFORMAT NO.SECONDS))
|
||||
[CROCK.TUNE '((1000 . 1000)
|
||||
(800 . 1000)
|
||||
(600 . 1000)
|
||||
(500 . 1000)
|
||||
(400 . 1000)
|
||||
(NIL . 500)
|
||||
(440 . 1000)
|
||||
(484 . 1000)
|
||||
(540 . 1000)
|
||||
(600 . 1000)
|
||||
(2000 . 1000)
|
||||
(1600 . 1000)
|
||||
(1200 . 1000)
|
||||
(1000 . 1000)
|
||||
(800 . 1000)
|
||||
(NIL . 500)
|
||||
(880 . 1000)
|
||||
(968 . 1000)
|
||||
(1080 . 1000)
|
||||
(1188 . 1000]
|
||||
(CROCKWINDOW))))
|
||||
|
||||
|
||||
|
||||
@@ -334,31 +334,31 @@ Copyright (c) 1984, 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
|
||||
(RPAQ? CROCK.DATEFORMAT '(DATEFORMAT NO.SECONDS))
|
||||
|
||||
(RPAQ? CROCK.TUNE '((1000 . 1000)
|
||||
(800 . 1000)
|
||||
(600 . 1000)
|
||||
(500 . 1000)
|
||||
(400 . 1000)
|
||||
(NIL . 500)
|
||||
(440 . 1000)
|
||||
(484 . 1000)
|
||||
(540 . 1000)
|
||||
(600 . 1000)
|
||||
(2000 . 1000)
|
||||
(1600 . 1000)
|
||||
(1200 . 1000)
|
||||
(1000 . 1000)
|
||||
(800 . 1000)
|
||||
(NIL . 500)
|
||||
(880 . 1000)
|
||||
(968 . 1000)
|
||||
(1080 . 1000)
|
||||
(1188 . 1000)))
|
||||
(RPAQ? CROCK.TUNE
|
||||
'((1000 . 1000)
|
||||
(800 . 1000)
|
||||
(600 . 1000)
|
||||
(500 . 1000)
|
||||
(400 . 1000)
|
||||
(NIL . 500)
|
||||
(440 . 1000)
|
||||
(484 . 1000)
|
||||
(540 . 1000)
|
||||
(600 . 1000)
|
||||
(2000 . 1000)
|
||||
(1600 . 1000)
|
||||
(1200 . 1000)
|
||||
(1000 . 1000)
|
||||
(800 . 1000)
|
||||
(NIL . 500)
|
||||
(880 . 1000)
|
||||
(968 . 1000)
|
||||
(1080 . 1000)
|
||||
(1188 . 1000)))
|
||||
|
||||
(RPAQ? CROCKWINDOW )
|
||||
(PUTPROPS CROCK COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1940 16814 (CROCK 1950 . 2520) (CROCK.BUTTONEVENTFN 2522 . 2811) (CROCK.CHANGE.STYLE
|
||||
2813 . 5626) (CROCK.CLOSEFN 5628 . 5790) (CROCK.PROCESS 5792 . 14290) (CROCK.RESHAPEFN 14292 . 14451)
|
||||
(CROCK.ALARM 14453 . 15681) (CROCK.RING.ALARM 15683 . 16424) (CROCK.INIT 16426 . 16812)))))
|
||||
(FILEMAP (NIL (1609 16483 (CROCK 1619 . 2189) (CROCK.BUTTONEVENTFN 2191 . 2480) (CROCK.CHANGE.STYLE
|
||||
2482 . 5295) (CROCK.CLOSEFN 5297 . 5459) (CROCK.PROCESS 5461 . 13959) (CROCK.RESHAPEFN 13961 . 14120)
|
||||
(CROCK.ALARM 14122 . 15350) (CROCK.RING.ALARM 15352 . 16093) (CROCK.INIT 16095 . 16481)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,14 +1,11 @@
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED "13-Jan-87 01:23:25" {ERIS}<LISPUSERS>LISPCORE>DEFAULTICON.;1 4586
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (FNS \MAKEICONWINDOW)
|
||||
(FILECREATED "18-Feb-2026 16:26:48" {WMEDLEY}<lispusers>DEFAULTICON.;2 4702
|
||||
|
||||
previous date%: "19-Dec-85 01:24:06" {ERIS}<LISP>KOTO>LISPUSERS>DEFAULTICON.;1)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "13-Jan-87 01:23:25" {WMEDLEY}<lispusers>DEFAULTICON.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT DEFAULTICONCOMS)
|
||||
|
||||
@@ -16,137 +13,140 @@ Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
|
||||
(UGLYVARS \DEFAULTICON)
|
||||
(INITVARS (DEFAULTICON \DEFAULTICON))
|
||||
(FNS \MAKEICONWINDOW)))
|
||||
|
||||
(FILESLOAD ICONW)
|
||||
(READVARS \DEFAULTICON)
|
||||
(({(READBITMAP)(64 64
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@AOOOOOOOOOOH@@"
|
||||
"@@N@@@@@@@@@@G@@"
|
||||
"@C@@@@@@@@@@@@L@"
|
||||
"@D@@@@@@@@@@@@B@"
|
||||
"@H@@@@@@@@@@@@A@"
|
||||
"A@@@@@@@@@@@@@@H"
|
||||
"B@@@@@@@@@@@CO@D"
|
||||
"B@@@@@@@@@@@BDHD"
|
||||
"D@@@@@@@@@@@ABDB"
|
||||
"D@@@@@@@@@@@AODB"
|
||||
"D@@@@@@@@@@@ABLB"
|
||||
"D@@@@@@@@@@@ABDA"
|
||||
"H@@@@@@@@@@@ABDA"
|
||||
"H@@@@@@@@@@@AOHA"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"H@@@@@@@@@@@@@@A"
|
||||
"D@@@@@@@@@@@@@@B"
|
||||
"D@@@@@@@@@@@@@@B"
|
||||
"D@@@@@@@@@@@@@@B"
|
||||
"B@@@@@@@@@@@@@@D"
|
||||
"B@@@@@@@@@@@@@@D"
|
||||
"A@@@@@@@@@@@@@@H"
|
||||
"@H@@@@@@@@@@@@A@"
|
||||
"@D@@@@@@@@@@@@B@"
|
||||
"@C@@@@@@@@@@@@L@"
|
||||
"@@N@@@@@@@@@@G@@"
|
||||
"@@AOOOOOOOOOOH@@")} {(READBITMAP)(64 64
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@@@@@@@@@@@@@@@"
|
||||
"@@AOOOOOOOOOOH@@"
|
||||
"@@OOOOOOOOOOOO@@"
|
||||
"@COOOOOOOOOOOOL@"
|
||||
"@GOOOOOOOOOOOON@"
|
||||
"@OOOOOOOOOOOOOO@"
|
||||
"AOOOOOOOOOOOOOOH"
|
||||
"COOOOOOOOOOOOOOL"
|
||||
"COOOOOOOOOOONDOL"
|
||||
"GOOOOOOOOOOOOBGN"
|
||||
"GOOOOOOOOOOOOOGN"
|
||||
"GOOOOOOOOOOOOBON"
|
||||
"GOOOOOOOOOOOOBGO"
|
||||
"OOOOOOOOOOOOOBGO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"OOOOOOOOOOOOOOOO"
|
||||
"GOOOOOOOOOOOOOON"
|
||||
"GOOOOOOOOOOOOOON"
|
||||
"GOOOOOOOOOOOOOON"
|
||||
"COOOOOOOOOOOOOOL"
|
||||
"COOOOOOOOOOOOOOL"
|
||||
"AOOOOOOOOOOOOOOH"
|
||||
"@OOOOOOOOOOOOOO@"
|
||||
"@GOOOOOOOOOOOON@"
|
||||
"@COOOOOOOOOOOOL@"
|
||||
"@@OOOOOOOOOOOO@@"
|
||||
"@@AOOOOOOOOOOH@@")} (5 6 52 46)))
|
||||
|
||||
(READVARS-FROM-STRINGS '(\DEFAULTICON)
|
||||
"(({(READBITMAP)(64 64
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@AOOOOOOOOOOH@@%"
|
||||
%"@@N@@@@@@@@@@G@@%"
|
||||
%"@C@@@@@@@@@@@@L@%"
|
||||
%"@D@@@@@@@@@@@@B@%"
|
||||
%"@H@@@@@@@@@@@@A@%"
|
||||
%"A@@@@@@@@@@@@@@H%"
|
||||
%"B@@@@@@@@@@@CO@D%"
|
||||
%"B@@@@@@@@@@@BDHD%"
|
||||
%"D@@@@@@@@@@@ABDB%"
|
||||
%"D@@@@@@@@@@@AODB%"
|
||||
%"D@@@@@@@@@@@ABLB%"
|
||||
%"D@@@@@@@@@@@ABDA%"
|
||||
%"H@@@@@@@@@@@ABDA%"
|
||||
%"H@@@@@@@@@@@AOHA%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"H@@@@@@@@@@@@@@A%"
|
||||
%"D@@@@@@@@@@@@@@B%"
|
||||
%"D@@@@@@@@@@@@@@B%"
|
||||
%"D@@@@@@@@@@@@@@B%"
|
||||
%"B@@@@@@@@@@@@@@D%"
|
||||
%"B@@@@@@@@@@@@@@D%"
|
||||
%"A@@@@@@@@@@@@@@H%"
|
||||
%"@H@@@@@@@@@@@@A@%"
|
||||
%"@D@@@@@@@@@@@@B@%"
|
||||
%"@C@@@@@@@@@@@@L@%"
|
||||
%"@@N@@@@@@@@@@G@@%"
|
||||
%"@@AOOOOOOOOOOH@@%")} {(READBITMAP)(64 64
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@@@@@@@@@@@@@@@%"
|
||||
%"@@AOOOOOOOOOOH@@%"
|
||||
%"@@OOOOOOOOOOOO@@%"
|
||||
%"@COOOOOOOOOOOOL@%"
|
||||
%"@GOOOOOOOOOOOON@%"
|
||||
%"@OOOOOOOOOOOOOO@%"
|
||||
%"AOOOOOOOOOOOOOOH%"
|
||||
%"COOOOOOOOOOOOOOL%"
|
||||
%"COOOOOOOOOOONDOL%"
|
||||
%"GOOOOOOOOOOOOBGN%"
|
||||
%"GOOOOOOOOOOOOOGN%"
|
||||
%"GOOOOOOOOOOOOBON%"
|
||||
%"GOOOOOOOOOOOOBGO%"
|
||||
%"OOOOOOOOOOOOOBGO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"OOOOOOOOOOOOOOOO%"
|
||||
%"GOOOOOOOOOOOOOON%"
|
||||
%"GOOOOOOOOOOOOOON%"
|
||||
%"GOOOOOOOOOOOOOON%"
|
||||
%"COOOOOOOOOOOOOOL%"
|
||||
%"COOOOOOOOOOOOOOL%"
|
||||
%"AOOOOOOOOOOOOOOH%"
|
||||
%"@OOOOOOOOOOOOOO@%"
|
||||
%"@GOOOOOOOOOOOON@%"
|
||||
%"@COOOOOOOOOOOOL@%"
|
||||
%"@@OOOOOOOOOOOO@@%"
|
||||
%"@@AOOOOOOOOOOH@@%")} (5 6 52 46)))
|
||||
")
|
||||
|
||||
(RPAQ? DEFAULTICON \DEFAULTICON)
|
||||
(DEFINEQ
|
||||
@@ -175,7 +175,6 @@ Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
|
||||
(WINDOWPROP icon 'HEIGHT]
|
||||
icon])
|
||||
)
|
||||
(PUTPROPS DEFAULTICON COPYRIGHT ("Xerox Corporation" 1985 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3170 4498 (\MAKEICONWINDOW 3180 . 4496)))))
|
||||
(FILEMAP (NIL (3351 4679 (\MAKEICONWINDOW 3361 . 4677)))))
|
||||
STOP
|
||||
|
||||
@@ -1,17 +1,17 @@
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED " 4-Mar-87 15:59:01" {PHYLUM}<LISPUSERS>LYRIC>DEFAULTSUBITEMFN.;1 1299
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
previous date%: "31-Jan-86 17:45:55" {PHYLUM}<LISP>KOTO>LISPUSERS>DEFAULTSUBITEMFN.;1)
|
||||
(FILECREATED "18-Feb-2026 16:28:38" {WMEDLEY}<lispusers>DEFAULTSUBITEMFN.;2 1229
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE " 4-Mar-87 15:59:01" {WMEDLEY}<lispusers>DEFAULTSUBITEMFN.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT DEFAULTSUBITEMFNCOMS)
|
||||
|
||||
(RPAQQ DEFAULTSUBITEMFNCOMS ((* * redefine the DEFAULTSUBITEMFN to add the EVAL keyword to the subitem menu field) (FNS DEFAULTSUBITEMFN))
|
||||
)
|
||||
(RPAQQ DEFAULTSUBITEMFNCOMS ((* * redefine the DEFAULTSUBITEMFN to add the EVAL keyword to the
|
||||
subitem menu field)
|
||||
(FNS DEFAULTSUBITEMFN)))
|
||||
(* * redefine the DEFAULTSUBITEMFN to add the EVAL keyword to the subitem menu field)
|
||||
|
||||
(DEFINEQ
|
||||
@@ -20,7 +20,6 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
(LAMBDA (MENU ITEM) (* edited%: "31-Dec-85 16:41") (* rrb "17-Aug-84 17:24") (* default subitemfn for menus. Checks the fourth element of the item for an expression of the form (SUBITEMS a b c) or if the fourth element is (EVAL form) will return the value of form. MENU and ITEM will be available during the evaluation) (PROG (TEMP) (RETURN (if (AND (LISTP ITEM) (LISTP (SETQ TEMP (CDR ITEM))) (LISTP (SETQ TEMP (CDR TEMP))) (LISTP (SETQ TEMP (CDR TEMP)))) then (SELECTQ (CAR (SETQ TEMP (LISTP (CAR TEMP)))) (SUBITEMS (CDR TEMP)) (EVAL (EVAL (CADR TEMP))) NIL)))))
|
||||
)
|
||||
)
|
||||
(PUTPROPS DEFAULTSUBITEMFN COPYRIGHT ("Xerox Corporation" 1986 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (606 1206 (DEFAULTSUBITEMFN 616 . 1204)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,41 +1,38 @@
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED "19-Feb-87 10:40:43" {QV}<LFG>PARSER>NEXT>LAMBDATRAN.;2 9556
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (FNS FNTYP1 LTDWIMUSERFN LTSTKNAME NARGS)
|
||||
(FILECREATED "18-Feb-2026 16:30:17" {WMEDLEY}<lispusers>LAMBDATRAN.;2 9157
|
||||
|
||||
previous date%: "19-Feb-87 09:56:18" {QV}<LFG>PARSER>NEXT>LAMBDATRAN.;1)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "19-Feb-87 10:40:43" {WMEDLEY}<lispusers>LAMBDATRAN.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1984, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LAMBDATRANCOMS)
|
||||
|
||||
(RPAQQ LAMBDATRANCOMS [(* Translation machinery for new LAMBDA words)
|
||||
(LOCALVARS . T)
|
||||
[DECLARE%: FIRST (P (VIRGINFN 'ARGLIST T)
|
||||
(MOVD? 'ARGLIST 'OLDARGLIST)
|
||||
(VIRGINFN 'NARGS T)
|
||||
(MOVD? 'NARGS 'OLDNARGS)
|
||||
(VIRGINFN 'ARGTYPE T)
|
||||
(MOVD? 'ARGTYPE 'OLDARGTYPE)
|
||||
(MOVD? 'NILL 'LTDWIMUSERFN]
|
||||
(FNS ARGLIST ARGTYPE FNTYP1 LTDWIMUSERFN LTSTKNAME NARGS)
|
||||
(ADDVARS (DWIMUSERFORMS (LTDWIMUSERFN)))
|
||||
(PROP VARTYPE LAMBDATRANFNS)
|
||||
(ALISTS (LAMBDATRANFNS))
|
||||
(PROP MACRO LTSTKNAME)
|
||||
(P (PUTHASH 'LTSTKNAME '(NIL) MSTEMPLATES))
|
||||
(P (RELINK 'WORLD))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (P (RESETSAVE DWIMIFYCOMPFLG T))
|
||||
(GLOBALVARS CLISPARRAY COMMENTFLG LAMBDASPLST LAMBDATRANFNS BOUNDPDUMMY
|
||||
))
|
||||
(DECLARE%: DONTCOPY (RECORDS LAMBDAWORD))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA)
|
||||
(NLAML LTSTKNAME)
|
||||
(LAMA])
|
||||
(RPAQQ LAMBDATRANCOMS
|
||||
[(* Translation machinery for new LAMBDA words)
|
||||
(LOCALVARS . T)
|
||||
[DECLARE%: FIRST (P (VIRGINFN 'ARGLIST T)
|
||||
(MOVD? 'ARGLIST 'OLDARGLIST)
|
||||
(VIRGINFN 'NARGS T)
|
||||
(MOVD? 'NARGS 'OLDNARGS)
|
||||
(VIRGINFN 'ARGTYPE T)
|
||||
(MOVD? 'ARGTYPE 'OLDARGTYPE)
|
||||
(MOVD? 'NILL 'LTDWIMUSERFN]
|
||||
(FNS ARGLIST ARGTYPE FNTYP1 LTDWIMUSERFN LTSTKNAME NARGS)
|
||||
(ADDVARS (DWIMUSERFORMS (LTDWIMUSERFN)))
|
||||
(PROP VARTYPE LAMBDATRANFNS)
|
||||
(ALISTS (LAMBDATRANFNS))
|
||||
(PROP MACRO LTSTKNAME)
|
||||
(P (PUTHASH 'LTSTKNAME '(NIL)
|
||||
MSTEMPLATES))
|
||||
(P (RELINK 'WORLD))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (P (RESETSAVE DWIMIFYCOMPFLG T))
|
||||
(GLOBALVARS CLISPARRAY COMMENTFLG LAMBDASPLST LAMBDATRANFNS BOUNDPDUMMY))
|
||||
(DECLARE%: DONTCOPY (RECORDS LAMBDAWORD))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML LTSTKNAME)
|
||||
(LAMA])
|
||||
|
||||
|
||||
|
||||
@@ -46,12 +43,19 @@ Copyright (c) 1984, 1987 by Xerox Corporation. All rights reserved.
|
||||
(LOCALVARS . T)
|
||||
)
|
||||
(DECLARE%: FIRST
|
||||
|
||||
(VIRGINFN 'ARGLIST T)
|
||||
|
||||
(MOVD? 'ARGLIST 'OLDARGLIST)
|
||||
|
||||
(VIRGINFN 'NARGS T)
|
||||
|
||||
(MOVD? 'NARGS 'OLDNARGS)
|
||||
|
||||
(VIRGINFN 'ARGTYPE T)
|
||||
|
||||
(MOVD? 'ARGTYPE 'OLDARGTYPE)
|
||||
|
||||
(MOVD? 'NILL 'LTDWIMUSERFN)
|
||||
)
|
||||
(DEFINEQ
|
||||
@@ -190,14 +194,18 @@ Copyright (c) 1984, 1987 by Xerox Corporation. All rights reserved.
|
||||
|
||||
(ADDTOVAR DWIMUSERFORMS (LTDWIMUSERFN))
|
||||
|
||||
(PUTPROPS LAMBDATRANFNS VARTYPE ALIST)
|
||||
(PUTPROPS LAMBDATRANFNS VARTYPE ALIST)
|
||||
|
||||
(ADDTOVAR LAMBDATRANFNS )
|
||||
|
||||
(PUTPROPS LTSTKNAME MACRO (X (CONS COMMENTFLG X)))
|
||||
(PUTHASH 'LTSTKNAME '(NIL) MSTEMPLATES)
|
||||
(PUTPROPS LTSTKNAME MACRO (X (CONS COMMENTFLG X)))
|
||||
|
||||
(PUTHASH 'LTSTKNAME '(NIL)
|
||||
MSTEMPLATES)
|
||||
|
||||
(RELINK 'WORLD)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(RESETSAVE DWIMIFYCOMPFLG T)
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
@@ -219,8 +227,7 @@ Copyright (c) 1984, 1987 by Xerox Corporation. All rights reserved.
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS LAMBDATRAN COPYRIGHT ("Xerox Corporation" 1984 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2224 8821 (ARGLIST 2234 . 3188) (ARGTYPE 3190 . 3544) (FNTYP1 3546 . 4455) (
|
||||
LTDWIMUSERFN 4457 . 7957) (LTSTKNAME 7959 . 8483) (NARGS 8485 . 8819)))))
|
||||
(FILEMAP (NIL (1871 8468 (ARGLIST 1881 . 2835) (ARGTYPE 2837 . 3191) (FNTYP1 3193 . 4102) (
|
||||
LTDWIMUSERFN 4104 . 7604) (LTSTKNAME 7606 . 8130) (NARGS 8132 . 8466)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,128 +1,127 @@
|
||||
(DEFINE-FILE-INFO §READTABLE "XCL" §PACKAGE (DEFPACKAGE "LAYOUT-SEDIT" (§NICKNAMES "L-S")))
|
||||
(il:filecreated " 9-Jan-87 19:55:25" il:{eris}<lispusers>lispcore>layout-sedit.\;2 7190
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "LAYOUT-SEDIT" ( NICKNAMES "L-S")) READTABLE "XCL" BASE 10)
|
||||
|
||||
il:|changes| il:|to:| (il:variables user::*l-s-region-zero* user::*l-s-region-delta*
|
||||
user::*l-s-reuse-earlier-regions*)
|
||||
(il:functions get-region save-region user::use-l-s-regions
|
||||
user::stop-using-l-s-regions)
|
||||
(il:vars il:layout-seditcoms)
|
||||
(IL:FILECREATED "18-Feb-2026 16:36:18" IL:|{WMEDLEY}<lispusers>LAYOUT-SEDIT.;2| 5714
|
||||
|
||||
il:|previous| il:|date:| "26-Dec-86 19:42:46" il:{eris}<pavel>lisp>layout-sedit.\;2)
|
||||
:EDIT-BY IL:|rmk|
|
||||
|
||||
:CHANGES-TO (IL:VARS IL:LAYOUT-SEDITCOMS)
|
||||
(IL:VARIABLES *REGION-ALIST* USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA*
|
||||
USER::*L-S-REUSE-EARLIER-REGIONS*)
|
||||
(IL:FUNCTIONS USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS REGION-PLUS
|
||||
GET-REGION SAVE-REGION)
|
||||
|
||||
:PREVIOUS-DATE " 9-Jan-87 19:55:25" IL:|{WMEDLEY}<lispusers>LAYOUT-SEDIT.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1986, 1987 by Pavel Curtis. All rights reserved.
|
||||
(IL:PRETTYCOMPRINT IL:LAYOUT-SEDITCOMS)
|
||||
|
||||
(il:prettycomprint il:layout-seditcoms)
|
||||
(IL:RPAQQ IL:LAYOUT-SEDITCOMS
|
||||
((IL:FUNCTIONS USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS)
|
||||
(IL:VARIABLES *REGION-ALIST* USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA*
|
||||
USER::*L-S-REUSE-EARLIER-REGIONS*)
|
||||
(IL:FUNCTIONS REGION-PLUS)
|
||||
(IL:FUNCTIONS GET-REGION SAVE-REGION)
|
||||
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DONTEVAL@COMPILE IL:DOCOPY (IL:P (USER::USE-L-S-REGIONS)
|
||||
))
|
||||
|
||||
(IL:* IL:|;;| "Arrange to use the proper compiler and makefile environment ")
|
||||
|
||||
(il:rpaqq il:layout-seditcoms ((il:functions user::use-l-s-regions user::stop-using-l-s-regions)
|
||||
(il:variables *region-alist* user::*l-s-region-zero*
|
||||
user::*l-s-region-delta* user::*l-s-reuse-earlier-regions*)
|
||||
(il:functions region-plus)
|
||||
(il:functions get-region save-region)
|
||||
(il:declare\: il:donteval@load il:donteval@compile il:docopy
|
||||
(il:p (user::use-l-s-regions)))
|
||||
(il:* il:|;;|
|
||||
"Arrange to use the proper compiler and makefile environment ")
|
||||
(il:prop (il:filetype il:makefile-environment)
|
||||
il:layout-sedit)))
|
||||
(IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT)
|
||||
IL:LAYOUT-SEDIT)))
|
||||
|
||||
(defun user::use-l-s-regions nil (assert (null il:|\\\\contexts|)
|
||||
nil "Close all open SEdit windows")
|
||||
(il:sedit.reset)
|
||||
(il:movd 'il:sedit.get.window.region 'old-get-region)
|
||||
(il:movd 'il:sedit.save.window.region 'old-save-region)
|
||||
(il:movd 'get-region 'il:sedit.get.window.region)
|
||||
(il:movd 'save-region 'il:sedit.save.window.region))
|
||||
(DEFUN USER::USE-L-S-REGIONS ()
|
||||
(ASSERT (NULL IL:|\\\\contexts|)
|
||||
NIL "Close all open SEdit windows")
|
||||
(IL:SEDIT.RESET)
|
||||
(IL:MOVD 'IL:SEDIT.GET.WINDOW.REGION 'OLD-GET-REGION)
|
||||
(IL:MOVD 'IL:SEDIT.SAVE.WINDOW.REGION 'OLD-SAVE-REGION)
|
||||
(IL:MOVD 'GET-REGION 'IL:SEDIT.GET.WINDOW.REGION)
|
||||
(IL:MOVD 'SAVE-REGION 'IL:SEDIT.SAVE.WINDOW.REGION))
|
||||
|
||||
(DEFUN USER::STOP-USING-L-S-REGIONS ()
|
||||
(ASSERT (NULL IL:|\\\\contexts|)
|
||||
NIL "Close all open SEdit windows")
|
||||
(IL:SEDIT.RESET)
|
||||
(IL:MOVD 'OLD-GET-REGION 'IL:SEDIT.GET.WINDOW.REGION)
|
||||
(IL:MOVD 'OLD-SAVE-REGION 'IL:SEDIT.SAVE.WINDOW.REGION))
|
||||
|
||||
(defun user::stop-using-l-s-regions nil (assert (null il:|\\\\contexts|)
|
||||
nil "Close all open SEdit windows")
|
||||
(il:sedit.reset)
|
||||
(il:movd 'old-get-region 'il:sedit.get.window.region)
|
||||
(il:movd 'old-save-region 'il:sedit.save.window.region))
|
||||
(DEFVAR *REGION-ALIST* NIL
|
||||
|
||||
(IL:* IL:|;;;| "An AList mapping a region to the SEdit context that currently owns it. The associations of regions no longer in use should have a CDR of NIL. The list is kept in reverse order, with the farthest region from *REGION-ZERO* at the front of the list. So as to allow experimentation by users, we maintain the invariant that the first association on the list never has a CDR of NIL. To reestablish that invariant, we sometimes POP the AList rather than set the CDR to NIL.")
|
||||
|
||||
(defvar *region-alist* nil
|
||||
)
|
||||
|
||||
(il:* il:|;;;| "An AList mapping a region to the SEdit context that currently owns it. The associations of regions no longer in use should have a CDR of NIL. The list is kept in reverse order, with the farthest region from *REGION-ZERO* at the front of the list. So as to allow experimentation by users, we maintain the invariant that the first association on the list never has a CDR of NIL. To reestablish that invariant, we sometimes POP the AList rather than set the CDR to NIL.")
|
||||
)
|
||||
|
||||
|
||||
(defvar user::*l-s-region-zero* (il:createregion 25 (- (truncate il:screenheight 2)
|
||||
(DEFVAR USER::*L-S-REGION-ZERO* (IL:CREATEREGION 25 (- (TRUNCATE IL:SCREENHEIGHT 2)
|
||||
19)
|
||||
(truncate il:screenwidth 2)
|
||||
(truncate il:screenheight 2))
|
||||
(TRUNCATE IL:SCREENWIDTH 2)
|
||||
(TRUNCATE IL:SCREENHEIGHT 2))
|
||||
|
||||
(il:* il:|;;;| "The region to be used by the first SEdit window. This works in conjunction with USER::*L-S-REGION-DELTA* to specify the region for each new SEdit window.")
|
||||
)
|
||||
(IL:* IL:|;;;| "The region to be used by the first SEdit window. This works in conjunction with USER::*L-S-REGION-DELTA* to specify the region for each new SEdit window.")
|
||||
|
||||
)
|
||||
|
||||
(defvar user::*l-s-region-delta* (il:createregion 11 -44 0 0) )
|
||||
(DEFVAR USER::*L-S-REGION-DELTA* (IL:CREATEREGION 11 -44 0 0))
|
||||
|
||||
(DEFVAR USER::*L-S-REUSE-EARLIER-REGIONS* NIL
|
||||
|
||||
(defvar user::*l-s-reuse-earlier-regions* nil
|
||||
(IL:* IL:|;;;| "If non-NIL, then earlier regions (i.e., those closer to USER::*L-S-REGION-ZERO* will get reused when free. Otherwise, new regions, farther from USER::*L-S-REGION-ZERO* than any currently in use, will be created.")
|
||||
|
||||
(il:* il:|;;;| "If non-NIL, then earlier regions (i.e., those closer to USER::*L-S-REGION-ZERO* will get reused when free. Otherwise, new regions, farther from USER::*L-S-REGION-ZERO* than any currently in use, will be created.")
|
||||
)
|
||||
)
|
||||
|
||||
(DEFUN REGION-PLUS (ONE TWO)
|
||||
(IL:CREATEREGION (+ (IL:FETCH (IL:REGION IL:LEFT) IL:OF ONE)
|
||||
(IL:FETCH (IL:REGION IL:LEFT) IL:OF TWO))
|
||||
(+ (IL:FETCH (IL:REGION IL:BOTTOM) IL:OF ONE)
|
||||
(IL:FETCH (IL:REGION IL:BOTTOM) IL:OF TWO))
|
||||
(+ (IL:FETCH (IL:REGION IL:WIDTH) IL:OF ONE)
|
||||
(IL:FETCH (IL:REGION IL:WIDTH) IL:OF TWO))
|
||||
(+ (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF ONE)
|
||||
(IL:FETCH (IL:REGION IL:HEIGHT) IL:OF TWO))))
|
||||
|
||||
(defun region-plus (one two) (il:createregion (+ (il:fetch (il:region il:left) il:of one)
|
||||
(il:fetch (il:region il:left) il:of two))
|
||||
(+ (il:fetch (il:region il:bottom) il:of one)
|
||||
(il:fetch (il:region il:bottom) il:of two))
|
||||
(+ (il:fetch (il:region il:width) il:of one)
|
||||
(il:fetch (il:region il:width) il:of two))
|
||||
(+ (il:fetch (il:region il:height) il:of one)
|
||||
(il:fetch (il:region il:height) il:of two))))
|
||||
(DEFUN GET-REGION (CONTEXT)
|
||||
(LET ((PAIR (AND USER::*L-S-REUSE-EARLIER-REGIONS* (FIND NIL *REGION-ALIST* :KEY 'CDR))))
|
||||
(COND
|
||||
((NULL PAIR)
|
||||
(COND
|
||||
((NULL *REGION-ALIST*)
|
||||
(SETQ *REGION-ALIST* (LIST (CONS USER::*L-S-REGION-ZERO* CONTEXT)))
|
||||
USER::*L-S-REGION-ZERO*)
|
||||
(T (LET ((NEW-REGION (REGION-PLUS (CAR (FIRST *REGION-ALIST*))
|
||||
USER::*L-S-REGION-DELTA*)))
|
||||
(PUSH (CONS NEW-REGION CONTEXT)
|
||||
*REGION-ALIST*)
|
||||
NEW-REGION))))
|
||||
(T (SETF (CDR PAIR)
|
||||
CONTEXT)
|
||||
(CAR PAIR)))))
|
||||
|
||||
(DEFUN SAVE-REGION (CONTEXT)
|
||||
|
||||
(defun get-region (context) (let ((pair (and user::*l-s-reuse-earlier-regions* (find nil
|
||||
*region-alist*
|
||||
:key
|
||||
'cdr))))
|
||||
(cond
|
||||
((null pair)
|
||||
(cond
|
||||
((null *region-alist*)
|
||||
(setq *region-alist* (list (cons user::*l-s-region-zero*
|
||||
context)))
|
||||
user::*l-s-region-zero*)
|
||||
(t (let ((new-region (region-plus (car (first *region-alist*)
|
||||
)
|
||||
user::*l-s-region-delta*)))
|
||||
(push (cons new-region context)
|
||||
*region-alist*)
|
||||
new-region))))
|
||||
(t (setf (cdr pair)
|
||||
context)
|
||||
(car pair)))))
|
||||
(IL:* IL:|;;;| "The context is done with its region. Deallocate it.")
|
||||
|
||||
(LET ((PAIR (FIND CONTEXT *REGION-ALIST* :KEY 'CDR)))
|
||||
(IF (NULL PAIR)
|
||||
(WARN "An SEdit context is trying to give up an unallocated region.")
|
||||
(SETF (CDR PAIR)
|
||||
NIL))
|
||||
(SETQ *REGION-ALIST* (MEMBER-IF-NOT 'NULL *REGION-ALIST* :KEY 'CDR))))
|
||||
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DONTEVAL@COMPILE IL:DOCOPY
|
||||
|
||||
(defun save-region (context)
|
||||
|
||||
(il:* il:|;;;| "The context is done with its region. Deallocate it.")
|
||||
(let ((pair (find context *region-alist* :key 'cdr)))
|
||||
(if (null pair)
|
||||
(warn "An SEdit context is trying to give up an unallocated region.")
|
||||
(setf (cdr pair)
|
||||
nil))
|
||||
(setq *region-alist* (member-if-not 'null *region-alist* :key 'cdr))))
|
||||
|
||||
(il:declare\: il:donteval@load il:donteval@compile il:docopy
|
||||
(user::use-l-s-regions)
|
||||
(USER::USE-L-S-REGIONS)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(il:* il:|;;| "Arrange to use the proper compiler and makefile environment ")
|
||||
(IL:* IL:|;;| "Arrange to use the proper compiler and makefile environment ")
|
||||
|
||||
|
||||
(il:putprops il:layout-sedit il:filetype compile-file)
|
||||
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:FILETYPE COMPILE-FILE)
|
||||
|
||||
(il:putprops il:layout-sedit il:makefile-environment (:readtable "XCL" :package (xcl:defpackage
|
||||
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE (XCL:DEFPACKAGE
|
||||
"LAYOUT-SEDIT"
|
||||
(:nicknames "L-S"))))
|
||||
(il:putprops il:layout-sedit il:copyright ("Pavel Curtis" 1986 1987))
|
||||
(il:declare\: il:dontcopy
|
||||
(il:filemap (nil)))
|
||||
il:stop
|
||||
(:NICKNAMES "L-S"))))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL (1426 1788 (USER::USE-L-S-REGIONS 1426 . 1788)) (1790 2051 (USER::STOP-USING-L-S-REGIONS
|
||||
1790 . 2051)) (3443 4007 (REGION-PLUS 3443 . 4007)) (4009 4732 (GET-REGION 4009 . 4732)) (4734 5138 (
|
||||
SAVE-REGION 4734 . 5138)))))
|
||||
IL:STOP
|
||||
|
||||
@@ -1 +1,52 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "LAYOUT-SEDIT" ( NICKNAMES "L-S")))
(IL:FILECREATED " 9-Sep-94 13:47:35" ("compiled on " IL:|{DSK}<lispcore>lispusers>LAYOUT-SEDIT.;1|)
"28-Jul-94 17:28:46" IL:|bcompl'd| IL:|in| "Medley 25-Aug-94 ..." IL:|dated| "25-Aug-94 10:02:49")
(IL:FILECREATED " 9-Jan-87 19:55:25" IL:{ERIS}<LISPUSERS>LISPCORE>LAYOUT-SEDIT.\;2 7190 IL:|changes|
IL:|to:| (IL:VARIABLES USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA* USER::*L-S-REUSE-EARLIER-REGIONS*
) (IL:FUNCTIONS GET-REGION SAVE-REGION USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS) (IL:VARS
IL:LAYOUT-SEDITCOMS) IL:|previous| IL:|date:| "26-Dec-86 19:42:46" IL:{ERIS}<PAVEL>LISP>LAYOUT-SEDIT.\;2
)
(IL:PRETTYCOMPRINT IL:LAYOUT-SEDITCOMS)
(IL:RPAQQ IL:LAYOUT-SEDITCOMS ((IL:FUNCTIONS USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS) (
IL:VARIABLES *REGION-ALIST* USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA*
USER::*L-S-REUSE-EARLIER-REGIONS*) (IL:FUNCTIONS REGION-PLUS) (IL:FUNCTIONS GET-REGION SAVE-REGION) (
IL:DECLARE\: IL:DONTEVAL@LOAD IL:DONTEVAL@COMPILE IL:DOCOPY (IL:P (USER::USE-L-S-REGIONS))) (IL:*
IL:|;;| "Arrange to use the proper compiler and makefile environment ") (IL:PROP (IL:FILETYPE
IL:MAKEFILE-ENVIRONMENT) IL:LAYOUT-SEDIT)))
(DEFUN USER::USE-L-S-REGIONS NIL (ASSERT (NULL IL:|\\\\contexts|) NIL "Close all open SEdit windows")
(IL:SEDIT.RESET) (IL:MOVD (QUOTE IL:SEDIT.GET.WINDOW.REGION) (QUOTE OLD-GET-REGION)) (IL:MOVD (QUOTE
IL:SEDIT.SAVE.WINDOW.REGION) (QUOTE OLD-SAVE-REGION)) (IL:MOVD (QUOTE GET-REGION) (QUOTE
IL:SEDIT.GET.WINDOW.REGION)) (IL:MOVD (QUOTE SAVE-REGION) (QUOTE IL:SEDIT.SAVE.WINDOW.REGION)))
(DEFUN USER::STOP-USING-L-S-REGIONS NIL (ASSERT (NULL IL:|\\\\contexts|) NIL
"Close all open SEdit windows") (IL:SEDIT.RESET) (IL:MOVD (QUOTE OLD-GET-REGION) (QUOTE
IL:SEDIT.GET.WINDOW.REGION)) (IL:MOVD (QUOTE OLD-SAVE-REGION) (QUOTE IL:SEDIT.SAVE.WINDOW.REGION)))
(DEFVAR *REGION-ALIST* NIL (IL:* IL:|;;;|
"An AList mapping a region to the SEdit context that currently owns it. The associations of regions no longer in use should have a CDR of NIL. The list is kept in reverse order, with the farthest region from *REGION-ZERO* at the front of the list. So as to allow experimentation by users, we maintain the invariant that the first association on the list never has a CDR of NIL. To reestablish that invariant, we sometimes POP the AList rather than set the CDR to NIL."
))
(DEFVAR USER::*L-S-REGION-ZERO* (IL:CREATEREGION 25 (- (TRUNCATE IL:SCREENHEIGHT 2) 19) (TRUNCATE
IL:SCREENWIDTH 2) (TRUNCATE IL:SCREENHEIGHT 2)) (IL:* IL:|;;;|
"The region to be used by the first SEdit window. This works in conjunction with USER::*L-S-REGION-DELTA* to specify the region for each new SEdit window."
))
(DEFVAR USER::*L-S-REGION-DELTA* (IL:CREATEREGION 11 -44 0 0))
(DEFVAR USER::*L-S-REUSE-EARLIER-REGIONS* NIL (IL:* IL:|;;;|
"If non-NIL, then earlier regions (i.e., those closer to USER::*L-S-REGION-ZERO* will get reused when free. Otherwise, new regions, farther from USER::*L-S-REGION-ZERO* than any currently in use, will be created."
))
(DEFUN REGION-PLUS (ONE TWO) (IL:CREATEREGION (+ (IL:FETCH (IL:REGION IL:LEFT) IL:OF ONE) (IL:FETCH (
IL:REGION IL:LEFT) IL:OF TWO)) (+ (IL:FETCH (IL:REGION IL:BOTTOM) IL:OF ONE) (IL:FETCH (IL:REGION
IL:BOTTOM) IL:OF TWO)) (+ (IL:FETCH (IL:REGION IL:WIDTH) IL:OF ONE) (IL:FETCH (IL:REGION IL:WIDTH) IL:OF
TWO)) (+ (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF ONE) (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF TWO))))
(DEFUN GET-REGION (CONTEXT) (LET ((PAIR (AND USER::*L-S-REUSE-EARLIER-REGIONS* (FIND NIL
*REGION-ALIST* :KEY (QUOTE CDR))))) (COND ((NULL PAIR) (COND ((NULL *REGION-ALIST*) (SETQ
*REGION-ALIST* (LIST (CONS USER::*L-S-REGION-ZERO* CONTEXT))) USER::*L-S-REGION-ZERO*) (T (LET ((
NEW-REGION (REGION-PLUS (CAR (FIRST *REGION-ALIST*)) USER::*L-S-REGION-DELTA*))) (PUSH (CONS
NEW-REGION CONTEXT) *REGION-ALIST*) NEW-REGION)))) (T (SETF (CDR PAIR) CONTEXT) (CAR PAIR)))))
(DEFUN SAVE-REGION (CONTEXT) (IL:* IL:|;;;| "The context is done with its region. Deallocate it.") (
LET ((PAIR (FIND CONTEXT *REGION-ALIST* :KEY (QUOTE CDR)))) (IF (NULL PAIR) (WARN
"An SEdit context is trying to give up an unallocated region.") (SETF (CDR PAIR) NIL)) (SETQ
*REGION-ALIST* (MEMBER-IF-NOT (QUOTE NULL) *REGION-ALIST* :KEY (QUOTE CDR)))))
(USER::USE-L-S-REGIONS)
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:FILETYPE COMPILE-FILE)
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE (XCL:DEFPACKAGE
"LAYOUT-SEDIT" (:NICKNAMES "L-S"))))
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:COPYRIGHT ("Pavel Curtis" 1986 1987))
NIL
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "LAYOUT-SEDIT" ( NICKNAMES "L-S")) READTABLE "XCL" BASE 10)
|
||||
|
||||
(IL:FILECREATED "18-Feb-2026 16:39:44" ("compiled on " IL:|{WMEDLEY}<lispusers>LAYOUT-SEDIT.;2|)
|
||||
"18-Feb-2026 16:37:55" IL:|bcompl'd| IL:|in| "FULL 18-Feb-2026 ..." IL:|dated| "18-Feb-2026 16:38:04")
|
||||
(IL:FILECREATED "18-Feb-2026 16:36:18" IL:|{WMEDLEY}<lispusers>LAYOUT-SEDIT.;2| 5714 :EDIT-BY IL:|rmk|
|
||||
:CHANGES-TO (IL:VARS IL:LAYOUT-SEDITCOMS) (IL:VARIABLES *REGION-ALIST* USER::*L-S-REGION-ZERO*
|
||||
USER::*L-S-REGION-DELTA* USER::*L-S-REUSE-EARLIER-REGIONS*) (IL:FUNCTIONS USER::USE-L-S-REGIONS
|
||||
USER::STOP-USING-L-S-REGIONS REGION-PLUS GET-REGION SAVE-REGION) :PREVIOUS-DATE " 9-Jan-87 19:55:25"
|
||||
IL:|{WMEDLEY}<lispusers>LAYOUT-SEDIT.;1|)
|
||||
(IL:PRETTYCOMPRINT IL:LAYOUT-SEDITCOMS)
|
||||
(IL:RPAQQ IL:LAYOUT-SEDITCOMS ((IL:FUNCTIONS USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS) (
|
||||
IL:VARIABLES *REGION-ALIST* USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA*
|
||||
USER::*L-S-REUSE-EARLIER-REGIONS*) (IL:FUNCTIONS REGION-PLUS) (IL:FUNCTIONS GET-REGION SAVE-REGION) (
|
||||
IL:DECLARE\: IL:DONTEVAL@LOAD IL:DONTEVAL@COMPILE IL:DOCOPY (IL:P (USER::USE-L-S-REGIONS))) (IL:*
|
||||
IL:|;;| "Arrange to use the proper compiler and makefile environment ") (IL:PROP (IL:FILETYPE
|
||||
IL:MAKEFILE-ENVIRONMENT) IL:LAYOUT-SEDIT)))
|
||||
(DEFUN USER::USE-L-S-REGIONS NIL (ASSERT (NULL IL:|\\\\contexts|) NIL "Close all open SEdit windows")
|
||||
(IL:SEDIT.RESET) (IL:MOVD (QUOTE IL:SEDIT.GET.WINDOW.REGION) (QUOTE OLD-GET-REGION)) (IL:MOVD (QUOTE
|
||||
IL:SEDIT.SAVE.WINDOW.REGION) (QUOTE OLD-SAVE-REGION)) (IL:MOVD (QUOTE GET-REGION) (QUOTE
|
||||
IL:SEDIT.GET.WINDOW.REGION)) (IL:MOVD (QUOTE SAVE-REGION) (QUOTE IL:SEDIT.SAVE.WINDOW.REGION)))
|
||||
(DEFUN USER::STOP-USING-L-S-REGIONS NIL (ASSERT (NULL IL:|\\\\contexts|) NIL
|
||||
"Close all open SEdit windows") (IL:SEDIT.RESET) (IL:MOVD (QUOTE OLD-GET-REGION) (QUOTE
|
||||
IL:SEDIT.GET.WINDOW.REGION)) (IL:MOVD (QUOTE OLD-SAVE-REGION) (QUOTE IL:SEDIT.SAVE.WINDOW.REGION)))
|
||||
(DEFVAR *REGION-ALIST* NIL (IL:* IL:|;;;|
|
||||
"An AList mapping a region to the SEdit context that currently owns it. The associations of regions no longer in use should have a CDR of NIL. The list is kept in reverse order, with the farthest region from *REGION-ZERO* at the front of the list. So as to allow experimentation by users, we maintain the invariant that the first association on the list never has a CDR of NIL. To reestablish that invariant, we sometimes POP the AList rather than set the CDR to NIL."
|
||||
))
|
||||
(DEFVAR USER::*L-S-REGION-ZERO* (IL:CREATEREGION 25 (- (TRUNCATE IL:SCREENHEIGHT 2) 19) (TRUNCATE
|
||||
IL:SCREENWIDTH 2) (TRUNCATE IL:SCREENHEIGHT 2)) (IL:* IL:|;;;|
|
||||
"The region to be used by the first SEdit window. This works in conjunction with USER::*L-S-REGION-DELTA* to specify the region for each new SEdit window."
|
||||
))
|
||||
(DEFVAR USER::*L-S-REGION-DELTA* (IL:CREATEREGION 11 -44 0 0))
|
||||
(DEFVAR USER::*L-S-REUSE-EARLIER-REGIONS* NIL (IL:* IL:|;;;|
|
||||
"If non-NIL, then earlier regions (i.e., those closer to USER::*L-S-REGION-ZERO* will get reused when free. Otherwise, new regions, farther from USER::*L-S-REGION-ZERO* than any currently in use, will be created."
|
||||
))
|
||||
(DEFUN REGION-PLUS (ONE TWO) (IL:CREATEREGION (+ (IL:FETCH (IL:REGION IL:LEFT) IL:OF ONE) (IL:FETCH (
|
||||
IL:REGION IL:LEFT) IL:OF TWO)) (+ (IL:FETCH (IL:REGION IL:BOTTOM) IL:OF ONE) (IL:FETCH (IL:REGION
|
||||
IL:BOTTOM) IL:OF TWO)) (+ (IL:FETCH (IL:REGION IL:WIDTH) IL:OF ONE) (IL:FETCH (IL:REGION IL:WIDTH) IL:OF
|
||||
TWO)) (+ (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF ONE) (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF TWO))))
|
||||
(DEFUN GET-REGION (CONTEXT) (LET ((PAIR (AND USER::*L-S-REUSE-EARLIER-REGIONS* (FIND NIL
|
||||
*REGION-ALIST* :KEY (QUOTE CDR))))) (COND ((NULL PAIR) (COND ((NULL *REGION-ALIST*) (SETQ
|
||||
*REGION-ALIST* (LIST (CONS USER::*L-S-REGION-ZERO* CONTEXT))) USER::*L-S-REGION-ZERO*) (T (LET ((
|
||||
NEW-REGION (REGION-PLUS (CAR (FIRST *REGION-ALIST*)) USER::*L-S-REGION-DELTA*))) (PUSH (CONS
|
||||
NEW-REGION CONTEXT) *REGION-ALIST*) NEW-REGION)))) (T (SETF (CDR PAIR) CONTEXT) (CAR PAIR)))))
|
||||
(DEFUN SAVE-REGION (CONTEXT) (IL:* IL:|;;;| "The context is done with its region. Deallocate it.") (
|
||||
LET ((PAIR (FIND CONTEXT *REGION-ALIST* :KEY (QUOTE CDR)))) (IF (NULL PAIR) (WARN
|
||||
"An SEdit context is trying to give up an unallocated region.") (SETF (CDR PAIR) NIL)) (SETQ
|
||||
*REGION-ALIST* (MEMBER-IF-NOT (QUOTE NULL) *REGION-ALIST* :KEY (QUOTE CDR)))))
|
||||
(USER::USE-L-S-REGIONS)
|
||||
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:FILETYPE COMPILE-FILE)
|
||||
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE (XCL:DEFPACKAGE
|
||||
"LAYOUT-SEDIT" (:NICKNAMES "L-S"))))
|
||||
NIL
|
||||
|
||||
@@ -1,32 +1,27 @@
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED " 2-Feb-87 10:38:19" {ERIS}<LISPUSERS>LYRIC>PHONE-DIRECTORY.;1 9029
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (VARS PHONE-DIRECTORYCOMS)
|
||||
(FILECREATED "18-Feb-2026 16:27:33" {WMEDLEY}<lispusers>PHONE-DIRECTORY.;2 8485
|
||||
|
||||
previous date%: " 9-Jan-87 19:45:25" {ERIS}<LISPUSERS>KOTO>PHONE-DIRECTORY.;3)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE " 2-Feb-87 10:38:19" {WMEDLEY}<lispusers>PHONE-DIRECTORY.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT PHONE-DIRECTORYCOMS)
|
||||
|
||||
(RPAQQ PHONE-DIRECTORYCOMS ((FNS Cache-Phone-Directory-Files Let-your-fingers-do-the-walking
|
||||
Phone-Directory-Kill-Proc Phone-Window-ButtonEventFn Lookup-Person
|
||||
Phone-Window-WhenOpenedFn)
|
||||
(VARS fingersIconMask fingersIconBM)
|
||||
(INITVARS (*Cached-Phone-Directory-Files* NIL)
|
||||
(*Phone-Directory-Pos* (create POSITION XCOORD _ 15 YCOORD _
|
||||
(DIFFERENCE SCREENHEIGHT 75)))
|
||||
(*Phone-Directory-Region* (CREATEREGION 15 (DIFFERENCE
|
||||
SCREENHEIGHT 258
|
||||
)
|
||||
400 250)))
|
||||
(GLOBALVARS *Cached-Phone-Directory-Files* *Phone-Directory-Pos*
|
||||
*Phone-Directory-Region* fingersIconMask fingersIconBM)
|
||||
(FILES GREP)
|
||||
(P (Let-your-fingers-do-the-walking))))
|
||||
(RPAQQ PHONE-DIRECTORYCOMS
|
||||
((FNS Cache-Phone-Directory-Files Let-your-fingers-do-the-walking Phone-Directory-Kill-Proc
|
||||
Phone-Window-ButtonEventFn Lookup-Person Phone-Window-WhenOpenedFn)
|
||||
(VARS fingersIconMask fingersIconBM)
|
||||
(INITVARS (*Cached-Phone-Directory-Files* NIL)
|
||||
(*Phone-Directory-Pos* (create POSITION XCOORD _ 15 YCOORD _ (DIFFERENCE SCREENHEIGHT
|
||||
75)))
|
||||
(*Phone-Directory-Region* (CREATEREGION 15 (DIFFERENCE SCREENHEIGHT 258)
|
||||
400 250)))
|
||||
(GLOBALVARS *Cached-Phone-Directory-Files* *Phone-Directory-Pos* *Phone-Directory-Region*
|
||||
fingersIconMask fingersIconBM)
|
||||
(FILES GREP)
|
||||
(P (Let-your-fingers-do-the-walking))))
|
||||
(DEFINEQ
|
||||
|
||||
(Cache-Phone-Directory-Files
|
||||
@@ -139,11 +134,12 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
|
||||
(GLOBALVARS *Cached-Phone-Directory-Files* *Phone-Directory-Pos* *Phone-Directory-Region*
|
||||
fingersIconMask fingersIconBM)
|
||||
)
|
||||
|
||||
(FILESLOAD GREP)
|
||||
(Let-your-fingers-do-the-walking)
|
||||
(PUTPROPS PHONE-DIRECTORY COPYRIGHT ("Xerox Corporation" 1986 1987))
|
||||
|
||||
(Let-your-fingers-do-the-walking)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1649 6373 (Cache-Phone-Directory-Files 1659 . 2954) (Let-your-fingers-do-the-walking
|
||||
2956 . 4251) (Phone-Directory-Kill-Proc 4253 . 4684) (Phone-Window-ButtonEventFn 4686 . 5362) (
|
||||
Lookup-Person 5364 . 5976) (Phone-Window-WhenOpenedFn 5978 . 6371)))))
|
||||
(FILEMAP (NIL (1168 5892 (Cache-Phone-Directory-Files 1178 . 2473) (Let-your-fingers-do-the-walking
|
||||
2475 . 3770) (Phone-Directory-Kill-Proc 3772 . 4203) (Phone-Window-ButtonEventFn 4205 . 4881) (
|
||||
Lookup-Person 4883 . 5495) (Phone-Window-WhenOpenedFn 5497 . 5890)))))
|
||||
STOP
|
||||
|
||||
@@ -1,15 +1,11 @@
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED " 9-Jan-87 16:47:16" {ERIS}<LISPCORE>LIBRARY>SKETCHCOLOR.;2 4779
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (VARS BLACKSHADE16 DARKGRAY16 MEDIUMGRAY16 LIGHTGRAY16 WHITESHADE16 REDTEXTURE
|
||||
GREENTEXTURE BLUETEXTURE SKETCHCOLORCOMS)
|
||||
(FILECREATED "18-Feb-2026 16:28:03" {WMEDLEY}<lispusers>SKETCHCOLOR.;2 4732
|
||||
|
||||
previous date%: "29-Oct-85 14:44:30" {ERIS}<LISPCORE>LIBRARY>SKETCHCOLOR.;1)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE " 9-Jan-87 16:47:16" {WMEDLEY}<lispusers>SKETCHCOLOR.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT SKETCHCOLORCOMS)
|
||||
|
||||
@@ -75,25 +71,30 @@ Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
|
||||
)
|
||||
|
||||
(RPAQQ SKETCHINCOLORFLG T)
|
||||
|
||||
(FILESLOAD COLOR STYLESHEET)
|
||||
|
||||
(PUTPROPS \FILLCIRCLE.DISPLAY READVICE [NIL (BEFORE NIL (COND ((LISTP TEXTURE)
|
||||
(COND ((TEXTUREP (CAR TEXTURE))
|
||||
(SETQ TEXTURE (CAR TEXTURE)))
|
||||
(T (SETQ TEXTURE
|
||||
(TEXTUREOFCOLOR
|
||||
(CADR TEXTURE])
|
||||
[XCL:REINSTALL-ADVICE '\FILLCIRCLE.DISPLAY :BEFORE '((:LAST (COND
|
||||
((LISTP TEXTURE)
|
||||
(COND
|
||||
((TEXTUREP (CAR TEXTURE))
|
||||
(SETQ TEXTURE (CAR TEXTURE)))
|
||||
(T (SETQ TEXTURE
|
||||
(TEXTUREOFCOLOR (CADR TEXTURE]
|
||||
|
||||
[XCL:REINSTALL-ADVICE '\POLYSHADE.DISPLAY :BEFORE '((:LAST (COND
|
||||
((LISTP FILL.SHADE)
|
||||
(COND
|
||||
((TEXTUREP (CAR FILL.SHADE))
|
||||
(SETQ FILL.SHADE (CAR FILL.SHADE))
|
||||
)
|
||||
(T (SETQ FILL.SHADE
|
||||
(TEXTUREOFCOLOR (CADR
|
||||
FILL.SHADE
|
||||
]
|
||||
|
||||
(PUTPROPS \POLYSHADE.DISPLAY READVICE [NIL (BEFORE NIL (COND ((LISTP FILL.SHADE)
|
||||
(COND ((TEXTUREP (CAR FILL.SHADE))
|
||||
(SETQ FILL.SHADE (CAR FILL.SHADE
|
||||
)))
|
||||
(T (SETQ FILL.SHADE
|
||||
(TEXTUREOFCOLOR
|
||||
(CADR FILL.SHADE])
|
||||
(READVISE \FILLCIRCLE.DISPLAY \POLYSHADE.DISPLAY)
|
||||
(PUTPROPS SKETCHCOLOR COPYRIGHT ("Xerox Corporation" 1985 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (771 3368 (COLORTEXTURETEST 781 . 2128) (LEVELTEXTURE 2130 . 2662) (PRIMARYTEXTURE 2664
|
||||
. 3366)))))
|
||||
(FILEMAP (NIL (547 3144 (COLORTEXTURETEST 557 . 1904) (LEVELTEXTURE 1906 . 2438) (PRIMARYTEXTURE 2440
|
||||
. 3142)))))
|
||||
STOP
|
||||
|
||||
@@ -1,16 +1,18 @@
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED "17-Mar-87 17:03:54" {DSK}<XAVIER>TRANSOR.;16 44778
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (VARS TRANSORCOMS)
|
||||
(FNS PRECH1 TRANSOUT)
|
||||
(FILECREATED "18-Feb-2026 21:57:19" {WMEDLEY}<lispusers>TRANSOR.;2 43458
|
||||
|
||||
previous date%: "17-Mar-87 17:00:04" {DSK}<XAVIER>TRANSOR.;15)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TRANSORCOMS)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-87 17:03:54" {WMEDLEY}<lispusers>TRANSOR.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TRANSORCOMS)
|
||||
|
||||
(RPAQQ TRANSORCOMS
|
||||
((FNS TRANSOR TRANSOR-PROCEED TRANSORFORM TRANSORFNS TRANSFORM TRANSIT TRANXT TRANSEXIT
|
||||
(RPAQQ TRANSORCOMS
|
||||
[(FNS TRANSOR TRANSOR-PROCEED TRANSORFORM TRANSORFNS TRANSFORM TRANSIT TRANXT TRANSEXIT
|
||||
KEEPLIST TRANSERR TRANSOUT PPASS1 TRANSLIST TRANSLIST1 PREMTEXT WACHADOON PRECH PRECH1
|
||||
PRECH2 RETAIL LNC PRESCAN)
|
||||
TRANSORMACROS TRANSOREMARKS TRANSORGLOBALS
|
||||
@@ -18,8 +20,10 @@
|
||||
(TESTRAN)
|
||||
(USERMACROS (APPEND TRANSORMACROS USERMACROS))
|
||||
(GLOBALVARS (APPEND TRANSORGLOBALS GLOBALVARS))
|
||||
(EDITCOMSA (UNION '(NLAM NLAMIT DOTHESE DOTHIS XFORMER CONTINUE) EDITCOMSA))
|
||||
(EDITCOMSL (UNION '(REMARK) EDITCOMSL))
|
||||
(EDITCOMSA (UNION '(NLAM NLAMIT DOTHESE DOTHIS XFORMER CONTINUE)
|
||||
EDITCOMSA))
|
||||
(EDITCOMSL (UNION '(REMARK)
|
||||
EDITCOMSL))
|
||||
(TRANSITCONSES '(ORR NIL XFORMER))
|
||||
(PRESCARRAY (ARRAY 127 127)))
|
||||
(INITVARS (NLISTPCOMS)
|
||||
@@ -36,10 +40,9 @@
|
||||
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP))
|
||||
(NIL PRESCAN (GLOBALVARS PRESCARRAY)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML TRANSERR KEEPLIST
|
||||
(NLAML TRANSERR KEEPLIST
|
||||
TRANSOR-PROCEED)
|
||||
(LAMA)))
|
||||
(EDITHIST TRANSOR)))
|
||||
(LAMA])
|
||||
(DEFINEQ
|
||||
|
||||
(TRANSOR
|
||||
@@ -861,52 +864,49 @@ TRANSOR made a translation error: " T)
|
||||
(RETURN (CLOSEF OUTF)))))
|
||||
)
|
||||
|
||||
(RPAQQ TRANSORMACROS ((REMARK (TXT)
|
||||
(E (KEEPLIST TXT)
|
||||
T))
|
||||
(NLAM NIL (E (SETQQ WHERETOGONEXT NLAMIT)
|
||||
T))
|
||||
[NLAMIT NIL (ORR NX !NX ((E (TRANSEXIT]
|
||||
(DOTHESE NIL (E (TRANSOR-PROCEED DOTHESE)
|
||||
T)
|
||||
NLAM)
|
||||
(DOTHIS NIL (E (TRANSOR-PROCEED DOTHIS)
|
||||
T)
|
||||
NLAM)
|
||||
(XFORMER NIL (E (TRANSERR TRANSFORMATIONERROR "FAULTY TRANSFORMATION"
|
||||
(CURRENTFORM CURRENTCOMS))
|
||||
T))))
|
||||
(RPAQQ TRANSORMACROS
|
||||
((REMARK (TXT)
|
||||
(E (KEEPLIST TXT)
|
||||
T))
|
||||
(NLAM NIL (E (SETQQ WHERETOGONEXT NLAMIT)
|
||||
T))
|
||||
[NLAMIT NIL (ORR NX !NX ((E (TRANSEXIT]
|
||||
(DOTHESE NIL (E (TRANSOR-PROCEED DOTHESE)
|
||||
T)
|
||||
NLAM)
|
||||
(DOTHIS NIL (E (TRANSOR-PROCEED DOTHIS)
|
||||
T)
|
||||
NLAM)
|
||||
(XFORMER NIL (E (TRANSERR TRANSFORMATIONERROR "FAULTY TRANSFORMATION" (CURRENTFORM
|
||||
CURRENTCOMS))
|
||||
T))))
|
||||
|
||||
(RPAQQ TRANSOREMARKS ((TRANSFORMATIONERROR (* The TRANSFORMATIONS specified for this form failed to
|
||||
work properly. The TTY message %'FAULTY TRANSFORMATION'
|
||||
was printed, any commands remaining in the
|
||||
transformation after the erroneous one were skipped,
|
||||
and translation continued as if the transformation had
|
||||
been normally completed. The user should treat the
|
||||
translated form with caution and amend his
|
||||
transformation to avoid future problems.))
|
||||
(TRANSERROR (* TRANSOR got confused at this point. The TTY message %'SHOW JIM
|
||||
GOODWIN' was printed and translation continued with the next
|
||||
form, but the user should treat the compromised area of code
|
||||
with caution.))
|
||||
(BLAMBDA1 (* Non-atomic CAR of form, but not an open lambda. Either a
|
||||
parenthesis error or computed CAR of form. Computed CAR of form is
|
||||
no longer legal in BBN-LISP; APPLY* is used instead. If computed
|
||||
CAR of form was intended, the translation to APPLY* will run ok.
|
||||
See manual for discussion of APPLY*.))
|
||||
(BLAMBDA2 (* Open LAMBDA with wrong number of args. What can it mean?))
|
||||
(BLAMBDA3 (* Lambda-expression without forms. What can it mean?))
|
||||
(ILLCAR (* Illegal data-type encountered as CAR of form Expression treated as
|
||||
list of forms.))
|
||||
(TAILP/DOTHIS (* When the transormacro DOTHIS is executed at a TAILP position,
|
||||
TRANSOR does a 1 command first, assuming that the current
|
||||
position is a list of forms and CAR of it is the form
|
||||
intended. The user should make sure that this is what was
|
||||
intended by the TRANSFORMATIONS which called DOTHIS, i.e. the
|
||||
TRANSFORMATIONS for the form containing this one.))))
|
||||
(RPAQQ TRANSOREMARKS
|
||||
((TRANSFORMATIONERROR (* The TRANSFORMATIONS specified for this form failed to work properly.
|
||||
The TTY message %'FAULTY TRANSFORMATION' was printed, any commands
|
||||
remaining in the transformation after the erroneous one were skipped,
|
||||
and translation continued as if the transformation had been normally
|
||||
completed. The user should treat the translated form with caution and
|
||||
amend his transformation to avoid future problems.))
|
||||
(TRANSERROR (* TRANSOR got confused at this point. The TTY message %'SHOW JIM GOODWIN' was
|
||||
printed and translation continued with the next form, but the user should
|
||||
treat the compromised area of code with caution.))
|
||||
(BLAMBDA1 (* Non-atomic CAR of form, but not an open lambda. Either a parenthesis error or
|
||||
computed CAR of form. Computed CAR of form is no longer legal in BBN-LISP;
|
||||
APPLY* is used instead. If computed CAR of form was intended, the translation to
|
||||
APPLY* will run ok. See manual for discussion of APPLY*.))
|
||||
(BLAMBDA2 (* Open LAMBDA with wrong number of args. What can it mean?))
|
||||
(BLAMBDA3 (* Lambda-expression without forms. What can it mean?))
|
||||
(ILLCAR (* Illegal data-type encountered as CAR of form Expression treated as list of forms.)
|
||||
)
|
||||
(TAILP/DOTHIS (* When the transormacro DOTHIS is executed at a TAILP position, TRANSOR does a
|
||||
1 command first, assuming that the current position is a list of forms and
|
||||
CAR of it is the form intended. The user should make sure that this is what
|
||||
was intended by the TRANSFORMATIONS which called DOTHIS, i.e. the
|
||||
TRANSFORMATIONS for the form containing this one.))))
|
||||
|
||||
(RPAQQ TRANSORGLOBALS (USERNOTES USERNOTES TESTFORM TESTFORM TRANSFORMATIONS TRANSFORMATIONS
|
||||
XFORMSFNS XFORMSVARS XFORMSVARS DUMPFILE TRANSFORMATIONS TRANSFORMATIONS
|
||||
XFORMSFNS XFORMSVARS XFORMSVARS DUMPFILE TRANSFORMATIONS TRANSFORMATIONS
|
||||
TRANSFORMATIONS TRANSFORMATIONS))
|
||||
|
||||
(RPAQQ MAXLOOP 1530)
|
||||
@@ -917,9 +917,11 @@ TRANSOR made a translation error: " T)
|
||||
|
||||
(RPAQ GLOBALVARS (APPEND TRANSORGLOBALS GLOBALVARS))
|
||||
|
||||
(RPAQ EDITCOMSA (UNION '(NLAM NLAMIT DOTHESE DOTHIS XFORMER CONTINUE) EDITCOMSA))
|
||||
(RPAQ EDITCOMSA (UNION '(NLAM NLAMIT DOTHESE DOTHIS XFORMER CONTINUE)
|
||||
EDITCOMSA))
|
||||
|
||||
(RPAQ EDITCOMSL (UNION '(REMARK) EDITCOMSL))
|
||||
(RPAQ EDITCOMSL (UNION '(REMARK)
|
||||
EDITCOMSL))
|
||||
|
||||
(RPAQQ TRANSITCONSES (ORR NIL XFORMER))
|
||||
|
||||
@@ -932,7 +934,7 @@ TRANSOR made a translation error: " T)
|
||||
(RPAQ? TRANSOUTREADTABLE FILERDTBL)
|
||||
(DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(PUTPROPS TAILP BLKLIBRARYDEF [LAMBDA (.BLKVAR.X .BLKVAR.Y)
|
||||
(PUTPROPS TAILP BLKLIBRARYDEF [LAMBDA (.BLKVAR.X .BLKVAR.Y)
|
||||
(* True if .BLKVAR.X is A tail of .BLKVAR.Y .BLKVAR.X and
|
||||
.BLKVAR.Y non-null.)
|
||||
(* Included with editor for block compilation purposes.)
|
||||
@@ -944,15 +946,19 @@ TRANSOR made a translation error: " T)
|
||||
(GO LP])
|
||||
)
|
||||
|
||||
(PUTPROPS TRANSOR FILEGROUP (TRANSOR TSET))
|
||||
(PUTPROPS TRANSOR FILEGROUP (TRANSOR TSET))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(BLOCK%: PRECHBLOCK PRECH PRECH1 PRECH2 RETAIL LNC (ENTRIES PRECH)
|
||||
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP))
|
||||
|
||||
(BLOCK%: TRANSITBLOCK TRANSIT WACHADOON (ENTRIES TRANSIT WACHADOON)
|
||||
(GLOBALVARS WACHADID WHENTODOIT TRANSITCONSES LAMBDACOMS NLISTPCOMS)
|
||||
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP))
|
||||
|
||||
(BLOCK%: TRANXTBLOCK TRANXT (ENTRIES TRANXT)
|
||||
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP))
|
||||
|
||||
(BLOCK%: NIL PRESCAN (GLOBALVARS PRESCARRAY))
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
@@ -963,23 +969,11 @@ TRANSOR made a translation error: " T)
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
|
||||
(ADDTOVAR EDITHISTALIST (TRANSOR (" 5-Feb-87 16:18:06" DJVB {DSK}<XAVIER>TRANSOR.;11 (TRANSOR)
|
||||
(FIXED TO WORK WITH NEW FILE RULES IN LYRIC))
|
||||
(" 6-Feb-87 15:24:20" DJVB {DSK}<XAVIER>TRANSOR.;12 (TRANSOR))
|
||||
(" 6-Mar-87 14:41:26" DJVB {DSK}<XAVIER>TRANSOR.;13
|
||||
(TRANSOR TRANSOR-PROCEED TRANSORFORM TRANSORFNS TRANSFORM
|
||||
RETAIL))
|
||||
("17-Mar-87 17:01:53" DJVB {DSK}<XAVIER>TRANSOR.;15 (PRECH1 TRANSOUT)
|
||||
(ADDED SPLIT READ/WRITE READTABLES AND PP FOR DEFUN))))
|
||||
)
|
||||
(PUTPROPS TRANSOR COPYRIGHT (NONE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2231 38324 (TRANSOR 2241 . 6284) (TRANSOR-PROCEED 6286 . 9093) (TRANSORFORM 9095 . 9527
|
||||
) (TRANSORFNS 9529 . 10225) (TRANSFORM 10227 . 11965) (TRANSIT 11967 . 14735) (TRANXT 14737 . 17950) (
|
||||
TRANSEXIT 17952 . 18262) (KEEPLIST 18264 . 19224) (TRANSERR 19226 . 19990) (TRANSOUT 19992 . 22436) (
|
||||
PPASS1 22438 . 22679) (TRANSLIST 22681 . 23700) (TRANSLIST1 23702 . 23934) (PREMTEXT 23936 . 24641) (
|
||||
WACHADOON 24643 . 25114) (PRECH 25116 . 25609) (PRECH1 25611 . 27779) (PRECH2 27781 . 28727) (RETAIL
|
||||
28729 . 29976) (LNC 29978 . 30841) (PRESCAN 30843 . 38322)))))
|
||||
(FILEMAP (NIL (2262 38355 (TRANSOR 2272 . 6315) (TRANSOR-PROCEED 6317 . 9124) (TRANSORFORM 9126 . 9558
|
||||
) (TRANSORFNS 9560 . 10256) (TRANSFORM 10258 . 11996) (TRANSIT 11998 . 14766) (TRANXT 14768 . 17981) (
|
||||
TRANSEXIT 17983 . 18293) (KEEPLIST 18295 . 19255) (TRANSERR 19257 . 20021) (TRANSOUT 20023 . 22467) (
|
||||
PPASS1 22469 . 22710) (TRANSLIST 22712 . 23731) (TRANSLIST1 23733 . 23965) (PREMTEXT 23967 . 24672) (
|
||||
WACHADOON 24674 . 25145) (PRECH 25147 . 25640) (PRECH1 25642 . 27810) (PRECH2 27812 . 28758) (RETAIL
|
||||
28760 . 30007) (LNC 30009 . 30872) (PRESCAN 30874 . 38353)))))
|
||||
STOP
|
||||
|
||||
@@ -1,25 +1,19 @@
|
||||
(DEFINE-FILE-INFO §PACKAGE "XCL-USER" §READTABLE "XCL")
|
||||
(IL:FILECREATED "13-Apr-87 17:38:17" IL:{DSK}<XAVIER>LOADTRAN.\;9 2045
|
||||
(DEFINE-FILE-INFO PACKAGE "XCL-USER" READTABLE "XCL" BASE 10)
|
||||
|
||||
IL:|changes| IL:|to:| (IL:VARS IL:LOADTRANCOMS STOP)
|
||||
(IL:FUNCTIONS MYLOAD I.S.OPR PRETTYCOMPRINT SETTEMPLATE DEFINE-FILE-INFO
|
||||
)
|
||||
(IL:FNS PRETTYCOMPRINT SETTEMPLATE)
|
||||
(IL:FILECREATED "18-Feb-2026 22:58:35" IL:|{WMEDLEY}<lispusers>TRANSOR-LOADTRAN.;2| 1561
|
||||
|
||||
IL:|previous| IL:|date:| " 6-Apr-87 16:57:48" IL:{DSK}<XAVIER>LOADTRAN.\;1)
|
||||
:EDIT-BY IL:|rmk|)
|
||||
|
||||
|
||||
; Copyright (c) 1987 by System Development Corp.. All rights reserved.
|
||||
(IL:PRETTYCOMPRINT IL:TRANSOR-LOADTRANCOMS)
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:LOADTRANCOMS)
|
||||
|
||||
(IL:RPAQQ IL:LOADTRANCOMS ((IL:VARS STOP)
|
||||
(IL:FNS PRETTYCOMPRINT SETTEMPLATE)
|
||||
(IL:FUNCTIONS DEFINE-FILE-INFO I.S.OPR MYLOAD)
|
||||
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY
|
||||
IL:COMPILERVARS (IL:ADDVARS (IL:NLAMA PRETTYCOMPRINT)
|
||||
(IL:NLAML)
|
||||
(IL:LAMA SETTEMPLATE)))))
|
||||
(IL:RPAQQ IL:TRANSOR-LOADTRANCOMS ((IL:VARS STOP)
|
||||
(IL:FNS PRETTYCOMPRINT SETTEMPLATE)
|
||||
(IL:FUNCTIONS DEFINE-FILE-INFO I.S.OPR MYLOAD)
|
||||
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY
|
||||
IL:COMPILERVARS (IL:ADDVARS (IL:NLAMA PRETTYCOMPRINT)
|
||||
(IL:NLAML)
|
||||
(IL:LAMA SETTEMPLATE)))))
|
||||
|
||||
(IL:RPAQQ STOP STOP)
|
||||
(IL:DEFINEQ
|
||||
@@ -33,17 +27,17 @@
|
||||
(BLOCK SETTEMPLATE (NILL))))
|
||||
)
|
||||
|
||||
(DEFUN DEFINE-FILE-INFO (&REST ARGS) (NILL))
|
||||
(DEFUN DEFINE-FILE-INFO (&REST ARGS)
|
||||
(NILL))
|
||||
|
||||
(DEFUN I.S.OPR (X)
|
||||
(NILL))
|
||||
|
||||
(DEFUN I.S.OPR (X) (NILL))
|
||||
|
||||
|
||||
(DEFUN MYLOAD (FILE) (LET ((FILE (OPEN FILE :DIRECTION :INPUT)))
|
||||
(UNWIND-PROTECT (IL:\\CML-LOAD FILE T *TERMINAL-IO* (FIND-PACKAGE
|
||||
"XCL-USER"))
|
||||
(CLOSE FILE))))
|
||||
|
||||
(DEFUN MYLOAD (FILE)
|
||||
(LET ((FILE (OPEN FILE :DIRECTION :INPUT)))
|
||||
(UNWIND-PROTECT
|
||||
(IL:\\CML-LOAD FILE T *TERMINAL-IO* (FIND-PACKAGE "XCL-USER"))
|
||||
(CLOSE FILE))))
|
||||
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY IL:COMPILERVARS
|
||||
|
||||
(IL:ADDTOVAR IL:NLAMA PRETTYCOMPRINT)
|
||||
@@ -52,7 +46,7 @@
|
||||
|
||||
(IL:ADDTOVAR IL:LAMA SETTEMPLATE)
|
||||
)
|
||||
(IL:PUTPROPS IL:LOADTRAN IL:COPYRIGHT ("System Development Corp." 1987))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL (1134 1357 (PRETTYCOMPRINT 1147 . 1283) (SETTEMPLATE 1285 . 1355)))))
|
||||
(IL:FILEMAP (NIL (830 1053 (PRETTYCOMPRINT 843 . 979) (SETTEMPLATE 981 . 1051)) (1055 1106 (
|
||||
DEFINE-FILE-INFO 1055 . 1106)) (1108 1141 (I.S.OPR 1108 . 1141)) (1143 1341 (MYLOAD 1143 . 1341)))))
|
||||
IL:STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,20 +1,15 @@
|
||||
(DEFINE-FILE-INFO §PACKAGE "INTERLISP" §READTABLE "INTERLISP" §BASE 10)
|
||||
(FILECREATED " 7-Dec-86 17:26:23" {ERIS}<LISPUSERS>LISPCORE>UNBOXEDOPS.;7 12906
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (OPTIMIZERS UFREMAINDER2 UFREMAINDER)
|
||||
(FNS UFREMAINDER)
|
||||
(VARS UNBOXEDOPSCOMS)
|
||||
(FILECREATED "18-Feb-2026 16:17:02" {WMEDLEY}<lispusers>UNBOXEDOPS.;2 10856
|
||||
|
||||
previous date%: " 3-Nov-86 20:30:24" {ERIS}<LISPUSERS>LISPCORE>UNBOXEDOPS.;6)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE " 7-Dec-86 17:26:23" {WMEDLEY}<lispusers>UNBOXEDOPS.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1986 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT UNBOXEDOPSCOMS)
|
||||
|
||||
(RPAQQ UNBOXEDOPSCOMS
|
||||
(RPAQQ UNBOXEDOPSCOMS
|
||||
[(FNS UFABS UFEQP UFGEQ UFGREATERP UFIX UFLEQ UFLESSP UFMAX UFMIN UFMINUS UFREMAINDER)
|
||||
(OPTIMIZERS UFABS UFABS1 UFEQP UFEQP2 UFGEQ UFGEQ2 UFGREATERP UFGREATERP2 UFIX UFIX1 UFLEQ
|
||||
UFLEQ2 UFLESSP UFLESSP2 UFMAX UFMAX2 UFMIN UFMIN2 UFMINUS UFMINUS1 UFREMAINDER)
|
||||
@@ -81,178 +76,168 @@ Copyright (c) 1986 by Xerox Corporation. All rights reserved.
|
||||
FY])
|
||||
)
|
||||
|
||||
(DEFOPTIMIZER UFABS (&OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
&REST RESTARGS &WHOLE ORIGINAL) (if (OR (NOT ARG1GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T
|
||||
"Illegal args to UFABS" %,
|
||||
%, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFABS1 ARG1))
|
||||
(DEFOPTIMIZER UFABS (&OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
&REST RESTARGS &WHOLE ORIGINAL)
|
||||
(if (OR (NOT ARG1GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFABS" %, %, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFABS1 ARG1))
|
||||
|
||||
(DEFOPTIMIZER UFABS1 (X)
|
||||
`[\FLOATBOX ((OPCODES UBFLOAT1 2)
|
||||
(\FLOATUNBOX ,X])
|
||||
|
||||
(DEFOPTIMIZER UFABS1 (X) `[\FLOATBOX ((OPCODES UBFLOAT1 2)
|
||||
(\FLOATUNBOX ,X])
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFEQP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(DEFOPTIMIZER UFEQP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(ARG2 NIL ARG2GIVEN)
|
||||
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFEQP" %, %,
|
||||
ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFEQP2 ARG1 ARG2))
|
||||
&REST RESTARGS)
|
||||
(if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFEQP" %, %, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFEQP2 ARG1 ARG2))
|
||||
|
||||
(DEFOPTIMIZER UFEQP2 (X Y)
|
||||
`(EQ (\FLOATUNBOX (FDIFFERENCE ,X ,Y))
|
||||
NIL))
|
||||
|
||||
(DEFOPTIMIZER UFEQP2 (X Y) `(EQ (\FLOATUNBOX (FDIFFERENCE ,X ,Y))
|
||||
NIL))
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFGEQ (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(DEFOPTIMIZER UFGEQ (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(ARG2 NIL ARG2GIVEN)
|
||||
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFGEQ" %, %,
|
||||
ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFGEQ2 ARG1 ARG2))
|
||||
&REST RESTARGS)
|
||||
(if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFGEQ" %, %, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFGEQ2 ARG1 ARG2))
|
||||
|
||||
(DEFOPTIMIZER UFGEQ2 (X Y)
|
||||
`[NOT ((OPCODES SWAP UBFLOAT2 5)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y])
|
||||
|
||||
(DEFOPTIMIZER UFGEQ2 (X Y) `[NOT ((OPCODES SWAP UBFLOAT2 5)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y])
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFGREATERP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(DEFOPTIMIZER UFGREATERP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(ARG2 NIL ARG2GIVEN)
|
||||
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFGREATERP" %,
|
||||
%, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFGREATERP2 ARG1 ARG2))
|
||||
&REST RESTARGS)
|
||||
(if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFGREATERP" %, %, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFGREATERP2 ARG1 ARG2))
|
||||
|
||||
(DEFOPTIMIZER UFGREATERP2 (X Y)
|
||||
`((OPCODES UBFLOAT2 5)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y)))
|
||||
|
||||
(DEFOPTIMIZER UFGREATERP2 (X Y) `((OPCODES UBFLOAT2 5)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y)))
|
||||
(DEFOPTIMIZER UFIX (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
&REST RESTARGS)
|
||||
(if (OR (NOT ARG1GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFIX" %, %, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFIX1 ARG1))
|
||||
|
||||
(DEFOPTIMIZER UFIX1 (X)
|
||||
`((OPCODES UBFLOAT1 4)
|
||||
(\FLOATUNBOX ,X)))
|
||||
|
||||
(DEFOPTIMIZER UFIX (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFIX" %, %, ORIGINAL
|
||||
T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFIX1 ARG1))
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFIX1 (X) `((OPCODES UBFLOAT1 4)
|
||||
(\FLOATUNBOX ,X)))
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFLEQ (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(DEFOPTIMIZER UFLEQ (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(ARG2 NIL ARG2GIVEN)
|
||||
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFLEQ" %, %,
|
||||
ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFLEQ2 ARG1 ARG2))
|
||||
&REST RESTARGS)
|
||||
(if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFLEQ" %, %, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFLEQ2 ARG1 ARG2))
|
||||
|
||||
(DEFOPTIMIZER UFLEQ2 (X Y)
|
||||
`[NOT ((OPCODES UBFLOAT2 5)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y])
|
||||
|
||||
(DEFOPTIMIZER UFLEQ2 (X Y) `[NOT ((OPCODES UBFLOAT2 5)
|
||||
(DEFOPTIMIZER UFLESSP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(ARG2 NIL ARG2GIVEN)
|
||||
&REST RESTARGS)
|
||||
(if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFLESSP" %, %, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFLESSP2 ARG1 ARG2))
|
||||
|
||||
(DEFOPTIMIZER UFLESSP2 (X Y)
|
||||
`((OPCODES SWAP UBFLOAT2 5)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y)))
|
||||
|
||||
(DEFOPTIMIZER UFMAX (&OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(ARG2 NIL ARG2GIVEN)
|
||||
&REST RESTARGS)
|
||||
(if (NOT ARG1GIVEN)
|
||||
then 'MIN.FLOAT
|
||||
elseif (NOT ARG2GIVEN)
|
||||
then `(FLOAT %, ARG1)
|
||||
elseif RESTARGS
|
||||
then `(UFMAX (UFMAX2 %, ARG1 %, ARG2)
|
||||
., RESTARGS)
|
||||
else (LIST 'UFMAX2 ARG1 ARG2)))
|
||||
|
||||
(DEFOPTIMIZER UFMAX2 (X Y)
|
||||
`[\FLOATBOX ((OPCODES UBFLOAT2 6)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y])
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFLESSP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(ARG2 NIL ARG2GIVEN)
|
||||
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
|
||||
(NOT ARG2GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFLESSP" %, %,
|
||||
ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFLESSP2 ARG1 ARG2))
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFLESSP2 (X Y) `((OPCODES SWAP UBFLOAT2 5)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y)))
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFMAX (&OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(DEFOPTIMIZER UFMIN (&OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(ARG2 NIL ARG2GIVEN)
|
||||
&REST RESTARGS) (if (NOT ARG1GIVEN)
|
||||
then 'MIN.FLOAT
|
||||
elseif (NOT ARG2GIVEN)
|
||||
then `(FLOAT %, ARG1)
|
||||
elseif RESTARGS
|
||||
then `(UFMAX (UFMAX2 %, ARG1 %, ARG2)
|
||||
., RESTARGS)
|
||||
else (LIST 'UFMAX2 ARG1 ARG2)))
|
||||
&REST RESTARGS)
|
||||
(if (NOT ARG1GIVEN)
|
||||
then 'MAX.FLOAT
|
||||
elseif (NOT ARG2GIVEN)
|
||||
then `(FLOAT %, ARG1)
|
||||
elseif RESTARGS
|
||||
then `(UFMIN (UFMIN2 %, ARG1 %, ARG2)
|
||||
., RESTARGS)
|
||||
else (LIST 'UFMIN2 ARG1 ARG2)))
|
||||
|
||||
(DEFOPTIMIZER UFMIN2 (X Y)
|
||||
`[\FLOATBOX ((OPCODES UBFLOAT2 7)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y])
|
||||
|
||||
(DEFOPTIMIZER UFMAX2 (X Y) `[\FLOATBOX ((OPCODES UBFLOAT2 6)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y])
|
||||
(DEFOPTIMIZER UFMINUS (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
&REST RESTARGS)
|
||||
(if (OR (NOT ARG1GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFMINUS" %, %, ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFMINUS1 ARG1))
|
||||
|
||||
(DEFOPTIMIZER UFMINUS1 (X)
|
||||
`[\FLOATBOX ((OPCODES UBFLOAT1 3)
|
||||
(\FLOATUNBOX ,X])
|
||||
|
||||
(DEFOPTIMIZER UFMIN (&OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
(ARG2 NIL ARG2GIVEN)
|
||||
&REST RESTARGS) (if (NOT ARG1GIVEN)
|
||||
then 'MAX.FLOAT
|
||||
elseif (NOT ARG2GIVEN)
|
||||
then `(FLOAT %, ARG1)
|
||||
elseif RESTARGS
|
||||
then `(UFMIN (UFMIN2 %, ARG1 %, ARG2)
|
||||
., RESTARGS)
|
||||
else (LIST 'UFMIN2 ARG1 ARG2)))
|
||||
(DEFOPTIMIZER UFREMAINDER (X Y)
|
||||
(CL:IF (AND (OR (CL:CONSTANTP X)
|
||||
(CL:SYMBOLP X))
|
||||
(OR (CL:CONSTANTP Y)
|
||||
(CL:SYMBOLP Y)))
|
||||
`(FDIFFERENCE ,X (FTIMES [FLOAT (UFIX (FQUOTIENT ,X ,Y]
|
||||
,Y))
|
||||
'COMPILER:PASS))
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFMIN2 (X Y) `[\FLOATBOX ((OPCODES UBFLOAT2 7)
|
||||
(\FLOATUNBOX ,X)
|
||||
(\FLOATUNBOX ,Y])
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFMINUS (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
|
||||
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
|
||||
RESTARGS)
|
||||
then (PRINTOUT T "************" T)
|
||||
(PRINTOUT T "Illegal args to UFMINUS" %, %,
|
||||
ORIGINAL T)
|
||||
(PRINTOUT T "************" T))
|
||||
(LIST 'UFMINUS1 ARG1))
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFMINUS1 (X) `[\FLOATBOX ((OPCODES UBFLOAT1 3)
|
||||
(\FLOATUNBOX ,X])
|
||||
|
||||
|
||||
(DEFOPTIMIZER UFREMAINDER (X Y) (CL:IF (AND (OR (CL:CONSTANTP X)
|
||||
(CL:SYMBOLP X))
|
||||
(OR (CL:CONSTANTP Y)
|
||||
(CL:SYMBOLP Y)))
|
||||
`(FDIFFERENCE ,X (FTIMES [FLOAT (UFIX (FQUOTIENT ,X
|
||||
,Y]
|
||||
,Y))
|
||||
'COMPILER:PASS))
|
||||
|
||||
|
||||
(PUTPROPS UNBOXEDOPS FILETYPE CL:COMPILE-FILE)
|
||||
(PUTPROPS UNBOXEDOPS FILETYPE CL:COMPILE-FILE)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -267,9 +252,8 @@ Copyright (c) 1986 by Xerox Corporation. All rights reserved.
|
||||
|
||||
(ADDTOVAR LAMA UFMIN UFMAX)
|
||||
)
|
||||
(PUTPROPS UNBOXEDOPS COPYRIGHT ("Xerox Corporation" 1986))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1185 3385 (UFABS 1195 . 1316) (UFEQP 1318 . 1441) (UFGEQ 1443 . 1565) (UFGREATERP 1567
|
||||
. 1700) (UFIX 1702 . 1821) (UFLEQ 1823 . 1945) (UFLESSP 1947 . 2074) (UFMAX 2076 . 2478) (UFMIN 2480
|
||||
. 2879) (UFMINUS 2881 . 3006) (UFREMAINDER 3008 . 3383)))))
|
||||
(FILEMAP (NIL (983 3183 (UFABS 993 . 1114) (UFEQP 1116 . 1239) (UFGEQ 1241 . 1363) (UFGREATERP 1365 .
|
||||
1498) (UFIX 1500 . 1619) (UFLEQ 1621 . 1743) (UFLESSP 1745 . 1872) (UFMAX 1874 . 2276) (UFMIN 2278 .
|
||||
2677) (UFMINUS 2679 . 2804) (UFREMAINDER 2806 . 3181)))))
|
||||
STOP
|
||||
|
||||
BIN
lispusers/UNBOXEDOPS.DFASL
Normal file
BIN
lispusers/UNBOXEDOPS.DFASL
Normal file
Binary file not shown.
@@ -1,19 +1,17 @@
|
||||
(DEFINE-FILE-INFO §PACKAGE "INTERLISP" §READTABLE "XCL" §BASE 10)
|
||||
(filecreated "18-Dec-86 19:03:25" {eris}<lispcore>internal>library>whocalls.\;2 4500
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
|changes| |to:| (fns distribute.callinfo distribute-call-info-for-symbol)
|
||||
(vars whocallscoms)
|
||||
(FILECREATED "18-Feb-2026 16:08:45" |{WMEDLEY}<lispusers>WHOCALLS.;2| 4272
|
||||
|
||||
|previous| |date:| " 7-Nov-86 02:47:11" {eris}<lispusers>lispcore>whocalls.\;2)
|
||||
:EDIT-BY |rmk|
|
||||
|
||||
:PREVIOUS-DATE "18-Dec-86 19:03:25" |{WMEDLEY}<lispusers>WHOCALLS.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1986 by Xerox Corporation. All rights reserved.
|
||||
(PRETTYCOMPRINT WHOCALLSCOMS)
|
||||
|
||||
(prettycomprint whocallscoms)
|
||||
|
||||
(rpaqq whocallscoms ((fns whocalls whocalls1 distribute.callinfo distribute-call-info-for-symbol)
|
||||
(prop proptype calledby usedfreeby usedglobalby boundby)))
|
||||
(defineq
|
||||
(RPAQQ WHOCALLSCOMS ((FNS WHOCALLS WHOCALLS1 DISTRIBUTE.CALLINFO DISTRIBUTE-CALL-INFO-FOR-SYMBOL)
|
||||
(PROP PROPTYPE CALLEDBY USEDFREEBY USEDGLOBALBY BOUNDBY)))
|
||||
(DEFINEQ
|
||||
|
||||
(WHOCALLS
|
||||
(LAMBDA (CALLEE USAGE)
|
||||
@@ -78,15 +76,14 @@
|
||||
x))))))
|
||||
)
|
||||
|
||||
(putprops calledby proptype ignore)
|
||||
(PUTPROPS CALLEDBY PROPTYPE IGNORE)
|
||||
|
||||
(putprops usedfreeby proptype ignore)
|
||||
(PUTPROPS USEDFREEBY PROPTYPE IGNORE)
|
||||
|
||||
(putprops usedglobalby proptype ignore)
|
||||
(PUTPROPS USEDGLOBALBY PROPTYPE IGNORE)
|
||||
|
||||
(putprops boundby proptype ignore)
|
||||
(putprops whocalls copyright ("Xerox Corporation" 1986))
|
||||
(declare\: dontcopy
|
||||
(filemap (nil (653 4251 (whocalls 663 . 2057) (whocalls1 2059 . 3191) (distribute.callinfo 3193 . 3419
|
||||
) (distribute-call-info-for-symbol 3421 . 4249)))))
|
||||
stop
|
||||
(PUTPROPS BOUNDBY PROPTYPE IGNORE)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (466 4064 (WHOCALLS 476 . 1870) (WHOCALLS1 1872 . 3004) (DISTRIBUTE.CALLINFO 3006 . 3232
|
||||
) (DISTRIBUTE-CALL-INFO-FOR-SYMBOL 3234 . 4062)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,14 +1,11 @@
|
||||
(DEFINE-FILE-INFO §PACKAGE "INTERLISP" §READTABLE "INTERLISP" §BASE 10)
|
||||
(FILECREATED "22-Dec-86 18:42:34" {ERIS}<LISPUSERS>LISPCORE>COMPILEBANG.;3 3465
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (FNS COMPILE!)
|
||||
(FILECREATED "18-Feb-2026 16:23:37" {WMEDLEY}<lispusers>compilebang.;2 3232
|
||||
|
||||
previous date%: "18-Nov-86 22:23:43" {ERIS}<LISPUSERS>LISPCORE>COMPILEBANG.;2)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "22-Dec-86 18:42:34" {WMEDLEY}<lispusers>compilebang.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1982, 1983, 1984, 1986 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT COMPILEBANGCOMS)
|
||||
|
||||
@@ -63,23 +60,22 @@ Copyright (c) 1982, 1983, 1984, 1986 by Xerox Corporation. All rights reserved.
|
||||
NIL NIL T))
|
||||
(T C))))
|
||||
|
||||
(ADDTOVAR USERMACROS [C NIL (ORR (UP 1)
|
||||
NIL)
|
||||
(ORR ((E (COMPILE! (OR (LISTP (%##))
|
||||
(%## !0))
|
||||
T T T)))
|
||||
((E 'C?])
|
||||
(ADDTOVAR USERMACROS
|
||||
[C NIL (ORR (UP 1)
|
||||
NIL)
|
||||
(ORR ((E (COMPILE! (OR (LISTP (%##))
|
||||
(%## !0))
|
||||
T T T)))
|
||||
((E 'C?])
|
||||
|
||||
(ADDTOVAR EDITCOMSA C)
|
||||
|
||||
(DEFCOMMAND (C :EVAL) (&REST LISPXLINE) (COND
|
||||
(LISPXLINE (COMPILE! (CAR LISPXLINE)
|
||||
(DEFCOMMAND (C :EVAL) (&REST LISPXLINE) (COND
|
||||
(LISPXLINE (COMPILE! (CAR LISPXLINE)
|
||||
NIL NIL T))
|
||||
(T C)))
|
||||
|
||||
|
||||
(PUTPROPS COMPILEBANG FILETYPE CL:COMPILE-FILE)
|
||||
(PUTPROPS COMPILEBANG COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1986))
|
||||
(PUTPROPS COMPILEBANG FILETYPE CL:COMPILE-FILE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (622 2567 (COMPILE! 632 . 2565)))))
|
||||
(FILEMAP (NIL (506 2451 (COMPILE! 516 . 2449)))))
|
||||
STOP
|
||||
|
||||
107
sources/FONT
107
sources/FONT
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 6-Feb-2026 23:44:25" {WMEDLEY}<sources>FONT.;671 276511
|
||||
(FILECREATED "19-Feb-2026 00:10:22" {WMEDLEY}<sources>FONT.;674 277477
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \FINDFONTFILE)
|
||||
:CHANGES-TO (FNS \FONT.CHECKARGS1)
|
||||
|
||||
:PREVIOUS-DATE " 6-Feb-2026 00:24:55" {WMEDLEY}<sources>FONT.;670)
|
||||
:PREVIOUS-DATE "14-Feb-2026 13:14:08" {WMEDLEY}<sources>FONT.;673)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT FONTCOMS)
|
||||
@@ -608,7 +608,8 @@
|
||||
FONTDESC])
|
||||
|
||||
(\FONT.CHECKARGS1
|
||||
[LAMBDA (SPEC STREAM NOERRORFLG) (* ; "Edited 22-Jul-2025 18:47 by rmk")
|
||||
[LAMBDA (SPEC STREAM NOERRORFLG) (* ; "Edited 19-Feb-2026 00:03 by rmk")
|
||||
(* ; "Edited 22-Jul-2025 18:47 by rmk")
|
||||
(* ; "Edited 14-Jul-2025 19:40 by rmk")
|
||||
(* ; "Edited 5-Jul-2025 14:16 by rmk")
|
||||
(* ; "Edited 29-Aug-91 12:19 by jds")
|
||||
@@ -620,6 +621,8 @@
|
||||
(* ;; "STREAM denotes a device: NIL means DISPLAY, another atom is a device name itself, an IMAGESTREAM means its IMAGESTREAMTYPE. Anything else here maps to DISPLAY, but maybe that should be an illegal arg error, even of NOERRORFLG.")
|
||||
|
||||
(DECLARE (GLOBALVARS DEFAULTFONT \GUARANTEEDDISPLAYFONT))
|
||||
(CL:WHEN (IMAGESTREAMP SPEC)
|
||||
(SETQ SPEC (DSPFONT NIL SPEC)))
|
||||
(LET (FONT DEVICE TEMP)
|
||||
(CL:UNLESS SPEC
|
||||
(if DEFAULTFONT
|
||||
@@ -703,7 +706,8 @@
|
||||
(CLOSEF? STRM))))])
|
||||
|
||||
(\READCHARSET
|
||||
[LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 6-Feb-2026 00:03 by rmk")
|
||||
[LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 14-Feb-2026 09:47 by rmk")
|
||||
(* ; "Edited 6-Feb-2026 00:03 by rmk")
|
||||
(* ; "Edited 11-Nov-2025 14:30 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 23:57 by rmk")
|
||||
(* ; "Edited 28-Aug-2025 23:17 by rmk")
|
||||
@@ -723,7 +727,8 @@
|
||||
do
|
||||
(* ;; "We know that FILE exists and is the best source of information about charset--maybe none. We assume FILE is one of the valid formats, we open it separately for each format-type, and ensure it is closed on exit. We can't used CL:WITHOPEN-FILE because that doesn't exist in the loadup when the first font is created.")
|
||||
|
||||
(for FNS FAMILY in (FONTDEVICEPROP FONTSPEC 'CHARSETFNS)
|
||||
(for FNS FAMILY in [OR (FONTDEVICEPROP FONTSPEC 'CHARSETFNS)
|
||||
'((MEDLEYFONT MEDLEYFONT.FILEP MEDLEYFONT.GETCHARSET]
|
||||
do [RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT))
|
||||
`(PROGN (CLOSEF? OLDVALUE]
|
||||
(CL:WHEN (CAR (NLSETQ (APPLY* (CADR FNS)
|
||||
@@ -3496,7 +3501,8 @@
|
||||
FONT])
|
||||
|
||||
(\CREATECHARSET
|
||||
[LAMBDA (CHARSET FONT) (* ; "Edited 25-Sep-2025 21:24 by rmk")
|
||||
[LAMBDA (CHARSET FONT) (* ; "Edited 14-Feb-2026 13:12 by rmk")
|
||||
(* ; "Edited 25-Sep-2025 21:24 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 22:59 by rmk")
|
||||
(* ; "Edited 31-Aug-2025 14:36 by rmk")
|
||||
(* ; "Edited 28-Aug-2025 14:31 by rmk")
|
||||
@@ -3525,11 +3531,16 @@
|
||||
(\ILLEGAL.ARG CHARSET))
|
||||
(LET [(CSINFO (if (fetch (FONTDESCRIPTOR FONTCOMPLETEP) of FONT)
|
||||
then (\GETCHARSETINFO FONT CHARSET)
|
||||
else (APPLY* (OR (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTDESCRIPTOR
|
||||
else (APPLY* [OR (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTDESCRIPTOR
|
||||
FONTDEVICE)
|
||||
of FONT)
|
||||
'CREATECHARSET))
|
||||
(FUNCTION \READCHARSET))
|
||||
(FUNCTION (LAMBDA (FONTSPEC FONT CHARSET)
|
||||
(* ;
|
||||
"No function: read or read-coerced-font")
|
||||
(OR (\READCHARSET FONTSPEC CHARSET FONT)
|
||||
(\READCHARSET (COERCEFONTSPEC FONTSPEC)
|
||||
CHARSET FONT]
|
||||
(create FONTSPEC using (FONTPROP FONT 'DEVICESPEC))
|
||||
FONT CHARSET]
|
||||
|
||||
@@ -4485,43 +4496,43 @@
|
||||
(ADDTOVAR LAMA FONTCOPY)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (11414 21127 (CHARWIDTH 11424 . 12209) (CHARWIDTHY 12211 . 13728) (STRINGWIDTH 13730 .
|
||||
14823) (\CHARWIDTH.DISPLAY 14825 . 15238) (\STRINGWIDTH.DISPLAY 15240 . 15664) (\STRINGWIDTH.GENERIC
|
||||
15666 . 21125)) (21128 27648 (DEFAULTFONT 21138 . 22423) (FONTCLASS 22425 . 24587) (FONTCLASSUNPARSE
|
||||
24589 . 25488) (FONTCLASSCOMPONENT 25490 . 26078) (SETFONTCLASSCOMPONENT 26080 . 26522) (
|
||||
GETFONTCLASSCOMPONENT 26524 . 27646)) (29361 46989 (FONTCREATE 29371 . 32616) (FONTCREATE1 32618 .
|
||||
35233) (FONTCREATE.SLUGFD 35235 . 36717) (\FONT.CHECKARGS1 36719 . 41242) (\FONTCREATE1.NOFN 41244 .
|
||||
41458) (FONTFILEP 41460 . 42348) (\READCHARSET 42350 . 46987)) (46990 54066 (\FONT.CHECKARGS 47000 .
|
||||
53749) (\CHARSET.CHECK 53751 . 54064)) (54067 60678 (COERCEFONTSPEC 54077 . 59989) (
|
||||
COERCEFONTSPEC.TARGETFACE 59991 . 60676)) (62873 64212 (MAKEFONTSPEC 62883 . 64210)) (64213 72390 (
|
||||
COMPLETE.FONT 64223 . 66746) (COMPLETEFONTP 66748 . 67371) (COMPLETE.CHARSET 67373 . 70058) (
|
||||
PRUNESLUGCSINFOS 70060 . 70985) (MONOSPACEFONTP 70987 . 72388)) (72429 80875 (FONTASCENT 72439 . 72823
|
||||
) (FONTDESCENT 72825 . 73310) (FONTHEIGHT 73312 . 73714) (FONTPROP 73716 . 80152) (\AVGCHARWIDTH 80154
|
||||
. 80873)) (81532 82440 (FONTDEVICEPROP 81542 . 82438)) (82486 83340 (EDITCHAR 82496 . 83338)) (83386
|
||||
95576 (GETCHARBITMAP 83396 . 84520) (PUTCHARBITMAP 84522 . 86680) (\GETCHARBITMAP.CSINFO 86682 . 88698
|
||||
) (\PUTCHARBITMAP.CSINFO 88700 . 95574)) (95577 116057 (MOVECHARBITMAP 95587 . 97481) (MOVEFONTCHARS
|
||||
97483 . 101443) (\MOVEFONTCHAR 101445 . 106288) (\MOVEFONTCHARS.SOURCEDATA 106290 . 112395) (
|
||||
\MAKESLUGCHAR 112397 . 114932) (SLUGCHARP.DISPLAY 114934 . 116055)) (116715 128552 (FONTFILES 116725
|
||||
. 118558) (\FINDFONTFILE 118560 . 120537) (\FONTFILENAMES 120539 . 121099) (\FONTFILENAME 121101 .
|
||||
124012) (FONTSPECFROMFILENAME 124014 . 128550)) (128553 165128 (FONTCOPY 128563 . 133626) (FONTP
|
||||
133628 . 133927) (FONTUNPARSE 133929 . 135648) (SETFONTDESCRIPTOR 135650 . 137114) (\STREAMCHARWIDTH
|
||||
137116 . 141280) (\COERCECHARSET 141282 . 144649) (\BUILDSLUGCSINFO 144651 . 148274) (\FONTSYMBOL
|
||||
148276 . 148926) (\DEVICESYMBOL 148928 . 149797) (\FONTFACE 149799 . 156989) (\FONTFACE.COLOR 156991
|
||||
. 163911) (SETFONTCHARENCODING 163913 . 165126)) (165129 184790 (FONTSAVAILABLE 165139 . 170493) (
|
||||
FONTEXISTS? 170495 . 174034) (\SEARCHFONTFILES 174036 . 177121) (FLUSHFONTCACHE 177123 . 179346) (
|
||||
FINDFONTFILES 179348 . 182562) (SORTFONTSPECS 182564 . 184788)) (184791 188898 (MATCHFONTFACE 184801
|
||||
. 185616) (MAKEFONTFACE 185618 . 186644) (FONTFACETOATOM 186646 . 188896)) (189529 190021 (
|
||||
\UNITWIDTHSVECTOR 189539 . 190019)) (204650 206717 (FONTDESCRIPTOR.DEFPRINT 204660 . 206239) (
|
||||
FONTCLASS.DEFPRINT 206241 . 206715)) (210546 213336 (\CREATEKERNELEMENT 210556 . 210914) (
|
||||
\FSETLEFTKERN 210916 . 211407) (\FGETLEFTKERN 211409 . 213334)) (213337 224412 (\CREATEFONT 213347 .
|
||||
216225) (\CREATECHARSET 216227 . 220163) (\INSTALLCHARSETINFO 220165 . 223499) (
|
||||
\INSTALLCHARSETINFO.CHARENCODING 223501 . 224410)) (224734 226098 (\FONTRESETCHARWIDTHS 224744 .
|
||||
226096)) (226728 236769 (\CREATEDISPLAYFONT 226738 . 228587) (\CREATECHARSET.DISPLAY 228589 . 234298)
|
||||
(\FONTEXISTS?.DISPLAY 234300 . 236767)) (236770 251635 (STRIKEFONT.FILEP 236780 . 237668) (
|
||||
STRIKEFONT.GETCHARSET 237670 . 243262) (WRITESTRIKEFONTFILE 243264 . 248175) (STRIKECSINFO 248177 .
|
||||
251633)) (251666 267983 (MAKEBOLD.CHARSET 251676 . 255325) (MAKEBOLD.CHAR 255327 . 257079) (
|
||||
MAKEITALIC.CHARSET 257081 . 260754) (MAKEITALIC.CHAR 260756 . 263102) (\SFMAKEBOLD 263104 . 265328) (
|
||||
\SFMAKEITALIC 265330 . 267981)) (267984 272133 (\SFMAKEROTATEDFONT 267994 . 269395) (\SFROTATECSINFO
|
||||
269397 . 270034) (\SFROTATEFONTCHARACTERS 270036 . 270416) (\SFROTATECSINFOOFFSETS 270418 . 272131)) (
|
||||
272134 273515 (\SFMAKECOLOR 272144 . 273513)))))
|
||||
(FILEMAP (NIL (11417 21130 (CHARWIDTH 11427 . 12212) (CHARWIDTHY 12214 . 13731) (STRINGWIDTH 13733 .
|
||||
14826) (\CHARWIDTH.DISPLAY 14828 . 15241) (\STRINGWIDTH.DISPLAY 15243 . 15667) (\STRINGWIDTH.GENERIC
|
||||
15669 . 21128)) (21131 27651 (DEFAULTFONT 21141 . 22426) (FONTCLASS 22428 . 24590) (FONTCLASSUNPARSE
|
||||
24592 . 25491) (FONTCLASSCOMPONENT 25493 . 26081) (SETFONTCLASSCOMPONENT 26083 . 26525) (
|
||||
GETFONTCLASSCOMPONENT 26527 . 27649)) (29364 47382 (FONTCREATE 29374 . 32619) (FONTCREATE1 32621 .
|
||||
35236) (FONTCREATE.SLUGFD 35238 . 36720) (\FONT.CHECKARGS1 36722 . 41427) (\FONTCREATE1.NOFN 41429 .
|
||||
41643) (FONTFILEP 41645 . 42533) (\READCHARSET 42535 . 47380)) (47383 54459 (\FONT.CHECKARGS 47393 .
|
||||
54142) (\CHARSET.CHECK 54144 . 54457)) (54460 61071 (COERCEFONTSPEC 54470 . 60382) (
|
||||
COERCEFONTSPEC.TARGETFACE 60384 . 61069)) (63266 64605 (MAKEFONTSPEC 63276 . 64603)) (64606 72783 (
|
||||
COMPLETE.FONT 64616 . 67139) (COMPLETEFONTP 67141 . 67764) (COMPLETE.CHARSET 67766 . 70451) (
|
||||
PRUNESLUGCSINFOS 70453 . 71378) (MONOSPACEFONTP 71380 . 72781)) (72822 81268 (FONTASCENT 72832 . 73216
|
||||
) (FONTDESCENT 73218 . 73703) (FONTHEIGHT 73705 . 74107) (FONTPROP 74109 . 80545) (\AVGCHARWIDTH 80547
|
||||
. 81266)) (81925 82833 (FONTDEVICEPROP 81935 . 82831)) (82879 83733 (EDITCHAR 82889 . 83731)) (83779
|
||||
95969 (GETCHARBITMAP 83789 . 84913) (PUTCHARBITMAP 84915 . 87073) (\GETCHARBITMAP.CSINFO 87075 . 89091
|
||||
) (\PUTCHARBITMAP.CSINFO 89093 . 95967)) (95970 116450 (MOVECHARBITMAP 95980 . 97874) (MOVEFONTCHARS
|
||||
97876 . 101836) (\MOVEFONTCHAR 101838 . 106681) (\MOVEFONTCHARS.SOURCEDATA 106683 . 112788) (
|
||||
\MAKESLUGCHAR 112790 . 115325) (SLUGCHARP.DISPLAY 115327 . 116448)) (117108 128945 (FONTFILES 117118
|
||||
. 118951) (\FINDFONTFILE 118953 . 120930) (\FONTFILENAMES 120932 . 121492) (\FONTFILENAME 121494 .
|
||||
124405) (FONTSPECFROMFILENAME 124407 . 128943)) (128946 165521 (FONTCOPY 128956 . 134019) (FONTP
|
||||
134021 . 134320) (FONTUNPARSE 134322 . 136041) (SETFONTDESCRIPTOR 136043 . 137507) (\STREAMCHARWIDTH
|
||||
137509 . 141673) (\COERCECHARSET 141675 . 145042) (\BUILDSLUGCSINFO 145044 . 148667) (\FONTSYMBOL
|
||||
148669 . 149319) (\DEVICESYMBOL 149321 . 150190) (\FONTFACE 150192 . 157382) (\FONTFACE.COLOR 157384
|
||||
. 164304) (SETFONTCHARENCODING 164306 . 165519)) (165522 185183 (FONTSAVAILABLE 165532 . 170886) (
|
||||
FONTEXISTS? 170888 . 174427) (\SEARCHFONTFILES 174429 . 177514) (FLUSHFONTCACHE 177516 . 179739) (
|
||||
FINDFONTFILES 179741 . 182955) (SORTFONTSPECS 182957 . 185181)) (185184 189291 (MATCHFONTFACE 185194
|
||||
. 186009) (MAKEFONTFACE 186011 . 187037) (FONTFACETOATOM 187039 . 189289)) (189922 190414 (
|
||||
\UNITWIDTHSVECTOR 189932 . 190412)) (205043 207110 (FONTDESCRIPTOR.DEFPRINT 205053 . 206632) (
|
||||
FONTCLASS.DEFPRINT 206634 . 207108)) (210939 213729 (\CREATEKERNELEMENT 210949 . 211307) (
|
||||
\FSETLEFTKERN 211309 . 211800) (\FGETLEFTKERN 211802 . 213727)) (213730 225378 (\CREATEFONT 213740 .
|
||||
216618) (\CREATECHARSET 216620 . 221129) (\INSTALLCHARSETINFO 221131 . 224465) (
|
||||
\INSTALLCHARSETINFO.CHARENCODING 224467 . 225376)) (225700 227064 (\FONTRESETCHARWIDTHS 225710 .
|
||||
227062)) (227694 237735 (\CREATEDISPLAYFONT 227704 . 229553) (\CREATECHARSET.DISPLAY 229555 . 235264)
|
||||
(\FONTEXISTS?.DISPLAY 235266 . 237733)) (237736 252601 (STRIKEFONT.FILEP 237746 . 238634) (
|
||||
STRIKEFONT.GETCHARSET 238636 . 244228) (WRITESTRIKEFONTFILE 244230 . 249141) (STRIKECSINFO 249143 .
|
||||
252599)) (252632 268949 (MAKEBOLD.CHARSET 252642 . 256291) (MAKEBOLD.CHAR 256293 . 258045) (
|
||||
MAKEITALIC.CHARSET 258047 . 261720) (MAKEITALIC.CHAR 261722 . 264068) (\SFMAKEBOLD 264070 . 266294) (
|
||||
\SFMAKEITALIC 266296 . 268947)) (268950 273099 (\SFMAKEROTATEDFONT 268960 . 270361) (\SFROTATECSINFO
|
||||
270363 . 271000) (\SFROTATEFONTCHARACTERS 271002 . 271382) (\SFROTATECSINFOOFFSETS 271384 . 273097)) (
|
||||
273100 274481 (\SFMAKECOLOR 273110 . 274479)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user