diff --git a/.github/ISSUE_TEMPLATE/primer.yml b/.github/ISSUE_TEMPLATE/primer.yml new file mode 100644 index 00000000..9fea67a1 --- /dev/null +++ b/.github/ISSUE_TEMPLATE/primer.yml @@ -0,0 +1,68 @@ +name: Report an issue with the "Medley Interlisp for the Newcomer" primer +description: Use this template to report issues or make suggestions. +title: "[Primer] " +labels: + - primer + - documentation +body: + - type: dropdown + id: problemType + attributes: + label: "What type of issue are you reporting?" + options: + - Suggested improvement + - Incorrect explanation / code sample + - Confusing explanation + - Outdated information + - Broken link + - Typo / Grammar + validations: + required: true + - type: dropdown + id: location + attributes: + label: "Section of the primer where the issue occurs" + options: + - Introduction + - Medley online and Medley Local + - Understanding and Navigating the Interface + - Understanding Lisp Syntax + - Atoms, Functions and Lists + - Variable Bindings and Scope + - Iterators and Conditionals + - The File Browser + - Debugging + - Editing functions with SEdit + - Build Your First Interactive Program + - Saving Your Work + - TEdit, The WYSIWYG Editor + - Drawing and Displaystreams + - Making a Graph with Grapher + - Additional Resources + - General Feedback (not specific to a section) + validations: + required: true + - type: textarea + id: issueLocationDetails + attributes: + label: "Please provide more details about the location of the issue" + description: "For example, the specific page title, section heading, or url." + validations: + required: false + - type: textarea + id: issueDescription + attributes: + label: "Description of the issue" + description: "Please provide a detailed description of the issue you encountered." + validations: + required: true + - type: textarea + id: suggestedFix + attributes: + label: "Suggested fix or improvement" + description: "If you have a suggestion for how to fix or improve the issue, please provide it here." + validations: + required: false + - type: markdown + attributes: + value: "## Thank you for helping us improve the **Medley Interlisp for the Newcomer** primer!" \ No newline at end of file diff --git a/.github/ISSUE_TEMPLATE/what_people_are_saying.yml b/.github/ISSUE_TEMPLATE/what_people_are_saying.yml index f4ccb337..c3826748 100644 --- a/.github/ISSUE_TEMPLATE/what_people_are_saying.yml +++ b/.github/ISSUE_TEMPLATE/what_people_are_saying.yml @@ -1,6 +1,6 @@ -name: "New entry for **What People Are Saying**" -description: "Suggest a new entry for the **What People are Saying** page" -title: "What People are Saying suggestion" +name: New "What People Are Saying" entry +description: 'Suggest a new entry for the "What People Are Saying" page' +title: "What People Are Saying suggestion" body: - type: dropdown id: contentType @@ -24,7 +24,7 @@ body: id: additionalInformation attributes: label: Additional information - description: "Use this space to supply any addiitonal information on the suggested item." + description: "Use this space to supply any additional information on the suggested item." validations: required: false - type: markdown diff --git a/.gitignore b/.gitignore index 1434e477..9d7492cd 100644 --- a/.gitignore +++ b/.gitignore @@ -31,7 +31,7 @@ loadups/whereis.hash loadups/apps.sysout loadups/fuller.database loadups/build/ -loadups/branches +loadups/tagged loadups/gitinfo diff --git a/NIL b/NIL new file mode 100644 index 00000000..299ebbab --- /dev/null +++ b/NIL @@ -0,0 +1,33 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED " 1-Nov-2025 13:41:38" {DSK}frank>il>medley>START-KINETIC.;2 1112 + + :EDIT-BY "FGH" + + :CHANGES-TO (FNS START-KINETIC) + + :PREVIOUS-DATE " 1-Nov-2025 13:21:22" {DSK}frank>il>medley>START-KINETIC.;1) + + +(PRETTYCOMPRINT START-KINETICCOMS) + +(RPAQQ START-KINETICCOMS ((FILES KINETIC) + (FNS START-KINETIC) + (P (START-KINETIC)))) + +(FILESLOAD KINETIC) +(DEFINEQ + +(START-KINETIC + [LAMBDA NIL (* ; "Edited 1-Nov-2025 13:41 by FGH") + (* ; "Edited 1-Nov-2025 13:15 by FGH") + (ADD.PROCESS '(KINETIC (CREATEW (CREATEREGION (FIX (TIMES 0.25 SCREENWIDTH)) + (FIX (TIMES 0.25 SCREENHEIGHT)) + (FIX (TIMES 0.5 SCREENWIDTH)) + (FIX (TIMES 0.5 SCREENHEIGHT]) +) + +(START-KINETIC) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (517 1068 (START-KINETIC 527 . 1066))))) +STOP diff --git a/START-KINETIC b/START-KINETIC new file mode 100644 index 00000000..299ebbab --- /dev/null +++ b/START-KINETIC @@ -0,0 +1,33 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED " 1-Nov-2025 13:41:38" {DSK}frank>il>medley>START-KINETIC.;2 1112 + + :EDIT-BY "FGH" + + :CHANGES-TO (FNS START-KINETIC) + + :PREVIOUS-DATE " 1-Nov-2025 13:21:22" {DSK}frank>il>medley>START-KINETIC.;1) + + +(PRETTYCOMPRINT START-KINETICCOMS) + +(RPAQQ START-KINETICCOMS ((FILES KINETIC) + (FNS START-KINETIC) + (P (START-KINETIC)))) + +(FILESLOAD KINETIC) +(DEFINEQ + +(START-KINETIC + [LAMBDA NIL (* ; "Edited 1-Nov-2025 13:41 by FGH") + (* ; "Edited 1-Nov-2025 13:15 by FGH") + (ADD.PROCESS '(KINETIC (CREATEW (CREATEREGION (FIX (TIMES 0.25 SCREENWIDTH)) + (FIX (TIMES 0.25 SCREENHEIGHT)) + (FIX (TIMES 0.5 SCREENWIDTH)) + (FIX (TIMES 0.5 SCREENHEIGHT]) +) + +(START-KINETIC) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (517 1068 (START-KINETIC 527 . 1066))))) +STOP diff --git a/START_KINETIC b/START_KINETIC new file mode 100644 index 00000000..2cfa7354 --- /dev/null +++ b/START_KINETIC @@ -0,0 +1,31 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "31-Oct-2025 12:36:44" {DSK}frank>il>medley>START_KINETIC.;1 897 + + :EDIT-BY "FGH" + + :CHANGES-TO (VARS START_KINETICCOMS) + (FNS START_KINETIC)) + + +(PRETTYCOMPRINT START_KINETICCOMS) + +(RPAQQ START_KINETICCOMS ((FILES KINETIC) + (FNS START_KINETIC) + (P (START-KINETIC)))) + +(FILESLOAD KINETIC) +(DEFINEQ + +(START_KINETIC + [LAMBDA NIL (* ; "Edited 31-Oct-2025 12:33 by FGH") + (KINETIC (CREATEW (CREATEREGION (FIX (TIMES 0.25 SCREENWIDTH)) + (FIX (TIMES 0.25 SCREENHEIGHT)) + (FIX (TIMES 0.5 SCREENWIDTH)) + (FIX (TIMES 0.5 SCREENHEIGHT]) +) + +(START-KINETIC) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (471 857 (START_KINETIC 481 . 855))))) +STOP diff --git a/docs/html-primer/Medley-Primer-OnePage.html b/docs/html-primer/Medley-Primer-OnePage.html deleted file mode 100644 index 162bc3f2..00000000 --- a/docs/html-primer/Medley-Primer-OnePage.html +++ /dev/null @@ -1,2 +0,0 @@ - -Medley-Primer-OnePage diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_001.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_001.png deleted file mode 100644 index 134a8b09..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_001.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_002.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_002.png deleted file mode 100644 index c1e72ae4..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_002.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_003.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_003.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_003.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_004.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_004.png deleted file mode 100644 index 33c6b56e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_004.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_005.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_005.png deleted file mode 100644 index 697cdb63..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_005.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_006.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_006.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_006.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_007.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_007.gif deleted file mode 100644 index f609c047..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_007.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_008.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_008.gif deleted file mode 100644 index 438cad57..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_008.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_009.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_009.gif deleted file mode 100644 index 0887753b..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_009.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_010.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_010.gif deleted file mode 100644 index c3a529bf..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_010.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_011.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_011.gif deleted file mode 100644 index 8725aacb..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_011.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_012.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_012.gif deleted file mode 100644 index 844b923f..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_012.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_013.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_013.gif deleted file mode 100644 index 59e164f9..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_013.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_014.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_014.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_014.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_015.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_015.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_015.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_016.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_016.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_016.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_017.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_017.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_017.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_018.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_018.gif deleted file mode 100644 index 22f74d3a..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_018.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_019.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_019.gif deleted file mode 100644 index aae710d5..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_019.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_020.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_020.gif deleted file mode 100644 index 612f7795..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_020.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_021.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_021.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_021.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_022.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_022.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_022.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_023.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_023.gif deleted file mode 100644 index 0ec8cc6f..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_023.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_024.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_024.gif deleted file mode 100644 index baf2ac0a..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_024.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_025.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_025.gif deleted file mode 100644 index fe7f1815..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_025.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_026.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_026.gif deleted file mode 100644 index 27e420ea..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_026.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_027.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_027.gif deleted file mode 100644 index 5d090470..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_027.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_028.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_028.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_028.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_029.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_029.gif deleted file mode 100644 index a93f51bf..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_029.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_030.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_030.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_030.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_031.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_031.gif deleted file mode 100644 index 16b4cd56..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_031.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_032.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_032.gif deleted file mode 100644 index ebd8aae3..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_032.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_033.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_033.gif deleted file mode 100644 index bd2a4b08..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_033.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_034.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_034.gif deleted file mode 100644 index 67de4555..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_034.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_035.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_035.gif deleted file mode 100644 index bdf5beca..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_035.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_036.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_036.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_036.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_037.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_037.gif deleted file mode 100644 index 556c7124..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_037.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_038.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_038.png deleted file mode 100644 index d52e604f..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_038.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_039.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_039.gif deleted file mode 100644 index df3899a8..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_039.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_040.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_040.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_040.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_041.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_041.gif deleted file mode 100644 index edd40961..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_041.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_042.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_042.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_042.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_043.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_043.gif deleted file mode 100644 index 1e8b4769..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_043.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_044.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_044.gif deleted file mode 100644 index fc5531af..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_044.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_045.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_045.gif deleted file mode 100644 index c2b18b41..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_045.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_046.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_046.gif deleted file mode 100644 index a613adb0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_046.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_047.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_047.gif deleted file mode 100644 index c3a529bf..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_047.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_048.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_048.gif deleted file mode 100644 index 5dbe5065..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_048.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_049.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_049.gif deleted file mode 100644 index 252b6eb2..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_049.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_050.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_050.gif deleted file mode 100644 index f91cb071..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_050.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_051.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_051.gif deleted file mode 100644 index ddefb8e8..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_051.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_052.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_052.gif deleted file mode 100644 index 7454b2a7..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_052.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_053.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_053.gif deleted file mode 100644 index d59b78d2..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_053.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_054.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_054.gif deleted file mode 100644 index 385c5fc4..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_054.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_055.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_055.gif deleted file mode 100644 index e615b3e1..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_055.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_056.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_056.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_056.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_057.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_057.gif deleted file mode 100644 index b6ca464a..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_057.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_058.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_058.gif deleted file mode 100644 index ee0b2b69..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_058.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_059.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_059.gif deleted file mode 100644 index 20d1fa14..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_059.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_060.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_060.gif deleted file mode 100644 index a8426e53..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_060.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_061.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_061.gif deleted file mode 100644 index 4f0f2560..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_061.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_062.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_062.gif deleted file mode 100644 index f1882b49..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_062.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_063.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_063.gif deleted file mode 100644 index 7057753e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_063.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_064.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_064.gif deleted file mode 100644 index 4c59b213..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_064.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_065.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_065.gif deleted file mode 100644 index b75f7480..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_065.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_066.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_066.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_066.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_067.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_067.gif deleted file mode 100644 index 5b016634..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_067.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_068.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_068.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_068.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_069.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_069.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_069.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_070.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_070.gif deleted file mode 100644 index 183033aa..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_070.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_071.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_071.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_071.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_072.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_072.gif deleted file mode 100644 index 3b4feab0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_072.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_073.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_073.gif deleted file mode 100644 index 5cefcdbc..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_073.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_074.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_074.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_074.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_075.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_075.gif deleted file mode 100644 index 2a93d4d3..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_075.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_076.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_076.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_076.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_077.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_077.gif deleted file mode 100644 index 85f00e1a..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_077.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_078.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_078.gif deleted file mode 100644 index 4a6e22a8..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_078.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_079.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_079.gif deleted file mode 100644 index d1ba0420..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_079.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_080.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_080.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_080.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_081.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_081.gif deleted file mode 100644 index c1811fa4..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_081.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_082.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_082.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_082.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_083.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_083.gif deleted file mode 100644 index f5317b73..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_083.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_084.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_084.gif deleted file mode 100644 index 5848a334..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_084.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_085.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_085.gif deleted file mode 100644 index cdc61377..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_085.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_086.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_086.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_086.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_087.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_087.gif deleted file mode 100644 index 52c7bcfd..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_087.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_088.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_088.gif deleted file mode 100644 index e2c5ab3a..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_088.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_089.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_089.gif deleted file mode 100644 index 407ab149..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_089.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_090.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_090.gif deleted file mode 100644 index 227799b7..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_090.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_091.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_091.gif deleted file mode 100644 index fcaf32fc..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_091.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_092.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_092.gif deleted file mode 100644 index 88b8349d..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_092.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_093.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_093.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_093.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_094.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_094.gif deleted file mode 100644 index 37baf58d..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_094.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_095.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_095.gif deleted file mode 100644 index 52ec68f8..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_095.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_096.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_096.gif deleted file mode 100644 index e2317cee..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_096.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_097.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_097.gif deleted file mode 100644 index 2a91340b..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_097.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_098.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_098.gif deleted file mode 100644 index 1af02b15..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_098.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_099.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_099.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_099.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_100.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_100.gif deleted file mode 100644 index 871398e9..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_100.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_101.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_101.gif deleted file mode 100644 index a08c77e1..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_101.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_102.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_102.gif deleted file mode 100644 index f85edcb3..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_102.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_103.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_103.gif deleted file mode 100644 index a470f97b..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_103.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_104.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_104.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_104.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_105.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_105.gif deleted file mode 100644 index f1dd7ebf..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_105.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_106.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_106.gif deleted file mode 100644 index 3cdd29b1..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_106.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_107.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_107.gif deleted file mode 100644 index 204de8c6..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_107.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_108.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_108.gif deleted file mode 100644 index 6b800da9..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_108.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_109.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_109.gif deleted file mode 100644 index fd1cf72c..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_109.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_110.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_110.gif deleted file mode 100644 index 4ac9391f..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_110.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_111.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_111.gif deleted file mode 100644 index 63f5022e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_111.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_112.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_112.gif deleted file mode 100644 index 6e21611b..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_112.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_113.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_113.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_113.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_114.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_114.gif deleted file mode 100644 index 9f42429e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_114.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_115.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_115.gif deleted file mode 100644 index 395ad149..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_115.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_116.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_116.gif deleted file mode 100644 index 00d3507a..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_116.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_117.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_117.gif deleted file mode 100644 index dc290f26..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_117.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_118.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_118.gif deleted file mode 100644 index 18462864..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_118.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_119.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_119.gif deleted file mode 100644 index 0dfafab1..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_119.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_120.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_120.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_120.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_121.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_121.gif deleted file mode 100644 index 00089828..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_121.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_122.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_122.gif deleted file mode 100644 index 045bc57e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_122.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_123.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_123.gif deleted file mode 100644 index 0c1bd152..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_123.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_124.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_124.gif deleted file mode 100644 index 44a87bb9..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_124.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_125.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_125.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_125.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_126.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_126.gif deleted file mode 100644 index 549608ec..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_126.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_127.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_127.gif deleted file mode 100644 index deb7f38b..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_127.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_128.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_128.gif deleted file mode 100644 index 9db51e18..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_128.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_129.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_129.gif deleted file mode 100644 index 9db51e18..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_129.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_130.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_130.gif deleted file mode 100644 index 3c161513..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_130.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_131.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_131.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_131.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_132.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_132.gif deleted file mode 100644 index 9db51e18..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_132.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_133.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_133.gif deleted file mode 100644 index 630f033e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_133.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_134.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_134.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_134.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_135.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_135.gif deleted file mode 100644 index 298316e6..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_135.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_136.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_136.gif deleted file mode 100644 index b5786322..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_136.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_137.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_137.gif deleted file mode 100644 index 5e7da185..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_137.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_138.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_138.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_138.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_139.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_139.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_139.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_140.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_140.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_140.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_141.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_141.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_141.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_142.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_142.gif deleted file mode 100644 index 82ecae8c..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_142.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_143.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_143.gif deleted file mode 100644 index 43159ba2..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_143.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_144.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_144.gif deleted file mode 100644 index d268ee15..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_144.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_145.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_145.gif deleted file mode 100644 index e1eff65c..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_145.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_146.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_146.gif deleted file mode 100644 index dae39f4c..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_146.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_147.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_147.gif deleted file mode 100644 index cc5a69d2..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_147.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_148.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_148.gif deleted file mode 100644 index 8399008c..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_148.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_149.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_149.gif deleted file mode 100644 index 1a9cea54..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_149.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_150.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_150.gif deleted file mode 100644 index bfb15249..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_150.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_151.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_151.gif deleted file mode 100644 index 8beeabd4..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_151.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_152.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_152.gif deleted file mode 100644 index b4d58ef3..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_152.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_153.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_153.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_153.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_154.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_154.gif deleted file mode 100644 index 23db15f5..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_154.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_155.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_155.gif deleted file mode 100644 index 8f103ebc..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_155.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_156.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_156.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_156.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_157.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_157.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_157.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_158.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_158.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_158.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_159.gif b/docs/html-primer/Medley-Primer-OnePage_files/Image_159.gif deleted file mode 100644 index 27d8e145..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_159.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_160.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_160.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_160.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/Image_161.png b/docs/html-primer/Medley-Primer-OnePage_files/Image_161.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer-OnePage_files/Image_161.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer-OnePage_files/content.htm b/docs/html-primer/Medley-Primer-OnePage_files/content.htm deleted file mode 100644 index 2305ee7e..00000000 --- a/docs/html-primer/Medley-Primer-OnePage_files/content.htm +++ /dev/null @@ -1,103 +0,0 @@ - -Medley-Primer-OnePage

Venue Medley for the Novice

Release 2.0

February, 1992

Address comments to:

Venue

User Documentation 1549 Industrial Road

San Carlos, CA 94070 415-508-9672

Medley for the Novice Release 2.0

February 1992

Copyright  1992 by Venue. All rights reserved.

Medley is a trademark of Venue.

Xerox is a registered trademark and InterPress is a trademark of Xerox Corporation.

UNIX is a registered trademark of UNIX System Laboratories. Post Script is a registered trademark of Adobe Systems Inc.

Copyright protection includes material generated from the

software programs displayed on the screen, such as icons, screen display looks, and the like.

The information in this document is subject to change without notice and should not be construed as a commitment by Venue. While every effort has been made to ensure the accuracy of this document, Venue assumes no responsibility for any errors that may appear.

Text was written and produced with Venue text formatting tools; Xerox printers were used to produce text masters. The typeface is Classic.

BRIEF GLOSSARY

The following definitions will acquaint you with general terms used throughout this primer. You will probably want to read through them now, and use this chapter as a reference while you read through the rest of the primer.

advising A Medley facility for specifying function modifications without necessarily knowing how a particular function works or even what it does. Even system functions can be changed with
advising.
argument A piece of information given to a Lisp function so that it can execute successfully. When a function is explained in the
primer, the arguments that it requires will also be given. Arguments are also called Parameters.
atom The smallest structure in Lisp; like a variable in other
programming languages, but can also have a property list and a function definition.
Background Menu The menu that appears when the mouse is not in any window and the right mouse button is pressed.
binding The value of a variable. It could be either a local or a global variable. See unbound.
bitmap A rectangular array of "pixels," each of which is on or off representing one point in the bitmap image.
BREAK An Lisp function that causes a function to stop executing, open a Break window, and allows you to find out what is happening while the function is halted.
Break Window A window that opens when an error is encountered while
running your program (i.e., when your program has broken).
There are tools to help you debug your program from this window. This is explained further in Chapter 14.
browse To examine a data structure by use of a display that allows you to "move" around within the data structure.
button (1) (n.) A key on a mouse.
(2) (v.t.) To press one of the mouse keys when making a selection.
CAR A function that returns the head or first element of a list. See
CDR.
caret The small blinking arrowhead that marks where text will appear when it is typed in from the keyboard.
CDR A function that returns the tail (that is, everything but the first element) of a list. See CAR.

CLlSP A mechanism for augmenting the standard Lisp syntax. One such augmentation included in Interlisp is the iterative
statement. See Chapter 9. cr Press your Return key.
datatype (1) The kind of a datum. In Interlisp, there are many system- defined datatypes, e.g., Floating-Point, Integer, Atom, etc.
(2) A datatype can also be user-defined. In this case, it is like a record made up from system types and other user-defined datatypes.
DWIM "Do-what-I-mean." Many errors made by Medley users could be corrected without any information about the purpose of the program or expression in question (e.g., misspellings, certain kinds of parenthesis errors). The DWIM facility is called
automatically whenever an error occurs in the evaluation of an Interlisp expression. If DWIM is able to make a correction, the computation continues as though no error had occurred; otherwise, the standard error mechanism is invoked.
error Occasionally, while a program is running, an error may occur which will stop the computation. Interlisp provides extensive facilities for detecting and handling error conditions, to
enable the testing, debugging, and revising of imperfect programs.
evaluate or EVAL To find the value of a form. For example, if the variable X is bound to 5, we get 5 by evaluating X. Evaluation of a Lisp function involves evaluating the arguments and then
applying the function.
Executive Window This is your main window, where you will run functions and
develop your programs. This is the window that the caret is in when you turn on your machine and load Medley.
file package A set of functions and conventions that facilitate the bookkeeping involved with working in a large system consisting of many source code files and their compiled counterparts. Essentially, the file package keeps track of
where things are and what things have changed. It also keeps track of which files have been modified and need to be
updated and recompiled.
form Another way of saying s-expression. A Lisp expression that can be evaluated.
function A piece of Lisp code that executes and returns a value. history The programmer’s assistant is built around a memory
structure called the history list. The history functions (e.g.
FIX, UNDO, REDO) are part of this assistant. These operations allow you to conveniently rework previously specified
operations.
History List As you type on the screen, you will notice a number followed by a slash, followed by another number. The first number is the exec number, the second is the event number. Each
number, and the information on that line, is stored
sequentially as the History List Using the History List, you

can easily reexecute lines typed earlier in a work session. See Chapter 2.
icon A pictorial representation, usually of a shrunken window.
inspector An interactive display program for examining and changing the parts of a data structure. Medley has inspectors for lists and other data types.
iterative statement (also called i.s.) A statement in Interlisp that repetitively
executes a body of code For example, (for x from l to 5 do (PRlNT x)) is an i.s.
iterative variable (also called i.v.) Usually, an iterative statement is controlled by the value that the i.v. takes on. In the iterative statement
example above, x is the iterative variable because its value is being changed by each cycle through the loop. All iterative
variables are local to the iterative statement where they are defined.
Lisp Family of languages invented for "list processing." These languages have in common a set of basic primitives for
creating and manipulating symbol structures. Interlisp-D is an implementation of the Lisp language together with an
environment (set of tools) for programming, and a set of packages that extend the functionality of the system.
list A collection of atoms and lists; a list is denoted by surrounding its contents with a pair of parentheses.
Masterscope A program analysis tool. When told to analyze a program,
Masterscope creates a database of information about the
program. In particular, Masterscope knows which functions call other functions and which functions use which variables.
Masterscope can then answer questions about the program and display the information with a browser.
menu A way of graphically presenting you with a set of options.
There are two kinds of menus: pop-up menus are created
when needed and disappear after an item has been selected; permanent menus remain on the screen after use until
deliberately closed.
mouse The mouse is the box attached to your keyboard. It controls the movement of the cursor on your screen. As you become
familiar with the mouse, you will find it much quicker to use the mouse than the keyboard.
Mouse Cursor The small arrow on the screen that points to the northwest.
Mouse Cursor Icons Four types of mouse cursor icons are shown below.
Wait. The processor is busy.
The Mouse Confirm Cursor. It appears when you have to confirm that the choice you just made was correct. If it was, press the left button. If the choice was not correct, press the right button to abort.

This means "sweep out" the shape of the window. To do this, move the mouse to a position where you want a corner. Press the left mouse button, and hold it down. Move the mouse
diagonally to sketch a rectangle. When the rectangle is the desired size and shape, release the left button.

This is the "move window" prompt. Move the mouse so that the large "ghost" rectangle is in the position where you want the window. When you click the left mouse button, the
window will appear at this new location.
NIL NIL is the Lisp symbol for the empty list. It can also be represented by a left parenthesis followed by a right
parenthesis ( ). It is the only expression in Lisp that is both an atom and a list.
pixel Pixel stands for "picture element." The computer monitor
screen is made up of a rectangular array of pixels. Each pixel corresponds to one bit. When a bit is turned on (i.e., set to 1), the pixel on the screen represented by this bit is black.
pretty printing Pretty printing refers to the way Lisp functions are printed with special indentation, to make them easier to read.
Functions are pretty printed in the structure editor, SEdit
(see Chapter 7). You can pretty print uncompiled functions by calling the function PP with the function you would like to
see as an argument, i.e. (PP function-name). For an example of this, see Figure 1.5.

Figure 1.5. Example of Pretty Printing Function PP

Programmer’s
Assistant The programmer’s assistant accesses the History List to allow you to FIX, UNDO, and/or REDO your previous expressions
typed to the executive window (see Chapter 2).
Prompt Window The narrow black window at the top of the screen. It displays system prompts, or prompts you have developed (see Figure 1.6).

Figure 1.6. Prompt Window
property list A list of the form ( <property-namel> <property-value1>
<property-name2> <property-value2> ....) associated with an atom. It accessed by the functions GETPROP and PUTPROP.
record A record is a data structure that consists of named "fields".
Accessing elements of a record can be separated from the details of how the data structure is actually stored. This
eliminates many programming details. A record definition
establishes a record template, describing the form of a record. A record instance is an actual record storing data according to a particular record template. (See datatype, second
definition.)
Right Button Default
Window Menu This is the menu that appears when the mouse is in a
window, and the right mouse button is pressed. It looks like the menu in Figure 1.7. If this menu does not appear when you press the right button of the mouse and the mouse is in
the window, move the mouse so that it is pointing to the title bar of the window, and press the right button.

Figure 1.7. Right Button Default Window Menu

s-expression Short for "symbolic expression". In Lisp, this refers to any well-formed collection of left parentheses, atoms, and right parentheses.

stack A pushdown list. Whenever a function is entered, information about that specific function call is pushed onto (i.e., added to
the front of) the stack. This information includes the variable names and their values associated with the function call.
When the function is exitted, that data is popped off the stack.

sysout A flle containing a whole Lisp environment: namely,
everything you defined or loaded into the environment, the windows that appeared on the screen, the amount of memory
used, and so on. Everything is stored in the sysout file exactly as it was when the function SYSOUT was called.

TRACE A function that creates a trace of the execution of another
function. Each time the traced function is called, it prints out the values of the arguments it was called with, and prints out the value it returns upon completion.

unbound Without value; an atom is unbound if a value has never been assigned to it.

window A rectangular area of the screen that acts as the main display area for some Lisp process,
PREFACE

It was dawn and the local told him it was down the road a piece, left at the first fishing bridge in the country, right at the appletree stump, and onto the dirt road just before the hill. At midnight he knew he was lost. -Anonymous

Welcome to the Medley Lisp Development Environment, a collection of powerful tools for assisting you in programming in Lisp, developing sophisticated user interfaces, and creating prototypes of your ideas in a quick and easy manner. Unfortunately, along
with the power comes mind-numbing complexity. The Medley documentation set
describes all the tools in detail, but it would be unreasonable for us to expect a new user to wade through all of it, so this primer is intended as an introduction, to give you a
taste of some of the features.
We developed this primer to provide a starting point for new Medley users, to enhance your excitement and challenge you with the potential before you. We’re going to make some assumptions about you. For starters, we’re going to assume that you’re sitting at a workstation that can run Medley. All of the examples in the book figure that you’re
going to want to try things out. We’re also going to assume that you’ve had some exposure to Lisp, hopefully Common Lisp.
Medley actually consists of two complete Lisp implementations, Common Lisp and InterLisp. All the screen I/O and some of the system functions are in InterLisp.
However, thanks to the package system, you can call back and forth between the two languages by simply including a package delimiter in front of a symbol name. This sounds complicated, but it will become clearer once we do some examples.
Throughout we make reference to the lnterlisp-D Reference Manual by section and page number. The material in the primer is just an introduction. When you need more depth, use the detailed treatment provided in the manual.
While only you can plot your ultimate destination, you will flnd this primer
indispensable for clearly defining and guiding you to the first landmarks on your way.

Acknowledgements
The early inspiration and model for this primer came from the Intelligent Tutoring
Systems group and the Learning Research and Development Center at the University of Pittsburgh. We gratefully acknowledge their pioneering contribution to more effective
artificial intelligence.
This primer was originally developed by Computer Possibilities, a company committed to making Al technology available. Primary development and writing was done by
Cynthia Cosic, with technical writing support provided by Sam Zordich. It has been re- done by Venue staff to reflect changes in the environment since the original publication.
At Xerox Artificial Intelligence Systems, John Vittal managed and directed the project. Substantial assistance was provided by many members of the AlS staff who provided both editorial and systems support.

Medley for the Novice, Release 2.0
vii
PREFACE

[This page intentionally left blank]

viii Medley for the Novice, Release 2.0
TYPING SHORTCUTS

Once you have logged in to Medley, you are in Lisp. The functions you type into the

Executive Window will now execute, that is, perform the designated task. Lisp is case-

sensitive; it often matters whether text is typed in upper- or lowercase letters. Use the Shift-Lock key on your keyboard to ensure that everything typed is in capital letters.

You must type all Lisp functions in parentheses. The Lisp interpreter will read from the left parenthesis to the closing right parenthesis to determine both the function you want to execute and the arguments to that function. Executing this function is called

"evaluation." When the function is evaluated, it returns a value, which is then printed in the Executive Window. This entire process is called the read-eval-print loop, and is how most Lisp interpreters, including the one for Lisp, run.

The prompt in is a number followed by a left-pointing arrow (see Figure 2.3). This number is the function’s position on the History List—a list that stores your

interactions with the Lisp interpreter. Type the function (PLUS 3 4) , and notice the History List assigns to the function (the number immediately to the left of the arrow).

Lisp reads in the function and its arguments, evaluates the function, and then prints the number 7.

Programmer’s Assistant

In addition to this read-eval-print loop, there is also a "programmer’s assistant." It is the programmer’s assistant that prints the number as part of the prompt in the

executive window, and uses these numbers to reference the function calls typed after them.

When you issue commands to the programmer’s assistant, you will not use parentheses as you do with ordinary functiion calls. You simply type the command, and some

specification that indicates which item on the history list the command refers to. Some programmer’s assistant commands are FIX, REDO, and UNDO. They are explained in

detail below.

Programmer’s assistant commands are useful only at the Lisp top level, that is, when you are typing into the Executive Window. They do not work in user-defined functions.

As an example use of the programmer’s assistant, use REDO to redo your function call

(PLUS 3 4). Type REDO at the prompt (programmer’s assistant commands can be

typed in either upper- or lowercase) , then specify the previous expression in one of the following ways:

When you originally typed in the function you now want to refer to, there was a
History List number to the left of the arrow in the prompt. Type this number after the programmer’s assistant command. This is the method illustrated in Figure 2-1.

Figure 2-1. Using a Programmer’s Assistant Command to REDO a Function
A negative number will specify the function call typed in that number of prompts dago. In this example, you would type in -1, the position immediately before the current position. This is shown in Figure 2-2.

Figure 2-2. Using a Negative Number after the Programmer’s Assistant Command
You can also specify the function for the programmer’s assistant with one of the items that was in that function call. The programmer’s assistant will search
backwards in the History List, and use the first function it finds that includes that
item. For example, type REDO PLUS to have the functiion (PLUS 3 4) reevaluated.
If you type a programmer’s assistant cmmand without specifying a function (i.e., simply typing the command, following by a Return), the programmer’s assistant executes the command using the function entered at the previous prompt.

Figure 2-3 shows a few more examples of how to use the programmer’s assistant.

Figure 2-3. Some Applications of the Programmer’s Assistant

If You Make a Mistake

Editing in the Executive Window is explained in detail in Chapter 7. In the following section, only a few of the most useful commands are repeated.

To move the caret to a new place in the command being typed, point the mouse cursor at the appropriate position. Then press the left mouse button.

To move the caret back to the end of the command being typed, press Control-X (hold the Control key down, and type X).

To delete:

Character behind the caret Press the Backspace key

Word behind the caret Press Control-W (hold the Control key down and type

W)

Any part of the command Move the caret to the appropriate place in the

command. Hold the right mouse button down and move the the mouse cursor over the text. All of the

blackened text between the caret and mouse cursor is deleted when you release the right mouse button.

Entire command Press Control-U (hold the Control key down and type

U)

Deletions can be undone. J ust press the UNDO key.

To add more text to the line, move the carent to the appropriate position and start to type. Whatever you type will appear at the caret.

[This page intentionally left blank]

TABLE of CONTENTS

Preface vii

Brief Glossary 1-1
Typing Shortcuts
Programmer’s Assistant 2-1
If You Make a Mistake 2-2
Using Menus
Making a Selection from a Menu 3-1
Explanations of Menu Items 3-2
Submenus 3-2
Summary 3-3
How to Use Files
Types of Files 4-1
Directories 4-1
Directory Options 4-2
Subdirectories 4-2
To See What Files Are Loaded 4-3
Simple Commands for Manipulating Files 4-3
Connecting to a Directory 4-3
File Version Numbers 4-4
FileBrowser
Calling the FileBrowser 5-1
FileBrowser Commands 5-3
Those Wondertul Windows!
Windows Provided by Medley 6-1
Creating a Window 6-2
Right Button Default Window Menu 6-2
Explanation of Each Menu Item 6-3
Scrollable Windows 6-4
Other Window Functions 6-5
PROMPTPRlNT 6-5
WHlCHW 6-6
Editing and Saving
Defining Functions 7-1
Simple Editing in the Executive Window 7-2
Using the List Structure Editor 7-3
Commenting Functions 7-4
File Functions and Variables: How to See and Save Them 7-5
File Variables 7-5
Saving Interlisp-D on Files 7-5
Your Init File
Using the USERGREETFILES Variable 8-1
Making an Init File 8-1
Medley Forgiveness: DWIM 9-1
Break Package
Break Windows 10-1
Break Package Examples 10-1
Ways to Stop Execution from the Keyboard (Breaking Lisp) 10-3
Break Menu 10-3
Returning to Top Level 10-4
WhatTo Do lf 11-1
Window and Regions
Windows 12-1
CREATEW 12-1
WlNDOWPROP 12-2
Getting Windows to Do Things 12-3
BUTTONEVENTFN 12-5
Looking at a Window’s Properties 12-5
Regions 12-5
What Are Menus?
Displaying Menus 13-1
Getting Menus to Do Stuff 13-2
WHENHELDFN and WHENSELECTEDFN Fields of a Menu 13-3
Looking at a Menu’s Fields 13-5
Bitmaps 14-1
Displaystreams
Drawing on a Displaystream 15-1
DRAWUNE 15-1
DRAWTO 15-2
DRAWCIRCLE 15-3
FILLCIRCLE 15-1
Locating and Changing Your Position in a Displaystream 15-4
DSPXP0SITION 15-5
DSPYPOSlTION 15-5
MOVETO 15-5
Fonts
What Makes Up a Font 16-1
Fontdescriptors and FONTCREATE 16-2
Display Fonts 16-3
InterPress Fonts 16-3
Functions for Using Fonts 16-4
FONTPROP - Looking at Font Properties 16-4
STRINGWlDTH 16-5
DSPFONT- Changing the Font in One Window 16-5
Personalizing Your Font Profile 16-6
The Inspector
Calling the Inspector 17-1
Using the Inspector 17-2
Inspector Example 17-2
Masterscope
SHOW DATA Command and GRAPHER 18-2
Where Does All the Time Go? SPY
How to Use Spy with the SPY Window 19-1
How to Use SPY from the Lisp Top Level 19-2
Interpreting SPY’s Results 19-2
Free Menus
Free Menu Example 20-1
Parts of a Free Menu Item 20-2
Types of Free Menu Items 20-3
The Grapher
Say it with Graphs 21-1
Add a Node 21-2
Add a Link 21-2
Delete a Link 21-2
Delete a Node 21-2
Move a Node 21-2
Making a Graph from a List 21-2
Incorporating Grapher into Your Program 21-2
More of Grapher 21-2
Resource Management
Naming Variables and Records 22-1
Some Space and Time Considerations 22-2
Global Variables 22-3
Circular Lists 22-3
When You Run Out of Space 22-4
Simple Interactions with the Cursor, a Bitmap, and a Window
GETMOUSESTATE Example Function 23-1
Advising GETMOUSESTATE 23-2
Changing the Cursor 23-2
Functions for Tracing the Cursor 23-3
Running the Functions 23-6
Glossary of Global System Variables
Directories 24-1
Flags 24-2
History Lists 24-3
System Menus 24-3
Windows 24-4
Miscellaneous 24-4
Other Useful References 25.1

Index.............................................................................................................................................. INDEX-1

[This page intentionally left blank]

USING MENUS

The purpose of this chapter is to show you how to use menus. Many things can be done more easily using menus, and there are many different menus provided in the Medley
environment. Some are "pop-up" menus that are only available until a selection is made, then disappear until they are needed again. An example of one of these is the Background Menu that appears when the mouse is not in any window and the right
mouse button is pressed. A background menu is shown in Figure 3-1. Your background menu may have different items on it.

Figure 3-1. Background Menu
Another common pop-up menu is the right button default window menu. This menu is explained more in Chapter 6.
Other menus are more permanent, such as the menu that is always available for use with the Filebrowser. This menu is shown in Figure 3-2., and the specifics of its use with the filebrowser are explained in Chapter 5.

Figure 3-2. Filebrowser Menu

Making a Selection from a Menu
To make a selection from a menu, point with the mouse to the item you would like to select. If one of the mouse buttons is already pressed, the menu item should be
highlighted in reverse video. If it is a permanent menu, you must press the left mouse button to highlight the item. When you release the button,m the item will be selected. Figure 3-3 shows a menu with the item "Undo" chosen.

Figure 3-3. Menu with the Item "Undo" Chosen

Explanation of Menu Items
Many menu items have explanations associated with the. If you are not sure what the consequences of choosing a particular menu iem will be, highlight the menu item but do not releast the left mouse button. If the menu item has an explanation associated with it, the explanation will be printed in the prompt window. Figure 3-4 shows the
explanation associated with the item "Snap" from the background menu.

Figure 3-4. Explanation Associated with Selected Menu Item

Submenus
Some menu items have submenus associated with them. This means that, for these items, you can make even more precise choices if you would like to.
A submenu can also be foun d as described below.
As shown in Figure 3-5, a submenu can be indicated by a gray arrow to the right of the menu item. To see the submenu, highlight the menu item and move the mose to the
right to follow the arrow. Choosing an item from a submenu is done the same way you make a choice from the menu. Any submenus that might be associated with the items in the submenu are indicated in the same way as the submenus associated with the
items in the menu.
3. USING MENUS

Figure 3-5. Edit Submenu Displayed with Right Arrow

Summary
In summary, here are a few rules of thumb to remember about the interactions of the mouse and system menus:
- Press the left mouse button to select a menu item
- Press the middle mouse button to get more options on a submenu
- Press the right mouse button to see the default right button window menu, and the background menu
  
  [This page intentionally left blank]
HOW TO USE FILES

Types of Files
A program file, or Lisp file, contains a series of expressions that can be read and
evaluated by the Lisp interpreter. These expressions can include function or macro
definitions, variables and their values, properties of variables, and so on. How to save Interlisp-D expressions on these files is explained in Chapter 7. Loading a file is
explained in the Simple Commands for Manipulating Files section below.
Not all files, however, have Lisp expressions stored on them. For example, TEdit files store text; sketches are stored on files made with the package Sketch , or can be
incorporated into TEdit files. These files are not loaded directly into the environment, but are accessed with the package used to create them, such as TEdit or Sketch.
When you name a file, there are conventions that you should follow. These conventions allow you to tell the type of file by the extension to its name.
If a file contains: Then:
Lisp expressions It should not have an extension or have the extension
.LISP. For example, a file called MYCODE should contain Lisp expressions.
Compiled Code It should have the extension .LCOM or .DFASL. For
example, a file called MYCODE.DFASL should contain compiled code.
A Sketch Its extension should be .SKETCH. For example, a file called MOUNTAINS.SKETCH should contain a Sketch.
Text It should have the extension .TEDIT. For example, a file called REPORT.TEDIT should contain text that can be edited with the editor TEDIT.

Directories
This section focu ses on how you can find files, and how you can easily manipulate files. To see all the files listed on a device, use the function DIR. For example, to see what files are stored in your current directory, type:
(DIR *.*)
Partial directory listings can be gotten by specifying a file name, rather than just a
device name. The wildcard character * can be used to match any number of unknown characters. For example, the command (DIR T*) will list the names of all files that begin with the letter T. An example using the wildcard is shown in Figure 4-1.

Figure 4-1. Using DIR with a Wildcard

Directory Options
Various words can appear as extra arguments to the DIR command. these words give you extra information about the files.
SIZE displays the size of each file in the directory. For example, type:
(DIR {DSK} SIZE)
DATE displays the creation date of each file in the directory. An example of this is shown in Figure 4-2.

Figure 4-2. Example Using DATE DEL deletes all the files foun d by the directory command.

Subdirectories
Sudirectories are very helpful for organizing files. A set of files that have a single
purpose (for example, all the external documentation files for a system) can be grouped together into a subdirectory.
To associate a subdirectory with a filename, simply include the desired subdirectory as part of the name of the file. Subdirectories are specified after the device name and
before the simple filename. The first subdirectory should be between less-than and
greater-than signs (angle brackets) < >, with nested subdirectory names only followed by a greater than sign >. For example:
{DSK}<Directory>SubDirectory>SubSubDirectory>...>filename
or use the UNIX convention:
{DSK}/Directory/Subdirectory/Subsubdirectory/filename

To See What Files Are Loaded
If you type FILELST<CR>, the names of all the files you loaded will be displayed. Type SYSFILES<CR> to see what files are loaded to create the sysout.

Simple Commands for Manipulating Files
When using these functions, always be sure to specify the full filename, including subfile directories if appropriate.
To have the conents of a file displayed in a window:
(SEE ’filename)
To copy a file (see Figure 4-3):
(COPYFILE ’oldfilename ’newfilename)

Figure 4-3. Example Use of COPYFILE
To delete a file (see Figure 4-4):
(DELFILE ’filename)

Figure 4-4. Example Use of DELFILE
To rename a file:
(RENAMEFILE ’oldfilename ’newfilename)
Files that contain Lisp expressions can be loaded into the environment. That means that the information on them is read, evaluated, and incorporated into the Medley
environment. To load a file, type:
(LOAD ’filename)

Connecting to a Directory
Often, each person or project has a subdirectory where files are stored. If this is your situation, you will want any files you create to be put into this directory automatically. This means you should "connect" to the directory.

CONN is the Medley command that connects you to a directory. For example, CONN in Figure 4-5 connects you to the subsubdirectory IM, in the subdirectory PRIMER , the directory LISPFILES, on the device DSK. This information—the device and the
directory names down to the subdirectory to which you want to be connected—is called the "path" to that subdirectory. CONN expects the path to a directory as an argument.

Figure 4-5. CONNecting to Subdirectory Primer Subsubdirectory IM
Once you are connected to a directory, the command DIR will assume you want to see the files in that directory, or any of its subdirectories.
Other commands that require a filename as an argument (e.g., SEE, above) will assume that the file is in the connecteds directory if there is no path specified with the filename. This will often save you typing.

File Version Numbers
When stored, each filename is fillowed by a semicolon and a number, as shown in this example:
MYFILE.TEDIT;1
The number is the version number of the file. This is the system’s way of protecting your files from being overwritten. Each time the file is written, a new file is created with a version number one greater than the last. This new file will have everything from your previous file, plus all of your changes.
In most cases, you can exclude the version number when referencing the file. When the version is not specified, and there is more than one version of the file on that particular directory, the system generally uses your most recent version. An exception is the
function DELFILE, which deletes the oldest version (the one with the lowest version number) if none is specified.

[This page intentionally left blank]
FILEBROWSER

The FileBrowser is a Lisp Library Package that works with files stored on disk and floppy devices, and can be used as a file directory editor. If it is not loaded into your sysout, you need to load it first by typing:

(LOAD ’FILEBROWSER.LCOM)

Calling the FileBrowser

Calling the FileBrowser with the directory calls up the files stored in that directory:

(FB ’<usr>local>lde>)

Another way to call a FileBrowser is to choose "FileBrowser" from the background

menu. You will be prompted for a description of the files to be included (see Figure 5-1). Type an asterisk (*), then press Return to see all the files in the connected directory.

Figure 5-1. Prompt for Files to Include in FileBrowser

These show a directory of the device in a window you can leave on the screen at all times. The parts of the FileBrowser window are shown below.

Prompt Window

Command Menu

File List

Figure 5-2. Parts of a FileBrowser Window Now you do not need to continually type the directory command.

To use the FileBrowser, choose a file by pointing to the file with the mouse and pressing the left or middle mouse button. A small dark arrow appears to the left of the file

name. Choose a command from the menu at the right. In Figure 5-3, the files

OCH1.TEDIT;1, OCH10.TEDIT;1, and OCH11.TEDIT;1 have been selected.

The left mouse button only allows you to choose one file at a time. Even if you choose other files, only the last file you selected with the left mouse button will remain

marked as chosen. When you use the middle mouse button to select a file, the file is added to those already chosen.

To unpick an already chosen file, hold the Control key down while pressing the middle mouse button.

Figure 5-3. Files Chosen

FILEBROWSER

The next section contains a summary of the FileBrowser commands.

FileBrowser Commands

Delete In the FileBrowser, this command marks a file, or files, for deletion (see Figure 5-4). These files are marked by a black line crossing through
them. You may select and mark any number of files for deletion. Delete does not actually remove these files from the device. The Expunge command actually wipes out the files previously marked for deletion.

Figure 5-4. Files Marked for Deletion

Undelete Undoes the delete command for one or more files. Undelete erases the black line through a file marked for deletion.
Copy This command copies the chosen file. The destination filename should
be typed at a prompt that appears in the window above the FileBrowser.
Wildcards do not work for this prompt. You must type the whole
unquoted filename. If more than one file is chosen to be copied, you will be prompted for a directory name. The files will be copied into the
directory you give, but with the same filenames as the ones they have in their original location.

Rename This command works much like the Copy command, but does not leave the original file. The chosen file will be renamed to the destination
filename. You will be prompted, in the prompt window, for the
destination filename. Give the complete unquoted filename. If more
than one file is chose to be renamed, you will be prompted for a directory name. The files will be moved into the directory you give.

Hardcopy If you do not have a hardcopy device, using this command causes an error. Otherwise, it gives a hardcopy of the file.
See Shows you a file in a window. To use this command, choose a single filename, then the See command. You are prompted for a window.
Each time the See command is chosen, a new window is opened to display the file.
Edit Calls the editor with the file as input. If the file is an executable one (i.e., Lisp code as opposed to a documentation file), only the FILECOMS list is edited. The FILECOMS list is the list of variables, lists, and

functions that are contained on that file. FileBrowser loads it and then allows you to edit the FILECOMS .
Load Choose a file with the left mouse button, or a group of files with the
middle mouse button. Once the filenames have been blackened, choose the Load command to load them all into Medley.

Compile This command calls the file compiler with the chosen filename(s) as arguments. The compiler compiles a file foun d on a storage device
({DSK}), not the functions defined in the Medley image. If any functions on a loaded file have been changed, run the function (MAKEFILE ’filename) to write the current version before compiling it. Files do not have to be loaded to use the Compile command.
Expunge This command completely deletes all the marked files from the
directory. This allows you to remove unwanted files from your storage device.

Recompute Choose this command when you know that the directory has been
changed and should be reread (e.g., after creating new versions of a file).
THOSE WONDERFUL WINDOWS!

A window is a designated area on the screen. Every rectangular box on the screen is a window. While Medley supplies many of the windows (such as the Executive Window), you may also create your own. Among other things, you will type, draw pictures, and
save portions of your screen with windows.

Windows Provided by Medley

Two important windows are available as soon as you enter the Medley environment.
One is the Executive Window, the main window where you will run your functions. It is the window that the caret is in when you turn on your machine, and load Medley. It is
shown in Figure 6-1.

Figure 6-1. Medley Executive Window

The other window that is open when you enter Medley is the "Prompt Window". It is the long thin black window at the top of the screen. It displays system prompts, or prompts you have associated with your programs. (See Figure 6-2.)

Figure 6-2. Prompt Window

Other programs, such as the editors, also use windows. These windows appear when
the program starts to run, and close (no longer appear on the screen) when the program is done running.

Creating a Window

To create a new window, type: (CREATEW). The mouse cursor will change, and have a small square attached to it. (See Figure 6-3.)

Figure 6-3. Mouse Cursor Asking You to Sweep Out Window

There may be a prompt in the prompt window to create a window. Press and hold the left mouse button. Move the mouse around, and notice that it sweeps out a rectangle. When the rectangle is the size that you’d like your window to be, release the left mouse button. More specific information about the creation of windows, such as giving them
titles and specifying their size and position on the screen when they are created, is given in the WINDOWPROP section of Chapter 12.

Right Button Default Window Menu
Position the cursor inside the window you just created, and press and hold the right mouse button. A menu of commands should appear (do not release the right button!), like the one in Figure 6-4. To execute one of the commands on this menu, choose the item. Making a choice from a menu is explained in Chapter 3.

Figure 6-4 Right Button Default Window Menu

As an example, select "Move" from this menu. The mouse cursor will become a ghost window (ju st an outline of a window, the same size as the one you are moving), with a square attached to one corner, like the one shown in Figure 6-5.

Figure 6-5 Mouse Cursor for Moving a Window

Move the mouse around. The ghost window will follow. Click the left mouse button to place tho window in a new location.

Choose "Shape", and notice that you are prompted to sweep out another window. Your original window will have the shape of the window you sketch out.

Explanation of Each Menu Item
The meaning of each right button default window menu item is explained below:

Close Removes the window from the screen
Snap Copies a portion of the screen into a new window Paint Allows drawing in a window
Clear Clears the window by erasing everything within the window boundaries Bury Puts the window beneath all other windows that overlap it
Redisplay Redisplays the window contents
Hardcopy Sends the contents of the window to a printer or to a flle Move Allows the wi ndow to be moved to a new spot on the screen Shape Repositions and/or reshapes the window
Shrink Reduces the window to a small black rectangle called an icon, or, if appropriate, to the shape for that window type (see Figure 6-6).

Figure 6-6 Example Icon

Expand Changes an icon back to its original window. Position the mouse cursor on the icon, depress the right button, and select Expand. Or, just button the icon with the middle mouse button.

These right-button default window menu selections are available in most windows, including the Executive Window. When the right button has other functions in a
window (as in an editor window), the right button default window menu should be accessible by pressing the Right button in the black border at the top of the window.

Scrollable Windows

Some windows in Medley are "scrollable". This means that you can move the contents of the window up and down, or side to side, to see anything that doesn’t fit in the
window.

Point the mouse cursor to the left or bottom border of a window. If the window is scrollable, a "scroll bar" will appear. The mouse cursor will change to a double headed arrow. (See Figure 6-7.)

Figure 6-7. Scroll Bar of Scrollable Window

The scroll bar represents the full contents of the window. The example scroll bar is completely white because the window has nothing in it When a part of the scroll bar is shaded, the amount shaded represents the amount of the window’s contents currently
shown. If everything is showing, the scroll bar will be fully shaded. (See Figure 6-8.)
The position of the shading is also important. It represents the relationship of the
section currently diplayed to the the full contents of the window. For example, if the shaded section is at the bottom of the scroll bar, you are looking at the end of the file.

Figure 6-8 Top of File When Shading at Top of Scroll Bar

When the scroll bar is visible, you can control the section of the window’s contents displayed:
- To move the contents higher in the window (scroll the contents up in the window), press the leff button of the mouse, the mouse cursor changes to look like this:
  
  Figure 6-9. Upward Scrolling Cursor
  
  The contents of the window will scroll up, making the line thit the cursor is beside the topmost line in the window.
- To move the contonts lower in the window (scroll the contents "down" in the window), press the right button of the mouse, and the mouse cursor changes to look like this:
  
  Flgure 6-10. Downward Scrolling Cursor
  
  The contents of the window scroll down, moving the line that is the topmost line in the window to beside the curtor.
- To show a specific section of the window’s contents, remember that the scroll bar represents the full contents of the window. Move the mouse cursor to the relative
  position of the section you want to see (e.g., to the top of the scroll bar if you want to see the top of the window’s contents). Press the middle button of the mouse. The mouse cursor will look like this:
  
  Figure 6-11 Proportional Scrolling Cursor
  
  When you release the middle mouse button, the window’s contents at that relative position will be displayed.
  The position of the mouse in the scroll bar defines how much of the window will be scrolled. If it is near the top, then only a little will be scrolled. If it is near the bottom, most of the window will be scrolled.
  
  Other Window Functions
  
  PROMPTPRlNT
  Prints an expression to the black prompt window.
  
  For example, type
  
  (PROMPTPRINT "THIS WILL BE PRINTED IN THE PROMPT WINDOW")
  
  The message will appear in the prompt window. (See Figure 6-12.)
  
  Figure 6-12 PROMPTPRINTing
  
  WHlCHW
  Returns as a value the name of the window that the mouse cursor IS in.
  
  (WHICHW) can be used as an argument to any function expecting a window, or to
  reclaim a window that has no name (that is not attached to some particular part of the program.).
EDITING AND SAVING

This chapter explains how to define functions, how to edit them, and how to save your work.

Defining Functions

DEFUN can be used to define new functions. The syntax for it is:
(DEFUN (<functionname> (<parameter-list><body-of-function>))
New functions can be created with DEFUN by typing directly into the Executive Window. Once defined, a function is a part of the Medley environment. For example, the function EXAMPLE-ADDER is defined in Figure 7-1.

Figure 7-1. Defining the Function EXAMPLE-ADDER

Now that the function is defined, it can be called from the Executive Window:

Figure 7-2.. After EXAMPLE-ADDER is defined, it can he executed The function returns 6, after printing out the message.
Functions can also be defined using the editor DEdit described above. To do this, simply type
(ED function-name ’FUNCTIONS)
You will be told that no definition exists for the function, and a menu will pop up asking you what type of function you would like to create:

Figure 7-3 Selecting a Function Template
Selecting the appropriate type will pop up an editor window with a function template. The use of the editor is explained in the Using the List Structure Editor section below.

Simple Editing in the Executive Window
First, type in an example function to edit:

3/41> (defun your-first-function (a b) (if (> a b)
’(the first is greater) ’(the second is greater)))
To run the function, type:
3/42> (YOUR-FIRST-FUNCTION 3 5) (THE SECOND IS GREATER)
Now, let’s alter this. Type:
3/43> FIX 41
Note that your original function is redisplayed, and ready to edit. (See Figure 7-4.)

Figure 7-4. Using FIX to Edit a Fundion

Move the text cursor to the appropriate place in the function by positioning the mouse cursor and pressing the left mouse button.
Delete text by moving the caret to the beginning of the section to be deleted. Hold the right mouse button down and move the mouse cursor over the text. All of the
highlighted text between the caret and mouse cursor is deleted when you release the right mouse button.
If you make a mistake, deletions can be undone. Press the UNDO key on the keypad to the left of the keyboard.
Now change GREATER to BIGGER:
1. Position the mouse cursor on the G of GREATER , and click the left mouse button. The text cursor is now where the mouse cursor is.
2. Next, press the right mouse button and hold it down. Notice that if you move the mouse cursor around, it will blacken the characters from the text cursor to the mouse cursor. Move the mouse so that the word "GREATER " is highlighted.
3. Release the right mouse button and GREATER is deleted.
4. Without moving the cursor, type in BIGGER .
5. There are two ways to end the editing session and run the function. One is to type Control-X. (Hold the Control key down, and type X.) Another is to move the text
  cursor to the end of the line and crø In both cases, the function has been edited!
  Try the new version of the function by typing:
  3/48> (YOUR-FIRST-FUNCTION 8 9) (THE SECOND IS BIGGER)
  and get the new result, or you can type:
  3/49> REDO 42
  (THE SECOND IS BIGGER)
  
  Using the List Structure Editor
  
  If the function you want to edit is not readily available (i.e. the function is not in the
  Executive Window, and you can’t remember the history list number, or you simply have a lot of editing), use the List Structure Editor, often called SEdit. This editor is evoked with a call to ED:
  81(ED ’YOUR-FIRST-FUNCTION ’FUNCTIONS)
  
  Your function will be displayed in an edit window, as in Figure 7-5.
  If there is no edit window on the screen, you will be prompted to create a window. As
  before, hold the leff mouse button down, move the mouse until it form s a rectangle of an acceptable size and shape, then release the button. Your function definition will
  automatically appear in this edit window.
  
  Figure 7-5. An Edit Window
  
  Many changes are easily done with the structure editor. Notice that by pressing the left mouse button you can place the caret in position, and by pressing the middle mouse
  button you can select atoms or s-expressions. Repeated pressing of the middle button selects bigger pieces of text.
  
  To add an expression that does not appear in the edit window (i.e., it cannot simply be underlined), place the caret at the insertion point and type it in.. For example, to
  replace the first GREATER with LARGER, place the caret to the left of GREATER , as shown in Figure 7-6.
  
  Figure 7-6. Caret Placement Prior to Changing GREATER with LARGER
  Now press the DELETE key seven times, and type in LARGER . The window now looks like this:
  
  Figure 7-7. GREATER Changed to LARGER
  Notice the asterisk in the left edge of the title bar of the window. This designates that the function has be changed. Now exit the edit session by typing Control-X, and the function will be redifined.
  
  Commenting Functions
  
  Text can be marked as a comment by typing a semi-colon before the text of the comment.
  ; This is the form of a comment
  Inside an editor window, the comment will be printed in a different font and may be moved to the far right of the code. SEdit is familiar with the Common Lisp convention of single comments being on the far right, double comments being justified with the
  function level, and triple comments being on the far left, as is shown in Figure 7-8.
  
  Figure 7-8. Placement of Comments
  There are other editor commands which can be very useful. To learn about them, read Appendix B of the Release Notes.
  
  File Functions and Variables: How to See and Save Them
  With Medley, all work is done inside the Lisp environment. There is no operating system or command level other than the Executive Window. All functions and data
  structures are defined and edited using normal Lisp commands. This sertion describes tools in the Medley environment that will keep track of any changes that you make in the environment that you have not yet saved on files, such as defining new functions,
  changing the values of variables, or adding new variables. And it then has you save the changes in a file you specify. All of these functions are in the INTERLISP (IL:) package.
  
  File Variables
  
  Certain system-defined global variables are used by the file package to keep track of the environment as it stands. You can get system information by checking the values of
  these variables. Two important variables follow.
  - FILELST evaluates to a list, all files that yoU have loaded into the Medley environment.
  - filenameCOMS (Each file loaded into the Lisp environment has associated with it a global variable, whose name is formed by appending COMS to the end of the filename.) This variable evaluates to a list of all the functions, variables, bitmaps, windows, and soon, that are stored on that particular file.
  For example, if you type:
  MYFILECOMS
  the system will respond with something like:
  ((FNS YOUR-FIRST-FUNCTION ) VARS))
  
  Saving Interlisp-D on Files
  The functions (FILES?) and (MAKEFILE ’filename) are useful when it is time to save function, variables, windows, bitmaps, records and whatever else to files.
  (FILES?) displays a list of variables that have values and are not already a part of any file, and then the functions that are not already part of any file.
  Type:
  (FILES?)
  the system will respond with something like:
  the variables: MY.VARIABLE CURRENT.TURTLE...to be dumped
  
  the functions: RIGHT LEFT FORWARD BACKWARD CLEAR-SCREEN...to be dumped
  want to say where the above go?
  
  If you type Y, the system will prompt with each item. There are three options:
  1. To save the item, type the filename (unquoted) of the file where the item should be placed. (This can be a brand new file or an existing file.)
  2. To skip the item, without removing it from consideration the next
    time (FILES?) is called, type crø This will allow you to postpone the decision about where to save the item.
  3. If the item should not be saved at all, type ]. Nowhere will appear after the item.
    Part of an example interaction is shown in the following figure:
    
    Figure 7-9. Part of an interaction using the function FILES?
    (FILES?) assembles the items by adding them to the appropriate file’s
    COMS variable (see the File Variables section above). (FILES?) does NOT write the file to secondary storage (disks or floppies). It only
    upclates the global variables discussed in the File Variables section above.
    
    (MAKEFILE ’filename)
    actually writes the file to secondary storage. Type:
    (MAKEFILE ’MY.FILE.NAME)
    and the system will create the file. The function returns the full name of the file created. (i.e. {DSK}MY.FlLE.NAME.; 1 ).
    
    Files written to (DSK) are permanent files. They can be removed only by the user deleting them or by reformatting the disk.
    
    Other file manipulation functions can be foun d in Chapter 4.
YOUR INIT FILE

Lisp has a number of global variables that control the environment. Global variables make it easy to customize the environment to fit your needs. One way to do this is to
develop an INIT file. This is a file that is loaded when you start an image. You can use it to set variables, load files, define functions, and any other things that you want to do to make the Medley environment suit you.

Using the USERGREETFILES Variable

As described in File Variables section of Chapter 11, each program file has a global Your INIT file could be called INIT, INIT.LISP, INIT.USER, or whatever the
convention is at your site. There is no default name preferred by the system, it just
looks for the files listed in the variable USERGREETFILES (see below). Check to see what the preference is at your site. Put this file in your directory. Your directory name should be the same as your login name. The INIT file is loaded by the function GREET. GREET is normally run when Medley is started. If this is not the case at your site, or you want
to use the machine and Medley has already been started, you can run the function
GREET yourself. If your user name was, for example, TURING , then you would type:
(GREET ’TURING)
This does a number of things, including undoing any previous greeting operation,
loading the site init file, and loading your init file. Where GREET looks for your INIT file depends on the value of the variable USERGREETFILES. The value of this variable is set when the system’s SYSOUT file is made, so check its value at your site! For example, its value could be:

Figure 8-1. Possible Value of USERGREETFILES
In each place you see >USER>, the argument passed to GREET is substituted into the path. This is your login name if you are just starting Medley. For example, the first value in the list would have the system check to see whether there was a
{DSK}<LISPFlLES>TURING>INIT.LISP file. No error is generated if you do not have an INIT file, and none of the files in USERGREETFILES are foun d.

Making an Init File

As described in File Variables section of Chapter 11, each program file has a global
variable associated with it, whose name is formed by appending COMS to the end of the root filename. For any of the standard INIT file names, the variable INITCOMS is used. To set up an init file, begin by editing this variable. Type:
(DV INITCOMS)
8. YOUR INIT FILE

An SEdit window wiil appear. This window is the same as the one called with the
function DF, and described in the Using the List Structure Editor section in Chapter 7. This chapter assumes that you know how to use the SEdit structure editor .
The COMS variable is a list of lists. The first atom in each internal list specifies for the file package what types of items are in the list, and what it is to do with them. This
section will deal with three types of lists: VARS, FILES, and P. Please read about others in Chapter 17 of the IRM.
Notice that inside the vars list, there is yet another list. The first item in the list is the name of the variable. It is bound to the value of the second item. There are many other variables that you can set by adding them to the VARS list. Some of these variables are described in Chapter 24, and many others can be foun d in the IRM.
If you want to automatically load files, that can be done in your init file also. For
example, if you always want to load tho Library file SPY.LCOM , you can load it by editing tho INITCOMS variable to list the appropriate file in the list starting with FILES:
.
.
.
(FILES SPY)
.
.
.
Figure 8-2. INITCOMS Changed to Load SPY.LCOM File
Other files can also be added by simply adding their names to this FILES list.
Another list that can appear in a COMS list begins with P. This list contains Lisp
expressions that are evaluated when the file is loaded. Do not put DEFINEQ expressions in this list. Define the function in the environment, and then save it on the file in the
usual way (see Chapter 7).
One type of expression you might want to see here, however, is a FONTCREATE function (see Chapter 16). For example, of you want to use a Helvetica 12 BOLD font, and there is not a font descriptor for it normally in your environment, the appropriate call to FONTCREATE should be in the "P" list. The INITCOMS would look like this:
.
.
.
(FILES SPY)
(P (FONTCREATE ’HELVETICA 12 ’BOLD))
.
.
.

Figure 8-3. INITCOMS Edited to Include a call to FONTCREATE
To quit, exit from SEdit in the usual way. When you run the function MAKEFILES (see Chapter 7), be sure that you are connected to the directory (see Chapter 4) where the INIT file should appear. Now when GREET is run, your Init file will be loaded.

8-2 Medley for the Novice, Release 2.0
MEDLEY FORGIVENESS: DWIM

DWIM (Do What I Mean) is an Interlisp utility that makes life easier.

DWIM tries to match unrecognized variable and function names to known ones. This allows Lisp to interpret minor typing errors or misspellings in a function, without
causing a break. Line 152 of Figure 9-1 illustrates how the misspelled BANNANNA was replaced by BANANA before the expression was evaluated.

Figure 9-1. Examples of DWIM Features

Sometimes DWIM may alter an expression you didn’t want it to. This may occur if, for
example, a hyphenated function name (e.g., (MY-FUNCTION) ) is misused. If the system does not recognize the function name, it may think you are trying to subtract "FUNCTION" from "MY". DWIM also takes the liberty of updating the function, so it will
have to be fixed. However, this is as much a blessing as a curse, since it points out the misused expression!
BREAKPACKAGE

The Break Package is a part of Interlisp that makes debugging your programs much easier.

Break Windows

A break is a function either called by the programmer or by the system when an error has occurred. A separate window opens for each break. This window works much like the Executive Window, except for extra menus unique to a break window. Inside a

break window, you can examine variables, look at the call stack at the time of the

break, or call the editor. Each successive break opens a new window, where you can execute functions without disturbing the original system stack. These windows

disappear when you resolve the break and return to a higher level.

Break Package Example

This example illustrates the basic break package functions. A more complete explanation of the breaking functions, and the break package will follow.

The correct definition of FACTORIAL is:

(defun factorial (x) (if (zerop x)

1

(* x (factorial (1- x)))))

To demonstrate the break package, we have edited in an error: DUMMY in the IF statement is an unbound atom, it lacks a value.

((defun factorial (x) (if (zerop x)

dummy

(* x (factorial (1- x)))))

The evaluated function

(FACTORIAL 4)

should return 24, but the above function has an error. DUMMY is an unbound atom, an atom without an assigned value, so Lisp will "break". A break window appears (Figure 10-1), that has all the functionality of the typing lisp expressions into the Executive

Window (The top level), in addition to the break menu functions. Each consecutive break will move to another level "down".

Figure 10-1. Break Window

Move the mouse cursor into the break window and hold down the middle mouse button.

The Break Menu will appear. Choose BT. Another menu, called the stack menu, will appear beside the break window. Choosing stack items from this menu will display

another window. This window displays the function’s local variable bindings, or values (see Figure 10-2). This new window, titled FACTORlAL Frame, is an inspector window (see inspector Chapter 17).

Figure 10-2. Back Trace of the System Stack

From the break window, you can call the editor for the function FACTORIAL by middle- buttoning on the word FACTORIAL and selecting DisplayEdit from the menu that pops up.

Replace the unbound atom DUMMY with 1. Exit the editor .

The function is fixed, and you can restart it from the last call on the stack. (It does not have to be started again from the Top Level.) To begin again from the last call on the stack, choose the last (top) FACTORIAL call in the BT menu. Select REVERT from the middle button break window, or type it into the window. The break window will close, and a new one will appear with the message: Breakpoint at FACTORIAL

To start execution with this last call to FACTORIAL , choose OK from the middle button break menu. The break window will disappear, and the correct answer, 24, will be

returned to the top level.

BREAKPACKAGE

Ways to Stop Execution from the Keyboard (Breaking Lisp)

There are ways you can stop execution from the keyboard. They differ in terms of how much of the current operating state is saved:

Control-G Provides you with a menu of processes to interrupt. Your process will
usually be "EXEC". Choose it to break your process. A break window will then appear.
Control-B Causes your function to break, saves the stack, then displays a break window with all the usual break functions. For information on other interrupt characcers, see Chapter 30 in the IRM.

Break Menu

Move the mouse cursor into the break window. Hold the middle button down, and a new menu will pop up, like the one in Figure 10-3.

Figure 10-3. Middle Button Menu in Break window
Five of the selections are particularly important when just starting to use Medley:
BT Back Trace displays the stack in a menu beside the break window. Back
Trace is a very powerful debugging tool. Each function call is placed on the
stack and removed when the execution of that function is complete. Choosing an item on the stack will open another window displaying that item’s local
variables and their bindings. This is an inspector window that offers all the power of the inspector. (For details, see the section on the Inspector, Chapter 17.)
? = Before you use this menu option, display the stack by choosing BT from this menu, and choose a function from it. Now, choose ?=. It will display the
current values of the arguments to the function that has been chosen from the stack.
 Move back to the previous break window, or if there is no other break window, back to the top level, the Executive Window.
REVERT Move the point of execution back to a specified function call before the error. The function to revert back to is, by default, the last function call before the break. If, however, a different function call is chosen on the BT menu, revert will go back to the start of this function and open a new break window. The
items on the stack above the new starting place will no longer exist. This is used in the tutorial example (see the Break Package Example section above).

OK Continue execution from the point of the break. This is useful if you have a simple error, i.e., an unbound variable or a nonnumeric argument to an
arithmetic function. Reset the variable in the break window, then select OK. (see the Break Package Example section above).
In addition to being available on the middle button menu of the break window, all of these functions can be typed directly into the window. Only BT behaves differently
when typed. It types the stack into the trace window instead of opening a new window.)

Returning to Top Level
Typing Control-D will immediately take you to the top level from any break window.
The functions called before the break will stop, but any side effect s of the function that occurred before the break remain. For example, if a function set a global variable before it broke, the variable will still be set after typing Control-D.
WHAT TO DO IF ...

The purpose of this chapter is to explain what to do in some of the problems commonly experienced by Medley users.

Executive Window turns black
An example is shown in Figure 11-1.
Press any key to unfreeze the window and continue. This pause happens when the command you just typed causes enough information to be printed to fill the window. It gives you a chance to read that one window of text before moving on.

Figure 11-1. Blackened Executive Window

You closed the Executive Window
Open another from the Background Menu.

Mouse disappears
Type (CURSOR T) in the Executive Window. The cursor will reappear.

Second window appears
This probably happens because you made a typing mistake, as in Figure 11-2.

Figure 11-2. Second Window Appears (Break Window) after Typing Error Made
Type a Control-D by simultaneously pressing the Control key and the "D". This aborts the error condition, returning control to the Executive Window.

You keep getting beeped at
Usually the beeping means that Medley want input from you. Look for the flashing
caret. It will usually be preceeded by some kind of prompt, indicating what you should type.

You cannot delete the first letter
of the filename you are typing to (FILES?) . Type Control-E (error) You will get a linefeed and  printed to the window. Now type the correct filename.
Your function is just sitting there
It is not returning a value, and you think that your program may be in an infinite loop or is having some other major problem. You can see what process is currently running by typing Control-T, or you could interrupt the process by typing Control-E.

A Break Window appears
If the Break Window look something like that shown in Figure 11-3, you are trying to save a file, but there is not enough space on the hard disk.

Figure 11-3. Break Window Caused by Insufficient Space in Save File
Exit from the Break Window by typing an up arrow  followed by a Return. Delete old versions of files, and any other files you do not need. Then try again to save the file

You have run out of space
Generally, a Break Window has appeared. The GAINSPACE function allows you to delete non-essential data structures. To use it, type:
(GAINSPACE)
into the Executive Window. Answer N to all questions except the following:
- Delete edit history
- Delete history list
- Delete values of old variables
- Delete your MASTERSCOPE database
- Delete information for undoing your greeting. Save your work and reload Lisp as soon as possible.
  A redefined message appears
  The message (Some.Crucial.Function.Or.Variable redefined) appears in the
  Executive Window (see Figure 11-4). The function, variable, or other property has been "smashed" (i.e., its original definition has been changed). If this is not what you
  wanted, type UNDO immediately!
  1. WHAT TO DO IF...
    
    Figure 11-4. CAR redefined!
    
    UNBOUND ATOM
    If this occurs, you probably just typed something wrong, or you passed an argument that should have been quoted to a function.
    
    UNDEFINED CAR OF FORM
    First, look at what caused the error. If the CAR of the form is a list, then you typed something wrong. If it is an atom, then perhaps that atom does not have a function associated with it. If it is a CLISP word like if or for, then DWIM may have been
    turned off (see Chapter 9). Type (DWIM ’C) to reenable DWIM.
    
    You have traced APPLY
    and your screen is spewing out information about everything going on in the
    environment. Type Control E, and type (UNBREAK ’APPLY) before reeturning to the Executive.
    
    [This page intentionally left blank]
  2. WINDOWS AND REGIONS
    
    Windows
    
    Windows have two basic parts: an area on the screen containing a collection of pixels,
    and a property list. The window properties determine how the window looks, the menus that can be accessed from it, what should happen when the mouse is inside the window and a mouse button is pressed, and soon.
    
    CREATEW
    Some of the window’s properties can be specified when a window is created with the function CREATEW. In particular, it is easy to specify the size and position of the
    window; its title; and the width of its borders.
    (CREATEW region title borderw’idth)
    
    Region is a record (named REGION , with the fields left, bottom , width, and height) or a list. A region describes a rectangular area on the screen, the window’s dimensions and position. The fields left and bottom refer to the position of the bottom leff corner of
    the region on the screen. Wi dth and height refer to the width and height of the region. The usable space inside the window will be smaller than the width and height, because some of the window’s region is consumed by the title bar, and some is taken by the
    borders.
    
    Title is a string that will be placed in the title bar of the window.
    
    Borderwidth is the width of the border around the exterior of the window, in number of pixels.
    
    For example, typing:
    (SETQ MY.WINDOW (CREATEW (CREATEREGION l00 150 300 200) "THIS IS MY OWN WINDOW")
    or
    (SETQ MY.WINDOW (CREATEW
    (CREATEW ’(100 150 300 200) "THIS IS MY OWN WINDOW")
    produces a window with a default borderwidth. Note that you did not need to specify all the window’s properties (see Figure 12-1).
    
    Figure 12-1. Creating a Window
    
    In fact, if (CREATEW) is called without specifying a region, you will be prompted to sweep out a region for the window (see Chapter 10)
    
    WlNDOWPROP
    The function to access or add to any property of a window’s property list is
    WINDOWPROP.
    (WINDOWPROP window property <value>)
    
    When you use WINDOWPROP with only two arguments—window and property—it
    returns the value of the window’s property. When you use WINDOWPROP with all three
    arguments—window, property and value—it sets the value the window’s property to the value you inserted for the third argument.
    
    For example, consider the window, MY WINDOW , created using (CREATEW). TITLE and
    REGION are both properties. Type
    (WINDOWPROP MY.WINDOW ’TITLE)
    and the value of MY.WlNDOW’s TITLE property is returned, "THIS 1S MY OWN WINDOW". To change the title, use the WINDOWPROP function, and give it the window, the property title, and the new title of the window.
    (WINDOWPROP MY.WINDOW ’TITLE "MY FIRST WINDOW")
    automatically changes the title and automatically updates the window. Now the window looks like Figure 12-2.
    
    Figure 12-2. TITLE is a Window Property
    Altering the region of the window, MY.WINDOW, is also be done with WINDOWPROP, in the same way you changed the title. (Changing either of the first two numbers of a region
    changes the position of the window on the screen. Changing either of the last two numbers changes the dimensions of the window itself.)
    
    Getting Windows to Do Things
    Four basic window properties will be discussed here: CURSORINFN , CURSOROUTFN, CURSORMOVEDFN, and BUTTONEVENTFN.
    A function can be stored as the value of the CURSORlNFN property of a window. It is called when the mouse cursor is moved into that window.
    Look at the following example:
    1. First, create a window called MY.WINDOW. Type:
      (SETQ MY.WINDQW
      (CREATEW
      (CREATEREGION 200 200 200 200) "THIS WINDOW WILL SCREAM!"))
      This creates a window.
    2. Now define the function SCREAME R. It will be stored on the property CURSOR1NFN . (Notice that this function has one argument, WlNDOWNAM E. All functions called from the property CURSOR1NFN are passed the window it was called from. So the value of MY.WINDOW is bound to WINDOWNAME. When it is called, SCREAMER simply rings
      bells.
      
      (DEFINEQ (SCREAMER (WINDOWNAME) (RINGBELLS)
      (PROMPTPRINT "YAY - IT WORKS!") (RINGBELLS)))
    3. Now, alter that window’s CURSORINFN property, so that the system calls the function SCREAMER at the appropriate time. Type:
      (WINDOWPROP MY.WINDOW ’CURSORINFN (FUNCTION SCREAMER))
    4. After this, when you move the mouse cursor into MY.WlNDOW , the CURSORINFN
      property’s function is called, and it rings bells twice.
      
      CURSORINFN is one of the many window properties that come with each window - just as REGION and TITLE did. Other properties include:
      CURSOROUTFN The function that is the value of this property is executed when the cursor is moved out of a window.
      CURSORMOVEDFN The function that is the value of this property is executed when the cursor is moved while it is inside the window.
      BUTTONEVENTFN The function that is the value of this property is executed when either the left or middle mouse buttons are pressed (or released).
      
      Figure 12-3 shows MY.WlNDOW’s properties. Notice that the CURSORINFN has the
      function SCREAMER stored in it. The properties were shown in this window using the function INSPECT. INSPECT is covered in Chapter 17.
      
      Figure 12-3. Inspecting MY.WINDOW for Mouse-Related Window Properties
      
      You can define functions for the values of the properties CURSOROUTFN and CURSORMOVEDFN in much the same way as you did for CURSORINFN. The function that is the value of the property BUTTONEVENTF N, however, can be specialized to respond in different ways, depending on which mouse button is pressed. This is explained in the
      next section.
      
      BUTTONEVENTFN
      
      BUTTONEVENTFN is another property of a window. The function that is stored as the value of this property is called when tho mouse is inside the window, and a mouse button is pressed. As an example of how to use it, type:
      (WINDOWPROP MY.WINDOW ’BUTTONEVENTFN (FUNCTION SCREAMER))
      When the mouse cursor is moved into the window, bells will ring because of the CURS0RlNFN, but it will also ring bells when either the left or middle mouse button is pressed. Notice that the right mouse button functions as it usually does, with the
      window manipulation menu. If only the left button should evoke the function SCREAMER, then the function can be written to do just this, using the function MOUSESTATE, and a form that only MOUSESTATE understands, ONLY. For example:
      (DEFINEQ
      (SCREAMER2 (WINDOWNAME)
      (if (MOUSESTATE (ONLY LEFT)) then (RINGBELLS))))
      
      In addition to (ONLY LEFT), MOUSESTATE can also be passed (ONLY MIDDLE) , (ONLY RIGHT) or combinations of these (e.g. (OR (ONLY LEFT) (ONLY MIDDLE))). You do not need to use ONLY with MOUSESTATE for every application. ONLY means that that
      button is pressed and no other.
      If you do write a function using (ONLY RIGHT), be sure that your function also checks position of the mouse cursor. Even if you want your function to be executed when the mouse cursor is inside the window and the right button is pressed, there is a convention that the function DOWINDOWCOM should be executed when the mouse cursor is in the
      title bar or the border of the window and the right mouse button is pressed. Please
      program your windows using this tradition! For more information, please see Chapter 28 in the IRM.
      
      Looking at a Window’s Properties
      INSPECT is a function that displays a list of the properties of a window, and their values. Figure 12.3 shows the INSPECT function run with MY.WINDOW . Note the
      properties introduced in CREATEW : WBORDER is the window’s border, REG is the region, and WTITLE is the window’s title.
      
      Regions
      
      A region is a record, with the fields LEFT, BOTTOM , WIDTH, and HEIGHT. LEFT and BOTTOM refer to where the bottom left hand corner of the region is positioned on the screen. WIDTH and HEIGHT refer to the width and height of the region.
      
      CREATEREGION creates an instance of a record of type REGION . Type:
      (SETQ MY.REGION (CREATEREGION 15 l00 200 450))
      to create a record of type REGION that denotes a rectangle 200 pixels high, and 450 pixels wide, whose bottom left corner is at position (15, 100). This record instance can be passed to any function that requires a region as an argument, such as CREATEW , above.
  3. WHAT ARE MENUS?
    
    While Medley provides a number of menus of its own (see Chapter 3), this section
    addresses the menus you wish to create. You will learn how to create a menu, display a menu, and define functions that make your menu useful. Menus are instances of
    records (see Chapter 24). There are 27 fields that determine the composition of every menu. Because Medley provides default values for most of these descriptive fields, you need to familiarize yourself with only a few that we describe in this section.
    Two of these fields, the TITLE of your menu, and the ITEMS you wish it to contain, can be typed into the executive window as shown below:
    Figure 13-1. Creating a menu
    Note that creating a menu does not display it. MY.MENU is set to an instance of a menu record that specifies how the menu will look, but the menu is not displayed.
    
    Displaying Menus
    
    Typing either the MENU or ADDNENU functions will display your menu on the screen. MENU implements pop-up menus, like the Background Menu or the Window Menu. ADDMENU puts menus into a semi-permanent window on the screen, and lets you select items from it.
    (MENU MENU POSITION) pops up a menu at a particular position on the screen. Type:
    (MENU MY.MENU NIL)
    to position the menu at the end of the mouse cursor. Note that the POSITION argument is NIL. In order to go on, you must either choose an item, or move outside the menu
    window and press a mouse button. When you do either, the menu will disappear. If you choose an item, then want to choose another, the menu must be redisplayed.
    (ADDMENU menu window position) positions a permanent menu on the screen, or in an existing window.
    Type:
    (ADDMENU MY.MENU)
    to display the menu as shown in Figure 13-2. This menu will remain active, (will stay on the screen) without stopping all the other processes. Because ADDMENU can display a menu without stopping all other processes, it is very popular in users programs.
    
    If window is specified, the menu is displayed in that window. If window is not specified, a window the correct size for the menu is created, and the menu is displayed in that
    window.
    If position is not specified, the menu appears at the current position of the mouse cursor.
    
    Figure 13-2. Simple MenuDisplayed with ADDMENU
    
    Getting Menus to Do Stuff
    One way to make a menu do things is to specify more about the menu items. Instead of items simply being the strings or atoms that will appear in the menu, items can be lists, each list with three elements (see Figure 13-3). The first element of each list is what
    will appear in the menu; the second expression is what is evaluated, and the results of the evaluation returned, when the item is selected; and the third expression is the
    expression that should be printed in the Prompt window when a mouse button is held down while the mouse is pointing to that menu item. This third item should be thought of as help text for the user. If the third element of the list is NIL, the system responds with Will select this item w hen you release the button.
    
    Figure 13-3. Creating a Menu to do Things, then displaying it with the function
    ADDMENU
    
    Now when an item is selected from MY.MENU2, something will happen. When a mouse button is held down, the expression typed as the third element in the item’s
    specification will be printed in the Prompt window. (See Figure 13-4.)
    
    Figure 13-4. Mouse Button Held Down While Mouse Cursor SeIects NEXT.QUESTION
    
    When the mouse button is released (i.e., the item is selected) the expression that was typed as the second element of the item’s specification will be run. (See Figure 13-5.)
    Figure 13-5. NEXT-QUESTION Selected
    
    WHENHELDFN and WHENSELECTEDFN Fields of a Menu
    Another way to get a menu to do things is to define functions, and make them the
    values of the menu’s WHENHELDFN and WHENSELECTEDFN fields. As the value of the
    WHENHELDFN field of a menu, the function you defined will be executed when you press
    and hold a mouse button inside the menu. As the value of the WHENSELECTEDFN field of a menu, the function you defined will be executed when you choose a menu item. This
    example has the same functionality as the previous example, where each menu item was entered as a list of three items.
    As an example, type in these two functions so that they can be executed when the menu is created and displayed:
    
    (DEFINEQ (MY.MENU3.WHENHELD (ITEM.SELECTED MENU.FROM BUTTON.PRESSED)
    (SELECTQ ITEM.SELECTED
    (QUIT (PROMPTPRINT "CHOOSE THIS TO STOP")
    (NEXT-QUESTION (PROMPTPRINT "CHOOSE THIS TO BE ASKED THE NEXT QUESTION"))
    (NEXT-TOPIC (PROMPTPRINT "CHOOSE THIS TO MOVE ON TO THE NEXT SUBJECT"))
    (SEE-TOPICS (PROMPTPRINT "CHOOSE THIS TO SEE THE TOPICS NOT YET LEARNED"))
    (ERROR (PROMPTPRINT "NO MATCH FOUND"))))
    
    (DEFINEQ (MY.MENU3.WHENSELECTED (ITEM.SELECTED MENU.FROM BUTTON.PRESSED)
    (SELECTQ ITEM.SELECTED
    (QUIT (PRINT "STOPPED")
    (NEXT-QUESTION (PRINT "HERE IS THE NEXT QUESTION")) (NEXT-TOPIC (PRINT "HERE IS THE NEXT SUBJECT")) (SEE-TOPICS (PRINT "THE FOLLOWING HAVE NOT BEEN
    LEARNED . . ."))
    (ERROR (PROMPTPRINT "NO MATCH FOUND"))))
    
    Now, to create the menu, type:
    (SETQ MY.MENU3 (CREATE MENU
    TITLE  "PLEASE CHOOSE ONE OF THE ITEMS"
    ITEMS  ’(QUIT NEXT-QUESTION NEXT-TOPIC SEE-TOPICS) WHENHELDFN  (FUNCTION MY.MENU3.WHENHELD) WHENSELECTEDFN  (FUNCTION MY.MENU3.WHENSELECTED)))
    To see your menu work, type
    (ADDMENU MY.MENU3)
    Now, due to executing the WHENHELDFN function, holding down any mouse button while pointing to a menu item will display an explanation of the item in the prompt window.
    The screen will once again look like Figure 13-4 when the mouse button is held when the mouse cursor is pointing to the item NEXT-TOPIC .
    Now due to executing the WHENSELECTEDFN function, releasing the mouse button to select an item will cause the proper actions for that item to be taken. The screen will once again look like Figure 13-5 when the item NEXT-TOPIC is selected. The crucial
    thing to note is that the functions you defined for WHENHELDFN and WHENSELECTEDFN
    are automatically given the following arguments:
    1. The item that was sølected, ITEM.SELECTED
    2. The menu it was selected from, MENU.FROM
    3. The mousø button that was pressed BUTTON PRESSED
      These functions, MY.MENU3.WHENHELD and MY.MENU3.WHENSELECTED, were quoted
      using FUNCTION instead of QUOTE both for program readability and so that the compiler can produce faster code when the program is compiled. It is good style to quote
      functions in Lisp by using the function FUNCTION instead of QUOTE.
      
      Looking at a Menu’s Fields
      INSPECT is a function that displays a list of the fields of a menu, and their values. Figure 13-6 shows the various fields of MY.MENU3 when the function (INSPECT
      MY.MENU3) was called. Notice the values that were assigned by the examples, and all the defaults.
      Figure 13-6. MY.MENU3 Fields
  4. BITMAPS
    
    A bitmap is a rectangular array of dots. The dots are called "pixels" (for picture
    elements). Each dot, or pixel, is represented by a single bit. When a pixel or bit is turned on (i.e. that bit set to 1), a black dot is inserted into a bitmap. If you have a bitmap of a floppy on your screen (Figure 14-1), then all of the bits in the area that make up the floppy are turned on, and the surrounding bits are turned off.
    
    Figure 14-1. Bitmap of a Floppy
    
    BITMAPCREATE creates a bitmap, even though it can’t be seen.
    (BITMAPCREATE width height)
    If the width and height are not supplied, the system will prompt you for them.
    EDITBM edits the bitmap. The syntax of the function is:
    (EDITBM bitmapname)
    Try the following to produce the results in Figure 14-4:
    (SETQ MY.BITMAP (BITMAPCREATE 60 40)) EDITBM MY.BITMAP)
    
    To dra w In the bitmap, move the mouse into the gridded section of the bitmap editor, and press and hold the leff mouse button. Move the mouse around to turn on the bits
    represented by the spaces in the grid. Notice that each space in the grid represents one pixel on the bitmap
    To erase Move the mouse into the gridded section of the bitmap editor, and press and hold the center mouse button. Move the mouse around to turn off the bits represented by the spaces in the gridded section of the bitmap editor.
    
    To w ork on a different section Point with the mouse cursor to the picture of the
    actual bitmap (the upper left corner of the bitmap editor). Press and hold the left mouse button. A menu with the single item, Move will appear. (See Figure 14-2.) Choose this
    item.
    
    Figure 14-2. Menu with Single Item (Move)
    
    You will be asked to position a ghost window over the bitmap. This ghost window
    represents the portion of the bitmap that you are currently editing. Place it over the
    section of the bitmap that you wish to edit and click the left mouse button (see Figure 14-3).
    
    Figure 14-3. Ghost Window Awaiting Positioning
    
    To end the session, bring the mouse cursor into the upper-right portion of the window (the grey area) and press the center button. Select OK from the menu to save your
    artwork.
    
    Figure 14-4. Editing a Bitmap
    
    BITBLT is the primitive function for moving bits (or pixels) from one bitmap to another.
    It extracts bits from the source bitmap, and combines them in appropriate ways with those of the destination bitmap. The syntax of the function is:
    
    (BITBLT sourcebitmap sourcelefl sourcebottom destinationbitmap destinationleft destinationbottom width height sourcetype operation texture clippIngregion)
    
    Here’s how it’s done —using MY.BITMAP as the sourcebitmap and MY.WlNDOW as the destinationbitmap.
    (BITBLT MY.BITMAP NIL NIL
    MY.WINDOW NIL NIL NIL NIL ‘INPUT ‘REPLACE)
    
    Note that the destination bitmap can be, and usually is, a window. Actually, it is the bitmap of a window, but the system handles that detail for you. Because of the NILs
    (meaning "use the default"), MY.BITMAP will be BITBLT’d into the lower right corner of
    MY.WlNDOW (see Figure 14-5).
    
    Figure 14-5. BITBLT ing a Bitmap onto a Window Here is what each of the BITBLT arguments to the function mean:
    sourcebitmap The bitmap to be moved into the destinationbitmap
    sourceleft A number, starting at 0 for the left edge of the
    sourcebitmap, that tells BITBLT where to start moving pixels from the sourcebitmap. For example, if the leftmost 10 pixels of sourcebitmap were not to be moved, sourceleft should be 10. The default value is 0.
    sourcebottom A number, starting at 0 for the bottom edge of the
    sourcebitmap, that tells BITBLT where to start moving pixels from the sourcebitmap. For example, if the bottom 10 rows of pixels of sourcebitmap were not to be moved, sourcebottom should be 10 The default value is 0.
    destinationbitmap The bitmap that will receive the sourcebitmap. This is
    often a window (actually the bitmap of a window, but Interlisp-D takes care of that for you).
    destinationleft A number, starting at 0 for the left edge of the
    destinationbitmap, that tells BITBLT where to start placing pixels from the sourcebitmap. For example, to place the
    sourcebitmap 10 pixels in from the left, destinationleft should be 10. The default value is 0.
    
    destinationbottom A number, starting at 0 for the bottom edge of the
    destinationbitmap, that tells BITBLT where to start placing pixels from the sourcebitmap. For example, to place the
    sourcebitmap 10 pixels up from the bottom,
    destinationbottom should be 10. The default value is 0.
    width How many pixels in each row of sourcebitmap should be moved. The samc amount of space is used in
    destinationbitmap to receive the sourcebitmap. If this
    argument is NIL, it defaults to the number of pixels from sourceleft to the end of the row of sourcebitmap.
    height How many rows of pixels of sourcebitmap should be moved.
    The same amount of space is used in destinationbitmap to receive the sourcebitmap. If this argument is NIL, it
    defaults to the number of rows from sourcebottom to the top of the sourcebitmap.
    sourcetype Refers to one of three ways to convert the sourcebitmap for
    writing. For now, just use ’INPUT.
    operation Refers to how the sourtebitmap gets BITBLT ’d on to the destinationbitmap. ’REPLACE will BLT the exact
    sourcebitmap. Other operations allow you to AND, OR or XOR the bits from the sourcebitmap onto the bits on the destinationbitmap.
    texture J ust use NIL for now.
    clippingregion J ust use NIL for now.
    
    For more information on these operations, see Chapter 27 in the IRM.
  5. DISPLAYSTREAMS
    
    A displaystream is a genera Jized "place to display". They determine exactly what is displayed where. One example of a displaystream is a window. Windows are the only
    displaystreams that will be used in this chapter. If you want to draw on a bitmap that is not a window, other than with BITBLT, or want to use other types of displaystreams, please refer to Chapter 27 in the IRM.
    
    This chapter explains functions for drawing on displaystreams: DRAWLINE , DRAWTO, DRAWCIRCLE., and FILLCIRCLE. In addition, functions for locating and changIng your curreAt position in the displaystream are covered: DSPXPOSITION , DSPYPOSITION, and MOVETO.
    
    Drawing on a Displaystream
    
    The examples belowshow you how the functions for drawing on a display stream work. First, create a window. Windows are displaystreams, and the one you create are used for the examples in this chapter. Type:
    (SETQ EXAMPLE.WINDOW (CREATEW))
    
    DRAWLlNE
    
    DRAWLINE draws a line in a displaystream. For example, type:
    (DRAWLINE 10 15 100 150 5 ’INVERT EXAMPLE.WINDOW)
    The results should look like Figure 15-1:
    Figure 15-1. Line Drawn onto the EXAMPLE.WINDOW Displayrtream The syntax of DRAWLINE is
    (DRAWLINE x1 y1 x2 y2 width operation stream color dashing)
    The coordinates of the left bottom corner of the displaystream are 0 0.
    
    xl and yl x and y coordinates of the beginning of the line x2andy2 ending coordinates of the line
    width width of the line, in pixels
    operation way the line is to be drawn. INVERT causes the line to invert the bits that are already in the displaystream. Drawing a line the second time using INVERT erases the line. For other operations, see Chapter 27 in the IRM.
    stream displaystream. In this case, you used a window.
    
    DRAWTO
    
    DRAWTO draws a line that begins at your current position in the displaystream. For example, type:
    (DRAWTO 120 135 5 ’INVERT EXAMPLE.WINDOW)
    The results should look like Figure 15-2:
    
    Figure 15-2. Another Line drawn onto the EXAMPLE.WINDOW Displaystream The syntax of DRAWTO is
    (DRAWTO x y width operation stream color dashing)
    
    The line begins at the current position in the displaystream. x x coordinate of the end of the line
    y y coordinate of the end of the line
    width width of the line
    operation way the lino is to be drawn. INVERT causes the line to invert the bits that aro already in tho displaystream. Drawing a line the second time using INVERT erases the line. For other operations, see Chapter 27 in the IRM
    stream displaystreom. In this case. you used a window.
    
    DRAWClRCLE
    
    DRAWCIRCLE draws a circle on a displaystream. To use it, type:
    (DRAWCIRCLE 150 100 30 ’(VERTICAL 5) NIL EXAMPLE.WINDOW)
    Now your window, EXAMPLE.WlNDOW, should look like Figure 15-3:
    
    Figure 15-3. Circle Drawn onto the EXAMPLE.WlNDOW Displaystream The syntax of DRAWCIRCLE is
    (DRAWCIRCLE centerx centery radius brush dashing stream) centerx x coordinate of the center of the circle
    centery coordinate of the center of the circle radius radius of the circle in pixels
    brush list.- The first- item of the list is the shape of the brush. Some of your
    options include ROUND, SQUARE, and VERTICAL. The second item of that list is the width of the brush in pixels.
    dashing list of positive integers. The brush is "on" for the number of units
    indicated by the first element of the list, "off" for the number of units
    indicated by the second element of the list. The third element specifies how long it will be on again, and so forth. The sequence is repeated until the circle has been drawn.
    stream displaystream. In this case, you used a window.
    
    FlLLClRCLE
    
    FILLCIRCLE draws a filled circle on a displaystream. To use it, type:
    (FILLCIRCLE 200 150 10 GRAYSHADE EXAMPLE.WINDOW)
    EXAMPLE.WlNDOW now looks like Figure 15-4:
    
    Figure 15-4. A filled circle drawn onto the displaystream The syntax of FILLCIRCLE is:
    (FILLCIRCLE centerx centery radius texture stream) centerx x coordinate of the center of the circle
    centery y coordinate of the center of the ci rcle radius radius of the circle in pixels
    texture shade that will be used to fill in the circle. Interlisp-D provides you with
    three shades: WHlTESHADE , BLACKSHADE, and GRAYSHADE. You can also create your own shades. For more information on how to do this, see
    Chapter 27 in the IRM.
    stream displaystream. In this case, you used a window
    There are many other functions for drawing on a displaystream. Please refer to Chapter 27 in the IRM.
    Text can also be placed into displaystreams. To do this, use printing functions such as PRIN1 and PRIN2, but supply the name of the displaystream as the "file" to print to. To place the text in the proper position in the displaystream, see the section below.
    
    Locating and Changing Your Position in a Displaystream
    
    There are functions provided to locate, and to change your current position in a
    displayitream. This can help you place text, and other images where you want them in
    a displaystream. This primer will only discuss three of these. There are others, and they can be foun d in the Chapter 27 of the IRM.
    
    DSPXPOSlTlON
    DSPXPOSITION is a function that will either change the current x position in a
    displaystream, or simply report it. To have the function report the current x position in
    EXAMPLE.WlNDOW, type:
    (DSPXPOSITION NIL EXAMPLE.WINDOW)
    
    DSPXPOSITION expects two arguments. The first is the new x position. If this argument is NIL, the current position is not changed, merely reported. The second argument is
    the displaystream.
    
    DSPYPOSlTlON
    DSPYPOSITION is an analogous function, but It changes or reports the current y
    position in a displaystream. As with DSPXPOSlTlON , if the first argument is a number, the current y position will be changed to that position. If it is NIL, the current position is simply reported. To have the function report the current y position in EXAMPLE.WlNDOW, type:
    (DSPYPOSITION NIL EXAMPLE.WlNDOW)
    
    MOVETO
    The function MOVETO always changes your position in the displaystream. It expects three arguments:
    (MOVETO x y stream)
    1. new x position in the display stream
    2. new y position in the display stream
    stream display stream. The examples so far have used a window
  6. FONTS
    
    This chapter explains font s and font descriptors, what they are and how to use them, so that you can use functions requiring font descriptors
    You have already been exposed to many font s in Medley. For example, when you use the structure editor, DEdit (see the Using the List Structure Editor section of Chapter 7), you noticed that the comments were printed in a smaller font than the code, and
    that CLlSP words (see the CLISP section of Chapter 9) were printed in a darker font
    than the other words in the function. These are only some of the font s that are available in Medley.
    In addition to the font s that appear on your screen, Medley uses font s for printers that are different than the ones used for the screen. The font s used to print to the screen are called DlSPLAYFONTS. The font s used for prining are called INTERPRESSFONTS , or PRESSFONTS, depending on the type of printer.
    
    What Makes Up a Font
    
    Fonts are described by family, weight, slope, width, and size. This section discusses each of these, and describes how they affect the font you see on the screen.
    Family is one way that font s can differ. Here are some examples of how "family" affect s the look of a font:
    CLASSIC This family makes the word "Able" look like this: Able MODERN This family makes the word "Able" look like this: Able TITAN This family makes the word "Able" look like this: Able
    Weight also determines the look of a font. Once again, "Able" will be used as an example, this time only with the Classic family. A font’s weight can be:
    BOLD And look like this: Able
    MEDIUM
    or REGULAR And look like this: Able
    The slope of a font is italic or regular. Using the Classic family font again, in a regular weight, the slope affect s the font like this:
    ITALIC Looks like this: Able
    REGULAR Looks like this: Able
    The width of a font is called its "expansion". It can be COMPRESSED , REGULAR, or
    EXPANDED.
    Together, the weight, slope, and expansion of a font specifies the font’s "face". Specifically, the face of a font is a three element list:
    (weight slope expansion)
    To make it easier to type, when a function requires a font face as an argument, it can be abbreviated with a three-character atom. The first specifies the weight, the second the
    
    slope, and the third character the expansion. For example, some common font faces are abbreviated:
    MRR This is the usual face, MEDIUM, REGULAR, REGULAR
    MIR Makes an italic font. It stands for: MEDIUM , ITALIC, REGULAR
    BRR Makes a bold font. The abbreviation means: BOLD, REGULAR , REGULAR BIR Means that the font should be both bold and italic. BIR stands for BOLD,
    ITALIC, REGULAR
    The above examples are used so oflen, that there are also more mnemonic abbreviations for them. They can also be used to specify a font face for a function that requires a face as an argument. They are:
    
    STANDARD This is the usual face: MEDIUM, REGULAR, REGULAR; it was abbreviated above, MRR
    ITALIC This was abbreviated above as MIR, and specifies an italic font
    BOLD Makes a bold font; it was abbreviated above, BRR
    BOLDITALIC Makes a font both bold and italic: BOLD, ITALIC , REGULAR; it was abbreviated above, BIR
    A font also has a size. It is a positive integer that specifies the height of the font in
    printers points. A point is, on an 1108 screen, about 1/72 of an inch. On the screen of an 1186, a point is 1/80 of an inch. The size of the font used in this chapter is 10. For
    comparison, here is an example of a TITAN, MRR, size 12 font: Able.
    
    Fontdescriptors and FONTCREATE
    For Medley to use a font, it must have a font descriptor. A font descriptor is a data type in Interlisp-D that that holds all the information needed in order to use a particular font. When you print out a font descriptor, it looks like this:
    {FONTDESCRIPTOR}#74,45540
    Fontdescriptors are created by the function FONTCREATE . For example,
    (FONTCREATE ’HELVETICA 12 ’BOLD)
    creates a font descriptor that, when used by other functions, prints in HELVETICA BOLD size 12. Interlisp-D functions that work with font s expect a font descriptor produced
    with the FONTCREATE function. The syntax of FONTCREATE is:
    (FONTCREATE family size face)
    Remember from the previous section, face is either a three element list (weight slope expansion), a three character atom abbreviation, e.g. MRR, or one of the mnemonic
    abbreviations, e.g. STANDARD .
    If FONTCREATE is asked to create a font descriptor that a J ready exists, the existing font descriptor is simply returned.
    
    Display Fonts
    Display font s require files that contain the bitmaps used to print each character on the screen. All of these files have the extension .DlSPLAYFONT . The file name itself
    describes the font style and size that uses its bitmaps. For example:
    MODERN12.DISPLAYFONT
    contains bitmaps for the font family MODERN in size 12 points. Wherever you put your
    .DISPLAYFONT files, you should make this one of the values of the variable DISPLAYFONTDIRECTORIES. Its value is a list of directories to search for the bitmap files for display font s. Usually, it contains the "FONT" directory where you copied the bitmap files, and the current connected directory. The current connected directory is
    specified by the atom NIL. When looking for a .DISPLAYFONT file, the system checks the FONT directory on the hard disk, then the current connected directory.
    Figure 16-1 shows an example value of DISPLAYFONTDIRECTORIES :
    
    Figure 16-1. Value for the Atom DISFLAYFONTDIRECTORIES
    
    InterPress Fonts
    InterPress is the format that is used by Xerox laser printers. These printers normally have a resolution that is much higher than that of the screen: 300 points per inch.
    To format files appropriately for output on such a printer, Interlisp must know the
    actual size for each character that is to be printed. This is done through the use of width files that contain font width information for font s in InterPress format. For InterPress font s, you should make the location of these files one of the values of the variable INTERPRESSFONTDIRECTORIES. Its value is a list of directories to search for the font widths files for InterPress font s. Figure 16-2 is an example value of INTERPRESSFONTDIRECTORIES:
    
    Figure 16-2. Value for Atom INTERPRESSFONTDIRECTORIES
    
    Functions for Using Fonts
    
    FONTPR0P Looking at Font Properties
    It is possible to see the properties of a font descriptor. This s done with the function FONTPROP. For the following examples, the font descriptor used will be the one returned by the function (DEFAULTFONT ’DISPLAY) . In other words, the font descriptor
    examined will be the default display font for the system.
    There are many properties of a font that might be useful for you. Some of these are:
    
    FAMILY To see the family of a font descriptor, type:
    (FONTPROP (DEFAULTFONT ’DISPLAY) ’FAMILY)
    SIZE As above, this is a positive integer that determines the height of the font in printer’s points. As an example, the SIZE of the current default font is:
    
    Figure 16-3. Value of Font Property SIZE of Default Font
    ASCENT The value of this property is a positive integer, the maximum height of
    any character in the specified font from the baseline (bottom). The top of
    
    the tallest character in the font, then, will be at (BASELINE + ASCENT
    - l). For example, the ASCENT of the default font is:
    
    Figure 16-4. Value Font Property ASCENT of Default Font
    DESCENT The DESCENT is an integer that specifies the maximum number of points that a character in the font descends below the baseline (e.g.,
    letters such as "p" and "g" have tails that descend below the baseline.). The bottom of the lowest character in the font will be at (BASELINE - DESCENT). To see the DESCENT of the default font, type:
    (FONTPROP (DEFAULTFONT ’DISPLAY) ’DESCENT) HEIGHT HEIGHT is equal to (DESCENT - ASCENT).
    FACE The value of this property is a list of the form (weight slope expansion). These are the weight, slope, and expansion described above. You can see each one separately, also. Use the property that you are interested in, WEIGHT, SLOPE, or EXPANSION, instead of FACE as the second argument to FONTPROP.
    For other font properties, see Chapter 27 of the IRM.
    
    STRlNGWlDTH
    It is often useful to see how much space is required to print an expression in a particular font. The function STRINGWIDTH does this. For example, type:
    (STRINGWIDTH "Hi there!" (FONTCREATE ’GACHA 10 ’STANDARD))
    The number returned is how many left to right pixels would be needed if the string
    were printed in this font. (Note that this doesn’t just work for pixels on the screen, but for all kinds of streams. For more information about streams, see Chapter 15.) Compare the number returned from the example call with the number returned when you change GACHA to TIMESROMAN.
    
    DSPFONT - Changing the Font in One Window
    The function DSPFONT changes the font in a single window. As an example of its use, first create a window to write in. Type:
    (SETQ MY.FONT.WINDOW (CREATEW))
    in the Executive Window. Sweep out the window. To print something in the default font, type:
    (PRINT ’HELLO MY.FONT.WINDOW)
    in the Executive Window. Your window, MY.FONT.WINDOW , will look something like Figure 16-5:
    
    Figure 16-5. HELLO, Printed with the Default Font in MY.FONT.WINDOW
    Now change the font in the window. Type:
    (DSPFONT (FONTCREATE ’HELVETICA 12 ’BOLD) MY.FONT.WINDOW)
    in the Executive Window. The arguments to FONTCREATE can be changed to create any desired font. Now retype the PRINT statement, and your window will look something
    like Figure 16-6:
    
    Flgure 16-6. Font in MY.FONT.WINDOW Changed Notice the font has been changed.
    
    Personalizing Your Font Profile
    Medley keeps a list of default font specifications. This list is used to set the font in all windows where the font is not specifically set by the user (see the DSPFONT section
    above). The value of the atom FONTPROFILE is this list (see Figure 16-7).
    A FONTPROFILE is a list of font descriptions that certain system functions access when printing output. It contains specifications for big font s (used when pretty printing a
    function to type the function name), small font s (used for printing comments in the editor), and various other font s.
    
    Figure 16-7. Value of the Atom FONTPROFILE
    
    The list is in the form of an association list. The font class names (e.g., DEFAULTFONT , or BOLDFONT) are the keywords of the association list. When a number follows the
    keyword, it is the font number for that font class.
    The lists following the font class name or number are the font specifications, in a form that the function FONTCREATE can use. The first font specification list affer a keyword
    is the specification for printing to windows. The list(GACHA 10) in the figure above is an example of the default specification for the printing to windows. The last two font
    specification lists are for Press and InterPress file printing, respectively. For more information, see Chapter 27 in the IRM.
    Now, to change your default font settings, change the value of the variable FONTPROFILE. Medley has a list of profiles stored as the value of the atom FONTDEFS . Choose the profile to use, then install it as the default FONTPROFILE .
    Evaluate the atom FONTDEFS and notice that each profile list begins with a keyword (see Figure 16-8). This keyword corresponds to the size of the font s included. BIG, SMALL, and STANDARD are some of the keywords for profiles on this list—SMALL and STANDARD appear in Figure 16-8.
    
    Figure 16-8. Part of Value of the Atom FONTDEFS
    To install a new profile from this list, follow the following example, but insert any keyword for BIG.
    To use the profile with the keyword BIG instead of the standard one, evaluate the following expression:
    (FONTSET ’BIG))
    Now the font s are permanently replaced. (That is, until another profile is installed.)
  7. THE INSPECTOR

The Inspector is a window-oriented tool designed to examine data structures. Because Medley is such a powerful programming environment, many types of data structures would be difficult to see in any other way.

Calling the Inspector

Take as an example an object defined through a sequence of pointers (i.e., a bitmap on the property list of a window on the property list of an atom inaprogram.)

To inspect an object named NAME, type:

(INSPECT ’NAME)

If NAME has many possible interpretations, an option menu will appear. For example, in Interlisp-D, a litatom can refer to both an atom and a function. For example, if NAME

was a record, had a function definition, and had properties on its property list, then the menu would appear as in Figure 17-1.

Figure 17-1. Option Window for Inspection of NAME

If NAME were a list, then the option menu shown in Figure 17.2 would appear. The options include:

Calling the display editor on the list
Calling the TTY editor (see Chapter 6)
Seeing the list’s elements in a display window. If you choose this option, each
element in the list will appear in the right column of the Inspector window. The left column of the Inspector window will be made up of numbers (see Figure 17-3).
Inspecting the list as a record type (this last option would produce a menu of known record types). If you choose a record type, the items in the list will appear in the
right column of the Inspector window. The left column of the Inspector window will be made up of the field names of the record.

Figure 17-2. Option Window for Inspection of List

Using the Inspector

If you choose to display your data structure in an edit window, simply edit the structure and exit in the normal manner when done. If you choose to display the data structure in an inspect window, then follow these instructions:
To select an item, point the mouse cursor at it and press the left mouse button.
Items in the right column of an Inspector window can themselves be inspected. To do this, choose the item, and press the center mouse button.
Items in the right column of an Inspector window can be changed. To do this, choose the corresponding item in the left column, and press the center mouse button. You

will be prompted for the new value, and the item will be changed. The sequence of steps is shown in Figure 17-3.

The item in the lefl column is selected, and the middle mouse button pressed. Select the

SET option from the menu that pops up.

You will then be prompted for the new value. Type it in.

The item in the right column is updated to the value of what you typed in.

Figure 17-3. Steps Involved in Changing Value in Right Column of Inspector Window

Inspector Example

This example will use ideas discussed in Chapter 21. An example, ANlMALGRAPH , is created in that section. You do not need to know the details of how it was created, but the structure is examined in this chapter.

If you type

(INSPECT ANIMAL.GRAPH)

and then choose the Inspect option from the menu, a display appears as shown in

Figure 17-4. ANlMAL.GRAPH is being inspected as a list. Note the numbers in the left column of the inspectorwindow.

THE INSPECTOR

Figure 17-4. Inspector Window For ANIMAL.GRAPH , Inspected as List If you choose the "As A Record" option, and choose "GRAPH" from the menu that
appears, the inspector window looks like Figure 17-5. Note the fieldnames in the left column of the inspector window.

Figure 17-5. Inspector Window for ANlMAL.GRAPH , Inspected as Instance of GRAPH
Record

The remaining examples will use ANlMAL.GRAPH inspected as a list. When the first item in the Inspector window is chosen with the leff mouse button, the Inspector
window looks like Figure 17-6.

Figure 17-6. Inspector Window for ANlMAL.GRAPH With First Element Selected
When you use the middle mouse button to inspect the selected list element, the display looks like Figure 17-7.

Figure 17-7. Inspector Window for ANlMAL.GRAPH and for First Element of
ANIMAL.GRAPH

How you can see that six items make up the list, and you can further choose to inspect one of these items. Notice that this is also inspected as a list. As usual, it could also
have been inspected as a record.
Select item 5 - MAMMAL DOG CAT - with the left mouse button. Press the middle mouse button. Choose "Inspect" to inspect your choice as a list. The Inspector now displays the values of the structure that makes up MAMMAL DOG CAT . (See Figure 17-8.)

Figure 17-8. Inspector Window for Element S From Figure 17.7 That Begins ((MAMMAL DOG CAT).
MASTERSCOPE

Masterscope is a tool that allows you to quickly examine the structure of complex
programs. As your programs enlarge, you may forget what variables are global, what functions call other functions, and so forth. Masterscope keeps track of this for you.
To use Masterscope, first load MASTERSCOPE.DFASL and EXPORTS.ALL.
Suppose that JVTO is the name of a file that contains many of the functions involved in a complex system and that LINTRANS is the file containing the remaining functions. The first step is to ask Masterscope to analyze these files. These files must be loaded.
All Masterscope queries and commands begin with a period followed by a space, as in
. ANALYZE FNS ON MSCOPEDEMO
The ANALYZE process takes a while, so the system prints a period on the screen for each function it has analyzed. (See Figure 18-1)

Figure 18-1. Executive Window After Analyzing Files
If you are not quite sure what functions were just analyzed, type the file’s COMS variable (see the File Variables section in Chapter 7) into the Executive Window. The names of
the functions stored on the file will be a part of the value of this variable.
A variety of commands are now possible, all referring to individual functions within the analyzed files. Substantial variation in exact wording is permitted. Some commands
are:
. SHOW PATHS FROM ANY TO ANY
. EDIT WHERE ANY CALLS functionname
. EDIT WHERE ANY USES variablename
. WHO CALLS WHOM
. WHO CALLS functionname
. BY WHOM IS functionname CALLED
. WHO USES variablename AS FIELD

Note that the function is being called to invoke each command. Refer to the IRM for commands not listed here.
Figure 18-2 shows the Executive Window after the commands . WHO CALLS GobbleDump and . WHO DOES JVL inScan CALL.

Figure 18-2. Sample Masterscope Output
18. MASTERSCOPE

SHOW DATA Command and GRAPHER

When the library package GRAPHER is loaded (to load this package, type (FILESLOAD GRAPHER)), Masterscope’s SHOWPATHS command is modified. The command will be
changed to generate a tree structure showi ng how the program’s functions interact instead of a tabular printout into the Executive window. For example, typing:
. SHOW PATHS FROM ProcessEND

produced the display shown in Figure 18-3.

Figure 18-3. SHOW PATHS Display Example

All the functions in the display are part of this analyzed file or a previously analyzed file. Boxed functions indicate that the function name has been duplicated in another place on the display.

Selecting any function name on the display will pretty print the function in a window (see Figure 18-4).

Figure 18-4. Browser Printout Example

Selecting it again with the left mouse button will produce a desription of the function’s role in the overall system (see Figure 18-5).
1. MASTERSCOPE
  
  Figure 18-5. Browser Description Example
2. WHERE DOES ALL THE TIME GO? SPY
  
  SPY is an Lisp library package that shows you where you spend your time when you run your system. It is easy to learn, and very useful when trying to make programs run
  faster.
  
  How to Use Spy with the SPY Window
  
  The function SPY.BUTTON brings up a small window which you will be prompted to position. Using the mouse buttons in this window controls the action of the SPY
  program. When you are not using SPY, the window appears as in Figure 19.1.
  Figure 19.1. SPY Window When SPY is Not Being Used
  
  To use SPY, click either the left or middle mouse button with the mouse cursor in the
  SPY window. The window will appear as in Figure 19.2, and means that SPY is accumulating data about your program.
  
  Figure 19.2. SPY Window When SPY is Being Used
  
  To turn off SPY after the program has run, again click a mouse button in the SPY
  window. The eye closes, and you are asked to position another window. This window contains SPY’s results. An example of the resulting window is shown in Figure 19.3.
  19. WHERE DOES ALL THE TIME GO? SPY
  
  Figure 19.3. Window Produced After Running SPY
  
  This window is scrollable horizontally and vertically. This is useful, since the whole tree does not fit in the window. If a part that you want to see is not shown, you can scroll the window to show the part you want to see.
  
  How to Use SPY from the Lisp Top Level
  
  SPY can also be run while a specific function or system is being used. To do this, type the function WITH.SPY:
  (WITH.SPY form)
  The expression used for form should be the call to begin running the function or system that SPY is to watch. If you watch the SPY window, the eye will blink! To see your
  results, run the function SPY.TREE. To do this, type:
  (SPY.TREE)
  The results of the last running of SPY will be displayed. If you do this, and SPY.TREE returns (no SPY samples have been gathered), your function ran too fast for SPY to follow.
  
  Interpreting SPY’s Results
  Each node in the tree is a box that contains, first, the percentage of time spent running that particular function, and second, the function name. There are two modes that can be used to display this tree.
  The default mode is cumulative. In this mode, each percentage is the amount of time
  that function spent on top of the stack, plus the amount of time spent by the functions it calls. The second mode is individual. To change the mode to individual, point to the title bar of the window, and press the middle mouse button. Choose Individual from the menu that appears. In this mode, the percentage shown is the amount of time the
  function spent on the top of the stack.
  To look at a single branch of the tree, point with the mouse cursor at one of the nodes of the tree, and press the right mouse button. From the menu that appears, choose the
  
  19-2 Medley for the Novice, Release 2.0
  19. WHERE DOES ALL THE TIME GO? SPY
  
  option SubTree. Another SPY window will appear, with just this branch of the tree in it.
  Another way to focu s within the tree is to remove branches from the tree. To do this, point to the node at the top of the branch you would like to delete. Press the middle mouse button, and choose Delete from the menu that appears.
  There are also different amounts of "merging" of functions that can be done in the
  window. A function can be called by another function more than once. The amount of merging determines where the subfunction, and the functions that it calls, appear in the tree, and how often. (For a detailed explanation of merging, see the Lisp Library Packages Manual.)
3. FREE MENUS
  
  Free Menu is a library package that is even more flexible than the regular menu package. It allows you to create menus with different types of items in them, and
  format s them as you require. Free menus are particularly useful when you want a "fill in the form" type interaction with the user.
  Each menu item is described with a list of properties and values. The following example will give you an idea of the structure of the description list, and some of your options.
  The most commonly used properties, and each type of menu item will be described in the Parts of a Free Menu Item and Types of Free Menu Items section below.
  
  Free Menu Example
  Free menus can be created and formatted automatically! It is done with the function
  FM.FORMATMENU. This function takes one argument, a description of the menu. The
  description is a list of lists; each internal list describes one row of the free menu. A free menu row can have more than one item in it, so there are really lists of lists of lists! It really isn’t hard, though, as you can see from the following example:
  (SETQ ExampleMenu (FM.FORMATMENU
  ’(((TYPE TITLE LABEL TitlesDoNothing) TYPE 3STATE LABEL Example3State))
  ((TYPE EDITSTART LABEL PressToStartEditing
  ITEMS (EDITEM)) (TYPE EDIT ID EDITEM LABEL ""))
  (WINDOWPROPS TITLE "Example Does Nothing"))))
  The first row has two items in it: one is a TITLE, and the second is a 3STATE item. The second row also has two items. The second, the EDIT item, is invisible, because its label is an empty string. The caret will appear for editing, however, if the EDITSTART item is chosen. Windowprops can appear as part of the description of the menu, because a
  menu is, affer all, just a special window. You can specify not only the title with
  WINDOWPROPS, but also the position of the free menu, using the "left" and "bottom"
  properties, and the width of the border in pixels, with the "border" property. Evaluating this expression will return a window. You can see the menu by using the function OPENW. The following example illustrates this:
  
  Figure 20.1. Example Free Menu
  
  The next example shows you what the menu looks like after the EDITSTART item,
  PressToStartEditing, has been chosen.
  
  Figure 20.2. Free menu after EDITSTART Item Chosen
  The following example shows the menu with the 3STATE item in its T state, with the item highlighted. (In the previous bitmaps, it was in its neutral state.)
  .
  
  Figure 20.3. Free menu with 3STATE Item in its T State
  
  Finally, Figure 20.4 shows the 3STATE item in its NIL state, with a diagonal line through the item
  
  Figure 20.4 Free menu with the 3STATE item in its NIL State
  If you would like to specify the layout yourself, you can do that too. See the Lisp Library Packages Manual for more information.
  
  Parts of a Free Menu Item
  There are eight different types of items that you can use in a free menu. No matter
  what type, the menu item is easily described by a list of properties, and values. Some of the properties you will use most often are listed below:
  
  LABEL Required for every type of menu item. It is the atom, string, or bitmap that appears as a menu selection.
  TYPE One of eight types of menu items. Each of these are described in the section below.
  MESSAGE The message that appears in the prompt window if a mouse button is held down over the item.
  ID An item’s unique identifier. An ID is needed for certain types of menu items.
  ITEMS Used to list a series of choices for an NCHOOSE item, and to list the ID’s of the editable items for an EDITSTART item.
  SELECTEDFN The name of the function to be called if the item is chosen.
  
  Types of Free Menu Items
  Each type of menu item is described in the following list, including an example description list for each one.
  
  MOMENTARY This is the familiar sort of menu item. When it is selected, the
  function stored with it is called. A description for the function that creates and format s the menu looks like this:
  (TYPE MOMENTARY
  LABEL Blink-N-Ring
  MESSAGE "Blinks the screen and rings bells" SELECTEDFN RINGBELLS)
  TOGGLE This menu item has two states, T and NIL. The default state is NIL, but choosing the item toggles its state. The following is an example description list, without code for the SELECTEDFN function, for this type of item:
  (TYPE TOGGLE
  LABEL DwimDisable SELECTEDFN ChangeDwimState)
  1. FREE MENUS
    
    3STATE This type of menu item has three states, NEUTRAL , T, and NIL. NEUTRAL is the default state. T is shown by highlighting the item, and NIL is shown with diagonal lines. The following is an example
    description list, without code for the SELECTEDFN function, for this type of item:
    (TYPE 3STATE
    LABEL CorrectProgramAllOrNoSpelling SELECTEDFN ToggleSpellingCorrection)
    TITLE This menu item appears on the menu as dummy text. It does nothing when chosen. An example of its description:
    (TYPE TITLE LABEL "Choices:")
    NWAY A group of items, nnly one of which can be chosen at a time. The items in the NWAY group should all have an ID field, and the ID’s
    should be the same. For example, to set up a menu that would allow the user to choose between Helvetica, Gacha, Modern, and Classic font s, the descriptions might look like this (once again, without the code for the SELECTEDFN):
    (TYPE NWAY ID FONTCHOICE
    LABEL Helvetica SELECTEDFN ChangeFont)
    (TYPE NWAY ID FONTCHOICE
    LABEL Gacha
    SELECTEDFN ChangeFont) (TYPE NWAY ID FONTCHOICE)
    LABEL Modern SELECTEDFN ChangeFont)
    (TYPE NWAY ID FONTCHOICE
    LABEL Classic SELECTEDFN Changefont)
    
    NCHOOSE This type of menu item is like NWAY except that the choices are given to the user in a submenu. The list to specify an NCHOOSE menu item that is analogous to the NWAY item above might look like this:
    (TYPE NCHOOSE
    LABEL FontChoices
    ITEMS Helvetica Gacha Modern Classic) SELECTDFN Changefont)
    EDITSTART When this type of menu itein is chosen, it activates another type of item, an EDIT item. The EDIT item or items associated with an EDITSTART item have their lD’s listed on the EDITSTART ’s ITEMS property. An example description list is:
    (TYPE EDITSTART LABEL "Function to add?" ITEMS (Fn))
    EDIT This type of menu item can actually be edited by you. It is often
    associated with an EDITSTART item (see above), but the caret that prompts for input will also appear if the item itself is chosen. An EDIT item follows the same editing conventions as editing in
    Executive Window:
    Add characters by typing them at the caret.
    Move the caret by pointing the mouse at the new position, and clicking the left button.
    
    Delete characters from the caret to the mouse by pressing the right button of the mouse. Delete a character behind the caret by pressing the backspace key.
    Stop editing by typing a carriage return, a Control-X, or by choosing another item from the menu.
    An example description list for this type of item is:
    (TYPE EDIT ID Fn LABEL **)
  2. THE GRAPHER
    
    Say it with Graphs
    
    Grapher is a collection of functions for creating and displaying graphs, networks of nodes and links. Grapher also allows you to associate program behavior with mouse selection of graph nodes. To load this package, type
    (FILESLOAD GRAPHER)
    Figure 21-1 shows a simple graph.
    
    Figure 21-1. Simple Graph
    
    In Figure 21-1 there are six nodes (ANIMAL , MAMMAL, DOG, CAT, FISH, and BIRD)
    connected by five links. A GRAPH is a record containing several fields. Perhaps the most
    important field is GRAPHNODES —which is itself a list of GRAPHNODE records. Figure 21-2 illustrates these data structures. The window on top contains the fields from the simple
    graph. The window on the bottoms an inspection of the node, DOG.
    
    Figure 21-2. Inspecting a Graph and a Node
    
    The GRAPHNODE data structure is described by its text (NODEID ), what goes into it (FROMNODES), what leaves it (TONODES ), and other fields that specify its looks. The basic model of graph building is to create a bunch of nodes, then layout the nodes into a
    graph, and finally display the resultant graph. This can be done in a number of ways.
    One is to use the function NODECREATE to create the nodes, LAYOUTGRAPH to lay out the nodes, and SHOWGRAPH to display the graph. The primer shows you two simpler ways,
    but please see the Library Packages Manual for more information about these other functions. The primer’s first method is to use SHOWGRAPH to display a graph with no nodes or links, then interactively add them. The second is to use the function
    LAYOUTSEXPR, which does the appropriate NODECREATES and a LAYOUTGRAPH, with a list.
    The function SHOWGRAPH displays graphs and allows you to edit them. The syntax of
    SHOWGRAPH is
    (SHOWGRAPH graph window lefibuttonfn middlebuttonfn topjustifyflg alloweditflg copybuttoneventfn)
    Obviously the graph structure is very complex. Here’s the easiest way to create a graph.
    (SETQ MY.GRAPH NIL)
    (SHOWGRAPH MY.GRAPH "My Graph" NIL NIL NIL T)
    
    Figure 21-3. My Graph
    
    You will be prompted to create a small window as in Figure 21-3. This graph has the title My Graph. Hold down the right mouse button in the window. A menu of graph
    editing operations will appear as in Figure 21-4.
    
    Figure 21-4. Menu of Graph Editing Operations
    Here’s how to use this menu. The commands in this menu are easy to learn. Experiment with them!
    
    Add a Node
    Start by selecting Add Node . Grapher will prompt you for the name of the node (see Figure 21-5.) and then its position.
    
    Figure 21-5. Grapher Prompts for Name of Node to add after Add Node is Chosen from Graph Editing Menu.
    
    Position the node by moving the mouse cursor to the desired location and clicking a mouse button. Figure 21-6 shows the graph with two nodes added using this menu.
    
    Figure 21-6. Two Nodes Added to MY GRAPH Using GraphEditing Menu
    
    Add a Link
    Select Add Link from the graph editing menu. The Prompt window will prompt you to select the two nodes to be linked. (See Figure 21-7.) Do this, and the link will be added.
    
    Figure 21-7. Prompt Window Requesting Selection of Two Nodes to Link, and Result
    
    Delete a Link
    Select Delete Link from the graph editing menu. ThePrompt window will prompt you to select the two nodes that should no longer be linked. (See Figure 21-8.) Do this, and
    the link will be deleted.
    
    Figure 21-8. Prompt Window Requesting Selection of Link to Delete, and Result
    
    Delete a Node
    Select Delete Node from the graph editing menu. The Prompt window will prompt you to select the node to be aeleted. (See Figure 21-9.) Do this, and the node will be deletea.
    
    Figure 21.-9. Prompt to Delete a Node
    
    Move a Node
    Select Delete Node from the graph editng menu. Choose a node pointing to the it with the mouse cursor, and pressing and holding the leff mouse button. When you move the mouse cursor, the node will be dragged along. When the node is at the new position,
    release the mouse button to deposit the node.
    
    Making a Graph from a List
    
    Typically, a graph is used to display one of your program’s data structures. Here is how that is done.
    
    LAYOUTSEXPR takes a list and returns a GRAPH record. The syntax of the function is
    (LAYOUTSEXPR sexpr format boxing font motherd personald famlyd)
    For example:
    (SETQ ANIMAL.TREE ’(ANIMAL (MAMMAL DOG CAT) BIRD FISH)) (SETQ ANIMAL.GRAPH
    (LAYOUTSEXPR ANIMAL.TREE ’HORIZONTAL)) (SHOWGRAPH ANIMAL.GRAPH "My Graph" NIL NIL NIL T)
    This is how Figure 21.1 was produced.
    
    Incorporating Grapher into Your Program
    The Grapher is designed to be built into other programs. It can call functions when, for example, a mouse button is clicked on a node. The function SHOWGRAPH does this:
    (SHOWGRAPH graph window lefibuttonfn middlebuttonfn topjustifyflg alloweditflg copybuttoneventfn)
    For example, the third argument to SHOWGRAPH , leftbuttonfn, is a function that is called when the left mouse button is pressed in the graph window. Try this:
    (DEFINEQ (My.LEFT.BUTT0N.FUNCTION (THE.GRAPHNODE THE.GRAPH.WINDOW)
    (INSPECT THE.GRAPHNODE)))
    
    (SHOWGRAPH FAMILY.GRAPH "Inspectable family" (FUNCTION MY.LEFT.BUTTON.FUNCTION)
    NIL NIL T)
    
    In the example above, MY.LEFT.BUTTON.FUNCTION simply calls the inspector. The
    function should be written assuming it will be passed a graphnode and the window that holds the graph. Try adding a function of your own.
    
    More of Grapher
    Some other Library packages make use of the Grapher. (Grapher needs to be loaded with the packages to use these functions.)
    - MASTERSCOPE: The Browser package modifies the Masterscope command, . SHOW PATHS, so that its output is displayed as a graph (using Grapher) instead of simply printed.
    - GRAPHZOOM: allows a graph to be redisplayed larger or smaller automatically.
  3. RESOURCE MANAGEMENT
    
    Naming Variables and Records
    You will find times when one environment simultaneously hosts a number of different programs. Running a demo of several programs, or reloading the entire Medley
    environment from floppies when it contains several different programs, are two
    examples that could, if you aren’t careful, provide a few problems. Here are a few tips on how to prevent problems:
    - If you change the value of a system variable, MENUHELDWAIT for example, or connect to a directory other than {DSK}<LISPFILES> , write a function to reset the variable or directory to its original value. Run this function when you are finished working.
      This is especially important if you change any of the system menus.
    - Do not redefine Medley functions or CLISP words. Remember, if you reset an atom’s value or function definition at the top level (in the Executive Window), the message (Some.Crucial.Function.Or.Variable redefined) , appears. If this is not what you wanted, type UNDO immediately!
      If, however, you reset the value or function definition of an atom inside your program, a warning message will not be printed.
    - Make the atom names in your programs as unique as possible. To do this without filling your program with unreadable names that noone, including you, can
      remember, prefix your variable names with the initials of your program. Even then, check to see that they are not already being used with the function BOUNDP . For
      example, type:
      (BOUNDP ’BackgroundMenu)
      
      This atom is bound to the menu that appears when you press the leff mouse button
      when the mouse cursor is not in any window. BOUNDP returns T. BOUNDP returns NIL
      if its argument does not currently have a value.
    - Make your function names as unique as possible. Once again, prefixing function
      names with the initials of your program can be helpful in making them unique, but even so, check to see that they are not already being used. GETD is the Interlisp-D function that returns the function definition of an atom, if it has one. If an atom has no function definition, GETD returns NIL. For example, type:
      (GETD ’CAR)
      A non-NIL value is returned. The atom CAR already has a function definition.
    - Use complete record field names in record FETCHes and REPLACE s when your code is not compiled. A complete record field name is a list consisting of the record
      declaration name and the field name. Consider the following example:
      (REC0RD NAME (FIRST LAST))
      (SETQ MyName (create Name FIRST ’John LAST ’Smith)) (FETCH (NAME FIRST) OF MyName)
    - Avoid reusing names that are field names of Lisp system records. A few examples of system records follow. Do not reuse these names.
      (RECORD REGION (LEFT BOTTOM WIDTH HEIGHT)) (RECORD POSITION (XCOORD YCOORD))
      
      (RECORD IMAGEOBJ (- BITMAP -)))
    - When you select a record name and field names for a new record, check to see whether those names have already been used.
      
      Call the function RECLOOK, with your record name as an argument, in the Executive Window (see Figure 22-1). If your record name is already a record, the record
      definition will be returned; otherwise the function will return NIL.
      
      Figure 22-1. Response to RECLOCK
      
      Call the function FIELDLOOK with your new field name in the Executive Window (see Figure 22-2). If your field name is already a field name in another record, the record definition will be returned; otherwise the function will return NIL.
      
      Figure 22-2. Response to FIELDLOOK
      
      Some Space and Time Considerations
      In order for your program to run at maximum speed, you must efficiently use the space available on the system. The following section points out areas that you may not know are wasting valuable space, and tips on how to prevent this waste.
      Often programs are written so that new data structures are created each time the
      program is run. This is wasteful. Write your programs so that they only create new variables and other data structures conditionally. If a structure has already been
      created, use it instead of creating a new one.
      Some time and space can be saved by changing your RECORD and TYPERECORD
      declarations to DATATYPE . DATATYPE is used the same way as the functions RECORD and TYPERECORD. In addition, the same FETCH and REPLACE commands can be used with the data structure DATATYPE creates. The difference is that the data structure
      DATATYPE creates cannot be treated as a list the way RECORD s and TYPERECORDs can.
      1. RESOURCE MANAGEMENT
        
        Global Variables
        Once defined, global variables remain until Lisp is reloaded. Avoid using global
        variables if at all possible! One specific problem arises when programs use the function
        GENSYM. In program development, many atoms are created that may no longer be useful. Hints:
    - Use
      (DELDEF atomname ’PROP)
      to delete property lists, and
      (DELDEF atomname ’VARS)
      to have the atom act like it is not defined.
      These not only remove the definition from memory, but also change the appropriate fileCOMS that the deleted object was associated with so that the file package will not attempt to save the object (function, variable, record definition, and so forth) the next time the file is made. J ust doing something like
      (SETQ (arg atomname) ’NOBIND)
      looks like it will have the same effect as the second DELDEF above, but the SETQ does not update the file package.
    - If you are generating atom names with GENSYM , try to keep a list of the atom names that are no longer needed. Reuse these atom names, before generating new ones.
      There is a (fairly large) maximum to the number of atoms you can have, but things slow down considerably when you create lots of atoms.
    - When possible, use a data structure such as a list or an array, instead of many
      individual atoms. Such a structure has only one pointer to it. Once this pointer is
      removed, the whole structure will be garbage-collected and space will be reclaimed.
      
      Circular Lists
      If your program is creating circular lists, a lot of space may be wasted. (Many
      crosslinked data structures end up having circularities.) Hints when using circular lists:
    - Write a function to remove pointers that make lists circular when you are through with the circular list.
    - If you are working with circular lists of windows, bind your main window to a unique global variable. Write window creation conditionally so that if the binding of that
      variable is already a window, use it, and only create a new window if that variable is unbound or NIL.
      Here is an example that illustrates the problem. When several auxilIary windows are built, pointers to these windows are usually kept on the main window’s property list.
      Each auxilIary window also typically keeps a pointer to the main window on its
      property list If the top level function creates windows rather than reusing existing ones, there will be many lists of useless windows cluttering the work space. Or, if such a main window is closed and will not be used again, you will have to break the links by deleting the relevant properties from both the main window and all of the auxiliary windows
      first. This is usually done by putting a special CLOSEFN on the main window and all of its auxiliary windows.
      
      When You Run Out of Space
      Typically, if you generato a lot of structure! that won’t get garbage collected, you will eventually run out of space. The important part ii being aNe to track down those
      structures and the code that generates them to become more space efficient.
      Use the Lisp Library Package GCHAX.DCOM to track down pointers to data structures. The basic idea is that GCHAX will return the number of references to a particular data structure.
      A special function exists that allows you to get a little extra space so that you can try to save your work when you get toward the edge (usually noted by a message indicating
      that you should save your work and load a new Medley environment). The GAINSPACE
      function allows you to delete non-essential data structures. To use it, type:
      (GAINSPACE)
      into the Executive Window. Answer N to all questions except the followi ng.
    - Delete edit history
    - Delete history list.
    - Delete values of old variables.
    - Delete your MASTERSCOPE database
    - Delete information for undoing your greeting.
      Save your work and reload Lisp as soon as possible.
      1. SIMPLE INTERACTIONS WITH THE CURSOR, A BITMAP, AND A WINDOW
        
        The purpose of this chapter is to show you how to build a moderately tricky interactive interface with the various Medley display facilities. In particular how to move a large
        bitmap (larger than 16 x 16 pixels) around inside a window. To do this, you will change the CURSORINFN and CURSOROUTFN properties of the window. If you would also like to then set the bitmap in place in the window, you must reset the BUTTONEVENTFN . This chapter explains how to create the mobile bitmap.
        
        GETMOUSESTATE Example Function
        One function that you will use to "trace the cursor" (have a bitmap follow the cursor around in a window) is GETMOUSESTATE. This function finds the current state of the. mouse, and resets global system variables, such as LASTMOUSEX and LASTMOUSEY.
        As an example of how this function works, create a window by typing
        (SETQ EXAMPLE.WINDOW (CREATEW))
        into the Executive Window, and sweeping out a window. Now, type in the function
        (DEFINEQ (PRINTCOORDS (W)
        (PROMPTPRINT "(" LASTMOUSEX ", "LASTMOUSEY ")") (BLOCK)
        (GETMOUSESTATE)))
        
        This function calls GETMOUSESTATE and then prints the new values of LASTMOUSEX and
        LASTMOUSEY in the promptwindow. To use it, type
        (WINDOWPROP EXAMPLE.WINDOW ’CURSORMOVEDFN ’PRINTCOORDS)
        The window property CURSORMOVEDFN, used in this example, will evaluate the function PRINTCOORDS each time the cursor is moved when it is inside the window. The position coordinates of the mouse cursor will appear in the prompt window. (See Figure 23.1.)
        
        Figure 23.1. Current Position Coordinates of Mouse Cursor in Prompt Window
        
        Advising GETMOUSESTATE
        For the bitmap to follow the moving mouse cursor, the function GETMOUSESTATE is advised. When you advise a function, you can add new commands to the function
        without knowing how it is actually implemented. The syntax for advise is
        (ADVISE fn when where what)
        fn is the name of the function to be augmented. when and where are optional
        arguments. when specifies whether the change should be made before, after, or around the body of the function. The values expected are BEFORE , AFTER, or AROUND.
        what specifies the additional code.
        
        In the example, the additional code, what, moves the bitmap to the position of the
        mouse cursor. The function GETNOUSESTATE will be ADVISEd when the mouse moves
        into the window. This will cause the bitmap to follow the mouse cursor. ADVISE will be undone when the mouse leaves the window or when a mouse button is pushed. The ADVISEing will be done and undone by changing the CURSORINFN , CURSOROUTFN, and BUTTONEVENTFN for the window.
        
        Changing the Cursor
        
        One last part of the example, to give the impression that a bitmap is dragged around a window, the original cursor should disappear. Try typing:
        (CURSOR (CURSORCREATE (BITMAPCREATE 1 l) 1 1]
        into the Executive Window. This causes the original cursor to disappear. It reappears when you type
        (CURSOR T)
        When the cursor is invisible, and the bitmap moves as the cursor moves, the illusion is given that the bitmap is dragged around the window.
        
        Functions for Tracing the Cursor
        
        To actually have a bitmap trace (follow) the cursor, the environment must be set up so that when the cursor enters the tracing region the trace is turned on, and when the
        cursor leaves the tracing region the trace is turned off. The function Establish/Trace/Data will do this. Type it in as it appears (include comments that will help you remember what the function does).
        
        (DEFINEQ (Establish/Trace/Data
        [LAMBDA (wnd tracebitmap cursor/rightoffset cursor/heightoffset GCGAGP)
        
        (* * This function is called to establish the data to trace the desired bitmap. "wnd" is the window in which the tracing is to take place, "tracebitmap" is the tracing bitmap, "cursor/rightoffset" and "cursor/heightoffset" are integers which detemine the hotspot of the tracing bitmap.
        As "cursor/heightoffset and "cursor/rightoffset" increase the cursor hotspot moves up and to the right.
        If GCGAGP is non-NIL, GCGAG will be disabled.)
        
        (PROG NIL
        (if (OR (NULL wnd)
        (NULL tracebitmap))
        then (PLAYTUNE (LIST (CONS 1000 4000))) (RETURN))
        (if GCGAGP
        then (GCGAG))
        (* * Create a blank cursor.)
        (SETQ *BLANKCURSOR*(BITMAPCREATE 16 16))
        (SETQ *BLANKTRACECURSOR*(CURSORCREATE *BLANKCURSOR*))
        
        (* * Set the CURSOR IN and OUT FNS for wnd to the following:)
        (WINDOWPROP wnd (QUOTE CURSORINFN)
        (FUNCTION SETUP/TRACE)) (WINDOWPROP wnd (QUOTE CURSOROUTFN)
        (FUNCTION UNTRACE/CURSOR))
        (* * To allow the bitmap to be set down in the window by pressing a mouse button, include this line.
        Otherwise, it is not needed)
        (WINDOWPROP wnd (QUOTE BUTTONEVENTFN)
        (FUNCTION PLACE/BITMAP/IN/WINDOW)) (WINDOWPROP wnd (QUOTE CURSOROUTFN)
        (* * Set up Global Variables for the tracing operation) (SETQ *TRACEBITMAP* tracebitmap
        (SETQ *RIGHTTRACE/OFFSET*(OR cursor/rightoffset 0)) (SETQ *HEIGHTTRACE/OFFSET*(OR cxursor heightoffset 0)) (SETQ *OLDBITMAPPOSITION*(BITMAPCREATE (BITMAPWIDTH
        tracebitmap)
        tracebitmap)))
        (SETQ *TRACEWINDOW* wnd]))
        (BITMAPHEIGHT
        
        When the function Establish/Trace/Data is called, the functions SETUP/TRACE and
        UNTRACE/CURSOR will be installed as the values of the window’s WlNDOWPROPS , and will be used to turn the trace on and off. Those functions should be typed in, then:
        
        (DEFINEQ (SETUP/TRACE [LAMBDA (wnd)
        (* * This function is wnd’s CURSORINFN.
        It simply resets the last trace position and the current tracing region. It also readvises GETMOUSESTATE to perform the trace function after each call.)
        (if *TRACEBITMAP*
        then (SETQ *LAST-TRACE-XPOS* -2000) (SETQ *LAST-TRACE-YPOS* -2000)
        (SETQ *WNDREGION* (WINDOWPROP wnd (QUOTE REGION))) (WINDOWPROP wnd (QUOTE TRACING)
        T)
        (* * make the cursor disappear)
        (CURSOR *BLANKTRACECURSOR*) (ADVISE (QUOTE GETMOUSESTATE)
        (QUOTE AFTER) NIL
        (QUOTE (TRACE/CURSOR]))
        (DEFINEQ (UNTRACE/CURSOR [LAMBDA (wnd)
        
        (* * This function is wnd’s CURSOROUTFN. The function first checks if the cursor is currently being traced; if so, it replaces the tracing bitmap with what is under it and then turns tracing off by unadvising GETMOUSESTATE and setting the TRACING window property of *TRACEWINDOW* to NIL.)
        (if (WINDOWPROP *TRACEWINDOW*(QUOTE TRACING))
        
        then (BITBLT *OLDBITMAPPOSITION* 0 0 (SCREENBITMAP) (IPLUS (CAR *WNDREGION*)*LAST-TRACE-XPOS*) (IPLUS (CADR *WNDREGION*)*LAST-TRACE-YPOS*))
        (WINDOWPROP *TRACEWINDOW*(QUOTE TRACING)
        NIL))
        (* * replace the original cursor shape) (CURSOR T)
        (* * unadvise GETMOUSESTATE) (UNADVISE (QUOTE GETMOUSESTATE]))
        The function SETUP/TRACE has a helper function that you must also type in. It is
        TRACE/CURSOR:
        (DEFINEQ (TRACE/CURSOR [LAMBDA NIL
        
        (* * This function does the actual BITBLTing of the tracing bitmap. This function is called after a GETMOUSESTATE, while tracing.)
        (PROG ((xpos (IDIFFERENCE (LASTMOUSEX *TRACEWINDOW*)
        *RIGHTTRACE/OFFSET*))
        (ypos (IDIFFERENCE (LASTMOUSEY *TRACEWINDOW*)
        *HEIGHTTRACE/OFFSET*))
        (* * If there is an error in the function, press the right button to unadvise the function. This will keep the machine from locking up.)
        (if (LASTMOUSESTATE RIGHT)
        then (UNADVISE (QUOTE GETMOUSESTATE))) (if (AND (NEQ xpos *LAST-TRACE-XPOS*)
        (NEQ ypos *LAST-TRACE-YPOS*))
        then
        (* * Restore what was under the old position of the trace bitmap)
        (BITBLT *OLDBITMAPPOSITION* 0 0 (SCREENBITMAP) (IPLUS (CAR *WNDREGION*)*LAST-TRACE-XPOS*) (IPLUS (CADR *WNDREGION*)*LAST-TRACE-YPOS*))
        (* * Save what will be under the position of the new trace bitmap)
        (BITBLT (SCREENBITMAP) (IPLUS (CAR *WNDREGION*)
        xpos)
        (IPLUS (CADR *WNDREGION*) ypos)*OLDBITMAPPOSITION* 0 0)
        (* * BITBLT the trace bitmap onto the new position of the mouse)
        (BITBLT *TRACEBITMAP* 0 0 (SCREENBITMAP) (IPLUS (CAR *WNDREGION*)
        xpos)
        (IPLUS (CADR *WNDREGION*)
        ypos)
        NIL NIL (QUOTE INPUT) (QUOTE PAINT))
        (* * Save the current position as the last trace position.) (SETQ *LAST-TRACE-XPOS* xpos)
        
        (SETQ *LAST-TRACE-YPOS* ypos]))
        
        The helper function for UNTRACE/CURSOR , called UNDO/TRACE/DATA, must also be added to the environment:
        
        (DEFINEQ (UNDO/TRACE/DATA [LAMBDA NIL
        
        (* * The purpose of this function is to turn tracing off and to free up the global variables used to trace the bitmap so that they can be garbage collected.)
        
        (* * Check if the cursor is currently being traced. It so, turn it off.)
        (UNTRACE/CURSOR)
        (WINDOWPROP *TRACEWINDOW*(QUOTE CURSORINFN) NIL)
        (WINDOWPROP *TRACEWINDOW*(QUOTE CURSOROUTFN) NIL)
        (SETQ *TRACEBITMAP* NIL)
        (SETQ *RIGHTTRACE/OFFSET* NIL) (SETQ *HEIGHTTRACE/OFFSET* NIL) (SETQ *OLDBITMAPPOSITION* NIL) (SETQ *TRACEWINDOW* NIL)
        (* * Turn GCGAG on) (GCGAG T]))
        Finally, if you included the WlNDOWPROP to allow the user to place the bitmap in the window by pressing a mouse button, you must also type this function:
        
        (DEFINEQ (PLACE/BITMAP/IN/WINDOW [LAMBDA (wnd)
        (UNADVISE (GETMOUSESTATE))
        (BITBLT *TRACEBITMAP* 0 0 (SCREENBITMAP) (IPLUS (CAR *WNDREGION*)
        xpos)
        (IPLUS (CADR *WNDREGION*)
        ypos)
        NIL NIL (QUOTE INPUT) (QUOTE PAINT]
        That’s all the functions!
        
        Running the Functions
        
        To run the functions you just typed in, first set a variable to a window by typing something like
        (SETQ EXAMPLE.WINDOW (CREATEW))
        into the Executive Window, and sweeping out a new window. Now, set a variable to a bitmap, by typing, perhaps,
        (SETQ EXAMPLE.BTM (EDITBM))
        
        Type
        (Estab1ish/Trace/Data EXAMPLE.WINDOW EXAMPLE.BTM))
        When you move the cursor into the window, the cursor will drag the bitmap.
        (If you want to be able to make menu selections while tracing the cursor, make sure
        that the hotspot of the cursor is set to the extreme right of the bitmap. Otherwise, the menu will be destroyed by the BITBLT s of the trace functions.)
        To stop tracing, do one of the following:
    - Move the mouse cursor out of the window
    - Press the right mouse button
    - Call the function UNTRACE/CURSOR
      1. GLOSSARY OF GLOBAL SYSTEM VARIABLES
        
        As you can tell by now, there are many system variables in Medley that are useful to know. The following sections gather many of the important variables together into
        groups relating to directory searching, system flags, history lists, system menus, windows, and, of course, the catchall miscellaneous category.
        
        Directories
        
        DISPLAYFONTDIRECTORIES
        Its value is a list of directories to search for the bitmap files for display font s. Usually, it contains the FONT directory where you copies the bitmap files (see Chapter 16), and the current connected directory. The current connected
        directory is specified by the atom NIL. Here is an example value of
        DISPLAYFONTDIRECTORIES.
        
        Figure 24.1. Value for the Atom DISPLAYFONTDIRECTORIES INTERPRESSFONTDIRECTORIES
        Is set to a list of directories to search for the font width files for InterPress font s.
        
        DIRECTORIES
        This variable is bound to a list of the directories you will be using (see Figure 24-2). The system uses this variable when it is trying to find a file to load. It checks each directory in the list, until the file is foun d. NIL in list means to check the current connected directory.
        LISPUSERSDIRECTORIES
        Its value is a list of directories to search for library package files.
        
        Flags
        
        DWIMIFYCOMPFLG
        This flag, if set to T, will cause all expressions to be completely dwinified before the expression is compiled (see Chapter 9). In this state, when the system does not recognize a function of keyword, it will compare the word to a system
        maintained list to determine whether the word is a macro, CLISP word, or misspelled user-defined variable.
        An example of swinifying before compilation is to convert an IF call to a COND. before they are compiled. Undwimified expressions can cause inaccurate
        compilation. This flag is set by the system to NIL. Normally, you want this set to T. For more information on DWIM, refer to the IRM.
        SYSPRETTYFLAG
        When set to T, all lists returned to the executive window are pretty printed. This flag is originally set by the system to NIL.
        CLISPIFTRANFLG
        When set to T, keeps the IF expression, rather than the COND translation in your code.
        PRETTYTABFLG
        When set to T, the pretty printer puts out a tab character rather than several spaces to try to make code align. If NIL, it uses space characters instead.
        FONTCHANGEFLG
        If NIL, then when pretty printing no font changes will happen (e.g., a smaller font for comments, bold for clip words, and so forth). The default is the atom ALL, so different font s are used where appropriate.
        
        AUTOBACKTRACEFLG
        There are many possible values for this variable. They affect when the back
        trace window appears with the break window, and how much detail is included in it. The values of this variable include:
        NIL, its initial value. The back trace window is not brought up when an error is generated, until you open it yourself.
        T, which means that the back trace BT window is opened for error breaks
        BT! brings up a back trace window with more detail, BT!, window for error breaks
        ALWAYS brings up a backtrace BT window for both error breaks, and breaks caused by calling the function BREAK
        ALWAYS! brings up a backtrace window with more detail, BT!, for both error breaks and breaks caused by calling the function
        
        NOSPELLFLG
        Is initially bound to NIL, so that DWIM tries to correct all spelling errors,
        whether they are in a form you just typed in or within a function being run. If the variable is T, then no spelling correction is performed. This variable is
        automatically reset to T when you are compiling a file. If it has some other non-
        NIL value, then spelling correction is only performed on type-in.
        
        History Lists
        LISPXHISTORY
        Originally set to the list (NIL 0 30 100) , with the following argument
        interpretation. The NIL is the list (implemented as a circular queue) to which the top level commands append. 0 is the current prompt number. 30 is the
        maximum length of the history list. 100 is the highest number used as a
        prompt. This is a system maintained list used by the programmers assistant commands REDO, UNDO, FIX, and ?? use to retrieve past function calls.
        To delete the history list, reset the variable LISPXHISTORY to its original value of (NIL 0 30 100).
        Setting this variable to NIL disables all the programmers assistant features.
        EDITHISTORY
        This is also set to (NIL 0 30 100), and has the same description as LISPXHISTORY. This list allows you to UNDO edits. You reset this the same way as LISPXHISTORY.
        
        System Menus
        
        System menus are all bound to global varieables and are easy to modyfy. If the menu name is set to the NIL value, the menu will be recreated using an items list bound to a global variable.
        To change a system menu, edit the items list bound to the appropriate global variable (system menus use this items list with the default WHENSELECTEDFN ), then set the
        value of the name to NIL. The next time you need the menu, it will be created from the items list you just edited. The names of system menus and the items lists follow.
        
        BackgroundMenu
        This is the variable bound to the menu this displays when you press the right button in the grey background area of the screen.
        
        BackgroundMenuCommands
        This list is used for the list of ITEMS for the background menu when it is created.
        WindowMenu
        This is the variable bound to the default window menu displayed when the right mouse button is pressed inside of a window.
        
        WindowMenuCommands
        This is the list of ITEMS for the WindowMenu.
        
        BreakMenu
        The menu displayed when the middle mouse button is pressed in a break
        window.
        
        BreakMenuCommands
        The list of ITEM for the BreakMenu.
        
        Windows
        
        PROMPTWINDOW
        Global name of the prompt window.
        
        T
        Although the value T has several meanings (such as universal TRUE), it also
        stands for the standard output stream. As this is usually the executive window, it may be used as the name for the TTY Window at the top level. Mouse
        processes have their own TTY Windows. A reference to the window T in a mouse driven function (e.g., a WHENSELECTEFN, Chapter 12) will open a TTY Window for Mouse.
        
        Miscellaneous
        CLEANUPOPTION
        This is a list of options that you set to automate clean-up after a work session. Example options are listing files, or recompilation. You will want to keep this set to NIL until you become comfortable with the machine.
        
        FILELST
        The list of all the files you loaded.
        
        SYSFILES
        The list of all the files you loaded for the SYSOUT file.
        INITIALS
        An atom you can bind to your name. If bound, the editor will add your name, in addition to the date, in the editor comment at the beginning of each function.
        FIRSTNAME
        If this variable is set, the system will use it to greet you personally when you log on to your machine.
        
        INITIALSLST
        A list of elements of the form (USERNAME . INITIALS) or (USERNAME FIRSTNAME INITIALS). This list is used by the function GREET to set your INITIALS , and your FIRSTNAME when you log in.
        #CAREFULCOLUMNS
        An integer. PRETTYPRINT estimates the number of characters in an atom,
        instead of computing it, for efficiency. Unfortunately, for very long atom names, errors can occur. #CAREFULCOLUMNS is the number of columns from the right within which PRETTYPRINT should compute the number of characters in each
        atom, to prevent these errors. Initially this is set to zero. PRETTYPRINT never computes the number of characters in an atom. If you set it to 20 or 30, when PRETTYPRINT comes within 20 or 30 columns of the right of the window, it will begin computing exactly how many characters are in each atom. This will
        prevent errors.
        
        DWIMWAIT
        Bound to the number of seconds DWIM should wait before it uses the default response, FIXSPELLDEFAULT , to answer its question.
        FIXSPELLDEFAULT
        Bound to either Y or N. Its value is used as the default answer to questions
        asked by DWIM that you don’t answer in DWIMWAIT seconds. It is initially bound to Y, but is rebound to N when DWIMIFYing.
        \TimeZoneComp
        This is the global variable set to the absolute value of the time offset from Greenwich. For EST, \TimeZoneComp should be set to 5.
      2. OTHER USEFUL REFERENCES

Here are some references to works that will be useful to you in addition to this primer. Some of these you have already been referred to, such as:

The Interlisp-D Reference Manual (IRM)
The Library Packages Manual
The User’s Guide to SKETCH

In addition, you can learn more about Lisp with the books:
Interlisp-D: The l a ngu ago a n d its usage by Steven H. Kaisler. This book was published in 1986 by John Wiley and Sons, NY.
Essenti a l LISP by John Anderson, Albert Corbett, and Brian Reiser. This book was published in 1986 by Addison Wesley Publishing Company, Reading, MA. It was
informed by research on how beginners learn LISP.
The Little Lisper by Daniel P. Friedman and Matthias Felleisen. The second edition of this book was published in 1986 by SRA Associates, Chicago. This book is a
deceptively simple introduction to recursive programming and the flexible data structures provided by LISP.
LISP by Patrick Winston and Berthold Horn. The second edition of this book was published in 1985 by the Addison Wesley Publishing Company, Reading, MA.
LISP: A Gentle Introd uction to Symbolic Comp ut a tion by David S. Touretzky. This book was published in 1984 by the Harper and Row Publishing Company, NY.

Finally, there are three articles about the Interlisp Programming environment:
Power Tools For Programmers byBeau Sheil. It appeared in Datamation in February, 1983, Pages 131 - 144.
The Interlisp Programming Environment by Warren Teitelman and Larry Masinter. It appeared in April, 1981, in IEEE Computer, Volume 14:1, Pages 25 - 34.
Programming In an Interactive Environment, the LISP Experience by Erik

Sandewall. It appeared in March, 1978, in the ACM Computing Surveys, Volume 10:1, pages 35 - 71.

Each of these articles was reprinted in the book Inter active Prog r amming

Environ ments by David R. Barstow, Howard E. Shrobe, and Erik Sandewail. This

book was published in 1984 by McGraw Hill, NY. The first article can be foun d on pages 19 - 30, the second on pages 83 - 96, and the third on pages 31 - 80.

Medley for the Novice, Release 2.0

25-1

diff --git a/docs/html-primer/Medley-Primer-OnePage_files/headings.htm b/docs/html-primer/Medley-Primer-OnePage_files/headings.htm deleted file mode 100644 index 02298456..00000000 --- a/docs/html-primer/Medley-Primer-OnePage_files/headings.htm +++ /dev/null @@ -1,47 +0,0 @@ - -Headings

Headings

Release 2.0 BRIEF GLOSSARY PREFACE TYPING SHORTCUTS Programmer’s Assistant If You Make a Mistake TABLE of CONTENTS USING MENUS Making a Selection from a Menu Explanation of Menu Items Submenus Summary HOW TO USE FILES Types of Files If a file contains: Then:Directories Directory Options Subdirectories To See What Files Are Loaded Simple Commands for Manipulating Files Connecting to a Directory File Version Numbers FILEBROWSER Calling the FileBrowser FileBrowser Commands THOSE WONDERFUL WINDOWS!Windows Provided by Medley Creating a Window Right Button Default Window Menu Explanation of Each Menu Item Scrollable Windows Other Window Functions PROMPTPRlNT (PROMPTPRINT "THIS WILL BE PRINTED IN THE PROMPT WINDOW")WHlCHW EDITING AND SAVING Defining Functions Simple Editing in the Executive Window Using the List Structure Editor Commenting Functions File Functions and Variables: How to See and Save Them File Variables Saving Interlisp-D on Files (FILES?)(MAKEFILE ’MY.FILE.NAME)YOUR INIT FILE Using the USERGREETFILES Variable Making an Init File MEDLEY FORGIVENESS: DWIM BREAKPACKAGE Break Windows Break Package Example Ways to Stop Execution from the Keyboard (Breaking Lisp) Break Menu Returning to Top Level WHAT TO DO IF ...Executive Window turns black You closed the Executive Window Mouse disappears Second window appears You keep getting beeped at You cannot delete the first letter Your function is just sitting there A Break Window appears You have run out of space (GAINSPACE)A redefined message appears UNBOUND ATOM UNDEFINED CAR OF FORM You have traced APPLY WINDOWS AND REGIONS Windows CREATEW WlNDOWPROP Getting Windows to Do Things BUTTONEVENTFN Looking at a Window’s Properties Regions WHAT ARE MENUS?Displaying Menus Getting Menus to Do Stuff WHENHELDFN and WHENSELECTEDFN Fields of a Menu Looking at a Menu’s Fields BITMAPS DISPLAYSTREAMS Drawing on a Displaystream DRAWLlNE DRAWTO DRAWClRCLE FlLLClRCLE Locating and Changing Your Position in a Displaystream DSPXPOSlTlON DSPYPOSlTlON MOVETO FONTS What Makes Up a Font Fontdescriptors and FONTCREATE Display Fonts InterPress Fonts Functions for Using Fonts FONTPR0P Looking at Font Properties STRlNGWlDTH DSPFONT - Changing the Font in One Window Personalizing Your Font Profile THE INSPECTOR Calling the Inspector Using the Inspector Inspector Example MASTERSCOPE SHOW DATA Command and GRAPHER WHERE DOES ALL THE TIME GO? SPY How to Use Spy with the SPY Window How to Use SPY from the Lisp Top Level Interpreting SPY’s Results FREE MENUS Free Menu Example Parts of a Free Menu Item Types of Free Menu Items THE GRAPHER Say it with Graphs Add a Node Add a Link Delete a Link Delete a Node Move a Node Making a Graph from a List Incorporating Grapher into Your Program More of Grapher RESOURCE MANAGEMENT Naming Variables and Records Some Space and Time Considerations Global Variables Circular Lists When You Run Out of Space SIMPLE INTERACTIONS WITH THE CURSOR, A BITMAP, AND A WINDOW GETMOUSESTATE Example Function Advising GETMOUSESTATE Changing the Cursor Functions for Tracing the Cursor Running the Functions GLOSSARY OF GLOBAL SYSTEM VARIABLES Directories Flags History Lists System Menus Windows Miscellaneous OTHER USEFUL REFERENCES

diff --git a/docs/html-primer/Medley-Primer.html b/docs/html-primer/Medley-Primer.html deleted file mode 100644 index c92200b5..00000000 --- a/docs/html-primer/Medley-Primer.html +++ /dev/null @@ -1,2 +0,0 @@ - -Medley-Primer

diff --git a/docs/html-primer/Medley-Primer_files/Image_001.png b/docs/html-primer/Medley-Primer_files/Image_001.png deleted file mode 100644 index 134a8b09..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_001.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_002.png b/docs/html-primer/Medley-Primer_files/Image_002.png deleted file mode 100644 index c1e72ae4..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_002.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_003.png b/docs/html-primer/Medley-Primer_files/Image_003.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_003.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_004.png b/docs/html-primer/Medley-Primer_files/Image_004.png deleted file mode 100644 index 33c6b56e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_004.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_005.png b/docs/html-primer/Medley-Primer_files/Image_005.png deleted file mode 100644 index 697cdb63..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_005.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_006.png b/docs/html-primer/Medley-Primer_files/Image_006.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_006.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_007.gif b/docs/html-primer/Medley-Primer_files/Image_007.gif deleted file mode 100644 index f609c047..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_007.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_008.gif b/docs/html-primer/Medley-Primer_files/Image_008.gif deleted file mode 100644 index 438cad57..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_008.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_009.gif b/docs/html-primer/Medley-Primer_files/Image_009.gif deleted file mode 100644 index 0887753b..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_009.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_010.gif b/docs/html-primer/Medley-Primer_files/Image_010.gif deleted file mode 100644 index c3a529bf..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_010.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_011.gif b/docs/html-primer/Medley-Primer_files/Image_011.gif deleted file mode 100644 index 8725aacb..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_011.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_012.gif b/docs/html-primer/Medley-Primer_files/Image_012.gif deleted file mode 100644 index 844b923f..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_012.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_013.gif b/docs/html-primer/Medley-Primer_files/Image_013.gif deleted file mode 100644 index 59e164f9..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_013.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_014.png b/docs/html-primer/Medley-Primer_files/Image_014.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_014.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_015.png b/docs/html-primer/Medley-Primer_files/Image_015.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_015.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_016.png b/docs/html-primer/Medley-Primer_files/Image_016.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_016.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_017.png b/docs/html-primer/Medley-Primer_files/Image_017.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_017.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_018.gif b/docs/html-primer/Medley-Primer_files/Image_018.gif deleted file mode 100644 index 22f74d3a..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_018.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_019.gif b/docs/html-primer/Medley-Primer_files/Image_019.gif deleted file mode 100644 index aae710d5..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_019.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_020.gif b/docs/html-primer/Medley-Primer_files/Image_020.gif deleted file mode 100644 index 612f7795..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_020.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_021.png b/docs/html-primer/Medley-Primer_files/Image_021.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_021.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_022.png b/docs/html-primer/Medley-Primer_files/Image_022.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_022.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_023.gif b/docs/html-primer/Medley-Primer_files/Image_023.gif deleted file mode 100644 index 0ec8cc6f..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_023.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_024.gif b/docs/html-primer/Medley-Primer_files/Image_024.gif deleted file mode 100644 index baf2ac0a..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_024.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_025.gif b/docs/html-primer/Medley-Primer_files/Image_025.gif deleted file mode 100644 index fe7f1815..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_025.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_026.gif b/docs/html-primer/Medley-Primer_files/Image_026.gif deleted file mode 100644 index 27e420ea..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_026.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_027.gif b/docs/html-primer/Medley-Primer_files/Image_027.gif deleted file mode 100644 index 5d090470..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_027.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_028.png b/docs/html-primer/Medley-Primer_files/Image_028.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_028.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_029.gif b/docs/html-primer/Medley-Primer_files/Image_029.gif deleted file mode 100644 index a93f51bf..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_029.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_030.png b/docs/html-primer/Medley-Primer_files/Image_030.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_030.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_031.gif b/docs/html-primer/Medley-Primer_files/Image_031.gif deleted file mode 100644 index 16b4cd56..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_031.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_032.gif b/docs/html-primer/Medley-Primer_files/Image_032.gif deleted file mode 100644 index ebd8aae3..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_032.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_033.gif b/docs/html-primer/Medley-Primer_files/Image_033.gif deleted file mode 100644 index bd2a4b08..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_033.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_034.gif b/docs/html-primer/Medley-Primer_files/Image_034.gif deleted file mode 100644 index 67de4555..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_034.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_035.gif b/docs/html-primer/Medley-Primer_files/Image_035.gif deleted file mode 100644 index bdf5beca..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_035.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_036.png b/docs/html-primer/Medley-Primer_files/Image_036.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_036.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_037.gif b/docs/html-primer/Medley-Primer_files/Image_037.gif deleted file mode 100644 index 556c7124..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_037.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_038.png b/docs/html-primer/Medley-Primer_files/Image_038.png deleted file mode 100644 index d52e604f..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_038.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_039.gif b/docs/html-primer/Medley-Primer_files/Image_039.gif deleted file mode 100644 index df3899a8..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_039.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_040.png b/docs/html-primer/Medley-Primer_files/Image_040.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_040.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_041.gif b/docs/html-primer/Medley-Primer_files/Image_041.gif deleted file mode 100644 index edd40961..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_041.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_042.png b/docs/html-primer/Medley-Primer_files/Image_042.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_042.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_043.gif b/docs/html-primer/Medley-Primer_files/Image_043.gif deleted file mode 100644 index 1e8b4769..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_043.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_044.gif b/docs/html-primer/Medley-Primer_files/Image_044.gif deleted file mode 100644 index fc5531af..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_044.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_045.gif b/docs/html-primer/Medley-Primer_files/Image_045.gif deleted file mode 100644 index c2b18b41..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_045.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_046.gif b/docs/html-primer/Medley-Primer_files/Image_046.gif deleted file mode 100644 index a613adb0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_046.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_047.gif b/docs/html-primer/Medley-Primer_files/Image_047.gif deleted file mode 100644 index c3a529bf..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_047.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_048.gif b/docs/html-primer/Medley-Primer_files/Image_048.gif deleted file mode 100644 index 5dbe5065..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_048.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_049.gif b/docs/html-primer/Medley-Primer_files/Image_049.gif deleted file mode 100644 index 252b6eb2..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_049.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_050.gif b/docs/html-primer/Medley-Primer_files/Image_050.gif deleted file mode 100644 index f91cb071..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_050.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_051.gif b/docs/html-primer/Medley-Primer_files/Image_051.gif deleted file mode 100644 index ddefb8e8..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_051.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_052.gif b/docs/html-primer/Medley-Primer_files/Image_052.gif deleted file mode 100644 index 7454b2a7..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_052.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_053.gif b/docs/html-primer/Medley-Primer_files/Image_053.gif deleted file mode 100644 index d59b78d2..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_053.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_054.gif b/docs/html-primer/Medley-Primer_files/Image_054.gif deleted file mode 100644 index 385c5fc4..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_054.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_055.gif b/docs/html-primer/Medley-Primer_files/Image_055.gif deleted file mode 100644 index e615b3e1..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_055.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_056.png b/docs/html-primer/Medley-Primer_files/Image_056.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_056.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_057.gif b/docs/html-primer/Medley-Primer_files/Image_057.gif deleted file mode 100644 index b6ca464a..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_057.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_058.gif b/docs/html-primer/Medley-Primer_files/Image_058.gif deleted file mode 100644 index ee0b2b69..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_058.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_059.gif b/docs/html-primer/Medley-Primer_files/Image_059.gif deleted file mode 100644 index 20d1fa14..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_059.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_060.gif b/docs/html-primer/Medley-Primer_files/Image_060.gif deleted file mode 100644 index a8426e53..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_060.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_061.gif b/docs/html-primer/Medley-Primer_files/Image_061.gif deleted file mode 100644 index 4f0f2560..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_061.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_062.gif b/docs/html-primer/Medley-Primer_files/Image_062.gif deleted file mode 100644 index f1882b49..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_062.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_063.gif b/docs/html-primer/Medley-Primer_files/Image_063.gif deleted file mode 100644 index 7057753e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_063.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_064.gif b/docs/html-primer/Medley-Primer_files/Image_064.gif deleted file mode 100644 index 4c59b213..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_064.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_065.gif b/docs/html-primer/Medley-Primer_files/Image_065.gif deleted file mode 100644 index b75f7480..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_065.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_066.png b/docs/html-primer/Medley-Primer_files/Image_066.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_066.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_067.gif b/docs/html-primer/Medley-Primer_files/Image_067.gif deleted file mode 100644 index 5b016634..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_067.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_068.png b/docs/html-primer/Medley-Primer_files/Image_068.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_068.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_069.png b/docs/html-primer/Medley-Primer_files/Image_069.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_069.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_070.gif b/docs/html-primer/Medley-Primer_files/Image_070.gif deleted file mode 100644 index 183033aa..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_070.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_071.png b/docs/html-primer/Medley-Primer_files/Image_071.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_071.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_072.gif b/docs/html-primer/Medley-Primer_files/Image_072.gif deleted file mode 100644 index 3b4feab0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_072.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_073.gif b/docs/html-primer/Medley-Primer_files/Image_073.gif deleted file mode 100644 index 5cefcdbc..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_073.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_074.png b/docs/html-primer/Medley-Primer_files/Image_074.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_074.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_075.gif b/docs/html-primer/Medley-Primer_files/Image_075.gif deleted file mode 100644 index 2a93d4d3..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_075.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_076.png b/docs/html-primer/Medley-Primer_files/Image_076.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_076.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_077.gif b/docs/html-primer/Medley-Primer_files/Image_077.gif deleted file mode 100644 index 85f00e1a..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_077.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_078.gif b/docs/html-primer/Medley-Primer_files/Image_078.gif deleted file mode 100644 index 4a6e22a8..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_078.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_079.gif b/docs/html-primer/Medley-Primer_files/Image_079.gif deleted file mode 100644 index d1ba0420..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_079.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_080.png b/docs/html-primer/Medley-Primer_files/Image_080.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_080.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_081.gif b/docs/html-primer/Medley-Primer_files/Image_081.gif deleted file mode 100644 index c1811fa4..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_081.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_082.png b/docs/html-primer/Medley-Primer_files/Image_082.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_082.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_083.gif b/docs/html-primer/Medley-Primer_files/Image_083.gif deleted file mode 100644 index f5317b73..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_083.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_084.gif b/docs/html-primer/Medley-Primer_files/Image_084.gif deleted file mode 100644 index 5848a334..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_084.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_085.gif b/docs/html-primer/Medley-Primer_files/Image_085.gif deleted file mode 100644 index cdc61377..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_085.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_086.png b/docs/html-primer/Medley-Primer_files/Image_086.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_086.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_087.gif b/docs/html-primer/Medley-Primer_files/Image_087.gif deleted file mode 100644 index 52c7bcfd..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_087.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_088.gif b/docs/html-primer/Medley-Primer_files/Image_088.gif deleted file mode 100644 index e2c5ab3a..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_088.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_089.gif b/docs/html-primer/Medley-Primer_files/Image_089.gif deleted file mode 100644 index 407ab149..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_089.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_090.gif b/docs/html-primer/Medley-Primer_files/Image_090.gif deleted file mode 100644 index 227799b7..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_090.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_091.gif b/docs/html-primer/Medley-Primer_files/Image_091.gif deleted file mode 100644 index fcaf32fc..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_091.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_092.gif b/docs/html-primer/Medley-Primer_files/Image_092.gif deleted file mode 100644 index 88b8349d..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_092.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_093.png b/docs/html-primer/Medley-Primer_files/Image_093.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_093.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_094.gif b/docs/html-primer/Medley-Primer_files/Image_094.gif deleted file mode 100644 index 37baf58d..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_094.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_095.gif b/docs/html-primer/Medley-Primer_files/Image_095.gif deleted file mode 100644 index 52ec68f8..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_095.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_096.gif b/docs/html-primer/Medley-Primer_files/Image_096.gif deleted file mode 100644 index e2317cee..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_096.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_097.gif b/docs/html-primer/Medley-Primer_files/Image_097.gif deleted file mode 100644 index 2a91340b..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_097.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_098.gif b/docs/html-primer/Medley-Primer_files/Image_098.gif deleted file mode 100644 index 1af02b15..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_098.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_099.png b/docs/html-primer/Medley-Primer_files/Image_099.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_099.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_100.gif b/docs/html-primer/Medley-Primer_files/Image_100.gif deleted file mode 100644 index 871398e9..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_100.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_101.gif b/docs/html-primer/Medley-Primer_files/Image_101.gif deleted file mode 100644 index a08c77e1..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_101.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_102.gif b/docs/html-primer/Medley-Primer_files/Image_102.gif deleted file mode 100644 index f85edcb3..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_102.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_103.gif b/docs/html-primer/Medley-Primer_files/Image_103.gif deleted file mode 100644 index a470f97b..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_103.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_104.png b/docs/html-primer/Medley-Primer_files/Image_104.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_104.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_105.gif b/docs/html-primer/Medley-Primer_files/Image_105.gif deleted file mode 100644 index f1dd7ebf..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_105.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_106.gif b/docs/html-primer/Medley-Primer_files/Image_106.gif deleted file mode 100644 index 3cdd29b1..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_106.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_107.gif b/docs/html-primer/Medley-Primer_files/Image_107.gif deleted file mode 100644 index 204de8c6..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_107.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_108.gif b/docs/html-primer/Medley-Primer_files/Image_108.gif deleted file mode 100644 index 6b800da9..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_108.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_109.gif b/docs/html-primer/Medley-Primer_files/Image_109.gif deleted file mode 100644 index fd1cf72c..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_109.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_110.gif b/docs/html-primer/Medley-Primer_files/Image_110.gif deleted file mode 100644 index 4ac9391f..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_110.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_111.gif b/docs/html-primer/Medley-Primer_files/Image_111.gif deleted file mode 100644 index 63f5022e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_111.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_112.gif b/docs/html-primer/Medley-Primer_files/Image_112.gif deleted file mode 100644 index 6e21611b..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_112.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_113.png b/docs/html-primer/Medley-Primer_files/Image_113.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_113.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_114.gif b/docs/html-primer/Medley-Primer_files/Image_114.gif deleted file mode 100644 index 9f42429e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_114.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_115.gif b/docs/html-primer/Medley-Primer_files/Image_115.gif deleted file mode 100644 index 395ad149..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_115.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_116.gif b/docs/html-primer/Medley-Primer_files/Image_116.gif deleted file mode 100644 index 00d3507a..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_116.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_117.gif b/docs/html-primer/Medley-Primer_files/Image_117.gif deleted file mode 100644 index dc290f26..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_117.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_118.gif b/docs/html-primer/Medley-Primer_files/Image_118.gif deleted file mode 100644 index 18462864..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_118.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_119.gif b/docs/html-primer/Medley-Primer_files/Image_119.gif deleted file mode 100644 index 0dfafab1..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_119.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_120.png b/docs/html-primer/Medley-Primer_files/Image_120.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_120.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_121.gif b/docs/html-primer/Medley-Primer_files/Image_121.gif deleted file mode 100644 index 00089828..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_121.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_122.gif b/docs/html-primer/Medley-Primer_files/Image_122.gif deleted file mode 100644 index 045bc57e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_122.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_123.gif b/docs/html-primer/Medley-Primer_files/Image_123.gif deleted file mode 100644 index 0c1bd152..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_123.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_124.gif b/docs/html-primer/Medley-Primer_files/Image_124.gif deleted file mode 100644 index 44a87bb9..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_124.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_125.png b/docs/html-primer/Medley-Primer_files/Image_125.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_125.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_126.gif b/docs/html-primer/Medley-Primer_files/Image_126.gif deleted file mode 100644 index 549608ec..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_126.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_127.gif b/docs/html-primer/Medley-Primer_files/Image_127.gif deleted file mode 100644 index deb7f38b..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_127.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_128.gif b/docs/html-primer/Medley-Primer_files/Image_128.gif deleted file mode 100644 index 9db51e18..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_128.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_129.gif b/docs/html-primer/Medley-Primer_files/Image_129.gif deleted file mode 100644 index 9db51e18..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_129.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_130.gif b/docs/html-primer/Medley-Primer_files/Image_130.gif deleted file mode 100644 index 3c161513..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_130.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_131.png b/docs/html-primer/Medley-Primer_files/Image_131.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_131.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_132.gif b/docs/html-primer/Medley-Primer_files/Image_132.gif deleted file mode 100644 index 9db51e18..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_132.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_133.gif b/docs/html-primer/Medley-Primer_files/Image_133.gif deleted file mode 100644 index 630f033e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_133.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_134.png b/docs/html-primer/Medley-Primer_files/Image_134.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_134.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_135.gif b/docs/html-primer/Medley-Primer_files/Image_135.gif deleted file mode 100644 index 298316e6..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_135.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_136.gif b/docs/html-primer/Medley-Primer_files/Image_136.gif deleted file mode 100644 index b5786322..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_136.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_137.gif b/docs/html-primer/Medley-Primer_files/Image_137.gif deleted file mode 100644 index 5e7da185..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_137.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_138.png b/docs/html-primer/Medley-Primer_files/Image_138.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_138.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_139.png b/docs/html-primer/Medley-Primer_files/Image_139.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_139.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_140.png b/docs/html-primer/Medley-Primer_files/Image_140.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_140.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_141.png b/docs/html-primer/Medley-Primer_files/Image_141.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_141.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_142.gif b/docs/html-primer/Medley-Primer_files/Image_142.gif deleted file mode 100644 index 82ecae8c..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_142.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_143.gif b/docs/html-primer/Medley-Primer_files/Image_143.gif deleted file mode 100644 index 43159ba2..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_143.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_144.gif b/docs/html-primer/Medley-Primer_files/Image_144.gif deleted file mode 100644 index d268ee15..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_144.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_145.gif b/docs/html-primer/Medley-Primer_files/Image_145.gif deleted file mode 100644 index e1eff65c..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_145.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_146.gif b/docs/html-primer/Medley-Primer_files/Image_146.gif deleted file mode 100644 index dae39f4c..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_146.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_147.gif b/docs/html-primer/Medley-Primer_files/Image_147.gif deleted file mode 100644 index cc5a69d2..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_147.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_148.gif b/docs/html-primer/Medley-Primer_files/Image_148.gif deleted file mode 100644 index 8399008c..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_148.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_149.gif b/docs/html-primer/Medley-Primer_files/Image_149.gif deleted file mode 100644 index 1a9cea54..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_149.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_150.gif b/docs/html-primer/Medley-Primer_files/Image_150.gif deleted file mode 100644 index bfb15249..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_150.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_151.gif b/docs/html-primer/Medley-Primer_files/Image_151.gif deleted file mode 100644 index 8beeabd4..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_151.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_152.gif b/docs/html-primer/Medley-Primer_files/Image_152.gif deleted file mode 100644 index b4d58ef3..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_152.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_153.png b/docs/html-primer/Medley-Primer_files/Image_153.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_153.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_154.gif b/docs/html-primer/Medley-Primer_files/Image_154.gif deleted file mode 100644 index 23db15f5..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_154.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_155.gif b/docs/html-primer/Medley-Primer_files/Image_155.gif deleted file mode 100644 index 8f103ebc..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_155.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_156.png b/docs/html-primer/Medley-Primer_files/Image_156.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_156.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_157.png b/docs/html-primer/Medley-Primer_files/Image_157.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_157.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_158.png b/docs/html-primer/Medley-Primer_files/Image_158.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_158.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_159.gif b/docs/html-primer/Medley-Primer_files/Image_159.gif deleted file mode 100644 index 27d8e145..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_159.gif and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_160.png b/docs/html-primer/Medley-Primer_files/Image_160.png deleted file mode 100644 index 09a298f0..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_160.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/Image_161.png b/docs/html-primer/Medley-Primer_files/Image_161.png deleted file mode 100644 index 8990609e..00000000 Binary files a/docs/html-primer/Medley-Primer_files/Image_161.png and /dev/null differ diff --git a/docs/html-primer/Medley-Primer_files/document.css b/docs/html-primer/Medley-Primer_files/document.css deleted file mode 100644 index b085590e..00000000 --- a/docs/html-primer/Medley-Primer_files/document.css +++ /dev/null @@ -1,20 +0,0 @@ -@charset "UTF-8"; * {margin:0; padding:0; text-indent:0; } - .s1 { color: black; font-family:"Times New Roman", serif; font-style: italic; font-weight: normal; text-decoration: none; font-size: 24pt; } - h4 { color: black; font-family:Arial, sans-serif; font-style: normal; font-weight: bold; text-decoration: none; font-size: 10pt; } - .p, p { color: black; font-family:"Times New Roman", serif; font-style: normal; font-weight: normal; text-decoration: none; font-size: 10pt; margin:0pt; } - .s2 { color: black; font-family:Symbol, serif; font-style: normal; font-weight: normal; text-decoration: none; font-size: 10pt; } - h1 { color: black; font-family:Arial, sans-serif; font-style: normal; font-weight: bold; text-decoration: none; font-size: 18pt; } - .s3 { color: black; font-family:"Courier New", monospace; font-style: normal; font-weight: normal; text-decoration: none; font-size: 10pt; } - .s4 { color: black; font-family:"Times New Roman", serif; font-style: italic; font-weight: normal; text-decoration: none; font-size: 10pt; } - .s5 { color: black; font-family:Arial, sans-serif; font-style: normal; font-weight: bold; text-decoration: none; font-size: 14pt; } - .s6 { color: black; font-family:Arial, sans-serif; font-style: normal; font-weight: normal; text-decoration: none; font-size: 10pt; } - .s7 { color: black; font-family:Arial, sans-serif; font-style: normal; font-weight: normal; text-decoration: underline; font-size: 10pt; } - .s8 { color: black; font-family:Arial, sans-serif; font-style: normal; font-weight: normal; text-decoration: none; font-size: 10pt; vertical-align: -2pt; } - h2 { color: black; font-family:Arial, sans-serif; font-style: normal; font-weight: bold; text-decoration: underline; font-size: 14pt; } - .s9 { color: black; font-family:"Courier New", monospace; font-style: normal; font-weight: bold; text-decoration: none; font-size: 10pt; } - .s10 { color: black; font-family:"Times New Roman", serif; font-style: normal; font-weight: bold; text-decoration: none; font-size: 10pt; } - .s11 { color: black; font-family:"Courier New", monospace; font-style: normal; font-weight: normal; text-decoration: underline; font-size: 10pt; } - h3 { color: black; font-family:Arial, sans-serif; font-style: normal; font-weight: bold; text-decoration: none; font-size: 12pt; } - .s12 { color: black; font-family:"Courier New", monospace; font-style: normal; font-weight: normal; text-decoration: none; font-size: 12pt; } - .s13 { color: black; font-family:"Courier New", monospace; font-style: normal; font-weight: normal; text-decoration: none; font-size: 10pt; vertical-align: 2pt; } - .s14 { color: black; font-family:"Times New Roman", serif; font-style: italic; font-weight: bold; text-decoration: none; font-size: 10pt; } diff --git a/docs/html-primer/Medley-Primer_files/navigation.css b/docs/html-primer/Medley-Primer_files/navigation.css deleted file mode 100644 index f95cdfb3..00000000 --- a/docs/html-primer/Medley-Primer_files/navigation.css +++ /dev/null @@ -1,40 +0,0 @@ -@charset "UTF-8"; -.nav > a, .top_nav > a, .toc > a -{ -color: #663300; -font-family: Arial, Helvetica, sans-serif; -font-size: 12px; -font-weight: bold; -background-color: white; -cursor: pointer; -text-decoration:none; -} -.nav > a:hover, .top_nav > a:hover, .toc > a:hover -{ -text-decoration:underline; -} - -.toc0 -{ -display: block; -margin-left: 0pt -} - -.toc1 -{ -display: block; -margin-left: 10pt -} - - -.toc2 -{ -display: block; -margin-left: 20pt -} - -.toc > *:before -{ -content: "• "; -} - diff --git a/docs/html-primer/Medley-Primer_files/part1.htm b/docs/html-primer/Medley-Primer_files/part1.htm deleted file mode 100644 index 941adbf8..00000000 --- a/docs/html-primer/Medley-Primer_files/part1.htm +++ /dev/null @@ -1,2 +0,0 @@ - -001-TITLEPAGE

< Previous | Contents | Next >

Venue Medley for the Novice

Release 2.0

February, 1992

Address comments to:

Venue

User Documentation 1549 Industrial Road

San Carlos, CA 94070 415-508-9672

Medley for the Novice Release 2.0

February 1992

Copyright  1992 by Venue. All rights reserved.

Medley is a trademark of Venue.

Xerox is a registered trademark and InterPress is a trademark of Xerox Corporation.

UNIX is a registered trademark of UNIX System Laboratories. Post Script is a registered trademark of Adobe Systems Inc.

Copyright protection includes material generated from the

software programs displayed on the screen, such as icons, screen display looks, and the like.

The information in this document is subject to change without notice and should not be construed as a commitment by Venue. While every effort has been made to ensure the accuracy of this document, Venue assumes no responsibility for any errors that may appear.

Text was written and produced with Venue text formatting tools; Xerox printers were used to produce text masters. The typeface is Classic.

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part10.htm b/docs/html-primer/Medley-Primer_files/part10.htm deleted file mode 100644 index c1c4471d..00000000 --- a/docs/html-primer/Medley-Primer_files/part10.htm +++ /dev/null @@ -1,2 +0,0 @@ - -07-EDITING-AND-SAVING

< Previous | Contents | Next >

7. EDITING AND SAVING

This chapter explains how to define functions, how to edit them, and how to save your work.

Defining Functions

DEFUN can be used to define new functions. The syntax for it is:

(DEFUN (<functionname> (<parameter-list><body-of-function>))

New functions can be created with DEFUN by typing directly into the Executive Window. Once defined, a function is a part of the Medley environment. For example, the function EXAMPLE-ADDER is defined in Figure 7-1.

Figure 7-1. Defining the Function EXAMPLE-ADDER

Now that the function is defined, it can be called from the Executive Window:

Figure 7-2.. After EXAMPLE-ADDER is defined, it can he executed The function returns 6, after printing out the message.

Functions can also be defined using the editor DEdit described above. To do this, simply type

(ED function-name ’FUNCTIONS)

You will be told that no definition exists for the function, and a menu will pop up asking you what type of function you would like to create:

Figure 7-3 Selecting a Function Template

Selecting the appropriate type will pop up an editor window with a function template. The use of the editor is explained in the Using the List Structure Editor section below.

Simple Editing in the Executive Window

First, type in an example function to edit:

3/41> (defun your-first-function (a b) (if (> a b)

’(the first is greater) ’(the second is greater)))

To run the function, type:

3/42> (YOUR-FIRST-FUNCTION 3 5) (THE SECOND IS GREATER)

Now, let’s alter this. Type:

3/43> FIX 41

Note that your original function is redisplayed, and ready to edit. (See Figure 7-4.)

Figure 7-4. Using FIX to Edit a Fundion

Move the text cursor to the appropriate place in the function by positioning the mouse cursor and pressing the left mouse button.

Delete text by moving the caret to the beginning of the section to be deleted. Hold the right mouse button down and move the mouse cursor over the text. All of the

highlighted text between the caret and mouse cursor is deleted when you release the right mouse button.

If you make a mistake, deletions can be undone. Press the UNDO key on the keypad to the left of the keyboard.

Now change GREATER to BIGGER:

1. Position the mouse cursor on the G of GREATER , and click the left mouse button. The text cursor is now where the mouse cursor is.

2. Next, press the right mouse button and hold it down. Notice that if you move the mouse cursor around, it will blacken the characters from the text cursor to the mouse cursor. Move the mouse so that the word "GREATER " is highlighted.

3. Release the right mouse button and GREATER is deleted.

4. Without moving the cursor, type in BIGGER .

5. There are two ways to end the editing session and run the function. One is to type Control-X. (Hold the Control key down, and type X.) Another is to move the text

cursor to the end of the line and crø In both cases, the function has been edited!

Try the new version of the function by typing:

3/48> (YOUR-FIRST-FUNCTION 8 9) (THE SECOND IS BIGGER)

and get the new result, or you can type:

3/49> REDO 42

(THE SECOND IS BIGGER)

Using the List Structure Editor

If the function you want to edit is not readily available (i.e. the function is not in the

Executive Window, and you can’t remember the history list number, or you simply have a lot of editing), use the List Structure Editor, often called SEdit. This editor is evoked with a call to ED:

81(ED ’YOUR-FIRST-FUNCTION ’FUNCTIONS)

Your function will be displayed in an edit window, as in Figure 7-5.

If there is no edit window on the screen, you will be prompted to create a window. As

before, hold the leff mouse button down, move the mouse until it form s a rectangle of an acceptable size and shape, then release the button. Your function definition will

automatically appear in this edit window.

Figure 7-5. An Edit Window

Many changes are easily done with the structure editor. Notice that by pressing the left mouse button you can place the caret in position, and by pressing the middle mouse

button you can select atoms or s-expressions. Repeated pressing of the middle button selects bigger pieces of text.

To add an expression that does not appear in the edit window (i.e., it cannot simply be underlined), place the caret at the insertion point and type it in.. For example, to

replace the first GREATER with LARGER, place the caret to the left of GREATER , as shown in Figure 7-6.

Figure 7-6. Caret Placement Prior to Changing GREATER with LARGER

Now press the DELETE key seven times, and type in LARGER . The window now looks like this:

Figure 7-7. GREATER Changed to LARGER

Notice the asterisk in the left edge of the title bar of the window. This designates that the function has be changed. Now exit the edit session by typing Control-X, and the function will be redifined.

Commenting Functions

Text can be marked as a comment by typing a semi-colon before the text of the comment.

; This is the form of a comment

Inside an editor window, the comment will be printed in a different font and may be moved to the far right of the code. SEdit is familiar with the Common Lisp convention of single comments being on the far right, double comments being justified with the

function level, and triple comments being on the far left, as is shown in Figure 7-8.

Figure 7-8. Placement of Comments

There are other editor commands which can be very useful. To learn about them, read Appendix B of the Release Notes.

File Functions and Variables: How to See and Save Them

With Medley, all work is done inside the Lisp environment. There is no operating system or command level other than the Executive Window. All functions and data

structures are defined and edited using normal Lisp commands. This sertion describes tools in the Medley environment that will keep track of any changes that you make in the environment that you have not yet saved on files, such as defining new functions,

changing the values of variables, or adding new variables. And it then has you save the changes in a file you specify. All of these functions are in the INTERLISP (IL:) package.

File Variables

Certain system-defined global variables are used by the file package to keep track of the environment as it stands. You can get system information by checking the values of

these variables. Two important variables follow.

• FILELST evaluates to a list, all files that yoU have loaded into the Medley environment.

• filenameCOMS (Each file loaded into the Lisp environment has associated with it a global variable, whose name is formed by appending COMS to the end of the filename.) This variable evaluates to a list of all the functions, variables, bitmaps, windows, and soon, that are stored on that particular file.

For example, if you type:

MYFILECOMS

the system will respond with something like:

((FNS YOUR-FIRST-FUNCTION ) VARS))

Saving Interlisp-D on Files

The functions (FILES?) and (MAKEFILE ’filename) are useful when it is time to save function, variables, windows, bitmaps, records and whatever else to files.

(FILES?) displays a list of variables that have values and are not already a part of any file, and then the functions that are not already part of any file.

Type:

(FILES?)

the system will respond with something like:

the variables: MY.VARIABLE CURRENT.TURTLE...to be dumped

the functions: RIGHT LEFT FORWARD BACKWARD CLEAR-SCREEN...to be dumped

want to say where the above go?

If you type Y, the system will prompt with each item. There are three options:

1. To save the item, type the filename (unquoted) of the file where the item should be placed. (This can be a brand new file or an existing file.)

2. To skip the item, without removing it from consideration the next

time (FILES?) is called, type crø This will allow you to postpone the decision about where to save the item.

3. If the item should not be saved at all, type ]. Nowhere will appear after the item.

Part of an example interaction is shown in the following figure:

Figure 7-9. Part of an interaction using the function FILES?

(FILES?) assembles the items by adding them to the appropriate file’s

COMS variable (see the File Variables section above). (FILES?) does NOT write the file to secondary storage (disks or floppies). It only

upclates the global variables discussed in the File Variables section above.

(MAKEFILE ’filename)

actually writes the file to secondary storage. Type:

(MAKEFILE ’MY.FILE.NAME)

and the system will create the file. The function returns the full name of the file created. (i.e. {DSK}MY.FlLE.NAME.; 1 ).

Files written to (DSK) are permanent files. They can be removed only by the user deleting them or by reformatting the disk.

Other file manipulation functions can be foun d in Chapter 4.

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part11.htm b/docs/html-primer/Medley-Primer_files/part11.htm deleted file mode 100644 index 2a78a9c4..00000000 --- a/docs/html-primer/Medley-Primer_files/part11.htm +++ /dev/null @@ -1,2 +0,0 @@ - -08-YOUR-INIT

< Previous | Contents | Next >

8. YOUR INIT FILE

Lisp has a number of global variables that control the environment. Global variables make it easy to customize the environment to fit your needs. One way to do this is to

develop an INIT file. This is a file that is loaded when you start an image. You can use it to set variables, load files, define functions, and any other things that you want to do to make the Medley environment suit you.

Using the USERGREETFILES Variable

As described in File Variables section of Chapter 11, each program file has a global Your INIT file could be called INIT, INIT.LISP, INIT.USER, or whatever the

convention is at your site. There is no default name preferred by the system, it just

looks for the files listed in the variable USERGREETFILES (see below). Check to see what the preference is at your site. Put this file in your directory. Your directory name should be the same as your login name. The INIT file is loaded by the function GREET. GREET is normally run when Medley is started. If this is not the case at your site, or you want

to use the machine and Medley has already been started, you can run the function

GREET yourself. If your user name was, for example, TURING , then you would type:

(GREET ’TURING)

This does a number of things, including undoing any previous greeting operation,

loading the site init file, and loading your init file. Where GREET looks for your INIT file depends on the value of the variable USERGREETFILES. The value of this variable is set when the system’s SYSOUT file is made, so check its value at your site! For example, its value could be:

Figure 8-1. Possible Value of USERGREETFILES

In each place you see >USER>, the argument passed to GREET is substituted into the path. This is your login name if you are just starting Medley. For example, the first value in the list would have the system check to see whether there was a

{DSK}<LISPFlLES>TURING>INIT.LISP file. No error is generated if you do not have an INIT file, and none of the files in USERGREETFILES are foun d.

Making an Init File

As described in File Variables section of Chapter 11, each program file has a global

variable associated with it, whose name is formed by appending COMS to the end of the root filename. For any of the standard INIT file names, the variable INITCOMS is used. To set up an init file, begin by editing this variable. Type:

(DV INITCOMS)

8. YOUR INIT FILE

An SEdit window wiil appear. This window is the same as the one called with the

function DF, and described in the Using the List Structure Editor section in Chapter 7. This chapter assumes that you know how to use the SEdit structure editor .

The COMS variable is a list of lists. The first atom in each internal list specifies for the file package what types of items are in the list, and what it is to do with them. This

section will deal with three types of lists: VARS, FILES, and P. Please read about others in Chapter 17 of the IRM.

Notice that inside the vars list, there is yet another list. The first item in the list is the name of the variable. It is bound to the value of the second item. There are many other variables that you can set by adding them to the VARS list. Some of these variables are described in Chapter 24, and many others can be foun d in the IRM.

If you want to automatically load files, that can be done in your init file also. For

example, if you always want to load tho Library file SPY.LCOM , you can load it by editing tho INITCOMS variable to list the appropriate file in the list starting with FILES:

.

.

.

(FILES SPY)

.

.

.

Figure 8-2. INITCOMS Changed to Load SPY.LCOM File

Other files can also be added by simply adding their names to this FILES list.

Another list that can appear in a COMS list begins with P. This list contains Lisp

expressions that are evaluated when the file is loaded. Do not put DEFINEQ expressions in this list. Define the function in the environment, and then save it on the file in the

usual way (see Chapter 7).

One type of expression you might want to see here, however, is a FONTCREATE function (see Chapter 16). For example, of you want to use a Helvetica 12 BOLD font, and there is not a font descriptor for it normally in your environment, the appropriate call to FONTCREATE should be in the "P" list. The INITCOMS would look like this:

.

.

.

(FILES SPY)

(P (FONTCREATE ’HELVETICA 12 ’BOLD))

.

.

.

Figure 8-3. INITCOMS Edited to Include a call to FONTCREATE

To quit, exit from SEdit in the usual way. When you run the function MAKEFILES (see Chapter 7), be sure that you are connected to the directory (see Chapter 4) where the INIT file should appear. Now when GREET is run, your Init file will be loaded.

8-2 Medley for the Novice, Release 2.0

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part12.htm b/docs/html-primer/Medley-Primer_files/part12.htm deleted file mode 100644 index f69c981a..00000000 --- a/docs/html-primer/Medley-Primer_files/part12.htm +++ /dev/null @@ -1,2 +0,0 @@ - -09-FLEXIBILITY

< Previous | Contents | Next >

9. MEDLEY FORGIVENESS: DWIM

DWIM (Do What I Mean) is an Interlisp utility that makes life easier.

DWIM tries to match unrecognized variable and function names to known ones. This allows Lisp to interpret minor typing errors or misspellings in a function, without

causing a break. Line 152 of Figure 9-1 illustrates how the misspelled BANNANNA was replaced by BANANA before the expression was evaluated.

Figure 9-1. Examples of DWIM Features

Sometimes DWIM may alter an expression you didn’t want it to. This may occur if, for

example, a hyphenated function name (e.g., (MY-FUNCTION) ) is misused. If the system does not recognize the function name, it may think you are trying to subtract "FUNCTION" from "MY". DWIM also takes the liberty of updating the function, so it will

have to be fixed. However, this is as much a blessing as a curse, since it points out the misused expression!

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part13.htm b/docs/html-primer/Medley-Primer_files/part13.htm deleted file mode 100644 index 33e88f19..00000000 --- a/docs/html-primer/Medley-Primer_files/part13.htm +++ /dev/null @@ -1,2 +0,0 @@ - -10-BREAK-MENU

< Previous | Contents | Next >

10. BREAKPACKAGE

The Break Package is a part of Interlisp that makes debugging your programs much easier.

Break Windows

A break is a function either called by the programmer or by the system when an error has occurred. A separate window opens for each break. This window works much like the Executive Window, except for extra menus unique to a break window. Inside a

break window, you can examine variables, look at the call stack at the time of the

break, or call the editor. Each successive break opens a new window, where you can execute functions without disturbing the original system stack. These windows

disappear when you resolve the break and return to a higher level.

Break Package Example

This example illustrates the basic break package functions. A more complete explanation of the breaking functions, and the break package will follow.

The correct definition of FACTORIAL is:

(defun factorial (x) (if (zerop x)

1

(* x (factorial (1- x)))))

To demonstrate the break package, we have edited in an error: DUMMY in the IF statement is an unbound atom, it lacks a value.

((defun factorial (x) (if (zerop x)

dummy

(* x (factorial (1- x)))))

The evaluated function

(FACTORIAL 4)

should return 24, but the above function has an error. DUMMY is an unbound atom, an atom without an assigned value, so Lisp will "break". A break window appears (Figure 10-1), that has all the functionality of the typing lisp expressions into the Executive

Window (The top level), in addition to the break menu functions. Each consecutive break will move to another level "down".

Figure 10-1. Break Window

Move the mouse cursor into the break window and hold down the middle mouse button.

The Break Menu will appear. Choose BT. Another menu, called the stack menu, will appear beside the break window. Choosing stack items from this menu will display

another window. This window displays the function’s local variable bindings, or values (see Figure 10-2). This new window, titled FACTORlAL Frame, is an inspector window (see inspector Chapter 17).

Figure 10-2. Back Trace of the System Stack

From the break window, you can call the editor for the function FACTORIAL by middle- buttoning on the word FACTORIAL and selecting DisplayEdit from the menu that pops up.

Replace the unbound atom DUMMY with 1. Exit the editor .

The function is fixed, and you can restart it from the last call on the stack. (It does not have to be started again from the Top Level.) To begin again from the last call on the stack, choose the last (top) FACTORIAL call in the BT menu. Select REVERT from the middle button break window, or type it into the window. The break window will close, and a new one will appear with the message: Breakpoint at FACTORIAL

To start execution with this last call to FACTORIAL , choose OK from the middle button break menu. The break window will disappear, and the correct answer, 24, will be

returned to the top level.

10. BREAKPACKAGE

Ways to Stop Execution from the Keyboard (Breaking Lisp)

There are ways you can stop execution from the keyboard. They differ in terms of how much of the current operating state is saved:

Control-G Provides you with a menu of processes to interrupt. Your process will

usually be "EXEC". Choose it to break your process. A break window will then appear.

Control-B Causes your function to break, saves the stack, then displays a break window with all the usual break functions. For information on other interrupt characcers, see Chapter 30 in the IRM.

Break Menu

Move the mouse cursor into the break window. Hold the middle button down, and a new menu will pop up, like the one in Figure 10-3.

Figure 10-3. Middle Button Menu in Break window

Five of the selections are particularly important when just starting to use Medley:

BT Back Trace displays the stack in a menu beside the break window. Back

Trace is a very powerful debugging tool. Each function call is placed on the

stack and removed when the execution of that function is complete. Choosing an item on the stack will open another window displaying that item’s local

variables and their bindings. This is an inspector window that offers all the power of the inspector. (For details, see the section on the Inspector, Chapter 17.)

? = Before you use this menu option, display the stack by choosing BT from this menu, and choose a function from it. Now, choose ?=. It will display the

current values of the arguments to the function that has been chosen from the stack.

 Move back to the previous break window, or if there is no other break window, back to the top level, the Executive Window.

REVERT Move the point of execution back to a specified function call before the error. The function to revert back to is, by default, the last function call before the break. If, however, a different function call is chosen on the BT menu, revert will go back to the start of this function and open a new break window. The

items on the stack above the new starting place will no longer exist. This is used in the tutorial example (see the Break Package Example section above).

OK Continue execution from the point of the break. This is useful if you have a simple error, i.e., an unbound variable or a nonnumeric argument to an

arithmetic function. Reset the variable in the break window, then select OK. (see the Break Package Example section above).

In addition to being available on the middle button menu of the break window, all of these functions can be typed directly into the window. Only BT behaves differently

when typed. It types the stack into the trace window instead of opening a new window.)

Returning to Top Level

Typing Control-D will immediately take you to the top level from any break window.

The functions called before the break will stop, but any side effect s of the function that occurred before the break remain. For example, if a function set a global variable before it broke, the variable will still be set after typing Control-D.

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part14.htm b/docs/html-primer/Medley-Primer_files/part14.htm deleted file mode 100644 index c47dc398..00000000 --- a/docs/html-primer/Medley-Primer_files/part14.htm +++ /dev/null @@ -1,2 +0,0 @@ - -11-WHAT-TO-DO

< Previous | Contents | Next >

11. WHAT TO DO IF ...

The purpose of this chapter is to explain what to do in some of the problems commonly experienced by Medley users.

Executive Window turns black

An example is shown in Figure 11-1.

Press any key to unfreeze the window and continue. This pause happens when the command you just typed causes enough information to be printed to fill the window. It gives you a chance to read that one window of text before moving on.

Figure 11-1. Blackened Executive Window

You closed the Executive Window

Open another from the Background Menu.

Mouse disappears

Type (CURSOR T) in the Executive Window. The cursor will reappear.

Second window appears

This probably happens because you made a typing mistake, as in Figure 11-2.

Figure 11-2. Second Window Appears (Break Window) after Typing Error Made

Type a Control-D by simultaneously pressing the Control key and the "D". This aborts the error condition, returning control to the Executive Window.

You keep getting beeped at

Usually the beeping means that Medley want input from you. Look for the flashing

caret. It will usually be preceeded by some kind of prompt, indicating what you should type.

You cannot delete the first letter

of the filename you are typing to (FILES?) . Type Control-E (error) You will get a linefeed and  printed to the window. Now type the correct filename.

Your function is just sitting there

It is not returning a value, and you think that your program may be in an infinite loop or is having some other major problem. You can see what process is currently running by typing Control-T, or you could interrupt the process by typing Control-E.

A Break Window appears

If the Break Window look something like that shown in Figure 11-3, you are trying to save a file, but there is not enough space on the hard disk.

Figure 11-3. Break Window Caused by Insufficient Space in Save File

Exit from the Break Window by typing an up arrow  followed by a Return. Delete old versions of files, and any other files you do not need. Then try again to save the file

You have run out of space

Generally, a Break Window has appeared. The GAINSPACE function allows you to delete non-essential data structures. To use it, type:

(GAINSPACE)

into the Executive Window. Answer N to all questions except the following:

• Delete edit history

• Delete history list

• Delete values of old variables

• Delete your MASTERSCOPE database

• Delete information for undoing your greeting. Save your work and reload Lisp as soon as possible.

A redefined message appears

The message (Some.Crucial.Function.Or.Variable redefined) appears in the

Executive Window (see Figure 11-4). The function, variable, or other property has been "smashed" (i.e., its original definition has been changed). If this is not what you

wanted, type UNDO immediately!

11. WHAT TO DO IF...

Figure 11-4. CAR redefined!

UNBOUND ATOM

If this occurs, you probably just typed something wrong, or you passed an argument that should have been quoted to a function.

UNDEFINED CAR OF FORM

First, look at what caused the error. If the CAR of the form is a list, then you typed something wrong. If it is an atom, then perhaps that atom does not have a function associated with it. If it is a CLISP word like if or for, then DWIM may have been

turned off (see Chapter 9). Type (DWIM ’C) to reenable DWIM.

You have traced APPLY

and your screen is spewing out information about everything going on in the

environment. Type Control E, and type (UNBREAK ’APPLY) before reeturning to the Executive.

[This page intentionally left blank]

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part15.htm b/docs/html-primer/Medley-Primer_files/part15.htm deleted file mode 100644 index e5335846..00000000 --- a/docs/html-primer/Medley-Primer_files/part15.htm +++ /dev/null @@ -1,2 +0,0 @@ - -12-WINDOWS

< Previous | Contents | Next >

12. WINDOWS AND REGIONS

Windows

Windows have two basic parts: an area on the screen containing a collection of pixels,

and a property list. The window properties determine how the window looks, the menus that can be accessed from it, what should happen when the mouse is inside the window and a mouse button is pressed, and soon.

CREATEW

Some of the window’s properties can be specified when a window is created with the function CREATEW. In particular, it is easy to specify the size and position of the

window; its title; and the width of its borders.

(CREATEW region title borderw’idth)

Region is a record (named REGION , with the fields left, bottom , width, and height) or a list. A region describes a rectangular area on the screen, the window’s dimensions and position. The fields left and bottom refer to the position of the bottom leff corner of

the region on the screen. Wi dth and height refer to the width and height of the region. The usable space inside the window will be smaller than the width and height, because some of the window’s region is consumed by the title bar, and some is taken by the

borders.

Title is a string that will be placed in the title bar of the window.

Borderwidth is the width of the border around the exterior of the window, in number of pixels.

For example, typing:

(SETQ MY.WINDOW (CREATEW (CREATEREGION l00 150 300 200) "THIS IS MY OWN WINDOW")

or

(SETQ MY.WINDOW (CREATEW

(CREATEW ’(100 150 300 200) "THIS IS MY OWN WINDOW")

produces a window with a default borderwidth. Note that you did not need to specify all the window’s properties (see Figure 12-1).

Figure 12-1. Creating a Window

In fact, if (CREATEW) is called without specifying a region, you will be prompted to sweep out a region for the window (see Chapter 10)

WlNDOWPROP

The function to access or add to any property of a window’s property list is

WINDOWPROP.

(WINDOWPROP window property <value>)

When you use WINDOWPROP with only two arguments—window and property—it

returns the value of the window’s property. When you use WINDOWPROP with all three

arguments—window, property and value—it sets the value the window’s property to the value you inserted for the third argument.

For example, consider the window, MY WINDOW , created using (CREATEW). TITLE and

REGION are both properties. Type

(WINDOWPROP MY.WINDOW ’TITLE)

and the value of MY.WlNDOW’s TITLE property is returned, "THIS 1S MY OWN WINDOW". To change the title, use the WINDOWPROP function, and give it the window, the property title, and the new title of the window.

(WINDOWPROP MY.WINDOW ’TITLE "MY FIRST WINDOW")

automatically changes the title and automatically updates the window. Now the window looks like Figure 12-2.

Figure 12-2. TITLE is a Window Property

Altering the region of the window, MY.WINDOW, is also be done with WINDOWPROP, in the same way you changed the title. (Changing either of the first two numbers of a region

changes the position of the window on the screen. Changing either of the last two numbers changes the dimensions of the window itself.)

Getting Windows to Do Things

Four basic window properties will be discussed here: CURSORINFN , CURSOROUTFN, CURSORMOVEDFN, and BUTTONEVENTFN.

A function can be stored as the value of the CURSORlNFN property of a window. It is called when the mouse cursor is moved into that window.

Look at the following example:

1. First, create a window called MY.WINDOW. Type:

(SETQ MY.WINDQW

(CREATEW

(CREATEREGION 200 200 200 200) "THIS WINDOW WILL SCREAM!"))

This creates a window.

2. Now define the function SCREAME R. It will be stored on the property CURSOR1NFN . (Notice that this function has one argument, WlNDOWNAM E. All functions called from the property CURSOR1NFN are passed the window it was called from. So the value of MY.WINDOW is bound to WINDOWNAME. When it is called, SCREAMER simply rings

bells.

(DEFINEQ (SCREAMER (WINDOWNAME) (RINGBELLS)

(PROMPTPRINT "YAY - IT WORKS!") (RINGBELLS)))

3. Now, alter that window’s CURSORINFN property, so that the system calls the function SCREAMER at the appropriate time. Type:

(WINDOWPROP MY.WINDOW ’CURSORINFN (FUNCTION SCREAMER))

4. After this, when you move the mouse cursor into MY.WlNDOW , the CURSORINFN

property’s function is called, and it rings bells twice.

CURSORINFN is one of the many window properties that come with each window - just as REGION and TITLE did. Other properties include:

CURSOROUTFN The function that is the value of this property is executed when the cursor is moved out of a window.

CURSORMOVEDFN The function that is the value of this property is executed when the cursor is moved while it is inside the window.

BUTTONEVENTFN The function that is the value of this property is executed when either the left or middle mouse buttons are pressed (or released).

Figure 12-3 shows MY.WlNDOW’s properties. Notice that the CURSORINFN has the

function SCREAMER stored in it. The properties were shown in this window using the function INSPECT. INSPECT is covered in Chapter 17.

Figure 12-3. Inspecting MY.WINDOW for Mouse-Related Window Properties

You can define functions for the values of the properties CURSOROUTFN and CURSORMOVEDFN in much the same way as you did for CURSORINFN. The function that is the value of the property BUTTONEVENTF N, however, can be specialized to respond in different ways, depending on which mouse button is pressed. This is explained in the

next section.

BUTTONEVENTFN

BUTTONEVENTFN is another property of a window. The function that is stored as the value of this property is called when tho mouse is inside the window, and a mouse button is pressed. As an example of how to use it, type:

(WINDOWPROP MY.WINDOW ’BUTTONEVENTFN (FUNCTION SCREAMER))

When the mouse cursor is moved into the window, bells will ring because of the CURS0RlNFN, but it will also ring bells when either the left or middle mouse button is pressed. Notice that the right mouse button functions as it usually does, with the

window manipulation menu. If only the left button should evoke the function SCREAMER, then the function can be written to do just this, using the function MOUSESTATE, and a form that only MOUSESTATE understands, ONLY. For example:

(DEFINEQ

(SCREAMER2 (WINDOWNAME)

(if (MOUSESTATE (ONLY LEFT)) then (RINGBELLS))))

In addition to (ONLY LEFT), MOUSESTATE can also be passed (ONLY MIDDLE) , (ONLY RIGHT) or combinations of these (e.g. (OR (ONLY LEFT) (ONLY MIDDLE))). You do not need to use ONLY with MOUSESTATE for every application. ONLY means that that

button is pressed and no other.

If you do write a function using (ONLY RIGHT), be sure that your function also checks position of the mouse cursor. Even if you want your function to be executed when the mouse cursor is inside the window and the right button is pressed, there is a convention that the function DOWINDOWCOM should be executed when the mouse cursor is in the

title bar or the border of the window and the right mouse button is pressed. Please

program your windows using this tradition! For more information, please see Chapter 28 in the IRM.

Looking at a Window’s Properties

INSPECT is a function that displays a list of the properties of a window, and their values. Figure 12.3 shows the INSPECT function run with MY.WINDOW . Note the

properties introduced in CREATEW : WBORDER is the window’s border, REG is the region, and WTITLE is the window’s title.

Regions

A region is a record, with the fields LEFT, BOTTOM , WIDTH, and HEIGHT. LEFT and BOTTOM refer to where the bottom left hand corner of the region is positioned on the screen. WIDTH and HEIGHT refer to the width and height of the region.

CREATEREGION creates an instance of a record of type REGION . Type:

(SETQ MY.REGION (CREATEREGION 15 l00 200 450))

to create a record of type REGION that denotes a rectangle 200 pixels high, and 450 pixels wide, whose bottom left corner is at position (15, 100). This record instance can be passed to any function that requires a region as an argument, such as CREATEW , above.

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part16.htm b/docs/html-primer/Medley-Primer_files/part16.htm deleted file mode 100644 index ecf2d40f..00000000 --- a/docs/html-primer/Medley-Primer_files/part16.htm +++ /dev/null @@ -1,2 +0,0 @@ - -13-WHAT-ARE-MENUS

< Previous | Contents | Next >

13. WHAT ARE MENUS?

While Medley provides a number of menus of its own (see Chapter 3), this section

addresses the menus you wish to create. You will learn how to create a menu, display a menu, and define functions that make your menu useful. Menus are instances of

records (see Chapter 24). There are 27 fields that determine the composition of every menu. Because Medley provides default values for most of these descriptive fields, you need to familiarize yourself with only a few that we describe in this section.

Two of these fields, the TITLE of your menu, and the ITEMS you wish it to contain, can be typed into the executive window as shown below:

Figure 13-1. Creating a menu

Note that creating a menu does not display it. MY.MENU is set to an instance of a menu record that specifies how the menu will look, but the menu is not displayed.

Displaying Menus

Typing either the MENU or ADDNENU functions will display your menu on the screen. MENU implements pop-up menus, like the Background Menu or the Window Menu. ADDMENU puts menus into a semi-permanent window on the screen, and lets you select items from it.

(MENU MENU POSITION) pops up a menu at a particular position on the screen. Type:

(MENU MY.MENU NIL)

to position the menu at the end of the mouse cursor. Note that the POSITION argument is NIL. In order to go on, you must either choose an item, or move outside the menu

window and press a mouse button. When you do either, the menu will disappear. If you choose an item, then want to choose another, the menu must be redisplayed.

(ADDMENU menu window position) positions a permanent menu on the screen, or in an existing window.

Type:

(ADDMENU MY.MENU)

to display the menu as shown in Figure 13-2. This menu will remain active, (will stay on the screen) without stopping all the other processes. Because ADDMENU can display a menu without stopping all other processes, it is very popular in users programs.

If window is specified, the menu is displayed in that window. If window is not specified, a window the correct size for the menu is created, and the menu is displayed in that

window.

If position is not specified, the menu appears at the current position of the mouse cursor.

Figure 13-2. Simple MenuDisplayed with ADDMENU

Getting Menus to Do Stuff

One way to make a menu do things is to specify more about the menu items. Instead of items simply being the strings or atoms that will appear in the menu, items can be lists, each list with three elements (see Figure 13-3). The first element of each list is what

will appear in the menu; the second expression is what is evaluated, and the results of the evaluation returned, when the item is selected; and the third expression is the

expression that should be printed in the Prompt window when a mouse button is held down while the mouse is pointing to that menu item. This third item should be thought of as help text for the user. If the third element of the list is NIL, the system responds with Will select this item w hen you release the button.

Figure 13-3. Creating a Menu to do Things, then displaying it with the function

ADDMENU

Now when an item is selected from MY.MENU2, something will happen. When a mouse button is held down, the expression typed as the third element in the item’s

specification will be printed in the Prompt window. (See Figure 13-4.)

Figure 13-4. Mouse Button Held Down While Mouse Cursor SeIects NEXT.QUESTION

When the mouse button is released (i.e., the item is selected) the expression that was typed as the second element of the item’s specification will be run. (See Figure 13-5.)

Figure 13-5. NEXT-QUESTION Selected

WHENHELDFN and WHENSELECTEDFN Fields of a Menu

Another way to get a menu to do things is to define functions, and make them the

values of the menu’s WHENHELDFN and WHENSELECTEDFN fields. As the value of the

WHENHELDFN field of a menu, the function you defined will be executed when you press

and hold a mouse button inside the menu. As the value of the WHENSELECTEDFN field of a menu, the function you defined will be executed when you choose a menu item. This

example has the same functionality as the previous example, where each menu item was entered as a list of three items.

As an example, type in these two functions so that they can be executed when the menu is created and displayed:

(DEFINEQ (MY.MENU3.WHENHELD (ITEM.SELECTED MENU.FROM BUTTON.PRESSED)

(SELECTQ ITEM.SELECTED

(QUIT (PROMPTPRINT "CHOOSE THIS TO STOP")

(NEXT-QUESTION (PROMPTPRINT "CHOOSE THIS TO BE ASKED THE NEXT QUESTION"))

(NEXT-TOPIC (PROMPTPRINT "CHOOSE THIS TO MOVE ON TO THE NEXT SUBJECT"))

(SEE-TOPICS (PROMPTPRINT "CHOOSE THIS TO SEE THE TOPICS NOT YET LEARNED"))

(ERROR (PROMPTPRINT "NO MATCH FOUND"))))

(DEFINEQ (MY.MENU3.WHENSELECTED (ITEM.SELECTED MENU.FROM BUTTON.PRESSED)

(SELECTQ ITEM.SELECTED

(QUIT (PRINT "STOPPED")

(NEXT-QUESTION (PRINT "HERE IS THE NEXT QUESTION")) (NEXT-TOPIC (PRINT "HERE IS THE NEXT SUBJECT")) (SEE-TOPICS (PRINT "THE FOLLOWING HAVE NOT BEEN

LEARNED . . ."))

(ERROR (PROMPTPRINT "NO MATCH FOUND"))))

Now, to create the menu, type:

(SETQ MY.MENU3 (CREATE MENU

TITLE  "PLEASE CHOOSE ONE OF THE ITEMS"

ITEMS  ’(QUIT NEXT-QUESTION NEXT-TOPIC SEE-TOPICS) WHENHELDFN  (FUNCTION MY.MENU3.WHENHELD) WHENSELECTEDFN  (FUNCTION MY.MENU3.WHENSELECTED)))

To see your menu work, type

(ADDMENU MY.MENU3)

Now, due to executing the WHENHELDFN function, holding down any mouse button while pointing to a menu item will display an explanation of the item in the prompt window.

The screen will once again look like Figure 13-4 when the mouse button is held when the mouse cursor is pointing to the item NEXT-TOPIC .

Now due to executing the WHENSELECTEDFN function, releasing the mouse button to select an item will cause the proper actions for that item to be taken. The screen will once again look like Figure 13-5 when the item NEXT-TOPIC is selected. The crucial

thing to note is that the functions you defined for WHENHELDFN and WHENSELECTEDFN

are automatically given the following arguments:

1. The item that was sølected, ITEM.SELECTED

2. The menu it was selected from, MENU.FROM

3. The mousø button that was pressed BUTTON PRESSED

These functions, MY.MENU3.WHENHELD and MY.MENU3.WHENSELECTED, were quoted

using FUNCTION instead of QUOTE both for program readability and so that the compiler can produce faster code when the program is compiled. It is good style to quote

functions in Lisp by using the function FUNCTION instead of QUOTE.

Looking at a Menu’s Fields

INSPECT is a function that displays a list of the fields of a menu, and their values. Figure 13-6 shows the various fields of MY.MENU3 when the function (INSPECT

MY.MENU3) was called. Notice the values that were assigned by the examples, and all the defaults.

Figure 13-6. MY.MENU3 Fields

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part17.htm b/docs/html-primer/Medley-Primer_files/part17.htm deleted file mode 100644 index 03ee2125..00000000 --- a/docs/html-primer/Medley-Primer_files/part17.htm +++ /dev/null @@ -1,2 +0,0 @@ - -14-BITMAPS

< Previous | Contents | Next >

14. BITMAPS

A bitmap is a rectangular array of dots. The dots are called "pixels" (for picture

elements). Each dot, or pixel, is represented by a single bit. When a pixel or bit is turned on (i.e. that bit set to 1), a black dot is inserted into a bitmap. If you have a bitmap of a floppy on your screen (Figure 14-1), then all of the bits in the area that make up the floppy are turned on, and the surrounding bits are turned off.

Figure 14-1. Bitmap of a Floppy

BITMAPCREATE creates a bitmap, even though it can’t be seen.

(BITMAPCREATE width height)

If the width and height are not supplied, the system will prompt you for them.

EDITBM edits the bitmap. The syntax of the function is:

(EDITBM bitmapname)

Try the following to produce the results in Figure 14-4:

(SETQ MY.BITMAP (BITMAPCREATE 60 40)) EDITBM MY.BITMAP)

To dra w In the bitmap, move the mouse into the gridded section of the bitmap editor, and press and hold the leff mouse button. Move the mouse around to turn on the bits

represented by the spaces in the grid. Notice that each space in the grid represents one pixel on the bitmap

To erase Move the mouse into the gridded section of the bitmap editor, and press and hold the center mouse button. Move the mouse around to turn off the bits represented by the spaces in the gridded section of the bitmap editor.

To w ork on a different section Point with the mouse cursor to the picture of the

actual bitmap (the upper left corner of the bitmap editor). Press and hold the left mouse button. A menu with the single item, Move will appear. (See Figure 14-2.) Choose this

item.

Figure 14-2. Menu with Single Item (Move)

You will be asked to position a ghost window over the bitmap. This ghost window

represents the portion of the bitmap that you are currently editing. Place it over the

section of the bitmap that you wish to edit and click the left mouse button (see Figure 14-3).

Figure 14-3. Ghost Window Awaiting Positioning

To end the session, bring the mouse cursor into the upper-right portion of the window (the grey area) and press the center button. Select OK from the menu to save your

artwork.

Figure 14-4. Editing a Bitmap

BITBLT is the primitive function for moving bits (or pixels) from one bitmap to another.

It extracts bits from the source bitmap, and combines them in appropriate ways with those of the destination bitmap. The syntax of the function is:

(BITBLT sourcebitmap sourcelefl sourcebottom destinationbitmap destinationleft destinationbottom width height sourcetype operation texture clippIngregion)

Here’s how it’s done —using MY.BITMAP as the sourcebitmap and MY.WlNDOW as the destinationbitmap.

(BITBLT MY.BITMAP NIL NIL

MY.WINDOW NIL NIL NIL NIL ‘INPUT ‘REPLACE)

Note that the destination bitmap can be, and usually is, a window. Actually, it is the bitmap of a window, but the system handles that detail for you. Because of the NILs

(meaning "use the default"), MY.BITMAP will be BITBLT’d into the lower right corner of

MY.WlNDOW (see Figure 14-5).

Figure 14-5. BITBLT ing a Bitmap onto a Window Here is what each of the BITBLT arguments to the function mean:

sourcebitmap The bitmap to be moved into the destinationbitmap

sourceleft A number, starting at 0 for the left edge of the

sourcebitmap, that tells BITBLT where to start moving pixels from the sourcebitmap. For example, if the leftmost 10 pixels of sourcebitmap were not to be moved, sourceleft should be 10. The default value is 0.

sourcebottom A number, starting at 0 for the bottom edge of the

sourcebitmap, that tells BITBLT where to start moving pixels from the sourcebitmap. For example, if the bottom 10 rows of pixels of sourcebitmap were not to be moved, sourcebottom should be 10 The default value is 0.

destinationbitmap The bitmap that will receive the sourcebitmap. This is

often a window (actually the bitmap of a window, but Interlisp-D takes care of that for you).

destinationleft A number, starting at 0 for the left edge of the

destinationbitmap, that tells BITBLT where to start placing pixels from the sourcebitmap. For example, to place the

sourcebitmap 10 pixels in from the left, destinationleft should be 10. The default value is 0.

destinationbottom A number, starting at 0 for the bottom edge of the

destinationbitmap, that tells BITBLT where to start placing pixels from the sourcebitmap. For example, to place the

sourcebitmap 10 pixels up from the bottom,

destinationbottom should be 10. The default value is 0.

width How many pixels in each row of sourcebitmap should be moved. The samc amount of space is used in

destinationbitmap to receive the sourcebitmap. If this

argument is NIL, it defaults to the number of pixels from sourceleft to the end of the row of sourcebitmap.

height How many rows of pixels of sourcebitmap should be moved.

The same amount of space is used in destinationbitmap to receive the sourcebitmap. If this argument is NIL, it

defaults to the number of rows from sourcebottom to the top of the sourcebitmap.

sourcetype Refers to one of three ways to convert the sourcebitmap for

writing. For now, just use ’INPUT.

operation Refers to how the sourtebitmap gets BITBLT ’d on to the destinationbitmap. ’REPLACE will BLT the exact

sourcebitmap. Other operations allow you to AND, OR or XOR the bits from the sourcebitmap onto the bits on the destinationbitmap.

texture J ust use NIL for now.

clippingregion J ust use NIL for now.

For more information on these operations, see Chapter 27 in the IRM.

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part18.htm b/docs/html-primer/Medley-Primer_files/part18.htm deleted file mode 100644 index c3a9dc89..00000000 --- a/docs/html-primer/Medley-Primer_files/part18.htm +++ /dev/null @@ -1,2 +0,0 @@ - -15-DISPLAYSTREAMS

< Previous | Contents | Next >

15. DISPLAYSTREAMS

A displaystream is a genera Jized "place to display". They determine exactly what is displayed where. One example of a displaystream is a window. Windows are the only

displaystreams that will be used in this chapter. If you want to draw on a bitmap that is not a window, other than with BITBLT, or want to use other types of displaystreams, please refer to Chapter 27 in the IRM.

This chapter explains functions for drawing on displaystreams: DRAWLINE , DRAWTO, DRAWCIRCLE., and FILLCIRCLE. In addition, functions for locating and changIng your curreAt position in the displaystream are covered: DSPXPOSITION , DSPYPOSITION, and MOVETO.

Drawing on a Displaystream

The examples belowshow you how the functions for drawing on a display stream work. First, create a window. Windows are displaystreams, and the one you create are used for the examples in this chapter. Type:

(SETQ EXAMPLE.WINDOW (CREATEW))

DRAWLlNE

DRAWLINE draws a line in a displaystream. For example, type:

(DRAWLINE 10 15 100 150 5 ’INVERT EXAMPLE.WINDOW)

The results should look like Figure 15-1:

Figure 15-1. Line Drawn onto the EXAMPLE.WINDOW Displayrtream The syntax of DRAWLINE is

(DRAWLINE x1 y1 x2 y2 width operation stream color dashing)

The coordinates of the left bottom corner of the displaystream are 0 0.

xl and yl x and y coordinates of the beginning of the line x2andy2 ending coordinates of the line

width width of the line, in pixels

operation way the line is to be drawn. INVERT causes the line to invert the bits that are already in the displaystream. Drawing a line the second time using INVERT erases the line. For other operations, see Chapter 27 in the IRM.

stream displaystream. In this case, you used a window.

DRAWTO

DRAWTO draws a line that begins at your current position in the displaystream. For example, type:

(DRAWTO 120 135 5 ’INVERT EXAMPLE.WINDOW)

The results should look like Figure 15-2:

Figure 15-2. Another Line drawn onto the EXAMPLE.WINDOW Displaystream The syntax of DRAWTO is

(DRAWTO x y width operation stream color dashing)

The line begins at the current position in the displaystream. x x coordinate of the end of the line

y y coordinate of the end of the line

width width of the line

operation way the lino is to be drawn. INVERT causes the line to invert the bits that aro already in tho displaystream. Drawing a line the second time using INVERT erases the line. For other operations, see Chapter 27 in the IRM

stream displaystreom. In this case. you used a window.

DRAWClRCLE

DRAWCIRCLE draws a circle on a displaystream. To use it, type:

(DRAWCIRCLE 150 100 30 ’(VERTICAL 5) NIL EXAMPLE.WINDOW)

Now your window, EXAMPLE.WlNDOW, should look like Figure 15-3:

Figure 15-3. Circle Drawn onto the EXAMPLE.WlNDOW Displaystream The syntax of DRAWCIRCLE is

(DRAWCIRCLE centerx centery radius brush dashing stream) centerx x coordinate of the center of the circle

centery coordinate of the center of the circle radius radius of the circle in pixels

brush list.- The first- item of the list is the shape of the brush. Some of your

options include ROUND, SQUARE, and VERTICAL. The second item of that list is the width of the brush in pixels.

dashing list of positive integers. The brush is "on" for the number of units

indicated by the first element of the list, "off" for the number of units

indicated by the second element of the list. The third element specifies how long it will be on again, and so forth. The sequence is repeated until the circle has been drawn.

stream displaystream. In this case, you used a window.

FlLLClRCLE

FILLCIRCLE draws a filled circle on a displaystream. To use it, type:

(FILLCIRCLE 200 150 10 GRAYSHADE EXAMPLE.WINDOW)

EXAMPLE.WlNDOW now looks like Figure 15-4:

Figure 15-4. A filled circle drawn onto the displaystream The syntax of FILLCIRCLE is:

(FILLCIRCLE centerx centery radius texture stream) centerx x coordinate of the center of the circle

centery y coordinate of the center of the ci rcle radius radius of the circle in pixels

texture shade that will be used to fill in the circle. Interlisp-D provides you with

three shades: WHlTESHADE , BLACKSHADE, and GRAYSHADE. You can also create your own shades. For more information on how to do this, see

Chapter 27 in the IRM.

stream displaystream. In this case, you used a window

There are many other functions for drawing on a displaystream. Please refer to Chapter 27 in the IRM.

Text can also be placed into displaystreams. To do this, use printing functions such as PRIN1 and PRIN2, but supply the name of the displaystream as the "file" to print to. To place the text in the proper position in the displaystream, see the section below.

Locating and Changing Your Position in a Displaystream

There are functions provided to locate, and to change your current position in a

displayitream. This can help you place text, and other images where you want them in

a displaystream. This primer will only discuss three of these. There are others, and they can be foun d in the Chapter 27 of the IRM.

DSPXPOSlTlON

DSPXPOSITION is a function that will either change the current x position in a

displaystream, or simply report it. To have the function report the current x position in

EXAMPLE.WlNDOW, type:

(DSPXPOSITION NIL EXAMPLE.WINDOW)

DSPXPOSITION expects two arguments. The first is the new x position. If this argument is NIL, the current position is not changed, merely reported. The second argument is

the displaystream.

DSPYPOSlTlON

DSPYPOSITION is an analogous function, but It changes or reports the current y

position in a displaystream. As with DSPXPOSlTlON , if the first argument is a number, the current y position will be changed to that position. If it is NIL, the current position is simply reported. To have the function report the current y position in EXAMPLE.WlNDOW, type:

(DSPYPOSITION NIL EXAMPLE.WlNDOW)

MOVETO

The function MOVETO always changes your position in the displaystream. It expects three arguments:

(MOVETO x y stream)

x new x position in the display stream

y new y position in the display stream

stream display stream. The examples so far have used a window

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part19.htm b/docs/html-primer/Medley-Primer_files/part19.htm deleted file mode 100644 index 3216076b..00000000 --- a/docs/html-primer/Medley-Primer_files/part19.htm +++ /dev/null @@ -1,2 +0,0 @@ - -16-FONTS

< Previous | Contents | Next >

16. FONTS

This chapter explains font s and font descriptors, what they are and how to use them, so that you can use functions requiring font descriptors

You have already been exposed to many font s in Medley. For example, when you use the structure editor, DEdit (see the Using the List Structure Editor section of Chapter 7), you noticed that the comments were printed in a smaller font than the code, and

that CLlSP words (see the CLISP section of Chapter 9) were printed in a darker font

than the other words in the function. These are only some of the font s that are available in Medley.

In addition to the font s that appear on your screen, Medley uses font s for printers that are different than the ones used for the screen. The font s used to print to the screen are called DlSPLAYFONTS. The font s used for prining are called INTERPRESSFONTS , or PRESSFONTS, depending on the type of printer.

What Makes Up a Font

Fonts are described by family, weight, slope, width, and size. This section discusses each of these, and describes how they affect the font you see on the screen.

Family is one way that font s can differ. Here are some examples of how "family" affect s the look of a font:

CLASSIC This family makes the word "Able" look like this: Able MODERN This family makes the word "Able" look like this: Able TITAN This family makes the word "Able" look like this: Able

Weight also determines the look of a font. Once again, "Able" will be used as an example, this time only with the Classic family. A font’s weight can be:

BOLD And look like this: Able

MEDIUM

or REGULAR And look like this: Able

The slope of a font is italic or regular. Using the Classic family font again, in a regular weight, the slope affect s the font like this:

ITALIC Looks like this: Able

REGULAR Looks like this: Able

The width of a font is called its "expansion". It can be COMPRESSED , REGULAR, or

EXPANDED.

Together, the weight, slope, and expansion of a font specifies the font’s "face". Specifically, the face of a font is a three element list:

(weight slope expansion)

To make it easier to type, when a function requires a font face as an argument, it can be abbreviated with a three-character atom. The first specifies the weight, the second the

slope, and the third character the expansion. For example, some common font faces are abbreviated:

MRR This is the usual face, MEDIUM, REGULAR, REGULAR

MIR Makes an italic font. It stands for: MEDIUM , ITALIC, REGULAR

BRR Makes a bold font. The abbreviation means: BOLD, REGULAR , REGULAR BIR Means that the font should be both bold and italic. BIR stands for BOLD,

ITALIC, REGULAR

The above examples are used so oflen, that there are also more mnemonic abbreviations for them. They can also be used to specify a font face for a function that requires a face as an argument. They are:

STANDARD This is the usual face: MEDIUM, REGULAR, REGULAR; it was abbreviated above, MRR

ITALIC This was abbreviated above as MIR, and specifies an italic font

BOLD Makes a bold font; it was abbreviated above, BRR

BOLDITALIC Makes a font both bold and italic: BOLD, ITALIC , REGULAR; it was abbreviated above, BIR

A font also has a size. It is a positive integer that specifies the height of the font in

printers points. A point is, on an 1108 screen, about 1/72 of an inch. On the screen of an 1186, a point is 1/80 of an inch. The size of the font used in this chapter is 10. For

comparison, here is an example of a TITAN, MRR, size 12 font: Able.

Fontdescriptors and FONTCREATE

For Medley to use a font, it must have a font descriptor. A font descriptor is a data type in Interlisp-D that that holds all the information needed in order to use a particular font. When you print out a font descriptor, it looks like this:

{FONTDESCRIPTOR}#74,45540

Fontdescriptors are created by the function FONTCREATE . For example,

(FONTCREATE ’HELVETICA 12 ’BOLD)

creates a font descriptor that, when used by other functions, prints in HELVETICA BOLD size 12. Interlisp-D functions that work with font s expect a font descriptor produced

with the FONTCREATE function. The syntax of FONTCREATE is:

(FONTCREATE family size face)

Remember from the previous section, face is either a three element list (weight slope expansion), a three character atom abbreviation, e.g. MRR, or one of the mnemonic

abbreviations, e.g. STANDARD .

If FONTCREATE is asked to create a font descriptor that a J ready exists, the existing font descriptor is simply returned.

Display Fonts

Display font s require files that contain the bitmaps used to print each character on the screen. All of these files have the extension .DlSPLAYFONT . The file name itself

describes the font style and size that uses its bitmaps. For example:

MODERN12.DISPLAYFONT

contains bitmaps for the font family MODERN in size 12 points. Wherever you put your

.DISPLAYFONT files, you should make this one of the values of the variable DISPLAYFONTDIRECTORIES. Its value is a list of directories to search for the bitmap files for display font s. Usually, it contains the "FONT" directory where you copied the bitmap files, and the current connected directory. The current connected directory is

specified by the atom NIL. When looking for a .DISPLAYFONT file, the system checks the FONT directory on the hard disk, then the current connected directory.

Figure 16-1 shows an example value of DISPLAYFONTDIRECTORIES :

Figure 16-1. Value for the Atom DISFLAYFONTDIRECTORIES

InterPress Fonts

InterPress is the format that is used by Xerox laser printers. These printers normally have a resolution that is much higher than that of the screen: 300 points per inch.

To format files appropriately for output on such a printer, Interlisp must know the

actual size for each character that is to be printed. This is done through the use of width files that contain font width information for font s in InterPress format. For InterPress font s, you should make the location of these files one of the values of the variable INTERPRESSFONTDIRECTORIES. Its value is a list of directories to search for the font widths files for InterPress font s. Figure 16-2 is an example value of INTERPRESSFONTDIRECTORIES:

Figure 16-2. Value for Atom INTERPRESSFONTDIRECTORIES

Functions for Using Fonts

FONTPR0P Looking at Font Properties

It is possible to see the properties of a font descriptor. This s done with the function FONTPROP. For the following examples, the font descriptor used will be the one returned by the function (DEFAULTFONT ’DISPLAY) . In other words, the font descriptor

examined will be the default display font for the system.

There are many properties of a font that might be useful for you. Some of these are:

FAMILY To see the family of a font descriptor, type:

(FONTPROP (DEFAULTFONT ’DISPLAY) ’FAMILY)

SIZE As above, this is a positive integer that determines the height of the font in printer’s points. As an example, the SIZE of the current default font is:

Figure 16-3. Value of Font Property SIZE of Default Font

ASCENT The value of this property is a positive integer, the maximum height of

any character in the specified font from the baseline (bottom). The top of

the tallest character in the font, then, will be at (BASELINE + ASCENT

- l). For example, the ASCENT of the default font is:

Figure 16-4. Value Font Property ASCENT of Default Font

DESCENT The DESCENT is an integer that specifies the maximum number of points that a character in the font descends below the baseline (e.g.,

letters such as "p" and "g" have tails that descend below the baseline.). The bottom of the lowest character in the font will be at (BASELINE - DESCENT). To see the DESCENT of the default font, type:

(FONTPROP (DEFAULTFONT ’DISPLAY) ’DESCENT) HEIGHT HEIGHT is equal to (DESCENT - ASCENT).

FACE The value of this property is a list of the form (weight slope expansion). These are the weight, slope, and expansion described above. You can see each one separately, also. Use the property that you are interested in, WEIGHT, SLOPE, or EXPANSION, instead of FACE as the second argument to FONTPROP.

For other font properties, see Chapter 27 of the IRM.

STRlNGWlDTH

It is often useful to see how much space is required to print an expression in a particular font. The function STRINGWIDTH does this. For example, type:

(STRINGWIDTH "Hi there!" (FONTCREATE ’GACHA 10 ’STANDARD))

The number returned is how many left to right pixels would be needed if the string

were printed in this font. (Note that this doesn’t just work for pixels on the screen, but for all kinds of streams. For more information about streams, see Chapter 15.) Compare the number returned from the example call with the number returned when you change GACHA to TIMESROMAN.

DSPFONT - Changing the Font in One Window

The function DSPFONT changes the font in a single window. As an example of its use, first create a window to write in. Type:

(SETQ MY.FONT.WINDOW (CREATEW))

in the Executive Window. Sweep out the window. To print something in the default font, type:

(PRINT ’HELLO MY.FONT.WINDOW)

in the Executive Window. Your window, MY.FONT.WINDOW , will look something like Figure 16-5:

Figure 16-5. HELLO, Printed with the Default Font in MY.FONT.WINDOW

Now change the font in the window. Type:

(DSPFONT (FONTCREATE ’HELVETICA 12 ’BOLD) MY.FONT.WINDOW)

in the Executive Window. The arguments to FONTCREATE can be changed to create any desired font. Now retype the PRINT statement, and your window will look something

like Figure 16-6:

Flgure 16-6. Font in MY.FONT.WINDOW Changed Notice the font has been changed.

Personalizing Your Font Profile

Medley keeps a list of default font specifications. This list is used to set the font in all windows where the font is not specifically set by the user (see the DSPFONT section

above). The value of the atom FONTPROFILE is this list (see Figure 16-7).

A FONTPROFILE is a list of font descriptions that certain system functions access when printing output. It contains specifications for big font s (used when pretty printing a

function to type the function name), small font s (used for printing comments in the editor), and various other font s.

Figure 16-7. Value of the Atom FONTPROFILE

The list is in the form of an association list. The font class names (e.g., DEFAULTFONT , or BOLDFONT) are the keywords of the association list. When a number follows the

keyword, it is the font number for that font class.

The lists following the font class name or number are the font specifications, in a form that the function FONTCREATE can use. The first font specification list affer a keyword

is the specification for printing to windows. The list(GACHA 10) in the figure above is an example of the default specification for the printing to windows. The last two font

specification lists are for Press and InterPress file printing, respectively. For more information, see Chapter 27 in the IRM.

Now, to change your default font settings, change the value of the variable FONTPROFILE. Medley has a list of profiles stored as the value of the atom FONTDEFS . Choose the profile to use, then install it as the default FONTPROFILE .

Evaluate the atom FONTDEFS and notice that each profile list begins with a keyword (see Figure 16-8). This keyword corresponds to the size of the font s included. BIG, SMALL, and STANDARD are some of the keywords for profiles on this list—SMALL and STANDARD appear in Figure 16-8.

Figure 16-8. Part of Value of the Atom FONTDEFS

To install a new profile from this list, follow the following example, but insert any keyword for BIG.

To use the profile with the keyword BIG instead of the standard one, evaluate the following expression:

(FONTSET ’BIG))

Now the font s are permanently replaced. (That is, until another profile is installed.)

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part2.htm b/docs/html-primer/Medley-Primer_files/part2.htm deleted file mode 100644 index 6cb3869c..00000000 --- a/docs/html-primer/Medley-Primer_files/part2.htm +++ /dev/null @@ -1,2 +0,0 @@ - -01-GLOSSARY

< Previous | Contents | Next >

1. BRIEF GLOSSARY

The following definitions will acquaint you with general terms used throughout this primer. You will probably want to read through them now, and use this chapter as a reference while you read through the rest of the primer.

advising A Medley facility for specifying function modifications without necessarily knowing how a particular function works or even what it does. Even system functions can be changed with

advising.

argument A piece of information given to a Lisp function so that it can execute successfully. When a function is explained in the

primer, the arguments that it requires will also be given. Arguments are also called Parameters.

atom The smallest structure in Lisp; like a variable in other

programming languages, but can also have a property list and a function definition.

Background Menu The menu that appears when the mouse is not in any window and the right mouse button is pressed.

binding The value of a variable. It could be either a local or a global variable. See unbound.

bitmap A rectangular array of "pixels," each of which is on or off representing one point in the bitmap image.

BREAK An Lisp function that causes a function to stop executing, open a Break window, and allows you to find out what is happening while the function is halted.

Break Window A window that opens when an error is encountered while

running your program (i.e., when your program has broken).

There are tools to help you debug your program from this window. This is explained further in Chapter 14.

browse To examine a data structure by use of a display that allows you to "move" around within the data structure.

button (1) (n.) A key on a mouse.

(2) (v.t.) To press one of the mouse keys when making a selection.

CAR A function that returns the head or first element of a list. See

CDR.

caret The small blinking arrowhead that marks where text will appear when it is typed in from the keyboard.

CDR A function that returns the tail (that is, everything but the first element) of a list. See CAR.

CLlSP A mechanism for augmenting the standard Lisp syntax. One such augmentation included in Interlisp is the iterative

statement. See Chapter 9. cr Press your Return key.

datatype (1) The kind of a datum. In Interlisp, there are many system- defined datatypes, e.g., Floating-Point, Integer, Atom, etc.

(2) A datatype can also be user-defined. In this case, it is like a record made up from system types and other user-defined datatypes.

DWIM "Do-what-I-mean." Many errors made by Medley users could be corrected without any information about the purpose of the program or expression in question (e.g., misspellings, certain kinds of parenthesis errors). The DWIM facility is called

automatically whenever an error occurs in the evaluation of an Interlisp expression. If DWIM is able to make a correction, the computation continues as though no error had occurred; otherwise, the standard error mechanism is invoked.

error Occasionally, while a program is running, an error may occur which will stop the computation. Interlisp provides extensive facilities for detecting and handling error conditions, to

enable the testing, debugging, and revising of imperfect programs.

evaluate or EVAL To find the value of a form. For example, if the variable X is bound to 5, we get 5 by evaluating X. Evaluation of a Lisp function involves evaluating the arguments and then

applying the function.

Executive Window This is your main window, where you will run functions and

develop your programs. This is the window that the caret is in when you turn on your machine and load Medley.

file package A set of functions and conventions that facilitate the bookkeeping involved with working in a large system consisting of many source code files and their compiled counterparts. Essentially, the file package keeps track of

where things are and what things have changed. It also keeps track of which files have been modified and need to be

updated and recompiled.

form Another way of saying s-expression. A Lisp expression that can be evaluated.

function A piece of Lisp code that executes and returns a value. history The programmer’s assistant is built around a memory

structure called the history list. The history functions (e.g.

FIX, UNDO, REDO) are part of this assistant. These operations allow you to conveniently rework previously specified

operations.

History List As you type on the screen, you will notice a number followed by a slash, followed by another number. The first number is the exec number, the second is the event number. Each

number, and the information on that line, is stored

sequentially as the History List Using the History List, you

can easily reexecute lines typed earlier in a work session. See Chapter 2.

icon A pictorial representation, usually of a shrunken window.

inspector An interactive display program for examining and changing the parts of a data structure. Medley has inspectors for lists and other data types.

iterative statement (also called i.s.) A statement in Interlisp that repetitively

executes a body of code For example, (for x from l to 5 do (PRlNT x)) is an i.s.

iterative variable (also called i.v.) Usually, an iterative statement is controlled by the value that the i.v. takes on. In the iterative statement

example above, x is the iterative variable because its value is being changed by each cycle through the loop. All iterative

variables are local to the iterative statement where they are defined.

Lisp Family of languages invented for "list processing." These languages have in common a set of basic primitives for

creating and manipulating symbol structures. Interlisp-D is an implementation of the Lisp language together with an

environment (set of tools) for programming, and a set of packages that extend the functionality of the system.

list A collection of atoms and lists; a list is denoted by surrounding its contents with a pair of parentheses.

Masterscope A program analysis tool. When told to analyze a program,

Masterscope creates a database of information about the

program. In particular, Masterscope knows which functions call other functions and which functions use which variables.

Masterscope can then answer questions about the program and display the information with a browser.

menu A way of graphically presenting you with a set of options.

There are two kinds of menus: pop-up menus are created

when needed and disappear after an item has been selected; permanent menus remain on the screen after use until

deliberately closed.

mouse The mouse is the box attached to your keyboard. It controls the movement of the cursor on your screen. As you become

familiar with the mouse, you will find it much quicker to use the mouse than the keyboard.

Mouse Cursor The small arrow on the screen that points to the northwest.

Mouse Cursor Icons Four types of mouse cursor icons are shown below.

Wait. The processor is busy.

The Mouse Confirm Cursor. It appears when you have to confirm that the choice you just made was correct. If it was, press the left button. If the choice was not correct, press the right button to abort.

This means "sweep out" the shape of the window. To do this, move the mouse to a position where you want a corner. Press the left mouse button, and hold it down. Move the mouse

diagonally to sketch a rectangle. When the rectangle is the desired size and shape, release the left button.

This is the "move window" prompt. Move the mouse so that the large "ghost" rectangle is in the position where you want the window. When you click the left mouse button, the

window will appear at this new location.

NIL NIL is the Lisp symbol for the empty list. It can also be represented by a left parenthesis followed by a right

parenthesis ( ). It is the only expression in Lisp that is both an atom and a list.

pixel Pixel stands for "picture element." The computer monitor

screen is made up of a rectangular array of pixels. Each pixel corresponds to one bit. When a bit is turned on (i.e., set to 1), the pixel on the screen represented by this bit is black.

pretty printing Pretty printing refers to the way Lisp functions are printed with special indentation, to make them easier to read.

Functions are pretty printed in the structure editor, SEdit

(see Chapter 7). You can pretty print uncompiled functions by calling the function PP with the function you would like to

see as an argument, i.e. (PP function-name). For an example of this, see Figure 1.5.

Figure 1.5. Example of Pretty Printing Function PP

Programmer’s

Assistant The programmer’s assistant accesses the History List to allow you to FIX, UNDO, and/or REDO your previous expressions

typed to the executive window (see Chapter 2).

Prompt Window The narrow black window at the top of the screen. It displays system prompts, or prompts you have developed (see Figure 1.6).

Figure 1.6. Prompt Window

property list A list of the form ( <property-namel> <property-value1>

<property-name2> <property-value2> ....) associated with an atom. It accessed by the functions GETPROP and PUTPROP.

record A record is a data structure that consists of named "fields".

Accessing elements of a record can be separated from the details of how the data structure is actually stored. This

eliminates many programming details. A record definition

establishes a record template, describing the form of a record. A record instance is an actual record storing data according to a particular record template. (See datatype, second

definition.)

Right Button Default

Window Menu This is the menu that appears when the mouse is in a

window, and the right mouse button is pressed. It looks like the menu in Figure 1.7. If this menu does not appear when you press the right button of the mouse and the mouse is in

the window, move the mouse so that it is pointing to the title bar of the window, and press the right button.

Figure 1.7. Right Button Default Window Menu

s-expression Short for "symbolic expression". In Lisp, this refers to any well-formed collection of left parentheses, atoms, and right parentheses.

stack A pushdown list. Whenever a function is entered, information about that specific function call is pushed onto (i.e., added to

the front of) the stack. This information includes the variable names and their values associated with the function call.

When the function is exitted, that data is popped off the stack.

sysout A flle containing a whole Lisp environment: namely,

everything you defined or loaded into the environment, the windows that appeared on the screen, the amount of memory

used, and so on. Everything is stored in the sysout file exactly as it was when the function SYSOUT was called.

TRACE A function that creates a trace of the execution of another

function. Each time the traced function is called, it prints out the values of the arguments it was called with, and prints out the value it returns upon completion.

unbound Without value; an atom is unbound if a value has never been assigned to it.

window A rectangular area of the screen that acts as the main display area for some Lisp process,

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part20.htm b/docs/html-primer/Medley-Primer_files/part20.htm deleted file mode 100644 index a9cfce39..00000000 --- a/docs/html-primer/Medley-Primer_files/part20.htm +++ /dev/null @@ -1,2 +0,0 @@ - -17-INSPECTOR

< Previous | Contents | Next >

17. THE INSPECTOR

The Inspector is a window-oriented tool designed to examine data structures. Because Medley is such a powerful programming environment, many types of data structures would be difficult to see in any other way.

Calling the Inspector

Take as an example an object defined through a sequence of pointers (i.e., a bitmap on the property list of a window on the property list of an atom inaprogram.)

To inspect an object named NAME, type:

(INSPECT ’NAME)

If NAME has many possible interpretations, an option menu will appear. For example, in Interlisp-D, a litatom can refer to both an atom and a function. For example, if NAME

was a record, had a function definition, and had properties on its property list, then the menu would appear as in Figure 17-1.

Figure 17-1. Option Window for Inspection of NAME

If NAME were a list, then the option menu shown in Figure 17.2 would appear. The options include:

• Calling the display editor on the list

• Calling the TTY editor (see Chapter 6)

• Seeing the list’s elements in a display window. If you choose this option, each

element in the list will appear in the right column of the Inspector window. The left column of the Inspector window will be made up of numbers (see Figure 17-3).

• Inspecting the list as a record type (this last option would produce a menu of known record types). If you choose a record type, the items in the list will appear in the

right column of the Inspector window. The left column of the Inspector window will be made up of the field names of the record.

Figure 17-2. Option Window for Inspection of List

Using the Inspector

If you choose to display your data structure in an edit window, simply edit the structure and exit in the normal manner when done. If you choose to display the data structure in an inspect window, then follow these instructions:

• To select an item, point the mouse cursor at it and press the left mouse button.

• Items in the right column of an Inspector window can themselves be inspected. To do this, choose the item, and press the center mouse button.

• Items in the right column of an Inspector window can be changed. To do this, choose the corresponding item in the left column, and press the center mouse button. You

will be prompted for the new value, and the item will be changed. The sequence of steps is shown in Figure 17-3.

The item in the lefl column is selected, and the middle mouse button pressed. Select the

SET option from the menu that pops up.

You will then be prompted for the new value. Type it in.

The item in the right column is updated to the value of what you typed in.

Figure 17-3. Steps Involved in Changing Value in Right Column of Inspector Window

Inspector Example

This example will use ideas discussed in Chapter 21. An example, ANlMALGRAPH , is created in that section. You do not need to know the details of how it was created, but the structure is examined in this chapter.

If you type

(INSPECT ANIMAL.GRAPH)

and then choose the Inspect option from the menu, a display appears as shown in

Figure 17-4. ANlMAL.GRAPH is being inspected as a list. Note the numbers in the left column of the inspectorwindow.

17. THE INSPECTOR

Figure 17-4. Inspector Window For ANIMAL.GRAPH , Inspected as List If you choose the "As A Record" option, and choose "GRAPH" from the menu that

appears, the inspector window looks like Figure 17-5. Note the fieldnames in the left column of the inspector window.

Figure 17-5. Inspector Window for ANlMAL.GRAPH , Inspected as Instance of GRAPH

Record

The remaining examples will use ANlMAL.GRAPH inspected as a list. When the first item in the Inspector window is chosen with the leff mouse button, the Inspector

window looks like Figure 17-6.

Figure 17-6. Inspector Window for ANlMAL.GRAPH With First Element Selected

When you use the middle mouse button to inspect the selected list element, the display looks like Figure 17-7.

Figure 17-7. Inspector Window for ANlMAL.GRAPH and for First Element of

ANIMAL.GRAPH

How you can see that six items make up the list, and you can further choose to inspect one of these items. Notice that this is also inspected as a list. As usual, it could also

have been inspected as a record.

Select item 5 - MAMMAL DOG CAT - with the left mouse button. Press the middle mouse button. Choose "Inspect" to inspect your choice as a list. The Inspector now displays the values of the structure that makes up MAMMAL DOG CAT . (See Figure 17-8.)

Figure 17-8. Inspector Window for Element S From Figure 17.7 That Begins ((MAMMAL DOG CAT).

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part21.htm b/docs/html-primer/Medley-Primer_files/part21.htm deleted file mode 100644 index 014feeba..00000000 --- a/docs/html-primer/Medley-Primer_files/part21.htm +++ /dev/null @@ -1,2 +0,0 @@ - -18-MASTERSCOPE

< Previous | Contents | Next >

18. MASTERSCOPE

Masterscope is a tool that allows you to quickly examine the structure of complex

programs. As your programs enlarge, you may forget what variables are global, what functions call other functions, and so forth. Masterscope keeps track of this for you.

To use Masterscope, first load MASTERSCOPE.DFASL and EXPORTS.ALL.

Suppose that JVTO is the name of a file that contains many of the functions involved in a complex system and that LINTRANS is the file containing the remaining functions. The first step is to ask Masterscope to analyze these files. These files must be loaded.

All Masterscope queries and commands begin with a period followed by a space, as in

. ANALYZE FNS ON MSCOPEDEMO

The ANALYZE process takes a while, so the system prints a period on the screen for each function it has analyzed. (See Figure 18-1)

Figure 18-1. Executive Window After Analyzing Files

If you are not quite sure what functions were just analyzed, type the file’s COMS variable (see the File Variables section in Chapter 7) into the Executive Window. The names of

the functions stored on the file will be a part of the value of this variable.

A variety of commands are now possible, all referring to individual functions within the analyzed files. Substantial variation in exact wording is permitted. Some commands

are:

. SHOW PATHS FROM ANY TO ANY

. EDIT WHERE ANY CALLS functionname

. EDIT WHERE ANY USES variablename

. WHO CALLS WHOM

. WHO CALLS functionname

. BY WHOM IS functionname CALLED

. WHO USES variablename AS FIELD

Note that the function is being called to invoke each command. Refer to the IRM for commands not listed here.

Figure 18-2 shows the Executive Window after the commands . WHO CALLS GobbleDump and . WHO DOES JVL inScan CALL.

Figure 18-2. Sample Masterscope Output

18. MASTERSCOPE

SHOW DATA Command and GRAPHER

When the library package GRAPHER is loaded (to load this package, type (FILESLOAD GRAPHER)), Masterscope’s SHOWPATHS command is modified. The command will be

changed to generate a tree structure showi ng how the program’s functions interact instead of a tabular printout into the Executive window. For example, typing:

. SHOW PATHS FROM ProcessEND

produced the display shown in Figure 18-3.

Figure 18-3. SHOW PATHS Display Example

All the functions in the display are part of this analyzed file or a previously analyzed file. Boxed functions indicate that the function name has been duplicated in another place on the display.

Selecting any function name on the display will pretty print the function in a window (see Figure 18-4).

Figure 18-4. Browser Printout Example

Selecting it again with the left mouse button will produce a desription of the function’s role in the overall system (see Figure 18-5).

18. MASTERSCOPE

Figure 18-5. Browser Description Example

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part22.htm b/docs/html-primer/Medley-Primer_files/part22.htm deleted file mode 100644 index 81423fd4..00000000 --- a/docs/html-primer/Medley-Primer_files/part22.htm +++ /dev/null @@ -1,2 +0,0 @@ - -19-SPY

< Previous | Contents | Next >

19. WHERE DOES ALL THE TIME GO? SPY

SPY is an Lisp library package that shows you where you spend your time when you run your system. It is easy to learn, and very useful when trying to make programs run

faster.

How to Use Spy with the SPY Window

The function SPY.BUTTON brings up a small window which you will be prompted to position. Using the mouse buttons in this window controls the action of the SPY

program. When you are not using SPY, the window appears as in Figure 19.1.

Figure 19.1. SPY Window When SPY is Not Being Used

To use SPY, click either the left or middle mouse button with the mouse cursor in the

SPY window. The window will appear as in Figure 19.2, and means that SPY is accumulating data about your program.

Figure 19.2. SPY Window When SPY is Being Used

To turn off SPY after the program has run, again click a mouse button in the SPY

window. The eye closes, and you are asked to position another window. This window contains SPY’s results. An example of the resulting window is shown in Figure 19.3.

19. WHERE DOES ALL THE TIME GO? SPY

Figure 19.3. Window Produced After Running SPY

This window is scrollable horizontally and vertically. This is useful, since the whole tree does not fit in the window. If a part that you want to see is not shown, you can scroll the window to show the part you want to see.

How to Use SPY from the Lisp Top Level

SPY can also be run while a specific function or system is being used. To do this, type the function WITH.SPY:

(WITH.SPY form)

The expression used for form should be the call to begin running the function or system that SPY is to watch. If you watch the SPY window, the eye will blink! To see your

results, run the function SPY.TREE. To do this, type:

(SPY.TREE)

The results of the last running of SPY will be displayed. If you do this, and SPY.TREE returns (no SPY samples have been gathered), your function ran too fast for SPY to follow.

Interpreting SPY’s Results

Each node in the tree is a box that contains, first, the percentage of time spent running that particular function, and second, the function name. There are two modes that can be used to display this tree.

The default mode is cumulative. In this mode, each percentage is the amount of time

that function spent on top of the stack, plus the amount of time spent by the functions it calls. The second mode is individual. To change the mode to individual, point to the title bar of the window, and press the middle mouse button. Choose Individual from the menu that appears. In this mode, the percentage shown is the amount of time the

function spent on the top of the stack.

To look at a single branch of the tree, point with the mouse cursor at one of the nodes of the tree, and press the right mouse button. From the menu that appears, choose the

19-2 Medley for the Novice, Release 2.0

19. WHERE DOES ALL THE TIME GO? SPY

option SubTree. Another SPY window will appear, with just this branch of the tree in it.

Another way to focu s within the tree is to remove branches from the tree. To do this, point to the node at the top of the branch you would like to delete. Press the middle mouse button, and choose Delete from the menu that appears.

There are also different amounts of "merging" of functions that can be done in the

window. A function can be called by another function more than once. The amount of merging determines where the subfunction, and the functions that it calls, appear in the tree, and how often. (For a detailed explanation of merging, see the Lisp Library Packages Manual.)

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part23.htm b/docs/html-primer/Medley-Primer_files/part23.htm deleted file mode 100644 index 9ab05b6b..00000000 --- a/docs/html-primer/Medley-Primer_files/part23.htm +++ /dev/null @@ -1,2 +0,0 @@ - -20-FREE-MENUS

< Previous | Contents | Next >

20. FREE MENUS

Free Menu is a library package that is even more flexible than the regular menu package. It allows you to create menus with different types of items in them, and

format s them as you require. Free menus are particularly useful when you want a "fill in the form" type interaction with the user.

Each menu item is described with a list of properties and values. The following example will give you an idea of the structure of the description list, and some of your options.

The most commonly used properties, and each type of menu item will be described in the Parts of a Free Menu Item and Types of Free Menu Items section below.

Free Menu Example

Free menus can be created and formatted automatically! It is done with the function

FM.FORMATMENU. This function takes one argument, a description of the menu. The

description is a list of lists; each internal list describes one row of the free menu. A free menu row can have more than one item in it, so there are really lists of lists of lists! It really isn’t hard, though, as you can see from the following example:

(SETQ ExampleMenu (FM.FORMATMENU

’(((TYPE TITLE LABEL TitlesDoNothing) TYPE 3STATE LABEL Example3State))

((TYPE EDITSTART LABEL PressToStartEditing

ITEMS (EDITEM)) (TYPE EDIT ID EDITEM LABEL ""))

(WINDOWPROPS TITLE "Example Does Nothing"))))

The first row has two items in it: one is a TITLE, and the second is a 3STATE item. The second row also has two items. The second, the EDIT item, is invisible, because its label is an empty string. The caret will appear for editing, however, if the EDITSTART item is chosen. Windowprops can appear as part of the description of the menu, because a

menu is, affer all, just a special window. You can specify not only the title with

WINDOWPROPS, but also the position of the free menu, using the "left" and "bottom"

properties, and the width of the border in pixels, with the "border" property. Evaluating this expression will return a window. You can see the menu by using the function OPENW. The following example illustrates this:

Figure 20.1. Example Free Menu

The next example shows you what the menu looks like after the EDITSTART item,

PressToStartEditing, has been chosen.

Figure 20.2. Free menu after EDITSTART Item Chosen

The following example shows the menu with the 3STATE item in its T state, with the item highlighted. (In the previous bitmaps, it was in its neutral state.)

.

Figure 20.3. Free menu with 3STATE Item in its T State

Finally, Figure 20.4 shows the 3STATE item in its NIL state, with a diagonal line through the item

Figure 20.4 Free menu with the 3STATE item in its NIL State

If you would like to specify the layout yourself, you can do that too. See the Lisp Library Packages Manual for more information.

Parts of a Free Menu Item

There are eight different types of items that you can use in a free menu. No matter

what type, the menu item is easily described by a list of properties, and values. Some of the properties you will use most often are listed below:

LABEL Required for every type of menu item. It is the atom, string, or bitmap that appears as a menu selection.

TYPE One of eight types of menu items. Each of these are described in the section below.

MESSAGE The message that appears in the prompt window if a mouse button is held down over the item.

ID An item’s unique identifier. An ID is needed for certain types of menu items.

ITEMS Used to list a series of choices for an NCHOOSE item, and to list the ID’s of the editable items for an EDITSTART item.

SELECTEDFN The name of the function to be called if the item is chosen.

Types of Free Menu Items

Each type of menu item is described in the following list, including an example description list for each one.

MOMENTARY This is the familiar sort of menu item. When it is selected, the

function stored with it is called. A description for the function that creates and format s the menu looks like this:

(TYPE MOMENTARY

LABEL Blink-N-Ring

MESSAGE "Blinks the screen and rings bells" SELECTEDFN RINGBELLS)

TOGGLE This menu item has two states, T and NIL. The default state is NIL, but choosing the item toggles its state. The following is an example description list, without code for the SELECTEDFN function, for this type of item:

(TYPE TOGGLE

LABEL DwimDisable SELECTEDFN ChangeDwimState)

20. FREE MENUS

3STATE This type of menu item has three states, NEUTRAL , T, and NIL. NEUTRAL is the default state. T is shown by highlighting the item, and NIL is shown with diagonal lines. The following is an example

description list, without code for the SELECTEDFN function, for this type of item:

(TYPE 3STATE

LABEL CorrectProgramAllOrNoSpelling SELECTEDFN ToggleSpellingCorrection)

TITLE This menu item appears on the menu as dummy text. It does nothing when chosen. An example of its description:

(TYPE TITLE LABEL "Choices:")

NWAY A group of items, nnly one of which can be chosen at a time. The items in the NWAY group should all have an ID field, and the ID’s

should be the same. For example, to set up a menu that would allow the user to choose between Helvetica, Gacha, Modern, and Classic font s, the descriptions might look like this (once again, without the code for the SELECTEDFN):

(TYPE NWAY ID FONTCHOICE

LABEL Helvetica SELECTEDFN ChangeFont)

(TYPE NWAY ID FONTCHOICE

LABEL Gacha

SELECTEDFN ChangeFont) (TYPE NWAY ID FONTCHOICE)

LABEL Modern SELECTEDFN ChangeFont)

(TYPE NWAY ID FONTCHOICE

LABEL Classic SELECTEDFN Changefont)

NCHOOSE This type of menu item is like NWAY except that the choices are given to the user in a submenu. The list to specify an NCHOOSE menu item that is analogous to the NWAY item above might look like this:

(TYPE NCHOOSE

LABEL FontChoices

ITEMS Helvetica Gacha Modern Classic) SELECTDFN Changefont)

EDITSTART When this type of menu itein is chosen, it activates another type of item, an EDIT item. The EDIT item or items associated with an EDITSTART item have their lD’s listed on the EDITSTART ’s ITEMS property. An example description list is:

(TYPE EDITSTART LABEL "Function to add?" ITEMS (Fn))

EDIT This type of menu item can actually be edited by you. It is often

associated with an EDITSTART item (see above), but the caret that prompts for input will also appear if the item itself is chosen. An EDIT item follows the same editing conventions as editing in

Executive Window:

Add characters by typing them at the caret.

Move the caret by pointing the mouse at the new position, and clicking the left button.

Delete characters from the caret to the mouse by pressing the right button of the mouse. Delete a character behind the caret by pressing the backspace key.

Stop editing by typing a carriage return, a Control-X, or by choosing another item from the menu.

An example description list for this type of item is:

(TYPE EDIT ID Fn LABEL **)

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part24.htm b/docs/html-primer/Medley-Primer_files/part24.htm deleted file mode 100644 index 101cb810..00000000 --- a/docs/html-primer/Medley-Primer_files/part24.htm +++ /dev/null @@ -1,2 +0,0 @@ - -21-GRAPHER

< Previous | Contents | Next >

21. THE GRAPHER

Say it with Graphs

Grapher is a collection of functions for creating and displaying graphs, networks of nodes and links. Grapher also allows you to associate program behavior with mouse selection of graph nodes. To load this package, type

(FILESLOAD GRAPHER)

Figure 21-1 shows a simple graph.

Figure 21-1. Simple Graph

In Figure 21-1 there are six nodes (ANIMAL , MAMMAL, DOG, CAT, FISH, and BIRD)

connected by five links. A GRAPH is a record containing several fields. Perhaps the most

important field is GRAPHNODES —which is itself a list of GRAPHNODE records. Figure 21-2 illustrates these data structures. The window on top contains the fields from the simple

graph. The window on the bottoms an inspection of the node, DOG.

Figure 21-2. Inspecting a Graph and a Node

The GRAPHNODE data structure is described by its text (NODEID ), what goes into it (FROMNODES), what leaves it (TONODES ), and other fields that specify its looks. The basic model of graph building is to create a bunch of nodes, then layout the nodes into a

graph, and finally display the resultant graph. This can be done in a number of ways.

One is to use the function NODECREATE to create the nodes, LAYOUTGRAPH to lay out the nodes, and SHOWGRAPH to display the graph. The primer shows you two simpler ways,

but please see the Library Packages Manual for more information about these other functions. The primer’s first method is to use SHOWGRAPH to display a graph with no nodes or links, then interactively add them. The second is to use the function

LAYOUTSEXPR, which does the appropriate NODECREATES and a LAYOUTGRAPH, with a list.

The function SHOWGRAPH displays graphs and allows you to edit them. The syntax of

SHOWGRAPH is

(SHOWGRAPH graph window lefibuttonfn middlebuttonfn topjustifyflg alloweditflg copybuttoneventfn)

Obviously the graph structure is very complex. Here’s the easiest way to create a graph.

(SETQ MY.GRAPH NIL)

(SHOWGRAPH MY.GRAPH "My Graph" NIL NIL NIL T)

Figure 21-3. My Graph

You will be prompted to create a small window as in Figure 21-3. This graph has the title My Graph. Hold down the right mouse button in the window. A menu of graph

editing operations will appear as in Figure 21-4.

Figure 21-4. Menu of Graph Editing Operations

Here’s how to use this menu. The commands in this menu are easy to learn. Experiment with them!

Add a Node

Start by selecting Add Node . Grapher will prompt you for the name of the node (see Figure 21-5.) and then its position.

Figure 21-5. Grapher Prompts for Name of Node to add after Add Node is Chosen from Graph Editing Menu.

Position the node by moving the mouse cursor to the desired location and clicking a mouse button. Figure 21-6 shows the graph with two nodes added using this menu.

Figure 21-6. Two Nodes Added to MY GRAPH Using GraphEditing Menu

Add a Link

Select Add Link from the graph editing menu. The Prompt window will prompt you to select the two nodes to be linked. (See Figure 21-7.) Do this, and the link will be added.

Figure 21-7. Prompt Window Requesting Selection of Two Nodes to Link, and Result

Delete a Link

Select Delete Link from the graph editing menu. ThePrompt window will prompt you to select the two nodes that should no longer be linked. (See Figure 21-8.) Do this, and

the link will be deleted.

Figure 21-8. Prompt Window Requesting Selection of Link to Delete, and Result

Delete a Node

Select Delete Node from the graph editing menu. The Prompt window will prompt you to select the node to be aeleted. (See Figure 21-9.) Do this, and the node will be deletea.

Figure 21.-9. Prompt to Delete a Node

Move a Node

Select Delete Node from the graph editng menu. Choose a node pointing to the it with the mouse cursor, and pressing and holding the leff mouse button. When you move the mouse cursor, the node will be dragged along. When the node is at the new position,

release the mouse button to deposit the node.

Making a Graph from a List

Typically, a graph is used to display one of your program’s data structures. Here is how that is done.

LAYOUTSEXPR takes a list and returns a GRAPH record. The syntax of the function is

(LAYOUTSEXPR sexpr format boxing font motherd personald famlyd)

For example:

(SETQ ANIMAL.TREE ’(ANIMAL (MAMMAL DOG CAT) BIRD FISH)) (SETQ ANIMAL.GRAPH

(LAYOUTSEXPR ANIMAL.TREE ’HORIZONTAL)) (SHOWGRAPH ANIMAL.GRAPH "My Graph" NIL NIL NIL T)

This is how Figure 21.1 was produced.

Incorporating Grapher into Your Program

The Grapher is designed to be built into other programs. It can call functions when, for example, a mouse button is clicked on a node. The function SHOWGRAPH does this:

(SHOWGRAPH graph window lefibuttonfn middlebuttonfn topjustifyflg alloweditflg copybuttoneventfn)

For example, the third argument to SHOWGRAPH , leftbuttonfn, is a function that is called when the left mouse button is pressed in the graph window. Try this:

(DEFINEQ (My.LEFT.BUTT0N.FUNCTION (THE.GRAPHNODE THE.GRAPH.WINDOW)

(INSPECT THE.GRAPHNODE)))

(SHOWGRAPH FAMILY.GRAPH "Inspectable family" (FUNCTION MY.LEFT.BUTTON.FUNCTION)

NIL NIL T)

In the example above, MY.LEFT.BUTTON.FUNCTION simply calls the inspector. The

function should be written assuming it will be passed a graphnode and the window that holds the graph. Try adding a function of your own.

More of Grapher

Some other Library packages make use of the Grapher. (Grapher needs to be loaded with the packages to use these functions.)

• MASTERSCOPE: The Browser package modifies the Masterscope command, . SHOW PATHS, so that its output is displayed as a graph (using Grapher) instead of simply printed.

• GRAPHZOOM: allows a graph to be redisplayed larger or smaller automatically.

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part25.htm b/docs/html-primer/Medley-Primer_files/part25.htm deleted file mode 100644 index 69bae92e..00000000 --- a/docs/html-primer/Medley-Primer_files/part25.htm +++ /dev/null @@ -1,2 +0,0 @@ - -22-RESOURCE-MANAGEMENT

< Previous | Contents | Next >

22. RESOURCE MANAGEMENT

Naming Variables and Records

You will find times when one environment simultaneously hosts a number of different programs. Running a demo of several programs, or reloading the entire Medley

environment from floppies when it contains several different programs, are two

examples that could, if you aren’t careful, provide a few problems. Here are a few tips on how to prevent problems:

• If you change the value of a system variable, MENUHELDWAIT for example, or connect to a directory other than {DSK}<LISPFILES> , write a function to reset the variable or directory to its original value. Run this function when you are finished working.

This is especially important if you change any of the system menus.

• Do not redefine Medley functions or CLISP words. Remember, if you reset an atom’s value or function definition at the top level (in the Executive Window), the message (Some.Crucial.Function.Or.Variable redefined) , appears. If this is not what you wanted, type UNDO immediately!

If, however, you reset the value or function definition of an atom inside your program, a warning message will not be printed.

• Make the atom names in your programs as unique as possible. To do this without filling your program with unreadable names that noone, including you, can

remember, prefix your variable names with the initials of your program. Even then, check to see that they are not already being used with the function BOUNDP . For

example, type:

(BOUNDP ’BackgroundMenu)

This atom is bound to the menu that appears when you press the leff mouse button

when the mouse cursor is not in any window. BOUNDP returns T. BOUNDP returns NIL

if its argument does not currently have a value.

• Make your function names as unique as possible. Once again, prefixing function

names with the initials of your program can be helpful in making them unique, but even so, check to see that they are not already being used. GETD is the Interlisp-D function that returns the function definition of an atom, if it has one. If an atom has no function definition, GETD returns NIL. For example, type:

(GETD ’CAR)

A non-NIL value is returned. The atom CAR already has a function definition.

• Use complete record field names in record FETCHes and REPLACE s when your code is not compiled. A complete record field name is a list consisting of the record

declaration name and the field name. Consider the following example:

(REC0RD NAME (FIRST LAST))

(SETQ MyName (create Name FIRST ’John LAST ’Smith)) (FETCH (NAME FIRST) OF MyName)

• Avoid reusing names that are field names of Lisp system records. A few examples of system records follow. Do not reuse these names.

(RECORD REGION (LEFT BOTTOM WIDTH HEIGHT)) (RECORD POSITION (XCOORD YCOORD))

(RECORD IMAGEOBJ (- BITMAP -)))

• When you select a record name and field names for a new record, check to see whether those names have already been used.

Call the function RECLOOK, with your record name as an argument, in the Executive Window (see Figure 22-1). If your record name is already a record, the record

definition will be returned; otherwise the function will return NIL.

Figure 22-1. Response to RECLOCK

Call the function FIELDLOOK with your new field name in the Executive Window (see Figure 22-2). If your field name is already a field name in another record, the record definition will be returned; otherwise the function will return NIL.

Figure 22-2. Response to FIELDLOOK

Some Space and Time Considerations

In order for your program to run at maximum speed, you must efficiently use the space available on the system. The following section points out areas that you may not know are wasting valuable space, and tips on how to prevent this waste.

Often programs are written so that new data structures are created each time the

program is run. This is wasteful. Write your programs so that they only create new variables and other data structures conditionally. If a structure has already been

created, use it instead of creating a new one.

Some time and space can be saved by changing your RECORD and TYPERECORD

declarations to DATATYPE . DATATYPE is used the same way as the functions RECORD and TYPERECORD. In addition, the same FETCH and REPLACE commands can be used with the data structure DATATYPE creates. The difference is that the data structure

DATATYPE creates cannot be treated as a list the way RECORD s and TYPERECORDs can.

22. RESOURCE MANAGEMENT

Global Variables

Once defined, global variables remain until Lisp is reloaded. Avoid using global

variables if at all possible! One specific problem arises when programs use the function

GENSYM. In program development, many atoms are created that may no longer be useful. Hints:

• Use

(DELDEF atomname ’PROP)

to delete property lists, and

(DELDEF atomname ’VARS)

to have the atom act like it is not defined.

These not only remove the definition from memory, but also change the appropriate fileCOMS that the deleted object was associated with so that the file package will not attempt to save the object (function, variable, record definition, and so forth) the next time the file is made. J ust doing something like

(SETQ (arg atomname) ’NOBIND)

looks like it will have the same effect as the second DELDEF above, but the SETQ does not update the file package.

• If you are generating atom names with GENSYM , try to keep a list of the atom names that are no longer needed. Reuse these atom names, before generating new ones.

There is a (fairly large) maximum to the number of atoms you can have, but things slow down considerably when you create lots of atoms.

• When possible, use a data structure such as a list or an array, instead of many

individual atoms. Such a structure has only one pointer to it. Once this pointer is

removed, the whole structure will be garbage-collected and space will be reclaimed.

Circular Lists

If your program is creating circular lists, a lot of space may be wasted. (Many

crosslinked data structures end up having circularities.) Hints when using circular lists:

• Write a function to remove pointers that make lists circular when you are through with the circular list.

• If you are working with circular lists of windows, bind your main window to a unique global variable. Write window creation conditionally so that if the binding of that

variable is already a window, use it, and only create a new window if that variable is unbound or NIL.

Here is an example that illustrates the problem. When several auxilIary windows are built, pointers to these windows are usually kept on the main window’s property list.

Each auxilIary window also typically keeps a pointer to the main window on its

property list If the top level function creates windows rather than reusing existing ones, there will be many lists of useless windows cluttering the work space. Or, if such a main window is closed and will not be used again, you will have to break the links by deleting the relevant properties from both the main window and all of the auxiliary windows

first. This is usually done by putting a special CLOSEFN on the main window and all of its auxiliary windows.

When You Run Out of Space

Typically, if you generato a lot of structure! that won’t get garbage collected, you will eventually run out of space. The important part ii being aNe to track down those

structures and the code that generates them to become more space efficient.

Use the Lisp Library Package GCHAX.DCOM to track down pointers to data structures. The basic idea is that GCHAX will return the number of references to a particular data structure.

A special function exists that allows you to get a little extra space so that you can try to save your work when you get toward the edge (usually noted by a message indicating

that you should save your work and load a new Medley environment). The GAINSPACE

function allows you to delete non-essential data structures. To use it, type:

(GAINSPACE)

into the Executive Window. Answer N to all questions except the followi ng.

• Delete edit history

• Delete history list.

• Delete values of old variables.

• Delete your MASTERSCOPE database

• Delete information for undoing your greeting.

Save your work and reload Lisp as soon as possible.

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part26.htm b/docs/html-primer/Medley-Primer_files/part26.htm deleted file mode 100644 index b11dee3f..00000000 --- a/docs/html-primer/Medley-Primer_files/part26.htm +++ /dev/null @@ -1,2 +0,0 @@ - -23-INTERACTIONS

< Previous | Contents | Next >

23. SIMPLE INTERACTIONS WITH THE CURSOR, A BITMAP, AND A WINDOW

The purpose of this chapter is to show you how to build a moderately tricky interactive interface with the various Medley display facilities. In particular how to move a large

bitmap (larger than 16 x 16 pixels) around inside a window. To do this, you will change the CURSORINFN and CURSOROUTFN properties of the window. If you would also like to then set the bitmap in place in the window, you must reset the BUTTONEVENTFN . This chapter explains how to create the mobile bitmap.

GETMOUSESTATE Example Function

One function that you will use to "trace the cursor" (have a bitmap follow the cursor around in a window) is GETMOUSESTATE. This function finds the current state of the. mouse, and resets global system variables, such as LASTMOUSEX and LASTMOUSEY.

As an example of how this function works, create a window by typing

(SETQ EXAMPLE.WINDOW (CREATEW))

into the Executive Window, and sweeping out a window. Now, type in the function

(DEFINEQ (PRINTCOORDS (W)

(PROMPTPRINT "(" LASTMOUSEX ", "LASTMOUSEY ")") (BLOCK)

(GETMOUSESTATE)))

This function calls GETMOUSESTATE and then prints the new values of LASTMOUSEX and

LASTMOUSEY in the promptwindow. To use it, type

(WINDOWPROP EXAMPLE.WINDOW ’CURSORMOVEDFN ’PRINTCOORDS)

The window property CURSORMOVEDFN, used in this example, will evaluate the function PRINTCOORDS each time the cursor is moved when it is inside the window. The position coordinates of the mouse cursor will appear in the prompt window. (See Figure 23.1.)

Figure 23.1. Current Position Coordinates of Mouse Cursor in Prompt Window

Advising GETMOUSESTATE

For the bitmap to follow the moving mouse cursor, the function GETMOUSESTATE is advised. When you advise a function, you can add new commands to the function

without knowing how it is actually implemented. The syntax for advise is

(ADVISE fn when where what)

fn is the name of the function to be augmented. when and where are optional

arguments. when specifies whether the change should be made before, after, or around the body of the function. The values expected are BEFORE , AFTER, or AROUND.

what specifies the additional code.

In the example, the additional code, what, moves the bitmap to the position of the

mouse cursor. The function GETNOUSESTATE will be ADVISEd when the mouse moves

into the window. This will cause the bitmap to follow the mouse cursor. ADVISE will be undone when the mouse leaves the window or when a mouse button is pushed. The ADVISEing will be done and undone by changing the CURSORINFN , CURSOROUTFN, and BUTTONEVENTFN for the window.

Changing the Cursor

One last part of the example, to give the impression that a bitmap is dragged around a window, the original cursor should disappear. Try typing:

(CURSOR (CURSORCREATE (BITMAPCREATE 1 l) 1 1]

into the Executive Window. This causes the original cursor to disappear. It reappears when you type

(CURSOR T)

When the cursor is invisible, and the bitmap moves as the cursor moves, the illusion is given that the bitmap is dragged around the window.

Functions for Tracing the Cursor

To actually have a bitmap trace (follow) the cursor, the environment must be set up so that when the cursor enters the tracing region the trace is turned on, and when the

cursor leaves the tracing region the trace is turned off. The function Establish/Trace/Data will do this. Type it in as it appears (include comments that will help you remember what the function does).

(DEFINEQ (Establish/Trace/Data

[LAMBDA (wnd tracebitmap cursor/rightoffset cursor/heightoffset GCGAGP)

(* * This function is called to establish the data to trace the desired bitmap. "wnd" is the window in which the tracing is to take place, "tracebitmap" is the tracing bitmap, "cursor/rightoffset" and "cursor/heightoffset" are integers which detemine the hotspot of the tracing bitmap.

As "cursor/heightoffset and "cursor/rightoffset" increase the cursor hotspot moves up and to the right.

If GCGAGP is non-NIL, GCGAG will be disabled.)

(PROG NIL

(if (OR (NULL wnd)

(NULL tracebitmap))

then (PLAYTUNE (LIST (CONS 1000 4000))) (RETURN))

(if GCGAGP

then (GCGAG))

(* * Create a blank cursor.)

(SETQ *BLANKCURSOR*(BITMAPCREATE 16 16))

(SETQ *BLANKTRACECURSOR*(CURSORCREATE *BLANKCURSOR*))

(* * Set the CURSOR IN and OUT FNS for wnd to the following:)

(WINDOWPROP wnd (QUOTE CURSORINFN)

(FUNCTION SETUP/TRACE)) (WINDOWPROP wnd (QUOTE CURSOROUTFN)

(FUNCTION UNTRACE/CURSOR))

(* * To allow the bitmap to be set down in the window by pressing a mouse button, include this line.

Otherwise, it is not needed)

(WINDOWPROP wnd (QUOTE BUTTONEVENTFN)

(FUNCTION PLACE/BITMAP/IN/WINDOW)) (WINDOWPROP wnd (QUOTE CURSOROUTFN)

(* * Set up Global Variables for the tracing operation) (SETQ *TRACEBITMAP* tracebitmap

(SETQ *RIGHTTRACE/OFFSET*(OR cursor/rightoffset 0)) (SETQ *HEIGHTTRACE/OFFSET*(OR cxursor heightoffset 0)) (SETQ *OLDBITMAPPOSITION*(BITMAPCREATE (BITMAPWIDTH

tracebitmap)

tracebitmap)))

(SETQ *TRACEWINDOW* wnd]))

(BITMAPHEIGHT

When the function Establish/Trace/Data is called, the functions SETUP/TRACE and

UNTRACE/CURSOR will be installed as the values of the window’s WlNDOWPROPS , and will be used to turn the trace on and off. Those functions should be typed in, then:

(DEFINEQ (SETUP/TRACE [LAMBDA (wnd)

(* * This function is wnd’s CURSORINFN.

It simply resets the last trace position and the current tracing region. It also readvises GETMOUSESTATE to perform the trace function after each call.)

(if *TRACEBITMAP*

then (SETQ *LAST-TRACE-XPOS* -2000) (SETQ *LAST-TRACE-YPOS* -2000)

(SETQ *WNDREGION* (WINDOWPROP wnd (QUOTE REGION))) (WINDOWPROP wnd (QUOTE TRACING)

T)

(* * make the cursor disappear)

(CURSOR *BLANKTRACECURSOR*) (ADVISE (QUOTE GETMOUSESTATE)

(QUOTE AFTER) NIL

(QUOTE (TRACE/CURSOR]))

(DEFINEQ (UNTRACE/CURSOR [LAMBDA (wnd)

(* * This function is wnd’s CURSOROUTFN. The function first checks if the cursor is currently being traced; if so, it replaces the tracing bitmap with what is under it and then turns tracing off by unadvising GETMOUSESTATE and setting the TRACING window property of *TRACEWINDOW* to NIL.)

(if (WINDOWPROP *TRACEWINDOW*(QUOTE TRACING))

then (BITBLT *OLDBITMAPPOSITION* 0 0 (SCREENBITMAP) (IPLUS (CAR *WNDREGION*)*LAST-TRACE-XPOS*) (IPLUS (CADR *WNDREGION*)*LAST-TRACE-YPOS*))

(WINDOWPROP *TRACEWINDOW*(QUOTE TRACING)

NIL))

(* * replace the original cursor shape) (CURSOR T)

(* * unadvise GETMOUSESTATE) (UNADVISE (QUOTE GETMOUSESTATE]))

The function SETUP/TRACE has a helper function that you must also type in. It is

TRACE/CURSOR:

(DEFINEQ (TRACE/CURSOR [LAMBDA NIL

(* * This function does the actual BITBLTing of the tracing bitmap. This function is called after a GETMOUSESTATE, while tracing.)

(PROG ((xpos (IDIFFERENCE (LASTMOUSEX *TRACEWINDOW*)

*RIGHTTRACE/OFFSET*))

(ypos (IDIFFERENCE (LASTMOUSEY *TRACEWINDOW*)

*HEIGHTTRACE/OFFSET*))

(* * If there is an error in the function, press the right button to unadvise the function. This will keep the machine from locking up.)

(if (LASTMOUSESTATE RIGHT)

then (UNADVISE (QUOTE GETMOUSESTATE))) (if (AND (NEQ xpos *LAST-TRACE-XPOS*)

(NEQ ypos *LAST-TRACE-YPOS*))

then

(* * Restore what was under the old position of the trace bitmap)

(BITBLT *OLDBITMAPPOSITION* 0 0 (SCREENBITMAP) (IPLUS (CAR *WNDREGION*)*LAST-TRACE-XPOS*) (IPLUS (CADR *WNDREGION*)*LAST-TRACE-YPOS*))

(* * Save what will be under the position of the new trace bitmap)

(BITBLT (SCREENBITMAP) (IPLUS (CAR *WNDREGION*)

xpos)

(IPLUS (CADR *WNDREGION*) ypos)*OLDBITMAPPOSITION* 0 0)

(* * BITBLT the trace bitmap onto the new position of the mouse)

(BITBLT *TRACEBITMAP* 0 0 (SCREENBITMAP) (IPLUS (CAR *WNDREGION*)

xpos)

(IPLUS (CADR *WNDREGION*)

ypos)

NIL NIL (QUOTE INPUT) (QUOTE PAINT))

(* * Save the current position as the last trace position.) (SETQ *LAST-TRACE-XPOS* xpos)

(SETQ *LAST-TRACE-YPOS* ypos]))

The helper function for UNTRACE/CURSOR , called UNDO/TRACE/DATA, must also be added to the environment:

(DEFINEQ (UNDO/TRACE/DATA [LAMBDA NIL

(* * The purpose of this function is to turn tracing off and to free up the global variables used to trace the bitmap so that they can be garbage collected.)

(* * Check if the cursor is currently being traced. It so, turn it off.)

(UNTRACE/CURSOR)

(WINDOWPROP *TRACEWINDOW*(QUOTE CURSORINFN) NIL)

(WINDOWPROP *TRACEWINDOW*(QUOTE CURSOROUTFN) NIL)

(SETQ *TRACEBITMAP* NIL)

(SETQ *RIGHTTRACE/OFFSET* NIL) (SETQ *HEIGHTTRACE/OFFSET* NIL) (SETQ *OLDBITMAPPOSITION* NIL) (SETQ *TRACEWINDOW* NIL)

(* * Turn GCGAG on) (GCGAG T]))

Finally, if you included the WlNDOWPROP to allow the user to place the bitmap in the window by pressing a mouse button, you must also type this function:

(DEFINEQ (PLACE/BITMAP/IN/WINDOW [LAMBDA (wnd)

(UNADVISE (GETMOUSESTATE))

(BITBLT *TRACEBITMAP* 0 0 (SCREENBITMAP) (IPLUS (CAR *WNDREGION*)

xpos)

(IPLUS (CADR *WNDREGION*)

ypos)

NIL NIL (QUOTE INPUT) (QUOTE PAINT]

That’s all the functions!

Running the Functions

To run the functions you just typed in, first set a variable to a window by typing something like

(SETQ EXAMPLE.WINDOW (CREATEW))

into the Executive Window, and sweeping out a new window. Now, set a variable to a bitmap, by typing, perhaps,

(SETQ EXAMPLE.BTM (EDITBM))

Type

(Estab1ish/Trace/Data EXAMPLE.WINDOW EXAMPLE.BTM))

When you move the cursor into the window, the cursor will drag the bitmap.

(If you want to be able to make menu selections while tracing the cursor, make sure

that the hotspot of the cursor is set to the extreme right of the bitmap. Otherwise, the menu will be destroyed by the BITBLT s of the trace functions.)

To stop tracing, do one of the following:

• Move the mouse cursor out of the window

• Press the right mouse button

• Call the function UNTRACE/CURSOR

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part27.htm b/docs/html-primer/Medley-Primer_files/part27.htm deleted file mode 100644 index e4d9fa9e..00000000 --- a/docs/html-primer/Medley-Primer_files/part27.htm +++ /dev/null @@ -1,2 +0,0 @@ - -24-GLOBAL-VARIABLES

< Previous | Contents | Next >

24. GLOSSARY OF GLOBAL SYSTEM VARIABLES

As you can tell by now, there are many system variables in Medley that are useful to know. The following sections gather many of the important variables together into

groups relating to directory searching, system flags, history lists, system menus, windows, and, of course, the catchall miscellaneous category.

Directories

DISPLAYFONTDIRECTORIES

Its value is a list of directories to search for the bitmap files for display font s. Usually, it contains the FONT directory where you copies the bitmap files (see Chapter 16), and the current connected directory. The current connected

directory is specified by the atom NIL. Here is an example value of

DISPLAYFONTDIRECTORIES.

Figure 24.1. Value for the Atom DISPLAYFONTDIRECTORIES INTERPRESSFONTDIRECTORIES

Is set to a list of directories to search for the font width files for InterPress font s.

DIRECTORIES

This variable is bound to a list of the directories you will be using (see Figure 24-2). The system uses this variable when it is trying to find a file to load. It checks each directory in the list, until the file is foun d. NIL in list means to check the current connected directory.

LISPUSERSDIRECTORIES

Its value is a list of directories to search for library package files.

Flags

DWIMIFYCOMPFLG

This flag, if set to T, will cause all expressions to be completely dwinified before the expression is compiled (see Chapter 9). In this state, when the system does not recognize a function of keyword, it will compare the word to a system

maintained list to determine whether the word is a macro, CLISP word, or misspelled user-defined variable.

An example of swinifying before compilation is to convert an IF call to a COND. before they are compiled. Undwimified expressions can cause inaccurate

compilation. This flag is set by the system to NIL. Normally, you want this set to T. For more information on DWIM, refer to the IRM.

SYSPRETTYFLAG

When set to T, all lists returned to the executive window are pretty printed. This flag is originally set by the system to NIL.

CLISPIFTRANFLG

When set to T, keeps the IF expression, rather than the COND translation in your code.

PRETTYTABFLG

When set to T, the pretty printer puts out a tab character rather than several spaces to try to make code align. If NIL, it uses space characters instead.

FONTCHANGEFLG

If NIL, then when pretty printing no font changes will happen (e.g., a smaller font for comments, bold for clip words, and so forth). The default is the atom ALL, so different font s are used where appropriate.

AUTOBACKTRACEFLG

There are many possible values for this variable. They affect when the back

trace window appears with the break window, and how much detail is included in it. The values of this variable include:

• NIL, its initial value. The back trace window is not brought up when an error is generated, until you open it yourself.

• T, which means that the back trace BT window is opened for error breaks

• BT! brings up a back trace window with more detail, BT!, window for error breaks

• ALWAYS brings up a backtrace BT window for both error breaks, and breaks caused by calling the function BREAK

• ALWAYS! brings up a backtrace window with more detail, BT!, for both error breaks and breaks caused by calling the function

NOSPELLFLG

Is initially bound to NIL, so that DWIM tries to correct all spelling errors,

whether they are in a form you just typed in or within a function being run. If the variable is T, then no spelling correction is performed. This variable is

automatically reset to T when you are compiling a file. If it has some other non-

NIL value, then spelling correction is only performed on type-in.

History Lists

LISPXHISTORY

Originally set to the list (NIL 0 30 100) , with the following argument

interpretation. The NIL is the list (implemented as a circular queue) to which the top level commands append. 0 is the current prompt number. 30 is the

maximum length of the history list. 100 is the highest number used as a

prompt. This is a system maintained list used by the programmers assistant commands REDO, UNDO, FIX, and ?? use to retrieve past function calls.

To delete the history list, reset the variable LISPXHISTORY to its original value of (NIL 0 30 100).

Setting this variable to NIL disables all the programmers assistant features.

EDITHISTORY

This is also set to (NIL 0 30 100), and has the same description as LISPXHISTORY. This list allows you to UNDO edits. You reset this the same way as LISPXHISTORY.

System Menus

System menus are all bound to global varieables and are easy to modyfy. If the menu name is set to the NIL value, the menu will be recreated using an items list bound to a global variable.

To change a system menu, edit the items list bound to the appropriate global variable (system menus use this items list with the default WHENSELECTEDFN ), then set the

value of the name to NIL. The next time you need the menu, it will be created from the items list you just edited. The names of system menus and the items lists follow.

BackgroundMenu

This is the variable bound to the menu this displays when you press the right button in the grey background area of the screen.

BackgroundMenuCommands

This list is used for the list of ITEMS for the background menu when it is created.

WindowMenu

This is the variable bound to the default window menu displayed when the right mouse button is pressed inside of a window.

WindowMenuCommands

This is the list of ITEMS for the WindowMenu.

BreakMenu

The menu displayed when the middle mouse button is pressed in a break

window.

BreakMenuCommands

The list of ITEM for the BreakMenu.

Windows

PROMPTWINDOW

Global name of the prompt window.

T

Although the value T has several meanings (such as universal TRUE), it also

stands for the standard output stream. As this is usually the executive window, it may be used as the name for the TTY Window at the top level. Mouse

processes have their own TTY Windows. A reference to the window T in a mouse driven function (e.g., a WHENSELECTEFN, Chapter 12) will open a TTY Window for Mouse.

Miscellaneous

CLEANUPOPTION

This is a list of options that you set to automate clean-up after a work session. Example options are listing files, or recompilation. You will want to keep this set to NIL until you become comfortable with the machine.

FILELST

The list of all the files you loaded.

SYSFILES

The list of all the files you loaded for the SYSOUT file.

INITIALS

An atom you can bind to your name. If bound, the editor will add your name, in addition to the date, in the editor comment at the beginning of each function.

FIRSTNAME

If this variable is set, the system will use it to greet you personally when you log on to your machine.

INITIALSLST

A list of elements of the form (USERNAME . INITIALS) or (USERNAME FIRSTNAME INITIALS). This list is used by the function GREET to set your INITIALS , and your FIRSTNAME when you log in.

#CAREFULCOLUMNS

An integer. PRETTYPRINT estimates the number of characters in an atom,

instead of computing it, for efficiency. Unfortunately, for very long atom names, errors can occur. #CAREFULCOLUMNS is the number of columns from the right within which PRETTYPRINT should compute the number of characters in each

atom, to prevent these errors. Initially this is set to zero. PRETTYPRINT never computes the number of characters in an atom. If you set it to 20 or 30, when PRETTYPRINT comes within 20 or 30 columns of the right of the window, it will begin computing exactly how many characters are in each atom. This will

prevent errors.

DWIMWAIT

Bound to the number of seconds DWIM should wait before it uses the default response, FIXSPELLDEFAULT , to answer its question.

FIXSPELLDEFAULT

Bound to either Y or N. Its value is used as the default answer to questions

asked by DWIM that you don’t answer in DWIMWAIT seconds. It is initially bound to Y, but is rebound to N when DWIMIFYing.

\TimeZoneComp

This is the global variable set to the absolute value of the time offset from Greenwich. For EST, \TimeZoneComp should be set to 5.

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part28.htm b/docs/html-primer/Medley-Primer_files/part28.htm deleted file mode 100644 index 423c03b0..00000000 --- a/docs/html-primer/Medley-Primer_files/part28.htm +++ /dev/null @@ -1,2 +0,0 @@ - -25-REFERENCES

< Previous | Contents

25. OTHER USEFUL REFERENCES

Here are some references to works that will be useful to you in addition to this primer. Some of these you have already been referred to, such as:

• The Interlisp-D Reference Manual (IRM)

• The Library Packages Manual

• The User’s Guide to SKETCH

In addition, you can learn more about Lisp with the books:

• Interlisp-D: The l a ngu ago a n d its usage by Steven H. Kaisler. This book was published in 1986 by John Wiley and Sons, NY.

• Essenti a l LISP by John Anderson, Albert Corbett, and Brian Reiser. This book was published in 1986 by Addison Wesley Publishing Company, Reading, MA. It was

informed by research on how beginners learn LISP.

• The Little Lisper by Daniel P. Friedman and Matthias Felleisen. The second edition of this book was published in 1986 by SRA Associates, Chicago. This book is a

deceptively simple introduction to recursive programming and the flexible data structures provided by LISP.

• LISP by Patrick Winston and Berthold Horn. The second edition of this book was published in 1985 by the Addison Wesley Publishing Company, Reading, MA.

• LISP: A Gentle Introd uction to Symbolic Comp ut a tion by David S. Touretzky. This book was published in 1984 by the Harper and Row Publishing Company, NY.

Finally, there are three articles about the Interlisp Programming environment:

• Power Tools For Programmers byBeau Sheil. It appeared in Datamation in February, 1983, Pages 131 - 144.

• The Interlisp Programming Environment by Warren Teitelman and Larry Masinter. It appeared in April, 1981, in IEEE Computer, Volume 14:1, Pages 25 - 34.

• Programming In an Interactive Environment, the LISP Experience by Erik

Sandewall. It appeared in March, 1978, in the ACM Computing Surveys, Volume 10:1, pages 35 - 71.

Each of these articles was reprinted in the book Inter active Prog r amming

Environ ments by David R. Barstow, Howard E. Shrobe, and Erik Sandewail. This

book was published in 1984 by McGraw Hill, NY. The first article can be foun d on pages 19 - 30, the second on pages 83 - 96, and the third on pages 31 - 80.

Medley for the Novice, Release 2.0

< Previous | Contents

diff --git a/docs/html-primer/Medley-Primer_files/part3.htm b/docs/html-primer/Medley-Primer_files/part3.htm deleted file mode 100644 index 2babb8fe..00000000 --- a/docs/html-primer/Medley-Primer_files/part3.htm +++ /dev/null @@ -1,2 +0,0 @@ - -002-PREFACE

< Previous | Contents | Next >

PREFACE

It was dawn and the local told him it was down the road a piece, left at the first fishing bridge in the country, right at the appletree stump, and onto the dirt road just before the hill. At midnight he knew he was lost. -Anonymous

Welcome to the Medley Lisp Development Environment, a collection of powerful tools for assisting you in programming in Lisp, developing sophisticated user interfaces, and creating prototypes of your ideas in a quick and easy manner. Unfortunately, along

with the power comes mind-numbing complexity. The Medley documentation set

describes all the tools in detail, but it would be unreasonable for us to expect a new user to wade through all of it, so this primer is intended as an introduction, to give you a

taste of some of the features.

We developed this primer to provide a starting point for new Medley users, to enhance your excitement and challenge you with the potential before you. We’re going to make some assumptions about you. For starters, we’re going to assume that you’re sitting at a workstation that can run Medley. All of the examples in the book figure that you’re

going to want to try things out. We’re also going to assume that you’ve had some exposure to Lisp, hopefully Common Lisp.

Medley actually consists of two complete Lisp implementations, Common Lisp and InterLisp. All the screen I/O and some of the system functions are in InterLisp.

However, thanks to the package system, you can call back and forth between the two languages by simply including a package delimiter in front of a symbol name. This sounds complicated, but it will become clearer once we do some examples.

Throughout we make reference to the lnterlisp-D Reference Manual by section and page number. The material in the primer is just an introduction. When you need more depth, use the detailed treatment provided in the manual.

While only you can plot your ultimate destination, you will flnd this primer

indispensable for clearly defining and guiding you to the first landmarks on your way.

Acknowledgements

The early inspiration and model for this primer came from the Intelligent Tutoring

Systems group and the Learning Research and Development Center at the University of Pittsburgh. We gratefully acknowledge their pioneering contribution to more effective

artificial intelligence.

This primer was originally developed by Computer Possibilities, a company committed to making Al technology available. Primary development and writing was done by

Cynthia Cosic, with technical writing support provided by Sam Zordich. It has been re- done by Venue staff to reflect changes in the environment since the original publication.

At Xerox Artificial Intelligence Systems, John Vittal managed and directed the project. Substantial assistance was provided by many members of the AlS staff who provided both editorial and systems support.

Medley for the Novice, Release 2.0

vii

PREFACE

[This page intentionally left blank]

viii Medley for the Novice, Release 2.0

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part4.htm b/docs/html-primer/Medley-Primer_files/part4.htm deleted file mode 100644 index ac7034aa..00000000 --- a/docs/html-primer/Medley-Primer_files/part4.htm +++ /dev/null @@ -1,2 +0,0 @@ - -02-TYPING-SHORTCUTS

< Previous | Contents | Next >

2. TYPING SHORTCUTS

Once you have logged in to Medley, you are in Lisp. The functions you type into the

Executive Window will now execute, that is, perform the designated task. Lisp is case-

sensitive; it often matters whether text is typed in upper- or lowercase letters. Use the Shift-Lock key on your keyboard to ensure that everything typed is in capital letters.

You must type all Lisp functions in parentheses. The Lisp interpreter will read from the left parenthesis to the closing right parenthesis to determine both the function you want to execute and the arguments to that function. Executing this function is called

"evaluation." When the function is evaluated, it returns a value, which is then printed in the Executive Window. This entire process is called the read-eval-print loop, and is how most Lisp interpreters, including the one for Lisp, run.

The prompt in is a number followed by a left-pointing arrow (see Figure 2.3). This number is the function’s position on the History List—a list that stores your

interactions with the Lisp interpreter. Type the function (PLUS 3 4) , and notice the History List assigns to the function (the number immediately to the left of the arrow).

Lisp reads in the function and its arguments, evaluates the function, and then prints the number 7.

Programmer’s Assistant

In addition to this read-eval-print loop, there is also a "programmer’s assistant." It is the programmer’s assistant that prints the number as part of the prompt in the

executive window, and uses these numbers to reference the function calls typed after them.

When you issue commands to the programmer’s assistant, you will not use parentheses as you do with ordinary functiion calls. You simply type the command, and some

specification that indicates which item on the history list the command refers to. Some programmer’s assistant commands are FIX, REDO, and UNDO. They are explained in

detail below.

Programmer’s assistant commands are useful only at the Lisp top level, that is, when you are typing into the Executive Window. They do not work in user-defined functions.

As an example use of the programmer’s assistant, use REDO to redo your function call

(PLUS 3 4). Type REDO at the prompt (programmer’s assistant commands can be

typed in either upper- or lowercase) , then specify the previous expression in one of the following ways:

• When you originally typed in the function you now want to refer to, there was a

History List number to the left of the arrow in the prompt. Type this number after the programmer’s assistant command. This is the method illustrated in Figure 2-1.

Figure 2-1. Using a Programmer’s Assistant Command to REDO a Function

• A negative number will specify the function call typed in that number of prompts dago. In this example, you would type in -1, the position immediately before the current position. This is shown in Figure 2-2.

Figure 2-2. Using a Negative Number after the Programmer’s Assistant Command

• You can also specify the function for the programmer’s assistant with one of the items that was in that function call. The programmer’s assistant will search

backwards in the History List, and use the first function it finds that includes that

item. For example, type REDO PLUS to have the functiion (PLUS 3 4) reevaluated.

• If you type a programmer’s assistant cmmand without specifying a function (i.e., simply typing the command, following by a Return), the programmer’s assistant executes the command using the function entered at the previous prompt.

Figure 2-3 shows a few more examples of how to use the programmer’s assistant.

Figure 2-3. Some Applications of the Programmer’s Assistant

If You Make a Mistake

Editing in the Executive Window is explained in detail in Chapter 7. In the following section, only a few of the most useful commands are repeated.

To move the caret to a new place in the command being typed, point the mouse cursor at the appropriate position. Then press the left mouse button.

To move the caret back to the end of the command being typed, press Control-X (hold the Control key down, and type X).

To delete:

Character behind the caret Press the Backspace key

Word behind the caret Press Control-W (hold the Control key down and type

W)

Any part of the command Move the caret to the appropriate place in the

command. Hold the right mouse button down and move the the mouse cursor over the text. All of the

blackened text between the caret and mouse cursor is deleted when you release the right mouse button.

Entire command Press Control-U (hold the Control key down and type

U)

Deletions can be undone. J ust press the UNDO key.

To add more text to the line, move the carent to the appropriate position and start to type. Whatever you type will appear at the caret.

[This page intentionally left blank]

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part5.htm b/docs/html-primer/Medley-Primer_files/part5.htm deleted file mode 100644 index 9d30bda1..00000000 --- a/docs/html-primer/Medley-Primer_files/part5.htm +++ /dev/null @@ -1,2 +0,0 @@ - -003-TOC

< Previous | Contents | Next >

TABLE of CONTENTS

Preface vii

1. Brief Glossary 1-1

2. Typing Shortcuts

Programmer’s Assistant 2-1

If You Make a Mistake 2-2

3. Using Menus

Making a Selection from a Menu 3-1

Explanations of Menu Items 3-2

Submenus 3-2

Summary 3-3

4. How to Use Files

Types of Files 4-1

Directories 4-1

Directory Options 4-2

Subdirectories 4-2

To See What Files Are Loaded 4-3

Simple Commands for Manipulating Files 4-3

Connecting to a Directory 4-3

File Version Numbers 4-4

5. FileBrowser

Calling the FileBrowser 5-1

FileBrowser Commands 5-3

6. Those Wondertul Windows!

Windows Provided by Medley 6-1

Creating a Window 6-2

Right Button Default Window Menu 6-2

Explanation of Each Menu Item 6-3

Scrollable Windows 6-4

Other Window Functions 6-5

PROMPTPRlNT 6-5

WHlCHW 6-6

7. Editing and Saving

Defining Functions 7-1

Simple Editing in the Executive Window 7-2

Using the List Structure Editor 7-3

Commenting Functions 7-4

File Functions and Variables: How to See and Save Them 7-5

File Variables 7-5

Saving Interlisp-D on Files 7-5

8. Your Init File

Using the USERGREETFILES Variable 8-1

Making an Init File 8-1

9. Medley Forgiveness: DWIM 9-1

10. Break Package

Break Windows 10-1

Break Package Examples 10-1

Ways to Stop Execution from the Keyboard (Breaking Lisp) 10-3

Break Menu 10-3

Returning to Top Level 10-4

11. WhatTo Do lf 11-1

12. Window and Regions

Windows 12-1

CREATEW 12-1

WlNDOWPROP 12-2

Getting Windows to Do Things 12-3

BUTTONEVENTFN 12-5

Looking at a Window’s Properties 12-5

Regions 12-5

13. What Are Menus?

Displaying Menus 13-1

Getting Menus to Do Stuff 13-2

WHENHELDFN and WHENSELECTEDFN Fields of a Menu 13-3

Looking at a Menu’s Fields 13-5

14. Bitmaps 14-1

15. Displaystreams

Drawing on a Displaystream 15-1

DRAWUNE 15-1

DRAWTO 15-2

DRAWCIRCLE 15-3

FILLCIRCLE 15-1

Locating and Changing Your Position in a Displaystream 15-4

DSPXP0SITION 15-5

DSPYPOSlTION 15-5

MOVETO 15-5

16. Fonts

What Makes Up a Font 16-1

Fontdescriptors and FONTCREATE 16-2

Display Fonts 16-3

InterPress Fonts 16-3

Functions for Using Fonts 16-4

FONTPROP - Looking at Font Properties 16-4

STRINGWlDTH 16-5

DSPFONT- Changing the Font in One Window 16-5

Personalizing Your Font Profile 16-6

17. The Inspector

Calling the Inspector 17-1

Using the Inspector 17-2

Inspector Example 17-2

18. Masterscope

SHOW DATA Command and GRAPHER 18-2

19. Where Does All the Time Go? SPY

How to Use Spy with the SPY Window 19-1

How to Use SPY from the Lisp Top Level 19-2

Interpreting SPY’s Results 19-2

20. Free Menus

Free Menu Example 20-1

Parts of a Free Menu Item 20-2

Types of Free Menu Items 20-3

21. The Grapher

Say it with Graphs 21-1

Add a Node 21-2

Add a Link 21-2

Delete a Link 21-2

Delete a Node 21-2

Move a Node 21-2

Making a Graph from a List 21-2

Incorporating Grapher into Your Program 21-2

More of Grapher 21-2

22. Resource Management

Naming Variables and Records 22-1

Some Space and Time Considerations 22-2

Global Variables 22-3

Circular Lists 22-3

When You Run Out of Space 22-4

23. Simple Interactions with the Cursor, a Bitmap, and a Window

GETMOUSESTATE Example Function 23-1

Advising GETMOUSESTATE 23-2

Changing the Cursor 23-2

Functions for Tracing the Cursor 23-3

Running the Functions 23-6

24. Glossary of Global System Variables

Directories 24-1

Flags 24-2

History Lists 24-3

System Menus 24-3

Windows 24-4

Miscellaneous 24-4

25. Other Useful References 25.1

Index.............................................................................................................................................. INDEX-1

[This page intentionally left blank]

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part6.htm b/docs/html-primer/Medley-Primer_files/part6.htm deleted file mode 100644 index 5127f03d..00000000 --- a/docs/html-primer/Medley-Primer_files/part6.htm +++ /dev/null @@ -1,2 +0,0 @@ - -03-USING-MENUS

< Previous | Contents | Next >

3. USING MENUS

The purpose of this chapter is to show you how to use menus. Many things can be done more easily using menus, and there are many different menus provided in the Medley

environment. Some are "pop-up" menus that are only available until a selection is made, then disappear until they are needed again. An example of one of these is the Background Menu that appears when the mouse is not in any window and the right

mouse button is pressed. A background menu is shown in Figure 3-1. Your background menu may have different items on it.

Figure 3-1. Background Menu

Another common pop-up menu is the right button default window menu. This menu is explained more in Chapter 6.

Other menus are more permanent, such as the menu that is always available for use with the Filebrowser. This menu is shown in Figure 3-2., and the specifics of its use with the filebrowser are explained in Chapter 5.

Figure 3-2. Filebrowser Menu

Making a Selection from a Menu

To make a selection from a menu, point with the mouse to the item you would like to select. If one of the mouse buttons is already pressed, the menu item should be

highlighted in reverse video. If it is a permanent menu, you must press the left mouse button to highlight the item. When you release the button,m the item will be selected. Figure 3-3 shows a menu with the item "Undo" chosen.

Figure 3-3. Menu with the Item "Undo" Chosen

Explanation of Menu Items

Many menu items have explanations associated with the. If you are not sure what the consequences of choosing a particular menu iem will be, highlight the menu item but do not releast the left mouse button. If the menu item has an explanation associated with it, the explanation will be printed in the prompt window. Figure 3-4 shows the

explanation associated with the item "Snap" from the background menu.

Figure 3-4. Explanation Associated with Selected Menu Item

Submenus

Some menu items have submenus associated with them. This means that, for these items, you can make even more precise choices if you would like to.

A submenu can also be foun d as described below.

As shown in Figure 3-5, a submenu can be indicated by a gray arrow to the right of the menu item. To see the submenu, highlight the menu item and move the mose to the

right to follow the arrow. Choosing an item from a submenu is done the same way you make a choice from the menu. Any submenus that might be associated with the items in the submenu are indicated in the same way as the submenus associated with the

items in the menu.

3. USING MENUS

Figure 3-5. Edit Submenu Displayed with Right Arrow

Summary

In summary, here are a few rules of thumb to remember about the interactions of the mouse and system menus:

• Press the left mouse button to select a menu item

• Press the middle mouse button to get more options on a submenu

• Press the right mouse button to see the default right button window menu, and the background menu

[This page intentionally left blank]

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part7.htm b/docs/html-primer/Medley-Primer_files/part7.htm deleted file mode 100644 index 261b3fae..00000000 --- a/docs/html-primer/Medley-Primer_files/part7.htm +++ /dev/null @@ -1,2 +0,0 @@ - -04-USING-FILES

< Previous | Contents | Next >

4. HOW TO USE FILES

Types of Files

A program file, or Lisp file, contains a series of expressions that can be read and

evaluated by the Lisp interpreter. These expressions can include function or macro

definitions, variables and their values, properties of variables, and so on. How to save Interlisp-D expressions on these files is explained in Chapter 7. Loading a file is

explained in the Simple Commands for Manipulating Files section below.

Not all files, however, have Lisp expressions stored on them. For example, TEdit files store text; sketches are stored on files made with the package Sketch , or can be

incorporated into TEdit files. These files are not loaded directly into the environment, but are accessed with the package used to create them, such as TEdit or Sketch.

When you name a file, there are conventions that you should follow. These conventions allow you to tell the type of file by the extension to its name.

If a file contains: Then:

Lisp expressions It should not have an extension or have the extension

.LISP. For example, a file called MYCODE should contain Lisp expressions.

Compiled Code It should have the extension .LCOM or .DFASL. For

example, a file called MYCODE.DFASL should contain compiled code.

A Sketch Its extension should be .SKETCH. For example, a file called MOUNTAINS.SKETCH should contain a Sketch.

Text It should have the extension .TEDIT. For example, a file called REPORT.TEDIT should contain text that can be edited with the editor TEDIT.

Directories

This section focu ses on how you can find files, and how you can easily manipulate files. To see all the files listed on a device, use the function DIR. For example, to see what files are stored in your current directory, type:

(DIR *.*)

Partial directory listings can be gotten by specifying a file name, rather than just a

device name. The wildcard character * can be used to match any number of unknown characters. For example, the command (DIR T*) will list the names of all files that begin with the letter T. An example using the wildcard is shown in Figure 4-1.

Figure 4-1. Using DIR with a Wildcard

Directory Options

Various words can appear as extra arguments to the DIR command. these words give you extra information about the files.

SIZE displays the size of each file in the directory. For example, type:

(DIR {DSK} SIZE)

DATE displays the creation date of each file in the directory. An example of this is shown in Figure 4-2.

Figure 4-2. Example Using DATE DEL deletes all the files foun d by the directory command.

Subdirectories

Sudirectories are very helpful for organizing files. A set of files that have a single

purpose (for example, all the external documentation files for a system) can be grouped together into a subdirectory.

To associate a subdirectory with a filename, simply include the desired subdirectory as part of the name of the file. Subdirectories are specified after the device name and

before the simple filename. The first subdirectory should be between less-than and

greater-than signs (angle brackets) < >, with nested subdirectory names only followed by a greater than sign >. For example:

{DSK}<Directory>SubDirectory>SubSubDirectory>...>filename

or use the UNIX convention:

{DSK}/Directory/Subdirectory/Subsubdirectory/filename

To See What Files Are Loaded

If you type FILELST<CR>, the names of all the files you loaded will be displayed. Type SYSFILES<CR> to see what files are loaded to create the sysout.

Simple Commands for Manipulating Files

When using these functions, always be sure to specify the full filename, including subfile directories if appropriate.

To have the conents of a file displayed in a window:

(SEE ’filename)

To copy a file (see Figure 4-3):

(COPYFILE ’oldfilename ’newfilename)

Figure 4-3. Example Use of COPYFILE

To delete a file (see Figure 4-4):

(DELFILE ’filename)

Figure 4-4. Example Use of DELFILE

To rename a file:

(RENAMEFILE ’oldfilename ’newfilename)

Files that contain Lisp expressions can be loaded into the environment. That means that the information on them is read, evaluated, and incorporated into the Medley

environment. To load a file, type:

(LOAD ’filename)

Connecting to a Directory

Often, each person or project has a subdirectory where files are stored. If this is your situation, you will want any files you create to be put into this directory automatically. This means you should "connect" to the directory.

CONN is the Medley command that connects you to a directory. For example, CONN in Figure 4-5 connects you to the subsubdirectory IM, in the subdirectory PRIMER , the directory LISPFILES, on the device DSK. This information—the device and the

directory names down to the subdirectory to which you want to be connected—is called the "path" to that subdirectory. CONN expects the path to a directory as an argument.

Figure 4-5. CONNecting to Subdirectory Primer Subsubdirectory IM

Once you are connected to a directory, the command DIR will assume you want to see the files in that directory, or any of its subdirectories.

Other commands that require a filename as an argument (e.g., SEE, above) will assume that the file is in the connecteds directory if there is no path specified with the filename. This will often save you typing.

File Version Numbers

When stored, each filename is fillowed by a semicolon and a number, as shown in this example:

MYFILE.TEDIT;1

The number is the version number of the file. This is the system’s way of protecting your files from being overwritten. Each time the file is written, a new file is created with a version number one greater than the last. This new file will have everything from your previous file, plus all of your changes.

In most cases, you can exclude the version number when referencing the file. When the version is not specified, and there is more than one version of the file on that particular directory, the system generally uses your most recent version. An exception is the

function DELFILE, which deletes the oldest version (the one with the lowest version number) if none is specified.

[This page intentionally left blank]

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part8.htm b/docs/html-primer/Medley-Primer_files/part8.htm deleted file mode 100644 index 1123a67b..00000000 --- a/docs/html-primer/Medley-Primer_files/part8.htm +++ /dev/null @@ -1,2 +0,0 @@ - -05-FILEBROWSER

< Previous | Contents | Next >

5. FILEBROWSER

The FileBrowser is a Lisp Library Package that works with files stored on disk and floppy devices, and can be used as a file directory editor. If it is not loaded into your sysout, you need to load it first by typing:

(LOAD ’FILEBROWSER.LCOM)

Calling the FileBrowser

Calling the FileBrowser with the directory calls up the files stored in that directory:

(FB ’<usr>local>lde>)

Another way to call a FileBrowser is to choose "FileBrowser" from the background

menu. You will be prompted for a description of the files to be included (see Figure 5-1). Type an asterisk (*), then press Return to see all the files in the connected directory.

Figure 5-1. Prompt for Files to Include in FileBrowser

These show a directory of the device in a window you can leave on the screen at all times. The parts of the FileBrowser window are shown below.

Prompt Window

Prompt Window

Prompt Window

Command Menu

Command Menu

Command Menu

File List

File List

File List

Figure 5-2. Parts of a FileBrowser Window Now you do not need to continually type the directory command.

To use the FileBrowser, choose a file by pointing to the file with the mouse and pressing the left or middle mouse button. A small dark arrow appears to the left of the file

name. Choose a command from the menu at the right. In Figure 5-3, the files

OCH1.TEDIT;1, OCH10.TEDIT;1, and OCH11.TEDIT;1 have been selected.

The left mouse button only allows you to choose one file at a time. Even if you choose other files, only the last file you selected with the left mouse button will remain

marked as chosen. When you use the middle mouse button to select a file, the file is added to those already chosen.

To unpick an already chosen file, hold the Control key down while pressing the middle mouse button.

Figure 5-3. Files Chosen

5. FILEBROWSER

The next section contains a summary of the FileBrowser commands.

FileBrowser Commands

Delete In the FileBrowser, this command marks a file, or files, for deletion (see Figure 5-4). These files are marked by a black line crossing through

them. You may select and mark any number of files for deletion. Delete does not actually remove these files from the device. The Expunge command actually wipes out the files previously marked for deletion.

Figure 5-4. Files Marked for Deletion

Undelete Undoes the delete command for one or more files. Undelete erases the black line through a file marked for deletion.

Copy This command copies the chosen file. The destination filename should

be typed at a prompt that appears in the window above the FileBrowser.

Wildcards do not work for this prompt. You must type the whole

unquoted filename. If more than one file is chosen to be copied, you will be prompted for a directory name. The files will be copied into the

directory you give, but with the same filenames as the ones they have in their original location.

Rename This command works much like the Copy command, but does not leave the original file. The chosen file will be renamed to the destination

filename. You will be prompted, in the prompt window, for the

destination filename. Give the complete unquoted filename. If more

than one file is chose to be renamed, you will be prompted for a directory name. The files will be moved into the directory you give.

Hardcopy If you do not have a hardcopy device, using this command causes an error. Otherwise, it gives a hardcopy of the file.

See Shows you a file in a window. To use this command, choose a single filename, then the See command. You are prompted for a window.

Each time the See command is chosen, a new window is opened to display the file.

Edit Calls the editor with the file as input. If the file is an executable one (i.e., Lisp code as opposed to a documentation file), only the FILECOMS list is edited. The FILECOMS list is the list of variables, lists, and

functions that are contained on that file. FileBrowser loads it and then allows you to edit the FILECOMS .

Load Choose a file with the left mouse button, or a group of files with the

middle mouse button. Once the filenames have been blackened, choose the Load command to load them all into Medley.

Compile This command calls the file compiler with the chosen filename(s) as arguments. The compiler compiles a file foun d on a storage device

({DSK}), not the functions defined in the Medley image. If any functions on a loaded file have been changed, run the function (MAKEFILE ’filename) to write the current version before compiling it. Files do not have to be loaded to use the Compile command.

Expunge This command completely deletes all the marked files from the

directory. This allows you to remove unwanted files from your storage device.

Recompute Choose this command when you know that the directory has been

changed and should be reread (e.g., after creating new versions of a file).

< Previous | Contents | Next >

diff --git a/docs/html-primer/Medley-Primer_files/part9.htm b/docs/html-primer/Medley-Primer_files/part9.htm deleted file mode 100644 index 52b32978..00000000 --- a/docs/html-primer/Medley-Primer_files/part9.htm +++ /dev/null @@ -1,2 +0,0 @@ - -06-WINDOWS

< Previous | Contents | Next >

6. THOSE WONDERFUL WINDOWS!

A window is a designated area on the screen. Every rectangular box on the screen is a window. While Medley supplies many of the windows (such as the Executive Window), you may also create your own. Among other things, you will type, draw pictures, and

save portions of your screen with windows.

Windows Provided by Medley

Two important windows are available as soon as you enter the Medley environment.

One is the Executive Window, the main window where you will run your functions. It is the window that the caret is in when you turn on your machine, and load Medley. It is

shown in Figure 6-1.

Figure 6-1. Medley Executive Window

The other window that is open when you enter Medley is the "Prompt Window". It is the long thin black window at the top of the screen. It displays system prompts, or prompts you have associated with your programs. (See Figure 6-2.)

Figure 6-2. Prompt Window

Other programs, such as the editors, also use windows. These windows appear when

the program starts to run, and close (no longer appear on the screen) when the program is done running.

Creating a Window

To create a new window, type: (CREATEW). The mouse cursor will change, and have a small square attached to it. (See Figure 6-3.)

Figure 6-3. Mouse Cursor Asking You to Sweep Out Window

There may be a prompt in the prompt window to create a window. Press and hold the left mouse button. Move the mouse around, and notice that it sweeps out a rectangle. When the rectangle is the size that you’d like your window to be, release the left mouse button. More specific information about the creation of windows, such as giving them

titles and specifying their size and position on the screen when they are created, is given in the WINDOWPROP section of Chapter 12.

Right Button Default Window Menu

Position the cursor inside the window you just created, and press and hold the right mouse button. A menu of commands should appear (do not release the right button!), like the one in Figure 6-4. To execute one of the commands on this menu, choose the item. Making a choice from a menu is explained in Chapter 3.

Figure 6-4 Right Button Default Window Menu

As an example, select "Move" from this menu. The mouse cursor will become a ghost window (ju st an outline of a window, the same size as the one you are moving), with a square attached to one corner, like the one shown in Figure 6-5.

Figure 6-5 Mouse Cursor for Moving a Window

Move the mouse around. The ghost window will follow. Click the left mouse button to place tho window in a new location.

Choose "Shape", and notice that you are prompted to sweep out another window. Your original window will have the shape of the window you sketch out.

Explanation of Each Menu Item

The meaning of each right button default window menu item is explained below:

Close Removes the window from the screen

Snap Copies a portion of the screen into a new window Paint Allows drawing in a window

Clear Clears the window by erasing everything within the window boundaries Bury Puts the window beneath all other windows that overlap it

Redisplay Redisplays the window contents

Hardcopy Sends the contents of the window to a printer or to a flle Move Allows the wi ndow to be moved to a new spot on the screen Shape Repositions and/or reshapes the window

Shrink Reduces the window to a small black rectangle called an icon, or, if appropriate, to the shape for that window type (see Figure 6-6).

Figure 6-6 Example Icon

Expand Changes an icon back to its original window. Position the mouse cursor on the icon, depress the right button, and select Expand. Or, just button the icon with the middle mouse button.

These right-button default window menu selections are available in most windows, including the Executive Window. When the right button has other functions in a

window (as in an editor window), the right button default window menu should be accessible by pressing the Right button in the black border at the top of the window.

Scrollable Windows

Some windows in Medley are "scrollable". This means that you can move the contents of the window up and down, or side to side, to see anything that doesn’t fit in the

window.

Point the mouse cursor to the left or bottom border of a window. If the window is scrollable, a "scroll bar" will appear. The mouse cursor will change to a double headed arrow. (See Figure 6-7.)

Figure 6-7. Scroll Bar of Scrollable Window

The scroll bar represents the full contents of the window. The example scroll bar is completely white because the window has nothing in it When a part of the scroll bar is shaded, the amount shaded represents the amount of the window’s contents currently

shown. If everything is showing, the scroll bar will be fully shaded. (See Figure 6-8.)

The position of the shading is also important. It represents the relationship of the

section currently diplayed to the the full contents of the window. For example, if the shaded section is at the bottom of the scroll bar, you are looking at the end of the file.

Figure 6-8 Top of File When Shading at Top of Scroll Bar

When the scroll bar is visible, you can control the section of the window’s contents displayed:

• To move the contents higher in the window (scroll the contents up in the window), press the leff button of the mouse, the mouse cursor changes to look like this:

Figure 6-9. Upward Scrolling Cursor

The contents of the window will scroll up, making the line thit the cursor is beside the topmost line in the window.

• To move the contonts lower in the window (scroll the contents "down" in the window), press the right button of the mouse, and the mouse cursor changes to look like this:

Flgure 6-10. Downward Scrolling Cursor

The contents of the window scroll down, moving the line that is the topmost line in the window to beside the curtor.

• To show a specific section of the window’s contents, remember that the scroll bar represents the full contents of the window. Move the mouse cursor to the relative

position of the section you want to see (e.g., to the top of the scroll bar if you want to see the top of the window’s contents). Press the middle button of the mouse. The mouse cursor will look like this:

Figure 6-11 Proportional Scrolling Cursor

When you release the middle mouse button, the window’s contents at that relative position will be displayed.

The position of the mouse in the scroll bar defines how much of the window will be scrolled. If it is near the top, then only a little will be scrolled. If it is near the bottom, most of the window will be scrolled.

Other Window Functions

PROMPTPRlNT

Prints an expression to the black prompt window.

For example, type

(PROMPTPRINT "THIS WILL BE PRINTED IN THE PROMPT WINDOW")

The message will appear in the prompt window. (See Figure 6-12.)

Figure 6-12 PROMPTPRINTing

WHlCHW

Returns as a value the name of the window that the mouse cursor IS in.

(WHICHW) can be used as an argument to any function expecting a window, or to

reclaim a window that has no name (that is not attached to some particular part of the program.).

< Previous | Contents | Next >

diff --git a/docs/internal/FONTCODECHANGES.tedit b/docs/internal/FONTCODECHANGES.tedit index 8502fdeb..8bcbf264 100644 Binary files a/docs/internal/FONTCODECHANGES.tedit and b/docs/internal/FONTCODECHANGES.tedit differ diff --git a/docs/medley-irm/001-TITLEPAGE.PDF b/docs/medley-irm/001-TITLEPAGE.PDF new file mode 100644 index 00000000..05c630d8 Binary files /dev/null and b/docs/medley-irm/001-TITLEPAGE.PDF differ diff --git a/docs/medley-irm/003-TOC.PDF b/docs/medley-irm/003-TOC.PDF new file mode 100644 index 00000000..163276fd Binary files /dev/null and b/docs/medley-irm/003-TOC.PDF differ diff --git a/docs/medley-irm/01-INTRO.PDF b/docs/medley-irm/01-INTRO.PDF new file mode 100644 index 00000000..b662bec6 Binary files /dev/null and b/docs/medley-irm/01-INTRO.PDF differ diff --git a/docs/medley-irm/02-LITATOM.PDF b/docs/medley-irm/02-LITATOM.PDF new file mode 100644 index 00000000..d1bad4c6 Binary files /dev/null and b/docs/medley-irm/02-LITATOM.PDF differ diff --git a/docs/medley-irm/03-LISTS.PDF b/docs/medley-irm/03-LISTS.PDF new file mode 100644 index 00000000..4f9f849b Binary files /dev/null and b/docs/medley-irm/03-LISTS.PDF differ diff --git a/docs/medley-irm/04-STRINGS.PDF b/docs/medley-irm/04-STRINGS.PDF new file mode 100644 index 00000000..89bbb6d4 Binary files /dev/null and b/docs/medley-irm/04-STRINGS.PDF differ diff --git a/docs/medley-irm/05-ARRAY.PDF b/docs/medley-irm/05-ARRAY.PDF new file mode 100644 index 00000000..9302a7ec Binary files /dev/null and b/docs/medley-irm/05-ARRAY.PDF differ diff --git a/docs/medley-irm/06-HASHARRAYS.PDF b/docs/medley-irm/06-HASHARRAYS.PDF new file mode 100644 index 00000000..47b04a62 Binary files /dev/null and b/docs/medley-irm/06-HASHARRAYS.PDF differ diff --git a/docs/medley-irm/07-NUMBERS.IMAGEFILE b/docs/medley-irm/07-NUMBERS.IMAGEFILE new file mode 100644 index 00000000..221e3e89 --- /dev/null +++ b/docs/medley-irm/07-NUMBERS.IMAGEFILE @@ -0,0 +1,4631 @@ +%!PS-Adobe-2.0 %%Title: {DSK}frank>il>medley>docs>medley-irm>07-NUMBERS.IMAGEFILE;1 %%Creator: PostScript Driver Copyright (C) 1988-1992 Venue and others %%CreationDate: 9-May-2025 16:10:50 %%EndComments /bdef {bind def} bind def +/ldef {load def} bdef +/S /show ldef +/M /moveto ldef +/DR {transform round exch round exch itransform} bdef +/L {gsave newpath setlinewidth 0 setlinecap + M lineto currentpoint stroke grestore M} bdef +/L1 {gsave newpath 0 setdash setgray setlinewidth 0 setlinecap + M lineto currentpoint stroke grestore M} bdef +/F {findfont exch scalefont setfont} bdef +/CLP {newpath M dup 0 rlineto exch 0 exch rlineto + neg 0 rlineto closepath clip newpath} bdef +/R {gsave setgray newpath M dup 0 rlineto exch 0 exch + rlineto neg 0 rlineto closepath eofill grestore} bdef +/ellipsedict 9 dict def +ellipsedict /mtrx matrix put +/ellipse + { ellipsedict begin + /endangle exch def + /startangle exch def + /orientation exch def + /minorrad exch def + /majorrad exch def + /y exch def + /x exch def + /savematrix mtrx currentmatrix def + x y translate + orientation rotate + majorrad minorrad scale + 0 0 1 startangle endangle arc + savematrix setmatrix + end } bdef +/concatprocs + {/proc2 exch cvlit def + /proc1 exch cvlit def + /newproc proc1 length proc2 length add array def + newproc 0 proc1 putinterval + newproc proc1 length proc2 putinterval + newproc cvx + } bdef +/resmatrix matrix def +/findresolution + {72 0 resmatrix defaultmatrix dtransform + /yres exch def /xres exch def + xres dup mul yres dup mul add sqrt + } bdef +/thebitimage + {/maskp exch def + /bihgt exch def + /biwid exch def + /byte 1 string def + /strbufl biwid 8 div ceiling cvi def + /strbuf strbufl string def + maskp not{{1 exch sub} currenttransfer concatprocs settransfer} if + biwid bihgt + maskp { true } { 1 } ifelse + [biwid 0 0 bihgt 0 0] + {/col 0 def + {currentfile byte readhexstring pop 0 get + dup 16#B2 eq {pop + currentfile byte readhexstring pop 0 get 1 add + currentfile byte readhexstring pop pop /nbyte byte 0 get def + { strbuf col nbyte put /col col 1 add def} repeat} + {dup 16#B3 eq {pop /col col + currentfile byte readhexstring pop + 0 get add 1 add def} + {16#B4 eq {currentfile byte readhexstring pop pop} if + strbuf col byte 0 get put /col col 1 add def} ifelse + } ifelse + col strbufl ge { exit } if } loop + strbuf } + maskp { imagemask } { image } ifelse + } bdef +/setuserscreendict 22 dict def +setuserscreendict begin + /tempctm matrix def + /temprot matrix def + /tempscale matrix def +end +/setuserscreen + {setuserscreendict begin + /spotfunction exch def + /screenangle exch def + /cellsize exch def + /m tempctm currentmatrix def + /rm screenangle temprot rotate def + /sm cellsize dup tempscale scale def + sm rm m m concatmatrix m concatmatrix pop + 1 0 m dtransform /y1 exch def /x1 exch def + /veclength x1 dup mul y1 dup mul add sqrt def + /frequency findresolution veclength div def + /newscreenangle y1 x1 atan def + m 2 get m 1 get mul m 0 get m 3 get mul sub + 0 gt { { neg } /spotfunction load concatprocs + /spotfunction exch def } if + frequency newscreenangle /spotfunction load setscreen + end + } bdef +/setpatterndict 18 dict def +setpatterndict begin + /bitison + {/ybit exch def /xbit exch def + /bytevalue bstring ybit bwidth mul xbit 8 idiv add get def + /mask 1 7 xbit 8 mod sub bitshift def + bytevalue mask and 0 ne + } bdef +end +/bitpatternspotfunction + {setpatterndict begin + /y exch def /x exch def + /xindex x 1 add 2 div bpside mul 1 sub cvi def + /yindex y 1 add 2 div bpside mul 1 sub cvi def + xindex yindex bitison + {/onbits onbits 1 add def 1} + {/offbits offbits 1 add def 0} ifelse + end + } bdef +/setpattern + {setpatterndict begin + /cellsz exch def + /angle exch def + /bwidth exch def + /bpside exch def + /bstring exch def + /onbits 0 def /offbits 0 def + cellsz angle /bitpatternspotfunction load setuserscreen + {} settransfer + offbits offbits onbits add div setgray + end + } bdef +% - - - - - Fraction-setting code, to support NS fonts better - - - - - +/fractiondict 20 dict def +/fractionshow +{ fractiondict begin +/denom exch def +/num exch def +/regfont currentfont def +/fractfont currentfont [.65 0 0 .6 0 0] makefont def +gsave newpath 0 0 moveto +(1) true charpath flattenpath pathbbox +/height exch def pop pop pop + grestore +0 .4 height mul rmoveto +fractfont setfont num show +0 .4 height mul neg rmoveto regfont setfont (\244) show +fractfont setfont denom show regfont setfont end } bdef +/f14 { (1) (4) fractionshow } bdef +/f12 { (1) (2) fractionshow } bdef +/f34 { (3) (4) fractionshow } bdef +/f18 { (1) (8) fractionshow } bdef +/f38 { (3) (8) fractionshow } bdef +/f58 { (5) (8) fractionshow } bdef +/f78 { (7) (8) fractionshow } bdef +/f13 { (1) (3) fractionshow } bdef +/f23 { (2) (3) fractionshow } bdef +/bboxdict 20 dict def +/bboxchk { bboxdict begin +/regfont currentfont def +/chkfont currentfont [1.25 0 0 1.25 0 0] makefont def +gsave newpath 0 0 moveto +(\161) true charpath flattenpath pathbbox +/height exch def pop pop pop + grestore + currentpoint + .2 height mul .3 height mul rmoveto +chkfont setfont (\063) show + moveto + regfont setfont +(\161) show end } bdef +/rencdict 15 dict def +/encodefont { rencdict begin +/newname exch def +/oldfont exch def +/newcodes [ +8#001 /Aacute +8#002 /Acircumflex +8#003 /Adieresis +8#004 /Agrave +8#005 /Aring +8#006 /Atilde +8#007 /Ccedilla +8#010 /Eacute +8#011 /Ecircumflex +8#012 /Edieresis +8#013 /Egrave +8#014 /Iacute +8#015 /Icircumflex +8#016 /Idieresis +8#017 /Igrave +8#020 /Ntilde +8#021 /Oacute +8#022 /Ocircumflex +8#023 /Odieresis +8#024 /Ograve +8#025 /Otilde +8#026 /Scaron +8#027 /Uacute +8#030 /Ucircumflex +8#031 /Udieresis +8#032 /Ugrave +8#033 /Ydieresis +8#034 /Zcaron +8#177 /periodinferior +8#201 /aacute +8#202 /acircumflex +8#203 /adieresis +8#204 /agrave +8#205 /aring +8#206 /atilde +8#207 /ccedilla +8#210 /eacute +8#211 /ecircumflex +8#212 /edieresis +8#213 /egrave +8#214 /iacute +8#215 /icircumflex +8#216 /idieresis +8#217 /igrave +8#220 /ntilde +8#221 /oacute +8#222 /ocircumflex +8#223 /odieresis +8#224 /ograve +8#225 /otilde +8#226 /scaron +8#227 /uacute +8#230 /ucircumflex +8#231 /udieresis +8#232 /ugrave +8#233 /ydieresis +8#234 /zcaron +8#235 /Eth +8#236 /eth +8#237 /Thorn +8#240 /thorn + ] def +/olddict oldfont findfont def /newfont olddict maxlength dict def +olddict { exch dup /FID ne { dup /Encoding eq +{ exch dup length array copy newfont 3 1 roll put } +{ exch newfont 3 1 roll put } ifelse } + { pop pop } ifelse } forall +newfont /FontName newname put +newcodes aload pop +newcodes length 2 idiv { newfont /Encoding get 3 1 roll put } repeat +newname newfont definefont pop end } def + /accentdict 10 dict def + /accentor { accentdict begin /scaler exch def /delta exch def +/unders exch def /accents exch def /mainch exch def /scrt (X) def + /w1 mainch stringwidth pop def + currentpoint mainch show currentpoint 4 2 roll +accents { /ch exch def 2 copy moveto + scrt 0 ch put + /w2 scrt stringwidth pop def + w1 w2 sub 2 div delta rmoveto scrt show + /delta delta 150 scaler mul 9 div add def + } forall +unders { /ch exch def 2 copy moveto + scrt 0 ch put + /w2 scrt stringwidth pop def + ch 46 eq { w1 w2 sub 2 div -175 scaler mul 9 div rmoveto scrt show 0 175 rmoveto } + { w1 w2 sub 2 div 0 rmoveto scrt show } ifelse + } forall + pop pop moveto end } def +%%EndProlog +%%BeginSetup +letter /imagesizefactor 1 def %%EndSetup /Courier /Courier-Acnt encodefont +800 /Courier-Acnt F + +%%Page: 1 1 +%%BeginPageSetup +/savepage save def +0.01 imagesizefactor mul dup scale +%%EndPageSetup +gsave + 0 rotate + 79200 61200 0 0 CLP +/Times-Roman /Times-Roman-Acnt encodefont +900 /Times-Roman-Acnt F +49800 2400 M (7-1) S +/Helvetica-Bold /Helvetica-Bold-Acnt encodefont +1000 /Helvetica-Bold-Acnt F +29553 56820 M (7. NUMBERS AND ARITHMETIC FUNCTIONS) S +51001 56449 5401 56449 300 L +/Helvetica /Helvetica-Acnt encodefont +1000 /Helvetica-Acnt F +51000 55520 M ( ) S +/Palatino-Roman /Palatino-Roman-Acnt encodefont +900 /Palatino-Roman-Acnt F +7800 53154 M (There are four different types of numbers) 301 0 32 4 -1 roll widthshow +26091 53154 M ( in Interlisp: small integers) 301 0 32 4 -1 roll widthshow +37890 53154 M (, large integers) 301 0 32 4 -1 roll widthshow +44345 53154 M (, bignums) 301 0 32 4 -1 roll widthshow +7800 52054 M (\(arbitrary-size integers\)) 55 0 32 4 -1 roll widthshow +17205 52054 M (, and floating-point numbers) 55 0 32 4 -1 roll widthshow +28816 52054 M (. Small integers are in the range -65536 to 65535.) 55 0 32 4 -1 roll widthshow +7800 50954 M (Large integers and floating-point numbers are 32-bit quantities that are stored by \252boxing\272 the) 250 0 32 4 -1 roll widthshow +7800 49854 M (number \(see below\). Bignums are \252boxed\272 as a series of words.) S +7800 48054 M (Large integers and floating-point numbers can be any full word quantity. To distinguish among the) 66 0 32 4 -1 roll widthshow +7800 46954 M (various kinds of numbers, and other Interlisp pointers, these numbers are \252boxed\272 When a large) 147 0 32 4 -1 roll widthshow +7800 45854 M (integer or floating-point number is created \(by an arithmetic operation or by ) 98 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(READ) 235 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(\), Interlisp gets a) 98 0 32 4 -1 roll widthshow +7800 44694 M (new word from \252number storage\272 and puts the number into that word. Interlisp then passes around) 42 0 32 4 -1 roll widthshow +7800 43594 M (the pointer to that word, i.e., the \252boxed number) 152 0 32 4 -1 roll widthshow +28326 43594 M (\272, rather than the actual quantity itself. When a) 152 0 32 4 -1 roll widthshow +7800 42494 M (numeric function needs the actual numeric quantity, it performs the extra level of addressing to obtain) 6 0 32 4 -1 roll widthshow +7800 41394 M (the \252value\272 of the number. This latter process is called \252unboxing\272. Unboxing does not use any) 150 0 32 4 -1 roll widthshow +7800 40294 M (storage, but each boxing operation uses one new word of number storage. If a computation creates) 67 0 32 4 -1 roll widthshow +7800 39194 M (many large integers or floating-point numbers, i.e., does lots of boxes, it may cause a garbage) 254 0 32 4 -1 roll widthshow +7800 38094 M (collection of large integer space, or of floating-point number space.) S +7800 36294 M (The following functions can be used to distinguish the different types of numbers:) S +900 /Courier-Acnt F +10200 34366 M (\() S +/Courier-Bold /Courier-Bold-Acnt encodefont +900 /Courier-Bold-Acnt F +(SMALLP) S +/NewCenturySchlbk-Roman /NewCenturySchlbk-Roman-Acnt encodefont +1000 /NewCenturySchlbk-Roman-Acnt F +13980 34366 M ( ) S +/Courier-Oblique /Courier-Oblique-Acnt encodefont +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 34366 M ([Function]) S +12600 32706 M (Returns ) 50 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 120 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, if ) 50 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 120 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is a small integer; ) 50 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(NIL) 120 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( otherwise. Does not generate an error if ) 50 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 120 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is not a) 50 0 32 4 -1 roll widthshow +12600 31546 M (number.) S +900 /Courier-Acnt F +10200 29618 M (\() S +900 /Courier-Bold-Acnt F +(FIXP) S +1000 /NewCenturySchlbk-Roman-Acnt F +12900 29618 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +44463 29618 M ([Function]) S +12600 27958 M (Returns ) 125 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 299 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, if ) 125 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 299 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is an integer; ) 125 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(NIL) 299 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( otherwise. Note that ) 125 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(FIXP) 299 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is true for small integers,) 125 0 32 4 -1 roll widthshow +12600 26798 M (large integers, and bignums. Does not generate an error if ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( is not a number.) S +900 /Courier-Acnt F +10200 24810 M (\() S +900 /Courier-Bold-Acnt F +(FLOATP) S +1000 /NewCenturySchlbk-Roman-Acnt F +13980 24810 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 24810 M ([Function]) S +12600 23150 M (Returns ) 79 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 190 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( if ) 79 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 190 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is a floating-point number; ) 79 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(NIL) 190 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( otherwise. Does not give an error if ) 79 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 190 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is) 79 0 32 4 -1 roll widthshow +12600 21990 M (not a number.) S +900 /Courier-Acnt F +10200 20062 M (\() S +900 /Courier-Bold-Acnt F +(NUMBERP) S +1000 /NewCenturySchlbk-Roman-Acnt F +14520 20062 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 20062 M ([Function]) S +12600 18402 M (Returns ) 28 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 66 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, if ) 28 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 66 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is a number of any type; ) 28 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(NIL) 66 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( otherwise. Does not generate an error if ) 28 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 66 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is) 28 0 32 4 -1 roll widthshow +12600 17242 M (not a number.) S +/Palatino-Bold /Palatino-Bold-Acnt encodefont +900 /Palatino-Bold-Acnt F +12600 15442 M (Note) 10 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(: In previous releases, ) 10 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(NUMBERP) 24 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( was true only if \() 10 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(FLOATP ) 24 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 24 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(\) or \() 10 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(FIXP ) 24 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 24 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(\) were true.) 10 0 32 4 -1 roll widthshow +12600 14282 M (With the additon of Common Lisp ratios and complex numbers, ) 46 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(NUMBERP) 111 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( now returns ) 46 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(T) 111 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +12600 13122 M (for ) S +/Palatino-Italic /Palatino-Italic-Acnt encodefont +900 /Palatino-Italic-Acnt F +(all) S +900 /Palatino-Roman-Acnt F +( number types . Code relying on the "old" behavior should be modified.) S +7800 11322 M (Each small integer has a unique representation, so ) 61 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(EQ) 146 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( may be used to check equality. ) 61 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(EQ) 146 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( should not) 61 0 32 4 -1 roll widthshow +7800 10162 M (be used for large integers, bignums, or floating-point numbers, ) 106 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(EQP) 255 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, ) 106 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(IEQP) 255 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, or ) 106 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(EQUAL) 255 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( must be used) 106 0 32 4 -1 roll widthshow +7800 9002 M (instead.) S +900 /Courier-Acnt F +10200 7074 M (\() S +900 /Courier-Bold-Acnt F +(EQP) S +1000 /NewCenturySchlbk-Roman-Acnt F +12360 7074 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +/NewCenturySchlbk-Italic /NewCenturySchlbk-Italic-Acnt encodefont +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 7074 M ([Function]) S +12600 5414 M (Returns ) 71 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(T) 171 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, if ) 71 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 171 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and ) 71 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(Y) 171 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( are equal numbers; ) 71 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(NIL) 171 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( otherwise. ) 71 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(EQ) 171 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( may be used if ) 71 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 171 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and ) 71 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(Y) 171 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( are) 71 0 32 4 -1 roll widthshow +12600 4254 M (known to be small integers. ) 71 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(EQP) 169 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( does not convert ) 71 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 169 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and ) 71 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(Y) 169 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( to integers, e.g., ) 71 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\(EQP 2000) 169 0 32 4 -1 roll widthshow +grestore savepage restore showpage + +%%Page: 2 2 +%%BeginPageSetup +/savepage save def +0.01 imagesizefactor mul dup scale +%%EndPageSetup +gsave + 0 rotate + 79200 61200 0 0 CLP +/Times-Roman /Times-Roman-Acnt encodefont +900 /Times-Roman-Acnt F +10200 2400 M (7-2) S +/Helvetica /Helvetica-Acnt encodefont +1000 /Helvetica-Acnt F +9600 61200 M (INTERLISP-D REFERENCE MANUAL) S +/Courier /Courier-Acnt encodefont +900 /Courier-Acnt F +17400 56954 M (2000.3\) => NIL) 45 0 32 4 -1 roll widthshow +/Palatino-Roman /Palatino-Roman-Acnt encodefont +900 /Palatino-Roman-Acnt F +(, but it can be used to compare an integer and a floating-point number,) 19 0 32 4 -1 roll widthshow +17400 55794 M (e.g., ) 125 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\(EQP 2000 2000.0\) => T) 299 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. ) 125 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(EQP) 299 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( does not generate an error if ) 125 0 32 4 -1 roll widthshow +/Courier-Oblique /Courier-Oblique-Acnt encodefont +900 /Courier-Oblique-Acnt F +(X) 299 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( or ) 125 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(Y) 299 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( are not) 125 0 32 4 -1 roll widthshow +17400 54634 M (numbers.) S +900 /Courier-Acnt F +17400 52834 M (EQP) 476 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( can also be used to compare stack pointers \(see Chapter 11\) and compiled code) 198 0 32 4 -1 roll widthshow +17400 51674 M (objects \(see Chapter 10\).) S +12600 49874 M (The action taken on division by zero and floating-point overflow is determined with the following) 125 0 32 4 -1 roll widthshow +12600 48774 M (function:) S +900 /Courier-Acnt F +15000 46846 M (\() S +/Courier-Bold /Courier-Bold-Acnt encodefont +900 /Courier-Bold-Acnt F +(OVERFLOW) S +/NewCenturySchlbk-Roman /NewCenturySchlbk-Roman-Acnt encodefont +1000 /NewCenturySchlbk-Roman-Acnt F +19860 46846 M ( ) S +900 /Courier-Oblique-Acnt F +(FLG) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 46846 M ([Function]) S +17400 45186 M (Sets a flag that determines the system response to arithmetic overflow \(for floating-point) 66 0 32 4 -1 roll widthshow +17400 44086 M (arithmetic\) and division by zero; returns the previous setting.) S +17400 42286 M (For integer arithmetic: If ) 56 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(FLG) 134 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +( = T) 134 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, an error occurs on division by zero. If ) 56 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(FLG ) 134 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(= NIL) 134 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +17400 41126 M (or ) 59 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(0) 141 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, integer division by zero returns zero. Integer overflow cannot occur, because small) 59 0 32 4 -1 roll widthshow +17400 39966 M (integers are converted to bignums \(see the beginning of this chapter\).) S +17400 38166 M (For floating-point arithmetic: If ) 10 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(FLG) 25 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +( = T) 25 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, an error occurs on floating overflow or floating) 10 0 32 4 -1 roll widthshow +17400 37006 M (division by zero. If ) 89 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(FLG) 214 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +( = NIL) 214 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( or ) 89 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(0) 214 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, the largest \(or smallest\) floating-point number is) 89 0 32 4 -1 roll widthshow +17400 35846 M (returned as the result of the overflowed computation or floating division by zero.) S +17400 34046 M (The default value for ) 7 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(OVERFLOW) 16 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is ) 7 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(T) 16 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, meaning an error is generated on division by zero or) 7 0 32 4 -1 roll widthshow +17400 32886 M (floating overflow.) S +/Helvetica-Bold /Helvetica-Bold-Acnt encodefont +1000 /Helvetica-Bold-Acnt F +10200 30652 M (Generic Arithmetic) S +55801 30381 10201 30381 100 L +900 /Palatino-Roman-Acnt F +12600 28986 M (The functions in this section are \252generic\272 arithmetic functions. If any of the arguments are floating-) 55 0 32 4 -1 roll widthshow +12600 27886 M (point numbers \(see the Floating-Point Arithmetic section below\), they act exactly like floating-point) 106 0 32 4 -1 roll widthshow +12600 26786 M (functions, floating all arguments and returning a floating-point number as their value. Otherwise,) 132 0 32 4 -1 roll widthshow +12600 25686 M (they act like the integer functions \(see the Integer Arithmetic section below\). If given a non-numeric) 61 0 32 4 -1 roll widthshow +12600 24586 M (argument, they generate an error, ) 63 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(Non-numeric arg) 151 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. The results of division by zero and floating-) 63 0 32 4 -1 roll widthshow +12600 23426 M (point overflow is determined by the function ) S +900 /Courier-Acnt F +(OVERFLOW) S +900 /Palatino-Roman-Acnt F +( \(see the section above\).) S +900 /Courier-Acnt F +15000 21566 M (\() S +900 /Courier-Bold-Acnt F +(PLUS) S +900 /Courier-Acnt F +17700 21566 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +18780 21366 M (1) S +900 /Courier-Oblique-Acnt F +19140 21566 M ( X) S +600 /Courier-Oblique-Acnt F +20220 21366 M (2) S +900 /Courier-Oblique-Acnt F +20580 21566 M ( ... X) S +600 /Courier-Oblique-Acnt F +23820 21366 M (N) S +900 /Courier-Acnt F +24180 21566 M (\)) S +900 /Palatino-Roman-Acnt F +( ) S +44999 21566 M ([NoSpread Function]) S +900 /Courier-Oblique-Acnt F +17400 19683 M (X) S +600 /Courier-Oblique-Acnt F +17940 19483 M (1) S +1000 /NewCenturySchlbk-Roman-Acnt F +18300 19683 M ( ) S +900 /Courier-Acnt F +(+) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +19936 19483 M (2) S +1000 /NewCenturySchlbk-Roman-Acnt F +20296 19683 M ( ) S +900 /Courier-Acnt F +(+ ... +) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +25172 19483 M (N) S +1000 /NewCenturySchlbk-Roman-Acnt F +25532 19683 M (.) S +900 /Courier-Acnt F +15000 17728 M (\() S +900 /Courier-Bold-Acnt F +(MINUS) S +900 /Courier-Acnt F +18240 17728 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 17728 M ([Function]) S +900 /Courier-Acnt F +17400 15940 M (-) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +15000 14080 M (\() S +900 /Courier-Bold-Acnt F +(DIFFERENCE) S +900 /Courier-Acnt F +20940 14080 M ( ) S +900 /Courier-Oblique-Acnt F +(X Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 14080 M ([Function]) S +900 /Courier-Oblique-Acnt F +17400 12292 M (X) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +( - Y) S +900 /Courier-Acnt F +15000 10432 M (\() S +900 /Courier-Bold-Acnt F +15540 10432 M (TIMES) S +900 /Courier-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +19320 10232 M (1) S +900 /Courier-Oblique-Acnt F +19680 10432 M ( X) S +600 /Courier-Oblique-Acnt F +20760 10232 M (2) S +900 /Courier-Oblique-Acnt F +21120 10432 M ( ) S +900 /Courier-Acnt F +(...) S +900 /Courier-Oblique-Acnt F +( X) S +600 /Courier-Oblique-Acnt F +24360 10232 M (N) S +900 /Courier-Acnt F +24720 10432 M (\)) S +900 /Palatino-Roman-Acnt F +( ) S +44999 10432 M ([NoSpread Function]) S +900 /Courier-Oblique-Acnt F +17400 8549 M (X) S +600 /Courier-Oblique-Acnt F +17940 8349 M (1) S +1000 /NewCenturySchlbk-Roman-Acnt F +18300 8549 M ( ) S +900 /Courier-Acnt F +(*) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +19936 8349 M (2) S +1000 /NewCenturySchlbk-Roman-Acnt F +20296 8549 M ( ) S +900 /Courier-Acnt F +(* ... *) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +25172 8349 M (N) S +grestore savepage restore showpage + +%%Page: 3 3 +%%BeginPageSetup +/savepage save def +0.01 imagesizefactor mul dup scale +%%EndPageSetup +gsave + 0 rotate + 79200 61200 0 0 CLP +/Times-Roman /Times-Roman-Acnt encodefont +900 /Times-Roman-Acnt F +49800 2400 M (7-3) S +/Helvetica /Helvetica-Acnt encodefont +1000 /Helvetica-Acnt F +30508 61200 M (NUMBERS AND ARITHMETIC FUNCTIONS) S +/Courier /Courier-Acnt encodefont +900 /Courier-Acnt F +10200 56954 M (\() S +/Courier-Bold /Courier-Bold-Acnt encodefont +900 /Courier-Bold-Acnt F +(QUOTIENT) S +900 /Courier-Acnt F +15060 56954 M ( ) S +/Courier-Oblique /Courier-Oblique-Acnt encodefont +900 /Courier-Oblique-Acnt F +(X Y) S +900 /Courier-Acnt F +(\)) S +/Palatino-Roman /Palatino-Roman-Acnt encodefont +900 /Palatino-Roman-Acnt F +( ) S +44463 56954 M ([Function]) S +12600 55294 M (If ) 58 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 139 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and ) 58 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(Y) 139 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( are both integers, returns the integer division of ) 58 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 139 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and ) 58 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(Y) 139 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. Otherwise, converts) 58 0 32 4 -1 roll widthshow +12600 54134 M (both ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( and ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +( to floating-point numbers, and does a floating-point division.) S +900 /Courier-Acnt F +10200 52146 M (\() S +900 /Courier-Bold-Acnt F +(REMAINDER) S +/NewCenturySchlbk-Roman /NewCenturySchlbk-Roman-Acnt encodefont +1000 /NewCenturySchlbk-Roman-Acnt F +15600 52146 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +/NewCenturySchlbk-Italic /NewCenturySchlbk-Italic-Acnt encodefont +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 52146 M ([Function]) S +12600 50358 M (If ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( and ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +( are both integers, returns ) S +900 /Courier-Acnt F +(\(IREMAINDER ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +(, otherwise ) S +900 /Courier-Acnt F +(\(FREMAINDER) S +/NewCenturySchlbk-Bold /NewCenturySchlbk-Bold-Acnt encodefont +1000 /NewCenturySchlbk-Bold-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Bold-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +1000 /NewCenturySchlbk-Roman-Acnt F +(.) S +900 /Courier-Acnt F +10200 48364 M (\() S +900 /Courier-Bold-Acnt F +(GREATERP) S +/Helvetica-Bold /Helvetica-Bold-Acnt encodefont +1000 /Helvetica-Bold-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +15338 48364 M (X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 48364 M ([Function]) S +900 /Courier-Acnt F +12600 46704 M (T) S +900 /Palatino-Roman-Acnt F +(, if ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Acnt F +(>) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +(, ) S +900 /Courier-Acnt F +(NIL) S +900 /Palatino-Roman-Acnt F +( otherwise.) S +900 /Courier-Acnt F +10200 44716 M (\() S +900 /Courier-Bold-Acnt F +(LESSP) S +1000 /NewCenturySchlbk-Roman-Acnt F +13440 44716 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 44716 M ([Function]) S +900 /Courier-Acnt F +12600 43056 M (T) S +900 /Palatino-Roman-Acnt F +( if ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Acnt F +(<) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +(, ) S +900 /Courier-Acnt F +(NIL) S +900 /Palatino-Roman-Acnt F +( otherwise.) S +900 /Courier-Acnt F +10200 41062 M (\() S +900 /Courier-Bold-Acnt F +(GEQ) S +1000 /Helvetica-Bold-Acnt F +12360 41062 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 41062 M ([Function]) S +900 /Courier-Acnt F +12600 39402 M (T) S +900 /Palatino-Roman-Acnt F +(, if ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Acnt F +(>=) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +(, ) S +900 /Courier-Acnt F +(NIL) S +900 /Palatino-Roman-Acnt F +( otherwise.) S +900 /Courier-Acnt F +10200 37414 M (\() S +900 /Courier-Bold-Acnt F +(LEQ) S +1000 /NewCenturySchlbk-Roman-Acnt F +12360 37414 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 37414 M ([Function]) S +900 /Courier-Acnt F +12600 35754 M (T) S +900 /Palatino-Roman-Acnt F +(, if ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Acnt F +(<=) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +(, ) S +900 /Courier-Acnt F +(NIL) S +900 /Palatino-Roman-Acnt F +( otherwise.) S +900 /Courier-Acnt F +10200 33766 M (\() S +900 /Courier-Bold-Acnt F +(ZEROP) S +1000 /NewCenturySchlbk-Roman-Acnt F +13440 33766 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 33766 M ([Function]) S +12600 31978 M (The same as ) S +900 /Courier-Acnt F +(\(EQP) S +1000 /NewCenturySchlbk-Bold-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Bold-Acnt F +( ) S +900 /Courier-Acnt F +(0\)) S +1000 /NewCenturySchlbk-Roman-Acnt F +(.) S +900 /Courier-Acnt F +10200 29990 M (\() S +900 /Courier-Bold-Acnt F +(MINUSP) S +1000 /NewCenturySchlbk-Roman-Acnt F +13980 29990 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 29990 M ([Function]) S +900 /Courier-Acnt F +12600 28202 M (T) S +900 /Palatino-Roman-Acnt F +(, if ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( is negative; ) S +900 /Courier-Acnt F +(NIL) S +900 /Palatino-Roman-Acnt F +( otherwise. Works for both integers and floating-point numbers) S +1000 /NewCenturySchlbk-Roman-Acnt F +(.) S +900 /Courier-Acnt F +10200 26214 M (\() S +900 /Courier-Bold-Acnt F +(MIN) S +1000 /NewCenturySchlbk-Roman-Acnt F +12360 26214 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +13178 26014 M (1) S +1000 /NewCenturySchlbk-Italic-Acnt F +13538 26214 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +14356 26014 M (2) S +1000 /NewCenturySchlbk-Italic-Acnt F +14716 26214 M ( ) S +900 /Courier-Acnt F +(...) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +17432 26014 M (N) S +900 /Courier-Acnt F +17792 26214 M (\)) S +900 /Palatino-Roman-Acnt F +( ) S +40199 26214 M ([NoSpread Function]) S +12600 24459 M (Returns the minimum of ) 43 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 103 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +23357 24259 M (1) 69 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +23717 24459 M (, ) 43 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 103 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +24750 24259 M (2) 69 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +25110 24459 M (, ) 43 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(...,) 103 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( ) 43 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 103 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +28571 24259 M (N) 69 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +28931 24459 M (. ) 43 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\(MIN\)) 103 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( returns the value of ) 43 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(MAX.INTEGER) 103 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( \(see) 43 0 32 4 -1 roll widthshow +12600 23204 M (the Integer Arithmetic section below\).) S +900 /Courier-Acnt F +10200 21276 M (\() S +900 /Courier-Bold-Acnt F +(MAX) S +1000 /NewCenturySchlbk-Roman-Acnt F +12360 21276 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +13178 21076 M (1) S +1000 /NewCenturySchlbk-Italic-Acnt F +13538 21276 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +14356 21076 M (2) S +1000 /NewCenturySchlbk-Italic-Acnt F +14716 21276 M ( ) S +900 /Courier-Acnt F +(...) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +17432 21076 M (N) S +900 /Courier-Acnt F +17792 21276 M (\)) S +900 /Palatino-Roman-Acnt F +( ) S +40199 21276 M ([NoSpread Function]) S +12600 19521 M (Returns the maximum of ) 19 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 45 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +23389 19321 M (1) 30 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +23749 19521 M (, ) 19 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 45 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +24758 19321 M (2) 30 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +25118 19521 M (, ..., ) 19 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 45 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +27271 19321 M (N) 30 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +27631 19521 M (. ) 19 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\(MAX\)) 45 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( returns the value of ) 19 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(MIN.INTEGER) 45 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( \(see the) 19 0 32 4 -1 roll widthshow +12600 18266 M (Integer Arithmetic section below\).) S +900 /Courier-Acnt F +10200 16338 M (\() S +900 /Courier-Bold-Acnt F +(ABS) S +1000 /NewCenturySchlbk-Roman-Acnt F +12360 16338 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +44463 16338 M ([Function]) S +900 /Courier-Oblique-Acnt F +12600 14678 M (X) S +900 /Palatino-Roman-Acnt F +( if ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Acnt F +(> 0) S +900 /Palatino-Roman-Acnt F +(, otherwise ) S +900 /Courier-Acnt F +(-) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +(. ) S +900 /Courier-Acnt F +(ABS) S +900 /Palatino-Roman-Acnt F +( uses ) S +900 /Courier-Acnt F +(GREATERP) S +900 /Palatino-Roman-Acnt F +( and ) S +900 /Courier-Acnt F +(MINUS) S +900 /Palatino-Roman-Acnt F +( \(not ) S +900 /Courier-Acnt F +(IGREATERP) S +900 /Palatino-Roman-Acnt F +( and ) S +900 /Courier-Acnt F +(IMINUS) S +900 /Palatino-Roman-Acnt F +(\).) S +1000 /Helvetica-Bold-Acnt F +5400 12384 M (Integer Arithmetic) S +51001 12113 5401 12113 100 L +900 /Palatino-Roman-Acnt F +7800 10718 M (The input syntax for an integer is an optional sign \(+ or -\) followed by a sequence of decimal digits,) 73 0 32 4 -1 roll widthshow +7800 9618 M (and terminated by a delimiting character. Integers entered with this syntax are interpreted as decimal) 14 0 32 4 -1 roll widthshow +7800 8518 M (integers. Integers in other radices can be entered as follows:) S +900 /Courier-Acnt F +9840 6590 M (123Q) S +900 /Courier-Acnt F +9300 5502 M (#o123) S +900 /Palatino-Roman-Acnt F +12600 5502 M (If an integer is followed by the letter ) 60 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(Q) 144 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, or preceeded by a pound sign and the letter \252) 60 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(o) 144 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(\272,) 60 0 32 4 -1 roll widthshow +12600 4342 M (the digits are interpreted as an octal \(base 8\) integer.) S +grestore savepage restore showpage + +%%Page: 4 4 +%%BeginPageSetup +/savepage save def +0.01 imagesizefactor mul dup scale +%%EndPageSetup +gsave + 0 rotate + 79200 61200 0 0 CLP +/Times-Roman /Times-Roman-Acnt encodefont +900 /Times-Roman-Acnt F +10200 2400 M (7-4) S +/Helvetica /Helvetica-Acnt encodefont +1000 /Helvetica-Acnt F +9600 61200 M (INTERLISP-D REFERENCE MANUAL) S +/Courier /Courier-Acnt encodefont +900 /Courier-Acnt F +13020 56954 M (#b10101) S +/Palatino-Roman /Palatino-Roman-Acnt encodefont +900 /Palatino-Roman-Acnt F +17400 56954 M (If an integer is preceeded by a pound sign and the letter \252) 3 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(b) 8 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(\272, the digits are interpreted as a) 3 0 32 4 -1 roll widthshow +17400 55794 M (binary \(base 2\) integer.) S +900 /Courier-Acnt F +13560 53994 M (#x1A90) S +900 /Palatino-Roman-Acnt F +17400 53994 M (If an integer is preceeded by a pound sign and the letter \252) 3 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(x) 8 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(\272, the digits are interpreted as a) 3 0 32 4 -1 roll widthshow +17400 52834 M (hexadecimal \(base 16\) integer.) S +900 /Courier-Acnt F +13020 51034 M (#5r1243) S +900 /Palatino-Roman-Acnt F +17400 51034 M (If an integer is preceeded by a pound sign, a positive decimal integer ) 30 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(BASE) 72 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, and the letter) 30 0 32 4 -1 roll widthshow +17400 49874 M (\252) 98 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(r) 236 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(\272, the digits are interpreted as an integer in the base ) 98 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(BASE) 236 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. For example, ) 98 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(#8r123 =) 236 0 32 4 -1 roll widthshow +17400 48714 M (123Q) 371 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, and ) 154 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(#16r12A3 = #x12A3) 371 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. When typing a number in a radix above ten, the) 154 0 32 4 -1 roll widthshow +17400 47554 M (uppercase letters A through Z can be used as the digits after 9 \(but there is no digit above) 28 0 32 4 -1 roll widthshow +17400 46454 M (Z, so it is not possible to type all base-99 digits\).) S +12600 44654 M (Medley keeps no record of how you typed a number, so ) 117 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(77Q) 280 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and ) 117 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(63) 280 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( both correspond to the same) 117 0 32 4 -1 roll widthshow +12600 43494 M (integer, and are indistinguishable internally. The function ) 11 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(RADIX) 28 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( \(see Chapter 25\), sets the radix used) 11 0 32 4 -1 roll widthshow +12600 42334 M (to print integers.) S +900 /Courier-Acnt F +12600 40534 M (PACK) 178 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and ) 74 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(MKATOM) 178 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( create numbers when given a sequence of characters observing the above syntax,) 74 0 32 4 -1 roll widthshow +12600 39374 M (e.g. ) S +900 /Courier-Acnt F +(\(PACK '\(1 2 Q\)\) => 10) S +900 /Palatino-Roman-Acnt F +(. Integers are also created as a result of arithmetic operations.) S +12600 37514 M (The range of integers of various types is implementation-dependent. This information is accessible to) 28 0 32 4 -1 roll widthshow +12600 36414 M (you through the following variables:) S +/Courier-Bold /Courier-Bold-Acnt encodefont +900 /Courier-Bold-Acnt F +15000 34614 M (MIN.SMALLP) S +900 /Palatino-Roman-Acnt F +20400 34614 M ( ) S +49441 34614 M ([Variable]) S +900 /Courier-Bold-Acnt F +15000 33654 M (MAX.SMALLP) S +900 /Palatino-Roman-Acnt F +20400 33654 M ( ) S +49441 33654 M ([Variable]) S +17400 31994 M (The smallest/largest possible small integer.) S +900 /Courier-Bold-Acnt F +15000 30194 M (MIN.FIXP) S +900 /Palatino-Roman-Acnt F +49441 30194 M ([Variable]) S +900 /Courier-Bold-Acnt F +15000 29234 M (MAX.FIXP) S +900 /Palatino-Roman-Acnt F +49441 29234 M ([Variable]) S +17400 27574 M (The smallest/largest possible large integer.) S +900 /Courier-Bold-Acnt F +15000 25774 M (MIN.INTEGER) S +900 /Palatino-Roman-Acnt F +20940 25774 M ( ) S +49441 25774 M ([Variable]) S +900 /Courier-Bold-Acnt F +15000 24814 M (MAX.INTEGER) S +900 /Palatino-Roman-Acnt F +20940 24814 M ( ) S +49441 24814 M ([Variable]) S +17400 23154 M (The value of ) 138 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(MAX.INTEGER) 332 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and ) 138 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(MIN.INTEGER) 332 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( are two special system datatypes. For) 138 0 32 4 -1 roll widthshow +17400 21994 M (some algorithms, it is useful to have an integer that is larger than any other integer.) 194 0 32 4 -1 roll widthshow +17400 20894 M (Therefore, the values of ) 27 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(MAX.INTEGER) 64 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and ) 27 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(MIN.INTEGER) 64 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( are two special data types; the) 27 0 32 4 -1 roll widthshow +17400 19734 M (value of ) 439 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(MAX.INTEGER) 1054 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is ) 439 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(GREATERP) 1054 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( than any other integer, and the value of) 439 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +17400 18574 M (MIN.INTEGER) 555 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is ) 231 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(LESSP) 555 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( than any other integer. Trying to do arithmetic using these) 231 0 32 4 -1 roll widthshow +17400 17414 M (special bignums, other than comparison, will cause an error.) S +12600 15614 M (All of the functions described below work on integers. Unless specified otherwise, if given a floating-) 25 0 32 4 -1 roll widthshow +12600 14514 M (point number, they first convert the number to an integer by truncating the fractional bits, e.g.,) 214 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +12600 13414 M (\(IPLUS 2.3 3.8\) = 5) 155 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(; if given a non-numeric argument, they generate an error, ) 65 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(Non-numeric) 155 0 32 4 -1 roll widthshow +12600 12254 M (arg) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +15000 10266 M (\() S +900 /Courier-Bold-Acnt F +(IPLUS) S +/NewCenturySchlbk-Roman /NewCenturySchlbk-Roman-Acnt encodefont +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +/Courier-Oblique /Courier-Oblique-Acnt encodefont +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +19336 10066 M (1) S +/NewCenturySchlbk-Italic /NewCenturySchlbk-Italic-Acnt encodefont +1000 /NewCenturySchlbk-Italic-Acnt F +19696 10266 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +20514 10066 M (2) S +1000 /NewCenturySchlbk-Italic-Acnt F +20874 10266 M ( ) S +900 /Courier-Acnt F +(...) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +23590 10066 M (N) S +900 /Courier-Acnt F +23950 10266 M (\)) S +900 /Palatino-Roman-Acnt F +( ) S +44999 10266 M ([NoSpread Function]) S +17400 8511 M (Returns the sum ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +24713 8311 M (1) S +900 /Palatino-Roman-Acnt F +25073 8511 M ( ) S +900 /Courier-Acnt F +(+) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +26603 8311 M (2) S +900 /Palatino-Roman-Acnt F +26963 8511 M ( ) S +900 /Courier-Acnt F +(+ ... +) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +31733 8311 M (N.) S +900 /Palatino-Roman-Acnt F +32453 8511 M ( ) S +900 /Courier-Acnt F +(\(IPLUS\) = 0) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +15000 6428 M (\() S +900 /Courier-Bold-Acnt F +(IMINUS) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 6428 M ([Function]) S +900 /Courier-Acnt F +17400 4828 M (-) S +900 /Courier-Oblique-Acnt F +(X) S +grestore savepage restore showpage + +%%Page: 5 5 +%%BeginPageSetup +/savepage save def +0.01 imagesizefactor mul dup scale +%%EndPageSetup +gsave + 0 rotate + 79200 61200 0 0 CLP +/Times-Roman /Times-Roman-Acnt encodefont +900 /Times-Roman-Acnt F +49800 2400 M (7-5) S +/Helvetica /Helvetica-Acnt encodefont +1000 /Helvetica-Acnt F +30508 61200 M (NUMBERS AND ARITHMETIC FUNCTIONS) S +/Courier /Courier-Acnt encodefont +900 /Courier-Acnt F +10200 56826 M (\() S +/Courier-Bold /Courier-Bold-Acnt encodefont +900 /Courier-Bold-Acnt F +(IDIFFERENCE) S +/NewCenturySchlbk-Italic /NewCenturySchlbk-Italic-Acnt encodefont +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +/Courier-Oblique /Courier-Oblique-Acnt encodefont +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +/Palatino-Roman /Palatino-Roman-Acnt encodefont +900 /Palatino-Roman-Acnt F +( ) S +44463 56826 M ([Function]) S +900 /Courier-Oblique-Acnt F +12600 55038 M (X) S +/NewCenturySchlbk-Roman /NewCenturySchlbk-Roman-Acnt encodefont +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Acnt F +( -) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +10200 53050 M (\() S +900 /Courier-Bold-Acnt F +(ADD1) S +1000 /NewCenturySchlbk-Italic-Acnt F +12900 53050 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +44463 53050 M ([Function]) S +900 /Courier-Oblique-Acnt F +12600 51262 M (X) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Acnt F +( + 1) S +900 /Courier-Acnt F +10200 49274 M (\() S +900 /Courier-Bold-Acnt F +(SUB1) S +1000 /NewCenturySchlbk-Italic-Acnt F +12900 49274 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +44463 49274 M ([Function]) S +900 /Courier-Oblique-Acnt F +12600 47674 M (X) S +900 /Courier-Acnt F +( - 1) S +900 /Courier-Acnt F +10200 45686 M (\() S +900 /Courier-Bold-Acnt F +(ITIMES) S +1000 /NewCenturySchlbk-Italic-Acnt F +13980 45686 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +14798 45486 M (1) S +1000 /NewCenturySchlbk-Italic-Acnt F +15158 45686 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +15976 45486 M (2) S +1000 /NewCenturySchlbk-Italic-Acnt F +16336 45686 M ( ) S +900 /Courier-Acnt F +(...) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +19052 45486 M (N) S +900 /Courier-Acnt F +19412 45686 M (\)) S +900 /Palatino-Roman-Acnt F +( ) S +40199 45686 M ([NoSpread Function]) S +12600 43931 M (Returns the product ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +21367 43731 M (1) S +900 /Palatino-Roman-Acnt F +21727 43931 M ( ) S +900 /Courier-Acnt F +(*) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +23257 43731 M (2) S +900 /Palatino-Roman-Acnt F +23617 43931 M ( ) S +900 /Courier-Acnt F +(* ... * ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +28702 43731 M (N) S +900 /Palatino-Roman-Acnt F +29062 43931 M (. ) S +900 /Courier-Acnt F +(\(ITIMES\) = 1) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +10200 41848 M (\() S +900 /Courier-Bold-Acnt F +(IQUOTIENT) S +1000 /NewCenturySchlbk-Roman-Acnt F +15600 41848 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 41848 M ([Function]) S +900 /Courier-Oblique-Acnt F +12600 40188 M (X) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Acnt F +(/) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +( truncated. Examples:) S +900 /Courier-Acnt F +16200 38688 M (\(IQUOTIENT 3 2\) => 1) S +16200 37788 M (\(IQUOTIENT -3 2\) => -1) S +900 /Palatino-Roman-Acnt F +12600 36128 M (If ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +( is zero, the result is determined by the function ) S +900 /Courier-Acnt F +(OVERFLOW) S +900 /Palatino-Roman-Acnt F +( .) S +900 /Courier-Acnt F +10200 34140 M (\() S +900 /Courier-Bold-Acnt F +(IREMAINDER) S +1000 /NewCenturySchlbk-Roman-Acnt F +16140 34140 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 34140 M ([Function]) S +12600 32480 M (Returns the remainder when ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( is divided by ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +(. Example:) S +900 /Courier-Acnt F +16200 30980 M (\(IREMAINDER 5 2\) => 1) S +10200 29192 M (\() S +900 /Courier-Bold-Acnt F +(IMOD) S +1000 /NewCenturySchlbk-Roman-Acnt F +12900 29192 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 29192 M ([Function]) S +12600 27532 M (Computes the integer modulus of ) 158 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 380 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( mod ) 158 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 380 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(; this differs from ) 158 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(IREMAINDER) 380 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( in that the) 158 0 32 4 -1 roll widthshow +12600 26372 M (result is always a non-negative integer in the range [0,) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Palatino-Roman-Acnt F +(\).) S +900 /Courier-Acnt F +10200 24384 M (\() S +900 /Courier-Bold-Acnt F +(IGREATERP) S +1000 /NewCenturySchlbk-Roman-Acnt F +15600 24384 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 24384 M ([Function]) S +900 /Courier-Acnt F +12600 22724 M (T) S +900 /Palatino-Roman-Acnt F +(, if ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Acnt F +(>) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +(; ) S +900 /Courier-Acnt F +(NIL) S +900 /Palatino-Roman-Acnt F +( otherwise.) S +900 /Courier-Acnt F +10200 20736 M (\() S +900 /Courier-Bold-Acnt F +(ILESSP) S +1000 /NewCenturySchlbk-Roman-Acnt F +13980 20736 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 20736 M ([Function]) S +900 /Courier-Acnt F +12600 19076 M (T) S +900 /Palatino-Roman-Acnt F +(, if ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Acnt F +(<) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +(; ) S +900 /Courier-Acnt F +(NIL) S +900 /Palatino-Roman-Acnt F +( otherwise.) S +900 /Courier-Acnt F +10200 17088 M (\() S +900 /Courier-Bold-Acnt F +(IGEQ) S +1000 /NewCenturySchlbk-Roman-Acnt F +12900 17088 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 17088 M ([Function]) S +900 /Courier-Acnt F +12600 15428 M (T) S +900 /Palatino-Roman-Acnt F +(, if ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Acnt F +(>=) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +(; ) S +900 /Courier-Acnt F +(NIL) S +900 /Palatino-Roman-Acnt F +( otherwise.) S +900 /Courier-Acnt F +10200 13440 M (\() S +900 /Courier-Bold-Acnt F +(ILEQ) S +1000 /NewCenturySchlbk-Roman-Acnt F +12900 13440 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 13440 M ([Function]) S +900 /Courier-Acnt F +12600 11780 M (T) S +900 /Palatino-Roman-Acnt F +(, if ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Acnt F +(<=) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +(; ) S +900 /Courier-Acnt F +(NIL) S +900 /Palatino-Roman-Acnt F +( otherwise.) S +900 /Courier-Acnt F +10200 9792 M (\() S +900 /Courier-Bold-Acnt F +(IMIN) S +1000 /NewCenturySchlbk-Roman-Acnt F +12900 9792 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +13718 9592 M (1) S +1000 /NewCenturySchlbk-Italic-Acnt F +14078 9792 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +14896 9592 M (2) S +1000 /NewCenturySchlbk-Italic-Acnt F +15256 9792 M ( ) S +900 /Courier-Acnt F +(...) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +17972 9592 M (N) S +900 /Courier-Acnt F +18332 9792 M (\)) S +900 /Palatino-Roman-Acnt F +( ) S +40199 9792 M ([NoSpread Function]) S +12600 8037 M (Returns the minimum of ) 205 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 493 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +24005 7837 M (1) 329 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +24365 8037 M (, ) 205 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 493 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +25560 7837 M (2) 329 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +25920 8037 M (, ) 205 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(...,) 493 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( ) 205 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 493 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +29705 7837 M (N) 329 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +30065 8037 M (. ) 205 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\(IMIN\)) 493 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( returns the largest possible large) 205 0 32 4 -1 roll widthshow +12600 6782 M (integer, the value of ) S +900 /Courier-Acnt F +(MAX.INTEGER) S +900 /Palatino-Roman-Acnt F +(.) S +grestore savepage restore showpage + +%%Page: 6 6 +%%BeginPageSetup +/savepage save def +0.01 imagesizefactor mul dup scale +%%EndPageSetup +gsave + 0 rotate + 79200 61200 0 0 CLP +/Times-Roman /Times-Roman-Acnt encodefont +900 /Times-Roman-Acnt F +10200 2400 M (7-6) S +/Helvetica /Helvetica-Acnt encodefont +1000 /Helvetica-Acnt F +9600 61200 M (INTERLISP-D REFERENCE MANUAL) S +/Courier /Courier-Acnt encodefont +900 /Courier-Acnt F +15000 56826 M (\() S +/Courier-Bold /Courier-Bold-Acnt encodefont +900 /Courier-Bold-Acnt F +(IMAX) S +/NewCenturySchlbk-Roman /NewCenturySchlbk-Roman-Acnt encodefont +1000 /NewCenturySchlbk-Roman-Acnt F +17700 56826 M ( ) S +/Courier-Oblique /Courier-Oblique-Acnt encodefont +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +18518 56626 M (1) S +/NewCenturySchlbk-Italic /NewCenturySchlbk-Italic-Acnt encodefont +1000 /NewCenturySchlbk-Italic-Acnt F +18878 56826 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +19696 56626 M (2) S +1000 /NewCenturySchlbk-Italic-Acnt F +20056 56826 M ( ) S +900 /Courier-Acnt F +(...) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +22772 56626 M (N) S +900 /Courier-Acnt F +23132 56826 M (\)) S +/Palatino-Roman /Palatino-Roman-Acnt encodefont +900 /Palatino-Roman-Acnt F +( ) S +44999 56826 M ([NoSpread Function]) S +17400 55071 M (Returns the maximum of ) 184 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 441 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +28849 54871 M (1) 294 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +29209 55071 M (, ) 184 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 441 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +30383 54871 M (2) 294 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +30743 55071 M (, ) 184 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(...,) 441 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( ) 184 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 441 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +34486 54871 M (N) 294 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +34846 55071 M (. ) 184 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\(IMAX\)) 441 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( returns the smallest possible large) 184 0 32 4 -1 roll widthshow +17400 53816 M (integer, the value of ) S +900 /Courier-Acnt F +(MIN.INTEGER) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +15000 51828 M (\() S +900 /Courier-Bold-Acnt F +(IEQP) S +1000 /NewCenturySchlbk-Roman-Acnt F +17700 51828 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 51828 M ([Function]) S +17400 50168 M (Returns ) 13 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(T) 31 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( if ) 13 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 31 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and ) 13 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(Y) 31 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( are equal integers; ) 13 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(NIL) 31 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( otherwise. Note that ) 13 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(EQ) 31 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( may be used if ) 13 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 31 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and) 13 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +17400 49008 M (Y) 159 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( are known to be small integers. ) 66 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(IEQP) 159 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( converts ) 66 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 159 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and ) 66 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(Y) 159 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( to integers, e.g., ) 66 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\(IEQP 2000) 159 0 32 4 -1 roll widthshow +17400 47848 M (2000.3\) => T) S +900 /Palatino-Roman-Acnt F +(. ) S +900 /Courier-Acnt F +15000 45860 M (\() S +900 /Courier-Bold-Acnt F +(FIX) S +1000 /NewCenturySchlbk-Roman-Acnt F +17160 45860 M ( ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +49263 45860 M ([Function]) S +17400 44200 M (If ) 75 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 179 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is an integer, returns ) 75 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 179 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. Otherwise, converts ) 75 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 179 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( to an integer by truncating fractional) 75 0 32 4 -1 roll widthshow +17400 43040 M (bits For example, ) S +900 /Courier-Acnt F +(\(FIX 2.3\) => 2) S +900 /Palatino-Roman-Acnt F +(, ) S +900 /Courier-Acnt F +(\(FIX -1.7\) => -1) S +900 /Palatino-Roman-Acnt F +(.) S +17400 41180 M (Since ) 5 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(FIX) 12 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is also a programmer's assistant command \(see Chapter 13\), typing ) 5 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(FIX) 12 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( directly) 5 0 32 4 -1 roll widthshow +17400 40020 M (to a Medley executive will not cause the function ) S +900 /Courier-Acnt F +(FIX) S +900 /Palatino-Roman-Acnt F +( to be called.) S +900 /Courier-Acnt F +15000 38032 M (\() S +900 /Courier-Bold-Acnt F +(FIXR) S +1000 /NewCenturySchlbk-Roman-Acnt F +17700 38032 M ( ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +49263 38032 M ([Function]) S +17400 36372 M (If ) 56 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 134 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is an integer, returns ) 56 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 134 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. Otherwise, converts ) 56 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 134 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( to an integer by rounding. ) 56 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(FIXR) 134 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( will) 56 0 32 4 -1 roll widthshow +17400 35212 M (round towards the even number if ) 211 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 507 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is exactly half way between two integers. For) 211 0 32 4 -1 roll widthshow +17400 34052 M (example, ) S +900 /Courier-Acnt F +(\(FIXR 2.3\) => 2) S +900 /Palatino-Roman-Acnt F +(, ) S +900 /Courier-Acnt F +(\(FIXR -1.7\) => -2) S +900 /Palatino-Roman-Acnt F +(, ) S +900 /Courier-Acnt F +(\(FIXR 3.5\) => 4\)) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +15000 32064 M (\() S +900 /Courier-Bold-Acnt F +(GCD) S +1000 /NewCenturySchlbk-Roman-Acnt F +17160 32064 M ( ) S +900 /Courier-Oblique-Acnt F +(N) S +600 /Courier-Oblique-Acnt F +17978 31864 M (1) S +1000 /NewCenturySchlbk-Italic-Acnt F +18338 32064 M ( ) S +900 /Courier-Oblique-Acnt F +(N) S +600 /Courier-Oblique-Acnt F +19156 31864 M (2) S +900 /Courier-Acnt F +19516 32064 M (\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 32064 M ([Function]) S +17400 30309 M (Returns the greatest common divisor of ) S +900 /Courier-Oblique-Acnt F +(N) S +600 /Courier-Oblique-Acnt F +33902 30109 M (1) S +900 /Palatino-Roman-Acnt F +34262 30309 M ( and ) S +900 /Courier-Oblique-Acnt F +(N) S +600 /Courier-Oblique-Acnt F +36776 30109 M (2) S +900 /Palatino-Roman-Acnt F +37136 30309 M (, ) S +900 /Courier-Acnt F +(\(GCD 72 64\)=8) S +900 /Palatino-Roman-Acnt F +(.) S +/Helvetica-Bold /Helvetica-Bold-Acnt encodefont +1000 /Helvetica-Bold-Acnt F +10200 27920 M (Logical Arithmetic) S +18924 27920 M ( Functions) S +55801 27649 10201 27649 100 L +900 /Courier-Acnt F +15000 26126 M (\() S +900 /Courier-Bold-Acnt F +(LOGAND) S +1000 /NewCenturySchlbk-Roman-Acnt F +18780 26126 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +19598 25926 M (1) S +1000 /NewCenturySchlbk-Italic-Acnt F +19958 26126 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +20776 25926 M (2) S +1000 /NewCenturySchlbk-Italic-Acnt F +21136 26126 M ( ) S +900 /Courier-Acnt F +(...) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +23852 25926 M (N) S +900 /Courier-Acnt F +24212 26126 M (\)) S +900 /Palatino-Roman-Acnt F +( ) S +44999 26126 M ([NoSpread Function]) S +17400 24371 M (Returns the logical ) S +900 /Courier-Acnt F +(AND) S +900 /Palatino-Roman-Acnt F +( of all its arguments, as an integer. Example:) S +900 /Courier-Acnt F +21000 22871 M (\(LOGAND 7 5 6\) => 4) S +15000 21083 M (\() S +900 /Courier-Bold-Acnt F +(LOGOR) S +1000 /NewCenturySchlbk-Roman-Acnt F +18240 21083 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +19058 20883 M (1) S +1000 /NewCenturySchlbk-Italic-Acnt F +19418 21083 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +20236 20883 M (2) S +1000 /NewCenturySchlbk-Italic-Acnt F +20596 21083 M ( ) S +900 /Courier-Acnt F +(...) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +23312 20883 M (N) S +900 /Courier-Acnt F +23672 21083 M (\)) S +900 /Palatino-Roman-Acnt F +( ) S +44999 21083 M ([NoSpread Function]) S +17400 19328 M (Returns the logical ) S +900 /Courier-Acnt F +(OR) S +900 /Palatino-Roman-Acnt F +( of all its arguments, as an integer. Example:) S +900 /Courier-Acnt F +21000 17828 M (\(LOGOR 1 3 9\) => 11) S +15000 16040 M (\() S +900 /Courier-Bold-Acnt F +(LOGXOR) S +1000 /NewCenturySchlbk-Roman-Acnt F +18780 16040 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +19598 15840 M (1) S +1000 /NewCenturySchlbk-Italic-Acnt F +19958 16040 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +20776 15840 M (2) S +1000 /NewCenturySchlbk-Italic-Acnt F +21136 16040 M ( ) S +900 /Courier-Acnt F +(...) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +23852 15840 M (N) S +900 /Courier-Acnt F +24212 16040 M (\)) S +900 /Palatino-Roman-Acnt F +( ) S +44999 16040 M ([NoSpread Function]) S +17400 14285 M (Returns the logical exclusive ) S +900 /Courier-Acnt F +(OR) S +900 /Palatino-Roman-Acnt F +( of its arguments, as an integer. Example:) S +900 /Courier-Acnt F +21000 12785 M (\(LOGXOR 11 5\) => 14) S +21000 11885 M (\(LOGXOR 11 5 9\) = \(LOGXOR 14 9\) => 7) S +15000 10097 M (\() S +900 /Courier-Bold-Acnt F +(LSH) S +1000 /NewCenturySchlbk-Roman-Acnt F +17160 10097 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 10097 M ([Function]) S +17400 8437 M (\(Arithmetic\) \252Left Shift.\272 Returns ) 76 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 182 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( shifted left ) 76 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 182 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( places, with the sign bit unaffected. ) 76 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 182 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +17400 7277 M (can be positive or negative. If ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Palatino-Roman-Acnt F +( is negative, ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( is shifted right ) S +900 /Courier-Acnt F +(-) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Palatino-Roman-Acnt F +( places.) S +grestore savepage restore showpage + +%%Page: 7 7 +%%BeginPageSetup +/savepage save def +0.01 imagesizefactor mul dup scale +%%EndPageSetup +gsave + 0 rotate + 79200 61200 0 0 CLP +/Times-Roman /Times-Roman-Acnt encodefont +900 /Times-Roman-Acnt F +49800 2400 M (7-7) S +/Helvetica /Helvetica-Acnt encodefont +1000 /Helvetica-Acnt F +30508 61200 M (NUMBERS AND ARITHMETIC FUNCTIONS) S +/Courier /Courier-Acnt encodefont +900 /Courier-Acnt F +10200 56826 M (\() S +/Courier-Bold /Courier-Bold-Acnt encodefont +900 /Courier-Bold-Acnt F +(RSH) S +/NewCenturySchlbk-Roman /NewCenturySchlbk-Roman-Acnt encodefont +1000 /NewCenturySchlbk-Roman-Acnt F +12360 56826 M ( ) S +/Courier-Oblique /Courier-Oblique-Acnt encodefont +900 /Courier-Oblique-Acnt F +(X) S +/NewCenturySchlbk-Italic /NewCenturySchlbk-Italic-Acnt encodefont +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Courier-Acnt F +(\)) S +/Palatino-Roman /Palatino-Roman-Acnt encodefont +900 /Palatino-Roman-Acnt F +( ) S +44463 56826 M ([Function]) S +12600 55166 M (\(Arithmetic\) \252Right Shift.\272 Returns ) 68 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 163 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( shifted right ) 68 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 163 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( places, with the sign bit unaffected,) 68 0 32 4 -1 roll widthshow +12600 54006 M (and copies of the sign bit shifted into the leftmost bit. ) 6 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 15 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( can be positive or negative. If ) 6 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 15 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is) 6 0 32 4 -1 roll widthshow +12600 52846 M (negative, ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( is shifted left -) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Palatino-Roman-Acnt F +( places.) S +/Palatino-Bold /Palatino-Bold-Acnt encodefont +900 /Palatino-Bold-Acnt F +12600 50986 M (Warning:) 10 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( Be careful if using ) 10 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(RSH) 25 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( to simulate division; ) 10 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(RSH) 25 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(ing a negative number isn't the) 10 0 32 4 -1 roll widthshow +12600 49826 M (same as dividing by a power of two.) S +900 /Courier-Acnt F +10200 47898 M (\() S +900 /Courier-Bold-Acnt F +(LLSH) S +1000 /NewCenturySchlbk-Roman-Acnt F +12900 47898 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 47898 M ([Function]) S +900 /Courier-Acnt F +10200 46810 M (\() S +900 /Courier-Bold-Acnt F +(LRSH) S +1000 /NewCenturySchlbk-Roman-Acnt F +12900 46810 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 46810 M ([Function]) S +12600 45150 M (\252Logical Left Shift\272 and \252Logical Right Shift\272. The difference between a logical and) 214 0 32 4 -1 roll widthshow +12600 44050 M (arithmetic right shift lies in the treatment of the sign bit. Logical shifting treats it just like) 34 0 32 4 -1 roll widthshow +12600 42950 M (any other bit; arithmetic shifting will not change it, and will \252propagate\272 rightward when) 29 0 32 4 -1 roll widthshow +12600 41850 M (actually shifting rightwards. Note that shifting \(arithmetic\) a negative number \252all the) 128 0 32 4 -1 roll widthshow +12600 40750 M (way\272 to the right yields ) S +900 /Courier-Acnt F +(-1) S +900 /Palatino-Roman-Acnt F +(, not ) S +900 /Courier-Acnt F +(0) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Palatino-Bold-Acnt F +12600 38890 M (Note) 73 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(: ) 73 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(LLSH) 176 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and ) 73 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(LRSH) 176 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( always operate mod-2) 73 0 32 4 -1 roll widthshow +600 /Palatino-Roman-Acnt F +31129 39090 M (32) 49 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +31729 38890 M ( arithmetic. Passing a bignum to either of) 73 0 32 4 -1 roll widthshow +12600 37730 M (these will cause an error. ) S +900 /Courier-Acnt F +(LRSH) S +900 /Palatino-Roman-Acnt F +( of negative numbers will shift 0s into the high bits.) S +900 /Courier-Acnt F +10200 35742 M (\() S +900 /Courier-Bold-Acnt F +(INTEGERLENGTH) S +1000 /NewCenturySchlbk-Roman-Acnt F +17760 35742 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 35742 M ([Function]) S +12600 34082 M (Returns the number of bits needed to represent ) 579 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 1391 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. This is equivalent to:) 579 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +12600 32922 M (1+floor[log2[abs[) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(]]]) S +900 /Palatino-Roman-Acnt F +(. ) S +900 /Courier-Acnt F +(\(INTEGERLENGTH 0\) = 0) S +900 /Palatino-Roman-Acnt F +(. ) S +900 /Courier-Acnt F +( ) S +900 /Courier-Acnt F +10200 30934 M (\() S +900 /Courier-Bold-Acnt F +(POWEROFTWOP) S +1000 /NewCenturySchlbk-Roman-Acnt F +16680 30934 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 30934 M ([Function]) S +12600 29274 M (Returns non-) S +900 /Courier-Acnt F +(NIL) S +900 /Palatino-Roman-Acnt F +( if ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( \(coerced to an integer\) is a power of two.) S +900 /Courier-Acnt F +10200 27286 M (\() S +900 /Courier-Bold-Acnt F +(EVENP) S +1000 /NewCenturySchlbk-Roman-Acnt F +13440 27286 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +40199 27286 M ([NoSpread Function]) S +12600 25626 M (If ) 49 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(Y) 117 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is not given, equivalent to ) 49 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\(ZEROP \(IMOD ) 117 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 117 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +( 2\)\)) 117 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(; otherwise equivalent to ) 49 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\(ZEROP) 117 0 32 4 -1 roll widthshow +12600 24338 M (\(IMOD X Y\)\)) S +1000 /NewCenturySchlbk-Roman-Acnt F +(.) S +900 /Courier-Acnt F +10200 22350 M (\() S +900 /Courier-Bold-Acnt F +(ODDP) S +1000 /NewCenturySchlbk-Roman-Acnt F +12900 22350 M ( ) S +900 /Courier-Oblique-Acnt F +(N) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(MODULUS) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +40199 22350 M ([NoSpread Function]) S +12600 20690 M (Equivalent to ) S +900 /Courier-Acnt F +(\(NOT \(EVENP N MODULUS\)\)) S +900 /Palatino-Roman-Acnt F +(. ) S +900 /Courier-Oblique-Acnt F +(MODULUS) S +900 /Palatino-Roman-Acnt F +( defaults to 2.) S +900 /Courier-Acnt F +10200 18702 M (\() S +900 /Courier-Bold-Acnt F +(LOGNOT) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +14258 18702 M (N) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +45452 18702 M ([Macro]) S +12600 17042 M (Logical negation of the bits in ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Palatino-Roman-Acnt F +(. Equivalent to ) S +900 /Courier-Acnt F +(\(LOGXOR ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Courier-Acnt F +( -1\)) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +10200 15054 M (\() S +900 /Courier-Bold-Acnt F +(BITTEST) S +1000 /NewCenturySchlbk-Roman-Acnt F +14520 15054 M ( ) S +900 /Courier-Oblique-Acnt F +(N) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(MASK) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +45452 15054 M ([Macro]) S +12600 13394 M (Returns ) 28 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(T) 68 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( if any of the bits in ) 28 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(MASK) 68 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( are on in the number ) 28 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 68 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. Equivalent to ) 28 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\(NOT \(ZEROP) 68 0 32 4 -1 roll widthshow +12600 12234 M (\(LOGAND) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(MASK) S +900 /Courier-Acnt F +(\)\)\)) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +10200 10246 M (\() S +900 /Courier-Bold-Acnt F +(BITCLEAR) S +1000 /NewCenturySchlbk-Roman-Acnt F +15060 10246 M ( ) S +900 /Courier-Oblique-Acnt F +(N) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(MASK) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +45452 10246 M ([Macro]) S +12600 8586 M (Turns off bits from ) S +900 /Courier-Oblique-Acnt F +(MASK) S +900 /Palatino-Roman-Acnt F +( in ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Palatino-Roman-Acnt F +(. Equivalent to ) S +900 /Courier-Acnt F +(\(LOGAND) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Acnt F +(\(LOGNOT) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(MASK) S +900 /Courier-Acnt F +(\)\)) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +10200 6598 M (\() S +900 /Courier-Bold-Acnt F +(BITSET) S +1000 /NewCenturySchlbk-Roman-Acnt F +13980 6598 M ( ) S +900 /Courier-Oblique-Acnt F +(N) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(MASK) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +45452 6598 M ([Macro]) S +12600 4938 M (Turns on the bits from ) S +900 /Courier-Oblique-Acnt F +(MASK) S +900 /Palatino-Roman-Acnt F +( in ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Palatino-Roman-Acnt F +(. Equivalent to ) S +900 /Courier-Acnt F +(\(LOGOR ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Courier-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(MASK) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +(.) S +grestore savepage restore showpage + +%%Page: 8 8 +%%BeginPageSetup +/savepage save def +0.01 imagesizefactor mul dup scale +%%EndPageSetup +gsave + 0 rotate + 79200 61200 0 0 CLP +/Times-Roman /Times-Roman-Acnt encodefont +900 /Times-Roman-Acnt F +10200 2400 M (7-8) S +/Helvetica /Helvetica-Acnt encodefont +1000 /Helvetica-Acnt F +9600 61200 M (INTERLISP-D REFERENCE MANUAL) S +/Courier /Courier-Acnt encodefont +900 /Courier-Acnt F +15000 56826 M (\() S +/Courier-Bold /Courier-Bold-Acnt encodefont +900 /Courier-Bold-Acnt F +(MASK.1'S) S +/NewCenturySchlbk-Roman /NewCenturySchlbk-Roman-Acnt encodefont +1000 /NewCenturySchlbk-Roman-Acnt F +19860 56826 M ( ) S +/Courier-Oblique /Courier-Oblique-Acnt encodefont +900 /Courier-Oblique-Acnt F +(POSITION) S +/NewCenturySchlbk-Italic /NewCenturySchlbk-Italic-Acnt encodefont +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(SIZE) S +900 /Courier-Acnt F +(\)) S +/Palatino-Roman /Palatino-Roman-Acnt encodefont +900 /Palatino-Roman-Acnt F +( ) S +50252 56826 M ([Macro]) S +17400 55166 M (Returns a bit-mask with ) 73 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(SIZE) 176 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( one-bits starting with the bit at ) 73 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(POSITION) 176 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. Equivalent to) 73 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +17400 54006 M (\(LLSH \(SUB1 \(EXPT 2) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(SIZE) S +900 /Courier-Acnt F +(\)\)) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(POSITION) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +15000 52018 M (\() S +900 /Courier-Bold-Acnt F +(MASK.0'S) S +1000 /NewCenturySchlbk-Roman-Acnt F +19860 52018 M ( ) S +900 /Courier-Oblique-Acnt F +(POSITION) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(SIZE) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +50252 52018 M ([Macro]) S +17400 50358 M (Returns a bit-mask with all one bits, except for ) 343 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(SIZE) 822 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( bits starting at ) 343 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(POSITION) 822 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(.) 343 0 32 4 -1 roll widthshow +17400 49198 M (Equivalent to ) S +900 /Courier-Acnt F +(\(LOGNOT \(MASK.1'S) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(POSITION) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(SIZE) S +900 /Courier-Acnt F +(\)\)) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +15000 47210 M (\() S +900 /Courier-Bold-Acnt F +(LOADBYTE) S +1000 /NewCenturySchlbk-Roman-Acnt F +19860 47210 M ( ) S +900 /Courier-Oblique-Acnt F +(N) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(POS) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(SIZE) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 47210 M ([Function]) S +17400 45422 M (Extracts ) 17 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(SIZE) 41 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( bits from ) 17 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 41 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, starting at position ) 17 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(POS) 41 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. Equivalent to \() 17 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(LOGAND \(RSH) 41 0 32 4 -1 roll widthshow +/NewCenturySchlbk-Bold /NewCenturySchlbk-Bold-Acnt encodefont +1000 /NewCenturySchlbk-Bold-Acnt F +( ) 22 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 41 0 32 4 -1 roll widthshow +1000 /NewCenturySchlbk-Bold-Acnt F +( ) 22 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(POS) 41 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\)) 41 0 32 4 -1 roll widthshow +17400 44134 M (\(MASK.1'S 0) S +1000 /NewCenturySchlbk-Bold-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(SIZE) S +900 /Courier-Acnt F +(\)\)) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +15000 42146 M (\() S +900 /Courier-Bold-Acnt F +(DEPOSITBYTE) S +1000 /NewCenturySchlbk-Roman-Acnt F +21480 42146 M ( ) S +900 /Courier-Oblique-Acnt F +(N) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(POS) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(SIZE) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(VAL) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 42146 M ([Function]) S +17400 40486 M (Insert ) S +900 /Courier-Oblique-Acnt F +(SIZE) S +900 /Palatino-Roman-Acnt F +( bits of ) S +900 /Courier-Oblique-Acnt F +(VAL) S +900 /Palatino-Roman-Acnt F +( at position ) S +900 /Courier-Oblique-Acnt F +(POS) S +900 /Palatino-Roman-Acnt F +( into ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Palatino-Roman-Acnt F +(, returning the result. Equivalent to) S +900 /Courier-Acnt F +21000 38986 M (\(LOGOR \(BITCLEAR ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Courier-Acnt F +( \(MASK.1'S ) S +900 /Courier-Oblique-Acnt F +(POS) S +900 /Courier-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(SIZE) S +900 /Courier-Acnt F +(\)\)) S +21000 38086 M ( \(LSH \(LOGAND ) S +900 /Courier-Oblique-Acnt F +(VAL) S +900 /Courier-Acnt F +( \(MASK.1'S 0 ) S +900 /Courier-Oblique-Acnt F +(SIZE) S +900 /Courier-Acnt F +(\)\)) S +900 /Courier-Oblique-Acnt F +21000 37186 M ( POS) S +900 /Courier-Acnt F +(\)\)) S +900 /Courier-Acnt F +15000 35398 M (\() S +900 /Courier-Bold-Acnt F +(ROT) S +1000 /NewCenturySchlbk-Roman-Acnt F +17160 35398 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(N) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(FIELDSIZE) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 35398 M ([Function]) S +17400 33738 M (\252Rotate bits in field\272. It performs a bitwise left-rotation of the integer ) 184 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 442 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, by ) 184 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 442 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( places,) 184 0 32 4 -1 roll widthshow +17400 32578 M (within a field of ) 62 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(FIELDSIZE) 148 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( bits wide. Bits being shifted out of the position selected by) 62 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +17400 31418 M (\(EXPT 2 \(SUB1 ) S +900 /Courier-Oblique-Acnt F +(FIELDSIZE) S +900 /Courier-Acnt F +(\)\)) S +900 /Palatino-Roman-Acnt F +( will flow into the \252units\272 position.) S +12600 29558 M (The notions of position and size can be combined to make up a \252byte specifier\272, which is constructed) 40 0 32 4 -1 roll widthshow +12600 28458 M (by the macro ) S +900 /Courier-Acnt F +(BYTE) S +900 /Palatino-Roman-Acnt F +( [note reversal of arguments as compared with the above functions]:) S +900 /Courier-Acnt F +15000 26470 M (\() S +900 /Courier-Bold-Acnt F +(BYTE) S +1000 /NewCenturySchlbk-Roman-Acnt F +17700 26470 M ( ) S +900 /Courier-Oblique-Acnt F +(SIZE) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(POSITION) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +50252 26470 M ([Macro]) S +17400 24810 M (Constructs and returns a \252byte specifier\272 containing ) S +900 /Courier-Oblique-Acnt F +(SIZE) S +900 /Palatino-Roman-Acnt F +( and ) S +900 /Courier-Oblique-Acnt F +(POSITION) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +15000 22822 M (\() S +900 /Courier-Bold-Acnt F +(BYTESIZE) S +1000 /NewCenturySchlbk-Roman-Acnt F +19860 22822 M ( ) S +900 /Courier-Oblique-Acnt F +(BYTESPEC) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +50252 22822 M ([Macro]) S +17400 21162 M (Returns the ) S +900 /Courier-Acnt F +(SIZE) S +900 /Palatino-Roman-Acnt F +( componant of the \252byte specifier\272 ) S +900 /Courier-Oblique-Acnt F +(BYTESPEC) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +15000 19174 M (\() S +900 /Courier-Bold-Acnt F +(BYTEPOSITION) S +1000 /NewCenturySchlbk-Roman-Acnt F +22020 19174 M ( ) S +900 /Courier-Oblique-Acnt F +(BYTESPEC) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +50252 19174 M ([Macro]) S +17400 17514 M (Returns the ) S +900 /Courier-Acnt F +(POSITION) S +900 /Palatino-Roman-Acnt F +( componant of the \252byte specifier\272 ) S +900 /Courier-Oblique-Acnt F +(BYTESPEC) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +15000 15526 M (\() S +900 /Courier-Bold-Acnt F +(LDB) S +1000 /NewCenturySchlbk-Roman-Acnt F +17160 15526 M ( ) S +900 /Courier-Oblique-Acnt F +(BYTESPEC) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(VAL) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +50252 15526 M ([Macro]) S +17400 13866 M (Equivalent to) S +900 /Courier-Acnt F +17400 12238 M (\(LOADBYTE) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(VAL) S +900 /Courier-Acnt F +( \(BYTEPOSITION ) S +900 /Courier-Oblique-Acnt F +(BYTESPEC) S +900 /Courier-Acnt F +(\)\(BYTESIZE) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(BYTESPEC) S +900 /Courier-Acnt F +(\)\)) S +15000 10450 M (\() S +900 /Courier-Bold-Acnt F +(DPB) S +1000 /NewCenturySchlbk-Roman-Acnt F +17160 10450 M ( ) S +900 /Courier-Oblique-Acnt F +(N) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(BYTESPEC) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(VAL) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +50252 10450 M ([Macro]) S +17400 8790 M (Equivalent to) S +900 /Courier-Acnt F +17400 7162 M (\(DEPOSITBYTE) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(VAL) S +900 /Courier-Acnt F +( \(BYTEPOSITION) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(BYTESPEC) S +900 /Courier-Acnt F +(\)\(BYTESIZE) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(BYTESPEC) S +900 /Courier-Acnt F +(\) ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Courier-Acnt F +(\)) S +grestore savepage restore showpage + +%%Page: 9 9 +%%BeginPageSetup +/savepage save def +0.01 imagesizefactor mul dup scale +%%EndPageSetup +gsave + 0 rotate + 79200 61200 0 0 CLP +/Times-Roman /Times-Roman-Acnt encodefont +900 /Times-Roman-Acnt F +49800 2400 M (7-9) S +/Helvetica /Helvetica-Acnt encodefont +1000 /Helvetica-Acnt F +30508 61200 M (NUMBERS AND ARITHMETIC FUNCTIONS) S +/Helvetica-Bold /Helvetica-Bold-Acnt encodefont +1000 /Helvetica-Bold-Acnt F +5400 56820 M (Floating-Point Arithmetic) S +51001 56549 5401 56549 100 L +/Palatino-Roman /Palatino-Roman-Acnt encodefont +900 /Palatino-Roman-Acnt F +7800 55154 M (A floating-point number is input as a signed integer, followed by a decimal point, and another) 217 0 32 4 -1 roll widthshow +7800 54054 M (sequence of digits called the fraction, followed by an exponent \(represented by ) 13 0 32 4 -1 roll widthshow +/Courier /Courier-Acnt encodefont +900 /Courier-Acnt F +(E) 30 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( followed by a signed) 13 0 32 4 -1 roll widthshow +7800 52894 M (integer\) and terminated by a delimiter.) S +7800 51094 M (Both signs are optional, and either the fraction following the decimal point, or the integer preceding) 75 0 32 4 -1 roll widthshow +7800 49994 M (the decimal point may be omitted. One or the other of the decimal point or exponent may also be) 108 0 32 4 -1 roll widthshow +7800 48894 M (omitted, but at least one of them must be present to distinguish a floating-point number from an) 157 0 32 4 -1 roll widthshow +7800 47794 M (integer. For example, the following will be recognized as floating-point numbers:) S +900 /Courier-Acnt F +16200 46354 M (5. 5.00 5.01 .3) S +16200 45054 M (5E2 5.1E2 5E-3 -5.2E+6) S +900 /Palatino-Roman-Acnt F +7800 43394 M (Floating-point numbers are printed using the format control specified by the function ) 121 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(FLTFMT) 290 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( \(see) 121 0 32 4 -1 roll widthshow +7800 42234 M (Chapter 25\). ) S +900 /Courier-Acnt F +(FLTFMT) S +900 /Palatino-Roman-Acnt F +( is initialized to ) S +900 /Courier-Acnt F +(T) S +900 /Palatino-Roman-Acnt F +(, or free format. For example, the above floating-point numbers) S +7800 41074 M (would be printed free format as:) S +900 /Courier-Acnt F +16200 39634 M (5.0 5.0 5.01 .3) S +16200 38334 M (500.0 510.0 .005 -5.2E6) S +900 /Palatino-Roman-Acnt F +7800 36674 M (Floating-point numbers are created by the reader when a ) 26 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\252.) 62 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(\272 or an ) 26 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(E) 62 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( appears in a number, e.g., ) 26 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(1000) 62 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +7800 35514 M (is an integer, ) 107 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(1000.) 258 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( a floating-point number, as are ) 107 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(1E3) 258 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and ) 107 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(1.E3) 258 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. Note that ) 107 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(1000D) 258 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, ) 107 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(1000F) 258 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, and) 107 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +7800 34354 M (1E3D) 89 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( are perfectly legal literal atoms. Floating-point numbers are also created by ) 37 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(PACK) 89 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and ) 37 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(MKATOM) 89 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(,) 37 0 32 4 -1 roll widthshow +7800 33194 M (and as a result of arithmetic operations.) S +900 /Courier-Acnt F +7800 31394 M (PRINTNUM) 452 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( \(see Chapter 25\) permits greater control over the printed appearance of floating-point) 188 0 32 4 -1 roll widthshow +7800 30234 M (numbers, allowing such things as left-justification, suppression of trailing decimals, etc.) S +7800 28434 M (The floating-point number range is stored in the following variables:) S +/Courier-Bold /Courier-Bold-Acnt encodefont +900 /Courier-Bold-Acnt F +10200 26634 M (MIN.FLOAT) S +900 /Palatino-Roman-Acnt F +15060 26634 M ( ) S +44641 26634 M ([Variable]) S +12600 24974 M (The smallest possible floating-point number.) S +900 /Courier-Bold-Acnt F +10200 23174 M (MAX.FLOAT) S +900 /Palatino-Roman-Acnt F +15060 23174 M ( ) S +44641 23174 M ([Variable]) S +12600 21514 M (The largest possible floating-point number.) S +7800 19714 M (All of the functions described below work on floating-point numbers. Unless specified otherwise, if) 76 0 32 4 -1 roll widthshow +7800 18614 M (given an integer, they first convert the number to a floating-point number, e.g.,) 98 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +( \(FPLUS 1 2.3\)) 234 0 32 4 -1 roll widthshow +7800 17454 M (<=> \(FPLUS 1.0 2.3\) => 3.3) 138 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(; if given a non-numeric argument, they generate an error, ) 58 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(Non-) 138 0 32 4 -1 roll widthshow +7800 16294 M (numeric arg) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +10200 14306 M (\() S +900 /Courier-Bold-Acnt F +(FPLUS) S +/NewCenturySchlbk-Roman /NewCenturySchlbk-Roman-Acnt encodefont +1000 /NewCenturySchlbk-Roman-Acnt F +13440 14306 M ( ) S +/Courier-Oblique /Courier-Oblique-Acnt encodefont +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +14258 14106 M (1) S +/NewCenturySchlbk-Italic /NewCenturySchlbk-Italic-Acnt encodefont +1000 /NewCenturySchlbk-Italic-Acnt F +14618 14306 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +15436 14106 M (2) S +1000 /NewCenturySchlbk-Italic-Acnt F +15796 14306 M ( ) S +900 /Courier-Acnt F +(...) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +18512 14106 M (N) S +900 /Courier-Acnt F +18872 14306 M (\)) S +900 /Palatino-Roman-Acnt F +( ) S +40199 14306 M ([NoSpread Function]) S +900 /Courier-Oblique-Acnt F +12600 12423 M (X) S +600 /Courier-Oblique-Acnt F +13140 12223 M (1) S +1000 /NewCenturySchlbk-Roman-Acnt F +13500 12423 M ( ) S +900 /Courier-Acnt F +(+) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +15136 12223 M (2) S +1000 /NewCenturySchlbk-Roman-Acnt F +15496 12423 M ( ) S +900 /Courier-Acnt F +(+ ... +) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +20372 12223 M (N) S +900 /Courier-Acnt F +10200 10340 M (\() S +900 /Courier-Bold-Acnt F +(FMINUS) S +1000 /NewCenturySchlbk-Roman-Acnt F +13980 10340 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 10340 M ([Function]) S +900 /Courier-Acnt F +12600 8552 M (-) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +10200 6564 M (\() S +900 /Courier-Bold-Acnt F +(FDIFFERENCE) S +1000 /NewCenturySchlbk-Roman-Acnt F +16680 6564 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 6564 M ([Function]) S +900 /Courier-Oblique-Acnt F +12600 4776 M (X) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Acnt F +(-) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +grestore savepage restore showpage + +%%Page: 10 10 +%%BeginPageSetup +/savepage save def +0.01 imagesizefactor mul dup scale +%%EndPageSetup +gsave + 0 rotate + 79200 61200 0 0 CLP +/Times-Roman /Times-Roman-Acnt encodefont +900 /Times-Roman-Acnt F +10200 2400 M (7-10) S +/Helvetica /Helvetica-Acnt encodefont +1000 /Helvetica-Acnt F +9600 61200 M (INTERLISP-D REFERENCE MANUAL) S +/Courier /Courier-Acnt encodefont +900 /Courier-Acnt F +15000 56826 M (\() S +/Courier-Bold /Courier-Bold-Acnt encodefont +900 /Courier-Bold-Acnt F +(FTIMES) S +/NewCenturySchlbk-Roman /NewCenturySchlbk-Roman-Acnt encodefont +1000 /NewCenturySchlbk-Roman-Acnt F +18780 56826 M ( ) S +/Courier-Oblique /Courier-Oblique-Acnt encodefont +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +19598 56626 M (1) S +/NewCenturySchlbk-Italic /NewCenturySchlbk-Italic-Acnt encodefont +1000 /NewCenturySchlbk-Italic-Acnt F +19958 56826 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +20776 56626 M (2) S +1000 /NewCenturySchlbk-Italic-Acnt F +21136 56826 M ( ) S +900 /Courier-Acnt F +(...) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +23852 56626 M (N) S +900 /Courier-Acnt F +24212 56826 M (\)) S +/Palatino-Roman /Palatino-Roman-Acnt encodefont +900 /Palatino-Roman-Acnt F +( ) S +44999 56826 M ([NoSpread Function]) S +900 /Courier-Oblique-Acnt F +17400 54943 M (X) S +600 /Courier-Oblique-Acnt F +17940 54743 M (1) S +1000 /NewCenturySchlbk-Roman-Acnt F +18300 54943 M ( ) S +900 /Courier-Acnt F +(*) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +19936 54743 M (2) S +900 /Courier-Acnt F +20296 54943 M ( * ... *) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +25434 54743 M (N) S +900 /Courier-Acnt F +15000 52860 M (\() S +900 /Courier-Bold-Acnt F +(FQUOTIENT) S +1000 /NewCenturySchlbk-Roman-Acnt F +20400 52860 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 52860 M ([Function]) S +900 /Courier-Oblique-Acnt F +17400 51072 M (X) S +900 /Courier-Acnt F +( /) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +1000 /NewCenturySchlbk-Roman-Acnt F +(.) S +900 /Palatino-Roman-Acnt F +17400 49212 M (The results of division by zero and floating-point overflow is determined by the function) 54 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +17400 48112 M (OVERFLOW) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +15000 46124 M (\() S +900 /Courier-Bold-Acnt F +(FREMAINDER) S +1000 /NewCenturySchlbk-Roman-Acnt F +20940 46124 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 46124 M ([Function]) S +17400 44464 M (Returns the remainder when ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( is divided by ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +(. Equivalent to:) S +900 /Courier-Acnt F +21000 42964 M (\(FDIFFERENCE ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +( \(FTIMES ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +( \(FIX \(FQUOTIENT ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)\)\)\)) S +900 /Palatino-Roman-Acnt F +17400 41304 M (Example:) S +900 /Courier-Acnt F +21000 39864 M (\(FREMAINDER 7.5 2.3\) => 0.6) S +15000 38076 M (\() S +900 /Courier-Bold-Acnt F +(FGREATERP) S +1000 /NewCenturySchlbk-Roman-Acnt F +20400 38076 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 38076 M ([Function]) S +900 /Courier-Acnt F +17400 36416 M (T) S +900 /Palatino-Roman-Acnt F +(, if ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Acnt F +(>) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +(, ) S +900 /Courier-Acnt F +(NIL) S +900 /Palatino-Roman-Acnt F +( otherwise.) S +900 /Courier-Acnt F +15000 34428 M (\() S +900 /Courier-Bold-Acnt F +(FLESSP) S +1000 /NewCenturySchlbk-Roman-Acnt F +18780 34428 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 34428 M ([Function]) S +900 /Courier-Acnt F +17400 32768 M (T) S +900 /Palatino-Roman-Acnt F +(, if ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Acnt F +(<) S +900 /Palatino-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +(, ) S +900 /Courier-Acnt F +(NIL) S +900 /Palatino-Roman-Acnt F +( otherwise.) S +900 /Courier-Acnt F +15000 30780 M (\() S +900 /Courier-Bold-Acnt F +(FEQP) S +1000 /NewCenturySchlbk-Roman-Acnt F +17700 30780 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 30780 M ([Function]) S +17400 29120 M (Returns ) 84 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(T) 202 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( if ) 84 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 202 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and ) 84 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(Y) 202 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( are equal floating-point numbers; ) 84 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(NIL) 202 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( otherwise. ) 84 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(FEQP) 202 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( converts ) 84 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 202 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +17400 27960 M (and ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +( to floating-point numbers.) S +900 /Courier-Acnt F +15000 25972 M (\() S +900 /Courier-Bold-Acnt F +(FMIN) S +1000 /NewCenturySchlbk-Roman-Acnt F +17700 25972 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +18518 25772 M (1) S +1000 /NewCenturySchlbk-Italic-Acnt F +18878 25972 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +19696 25772 M (2) S +1000 /NewCenturySchlbk-Italic-Acnt F +20056 25972 M ( ) S +900 /Courier-Acnt F +(...) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +22772 25772 M (N) S +900 /Courier-Acnt F +23132 25972 M (\)) S +900 /Palatino-Roman-Acnt F +( ) S +44999 25972 M ([NoSpread Function]) S +17400 24217 M (Returns the minimum of ) 132 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 317 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +28513 24017 M (1) 211 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +28873 24217 M (, ) 132 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 317 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +29995 24017 M (2) 211 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +30355 24217 M (, ) 132 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(...,) 317 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( ) 132 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 317 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +33994 24017 M (N) 211 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +34354 24217 M (. ) 132 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\(FMIN\)) 317 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( returns the largest possible floating-) 132 0 32 4 -1 roll widthshow +17400 22962 M (point number, the value of ) S +900 /Courier-Acnt F +(MAX.FLOAT) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +15000 20974 M (\() S +900 /Courier-Bold-Acnt F +(FMAX) S +1000 /NewCenturySchlbk-Roman-Acnt F +17700 20974 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +18518 20774 M (1) S +1000 /NewCenturySchlbk-Italic-Acnt F +18878 20974 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +19696 20774 M (2) S +1000 /NewCenturySchlbk-Italic-Acnt F +20056 20974 M ( ) S +900 /Courier-Acnt F +(...) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +600 /Courier-Oblique-Acnt F +22772 20774 M (N) S +900 /Courier-Acnt F +23132 20974 M (\)) S +900 /Palatino-Roman-Acnt F +( ) S +44999 20974 M ([NoSpread Function]) S +17400 19219 M (Returns the maximum of ) 77 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 186 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +28421 19019 M (1) 124 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +28781 19219 M (, ) 77 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 186 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +29848 19019 M (2) 124 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +30208 19219 M (, ) 77 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(...,) 186 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( ) 77 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 186 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +33737 19019 M (N) 124 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +34097 19219 M (. ) 77 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\(FMAX\)) 186 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( returns the smallest possible floating-) 77 0 32 4 -1 roll widthshow +17400 17964 M (point number, the value of ) S +900 /Courier-Acnt F +(MIN.FLOAT) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +15000 15976 M (\() S +900 /Courier-Bold-Acnt F +(FLOAT) S +1000 /NewCenturySchlbk-Roman-Acnt F +18240 15976 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 15976 M ([Function]) S +17400 14316 M (Converts ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( to a floating-point number. Example:) S +900 /Courier-Acnt F +21000 12816 M (\(FLOAT 0\) => 0.0) S +/Helvetica-Bold /Helvetica-Bold-Acnt encodefont +1000 /Helvetica-Bold-Acnt F +10200 10722 M (Transcendental Arithmetic Functions) S +55801 10451 10201 10451 100 L +900 /Courier-Acnt F +15000 8928 M (\() S +900 /Courier-Bold-Acnt F +(EXPT) S +1000 /NewCenturySchlbk-Roman-Acnt F +17700 8928 M ( ) S +900 /Courier-Oblique-Acnt F +(A) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 8928 M ([Function]) S +17400 7223 M (Returns ) 37 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(A) 88 0 32 4 -1 roll widthshow +600 /Courier-Oblique-Acnt F +21332 7523 M (N) 58 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +21692 7223 M (. If ) 37 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(A) 88 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is an integer and ) 37 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 88 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is a positive integer, returns an integer, e.g, ) 37 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\(EXPT 3) 88 0 32 4 -1 roll widthshow +17400 6063 M (4\) => 81) 155 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, otherwise returns a floating-point number. If ) 64 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(A) 155 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is negative and ) 64 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 155 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( fractional,) 64 0 32 4 -1 roll widthshow +grestore savepage restore showpage + +%%Page: 11 11 +%%BeginPageSetup +/savepage save def +0.01 imagesizefactor mul dup scale +%%EndPageSetup +gsave + 0 rotate + 79200 61200 0 0 CLP +/Times-Roman /Times-Roman-Acnt encodefont +900 /Times-Roman-Acnt F +49350 2400 M (7-11) S +/Helvetica /Helvetica-Acnt encodefont +1000 /Helvetica-Acnt F +30508 61200 M (NUMBERS AND ARITHMETIC FUNCTIONS) S +/Palatino-Roman /Palatino-Roman-Acnt encodefont +900 /Palatino-Roman-Acnt F +12600 56954 M (generates the error, ) 58 0 32 4 -1 roll widthshow +/Courier /Courier-Acnt encodefont +900 /Courier-Acnt F +(Illegal exponentiation) 140 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. If ) 58 0 32 4 -1 roll widthshow +/Courier-Oblique /Courier-Oblique-Acnt encodefont +900 /Courier-Oblique-Acnt F +(N) 140 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is floating and either too large or) 58 0 32 4 -1 roll widthshow +12600 55794 M (too small, generates the error, ) S +900 /Courier-Acnt F +(Value out of range expt) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +10200 53806 M (\() S +/Courier-Bold /Courier-Bold-Acnt encodefont +900 /Courier-Bold-Acnt F +(SQRT) S +/NewCenturySchlbk-Roman /NewCenturySchlbk-Roman-Acnt encodefont +1000 /NewCenturySchlbk-Roman-Acnt F +12900 53806 M ( ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +44463 53806 M ([Function]) S +12600 52146 M (Returns the square root of ) 29 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 69 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( as a floating-point number. ) 29 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(N) 69 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( may be fixed or floating-point.) 29 0 32 4 -1 roll widthshow +12600 50986 M (Generates an error if ) S +900 /Courier-Oblique-Acnt F +(N) S +900 /Palatino-Roman-Acnt F +( is negative.) S +900 /Courier-Acnt F +10200 48998 M (\() S +900 /Courier-Bold-Acnt F +(LOG) S +1000 /NewCenturySchlbk-Roman-Acnt F +12360 48998 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +44463 48998 M ([Function]) S +12600 47338 M (Returns the natural logarithm of ) 231 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 555 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( as a floating-point number. ) 231 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 555 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( can be integer or) 231 0 32 4 -1 roll widthshow +12600 46178 M (floating-point.) S +900 /Courier-Acnt F +10200 44250 M (\() S +900 /Courier-Bold-Acnt F +(ANTILOG) S +1000 /NewCenturySchlbk-Roman-Acnt F +14520 44250 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 44250 M ([Function]) S +12600 42590 M (Returns the floating-point number whose logarithm is ) 146 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 350 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. ) 146 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 350 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( can be integer or floating-) 146 0 32 4 -1 roll widthshow +12600 41430 M (point. Example:) S +900 /Courier-Acnt F +16200 39990 M (\(ANTILOG 1\) = e => 2.71828...) S +10200 38202 M (\() S +900 /Courier-Bold-Acnt F +(SIN) S +1000 /NewCenturySchlbk-Roman-Acnt F +12360 38202 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +/NewCenturySchlbk-Italic /NewCenturySchlbk-Italic-Acnt encodefont +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(RADIANSFLG) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 38202 M ([Function]) S +12600 36542 M (Returns the sine of ) 64 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 154 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( as a floating-point number. ) 64 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 154 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is in degrees unless ) 64 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(RADIANSFLG) 154 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +( =) 154 0 32 4 -1 roll widthshow +12600 35382 M (T) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +10200 33394 M (\() S +900 /Courier-Bold-Acnt F +(COS) S +1000 /NewCenturySchlbk-Roman-Acnt F +12360 33394 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(RADIANSFLG) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 33394 M ([Function]) S +12600 31734 M (Similar to ) S +900 /Courier-Acnt F +(SIN) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +10200 29746 M (\() S +900 /Courier-Bold-Acnt F +10740 29746 M (TAN) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(RADIANSFLG) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 29746 M ([Function]) S +12600 28086 M (Similar to ) S +900 /Courier-Acnt F +(SIN) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +10200 26098 M (\() S +900 /Courier-Bold-Acnt F +(ARCSIN) S +1000 /NewCenturySchlbk-Roman-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +14258 26098 M (X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(RADIANSFLG) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 26098 M ([Function]) S +12600 24438 M (The value of ) 47 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(ARCSIN) 113 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is a floating-point number, and is in degrees unless ) 47 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(RADIANSFLG) 113 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( ) 47 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(=) 113 0 32 4 -1 roll widthshow +12600 23278 M (T) 109 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. In other words, if ) 45 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\(ARCSIN ) 109 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X RADIANSFLG) 109 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\) = Z) 109 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( then ) 45 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\(SIN Z ) 109 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(RADIANSFLG) 109 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\) =) 109 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +12600 22062 M (X) 78 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. The range of the value of ) 32 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(ARCSIN) 78 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is -90 to +90 for degrees, ) 32 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(-) 78 0 32 4 -1 roll widthshow +/Symbol /Symbol-Acnt encodefont +900 /Symbol-Acnt F +(\160) 32 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(/2 to ) 32 0 32 4 -1 roll widthshow +900 /Symbol-Acnt F +(\160) 32 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(/2) 78 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( for radians. ) 32 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 78 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +12600 20902 M (must be a number between -1 and 1. ) S +900 /Courier-Acnt F +10200 18974 M (\() S +900 /Courier-Bold-Acnt F +(ARCCOS) S +1000 /NewCenturySchlbk-Roman-Acnt F +13980 18974 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(RADIANSFLG) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 18974 M ([Function]) S +12600 17314 M (Similar to ) S +900 /Courier-Acnt F +(ARCSIN) S +900 /Palatino-Roman-Acnt F +(. Range is ) S +900 /Courier-Acnt F +(0) S +900 /Palatino-Roman-Acnt F +( to ) S +900 /Courier-Acnt F +(180) S +900 /Palatino-Roman-Acnt F +(, 0 to ) S +900 /Symbol-Acnt F +(\160) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +10200 15326 M (\() S +900 /Courier-Bold-Acnt F +(ARCTAN) S +1000 /NewCenturySchlbk-Roman-Acnt F +13980 15326 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(RADIANSFLG) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 15326 M ([Function]) S +12600 13666 M (Similar to ) S +900 /Courier-Acnt F +(ARCSIN) S +900 /Palatino-Roman-Acnt F +(. Range is ) S +900 /Courier-Acnt F +(0) S +900 /Palatino-Roman-Acnt F +( to ) S +900 /Courier-Acnt F +(180) S +900 /Palatino-Roman-Acnt F +(, 0 to ) S +900 /Symbol-Acnt F +(\160) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +10200 11672 M (\() S +900 /Courier-Bold-Acnt F +(ARCTAN2) S +/Helvetica-Bold /Helvetica-Bold-Acnt encodefont +1000 /Helvetica-Bold-Acnt F +14520 11672 M ( ) S +900 /Courier-Oblique-Acnt F +(Y) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(X) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(RADIANSFLG) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +44463 11672 M ([Function]) S +12600 10012 M (Computes ) 184 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\(ARCTAN \(FQUOTIENT) 442 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( ) 184 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(Y) 442 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( ) 184 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 442 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\)) 442 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( ) 184 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(RADIANSFLG) 442 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(\)) 442 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, and returns a corresponding) 184 0 32 4 -1 roll widthshow +12600 8852 M (value in the range ) 89 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(-180) 214 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( to ) 89 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(180) 214 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( \(or ) 89 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(-) 214 0 32 4 -1 roll widthshow +900 /Symbol-Acnt F +(\160) 89 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +( ) 214 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(to ) 89 0 32 4 -1 roll widthshow +900 /Symbol-Acnt F +(\160) 89 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(\), i.e. the result is in the proper quadrant as) 89 0 32 4 -1 roll widthshow +12600 7692 M (determined by the signs of ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Palatino-Roman-Acnt F +( and ) S +900 /Courier-Oblique-Acnt F +(Y) S +900 /Palatino-Roman-Acnt F +(.) S +grestore savepage restore showpage + +%%Page: 12 12 +%%BeginPageSetup +/savepage save def +0.01 imagesizefactor mul dup scale +%%EndPageSetup +gsave + 0 rotate + 79200 61200 0 0 CLP +/Times-Roman /Times-Roman-Acnt encodefont +900 /Times-Roman-Acnt F +10200 2400 M (7-12) S +/Helvetica /Helvetica-Acnt encodefont +1000 /Helvetica-Acnt F +9600 61200 M (INTERLISP-D REFERENCE MANUAL) S +/Helvetica-Bold /Helvetica-Bold-Acnt encodefont +1000 /Helvetica-Bold-Acnt F +10200 56820 M (Generating Random Numbers) S +55801 56549 10201 56549 100 L +/Courier /Courier-Acnt encodefont +900 /Courier-Acnt F +15000 55026 M (\() S +/Courier-Bold /Courier-Bold-Acnt encodefont +900 /Courier-Bold-Acnt F +(RAND) S +/NewCenturySchlbk-Italic /NewCenturySchlbk-Italic-Acnt encodefont +1000 /NewCenturySchlbk-Italic-Acnt F +17700 55026 M ( ) S +/Courier-Oblique /Courier-Oblique-Acnt encodefont +900 /Courier-Oblique-Acnt F +(LOWER) S +1000 /NewCenturySchlbk-Italic-Acnt F +( ) S +900 /Courier-Oblique-Acnt F +(UPPER) S +900 /Courier-Acnt F +(\)) S +/Palatino-Roman /Palatino-Roman-Acnt encodefont +900 /Palatino-Roman-Acnt F +( ) S +49263 55026 M ([Function]) S +17400 53366 M (Returns a pseudo-random number between ) 21 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(LOWER) 51 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( and ) 21 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(UPPER) 51 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( inclusive, i.e., ) 21 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(RAND) 51 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( can be) 21 0 32 4 -1 roll widthshow +17400 52206 M (used to generate a sequence of random numbers. If both limits are integers, the value of) 59 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +17400 51106 M (RAND) 193 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is an integer, otherwise it is a floating-point number. The algorithm is completely) 80 0 32 4 -1 roll widthshow +17400 49946 M (deterministic, i.e., given the same initial state, ) 246 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(RAND) 590 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( produces the same sequence of) 246 0 32 4 -1 roll widthshow +17400 48786 M (values. The internal state of ) S +900 /Courier-Acnt F +(RAND) S +900 /Palatino-Roman-Acnt F +( is initialized using the function ) S +900 /Courier-Acnt F +(RANDSET) S +900 /Palatino-Roman-Acnt F +(.) S +900 /Courier-Acnt F +15000 46798 M (\() S +900 /Courier-Bold-Acnt F +(RANDSET) S +/NewCenturySchlbk-Roman /NewCenturySchlbk-Roman-Acnt encodefont +1000 /NewCenturySchlbk-Roman-Acnt F +19320 46798 M ( ) S +900 /Courier-Oblique-Acnt F +(X) S +900 /Courier-Acnt F +(\)) S +900 /Palatino-Roman-Acnt F +( ) S +49263 46798 M ([Function]) S +17400 45138 M (Returns the internal state of ) 48 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(RAND) 114 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(. If ) 48 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 114 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +( = NIL) 114 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, just returns the current state. If ) 48 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 114 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +( = T) 114 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(,) 48 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +17400 43978 M (RAND) 149 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is initialized using the clocks, and ) 62 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(RANDSET) 149 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( returns the new state. Otherwise, ) 62 0 32 4 -1 roll widthshow +900 /Courier-Oblique-Acnt F +(X) 149 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +( is) 62 0 32 4 -1 roll widthshow +17400 42818 M (interpreted as a previous internal state, i.e., a value of ) 1 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(RANDSET) 2 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(, and is used to reset ) 1 0 32 4 -1 roll widthshow +900 /Courier-Acnt F +(RAND) 2 0 32 4 -1 roll widthshow +900 /Palatino-Roman-Acnt F +(.) 1 0 32 4 -1 roll widthshow +17400 41658 M (For example,) S +/Symbol /Symbol-Acnt encodefont +900 /Symbol-Acnt F +21000 40218 M (\254) S +900 /Courier-Acnt F +(\(SETQ OLDSTATE \(RANDSET\)\)) S +21600 39318 M (...) S +900 /Symbol-Acnt F +21000 38218 M (\254) S +900 /Courier-Acnt F +(\(for X from 1 to 10 do \(PRIN1 \(RAND 1 10\)\)\)) S +21600 37318 M (2847592748NIL) S +900 /Symbol-Acnt F +21000 36218 M (\254) S +900 /Courier-Acnt F +(\(RANDSET OLDSTATE\)) S +21600 35318 M (...) S +900 /Symbol-Acnt F +21000 34218 M (\254) S +900 /Courier-Acnt F +(\(for X from 1 to 10 do \(PRIN1 \(RAND 1 10\)\)\)) S +21600 33318 M (2847592748NIL) S +grestore savepage restore showpage + +%%Page: 13 13 +%%BeginPageSetup +/savepage save def +0.01 imagesizefactor mul dup scale +%%EndPageSetup +gsave + 0 rotate + 79200 61200 0 0 CLP +/Times-Roman /Times-Roman-Acnt encodefont +900 /Times-Roman-Acnt F +49350 2400 M (7-13) S +grestore savepage restore showpage + +%%Page: 14 14 +%%BeginPageSetup +/savepage save def +0.01 imagesizefactor mul dup scale +%%EndPageSetup +gsave + 0 rotate + 79200 61200 0 0 CLP +/Times-Roman /Times-Roman-Acnt encodefont +900 /Times-Roman-Acnt F +10200 2400 M (7-14) S +/Helvetica /Helvetica-Acnt encodefont +1000 /Helvetica-Acnt F +9600 61200 M (INTERLISP-D REFERENCE MANUAL) S +/Palatino-Roman /Palatino-Roman-Acnt encodefont +900 /Palatino-Roman-Acnt F +22800 49655 M ([This page intentionally left blank]) S +grestore savepage restore showpage + +%%Trailer diff --git a/docs/medley-irm/07-NUMBERS.PDF b/docs/medley-irm/07-NUMBERS.PDF new file mode 100644 index 00000000..d1d55e12 Binary files /dev/null and b/docs/medley-irm/07-NUMBERS.PDF differ diff --git a/docs/medley-irm/08-RECORDPACKAGE.PDF b/docs/medley-irm/08-RECORDPACKAGE.PDF new file mode 100644 index 00000000..9090336c Binary files /dev/null and b/docs/medley-irm/08-RECORDPACKAGE.PDF differ diff --git a/docs/medley-irm/09-CONDITIONALS.PDF b/docs/medley-irm/09-CONDITIONALS.PDF new file mode 100644 index 00000000..d9bc9196 Binary files /dev/null and b/docs/medley-irm/09-CONDITIONALS.PDF differ diff --git a/docs/medley-irm/10-FUNC-DEF.PDF b/docs/medley-irm/10-FUNC-DEF.PDF new file mode 100644 index 00000000..7d530f0f Binary files /dev/null and b/docs/medley-irm/10-FUNC-DEF.PDF differ diff --git a/docs/medley-irm/11-VAR-BINDINGS.PDF b/docs/medley-irm/11-VAR-BINDINGS.PDF new file mode 100644 index 00000000..dc0b9c79 Binary files /dev/null and b/docs/medley-irm/11-VAR-BINDINGS.PDF differ diff --git a/docs/medley-irm/12-MISC.PDF b/docs/medley-irm/12-MISC.PDF new file mode 100644 index 00000000..2c94b928 Binary files /dev/null and b/docs/medley-irm/12-MISC.PDF differ diff --git a/docs/medley-irm/13-EXECUTIVE.PDF b/docs/medley-irm/13-EXECUTIVE.PDF new file mode 100644 index 00000000..943e43c6 Binary files /dev/null and b/docs/medley-irm/13-EXECUTIVE.PDF differ diff --git a/docs/medley-irm/14-ERRORS.PDF b/docs/medley-irm/14-ERRORS.PDF new file mode 100644 index 00000000..d265eef9 Binary files /dev/null and b/docs/medley-irm/14-ERRORS.PDF differ diff --git a/docs/medley-irm/15-BREAKING.PDF b/docs/medley-irm/15-BREAKING.PDF new file mode 100644 index 00000000..9fe9135d Binary files /dev/null and b/docs/medley-irm/15-BREAKING.PDF differ diff --git a/docs/medley-irm/16-SEDIT.PDF b/docs/medley-irm/16-SEDIT.PDF new file mode 100644 index 00000000..01bc27ce Binary files /dev/null and b/docs/medley-irm/16-SEDIT.PDF differ diff --git a/docs/medley-irm/17-FILEPACKAGE.PDF b/docs/medley-irm/17-FILEPACKAGE.PDF new file mode 100644 index 00000000..2c239517 Binary files /dev/null and b/docs/medley-irm/17-FILEPACKAGE.PDF differ diff --git a/docs/medley-irm/18-COMPILER.PDF b/docs/medley-irm/18-COMPILER.PDF new file mode 100644 index 00000000..be4c056d Binary files /dev/null and b/docs/medley-irm/18-COMPILER.PDF differ diff --git a/docs/medley-irm/19-DWIM.PDF b/docs/medley-irm/19-DWIM.PDF new file mode 100644 index 00000000..d05140ca Binary files /dev/null and b/docs/medley-irm/19-DWIM.PDF differ diff --git a/docs/medley-irm/20-CLISP.PDF b/docs/medley-irm/20-CLISP.PDF new file mode 100644 index 00000000..119531bc Binary files /dev/null and b/docs/medley-irm/20-CLISP.PDF differ diff --git a/docs/medley-irm/21-PERFORMANCE.PDF b/docs/medley-irm/21-PERFORMANCE.PDF new file mode 100644 index 00000000..4a8f6559 Binary files /dev/null and b/docs/medley-irm/21-PERFORMANCE.PDF differ diff --git a/docs/medley-irm/22-PROCESSES.PDF b/docs/medley-irm/22-PROCESSES.PDF new file mode 100644 index 00000000..a6d1e50a Binary files /dev/null and b/docs/medley-irm/22-PROCESSES.PDF differ diff --git a/docs/medley-irm/23-STREAMS.PDF b/docs/medley-irm/23-STREAMS.PDF new file mode 100644 index 00000000..3bf9483e Binary files /dev/null and b/docs/medley-irm/23-STREAMS.PDF differ diff --git a/docs/medley-irm/24-IO.PDF b/docs/medley-irm/24-IO.PDF new file mode 100644 index 00000000..9049785a Binary files /dev/null and b/docs/medley-irm/24-IO.PDF differ diff --git a/docs/medley-irm/25-USERIO-PACKAGES.PDF b/docs/medley-irm/25-USERIO-PACKAGES.PDF new file mode 100644 index 00000000..3c522bc4 Binary files /dev/null and b/docs/medley-irm/25-USERIO-PACKAGES.PDF differ diff --git a/docs/medley-irm/26-GRAPHICS.PDF b/docs/medley-irm/26-GRAPHICS.PDF new file mode 100644 index 00000000..d89f2ee4 Binary files /dev/null and b/docs/medley-irm/26-GRAPHICS.PDF differ diff --git a/docs/medley-irm/27-WINDOWS.PDF b/docs/medley-irm/27-WINDOWS.PDF new file mode 100644 index 00000000..f336f1fb Binary files /dev/null and b/docs/medley-irm/27-WINDOWS.PDF differ diff --git a/docs/medley-irm/28-HARDCOPY.PDF b/docs/medley-irm/28-HARDCOPY.PDF new file mode 100644 index 00000000..cf373ba5 Binary files /dev/null and b/docs/medley-irm/28-HARDCOPY.PDF differ diff --git a/docs/medley-irm/29-TERMINAL.PDF b/docs/medley-irm/29-TERMINAL.PDF new file mode 100644 index 00000000..c32ced60 Binary files /dev/null and b/docs/medley-irm/29-TERMINAL.PDF differ diff --git a/docs/medley-irm/TOP-AND-BOTTOM.PDF b/docs/medley-irm/TOP-AND-BOTTOM.PDF new file mode 100644 index 00000000..b52c776b Binary files /dev/null and b/docs/medley-irm/TOP-AND-BOTTOM.PDF differ diff --git a/docs/medley-irm/TOP-AND-BOTTOM.TEDIT b/docs/medley-irm/TOP-AND-BOTTOM.TEDIT new file mode 100644 index 00000000..c607f36f Binary files /dev/null and b/docs/medley-irm/TOP-AND-BOTTOM.TEDIT differ diff --git a/docs/primer/001-TITLEPAGE.TEDIT b/docs/primer/001-TITLEPAGE.TEDIT deleted file mode 100644 index f8ca0e89..00000000 Binary files a/docs/primer/001-TITLEPAGE.TEDIT and /dev/null differ diff --git a/docs/primer/002-PREFACE.TEDIT b/docs/primer/002-PREFACE.TEDIT deleted file mode 100644 index 54932787..00000000 Binary files a/docs/primer/002-PREFACE.TEDIT and /dev/null differ diff --git a/docs/primer/003-TOC.TEDIT b/docs/primer/003-TOC.TEDIT deleted file mode 100644 index 64166d16..00000000 Binary files a/docs/primer/003-TOC.TEDIT and /dev/null differ diff --git a/docs/primer/01-GLOSSARY.TEDIT b/docs/primer/01-GLOSSARY.TEDIT deleted file mode 100644 index 37aab11a..00000000 Binary files a/docs/primer/01-GLOSSARY.TEDIT and /dev/null differ diff --git a/docs/primer/02-TYPING-SHORTCUTS.TEDIT b/docs/primer/02-TYPING-SHORTCUTS.TEDIT deleted file mode 100644 index df0dab88..00000000 Binary files a/docs/primer/02-TYPING-SHORTCUTS.TEDIT and /dev/null differ diff --git a/docs/primer/03-USING-MENUS.TEDIT b/docs/primer/03-USING-MENUS.TEDIT deleted file mode 100644 index bad688f8..00000000 Binary files a/docs/primer/03-USING-MENUS.TEDIT and /dev/null differ diff --git a/docs/primer/04-USING-FILES.TEDIT b/docs/primer/04-USING-FILES.TEDIT deleted file mode 100644 index 2ba249bf..00000000 Binary files a/docs/primer/04-USING-FILES.TEDIT and /dev/null differ diff --git a/docs/primer/05-FILEBROWSER.TEDIT b/docs/primer/05-FILEBROWSER.TEDIT deleted file mode 100644 index 2edd9864..00000000 Binary files a/docs/primer/05-FILEBROWSER.TEDIT and /dev/null differ diff --git a/docs/primer/06-WINDOWS.TEDIT b/docs/primer/06-WINDOWS.TEDIT deleted file mode 100644 index 523d9bf1..00000000 Binary files a/docs/primer/06-WINDOWS.TEDIT and /dev/null differ diff --git a/docs/primer/07-EDITING-AND-SAVING.TEDIT b/docs/primer/07-EDITING-AND-SAVING.TEDIT deleted file mode 100644 index e5ed9005..00000000 Binary files a/docs/primer/07-EDITING-AND-SAVING.TEDIT and /dev/null differ diff --git a/docs/primer/08-YOUR-INIT.TEDIT b/docs/primer/08-YOUR-INIT.TEDIT deleted file mode 100644 index 4b67ddc3..00000000 Binary files a/docs/primer/08-YOUR-INIT.TEDIT and /dev/null differ diff --git a/docs/primer/09-FLEXIBILITY.TEDIT b/docs/primer/09-FLEXIBILITY.TEDIT deleted file mode 100644 index 58c54baf..00000000 Binary files a/docs/primer/09-FLEXIBILITY.TEDIT and /dev/null differ diff --git a/docs/primer/10-BREAK-MENU.TEDIT b/docs/primer/10-BREAK-MENU.TEDIT deleted file mode 100644 index 615c2dc7..00000000 Binary files a/docs/primer/10-BREAK-MENU.TEDIT and /dev/null differ diff --git a/docs/primer/11-WHAT-TO-DO.TEDIT b/docs/primer/11-WHAT-TO-DO.TEDIT deleted file mode 100644 index dffdcad6..00000000 Binary files a/docs/primer/11-WHAT-TO-DO.TEDIT and /dev/null differ diff --git a/docs/primer/12-WINDOWS.TEDIT b/docs/primer/12-WINDOWS.TEDIT deleted file mode 100644 index 9c8de454..00000000 Binary files a/docs/primer/12-WINDOWS.TEDIT and /dev/null differ diff --git a/docs/primer/13-WHAT-ARE-MENUS.TEDIT b/docs/primer/13-WHAT-ARE-MENUS.TEDIT deleted file mode 100644 index b3d177bc..00000000 Binary files a/docs/primer/13-WHAT-ARE-MENUS.TEDIT and /dev/null differ diff --git a/docs/primer/14-BITMAPS.TEDIT b/docs/primer/14-BITMAPS.TEDIT deleted file mode 100644 index 54c9ba3c..00000000 Binary files a/docs/primer/14-BITMAPS.TEDIT and /dev/null differ diff --git a/docs/primer/15-DISPLAYSTREAMS.TEDIT b/docs/primer/15-DISPLAYSTREAMS.TEDIT deleted file mode 100644 index 7dcc9a4c..00000000 Binary files a/docs/primer/15-DISPLAYSTREAMS.TEDIT and /dev/null differ diff --git a/docs/primer/16-FONTS.TEDIT b/docs/primer/16-FONTS.TEDIT deleted file mode 100644 index 17b5e8ca..00000000 Binary files a/docs/primer/16-FONTS.TEDIT and /dev/null differ diff --git a/docs/primer/17-INSPECTOR.TEDIT b/docs/primer/17-INSPECTOR.TEDIT deleted file mode 100644 index 3dcbf68a..00000000 Binary files a/docs/primer/17-INSPECTOR.TEDIT and /dev/null differ diff --git a/docs/primer/18-MASTERSCOPE.TEDIT b/docs/primer/18-MASTERSCOPE.TEDIT deleted file mode 100644 index 8feeb509..00000000 Binary files a/docs/primer/18-MASTERSCOPE.TEDIT and /dev/null differ diff --git a/docs/primer/19-SPY.TEDIT b/docs/primer/19-SPY.TEDIT deleted file mode 100644 index 70033bb5..00000000 Binary files a/docs/primer/19-SPY.TEDIT and /dev/null differ diff --git a/docs/primer/20-FREE-MENUS.TEDIT b/docs/primer/20-FREE-MENUS.TEDIT deleted file mode 100644 index 8f98a42d..00000000 --- a/docs/primer/20-FREE-MENUS.TEDIT +++ /dev/null @@ -1,48 +0,0 @@ -1 Medley for the Novice, Release 2.0 1 Medley for the Novice, Release 2.0 20. FREE MENUS 1 20. FREE MENUS 1 "20"20. FREE MENUS 6 Free Menu(FREE% MENU NIL Free% Menu NIL NIL 1) is a library package that is even more flexible than the regular menu package. It allows you to create menus with different types of items in them, and formats them as you require. Free menus are particularly useful when you want a "fill in the form" type interaction with the user. Each menu item is described with a list of properties and values. The following example will give you an idea of the structure of the description list, and some of your options. The most commonly used properties, and each type of menu item will be described in the Parts of a Free Menu Item and Types of Free Menu Items section below. Free Menu Example 1 Free menus can be created(FREE% MENU NIL Free% Menu NIL NIL 1 SUBNAME CREATING SUBTEXT creating) and formatted(FREE% MENU NIL Free% Menu NIL NIL 1 SUBNAME FORMATTING SUBTEXT formatting) automatically! It is done with the function FM.FORMATMENU(FM.FORMATMENU (Function) NIL NIL NIL 1). This function takes one argument, a description of the menu. The description is a list of lists; each internal list describes one row of the free menu. A free menu row can have more than one item in it, so there are really lists of lists of lists! It really isn't hard, though, as you can see from the following example: (SETQ ExampleMenu (FM.FORMATMENU '(((TYPE TITLE LABEL TitlesDoNothing) TYPE 3STATE LABEL Example3State)) ((TYPE EDITSTART LABEL PressToStartEditing ITEMS (EDITEM)) (TYPE EDIT ID EDITEM LABEL "")) (WINDOWPROPS TITLE "Example Does Nothing")))) The first row has two items in it: one is a TITLE, and the second is a 3STATE item. The second row also has two items. The second, the EDIT item, is invisible, because its label is an empty string. The caret will appear for editing, however, if the EDITSTART item is chosen. Windowprops can appear as part of the description of the menu, because a menu is, affer all, just a special window. You can specify not only the title with WINDOWPROPS, but also the position of the free menu, using the "left" and "bottom" properties, and the width of the border in pixels, with the "border" property. Evaluating this expression will return a window. You can see the menu by using the function OPENW(OPENW (Function) NIL NIL NIL 1). The following example illustrates this: Figure 20.1. Example Free Menu The next example shows you what the menu looks like after the EDITSTART item, PressToStartEditing, has been chosen. Figure 20.2. Free menu after EDITSTART Item Chosen The following example shows the menu with the 3STATE item in its T state, with the item highlighted. (In the previous bitmaps, it was in its neutral state.) . Figure 20.3. Free menu with 3STATE Item in its T State Finally, Figure 20.4 shows the 3STATE item in its NIL state, with a diagonal line through the item Figure 20.4 Free menu with the 3STATE item in its NIL State If you would like to specify the layout yourself, you can do that too. See the Lisp Library Packages Manual for more information. Parts of a Free Menu Item 1 There are eight different types of items that you can use in a free menu(FREE% MENU NIL Free% Menu NIL NIL 2 SUBNAME PROPERTIES SUBTEXT properties). No matter what type, the menu item is easily described by a list of properties, and values. Some of the properties you will use most often are listed below: LABEL (FREE% MENU NIL Free% Menu NIL NIL 2 SUBNAME PROPERTIES SUBTEXT properties SUBSUBNAME LABEL SUBSUBTEXT LABEL) Required for every type of menu item. It is the atom, string, or bitmap that appears as a menu selection. TYPE(FREE% MENU NIL Free% Menu NIL NIL 2 SUBNAME PROPERTIES SUBTEXT properties SUBSUBNAME TYPE SUBSUBTEXT TYPE) One of eight types of menu items. Each of these are described in the section below. MESSAGE(FREE% MENU NIL Free% Menu NIL NIL 2 SUBNAME PROPERTIES SUBTEXT properties SUBSUBNAME MESSAGE SUBSUBTEXT MESSAGE) The message that appears in the prompt window if a mouse button is held down over the item. ID(FREE% MENU NIL Free% Menu NIL NIL 2 SUBNAME PROPERTIES SUBTEXT properties SUBSUBNAME ID SUBSUBTEXT ID) An item's unique identifier. An ID is needed for certain types of menu items. ITEMS(FREE% MENU NIL Free% Menu NIL NIL 2 SUBNAME PROPERTIES SUBTEXT properties SUBSUBNAME ITEMS SUBSUBTEXT ITEMS) Used to list a series of choices for an NCHOOSE item, and to list the ID's of the editable items for an EDITSTART item. SELECTEDFN(FREE% MENU NIL Free% Menu NIL NIL 2 SUBNAME PROPERTIES SUBTEXT properties SUBSUBNAME SELECTEDFN) The name of the function to be called if the item is chosen. Types of Free Menu(FREE% MENU NIL Free% Menu NIL NIL 2 SUBNAME TYPES SUBTEXT types) Items 1 Each type of menu item is described in the following list, including an example description list for each one. MOMENTARY(FREE% MENU NIL Free% Menu NIL NIL 2 SUBNAME TYPES SUBTEXT types SUBSUBNAME MOMENTARY SUBSUBTEXT MOMENTARY) This is the familiar sort of menu item. When it is selected, the function stored with it is called. A description for the function that creates and formats the menu looks like this: (TYPE MOMENTARY LABEL Blink-N-Ring MESSAGE "Blinks the screen and rings bells" SELECTEDFN RINGBELLS) TOGGLE(FREE% MENU NIL Free% Menu NIL NIL 2 SUBNAME TYPES SUBTEXT types SUBSUBNAME TOGGLE SUBSUBTEXT TOGGLE) This menu item has two states, T and NIL. The default state is NIL, but choosing the item toggles its state. The following is an example description list, without code for the SELECTEDFN function, for this type of item: (TYPE TOGGLE LABEL DwimDisable SELECTEDFN ChangeDwimState) 3STATE(FREE% MENU NIL Free% Menu NIL NIL 3 SUBNAME TYPES SUBTEXT types SUBSUBNAME 3STATE SUBSUBTEXT 3STATE) This type of menu item has three states, NEUTRAL, T, and NIL. NEUTRAL is the default state. T is shown by highlighting the item, and NIL is shown with diagonal lines. The following is an example description list, without code for the SELECTEDFN function, for this type of item: (TYPE 3STATE LABEL CorrectProgramAllOrNoSpelling SELECTEDFN ToggleSpellingCorrection) TITLE(FREE% MENU NIL Free% Menu NIL NIL 3 SUBNAME TYPES SUBTEXT types SUBSUBNAME TITLE SUBSUBTEXT TITLE) This menu item appears on the menu as dummy text. It does nothing when chosen. An example of its description: (TYPE TITLE LABEL "Choices:") NWAY(FREE% MENU NIL Free% Menu NIL NIL 3 SUBNAME TYPES SUBTEXT types SUBSUBNAME NWAY SUBSUBTEXT NWAY) A group of items, nnly one of which can be chosen at a time. The items in the NWAY group should all have an ID field, and the ID's should be the same. For example, to set up a menu that would allow the user to choose between Helvetica, Gacha, Modern, and Classic fonts, the descriptions might look like this (once again, without the code for the SELECTEDFN): (TYPE NWAY ID FONTCHOICE LABEL Helvetica SELECTEDFN ChangeFont) (TYPE NWAY ID FONTCHOICE LABEL Gacha SELECTEDFN ChangeFont) (TYPE NWAY ID FONTCHOICE) LABEL Modern SELECTEDFN ChangeFont) (TYPE NWAY ID FONTCHOICE LABEL Classic SELECTEDFN Changefont) NCHOOSE(FREE% MENU NIL Free% Menu NIL NIL 3 SUBNAME TYPES SUBTEXT types SUBSUBNAME NCHOOSE SUBSUBTEXT NCHOOSE) This type of menu item is like NWAY except that the choices are given to the user in a submenu. The list to specify an NCHOOSE menu item that is analogous to the NWAY item above might look like this: (TYPE NCHOOSE LABEL FontChoices ITEMS Helvetica Gacha Modern Classic) SELECTDFN Changefont) EDITSTART (FREE% MENU NIL Free% Menu NIL NIL 3 SUBNAME TYPES SUBTEXT types SUBSUBNAME EDITSTART SUBSUBTEXT EDITSTART) When this type of menu itein is chosen, it activates another type of item, an EDIT item. The EDIT item or items associated with an EDITSTART item have their lD's listed on the EDITSTART's ITEMS property. An example description list is: (TYPE EDITSTART LABEL "Function to add?" ITEMS (Fn)) EDIT(FREE% MENU NIL Free% Menu NIL NIL 3 SUBNAME TYPES SUBTEXT types SUBSUBNAME EDIT SUBSUBTEXT EDIT) This type of menu item can actually be edited by you. It is often associated with an EDITSTART item (see above), but the caret that prompts for input will also appear if the item itself is chosen. An EDIT item follows the same editing conventions as editing in Executive Window: Add characters by typing them at the caret. Move the caret by pointing the mouse at the new position, and clicking the left button. Delete characters from the caret to the mouse by pressing the right button of the mouse. Delete a character behind the caret by pressing the backspace key. Stop editing by typing a carriage return, a Control-X, or by choosing another item from the menu. An example description list for this type of item is: (TYPE EDIT ID Fn LABEL **) (LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "20-" "") STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "20-" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (TEXT NIL NIL (54 54 504 690) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "20-" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "20-" "")) (54 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "20-" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "20-" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE RECTOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 690) NIL)))))8ll��8ll��5��5��2��2HH��2HH� -�2HH��2HH��2H��,HH� --�T-�T2��5��F��PAGEHEADING VERSOHEADF��PAGEHEADING RECTOHEADE��PAGEHEADINGFOOTINGVE��PAGEHEADINGFOOTINGR,CLASSIC -CLASSIC -TITAN -CLASSIC HELVETICAMODERN HELVETICACLASSIC - HELVETICA -MODERN - -TIMESROMAN -HRULE.GETFNMODERN - -" HRULE.GETFNCLASSIC -# HRULE.GETFNCLASSIC - HRULE.GETFNCLASSIC - IM.CHAP.GETFN HELVETICAHRULE.GETFNMODERN %IM.INDEX.GETFNN HRULE.GETFNCLASSICGIM.INDEX.GETFNKIM.INDEX.GETFN- (IM.INDEX.GETFND((/"%/,:n �� IM.INDEX.GETFN+> . [ . O HRULE.GETFNCLASSICHKIM.INDEX.GETFN� -mIM.INDEX.GETFNCLASSIC -k -kIM.INDEX.GETFNCLASSIC -U -qIM.INDEX.GETFNCLASSIC -\ -gIM.INDEX.GETFNCLASSIC -O -mIM.INDEX.GETFNCLASSIC -(9 - -aIM.INDEX.GETFNCLASSIC -> AIM.INDEX.GETFNHRULE.GETFNCLASSICo - kIM.INDEX.GETFN HELVETICA�- -eIM.INDEX.GETFN HELVETICA n -" -eIM.INDEX.GETFN HELVETICA)(b -" %& -cIM.INDEX.GETFN HELVETICAn - -aIM.INDEX.GETFN HELVETICAO - -gIM.INDEX.GETFN HELVETICAT$"' - kIM.INDEX.GETFN HELVETICAO" $ + -6 -aIM.INDEX.GETFN HELVETICAW jL - -J -� -V -7 -"�uz� \ No newline at end of file diff --git a/docs/primer/21-GRAPHER.TEDIT b/docs/primer/21-GRAPHER.TEDIT deleted file mode 100644 index 9520bb1b..00000000 Binary files a/docs/primer/21-GRAPHER.TEDIT and /dev/null differ diff --git a/docs/primer/22-RESOURCE-MANAGEMENT.TEDIT b/docs/primer/22-RESOURCE-MANAGEMENT.TEDIT deleted file mode 100644 index 1395787b..00000000 Binary files a/docs/primer/22-RESOURCE-MANAGEMENT.TEDIT and /dev/null differ diff --git a/docs/primer/23-INTERACTIONS.TEDIT b/docs/primer/23-INTERACTIONS.TEDIT deleted file mode 100644 index 01cd5992..00000000 --- a/docs/primer/23-INTERACTIONS.TEDIT +++ /dev/null @@ -1,28 +0,0 @@ -1 Medley for the Novice, Release 2.0 1 Medley for the Novice, Release 2.0 23. SIMPLE INTERACTIONS WITH CURSOR, BITMAP, AND WINDOW 1 23. SIMPLE INTERACTIONS WITH CURSOR, BITMAP, AND WINDOW 1 "23"23. SIMPLE INTERACTIONS WITH THE CURSOR, A BITMAP, AND A WINDOW 6 The purpose of this chapter is to show you how to build a moderately tricky interactive interface(INTERFACE NIL Interface NIL NIL NIL SUBNAME BUILDING SUBTEXT building) with the various Medley display facilities. In particular how to move a large bitmap (larger than 16 x 16 pixels) around inside a window. To do this, you will change the CURSORINFN and CURSOROUTFN properties of the window. If you would also like to then set the bitmap in place in the window, you must reset the BUTTONEVENTFN. This chapter explains how to create the mobile bitmap. GETMOUSESTATE Example Function 1 One function that you will use to "trace the cursor" (have a bitmap follow the cursor around in a window) is GETMOUSESTATE(GETMOUSESTATE (Function) NIL NIL NIL NIL). This function finds the current state of the. mouse, and resets global system variables, such as LASTMOUSEX(LASTMOUSEX (Variable) NIL NIL NIL NIL) and LASTMOUSEY(LASTMOUSEY (Variable) NIL NIL NIL NIL). As an example of how this function works, create a window by typing (SETQ EXAMPLE.WINDOW (CREATEW)) into the Executive Window, and sweeping out a window. Now, type in the function (DEFINEQ (PRINTCOORDS (W) (PROMPTPRINT "(" LASTMOUSEX ", "LASTMOUSEY ")") (BLOCK) (GETMOUSESTATE))) This function calls GETMOUSESTATE and then prints the new values of LASTMOUSEX and LASTMOUSEY in the promptwindow. To use it, type (WINDOWPROP EXAMPLE.WINDOW 'CURSORMOVEDFN 'PRINTCOORDS) The window property CURSORMOVEDFN(CURSORMOVEDFN (Property) NIL NIL NIL NIL), used in this example, will evaluate the function PRINTCOORDS(PRINTCOORDS (Function) NIL NIL NIL NIL) each time the cursor is moved when it is inside the window. The position coordinates of the mouse cursor will appear in the prompt window. (See Figure 23.1.) Figure 23.1. Current Position Coordinates of Mouse Cursor in Prompt Window Advising GETMOUSESTATE 1 For the bitmap to follow the moving mouse cursor, the function GETMOUSESTATE is advised. When you advise a function, you can add new commands to the function without knowing how it is actually implemented. The syntax for advise is (ADVISE fn when where what) fn is the name of the function to be augmented. when and where are optional arguments. when specifies whether the change should be made before, after, or around the body of the function. The values expected are BEFORE, AFTER, or AROUND. what specifies the additional code. In the example, the additional code, what, moves the bitmap to the position of the mouse cursor. The function GETNOUSESTATE will be ADVISEd when the mouse moves into the window. This will cause the bitmap to follow the mouse cursor. ADVISE will be undone when the mouse leaves the window or when a mouse button is pushed. The ADVISEing will be done and undone by changing the CURSORINFN, CURSOROUTFN, and BUTTONEVENTFN for the window. Changing the Cursor 1 One last part of the example, to give the impression that a bitmap is dragged around a window, the original cursor(CURSOR NIL Cursor NIL NIL NIL SUBNAME CHANGING SUBTEXT changing) should disappear. Try typing: (CURSOR (CURSORCREATE (BITMAPCREATE 1 l) 1 1] into the Executive Window. This causes the original cursor to disappear. It reappears when you type (CURSOR T) When the cursor is invisible, and the bitmap moves as the cursor moves, the illusion is given that the bitmap is dragged around the window. Functions for Tracing the Cursor 1 To actually have a bitmap trace (follow) the cursor(CURSOR NIL Cursor NIL NIL NIL SUBNAME TRACING SUBTEXT tracing), the environment must be set up so that when the cursor enters the tracing region the trace is turned on, and when the cursor leaves the tracing region the trace is turned off. The function Establish/Trace/Data will do this. Type it in as it appears (include comments that will help you remember what the function does). (DEFINEQ (Establish/Trace/Data [LAMBDA (wnd tracebitmap cursor/rightoffset cursor/heightoffset GCGAGP) (* * This function is called to establish the data to trace the desired bitmap. "wnd" is the window in which the tracing is to take place, "tracebitmap" is the tracing bitmap, "cursor/rightoffset" and "cursor/heightoffset" are integers which detemine the hotspot of the tracing bitmap. As "cursor/heightoffset and "cursor/rightoffset" increase the cursor hotspot moves up and to the right. If GCGAGP is non-NIL, GCGAG will be disabled.) (PROG NIL (if (OR (NULL wnd) (NULL tracebitmap)) then (PLAYTUNE (LIST (CONS 1000 4000))) (RETURN)) (if GCGAGP then (GCGAG)) (* * Create a blank cursor.) (SETQ *BLANKCURSOR*(BITMAPCREATE 16 16)) (SETQ *BLANKTRACECURSOR*(CURSORCREATE *BLANKCURSOR*)) (* * Set the CURSOR IN and OUT FNS for wnd to the following:) (WINDOWPROP wnd (QUOTE CURSORINFN) (FUNCTION SETUP/TRACE)) (WINDOWPROP wnd (QUOTE CURSOROUTFN) (FUNCTION UNTRACE/CURSOR)) (* * To allow the bitmap to be set down in the window by pressing a mouse button, include this line. Otherwise, it is not needed) (WINDOWPROP wnd (QUOTE BUTTONEVENTFN) (FUNCTION PLACE/BITMAP/IN/WINDOW)) (WINDOWPROP wnd (QUOTE CURSOROUTFN) (* * Set up Global Variables for the tracing operation) (SETQ *TRACEBITMAP* tracebitmap (SETQ *RIGHTTRACE/OFFSET*(OR cursor/rightoffset 0)) (SETQ *HEIGHTTRACE/OFFSET*(OR cxursor heightoffset 0)) (SETQ *OLDBITMAPPOSITION*(BITMAPCREATE (BITMAPWIDTH tracebitmap) (BITMAPHEIGHT tracebitmap))) (SETQ *TRACEWINDOW* wnd])) When the function Establish/Trace/Data is called, the functions SETUP/TRACE(SETUP/TRACE (Function) NIL NIL NIL NIL) and UNTRACE/CURSOR(UNTRACE/CURSOR (Function) NIL NIL NIL NIL) will be installed as the values of the window's WlNDOWPROPS, and will be used to turn the trace on and off. Those functions should be typed in, then: (DEFINEQ (SETUP/TRACE [LAMBDA (wnd) (* * This function is wnd's CURSORINFN. It simply resets the last trace position and the current tracing region. It also readvises GETMOUSESTATE to perform the trace function after each call.) (if *TRACEBITMAP* then (SETQ *LAST-TRACE-XPOS* -2000) (SETQ *LAST-TRACE-YPOS* -2000) (SETQ *WNDREGION* (WINDOWPROP wnd (QUOTE REGION))) (WINDOWPROP wnd (QUOTE TRACING) T) (* * make the cursor disappear) (CURSOR *BLANKTRACECURSOR*) (ADVISE (QUOTE GETMOUSESTATE) (QUOTE AFTER) NIL (QUOTE (TRACE/CURSOR])) (DEFINEQ (UNTRACE/CURSOR [LAMBDA (wnd) (* * This function is wnd's CURSOROUTFN. The function first checks if the cursor is currently being traced; if so, it replaces the tracing bitmap with what is under it and then turns tracing off by unadvising GETMOUSESTATE and setting the TRACING window property of *TRACEWINDOW* to NIL.) (if (WINDOWPROP *TRACEWINDOW*(QUOTE TRACING)) then (BITBLT *OLDBITMAPPOSITION* 0 0 (SCREENBITMAP) (IPLUS (CAR *WNDREGION*)*LAST-TRACE-XPOS*) (IPLUS (CADR *WNDREGION*)*LAST-TRACE-YPOS*)) (WINDOWPROP *TRACEWINDOW*(QUOTE TRACING) NIL)) (* * replace the original cursor shape) (CURSOR T) (* * unadvise GETMOUSESTATE) (UNADVISE (QUOTE GETMOUSESTATE])) The function SETUP/TRACE has a helper function that you must also type in. It is TRACE/CURSOR: (DEFINEQ (TRACE/CURSOR [LAMBDA NIL (* * This function does the actual BITBLTing of the tracing bitmap. This function is called after a GETMOUSESTATE, while tracing.) (PROG ((xpos (IDIFFERENCE (LASTMOUSEX *TRACEWINDOW*) *RIGHTTRACE/OFFSET*)) (ypos (IDIFFERENCE (LASTMOUSEY *TRACEWINDOW*) *HEIGHTTRACE/OFFSET*)) (* * If there is an error in the function, press the right button to unadvise the function. This will keep the machine from locking up.) (if (LASTMOUSESTATE RIGHT) then (UNADVISE (QUOTE GETMOUSESTATE))) (if (AND (NEQ xpos *LAST-TRACE-XPOS*) (NEQ ypos *LAST-TRACE-YPOS*)) then (* * Restore what was under the old position of the trace bitmap) (BITBLT *OLDBITMAPPOSITION* 0 0 (SCREENBITMAP) (IPLUS (CAR *WNDREGION*)*LAST-TRACE-XPOS*) (IPLUS (CADR *WNDREGION*)*LAST-TRACE-YPOS*)) (* * Save what will be under the position of the new trace bitmap) (BITBLT (SCREENBITMAP) (IPLUS (CAR *WNDREGION*) xpos) (IPLUS (CADR *WNDREGION*) ypos)*OLDBITMAPPOSITION* 0 0) (* * BITBLT the trace bitmap onto the new position of the mouse) (BITBLT *TRACEBITMAP* 0 0 (SCREENBITMAP) (IPLUS (CAR *WNDREGION*) xpos) (IPLUS (CADR *WNDREGION*) ypos) NIL NIL (QUOTE INPUT) (QUOTE PAINT)) (* * Save the current position as the last trace position.) (SETQ *LAST-TRACE-XPOS* xpos) (SETQ *LAST-TRACE-YPOS* ypos])) The helper function for UNTRACE/CURSOR, called UNDO/TRACE/DATA, must also be added to the environment: (DEFINEQ (UNDO/TRACE/DATA [LAMBDA NIL (* * The purpose of this function is to turn tracing off and to free up the global variables used to trace the bitmap so that they can be garbage collected.) (* * Check if the cursor is currently being traced. It so, turn it off.) (UNTRACE/CURSOR) (WINDOWPROP *TRACEWINDOW*(QUOTE CURSORINFN) NIL) (WINDOWPROP *TRACEWINDOW*(QUOTE CURSOROUTFN) NIL) (SETQ *TRACEBITMAP* NIL) (SETQ *RIGHTTRACE/OFFSET* NIL) (SETQ *HEIGHTTRACE/OFFSET* NIL) (SETQ *OLDBITMAPPOSITION* NIL) (SETQ *TRACEWINDOW* NIL) (* * Turn GCGAG on) (GCGAG T])) Finally, if you included the WlNDOWPROP to allow the user to place the bitmap in the window by pressing a mouse button, you must also type this function: (DEFINEQ (PLACE/BITMAP/IN/WINDOW [LAMBDA (wnd) (UNADVISE (GETMOUSESTATE)) (BITBLT *TRACEBITMAP* 0 0 (SCREENBITMAP) (IPLUS (CAR *WNDREGION*) xpos) (IPLUS (CADR *WNDREGION*) ypos) NIL NIL (QUOTE INPUT) (QUOTE PAINT] That's all the functions! Running the Functions 1 To run the functions you just typed in, first set a variable to a window by typing something like (SETQ EXAMPLE.WINDOW (CREATEW)) into the Executive Window, and sweeping out a new window. Now, set a variable to a bitmap, by typing, perhaps, (SETQ EXAMPLE.BTM (EDITBM)) Type (Estab1ish/Trace/Data EXAMPLE.WINDOW EXAMPLE.BTM)) When you move the cursor into the window, the cursor will drag the bitmap. (If you want to be able to make menu selections while tracing the cursor(CURSOR NIL Cursor NIL NIL NIL SUBNAME SETTING% THE% HOTSPOT SUBTEXT setting% the% hotspot), make sure that the hotspot of the cursor is set to the extreme right of the bitmap. Otherwise, the menu will be destroyed by the BITBLTs of the trace functions.) To stop tracing, do one of the following: ��f� Move the mouse cursor out of the window ��f� Press the right mouse button ��f� Call the function UNTRACE/CURSOR (LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "23-" "") STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "23-" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (TEXT NIL NIL (54 54 504 690) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "23-" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD LEFT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "23-" "")) (54 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGV) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE VERSOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "23-" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD RIGHT) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY HELVETICA OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "23-" "")) (270 15 288 36) NIL) (HEADING NIL (HEADINGTYPE FOOTINGR) (54 27 558 36) NIL) (HEADING NIL (HEADINGTYPE RECTOHEAD) (54 762 558 36) NIL) (TEXT NIL NIL (54 54 504 684) NIL)))))5$��DHH�l��DHH�l��>HH�l��2HT�T,`l�,H`�,HH�,ll�,ll�,ll�,HH�,HH�,HH� --�T-�T2��F��PAGEHEADING VERSOHEADF��PAGEHEADING RECTOHEADE��PAGEHEADINGFOOTINGVE��PAGEHEADINGFOOTINGR,TITAN -CLASSIC -TITAN -CLASSIC HELVETICAMODERN HELVETICACLASSIC - HELVETICA -MODERN - -TIMESROMAN -HRULE.GETFNMODERN - -" HRULE.GETFNCLASSIC -# 9 HRULE.GETFNCLASSIC -8 HRULE.GETFNCLASSIC - IM.CHAP.GETFN HELVETICAAHRULE.GETFNMODERNaGIM.INDEX.GETFN� -t 9HRULE.GETFNCLASSICm *IM.INDEX.GETFNc -'IM.INDEX.GETFN -'IM.INDEX.GETFN D P - 5 # - -&8 *IM.INDEX.GETFN3(IM.INDEX.GETFN�LHRULE.GETFNCLASSIC? � .x %E _W, - HRULE.GETFNCLASSICrAIM.INDEX.GETFN. d - �!HRULE.GETFNCLASSIC3?IM.INDEX.GETFN�oH < = 7 < 2 : . / - , ) 6 4 # $ $ ' ; / & / $ : 4 7 E * (IM.INDEX.GETFN+IM.INDEX.GETFN1[ ( 9 a%!5"! +/5.0+ *# 9 �QM�)'"C1.0E -"C+ - -< " ) � 5 , - -s! ) HRULE.GETFNCLASSICb o 3 J H[IM.INDEX.GETFN� *+!*�Wz� \ No newline at end of file diff --git a/docs/primer/24-GLOBAL-VARIABLES.TEDIT b/docs/primer/24-GLOBAL-VARIABLES.TEDIT deleted file mode 100644 index 6346d140..00000000 Binary files a/docs/primer/24-GLOBAL-VARIABLES.TEDIT and /dev/null differ diff --git a/docs/primer/25-REFERENCES.TEDIT b/docs/primer/25-REFERENCES.TEDIT deleted file mode 100644 index d82bbe04..00000000 Binary files a/docs/primer/25-REFERENCES.TEDIT and /dev/null differ diff --git a/docs/primer/DRAFT.TEDIT b/docs/primer/DRAFT.TEDIT deleted file mode 100644 index f30e8fef..00000000 --- a/docs/primer/DRAFT.TEDIT +++ /dev/null @@ -1,4 +0,0 @@ -Primer from Scan TABLEOFCONTENTS ~)19 ~`~ 1. A Brief Glossary t 1.1 2. The Mouse and the Keyboard / 2.1 2.1. The Mouse 2.1 2.1.1. 2and3ButtonMice 2.1 2.2. _ The _ Keyhoard _ 2.2 2.2.1. _ The _ 1186 _ Keyhoard _ 2.2 2.2.2. _ The _ 1108 _ Keyhoard _ 2.2 3. Turning On Your Lisp Machine / 3.1 3.1. _ Turningonthello8 _ 3.1 3.2. _ Turning on _ the1186 _ 3.2 3.3. _ Loading _ lntertis~D from the _ Hard _ Disk _ 3.3 3.4. _ AfterBooting _ Lisp _ 3.5 3.5. _ Restarting _ Lisp After Logging _ Out _ 3.5 4. If You Have a Fileserver / 4.1 4.1. _ Turning on your 1108 _ 4.1 4.2. _ Turningonyourll86 _ 4.1 4.3. Location of Files 4.2 4.4. The Timeserver 4.2 5. Logging Out And Turning the Machine Off 51 5.1. _ Logging Out _ 5.1 5.2. _ Turning _ The _ MachineOff _ 5.2 6. Typing Shortcuts 6.1 6.1. _ If you _ makea _ Mistake _ 6.3 7. Using Menus 7.1 7.1. _ Making _ a _ Selection from _ a _ Menu _ 7.2 7.2. _ Explanations _ of _ Menu _ Items _ 7.2 7.3. Submenus 7.3 8. How to use Files 8.1 8.1. _ Types of Files _ 8.1 TA8~ OF CONTENtt To'., 1 - - - - . - - - - . - - , - TABLE OF CONTENtr 8.2. _ Directories _ 8.1 8.3. _ Directory Options _ 8.2 8.4. _ Subfile _ Directories _ 8.3 8.5. _ To See What Filri Are _ Loaded _ 8.3 8.6. _ Simple Commands for Manipulating _ Filu _ 8.3 \ 8.7. _ to a _ 8.4 - `.~--y Connecting _ Directory \ s 8.8. _ File Vettion _ Numbers _ 8.4 9. FileBrowser 9.1 9.1. _ Calling the _ FileSrowser _ 9.1 9.2. FileBrowserCommands 9.3 10. ffose Wondertul Windows! 10.1 10.1. _ Windows _ provided _ by lnterlis~D _ 10.1 10.2. _ Creating a _ window _ 10.2 10.3. _ The Right _ Button DefaultWindow _ Menu _ 10.2 10.4. _ An _ explanation of each _ menu _ item _ 10.3 10.5. _ krollable Windows _ 10.3 10.6. Other Window Functions 10.5 10.6.1. PROMPTPRlNT 10.5 10.6.2. _ WHlCHW _ 10.6 11. Editing and Saving 11.1 11.1. _ Defining _ Functions _ 11.1 11.2. Simple Editing in the 1nterlis~D Executive Window 11.2 YA8~ OF cottnritt iA.3. _ W�ys to Stop Ex�cution from th� K�yboard, called _ 1�r��hlng LIzp5 _ 14.3 t4.4. _ Programming _ Br�aks and D�bugging Cod� _ 14.4 14.5. Break Monu 14.4 14.6. _ Returning to Top Lov�l _ `4.5 15. _ On-Line _ Help _ with _ Interlisp-D: _ HELPSYS and _ DlNFO _ ~ _ 15.1 15.1. _ HelpSys _ 15.1 15.2. Dlnfo 15.1 16. Floppy Disks / 16.1 16.1. _ Buying Floppy Disks _ 16.1 16.2. _ Basic Floppy Disk Information _ 16.1 16.3. _ Care of Floppies _ 16.2 16.4. _ Write Enabling and Write Protecting _ Floppies _ 16.3 16.4.1. _ Write Enabling an _ 1108's _ Floppy _ Disk _ 16.3 16.4.2. _ Write Protecting an _ 1186's Floppy Disk _ 16.3 16.5. _ Inserting _ Floppies _ intothe _ Floppy Drive _ 16.3 16.6. _ Functions for Floppy Disks _ 16.4 16.6.1. _ Formatting Floppies _ 16.4 16.6.2. _ Available Space on a Floppy Disk _ 16.4 16.6.3. _ The Name ofa Floppy Disk _ 16.4 16.6.4. _ FLOPPY.MODE _ 16.5 17. Duplicating Floppy Disks 17.1 17.1. _ Supplies _ 17.1 17.2. _ Preparabon _ 17.1 17.2.1. _ Handling _ Floppy _ Disks _ 17.1 17.2.2. _ Setup _ 17.1 17.3. _ Copying _ Floppy Disks _ 17.2 18. Sysout Files 18.1 18.1. _ Loading SYSOUT Filri _ 18.1 18.1.1. _ Loading a _ SYSOUTfile on the _ 1108 _ 18.1 18.1.2. _ Loading a SYSOuTfileonthe _ 1186 _ 18.2 18.2. _ Making _ Your Own SYSOUT File _ 18.3 19. Using the Epson FX80 Printer ~ 19.1 19.1. _ Initializing the RS232 Port _ 19.1 19.2. _ Power upthe Printer _ 19.1 19.3. _ to Align Top of Page _ 19.1 YA8~ OF CONTENTS TOC.3 TABLE OF CONTEND yl 19.4. _ Fundions To Print Filri and _ Bitmapf _ 19.2 19.4.1. _ RS232.Print _ 19.2 19.4.2. _ FXWSTREAM _ 19.2 19.4.3. _ Printing a Portion of the Screen _ 19.3 20. R5232 File Transfer With a VAX 20.1 20.1. _ Prerequisites _ 20.1 20.2. _ Using Chat to Transfer Filri _ 20.1 21. Ethernet File Transfer 21.1 21.1. _ Prerequisites _ 21.1 21.2. File Transfer 21.1 22. WhatToDolf... 22.1 �;;23. The Text �ditor,TEdit 23.1 23.1. _ Using TEdit _ 23.1 23.2. _ Managing the edit Window _ 23.2 23.3. _ Seleding _ Tert _ 23.3 23.4. _ Deleting, Copying, and _ Moving Text with edit _ 23.4 23.4.1. _ Deleting Text From a File _ 23.4 23.4.2. _ Copying _ Text _ 23.4 23.4.3. _ Moving _ Text _ 23.5 23.5. _ rtdit Menus _ 23.6 23.5.1. _ Finding _ and _ Substituting Text with _ edit _ 23.7 23.5.1.1. _ Finding Text _ 23.7 23.5.1.2. _ Substituting Text _ 23.8 23.5.L _ Text Formatting _ 23.10 23.5.2.1. _ Choosing Fonts _ 23.10 23.5.2.2. _ Paragraph _ Formatting _ 23.11 23.5.3. _ Adding _ Bitmaps and Sketches to your TEdit File _ 23.13 23.5.3.t. _ Adding a _ Bitmap to your TEdit file _ 23.13 23.5.3.2. _ Adding a Sketch to your TEdit file _ 23.14 23.5.4. _ Getting and _ Including _ Filri _ 23.14 23.5.4.1. _ Get _ 23.14 23.5.4.2. _ Include _ 23.14 23.5.5. _ Saving and Printing Files _ 23.15 24. _ Records _ May _ BG _ Your _ Favorite _ Data _ Structure! _ 24.1 2&1. _ Interlisp Record ~imitlves _ 24.1 T~.. rAa~0fC0NTENrt TABLE OF OoNTENfl 24.2. _ Exomplo _ 24.3 24.3. _ AF�wflps _ 24.4 25. Local Variables - Using LET and PR0G 7 25.1 25.1. _ LET _ 25.1 25.2. _ PfloG _ 25.3 25.3. _ Porillol _ vottus _ S~uential _ Vorioblo _ Binding _ 25.6 25.3.1. _ L~ _ 25.6 25.3.2. _ PROG� _ 25.7 26. lterative statements 26.1 26.1. _ General _ Strudurc and _ Use _ 26.1 26.2. _ Local _ Variables _ 26.2 26.3. _ lteration _ On _ Lists _ 26.3 26.4. _ Parallel _ lteration _ 26.4 26.5. _ Conditional _ lteration _ 26.5 26.6. _ More _ lteration _ 26.6 27. Window and Regions 27.1 27.1. _ Windows _ 27.1 27.1.1. _ CREATEW _ 27.1 27.1.2. _ WlNDOWPROP _ 27.2 27.1.3. _ Getting windows to do things _ 27.3 27.1.3.1. _ BUflONEVENTFN _ 27.4 27.1.4. _ Looking at a _ window's properties _ 27.5 27.2. _ Regions _ 27.5 28. What Are Menus? 281 28.1. _ Displaying _ Menus _ 28.1 28.2. _ Getting _ Menus to DO Stuff _ 28.2 28.2.1. The WHENHELDFH and WHENSELE~DFN fields of a menu 28.4 28.3. _ Looking _ at a _ menu's fields _ 28.5 29. Bitmaps 29.1 30. Displaystreams 30.1 30.1. _ Drawing _ on a _ Displaystream _ 30.1 30.1.1. _ DliWUNE _ 30.1 30.1.2. _ DliWTO _ 30.2 30.1.3. _ DliWaRCLE _ 30.3 TABS OF CONTENff TOC.5 l TABS OF CON~Nfl 30.1.3.1. _ FlLLGRCLE _ 30.3 30.2. _ Locating and _ Changing _ Your Position _ in _ a _ Displaystream _ 30.4 30.2.1. _ DSPXP0SlflON _ 30.5 30.2.2. _ DSPYPOSlBON _ 30.5 30.2.3. _ MOVETO _ 30.5 31. Fonts 31.1 31.1. _ WhatmakesupaFONn _ 31.1 31.2. _ Fontdescriptors, and _ FONTCREATE _ 31.2 31.3. _ Display Fonts-Theirfiles, and how to find them _ 31.3 31.4. _ Interpress _ Fonts- Their files, and _ how to find them _ 31.4 31.5. _ Functions for Using Fonts _ 31.4 31.5.1. _ FOHTPROP - _ Looking at Font Properties _ 31.4 31.5.2. _ SffllNGWlDTH _ 31.5 31.5.3. _ DSPFONT- Changing the Font in _ One Window _ 31.6 31.5.4. _ GIo~IlyChanging Fonts _ 31.7 31.5.5. _ Pettonalizing _ Your Font Profile _ 31.7 32. The Inspetror 32.1 32.1. _ Calling the Inspector _ 32.1 32.2. _ Using _ the _ Inspector _ 32.2 32.3. _ Inspector _ Example _ 32.2 33. Masterscope 33.1 33.1. _ The SHOW DATA command and GRAPHER _ 33.2 33.2. Databasefns: Automatic Conrtruction and Upkeep of a Mastettcope Data~se _ 33.3 34. Where Does All the Time Go? SPY 34.1 34.1. _ How to use Spy with the SAY Window _ 34.1 34.2. _ How to use _ SPY from the _ Lisp Top Level _ 34.2 343. _ Interpreting _ SPY's Results _ 34.2 35. SKETCH 35.1 35.1. _ Starting _ Sketch _ 35.1 35.2. _ Selecting _ Sketch elements _ 35.1 35.3. _ Drawing _ with _ Sketch _ 35.2 35.3.1. _ Simpl� Shapes: _ Circles, Ellipsri� and _ Boxes _ 35.3 35.3.1.1. _ Drawing _ Circlri _ 35.3 35.3.1.1 _ Elllpsri _ 35.3 TA.G TAlLE0fC0NFENrt `/` ----- Next Message ----- Date: 19 Dec 91 14:18 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.141853pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11640>; Thu, 19 Dec 1991 14:19:05 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 14:18:53 -0800 From: John Sybalsky -----RFC822 headers----> TABLE OF CONTENff 42. _ Simple _ Interactions _ with _ the _ Cursor, _ a _ Bitm&p, _ and _ & _ Window _ 42.1 42.1. _ An _ Example Function _ Using _ GETHOUSESTATE _ 42.1 42.2. _ Advising _ GETMOUSESTATE _ 42.2 42.3. _ Changing the Cursor _ 42.2 42.4. _ Functions for _ "Tracing the cursor" _ 42.3 42.5. _ Running the Functions _ 42.6 43. Glossary of Global System Variables 43.1 43.1. _ Directories _ 43.1 43.2. _ Flags _ 43.2 43.3. _ Hirtory _ Lists _ 43.3 43.4. _ Syrtem _ Menus _ 43.3 43.5. _ Windows _ 43.4 43.6. _ Miscellaneous _ 43.4 44. Other References that will be Useful to You 44.1 TA.G TAaU0FC0NTENff PREFACE it wos dawn and the locd told him it was down the road a p;ece, lefl &t the hst fishing bridge in the counvy right at the apple tree stump, and onto the d;rt roadjust before the hill. At m;dnight he knew he was lo$t. -Anonymous Welcome to the Interlisp-D programming environment! The Interlis~D environment truly must be one of the most sophisticated and powerful tools in use by human beings. Overall, it is flexible, well thought out, and full of pleasant surprises: "Wow, here are exactly the set of functions l thought I'd need to write." Unfortunately, along with the power comes mind-numbing complexity. The Intedisp Refertnce Manual describes the functions and some of the tools available in the Interlisp-D environment. To do this takes three large volumes. Other volumes are needed to document the library packages and other newly written tools. Needless to say, it is very difficult to learn such a huge amount of material when there is no way to determine where to rtart! We developed this primer to provide a starting point for new lnterlis~D usert, to enhance� your excitement and challenge you with the potential before you. We assume you know a little about LISP, most likely received from taking a survey courte in Artificial Intelligence (Al), and have seen a demonrtration of how lnterlis~D runs on your 1186 or 1108. We further assume that your machine is not on a network system with a file server - though this is addressed, and that you will be working from floppy disks and the hard disk that is part of the machine. If this describes your situation, you are ready to sit down in front of your machine and follow the ste~by-step examples provided in this primer. The primer is broken into many small chapters, and these chapters are organized into five parts. You may want to read Parts 1 through 3 straight through, since they describe the basics of using the machine. Each chapter in Sections 4 and 5, however, can be used to learn a specific skill whenever you are ready to for it Part one, "Introduction", includes Chapters 1 and 2. Part two, "Getting Into/Out of Interlisp", includes Chapters 3 through 5. Part three, "The lnterlis~D language and Programming Environment", includes Chapters 6 through IS. These chapters discuss primary elements in lnterIis~D, and orient you in relation to those elements. Part four, "Important Other Things to Know to Work Successfully", includes Chapters 16 through 31. Part five, "More Language and Environment and Packages", includes Chapters 32 through 44. PREFAcE v ----- Next Message ----- Date: 19 Dec 91 14:20 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.142054pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11636>; Thu, 19 Dec 1991 14:21:05 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 14:20:54 -0800 From: John Sybalsky -----RFC822 headers----> PREFACE Through out we make reference to the lnterlis~D Reference Manual by section and page number. The material in the primer is just an introduction. When you need more depth use the detailed treatment provided in the manual. While only you can plot your ultimate destination, you will flnd this primer indispensable for clearly defining and guiding you to the first landmarks on your way. Acknowledgements The early inspiration and model for this primer came from the Intelligent Tutoring Systems group and the Learning Research and Development Center at the University of Pittsburgh. We gratefully acknowledge their pioneering contribution to more effective artificial intelligence. This primer was developed by Computer Possibilities, a company committed to making Al technology available. Primary development and writing was done by Cynthia Cosic, with technical writing support provided by Sam Zordich. At Xerox Artificial Intelligence Systems, John Vittal managed and directed the project. Substantial assistance was provided by many members of the AlS staff who provided both editorial and systems support. PREFA~ �1 ----- Next Message ----- Date: 19 Dec 91 14:33 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.143340pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11653>; Thu, 19 Dec 1991 14:33:46 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 14:33:40 -0800 From: John Sybalsky -----RFC822 headers----> 1. ABRlEFGLOSSARY The following definitions will acquaint you with general terms used throughout this primer. You will probably want to read through them now, and use this chapter as a reference while you read through the rest of the primer. advising An lnterlis~D facility for specifying function modifications without necessarily knowing how a particular function works or even what it does. Even system functions can be changed with advising. argument An argument is a piece of information given to an lnterlis~D function so that it can execute successfully. When a function is explained in the primer, the arguments that it requires will also be given. Arguments are also called Parametert. atom The smallest rtrvcture in Lisp; like a variable in other programming languages, but can also have a property lirt and a function definition. Background Menu The menu that appears when the mouse is not in any window and the right mouse button is pressed. A typical background menu is shown in Figure I.I. Loops Icon FileB'owser Figuro 1.1. The Menu that appeort when the mouse is not in any window, and the right mouse button is pressed. Your background menu may have some different items in it binding The value of a variable. It could be either a local or a global variable. See unbound. bitmap A rectangular array of `� pixels, `� each of which is on or off representing one point in the bitmap image. BREAK An Interlisp function that causes a function to stop executing, open a Break window, and allow the user to find out what is happening while the function is halted. Break Window A window that opens when an error is encountered while running your program (i.e., when your program has broken). There are tools to help you debug your program from this window. This is explained further in Chapter 14, Page 14.1. browse To examine a data strvcture by use of a display that allows the user to "move" around within the data rtructure. button A BRIEF GL0SSARY 1.1 1 A BRIEF GLOssAny (1) (n.) Akeyonamouse. (2) (v.t.) To depress one of the mouse keys when making a selection. EAR A function that returns the head or firrt element of a list. See CDR. caret The small blinking arrowhead that marks where tert will appear when it is typed in from the keyboard. An example of the caret in the lnterIis~D Executive Window is shown in Figure 1.2. NIL B6+(PLus 3A Figur� lJ. Me caret is to the right of the numher 3. When a characters frped atthe keylsoard. it will ap~ar at the caret CDR A function that returns the tail (that is, everything but the first element) ofa list SeeEAR. CLlSP A mechanism for augmenting the standard Lisp syntax. One such augmentation included in Interlisp is the iterative rtatement. SeeSection 13.1. cr Please press your carriage return key. datatype (1) The kind of a datum. In Interlisp, there are many SystemAefine~ datatypes e.g. Floating Point, Integer, Atom, etc. (2) A datatype can also be user~efined. In this case it is like a record made up from system types and other user-defined datatypes. DWlM D~what�l-mean. Many errors made by Interlisp users could be corrected without any information about the purpose of the program or expression in question (e.g. misspellings, certain kinds of parenthesis errort). The DWlM facility is called automatically whenever an error occurt in the evaluation of an Interlisp expression. If DWlM is able to make a correction, the computation continues as though no error had occurred; otherwise, the standard error mechanism is invoked. error Occasionally, while a program is running, an error may occur which will stop the computation. Interlisp provides ertensive facilities for detecting and handling error conditions, to enable the testing, debugging, and revising of impertect programs. evaluate or EVAL Means to flnd the value of a form. For example, if the variable X is bound to 5, we get 5 by evaluating X. Evaluation of a Interlisp function involves evaluating th� arguments and then applying th�function. file packag� A set of functions and conv�ntions that facilitato th� bookke�ping involved with working in i larg� syst�m consisting of many sourc� cod� files and th�ir compiled count�rparts. Essentially, th� fll� packag� k:ps track of wh�r� things ar� and 1, A�R1EFGLos~y l A �Rl�F GLoSSARY whet things hevo chonged. N 4150 kaps tr�ck of which files hove been modifiod end n#d to be updetod end recompiled. form Another wey of seying ~xpre5sion. An Jntorlisp-D ex~on tbetcen be evaluated. function A Lisp function is e piece of l;sp code thet executes end returns e veiue. history The progremmer�s essistent is l,uilt eround e memory structure celled the hirtory Iirt. The hirtory functions (e.g. FIX, UNDO, REDO) ere part of this essirtant. These operations allow you to conveniently r~work previously specifiecl operations. History List As you type on the xreen, you will notice a number followecl by a prompt attow. Each number, and the information on that line, is seeluentially rtored as the History List Using the History List, you can easily reexecute lines typed earlier in a worksession. See Chapter6. icon A pictorial representation, usually of shrunken window. lnterlis~D Executive Window This is your main window, where you will run functions and develop your programs. See Figure 1.3. This is the window that the caret is in when you turn on your machine and load lnterlis~D. NIL 8~#iPRO*PTPRIHT "HELLO" A Fqur� tJ. m window inspector An interactive display program for examining and changing the parts of a data structure. Jnterlisp-D has inspectors for lists and other data types. iterative statement (also called i.s.) A statement in Interlisp that repetitively executes abody of code. (E.g.(forxfromltosdo(PRlNTx))isani.s.) iterative variable (also called i.v.) Usually, an iterative statement is controlled by the value that the i.v. takes on. In the iterative statement example above, x is the iterative variable leecause its value is being changed by each cycle through the loop. All iterative variables are local to the iterative rtatement where they are defined. LISP Family of languages invented for "list processing." These languages have in common a set of basic primitives for creating and manipulating symbol rtructures. lnterlis~D is an implementation of the LISP language together with an environment (set of tools) for programming, an a set of packages that ertend the functionality of the system. list A collection of atoms and lists; a list is denoted by surrounding its contents with a pair of parentheses. A BRIEF GLOSSARY lJ 1 A BRIEF GLOSSARY Loading LJSP This is the process of bringing lnterlis~D from floppy disks, hard disks, or some other secondary rtorage into your main, or working, memory. You will need to load (i.e., install, and boot) lnterlis~D if you have not logged off the machine at the end of a session. The process of loading lnterlis~D is explained in Chapter3. Maintenance Panel Codes Should you have a problem with your equipment, these codes will indicate the status of your processor. On the 1108, these are the red LED numbett under the floppy drive door. There is a cover over these numbers. Pull down the cover located immediately under the floppy door button. The code numbers are defined for the 1108 in the 1108 Useri Guide, in the MP Codeschapter. If there is a problem with the 1186, the mouse curtor will change from its normal arrow to the code number that describes the problem. The code numbert are defined for the 1186 in the 1166 User's Guide in the Curtor Codes subsection of the Diagnostics Chapter. Marterscope A program analysis tool. When told to analyze a program, Masterscope creates a data base of information about the program. In particular, Marterscope knows which functions call other functions and which functions use which variables. Masterscope can then answer questions about the program and display the information with a browser. menu A way of graphically presenting the user with a set of options. There are twO kinds of menus: p0~up menus are created when needed and disappear after an item has been selected; permanent menus remain on the screen after use. mouse The Mouse is the box to the right of your keyboard. It controls the movement of the cursor on your screen. As you become familiar with the mouse, you will find it much quicker to use the mouse than the keyboard. See Figure 1.4. (Note: Some mice have three buttons; the button in the center is known as the middle mouse button. If your mouse has only two buttons, you can simulate a middle button by pressing the left and right buttons simultaneously.). Fw- 1.& Mous� Mouse Curtor The small arrow on the screen that points to the northwest. See Figure 1.5. F~m I.L Mous� c~~~ Mous� Curtor Icons I.A A llEF GLos~Y l A IRlEF GLOSSARY I Wait Tho processor is busy. The processor is saving a anpashot or your cureent system session. This is usually don� when tbc procffssor hos ~n idle for a while. The "Mouse Confirm Cursor". It appeatt when you have to confirm that the choice you just made was correct. If it was, press the left button. If the choice was not tight, press the right button to abort. F='*x This means "sweep out" the shape of the window. To do this, move the mouse to a position where you want a corner. Press the leff mouse button, and hold it down. Move the mouse diagonally to sketch a rectangle. When the rectangle is the desired size and shape, release the left button. r-'l l l l l - This is the "move window" prompt. Move the mouse so that the large "ghost" rectangle is in the position where you want the window. When you click the left mouse button, the window will appear at this new location. NIL NIL is the lnterlis~D symbol for the empty list h can also be represented by a lefl paren followed by a right paren: (). It is the only expression in lnterIis~D that is both an atom and a list pixel Pixel rtands for PIcture Element. The xreen of your Lisp Machine is made up of a rectangular array of pixels. Each pixel corresponds to one bit When a bit is turned on, i.e. set to 1, the pixel on the screen represented by this bit is black. pretty printing Pretty printing refers to the way lnterIis~D functions are printed with special indentation, to make them easier to read. Functions are pretty printed in the structure eclitor, DEdit (See Section 11.3, Page 11.4). You can pretty print uncompiled functions by calling the function PP with the function you would like to see as an argument, i.e. (PP tunction-name). For an example of this, see Figure 1.6. 96.(PP HEAD) [LANBDA (LST) <��6rt�G; `�~JlinH13;3&�) (CAR LsTJ) (HEAD) 97.' Fbm 1.6. An oxam~ u~oftho pro printing `unmon FP A BRIEF GLOSSARY 1.5 I A BRIEF GLOSSARY Programmer's Assistant The programmer's assistant accesses the History List to allow you to FIX, UlOO, and'or REDO your previous expressions typed to the lnterlis~D executive window. (See Chapter 6.) Promptwindow The skinny black window at the top of the xreen. It displays system prompts, or prompts you have developed. (See Figure 1.7.) Fqur� 1.7. Prompt window property list A list of the form (

....) associated with an atom. It accessed by the functions GETPROP and PUTPR0P. record A record is a data-structure that consists of named "flelds". Accessing elements of a record can be separated from the details of how the data structure is actually stored. This eliminates many programming details. A record definition establishes a record template, describing the form of a record. A record instance is an actual record storing data according to a particular record template. (See datatype, second definition.) Right Button Default Window Menu This is the menu that appeaff when the mouse is in a window, and the right mouse button is pressed. It looks like the menu in Figure 1.8. If this menu does not appear when you depress the right button of the mouse and the mouse is in the window, move the mouse so that it is pointing to the title bar of the window, and press the right button. Clone Snap Paint Clear 8ury Redi~play Hardcopy~ Move Shapo Shrink f~a 1.1. tt� Right Sutton DqfaultWindow Menu 5-expression Short for "symbolic expression." In Lisp, this refers to any well-formed collection of leff parffns, atoms, and right parens. stack A pushdown lirt Whenever a function is entered, information about that specific function call is pushed onto (i.e. added to the front ofi the stack; this information includes the variable names and their values associated with the function call. When the function is exitted, that data is popped off the stack. storag� devices Information is rtored for your Lisp machine on floppy disks, or on the hard disk. They are referred to as (FLOPPY) and (DSK) respectiv�ly. sysout A fll� containing G wl'0l� Lisp environm�nt: namely, lnterlis~O, ev�rything th� user' d�finecl or loaded into the environment, th� 1.6 A ~N:EF GL0SsARY I A BRIEF GLOSSARY windows that �ppeored on tho Kreen, tb� �mount of memory used, and 50 on. Evorything ;s rtor�d in th� sysout fil� exactly .5 it was whon tho function SYSWT was called). TFACE A function that cr�ates a trace of the execution of another function. Eich time the traced function is called, it prints out the values of the arguments it was called with, and prints out the value it returns upon completion. Unbound Without value; an atom is unbound if a value has never been assigned to it window A rectangular area of the screen that acts as the main display area for some Interlisp process, A BRIEF GLOSSARY 1.7 1 ----- Next Message ----- Date: 19 Dec 91 14:42 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.144256pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11642>; Thu, 19 Dec 1991 14:43:07 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 14:42:56 -0800 From: John Sybalsky -----RFC822 headers----> 6. TYPING SHORTCUTS Once you have logged it, as per Chapters 3 or 4, you are in lnterlis~D. The functions you type into the Interlisp-D executive window will now execute, that is, perform the designated task. Please note that Interlisp-D is case-sensitive; offen it matters whether text is typed in capital- or lower-case letters. The shifflock key is above the left shift key; when it is pressed (on the 1186, the red LED will be on; on the 1108, the key will be depressed), everything typed is in capital letters. You must type all Interlisp-D functions in parentheses. The lnterlis~D interpreter wtll read from the leff parenthesis to the closing right parenthesis to determine both the function you want to execute, and the arguments to that function. Executing this function is called evaluation. When the function is evaluated it returns a value, which is then printed in the lnterlis~D executive window. This entire process is called the read-eval-print loop, and is how most Ll5P interpreters, including the one for lnterlis~D, run. The prompt in Interlis~D is a number followed by a left pointing arrow (see Figure 6.3). This number is the function's position on the History List -- a list that stores your interactions with the lnterlis~D interpreter. Type the function (PLUS 3 4), and notice the number the History List assigns to the function (the number immediately to the leff of the arrow). lnterlis~D reads in the function and its arguments, evaluates the function, then prints the number 7. In addition to this read-eval-print loop, there is also a programmer's assistant��. It is the programmer's assistant that prints the number as part of the prompt in the lnterlis~D executive window, and uses these numbers to reference the function calls typed after them. When you issue commands to the programmer's assistant, you will not use parentheses as you do with ordinary function calls. You simply type the command, and some specification that indicates which item on the history list the command refers to. Some programmer's assistant commands are FIX, REDO, and UNDO. They are explained in detail below. Programmer's assistant commands are useful only at the lnterlis~D top level, that is, when you are typing into the lnterlis~D executive window. They will not work in user-defined functions. As an example use of the programmer's assistant, use REDO to redo your function call (PLUS 3 4). Type REDO (Note: programmer's assistant commands can be typed in either upper TYPING 5H0RTCUTS 6 1 TYPING SHORTCUTS or lower case) at the prompt, then specify the previous expression in one of the following ways: (1) When you originally typed in tne function you now want to refer to, there was a History List number to the left of the arrow in the prompt. Type this number affer the programmer's assistant command. This is the method illustrated in the following figure: iPLUe~ 3 4) C�'5~REOO `24 7 26-',' , , , . . , . , . . . . . . . , . . . . , , , , . Figure 6.1. Using the programrner's assistant to REDO a function, when you know the its number on the history list (2) A negative number will specily the function call typed in that number of prompts ago. in this example, you would type in-I, the position immediately before the current position. This is shown in the following figure: `2�~.(PLUS :3 j) ;;;; `-,7' ii, ~` F.EDS -i 7 :�`0~. , , , , , ,: , , :, , ,:, , , , , , ;, : , , , ,; , , Figur� 6.2. Typing a negative number affer the programmer's assistant command will cause it use the function found on the History List that many positions before the current one. (3) You can also specify the function for the programmer's assistant with one of the items that was in that function call. The programmer's assistant will se'rch backwards in the History List, and use the first function it finds that includes that item. For example, type REDO PLUS to have the function (PLUS 3 4) reevaluated. (4) If you type a Programmer's Assistant command without specifying a function (i.e., simply typing the command, then a cr) the Programmer's Assistant executes the command using the function entered at the previous prompt. Here are a few more examples of using the programmer's assistant: G.a TYPING SHORrCUff 1 TYPING SH0RTCUTS NIL 54k[PLUS 4 5) 9 55~REDO 9 56#?? 54 +(PLUC~ 4 5) 9 56~(SETQ B `80Y) BOY 5'~B BOY 59" UNDO cETQ SETQ undone. 59'.B UN8OUND nTOM B SBkREDO 56 BOY 6IkB BOY 62# Fq�ur� 6.3. Some Applications of the Programmer's Assistant 6.1 If you make a Mistake Editing in the Interlisp-D Executive Window is explained in Section 11.2, Page 11.2. In this section, only a few of the most useful commands will be repeated. To move the caret to a new place in the command being typed, point the mouse cursor at the appropriate position, and press the leff mouse button. To move the caret back to the end of the command being typed, press CONTROL-X. (Hold the CONTROL key down, and type �.X.'.) The way you choose to delete an error may depend on the amount you need to remove. To delete: The character behind the caret simply press the backspace key The word behind the caret press CONTROL-W. (Hold the CONTROL key down, and rype `�W'�.) Any part of the command, first move the caret to the appropriate place in the command. Hold the right mouse button down and move the mouse cursor over the ten. All of the blackened tert between the caret and mouse cursor is deleted when you release the right mouse button. TYPING SHORTCUTS 63 IF YOU MAKE A MISTAKE The entire command press CONTROL-U. (Hold the CONTROL key down, and type in".) Deletions can be undone. Just press the UNDO key. To add more text to the line, move the caret to the appropriate position, and just type. Whatever you type will appear at the caret. 6.4 TYPING SHORTcUTS ----- Next Message ----- Date: 19 Dec 91 14:48 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.144827pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11544>; Thu, 19 Dec 1991 14:48:38 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 14:48:27 -0800 From: John Sybalsky -----RFC822 headers----> 7. USING MENUS The purpose of this chapter is to show you how to use menus. Many things can be done more easily using menus, and there are many different menus provided in the Interlisp-D environment. Some are "po~up" menus, that are only available until a selection is made, then disappear until they are needed again. An example of one of these is the "background menu", that appears when the mouse is not in any window and the right mouse button is pressed. A background menu is shown in Figure 7.1. Yours may have different items in it. SkGtL'h LUop3 Icon CHAT F.lle0ro~er sav"VM 5nap Figure 7.1. A hackground menu. Another common pop-up menu is the right button default window menu. This menu is explained more in Section 10.4, Page 10.3. Other menus are more permanent, such as the menu that is always available for use with the Interlisp-D Filebrowser. This menu is shown in figure Figure 7.2, and the specifics of its use with the filebrowser is explained in Chapter 9). Dnjelsta Rcname Hor~'UpJ -=`ffl.e Compil'. E~prnnge Recrjm Ut.fl,L' Figure 7.2. The menu that is available when using the Filehrowser USING MENUS 71 I MAKING A SELEcTION FROM A MENU 7.1 Making a Selection from a Menu To make a selection from a menu, point with the inouse to the item you would like to selert If one of the moU5e buttons is already pressed, the menu item 5hould blacken. If it is a permanent menu, you must press the leff mouse button to blacken the item. When you release the button, the item will be chosen. Figure 7.3 shows a menu with the item "Undo" chosen. � �1 .lffer Bpfor', GeIer~, Replace `witch ( `3 LIt. Find `=w~ pcpflnt Edt Edfl-Um 0~ik Eva E.xit Figure 73. A menu with the item "Undo" chosen 7.2 Explanations of Men.u Items Many menu items have explanations associated with them. If you are not sure what the consequences of choosing a particular menu item will be, blacken the menu item, and do not release the leff button. If the menu item has an explanation associated with it, the explanation will be printed in the prompt window. Figure 7.4 shows the explanation associated with the item "Snap" from the background menu. ile0row~or Flguv� 7.& The explanation associated with the cliosen item, Snip, is displayed in the prom pt window. 7.2 USING NENuS I SUBMENUS 7.3 Submenus Some menus items have submenus associated witl, them. This means that, for these items, you can make even more precise choices if you would like to. A submenu can slso be found in one of two ways. One is to point to the item with the mouse cuttor, and press the middle mouse button. If there is a submenu associated with that item, it will appear. (See Figure 7.5.) �l Atter 8e?are DoloCe Replace Yvitch `ut l)nda Find cap Repnnt Edit EditL'om Break Eva OK TOP FigurQ 7.5. The submenu associated with the menu item Exit It appeared when the mouse curtor Pointed to the menu item. and the middle mouse button was pressed. A submenu can be indicated by a gray arrow to the right of the menu item, like the one to the right of the "Hardcopy'� choice in Figure 7.1. To see the submenu, blacken the menu item, and move the mouse to follow the arrow. An example of this is shown in Figure 7.6. Choosing an item from a submenu is done in the same way as choosing an item from the menu. Any submenus that might be associated with the items in the submenu are indicated in the same way as the submenus associated with the items in the menu. Dnclelete .~ . Copy Rename Harjcopv .=.ee ~~e~; Loa.d c'.Ee!T.: E,puni~e P',com Ll!e� Figure 7.6. The submenu associated with the menu item Edit - It appeared when the menu item was blackened, and the mou>e was moved (0 follow the gray arrow. In summary, here are a few rules of thumb to rerrember about the interactions of the mouse, and system menus: � Press the leff mouse button to select an item of a menu � Press the middle mouse button to get more options - one of the ways to find a submenu USING MENUS 73 SUBMENU5 � Press the right mouse button to see the default right button window menu, and the background menu 7.4 usiNG MENUS ----- Next Message ----- Date: 19 Dec 91 14:56 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.145658pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11659>; Thu, 19 Dec 1991 14:57:09 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 14:56:58 -0800 From: John Sybalsky -----RFC822 headers----> 8. MOW TO USE FILES 8.1 Types of Files A program file, or lisp file, contains a series of expressions that can be read and evaluated by the lnterlis~D interpreter. These expressions can include function or macro definitions, variables and their values, properties of variables, and soon. How to save Interlisp-D expressions on these files is explained in Section 11.6, Page 11.7. Loading a file is explained below, in Section 8.6, Page 8.4. Not all files, however, have lnterlis~D expressions stored on them. For example, TEdit files (see Chapter 23) store tert; sketches are stored on files made with the package Sketch (see Chapter 35), or can be incorporated into TEdit files. These files are not loaded directly into the environment, but are accessed with the package used to create them, such as TEdit or Sketch. When you name a file, there are conventions that you should follow. These conventions allow you to tell the type of a file by the extension to its name. If a file contains: Interlisp-D expressions, it should not have an extension. For example, a file called "MYCODE" should contain lnterlis~D expressions; compiled code, it should have the extension" .DCOM'�. For example, a file called `�MYCODE.DCOM" should contain compiled code; a Sketch, then its extension should be ".SKETCH��. For example, a file called �`MOUNTAlNS.SKETCH" should contain a Sketch; text, it should have the extension ".TEDlT�'. For example, a file called `�REPORT.TEDlT'� should contain text that can be edited with the editor TEDlT. 8.2 Directories This section focuses on how you can find files, and how you can easily manipulate files. To see all the files listed on a device, use the function DIR. For example, to see what files are stored on the Y;ard disk, type (DIR (DSK)) HOW TO USE FILES B1 DlR�G0R1E5 To see what files are stored on the floppy disk inside of the floppy drive, type (DIR (FLOPPY)) Partial directory listings can be gotten by specifying a file name, rather than just a device name. The wildcard "�`� can be used to match any number of unknown characters. For example, the command (DIR (DSK)T�) will list the names of all files stored on the hard disk that begin with the letter T. An example using the wildcard is shown in Figure 8.1 `DIR `(P\h',(LI'.\PFIL�.'.'PRIMER~T';l `LPQh/''.LI."'l FILE.C\,'PRIMER\ Tsi'REF.>.TEP[1)2 T6LlClNT.TEDIT,1 FigurG 8.1. Using the function DIR with a wildcard 8.3 Directory Options Various words can appear as extra arguments to the DIR command. These words give you extra information about the files. (1) SIZE displays the size of each file in the directory. For example, type (DIR (DSK) SIZE) (2) DATE displays the creation date of each file in the directory. An example of this is shown in Figure 8.2 35~(DIR (DsxJ.PRIMER~T* DATE) CREATIDNOATE (�DSK)'LI5PFILES~PRIflER? TA'1"REF~TEPlT;2 26-lun-R5 19:A,O:R2 TBLnrnNT.TEDIT;1 26-lun'66 ja:4R~�? 3Lq~ . . . . . . : . . . . . . . . . . . .. . . . . . .. . . . . Figure 8.2. An eximpie using th� dir�ctory option DATE (3) DEL deletes all tho files found by the directory command G.a H0W TO USE FILES SU�FlLE DlREO0RlES 8.4 Subfile Directories Subfile directories are very helpful for orgonizing files. A set of files that have a single purpose, for example all the external documentation files for a system, can be grouped together into a subfiledirectory. To associate a subfile directory with a filename, simply include the desired subfile directory as part of the name of the file� Subfile directories are specified after the device name and before the simple filename. The first sibfile directory should be between less-than and greater-than signs < >, with nested subdirectory names only followed by a greater-than sign >� For example: [DSK)SubOlmctory>SrnbSubDir�ctor-y>.. .>fi1on~ 8.5 To See What Files Are Loaded If you type FILELST, the names of all the files you loaded will display. Type SYSFILES, to see what files are loaded to create the SYSOUT. 8.6 Simple Commands for Manipulating Files The following commands will work with the (FLOPPY) and other devices, but have been shown with (DSK) for simplicity� To have the contents of a file displayed in a window: (SEE `[DSK)f11�nrn) To copy a file: (coPYFILE `[~)o1dfi1�n~ `[DSF)ne,r,,ilonrn) An example of this is shown in Figure 8.3 (sOPvFILE `T~0r,R�Fc.TEDIT `PF;IMEFR�EFO�.T�DITJ t'Dcxl,(.LIsPFILEs.PRIM�P.;�.PRIMEP.fiEFs.TEDIT;1 Figure 8.3. An example of the use of the function COPYFILE To delete a file: (DEl.FIL� `(~)fi1on~) An example of this is shown in Figure 8.4. � ,, OELFIL� `L'AMPLE.TEPITJ � . \l.. I'PfILE;'."PRIMER?>AnPLE.T�PIT;1 FigureS.O. The function DELFlLE To rename a file: (RENlEFILE �(osK)oldftl�nrn `(rSF)ner,r11�n~) HOW TO USE FILES 83 1 SIMPLE COMMANDS FOR MANIPULATING FILES "LOAD" a file: Files that contain Interlisp-D expressions can be loaded into the environment. That means that the information on them is read, evaluated, and incorporated into the Interlisp-D environment. To load a file, type: (LUG `[DSff)filenm) When using these functions, always be sure to specify the full filename, including subfile directories if appropriate. 8.7 Connecting to a Directory Offen, each person or project has a subdirectory where their files are stored. If this is your situation, you will want any files you create to be put into this directory automatically. This means you should "connect" to the directory. CONK is the Interlisp-D form that connects you to a directory. For example, COilKin the following figure: - 1 l 11 29#(L'OtJN ``CDv~K1,.LIv"PFILES~\PP,IMER7IM\,!,I t'OS'Y96)cLIy'PFIL�Cv;~PRIh1�R.~lM> 30# Fqrnre 8.5. COflffeaing to the subdiredory "PRIMERs srnbsu~i'edory ,.lM" connects you to the subsubdirectory iM, in the subdirectory PRIMER, in the directory LlSPFlLES, on the device D5K. This information, the device and the directory names down to the subdirectory you want to be connected to, is called the "path" to that subdirectory. co:: expects the path to a directory as an argument. Once you are connected to a directory, the command DIR will assume that you want to see the files in that directory, or any of its subdirectories. Other commands that require a filename as an argument (e.g., SEE, above) will assume, if there is no path specified with the filename, that the file is in the connected directory. This will often save you typing. 8.8 File Version Numbers Whe.n stored, each file name is followed by a semicolon and a number. fffILE.TEOIY;1 The number ii the vertion number of the file. This is the system's way of protecting your files from being overwritten. Each time the file is written, a new file is created with a vettion number one 8.1 HOW T0 us: FILES FILE VERSION NUMBERS greater than the lost. This now fle will hove everything from your previous file, plus all of your changes. In most cases, you can exclude the version number when referencing the file. When the vertion is not specified, and there is more that one vertion of the file on that particular directory, the System generally uses your most recent version. An exception is the function DELFILE, which deletes the oldest version (the one with the lowest vertion number) if none is specified. HOW TO USE FILES as ----- Next Message ----- Date: 19 Dec 91 15:03 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.150359pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11664>; Thu, 19 Dec 1991 15:04:10 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 15:03:59 -0800 From: John Sybalsky -----RFC822 headers----> tO.THOSE WONDERFUL WINDOWS! A window is a designated area on the screen. Every rectangular box on the screen is a window. While Interlisp-D supplies many of the windows (such as the lnterlis~D executive window), you may also create your own. Among other things, you will type, draw pictures, and save portions of your screen with windows. 10.1 Windows provided by Interlisp-D Two important windows are available as soon as you enter the lnterlis~D environment. One is the lnterlis~D executive window, the main window where you will run your functions. It is the window that the caret is in when you turn on your machine, and load lnterlis~D. It is shown in Figure 10.1. Figure 10.1. Interlsp-D Executive Window The other window that is open when you enter Interlisp-D is the "Prompt Window". It is the long thin black window at the top of the screen. It displays system prompts, or prompts you have associated with your programs. (See Figure 10.2.) Figure 10.2. Prompt Window Other programs, such as the editors, also use windows. These windows appear when the program starts to run, and close (no longer appear on the screen) when the program is done running. THOSE WONDERFUL WINDOWS' 101 CREATING A WINDOW 10.2 Creating a window To create a new window, type: (CREATEil). The mouse cursor will change, and have a small square attached to it. (See Figure 10.3.) Figure 10.3. The mouse cursor asking you to sweep out a window There may be a prompt in the prompt window to create a window. Press and hold the leff mouse button. Move the mouse around, and notice that it sweeps out a rectangle. When the rectangle is the size that you'd like your window to be, release the leff mouse button. More specific information about the creation of windows, such as giving them titles and specifying their size and position on the xreen when they are created, is given in Section 27.1.2, Page 27.2. 10.3 The Right Button Default Window Menu Position the cursor inside the window you just created, and press and hold the right mouse button. A menu of commands should appear (do not release the right button!), like the one in figure 10.4. To execute one of the commands on this menu, choose the item. Making a choice from a menu is explained in Section 7.1, Page 7.2. clQ1,�/ Pant `[oar Bury RoJisplay Hardsopy~ Movc `5hape shrink Figur� 1O.& The Right Button Default Window Menu As an example, select "Move" from this menu. The mouse cursor will become a ghost window Oust an outline of a window, the same size as the one you are moving), with a square attached to one corner, like the one shown in Figure 10.5. ~l ~l F~ure 10.1 Th� mous� cunor !or moving & window Move the mous� around. The ghost window will follow. Click the left mous� button to plac� tho window in a new location. 10.1 TH0Sff w0NKQFUL WlH00~l f THE RIGHT 8Uff0N DEFAULT MN00~ MFNU Choose "Shape", afid notice that you are prompted to sweep out another window. Your original window will have the shape of the window you sketch out. 10.4 An explanation of each menu item The meaning of each right button default window menu item is explained below: Close removes the window from the screen; Snap copies a portion of the screen into a new window; Paint allows drawing in a window; Clear cleart the window by erasing everything within the window boundaries; Bury puts the window beneath all other windows that overlap it; Redisplay redisplays the window contents; Hardcopy sends the contents of the window to a printer or to a flle; Move allows the wi ndow to be moved toanew spot on the screen; Shape repositions and/or reshapes the window; Shrink reduces the window to a small black rectangle callecl an icon. (See Figure 1O6.) Figum lO.L An example icon Expand changes an icon back to iB original window. Position the mouse cursor on the icon, depress the right button, and select Expand. Or, just button the icon with the middle mouse button. These right-button default window menu selections are available in most windows, including the lnterlis~D Executive window. When the right button has other functions in a window (as in an editor window), the right button default window menu should be accessible by pressing the Right button in the black border at the top of the window. 10.5 Scrollable Windows Some windows in Interlisp-D are "scrollable". This means that you can move the contents of the window up and down, or side to side, to see anything that doesn't fit in the window. Point the mouse curtor to the leff or bottom border of a window. If the window is scrollable, a "scroll bar" will appear. THOSE WONDERFlJL WINDOWS' 103 SCROLLABLE WINDOWS The mouse cursor will change to a double headed arrow. (See Figure 10.7.) . 1 , 1 Figuro 10.7. The scrolJ bar of a scrollable window. The mouse cursor changes o a double headed arrow. The xroll bar represents the full contents of the window. The example scroll bar is completely white because the window has nothing in it When a part of the scroll bar is shaded, the amount shaded represents the amount of the window's contents currently shown. If everything is showing, the scroll bar will be fully shaded. (See Figure 10.8.) The position of the shading is also important. It represents the relationshi'p of the section currently diplayed to the the full contents of the window. For example, if the shaded section is at the bottom of the scroll bar, you are looking at the end of the file. 1 � . The amount of :>hadin~ in A::;:. the scroll bar represents the amount of the rile ;>hown in the window. Most of the file is visible. Because the shading is at the tap of the scroll bar, you know you are looking at the top of the file. Figur� 10.1 Tho amount of shading in the scroll bar represents the amount of the file shown in the window. Most of the file is visible. Because the shading sat the top of the scroll bar. you know you are looking at the top of the file When the scroll bar is visible, you can control the section of the window's contents displayecl: � To move the contents higher in the window (scroll the contents up in the window), press the leff button of the mouse, the mouse cursor changes to look like this: Fun 10.1. upward icrollinq cuttor. The contents of the window will scroll up, making the line thit the cursor is beside the topmost lin� in the window. 10.4 THo$a ~HOERFUL~~w51 SCROLLASLE MN00~S � To move the contonts lower in the window (scroll the contents ��down" in the window), press the right button of the mouse, ond the mouse cursor changes to look like this: Flgrnro 10.10. Oownw�rd scrollinq curtor The contents of the window scroll down, moving the line that is the topmost line in the window to beside the curtor. � To show a specific section of the window's contents, remember that the scroll bar represents the full contents of the window. Move the mouse curtor to the relative position of the section you want to see (e.g., to the top of the scroll bar if you want to see the top of the window's contents.). Press the middle button of the mouse. The mouse cursor will look like this: f'9ure 10.11. Proportional scrolling crnrtor. When you release the middle mouse button, the window's contents at that relative position will be displayed. 10.6 Other Window Functions 10.6.1 PROMPTPRlNT Prints an expression to the black prompt window. For example, type (P~PTPRIKT �TNIS SILL BE PRIKTED I* THE PAT UIKOoS') The message will appear in the prompt window. (See Figure 10.12.) 1 . �1 Il 43 lpROMPTPRINT `THIS WILL BE PRINTED IN THE PROMPT WINDOW') Flurf 10.12. PROMPTPRlNTing THOSE WONDERFUL WINDOWS' 10.5 OTHER WINDOW FUNCTIONS 10.6.2 WHlCNW Returns as a value the name of the window that the mouse cursor IS in. (VHICHW) can be used as an argument to any function expecting a window, or to reclaim a window that has no name (that is not attached to some particular part of the program.). 10.6 THOil wONOERFUL~N00vn' ----- Next Message ----- Date: 19 Dec 91 15:18 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.151815pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11655>; Thu, 19 Dec 1991 15:18:21 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 15:18:15 -0800 From: John Sybalsky -----RFC822 headers----> tl. �DlTUNG AND SAVING This chapter explains how to define functions, how to edit them, and how to save your work. 11.1 Defining Functions DEFINEQ can be used to define new functions. The syntax for it is: (HFIffEQ ( (j> New functions can be created with DEFINEQ by ryping directly into the lnterlis~D executive window. Once defined, a function is a part of the lnterlis~D environment. For example, the function EXANPLE-ADDER is defined in Figure 11.1. - HIL 46=(OEFINEQ (E.~AMPLE-rt"D&ER (~" B cJ (PRINT `THE SUM OF THE THREE NUMBERS Is ") (IPLUS n" B CJJJ (EXn~MPLE-~&DERj 47- F1ure 11.1. Defining the function EXAMPLE�ADDER Now that the function is defined, it can be called from the lnterlis~D executive window: � . - NIL 49'. cEX~-MPLE-ffD&ER 3 4 `J; "THE SUM OF THE THREE NljMBERS 15 12 c~g Fq'rnre IIJ. After EXAMPL��ADDER is defined, it can he executed The function returns 12, after printing out the message. Functions can also be defined using the editor DEdit described above. To do this, simply type (DF furttiorvnamej EDITING AND SAVING 111 1 DEFINING FUNCTIONS You will be asked whether you would like to edit a Dummy definition. A dummy definition is a standard template for your function definition. Answer by typing Y for Yes, and you will be able to define the function in the editor. (See Figure 11.3. The use of the editor is explained in Section 11.3, Page 11.4.) � h.'1,flF PJ�~-HOT'E'['�Ti � Ho FH~., dean ;or oil NflT-E�� 1:-7, on �oU Ui `;�h ro ?dlr a `lu 60A "Fl��;:�l Figurn 11.1 Using DEdit to define a function II _ 2 _ Simple _ Editing _ in _ the _ Interlisp-D _ Executive Window First, type in an example function to edit: 51~(oEFIxEQ (Y~R-FIRST-fuKTIrn (A B) (if (GREATERP A B th�n TNE FIR T IS GREATER els� THE SECO*O IS 6REATE )))) To run the function, type (YOUR-FIR$T-FUflcTIoa 3 5). 52~(Y~R-FIRST-Fu~TI: 3 5) (TNE SEc~ Is GREATER) Now, let's alter this. Type: 53~FIZ 51 cr Notf that your original function is redisplayed, and ready to edit. (SeeFigure 11.4.) llJ EO1Y1~ AHO SAVING r, SIMPLE EDITING IN TNE INTERLISP�D EXECUTIVE WIND0W NIL 53~FI~ 51 +(DEFINEQ [YOUR-FIRST-FUNCTION (A B) (� edited; "~1-Dec-GB 19;"8") (IF (GREaTERP�A B) THEN (QUOTE (THE FiRST Is UREATERj) ELSE (QUOTE (THE SECOND IS u'RE~~TER] 1A f~ur�11.& Using FIX to editafundion Move the tert cursor to the appropriate place in the function by positioning the mouse cursor and pressing the Jeff mouse button. Delete text by moving the caret to the beginning of the section to be deleted. Hold the right mouse button down and move the mouse cursor over the text. All of the blackened text between the caret and mouse cursor is deleted when you release the right mouse button. If you make a mistake deletions can be undone. On an 1108, press the OPEN key to. UNDO the deletion. On an 1108, press the UNDO key on the keypad to the Jeff of the keyboard. Now changeGREATERtoBIGGER: (1) Position the mouse cursor on the G of GREATER, and click the leff mouse button. The text curtor is now where the mouse cursor 15. (2) Next, press the right mouse button and hold it down. Notice that if you move the mouse cursor around, it will blacken the characters from the text cursor to the mouse cursor. Move the mouse so that the word "GREATER" is blackened. (3) Release the right mouse button and GREATER is deleted. (4) Without moving the cursor, type in BIGGER. (5) There are two ways to end the editing session and run the function. One is to type CONTROL-X. (Hold the CONTROL key down, and type "X".) Another is to move the text cursor to the end of the line and cr� In both cases, the function has been edited! Trythe new version of the function bytyping: 58~(Y~-FZRST-F~Tzrn 8 9) (TN� sEc~ Is BIKER) and get the new result, or you can type: 5~RE00 52cr (TNE SEc~ Is BIKER) EDITING AND SAVING 11.3 USING THE LIST STRUaURE EDITOR 11.3 Using The List Structure Editor If the function you want to edit is not readily available (i.e. the function is not in the Interlisp-D Executive window, and you can't remember the history list number, or you simply have a lot of editing), use the List Structure Editor, offen called DEdit. This editor is evoked with a call to OF: 81~(DF YWR-FIRST-f~TIa) Your function will be displayed in an edit window, as in Figure 11.5. If there is no edit window on the screen, you will be prompted to create a window. As before, hold the leff mouse button down, move the mouse until it forms a rectangle of an acceptable size and shape, then release the button. Your function definition will automatically appear in this edit window. !L~nb&A IA Bj (* OJtfJ' ��:�1�O:cw `~;`~``� .~.tr~r (IF 113'REATEPP A B'i EqV;r~ THEN iO�UUTE "THE ::.p�'.T f ~Ir,GER),l cl,,t' ELSE 1~UUTE THE .=�E.u'N& j:. eluh'ER;J)) 4ep~:c /``tC.h . Un~io Find Rcorint cit. EOlfl/C T7~ Sr:ok E�.. y E..t. Figur� Il.L An Edit Window Many changes are easily done with the structure editor. Notice that by pressing the left mouse button, different expressions are underlined. Underline BIGGER as in Figure 11.5. Release the left mouse button. To add an expression that doesn't appear in the edit window, (i.e. it can't simply be underlined), just type it in. Doing this will create an edit buffer below the DEdit window. For example, type LARGER and hit cr� (Remember to cr! You won't be able to do anything in the editor until you cr - this can fool you at first, so beware.) A new window opens up at the bottom for the new expression. (See Figure 11.6.) LARGER now has the bold line underneath it, while BIGGER has a dotted line. A 11.4 EDITING ~O ~VING USING THE LIST STRUCTURE EDITOR , LAMDOA VA B\ ~� �dlt�d `�3' �O�c 00 l F;3Q'�) ArtOr VV (OREATERP A B) Befom ~ VQUOTE -THE FIRST Is 816OER)) cOIOtO (15 (QUOTE VTHE SEL'ONO IS BIW~Ry,\.i Ropl&ce witch ( ) y)out Unoo Find wap FQum Il.L Edit Window with Edit Buffer DEdit keeps track of items you have chosen by Using a stack. The underlines tell you the order of the items on the stack. The solid underline indicates the item on the top of the stack; the dotted underline indicates the second to the top. (liIGGER was pushed on first. When LARGER was pushed on, BIGGER became the second element in the "stack", and LARGER the first.) Many commands operate with two items on the stack. Some of them are listed below: Atter pops the stack, and adds this top item (in this example, LARGER) to the edit window affer the second item on the stack(in this example, BIGGER). The item that was at the top of the stack, LARGER, will now appear in both the original and the new position. Before pops the stack, and adds this top item (in this example, LARGER) to the edit window before the second item on the stack. (See Figure 11.7.) (LAKBDA VA 8' C' oJ'lfG `3,-Ooc�~ ~F;l.O�� ,~rtOr (IF VGREATERp A 8J E~'inre ~ (QUOTE (THE FIRST IS ~`R ,8�IUGEP); cOlGte ELI (QUOTE (THE SECOND IS 8I,�b'E .j! ,1J F!Gplace itch r tJut Undo Find ,=-.i,1r P.O~rir,t Eda fiUre 11.7. The command Before is chosen; the word LARGER appean Iefore the word BIGGER Replace pops the stack, and substitutes this top item for the second item on the stack. Sat tch changes the position of the first and second items on the stack in the edit window. Find pops the stack, and searches this top expression for an occurance of the second item on the stack. If the item is found, it is underlined with a solid line, that is, pushed on the stack. To find the next occurance, simply choose "Find" again. If the expression is not found, the prompt window will blink, and a EDITING AND SAVING 115 1 USING ~E LIST STRUCTURE EDITOR �sp�c1�11~ as�fa1 If yri ant to &p�c� ~r co�ants) There are other editor commands which can be very UsefUl. To learn about them, read to the lntertis~D Reffrence Manual, Volume 2, Section 16, on DEDIT. it .4 _ File _ Functions and _ Variables - _ How to _ See Them _ and _ Save Them With lnterlis~D, all work is done inside the "Lisp Environment". There is no "Operating System" or "Command Level" other than the lnterlis~D Executive Window. All functions and data strUctures are defined and edited using normal Interlisp-D commands. This sertion describes tools in the Interlisp-D environment that will keep track of any changes that you make in the environment that you have not yet saved on files, such as defining new functions, changing the values of variables, or adding new variables. And it then has you save the changes in a file you specify. 11.5 File Variables Certain system-defined global variables are used by the file package to keep track of the environment as it stands. You can get system information by checking the values of these variables. Two important variables follow. � FILELST evaluates to a list, all files that yoU have loaded into the lnteris~D environment. � filenameC0liS (Each file loaded into the Lisp environment has associated with it a global variable, whose name is formed by appending "COMS" to the end of the filename.) This variable evaluates to a list of all the functions, variables, bitmaps, windows, and soon, that are stored on that particular file. For example, if you type: ~FILEC0*s the system will respond with something like: FKS YouR-FZRST-Fu*CTIil ) VARS)) 11.6 Saving Interlisp-D on Files The functions (FILES?) and (NAKEFILE `filename) are useful when it is time to save function, variables, windows, bitmaps, records and whatever else to files. EDITING AND SAVING 117 I USING THE LIST STRUCTURE EDITOR message that the item was not found will appear. (See Figure 11.8 for an example of an item, the atom THIRD, not appearing in the function, YOUR-FIRST-FUKCTION. �1 L.flFBo~P~�~T\P _ B! (,`-.J'l-.J. _ .z' _ P..,n _ 1- THEN `c1.lcTE _ `THE _ FIPT _ ~I.'i'.EP'] ELSE 1�tlJlJTE _ HE _ `/E/l)MlD TrtI,,,v Sr.i El ET. Figw� 11.& The atom THIRD is not in the fundion being edited Saap changes places, on the stack, of the first and second items on the stack. The edit window does not change, except that the expression that had a solid underline now has a dotted underline, and vice versa. Delete works on only the top item of the stack. Delete removes the solid underlined expression from the edit window. Undo undoes the last editor command. Completing the example begun earlier, here's how to have the word LARGER that you typed into the edit buffer appear in place of the BIGGER that you selected from the DEdit window: select the SWITCH command. Notice that the two items are switched, and the stack is popped. Now select EXIT and to leave the editor, and your function will again be redefined. 11.3.1 Commenting Fundions Tert can be marked as a comment by nesting it in a set of parentheses with a star immediately after the left parenthesis. (� This ii th� Von of � c~rtt) Inside an editor window, the comment will be printed in a smaller font and may be moved to the far right of the code. Sometimes, however, centered comments are more appropriate. To center a comment, type ,, .... after the left parenthesis. � This co.oortt �111 rtot b� rnd to th� ?�r ri9ht of th� co5o� but �111 b� c�rtt�rd) It is also possible to insert Iinebreaks within a comment. A dash should be placed in the comment whcrev�r A carriag� return is needed. Thii feotur� allows several comm�nt1 to b� placed insid� one S.t of pir�ntheses. (� This co�oo.t �111 h t~~ at. t�o 1i�os. - 11.6 FIrING AND LAYING SAVING INTERLlSP-D ON FILES (FILES?) displays a list of variables that have values and are not already a part of any file, and then the functions that are not already part of any file. Type: (FILES?) the system will respond with something like: tb� variables: ~.VARIlLE cURREKT.tuRTLE.. to be du;ed. th� functions: RI6HT LEFT FOIAff liCK*Aa cLEAR-uREEil.. to be d~~. srit to s&y �bere th� abov� go? If you type Y, the system will prompt with each item. There are three options: (1) To save the item, type the filename (unquoted) of the file where the item should be placed. (This can be a brand new file or an existing file.) (2) To skip the item, without removing it from consideration the next time (FILES?) is called, type cr� This will allow you to postpone the decision about where to save the item. (3) If the item should not be saved at all, type J. NoilhQ re will appear afler the item. Part of an example interaction is shown in the following figure: HIL u31~(FILES,) Che variables: MY-'y'AR. To be di.imped. the functions: MY-SEcuNO-FUtllJTIJN, YJUP-FIP�oT'FUNi)TIJN to be dumped. want to say where the .ibove 30 �? `ye' (variables) NY-VAR Nowhere (runctions) NY-SELrnNO-FUN&'TION File name: E;~AMPL~ F~11.9. Part of an interaction using the function FILES? (FILES?) assembles the items by adding them to the appropriate file's COMS variable. (See Section 11.5, Page 11.7.) (FILES?) does NOT write the file to secondary storage (disks or floppies). It only upclates the global variables discussed in SectionIt.S. (NAKEFILE `Tl lena�e) actually writes the file to secondary storage. Files should only be writen when the time is set. If the time is not set, you will run into problems, such as not being able to copy your file. To check the time, typ� (riTE) If the date is correct, yoU can safely use IRE FILE. If it is riot correct, set the time with the function SETTIKE. To use it, type (SETTIKE date), where dat� isa string such as the one shown inFiguretl.10. it.a Eomlflll ANC SAVING I SAVING INTERUSP~ ON FILES NIL 97;k(SETTIME "10-Jul-86 15:08 2<8) "i6-Jul-86 15;08:22 EDT" 98+ Fq�urn 11.10. Using the SETTIKE function to set the date and time Once the time is set correctly, use the function MAKEFILE. Type: (liffEFILE `P.FILE.~) and the system will create the file. The function returns the full name of the file created. (i.e. (DSK)MY.FlLE.NAME.; 1). Note: Files written to (DSK) are permanent files. They can be removed only by the user deleting them or by reformatting the disk. Other file manipulation functions can be found in Section 8.6, Page 8.3. EDITING AND SAVING 119 I ----- Next Message ----- Date: 19 Dec 91 15:20 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.152031pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11670>; Thu, 19 Dec 1991 15:20:42 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 15:20:31 -0800 From: John Sybalsky -----RFC822 headers----> t3. FLEXIBILITY AND FORGIVENESS: CLISP AND DWIM CLlSP, (Conversational Lisp), and DWlM, (Do What Mean), are two Interlisp utilities that make life easier. 13.1 CLlSP CLlSP allows the machine to understand and execute commands given in a non-standard way. For example, Figure 13.1 contains an example expressi on (4 + 5). NIL b'4-iJ + 5; 9 85' F9ure 13.1. cLlsP allows the use of infix notation Without CLlSP, you would need to type this using the notation (PLUS 4 5). CLlSP allows you to use expressions such as (4 + 5) for all arithmetic expressions. CLlSP also allows you to use more readable forms inrtead of standard Lisp control structures. Expressions like IF-THEN-ELSE statements can replace COND statements. For example, instead of: (CIO 1J6RE(APLTUESRPBA B (PLUS A 10)) 10 the following can be used: (if (A ~ B) then (A + 10) else (B + 10)) The system translates this CLlSP code into Interlisp-D code. Setting flags will allow you to either save the CLlSP code, or save the translation. One such flag is CLISPIFTRANFLG; if it is set to ffIL, all the IF statements will be replaced with the equivilent CORD statements. This means that when you DEdit the function, the IF will be removed and replaced with the CORD. Typically, flags such as this one are set in your INlT file. These flags are dixussed in the Intertlsp-D Reference Manual in Volume 2, Section 21. FLEXIBILITY AND FORGIVENESS. cLIsP AND DWIM 13 I I OWlM 13.2 DWlM DWlM tries to match unrecognized variable and function names to known ones. This allows Lisp to interpret minor typing errors or misspellings in a function, without causing a break. Line 87 of Figure 13.2 illustrates how the misspelled 0ANNANNA was replaced by 8ANANA before the expression was evaluated. NIL a7(8ETQ� 8~�N.HA `FRUITj FRUIT 38'8nNN,,~NNA =8,,'H,,NA FRUIT 39' Figure 13.2. Examples of CLlSP and DWlM features Sometimes DWlM may alter an expression you didn't want it to. This may occur if, for example,a hyphenated function name (eg. (NY-FUNCTION)) is misused. If the system doesn't recognize it, it may think you are trying to subtract "FUN~lON" from "MY". DWlM also takes the liberty of updating the function, so it will have to be fixed. However, this is as much a blessing as a curse, since it points out the misused expression! 13.2 F~1lUM AND ~ROVENES$: cub AND OWN I ----- End Forwarded Messages ----- Figure 13.2. Examples of CLlSP and DWlM features Sometimes DWlM may alter an expression you didn't want it to. This may occur if, for example,a hyphenated function name (eg. (NY-FUNCTION)) is misused. If the system doesn't recognize it, it may think you are trying to subtract "FUN~lON" from "MY". DWlM also takes the liberty of updating the function, so it will have to be fixed. However, this is as much a blessing as a curse, since it points out the misused expression! 13.2 F~1lUM AND ~ROVENES$: cub AND OWN I ----- End Forwarded Messages ----- -TIMESROMAN -VH(DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8) (POSTSCRIPT (GACHA 8))) -E(z� \ No newline at end of file diff --git a/docs/primer/DRAFT2.TEDIT b/docs/primer/DRAFT2.TEDIT deleted file mode 100644 index f8837033..00000000 --- a/docs/primer/DRAFT2.TEDIT +++ /dev/null @@ -1,6 +0,0 @@ -Second Group Date: 19 Dec 91 18:11 PST (Thursday) Posted-Date: 19 Dec 91 18:19 PST From: John Sybalsky:PARC:Xerox Subject: more primer files. To: porter:mv:envos >>CoveringMessage<< ----- Begin Forwarded Messages ----- Date: 19 Dec 91 15:28 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.152817pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11662>; Thu, 19 Dec 1991 15:28:23 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 15:28:17 -0800 From: John Sybalsky -----RFC822 headers----> F- 14. BREAKPACliGE The Break Package is a part of Interlisp that makes debugging your programs much easier. 14.1 Break WindoNT A break is a function either called by the programmer or by the system when an error has occurred. A separate window opens for each break. This window works much like the Interlisp-D Executive Window, except for extra menus unique to a break window. Inside a break window, you can examine variables, look at the call stack at the time of the break, or call the editor. Each successive break opens a new window, where you can execute functions without disturbing the original system stack. These windows disappear when you resolve the break and return to a higher level. 14.2 Break Package Example This example illustrates the basic break package functions. A more complete explanation of the breaking functions, and the break package will follow. The correct definition of FAGTORIAL is: (DEFIKEQ (FMT0RIAL (xj then 1 (if�f5� (ITIES x (f~ToRIAL (sue, xj To demonstrate the break package, we have edited in an error: DUffKY in the IF statement is an unbound atom, it lacks a value. (D�FIKEQ (F~T0RIAL (xj then ~ (if~[~~ (ITIKES x (FACTORIAL ~suei xj The evaluated function (F~T0RI~ 4) should return 24, but the above function has an error. DUMMY is an unbound atom, an atom without an assigned value, so Lisp will "break". A break window appears (Figure 14.1), that has all the functionality of the typing Interlisp-D expressions into the lnterlis~D executive window (The top level), in addition to the break menu functions. Each consecutive break will move to another level "down". BREAK PACKAGE 141 BREAK PACKAGE EXAMPLE 51+(PP Fllu'T&RIAL) cFACTORlAL [LA'NBOR ! `.j "�rOMn�NT~� (if (EROP `~ i,,ien Dummy 6Jil (lTIflEc A !FR~TORIAL !.UB1 :~j; !FACTCPIALj 5?(FALTORIAL 4,1 DUMMY (in FAi',TORlALJ in =ERDP P1!t4flY only br'ok�on! Figuro I..l. Break window Move the mouse cursor into the break window and hold down the middle mouse button. The Break Menu will appear. Choose BT. Another menu, called the stack menu, will appear beside the break window. Choosing stack items from this menu will display another window. This window displays the function's local variable bindings, or values. (See Figure 14.2) This new window, titled FACTORlAL Frame, is an inspector window. (See inspector Chapter 32). Sr fau'TUR[AL EP.PoM5ET fiRE&1 UNBOUND ATOM LflQ DUMMY (in fAcTORIAL) in \(ZEROP x) DUMMY) cob � FL�iDRI~ (DUMMY broken) cob FkWRl~ L.OB F,c~RI~ L'4M0 Figun 14.3. Back Yraco of trio 5ystem Stack From the break window, you can call the editor for the function FACTORIAL by typing (OF F~15IL) Underline X. Choose EVAL from the zditor menu. The value of X at the time of thff break will appear in the edit buffer below tho editor window. Any list or atom can be evaluated in this way (See Figure 14.3.) 14.1 lRF~PACMA'GF BREAK PACKAGE EXAMPLE UNBOUND ATOM � DUMMY (in FACTORIAL ~ (ITIKES x \�fASTORIAL ~SUB1 X))))) Replace switch ( ) � (DUMMY broken) ()cUt OF FAL'TORIAL) Undo Find Swop Reprint Edit EatCam Break E~a1 E.t Figure 14.3. Editing from the Break Window Replace the unbound atom DUffNY with 1 � Exit the editor with the EXIT command on the editor menu. The function is fixed, and you can restart it from the last call on the stack (It does not have to be started again from the Top Level) To begin again from the last call on the stack, choose the last (top) FACTOR1AL call in the BT menu. Select REVERT from the middle button break window, or type it into the window. TThe break window will close, and a new one will appear with the message: FACTORlAL broken. To start execution with this last call to FACTORIAL, choose OK from the middle button break menu. The break window will disappear, and the correct answer, 24, will be returned to the top level. 14.3 _ Ways to _ Stop _ Execution _ from the _ Keyboard, called _ "Breaking _ Lisp" There are ways you can stop execution from the keyboard. They differ in terms of how much of the current operating state is saved: Control-G provides you with a menu of processes to Interrupt. Your process will usually be �` EXEC". Choose it to break your process. A break window will then appear. Control-B causes your function to break, saves the stack, then displays a break window with all the usual break functions. For information on other interrupt characcers, see the Interlisp Reference Manual, volume 111, page 30.1. 8REAKPAcKAG� 14.3 I PROGRAMMING BREAKS AND DEBUGGlNG CODE 14.4 Programming Breaks and Debugging Code PrOgramming breaks are put into code to cause a break when that section of code is executed. This is very useful for debugging code. There are 2 basic ways to set prOgramming breaks: (BREAK functionna:e) This function call made at the tOp level will cause a break at the start of the execution of "functionname". This is helpful in checking the values of parameters given to the function. Setting a break in the editor Take the function that you want tO break into the editor. Underline the expression that should break before it is evaluated. Choose BREAK on the editor command menu. Exit the editor. The function will break at this spot when it is executed. Once the function is broken, an effective way tO use the break window for debugging is to put it into the editor window. (See Section 14.2, Page 14.2.) All the local bindings still exist, so you can use the editor's EVAL command to evaluate lists, variables, and expressions individually. Just underline the item in the usual way (move the mouse to the word or parenthesis and press the leff mouse button), then choose EVAL from the command menu. (See Section 14.2 for more detail.) Both kinds of programmed breaks can be undone using the (UNBREAK) function. Type (~KBRDF functionnm) Calling (UNBREAK) without specifying a function name will unbreak all broken functions. 14.5 Break Menu Move the mouse cursor into the break window. Hold the middle button down, and a new menu will pop up, like the one in Figure 14.4. OK BT BY! "a f~ure 14.& Th� middle bUtton menu in the Break window Five of the selection& are particularly important when just starting to use lnterlis~D: 8T Sack Trace displays the stack in a menu beside the break window. Back Trace is a very powerful debugging t00l. Each function call is placed on tho stack and removed when the execution of that function is complete. Choosing an item on th� stack will open another window displaying that item's local 1(. 8~xpAcl:AGE E~ BREAK MENU voriobles and their bindings. This is on inspector window thit offers all the power of the inspector. (For details, see the section on the Inspector, Chapter 32). ? Sefore you use this menu option, display the stack by choosing 8T from this menu, and choose a function from it. Now, choose 7: It will display the current values of the arguments to the function that has been chosen from the stack. ~ Move back to the previous break window, or if there is no other break window, back to the top level, the Interlisp�D Executive Window. REVERT Move the point of execution back to a specified function call before the error. The function to revert back to is, by default, the last function call before the break. If, however, a different function call is chosen on the BT menu, revert will go back to the start of this function and open a new break window. The items on the stack above the new starting place will no longer exist. This is used in the tutorial example. (See Section 14.2, Page 14.1.) OK Continue execution from the point of the break. This is useful if you have a simple error, i.e. an unbound variable or a nonnumeric argument to an arithmetic function. Reset the variable in the break window, then select OK. (See Section 14.2.) (Note: In addition to being available on the middle button menu of the break window, all of these functions can be typed directly into the window. Only ST behaves differently when typed. It types the stack into the trace window instead of opening a new window.) 14.6 Returning to Top Level Typing Control-D will immediately take you to the top level from any break window. The functions called before the break will stop, but any side effects of the function that occurred before the break remain. For example, if a function set a global variable before it broke, the variable will still be set afler typing Control-D. BREAK PACKAGE 14.5 1 ----- Next Message ----- Date: 19 Dec 91 15:51 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.155149pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11668>; Thu, 19 Dec 1991 15:51:54 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 15:51:49 -0800 From: John Sybalsky -----RFC822 headers----> 27. WINDOWS AND REGIONS 27.1 Windows Windows have two basic parts: an area Ofi the screen containing a collection of pixels, and a property list. The window properties determine how the window looks, the menus that can be accessed from it, what should happen when the mouse is inside the window and a mouse button is pressed, and soon. 27.1.1 CREATEW 5ome of the window's properties can be specified when a window is created with the function CREATEW. In particular, it is easy to specify the size and position of the window; its title; and the width of its borders. (CREATEW region title borderw'idth) Region is a record, named REGION, with the fields left, botto:. width, and height. A region describes a rectangular area on the screen, the window's dimensions and position. The fields left and botto� refer to the position of the bottom leff corner of the region on the screen. Vi dth and height refer to the width and height of the region. The usable space inside the window will be smaller than the width and height, because some of the window's region is consumed by the title bar, and some is taken by the borders. Title is a string that will be placed in the title bar of the window. Bordervvidtfr is the width of the border around the exterior of the window, in number of pixels. For example, typing: (SETQ ~.WIN~ CREATEW (CREAT RE6IS loo 150 300 200) THIS Is ~ r"w ilIN~� ) produces a window with a default borderwidth. Note that you did not need to specify all the window's properties. (See Figure 27.1.) wiNDows AND REGIONS 27 WINDOWS � ,.J[1.lGJ'J (�flf,,Tfff i'�CRE"TEPE,IrnN jvjw 5- `9;, �"~~i "TriI;' I> My ij'lN `ff Ibl&U'M' ii (~[N&JwlM2.65554 FigUre 27.1. Creating a Window In fact, if (CREATEW) is called without specifying a region, you will be prompted to sweep out a region for the window. (See Section 10.2, Page 10.2.) 27.1.2 WlNDOWPROP The function to access or add to any property of a window's property list is WIliDOVPROP. (WIN~PR0P window property ) When you use WIKDOWPROP with only two arguments - window and property - it returns the value of the window's property. When you use wIKOOVPROP with all three arguments - window, property and value - it sets the value the window's property to the value you inserted for the third argument. For example, consider the window, NY WINDOW, created using (CREATEW). TITLE and REGION are both properties. Type (ilI*~PW :.uI~ `TITLE) and the value of MY.WlNDOW's TITLE property is returned, "THIS 15 MY OWN WINDOW". To change the title, use the WINDOWPROP function, and give it the window, the property title, and the new title of the window. (wIK~PW ~.uI~ `TITLE �P FIRST ilIK~�) automatically changes the title and automatically updates the window. Now the window looks like Figure 27.2. 27.1 w1N00WS AND REG~NS WINDOWS 7�t'WINDOWfROP NV WINDOW TITLE) IS NV OWN WINDOW" s.(WINDOWPROP NY.WlNDOl4 TITLE `�QY FIRST WINDOW") THIS IS M\' OWN WINDOW" 4'. FigUre 27.2. TITLE is a Window Property Altering the region of the window, NY. VINDOV, is also be done with vINDOWPROP, in the same way you changed the title. (Note: changing either of the first two numbers of a region changes the position of the window on the screen. Changing either of the last two numbers changes the dimensions of the window itself.) 27.1.3 Getting windows to do things Four basic window properties will be discussed here. They are CURSORINFN, CURSOROUTFN, CURSORffOVEDFN, and BUTTONEVENTFN. A function can be stored as the value of the CURSORlNFN property of a window. It is called when the mouse cursor is moved into that window. Look at the following example: (1) First, create a window called MY.WlNDOW. Type: (SETQ P.WINDQW (CREATEI (cREATERE6Ia 200 200 200 200) "THIS WIllDOW WILL IREMl�)) This creates a window. (2) Now define the function SCREAMER. It will be stored on the property CURSOR1NFN. (Notice that this function has one argument, WlNDOWNAME. All functions called from the property CURSOR1NFN are passed the window it was called from. So the value of MY. WINDOW is bound to WlNDOWNAME. When it is called, SCREAMER simply rings bells. (DEFIN�Q (ScREMER (WIK~~E) RIilBELLS) PROlPTPRIlT TAT - IT WDRFSI") RIKBELLS))) (3) Now, alter that window's CURSORINFN property, so that the system calls the function SCREAMER at the appropriate time. Type: WlNDow5 AND REGIONS 273 WINDOWS (WIN~PRoP P.wINI;0II `cuR~RIaf� (F~IIk:TIK IR~R)) (4) Affer this, when you move the mouse cursor into MY.WlNDOW, the CURSORINFK property's function is called, and it rings beJls tvvice. CURSORINFN is one of the many window properties that come with each window - just as REGION and TITLE did. Other properties include: CURSOROUTFN The function that is the value of this property is executed when the cursor is moved out of a window; CURSORMOVEDFN the function that is the value of this property is executed when the cursor is moved while it is inside the window; BUTTONEVENTFN the function that is the value of this property is executed when either the Ieff or middle mouse buttons are pressed (or released). Figure 27.3 shows MY.WlNDOW's properties. Notice that the CURSORINFK has the function SCREAMER stored in it. The properties were shown in this window using the function INSPECT. INSPECT is covered in Chapter 32. . . ` 1 � GREEN NIL HI NOo'rtENTR'[FN O liE. TT'( PRObES PRfllESS NIL `,`181)ROER 4 NEWREL'I)NF4 NIL `NTITLE �THIS `ffiINDOW `tILL .QCREAn!" MOlEfN NIL CLOSEFN NIL HORIZOCROLL'.yIND1)',t NIL "ER1L'ROLLNINoO'ff NIL c.u'ROLLFN NIL H)RI=J-'cRlLLREG NIL ":`ERTSCR)LLREU NIL USERDATA NIL E!'!TENT NIL REOH4PEFN NIL REPAINTFN NIL L'URSORttOvEDFN NIL CURSOROUTFN NIL CURSORINFN SCCE'�ThER RIGHTBUTTONFN NIL BU1FONEVENTFN TOTOPU REG 12J0 "L)9 �J~ `36! SavE (BITMAP~��3,1jo52� NE~('t (WIflD1)'-'1j55,1'lj'..�8 DSP ~5TRE>M\,�~�F,jjjj~4 Figur� 27.3. Inspeaing MY.wlNDow for MouseRelated Window Properties You can define functions for the values of the properties CURSOROUTFK and CURSORMOVEDfN in much the same way as you did for CURSORINfN. The function that is the value of the property BUTTOHEVENTFN, however, cab be specialized to respond in different ways, depending on which mouse button is pressed. This is explained in the next section. 27.1.3.1 BUtrON�VENTFN BUTTONEVENTFK is anothqr property of a window. Tho function that is stored as tfl� valu� of this property is called when tho mouso is insid� tho window, and a mouso button is pressed. As an exampl� of how to us� iL type: 27A ~N00wS ANO REGIONS witurows (wI~PKP :.ilIK~ `euTTW"EKTtr (F~TI5 ScREA�ER)) When the mouse cursor is moved into the window, bells will ring because of the CURS0RlNFN, but it will also ring bells when either the Jeff or middle mouse button is pressed. Notice that the right mouse button functions .5 it usually does, with the window manipulation menu. If only the left button should evoke the function SCREAMER, then the function can be written to do just this, using the function MOUSESTATE, and a form that only NOUSESTATE understands, ONLY. For example: (DEFIKEQ (SCRElERZ WIK~) (if ESTATE (aLY LEFT)) th�a (RIKB�LLS)))) In addition to (ONLY LEFT), MOUSESTATE can also be passed (ONLY MIDDLE), (ONLY RIGHT) or combinations of these (e.g. (OR (ONLY LEFT) (ONLY MIDDLE))). You do not need to use ONLY with MOUSESTATE for every application. ONLY means that that button is pressed and no other. If you do write a function using (ONLY RIGHT), be sure that your function also checks position of the mouse cursor. Even if you want your function to be executed when the mouse cursor is inside the window and the right button is pressed, there is a convention that the function DOVINDOWCOM should be executed when the mouse cursor is in the title bar or the border of the window and the right mouse button is pressed. Please program your windows using this tradition! For more information, please see the Intertisp-D Reference Manual, Volume 3, Chapter 28, Pages 7 and 28. Please refer to the Intertisp Reference Manual, Volume 3, Chapter 28, for more detail and other important functions. 27.1.4 Looking at a window's prOperties INSPECT is a function that displays a list of the properties of a window, and their values. Figure 27.3 shows the INSPECT function run with MY�WINDOV. Note the properties introduced in CREATEW: WBORDER is the window's border, REG is the region, and WTITLE is the window's title. 27.2 Regions A region is a record, with the fields LEFT, BOTTOM, WIDTH, AND HEIGHT. LEFT and BOflOM refer to where the bottom leff hand corner of the region is positioned on the screen. WIDTH and HEIGHT refer to the width and height of the region. CREATERE6ION creates an instance of a record of type REGION. Type: (SETO ~.RE6Ia (CREATERESIl 15 loo 200 450)) WINDOWS AND REGIONS 275 REGIONS to create a record of type REGION that denotes a rectangle 200 pixels high, and 450 pixels wide, whose bottom leff corner is at position (15, 100). This record instance can be passed to any function that requires a region as an argument, such as CREATEV, above. a,. WlN00WS ANO REGIONS ----- Next Message ----- Date: 19 Dec 91 15:59 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.155935pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11672>; Thu, 19 Dec 1991 15:59:45 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 15:59:35 -0800 From: John Sybalsky -----RFC822 headers----> 28. WHAT ARE MENUS? While Interlisp-D provides a number of menus of its own (see Section 7.1, Page 7.2), this section addresses the menus you wish to create. You will learn how to create a menu, display a menu, and define functions that make your menu useful. Menu's are instances of records (see Chapter 24). There are 27 fields that determine the composition of every menu. Because Interlisp-O provides default values for most of these descriptive fields, you need to familiarize yourself with only a few that we describe in this section. Two of these fields, the TITLE of your menu, and the ITEMS you wish it to contain, can be typed into the Interlisp�D Executive window as shown below: NIL 33'(.ETO MY. MEN (cRE"'TE ME/lb TiTLE ,.PLE~~SE CHCio8� ONE OF THE ITEMS" ITEMS (0,LlIT NE,T-l)UE;STION NE;~T-TOPIL SEE-TOPIC;5'JJJ ,rMENU!,#c4, ij'�:'3jH Figure 28.1. Creating a menu Note that creating a menu does not display it. MY.MENU is set to an instance of a menu record that specifies how the menu will look, but the menu is not displayed. 28.1 Displaying Menus Typing either the MENU or ADDNENU functions will display your menu on the screen. MENU implements pop-up menus, like the Background Menu or the Window Menu. ADDMEHU puts menus into a semi-permanent window on the screen, and lets you select items from it. (MENU MENU POSITION) pops-up a menu at a particular position on the screen. Type: (*EKU MY.ffI KIL) to position the menu at the end of the mouse cursor Note that the POSITION argument is NIL. In order to go on, you must either choose an item, or move outside the menu window and WHAT ARE MENUS' 281 DISPLAYING MENUS press a mouse button. When you do either, the menu will disappear. If you choose an item, then want to choose another, the menu must be redisplayed. (ADONENU menu window position) positions a permanent menu on the screen, or ;n an existing window. Type: (ADlEKU P.*EI) to display the menu as shown in Figure 28.2. This menu will remain active, (will stay on the screen) without stopping all the other processes. Because ADONEliU can display a menu without stopping all other processes, it is very popular in users programs. If window is specified, the menu is displayed in that window. If window is not specified, a window the correct size for the menu is created, and the menu is displayed in that window. If position is not specified, the menu appears at the current position of the mouse cursor. NE..TQ�UESIlCN 3EEToPIC> . . Figure 28.2. A Simple Menu, displayed with AooNriU. 28.2 Getting Menus to DO Stuff One way to make a menu do things is to specify more about the menu items. Instead of items simply being the strings or atoms that will appear in the menu, items can be lists, each list with three elements. (See Figure 28.3.) The first element of each list is what will appear in the menu; the second expression is what is evaluated, and the results of the evaluation returned, when the item is selected; and the third expression is the expression that should be printed in the Prompt window when a mouse button is held down while the mouse is pointing to that menu item. This third item should be thought of as help text for the user. If the third element of the list is NIL, the system responds with "Will select this item when you release the button". JGJ WHAT AR5 MENUS? GErn~ MENUS TO DO STUFF NIL 17+(SETQ Nv.MENU2 (SR�ATE MENU TITLE "PLEASE LHOOSE ONE OF TflE ITEMS" I~,EMS `(VQUIT (PRINT "STOPPEO" \ "LHOOSE THIS TO 5O~�'',' (NE\T-QUESTIOH (PRINT "HERE IS TME NE.'\'T QLl�STIOH . �u'HOOSE THIS TO ~E lSKED THE NE."T QUESTION"', iNE!~T-TOPIL (PRINT ��HERE IS THE NE'~T TOPIL . "C.HOOSE THIS TO KOv� OH TO THE NE'\T SueJELT" `1 (SEE-TOPICS (PRINT "THE FOLLOYIN6 HA'\E NOT e.EEN L�ARNEO"', *CHOOSE THIS TO SEE THE TOPICS NOT YET LErtRNEO"l `ii �~~MENU,'#5~. `.5~5j 1qL(cl&MENL MY. MEtlU:' ,rNIN&El'~~~4', 175350 14 Firnre 28.3. Creating a menu that will do things, then displaying it with the funttion ADDNEHU Now when an item is selected from KY.KENU2, something will happen. When a mouse button is held down, the expression typed as the third element in the item's specification will be printed in the Prompt window. (See Figure 28.4.) NE7.T.'JUE'=TlE'r~J SEE-TOPIC' Fiqrnre 28.1. Mouse Button Held Down While Mouse Cursor SeIe~ NEXT-QUESTIoN When the mouse button is released (i.e. the item is selected) the expression that was typed as the second element of the item's specification will be run. (See Figure 28.5.) Y-'OUE'Tl"N `EETOPlr"' "HERE IS THE NEXT ilUETION. Figure 28.5. NEXT-QUESTION Selected WHAT ARE MENUS' 283 GEHlNG MENUS TO DO STUFF 28.2.1 _ The WHENH�LDFN _ and WNENSEL�CTEDFN fields of a _ menu Another way to get a menu to do things is to define functions, and make them the values of the menu's WHENHELDFN and WHENSELECTEDFN fields. As the value of the WHENHELDFN field of a menu, the function you defined will be executed when you press and hold a mouse button inside the menu. As the value of the WHENS�L�CTEDFN field of a menu, the function you defined will be executed when you choose a menu item. This example has the same functionality as the previous example, where each menu item was entered as a list of three items. As an example, type in these two functions so that they can be executed when the menu is created and displayed: (DEFIKEQ L�CTED (SELEcfQPiNTEENNUJSENHENHELO (ITEl.S�LECTED a:. FROM BUTT:. PRESSED) QUIT (PROMPTPRIKT �cHOOSE THIS TO sToP�)) NEXT-QUESTION (PROMPTPRIKT CHOOSE THIS TO BE ASKED TNE NEXT QUESTION-)) NEXT-TOPIC PROMPTPRINT �CHOOSE THIS TO MOO,E a TO THE NEXT SUBUIECT�)) SEE-TOPICS PROMPTPRINT �CHDOSE THIS TO SEE THE TOPICS NOT YET L�ARNED�)) ERROR (PROM TPRIKT NO liTCH FOUND�))))) (DEFINEQ WENSELECTED (ITEM.SELECTED MENU. FROM 8UTT:.PRESSED) QUIT (PRINT �STOPPED�)) NEXT-QU RINT "HERE IS THE NEXT QUESTION...)) NEXT-T �HERE IS THE NEXT TOPIC. . - PICS PRINT �THE FOLLONIK HAVE NOT 8EEN LEARNED. ..� ERROR (PRONFTPRINT NO liTCH FOUND))))) Now, to create the menu, type: (SETQ MY.NE:3 (CREATE NE: TITLE �PLEASE CHOOSE :E OF THE ITEMS� ITEK `(QUIT NEXT-QUESTION NEXT-TOPIC SEE-TOPICS) NHENHELDFN (FUNCTIK MY.NENU3.NHENHELD) fflENSELECTEDFN (FUNCTION NY, .MENU3 .fflENSELECTED))) Type (ADDMENU MY.MENU3) to see your menu work. NOW, due to executing the WH�NNELDFN function, holding down any mouse button while pointing to a menu item will display an explanation of the item in the prompt window. The screen will once again look like Figure 28.4 when the mouse button is held when the mouse cursor is pointing to the item NEXT-TOPIC. Now due to executing the WHENSELECTEDFN function, releasing the mouse button to select an item will cause the proper actions for that item to be taken. The screen will once again look like Figure 28.5 when the item NEXT-TOPIC is selected. The crucial thing to note is that the functions you defined for WHENHELDFN and WHENSELECTEDFN are automatically given the following arguments: (t) the item that was s�lected, ITEM. SELECTED; (2) the menu it was selected from, MENU. FROM; (3) and the mous� button that was pressed BUTTON PRESSED. Hot�: thes� functions, *Y.NENU3.fflENflELO and ffY.KEKUJ.ilHEKSELCTEO, w�re quoted using FUKCTIOK instead of QUOTE both for program r�adability and so that the 21.1 ~YAR1".NUs? GETTlMG MENUS TO 00 STUFF compiler con produce foster code when the program is compiled. It is good style to quote functions in Intertisp by using the function FUNCTION instead of QUOTE. 28.3 Looking at a menu�s fields INSPECT is a function that displays a list of the fields of a menu, and their values. The Figure 28.6 shows the various fields of NY .NENU3 when the function (INSPECT NY �NENU) was called. Notice the values that were assigned by the examples, and all the defaults. \JN"PELT NY liENl./3��l �l1IHDU'wJ#'1, 54�scj NENllPECICNB1:TTi=fl o Imrni';E (�!VINDLlrt�$#b1.l�5lSjl � t1)UlT HE�~T-Ll�L'E'TI1=1N `�`-Ti'iFl'� ET � MENUPOffo�' � ANUEAFF'ETFLL: NIL ffENUEQHT i:FclNTPc:::cf IpTclFt -a TITLE `�PLEAL'E CHil.l `HE ,iF THE ITE � ffEHlJoFF6ET A LECTEDFN fly flEflJ,� h.�rtEf:EL.FCTE�l `1flE'flELDFH NV flEPlLl3 \�rtEHHELJP � ENl)NHELoFH l:LFF'RCHPT � flENOFEEOe4l,'r.FLG NIL Figure 28.6. The Fields of MY.MENU3 WHAT ARE MENUS' 285 ----- Next Message ----- Date: 19 Dec 91 16:10 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.161052pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11680>; Thu, 19 Dec 1991 16:10:56 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 16:10:52 -0800 From: John Sybalsky -----RFC822 headers----> 29. lilTMAPS A bitmap is a retangular array of dots. The dots are called pixels (for picture elements). Each dot, or pixel, is represented by a single bit. When a pixel or bit is turned on (i.e. that bit set to 1), a black dot is inserted into a bitmap. If you have a bitmap of a floppy on your screen, (Figure Figure 29.1), then all of the bits in the area that make up the floppy are turned on, and the surrounding bits are turned off. FLOPPY (Ia b~JwP- ~`,5,,Bh (t-:)o Figure 29.1. Bitmap of a Floppy BITNAPCREATE creates a bitmap, even though it can't be seen. (BIfflPCRDTE width height) If the width and height are not supplied, the system will prompt you for them. EDZTBN edits the bitmap. The syntax of the function is: (EDITl bitmapname) Try the following to produce the results in Figure 29.4: l~SoETiQr:~r�B!sTHituPbB~I~PcRDTE eo 40)) To draw In the bitmap, move the mouse into the gridded section of the bitmap editor, and press and hold the leff mouse button. Move the mouse around to turn on the bits represented by the spaces in the grid. Notice that each space in the grid represents one pixel on the bitmap To erase Move the mouse into the gridded section of the bitmap editor, and press and hold the center mouse button. Move the mouse around to turn off the bits represented by the spaces in the gridded section of the bitmap editor. To work on a different section Point with the mouse cursor to the picture of the actual bitmap (the upper left corner of the bitmap editor). Press and hold the BlTMAPS 291 BlTMAPS Jeff mouse button. A menu with the singJe item, ttove will appear. (See Figure 29.2.) Choose this item. . . Figure 29.2. Move the mou5e cursor to the Dtcture of the bitmap. Press and hold the Iek mouse button. and the Move menu will appear You will be asked to position a ghost window over the bitmap. This ghost window represents the portion of the bitmap that you are currently editing. Place it over the section of the bitmap that you wish to edit. (See Figure 29.3.) . . . . . . ... . .... I . 29.3. .. J=.. :. II.lI:.:;;. _ . . f1ure Affer you choose move. yoU will be asked to position a ghost window like this one. Position it by clicking the leff mouse button when the ghost window is over the part of the picture of the bitmap you would like to edit. To end the session 8ring the mouse cursor into the upper-right portion of the window (the grey area) and press the center button. Select OK from the menu to save your artwork. 29) .lY~ r'. alTMAps .:: 5''iSETQ ffy IllNAP (I[TNAPcPEATE OR GO)' j:y.IlfM&P os�t\ ,A.BlTMAPl�6',1.q;�lO 58oi,EOIlBM my.IlTNAP\ - - . . -A fr.j: ` = "''~ = . ~. . . . F~ure 29.4. Editing a Bitmap BITBLT is the primitive function for moving bits (or pixels) from one bitmap to another. It extracts bits from the source bitmap, and combines them in appropriate ways with those of the destination bitmap. The syntax of the function is: (BITBLT sourcebitmap sourcelefl sourcebottom destinationbitmap destinationleft destinationbottom width height sourcetype operation texture clippIngregion) Here's how it's done - using MY.BlTMAP as the sourcebitmap and MY.WlNDOW as the destinationbitmap.' (BITBLT rn.BITll4P NIL NIL P.wIN~ NIL NIL KIL NIL `INPUT `REPuCE) Note that the destination bitmap can be, and usually is, a window. Actually, it is the bitmap of a window, but the system handles that detail for you. Because of the IlLs (meaning "use the default"), MY.BlTMAP will be BlTBLT'd into the lower right hand corner of MY.WlNDOW. (See Figure 29.5.) BlTMAPS 293 ~17MAP5 98'(BITBLT KY Strap NIL NIL my ,1(10p,, FL `IL NIL HIL Tipil' P.�PLlfi (~=l', Figure 29.5. 9ITBLTng a Bitmap onto a Window Here is what each of the SlTBLT arguments to the function mean: sourcebitmap the bitmap to be moved into the destinationbitmap sourcelett a number, starting at O for the Jeff edge of the sourcebitmap, that tells SITBLT where to start moving pixels from the sourcebitmap. For example, if the leftmost 10 pixeis of sourcebitmap were not to be moved, sourceleft should de 10 The default value is O. sourcebottom a number, starting at O for the bottom edge of the sourcebitmap, that tells BIT6LT where to start moving p1'xels from the sourcebitmap. For example, if the bottom 10 rows of pixels of sourcebitmap were not to be moved, sourcebottom should be 10 The default value is O. destinationbitmap the bitmap that will receive the sourcebitmap. This is offen a window (actually the bitmap of a window, but Interlisp-b takes care of that for you). destinationleff a number, starting at O for the leff edge of the destinationbitmap, that tells BITBLT where to start placing pixels from the sourcebitmap. For example, to place the sourcebitmap 10 pixels in from the Jeff, destinationleft should be 10. The default value is 0. destinationbottom a number, starting at 0 for the bottom edge of the destinationbitmap, that tells BITBLT where to start placing pixels from the sourcebitmap. For example, to place the sourcebitmap 10 pixels up from the bottom, destinationbottom should be 10. The default value is 0. width how many pixels in each row of sourcebitmap should be moved. The samc amount of space is used in destinationbitmap to receive the sourcebitmap. If this argument is NIL, it defaults to the number of pixels from sourceleft to the end of the row of sourcebitmap. height how many rows of pixels of sourcebitmap should be moved. The same amount of space is used in destinationbitmap to receive thq sourtebitmap. If this argument is NIL, it defaults to the number of row; from sourcebottom to tho top of the sourcebitmap. sourcetyp� rofors to on� of thro� ways to cofiv�rt th� sourcebitmap for writing. For now, just us� `INPUT. 29.� o~ps ` ` ` ` ` ` ` ` ` ` ` ` ` `` ` `" ` ` ` ` ` ` ` ` ` ` ` ` ` OIlMAPS operation refers to how the sourtebitmap gets BlTBLT'd on to the destinationbitmap. `REPLACE will BLT the exact sourcebitmap. Other operations allow you to AND, OR or XOR the bits from the sourcebitmap onto the bits on the destinationbitmap. texture Just use NIL for now. clippingregion just use NIL for now. Por more information on these operations, see the Interlisp-D Reference Manual, Volume 3, Chapter 27, Page 14. Sourcebitmap, sourceleft, sourcebottom, destinationbitmap, destinationleft, destinationbottom, width and height are shown in Figure 29.6. Destination Bitmap Source Bitmap FLOPPY tlcblffkUP' 3/S/Bh height e./,o width Source leh. Source bottom. The "x y coordinates in terms of the source (OOforthewhoiesource). Destination Jeff, Dertination Bottom. The ,,x y" coordinates in terms of the destination bitmap. (00 to put the source bitmap in the Ieft bottom corner of the dertination bitmap). Figure 29.6. BITBLT'ed Bitmap of a Floppy BITMAPS 295 ----- Next Message ----- Date: 19 Dec 91 16:16 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.161653pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11679>; Thu, 19 Dec 1991 16:16:57 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 16:16:53 -0800 From: John Sybalsky -----RFC822 headers----> 30. DlSPLAYSTREAMS A displaystream is a generaJized "place to display". They determine exactly what is displayed where. One example of a displaystream is a window. Windows are the only displaystreams that will be used in this chapter. If you want to draw on a bitmap that is not a window, other than with BITBLT, or want to use other types of displaystreams, please refer to the Interlisp-D Reference Manual, Volume 3, Chapter 27. This chapter explains functions for drawing on displaystreams: DRAWLINE, DRAWTO, DRAVCIRCLE., and FILLCIRCLE. In addition, functions for locating and changIng your curreAt position in the displaystream are covered: DSPXPOSITIOH, DSPYPOSITION, and NOVETO. 30.t Drawing on a Displaystream Examples will show you how the functions for drawing on a display stream work. First, create a window. Windows are displaystreams, and the one you create will be used for the examples in this chapter. Type: (SETO EwPLE.wIN~ (CREATEI)) 30.1.1 DRAWLlNE DRAWL IRE draws a line in a displaystream. For example, type: (DliVLIKE 10 IS loo 150 S �IlERT ExMPLEwIN~) The results should look like this: Figure 30.1. The line drawn onto the displayrtream, ExAMPLEwlNDoW DlSPLAYSTREAMS 30 DRAWING ON A DlSPLAYsTaE:M The syntax of DRAWL1NE is (Dli~IKE xl yl x2 y2 width opera tion stream �) The coordinates of the Jeff bottom corner of the displaystream areOO. xl and yl are the x and y coordinates of the beginning of the line; x2andy2 are the ending coordinates of the line; width isthe width of the line, in pixels operation is the way the line is to be drawn. INVERT causes the line to invert the bits that are already in the displaystream. Drawing a line the second time using INVERT erases the line. For other operations, see the Interlis~D Reference Manual, Volume 111, Page 27.15. stream is the displaystream. In this case, you used a window. 30.1.2 ORA~O DRAWTO draws a line that begins at your current position in the displaystream. For example, type: (Dli~O 120 135 5 `IrvERT E~LE.*IH~) The results should look like this: Figuro 30.2. Another line drawn onto the displaystream, ExAMPLE�WlNDow� The syntax of ORAWTO is (oliilT0 x y width operation stream i) The line begins at the current position in the displaystream. x is the x coordinate of the end of the line; y is they coordinate of the end of the line; width is the width of the line operation is the way the lino is to be drawn. INVERT causes the line to invert the bits that aro already in tho displaystream. Drawing a line the second time using INVERT erases the line. For other operations, see the lnteHi~O Reference Manual, Volume Ill, Page 27.15. stream is the displaystreom. In this case. you used a window. 30.2 llPLAYSTQCANT DRAW1NG ON A D15PLAr5~E~ 30.1.3 DRAWClRCLE DRAWCIRCLE draws a circle on a displaystream. To use it, type: (0li~I~LE 150 100 so `(~RTICAL 5) KIL E~LE .VI~) Now your window, EXAMPLE.WlNDOW, should look like this: Flur� 30.3. The circle drawn onto the displaystream. EXAMPLE WINDOW The syntax of DRAWCIRCLE is (0li~IEL� centerx centery radius brush dashing stream) centerx is the x coordinate of the center of the circle centery is they coordinate of the center of the circle radius is the radius of the circle in pixels brush is a list.- The first- item of the list is the shape of the brush. Some of your options include ROUND, SQUARE, and VERTICAL. The second item of that list is the width ofthe brush in pixels. dashing is a list of positive integers. The brush is "on" for the number of units indicated by the first element of the list, "off" for the number of units indicated by the second element of the list. The third element specifies how long it will be on again, and so forth. The sequence is repeated until the circle has been drawn. stream is the displaystream. In this case, you used a window. 30.1.3.1 FlLLClRCLE FILLCIRCLE draws a filled circle on a displaystream. To use it, type: (FILLCIRCLE 200 150 10 6liY~DE ExlPLE.wIli~) EXAMPLE.WlNDOW now looks like this: DlSPLAYSTREAMS 303 l DRAWING ON A DISPLAYSTREAM Figure JO.t A filled circle drawn onto the displaystream, EXAMPLE WINDOW The syntax of FILLCIRCLE i5 (FILLCIRCL� centerx centery radius texture stream) centerx is the x coordinate of the center of the circle centery is theycoordinate of the center of the ci rcle radius is the radius of the circle in pixels texture is the shade that will be used to fill in the circle. Interlisp-D provides you with three shades, WHlTESHADE, BLACKSHADE, and GRAYSHADE. You can also create your own shades. For more information on how to do this, see the Interlisp-D Reference Manual, Volumelll, Page 27.7. stream is the displaystream. In this case, you used a window. There are many other functions for drawing on a displaystream. Please refer to the Intertisp-D Reference Manual, Volume 111, Chapter 27. Text can also be placed into displaystreams. To do this, use printing functions such as PRIffl and PRIN2, but supply the name of the displaystream as the "file" to print to. To place the ten in the proper position in the displaystream, see 5ection 30.2, Page 30.4. 30.2 _ Locating _ and _ Changing _ Your _ Position _ in _ a _ Displaystream There are functions provided to locate, and to change your current position in a displayitream. This can help you place text, and other images where you want them in a displaystream. This primer will only discuss three of these. There are others, and they can be found in the lnterlis~D Reference Manual, Volume Ill, Chapter 27. 30.4 0lSPLAY$TREA~ r. LOCATING AND CHANGING YOUR POSITION IN A DISPLAYSTREAM 30.2.1 DSPXPOSlTlON DSPXPOSITION is a functiOn that will either change the current x pOsition in a displaystream, or simply report it. To have the function report the current x position in EXAMPLE.WlNDOW, type: (OSP*PoSlTIoN NIL EXlPLE .ilINDON) DSPXPOSITION expects two arguments. The first is the new x position. If this argument is NIL, the current position is not changed, merely reported. The second argument is the displaystream. 30.2.2 DSPYPOSlTlON DSPYPOSITION is an analogous function, but It changes or reports the current y position in a displaystream. As with DSPXPOSlTlON, If the first argument Is a number, the current y position will be changed to that position. If it is NIL, the current position is simply reported. To have the function report the current y position in EXAMPLE.WlNDOW, type: (DSPYROSITIoN NIL ExlPLE.WIK-~) 30.2.3 MOVETO The function NOVETO always changes your position in the displaystream. It expects three arguments: (~-ET0 xystream) x is the new x position in the display stream y is the new y position in the display stream stream is the display stream. The examples so far have used a window. DISPLAYSTREAMS 30 5 ----- Next Message ----- Date: 19 Dec 91 16:30 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.163054pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11682>; Thu, 19 Dec 1991 16:30:58 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 16:30:54 -0800 From: John Sybalsky -----RFC822 headers----> 31. FONTS This chapter explains fonts and fontdescriptors, what they are and how to use them, so that you can use functions requiring fontdescriptors You have already been exposed to many fonts in Interlisp-D. For example, when you use the structure editor, DEdit, (See Section 11.3.), you noticed that the comments were printed in a smaller font than the code, and :hat CLlSP words (See Section 13.1, Page 13.1.) were printed in a darker font than the other words in the function. These are only -me of the fonts that are available in Interlisp-D. In addition to the fonts that appear on your screen, Interlisp-D uses fonts for printers that are different than the ones used for the screen. The fonts used to print to the screen are called DlSPLAYFONTS. The fonts used for prining are called INTERPRESSFONTS, or PRESSFONTS, depending on the type of printer. 31.1 What makes up a FONT? Fonts are described by family, weight, slope, width, and size. This section discusses each of these, and describes how they affect the font you see on the screen. Family is one way that fonts can differ. Here are some examples of how "family" affects the look of a font: CLASSIC This family makes the word "Able" look like this: Able MODERN This family makes the word "Able" look like this: Able TERMINAL This family makes the word "Able" look like this: Able Weight also determines the look of a font. Once again, "Able" will be used as an example, this time only with the Classic family. A font's weight can be: BOLD and look like this: Able MEDIUM or REGULAR and look like this: Able The slope of a font is italic or regular. Using the Classic family font again, in a regular weight, the slope affects the font like this: ITALIC looks like this: A file REGULAR looks like this: Able FONT5 311 1 WHAT MAKES UP A FONT? The width of a font is called its "expansion". It can be COMPRESSED, REGULAR, or EXPANDED. Together, the weight, slope, and expansion of a font specifies the font's "face". Specifically, the face of a font is a three element list: (weight slope expansion) To make it easier to type, when a function requires a font face as an argument, it can be abbreviated with a three character atom. The first specifies the weight, the second the slope, and the third character the expansion. For example, some common font faces are abbreviated: MRR This is the usual face, MEDIUM, REGULAR, REGULAR; MlR makes an italic font. It stands for: MEDIUM, ITALIC, REGULAR; BRR makes a bold font. The abbreviation means: BOLD, REGULAR, REGULAR; BIR means that the font should be both bold and italic. BIR stands for BOLD, ITALIC, REGULAR. The above examples are used so oflen, that there are also more mnemonic abbreviations for them. They can also be used to specify a font face for a function that requires a face as an argument. They are: STANDARD This is the usual face: MEDIUM, REGULAR, REGULAR. It was abbreviated above, MRR; ITALIC This was abbreviated above as MR, and specifies an italic font; BOLD of course, makes a bold font. It was abbreviated above, BRR; BOLDlTALIC means that the font should be both bold and italic: BOLD, ITALIC, REGULAR. It was abbreviated above, BlR. A font also has a size. It is a positive integer that specifies the height of the font in printers points. A point is, on an 1108 screen, about 1/72 of an inch. On the screen of an 1186, a point is 1/80 of an inch. The size of the font used in this chapter is 10. For comparison, here is an example of a TERMINAL, MRR, size 12 font: Able. 31.2 Fontdescriptors, and FONTCREATE For Interlisp�D to use a fort, it must have a fontdescriptor. A fontdescriptor is a data type in Interlisp�D that that holds all the information needed in order to use a particular font. When you print out a fontdescriptor, it looks like this: [fKTDEIRIPToRj�i�,�s~�0 Fontdescriptors are created by the function F0NTCREATE. For example, (F~TCREATE `flEL~1lCA 12 `~o) J: 31.2 FOflff FONTDESCRlPTORS, AND F0NTCREAlE creates G fontdescriptor that, when used by other functions, prints in HELVETIEA BOLD size 12. Interlisp-D functions that work with fonts Gxpect a fontdescriptor produced with the FONTCREATE function. The syntax of FONTCREATE is: (F0KTCREATE family size face) Remember from the previous section, face is either a three element list, (weight slope expansion), a three character atom abbreviation, e.g. MRR, or one of the mnemonic abbreviations, e.g. STANDARD. If FONTCREATE is asked to create a fontdescriptor that aJready exists, the existing fontdescriptor is simply returned. 31.3 Display Fonts - Their files, and how to find them Display fonts require files that contain the bitmaps used to print each character on the screen. All of these files have the extension .DlSPLAYFONT. The file name itself describes the font style and size that uses its bitmaps. For example: ~ERK12.DISPUYFRT contains bitmaps for the font family MODERN in size 12 points. Initially, these files are on floppies. The files that are used most offen should be copied onto a directory of your hard disk or fileserver. Usually, this directory is called FONTS. Wherever you put your .DISPLAYFONT files, you should make this one of the values of the variable DISPLAYFONTDIRECTORIES. Its value is a list of directories to search for the bitmap files for display fonts. Usually, it contains the "FONT" directory where you copied the bitmap files, the device (FLOPPY), and the current connected directory The current connected directory is specified by the atom NIL. Here is an example value of DISPLAYFONTDIRECTORIES: . - 11 NIL r~':PI:='pL"'yFnNTDIP,ECTBP,IES i;!I�o= ` . =PFIL -FnNT~." (D.~fr):!.LIT'.PFIL fFLnPF"')- NIL!i 9!� Figure 31.1. A value�for the atom DISFLAYFONTDIRECTORIES When looking for a .DiSPl.AYFONl file. `he system will check the F0NT directory on the hard disk. then the top level directory on the hard disk, then the floppy. then the current connected dir8rtory FONTS 313 INTERPRESS FONT5 - THEIR FILES, AND HOW TO FIND THEM 31.4 _ Interpress _ Fonts _ - _ Their files, _ and _ how _ to _ find _ them Interpress i5 the format that is used by Xerox laser printers. These printers normally have a resolution that is much higher than that of the screen: 300 points per inch. In order to format f,Ies appropriately for Output on such a printer, Interlisp must know the actual size for each character that is to be printed. This is done through the use of width files that contain font width information for fonts in Interpress format. Initially, these files (with extension .WD) are on floppies. The files should be copied onto a directory of your hard disk or fileserver. For Interpress fonts, you should make the location of these files one of the `values of the variable INTERPRESSFOliToIRFcTORIES. Its value is a list of directories to search for the font viidths files for Interpress fonts. Here is an example value of INTERPRE5SFONTD1RECT0R1ES: . 11 1'lIL i?IbdTEFPfiET�=:FnN7PIP:EcTnRI�~,~ .i=~~.~ j:~,~ Figure 31.2. A value for the atom INTERPREssFoNTDIREcToRIEs When looking for a font widths file for an Interpress font, Interlisp-D will cne~ the hard disk. 31.5 Functions for Using Fonts 31.5.1 F0NTPR0P Looking at Font Properties It is possible to see the properties of a fontdescriptor. This s done with the function FONTPROP. For the following examples, the fontdescriptor used will be the one returned by the function (DEFAULTFONT `DISPLAY). In other words, the fontdescriptor examined will be the default display font for the system. There are many properties of a font that might be useful for you. Some of these are: FAffILY To see the family of a font descriptor, type: (FKTPliP (DEFAllLTFoIT `DISPLAY) `f~ILY) SIZE As above, this is a positive integer that determines the height of the font in printer's points. As an example, the SIZE of the current default font is: 31� ~n FUNCTIONS FOR USING FONTS . 11 NIL Gi,�(FnNTPROP (DEF~ULTFONT PI~~PLAY) `.,�,:`IZE\ is, Figure 31.3. The value of (he font property SIZE of the default font ASCENT The value of this property is a positive integer, the maximum height of any character in the specified font from the baseline (bottom). The top of the tallest character in the font, then, will be at (BASELINE # ASCE[VT - l). For example, the ASCENT of the default font is: � 1 11 NIL A� 4' ,. I!�FnNTPROP if OfF"' ULTFnNT �PI~,~PL~","!' `~e-rENT:! q.- A,5~: Figure 31.& The value of the font property ASCENT of the default font DESCENT The DESCENT is an integer that specifies the maximum number of points that a character in the font descends below the baseline (e.g. letters such as "p" and "g" have tails that descend below the baseline.). The bottom of the lowest character in the font will be at (BASELINE - DESCENT). To see the DESCENT of the default font, type: (FOkTPROP (DEfAULTFKT `DISPUY) `DESr:�KT) HEIGHT HE IGHT is equal to t'DESCENT-ASCENT). FACE The value of this property is a list of the form, (weight slope expansion). These are the weight, slope, and expansion described above. You can see each one separately, also. Use the property that you are interested in, VEIGHT, SLOPE, or EXPANSION, instead of FACE as the second argument to FONTPROP. For other font properties, see the Interlisp-D Reference Manual, VolumeIll, Pages 27.27 - 27.28. 31.5.2 5TRlNGWlDTH It is offen useful to see how much space is required to print an expression in a particular font. The function STRINGVIDTH does this. For example, type: (STRIKWIDTH "NV thera!� (`L'NTcREAT� `UCli 10 `STAKDARD)) The number returned IS how many leff to right pixels would be needed if the string were printed in this font. (Note that this F0NTS 31 S FUNCTIONS FOR USING FONTS doesn't ju5t work for pixels on the screen, but for all kinds of streams. For more information about streams, see Chapter 30.) Compare the number returned from the example call with the number returned when you change GACHA to TlMESROMAN. 31.5.3 DSPFONT - Changing the Font in One Window The function DSFF0NT changes the font in a single window. As an example of its use, first create a window to write in. Type: (SETQ ~.FoNT.WINnaN (CttEATE*)) in the Interlisp-D Executive window. Sweep out the window. To print something in the defau!t font, type: (PRINT `HELLO N'f'.FO*T.wIN~) in the Interlisp-D Executive window. Your window, MY. FONT.WlNDOW, will lOOk sOmething like this: HELL Figure 31.5. HELLO, printed with the default font in MY.FONT.WINOOW Now change the font in the window. Type: (DSPF0NT (FONTCREATE `HELVETICA 12 `SOLD) *T.FONT.WINDaN) in the Interlisp-D Executive window. The arguments to FONTCREATE can be chang~-'d to create any desired font. Now retype the PRINT statement, and your window will look somethinglikethis: - . HIL .q.'~;, PSPFnNT (FnNTrRE~TE `HEL";'ET1L~ 1:'� �BnLPt M't�.FnNT.vINPnWj l:FnNTPE~1'RIpTnfl~#?.~,. 1-'� 14 "4 3~~iPR[NT `HELLO MY.fnflr.l]INoniff) HELLO Flgur� 31.L The font iiiMY FONT WINDow, changed Notice the font has been changedl J. 31.6 FONtt FUNfll0NS FOR USING F0Nff 31.5.4 _ Globally Changing _ Fonts _________________________ There is a library package to globally change the fonts in all the windows. To use it, first load BlG.DCOM. (See Section 8.6, Page 8.4 for how to load a file.) To change fonts in 311 windows using the package BlG.DCOM, type (KE*Fo*T ~ There are four keywords for size of fonts to specify. They are HUGE, BIG, STANDARD, and MEDIUM. For example: (*E*FKT `BIG) sets the fonts in ALL the windows to be a larger size. Note: this package changes the fonts everywhere, including the editor window and system merius It is particularly useful to change the size of the font for demos. 31.5.5 Personalizing Your Font Profile Interlisp-D keeps a list of default font specifications. This list is used to set the font in all windows where the font is not specifically set by the user (Section 31.5.3). The value of the atom FONTPROFILE is this list. (See Figure 31.7.) A FONTPROFILE is a list of font descriptions that certain system functions access when printing output. It contains specifications for big fonts (used when pretty printing a function to type the function name), small fonts (used for printing comments in the editor), and various other fonts. F0NTS 317 I FUNCTIONS FOR USING FONTS - . . . 43-FJtlTPRUF[LE l!' P�F"ULTFClFlT i ,.` `,`cH4 LLT; ;�`,`~LHk aj t'TEPMINk'L Sij `.`BlLPF'lNT :` (H�LlETIl='n' Jo E,PP.;1 `lH�L':'�TIC" L=' BPP,i `llJPEPtl in' ~FF) `,`LITTL�FC'NT 3 ;ttEL'�?ErIC" ,3,' iHE - c 1,1p; i.'BIC-FCNT ~ llnof - hlIP"i `HE 1.=' BpP.i `.`HEL'�'ET .- it' epp:' `.`IrtoPEPrl - (J\EPFONT 6oLOFElNT (C.lMllENTFANT LITTL�Fi)r'T `.`L"M0P~"FL1flT 61 eFol~! T i.'.='r'3TEMFeNT',i `.`CLI~T'~PFUNT BC'LOF')1'lf i.' CH,,N'3'EF')HT i,'PPETT\'1?.Cit1F(ji~T Bl.lLC'FllltlT i.'FCPlTL DEf"'ULTFEitiT" ,`Fel'JT"� 6cLDFclllT; t.'FCt'1T3 LITTLEFcif�lT; `.f1tlTJ BlCF(.'r'lT',i i.'FElNT~ S `,`HEL',"ETl;,,' 10 81P'. `lHEL'y'ETlc,, `3 61A) CfillDEPN a 81P:; t.'FilNTB 6 `HEL";'ET16~ 10 8RP',i `.`HEL'."ET1C~ L'~ BAA"' llPEPN 3 BAA] Fi)NT7 ? c"'i'.H~ 1:�'' :e-"Ln~ 1:�!' `.TERMItl,'L 1;''.,,!, 5a, Figure 31.7. The value of the atom FONTPROFlLE The list is in the form of an a5sociation list. The font class names, (e.g. DEFAULTFONT, Or SOLDFONT) are the keywords of the association list. When a number follows the keyword, it is the font number for that font class. The lists following the font class name or number are the font specifications, in a form that the function FONTCREATE can use. The first font specification list affer a keyword is the specification for printing to windows. The list, (GACHA 10), in the figure above is an example of the default specification for the printing to windows. The last two font specification lists are for Press and Interpress file printing, respectively. For more information, see the lnterlis~D Reference Manual, Volume 3, Chapter 27. Now, to change your default font settings, change the value of the variable FONTPROFIL�. lnterlis~D has a list of profiles stored as the value of the atom FONTDEFS. Choose the profile to use, then install it as the default FONTPROFILE. Evaluate the atom FONTDEFS and notice that each profile list begins with a keyword. (5ee Figure 31.8.) This keyword corresponds to the size of the fonts included. BIG, SMALL, and STANDARD are some of :he keywords foT profiles on this list - SMALL and STANDARD appear in Figure 31.8. 31.8 F0Htt 1 FUNCTl0NS F0R USING F0NTS [[SMALL cFONTPRQFlLE (DEFALlLTFONT l (TERMINAL 8) t�UaCHA 8) `TERmIHAL 8)) (8OLPFL~NT (Mi!OERtt 3 BRR) \HELY'FTIL" 6 BRR) ltl\flEfiH 8 BRfi)) 1 LITTLEFCNT ~`� (hllCiERN 8 MIR) lHEL'v'ETIu'"' 8 MIR) iMCiPERN ,q, MIR)) (TIN\FONT a IhllOERN a) to,'F..H" ~) hll!nEr.H 6 iBIrFnNT j (;`,nPF~N 1P BFR) `!HE".'LETIcA lG BRF) hlrPEF;11 16 ~RP) iTE.\TFrNT r `.,6LM"~'.lC 13) `iTIhlE:'Pnn,,"N In) i.LL~.~:IC lot) !`TE\TBnLPFnNT tCL~~CIC 16 Bfifi.,' ~TIME.';RL1MAN 1P BfiR) tP:LAc.~,Ir 16 BRR] [cT~NPARP (FDNTPrnPiLE (PEF"ULTFnNT 1 Figure 31.8. Part of the value of the atom FONTDEFS To install a new profile from this list, follow the following example, but insert any keyword for BIG. To use the profile with the keyword BIG instead of the standard one, evaluate the following expressioh (FOMTSET `BIG)) Now the fonts are permanently replaced. (That is, until another profile is installed.) FONIS 319 1 r. FUNCTIoNS FOR USING F0NTS [[SMALL cFONTPROFlLE (OEFALlLTPONT i (TERMINAL 6) \*U'acHA 6) t�TERmIHAL 6)) (SOLPFL~NT (M'1.OERN 6 BRR) tHELY'FTIL"' 6 BRR) Ihll!OER'H qL BRR)) i LITTLEFCNT ~" (MlcERN 6 MIR) lHEL'v'ETIu'"' 6 MIR) iMCiOERN ,q� MIR)) (TIN\FONT a IhllOERN a) U,,F.,H" aj hll!nEr.N 6 iBIrFnNT J `;;1nPF~N 1P BFR) `!HE".'LETICA 16 BRF) hlrPEF;i1 16 ~fiP) !` i TE.\TFrNT r 6L"~.'lc 1'~) liTIhlE;:pnMN In) i.LL~.>:Ic In:) !`TE\TBnLPFnNT t CLA~C 1 16 Bfifi jTIME.';ROMAN 1P BfiR) \P:LAc.~.Ir 16 BRR] [<~T~NPARP (FlNTPRnPILE (PEF"ULTFnNT 1 Figure 31.8. Part of the value of the atom FONTDEFS To install a new profile from this list, follow the following example, but insert any keyword for BIG. To use the profile with the keyword BIG instead of the standard one, evaluate the following expressioh (FlTSET `BIG)) Now the fonts are permanently replaced. (That is, until another profile is installed.) FONTS 319 1 ----- Next Message ----- Date: 19 Dec 91 16:35 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.163540pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11681>; Thu, 19 Dec 1991 16:35:49 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 16:35:40 -0800 From: John Sybalsky -----RFC822 headers----> 12. YOUR INlT FILE Interlisp-D has a number of global variables that control the environment of your 1108 or 1186. Global variables make it easy to customize the environment to fit your needs. One way to do this is to develop an "INlT�' file. This is a file that is loaded when you log on to your machine. You can use it to set variables, load files, define functions, and any other things that you want to do to make the Interlisp-D environment suit you. Your lnit fi'e could be callecl INlT, INlT.LlSP, INlT.USER, or whatever the convention is at your site. There is no default name preferred by the system, it just looks for the files listed in the variable USERGREETFILES, (see below). Check to see what the preference is at your site. Put this file in your directory. Your directory name should be the same as your login name. The INlT file is loaded by the function GREET. GREET is normally run when Interlisp-D is started. If this is not the case at your site, or you want to use the machine and Interlisp-D has already been started, you can run the function GREET yourself. If your user name was, for example, TURlNG, then you would type: (GREET `TURIK) This does a number of things, including undoing any previous greeting operation, loading the site init file, and loading your init file. Where GREET looks for your INlT file depends on the value of the variable USERGREETFiLES. The value of this variable is set when the system's SYSOUT file is made, so check its value at your site! For example, its value could be: - . - 11 NIL 3'USERGREETFlLE5 iiiFD5hl,(.LI5PFILES~ USER ;INIT.LISPJ t1rD5h','.LI5PFILE.>.~INIT.LI5PJ t',rFLoPPY',INIT.L15�J i,rosh','�LI5PFILES\ USER .`INIT.U5ERJ ((O.h L FILE.' .INlT.U.'ER'�j i(D. . FIL SER INIT:, i(FLUPP';'j I F~ure12.1. ApcsstblevalueofUSERGREETFILES. In each place you see, "> USER >", the argument passed to GREET is substituted i:ito the path. This is your login name if you are just starting Interlisp-D. For example, the first value in the list would have the system check to see whether there was a file, [DSX]TURlNG>lNlT.LlSP. No error is generated if you do not hcve an INlT file, and none of the files in USERGREETFZLE$ are found. Y0UR NIT FILE 12 1 MAKING AN INlT FILE 12.1 Making an lnit File As described in Section 11.5, Page 11.7, each lnterlis~D program file has a global variable associated with it, whose name is formed by appending "COMS" to the end of the root filename. For any of the standard INlT file names, the variable INlTCOMS is used. To set up an init file, begin by editing this variable. First, type: (SETQ I*ITco*s `((VAnS))) Now, to edit the variable, type: (l z:sicn*s> A DEdit window wiil appear. This DEdit window is the same as the one called with the function OF, and described in Section 11.3, Page 11.4. This chapter will assume that you know how to use the structure editor, DEdit. The CONS variable is a list of lists. The first atom in each internal list specifies for the file package what types of items are in the list, and what it is to do with them. This section will deal with three types of lists: VARS, FILES, and P. Please read about others in the lnterlis~D Reference Manual, Volume ll, Chapter 17. The list that begins with "VAR5'� allows you to set the values of variables. For example, one global variable is called DEditLinger. Its default value is T, and means that the D�dit window won't close affer you exit DEdit. If it is set to NIL, then the DEdit window will be closed when you exit DEdit. To set it to NIL in your INlT file, edit the VARS.list so that it looks like this: � . . .1 1 �1 ((`,4R.$' iOEdirLinger NlLii Her B~,are G~lete Replace `3yvitch ( ) (out Undo Find 5'rtap Rcprint Edit EditCam Break Eva Exit Figur� 12J. Setting the variable DEdI tLi nge r in INITCONS. Notice that inside the vars list, there is yet another list. The firtt item in the list is the name of the variable. It is bound to the value of the second item. There are many other variables that you can set by adding them to the VARS list. Some of these variables are described in Chapter 43, and many others can be found in the lnterlis~D Reference Manual. If you want to automatically load files, that can be done in your init file also. For'exampe, if you always want to load tho Library file SPY. DCOM, you can load it by editing tho INlTC0MS variable to list the appropriate file in th� list starting with FILES: 12.1 YOUR NIT flu MAKING AN INlT FILE (yARS iflEdlr.Llng�r NIL') After ff1LE~ _ ~PY\) Betott Delete Replace Switch ()out Undo Find Swap Reprint Edit EddCom Breok Evol Exit FluFe 12.3. INITCOMS changed to load the file SPY.DCOM Other files can also be added by simply adding their names to this FILES list. Another list that can appear in a COMS list begins with "P". This list contains Interlisp-D expressions that are evaluated when the file is loaded. Do not put DEFINEQ expressions in this list. Define the function in the environment, and then save it on the file in the usual way (see Section 11.6, Page 11.7). One type of expression you might want to see here, however, is a F0NTCREATE function (see Section 31.2, Page 31.2). For example, of you want to use a Helvetica 12 BOLD font, and there is not a fontdescriptor for it normally in your environment, the appropriate call to FOffTCREATE should be in the `�P" list. The INlTCOMS would look like this: . ((VARS (D�ditLingcr NIL)) After (FILES SPY) Betone (~ JFoHTcREaTE (QUOTE Delcte HEL\'ETIl',, Repace ~vyitch 1- ~juoTE _ SOL") _ .1)) (`out Undo Find Swap Reprint Edit EdiKom Break Eva Exit Figure 12.4. ltulTcOfl5editedtoincludeacalltofOffTCflEATE. The form will be evaluated when thelNlT file is loaded. To quit, exit from DEdit in the usual way. When you run the function NAKEFiLES (See Section 11.6, Page 11.7.), be sure that you are connected to the directory (see Section 8.7, Page 8.4) where the INlT file should appear. Now when GREET is run, your init file will be loaded. Y0UR INlT FILE 123 ----- Next Message ----- Date: 19 Dec 91 16:48 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.164812pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11686>; Thu, 19 Dec 1991 16:48:22 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 16:48:12 -0800 From: John Sybalsky -----RFC822 headers----> r 33. MASTERSCOPE Masterscope is a tool that allows you to quickly examine the structure of complex programs. As your programs enlarge, you may forget what variables are global, what functions call other functions, and so forth. Masterscope keeps track of this for you. Suppose that JVTO is the name of a file that contains many of the functions involved in a complex system and that LlNTRANS is the file containing the remaining functions. The first step is to ask Masterscope to analyze these files. These files must be loaded. All Masterscope queries and commands begin with a period followed by a space, as in � AliLYZE FKS a Jvro The ANALYZE process takes a while, so the 5ystem prints a period on the screen for each function it has analyzed. (See Figure 33.1) 82&. ANALYZE FNS ON 3VTO . d.,ne D3~. aNALY?E FNS ON LIH1R'N~ . 1a,lA.l Figure 33.1. The Interlisp-D Executive Window affer anolyzing the files If you are not quite sure what functions were just analyzed, type the file's CONS variable (See Section 11.5, Page 11.7.) into the Interlisp-D Executive Window. The names of the functions stored on the file will be a part of the value of this variable. A variety of commands are now possible, all referring to individual functions within the analyzed files. Substantial variation in exact wording is permitted. Some commands are: � SHoN PATHS FRDN ANY T0 ANY � EDIT WERE ANY CALLS functionname � EDIT WERE ANY USES variablename � Wo CALLS WDN � Wo CALLS functionname � BY WoN IS functionname CALLED � WD USES variablename AS FIELD Note that the function is being called to invoke each command. Refer to the /nterlisp-D Reference Manual for commands not listed here. Figure 33.2 shows the lnterlis~D Executive Window affer the commands � wno CALLS GobbleDunp and � vffo DOES JVLinScan CALL. MASTb'R'j~OPE 331 MASTEH,COPE NIL 7,.,'. 1,,.lillj O~LL;==: ,1)~8 iD.B~imp (,"c.h.~t,:r~i'TJ .J;/,j~J,J .J'.'t'r'Jet'TJ J;,'~~ 1Tij Gi>"ri'.'p~" ,,)bbl,,Ffu:h ,"jbb1~'Srririll I/dump Fiji `...,9j', "Ho clclE.. .J"i'L i `-. r, 1'"'LL (Liri.'ci-ri 1'�.'Cfr.3b1A 3 -h1~J `9'A Figure 33.2. Sample Masterscope Output 33.t The SHOW DATA command and GRAPNER When the library package GRAPHER is loaded, (to load this package, type (FILESLOAD GRAPHER).) Masterscope's SHOWPATHS command is modified. The command will be changed to generate a tree structure 5howi ng how the program's functions interact instead of a tabular printout into the lnterlis~D Executive window. For example, typing: � ~ PATHS FW Proce:s�E. produced the display shown in Figure 33.3. .GtB.,31nT~, T L:.n;.lLl:'�.Ut�n:P,.= ~"``-,Jt",,;r,.pj r~infr.:p it'~�;r.!rPr:p r.>~>(Li;'7Ui�n~p..: ..~..JtL,;.l. Ofl'.JtLl;l. . `,r:L,st lET _ p-: �::J8:~inEnJ ,*.l.T�.'r:. � .Err.'.r Pfl!I Pr'ni.~n,.; :p~1y ~lnt~nlno Figur� 33.3. SHOW PATHS Dsplay Example All the functions in the display are part of this analyzed file or a previously analyzed file. Boxed functions indicate that the function name has been duplicated in another place on the display. Selecting any function name on the display will pretty print the function in a window. (See Figure 33.4.) ij.J MAsTERscopa THE SHOW DATA COMMAND AND GRAPHER -~&lLir1wilhS h�fi .�~Tl�o1nTwTr1no~ ~9i"~ � 1n,fl~ _ ~i~or9~~~ � ~~&tl1r?inith. "(s . to~~tLisi _ ~~otLirt ~�~.~.~r�,�; ______ Pw:�Llrt ~(L�TT�.' � .` .d.~~~~;� ~qLT~' f � ��..`P�intError PTl.I Frint~nin�i � � .- upv ~inlWr,r. [LAnaPA ~propnaao�'i (` cdttod: ��16�MAA��3�' L'6''d�� eCAn~'9SCorProp prcpneae (suR 1012C8L'�k]) Figutt 33.4. Browser Printout Example. Selecting it again with the leff mOuse button will produce a dexription of the function's role in the overall system (See Figure 33.4) ~r.�;l.1,'?U1�n�;�f'.:� �t1Bfg�inTW:�l.riny~ ________ ,p'~�~ 1"~�:t,-'��.Pr'~ . ~c.3v.Li�iniih~t Proc&;:Eli<. _________ � .. . Por;�~�r' �~:l=T7�o�. �nf&r�.��r ~T=i Prir,t.~nir,� � �P�ntWr,1fl4� � GerryProp i,, - � L-Qll:! inetAnC .rorPrtih� 1n�N�l,~ lrireFi�J.,rning� Din" `pe~�b��'c8cJ1nT;.,='�tr1n0. i=~rML�,� 1r�'"�$�T=~',F�r=Ce�'��EtlD � u~' f.-cc� TO cocl Fl�Urf 33.5. Browser Description Example. 33.2 Databasefns: Automatic Construction and Upkeep of a Masterscope Database DataBaseFns is a separate library package that allows you to automatically construct and maintain Masterscope databases of your files� The package is contained in the DATABASEFNS.DCOM file. When DATABASEFNS.DCOM is loaded, a Masterscope database will be automatically maintained for every file whose.DATABASE MAST'RS~OPE 333 DATABASEFNS: _ AUTOMATIC CONSTRUCTION AND _ UPKEEP OF A MASTERSCOPE _ DATABASE property has the value YES. If this property's value is not set, you will be asked when you save the file "Do you want a Masterscope Database for this file?". Saying YES enables the DabaBaseFns to construct a Masterscope database of the file you are saving. Each time the function *AKEFILE is used on a file whose DATABASE property has a value YES, Masterscope will analyze your file and update its own database. Each file's masterscop database is kept in a separate file whose name has the form FILE. DATABASE. Whenever you load a file with a YES value for its DATABASE property, you will be asked whether you also want the database file loaded. 33.4 N~TERSCOPE 1 ----- Next Message ----- Date: 19 Dec 91 16:50 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.165058pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11688>; Thu, 19 Dec 1991 16:51:02 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 16:50:58 -0800 From: John Sybalsky -----RFC822 headers----> r� 34.WHERE DOES ALL THE TIME GO? sPY SPY is an Interlisp-D library package that shows you where you spend your time when you run your system. It is easy to learn, and very useful when trying to make programs run faster. 34.1 Now to use Spy with the SPY Window The function SPY. BUTTON brings up a small window which you will be prompted to position. Using the mouse buttons in this window controls the action of the SPY program. When you are not using SPY, the window appears as in Figure 34.1. Figure 34.1. The SPY window when SPY 15 not being rnsed. Ts use SPY, click either the leh or middle mouse button with the mouse cursor in the SPY window. The window will appear as in Figure 34.2, and means that SPY is accumulating data about your program. Figure 34.2. The SPY wir.oow when SPY is being used To turn off SPY affer the program has run, again click a mouse button in the SPY window. The eye closes, and you are asked to position another window. This window contains SPY's results. An ex~nr'ple of result window is shown in Figure 34.3. WHERE D0ES ALL THE TIME G0' SPY 341 1 HOW TO USE SPY WITH THE SPY WINDOW - TIrE. l _ `3~~"H[P _ J~. _ [WIT. _ IN~&F.-1!~ 17 _ `..TIrtP. PplJl'.E,-'-'.. - a ~i~~~~pT~�&- . REPE,,TE&L'.EV~rn EJ~rn �1 EF.�UFE 7 _ ---RR.. h.JPillU~. _ fPlLE-� -. 4 f, IPP,9R.h `F..n 4 Figure 34.3. The window produced afler running $PY This window i5 scrollable in two directions� horizontally, and vertically. This is useful, since the whole tree does not fit in the Winoovv. If a part that you want to see is not shown, then you can scroll the window to show the part you want to see. 34.2 How to use SPY from the Lisp Top Level SPY can also be run while a specific function or system is being used. To do this, type the function WITH. SPY: (VITN.sPY form) The expression used for form should be the call to begin running the function or system that SPY is to watch. If you watch the SPY window, the eye will blink! To see your results, run the function SPY. TREE. To do this, type: (SPY.TREE) The results of the last running of SPY will be displayed. If you do this, and 5PY.TREE returns (no SPY saiples have been gathQ red), your function ran too fast for SPY to follow. 34.3 Interpreting SPY's Results Each node in the tree is a box that contains, first, the percentage of time spent running that particular function, and second, the function name. There are two modes that can be used to display this tree. The default mode is cumulative. In this mode, each percentage is the amount of time that function spent on top of the stack, plus the amount of time spent by the functions it calls. The second mode is individual. To chango the mode to individual, point to the title bar of the window, and press the middle `n.ouse button. Choose Individual from the menu that appears. In this mode, the percentage shown is the amount of time th3t the function spent on the top of the stack. 34.2 WHERE 00E5 ALL TN5 ylMff G0? spY 1 lNTERPREn~ SPY'S RESuLtt ----- Next Message ----- Date: 19 Dec 91 16:40 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.164041pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11685>; Thu, 19 Dec 1991 16:40:51 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 16:40:41 -0800 From: John Sybalsky -----RFC822 headers----> 32. THE INSPECTOR The Inspector is a window-oriented tool designed to examine data structures. Because Interlisp-D is such a powerful programming environment, many types of data structures would be difficult to see in any other way. 32.1 Calling the Inspector Take as an example an object defined through a sequence of pointers (i.e. a bitmap on the property list of a window on the property list of an atom inaprogram.) To inspect an object named NAME, type: (IKSPECT `~) If NAME has many possible interpretations, an option menu will appear. For example, in Interlisp-D, a litatom can refer to both an atom and a function. For example, if NAME was a record, had a function definition, and had properties on its property list, then the menu would appear as in Figure 32.1. PRG'PS FklS FIELD;=~ Figure 32.1. Option Window For Inspection of NAME If NAME were a list, then the option menu shown in Figure 32.2 would appear. The options include: � calling the display editor on the list; � calling the ~ editor (the "Typing Shortcuts",Chapter 6); � seeing the list's elements in a display window. If you choose this option, each element in the list will appear in the right column of the Inspector window. The left column of the Inspector window will be made up of numbers. (See Figure 32.3.) � inspecting the list as a record type (this last option would produce a menu of known record types). If you choose a record type, the items in the list will appear in the right column of the Inspector window. The left column of the Inspector window wili be made up of the field names of the record. P~rI~.lErtr Tr:rE'1ir. Inip~rr A~are'iJrd Figure 32.2. Option Window For Inspection of Lirt THE INSPECTOR 321 USING THE INSPECTOR 32.2 Using the Inspector If you choose to display your data structure in an edit window, simply edit the structure and exit in the normal manner when done. If you choose to display the data structure in an inspect window, then follow these instructions: � To select an item, point the mouse cursor at it and press the left mouse button. � Items in the right column of an Inspector window can themselves be inspected. To do this, choose the item, and press the center mouse button. � Items in the right column of an Inspector window can be changed. To do this, choose the corresponding item in the left column, and press the center mouse button. You will be prompted for the new value, and the item will be changed. The sequence of steps is shown in Figure 32.3. � . 1 INPEu'T-ME-TOOl 1ie-,PErT-hl�-TQi32 a IN.u'FErT-11E-TQO3 The item in the lefl column is selected, and the middle mouse button pressed. Select the SET option from the menu that pops up. The ev..pre:1Un re3J will be E `/~LuQred. cHaflGE&-'.:~"LlJ4 1 ]N.=~Pfi=.T-rrtE-Tc~i 2 1H".~pEcT-ttE-TI:i12 a Il You will then be prompted for the new value. Type it in. �6 1 [flPEQT-ME-TOOi 2 [Y.~PECT-1'1E-TOfl2 a CH~Pl,'ED-'.;~LUE The item in the right column is updated to the value of what you typed in. Figure 32.3. The sequence of steps involved in changing a value in the right column of an Inspector window. 32.3 Inspector Example This example will use ideas discussed in 5ection 37.1. An example, ANlMALGItAPH, is created in that section. You do not need to know the details of how it was created, but the structure will be examined in this chapter. If you type (IKSPECT lI~.6liPN) and then choos� th� Inspect option from th� menu, a display app�ars as shown in Figure 32.4. ANlMAL.G~PH is being J 33.J TkElNSPECT~ lff5PE~0R EXAMPLE inspected as a list. Note the numbers in the left column of the inspectorwindow. 1 i't'fI.~H ~ NIL NIL --j `BIRD .~ NIL NIL � T .i, NIL 4 NIL 5 NIL 6 NIL ? NIL ,q� NIL 9. NIL 1A. NIL 11 NIL 1~" NIL Figure 32.4. Inspector Window For ANIMAL GRAPH, inspected as a list. If you choose the "As A Record" option, and choose "GRAPH" from the menu that appears, the inspector window looks like Figure 32.5. Note the fieldnames in the leff column of the inspectorwindow. UP"PH.CH"NCEL"eELFfl NIL CR"PH. INVEP.TL~BELFN NIL CR"PH. IFlvEp.TBCiROERFN NIL CR"PH.FONTcH"NoEFN NIL bRaPH.&ELETELINKFN NIL CRaPH�~D&LINkFN NIL URAPH.c�LETENC~UEFN HIL bRAPH. .oo&NUGEFN NIL oRoPH.Mo$ENUoEFN NIL DIREcTEDfLG NIL o"IDE~FLo T C.RuPHNi:DE.~ (i.'fl:H & NIL NIL --! `BIPP & NIL GIL Figure 32.5. Inspector Window For ANlMAL.GRAPH, inspected as an instance of a "GRAPH" record. The remaining examples will use ANlMAL.GRAPH inspected as a list. When the first item in the Inspector window is chosen with the leff mouse button, the Inspector window looks like Figure 32.6. 1 ` _ �1 T 3 NIL 4 NIL 5 NIL r~ NIL NIL NIL 9 NIL 1H NIL 11 NIL 1- NIL Figure 32.6. Inspector Window For ANlMAL.GRAPH With First Element Selected When you use the middle mouse button to inspect the seiected list element, the display looks like Figure 32.7. THE INSPECTOR 32 j INSPECTOR EXAMPLE 1 �1 T 3 NIL = 4 PIlL 5 NIL 1 iFIfl 1.19:' 44) PIlL NIL HIL --! `BIRD (.192 29) NIL PIlL NIL -- b' NIL 3 (CAT (.is ,J NIL NIL NIL PIlL j. (&UU i"1;39 7) PIlL PJIL NIL NIL ~ ((rh,,"trtffi,,"L GJU c~T) 199 14j fiL J.IlL 9 PIlL 6 ((,,"PIIMAL ; BIRD FI.Jh) .`..~ C9. IlL 19 PIlL 11 NIL 1'.' NIL Figuro 32.7. Inspertor Window For ANlMAL.GRAPH and For the First Element of ANIMAL�GRAPH How you can see that 5iX items make up the list, and you can further choose to inspect one of these items. Notice that this is also inspected as a list. As usual, it could also have been inspected as a record. Select item 5 - MAMMAL DOG CAT - with the leff mouse button. Press the middle mouse button. Choose "Inspect" to inspect your choice as a list. The Inspector now displays the values of the structure that makes up MAMMAL DOG CAT. (See Figure 32.8.) 1 (h1~~MMkL GJ, lIT) 2 ilvjy' lJ) NIL 4 NIL 5 NIL 6 45 7 is o i',Do': ClIT',i !) (c"'NlMlIL .~ BlRP FI."3Hj iR, (Fi=1NTCLn"',~r'j7R!i?e..764 ii hllIPtMlIL 12 NIL Figure 32.8. Inspector Window for Element S From Figure 32.7 That Begins ((MAMMAL DOG CAT). 32.A THE INSPECTOR ----- Next Message ----- Date: 19 Dec 91 16:54 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.165444pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11690>; Thu, 19 Dec 1991 16:54:53 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 16:54:44 -0800 From: John Sybalsky -----RFC822 headers----> . . . . . . . r� 34.WMERE DOES ALL THE TiME GO? sPY SPY is an Interlisp�D library package that shows you where you spend your time when you run your system. It is easy to learn, and very useful when trying to make programs run faster. 34.1 How to use Spy with the SPY Window The function SPY. BUTTON brings up a small window which you will be prompted to position. Using the mouse buttons in this window controls the action of the SPY program. When you are not using SPY, the window appears as in Figure 34.1. Figure 34.1. The SPY window when SPY is not being used. Ts use SPY, click either the Iefl or middle mouse button with the mouse cursor in the SPY window. The window will appear as in Figure 34.2, and means that SPY is accumulating data about your program. sPY Figure 34.2. The SPY wirdow when SPY is being used To turn off SPY atter the program has run, again click a mouse button in the SPY window. The eye closes, and you are asked to position another window. This window contains SPY's results. An example of result window is shown in Figure 34.3. WHERE D0ES ALL THE TIME Go' SPY 341 l How TO USE SPY `KlTH THE SPY WINDOW rp.i)rE? ~L,:,,.*~. IrtP.rpji=.E;'';. . �U TI~REhpYfi�&. J!l!i .EV~fi)f. `:. � �1 FEPEA~OL.EU~rn -`1 EJ~J .l ER.GURE 7 _ ��.BN.�.F i;f;i�.iU~. _ Fpi'cf��:�11 .. j IPP,fl~.�hJri.�ii.iN 4 Fiqure 34.3. The window produced affer running SPY Tljis window i5 scrollable in two directions, hOrizontaily, and vertically. This is useful, since the whole tree does not fit in the wiroow. If a part that you want to see is not shown, then you can scroll the window to show the part you want to see. 34.2 How to use SPY from the Lisp Top Level SPY can also be run while a specific function or system is being used. To do this, type the function VITH SPY: (WITH.sPY form) The expression used for form should be the call to begin running the function or system that SPY is to watch. If you watch the SPY window, the eye will blink! To see your results, run the function SPY. TREE. To do this, type: (SPY.TREE) The results of the last running of SPY will be displayed. If you do this, and SPY.TREE returns (no SPY saiples have been gathered), your function ran too fast for SPY to follow. 34.3 Interpreting SPY's Results Each node in the tree is a box that contains, first, the percentage of time spent running that particular function, and second, the function name. There are two modes that can be used to display this tree. The default mode is cumulative. In this mode, each percentage is the amount of time that function spent on top of the stack, plus the amount of time spent by the functions it calls. The second mode is individual. To chango the mode to individual, point to the titlo bar of the window, and press the middle .~ouse button. Choose Individual from the menu that appears. In this mode, the percentage shown is the amount of time that the function spent on the top of the stack. 34.2 WHERE nQE$ ALL THE TIME G0? SPY 1 1NTERPREfl~ SPY'S RESULTS To look fit G iingle branch of the tree, point with the mouse curtor at one of the nodes of the tree, and press the right mouse hutton. From the menu that appeatt, choose the option SubTree. Another SPY window will appear, with just this branch of the tree in it. Another way to focus within the tree is to remove branches from tlie tree. To do this, point to the node at the top of the branch you would like to delete. Press the middle mouse button, and choose Delete from the menu that appears. There are also different amounts of "merging" of functions that can be done in the window. A function can be called by another function more than once. The amount of merging determines where the subfunction, and the functions that it calls, appear in the tree, and how offen. (For a detailed explanation of merging, see the Lisp Library Packages Manual.) WHERE DOES ALL THE TIME GO' sPY 343 1 ----- Next Message ----- Date: 19 Dec 91 16:59 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.165929pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11691>; Thu, 19 Dec 1991 16:59:33 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 16:59:29 -0800 From: John Sybalsky -----RFC822 headers----> tilL.. 36. FREE MENUS Free Menu is a library package that is even more flexible than the regular menu package. It allows you to create menus with different types of items in them, and will format them as you would like. Free menus are pai~icularly useful when you want a "fill in the form" type interaction with the user. Each menu item is described with a list of properties and values. The following example will give you an idea of the structure of the description list, and some of your options. The most commonly used properties, aiid each type of menu item will be described in Section 36.2 and Section 36.3. 36.1 An Example Free Menu Free menus can be created and formatted automatically! It is done with the function FN. FORNATNENU This function takes one argument, a description of the menu. The description is a list of lists; each internal list describes of one row of the free menu. A free menu row can have more than one item in it, so there are really lists of lists of lists! It really isn't hard, though, as you can see from the following example: (SETQ Ex~1e*anu (F*.FORliT*EMu `(( TYPE TITLE LABEL TitlesDonothing) TYPE 3STATE LABEL Ex~1e3State)) ( TYPE EDITSTART LABEL PressToStartEd;ting ITEMS (EDITE*)) (TYPE EDIT ID EDITEN LABEL ��)) (*IKDDMPRDPS TITLE �Ex~1e Dris Nothing)))) The first row has 2 items in it; one is a TITLE, and the second is a 35TATE item. The second row also has 2 items. The second, the EDIT item, is invisible, because its label is an empty string. The caret will appear for editing, however, if the EDlTSTART item is chosen. Windowprops can appear as part of the description of the menu, because a menu is, affer all, just a special window. You can specify not only the title with WINDOWPROPS, but also the position of the free menu, using the "Ieff" and "bottom" properties, and !he width of the border in pixels, with the "border" property. Evaluating this expression will return a window. You can see the menu by using the function OPENW. The following example illustrates this: FREE MENUS 361 1 AN EXAMPLE FREE MENU 6i,'~T~ E;mD.1c1d~nij .;F(,7,fJp,[4,,$~]~fJ.J\J ,, �. T' Gf TITLE LBEL T ir1~,flN~rr T .T"rE =-�`T."TE L"bEL E:.Jm"1c5tJcs'!'. . `FE =,IT:..THF:T LEL =r~'=Tu'"r~t'tEditing lTEfl= cOlTEN' T"E `IT ID EDITEm L~8EL , "`..ililci=,..''=cipT=.. TITLE ` ;,.,1";c Din' 1'luthlnj.'? .TT9'i i)pf)liff molMertiJ'i f.hi1ltlDu',V'r#' j64 Figure 36.1. An example free menu The next example shows you what the menu looks like affer the EDlTSTART item, PressToStartEditing, has been chosen. T,r f~"=.Oi=i1'1,=irhin3 E':,mp1~,='.=r.,r~ P~'~='"'TJT..,rTEJ1r1r1.j A Figure 36.2. Free menu affer the EDlTSTART item has been chosen The following example shows the menu with the 3STATE item in its T state, with the item highlighted (In the previous bitmaps, it was in its neutral state.) . � c l 1 1 .1-=':.OiJ-tljrhini=! ,:`T'='Ot..;rrE'liriiJ, FigUre 36.3. Free menu with the 35TATE .tem in its T state Finally, Figure 36.4 shows the 35TATE item in its NIL state, with a diagonal line through the item T1r le.".OcNorhing E..::r'~ _ 1 _ = _ �`.`..,i.~ Rrn. ;``, T,St.arrEdir,iri, . . . . . Figure 36.& Free menu with the 3STATE item in its NIL state If you would like to specify the layout yourself, you can do that too. See the Lisp Library Packages Manual for more information. 36.2 Parts of a Free Menu Item There are 8 different types of items that you can use in a free menu. No matter what type, the menu item is easily described by a list of properties, and values. Somo of the properties you will use most often are: 36.2 FREE MENUS 1 PARTS OF A FREE MENU ITEM LABEL Required for every type of menu item. It is the atom, string, or bitmap that appears as a menu selection. TYPE One of eight types of menu items. Each of these are described below. MESSAGE The message that will appear in the prompt window if a mouse button is held down over the item. ID An item's unique identifier. An ID is needed for certain types of menu items. ITEMS Used to list a series of choices for an NCHOOSE item, and to list the ID's of the editable items for an EDITSTART item. SELECTEDFN The name of the function to be called if the item is chosen 36.3 Types of Free Menu Items Each type of menu item is described in the following list, including an example description list for each one. Momentary This is the familiar sort of menu item. When it is selected, the function stored with it is called. A description for the function that creates and formats the menu looks like this: (TYPE WEKTARY LABEL Blink-K-Rin9 *ES~6E �Blinks the screen and rings bells� s�LEcTEDFK RIKBELLS) TOGGL� This menu item has two states, T and NIL. The default state is NIL, but choosing the item toggles its state. The following is an example description list, without code for the SELECTEDFN function, for this type of item: (TYPE T~6LE LABEL hi~isab1e sELEcTEDFN changeIl*State) 3STATE This type of menu item has 3 states, NUIETRAL, T, AND NIL Neutral is the default state. T is shown by highlighting the item, and NIL is shown with diagonal lines. The following is an example description list, without code for the SELECTEDFN function, for this type of item: (TYPE 3STATE LABEL correctprogra�Allofflospelling sELEcTEDFli ToggleSpellingcorrection) TITLE This menu item appears on the menu as dummy text. It does nothing when chosen. An example of its description: (TYPE TITLE LABEL �Choices:") NWAY A group of items, nnly one of which can be chosen at a time. The items in the NWA�Y group should all have an ID field, and the ID's should be the same. For exan1Fle, to set up a menu that would allow the user to chose betvveei Helvetica, Gacha, Modern, and Classic fonts, the descriptions might look like this (Once again, without the code for the SELECTEDFN): (TYPE lAY ID F~Tc~Ic' LABEL blvetica sELEcTEDFN changeFont) FREE MENUS 36) I TYPES OF FREE MENU ITEMS (TYPE NVAY ID FOQTCKICE LABEL Gacha SELECTEDF (TYPE lAY ID F05TliCriC0ha,~n8efont) LABEL Modern SELECTEDFli Chan2eFont) (TYPE KAY ID fONTCHOIC LABEL Classic SELECTEDFN Changefont) NCHOOSE This type of menu item is like NWAY except that the choices are given to the user in a submenu. The list to specify an NCHOOSE menu item that is analogous to the NWAY item above might look like this: (TYPE MC~SF LABEL FontChoices ITEMS Helvotica Gacha Modern Classic) SELECT DfK Changefont) EDlTSTART When this type of menu itein is chosen, it activates another type of item, an EDIT item. The EDIT item or items associated with an EDlTSTART item have their lD's listed on the EDlT5TART's ITEMS property. An example description list is: (TYPE EDITSTART LABEL �Function to add? ITEMS (Fn)) EDIT This type of menu item can actually be edited by you. It is often associated with an EDlT5TART item (see above), but the caret that prompts for input will also appear if the item itself is chosen. An EDIT item follows the same editing conventions as editing in Interlisp-D Executive window: Add Characters by typing them at the caret. Move the caret by pointing the mouse at the new position, and clicking the leff button. Delete Characters from the caret to the mouse by pressing the right button of the mouse. Delete a character behind the caret by pressing the back space key. Stop editing by typing a carriage return, a Control-X, or by choosing another item from the menu. An example description list for this type of item is: (TYPE EDIT ID Fn LABEL ��) 36.4 FREENEMus 1 ----- Next Message ----- Date: 19 Dec 91 17:05 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.170545pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11694>; Thu, 19 Dec 1991 17:05:54 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 17:05:45 -0800 From: John Sybalsky -----RFC822 headers----> 37. THEGRAPHER 37.1 Say it with Graphs Grapher is a collection of functions for creating and displaying graphs, networks of nodes and links. Grapher also allows you to associate program behavior with mouse selection of graph nodes. To load this package, type (FILESL~ GliPHER) Figure 37.1 shows a simple graph. i `iLk w.F."PH `N M'L.l;R"PH `NlM'�L r;P"Pff�' ,(.h,,lINGUY!:�w',1513.y1 14' -FIH . NIM"L, BIRO Figure 37.1. A Simple Graph In Figure 37.1 there are six nodes (ANIMAL, MAMMAL, DOG, LAT, FISH, and BIRD) connected by five links. A GRAPH is a record containing several fields. Perhaps the most important field is GRAPHNOD�S - which is itszlf a list of GRAPHNODE records. Figure 37.2 illustrates these data structures The window on top contains the fields from the simple graph. The window on the bottoms an inspection of the node, DOG. THEGRAPHER 371 SAY lTWlTH GRAPHS i9'1, I ET �`NI1'1,,L.CR~PH'.i Ilvl,l = `-#"=9,1j~'j','3 GPPH.cr"ilLEL,,�'BELFN `IL � 1'R"pH. Ili'�!ERTLBELFN 1.lIL � H. Ifl��.��ERTBDPDEPFN tilL H.FGtTi'.HNoEFPl 1�lIL , rP�'PH,t.lL/El�llDEFbl IL . OIRECTECFLi, (ilL � rp..'Pflbll) ~ I.F = , tilL III `.�B.IP.D NIL ff IL . NOOEBOPOER `ilL tiODEL,,'BEL loo , , `tODEFONT ~`FOIiT ` . .OtlffO&EO- It'lL - . t,iODE'.~,lOTH `.4, , IiUOEL6EL.'-H~OE ��lIL , NODELfiELBlTIrt,i�P �IIL , I,iUDEPUITlClI.l in NODE ID 300 Figure 37.2. Inspefling a Graph and a Node The GRAPHNODE data structure i~ described by its text (NODElD), what goes into it (FROMNODES), what leaves it (TONODES), and other fields that specify its looks. The basic model of graph building is to create a bunch of nodes, then layout the nodes into a graph, and finally display the resultant graph. This can be done in a number of ways. One is to use the function NODECREATE to create the nodes, LAYOUTGRAPH to lay out the nodes, and SHOWGRAPff to display the graph. The primer shows you two simpler ways, but please see the Library Packages Manual for more information about these other functions. The primer's first method is to use SHOWGRAPH to display a graph with no nodes or links, then interactively add them. The second is to use the function LAYOUT5EXPR, which does the appropriate NODECREATES and a LAYOUTGRAPH, with a list. The function SHQWGRAPH displays graphs and allows you to edit them. The syntax of SHOWGffAPH is (~liPH graph window lefibuttonfn middlebuttonfn topjustiffflg alloweditflg copybuttoneventfn) Obviously the graph structure is very complex. Here's the easiest way to create a graph. ~.6liPN III) lS5~liPN P.6liPH �5Y Sraph� KIL NIL NIL T) Figur� 37.3. My Graph 37.2 THEGRAPHER .J SAY IT WITH GRAPHS You will be prompted to create a small window as in Figure Figure 37.3. This graph has the title My Graph. Hold down the right mouse button in the wiridow. A menu of graph editing operations will appear as in Figure 37.4. D;Ier~ Link &=h~~n9e ib P.I ljbel g,nill~.r l&'bel l~.ro�~.r Dir~..ct~.i1 SIdPg ~ Boi�dP.r `h;~d" `Tr"P Figure 37.4. A Menu of Graph Editing Operations Here's how to use this menu to: Add a Node Start by selecting Add Node. Grapher will prompt you for the name of the node (See Figure 37.5.) and then its position. Figure 37.5. Grapher prompts for the name of the node to add affer Add Node is chosen from the graph editing menu. Position the node by moving the mouse cursor to the desired location and clicking a mouse button. Figure 37.6 ,hows the graph with two nodes added using this menu. ~ir�r-ri~tle s~~'ondnod~ Figure 37.6. Two nodes added to MY GRAPH using the graph ed it.q.g menu AddaLink Select Add Link from the graph editing menu The Prompt window will prompt you to select the two nodes to be linked. (See Figure 37.7.) Do this, and the link will be added. o . first-node ,.ccond-node Figure 37.7. The Prompt window will prompt you to select the two nodes to link. THEGRAPHER 37.3 SAY IT WITH GRAPHS DeleteALink Select Delete Link from the graph editing menu. ThePrompt window will prompt you to select the two nodes that should no longer be linked. (See Figure 37.8.) Do this, and the iink will be deleted. r _ `rr-n>';1~ ;`~"or,'j-nod; FigUre 37.8. The Prompt window will prompt you to Seje~~ `.1 ryo nodes that shouid no longer be linked. Delete A Node Select Delete Node from the graph editing menu. The Prompt window will prompt you to select the node to be aeleted. (See Figure 37.9.) Do this, and the node will be deletea. firs. r-nod" ,L'0fl'S1-fl0d~ Figure 37.9. The prompt to delete a node Moving a Node Select "Delete Node" from the graph editng menu. Choose a node pointing to the it with the mouse cursor, and pressing and holding the leff mouse button. When you move the mouse cursor, the node will be dragged along. When the node is at the new position, release the mouse button to deposit the node. The commands in this menu are easy to learn. Experiment with them! 37.2 Making a Graph from a List Typically, a graph is used to display one of your program's data structures. Here is how that is done. LATOUTSEXPR takes a list and returns a GRAPH record. The syntax of the function is (UYWTSEXPR sexpr format ~xing font motberd penonald fam;lyd) For example: (u~T10Q AKIliL.TREE `(MIlL (l'~ ~ CAT) BIli FISH)) AaIliL.6liN 37.4 THEGRApHER MAKING A GRAPH FR0M A LIST b~YouTSE*PR AKIliL .TREE �HoRIZ0NTALi~) (Eli N AHIliL.GliPN �Nj Gr�pb� NIL KIL a T) This is how Figure 37.1 was produced. 37.3 Incorporating Grapher into Your Program The Grapher is designed to be built into other programs. It can call functions when, for example, a mouse button is clicked on a node. The function SHOWGRAPff does this: (~liPH graph window leflbuttonfn middlebuttonfn topjusti~Rg alloweditflg copybuttoneventfn) For example, the third argument to SHOWGRAPH, leftbuttonfn, is a function that is called when the lefl mouse buttoii 15 pressed in the graph window. Try this: (DEFIK�Q (~.LEfT.BUTT0N.FUNCTI0N (TNE.6liPHNooE THE.GliPH.wIN~) (INSPECT TNE.6liPNNooE))) (~liPH FlILY.61PN �Inspoct&bla fiily� (F~TIK N".LEFT.BUTTa.FuNCTIo*) liIL NIL T) In the example above, liT.LEFT.BUTTON. FUNCTION simply calls the inspector. Note that the function should be written assuming it will be passed a graphnode and the window that holds the graph. Try adding a function of your own. 37.4 More of Grapher Some other Library packages make use of the Grapher. (Note: Grapher needs to be loaded with the packages to use these functions.) � NASTERSCOPE: The Browser package modifies the Masterscope command, . SHOW PATHS, so that its output is displayed as a graph (using Grapher) instead of simply printed. � GRAPHZOOM: allows a graph to be redisplayed larger or smaller automatically. THEGRAPHER 375 ----- Next Message ----- Date: 19 Dec 91 17:11 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.171147pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11697>; Thu, 19 Dec 1991 17:11:55 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 17:11:47 -0800 From: John Sybalsky -----RFC822 headers----> 41. RESOURCE MANAGEMENT 41.1 Naming Variables and Records You will find times when one environment simultaneously hosts a number of different programs. Running a demo of several programs, or reloading the entire Interlisp-D environment from floppies when it contains several different programs, are two examples that could, if you aren't careful, provide a few problems. Here are a few tips on how to prevent problems: � If you change the value of a system variable, ffENUHELDVAIT for example, or connect to a directory other than (DsK), write a function to reset the variable or directory to its original value. Run this function when you are finished working. This is especially important if you change any of the system menus. � Don't redefine Interlisp-D functions or CLl5P words. Remember, if you reset an atom's value or function definition at the top level (in the Interlisp-D Executive Window), the message (Some.Crucial.Function. Or. Variable redefined), appears. If this is not what you wanted, type UNDO immediately! If, however, you reset the value or function definition of an atom inside your program, a warning message will not be printed. � Make the atom names in your programs as unique as possible. To do this without filling your program with unreadable names that noone, including you, can remember, prefix your variable names with the initials of your program. Even then, check to see that they are not already being used with the function BOUNDP. For example, type: (~P �B&ckgroundhnu) This atom is bound to the menu that appears when you press the leff mouse button when the mouse cursor is not in any window. BOUKDP returns T. BOUNDP returns NIL if its argument does not currently have a value. � Make your function names as unique as possible. Once again, prefixing function names with the initials of your program can be helpful in making them unique, but even so, check to see that they are not already being used. GETD is the Interlisp-D function that returns the function definition of an atom, if it has one. If an atom has no function definition, GETO returns NIL. For example, type: (GEffl `CAR) RESOURCE MANAGEMENT 411 NAMING VARIABLES AND RECORDS A non-NIL value i~ returned. The atom CAR already has a function definition. � Use complete record field names in record FETCHes and REPLACEs when your code is not compiled. A Complete record field name is a list Consisting of the record declaration name and the field name. Consider the following example: REC0RD N~ FIRST LAST)) SETQ Nyfflrn create Nl� FIRST `John LAST `~ith)) FETCH (~ FIRST) OF Mylrn) � Avoid reusing names that are field names of Interlisp-D System records. A few examples of system records follow. Do not reuse these names. RECORD RE6IOl (LEFT RoTTOl WIDTH NEIGHT)) RECORD POSITIK xC00RD RECORD Ili6E~ BITliYCP00RD))) � When you select a record name and field names for a new record, check to see whether those names have already been used. Call the function RECLOOK, with your record name as an a�rgument, in the lnterlis~D Executive Window. (See Figure 41.1.) If your record name is already a record, the record definition will be returned; otherwise the function will return NIL. - . 11 4..O�:�(fi.ECL)OY~ FB;'~ITiON) !`P\ECCPO PO~1TI)N [�T\L~'.lp:E)F;,P "So'1P~D! (8Nfl (LlSTP O~TUM\ (NUl18�P~P !`,C4l'~ D~TUfi1:)) (i\"('~'T�h1\\j (NUMBER� (CDR OurOIl] 5ik(P~ECLOUff N~,~P~~) NIL 5~'~E Figuv� 41.1. RECLOOK returns tbe record definition If ts argument is already declared as a record, NIL otne~ise. Call the function FIELDLOOK with your new field name in the Interlisp�D Executive Window. (See Figure 41 2.) If your field name is already a field name in another record, the record definition will be returned; otherwise the function will return NIL. 412 RESOURCE MANAGEMENT �1 NAMING VARIABLES AND RECORDS , 1 ~.4'+(fIELOLOOft Y96COORD) ((RECORD pO'e.ITION (:~`COORO \COORD) [T'Y'PE"� (~NP (LIvt~TP O4TUbl! (NUblBERP (CAR D,iTUhl\ I:.NUMBERP ("OR D~TUftt] (S\�'~~.TEb1)\) 55~(FIELPLOPh .ip~;\ NIL 58- Figure 41.2. FIELDLOOK returns the record definition if ItS argument Is already the field ofarecord.NILothe~ise 41.2 Some Space and Time Considerations In order for your program to run at maximum speed, you must efficiently use the space available on the system. The following section points out areas that you may not know are wasting valuable space, and tips on how to prevent this waste. Often programs are written so that new data structures are created each time the program is run. This is wasteful. Write your programs so that they only create new variables and other data structures conditionally. If a structure has already been created, use it instead of creating a new one. Some time and space can be saved by changing your RECORD and TYPERECORD declarations to DATATYPE. DATATYPE is used the same way as the functions RECORD and TYPERECORD. (See Chapter 24.) In addition, the same FETCH and REPLACE commands can be used with the data structure DATATYPE creates. The difference is that the data structure DATATYPE creates cannot be treated as a list the way RECORDs and TYPEREC0RDs can. 41.2.1 Global Variables Once defined, global variables remain until Interlisp-D is reloaded. Avoid using global variables if at all possible! One specific problem arises when programs use the function 6ENSYff. In program development, many atoms are created that may no longer be useful. Hints: � Use (DELDEF atomname `PKP) to delete property lists, and (DELDEF atomname `vARS) RESOURCE MANAGEMENT 413 ----- Next Message ----- Date: 19 Dec 91 17:15 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.171603pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11560>; Thu, 19 Dec 1991 17:16:06 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 17:16:03 -0800 From: John Sybalsky -----RFC822 headers----> SOME SPACE AND TIME CONSIDERATIONS to have the atom act like it is not defined. These not only remove the definition from memory, but also change the appropriate f 11 eCOffS that the deleted object was associated with so that the file package will not attempt to save the object (function, variable, record definition, and so forth) the next time the file is made. Just doing something like (SETQ (arg at~nm) `~IE) looks like it will have the same effect as the second DELDEF above, but the SETQ doesn't update the file package. � If you are generating atom names with GENSYN, try to keep a list of the atom names that are no longer needed. Reuse these atom names, before generating new ones. There is a (fairly large) maximum to the number of atoms you can have, but things slow down considerably when you create lots of atoms. � When possible, use a data structure such as a list or an array, instead of many individual atoms. 5uch a structure has only one pointer to it. Once this pointer is removed, the whole Structure will be garbage collected and space reclaimed. 41.2.2 Circular Lists If your program is creating circular lists, a lot of space may be wasted. (Note that many cross linked data structures end up having circularities.) Hints when using circular lists: � Write a function to remove pointers that make lists circular when you are through with the circular list. � If you are working with circular lists of windows, bind your main window to a unique global variable. Write window creation conditionally so that if the binding of that variable is already a window, use it, and only create a new window if that variable 15 unbound or NIL. Here is an example that illustrates the problem. When several auxilIary windows are built, pointers to these windows are usually kept on the main window's property list. Each auxilIary window also typically keeps a pointer to the main window on its property list If the top level function creates windows rather than reusing existing ones, there will be many lists of useless windows cluttering the work space. Or, if such a main window is closed and will not be used again, you will have to break the links by deleting the relevant properties from both the main window and all of the auxiliary windows first. This is usually done by putting a special CLOSEFli on the main window and all of its auxiliary windows. 41.2.3 When You Run Out Of Space Typically, if you generato a lot of structure! that won't get garbage collected, you will eventually run out of space. The important part ii being aNe to track down those structures and 4I.4 REsouRcE MANAGEMENT I SOME SPACE AND TIME CONSIDERATIONS the code that generates them in order tO become more space efficient. The Lisp Library Package GCHAX.DCOM can be used to track down pointers to data structures. The basic idea is that GCHAX will return the number of references to a particular data structure. A special function exists that allows you to get a little extra space 50 that you can try to save your work when you get toward the edge (usually noted by a message indicating that you should save your work and sysin a fresh Lisp). The GAINSPACE function allows you to delete non-essential data structures. To use it, type: (liIKSPACE) into the Interlisp-D Executive Window. Answer "N" to all questions except the followi ng. � Delete edit history � Delete history list. � Delete values of old variables. � Delete your MASTERSCOPE datadase � Delete information for undoing your greeting. Save your work and reload Lisp as soon as possible. RESOURCE MANAGEMENT 41 S ----- Next Message ----- Date: 19 Dec 91 17:23 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.172334pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11625>; Thu, 19 Dec 1991 17:23:37 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 17:23:34 -0800 From: John Sybalsky -----RFC822 headers----> 42. SIMPLE INTERACTIONS WITH THE CURSOR, A BITMAP, AND A WINDOW The purpose of this chapter is to show you how to build a moderately tricky interactive interface with the various lnterlis~D display facilities. In particular how to move a large bitmap (larger than 16 x 16 pixels) around inside a window To do this, you will change the CURSORINFN and CURSOROUTFN properties of the window. If you would also like to then set the bitmap in place in the window, you must reset the BUTTOKEVENTFN. This chapter explains how to create the mobile bitmap. 42.1 An Example Function Using GETMOUSESTATE One function that you will use to "trace the cursor" (have a bitmap follow the cursor around in a window) is GETNOUSESTATE. This function finds the current state of the. mouse, and resets global system variables, such as LASTM0USEX andLASTMOUSEY. As an example of how this function works, create a window by typing (SETQ EzMPLE.wIN~ (CREATEI)) into the Interlisp-D Executive window, and sweeping out a window. Now, type in the function (DEFIKEQ (PRIKTC00RDS (V) P~TPRI*T �(� ~TuouSEx ., . US~EY �)�) BLocK) 6E~SESTATE))) This function calls GETNOUSESTATE and then prints the new values of LASTNOUSEX and LASTMOUSET in the promptwindow. To use it, type (WIKraoPRoP EXlPLE .ilI*~ `CURSD~EDFK `PRIaTC00RDS) The window property CURSORffOVEDFN, used in this example, will evaluate the function PRINTCOORDS each time the cursor is moved when it is inside the window. The position coordinates of the mouse cursor will appear in the prompt window. (See Figure 42.1.) SIMPLE INTERACTIONS M'ITH THE cuRsoR. A BlTMAP, AND A WINDOW 42 f I AN EXAMPLE FUNcTION USING GETMOUSE5TATE Figure 42.1. The current position coordinates of the mouse cursor are shown in the prompt window 42.2 Advising GETMOUSESTATE For the bitmap to follow the moving mouse cursor, the function GETKOUSESTATE is advised. When you advise a function, you can add new commands to the function without knowing how it is actually implemented. The syntax for advise is (RISE fn when where what) fn is the name of the function to be augmented. when and where are optional arguments. when specifies whether the change should be made before, affer, or around the body of the function. The values expected are BEFORE, AFTER, or AROUND. what specifies the additional code. In the example, the additional code, what, moves the bitmap to the position of the mouse cursor. The function GETNOUSESTATE will be ADVISEd when the mouse moves into the window. This will cause the bitmap to follow the mouse cursor. ADVISE will be undone when the mouse leaves the window or when a mouse button is pushed. The AOVISEing will be done and undone by changing the CURSORINFK, CURSOROUTFN, and BUTTONEVENTFK forthewindow. 42.3 Changing the Cursor Ofif laot part of tho examplo, to give th� impression that a bitmap is dragged around a window, th� original cursor should disappear. Try typing: (CURSOR (CURSORCR�Rrt (6I~PCREAtt 1 l) 1 11 �2.2 SINPU NVE~CYI0NS WITH Tn: CURSOR. A StTNAP. ANO A WIHIOOW CHANGING THE CURSOR into the lnterlis~D Executive Window. This causes the original cuttor to disappear. It reappears when you type (CURSOR T) When the cursor is invisible, and the bitmap moves as the cursor moves, the illusion is given that the bitmap is dragged around the window. 42.4 Functions for "Tracing the cursor" To actually have a bitmap trace (follow) the cursor, the environment must be set up so that when the cursor enters the tracing region the trace is turned on, and when the cursor leaves the tracing region the trace is turned off. The function Establish/Trace/Data will do this. Type it in as it appears (note: including the comments will help you remember what the function does later). (DEFIKEQ Establish/Trace/rata [LANR0 (�nd tracebiteap cursor/rightoffse~ cursor/heighteffse~ GCGA6P) � This functlri is coll�d to ostablish tha d�ti to trac� the d�sirod bitaap� ��nd� is the �ind~ in �hich the tracing is to take place, �tracebit�ap" is the �cursor/rightoffset� and �~~~50~'~~~g~~0t~~~~~5~i~~1 b~~i~~t~g~~5 �hich dete~ine the hotspot of the tracing biteap. As "cursor/heightof'set and �cursor/rightoffset� increase the cursor hotspot :ves up and to the right. If GCGAGP is non-NIL, GcGAC �ill be disabled.) (PRoG NIL (if (0R NULL �nd) (NULL tracebitaap)) then (PLAYTUN� (LIST (CONS 1000 4000))) (if ~&~&pRET~RN)) then (GC6A6)) � Create a blank cursor.) (SSEETTQQ ~8BrnUNNKKCTliURCS0ECRtiR(soBIRllNA�(CPCURRsoEARTcEREl,eT~lo�)jwxc~~2~�j~ � � Set the CURSOR IN and 0UT FNS for �nd to the Jolloeing:) (*INroNPRoP �nd UTE CURSORINF (FU TIrn SETUP/Tlic (WINDoNPooP �nd~~TE CURSoRoUTFENNJJ (FU TIoN UNTlic�/CURSOR)) (O � To all",' the bita,ap to be set den in the �indw bY pressing a "`ouse button, include this line. 0ther',,'ise, it is not needed) (WINnoNPRop �nd (UTE RUTToNEVENTFN) (FUNCTIoN PLACEIBITNAPIINIwINrGN)) Set up Global Variables for the tracing 9eratien) (SETQ �TRAcElITNAp� tracebiteap) TQ �RIGNTTliCE'oFFSET�(oR cursor/rightoffse~ 0) 5>sfE~TQ �HEIGHTTRACEIoFFSET�(0R cursor/hei htoffset )) TQ �0LQBIT~PPosITIoN�(BIfflPCREATE llNArnIOTN tracebit�ap) (SETQ �TliCCwfNDoN� rndj)) BITNApHEI6hT tracebiteap))) SIMPLE INTERAcT'oNs WITH THE cuRsoR. A BJTMAP. AND A WINDOW 423 1 FUNCTIONS FOR "TRACING THE CURSOR' When the function Establish/Trace/Data is called, the functions SETUP/TRACE and UNTRACE/CURSOR will be installed as the values of the window's WlNDOWPROP$, and will be used to turn the trace on and off. Those functions should be typed in, then: (DEFINEQ SETUP/TRACE [ADA �nd) (O � This function is and's cuRSORIKFK. It siepiy resoti th� last trace position and the current tracing region. It also raadvises fiETNouSESTATE to perforn the trace function after each call.) (if �TRAcEBITNAP� then SETQ �LAST-lPACE-XPO5� -zOo SETQ �LAST-TRACE-YPOS� -zooo�) SETQ �vNDREGIa� (WINOaNPROP and (ATE REGI0N))) WIN~flROP and (ATE TliCIK) T) � :ake the cursor disappear) CURSOR �BLANKTRACECURSOR�) ANISE QUOTE GEThOUSESTATE) QUOTE AFTER) IL (QUOTE (TPACE/CURSOR])) (Dt~EQ(UaNTRACE/CURSOR � Th1s function is �nd's CURsOROUTFN. The function first checks if the cursor is currently being traced; if so, it replaces th� tracing biiaap aith ahat is under it and then turns tracing off by unadvislng 6ETNOUSESTATE and setting th� TliCIK ainda propertj of �TRACEWINOoO� TO NIL.) (if (VIN~PnOP �TRACEWINOON�(QUOTE TliCIK)) then (BITBLT �0LOBITNAPPOSITION� o o (scREENBIllNAP) IPLUS CAR �ffDRE6ION�)�LAST-lRACE-xPOS�) (IPLUS 1CADR �:DREGIOffo )�usT-TlicE-YPos�)) (WINOoePRoP �lliCEMINOON�(QUOTE TRACIK) NIL)) replace the original cursor shape) (CURSOR T) unadvise 6E~sESTATE) (U~"'ISE (QUOTE 6ETNOUSESTAlE])) The function SETUP/TRACE has a helper function that you must also type in. It is TRACE/CURSOR: (DEFINEQ (TliCE/CURSoR [LANRli NIL � This functi: does th� actual BITBLTln of th� tracing blteap. This functla Is c�lled after a GE f TATE, abl � tracing.) (PRoG ( xpos IDIFFERENCE LAsTNOUsEZ �TRACEWINnoN� �RIGNTTRACE/OFF [ypoo IDIFFERENCE LAsTNOUsEY �TRACE*INr~� �NEIGnTTRACE/OfFSsEETiJ))) � If there Is an �rror In th� function, ress th� riKbt button to unodvls� th� function. This �ill eep th� ac in� fr: locking up.) (If (LASTNOUSESTATE RIGiiT) (if ~t1h~~~ (NUNAPuISE (QUOTE 6ElS~5ESlATE))) Q xpoa �LAST-TRACE-XP0s� (KEO ,pea �LAsl-TeACE-YPOS�j) th�n � Restoro ah�t ~s und�r the eld pooltla of th� tr�c� OilUp) (SITGLY �OLliIllnApposITIG�� o o (IREE5IlliA~) �2A SIMPLE lNTE~CJ\OHS WITH THE CURSOR. A BtTMAP. AflO A WINDOW 1 F, FUNCTIONS FOR "TRACING THE CURSOR" IPLUS CAR �il IPLUS CADR �:DDRRESEGISIrn�2�LASTTRAC � s�v� �b&t �111 b� und�r th� position of th� nee tr�c� biteap) (51 TILT SCREENBITNAP) [IPLUS (CAR �aDREGIa�) xpos) (IPLUS �vNDREGIoa� O O) BIfflLT the tracG blt:p onto th� n�� position of th� eouse.) (8ITBLT �TRACEBITNAP� O O ~5CREENBITNAP) (IPLUS (CAR �ilDRE ION") (fPLUS (CADS �ffORE6ION�) ypos NIL NIL YE INPUT) (ONDTE P liT)) � Savu the current position as the last trace position.) (SETQ �LAST-TRACE-xPDS� xpos (SETQ "LAST-TRACE-YPOS� ypos The helper function for UHTRACE/CURSOR, called UNDO/TRACE/DATA, must also be added to the environment: (DEFINEQ (UNDo/TRACE/DATA [LISA NIL � The purpose of this function is to turn tracing off and to free up the global variables used to trace the bitaap, so that thej can be garbage collected.) Check if the cursor is currently being traced. It so, turn it off.) UiTRACE/CURSoR) WINDoNPRDP �TliCE*IN~�(uTE CURSDRINFN) NIL) (WINDo*PRDP �TRACEwINDDN�(uTE CUR~R0UTFN) NIL) SETQ "TRACEBITsAP� NIL) SETQ �RIGNTTlicE/oFFsET� NIL) SETQ �HEIGHTTRACE/OFFSET� NIL) SETQ �OLDBITliPP0SITIDN� NIL) SETQ �TRACE*I~� NIL) � Turn GCGAG on) (6C6A6 TJ)) Finally, if you inCluded the WlNDOWPROP to allow the user to place the bitmap in the window by pressing a mouse button, you must also type this function: (D[E~DEAQ, �nd) UNADVISE (SETNDUSESTATE)) fBITBLT �TliCEBITNAP� O O SCREENBIlNAP) (IPLUS (CA 0N�) xpo (IPLUS (CADR �iDREGION�) ypos) NIL NIL (UTE INPUT) (ATE PAINT] That's all the functions! SIMPLE INTERAcTioNs NITH THE cuRsoR, A BITMAP, AND A WIND0W 42 S p RUNNING THE FuNcTlGh5 42.5 Running the Functions To run the functions you just typed in, first set a variable to a window by typing something like (SETQ EXMPLE.wIN~ (CR�ATEI)) into the Jnterlisp-D Executive window, and sweeping out a new window. No'rv, set a variable to a bitmap, by typing, perhaps, (SETQ ExlPLE.BTn (�DITl)) Type (Estab1isfl'Trsce'Oo~ EXlPLE.WIN~ EXlPLE.BTK)) When you move the cursor into the window, the cursor will drag the bitmap. (Note: If you want to be able to make menu selections while tracing the cursor, make sure that the hotspot of the cursor is set to the extreme right of the bitmap. Otherwise, the menu will be destroyed by the BITSLTs of the trace functions.) To stop tracing, either � move the mouse cursor out of the window; � press the right mouse button; � call the function UNTRACE/CURS0R. u.6 SIMPLE lNTEPACT~NS WITH THE CURSOR. A SITMAP. AND A WlN00W ----- Next Message ----- Date: 19 Dec 91 17:30 PST From: sybalsky:PARC:Xerox To: sybalsky Message-ID: <<91Dec19.173105pst.43009@origami.parc.xerox.com>.?::> <----RFC822 headers----- Received: from origami.parc.xerox.com ([13.1.100.224]) by alpha.xerox.com with SMTP id <11702>; Thu, 19 Dec 1991 17:31:18 PST Received: by origami.parc.xerox.com id <43009>; Thu, 19 Dec 1991 17:31:05 -0800 From: John Sybalsky -----RFC822 headers----> r fi. OTMER R�FERENCES THAT WILL 8E USEFUL TO YOU Here are some references to works that will be useful to you in addition to this primer. Some of these you have already been referred to, such as: � The Interlisp�D Reference Manual � The Library Packages Manual � The User's Guide to SKETCH � Thell86orllO8User'sGuide In addition, you can learn more about LISP with the books: � Interlisp-D: The languago and its usage by Steven H. Kaisler. This book was published in 1986 by John Wiley and Sons, NY. � Essential LISP by John Anderson, Albert Corbett, and Brian Reiser. This book was published in 1986 by Addison Wesley Publishing Company, Reading, MA. It was informed by research on how beginners learn LISP. � The Little Lisper by Daniel P. Friedman and Matthias Felleisen. The second edition of this book was published in 1986 by SRA Associates, Chicago. This book is a deceptively simple introduction to recursive programming and the flexible data structures provided by LISP. � LISP by Patrick Winston and Berthold Horn. The second edition of this book was published in 1985 by the Addison Wesley Publishing Company, Reading, MA. � LISP: A Gentle Introduction to Syabolic Coaputation by David S. Touretzky. This book was published in 1984 by the Harper and Row Publishing Company, NY. Finally, there are three articles about the Interlisp Programming environment: � Poaer Tools Tor PrograffaersbyBeauSheil. It appeared in Datamation in February, 1983, Pages 131 - 144. � The Interlisp Prograffaing Environaent by Warren Teitelman and Larry Masinter. It appeared in April, 1981, in lEEE Computer, Volume 14:1, Pages 25 - 34. � Prograa�ing In an Interactive Environaent� the LISP Experience by Erik Sandewall. It appeared in March, 1978, in the ACM Computing Surveys, Volume 10:1, pages 35 - 71. Each of these articles was reprinted in the book Interactive Prog ra��l ng Envl ronaents by David R. Barstow, Howard E. 0THER REFERENCES THAT WILL BE USEFuL T0 You 441 I OTHER REFERENCES THAT WILL BE USEFUL TO YOU Shrobe, and Erik Sandewail. This book was published in 1984 by McGraw Hill, NY. The first article can be found on pages 19 - 30, the second on pages 83 - 96, and the third on pages 31 80. J:' ill OTHER REFERE~E5 THAT WILL 55 usEFuL TO You I ----- End Forwarded Messages ----- End of message -TIMESROMAN - -TIMESROMAN -VH(DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8) (POSTSCRIPT (GACHA 8))) -�O�mz� \ No newline at end of file diff --git a/fonts/medleydisplayfonts/PCTERMINAL12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PCTERMINAL12-BRR.MEDLEYDISPLAYFONT index f7cb41ae..4e2a59e8 100644 Binary files a/fonts/medleydisplayfonts/PCTERMINAL12-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PCTERMINAL12-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PCTERMINAL12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PCTERMINAL12-MRR.MEDLEYDISPLAYFONT index 3057311b..d8949ed2 100644 Binary files a/fonts/medleydisplayfonts/PCTERMINAL12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PCTERMINAL12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PCTERMINAL14-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PCTERMINAL14-BRR.MEDLEYDISPLAYFONT index 59f7d5b1..e7b786cb 100644 Binary files a/fonts/medleydisplayfonts/PCTERMINAL14-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PCTERMINAL14-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PCTERMINAL14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PCTERMINAL14-MRR.MEDLEYDISPLAYFONT index 809ce525..e252c0a7 100644 Binary files a/fonts/medleydisplayfonts/PCTERMINAL14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PCTERMINAL14-MRR.MEDLEYDISPLAYFONT differ diff --git a/greetfiles/APPS-INIT b/greetfiles/APPS-INIT index 24dde3f9..21f74cec 100644 --- a/greetfiles/APPS-INIT +++ b/greetfiles/APPS-INIT @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Feb-2024 13:56:23" {DSK}frank>il>medley>gmedley>greetfiles>APPS-INIT.;17 23321 +(FILECREATED "26-Nov-2025 12:30:08" {DSK}larry>il>MEDLEY>GREETFILES>APPS-INIT.;2 23361 - :CHANGES-TO (VARS APPS-INITCOMS) - (FNS Apps.DoInit Apps.AroundExitFn) + :EDIT-BY "lmm" - :PREVIOUS-DATE "25-Feb-2024 13:14:02" -{DSK}frank>il>medley>gmedley>greetfiles>APPS-INIT.;16) + :CHANGES-TO (FNS Apps.CreateButtons) + + :PREVIOUS-DATE "25-Feb-2024 13:56:23" {DSK}larry>il>MEDLEY>GREETFILES>APPS-INIT.;1) (PRETTYCOMPRINT APPS-INITCOMS) @@ -214,7 +214,8 @@ 'MEDLEY-INIT-VARS AROUNDEXITFNS]) (Apps.CreateButtons - [LAMBDA (DoDocsToo) (* ; "Edited 13-Dec-2022 12:51 by frank") + [LAMBDA (DoDocsToo) (* ; "Edited 26-Nov-2025 12:29 by lmm") + (* ; "Edited 13-Dec-2022 12:51 by frank") (* ; "Edited 7-Dec-2022 11:28 by FGH") (* ; "Edited 5-Dec-2022 17:31 by FGH") (* ; "Edited 12-Nov-2022 14:52 by FGH") @@ -229,7 +230,7 @@ "ROOMS"))) (FEATURES-LABELS (for FEATURE in FEATURES collect (CADDR FEATURE))) (DOCS (LIST (LIST "https://interlisp.org/docs/medley/orientation/" "BASICS") - (LIST "https://interlisp.org/documentation/Medley-Primer.pdf" "PRIMER") + (LIST "https://primer.interlisp.org/" "PRIMER") (LIST "https://interlisp.org/documentation/IRM.pdf" "MANUAL") (LIST "https://interlisp.org/documentation/notecards_user_guide_v1.2.pdf" "NOTECARDS") @@ -419,8 +420,8 @@ (BKSYSBUF " ") ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1229 23187 (Apps.InitNotecards 1239 . 5101) (Apps.SetUpNOTECARDSDIRECTORIES 5103 . 6658 -) (Apps.DoInit 6660 . 10257) (Apps.CreateButtons 10259 . 19083) (Apps.CreateLabel 19085 . 19895) ( -Apps.ActivateCLOS 19897 . 21246) (Apps.ActivateRooms 21248 . 22099) (Apps.ShowDoc 22101 . 22250) ( -XCL-USER::EXEC_INTERLISP 22252 . 23024) (Apps.AroundExitFn 23026 . 23185))))) + (FILEMAP (NIL (1184 23227 (Apps.InitNotecards 1194 . 5056) (Apps.SetUpNOTECARDSDIRECTORIES 5058 . 6613 +) (Apps.DoInit 6615 . 10212) (Apps.CreateButtons 10214 . 19123) (Apps.CreateLabel 19125 . 19935) ( +Apps.ActivateCLOS 19937 . 21286) (Apps.ActivateRooms 21288 . 22139) (Apps.ShowDoc 22141 . 22290) ( +XCL-USER::EXEC_INTERLISP 22292 . 23064) (Apps.AroundExitFn 23066 . 23225))))) STOP diff --git a/greetfiles/APPS-INIT.LCOM b/greetfiles/APPS-INIT.LCOM index b3253ecf..bcf9748c 100644 Binary files a/greetfiles/APPS-INIT.LCOM and b/greetfiles/APPS-INIT.LCOM differ diff --git a/greetfiles/ONLINE-INIT b/greetfiles/ONLINE-INIT new file mode 100644 index 00000000..cdcae723 --- /dev/null +++ b/greetfiles/ONLINE-INIT @@ -0,0 +1,253 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "29-Oct-2025 23:56:02" {DSK}frank>il>medley>greetfiles>ONLINE-INIT.;2 11034 + + :EDIT-BY "FGH" + + :CHANGES-TO (ADVICE (SAVEVM :IN \IDLER)) + (FNS Online.SftpInitInfo Online.SftpUpdateInfo Online.SetUpNOTECARDSDIRECTORIES + Online.DoInit ONLINEP Online.FileButton) + (VARS ONLINE-INITCOMS) + + :PREVIOUS-DATE "18-Mar-2025 22:45:51" {DSK}frank>il>medley>greetfiles>ONLINE-INIT.;1) + + +(PRETTYCOMPRINT ONLINE-INITCOMS) + +(RPAQQ ONLINE-INITCOMS + [(FILES (SYSLOAD) + APPS-INIT) + (FILES (SYSLOAD) + VTCHAT) + (GLOBALVARS Online.LogoutTimeout Online.SftpPort Online.SftpPassword Online.SftpDisplay + IDLE.PROFILE IDLE.BOUNCING.BOX Online.SftpDisplayMenu ONLINEP ShellBrowser ShellOpener + CLHS.OPENER MEDLEYDIR) + (INITVARS (Online.LogoutTimeout 30) + (ONLINEP NIL)) + (ADVISE (SAVEVM :IN \IDLER)) + (FNS Online.SftpInitInfo Online.SftpUpdateInfo Online.SetUpNOTECARDSDIRECTORIES + Online.FileButton Online.DoInit ONLINEP) + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (Online.DoInit))) + (DECLARE%: FIRST DONTEVAL@LOAD DOCOPY (P (BKSYSBUF " "]) + +(FILESLOAD (SYSLOAD) + APPS-INIT) + +(FILESLOAD (SYSLOAD) + VTCHAT) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS Online.LogoutTimeout Online.SftpPort Online.SftpPassword Online.SftpDisplay IDLE.PROFILE + IDLE.BOUNCING.BOX Online.SftpDisplayMenu ONLINEP ShellBrowser ShellOpener CLHS.OPENER + MEDLEYDIR) +) + +(RPAQ? Online.LogoutTimeout 30) + +(RPAQ? ONLINEP NIL) + +[XCL:REINSTALL-ADVICE '(SAVEVM :IN \IDLER) + :AROUND + '((:LAST (COND + ((ONLINEP) + (LOGOUT)) + (T *] + +(READVISE (SAVEVM :IN \IDLER)) +(DEFINEQ + +(Online.SftpInitInfo + [LAMBDA NIL (* ; "Edited 17-Dec-2021 01:25 by abc") + (SETQ Online.SftpPort (UNIX-GETENV "SFTP_PORT")) + (SETQ Online.SftpPassword (UNIX-GETENV "SFTP_PWD")) + (SETQ Online.SftpDisplay (CONCAT Online.SftpPort " / " (L-CASE USERNAME) + " / " Online.SftpPassword)) + (SETQ Online.SftpDisplayMenu (create MENU + TITLE _ "SFTP Info" + ITEMS _ (LIST (MKATOM (CONCAT "Port: " Online.SftpPort)) + (MKATOM (CONCAT "User: " (L-CASE USERNAME))) + (MKATOM (CONCAT "Pwd: " Online.SftpPassword))) + MENUFONT _ (FONTCREATE 'CLASSIC 14 'BOLD]) + +(Online.SftpUpdateInfo + [LAMBDA (WHEN) (* ; "Edited 23-Nov-2021 22:44 by medley") + (COND + ((OR (EQ WHEN 'AFTERLOGOUT) + (EQ WHEN 'AFTERSAVEVM)) + (Online.SftpInitInfo]) + +(Online.SetUpNOTECARDSDIRECTORIES + [LAMBDA NIL (* ; "Edited 25-Feb-2024 11:20 by fgh") + + (* ;; "Find the location of the Notecards directory and call NC.SetUpNOTECARDSDIRECTORIES.") + + (* ;; " This is needed to make sure that lazy loading of Notecard types works.") + + (* ;; " This function should actually be defined and called in APPS-INIT. But until it is") + + (* ;; " we'll include and call it here in ONLIONE-INIT. No harm in calling it twice when") + + (* ;; " it eventually gets integrated into APPS-INIT.") + (* ; "Edited 25-Feb-2024 11:15 by fgh") + (LET* [(LOC1 (CONCAT MEDLEYDIR "notecards>")) + (LOC2 (CONCAT MEDLEYDIR "..>notecards>")) + (LOC3 (CONCAT MEDLEYDIR "..>..>notecards>")) + (NCDIR (for LOC in (LIST LOC1 LOC2 LOC3) thereis (OR (INFILEP (CONCAT LOC + "system>NOTECARDS")) + (INFILEP (CONCAT LOC + "system>NOTECARDS.LCOM" + ] + (if NCDIR + then (NC.SetUpNOTECARDSDIRECTORIES NCDIR) + T + else (PRIN1 "Warning: Notecards directory could not be found." T) + (PRIN1 "Hence, NOTECARDSDIRECTORIES is probably not set correctly" T) + (PRIN1 "and Notecards will not work properly." T) + NIL]) + +(Online.FileButton + [LAMBDA NIL (* ; "Edited 18-Mar-2025 22:31 by guest") + (* ; "Edited 17-Mar-2025 16:51 by fgh") + (* ; "Edited 16-Mar-2025 23:40 by guest") + + (* ;; " Add the FILES IMPORT/EXPORT button to the bottom of the button stack on the right side of the screen") + + (LET* ((RIGHTMARGINISH 140) + (Apps.BUTTONS (for B in *ALL-BUTTONS* when (WINDOWPROP B 'Apps.BUTTON) collect B)) + (LowestButton (CAR Apps.BUTTONS)) + P B L) + (if LowestButton + then + (* ;; " Find the lowest existing button on the right side of the screen") + + (for B in Apps.BUTTONS when [ILESSP (fetch BOTTOM of (WINDOWPROP B 'REGION)) + (fetch BOTTOM of (WINDOWPROP LowestButton + 'REGION] + do (SETQ LowestButton B)) + + (* ;; + " Set the y-position for the label based on the lowest button, then create the label") + + (SETQ L (Apps.CreateLabel "FILES" (IDIFFERENCE SCREENWIDTH (IDIFFERENCE + RIGHTMARGINISH + 50)) + (IDIFFERENCE (fetch BOTTOM of (WINDOWPROP LowestButton 'REGION)) + 35))) + (WINDOWPROP L 'RIGHTBUTTONFN 'NILL) + + (* ;; + " Set the position of the files button based on the label, then create the button") + + (SETQ P (create POSITION + XCOORD _ (IDIFFERENCE SCREENWIDTH RIGHTMARGINISH) + YCOORD _ (IDIFFERENCE (fetch BOTTOM of (WINDOWPROP LowestButton + 'REGION)) + 85))) + (SETQ B (CREATE-BUTTON '(ShellBrowse (UNIX-GETENV "OIO_FB_URL")) + "IMPORT/EXPORT" P)) + (WINDOWPROP B 'RIGHTBUTTONFN 'NILL) + [WINDOWPROP B 'BUTTONEVENTFN (FUNCTION (LAMBDA (BUTTON) + (if (LASTMOUSESTATE (ONLY LEFT)) + then (EXECUTE-BUTTON BUTTON] + T]) + +(Online.DoInit + [LAMBDA NIL + + (* ;; "Edited 29-Oct-2025 23:55 by FGH") + + (* ;; "Edited 16-Mar-2025 23:26 by guest") + + (* ;; "Edited 25-Feb-2024 11:37 by fgh") + + (* ;; "Edited 24-Feb-2024 00:26 by runner") + + (* ;; "Edited 7-Dec-2022 11:14 by FGH") + + (* ;; "Edited 12-Nov-2022 13:57 by FGH") + + (* ;; "Edited 12-Oct-2022 20:23 by fgh") + + (* ;; "Edited 6-Sep-2022 17:22 by fgh") + + (* ;; "Edited 4-Sep-2022 16:44 by larry") + + (* ;; "Edited 18-Mar-2022 18:53 by fgh") + + (* ;; "Edited 17-Dec-2021 22:05 by fgh") + + (PROGN + (* ;; "Set up SFTP Info widget in WHO-LINE window") + + (Online.SftpInitInfo) + (NCONC1 AROUNDEXITFNS 'Online.SftpUpdateInfo) + [COND + ([NOTANY *WHO-LINE-ENTRY-REGISTRY* (FUNCTION (LAMBDA (ENTRY) + (STRING-EQUAL (CAR ENTRY) + "SFTP"] + (PROGN (NCONC1 *WHO-LINE-ENTRIES* (LIST "SFTP" 'Online.SftpDisplay 30 + [FUNCTION (LAMBDA NIL + (MENU Online.SftpDisplayMenu] + NIL + "Port/Username/Password thru which to access files using SFTP" + )) + (NCONC *WHO-LINE-ENTRY-REGISTRY* (LAST *WHO-LINE-ENTRIES*)) + (INSTALL-WHO-LINE-OPTIONS] + + (* ;; " Set the IDLE timeout, set to SAVEVM 1 min after idle, set idle bouncing box") + + (LISTPUT IDLE.PROFILE 'SAVEVM 1) + (LISTPUT IDLE.PROFILE 'TIMEOUT Online.LogoutTimeout) + (SETQ IDLE.BOUNCING.BOX "Press any key to continue") + + (* ;; "set ONLINEP as a definitive flag that this is an online session") + + (SETQ ONLINEP (COND + ((STRING-EQUAL (UNIX-GETENV 'MEDLEY_ONLINE) + "true") + T) + (T NIL))) + + (* ;; + "set the opener for accesssing the Common Lisp Hyperspec - for use in HELPSYS LispUsers package") + + (SETQ CLHS.OPENER "/usr/local/interlisp/online/bin/request_new_tab") + (SETQ ShellOpener "/usr/local/interlisp/online/bin/request_new_tab") + (SETQ ShellBrowser "/usr/local/interlisp/online/bin/request_new_tab") + + (* ;; " get rid of Notecards logout prevention") + + (ADVISE 'NC.LogoutAdvice 'BEFORE 'FIRST '(RETURN T)) + + (* ;; "Reset Chat displaytype to enable vt100") + + (RPLACA (CAR CHAT.DISPLAYTYPES) + NIL) + + (* ;; "Create File Import/Export Button") + + (Online.FileButton) + + (* ;; "If there is a start-script file, load it ") + + (LET [(START-SCRIPT (UNIX-GETENV 'START_SCRIPT] + (IF START-SCRIPT + THEN (LOAD START-SCRIPT]) + +(ONLINEP + [LAMBDA NIL (* ; "Edited 24-Feb-2024 22:31 by fgh") + ONLINEP]) +) +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(Online.DoInit) +) +(DECLARE%: FIRST DONTEVAL@LOAD DOCOPY + +(BKSYSBUF " ") +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (1924 10898 (Online.SftpInitInfo 1934 . 2807) (Online.SftpUpdateInfo 2809 . 3064) ( +Online.SetUpNOTECARDSDIRECTORIES 3066 . 4774) (Online.FileButton 4776 . 7604) (Online.DoInit 7606 . +10759) (ONLINEP 10761 . 10896))))) +STOP diff --git a/greetfiles/ONLINE-INIT.LCOM b/greetfiles/ONLINE-INIT.LCOM new file mode 100644 index 00000000..a9e38cda Binary files /dev/null and b/greetfiles/ONLINE-INIT.LCOM differ diff --git a/installers/cygwin/medley.iss b/installers/cygwin/medley.iss index 1a71e1cd..27934a89 100644 --- a/installers/cygwin/medley.iss +++ b/installers/cygwin/medley.iss @@ -64,7 +64,7 @@ Name: "{group}\Medley\Uninstall_Medley"; Filename: "{uninstallexe}" ; Name: "{group}\Medley\Medley"; Filename: "powershell"; Parameters: "-NoExit -File {app}\medley.ps1 --help"; IconFilename: "{app}\Medley.ico" [Run] -Filename: "{app}\cygwin\setup-x86_64.exe"; Parameters: "--quiet-mode --no-admin --wait --no-shortcuts --no-write-registry --verbose --root ""{app}"" --site https://mirrors.kernel.org/sourceware/cygwin --only-site --local-package-dir ""{app}\cygwin"" --packages nano,xdg-utils"; StatusMsg: "Installing Cygwin ..." +Filename: "{app}\cygwin\setup-x86_64.exe"; Parameters: "--quiet-mode --no-admin --wait --no-shortcuts --no-write-registry --verbose --root ""{app}"" --site https://mirrors.kernel.org/sourceware/cygwin --only-site --local-package-dir ""{app}\cygwin"" --packages nano,xdg-utils,ghostscript,ghostscript-fonts-other"; StatusMsg: "Installing Cygwin ..." Filename: "{app}\bin\bash"; Parameters: "-login -c 'sed -i -e s/^none/#none/ /etc/fstab && echo none / cygdrive binary,posix=0,user 0 0 >>/etc/fstab'"; Flags: runhidden Filename: "tar"; Parameters: "-x -z -C ""{app}"" -f ""{app}\install\medley.tgz"""; Flags: runhidden; StatusMsg: "Installing Medley ..." Filename: "powershell"; Parameters: "remove-item -force -recurse ""{app}\maiko"""; Flags: runhidden; StatusMsg: "Installing Maiko ..." diff --git a/internal/loadups/LOADUP-LISP b/internal/loadups/LOADUP-LISP index 61ad45ff..23875a66 100644 --- a/internal/loadups/LOADUP-LISP +++ b/internal/loadups/LOADUP-LISP @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "18-Aug-2025 12:09:49" |{WMEDLEY}loadups>LOADUP-LISP.;21| 6713 +(FILECREATED " 5-Nov-2025 09:04:36" |{DSK}larry>il>MEDLEY>INTERNAL>loadups>LOADUP-LISP.;2| 7333 - :EDIT-BY |rmk| + :EDIT-BY "lmm" :CHANGES-TO (FNS LOADUP-LISP) - :PREVIOUS-DATE "15-Jun-2025 14:39:57" |{WMEDLEY}loadups>LOADUP-LISP.;20|) + :PREVIOUS-DATE "16-Oct-2025 16:55:27" +|{DSK}larry>il>MEDLEY>INTERNAL>loadups>LOADUP-LISP.;1|) (PRETTYCOMPRINT LOADUP-LISPCOMS) @@ -19,7 +20,9 @@ (DEFINEQ (LOADUP-LISP - (LAMBDA (DRIBBLEFILE) (* \; "Edited 18-Aug-2025 12:08 by rmk") + (LAMBDA (DRIBBLEFILE) (* \; "Edited 5-Nov-2025 09:01 by lmm") + (* \; "Edited 16-Oct-2025 16:55 by rmk") + (* \; "Edited 18-Aug-2025 12:08 by rmk") (* \; "Edited 15-Jun-2025 14:39 by rmk") (* \; "Edited 24-May-2025 10:20 by rmk") (* \; "Edited 21-May-2025 09:25 by rmk") @@ -89,9 +92,11 @@ (* |;;| "Before the MEDLEYFONT implementation, FONTPROFILE came after NEWPRINTDEF above, but the loadup failed for undiagnosed reasons. After moving it around, it appears that it must come before MENU, because it creates thw WINDOWTITLEFONT, but after HLDISPLAY. Not yet known what the HLDISPLAY dependency is. ") - (LOADUP '(UNICODE CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY FONTPROFILE MENU WINDOWOBJ - WINDOWSCROLL WINDOW WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT - DESCRIBE CMLARRAYINSPECTOR EDITINTERFACE TTYIN)) + (* |;;| "Also, UNICODE is split into UNICODE-TABLES and UNICODE, so the tables are loaded before their MCCS/Uncode client functions are installed. Functions in UFS now depend on those translations so that filenames can have characters outside of Ascii. ") + + (LOADUP '(UNICODE-TABLES UNICODE CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY FONTPROFILE MENU + WINDOWOBJ WINDOWSCROLL WINDOW WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL + DEXEC INSPECT DESCRIBE CMLARRAYINSPECTOR EDITINTERFACE TTYIN)) (LOADUP '(BREAK-AND-TRACE)) (LOADUP '(FASDUMP XCL-COMPILER ADVISE)) @@ -123,7 +128,10 @@ (* |;;| " Added late, LOAD late to avoid any dependencies") + (* |;;| "prevent medley from pinning CPU") + (LOADUP '(XCL-LOOP XCL-HASH-LOOP)) + (LOADUP '(BACKGROUND-YIELD)) (* |;;| " networking code -- should make it optional but too many cross dependencies") @@ -141,5 +149,5 @@ (GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST) ) (DECLARE\: DONTCOPY - (FILEMAP (NIL (640 6507 (LOADUP-LISP 650 . 6505))))) + (FILEMAP (NIL (675 7127 (LOADUP-LISP 685 . 7125))))) STOP diff --git a/internal/loadups/LOADUP-LISP.LCOM b/internal/loadups/LOADUP-LISP.LCOM index edf3b884..3a1d8608 100644 Binary files a/internal/loadups/LOADUP-LISP.LCOM and b/internal/loadups/LOADUP-LISP.LCOM differ diff --git a/library/MAIKOCOLOR b/library/MAIKOCOLOR index 3af8c6cc..dcddf0fd 100644 --- a/library/MAIKOCOLOR +++ b/library/MAIKOCOLOR @@ -1,21 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "26-Oct-2021 10:53:57" {DSK}larry>medley>library>MAIKOCOLOR.;2 60141 +(FILECREATED "30-Dec-2025 14:53:37" {WMEDLEY}MAIKOCOLOR.;3 58803 - changes to%: (VARS MAIKOCOLORCOMS) - (MACROS \MAIKO.CGTHREEP \MAIKO.CGFOURP \MAIKO.CGSIXP \MAIKO.CGTWOP) - (FNS \MAIKO.COLORINIT \MAIKO.STARTCOLOR \MAIKO.STOPCOLOR \MAIKOCOLOR.EVENTFN - \MAIKO.SENDCOLORMAPENTRY \MAIKO.CHANGESCREEN CURSOREXIT CURSORSCREEN - WARPCURSOR \SLOWBLTCHAR \SOFTCURSORUP \BITBLT.DISPLAY \PUNT.SLOWBLTCHAR - \PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP BITMAPOBJ.SNAPW \MAIKO.PUNTBLTCHAR - \MAIKO.BLTCHAR) + :EDIT-BY rmk - previous date%: "23-Oct-91 14:43:35" {DSK}larry>medley>library>MAIKOCOLOR.;1) + :CHANGES-TO (VARS MAIKOCOLORCOMS) + :PREVIOUS-DATE "26-Oct-2021 10:53:57" {WMEDLEY}MAIKOCOLOR.;2) -(* ; " -Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd.. -") (PRETTYCOMPRINT MAIKOCOLORCOMS) @@ -29,7 +21,7 @@ Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd.. \MAIKO.SENDCOLORMAPENTRY \MAIKO.CHANGESCREEN) (FNS CURSOREXIT CURSORSCREEN WARPCURSOR \SLOWBLTCHAR \SOFTCURSORUP \BITBLT.DISPLAY) (* ; - "these FNS defs. will be moved to original files,later") + "these FNS defs. will be moved to original files,later") (FNS \PUNT.SLOWBLTCHAR \MAIKO.PUNTBLTCHAR \MAIKO.BLTCHAR) (FNS \PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP) (FNS BITMAPOBJ.SNAPW) @@ -47,7 +39,7 @@ Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd.. (GLOBALVARS MAIKOCOLOR.BITSPERPIXEL) (FILES COLOR BIGBITMAPS) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD 'CURSOREXIT 'SAVE.CURSOREXIT) - (MOVD '\MAIKO.BLTCHAR '\BILTCHAR) + (MOVD '\MAIKO.BLTCHAR '\BLTCHAR) (\MAIKO.COLORINIT) (COLORDISPLAY 'ON 'MAIKOCOLOR) (CURSORSCREEN (COLORSCREEN) @@ -909,28 +901,20 @@ Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd.. [PROGN (DEFMACRO \MAIKO.CGTHREEP () (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage)) 48)) - (PUTPROPS \MAIKO.CGTHREEP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of - - \InterfacePage - )) - 48)))] + (PUTPROPS \MAIKO.CGTHREEP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage)) + 48)))] -(PUTPROPS \MAIKO.CGFOURP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of - \InterfacePage - )) - 64))) +(PUTPROPS \MAIKO.CGFOURP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage)) + 64))) [PROGN (DEFMACRO \MAIKO.CGSIXP () (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage)) 96)) - (PUTPROPS \MAIKO.CGSIXP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of - \InterfacePage - )) - 96)))] + (PUTPROPS \MAIKO.CGSIXP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage)) + 96)))] -(PUTPROPS \MAIKO.CGTWOP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage - )) - 24))) +(PUTPROPS \MAIKO.CGTWOP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage)) + 24))) ) (DECLARE%: EVAL@COMPILE @@ -974,7 +958,7 @@ Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd.. (MOVD 'CURSOREXIT 'SAVE.CURSOREXIT) -(MOVD '\MAIKO.BLTCHAR '\BILTCHAR) +(MOVD '\MAIKO.BLTCHAR '\BLTCHAR) (\MAIKO.COLORINIT) @@ -989,13 +973,12 @@ Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd.. (LOGOW) ) -(PUTPROPS MAIKOCOLOR COPYRIGHT ("Fuji Xerox Co., Ltd." 1988 1989 1990 1991)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3229 7254 (\MAIKO.COLORINIT 3239 . 4475) (\MAIKO.STARTCOLOR 4477 . 5293) ( -\MAIKO.STOPCOLOR 5295 . 5749) (\MAIKOCOLOR.EVENTFN 5751 . 6382) (\MAIKO.SENDCOLORMAPENTRY 6384 . 6842) - (\MAIKO.CHANGESCREEN 6844 . 7252)) (7255 28244 (CURSOREXIT 7265 . 8769) (CURSORSCREEN 8771 . 10877) ( -WARPCURSOR 10879 . 11194) (\SLOWBLTCHAR 11196 . 11608) (\SOFTCURSORUP 11610 . 17471) (\BITBLT.DISPLAY -17473 . 28242)) (28315 40283 (\PUNT.SLOWBLTCHAR 28325 . 35163) (\MAIKO.PUNTBLTCHAR 35165 . 39855) ( -\MAIKO.BLTCHAR 39857 . 40281)) (40284 56617 (\PUNT.BLTSHADE.BITMAP 40294 . 47386) (\PUNT.BITBLT.BITMAP - 47388 . 56615)) (56618 57426 (BITMAPOBJ.SNAPW 56628 . 57424))))) + (FILEMAP (NIL (2639 6664 (\MAIKO.COLORINIT 2649 . 3885) (\MAIKO.STARTCOLOR 3887 . 4703) ( +\MAIKO.STOPCOLOR 4705 . 5159) (\MAIKOCOLOR.EVENTFN 5161 . 5792) (\MAIKO.SENDCOLORMAPENTRY 5794 . 6252) + (\MAIKO.CHANGESCREEN 6254 . 6662)) (6665 27654 (CURSOREXIT 6675 . 8179) (CURSORSCREEN 8181 . 10287) ( +WARPCURSOR 10289 . 10604) (\SLOWBLTCHAR 10606 . 11018) (\SOFTCURSORUP 11020 . 16881) (\BITBLT.DISPLAY +16883 . 27652)) (27725 39693 (\PUNT.SLOWBLTCHAR 27735 . 34573) (\MAIKO.PUNTBLTCHAR 34575 . 39265) ( +\MAIKO.BLTCHAR 39267 . 39691)) (39694 56027 (\PUNT.BLTSHADE.BITMAP 39704 . 46796) (\PUNT.BITBLT.BITMAP + 46798 . 56025)) (56028 56836 (BITMAPOBJ.SNAPW 56038 . 56834))))) STOP diff --git a/library/MAIKOCOLOR.LCOM b/library/MAIKOCOLOR.LCOM index b4c0f333..5160611c 100644 Binary files a/library/MAIKOCOLOR.LCOM and b/library/MAIKOCOLOR.LCOM differ diff --git a/library/MULTI-ALIST b/library/MULTI-ALIST index 64b650d7..223a0948 100644 --- a/library/MULTI-ALIST +++ b/library/MULTI-ALIST @@ -1,14 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Sep-2025 18:41:59" {WMEDLEY}MULTI-ALIST.;30 15648 +(FILECREATED "21-Dec-2025 20:40:36" {WMEDLEY}MULTI-ALIST.;32 15606 :EDIT-BY rmk - :CHANGES-TO (FNS EXTENDMULTI-PAIR FETCHMULTI-PAIR) - (MACROS FETCHMULTI) + :CHANGES-TO (PROPS (SGETMULTI ARGNAMES)) + (MACROS SGETMULTI GETMULTI) - :PREVIOUS-DATE "25-Sep-2025 11:35:45" -{DSK}kaplan>Local>medley3.5>working-medley>library>MULTI-ALIST.;28) + :PREVIOUS-DATE "25-Sep-2025 18:41:59" {WMEDLEY}MULTI-ALIST.;30) (PRETTYCOMPRINT MULTI-ALISTCOMS) @@ -62,7 +61,7 @@ (CDR ARGS)))) (PUTPROPS SGETMULTI MACRO ((MULTIALIST . KEYS) - (CDR (GETMULTI-PAIR MULTIALIST . KEYS)))) + (CDR (SGETMULTI-PAIR MULTIALIST . KEYS)))) (PUTPROPS SGETMULTI-PAIR MACRO (ARGS (GETMULTI-PAIR.EXPAND 'SASSOC (CAR ARGS) (CDR ARGS)))) @@ -282,7 +281,7 @@ (LOCALVARS . T) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3720 10430 (MAPMULTI 3730 . 4876) (MAPMULTI1 4878 . 5935) (COLLECTMULTI 5937 . 6408) ( -FETCHMULTI-PAIR 6410 . 7470) (EXTENDMULTI-PAIR 7472 . 10428)) (10431 14805 (GETMULTI-PAIR.EXPAND 10441 - . 11942) (PUTMULTI.EXPAND 11944 . 14803))))) + (FILEMAP (NIL (3678 10388 (MAPMULTI 3688 . 4834) (MAPMULTI1 4836 . 5893) (COLLECTMULTI 5895 . 6366) ( +FETCHMULTI-PAIR 6368 . 7428) (EXTENDMULTI-PAIR 7430 . 10386)) (10389 14763 (GETMULTI-PAIR.EXPAND 10399 + . 11900) (PUTMULTI.EXPAND 11902 . 14761))))) STOP diff --git a/library/MULTI-ALIST.LCOM b/library/MULTI-ALIST.LCOM index d4c08798..16b75a6c 100644 Binary files a/library/MULTI-ALIST.LCOM and b/library/MULTI-ALIST.LCOM differ diff --git a/library/MULTI-ALIST.TEDIT b/library/MULTI-ALIST.TEDIT index 25c9ad8d..a7f1bab6 100644 Binary files a/library/MULTI-ALIST.TEDIT and b/library/MULTI-ALIST.TEDIT differ diff --git a/library/START-INSPHEX b/library/START-INSPHEX new file mode 100644 index 00000000..2fe3d269 --- /dev/null +++ b/library/START-INSPHEX @@ -0,0 +1,55 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED " 5-Nov-2025 23:12:38" {DSK}frank>il>medley>library>START-INSPHEX.;5 2142 + + :EDIT-BY "FGH" + + :CHANGES-TO (FNS START-INSPHEX) + (VARS START-INSPHEXCOMS) + (FUNCTIONS TmpShellWget) + + :PREVIOUS-DATE " 5-Nov-2025 19:57:59" {DSK}frank>il>medley>library>START-INSPHEX.;1) + + +(PRETTYCOMPRINT START-INSPHEXCOMS) + +(RPAQQ START-INSPHEXCOMS ((FUNCTIONS TmpShellWget) + (FNS START-INSPHEX) + (P (START-INSPHEX)))) + +(CL:DEFUN TmpShellWget (URL OUTFILENAME) + (LET* ((WGET (ShellWhich "wget")) + (OUTNAME (OUTFILEP OUTFILENAME)) + (UNIXNAME (LET [(UN (UNIX-FILE-NAME OUTNAME 'OUTPUT] + (if (STREQUAL (SUBSTRING UN (NCHARS UN)) + ".") + then (SUBSTRING UN 1 -2) + else UN))) + (CMD (CONCAT WGET " " URL " -O " UNIXNAME))) + (if (NULL WGET) + then (ERROR "ShellWget - wget not available")) + (ShellCommand CMD) + OUTNAME)) +(DEFINEQ + +(START-INSPHEX + [LAMBDA NIL (* ; "Edited 5-Nov-2025 23:09 by FGH") + (LET ((INSPHEX.FILE (CONCAT LOGINDIR ">INSPHEX")) + INSPHEX.DFASL) + (TmpShellWget "https://raw.githubusercontent.com/pamoroso/insphex/refs/heads/main/INSPHEX" + INSPHEX.FILE) + (SETQ INSPHEX.DFASL (CL:COMPILE-FILE INSPHEX.FILE)) + (LOAD INSPHEX.DFASL) + [ADVISE '(TEDIT IN INSPHEX::CREATE-HEX-WINDOW) + 'BEFORE + '(SETQ WINDOW (CREATEW (CREATEREGION (FIX (TIMES 0.25 SCREENWIDTH)) + (FIX (TIMES 0.25 SCREENHEIGHT)) + (FIX (TIMES 0.5 SCREENWIDTH)) + (FIX (TIMES 0.5 SCREENHEIGHT] + (ADD.PROCESS '(INSPHEX:HEXDUMP INSPHEX.DFASL T]) +) + +(START-INSPHEX) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (608 1201 (TmpShellWget 608 . 1201)) (1202 2098 (START-INSPHEX 1212 . 2096))))) +STOP diff --git a/library/START-INSPHEX.DFASL b/library/START-INSPHEX.DFASL new file mode 100644 index 00000000..efe40f7a Binary files /dev/null and b/library/START-INSPHEX.DFASL differ diff --git a/library/UNICODE b/library/UNICODE index f091f289..cf86b540 100644 --- a/library/UNICODE +++ b/library/UNICODE @@ -1,20 +1,23 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "11-Oct-2025 13:01:09" {WMEDLEY}UNICODE.;179 113928 +(FILECREATED "23-Oct-2025 08:31:21" {WMEDLEY}UNICODE.;211 82245 :EDIT-BY rmk - :CHANGES-TO (VARS UNICODECOMS) - (FNS XCCSTOMCCS-MAPPING READ-UNICODE-MAPPING MAKE-UNICODE-TRANSLATION-TABLES - MERGE-UNICODE-TRANSLATION-TABLES UNICODE-EXTEND-TRANSLATION?) + :CHANGES-TO (FNS UTOMCODE UTF8.INCCODEFN UTOMCODE? UTF8.PEEKCCODEFN) + (VARS UNICODECOMS) + (MACROS UNICODE.SMALLP) - :PREVIOUS-DATE " 5-Oct-2025 17:44:17" {WMEDLEY}UNICODE.;174) + :PREVIOUS-DATE "22-Oct-2025 23:28:51" {WMEDLEY}UNICODE.;210) (PRETTYCOMPRINT UNICODECOMS) (RPAQQ UNICODECOMS - ((COMS (* ; "External formats") + ( + (* ;; "Unicode external formats and MCCS-to-Unicode mapping functions. Must be loaded after UNICODE-TABLES.") + + (COMS (* ; "External formats") (FNS UTF8.OUTCHARFN UTF8.SLUG.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN \UTF8.BACKCCODEFN) (FNS UTF16BE.OUTCHARFN UTF16BE.INCCODEFN UTF16BE.PEEKCCODEFN \UTF16BE.BACKCCODEFN) @@ -26,38 +29,16 @@ (ADDVARS (*DEFAULT-EXTERNALFORMATS* (UNIX :UTF-8))) (FNS UTF8.BINCODE \UTF8.FETCHCODE) (FNS UTF8.VALIDATE NUTF8-BYTE1-BYTES NUTF8-CODE-BYTES NUTF8-STRING-BYTES N-MCHARS) - (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNICODE.TRANSLATE \UTF8.GETBASEBYTE)) - (FNS MTOUCODE UTOMCODE MTOUCODE? UTOMCODE? MTOUSTRING UTOMSTRING MTOUTF8STRING - UTF8TOMSTRING) - (FNS XTOUCODE UTOXCODE XTOUCODE? UTOXCODE? XTOUSTRING UTOXSTRING XTOUTF8STRING)) + (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNICODE.TRANSLATE \UTF8.GETBASEBYTE + UNICODE.SMALLP))) (* ;; "") - (COMS (* ; "Read Unicode mapping files") - (INITVARS (UNICODEDIRECTORIES NIL)) - (VARS XCCS-CHARSETS) - (FNS READ-UNICODE-MAPPING-FILENAMES READ-UNICODE-MAPPING)) - [COMS (* ; - "Make translation tables for UTF external formats") - (FNS MAKE-UNICODE-TRANSLATION-TABLES XCCSTOMCCS-MAPPING - MERGE-UNICODE-TRANSLATION-TABLES UNICODE.UNMAPPED UNICODE-EXTEND-TRANSLATION?) - (FNS ALL-UNICODE-MAPPINGS XCCSJAPANESECHARSETS) - (INITVARS (*MCCSTOUNICODE*) - (*UNICODETOMCCS*) - (*MCCS-LOADED-CHARSETS*) - (*UNICODE-LOADED-CHARSETS*)) - (GLOBALVARS *MCCSTOUNICODE* *UNICODETOMCCS* *NEXT-PRIVATE-UNICODE* - *NEXT-PRIVATE-MCCSCODE* *MCCS-LOADED-CHARSETS* *UNICODE-LOADED-CHARSETS*) - (DECLARE%: EVAL@COMPILE DONTCOPY + + (* ;; "These come after the translation tables have been loaded, since the Unix file names needed to read the mapping files depend on the UTF8 string coercions. Those functions are defined as EVQ in UFS, cannot be used until the tables exist. This assumes that previous files have only 7-bit MCCS characters in their names.") - (* ;; "There are 6400 private Unicodes in 25 256-code charsets. For XCCS we map to a contiguous region of unused/reserved--private isn't big enough.") - - (CONSTANTS (FIRST-PRIVATE-UNICODE (HEXNUM? "E000")) - (LAST-PRIVATE-UNICODE (HEXNUM? "F8FF")) - (FIRST-PRIVATE-MCCSCODE (CHARCODE "200,0")) - (LAST-PRIVATE-MCCSCODE (CHARCODE "230,377"))) - (MACROS TRUECODEP)) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAKE-UNICODE-TRANSLATION-TABLES 'ALL] + (FNS MTOUCODE UTOMCODE MTOUCODE? UTOMCODE? MTOUSTRING UTOMSTRING MTOUTF8STRING UTF8TOMSTRING) + (FNS XTOUCODE UTOXCODE XTOUCODE? UTOXCODE? XTOUSTRING UTOXSTRING XTOUTF8STRING) (* ;; "") @@ -77,13 +58,20 @@ (COMS (* ; "debugging") (FNS SHOWCHARS) (DECLARE%: DOEVAL@LOAD DONTCOPY (MACROS HEXCHAR OCTALCHAR))) - (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM LOADUPS) - EXPORTS.ALL)) + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) + UNICODE-EXPORTS)) (PROP (FILETYPE) UNICODE))) +(* ;; +"Unicode external formats and MCCS-to-Unicode mapping functions. Must be loaded after UNICODE-TABLES." +) + + + + (* ; "External formats") (DEFINEQ @@ -150,7 +138,8 @@ T]) (UTF8.INCCODEFN - [LAMBDA (STREAM COUNTP RAW) (* ; "Edited 24-Apr-2025 15:44 by rmk") + [LAMBDA (STREAM COUNTP RAW) (* ; "Edited 23-Oct-2025 08:31 by rmk") + (* ; "Edited 24-Apr-2025 15:44 by rmk") (* ; "Edited 2-Feb-2024 11:44 by rmk") (* ; "Edited 30-Jan-2024 22:56 by rmk") (* ; "Edited 6-Aug-2021 16:02 by rmk:") @@ -235,13 +224,15 @@ (LLSH (LOADBYTE BYTE3 0 6) 6) (LOADBYTE BYTE4 0 6]) - (CL:UNLESS (OR RAW (NOT (SMALLP CODE))) - (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOMCCS*))) + (CL:UNLESS RAW + (SETQ CODE (UNICODE.TRANSLATE (UNICODE.SMALLP CODE) + *UNICODETOMCCS*))) (CL:WHEN COUNTP (SETQ *BYTECOUNTER* COUNT)) CODE]) (UTF8.PEEKCCODEFN - [LAMBDA (STREAM NOERROR RAW) (* ; "Edited 24-Apr-2025 15:44 by rmk") + [LAMBDA (STREAM NOERROR RAW) (* ; "Edited 23-Oct-2025 08:26 by rmk") + (* ; "Edited 24-Apr-2025 15:44 by rmk") (* ; "Edited 2-Feb-2024 11:48 by rmk") (* ; "Edited 14-Jun-2021 22:53 by rmk:") @@ -324,7 +315,8 @@ elseif NOERROR else (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4] (CL:WHEN (AND CODE (NOT RAW)) - (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOMCCS*))) + (SETQ CODE (UNICODE.TRANSLATE (UNICODE.SMALLP CODE) + *UNICODETOMCCS*))) (RETURN CODE]) (\UTF8.BACKCCODEFN @@ -854,7 +846,7 @@ (* ;; "If RETURNALL and there are alternatives in the RANG, the list is returned. Othewise just the first one if the fake flag allows ") (LET [(RANGE (OR (GETHASH CODE TRANSLATION-TABLE) - (UNICODE.UNMAPPED CODE TRANSLATION-TABLE + (UNICODE.UNMAPPED CODE TRANSLATION-TABLE DONTFAKE] (CL:WHEN RANGE (if (AND RETURNALL (CDR RANGE)) @@ -872,8 +864,26 @@ (ERROR "INVALID UTF8 BYTE" BYTE)) BYTE) ELSE (\GETBASEBYTE BASE OFFSET)))) + +(PUTPROPS UNICODE.SMALLP MACRO [OPENLAMBDA (UNICODE) (* ; + "Cananonicalizes a large UNICODE for EQ hash-testing") + (OR (SMALLP UNICODE) + (CAR (OR (MEMBER UNICODE *LARGEUNICODES*) + (PUSH *LARGEUNICODES* UNICODE]) ) ) + + + +(* ;; "") + + + + +(* ;; +"These come after the translation tables have been loaded, since the Unix file names needed to read the mapping files depend on the UTF8 string coercions. Those functions are defined as EVQ in UFS, cannot be used until the tables exist. This assumes that previous files have only 7-bit MCCS characters in their names." +) + (DEFINEQ (MTOUCODE @@ -883,10 +893,12 @@ (UNICODE.TRANSLATE MCODE *MCCSTOUNICODE*]) (UTOMCODE - [LAMBDA (UNNICODE) (* ; "Edited 24-Apr-2025 10:17 by rmk") + [LAMBDA (UNICODE) (* ; "Edited 23-Oct-2025 08:23 by rmk") + (* ; "Edited 24-Apr-2025 10:17 by rmk") (* ; "Edited 16-Jan-2025 23:46 by rmk") (* ; "Edited 9-Aug-2020 09:04 by rmk:") - (UNICODE.TRANSLATE UNNICODE *UNICODETOMCCS*]) + (UNICODE.TRANSLATE (UNICODE.SMALLP UNICODE) + *UNICODETOMCCS*]) (MTOUCODE? [LAMBDA (MCODE) (* ; "Edited 4-Sep-2025 15:09 by rmk") @@ -902,7 +914,8 @@ (UNICODE.TRANSLATE MCODE *MCCSTOUNICODE* T T]) (UTOMCODE? - [LAMBDA (UNICODE) (* ; "Edited 24-Apr-2025 10:18 by rmk") + [LAMBDA (UNICODE) (* ; "Edited 23-Oct-2025 08:24 by rmk") + (* ; "Edited 24-Apr-2025 10:18 by rmk") (* ; "Edited 19-Jan-2025 21:14 by rmk") (* ; "Edited 18-Jan-2025 11:46 by rmk") (* ; "Edited 15-Jan-2025 19:51 by rmk") @@ -914,7 +927,10 @@ (* ;; " NOTE: Alternative codes are returned in a list, the code itself is returned for a singleton.") - (UNICODE.TRANSLATE UNICODE *UNICODETOMCCS* T T]) + (* ;; "Canonicalize unicodes outside of the 16-bit plane") + + (UNICODE.TRANSLATE (UNICODE.SMALLP UNICODE) + *UNICODETOMCCS* T T]) (MTOUSTRING [LAMBDA (MSTRING DESTRUCTIVE) (* ; "Edited 2-Sep-2025 12:19 by rmk") @@ -1002,7 +1018,9 @@ else MSTRING]) (UTF8TOMSTRING - [LAMBDA (UTF8STRING) (* ; "Edited 9-Sep-2025 08:59 by rmk") + [LAMBDA (UTF8STRING) (* ; "Edited 22-Oct-2025 22:00 by rmk") + (* ; "Edited 16-Oct-2025 14:39 by rmk") + (* ; "Edited 9-Sep-2025 08:59 by rmk") (CL:UNLESS (OR (STRINGP UTF8STRING) (LITATOM UTF8STRING)) (SETQ UTF8STRING (MKSTRING UTF8STRING))) @@ -1112,552 +1130,6 @@ -(* ; "Read Unicode mapping files") - - -(RPAQ? UNICODEDIRECTORIES NIL) - -(RPAQQ XCCS-CHARSETS - ((LATIN "0") - (JAPANESE-SYMBOLS1 "41") - (JAPANESE-SYMBOLS2 "42") - (EXTENDED-LATIN "43") - (HIRAGANA "44") - (KATAKANA "45") - (GREEK "46") - (CYRILLIC "47") - (FORMS "50") - (RUNIC-GOTHIC "51") - (MORE-CYRILLIC "52") - (UNKNOWN1 "56") - (UNKNOWN2 "57") - (JIS "60-166") - (ARABIC "340") - (HEBREW "341") - (IPA "342") - (HANGUL "343") - (GEORGIAN-ARMENIAN "344") - (DEVANAGRI "345") - (BENGALI "346") - (GURMUKHI "347") - (THAI-LAO "350") - (SYMBOLS3 "353") - (EXTENDED-ITC-DINGBATS "354") - (ITC-DINGBATS1 "355") - (SYMBOLS2 "356") - (SYMBOLS1 "357") - (LIGATURES "360") - (ACCENTED-LATIN1 "361") - (ACCENTED-LATIN2 "362") - (ACCENTED-GREEK1 "363") - (ACCENTED-GREEK2 "364") - (MORE-ARABIC "365") - (GRAPHIC-VARIANTS "375") - (DEFAULT LATIN ACCENTED-LATIN1 EXTENDED-LATIN SYMBOLS1 SYMBOLS2 FORMS JAPANESE-SYMBOLS1 - JAPANESE-SYMBOLS2) - (JAPANESE HIRAGANA KATAKANA JIS))) -(DEFINEQ - -(READ-UNICODE-MAPPING-FILENAMES - [LAMBDA (FILESPEC) (* ; "Edited 4-Sep-2025 00:11 by rmk") - (* ; "Edited 27-Jan-2025 16:46 by rmk") - (* ; "Edited 21-Jan-2025 22:51 by rmk") - (* ; "Edited 19-Jan-2025 12:21 by rmk") - (* ; "Edited 3-Feb-2024 11:00 by rmk") - (* ; "Edited 30-Jan-2024 08:45 by rmk") - (* ; "Edited 26-Jan-2024 14:02 by mth") - (* ; "Edited 5-Aug-2020 15:59 by kaplan") - (* ; "Edited 4-Aug-2020 17:31 by rmk:") - - (* ;; "FILESPEC can be a file name, character-set name, the name of a collection of character sets, an XCCS character code, or a list of those. Maps those into the names of files that contain the indicated Unicode mappings.") - - (CL:REMOVE-DUPLICATES - [if (EQ FILESPEC 'ALL) - then - (* ;; - "Perhaps should figure out which files in the directories and subdirectories are relevant?") - - (READ-UNICODE-MAPPING-FILENAMES (for N in XCCS-CHARSETS collect (CAR N))) - else (FOR F X CSI INSIDE FILESPEC - JOIN - (* ;; "Last case hopes to pick up all the tables that are grouped together in a subdirectory (e.g. if F is JIS)") - - (OR (CL:WHEN (CHARCODEP F) (* ; - "An XCCS code can retrieve its character set") - (for D FN (FOCTAL _ (OCTALSTRING (LRSH F 8))) inside UNICODEDIRECTORIES - when (SETQ FN (FILDIR (PACKFILENAME 'DIRECTORY D 'BODY - (CONCAT 'XCCS- FOCTAL '=*) - 'EXTENSION - 'TXT - 'VERSION ""))) do (RETURN FN))) - (MKLIST (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION 'TXT 'VERSION "") - T UNICODEDIRECTORIES)) - (for D inside UNICODEDIRECTORIES - when [SETQ $$VAL (OR (FILDIR (PACKFILENAME 'NAME (CONCAT "XCCS-*=" F) - 'EXTENSION - 'TXT - 'VERSION "" 'BODY D)) - (FILDIR (PACKFILENAME 'NAME (CONCAT "XCCS-" F "=*") - 'EXTENSION - 'TXT - 'VERSION "" 'BODY D] - do (RETURN $$VAL)) - (AND (SETQ CSI (ASSOC F XCCS-CHARSETS)) - (READ-UNICODE-MAPPING-FILENAMES (CDR CSI))) - (for D inside UNICODEDIRECTORIES - when (DIRECTORYNAMEP (SETQ D (CONCAT D ">" F ">"))) - join (FILDIR (CONCAT D ">*.TXT;"] - :TEST - (FUNCTION STRING.EQUAL]) - -(READ-UNICODE-MAPPING - [LAMBDA (FILESPEC PRINT NOERROR) (* ; "Edited 11-Oct-2025 12:08 by rmk") - (* ; "Edited 4-Sep-2025 00:17 by rmk") - (* ; "Edited 24-Apr-2025 15:32 by rmk") - (* ; "Edited 31-Jan-2025 17:43 by rmk") - (* ; "Edited 17-Jan-2025 16:41 by rmk") - (* ; "Edited 3-Feb-2024 00:21 by rmk") - (* ; "Edited 5-Jan-2024 12:26 by rmk") - (* ; "Edited 3-Jul-2021 13:37 by rmk:") - - (* ;; "Combines the char-mapping tables from FILES coded in the Uncode-CDROM format. Comments prefixed by # and") - - (* ;; " Column 1: XCCS input hex code in the format 0xXXXX") - - (* ;; " Column 2: Corresponding Unicode code-sequence in the format") - - (* ;; " 0xXXXX ... 0xYYYY") - - (* ;; " Column 3: (after #) Character name in some mapping files, utf-8 character") - - (* ;; " for XCCS mapping files") - - (* ;; "") - - (* ;; "Result is a list of (fromcode tocode1 ... tocoden) integer lists (almost always with only a single tocode, where fromcode is an XCCS code and the tocodes are corresponding Unicodes.") - - (for FILE [SEPBITTABLE _ (MAKEBITTABLE (CHARCODE (TAB SPACE] in (READ-UNICODE-MAPPING-FILENAMES - FILESPEC) - join - (* ;; "External format :THROUGH means read as bytes, so the Unicode UTF-8 comments cannot cause reading problems.") - - (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT :EXTERNAL-FORMAT `(:THROUGH LF)) - (bind LINE NAME CHARSET START MAP - first (CL:UNLESS (FILEPOS "Name:" STREAM NIL NIL NIL T) - (ERROR "NOT A UNICODE MAPPING FILE" (FULLNAME STREAM))) - (SETQ NAME (CL:STRING-TRIM " " (CL:READ-LINE STREAM NIL NIL))) - (SETQ CHARSET (CL:IF (FILEPOS "XCCS charset:" STREAM NIL NIL NIL T) - (CL:STRING-TRIM " " (CL:READ-LINE STREAM NIL NIL)) - "")) - (CL:WHEN PRINT (* ; "Strip off XCCS in front of name") - (PRINTOUT T T CHARSET " " [SUBSTRING NAME (CONSTANT - (ADD1 (NCHARS "XCCS"] - T)) while (SETQ LINE (CL:READ-LINE STREAM NIL NIL)) - when (SETQ START (STRPOSL SEPBITTABLE LINE 1 T)) - unless (EQ (CHARCODE %#) - (NTHCHARCODE LINE START)) - collect [SETQ MAP (bind END CODES while [SETQ END (OR (STRPOSL SEPBITTABLE LINE - START) - (ADD1 (NCHARS LINE] - collect [CHARCODE.DECODE (SUBSTRING LINE START - (SUB1 END) - (CONSTANT (CONCAT] - repeatwhile (AND (SETQ START (STRPOSL SEPBITTABLE LINE END - T)) - (NEQ (CHARCODE %#) - (NTHCHARCODE LINE START))) - finally (CL:WHEN (CDDR $$VAL) - (* ; "Combiners go into a CADR list") - (RPLACD $$VAL (CONS (CDR $$VAL))))] - MAP]) -) - - - -(* ; "Make translation tables for UTF external formats") - -(DEFINEQ - -(MAKE-UNICODE-TRANSLATION-TABLES - [LAMBDA (MAPPING REINSTALL) (* ; "Edited 11-Oct-2025 11:54 by rmk") - (* ; "Edited 4-Sep-2025 00:30 by rmk") - (* ; "Edited 24-Apr-2025 15:47 by rmk") - (* ; "Edited 31-Jan-2025 17:46 by rmk") - (* ; "Edited 26-Jan-2025 19:36 by rmk") - (* ; "Edited 22-Jan-2025 14:22 by rmk") - (* ; "Edited 19-Jan-2025 15:08 by rmk") - (* ; "Edited 18-Jan-2025 11:52 by rmk") - (* ; "Edited 3-Feb-2024 00:24 by rmk") - (* ; "Edited 30-Jan-2024 09:54 by rmk") - (* ; "Edited 21-Aug-2021 13:12 by rmk:") - - (* ;; "MAPPING is the list of numeric code correspondence pairs constructed by applying READ-UNICODE-MAPPING to XCCS-to-Unicode mapping files. This applies the XCCS-to-MCCS translations, and then updates or produces two recoding arrays, one maps left-side codes into right-side codes (e.g. MCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. MCCS).") - (* ; "Edited 17-Aug-2020 08:46 by rmk:") - (CL:UNLESS [AND (LISTP MAPPING) - (FOR PAIR R IN MAPPING AS I TO 10 - ALWAYS (AND (LISTP PAIR) - (CHARCODEP (CAR PAIR)) - [FIXP (SETQ R (CAR (MKLIST (CADR PAIR] - (CHARCODEP (IABS R] - - (* ;; "Seems like the argument is not already a list of mapping pairs (perhaps with a combiner), presumably a list of charsets to be read.") - - (SETQ MAPPING (READ-UNICODE-MAPPING MAPPING))) - (SETQ MAPPING (XCCSTOMCCS-MAPPING MAPPING)) - - (* ;; "This updates or produces two recoding arrays, one maps left-side codes into right-side codes (e.g. XCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. XCCS).") - - (* ;; "") - - (* ;; "If REINSTALL is T, the new mapping vectors replace the current maps in the *XCCSTOUNICODE* and *UNICODETOXCCS* global variables. Otherwise we create new tables (mostly for comparison and debugging).") - - (* ;; "") - - (if REINSTALL - then (SETQ *MCCS-LOADED-CHARSETS* (SETQ *UNICODE-LOADED-CHARSETS* NIL)) - (SETQ *NEXT-PRIVATE-MCCSCODE* FIRST-PRIVATE-MCCSCODE) - (SETQ *NEXT-PRIVATE-UNICODE* FIRST-PRIVATE-UNICODE) - (LET [(TABLE (HASHARRAY (LENGTH MAPPING))) - (INVERSETABLE (HASHARRAY (LENGTH MAPPING] - (MERGE-UNICODE-TRANSLATION-TABLES NIL MAPPING TABLE INVERSETABLE) - (SETQ *MCCSTOUNICODE* TABLE) - (SETQ *UNICODETOMCCS* INVERSETABLE) - (LIST *MCCSTOUNICODE* *UNICODETOMCCS*)) - else (CL:UNLESS (BOUNDP '*NEXT-PRIVATE-MCCSCODE*) - (SETQ *NEXT-PRIVATE-MCCSCODE* FIRST-PRIVATE-MCCSCODE) - (SETQ *NEXT-PRIVATE-UNICODE* FIRST-PRIVATE-UNICODE)) - (MERGE-UNICODE-TRANSLATION-TABLES NIL MAPPING]) - -(XCCSTOMCCS-MAPPING - [LAMBDA (XTOUMAPPING) (* ; "Edited 11-Oct-2025 12:57 by rmk") - - (* ;; - "This translates the pairs that map XCCS to Unicode into pairs that translate MCCS to Unicode.") - - (* ;; - "We grab the affected pairs before we make any changes so that we don't get into ordering issues.") - - (LET* ([XTOMCODES (CHARCODE ((Currency Dollar) - (Dollar Currency) - (Uparrow Circumflex) - (Circumflex Uparrow) - (Leftarrow Lowline) - (Lowline Leftarrow] - (AFFECTED (for MP in XTOUMAPPING when (thereis XP in XTOMCODES - suchthat (EQ (CAR MP) - (CAR XP))) collect MP))) - (for AP in AFFECTED do (RPLACA AP (CADR (ASSOC (CAR AP) - XTOMCODES))) - finally (push XTOUMAPPING (CHARCODE (DEL DEL))) - (RETURN XTOUMAPPING]) - -(MERGE-UNICODE-TRANSLATION-TABLES - [LAMBDA (INVERSE MAPPING TABLE INVERSETABLE) (* ; "Edited 11-Oct-2025 10:24 by rmk") - (* ; "Edited 24-Apr-2025 15:28 by rmk") - (* ; "Edited 1-Feb-2025 21:42 by rmk") - (* ; "Edited 26-Jan-2025 12:58 by rmk") - (* ; "Edited 22-Jan-2025 08:20 by rmk") - (* ; "Edited 19-Jan-2025 15:58 by rmk") - (* ; "Edited 18-Jan-2025 11:49 by rmk") - (* ; "Edited 27-Mar-2024 12:10 by rmk") - (* ; "Edited 3-Feb-2024 12:46 by rmk") - (* ; "Edited 31-Jan-2024 10:06 by rmk") - - (* ;; "MAPPINGS is a list of pairs that map domain codes to range codes. TABLE and INVERSETABLE default to *MCCSTOUNICODE* *UNICODETOMCCS* respectively. ") - - (CL:UNLESS TABLE - [SETQ TABLE (OR *MCCSTOUNICODE* (SETQ *MCCSTOUNICODE* (HASHARRAY (LENGTH MAPPING]) - (CL:UNLESS INVERSETABLE - [SETQ INVERSETABLE (OR *UNICODETOMCCS* (SETQ *UNICODETOMCCS* (HASHARRAY (LENGTH MAPPING]) - (for M D R OLDR in MAPPING first (CL:IF INVERSE (swap TABLE INVERSETABLE)) - eachtime (SETQ D (CAR M)) - (SETQ R (CADR M)) - - (* ;; "We don't do combiners, but we are allowing non-SMALLP's") - unless (OR (LISTP D) - (LISTP R)) do - (* ;; "The (CONS R OLDR) deals with alternatives: (U X1) (U X2) => (U (X1 X2)), lowest code first. Those are only possible in the U-to-X direction when the tables contain (X1 U) and (X2 U). There are no duplicates/alternative table entries in the X-to-U direction.") - - (SETQ OLDR (GETHASH D TABLE)) - (CL:UNLESS (MEMB R OLDR) - (PUTHASH D (SORT (CONS R OLDR)) - TABLE)) - (swap D R) - (SETQ OLDR (GETHASH D INVERSETABLE)) - (CL:UNLESS (MEMB R OLDR) - (PUTHASH D (SORT (CONS R OLDR)) - INVERSETABLE))) - (LIST TABLE INVERSETABLE]) - -(UNICODE.UNMAPPED - [LAMBDA (CODE TABLE DONTFAKE) (* ; "Edited 24-Apr-2025 15:48 by rmk") - (* ; "Edited 22-Jan-2025 08:19 by rmk") - (* ; "Edited 19-Jan-2025 22:02 by rmk") - (* ; "Edited 18-Jan-2025 12:02 by rmk") - (* ; "Edited 2-Feb-2024 23:52 by rmk") - (* ; "Edited 31-Jan-2024 10:07 by rmk") - (* ; "Edited 11-Aug-2020 20:23 by rmk:") - - (* ;; "This is the slow fall-out when UNICODE.TRANSLATE determines that CODE has no fast mapping in TRANSLATION-TABLE.") - - (* ;; "") - - (* ;; "If we have not already installed the mapping segment for that code, we try to retrieve it from the numberic file. If that segment mapping doesn't exist or doesn't have an entry for CODE, we fake up a mapping with a negative range in both directions. One way or the other, there will be an entry for that segment in both mapping vectors.") - - (* ;; "") - - (PROG ((INVERSE (EQ TABLE *UNICODETOMCCS*)) - RANGE HASH) - - (* ;; "If we already looked up CODE's character set in a file, then we have already filled in its information in the translation table. If it didn't have a code for a particular character, then we fake it here. Faked codes are negative, so we can detect them easily, and interpret them with IABS.") - - (CL:WHEN (AND (UNICODE-EXTEND-TRANSLATION? CODE TABLE) - (SETQ RANGE (GETHASH CODE TABLE))) - - (* ;; "We might have gotten the segment that didn't have an entry for CODE.") - - (RETURN RANGE)) - - (* ;; "") - - (CL:UNLESS DONTFAKE - - (* ;; "Our attempt at extending the known tables did not provide a mapping for CODE. So we fake it up with the next unused private code in the code space. ") - - (* ;; "The number of possible faked mappings is determined by the number of private-use Unicodes, since the MCCS character space is pretty sparse. The codes don't have to come from the same part of the code space, and the NEXTCODEs are saved in global variables. The last available codes are constants.") - - (CL:WHEN (IEQP *NEXT-PRIVATE-MCCSCODE* LAST-PRIVATE-MCCSCODE) - (* ; - "Same number of available codes both ways") - (ERROR "EXHAUSTED RANGE FOR UNMAPPED CODES")) - (if INVERSE - then (SETQ RANGE *NEXT-PRIVATE-MCCSCODE*) - (add *NEXT-PRIVATE-MCCSCODE* 1) - else (SETQ RANGE *NEXT-PRIVATE-UNICODE*) - (add *NEXT-PRIVATE-UNICODE* 1)) - (MERGE-UNICODE-TRANSLATION-TABLES INVERSE (CONS (LIST CODE RANGE))) - - (* ;; "CONS because of LIST convention so we can eventually distinguish combiners.") - - (RETURN (CONS RANGE)))]) - -(UNICODE-EXTEND-TRANSLATION? - [LAMBDA (CODE TABLE) (* ; "Edited 11-Oct-2025 09:49 by rmk") - (* ; "Edited 4-Sep-2025 00:34 by rmk") - (* ; "Edited 29-Jun-2025 16:44 by rmk") - (* ; "Edited 24-Apr-2025 15:49 by rmk") - (* ; "Edited 26-Jan-2025 11:26 by rmk") - (* ; "Edited 21-Jan-2025 22:31 by rmk") - (* ; "Edited 18-Jan-2025 12:40 by rmk") - (* ; "Edited 13-Jan-2025 23:50 by rmk") - (* ; "Edited 26-Aug-2024 16:49 by rmk") - (* ; "Edited 27-Mar-2024 23:02 by rmk") - (* ; "Edited 5-Feb-2024 13:48 by rmk") - (* ; "Edited 3-Feb-2024 12:40 by rmk") - - (* ;; "There is currently no mapping for CODE in TABLE, hopefully just because the relevant character-set mapping has not been installed. We infer from TABLE whether CODE is an MCCS or UNICODE code and look for the proper mapping table (forward or inverted) for its character set. ") - - (* ;; "We record which character sets we have already expanded so we don't do them again.") - - (LET ((CHARSET (\CHARSET CODE)) - (INVERSE (EQ TABLE *UNICODETOMCCS*)) - MAPPING FILE) - - (* ;; "If we already looked for CHARSET in the file and found anything, it has already been merged. Otherwise, it would just fail again") - - (CL:UNLESS (MEMB CHARSET (CL:IF INVERSE - *UNICODE-LOADED-CHARSETS* - *MCCS-LOADED-CHARSETS*)) - - (* ;; "Don't try this charset again.") - - (CL:IF INVERSE - (push *UNICODE-LOADED-CHARSETS* CHARSET) - (push *MCCS-LOADED-CHARSETS* CHARSET)) - (SETQ FILE (FINDFILE (CL:IF INVERSE - 'UNICODE-TO-MCCS-MAPPINGS - 'MCCS-TO-UNICODE-MAPPINGS) - T UNICODEDIRECTORIES)) - - (* ;; "The mappings files are indexed by CHARSET.") - - (CL:WHEN [AND FILE (SETQ MAPPING (CL:WITH-OPEN-FILE (STREAM FILE :INPUT) - (CL:WHEN (FILEPOS (CONCAT "[" CHARSET " ") - STREAM NIL NIL NIL T) - (READ STREAM] - - (* ;; - "Merge MAPPING into both tables, respecting the direction indicated by TABLE. ") - - (MERGE-UNICODE-TRANSLATION-TABLES INVERSE MAPPING) - T))]) -) -(DEFINEQ - -(ALL-UNICODE-MAPPINGS - [LAMBDA (INVERTED FILE) (* ; "Edited 24-Apr-2025 15:51 by rmk") - (* ; "Edited 31-Jan-2025 17:46 by rmk") - (* ; "Edited 26-Jan-2025 13:40 by rmk") - (* ; "Edited 22-Jan-2025 14:07 by rmk") - (* ; "Edited 19-Jan-2025 12:20 by rmk") - (* ; "Edited 17-Jan-2025 22:32 by rmk") - (* ; "Edited 15-Jan-2025 09:49 by rmk") - (* ; "Edited 27-Mar-2024 14:48 by rmk") - (* ; "Edited 5-Feb-2024 13:14 by rmk") - (* ; "Edited 3-Feb-2024 09:16 by rmk") - - (* ;; "Reads all the XCCS-to-UNICODE mapping files that we know about, and produces a 2-level index that maps between MCCS codes and UNICODE codes, depending on INVERTED.") - - (* ;; "The first index level segments all the domain codes according to their character sets. The segments are sorted by character set, the pairs within each segment are sorted by their domain codes. ") - - (* ;; - "E.g. if INVERTED=NIL and given a XCCS code, the lookup for the corresponding Unicode(s) is") - - (* ;; " (CADR (ASSOC MCCSCODE (\CHARSET MCCSCODE) INDEX)))).") - - (* ;; "If FILE is not NIL, the result is written to a file. If FILE is T, the file is either MCCS-TO-UNICODE-MAPPINGS.TXT or UNICODE-TO-MCCS-MAPPINGS.TXT, depending on INVERTED.") - - (LET (INDEX) - (for PAIR DOMAIN RANGE CHARSET in (READ-UNICODE-MAPPING 'ALL) eachtime (SETQ DOMAIN - (CAR PAIR)) - (SETQ RANGE (CADR PAIR)) - - (* ;; - "(LISTP RANGE) is a combiner, ignored for now.") - unless (LISTP RANGE) do (CL:WHEN INVERTED (SWAP DOMAIN RANGE)) - - (* ;; - "One segment for each high-byte character set. This aligns with UNICODE-EXTEND.TRANSLATION?") - - [SETQ CHARSET (OR (ASSOC (\CHARSET DOMAIN) - INDEX) - (CAR (push INDEX (CONS (\CHARSET DOMAIN] - - (* ;; "For alternative mappings (in the U-to-M direction) we end up with (D R1 R2 ...). (CADR is the first (and almost always) the only one.") - - (pushnew [CDR (OR (ASSOC DOMAIN (CDR CHARSET)) - (CAR (push (CDR CHARSET) - (CONS DOMAIN] - RANGE)) - - (* ;; "Push the charset mappings down an extra CONS, so that a subsequent READ will get them all after a FILEPOS search for super-paren [") - - [for CS in INDEX do (for M in (CDR CS) when (CDDR M) do - (* ;; - "Sort the range alternatives, if any") - - (change (CDR M) - (SORT DATUM))) - - (* ;; "Sort by domain codes and push down a level") - - (change (CDR CS) - (CONS (SORT DATUM T] - (SETQ INDEX (SORT INDEX T)) (* ; "Sort character sets") - (if FILE - then (SETQ FILE (PACKFILENAME 'BODY (if (NEQ FILE T) - then FILE - elseif INVERTED - then 'UNICODE-TO-MCCS-MAPPINGS - else 'MCCS-TO-UNICODE-MAPPINGS) - 'DIRECTORY - (CAR (MKLIST UNICODEDIRECTORIES)) - 'EXTENSION - 'TXT)) - (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION) - - (* ;; - "We can FILEPOS for %"[nnn %" then READ for each segment. Or just READFILE to get them all.") - - (for I in INDEX do (PRINTOUT STREAM "[" (CAR I) - " " - (CADR I) - "]" T T)) - (PRINTOUT STREAM "STOP" T) - (FULLNAME STREAM)) - else INDEX]) - -(XCCSJAPANESECHARSETS - [LAMBDA (OCTAL FILE) (* ; "Edited 11-Jun-2025 23:00 by rmk") - - (* ;; "Returns the list of numbers for the Japanese character sets.") - - (for F POS CS in (READ-UNICODE-MAPPING-FILENAMES "JIS") - when (SETQ POS (STRPOS "XCCS-" F 1 NIL NIL T)) - collect [SETQ CS (SUBSTRING F POS (SUB1 (STRPOS '=JIS F POS] - (CL:IF OCTAL - CS - (MKATOM (CONCAT CS "Q"))) - finally (SORT $$VAL) - (CL:WHEN FILE - (RETURN (CL:WITH-OPEN-FILE (STREAM (PACKFILENAME 'BODY (CL:IF (EQ FILE T) - "JAPANESECHARSETS" - FILE) - 'DIRECTORY - (CAR (MKLIST UNICODEDIRECTORIES)) - 'EXTENSION - 'TXT) - :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION) - (PRINT $$VAL STREAM) - (FULLNAME STREAM))))]) -) - -(RPAQ? *MCCSTOUNICODE* ) - -(RPAQ? *UNICODETOMCCS* ) - -(RPAQ? *MCCS-LOADED-CHARSETS* ) - -(RPAQ? *UNICODE-LOADED-CHARSETS* ) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS *MCCSTOUNICODE* *UNICODETOMCCS* *NEXT-PRIVATE-UNICODE* *NEXT-PRIVATE-MCCSCODE* - *MCCS-LOADED-CHARSETS* *UNICODE-LOADED-CHARSETS*) -) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQ FIRST-PRIVATE-UNICODE (HEXNUM? "E000")) - -(RPAQ LAST-PRIVATE-UNICODE (HEXNUM? "F8FF")) - -(RPAQ FIRST-PRIVATE-MCCSCODE (CHARCODE "200,0")) - -(RPAQ LAST-PRIVATE-MCCSCODE (CHARCODE "230,377")) - - -(CONSTANTS (FIRST-PRIVATE-UNICODE (HEXNUM? "E000")) - (LAST-PRIVATE-UNICODE (HEXNUM? "F8FF")) - (FIRST-PRIVATE-MCCSCODE (CHARCODE "200,0")) - (LAST-PRIVATE-MCCSCODE (CHARCODE "230,377"))) -) - -(DECLARE%: EVAL@COMPILE - -(PUTPROPS TRUECODEP MACRO (OPENLAMBDA (RANGE TABLE) - - (* ;; "Return NIL if RANGE is a fake range in TABLE, otherwise RANGE.") - - (CL:UNLESS (CL:IF (EQ TABLE *MCCSTOUNICODE*) - (AND (IGEQ RANGE FIRST-PRIVATE-UNICODE) - (ILEQ RANGE LAST-PRIVATE-UNICODE)) - (AND (IGEQ RANGE FIRST-PRIVATE-MCCSCODE) - (ILEQ RANGE LAST-PRIVATE-MCCSCODE))) - RANGE))) -) -) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(MAKE-UNICODE-TRANSLATION-TABLES 'ALL) -) - - - -(* ;; "") - - - - (* ; "Write Unicode mapping files") (DEFINEQ @@ -2005,31 +1477,27 @@ ) (DECLARE%: EVAL@COMPILE DONTCOPY -(FILESLOAD (FROM LOADUPS) - EXPORTS.ALL) +(FILESLOAD (LOADCOMP) + UNICODE-EXPORTS) ) (PUTPROPS UNICODE FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4573 19821 (UTF8.OUTCHARFN 4583 . 7599) (UTF8.SLUG.OUTCHARFN 7601 . 8265) ( -UTF8.INCCODEFN 8267 . 13988) (UTF8.PEEKCCODEFN 13990 . 18839) (\UTF8.BACKCCODEFN 18841 . 19819)) ( -19822 24512 (UTF16BE.OUTCHARFN 19832 . 20851) (UTF16BE.INCCODEFN 20853 . 21978) (UTF16BE.PEEKCCODEFN -21980 . 23320) (\UTF16BE.BACKCCODEFN 23322 . 24510)) (24513 29236 (UTF16LE.OUTCHARFN 24523 . 25639) ( -UTF16LE.INCCODEFN 25641 . 26766) (UTF16LE.PEEKCCODEFN 26768 . 28044) (\UTF16LE.BACKCCODEFN 28046 . -29234)) (29237 32284 (READBOM 29247 . 31316) (WRITEBOM 31318 . 32282)) (32314 35879 ( -MAKE-UNICODE-FORMATS 32324 . 35877)) (35976 40470 (UTF8.BINCODE 35986 . 38674) (\UTF8.FETCHCODE 38676 - . 40468)) (40471 46098 (UTF8.VALIDATE 40481 . 43078) (NUTF8-BYTE1-BYTES 43080 . 43817) ( -NUTF8-CODE-BYTES 43819 . 44876) (NUTF8-STRING-BYTES 44878 . 45774) (N-MCHARS 45776 . 46096)) (47826 -56695 (MTOUCODE 47836 . 48223) (UTOMCODE 48225 . 48615) (MTOUCODE? 48617 . 49650) (UTOMCODE? 49652 . -50616) (MTOUSTRING 50618 . 51203) (UTOMSTRING 51205 . 51790) (MTOUTF8STRING 51792 . 55798) ( -UTF8TOMSTRING 55800 . 56693)) (56696 62398 (XTOUCODE 56706 . 57224) (UTOXCODE 57226 . 57734) ( -XTOUCODE? 57736 . 58797) (UTOXCODE? 58799 . 59882) (XTOUSTRING 59884 . 60577) (UTOXSTRING 60579 . -61320) (XTOUTF8STRING 61322 . 62396)) (63635 71937 (READ-UNICODE-MAPPING-FILENAMES 63645 . 67442) ( -READ-UNICODE-MAPPING 67444 . 71935)) (72004 86230 (MAKE-UNICODE-TRANSLATION-TABLES 72014 . 75770) ( -XCCSTOMCCS-MAPPING 75772 . 76989) (MERGE-UNICODE-TRANSLATION-TABLES 76991 . 79644) (UNICODE.UNMAPPED -79646 . 82970) (UNICODE-EXTEND-TRANSLATION? 82972 . 86228)) (86231 93067 (ALL-UNICODE-MAPPINGS 86241 - . 91730) (XCCSJAPANESECHARSETS 91732 . 93065)) (94658 105926 (WRITE-UNICODE-MAPPING 94668 . 98418) ( -WRITE-UNICODE-INCLUDED 98420 . 103142) (WRITE-UNICODE-MAPPING-HEADER 103144 . 104392) ( -WRITE-UNICODE-MAPPING-FILENAME 104394 . 105924)) (105927 106603 (XCCS-UTF8-AFTER-OPEN 105937 . 106601) -) (109128 111345 (UTF8HEXSTRING 109138 . 111343)) (111372 113414 (SHOWCHARS 111382 . 113412))))) + (FILEMAP (NIL (3488 19026 (UTF8.OUTCHARFN 3498 . 6514) (UTF8.SLUG.OUTCHARFN 6516 . 7180) ( +UTF8.INCCODEFN 7182 . 13035) (UTF8.PEEKCCODEFN 13037 . 18044) (\UTF8.BACKCCODEFN 18046 . 19024)) ( +19027 23717 (UTF16BE.OUTCHARFN 19037 . 20056) (UTF16BE.INCCODEFN 20058 . 21183) (UTF16BE.PEEKCCODEFN +21185 . 22525) (\UTF16BE.BACKCCODEFN 22527 . 23715)) (23718 28441 (UTF16LE.OUTCHARFN 23728 . 24844) ( +UTF16LE.INCCODEFN 24846 . 25971) (UTF16LE.PEEKCCODEFN 25973 . 27249) (\UTF16LE.BACKCCODEFN 27251 . +28439)) (28442 31489 (READBOM 28452 . 30521) (WRITEBOM 30523 . 31487)) (31519 35084 ( +MAKE-UNICODE-FORMATS 31529 . 35082)) (35181 39675 (UTF8.BINCODE 35191 . 37879) (\UTF8.FETCHCODE 37881 + . 39673)) (39676 45303 (UTF8.VALIDATE 39686 . 42283) (NUTF8-BYTE1-BYTES 42285 . 43022) ( +NUTF8-CODE-BYTES 43024 . 44081) (NUTF8-STRING-BYTES 44083 . 44979) (N-MCHARS 44981 . 45301)) (47785 +57213 (MTOUCODE 47795 . 48182) (UTOMCODE 48184 . 48710) (MTOUCODE? 48712 . 49745) (UTOMCODE? 49747 . +50916) (MTOUSTRING 50918 . 51503) (UTOMSTRING 51505 . 52090) (MTOUTF8STRING 52092 . 56098) ( +UTF8TOMSTRING 56100 . 57211)) (57214 62916 (XTOUCODE 57224 . 57742) (UTOXCODE 57744 . 58252) ( +XTOUCODE? 58254 . 59315) (UTOXCODE? 59317 . 60400) (XTOUSTRING 60402 . 61095) (UTOXSTRING 61097 . +61838) (XTOUTF8STRING 61840 . 62914)) (62979 74247 (WRITE-UNICODE-MAPPING 62989 . 66739) ( +WRITE-UNICODE-INCLUDED 66741 . 71463) (WRITE-UNICODE-MAPPING-HEADER 71465 . 72713) ( +WRITE-UNICODE-MAPPING-FILENAME 72715 . 74245)) (74248 74924 (XCCS-UTF8-AFTER-OPEN 74258 . 74922)) ( +77449 79666 (UTF8HEXSTRING 77459 . 79664)) (79693 81735 (SHOWCHARS 79703 . 81733))))) STOP diff --git a/library/UNICODE-EXPORTS b/library/UNICODE-EXPORTS new file mode 100644 index 00000000..e65ecc22 --- /dev/null +++ b/library/UNICODE-EXPORTS @@ -0,0 +1,79 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "22-Oct-2025 23:27:50" {WMEDLEY}UNICODE-EXPORTS.;1 2673 + + :EDIT-BY rmk + + :CHANGES-TO (VARS UNICODE-EXPORTSCOMS)) + + +(PRETTYCOMPRINT UNICODE-EXPORTSCOMS) + +(RPAQQ UNICODE-EXPORTSCOMS + ( + (* ;; "Compile-time declarations shared by UNICODE-TABLES and UNICODE") + + (GLOBALVARS *MCCSTOUNICODE* *UNICODETOMCCS* *NEXT-PRIVATE-UNICODE* *NEXT-PRIVATE-MCCSCODE* + *MCCS-LOADED-CHARSETS* *UNICODE-LOADED-CHARSETS* *LARGEUNICODES*) + + (* ;; "There are 6400 private Unicodes in 25 256-code charsets. For MCCS we map to a contiguous region of unused/reserved--private isn't big enough.") + + (CONSTANTS (FIRST-PRIVATE-UNICODE (HEXNUM? "E000")) + (LAST-PRIVATE-UNICODE (HEXNUM? "F8FF")) + (FIRST-PRIVATE-MCCSCODE (CHARCODE "200,0")) + (LAST-PRIVATE-MCCSCODE (CHARCODE "230,377"))) + (MACROS TRUECODEP) + (FILES (FROM LOADUPS) + EXPORTS.ALL))) + + + +(* ;; "Compile-time declarations shared by UNICODE-TABLES and UNICODE") + +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS *MCCSTOUNICODE* *UNICODETOMCCS* *NEXT-PRIVATE-UNICODE* *NEXT-PRIVATE-MCCSCODE* + *MCCS-LOADED-CHARSETS* *UNICODE-LOADED-CHARSETS* *LARGEUNICODES*) +) + + + +(* ;; +"There are 6400 private Unicodes in 25 256-code charsets. For MCCS we map to a contiguous region of unused/reserved--private isn't big enough." +) + +(DECLARE%: EVAL@COMPILE + +(RPAQ FIRST-PRIVATE-UNICODE (HEXNUM? "E000")) + +(RPAQ LAST-PRIVATE-UNICODE (HEXNUM? "F8FF")) + +(RPAQ FIRST-PRIVATE-MCCSCODE (CHARCODE "200,0")) + +(RPAQ LAST-PRIVATE-MCCSCODE (CHARCODE "230,377")) + + +(CONSTANTS (FIRST-PRIVATE-UNICODE (HEXNUM? "E000")) + (LAST-PRIVATE-UNICODE (HEXNUM? "F8FF")) + (FIRST-PRIVATE-MCCSCODE (CHARCODE "200,0")) + (LAST-PRIVATE-MCCSCODE (CHARCODE "230,377"))) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS TRUECODEP MACRO (OPENLAMBDA (RANGE TABLE) + + (* ;; "Return NIL if RANGE is a fake range in TABLE, otherwise RANGE.") + + (CL:UNLESS (CL:IF (EQ TABLE *MCCSTOUNICODE*) + (AND (IGEQ RANGE FIRST-PRIVATE-UNICODE) + (ILEQ RANGE LAST-PRIVATE-UNICODE)) + (AND (IGEQ RANGE FIRST-PRIVATE-MCCSCODE) + (ILEQ RANGE LAST-PRIVATE-MCCSCODE))) + RANGE))) +) + +(FILESLOAD (FROM LOADUPS) + EXPORTS.ALL) +(DECLARE%: DONTCOPY + (FILEMAP (NIL))) +STOP diff --git a/library/UNICODE-TABLES b/library/UNICODE-TABLES new file mode 100644 index 00000000..71d05c08 --- /dev/null +++ b/library/UNICODE-TABLES @@ -0,0 +1,571 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "22-Oct-2025 23:28:42" {WMEDLEY}UNICODE-TABLES.;4 34028 + + :EDIT-BY rmk + + :CHANGES-TO (VARS UNICODE-TABLESCOMS) + + :PREVIOUS-DATE "16-Oct-2025 16:47:54" {WMEDLEY}UNICODE-TABLES.;3) + + +(PRETTYCOMPRINT UNICODE-TABLESCOMS) + +(RPAQQ UNICODE-TABLESCOMS + [ + (* ;; "Read Unicode mapping tables. A separate file before UNICODE in the loadup, because the tables must be loaded while UTF8TOMCODE and MCODETOUTF8 are still equivalenced to EVQ. This file has to come before UNICODE in the loadup sequence.") + + (COMS (* ; "Read Unicode mapping files") + (INITVARS (UNICODEDIRECTORIES NIL)) + (GLOBALVARS UNICODEDIRECTORIES) + (VARS XCCS-CHARSETS) + (FNS READ-UNICODE-MAPPING-FILENAMES READ-UNICODE-MAPPING)) + (COMS (* ; + "Make translation tables for UTF external formats") + (FNS MAKE-UNICODE-TRANSLATION-TABLES XCCSTOMCCS-MAPPING + MERGE-UNICODE-TRANSLATION-TABLES UNICODE.UNMAPPED UNICODE-EXTEND-TRANSLATION?) + (FNS ALL-UNICODE-MAPPINGS XCCSJAPANESECHARSETS) + (INITVARS (*MCCSTOUNICODE*) + (*UNICODETOMCCS*) + (*MCCS-LOADED-CHARSETS*) + (*UNICODE-LOADED-CHARSETS*) + (*LARGEUNICODES*)) + [DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAKE-UNICODE-TRANSLATION-TABLES 'ALL] + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) + UNICODE-EXPORTS]) + + + +(* ;; +"Read Unicode mapping tables. A separate file before UNICODE in the loadup, because the tables must be loaded while UTF8TOMCODE and MCODETOUTF8 are still equivalenced to EVQ. This file has to come before UNICODE in the loadup sequence." +) + + + + +(* ; "Read Unicode mapping files") + + +(RPAQ? UNICODEDIRECTORIES NIL) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS UNICODEDIRECTORIES) +) + +(RPAQQ XCCS-CHARSETS + ((LATIN "0") + (JAPANESE-SYMBOLS1 "41") + (JAPANESE-SYMBOLS2 "42") + (EXTENDED-LATIN "43") + (HIRAGANA "44") + (KATAKANA "45") + (GREEK "46") + (CYRILLIC "47") + (FORMS "50") + (RUNIC-GOTHIC "51") + (MORE-CYRILLIC "52") + (UNKNOWN1 "56") + (UNKNOWN2 "57") + (JIS "60-166") + (ARABIC "340") + (HEBREW "341") + (IPA "342") + (HANGUL "343") + (GEORGIAN-ARMENIAN "344") + (DEVANAGRI "345") + (BENGALI "346") + (GURMUKHI "347") + (THAI-LAO "350") + (SYMBOLS3 "353") + (EXTENDED-ITC-DINGBATS "354") + (ITC-DINGBATS1 "355") + (SYMBOLS2 "356") + (SYMBOLS1 "357") + (LIGATURES "360") + (ACCENTED-LATIN1 "361") + (ACCENTED-LATIN2 "362") + (ACCENTED-GREEK1 "363") + (ACCENTED-GREEK2 "364") + (MORE-ARABIC "365") + (GRAPHIC-VARIANTS "375") + (DEFAULT LATIN ACCENTED-LATIN1 EXTENDED-LATIN SYMBOLS1 SYMBOLS2 FORMS JAPANESE-SYMBOLS1 + JAPANESE-SYMBOLS2) + (JAPANESE HIRAGANA KATAKANA JIS))) +(DEFINEQ + +(READ-UNICODE-MAPPING-FILENAMES + [LAMBDA (FILESPEC) (* ; "Edited 16-Oct-2025 16:43 by rmk") + (* ; "Edited 4-Sep-2025 00:11 by rmk") + (* ; "Edited 27-Jan-2025 16:46 by rmk") + (* ; "Edited 21-Jan-2025 22:51 by rmk") + (* ; "Edited 19-Jan-2025 12:21 by rmk") + (* ; "Edited 3-Feb-2024 11:00 by rmk") + (* ; "Edited 30-Jan-2024 08:45 by rmk") + (* ; "Edited 26-Jan-2024 14:02 by mth") + (* ; "Edited 5-Aug-2020 15:59 by kaplan") + (* ; "Edited 4-Aug-2020 17:31 by rmk:") + + (* ;; "FILESPEC can be a file name, character-set name, the name of a collection of character sets, an XCCS character code, or a list of those. Maps those into the names of files that contain the indicated Unicode mappings.") + + (CL:REMOVE-DUPLICATES [for F X CSI inside (if (EQ FILESPEC 'ALL) + then + (* ;; + "Perhaps should figure out which files in the directories and subdirectories are relevant?") + + (for N in XCCS-CHARSETS + collect (CAR N)) + else FILESPEC) + join + (* ;; "Last case hopes to pick up all the tables that are grouped together in a subdirectory (e.g. if F is JIS)") + + (OR (CL:WHEN (CHARCODEP F) (* ; + "An XCCS code can retrieve its character set") + (for D FN (FOCTAL _ (OCTALSTRING (LRSH F 8))) inside + UNICODEDIRECTORIES + when (SETQ FN (FILDIR (PACKFILENAME 'DIRECTORY D + 'BODY + (CONCAT 'XCCS- FOCTAL + '=*) + 'EXTENSION + 'TXT + 'VERSION ""))) + do (RETURN FN))) + (MKLIST (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION 'TXT + 'VERSION "") + T UNICODEDIRECTORIES)) + (for D inside UNICODEDIRECTORIES + when [SETQ $$VAL (OR (FILDIR (PACKFILENAME 'NAME + (CONCAT "XCCS-*=" F) + 'EXTENSION + 'TXT + 'VERSION "" 'BODY D)) + (FILDIR (PACKFILENAME 'NAME + (CONCAT "XCCS-" F "=*") + 'EXTENSION + 'TXT + 'VERSION "" 'BODY D] + do (RETURN $$VAL)) + (AND (SETQ CSI (ASSOC F XCCS-CHARSETS)) + (READ-UNICODE-MAPPING-FILENAMES (CDR CSI))) + (for D inside UNICODEDIRECTORIES + when (DIRECTORYNAMEP (SETQ D (CONCAT D ">" F ">"))) + join (FILDIR (CONCAT D ">*.TXT;"] + :TEST + (FUNCTION STRING.EQUAL]) + +(READ-UNICODE-MAPPING + [LAMBDA (FILESPEC PRINT NOERROR) (* ; "Edited 16-Oct-2025 11:25 by rmk") + (* ; "Edited 11-Oct-2025 12:08 by rmk") + (* ; "Edited 4-Sep-2025 00:17 by rmk") + (* ; "Edited 24-Apr-2025 15:32 by rmk") + (* ; "Edited 31-Jan-2025 17:43 by rmk") + (* ; "Edited 17-Jan-2025 16:41 by rmk") + (* ; "Edited 3-Feb-2024 00:21 by rmk") + (* ; "Edited 5-Jan-2024 12:26 by rmk") + (* ; "Edited 3-Jul-2021 13:37 by rmk:") + + (* ;; "Combines the char-mapping tables from FILES coded in the Uncode-CDROM format. Comments prefixed by # and") + + (* ;; " Column 1: XCCS input hex code in the format 0xXXXX") + + (* ;; " Column 2: Corresponding Unicode code-sequence in the format") + + (* ;; " 0xXXXX ... 0xYYYY") + + (* ;; " Column 3: (after #) Character name in some mapping files, utf-8 character") + + (* ;; " for XCCS mapping files") + + (* ;; "") + + (RESETLST + (for FILE STREAM [SEPBITTABLE _ (MAKEBITTABLE (CHARCODE (TAB SPACE] in ( + READ-UNICODE-MAPPING-FILENAMES + FILESPEC) + join + (* ;; "External format :THROUGH means read as bytes, so the Unicode UTF-8 comments cannot cause reading problems.") + + [RESETSAVE [SETQ STREAM (OPENSTREAM FILE 'INPUT NIL '((FORMAT :THROUGH) + (EOLCONVENTION LF] + '(PROGN (CLOSEF? OLDVALUE] + (bind LINE NAME CHARSET START + first (CL:UNLESS (FILEPOS "Name:" STREAM NIL NIL NIL T) + (ERROR "NOT A UNICODE MAPPING FILE" (FULLNAME STREAM))) + (SETQ NAME (CL:STRING-TRIM " " (CL:READ-LINE STREAM NIL NIL))) + (SETQ CHARSET (CL:IF (FILEPOS "XCCS charset:" STREAM NIL NIL NIL T) + (CL:STRING-TRIM " " (CL:READ-LINE STREAM NIL NIL)) + "")) + (CL:WHEN PRINT (* ; "Strip off XCCS in front of name") + (PRINTOUT T T CHARSET " " [SUBSTRING NAME (CONSTANT (ADD1 (NCHARS "XCCS" + ] + T)) while (SETQ LINE (CL:READ-LINE STREAM NIL NIL)) + when (SETQ START (STRPOSL SEPBITTABLE LINE 1 T)) + unless (EQ (CHARCODE %#) + (NTHCHARCODE LINE START)) + collect [bind END CODES while [SETQ END (OR (STRPOSL SEPBITTABLE LINE START) + (ADD1 (NCHARS LINE] + collect [CHARCODE.DECODE (SUBSTRING LINE START (SUB1 END) + (CONSTANT (CONCAT] + repeatwhile (AND (SETQ START (STRPOSL SEPBITTABLE LINE END T)) + (NEQ (CHARCODE %#) + (NTHCHARCODE LINE START))) + finally (CL:WHEN (CDDR $$VAL) (* ; "Combiners go into a CADR list") + (RPLACD $$VAL (CONS (CDR $$VAL))))] + finally (CLOSEF? STREAM))))]) +) + + + +(* ; "Make translation tables for UTF external formats") + +(DEFINEQ + +(MAKE-UNICODE-TRANSLATION-TABLES + [LAMBDA (MAPPING REINSTALL) (* ; "Edited 11-Oct-2025 11:54 by rmk") + (* ; "Edited 4-Sep-2025 00:30 by rmk") + (* ; "Edited 24-Apr-2025 15:47 by rmk") + (* ; "Edited 31-Jan-2025 17:46 by rmk") + (* ; "Edited 26-Jan-2025 19:36 by rmk") + (* ; "Edited 22-Jan-2025 14:22 by rmk") + (* ; "Edited 19-Jan-2025 15:08 by rmk") + (* ; "Edited 18-Jan-2025 11:52 by rmk") + (* ; "Edited 3-Feb-2024 00:24 by rmk") + (* ; "Edited 30-Jan-2024 09:54 by rmk") + (* ; "Edited 21-Aug-2021 13:12 by rmk:") + + (* ;; "MAPPING is the list of numeric code correspondence pairs constructed by applying READ-UNICODE-MAPPING to XCCS-to-Unicode mapping files. This applies the XCCS-to-MCCS translations, and then updates or produces two recoding arrays, one maps left-side codes into right-side codes (e.g. MCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. MCCS).") + (* ; "Edited 17-Aug-2020 08:46 by rmk:") + (CL:UNLESS [AND (LISTP MAPPING) + (FOR PAIR R IN MAPPING AS I TO 10 + ALWAYS (AND (LISTP PAIR) + (CHARCODEP (CAR PAIR)) + [FIXP (SETQ R (CAR (MKLIST (CADR PAIR] + (CHARCODEP (IABS R] + + (* ;; "Seems like the argument is not already a list of mapping pairs (perhaps with a combiner), presumably a list of charsets to be read.") + + (SETQ MAPPING (READ-UNICODE-MAPPING MAPPING))) + (SETQ MAPPING (XCCSTOMCCS-MAPPING MAPPING)) + + (* ;; "This updates or produces two recoding arrays, one maps left-side codes into right-side codes (e.g. XCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. XCCS).") + + (* ;; "") + + (* ;; "If REINSTALL is T, the new mapping vectors replace the current maps in the *XCCSTOUNICODE* and *UNICODETOXCCS* global variables. Otherwise we create new tables (mostly for comparison and debugging).") + + (* ;; "") + + (if REINSTALL + then (SETQ *MCCS-LOADED-CHARSETS* (SETQ *UNICODE-LOADED-CHARSETS* NIL)) + (SETQ *NEXT-PRIVATE-MCCSCODE* FIRST-PRIVATE-MCCSCODE) + (SETQ *NEXT-PRIVATE-UNICODE* FIRST-PRIVATE-UNICODE) + (LET [(TABLE (HASHARRAY (LENGTH MAPPING))) + (INVERSETABLE (HASHARRAY (LENGTH MAPPING] + (MERGE-UNICODE-TRANSLATION-TABLES NIL MAPPING TABLE INVERSETABLE) + (SETQ *MCCSTOUNICODE* TABLE) + (SETQ *UNICODETOMCCS* INVERSETABLE) + (LIST *MCCSTOUNICODE* *UNICODETOMCCS*)) + else (CL:UNLESS (BOUNDP '*NEXT-PRIVATE-MCCSCODE*) + (SETQ *NEXT-PRIVATE-MCCSCODE* FIRST-PRIVATE-MCCSCODE) + (SETQ *NEXT-PRIVATE-UNICODE* FIRST-PRIVATE-UNICODE)) + (MERGE-UNICODE-TRANSLATION-TABLES NIL MAPPING]) + +(XCCSTOMCCS-MAPPING + [LAMBDA (XTOUMAPPING) (* ; "Edited 11-Oct-2025 12:57 by rmk") + + (* ;; + "This translates the pairs that map XCCS to Unicode into pairs that translate MCCS to Unicode.") + + (* ;; + "We grab the affected pairs before we make any changes so that we don't get into ordering issues.") + + (LET* ([XTOMCODES (CHARCODE ((Currency Dollar) + (Dollar Currency) + (Uparrow Circumflex) + (Circumflex Uparrow) + (Leftarrow Lowline) + (Lowline Leftarrow] + (AFFECTED (for MP in XTOUMAPPING when (thereis XP in XTOMCODES + suchthat (EQ (CAR MP) + (CAR XP))) collect MP))) + (for AP in AFFECTED do (RPLACA AP (CADR (ASSOC (CAR AP) + XTOMCODES))) + finally (push XTOUMAPPING (CHARCODE (DEL DEL))) + (RETURN XTOUMAPPING]) + +(MERGE-UNICODE-TRANSLATION-TABLES + [LAMBDA (INVERSE MAPPING TABLE INVERSETABLE) (* ; "Edited 11-Oct-2025 10:24 by rmk") + (* ; "Edited 24-Apr-2025 15:28 by rmk") + (* ; "Edited 1-Feb-2025 21:42 by rmk") + (* ; "Edited 26-Jan-2025 12:58 by rmk") + (* ; "Edited 22-Jan-2025 08:20 by rmk") + (* ; "Edited 19-Jan-2025 15:58 by rmk") + (* ; "Edited 18-Jan-2025 11:49 by rmk") + (* ; "Edited 27-Mar-2024 12:10 by rmk") + (* ; "Edited 3-Feb-2024 12:46 by rmk") + (* ; "Edited 31-Jan-2024 10:06 by rmk") + + (* ;; "MAPPINGS is a list of pairs that map domain codes to range codes. TABLE and INVERSETABLE default to *MCCSTOUNICODE* *UNICODETOMCCS* respectively. ") + + (CL:UNLESS TABLE + [SETQ TABLE (OR *MCCSTOUNICODE* (SETQ *MCCSTOUNICODE* (HASHARRAY (LENGTH MAPPING]) + (CL:UNLESS INVERSETABLE + [SETQ INVERSETABLE (OR *UNICODETOMCCS* (SETQ *UNICODETOMCCS* (HASHARRAY (LENGTH MAPPING]) + (for M D R OLDR in MAPPING first (CL:IF INVERSE (swap TABLE INVERSETABLE)) + eachtime (SETQ D (CAR M)) + (SETQ R (CADR M)) + + (* ;; "We don't do combiners, but we are allowing non-SMALLP's") + unless (OR (LISTP D) + (LISTP R)) do + (* ;; "The (CONS R OLDR) deals with alternatives: (U X1) (U X2) => (U (X1 X2)), lowest code first. Those are only possible in the U-to-X direction when the tables contain (X1 U) and (X2 U). There are no duplicates/alternative table entries in the X-to-U direction.") + + (SETQ OLDR (GETHASH D TABLE)) + (CL:UNLESS (MEMB R OLDR) + (PUTHASH D (SORT (CONS R OLDR)) + TABLE)) + (swap D R) + (SETQ OLDR (GETHASH D INVERSETABLE)) + (CL:UNLESS (MEMB R OLDR) + (PUTHASH D (SORT (CONS R OLDR)) + INVERSETABLE))) + (LIST TABLE INVERSETABLE]) + +(UNICODE.UNMAPPED + [LAMBDA (CODE TABLE DONTFAKE) (* ; "Edited 24-Apr-2025 15:48 by rmk") + (* ; "Edited 22-Jan-2025 08:19 by rmk") + (* ; "Edited 19-Jan-2025 22:02 by rmk") + (* ; "Edited 18-Jan-2025 12:02 by rmk") + (* ; "Edited 2-Feb-2024 23:52 by rmk") + (* ; "Edited 31-Jan-2024 10:07 by rmk") + (* ; "Edited 11-Aug-2020 20:23 by rmk:") + + (* ;; "This is the slow fall-out when UNICODE.TRANSLATE determines that CODE has no fast mapping in TRANSLATION-TABLE.") + + (* ;; "") + + (* ;; "If we have not already installed the mapping segment for that code, we try to retrieve it from the numberic file. If that segment mapping doesn't exist or doesn't have an entry for CODE, we fake up a mapping with a negative range in both directions. One way or the other, there will be an entry for that segment in both mapping vectors.") + + (* ;; "") + + (PROG ((INVERSE (EQ TABLE *UNICODETOMCCS*)) + RANGE HASH) + + (* ;; "If we already looked up CODE's character set in a file, then we have already filled in its information in the translation table. If it didn't have a code for a particular character, then we fake it here. Faked codes are negative, so we can detect them easily, and interpret them with IABS.") + + (CL:WHEN (AND (UNICODE-EXTEND-TRANSLATION? CODE TABLE) + (SETQ RANGE (GETHASH CODE TABLE))) + + (* ;; "We might have gotten the segment that didn't have an entry for CODE.") + + (RETURN RANGE)) + + (* ;; "") + + (CL:UNLESS DONTFAKE + + (* ;; "Our attempt at extending the known tables did not provide a mapping for CODE. So we fake it up with the next unused private code in the code space. ") + + (* ;; "The number of possible faked mappings is determined by the number of private-use Unicodes, since the MCCS character space is pretty sparse. The codes don't have to come from the same part of the code space, and the NEXTCODEs are saved in global variables. The last available codes are constants.") + + (CL:WHEN (IEQP *NEXT-PRIVATE-MCCSCODE* LAST-PRIVATE-MCCSCODE) + (* ; + "Same number of available codes both ways") + (ERROR "EXHAUSTED RANGE FOR UNMAPPED CODES")) + (if INVERSE + then (SETQ RANGE *NEXT-PRIVATE-MCCSCODE*) + (add *NEXT-PRIVATE-MCCSCODE* 1) + else (SETQ RANGE *NEXT-PRIVATE-UNICODE*) + (add *NEXT-PRIVATE-UNICODE* 1)) + (MERGE-UNICODE-TRANSLATION-TABLES INVERSE (CONS (LIST CODE RANGE))) + + (* ;; "CONS because of LIST convention so we can eventually distinguish combiners.") + + (RETURN (CONS RANGE)))]) + +(UNICODE-EXTEND-TRANSLATION? + [LAMBDA (CODE TABLE) (* ; "Edited 11-Oct-2025 09:49 by rmk") + (* ; "Edited 4-Sep-2025 00:34 by rmk") + (* ; "Edited 29-Jun-2025 16:44 by rmk") + (* ; "Edited 24-Apr-2025 15:49 by rmk") + (* ; "Edited 26-Jan-2025 11:26 by rmk") + (* ; "Edited 21-Jan-2025 22:31 by rmk") + (* ; "Edited 18-Jan-2025 12:40 by rmk") + (* ; "Edited 13-Jan-2025 23:50 by rmk") + (* ; "Edited 26-Aug-2024 16:49 by rmk") + (* ; "Edited 27-Mar-2024 23:02 by rmk") + (* ; "Edited 5-Feb-2024 13:48 by rmk") + (* ; "Edited 3-Feb-2024 12:40 by rmk") + + (* ;; "There is currently no mapping for CODE in TABLE, hopefully just because the relevant character-set mapping has not been installed. We infer from TABLE whether CODE is an MCCS or UNICODE code and look for the proper mapping table (forward or inverted) for its character set. ") + + (* ;; "We record which character sets we have already expanded so we don't do them again.") + + (LET ((CHARSET (\CHARSET CODE)) + (INVERSE (EQ TABLE *UNICODETOMCCS*)) + MAPPING FILE) + + (* ;; "If we already looked for CHARSET in the file and found anything, it has already been merged. Otherwise, it would just fail again") + + (CL:UNLESS (MEMB CHARSET (CL:IF INVERSE + *UNICODE-LOADED-CHARSETS* + *MCCS-LOADED-CHARSETS*)) + + (* ;; "Don't try this charset again.") + + (CL:IF INVERSE + (push *UNICODE-LOADED-CHARSETS* CHARSET) + (push *MCCS-LOADED-CHARSETS* CHARSET)) + (SETQ FILE (FINDFILE (CL:IF INVERSE + 'UNICODE-TO-MCCS-MAPPINGS + 'MCCS-TO-UNICODE-MAPPINGS) + T UNICODEDIRECTORIES)) + + (* ;; "The mappings files are indexed by CHARSET.") + + (CL:WHEN [AND FILE (SETQ MAPPING (CL:WITH-OPEN-FILE (STREAM FILE :INPUT) + (CL:WHEN (FILEPOS (CONCAT "[" CHARSET " ") + STREAM NIL NIL NIL T) + (READ STREAM] + + (* ;; + "Merge MAPPING into both tables, respecting the direction indicated by TABLE. ") + + (MERGE-UNICODE-TRANSLATION-TABLES INVERSE MAPPING) + T))]) +) +(DEFINEQ + +(ALL-UNICODE-MAPPINGS + [LAMBDA (INVERTED FILE) (* ; "Edited 24-Apr-2025 15:51 by rmk") + (* ; "Edited 31-Jan-2025 17:46 by rmk") + (* ; "Edited 26-Jan-2025 13:40 by rmk") + (* ; "Edited 22-Jan-2025 14:07 by rmk") + (* ; "Edited 19-Jan-2025 12:20 by rmk") + (* ; "Edited 17-Jan-2025 22:32 by rmk") + (* ; "Edited 15-Jan-2025 09:49 by rmk") + (* ; "Edited 27-Mar-2024 14:48 by rmk") + (* ; "Edited 5-Feb-2024 13:14 by rmk") + (* ; "Edited 3-Feb-2024 09:16 by rmk") + + (* ;; "Reads all the XCCS-to-UNICODE mapping files that we know about, and produces a 2-level index that maps between MCCS codes and UNICODE codes, depending on INVERTED.") + + (* ;; "The first index level segments all the domain codes according to their character sets. The segments are sorted by character set, the pairs within each segment are sorted by their domain codes. ") + + (* ;; + "E.g. if INVERTED=NIL and given a XCCS code, the lookup for the corresponding Unicode(s) is") + + (* ;; " (CADR (ASSOC MCCSCODE (\CHARSET MCCSCODE) INDEX)))).") + + (* ;; "If FILE is not NIL, the result is written to a file. If FILE is T, the file is either MCCS-TO-UNICODE-MAPPINGS.TXT or UNICODE-TO-MCCS-MAPPINGS.TXT, depending on INVERTED.") + + (LET (INDEX) + (for PAIR DOMAIN RANGE CHARSET in (READ-UNICODE-MAPPING 'ALL) eachtime (SETQ DOMAIN + (CAR PAIR)) + (SETQ RANGE (CADR PAIR)) + + (* ;; + "(LISTP RANGE) is a combiner, ignored for now.") + unless (LISTP RANGE) do (CL:WHEN INVERTED (SWAP DOMAIN RANGE)) + + (* ;; + "One segment for each high-byte character set. This aligns with UNICODE-EXTEND.TRANSLATION?") + + [SETQ CHARSET (OR (ASSOC (\CHARSET DOMAIN) + INDEX) + (CAR (push INDEX (CONS (\CHARSET DOMAIN] + + (* ;; "For alternative mappings (in the U-to-M direction) we end up with (D R1 R2 ...). (CADR is the first (and almost always) the only one.") + + (pushnew [CDR (OR (ASSOC DOMAIN (CDR CHARSET)) + (CAR (push (CDR CHARSET) + (CONS DOMAIN] + RANGE)) + + (* ;; "Push the charset mappings down an extra CONS, so that a subsequent READ will get them all after a FILEPOS search for super-paren [") + + [for CS in INDEX do (for M in (CDR CS) when (CDDR M) do + (* ;; + "Sort the range alternatives, if any") + + (change (CDR M) + (SORT DATUM))) + + (* ;; "Sort by domain codes and push down a level") + + (change (CDR CS) + (CONS (SORT DATUM T] + (SETQ INDEX (SORT INDEX T)) (* ; "Sort character sets") + (if FILE + then (SETQ FILE (PACKFILENAME 'BODY (if (NEQ FILE T) + then FILE + elseif INVERTED + then 'UNICODE-TO-MCCS-MAPPINGS + else 'MCCS-TO-UNICODE-MAPPINGS) + 'DIRECTORY + (CAR (MKLIST UNICODEDIRECTORIES)) + 'EXTENSION + 'TXT)) + (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION) + + (* ;; + "We can FILEPOS for %"[nnn %" then READ for each segment. Or just READFILE to get them all.") + + (for I in INDEX do (PRINTOUT STREAM "[" (CAR I) + " " + (CADR I) + "]" T T)) + (PRINTOUT STREAM "STOP" T) + (FULLNAME STREAM)) + else INDEX]) + +(XCCSJAPANESECHARSETS + [LAMBDA (OCTAL FILE) (* ; "Edited 11-Jun-2025 23:00 by rmk") + + (* ;; "Returns the list of numbers for the Japanese character sets.") + + (for F POS CS in (READ-UNICODE-MAPPING-FILENAMES "JIS") + when (SETQ POS (STRPOS "XCCS-" F 1 NIL NIL T)) + collect [SETQ CS (SUBSTRING F POS (SUB1 (STRPOS '=JIS F POS] + (CL:IF OCTAL + CS + (MKATOM (CONCAT CS "Q"))) + finally (SORT $$VAL) + (CL:WHEN FILE + (RETURN (CL:WITH-OPEN-FILE (STREAM (PACKFILENAME 'BODY (CL:IF (EQ FILE T) + "JAPANESECHARSETS" + FILE) + 'DIRECTORY + (CAR (MKLIST UNICODEDIRECTORIES)) + 'EXTENSION + 'TXT) + :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION) + (PRINT $$VAL STREAM) + (FULLNAME STREAM))))]) +) + +(RPAQ? *MCCSTOUNICODE* ) + +(RPAQ? *UNICODETOMCCS* ) + +(RPAQ? *MCCS-LOADED-CHARSETS* ) + +(RPAQ? *UNICODE-LOADED-CHARSETS* ) + +(RPAQ? *LARGEUNICODES* ) +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(MAKE-UNICODE-TRANSLATION-TABLES 'ALL) +) +(DECLARE%: EVAL@COMPILE DONTCOPY + +(FILESLOAD (LOADCOMP) + UNICODE-EXPORTS) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (3341 12542 (READ-UNICODE-MAPPING-FILENAMES 3351 . 8301) (READ-UNICODE-MAPPING 8303 . +12540)) (12609 26839 (MAKE-UNICODE-TRANSLATION-TABLES 12619 . 16379) (XCCSTOMCCS-MAPPING 16381 . 17598 +) (MERGE-UNICODE-TRANSLATION-TABLES 17600 . 20253) (UNICODE.UNMAPPED 20255 . 23579) ( +UNICODE-EXTEND-TRANSLATION? 23581 . 26837)) (26840 33676 (ALL-UNICODE-MAPPINGS 26850 . 32339) ( +XCCSJAPANESECHARSETS 32341 . 33674))))) +STOP diff --git a/library/UNICODE-TABLES.LCOM b/library/UNICODE-TABLES.LCOM new file mode 100644 index 00000000..d339e038 Binary files /dev/null and b/library/UNICODE-TABLES.LCOM differ diff --git a/library/UNICODE.LCOM b/library/UNICODE.LCOM index 32d12b9e..b14e049a 100644 Binary files a/library/UNICODE.LCOM and b/library/UNICODE.LCOM differ diff --git a/library/UNIXUTILS b/library/UNIXUTILS index 9bb94cb9..9f9491d9 100644 --- a/library/UNIXUTILS +++ b/library/UNIXUTILS @@ -1,11 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "13-Nov-2023 12:57:10" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;26 16663 +(FILECREATED "26-Nov-2025 14:21:13" {WMEDLEY}UNIXUTILS.;35 18084 - :CHANGES-TO (FNS ShellBrowser) + :EDIT-BY rmk - :PREVIOUS-DATE "11-Nov-2023 09:06:39" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;25 -) + :CHANGES-TO (VARS UNIXUTILSCOMS) + + :PREVIOUS-DATE " 4-Nov-2025 10:11:10" {WMEDLEY}UNIXUTILS.;34) (PRETTYCOMPRINT UNIXUTILSCOMS) @@ -18,8 +19,8 @@ (INITVARS (ShellBrowser) (ShellOpener)) (FUNCTIONS ShellCommand ShellWhich) - (ADDVARS (MEDLEY-INIT-VARS (ShellBrowser) - (ShellOpener))) + (ADDVARS (MEDLEY-INIT-VARS (ShellBrowser NIL RESET) + (ShellOpener NIL RESET))) (FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME) (PROPS (UNIXUTILS FILETYPE)))) (DECLARE%: EVAL@COMPILE DONTCOPY @@ -56,8 +57,8 @@ (T (SETFILEPTR S 0) (RSTRING S]) -(ADDTOVAR MEDLEY-INIT-VARS (ShellBrowser) - (ShellOpener)) +(ADDTOVAR MEDLEY-INIT-VARS (ShellBrowser NIL RESET) + (ShellOpener NIL RESET)) (DEFINEQ (ShellBrowser @@ -146,7 +147,8 @@ "true"]) (ShellOpen - [LAMBDA (FilenameOrURL) + [LAMBDA (FilenameOrURL) (* ; "Edited 10-Sep-2025 15:29 by rmk") + (* ; "Edited 4-May-2025 11:14 by rmk") (* ;; "Open the file or URL using the generic %"opener%" for this machine via a shell call.") @@ -176,62 +178,56 @@ " >>/tmp/ShellBrowser-warnings-$$.txt")) T) else (CONCAT "Unable to find a browser to open: " FilenameOrURL))) - else - (LET* - ((OPENER (ShellOpener)) - (FULLNAME (FULLNAME FilenameOrURL))) - (if (NOT FULLNAME) - then (CONCAT "File not found: " FilenameOrURL) - elseif (STREQUAL OPENER "true") - then (CONCAT "Unable to find a file opener to open: " FilenameOrURL) - else (LET* ((VERSION.SPECIFIED (FILENAMEFIELD FilenameOrURL 'VERSION)) - (UNPACKED (UNPACKFILENAME.STRING FULLNAME)) - (NEWNAME (CONCAT (LISTGET UNPACKED 'NAME) - "~" - (LISTGET UNPACKED 'VERSION) - "~")) - (EXTENSION (LISTGET UNPACKED 'EXTENSION)) - [UNVERSIONED (LET (FN (UNPACKED (COPY UNPACKED))) - (LISTPUT UNPACKED 'VERSION NIL) - (LISTPUT UNPACKED 'HOST NIL) - (SETQ FN (PACKFILENAME.STRING UNPACKED)) - (if (STREQUAL (SUBSTRING FN -1) - ".") - then (SETQ FN (SUBSTRING UNIXFILE 1 -2))) - (SETQ FN (SLASHIT FN] - (UNVERSIONED.EXISTS (INFILEP (CONCAT "{UNIX}" UNVERSIONED))) - (TMPDIR (CONCAT "/tmp/" (RAND 1000 9999))) - (TARGETFILE.LISP (PACKFILENAME.STRING 'HOST "{UNIX}" 'DIRECTORY TMPDIR - 'NAME NEWNAME 'EXTENSION EXTENSION)) - (TARGETFILE.UNIX (SLASHIT (PACKFILENAME.STRING 'HOST NIL 'DIRECTORY TMPDIR - 'NAME NEWNAME 'EXTENSION EXTENSION))) - (UNIXFILE NIL)) - (DECLARE (SPECVARS UNIXFILE)) - (if (OR VERSION.SPECIFIED (NOT UNVERSIONED.EXISTS)) - then (COPYFILE FULLNAME TARGETFILE.LISP) - (SETQ UNIXFILE TARGETFILE.UNIX) - else (SETQ UNIXFILE UNVERSIONED)) - (CL:WITH-OPEN-STREAM - (SHELLSTREAM (OPENSTREAM (CONCAT "{CORE}SHELLOUT" (RAND 1000 9999)) - 'BOTH)) - (ShellCommand (CONCAT OPENER " '" UNIXFILE "'" - " >>/tmp/ShellOpener-warnings-$$.txt") - SHELLSTREAM) - (if (EQ (GETFILEPTR SHELLSTREAM) - 0) - then T - else (LET* ((OUTSTRING (ALLOCSTRING (GETFILEPTR SHELLSTREAM) - " "))) - (CL:WITH-OPEN-STREAM (STRINGSTREAM (OPENSTRINGSTREAM OUTSTRING - 'OUTPUT)) - (SETFILEPTR SHELLSTREAM 0) - (CL:TAGBODY [SETFILEINFO SHELLSTREAM 'ENDOFSTREAMOP - #'(CL:LAMBDA (s) - (GO OUT] - (CL:LOOP (PRINTCCODE (READCCODE SHELLSTREAM) - STRINGSTREAM)) - OUT)) - OUTSTRING]) + else (LET* ((OPENER (ShellOpener)) + (FULLNAME (FULLNAME FilenameOrURL))) + (if (NOT FULLNAME) + then (CONCAT "File not found: " FilenameOrURL) + elseif (STREQUAL OPENER "true") + then (CONCAT "Unable to find a file opener to open: " FilenameOrURL) + else (LET* ((VERSION.SPECIFIED (FILENAMEFIELD FilenameOrURL 'VERSION)) + (UNPACKED (UNPACKFILENAME.STRING FULLNAME)) + (NEWNAME (CONCAT (LISTGET UNPACKED 'NAME) + "~" + (LISTGET UNPACKED 'VERSION) + "~")) + (EXTENSION (LISTGET UNPACKED 'EXTENSION)) + [UNVERSIONED (LET (FN (UNPACKED (COPY UNPACKED))) + (LISTPUT UNPACKED 'VERSION NIL) + (LISTPUT UNPACKED 'HOST NIL) + (SETQ FN (PACKFILENAME.STRING UNPACKED)) + (if (STREQUAL (SUBSTRING FN -1) + ".") + then (SETQ FN (SUBSTRING UNIXFILE 1 -2))) + (SETQ FN (SLASHIT FN] + (UNVERSIONED.EXISTS (INFILEP (CONCAT "{UNIX}" UNVERSIONED))) + (TMPDIR (CONCAT "/tmp/" (RAND 1000 9999))) + (TARGETFILE.LISP (PACKFILENAME.STRING 'HOST "{UNIX}" 'DIRECTORY TMPDIR + 'NAME NEWNAME 'EXTENSION EXTENSION)) + (TARGETFILE.UNIX (SLASHIT (PACKFILENAME.STRING 'HOST NIL 'DIRECTORY + TMPDIR 'NAME NEWNAME 'EXTENSION + EXTENSION))) + (UNIXFILE NIL)) + (DECLARE (SPECVARS UNIXFILE)) + (if (OR VERSION.SPECIFIED (NOT UNVERSIONED.EXISTS)) + then (COPYFILE FULLNAME TARGETFILE.LISP) + (SETQ UNIXFILE TARGETFILE.UNIX) + else (SETQ UNIXFILE UNVERSIONED)) + (CL:WITH-OPEN-STREAM + (SHELLSTREAM (OPENSTREAM (CONCAT "{CORE}SHELLOUT" (RAND 1000 9999)) + 'BOTH)) + (ShellCommand (CONCAT OPENER " '" UNIXFILE "'" + " >>/tmp/ShellOpener-warnings-$$.txt") + SHELLSTREAM) + (if (EQ (GETFILEPTR SHELLSTREAM) + 0) + then T + else (LET ((OUTSTRING (ALLOCSTRING (GETFILEPTR SHELLSTREAM) + " "))) + (CL:WITH-OPEN-STREAM (STRINGSTREAM (OPENSTRINGSTREAM + OUTSTRING + 'OUTPUT)) + (COPYCHARS SHELLSTREAM STRINGSTREAM 0 -1)) + OUTSTRING]) (PROCESS-COMMAND [LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk") @@ -244,7 +240,10 @@ 0))) DO (BLOCK) FINALLY (RETURN CODE]) (SLASHIT - [LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 23-Sep-2023 15:27 by rmk") + [LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 4-Nov-2025 10:10 by rmk") + (* ; "Edited 22-Oct-2025 13:05 by rmk") + (* ; "Edited 25-Sep-2025 09:57 by rmk") + (* ; "Edited 23-Sep-2023 15:27 by rmk") (* ;; "It would also be nice to use the generic unpackfilename/packfilename tools. But packfilename sticks in brackets again, and sticks a dot on when removing the version.") @@ -255,13 +254,14 @@ (LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X) 0] [SETQ SLASHED (CONCATCODES (for I C from DIRPOS while (SETQ C (NTHCHARCODE X I)) - collect (SELCHARQ C - ((< >) - (SETQ LASTDIRPOS I) - (CHARCODE /)) - (/ (SETQ LASTDIRPOS I) - C) - C] + join (SELCHARQ C + ((< >) + (SETQ LASTDIRPOS I) + (CONS (CHARCODE /))) + (/ (SETQ LASTDIRPOS I) + (CONS C)) + (SPACE (APPEND (CHARCODE (\ SPACE)))) + (CONS C] (CL:WHEN (AND LCASEDIRS LASTDIRPOS) (SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS))) (SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS)) @@ -274,13 +274,15 @@ SLASHED))]) (UNIX-FILE-NAME - [LAMBDA (FILE ACCESS COPY) (* ; "Edited 1-Oct-2023 20:52 by rmk") + [LAMBDA (FILE ACCESS COPY) (* ; "Edited 27-Sep-2025 16:24 by rmk") + (* ; "Edited 19-Sep-2025 07:29 by rmk") + (* ; "Edited 13-Sep-2025 18:37 by rmk") + (* ; "Edited 1-Oct-2023 20:52 by rmk") + + (* ;; "Forces an extension %"ufn%" if there isn't one already, to avoid the dot/no-dot question") (* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file is doesn't have the Medley version convention. If FILE does not have a corresponding Unix name, COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.") - - (CL:WHEN (\GETSTREAM FILE ACCESS T) - (SETQ FILE (OR (FULLNAME FILE) - FILE))) (* ; "Might catch NODIRCORE") + (* ; "Might catch NODIRCORE") (CL:WHEN FILE (SETQ FILE (TRUEFILENAME FILE)) (CL:UNLESS (STREAMP FILE) @@ -290,35 +292,42 @@ (NIL (SETQ ACCESS 'INPUT) 'OLD) (\ILLEGAL.ARG ACCESS]) - [SELECTQ (FILENAMEFIELD FILE 'HOST) - (UNIX [SUBSTRING FILE (ADD1 (CONSTANT (NCHARS "{UNIX}"]) - (DSK (LET [(VERSION (FILENAMEFIELD FILE 'VERSION] - (SETQ FILE (SLASHIT (PACKFILENAME 'HOST NIL 'VERSION NIL 'BODY FILE))) - (CL:IF (AND VERSION (IGREATERP VERSION 1)) - (CONCAT FILE (CL:IF (FILENAMEFIELD FILE 'EXTENSION) - "." - "") - "~" VERSION "~") - FILE))) - (CL:WHEN (AND COPY (EQ ACCESS 'INPUT) - FILE) - (RESETLST - (CL:WHEN (\GETSTREAM FILE 'INPUT T) (* ; "Hope is randaccess") - [RESETSAVE (GETFILEPTR FILE) - `(PROGN (SETFILEPTR ,FILE OLDVALUE]) - (COPYFILE FILE (CONCAT "{UNIX}/tmp/medley-" (L-CASE COPY) - "-" - (IDATE) - "-" - (RAND) - (CL:IF (FILENAMEFIELD FILE 'EXTENSION) - (CONCAT "." (FILENAMEFIELD FILE 'EXTENSION)) - "")))))])]) + (LET (UNAME VERSION) + [SELECTQ (FILENAMEFIELD FILE 'HOST) + ((UNIX DSK) + (SETQ UNAME FILE)) + (PROGN + (* ;; "Catch the streams as well as other devices (CORE, servers)") + + [SETQ UNAME (OUTFILEP (CONCAT "{DSK}/tmp/medley-" (CL:IF COPY + (CONCAT (L-CASE COPY) + "-") + "") + (IDATE] + (CL:WHEN (AND COPY FILE) + (RESETLST + (CL:WHEN (\GETSTREAM FILE 'INPUT T) + (* ; "Hope it's randaccess") + [RESETSAVE (GETFILEPTR FILE) + `(PROGN (SETFILEPTR ,FILE OLDVALUE]) + + (* ;; "Let DSK pick a new version number, rather than RAND") + + (COPYFILE FILE UNAME)))] + (SETQ VERSION (FILENAMEFIELD UNAME 'VERSION)) (* ; "Convert to Unix version. ") + (SETQ UNAME (PACKFILENAME 'VERSION NIL 'BODY UNAME)) + (CL:WHEN (AND VERSION (IGREATERP VERSION 1)) + (SETQ UNAME (CONCAT UNAME ".~" VERSION "~"))) + (SETQ UNAME (SLASHIT UNAME NIL T)) + (CL:IF (EQ (CHARCODE %.) + (NTHCHARCODE UNAME -1)) + (SUBSTRING UNAME 1 -2) + UNAME)))]) ) (PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1146 1519 (ShellCommand 1146 . 1519)) (1521 1918 (ShellWhich 1521 . 1918)) (2008 16585 -(ShellBrowser 2018 . 3790) (ShellBrowse 3792 . 4477) (ShellOpener 4479 . 6167) (ShellOpen 6169 . 11324 -) (PROCESS-COMMAND 11326 . 11939) (SLASHIT 11941 . 13983) (UNIX-FILE-NAME 13985 . 16583))))) + (FILEMAP (NIL (1137 1510 (ShellCommand 1137 . 1510)) (1512 1909 (ShellWhich 1512 . 1909)) (2019 18006 +(ShellBrowser 2029 . 3801) (ShellBrowse 3803 . 4488) (ShellOpener 4490 . 6178) (ShellOpen 6180 . 11659 +) (PROCESS-COMMAND 11661 . 12274) (SLASHIT 12276 . 14731) (UNIX-FILE-NAME 14733 . 18004))))) STOP diff --git a/library/UNIXUTILS.DFASL b/library/UNIXUTILS.DFASL index 8a008955..96e1669b 100644 Binary files a/library/UNIXUTILS.DFASL and b/library/UNIXUTILS.DFASL differ diff --git a/library/sketch/SKETCH b/library/sketch/SKETCH index 76c5e334..552659c7 100644 --- a/library/sketch/SKETCH +++ b/library/sketch/SKETCH @@ -1,18 +1,21 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 5-Dec-2023 00:44:13" {WMEDLEY}sketch>SKETCH.;5 491114 +(FILECREATED "30-Nov-2025 10:10:57" {WMEDLEY}SKETCH>SKETCH.;11 493235 :EDIT-BY rmk :CHANGES-TO (VARS SKETCHCOMS) + (FNS UPDATE-SKETCH EDIT-SKETCH) - :PREVIOUS-DATE "19-Oct-2023 23:55:27" {WMEDLEY}sketch>SKETCH.;4) + :PREVIOUS-DATE " 8-Nov-2025 12:19:12" {WMEDLEY}SKETCH>SKETCH.;10) (PRETTYCOMPRINT SKETCHCOMS) (RPAQQ SKETCHCOMS - [[DECLARE%: FIRST DOCOPY DONTEVAL@LOAD + [(FILES (SYSLOAD) + TEDIT) + [DECLARE%: FIRST DOCOPY DONTEVAL@LOAD (P (PROG ((NOTECARDSFLG (GETPROP 'NOTECARDS 'FILEDATES)) (SKETCHFLG (AND (BOUNDP 'ALL.SKETCHES) ALL.SKETCHES)) @@ -48,17 +51,16 @@ To abort loading the new version of Sketch, type '^'."] (FNS SKETCH SKETCH.FROM.A.FILE SKETCHW.CREATE SKETCH.RESET SKETCHW.FIG.CHANGED SK.WINDOW.TITLE EDITSLIDE EDITSKETCH SK.PUT.ON.FILE SK.OUTPUT.FILE.NAME SKETCH.PUT SK.GET.FROM.FILE SK.INCLUDE.FILE SK.GET.IMAGEOBJ.FROM.FILE SKETCH.GET - ADD.SKETCH.TO.VIEWER FILENAMELESSVERSION SK.ADD.ELEMENTS.TO.SKETCH SKETCH.SET.A.DEFAULT - SK.POPUP.SELECTIONFN GETSKETCHWREGION SK.ADD.ELEMENT SK.ADD.PRIORITY.ELEMENT.TO.SKETCH - SK.ELTS.BY.PRIORITY SK.ORDER.ELEMENTS SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH - SK.ADD.ELEMENTS SK.CHECK.WHENADDEDFN SK.APPLY.MENU.COMMAND SK.DELETE.ELEMENT1 - SK.MARK.DIRTY SK.MARK.UNDIRTY SK.MENU.AND.RETURN.FIELD SKETCH.SET.BRUSH.SHAPE - SKETCH.SET.BRUSH.SIZE SKETCHW.CLOSEFN SK.CONFIRM.DESTRUCTION SKETCHW.OUTFN - SKETCHW.REOPENFN MAKE.LOCAL.SKETCH MAP.SKETCHSPEC.INTO.VIEWER SKETCHW.REPAINTFN - SKETCHW.REPAINTFN1 SK.DRAWFIGURE.IF SKETCHW.SCROLLFN SKETCHW.RESHAPEFN - SK.UPDATE.EVENT.SELECTION LIGHTGRAYWINDOW SK.ADD.SPACES SK.SKETCH.MENU - SK.CHECK.IMAGEOBJ.WHENDELETEDFN SK.APPLY.IMAGEOBJ.WHENDELETEDFN SK.RETURN.TTY - SK.TAKE.TTY) + ADD.SKETCH.TO.VIEWER SK.ADD.ELEMENTS.TO.SKETCH SKETCH.SET.A.DEFAULT SK.POPUP.SELECTIONFN + GETSKETCHWREGION SK.ADD.ELEMENT SK.ADD.PRIORITY.ELEMENT.TO.SKETCH SK.ELTS.BY.PRIORITY + SK.ORDER.ELEMENTS SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH SK.ADD.ELEMENTS + SK.CHECK.WHENADDEDFN SK.APPLY.MENU.COMMAND SK.DELETE.ELEMENT1 SK.MARK.DIRTY + SK.MARK.UNDIRTY SK.MENU.AND.RETURN.FIELD SKETCH.SET.BRUSH.SHAPE SKETCH.SET.BRUSH.SIZE + SKETCHW.CLOSEFN SK.CONFIRM.DESTRUCTION SKETCHW.OUTFN SKETCHW.REOPENFN MAKE.LOCAL.SKETCH + MAP.SKETCHSPEC.INTO.VIEWER SKETCHW.REPAINTFN SKETCHW.REPAINTFN1 SK.DRAWFIGURE.IF + SKETCHW.SCROLLFN SKETCHW.RESHAPEFN SK.UPDATE.EVENT.SELECTION LIGHTGRAYWINDOW + SK.ADD.SPACES SK.SKETCH.MENU SK.CHECK.IMAGEOBJ.WHENDELETEDFN + SK.APPLY.IMAGEOBJ.WHENDELETEDFN SK.RETURN.TTY SK.TAKE.TTY) (COMS (* ; "fns for dealing with the sketch menu") (FNS SKETCH.COMMANDMENU SKETCH.COMMANDMENU.ITEMS CREATE.SKETCHW.COMMANDMENU @@ -242,6 +244,8 @@ To abort loading the new version of Sketch, type '^'."] "Reads a file name and opens a sketch window onto the sketch it contains." ] (VARS (BackgroundMenu)) + (COMS (VARS SKETCHFILES) + (FNS UPDATE-SKETCH EDIT-SKETCH)) (FILES SKETCH-OPS SKETCH-ELEMENTS SKETCH-EDIT SKETCH-OBJ SKETCH-BMELT) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (FILES (LOADCOMP) SKETCH-OPS SKETCH-ELEMENTS SKETCH-OBJ @@ -260,13 +264,6 @@ To abort loading the new version of Sketch, type '^'."] (MACROS SK.SET.RECORD.LENGTHS.MACRO) (GLOBALVARS SKETCH.RECORD.LENGTHS) (P (SK.SET.RECORD.LENGTHS))) - [COMS (* ; - "to correct for a bug in the file package that marks LOADCOMPed file as changed") - (P (UNMARKASCHANGED 'SKETCH 'FILE) - (UNMARKASCHANGED 'SKETCH-ELEMENTS 'FILE) - (UNMARKASCHANGED 'SKETCH-OPS 'FILE) - (UNMARKASCHANGED 'SKETCH-EDIT 'FILE) - (UNMARKASCHANGED 'SKETCH-OBJ 'FILE] (COMS (* ; "add sketch as option to file browser edit command") (FNS SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER) @@ -275,6 +272,9 @@ To abort loading the new version of Sketch, type '^'."] (NLAML) (LAMA SK.UNIONREGIONS SKETCH.CREATE]) + +(FILESLOAD (SYSLOAD) + TEDIT) (DECLARE%: FIRST DOCOPY DONTEVAL@LOAD [PROG ((NOTECARDSFLG (GETPROP 'NOTECARDS 'FILEDATES)) @@ -437,12 +437,13 @@ To abort loading the new version of Sketch, type '^'."] (RETURN NEWNAME]) (SK.OUTPUT.FILE.NAME - [LAMBDA (SKETCHFILENAME) (* rrb " 5-May-86 10:45") + [LAMBDA (SKETCHFILENAME) (* ; "Edited 3-Nov-2025 15:05 by rmk") + (* rrb " 5-May-86 10:45") (COND - ((STRPOS " " SKETCHFILENAME) (* don't put up dummy names that - contain spaces) + ((STRPOS " " SKETCHFILENAME) (* ; + "don't put up dummy names that contain spaces") NIL) - (T (FILENAMELESSVERSION SKETCHFILENAME]) + (T (PACKFILENAME 'VERSION NIL 'BODY SKETCHFILENAME]) (SKETCH.PUT [LAMBDA (FILENAME SKETCH VIEWER REGION SCALE GRID) (* ; "Edited 1-Feb-2022 09:17 by rmk") @@ -640,13 +641,6 @@ To abort loading the new version of Sketch, type '^'."] (GETSKETCHPROP TOSKETCH 'VIEWS]) (PUTSKETCHPROP TOSKETCH SKPROP (GETSKETCHPROP ADDSKETCH SKPROP]) -(FILENAMELESSVERSION - [LAMBDA (FILENAME) (* rrb "29-Jan-86 15:57") - - (* strips the version number off of FILENAME if it has one.) - - (PACKFILENAME (CONS 'VERSION (CONS NIL (UNPACKFILENAME FILENAME]) - (SK.ADD.ELEMENTS.TO.SKETCH [LAMBDA (ELTS SKW) (* rrb "10-Mar-86 16:50") (* adds a list of elements to a sketch) @@ -659,7 +653,9 @@ To abort loading the new version of Sketch, type '^'."] (SK.ADD.ELEMENT ELT SKW]) (SKETCH.SET.A.DEFAULT - [LAMBDA (SKW) (* rrb "14-Jul-86 13:43") + [LAMBDA (SKW) (* ; "Edited 6-Nov-2025 22:34 by rmk") + (* rrb "14-Jul-86 13:43") + (* ; "allows the user to set a default") (* allows the user to set a default) (\CURSOR.IN.MIDDLE.MENU (create MENU ITEMS _ '[(Line SKETCH.SET.BRUSH.SIZE @@ -673,7 +669,8 @@ To abort loading the new version of Sketch, type '^'."] (Add% arrowhead SK.SET.LINE.ARROWHEAD "Sets the arrowhead characteristics of new lines." ) - ("Mouse line specs" SK.SET.LINE.LENGTH.MODE + ("Mouse line specs" SK.SET.LINE.LENGTH.MODE + "Sets whether the lines drawn with the middle mouse button connect to each other." ))) (Arrowhead SK.SET.ARROWHEAD.LENGTH @@ -715,7 +712,8 @@ To abort loading the new version of Sketch, type '^'."] (SUBITEMS ("Clockwise" SK.SET.ARC.DIRECTION.CW "Makes new arcs go around in the clockwise direction" ) - ("Counterclockwise" SK.SET.ARC.DIRECTION.CCW + ("Counterclockwise" SK.SET.ARC.DIRECTION.CCW + "Makes new arcs go around in the counterclockwise direction" ))) ("Input scale" SK.SET.INPUT.SCALE @@ -740,7 +738,8 @@ To abort loading the new version of Sketch, type '^'."] This will be slow for arcs and curves."] CENTERFLG _ T WHENSELECTEDFN _ (FUNCTION SK.POPUP.SELECTIONFN) - MENUFONT _ (SK.FONTNAMELIST (FONTCREATE BOLDFONT]) + MENUFONT _ (FONTPROP (FONTCREATE BOLDFONT) + 'SPEC]) (SK.POPUP.SELECTIONFN [LAMBDA (ITEM MENU) (* rrb " 3-Sep-85 14:27") @@ -1348,12 +1347,13 @@ This will be slow for arcs and curves."] (DEFINEQ (SKETCH.COMMANDMENU - [LAMBDA (ITEMS TITLE) (* rrb "14-Jul-86 13:43") + [LAMBDA (ITEMS TITLE) (* ; "Edited 6-Nov-2025 22:36 by rmk") + (* rrb "14-Jul-86 13:43") (create MENU ITEMS _ ITEMS CENTERFLG _ T WHENSELECTEDFN _ (FUNCTION SKETCHW.SELECTIONFN) - MENUFONT _ (SK.FONTNAMELIST (FONTCREATE BOLDFONT)) + MENUFONT _ (FONTCREATE BOLDFONT) TITLE _ TITLE]) (SKETCH.COMMANDMENU.ITEMS @@ -6657,10 +6657,9 @@ This will be slow for arcs and curves.")) (DEFINEQ (SKETCH.TITLE - [LAMBDA (SKW) (* rrb " 5-May-86 13:19") - - (* gets the title of the sketch being edited in SKW.) - + [LAMBDA (SKW) (* rrb " 5-May-86 13:19") + (* gets the title of the sketch being + edited in SKW.) (fetch (SKETCH SKETCHNAME) of (INSURE.SKETCH SKW]) (SK.SHRINK.ICONCREATE @@ -8594,6 +8593,43 @@ Otherwise, type '^'.") (RPAQQ BackgroundMenu NIL) +(RPAQQ SKETCHFILES (SKETCH SKETCH-OPS SKETCH-ELEMENTS SKETCH-EDIT SKETCH-OBJ SKETCH-BMELT)) +(DEFINEQ + +(UPDATE-SKETCH + [LAMBDA (FILES LDFLG) (* ; "Edited 30-Nov-2025 10:09 by rmk") + (* ; "Edited 9-Mar-2025 19:17 by rmk") + (* ; "Edited 7-Mar-2025 23:40 by rmk") + (* ; "Edited 26-Oct-2022 21:10 by rmk") + (* ; "Edited 16-Feb-2025 11:25 by rmk") + + (* ;; + "Loads compiled TEDITFILES that were compiled on sources different from the currently loaded files.") + + (CL:UNLESS LDFLG + (SETQ LDFLG 'SYSLOAD)) + (for F CF in (OR FILES SKETCHFILES) when (SETQ CF (FINDFILE-WITH-EXTENSIONS F NIL + *COMPILED-EXTENSIONS*)) + unless (thereis LF TCF in LOADEDFILELST first (SETQ TCF (TRUEFILENAME CF)) + suchthat (STRING.EQUAL TCF (TRUEFILENAME LF))) do (LOAD CF LDFLG]) + +(EDIT-SKETCH + [LAMBDA NIL (* ; "Edited 30-Nov-2025 10:10 by rmk") + (* ; "Edited 7-Mar-2025 22:53 by rmk") + (* ; "Edited 3-Jul-2023 13:44 by rmk") + (* ; "Edited 17-Jun-2023 10:00 by rmk") + (* ; "Edited 25-Apr-2023 17:39 by rmk") + (* ; "Edited 26-Oct-2022 21:12 by rmk") + (* ; "Edited 14-Sep-2022 08:37 by rmk") + (BKSYSBUF " ") + (RESETLST + (RESETSAVE LOADDBFLG 'YES) + (UPDATE-SKETCH SKETCHFILES) + (FOR F IN SKETCHFILES DO (LOADFROM F) + (LOADCOMP F))) + (%. ANALYZE ON IN SKETCHFILES]) +) + (FILESLOAD SKETCH-OPS SKETCH-ELEMENTS SKETCH-EDIT SKETCH-OBJ SKETCH-BMELT) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY @@ -8723,21 +8759,6 @@ Otherwise, type '^'.") -(* ; "to correct for a bug in the file package that marks LOADCOMPed file as changed") - - -(UNMARKASCHANGED 'SKETCH 'FILE) - -(UNMARKASCHANGED 'SKETCH-ELEMENTS 'FILE) - -(UNMARKASCHANGED 'SKETCH-OPS 'FILE) - -(UNMARKASCHANGED 'SKETCH-EDIT 'FILE) - -(UNMARKASCHANGED 'SKETCH-OBJ 'FILE) - - - (* ; "add sketch as option to file browser edit command") (DEFINEQ @@ -8768,149 +8789,150 @@ Otherwise, type '^'.") (ADDTOVAR LAMA SK.UNIONREGIONS SKETCH.CREATE) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (22176 85539 (SKETCH 22186 . 24291) (SKETCH.FROM.A.FILE 24293 . 24608) (SKETCHW.CREATE -24610 . 29184) (SKETCH.RESET 29186 . 30708) (SKETCHW.FIG.CHANGED 30710 . 31050) (SK.WINDOW.TITLE 31052 - . 31439) (EDITSLIDE 31441 . 31847) (EDITSKETCH 31849 . 32173) (SK.PUT.ON.FILE 32175 . 33627) ( -SK.OUTPUT.FILE.NAME 33629 . 34003) (SKETCH.PUT 34005 . 36903) (SK.GET.FROM.FILE 36905 . 37798) ( -SK.INCLUDE.FILE 37800 . 40308) (SK.GET.IMAGEOBJ.FROM.FILE 40310 . 42513) (SKETCH.GET 42515 . 42822) ( -ADD.SKETCH.TO.VIEWER 42824 . 45410) (FILENAMELESSVERSION 45412 . 45688) (SK.ADD.ELEMENTS.TO.SKETCH -45690 . 46204) (SKETCH.SET.A.DEFAULT 46206 . 53364) (SK.POPUP.SELECTIONFN 53366 . 53908) ( -GETSKETCHWREGION 53910 . 54116) (SK.ADD.ELEMENT 54118 . 55697) (SK.ADD.PRIORITY.ELEMENT.TO.SKETCH -55699 . 57093) (SK.ELTS.BY.PRIORITY 57095 . 57391) (SK.ORDER.ELEMENTS 57393 . 57660) ( -SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH 57662 . 59156) (SK.ADD.ELEMENTS 59158 . 59682) ( -SK.CHECK.WHENADDEDFN 59684 . 60414) (SK.APPLY.MENU.COMMAND 60416 . 61214) (SK.DELETE.ELEMENT1 61216 . -62794) (SK.MARK.DIRTY 62796 . 63462) (SK.MARK.UNDIRTY 63464 . 63795) (SK.MENU.AND.RETURN.FIELD 63797 - . 64462) (SKETCH.SET.BRUSH.SHAPE 64464 . 65049) (SKETCH.SET.BRUSH.SIZE 65051 . 65557) ( -SKETCHW.CLOSEFN 65559 . 67350) (SK.CONFIRM.DESTRUCTION 67352 . 68351) (SKETCHW.OUTFN 68353 . 68617) ( -SKETCHW.REOPENFN 68619 . 69031) (MAKE.LOCAL.SKETCH 69033 . 69763) (MAP.SKETCHSPEC.INTO.VIEWER 69765 . -70975) (SKETCHW.REPAINTFN 70977 . 71805) (SKETCHW.REPAINTFN1 71807 . 72746) (SK.DRAWFIGURE.IF 72748 . -73270) (SKETCHW.SCROLLFN 73272 . 77465) (SKETCHW.RESHAPEFN 77467 . 79725) (SK.UPDATE.EVENT.SELECTION -79727 . 81782) (LIGHTGRAYWINDOW 81784 . 81947) (SK.ADD.SPACES 81949 . 82695) (SK.SKETCH.MENU 82697 . -83019) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN 83021 . 83873) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 83875 . 84835) - (SK.RETURN.TTY 84837 . 85205) (SK.TAKE.TTY 85207 . 85537)) (85593 108921 (SKETCH.COMMANDMENU 85603 . -85940) (SKETCH.COMMANDMENU.ITEMS 85942 . 106025) (CREATE.SKETCHW.COMMANDMENU 106027 . 106447) ( -SKETCHW.SELECTIONFN 106449 . 107552) (SKETCH.MONITORLOCK 107554 . 108025) (SK.EVAL.AS.PROCESS 108027 - . 108640) (SK.EVAL.WITH.LOCK 108642 . 108919)) (108922 116726 (SK.FIX.MENU 108932 . 110026) ( -SK.SET.UP.MENUS 110028 . 112329) (SK.INSURE.HAS.MENU 112331 . 112993) (SK.CREATE.STANDARD.MENU 112995 - . 113440) (SK.ADD.ITEM.TO.MENU 113442 . 114117) (SK.GET.VIEWER.POPUP.MENU 114119 . 116320) ( -SK.CLEAR.POPUP.MENU 116322 . 116724)) (116782 125604 (SKETCH.CREATE 116792 . 117578) (GETSKETCHPROP -117580 . 120637) (PUTSKETCHPROP 120639 . 124571) (CREATE.DEFAULT.SKETCH.CONTEXT 124573 . 125602)) ( -125770 148666 (SK.COPY.BUTTONEVENTFN 125780 . 137008) (SK.BUTTONEVENT.MARK 137010 . 137393) ( -SK.BUILD.IMAGEOBJ 137395 . 147310) (SK.BUTTONEVENT.OVERP 147312 . 147935) (SK.BUTTONEVENT.SAME.KEYS -147937 . 148664)) (148945 174760 (SK.SEL.AND.CHANGE 148955 . 149247) (SK.CHECK.WHENCHANGEDFN 149249 . -149955) (SK.CHECK.PRECHANGEFN 149957 . 150558) (SK.CHANGE.ELT 150560 . 150752) (SK.CHANGE.THING 150754 - . 152005) (SKETCH.CHANGE.ELEMENTS 152007 . 153190) (SK.APPLY.SINGLE.CHANGEFN 153192 . 153765) ( -SK.DO.CHANGESPECS 153767 . 155426) (SK.VIEWER.FROM.SKETCH.ARG 155428 . 155870) (SK.DO.CHANGESPEC1 -155872 . 157747) (SK.CHANGEFN 157749 . 158329) (SK.READCHANGEFN 158331 . 158790) (SK.DEFAULT.CHANGEFN -158792 . 161264) (CHANGEABLEFIELDITEMS 161266 . 161913) (SK.APPLY.CHANGE.COMMAND 161915 . 162532) ( -SK.DO.AND.RECORD.CHANGES 162534 . 163931) (SK.APPLY.CHANGE.COMMAND1 163933 . 165421) ( -SK.ELEMENTS.CHANGEFN 165423 . 167747) (READ.POINT.TO.ADD 167749 . 168693) (GLOBAL.KNOT.FROM.LOCAL -168695 . 169155) (SK.ADD.KNOT.TO.ELEMENT 169157 . 170101) (SK.GROUP.CHANGEFN 170103 . 171315) ( -SK.GROUP.CHANGEFN1 171317 . 174758)) (174927 188660 (ADD.ELEMENT.TO.SKETCH 174937 . 176643) ( -ADD.SKETCH.VIEWER 176645 . 177313) (REMOVE.SKETCH.VIEWER 177315 . 177928) (ALL.SKETCH.VIEWERS 177930 - . 178170) (SKETCH.ALL.VIEWERS 178172 . 178432) (VIEWER.BUCKET 178434 . 178585) (ELT.INSIDE.REGION? -178587 . 178914) (ELT.INSIDE.SKWP 178916 . 179207) (SCALE.FROM.SKW 179209 . 179459) ( -SK.ADDELT.TO.WINDOW 179461 . 180321) (SK.CALC.REGION.VIEWED 180323 . 180701) (SK.DRAWFIGURE 180703 . -181992) (SK.DRAWFIGURE1 181994 . 182378) (SK.LOCAL.FROM.GLOBAL 182380 . 183615) (SKETCH.REGION.VIEWED -183617 . 186304) (SKETCH.VIEW.FROM.NAME 186306 . 186736) (SK.UPDATE.REGION.VIEWED 186738 . 187130) ( -SKETCH.ADD.AND.DISPLAY 187132 . 187540) (SKETCH.ADD.AND.DISPLAY1 187542 . 187980) (SK.ADD.ITEM 187982 - . 188314) (SKETCHW.ADD.INSTANCE 188316 . 188658)) (188701 201889 (SK.SEL.AND.DELETE 188711 . 189099) -(SK.ERASE.AND.DELETE.ITEM 189101 . 189520) (REMOVE.ELEMENT.FROM.SKETCH 189522 . 190633) ( -SK.DELETE.ELEMENT 190635 . 191193) (SK.DELETE.ELEMENT2 191195 . 191856) (SK.DELETE.KNOT 191858 . -192149) (SK.SEL.AND.DELETE.KNOT 192151 . 193276) (SK.DELETE.ELEMENT.KNOT 193278 . 196485) ( -SK.CHECK.WHENDELETEDFN 196487 . 197267) (SK.CHECK.PREEDITFN 197269 . 197753) ( -SK.CHECK.END.INITIAL.EDIT 197755 . 198289) (SK.CHECK.WHENPOINTDELETEDFN 198291 . 199087) (SK.ERASE.ELT - 199089 . 199425) (SK.DELETE.ELT 199427 . 199802) (SK.DELETE.ITEM 199804 . 200212) (DELFROMTCONC -200214 . 201887)) (201928 215762 (SK.COPY.ELT 201938 . 202308) (SK.SEL.AND.COPY 202310 . 202693) ( -SK.COPY.ELEMENTS 202695 . 208323) (SK.ADD.COPY.OF.ELEMENTS 208325 . 210092) ( -SK.GLOBAL.FROM.LOCAL.ELEMENTS 210094 . 210334) (SK.COPY.ITEM 210336 . 211133) (SK.INSERT.SKETCH 211135 - . 215760)) (215802 245823 (SK.MOVE.ELT 215812 . 216087) (SK.MOVE.ELT.OR.PT 216089 . 216402) ( -SK.APPLY.DEFAULT.MOVE 216404 . 216838) (SK.SEL.AND.MOVE 216840 . 217387) (SK.MOVE.ELEMENTS 217389 . -228261) (SKETCH.MOVE.ELEMENTS 228263 . 230194) (SKETCH.COPY.ELEMENTS 230196 . 232243) ( -\SKETCH.COPY.ELEMENT 232245 . 232970) (SK.TRANSLATE.ELEMENT 232972 . 233455) (SK.COPY.GLOBAL.ELEMENT -233457 . 233668) (SK.MAKE.ELEMENT.MOVE.ARG 233670 . 234290) (SK.MAKE.ELEMENTS.MOVE.ARG 234292 . 234814 -) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 234816 . 235885) (SK.SHOW.FIG.FROM.INFO 235887 . 236255) ( -SK.MOVE.THING 236257 . 237163) (UPDATE.ELEMENT.IN.SKETCH 237165 . 239220) (SK.UPDATE.ELEMENT 239222 . -240781) (SK.UPDATE.ELEMENTS 240783 . 241502) (SK.UPDATE.ELEMENT1 241504 . 245404) ( -SK.MOVE.ELEMENT.POINT 245406 . 245821)) (245886 268175 (SK.MOVE.POINTS 245896 . 246183) ( -SK.SEL.AND.MOVE.POINTS 246185 . 246490) (SK.DO.MOVE.ELEMENT.POINTS 246492 . 255149) ( -SK.MOVE.ITEM.POINTS 255151 . 256822) (SK.TRANSLATEPTSFN 256824 . 257208) (SK.TRANSLATE.POINTS 257210 - . 258111) (SK.SELECT.MULTIPLE.POINTS 258113 . 263753) (SK.CONTROL.POINTS.IN.REGION 263755 . 265176) ( -SK.ADD.PT.SELECTION 265178 . 265642) (SK.REMOVE.PT.SELECTION 265644 . 266261) (SK.ADD.POINT 266263 . -266886) (SK.ELTS.CONTAINING.PTS 266888 . 267513) (SK.HOTSPOTS.NOT.ON.LIST 267515 . 268173)) (268333 -271129 (SK.SET.MOVE.MODE 268343 . 269014) (SK.SET.MOVE.MODE.POINTS 269016 . 269355) ( -SK.SET.MOVE.MODE.ELEMENTS 269357 . 269701) (SK.SET.MOVE.MODE.COMBINED 269703 . 270053) (READMOVEMODE -270055 . 271127)) (271130 289885 (SK.ALIGN.POINTS 271140 . 271430) (SK.SEL.AND.ALIGN.POINTS 271432 . -271741) (SK.ALIGN.POINTS.LEFT 271743 . 272046) (SK.ALIGN.POINTS.RIGHT 272048 . 272353) ( -SK.ALIGN.POINTS.TOP 272355 . 272656) (SK.ALIGN.POINTS.BOTTOM 272658 . 272965) ( -SK.EVEN.SPACE.POINTS.IN.X 272967 . 273287) (SK.EVEN.SPACE.POINTS.IN.Y 273289 . 273609) ( -SK.DO.ALIGN.POINTS 273611 . 284233) (SK.NTH.CONTROL.POINT 284235 . 284696) ( -SK.GET.SELECTED.ELEMENT.STRUCTURE 284698 . 285364) (SK.CORRESPONDING.CONTROL.PT 285366 . 285920) ( -SK.CONTROL.POINT.NUMBER 285922 . 286292) (SK.DO.ALIGN.SETVALUE 286294 . 289883)) (289949 303381 ( -SKETCH.CREATE.GROUP 289959 . 290448) (SK.CREATE.GROUP1 290450 . 290997) (SK.UPDATE.GROUP.AFTER.CHANGE -290999 . 291788) (SK.GROUP.ELTS 291790 . 292071) (SK.SEL.AND.GROUP 292073 . 292459) (SK.GROUP.ELEMENTS - 292461 . 294110) (SK.UNGROUP.ELT 294112 . 294396) (SK.SEL.AND.UNGROUP 294398 . 296067) ( -SK.UNGROUP.ELEMENT 296069 . 297005) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 297007 . 297929) ( -SK.LOCAL.REGION.OF.LOCAL.ELEMENTS 297931 . 298942) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 298944 . -300284) (SK.UNIONREGIONS 300286 . 302652) (SKETCH.REGION.OF.SKETCH 302654 . 303070) (SK.FLASHREGION -303072 . 303379)) (303382 316853 (INIT.GROUP.ELEMENT 303392 . 304264) (GROUP.DRAWFN 304266 . 304716) ( -GROUP.EXPANDFN 304718 . 306281) (GROUP.INSIDEFN 306283 . 306692) (GROUP.REGIONFN 306694 . 307089) ( -GROUP.GLOBALREGIONFN 307091 . 307409) (GROUP.TRANSLATEFN 307411 . 309443) (GROUP.TRANSFORMFN 309445 . -312925) (GROUP.READCHANGEFN 312927 . 316851)) (316854 317862 (REGION.CENTER 316864 . 317465) ( -REMOVE.LAST 317467 . 317860)) (317915 323022 (SK.MOVE.GROUP.CONTROL.PT 317925 . 318216) ( -SK.SEL.AND.MOVE.CONTROL.PT 318218 . 319622) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT 319624 . 321697) ( -SK.READ.NEW.GROUP.CONTROL.PT 321699 . 323020)) (323281 327905 (SK.DO.GROUP 323291 . 324743) ( -SK.CHECK.WHENGROUPEDFN 324745 . 325455) (SK.DO.UNGROUP 325457 . 326662) (SK.CHECK.WHENUNGROUPEDFN -326664 . 327251) (SK.GROUP.UNDO 327253 . 327576) (SK.UNGROUP.UNDO 327578 . 327903)) (328146 333068 ( -SK.FREEZE.ELTS 328156 . 328440) (SK.SEL.AND.FREEZE 328442 . 328832) (SK.FREEZE.ELEMENTS 328834 . -329385) (SK.UNFREEZE.ELT 329387 . 329676) (SK.SEL.AND.UNFREEZE 329678 . 331214) (SK.UNFREEZE.ELEMENTS -331216 . 331775) (SK.FREEZE.UNDO 331777 . 332022) (SK.UNFREEZE.UNDO 332024 . 332271) (SK.DO.FREEZE -332273 . 332666) (SK.DO.UNFREEZE 332668 . 333066)) (333298 343108 (SKETCH.ELEMENTS.OF.SKETCH 333308 . -334143) (SKETCH.LIST.OF.ELEMENTS 334145 . 334863) (SKETCH.ADD.ELEMENT 334865 . 335940) ( -SKETCH.DELETE.ELEMENT 335942 . 337674) (DELFROMGROUPELT 337676 . 338476) (SKETCH.ELEMENT.TYPE 338478 - . 338827) (SKETCH.ELEMENT.CHANGED 338829 . 340397) (SK.ELEMENT.CHANGED1 340399 . 341050) ( -SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 341052 . 343106)) (343162 347774 (INSURE.SKETCH 343172 . 345787) - (LOCALSPECS.FROM.VIEWER 345789 . 346149) (SK.LOCAL.ELT.FROM.GLOBALPART 346151 . 346619) ( -SKETCH.FROM.VIEWER 346621 . 346855) (INSPECT.SKETCH 346857 . 347182) (ELT.INSIDE.SKETCHWP 347184 . -347457) (SK.INSIDE.REGION 347459 . 347772)) (347775 352105 (MAPSKETCHSPECS 347785 . 348406) ( -MAPCOLLECTSKETCHSPECS 348408 . 349157) (MAPSKETCHSPECSUNTIL 349159 . 349967) (MAPGLOBALSKETCHSPECS -349969 . 350670) (MAPGLOBALSKETCHELEMENTS 350672 . 352103)) (352167 378059 (SK.ADD.SELECTION 352177 . -352917) (SK.COPY.INSERTFN 352919 . 356550) (SCREENELEMENTP 356552 . 357025) (SK.ITEM.REGION 357027 . -357514) (SK.ELEMENT.GLOBAL.REGION 357516 . 358044) (SK.LOCAL.ITEMS.IN.REGION 358046 . 360025) ( -SK.REGIONFN 360027 . 360349) (SK.GLOBAL.REGIONFN 360351 . 360709) (SK.REMOVE.SELECTION 360711 . 361439 -) (SK.SELECT.MULTIPLE.ITEMS 361441 . 371883) (SKETCH.GET.ELEMENTS 371885 . 373308) (SK.PUT.MARKS.UP -373310 . 373649) (SK.TAKE.MARKS.DOWN 373651 . 373990) (SK.TRANSLATE.GLOBALPART 373992 . 376119) ( -SK.TRANSLATE.ITEM 376121 . 377048) (SK.TRANSLATEFN 377050 . 377246) (TRANSLATE.SKETCH 377248 . 378057) -) (378325 381232 (SK.INPUT.SCALE 378335 . 379182) (SK.UPDATE.SKETCHCONTEXT 379184 . 379781) ( -SK.SET.INPUT.SCALE 379783 . 380432) (SK.SET.INPUT.SCALE.CURRENT 380434 . 380725) ( -SK.SET.INPUT.SCALE.VALUE 380727 . 381230)) (381283 383195 (SK.SET.FEEDBACK.MODE 381293 . 382599) ( -SK.SET.FEEDBACK.POINT 382601 . 382769) (SK.SET.FEEDBACK.VERBOSE 382771 . 382940) ( -SK.SET.FEEDBACK.ALWAYS 382942 . 383193)) (383346 384623 (SKETCH.TITLE 383356 . 383619) ( -SK.SHRINK.ICONCREATE 383621 . 384621)) (390313 393127 (READBRUSHSHAPE 390323 . 390782) (READ.FUNCTION -390784 . 391299) (READBRUSHSIZE 391301 . 391759) (READANGLE 391761 . 392253) (READARCDIRECTION 392255 - . 393125)) (393128 403539 (SK.CHANGE.DASHING 393138 . 397086) (READ.AND.SAVE.NEW.DASHING 397088 . -398856) (READ.NEW.DASHING 398858 . 400598) (READ.DASHING.CHANGE 400600 . 402075) (SK.CACHE.DASHING -402077 . 403079) (SK.DASHING.LABEL 403081 . 403537)) (403540 407245 (READ.FILLING.CHANGE 403550 . -405531) (SK.CACHE.FILLING 405533 . 406251) (READ.AND.SAVE.NEW.FILLING 406253 . 406851) ( -SK.FILLING.LABEL 406853 . 407243)) (407629 443882 (SK.GETGLOBALPOSITION 407639 . 407944) ( -SKETCH.TRACK.ELEMENTS 407946 . 411466) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS 411468 . 412027) ( -MAP.SKETCH.ELEMENTS.INTO.VIEWER 412029 . 412421) (MAP.GLOBAL.POSITION.INTO.VIEWER 412423 . 412803) ( -SKETCH.TO.VIEWER.POSITION 412805 . 413164) (SKETCH.TRACK.IMAGE 413166 . 414020) (SK.TRACK.IMAGE1 -414022 . 415434) (MAP.VIEWER.XY.INTO.GLOBAL 415436 . 416430) (SK.SET.POSITION 416432 . 416768) ( -MAP.VIEWER.PT.INTO.GLOBAL 416770 . 417876) (VIEWER.TO.SKETCH.POSITION 417878 . 418513) ( -SK.INSURE.SCALE 418515 . 418775) (SKETCH.TO.VIEWER.REGION 418777 . 419583) (VIEWER.TO.SKETCH.REGION -419585 . 419923) (SK.READ.POINT.WITH.FEEDBACK 419925 . 430928) (SKETCH.GET.POSITION 430930 . 432810) ( -\CLOBBER.POSITION 432812 . 433260) (NEAREST.HOT.SPOT 433262 . 434790) (GETWREGION 434792 . 435553) ( -GET.BITMAP.POSITION 435555 . 436339) (SK.TRACK.BITMAP1 436341 . 443880)) (444451 475337 ( -SK.BRING.UP.POSITION.PAD 444461 . 450321) (SK.PAD.READER.POSITION 450323 . 451972) ( -SK.POSITION.READER.REPAINTFN 451974 . 453758) (SK.POSITION.PAD.FROM.VIEWER 453760 . 455102) ( -SK.INIT.POSITION.NUMBER.PAD.MENU 455104 . 455454) (SK.READ.POSITION.PAD.HANDLER 455456 . 461188) ( -DISPLAY.POSITION.READER.TOTAL 461190 . 463488) (POSITION.PAD.READER.HANDLER 463490 . 471533) ( -POSITIONPAD.HELDFN 471535 . 473019) (\POSITION.PAD.ADD.DIGIT.MENU 473021 . 474600) ( -\POSITION.READER.NUMBERPAD 474602 . 475335)) (476963 479641 (SK.DRAWFN 476973 . 477339) ( -SK.TRANSFORMFN 477341 . 477722) (SK.EXPANDFN 477724 . 478001) (SK.INPUT 478003 . 478384) (SK.INSIDEFN -478386 . 479026) (SK.UPDATEFN 479028 . 479639)) (485309 489254 (SK.CHECK.SKETCH.VERSION 485319 . -486559) (SK.INSURE.RECORD.LENGTH 486561 . 488044) (SK.INSURE.HAS.LENGTH 488046 . 488784) ( -SK.RECORD.LENGTH 488786 . 488960) (SK.SET.RECORD.LENGTHS 488962 . 489252)) (489999 490886 ( -SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER 490009 . 490884))))) + (FILEMAP (NIL (21911 85500 (SKETCH 21921 . 24026) (SKETCH.FROM.A.FILE 24028 . 24343) (SKETCHW.CREATE +24345 . 28919) (SKETCH.RESET 28921 . 30443) (SKETCHW.FIG.CHANGED 30445 . 30785) (SK.WINDOW.TITLE 30787 + . 31174) (EDITSLIDE 31176 . 31582) (EDITSKETCH 31584 . 31908) (SK.PUT.ON.FILE 31910 . 33362) ( +SK.OUTPUT.FILE.NAME 33364 . 33849) (SKETCH.PUT 33851 . 36749) (SK.GET.FROM.FILE 36751 . 37644) ( +SK.INCLUDE.FILE 37646 . 40154) (SK.GET.IMAGEOBJ.FROM.FILE 40156 . 42359) (SKETCH.GET 42361 . 42668) ( +ADD.SKETCH.TO.VIEWER 42670 . 45256) (SK.ADD.ELEMENTS.TO.SKETCH 45258 . 45772) (SKETCH.SET.A.DEFAULT +45774 . 53325) (SK.POPUP.SELECTIONFN 53327 . 53869) (GETSKETCHWREGION 53871 . 54077) (SK.ADD.ELEMENT +54079 . 55658) (SK.ADD.PRIORITY.ELEMENT.TO.SKETCH 55660 . 57054) (SK.ELTS.BY.PRIORITY 57056 . 57352) ( +SK.ORDER.ELEMENTS 57354 . 57621) (SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH 57623 . 59117) ( +SK.ADD.ELEMENTS 59119 . 59643) (SK.CHECK.WHENADDEDFN 59645 . 60375) (SK.APPLY.MENU.COMMAND 60377 . +61175) (SK.DELETE.ELEMENT1 61177 . 62755) (SK.MARK.DIRTY 62757 . 63423) (SK.MARK.UNDIRTY 63425 . 63756 +) (SK.MENU.AND.RETURN.FIELD 63758 . 64423) (SKETCH.SET.BRUSH.SHAPE 64425 . 65010) ( +SKETCH.SET.BRUSH.SIZE 65012 . 65518) (SKETCHW.CLOSEFN 65520 . 67311) (SK.CONFIRM.DESTRUCTION 67313 . +68312) (SKETCHW.OUTFN 68314 . 68578) (SKETCHW.REOPENFN 68580 . 68992) (MAKE.LOCAL.SKETCH 68994 . 69724 +) (MAP.SKETCHSPEC.INTO.VIEWER 69726 . 70936) (SKETCHW.REPAINTFN 70938 . 71766) (SKETCHW.REPAINTFN1 +71768 . 72707) (SK.DRAWFIGURE.IF 72709 . 73231) (SKETCHW.SCROLLFN 73233 . 77426) (SKETCHW.RESHAPEFN +77428 . 79686) (SK.UPDATE.EVENT.SELECTION 79688 . 81743) (LIGHTGRAYWINDOW 81745 . 81908) ( +SK.ADD.SPACES 81910 . 82656) (SK.SKETCH.MENU 82658 . 82980) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN 82982 . +83834) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 83836 . 84796) (SK.RETURN.TTY 84798 . 85166) (SK.TAKE.TTY +85168 . 85498)) (85554 108969 (SKETCH.COMMANDMENU 85564 . 85988) (SKETCH.COMMANDMENU.ITEMS 85990 . +106073) (CREATE.SKETCHW.COMMANDMENU 106075 . 106495) (SKETCHW.SELECTIONFN 106497 . 107600) ( +SKETCH.MONITORLOCK 107602 . 108073) (SK.EVAL.AS.PROCESS 108075 . 108688) (SK.EVAL.WITH.LOCK 108690 . +108967)) (108970 116774 (SK.FIX.MENU 108980 . 110074) (SK.SET.UP.MENUS 110076 . 112377) ( +SK.INSURE.HAS.MENU 112379 . 113041) (SK.CREATE.STANDARD.MENU 113043 . 113488) (SK.ADD.ITEM.TO.MENU +113490 . 114165) (SK.GET.VIEWER.POPUP.MENU 114167 . 116368) (SK.CLEAR.POPUP.MENU 116370 . 116772)) ( +116830 125652 (SKETCH.CREATE 116840 . 117626) (GETSKETCHPROP 117628 . 120685) (PUTSKETCHPROP 120687 . +124619) (CREATE.DEFAULT.SKETCH.CONTEXT 124621 . 125650)) (125818 148714 (SK.COPY.BUTTONEVENTFN 125828 + . 137056) (SK.BUTTONEVENT.MARK 137058 . 137441) (SK.BUILD.IMAGEOBJ 137443 . 147358) ( +SK.BUTTONEVENT.OVERP 147360 . 147983) (SK.BUTTONEVENT.SAME.KEYS 147985 . 148712)) (148993 174808 ( +SK.SEL.AND.CHANGE 149003 . 149295) (SK.CHECK.WHENCHANGEDFN 149297 . 150003) (SK.CHECK.PRECHANGEFN +150005 . 150606) (SK.CHANGE.ELT 150608 . 150800) (SK.CHANGE.THING 150802 . 152053) ( +SKETCH.CHANGE.ELEMENTS 152055 . 153238) (SK.APPLY.SINGLE.CHANGEFN 153240 . 153813) (SK.DO.CHANGESPECS +153815 . 155474) (SK.VIEWER.FROM.SKETCH.ARG 155476 . 155918) (SK.DO.CHANGESPEC1 155920 . 157795) ( +SK.CHANGEFN 157797 . 158377) (SK.READCHANGEFN 158379 . 158838) (SK.DEFAULT.CHANGEFN 158840 . 161312) ( +CHANGEABLEFIELDITEMS 161314 . 161961) (SK.APPLY.CHANGE.COMMAND 161963 . 162580) ( +SK.DO.AND.RECORD.CHANGES 162582 . 163979) (SK.APPLY.CHANGE.COMMAND1 163981 . 165469) ( +SK.ELEMENTS.CHANGEFN 165471 . 167795) (READ.POINT.TO.ADD 167797 . 168741) (GLOBAL.KNOT.FROM.LOCAL +168743 . 169203) (SK.ADD.KNOT.TO.ELEMENT 169205 . 170149) (SK.GROUP.CHANGEFN 170151 . 171363) ( +SK.GROUP.CHANGEFN1 171365 . 174806)) (174975 188708 (ADD.ELEMENT.TO.SKETCH 174985 . 176691) ( +ADD.SKETCH.VIEWER 176693 . 177361) (REMOVE.SKETCH.VIEWER 177363 . 177976) (ALL.SKETCH.VIEWERS 177978 + . 178218) (SKETCH.ALL.VIEWERS 178220 . 178480) (VIEWER.BUCKET 178482 . 178633) (ELT.INSIDE.REGION? +178635 . 178962) (ELT.INSIDE.SKWP 178964 . 179255) (SCALE.FROM.SKW 179257 . 179507) ( +SK.ADDELT.TO.WINDOW 179509 . 180369) (SK.CALC.REGION.VIEWED 180371 . 180749) (SK.DRAWFIGURE 180751 . +182040) (SK.DRAWFIGURE1 182042 . 182426) (SK.LOCAL.FROM.GLOBAL 182428 . 183663) (SKETCH.REGION.VIEWED +183665 . 186352) (SKETCH.VIEW.FROM.NAME 186354 . 186784) (SK.UPDATE.REGION.VIEWED 186786 . 187178) ( +SKETCH.ADD.AND.DISPLAY 187180 . 187588) (SKETCH.ADD.AND.DISPLAY1 187590 . 188028) (SK.ADD.ITEM 188030 + . 188362) (SKETCHW.ADD.INSTANCE 188364 . 188706)) (188749 201937 (SK.SEL.AND.DELETE 188759 . 189147) +(SK.ERASE.AND.DELETE.ITEM 189149 . 189568) (REMOVE.ELEMENT.FROM.SKETCH 189570 . 190681) ( +SK.DELETE.ELEMENT 190683 . 191241) (SK.DELETE.ELEMENT2 191243 . 191904) (SK.DELETE.KNOT 191906 . +192197) (SK.SEL.AND.DELETE.KNOT 192199 . 193324) (SK.DELETE.ELEMENT.KNOT 193326 . 196533) ( +SK.CHECK.WHENDELETEDFN 196535 . 197315) (SK.CHECK.PREEDITFN 197317 . 197801) ( +SK.CHECK.END.INITIAL.EDIT 197803 . 198337) (SK.CHECK.WHENPOINTDELETEDFN 198339 . 199135) (SK.ERASE.ELT + 199137 . 199473) (SK.DELETE.ELT 199475 . 199850) (SK.DELETE.ITEM 199852 . 200260) (DELFROMTCONC +200262 . 201935)) (201976 215810 (SK.COPY.ELT 201986 . 202356) (SK.SEL.AND.COPY 202358 . 202741) ( +SK.COPY.ELEMENTS 202743 . 208371) (SK.ADD.COPY.OF.ELEMENTS 208373 . 210140) ( +SK.GLOBAL.FROM.LOCAL.ELEMENTS 210142 . 210382) (SK.COPY.ITEM 210384 . 211181) (SK.INSERT.SKETCH 211183 + . 215808)) (215850 245871 (SK.MOVE.ELT 215860 . 216135) (SK.MOVE.ELT.OR.PT 216137 . 216450) ( +SK.APPLY.DEFAULT.MOVE 216452 . 216886) (SK.SEL.AND.MOVE 216888 . 217435) (SK.MOVE.ELEMENTS 217437 . +228309) (SKETCH.MOVE.ELEMENTS 228311 . 230242) (SKETCH.COPY.ELEMENTS 230244 . 232291) ( +\SKETCH.COPY.ELEMENT 232293 . 233018) (SK.TRANSLATE.ELEMENT 233020 . 233503) (SK.COPY.GLOBAL.ELEMENT +233505 . 233716) (SK.MAKE.ELEMENT.MOVE.ARG 233718 . 234338) (SK.MAKE.ELEMENTS.MOVE.ARG 234340 . 234862 +) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 234864 . 235933) (SK.SHOW.FIG.FROM.INFO 235935 . 236303) ( +SK.MOVE.THING 236305 . 237211) (UPDATE.ELEMENT.IN.SKETCH 237213 . 239268) (SK.UPDATE.ELEMENT 239270 . +240829) (SK.UPDATE.ELEMENTS 240831 . 241550) (SK.UPDATE.ELEMENT1 241552 . 245452) ( +SK.MOVE.ELEMENT.POINT 245454 . 245869)) (245934 268223 (SK.MOVE.POINTS 245944 . 246231) ( +SK.SEL.AND.MOVE.POINTS 246233 . 246538) (SK.DO.MOVE.ELEMENT.POINTS 246540 . 255197) ( +SK.MOVE.ITEM.POINTS 255199 . 256870) (SK.TRANSLATEPTSFN 256872 . 257256) (SK.TRANSLATE.POINTS 257258 + . 258159) (SK.SELECT.MULTIPLE.POINTS 258161 . 263801) (SK.CONTROL.POINTS.IN.REGION 263803 . 265224) ( +SK.ADD.PT.SELECTION 265226 . 265690) (SK.REMOVE.PT.SELECTION 265692 . 266309) (SK.ADD.POINT 266311 . +266934) (SK.ELTS.CONTAINING.PTS 266936 . 267561) (SK.HOTSPOTS.NOT.ON.LIST 267563 . 268221)) (268381 +271177 (SK.SET.MOVE.MODE 268391 . 269062) (SK.SET.MOVE.MODE.POINTS 269064 . 269403) ( +SK.SET.MOVE.MODE.ELEMENTS 269405 . 269749) (SK.SET.MOVE.MODE.COMBINED 269751 . 270101) (READMOVEMODE +270103 . 271175)) (271178 289933 (SK.ALIGN.POINTS 271188 . 271478) (SK.SEL.AND.ALIGN.POINTS 271480 . +271789) (SK.ALIGN.POINTS.LEFT 271791 . 272094) (SK.ALIGN.POINTS.RIGHT 272096 . 272401) ( +SK.ALIGN.POINTS.TOP 272403 . 272704) (SK.ALIGN.POINTS.BOTTOM 272706 . 273013) ( +SK.EVEN.SPACE.POINTS.IN.X 273015 . 273335) (SK.EVEN.SPACE.POINTS.IN.Y 273337 . 273657) ( +SK.DO.ALIGN.POINTS 273659 . 284281) (SK.NTH.CONTROL.POINT 284283 . 284744) ( +SK.GET.SELECTED.ELEMENT.STRUCTURE 284746 . 285412) (SK.CORRESPONDING.CONTROL.PT 285414 . 285968) ( +SK.CONTROL.POINT.NUMBER 285970 . 286340) (SK.DO.ALIGN.SETVALUE 286342 . 289931)) (289997 303429 ( +SKETCH.CREATE.GROUP 290007 . 290496) (SK.CREATE.GROUP1 290498 . 291045) (SK.UPDATE.GROUP.AFTER.CHANGE +291047 . 291836) (SK.GROUP.ELTS 291838 . 292119) (SK.SEL.AND.GROUP 292121 . 292507) (SK.GROUP.ELEMENTS + 292509 . 294158) (SK.UNGROUP.ELT 294160 . 294444) (SK.SEL.AND.UNGROUP 294446 . 296115) ( +SK.UNGROUP.ELEMENT 296117 . 297053) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 297055 . 297977) ( +SK.LOCAL.REGION.OF.LOCAL.ELEMENTS 297979 . 298990) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 298992 . +300332) (SK.UNIONREGIONS 300334 . 302700) (SKETCH.REGION.OF.SKETCH 302702 . 303118) (SK.FLASHREGION +303120 . 303427)) (303430 316901 (INIT.GROUP.ELEMENT 303440 . 304312) (GROUP.DRAWFN 304314 . 304764) ( +GROUP.EXPANDFN 304766 . 306329) (GROUP.INSIDEFN 306331 . 306740) (GROUP.REGIONFN 306742 . 307137) ( +GROUP.GLOBALREGIONFN 307139 . 307457) (GROUP.TRANSLATEFN 307459 . 309491) (GROUP.TRANSFORMFN 309493 . +312973) (GROUP.READCHANGEFN 312975 . 316899)) (316902 317910 (REGION.CENTER 316912 . 317513) ( +REMOVE.LAST 317515 . 317908)) (317963 323070 (SK.MOVE.GROUP.CONTROL.PT 317973 . 318264) ( +SK.SEL.AND.MOVE.CONTROL.PT 318266 . 319670) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT 319672 . 321745) ( +SK.READ.NEW.GROUP.CONTROL.PT 321747 . 323068)) (323329 327953 (SK.DO.GROUP 323339 . 324791) ( +SK.CHECK.WHENGROUPEDFN 324793 . 325503) (SK.DO.UNGROUP 325505 . 326710) (SK.CHECK.WHENUNGROUPEDFN +326712 . 327299) (SK.GROUP.UNDO 327301 . 327624) (SK.UNGROUP.UNDO 327626 . 327951)) (328194 333116 ( +SK.FREEZE.ELTS 328204 . 328488) (SK.SEL.AND.FREEZE 328490 . 328880) (SK.FREEZE.ELEMENTS 328882 . +329433) (SK.UNFREEZE.ELT 329435 . 329724) (SK.SEL.AND.UNFREEZE 329726 . 331262) (SK.UNFREEZE.ELEMENTS +331264 . 331823) (SK.FREEZE.UNDO 331825 . 332070) (SK.UNFREEZE.UNDO 332072 . 332319) (SK.DO.FREEZE +332321 . 332714) (SK.DO.UNFREEZE 332716 . 333114)) (333346 343156 (SKETCH.ELEMENTS.OF.SKETCH 333356 . +334191) (SKETCH.LIST.OF.ELEMENTS 334193 . 334911) (SKETCH.ADD.ELEMENT 334913 . 335988) ( +SKETCH.DELETE.ELEMENT 335990 . 337722) (DELFROMGROUPELT 337724 . 338524) (SKETCH.ELEMENT.TYPE 338526 + . 338875) (SKETCH.ELEMENT.CHANGED 338877 . 340445) (SK.ELEMENT.CHANGED1 340447 . 341098) ( +SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 341100 . 343154)) (343210 347822 (INSURE.SKETCH 343220 . 345835) + (LOCALSPECS.FROM.VIEWER 345837 . 346197) (SK.LOCAL.ELT.FROM.GLOBALPART 346199 . 346667) ( +SKETCH.FROM.VIEWER 346669 . 346903) (INSPECT.SKETCH 346905 . 347230) (ELT.INSIDE.SKETCHWP 347232 . +347505) (SK.INSIDE.REGION 347507 . 347820)) (347823 352153 (MAPSKETCHSPECS 347833 . 348454) ( +MAPCOLLECTSKETCHSPECS 348456 . 349205) (MAPSKETCHSPECSUNTIL 349207 . 350015) (MAPGLOBALSKETCHSPECS +350017 . 350718) (MAPGLOBALSKETCHELEMENTS 350720 . 352151)) (352215 378107 (SK.ADD.SELECTION 352225 . +352965) (SK.COPY.INSERTFN 352967 . 356598) (SCREENELEMENTP 356600 . 357073) (SK.ITEM.REGION 357075 . +357562) (SK.ELEMENT.GLOBAL.REGION 357564 . 358092) (SK.LOCAL.ITEMS.IN.REGION 358094 . 360073) ( +SK.REGIONFN 360075 . 360397) (SK.GLOBAL.REGIONFN 360399 . 360757) (SK.REMOVE.SELECTION 360759 . 361487 +) (SK.SELECT.MULTIPLE.ITEMS 361489 . 371931) (SKETCH.GET.ELEMENTS 371933 . 373356) (SK.PUT.MARKS.UP +373358 . 373697) (SK.TAKE.MARKS.DOWN 373699 . 374038) (SK.TRANSLATE.GLOBALPART 374040 . 376167) ( +SK.TRANSLATE.ITEM 376169 . 377096) (SK.TRANSLATEFN 377098 . 377294) (TRANSLATE.SKETCH 377296 . 378105) +) (378373 381280 (SK.INPUT.SCALE 378383 . 379230) (SK.UPDATE.SKETCHCONTEXT 379232 . 379829) ( +SK.SET.INPUT.SCALE 379831 . 380480) (SK.SET.INPUT.SCALE.CURRENT 380482 . 380773) ( +SK.SET.INPUT.SCALE.VALUE 380775 . 381278)) (381331 383243 (SK.SET.FEEDBACK.MODE 381341 . 382647) ( +SK.SET.FEEDBACK.POINT 382649 . 382817) (SK.SET.FEEDBACK.VERBOSE 382819 . 382988) ( +SK.SET.FEEDBACK.ALWAYS 382990 . 383241)) (383394 384772 (SKETCH.TITLE 383404 . 383768) ( +SK.SHRINK.ICONCREATE 383770 . 384770)) (390462 393276 (READBRUSHSHAPE 390472 . 390931) (READ.FUNCTION +390933 . 391448) (READBRUSHSIZE 391450 . 391908) (READANGLE 391910 . 392402) (READARCDIRECTION 392404 + . 393274)) (393277 403688 (SK.CHANGE.DASHING 393287 . 397235) (READ.AND.SAVE.NEW.DASHING 397237 . +399005) (READ.NEW.DASHING 399007 . 400747) (READ.DASHING.CHANGE 400749 . 402224) (SK.CACHE.DASHING +402226 . 403228) (SK.DASHING.LABEL 403230 . 403686)) (403689 407394 (READ.FILLING.CHANGE 403699 . +405680) (SK.CACHE.FILLING 405682 . 406400) (READ.AND.SAVE.NEW.FILLING 406402 . 407000) ( +SK.FILLING.LABEL 407002 . 407392)) (407778 444031 (SK.GETGLOBALPOSITION 407788 . 408093) ( +SKETCH.TRACK.ELEMENTS 408095 . 411615) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS 411617 . 412176) ( +MAP.SKETCH.ELEMENTS.INTO.VIEWER 412178 . 412570) (MAP.GLOBAL.POSITION.INTO.VIEWER 412572 . 412952) ( +SKETCH.TO.VIEWER.POSITION 412954 . 413313) (SKETCH.TRACK.IMAGE 413315 . 414169) (SK.TRACK.IMAGE1 +414171 . 415583) (MAP.VIEWER.XY.INTO.GLOBAL 415585 . 416579) (SK.SET.POSITION 416581 . 416917) ( +MAP.VIEWER.PT.INTO.GLOBAL 416919 . 418025) (VIEWER.TO.SKETCH.POSITION 418027 . 418662) ( +SK.INSURE.SCALE 418664 . 418924) (SKETCH.TO.VIEWER.REGION 418926 . 419732) (VIEWER.TO.SKETCH.REGION +419734 . 420072) (SK.READ.POINT.WITH.FEEDBACK 420074 . 431077) (SKETCH.GET.POSITION 431079 . 432959) ( +\CLOBBER.POSITION 432961 . 433409) (NEAREST.HOT.SPOT 433411 . 434939) (GETWREGION 434941 . 435702) ( +GET.BITMAP.POSITION 435704 . 436488) (SK.TRACK.BITMAP1 436490 . 444029)) (444600 475486 ( +SK.BRING.UP.POSITION.PAD 444610 . 450470) (SK.PAD.READER.POSITION 450472 . 452121) ( +SK.POSITION.READER.REPAINTFN 452123 . 453907) (SK.POSITION.PAD.FROM.VIEWER 453909 . 455251) ( +SK.INIT.POSITION.NUMBER.PAD.MENU 455253 . 455603) (SK.READ.POSITION.PAD.HANDLER 455605 . 461337) ( +DISPLAY.POSITION.READER.TOTAL 461339 . 463637) (POSITION.PAD.READER.HANDLER 463639 . 471682) ( +POSITIONPAD.HELDFN 471684 . 473168) (\POSITION.PAD.ADD.DIGIT.MENU 473170 . 474749) ( +\POSITION.READER.NUMBERPAD 474751 . 475484)) (477112 479790 (SK.DRAWFN 477122 . 477488) ( +SK.TRANSFORMFN 477490 . 477871) (SK.EXPANDFN 477873 . 478150) (SK.INPUT 478152 . 478533) (SK.INSIDEFN +478535 . 479175) (SK.UPDATEFN 479177 . 479788)) (484955 487111 (UPDATE-SKETCH 484965 . 486078) ( +EDIT-SKETCH 486080 . 487109)) (487712 491657 (SK.CHECK.SKETCH.VERSION 487722 . 488962) ( +SK.INSURE.RECORD.LENGTH 488964 . 490447) (SK.INSURE.HAS.LENGTH 490449 . 491187) (SK.RECORD.LENGTH +491189 . 491363) (SK.SET.RECORD.LENGTHS 491365 . 491655)) (492120 493007 ( +SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER 492130 . 493005))))) STOP diff --git a/library/sketch/SKETCH-EDIT b/library/sketch/SKETCH-EDIT index fe712eea..998a52ec 100644 --- a/library/sketch/SKETCH-EDIT +++ b/library/sketch/SKETCH-EDIT @@ -1,18 +1,20 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 5-Dec-2023 00:12:04" {WMEDLEY}sketch>SKETCH-EDIT.;1 108598 +(FILECREATED " 2-Dec-2025 10:03:57" {WMEDLEY}SKETCH>SKETCH-EDIT.;21 113506 :EDIT-BY rmk - :CHANGES-TO (RECORDS TEXTELTSELECTION) + :CHANGES-TO (FNS \SKED.ARROWKEYS \SKED.INSERT.UNDO \SKED.INSERT.ACTION + \SKED.INSERT.CHARS.TO.STR \SKED.INSERT CHAR.BEGIN) + (VARS SKETCH-EDITCOMS) - :PREVIOUS-DATE "21-Aug-2021 20:50:04" {WMEDLEY}sketch>SKETCHEDIT.;1) + :PREVIOUS-DATE "30-Nov-2025 08:45:15" {WMEDLEY}SKETCH>SKETCH-EDIT.;17) (PRETTYCOMPRINT SKETCH-EDITCOMS) (RPAQQ SKETCH-EDITCOMS - ((COMS (* selection functions) + ((COMS (* ; "selection functions") (FNS BUTLAST CHAR.BEGIN CLOSEST.CHAR CLOSEST.LINE FLASHW HILITE.LINE HILITE.TEXT IN.TEXT.EXTEND INIMAGEOBJ INTEXT NEW.TEXT.EXTEND NEW.TEXT.SELECTIONP NTHCHARWIDTH NTHLOCALREGION ONCHAR SHOW.EXTENDED.SELECTION.FEEDBACK SHOW.FEEDBACK @@ -20,29 +22,30 @@ SK.ENTER.EDIT.CHANGE SKED.REMOVE.OTHER.SELECTIONS SKED.EXTEND.SELECTION SKED.MOVE.SELECTION CREATE.TEXT.SELECTION SKED.SELECTION.FEEDBACK SKED.SET.EXTENDSELECTION SKED.SET.SELECTION LINE.BEGIN SELECTION.GREATERP - SK.WORD.BREAK.CLASS SK.GETSYNTAX) + SK.GETSYNTAX) (DECLARE%: DONTCOPY (RECORDS TEXTELTSELECTION)) (UGLYVARS IN.TEXT.FEEDBACK.CURSOR NEW.TEXT.FEEDBACK.CURSOR NEW.TEXT.FEEDBACK.SHADE SELECTION.HIGHLIGHT.SHADE) (GLOBALVARS IN.TEXT.FEEDBACK.CURSOR NEW.TEXT.FEEDBACK.CURSOR NEW.TEXT.FEEDBACK.SHADE SELECTION.HIGHLIGHT.SHADE)) - (COMS (* editting functions) - (FNS WB.EDITOR SK.TTYENTRYFN SK.TTYEXITFN SKED.INSERT \SKED.INSERT FIRST.N.ELEMENTS - SKED.CREATE.NEW.TEXTBOX SKED.CHARACTERPOSITION SKED.LINE.AND.CHAR# - \SKED.DELETE.WORD.FROM.STRING \SKED.INSERT.CHARS.TO.STR JOINCHARS - STRINGFROMCHARACTERS GETALLCHARS CLEANUP.EDIT SKED.NEW.TEXTELT)) - (COMS (* line adding functions) + (COMS (* ; "editing functions") + (FNS WB.EDITOR SK.TTYENTRYFN SK.TTYEXITFN SKED.INSERT \SKED.INSERT \SKED.ARROWKEYS + \SKED.INSERT.ACTION \SKED.INSERT.UNDO FIRST.N.ELEMENTS SKED.CREATE.NEW.TEXTBOX + SKED.CHARACTERPOSITION SKED.LINE.AND.CHAR# \SKED.DELETE.WORD.FROM.STRING + \SKED.INSERT.CHARS.TO.STR JOINCHARS STRINGFROMCHARACTERS GETALLCHARS CLEANUP.EDIT + SKED.NEW.TEXTELT)) + (COMS (* ; "line adding functions") (FNS MAP.SCREEN.POSITION.ONTO.GRID NEAREST.ON.GRID SK.MIDDLE.TITLEFN WB.BUTTON.HANDLER WB.ADD.NEW.POINT WB.DRAWLINE WB.RUBBERBAND.POSITION SK.RUBBERBAND.FEEDBACKFN RESET.LINE.BEING.INPUT) - [P (* Was MODERNIZE loaded before?) + [P (* ; "Was MODERNIZE loaded before?") (CL:WHEN (GETD 'MODERNWINDOW.SETUP) (MODERNWINDOW.SETUP 'WB.BUTTON.HANDLER))] (FNS NEAREST.EXISTING.POSITION WB.NEARPT LASTMOUSEPOSITION)))) -(* selection functions) +(* ; "selection functions") (DEFINEQ @@ -59,10 +62,13 @@ (BUTLAST (CDR LST]) (CHAR.BEGIN - [LAMBDA (CHAR# LINE# TEXTELT STRM) (* rrb "14-Jan-85 15:40") - - (* determines the x position of the first bit of character CHAR# in LINE# of - TEXTELT.) + [LAMBDA (CHAR# LINE# TEXTELT STRM) (* ; "Edited 1-Dec-2025 00:22 by rmk") + (* rrb "14-Jan-85 15:40") + + (* ;; "determines the x position of the first bit of character CHAR# in LINE# of TEXTELT.") + + (* determines the x position of the first bit of character CHAR# in LINE# of + TEXTELT.) (PROG ((LTEXT (fetch (SCREENELT LOCALPART) of TEXTELT)) TEXT XPOS LFONT LREGION) @@ -72,26 +78,21 @@ of LTEXT) LINE#] (COND - ((EQ CHAR# 0) (* before the first character.) + ((EQ CHAR# 0) (* ; "before the first character.") (RETURN XPOS))) (SETQ LFONT (fetch (LOCALTEXT LOCALFONT) of LTEXT)) (RETURN (IPLUS XPOS (COND ((IMAGESTREAMTYPEP STRM 'HARDCOPY) - - (* hardcopy streams must pass the stream so correction in widths is accounted - for.) - + (* ; + "hardcopy streams must pass the stream so correction in widths is accounted for.") (DSPFONT LFONT STRM) (STRINGWIDTH (SUBSTRING TEXT 1 CHAR#) STRM)) ((FONTP LFONT) - (for I from 1 to CHAR# sum (CHARWIDTH (CHCON1 (NTHCHAR TEXT I)) - LFONT))) - (T - - (* if it is printed in shade, put cursor a percentage of the way across the - area.) - + (STRINGWIDTH (SUBSTRING TEXT 1 CHAR#) + LFONT)) + (T (* ; + "if it is printed in shade, put cursor a percentage of the way across the area.") (IQUOTIENT (ITIMES CHAR# (fetch (REGION WIDTH) of LREGION)) (NCHARS TEXT]) @@ -520,11 +521,10 @@ (SKED.MOVE.SELECTION SKW (NOT (WINDOWPROP SKW 'USEGRID]) (SKED.MOVE.SELECTION - [LAMBDA (SKW USEGRID) (* rrb "11-Jul-86 15:51") - - (* the user has left buttoned in a sketch window. - Put the caret there.) - + [LAMBDA (SKW USEGRID) (* ; "Edited 5-Nov-2025 23:56 by rmk") + (* rrb "11-Jul-86 15:51") + (* ; + "the user has left buttoned in a sketch window. Put the caret there.") (SKED.CLEAR.SELECTION SKW) (PROG (FEEDBACKX FEEDBACKY OLDGRIDX OLDGRIDY OLDX OLDY OLDCUR FEEDBACKCUR INTEXT INIMAGEOBJ STARTLINE STARTCHAR X Y (DSP (WINDOWPROP SKW 'DSP)) @@ -532,44 +532,36 @@ (GRID (SK.GRIDFACTOR SKW))) (until (MOUSESTATE UP) do - - (* track with the appropriate caret depending upon whether the cursor is inside - of existing text or not.) + (* ;; "track with the appropriate caret depending upon whether the cursor is inside of existing text or not.") (SETQ X (LASTMOUSEX DSP)) (SETQ Y (LASTMOUSEY DSP)) (COND ((OR (NEQ OLDX X) - (NEQ OLDY Y)) - - (* only look for things when the cursor position has changed.) - + (NEQ OLDY Y)) (* ; + "only look for things when the cursor position has changed.") (SETQ OLDX X) (SETQ OLDY Y) [COND ([AND (SETQ INTEXT (for ELT in (LOCALSPECS.FROM.VIEWER SKW) + unless (EQ 'SHADE (fetch (LOCALTEXT LOCALFONT) + of (fetch (SCREENELT LOCALPART) of ELT))) when (SELECTQ (fetch (SCREENELT GTYPE) of ELT) - (TEXT (AND (NEQ (fetch (LOCALTEXT LOCALFONT) - of (fetch (SCREENELT LOCALPART) - of ELT)) - 'SHADE) - (SETQ STARTLINE (INTEXT ELT X Y)))) - (TEXTBOX (AND (NEQ (fetch (LOCALTEXTBOX LOCALFONT) - of (fetch (SCREENELT LOCALPART) - of ELT)) - 'SHADE) - (INSIDE? (fetch (LOCALTEXTBOX - LOCALTEXTBOXREGION) - of (fetch (SCREENELT LOCALPART) - of ELT)) - X Y) - (SETQ STARTLINE (CLOSEST.LINE ELT Y)))) + (TEXT (SETQ STARTLINE (INTEXT ELT X Y))) + (TEXTBOX (CL:WHEN (INSIDE? (fetch (LOCALTEXTBOX + LOCALTEXTBOXREGION + ) + of (fetch (SCREENELT + LOCALPART) + of ELT)) + X Y) + (SETQ STARTLINE (CLOSEST.LINE ELT Y)))) NIL) do (RETURN ELT))) (NOT (SK.ELEMENT.PROTECTED? (fetch (SCREENELT GLOBALPART) of INTEXT) - 'CHANGE] (* inside of a text element.) + 'CHANGE] (* ; "inside of a text element.") (SETQ FEEDBACKCUR IN.TEXT.FEEDBACK.CURSOR) - (SETQ FEEDBACKX (CHAR.BEGIN (SETQ STARTCHAR (CLOSEST.CHAR X STARTLINE INTEXT + (SETQ FEEDBACKX (CHAR.BEGIN (SETQ STARTCHAR (CLOSEST.CHAR X STARTLINE INTEXT DSP)) STARTLINE INTEXT DSP)) (SETQ FEEDBACKY (LINE.BEGIN STARTLINE INTEXT))) @@ -577,7 +569,7 @@ (COND (USEGRID (SETQ FEEDBACKX (MAP.WINDOW.ONTO.GRID X SCALE GRID)) (SETQ FEEDBACKY (MAP.WINDOW.ONTO.GRID Y SCALE GRID))) - (T (* no grid) + (T (* ; "no grid") (SETQ FEEDBACKX X) (SETQ FEEDBACKY Y] (COND @@ -588,13 +580,13 @@ (SHOW.FEEDBACK (SETQ OLDCUR FEEDBACKCUR) (SETQ OLDGRIDX FEEDBACKX) (SETQ OLDGRIDY FEEDBACKY) - SKW))) (* give the coordinate display window - a shot.) + SKW))) (* ; + "give the coordinate display window a shot.") (SKETCHW.UPDATE.LOCATORS SKW))) finally (AND OLDGRIDX (SHOW.FEEDBACK OLDCUR OLDGRIDX OLDGRIDY SKW)) (COND - ((EQ OLDCUR IN.TEXT.FEEDBACK.CURSOR) (* selection is existing text) - (SKED.SET.SELECTION (CREATE.TEXT.SELECTION INTEXT STARTLINE STARTCHAR OLDGRIDX + ((EQ OLDCUR IN.TEXT.FEEDBACK.CURSOR) (* ; "selection is existing text") + (SKED.SET.SELECTION (CREATE.TEXT.SELECTION INTEXT STARTLINE STARTCHAR OLDGRIDX OLDGRIDY DSP) SKW)) (OLDGRIDX (SKED.SET.SELECTION (create POSITION @@ -688,30 +680,18 @@ (IGREATERP (fetch (TEXTELTSELECTION SKCHAR#) of SEL2) (fetch (TEXTELTSELECTION SKCHAR#) of SEL1]) -(SK.WORD.BREAK.CLASS - [LAMBDA (CHCODE) (* rrb "11-Jul-86 17:17") - (* version of TEDIT.WORDGET that makes - sure TEDIT is loaded.) - (COND - ((DEFINEDP (FUNCTION TEDIT.WORDGET)) - (TEDIT.WORDGET CHCODE)) - ((EQ CHCODE 32) (* space, return the code tedit uses - for word separators) - 22) - (T (* this probably isn't right but - should do something reasonable.) - (GETSYNTAX CHCODE (GETREADTABLE]) - (SK.GETSYNTAX - [LAMBDA (CHARCODE) (* rrb "11-Jul-86 17:18") - - (* version of getsyntax that uses the TEDIT table if it is available, otherwise - the terminal.) + [LAMBDA (CHARCODE) (* ; "Edited 30-Nov-2025 08:39 by rmk") + (* ; "Edited 10-Nov-2025 15:33 by rmk") + (* rrb "11-Jul-86 17:18") - (COND - ((DEFINEDP (FUNCTION TEDIT.GETSYNTAX)) - (TEDIT.GETSYNTAX CHARCODE TEDIT.READTABLE)) - (T (GETSYNTAX CHARCODE (GETTERMTABLE]) + (* ;; "Original code used TEDIT.GETSYNTAX if it was defined, otherwise called the system GETSYNTAX. That made SKETCH dependent on the system tags (CHARDELETE etc.). Bbut now we know that loading SKETCH insures that TEDIT is loaded, so Sketch is modified to use the Tedit action names") + + (* ;; "4 is (\TEDIT.TTC FN)") + + (CL:WHEN (EQ 4 (\SYNCODE (fetch READSA of TEDIT.READTABLE) + CHARCODE)) + (TEDIT.GET.CHARACTION CHARCODE]) ) (DECLARE%: DONTCOPY (DECLARE%: EVAL@COMPILE @@ -764,52 +744,57 @@ -(* editting functions) +(* ; "editing functions") (DEFINEQ (WB.EDITOR - [LAMBDA (SKW) (* rrb "17-Jul-85 15:53") - - (* the process that looks for characters and adds them to the white board as - text elements.) - - (* save the value of del as an interrupt character so it is restored when this - process exits. This is also done by TTYENTRYFN and TTYEXITFN on the process.) + [LAMBDA (SKW) (* ; "Edited 29-Nov-2025 17:14 by rmk") + (* rrb "17-Jul-85 15:53") + (* ; + "the process that looks for characters and adds them to the white board as text elements.") - (RESETFORM (INTERRUPTCHAR 127 T) - (PROG (CHARS EDITINPROGRESS) - (TTYDISPLAYSTREAM SKW) - LP (COND - ((\SYSBUFP) - - (* a character has been typed, read all of the characters, delete the current - selection if extended and insert the new characters.) + (* ;; "RMK: DEL/RUBOUT is no longer an interrupt character") - (RESET.LINE.BEING.INPUT SKW) - (SKED.INSERT (GETALLCHARS T) - SKW) - (SETQ EDITINPROGRESS T)) - ((AND EDITINPROGRESS (NOT (INSIDEP (WINDOWPROP SKW 'REGION) - LASTMOUSEX LASTMOUSEY))) - (CLEANUP.EDIT SKW) - (SETQ EDITINPROGRESS NIL))) (* let the mouse process run.) - (BLOCK) - (GO LP]) + (* ;; "save the value of del as an interrupt character so it is restored when this process exits. This is also done by TTYENTRYFN and TTYEXITFN on the process.") + + (PROG (CHARS EDITINPROGRESS) + (TTYDISPLAYSTREAM SKW) + LP (COND + ((\SYSBUFP) + + (* ;; "a character has been typed, read all of the characters, delete the current selection if extended and insert the new characters.") + + (RESET.LINE.BEING.INPUT SKW) + (SKED.INSERT (GETALLCHARS T) + SKW) + (SETQ EDITINPROGRESS T)) + ((AND EDITINPROGRESS (NOT (INSIDEP (WINDOWPROP SKW 'REGION) + LASTMOUSEX LASTMOUSEY))) + (CLEANUP.EDIT SKW) + (SETQ EDITINPROGRESS NIL))) (* ; "let the mouse process run.") + (BLOCK) + (GO LP]) (SK.TTYENTRYFN - [LAMBDA (SKPROC) (* rrb "20-Jun-85 14:13") - - (* the sketch process just got the tty. Turns off DEL as an interrupt) + [LAMBDA (SKPROC) (* ; "Edited 29-Nov-2025 17:16 by rmk") + (* rrb "20-Jun-85 14:13") + (* ; + "the sketch process just got the tty. Turns off DEL as an interrupt") - (PROCESSPROP SKPROC 'OLDINTERRUPTVALUE (INTERRUPTCHAR 127 NIL]) + (* ;; "RMK 2025: DEL/RUBOUT is no longer an interrupt") + + (AND NIL (PROCESSPROP SKPROC 'OLDINTERRUPTVALUE (INTERRUPTCHAR 127 NIL]) (SK.TTYEXITFN - [LAMBDA (SKPROC) (* rrb "20-Jun-85 13:55") - - (* the sketch process just got the tty. Turns off DEL as an interrupt) + [LAMBDA (SKPROC) (* ; "Edited 29-Nov-2025 17:17 by rmk") + (* rrb "20-Jun-85 13:55") + (* ; + "the sketch process just got the tty. Turns off DEL as an interrupt") - (INTERRUPTCHAR (PROCESSPROP SKPROC 'OLDINTERRUPTVALUE]) + (* ;; "RMK: DEL/RUBOUT is no longer an interrupt") + + (AND NIL (INTERRUPTCHAR (PROCESSPROP SKPROC 'OLDINTERRUPTVALUE]) (SKED.INSERT [LAMBDA (CHARCODES SKW ATSCALE) (* rrb "10-Feb-86 10:15") @@ -822,81 +807,64 @@ (\SKED.INSERT CHARCODES SKW ATSCALE]) (\SKED.INSERT - [LAMBDA (CHARCODES SKW ATSCALE) (* ; "Edited 20-Feb-87 17:28 by rrb") + [LAMBDA (CHARCODES SKW ATSCALE) (* ; "Edited 1-Dec-2025 13:23 by rmk") + (* ; "Edited 12-Nov-2025 14:49 by rmk") + (* ; "Edited 10-Nov-2025 15:32 by rmk") + (* ; "Edited 20-Feb-87 17:28 by rrb") (COND ((GREATERP (LENGTH CHARCODES) 200) - - (* the maximum string length limits the number of characters that can be - inserted at once. This can happen from a shift select.) + + (* ;; "the maximum string length limits the number of characters that can be inserted at once. This can happen from a shift select.") (SKED.INSERT (FIRST.N.ELEMENTS CHARCODES 200) SKW ATSCALE) (SKED.INSERT (NTH CHARCODES 201) SKW ATSCALE)) + ((\SKED.INSERT.ACTION CHARCODES SKW)) (T (PROG ((SELECTION (WINDOWPROP SKW 'SELECTION)) (EXTENSION (WINDOWPROP SKW 'EXTENDSELECTION)) TEXTELT ELTTYPE GTEXTELT FIRSTLINE# FIRSTCHAR# LASTLINE# LASTCHAR# STRLST NEWSTRS NEWELT STRPIECE NEWLINE# NEWCHAR# SKCONTEXT PTRCHAR# CONTROLCHARTAIL) - (COND - ((EQ (SK.GETSYNTAX (CAR CHARCODES)) - 'UNDO) - - (* user typed an undo Avoid the overhead of inserting no characters and allow - undo to be typed without a selection.) - - (SETQ CONTROLCHARTAIL 'UNDO) - (GO UNDO))) - (COND - ((NULL SELECTION) (* add a new text element with these - characters.) + (CL:UNLESS SELECTION (* ; + "add a new text element with these characters.") (STATUSPRINT SKW " " "Indicate the position the typing should go with the left button.") - (RETURN))) + (RETURN)) (SKED.CLEAR.SELECTION SKW NIL T) (SKED.REMOVE.OTHER.SELECTIONS SKW) - [COND - ((AND (OR (EQ (CAR CHARCODES) - (CHARCODE EOL)) - (EQ (CAR CHARCODES) - (CHARCODE LINEFEED))) - (KEYDOWNP 'CTRL)) - - (* user hit control CR. create a new text or textbox.) - - (SKED.CREATE.NEW.TEXTBOX [COND - ((NEW.TEXT.SELECTIONP SELECTION) - NIL) - (T (fetch (SCREENELT INDIVIDUALGLOBALPART) - of (fetch (TEXTELTSELECTION SKTEXTELT) - of SELECTION] + (CL:WHEN (AND (MEMB (CAR CHARCODES) + (CHARCODE (EOL LINEFEED))) + (KEYDOWNP 'CTRL)) (* ; + "user hit control CR. create a new text or textbox.") + (SKED.CREATE.NEW.TEXTBOX (CL:UNLESS (NEW.TEXT.SELECTIONP SELECTION) + (fetch (SCREENELT INDIVIDUALGLOBALPART) + of (fetch (TEXTELTSELECTION SKTEXTELT) + of SELECTION))) SKW (CDR CHARCODES)) (RETURN)) - [(NEW.TEXT.SELECTIONP SELECTION) - - (* selection is in open space, create a new text element.) - (* merge the characters into strings - of each line.) + [COND + [(NEW.TEXT.SELECTIONP SELECTION) (* ; + "selection is in open space, create a new text element.") + (* ; + "merge the characters into strings of each line.") (SETQ ELTTYPE 'TEXT) - (SETQ CONTROLCHARTAIL (\SKED.INSERT.CHARS.TO.STR CHARCODES NIL SKW)) + (SETQ CONTROLCHARTAIL (\SKED.INSERT.CHARS.TO.STR CHARCODES NIL SKW SELECTION)) (COND - ((OR NEWSTRS STRPIECE) - - (* if there are any new characters, add a new text element.) - - (* save the selection that marked the spot where the new text goes and add the - text but not in a way that puts an event on the history list. - this is done during clean up.) + ((OR NEWSTRS STRPIECE) (* ; + "if there are any new characters, add a new text element.") + + (* ;; "save the selection that marked the spot where the new text goes and add the text but not in a way that puts an event on the history list. this is done during clean up.") (WINDOWPROP SKW 'CHANGEDTEXTELT SELECTION) (SETQ NEWELT (SK.ADD.ELEMENT (CREATE.TEXT.ELEMENT (SETQ NEWSTRS (NCONC1 NEWSTRS STRPIECE)) (SK.MAP.INPUT.PT.TO.GLOBAL (create INPUTPT - INPUT.ONGRID? + INPUT.ONGRID? _ NIL - INPUT.POSITION + INPUT.POSITION _ ( SELECTION.POSITION @@ -913,20 +881,15 @@ of (fetch (SKETCHCONTEXT SKETCHBRUSH) of SKCONTEXT))) SKW T))) - (CONTROLCHARTAIL - - (* user typed control return to get textbox in the middle of no where.) - + (CONTROLCHARTAIL (* ; + "user typed control return to get textbox in the middle of no where.") (SKED.CREATE.NEW.TEXTBOX NIL SKW (CDR CONTROLCHARTAIL) ATSCALE) (RETURN)) - (T - - (* user typed backspace, etc. when no text exists. - Put caret back in same place.) - + (T (* ; + "user typed backspace, etc. when no text exists. Put caret back in same place.") (SKED.SET.SELECTION SELECTION SKW) - (RETURN))) (* put selection marker at the end.) + (RETURN))) (* ; "put selection marker at the end.") (SETQ NEWLINE# (LENGTH NEWSTRS)) (SETQ NEWCHAR# (NCHARS (CAR (LAST NEWSTRS] (T [SETQ GTEXTELT (fetch (SCREENELT INDIVIDUALGLOBALPART) @@ -935,8 +898,8 @@ (SETQ ELTTYPE (fetch (INDIVIDUALGLOBALPART GTYPE) of GTEXTELT)) (SETQ STRLST (fetch (LOCALTEXT LOCALLISTOFCHARACTERS) of (fetch (SCREENELT LOCALPART) of TEXTELT))) - (* set up points to beginning and end - of selection.) + (* ; + "set up points to beginning and end of selection.") [COND [(NULL EXTENSION) (SETQ LASTCHAR# (SETQ FIRSTCHAR# (fetch (TEXTELTSELECTION SKCHAR#) @@ -948,9 +911,8 @@ (SETQ FIRSTCHAR# (fetch (TEXTELTSELECTION SKCHAR#) of SELECTION)) (SETQ LASTLINE# (fetch (TEXTELTSELECTION SKLINE#) of EXTENSION)) (SETQ LASTCHAR# (fetch (TEXTELTSELECTION SKCHAR#) of EXTENSION)) - - (* make SELECTION be the candidate for the selection after the deletion.) - + (* ; + "make SELECTION be the candidate for the selection after the deletion.") (SETQ SELECTION EXTENSION)) (T (SETQ FIRSTLINE# (fetch (TEXTELTSELECTION SKLINE#) of EXTENSION)) (SETQ FIRSTCHAR# (fetch (TEXTELTSELECTION SKCHAR#) of EXTENSION)) @@ -958,37 +920,34 @@ (SETQ LASTCHAR# (fetch (TEXTELTSELECTION SKCHAR#) of SELECTION] [for STR in STRLST as LINE# from 1 do [COND - ((ILESSP LINE# FIRSTLINE#) (* before the first, copy across) + ((ILESSP LINE# FIRSTLINE#) (* ; "before the first, copy across") (SETQ NEWSTRS (NCONC1 NEWSTRS STR))) - ((IGREATERP LINE# LASTLINE#) (* After the last, copy across) + ((IGREATERP LINE# LASTLINE#) (* ; "After the last, copy across") (SETQ NEWSTRS (NCONC1 NEWSTRS STR))) - ((EQ LINE# FIRSTLINE#) (* on the first, save the part before.) + ((EQ LINE# FIRSTLINE#) (* ; + "on the first, save the part before.") (SETQ STRPIECE (SUBSTRING STR 1 FIRSTCHAR#)) - (* insert new text.) + (* ; "insert new text.") (COND [CHARCODES (SETQ CONTROLCHARTAIL (\SKED.INSERT.CHARS.TO.STR CHARCODES (EQ ELTTYPE 'TEXTBOX) - SKW)) - (SETQ NEWCHAR# (COND - (STRPIECE (NCHARS STRPIECE)) - (T 0))) + SKW SELECTION)) + (SETQ NEWCHAR# (CL:IF STRPIECE + (NCHARS STRPIECE) + 0)) (SETQ NEWLINE# (ADD1 (LENGTH NEWSTRS] (T (SETQ NEWCHAR# FIRSTCHAR#) (SETQ NEWLINE# FIRSTLINE#] - (COND - ((EQ LINE# LASTLINE#) - - (* on the last, copy the part before and the part after as one) - + (CL:WHEN (EQ LINE# LASTLINE#) (* ; + "on the last, copy the part before and the part after as one") (SETQ NEWSTRS (COND [STRPIECE (NCONC1 NEWSTRS (COND ((EQ LASTCHAR# (NCHARS STR)) - - (* special check because SUBSTRING returns NIL rather than the empty string.) - + (* ; + "special check because SUBSTRING returns NIL rather than the empty string.") STRPIECE) (T (CONCAT STRPIECE (SUBSTRING STR (ADD1 @@ -996,53 +955,43 @@ ] [(NEQ LASTCHAR# (NCHARS STR)) (NCONC1 NEWSTRS (SUBSTRING STR (ADD1 LASTCHAR#] - (T NEWSTRS] - - (* any other windows that had this selection have had it deleted already so - this doesn't do anything for them.) + (T NEWSTRS))))] - [COND - ((IGREATERP NEWLINE# (LENGTH NEWSTRS)) - - (* this corresponds to deleting every thing in a line. - Make sure that if it is the last line that the selection is reset) + (* ;; "any other windows that had this selection have had it deleted already so this doesn't do anything for them.") - (COND + (CL:WHEN (IGREATERP NEWLINE# (LENGTH NEWSTRS)) + + (* ;; "this corresponds to deleting every thing in a line. Make sure that if it is the last line that the selection is reset") + + [COND ((EQ (SETQ NEWLINE# (LENGTH NEWSTRS)) 0) (SETQ NEWCHAR# 0) (COND ((EQ ELTTYPE 'TEXT) - - (* deleted everything in a text element, delete the text element and set the - selection to new text cursor.) + + (* ;; "deleted everything in a text element, delete the text element and set the selection to new text cursor.") (COND [(WINDOWPROP SKW 'CHANGEDTEXTELT) - - (* make the history event for this edit so that it will restore the original - text element) - - (PROG ((INITSELECTION (WINDOWPROP SKW 'CHANGEDTEXTELT NIL))) - (COND - ((POSITIONP INITSELECTION) - - (* this text element was typing that was never officially added, don't record - the deletion either.) - - (SK.DELETE.ELEMENT (LIST TEXTELT) - SKW - 'DON'T)) - (T - - (* selection was existing text, record this as a delete event.) - - (SK.DELETE.ELEMENT - (LIST TEXTELT) - SKW - (LIST (fetch (SCREENELT GLOBALPART) - of (fetch (TEXTELTSELECTION SKTEXTELT) - of INITSELECTION] + (* ; + "make the history event for this edit so that it will restore the original text element") + (LET ((INITSELECTION (WINDOWPROP SKW 'CHANGEDTEXTELT NIL))) + (COND + ((POSITIONP INITSELECTION) + (* ; + "this text element was typing that was never officially added, don't record the deletion either.") + (SK.DELETE.ELEMENT (LIST TEXTELT) + SKW + 'DON'T)) + (T (* ; + "selection was existing text, record this as a delete event.") + (SK.DELETE.ELEMENT (LIST TEXTELT) + SKW + (LIST (fetch (SCREENELT GLOBALPART) + of (fetch (TEXTELTSELECTION + SKTEXTELT) + of INITSELECTION] (T (SK.DELETE.ELEMENT (LIST TEXTELT) SKW))) (SKED.SET.SELECTION (SK.SCALE.POSITION.INTO.VIEWER @@ -1052,16 +1001,14 @@ (VIEWER.SCALE SKW)) SKW) (RETURN NIL)) - ((EQ ELTTYPE 'TEXTBOX) (* deleted everything in a textbox) + ((EQ ELTTYPE 'TEXTBOX) (* ; "deleted everything in a textbox") NIL))) - (T (SETQ NEWCHAR# (NCHARS (CAR (LAST NEWSTRS] + (T (SETQ NEWCHAR# (NCHARS (CAR (LAST NEWSTRS]) (SETQ PTRCHAR# (SKED.CHARACTERPOSITION NEWSTRS NEWLINE# NEWCHAR#)) (COND ((WINDOWPROP SKW 'CHANGEDTEXTELT) - - (* this is not the first change to the text element. - Collect the changes so that only one element is put on the undo stack, not one - for each character.) + + (* ;; "this is not the first change to the text element. Collect the changes so that only one element is put on the undo stack, not one for each character.") (SETQ NEWELT (SK.UPDATE.ELEMENT (fetch (SCREENELT GLOBALPART) of TEXTELT) (SK.REPLACE.TEXT.IN.ELEMENT (fetch (SCREENELT @@ -1070,12 +1017,10 @@ NEWSTRS) SKW T))) ((AND CONTROLCHARTAIL (NEQ CONTROLCHARTAIL 'UNDO)) - - (* user typed a character command to create a new text box. - Create it and put the remaining characters in it and set the cursor there.) - - (* this is done here so that no undo event is created for the textbox that the - user was in when all they did was type a control-cr.) + + (* ;; "user typed a character command to create a new text box. Create it and put the remaining characters in it and set the cursor there.") + + (* ;; "this is done here so that no undo event is created for the textbox that the user was in when all they did was type a control-cr.") (SKED.CREATE.NEW.TEXTBOX (fetch (SCREENELT INDIVIDUALGLOBALPART) of NEWELT) @@ -1083,9 +1028,7 @@ (CDR CONTROLCHARTAIL)) (RETURN)) (T - - (* this is the first edit change to a new element, call the PREEDITFN and save - old text element so undo event can be constructed when the selection changes.) + (* ;; "this is the first edit change to a new element, call the PREEDITFN and save old text element so undo event can be constructed when the selection changes.") (OR (SK.CHECK.PREEDITFN SKW (fetch (SCREENELT GLOBALPART) of TEXTELT)) (RETURN NIL)) @@ -1096,9 +1039,8 @@ NEWSTRS) SKW)) (WINDOWPROP SKW 'CHANGEDTEXTELT SELECTION))) - - (* recalculate the line %# and char %# of the insertion point as the textboxes - at least do justification.) + + (* ;; "recalculate the line # and char # of the insertion point as the textboxes at least do justification.") [SETQ NEWCHAR# (CDR (SETQ NEWLINE# (SKED.LINE.AND.CHAR# (fetch (LOCALTEXTBOX LOCALLISTOFCHARACTERS) @@ -1106,62 +1048,22 @@ of NEWELT)) PTRCHAR#] (SETQ NEWLINE# (CAR NEWLINE#] - UNDO - (COND - ((NULL CONTROLCHARTAIL) - - (* set the selection to where the characters were just inserted.) + (* ;; "Cleanup") + + (COND + ((NULL CONTROLCHARTAIL) (* ; + "set the selection to where the characters were just inserted.") (SKED.SET.SELECTION (CREATE.TEXT.SELECTION NEWELT NEWLINE# NEWCHAR# NIL NIL (WINDOWPROP SKW 'DSP)) SKW)) - [(EQ CONTROLCHARTAIL 'UNDO) - - (* user types in an undo after some characters or while selection was in the - middle of text.) - - (PROG (INITSELECTION EDITEDELT) - (COND - ((SETQ INITSELECTION (WINDOWPROP SKW 'CHANGEDTEXTELT NIL)) - (* in the middle of editing, undo - these edits.) - [SETQ EDITEDELT (fetch (SCREENELT GLOBALPART) - of (OR NEWELT (fetch (TEXTELTSELECTION SKTEXTELT) - of (OR SELECTION (ERROR - "NO SELECTION WHEN THERE SHOULD BE" - ] - - (* add event to history list so the undo can be undone.) - - (COND - ((POSITIONP INITSELECTION) - - (* add an ADD event because previously there was nothing here.) - - (SK.ADD.HISTEVENT 'ADD (LIST EDITEDELT) - SKW) - (SK.CHECK.END.INITIAL.EDIT SKW EDITEDELT)) - (T (SK.ENTER.EDIT.CHANGE SKW (fetch (SCREENELT GLOBALPART) - of (fetch (TEXTELTSELECTION - SKTEXTELT) - of INITSELECTION)) - EDITEDELT))) - (SK.UNDO.LAST SKW) - (SKED.SET.SELECTION INITSELECTION SKW)) - (T - - (* haven't edited any characters in the current element, just undo the last - thing.) - - (SK.UNDO.LAST SKW] + ((EQ CONTROLCHARTAIL 'UNDO) (* ; + "user types in an undo after some characters or while selection was in the middle of text.") + (\SKED.INSERT.UNDO NEWELT SELECTION)) (T - - (* user typed a character command to create a new text box. - Create it and put the remaining characters in it and set the cursor there.) - - (* set the selection so that adding the new text box will create an undo event - for the character change that took place in this text box before the control-cr - was typed.) + (* ;; "user typed a character command to create a new text box. Create it and put the remaining characters in it and set the cursor there.") + + (* ;; "set the selection so that adding the new text box will create an undo event for the character change that took place in this text box before the control-cr was typed.") (SKED.SET.SELECTION (CREATE.TEXT.SELECTION NEWELT NEWLINE# NEWCHAR# NIL NIL (WINDOWPROP SKW 'DSP)) @@ -1170,6 +1072,96 @@ SKW (CDR CONTROLCHARTAIL]) +(\SKED.ARROWKEYS + [LAMBDA (ACTION SKW SELECTION) (* ; "Edited 2-Dec-2025 10:03 by rmk") + + (* ;; "Move the caret left/right/up/down according to the arrow keys") + + (CL:UNLESS SELECTION + (SETQ SELECTION (WINDOWPROP SKW 'SELECTION))) + (CL:WHEN (AND SELECTION (NOT (POSITIONP SELECTION))) + (LET* [(CHAR# (fetch (TEXTELTSELECTION SKCHAR#) of SELECTION)) + (LINE# (fetch (TEXTELTSELECTION SKLINE#) of SELECTION)) + (TEXTELT (fetch (TEXTELTSELECTION SKTEXTELT) of SELECTION)) + (SKLEFT (fetch (TEXTELTSELECTION SKLEFT) of SELECTION)) + (LINES (fetch (TEXT LISTOFCHARACTERS) of (fetch (SCREENELT INDIVIDUALGLOBALPART) + of TEXTELT] + (SELECTQ ACTION + (:ONECHAR.BACKWARD + (if (EQ CHAR# 0) + then (add LINE# -1) + [SETQ CHAR# (NCHARS (CAR (NTH LINES LINE#] + else (add CHAR# -1))) + (:ONECHAR.FORWARD + (if [EQ CHAR# (NCHARS (CAR (NTH LINES LINE#] + then (add LINE# 1) + (SETQ CHAR# 1) + else (add CHAR# 1))) + (:LINE.UP (add LINE# -1) + (CL:UNLESS (ILESSP LINE# 1) + (SETQ CHAR# (CLOSEST.CHAR SKLEFT LINE# TEXTELT SKW)))) + (:LINE.DOWN (add LINE# 1) + (CL:UNLESS (IGREATERP LINE# (LENGTH LINES)) + (SETQ CHAR# (CLOSEST.CHAR SKLEFT LINE# TEXTELT SKW)))) + (SHOULDNT)) + (CL:WHEN (<= 1 LINE# (LENGTH LINES)) + (SKED.SELECTION.FEEDBACK SKW) + (SKED.SET.SELECTION (create TEXTELTSELECTION + using SELECTION SKCHAR# _ CHAR# SKLINE# _ LINE# SKLEFT _ + (CHAR.BEGIN CHAR# LINE# (fetch (TEXTELTSELECTION + SKTEXTELT) + of SELECTION) + SKW) + SKBOTTOM _ (LINE.BEGIN LINE# TEXTELT)) + SKW))))]) + +(\SKED.INSERT.ACTION + [LAMBDA (CHARCODES SKW) (* ; "Edited 1-Dec-2025 22:28 by rmk") + (LET [(ACTION (SK.GETSYNTAX (CAR CHARCODES] + (SELECTQ ACTION + (:UNDO (\SKED.INSERT.UNDO SKW) + T) + ((:ONECHAR.BACKWARD :ONECHAR.FORWARD :LINE.UP :LINE.DOWN) + (\SKED.ARROWKEYS ACTION SKW) + T) + NIL]) + +(\SKED.INSERT.UNDO + [LAMBDA (SKW NEWELT SELECTION) (* ; "Edited 1-Dec-2025 23:21 by rmk") + (* ; "Edited 1-Dec-2025 12:56 by rmk") + (* ; "Edited 1-Dec-2025 12:48 by rmk") + (CL:UNLESS SELECTION + (SETQ SELECTION (WINDOWPROP SKW 'SELECTION))) + (PROG (INITSELECTION EDITEDELT) + (COND + ((SETQ INITSELECTION (WINDOWPROP SKW 'CHANGEDTEXTELT NIL)) + (* ; + "in the middle of editing, undo these edits.") + [SETQ EDITEDELT (fetch (SCREENELT GLOBALPART) of (OR NEWELT (fetch (TEXTELTSELECTION + SKTEXTELT) + of (OR SELECTION + (ERROR + "NO SELECTION WHEN THERE SHOULD BE" + ] + (* ; + "add event to history list so the undo can be undone.") + (COND + ((POSITIONP INITSELECTION) (* ; + "add an ADD event because previously there was nothing here.") + (SK.ADD.HISTEVENT 'ADD (LIST EDITEDELT) + SKW) + (SK.CHECK.END.INITIAL.EDIT SKW EDITEDELT)) + (T (SK.ENTER.EDIT.CHANGE SKW (fetch (SCREENELT GLOBALPART) + of (fetch (TEXTELTSELECTION SKTEXTELT) of + INITSELECTION + )) + EDITEDELT))) + (SK.UNDO.LAST SKW) + (SKED.SET.SELECTION INITSELECTION SKW)) + (T (* ; + "haven't edited any characters in the current element, just undo the last thing.") + (SK.UNDO.LAST SKW]) + (FIRST.N.ELEMENTS [LAMBDA (LST N) (* rrb "20-Jan-86 18:05") @@ -1332,164 +1324,140 @@ (NCHARS (CAR (LAST STRLST]) (\SKED.DELETE.WORD.FROM.STRING - [LAMBDA (STRING) (* rrb "11-Jul-86 17:17") - - (* returns a string that has the last word of STRING deleted.) + [LAMBDA (STRING) (* ; "Edited 30-Nov-2025 08:06 by rmk") + (* rrb "11-Jul-86 17:17") + + (* ;; "returns a string that has the last word of STRING deleted.") (PROG ((END (NCHARS STRING)) CLASS) SKBLANKS (COND - ((EQ END 0) (* ran out of characters.) + ((EQ END 0) (* ; "ran out of characters.") (RETURN)) - ((EQ (SETQ CLASS (SK.WORD.BREAK.CLASS (NTHCHARCODE STRING END))) + ((EQ (SETQ CLASS (TEDIT.WORDGET (NTHCHARCODE STRING END))) 22) (SETQ END (SUB1 END)) - (GO SKBLANKS))) - - (* now skip characters that have the same class as the first one encountered.) - + (GO SKBLANKS))) (* ; + "now skip characters that have the same class as the first one encountered.") SKSAME (SETQ END (SUB1 END)) (COND - ((EQ END 0) (* ran out of characters.) + ((EQ END 0) (* ; "ran out of characters.") (RETURN)) - ((EQ (SK.WORD.BREAK.CLASS (NTHCHARCODE STRING END)) + ((EQ (TEDIT.WORDGET (NTHCHARCODE STRING END)) CLASS) (GO SKSAME)) (T (RETURN (SUBSTRING STRING 1 END]) (\SKED.INSERT.CHARS.TO.STR - [LAMBDA (CHARCODES INCLUDECR SKW) (* rrb "11-Jul-86 17:18") + [LAMBDA (CHARCODES INCLUDECR SKW SELECTION) (* ; "Edited 1-Dec-2025 00:42 by rmk") + (* ; "Edited 24-Nov-2025 08:40 by rmk") + (* ; "Edited 12-Nov-2025 14:50 by rmk") + (* ; "Edited 10-Nov-2025 16:35 by rmk") + (* rrb "11-Jul-86 17:18") (DECLARE (SPECVARS NEWSTRS STRPIECE)) - - (* takes a list of characters and makes it into strings on the free variable - NEWSTRS. The variable STRPIECE is set to the last line of characters. - NEWSTRS is a list of the strings that precede this one which is used in the - case of backspace onto the previous line.) - (PROG (LINELST THISLINE REMAININGCHARS CLASS) - [for CHAR in CHARCODES + (* ;; "takes a list of characters and makes it into strings on the free variable NEWSTRS. The variable STRPIECE is set to the last line of characters. NEWSTRS is a list of the strings that precede this one which is used in the case of backspace onto the previous line.") + + (* ;; "SELECTION is for the actions that move the type-in") + + (PROG (LINELST THISLINE REMAININGCHARS) + (for CHAR in CHARCODES do (SELECTQ (SK.GETSYNTAX CHAR) - (CHARDELETE (* delete the previous character.) - [COND - (THISLINE (* easy case of deleting type in.) - (SETQ THISLINE (CDR THISLINE))) - (LINELST (* deleting a typed in CR.) - (SETQ THISLINE (CAR LINELST)) - (SETQ LINELST (CDR LINELST))) - [STRPIECE (* remove the previous character from - the current string.) - (COND - ((EQ (NCHARS STRPIECE) - 1) - (SETQ STRPIECE NIL)) - (T (SETQ STRPIECE (SUBSTRING STRPIECE 1 -2] - [NEWSTRS (SETQ STRPIECE (CAR (LAST NEWSTRS))) - (SETQ NEWSTRS (BUTLAST NEWSTRS)) - (COND - ((EQ (NTHCHARCODE STRPIECE -1) - (CHARCODE EOL)) - (* remove previous eol) - (COND - ((EQ (NCHARS STRPIECE) - 1) - (SETQ STRPIECE NIL)) - (T (SETQ STRPIECE (SUBSTRING STRPIECE 1 -2] - (T (* no characters to delete) - (FLASHW (TTYDISPLAYSTREAM]) - (WORDDELETE (* delete the previous word) - - (* use the TEdit word bounding readtable. - Code are%: character = 21 - - space = 22 - - punctuation = 20) + (NIL (* ; "Ordinary characters: just insert") + (COND + [(MEMB CHAR (CHARCODE (EOL LINEFEED))) + (* ; "eol") + (COND + ((KEYDOWNP 'CTRL) (* ; + "user entered control return, save remaining characters and return indicator") + (SETQ REMAININGCHARS (MEMB CHAR CHARCODES)) + (RETURN)) + (T (push LINELST (COND + (INCLUDECR + (* ; + "text boxes need to have the CRs left in.") + (CONS (CHARCODE EOL) + THISLINE)) + (T THISLINE))) + (SETQ THISLINE NIL] + (T + (* ;; "add this character onto the front of this line; reversal will happen before conversion to string and return.") - [COND - [[OR THISLINE (PROG1 (SETQ THISLINE (CAR LINELST)) - (SETQ LINELST (CDR LINELST] - (* easy case of deleting type in.) - - (* if this line was empty, skip the cr that created it as part of the white - space before the word.) - (* skip any whitespace) - (COND - ([NULL (SETQ THISLINE (for TAIL on THISLINE - while (EQ (SK.WORD.BREAK.CLASS - (CAR TAIL)) - 22) - finally (RETURN TAIL] - - (* the whitespace backed up to the beginning of a line. - quit there.) + (push THISLINE CHAR)))) + (:CHARDELETE.BACKWARD (* ; "delete the previous character.") + [COND + (THISLINE (* ; "easy case of deleting type in.") + (SETQ THISLINE (CDR THISLINE))) + (LINELST (* ; "deleting a typed in CR.") + (SETQ THISLINE (pop LINELST))) + (STRPIECE (* ; + "remove the previous character from the current string.") + (SETQ STRPIECE (SUBSTRING STRPIECE 1 -2))) + [NEWSTRS (SETQ STRPIECE (CAR (LAST NEWSTRS))) + (SETQ NEWSTRS (BUTLAST NEWSTRS)) + (CL:WHEN (EQ (NTHCHARCODE STRPIECE -1) + (CHARCODE EOL)) + (* ; "remove previous eol") + (SETQ STRPIECE (SUBSTRING STRPIECE 1 -2)))] + (T (* ; "no characters to delete") + (FLASHW (TTYDISPLAYSTREAM]) + (:WORDDELETE.BACKWARD (* ; "delete the previous word. Tedit binds DEL to CHARDELETE.FORWARD, sketch used DEL to delete the word") + + (* ;; "use the TEdit word bounding readtable. Code are: character = 21 --- space = 22 --- punctuation = 20") - NIL) - (T (SETQ CLASS (SK.WORD.BREAK.CLASS (CAR THISLINE))) - - (* skip all things of the same class as the first character before the - whitespace) + [COND + [(OR THISLINE (SETQ THISLINE (pop LINELST))) + (* ; "easy case of deleting type in.") + (* ; + "if this line was empty, skip the cr that created it as part of the white space before the word.") + (* ; "skip any whitespace") + (CL:WHEN (SETQ THISLINE (find TAIL on THISLINE + suchthat (NEQ (TEDIT.WORDGET (CAR TAIL)) + 22))) + (* ; + "the whitespace didn't backed up to the beginning of a line, something to do.") + (* ; + "skip all things of the same class as the first character before the whitespace") + (SETQ THISLINE (find TAIL (CLASS _ (TEDIT.WORDGET (CAR THISLINE))) + on THISLINE + suchthat (NEQ (TEDIT.WORDGET (CAR TAIL)) + CLASS))))] + (STRPIECE (* ; + "remove the previous character from the current string.") + (SETQ STRPIECE (\SKED.DELETE.WORD.FROM.STRING STRPIECE))) + (NEWSTRS [SETQ STRPIECE (\SKED.DELETE.WORD.FROM.STRING + (CAR (LAST NEWSTRS] + (SETQ NEWSTRS (BUTLAST NEWSTRS))) + (T (* ; "no characters to delete") + (FLASHW (TTYDISPLAYSTREAM]) + ((:WORDDELETE.FORWARD :CHARDELETE.FORWARD) + (* ; "Not implemented, no-ops") + NIL) + (:DELETE (* ; + "delete selection. Here that means don't insert anything.")) + (:UNDO + (* ;; "Undo in the middle of the charcodes. By side effect this flushes any characters typed after the undo but it's not clear where they should go anyway.") - (SETQ THISLINE (for TAIL on THISLINE - until (NEQ (SK.WORD.BREAK.CLASS - (CAR TAIL)) - CLASS) - finally (RETURN TAIL] - (STRPIECE (* remove the previous character from - the current string.) - (SETQ STRPIECE (\SKED.DELETE.WORD.FROM.STRING STRPIECE))) - (NEWSTRS [SETQ STRPIECE (\SKED.DELETE.WORD.FROM.STRING - (CAR (LAST NEWSTRS] - (SETQ NEWSTRS (BUTLAST NEWSTRS))) - (T (* no characters to delete) - (FLASHW (TTYDISPLAYSTREAM]) - (DELETE (* delete selection. - Here that means don't insert anything.)) - (UNDO - - (* by side effect this flushes any characters typed after the undo but it's not - clear where they should go anyway.) - - (RETURN 'UNDO)) - ((REDO FN CMD) + (RETURN 'UNDO)) + ((:REDO :CMD) (* ; "There are many more Tedit actions that we don't deal with here, these were called out when Sketch was using \TEDIT.GETSYNTAX or GETSYNTAX. Not clear we need this message, just fall through and treat REDO/CMD like other actions, as ordinary characters") (STATUSPRINT SKW " " "Not implemented in this editor. Sorry.")) - (COND - [(OR (EQ CHAR (CHARCODE EOL)) - (EQ CHAR (CHARCODE LINEFEED))) (* eol) - (COND - ((KEYDOWNP 'CTRL) - - (* user entered control return, save remaining characters and return indicator) - - (SETQ REMAININGCHARS (MEMB CHAR CHARCODES)) - (RETURN)) - (T (SETQ LINELST (CONS (COND - (INCLUDECR - (* text boxes need to have the CRs - left in.) - (CONS (CHARCODE EOL) - THISLINE)) - (T THISLINE)) - LINELST)) - (SETQ THISLINE NIL] - (T - - (* add this character onto the front of this line; - reversal will happen before conversion to string and return.) - - (SETQ THISLINE (CONS CHAR THISLINE] + (PROGN (* ; "All other actions") + NIL))) (COND - [LINELST (* had a cr in the character set.) + [LINELST (* ; "had a cr in the character set.") [SETQ NEWSTRS (NCONC NEWSTRS [CONS (JOINCHARS STRPIECE (REVERSE (CAR (LAST LINELST] (for CHLST in (REVERSE (BUTLAST LINELST)) collect (STRINGFROMCHARACTERS (REVERSE CHLST] (SETQ STRPIECE (STRINGFROMCHARACTERS (REVERSE THISLINE] - [THISLINE (* no new lines, add these characters - onto STRPIECE) + [THISLINE (* ; + "no new lines, add these characters onto STRPIECE") (SETQ STRPIECE (JOINCHARS STRPIECE (REVERSE THISLINE] - (T (* no new lines, or characters, leave - STRPIECE alone.) + (T (* ; + "no new lines, or characters, leave STRPIECE alone.") NIL)) (RETURN REMAININGCHARS]) @@ -1557,7 +1525,7 @@ -(* line adding functions) +(* ; "line adding functions") (DEFINEQ @@ -1916,7 +1884,7 @@ (WINDOWPROP SKW 'INPUTLINE NIL]) ) - (* Was MODERNIZE loaded before?) + (* ; "Was MODERNIZE loaded before?") (CL:WHEN (GETD 'MODERNWINDOW.SETUP) (MODERNWINDOW.SETUP 'WB.BUTTON.HANDLER)) @@ -1953,26 +1921,27 @@ YCOORD _ (LASTMOUSEY WIN]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2425 39533 (BUTLAST 2435 . 2783) (CHAR.BEGIN 2785 . 4710) (CLOSEST.CHAR 4712 . 8935) ( -CLOSEST.LINE 8937 . 9499) (FLASHW 9501 . 9658) (HILITE.LINE 9660 . 10479) (HILITE.TEXT 10481 . 12129) -(IN.TEXT.EXTEND 12131 . 15404) (INIMAGEOBJ 15406 . 15911) (INTEXT 15913 . 16410) (NEW.TEXT.EXTEND -16412 . 18631) (NEW.TEXT.SELECTIONP 18633 . 18813) (NTHCHARWIDTH 18815 . 19072) (NTHLOCALREGION 19074 - . 19312) (ONCHAR 19314 . 19709) (SHOW.EXTENDED.SELECTION.FEEDBACK 19711 . 20646) (SHOW.FEEDBACK 20648 - . 21138) (SHOW.FEEDBACK.BOX 21140 . 22194) (SELECTION.POSITION 22196 . 22988) (SKED.CLEAR.SELECTION -22990 . 23513) (SKETCH.CLEANUP 23515 . 25429) (SK.ENTER.EDIT.CHANGE 25431 . 26976) ( -SKED.REMOVE.OTHER.SELECTIONS 26978 . 27405) (SKED.EXTEND.SELECTION 27407 . 28872) (SKED.MOVE.SELECTION - 28874 . 34035) (CREATE.TEXT.SELECTION 34037 . 34553) (SKED.SELECTION.FEEDBACK 34555 . 36211) ( -SKED.SET.EXTENDSELECTION 36213 . 36530) (SKED.SET.SELECTION 36532 . 36932) (LINE.BEGIN 36934 . 37488) -(SELECTION.GREATERP 37490 . 38285) (SK.WORD.BREAK.CLASS 38287 . 39127) (SK.GETSYNTAX 39129 . 39531)) ( -40375 86109 (WB.EDITOR 40385 . 41710) (SK.TTYENTRYFN 41712 . 41990) (SK.TTYEXITFN 41992 . 42261) ( -SKED.INSERT 42263 . 42691) (\SKED.INSERT 42693 . 63815) (FIRST.N.ELEMENTS 63817 . 64084) ( -SKED.CREATE.NEW.TEXTBOX 64086 . 70615) (SKED.CHARACTERPOSITION 70617 . 71404) (SKED.LINE.AND.CHAR# -71406 . 73037) (\SKED.DELETE.WORD.FROM.STRING 73039 . 74078) (\SKED.INSERT.CHARS.TO.STR 74080 . 82491) - (JOINCHARS 82493 . 82880) (STRINGFROMCHARACTERS 82882 . 83207) (GETALLCHARS 83209 . 83550) ( -CLEANUP.EDIT 83552 . 84004) (SKED.NEW.TEXTELT 84006 . 86107)) (86144 107152 ( -MAP.SCREEN.POSITION.ONTO.GRID 86154 . 87603) (NEAREST.ON.GRID 87605 . 88149) (SK.MIDDLE.TITLEFN 88151 - . 90094) (WB.BUTTON.HANDLER 90096 . 97918) (WB.ADD.NEW.POINT 97920 . 101249) (WB.DRAWLINE 101251 . -105485) (WB.RUBBERBAND.POSITION 105487 . 106404) (SK.RUBBERBAND.FEEDBACKFN 106406 . 106910) ( -RESET.LINE.BEING.INPUT 106912 . 107150)) (107334 108575 (NEAREST.EXISTING.POSITION 107344 . 107546) ( -WB.NEARPT 107548 . 108433) (LASTMOUSEPOSITION 108435 . 108573))))) + (FILEMAP (NIL (2849 39635 (BUTLAST 2859 . 3207) (CHAR.BEGIN 3209 . 5332) (CLOSEST.CHAR 5334 . 9557) ( +CLOSEST.LINE 9559 . 10121) (FLASHW 10123 . 10280) (HILITE.LINE 10282 . 11101) (HILITE.TEXT 11103 . +12751) (IN.TEXT.EXTEND 12753 . 16026) (INIMAGEOBJ 16028 . 16533) (INTEXT 16535 . 17032) ( +NEW.TEXT.EXTEND 17034 . 19253) (NEW.TEXT.SELECTIONP 19255 . 19435) (NTHCHARWIDTH 19437 . 19694) ( +NTHLOCALREGION 19696 . 19934) (ONCHAR 19936 . 20331) (SHOW.EXTENDED.SELECTION.FEEDBACK 20333 . 21268) +(SHOW.FEEDBACK 21270 . 21760) (SHOW.FEEDBACK.BOX 21762 . 22816) (SELECTION.POSITION 22818 . 23610) ( +SKED.CLEAR.SELECTION 23612 . 24135) (SKETCH.CLEANUP 24137 . 26051) (SK.ENTER.EDIT.CHANGE 26053 . 27598 +) (SKED.REMOVE.OTHER.SELECTIONS 27600 . 28027) (SKED.EXTEND.SELECTION 28029 . 29494) ( +SKED.MOVE.SELECTION 29496 . 34566) (CREATE.TEXT.SELECTION 34568 . 35084) (SKED.SELECTION.FEEDBACK +35086 . 36742) (SKED.SET.EXTENDSELECTION 36744 . 37061) (SKED.SET.SELECTION 37063 . 37463) (LINE.BEGIN + 37465 . 38019) (SELECTION.GREATERP 38021 . 38816) (SK.GETSYNTAX 38818 . 39633)) (40480 91009 ( +WB.EDITOR 40490 . 41871) (SK.TTYENTRYFN 41873 . 42413) (SK.TTYEXITFN 42415 . 42941) (SKED.INSERT 42943 + . 43371) (\SKED.INSERT 43373 . 62845) (\SKED.ARROWKEYS 62847 . 65442) (\SKED.INSERT.ACTION 65444 . +65888) (\SKED.INSERT.UNDO 65890 . 68431) (FIRST.N.ELEMENTS 68433 . 68700) (SKED.CREATE.NEW.TEXTBOX +68702 . 75231) (SKED.CHARACTERPOSITION 75233 . 76020) (SKED.LINE.AND.CHAR# 76022 . 77653) ( +\SKED.DELETE.WORD.FROM.STRING 77655 . 78819) (\SKED.INSERT.CHARS.TO.STR 78821 . 87391) (JOINCHARS +87393 . 87780) (STRINGFROMCHARACTERS 87782 . 88107) (GETALLCHARS 88109 . 88450) (CLEANUP.EDIT 88452 . +88904) (SKED.NEW.TEXTELT 88906 . 91007)) (91048 112056 (MAP.SCREEN.POSITION.ONTO.GRID 91058 . 92507) ( +NEAREST.ON.GRID 92509 . 93053) (SK.MIDDLE.TITLEFN 93055 . 94998) (WB.BUTTON.HANDLER 95000 . 102822) ( +WB.ADD.NEW.POINT 102824 . 106153) (WB.DRAWLINE 106155 . 110389) (WB.RUBBERBAND.POSITION 110391 . +111308) (SK.RUBBERBAND.FEEDBACKFN 111310 . 111814) (RESET.LINE.BEING.INPUT 111816 . 112054)) (112242 +113483 (NEAREST.EXISTING.POSITION 112252 . 112454) (WB.NEARPT 112456 . 113341) (LASTMOUSEPOSITION +113343 . 113481))))) STOP diff --git a/library/sketch/SKETCH-EDIT.LCOM b/library/sketch/SKETCH-EDIT.LCOM index 91cd662b..9f6a8cd7 100644 Binary files a/library/sketch/SKETCH-EDIT.LCOM and b/library/sketch/SKETCH-EDIT.LCOM differ diff --git a/library/sketch/SKETCH-ELEMENTS b/library/sketch/SKETCH-ELEMENTS index ca3acf54..5e56caa3 100644 --- a/library/sketch/SKETCH-ELEMENTS +++ b/library/sketch/SKETCH-ELEMENTS @@ -1,14 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 5-Dec-2023 00:16:52" {WMEDLEY}sketch>SKETCH-ELEMENTS.;1 554138 +(FILECREATED "30-Nov-2025 10:57:24" {WMEDLEY}SKETCH>SKETCH-ELEMENTS.;25 545903 :EDIT-BY rmk - :CHANGES-TO (RECORDS LOCALCIRCLE CIRCLE LOCALELLIPSE ELLIPSE KNOTELT LOCALCURVE OPENCURVE - CLOSEDCURVE LOCALCLOSEDCURVE LOCALCLOSEDWIRE LOCALWIRE WIRE CLOSEDWIRE TEXT - LOCALTEXT LOCALTEXTBOX TEXTBOX BOX LOCALBOX ARC LOCALARC) + :CHANGES-TO (FNS SK.CHANGE.TEXT SK.CHANGE.FONT) - :PREVIOUS-DATE " 4-Aug-2022 09:57:43" {WMEDLEY}sketch>SKETCHELEMENTS.;2) + :PREVIOUS-DATE " 8-Nov-2025 14:02:38" {WMEDLEY}SKETCH>SKETCH-ELEMENTS.;24) (PRETTYCOMPRINT SKETCH-ELEMENTSCOMS) @@ -122,9 +120,8 @@ READ.TEXT TEXT.POSITION.AND.CREATE CREATE.TEXT.ELEMENT SK.UPDATE.TEXT.AFTER.CHANGE SK.TEXT.FROM.TEXTBOX TEXT.SET.GLOBAL.REGIONS TEXT.REGIONFN TEXT.GLOBALREGIONFN TEXT.TRANSLATEFN TEXT.TRANSFORMFN TEXT.TRANSLATEPTSFN TEXT.UPDATEFN SK.CHANGE.TEXT - TEXT.SET.SCALES BREAK.AT.CARRIAGE.RETURNS) - (FNS ADD.KNOWN.SKETCH.FONT SK.PICK.FONT SK.CHOOSE.TEXT.FONT SK.NEXTSIZEFONT - SK.DECREASING.FONT.LIST SK.GUESS.FONTSAVAILABLE) + SK.CHANGE.FONT TEXT.SET.SCALES BREAK.AT.CARRIAGE.RETURNS) + (FNS SK.PICK.FONT SK.CHOOSE.TEXT.FONT SK.NEXTSIZEFONT SK.DECREASING.FONT.LIST) (INITVARS (\KNOWN.SKETCH.FONTSIZES)) (GLOBALVARS \KNOWN.SKETCH.FONTSIZES) (DECLARE%: DONTCOPY (RECORDS TEXT LOCALTEXT)) @@ -136,7 +133,6 @@ (VARS INDICATE.TEXT.SHADE) [INITVARS (SK.DEFAULT.FONT) (SK.DEFAULT.TEXT.ALIGNMENT '(CENTER BASELINE] - (INITVARS \FONTSONFILE) (ADDVARS (SK.HORIZONTAL.STYLES LEFT RIGHT CENTER) (SK.VERTICAL.STYLES TOP CENTER BASELINE BOTTOM)) (VARS (SKETCH.TERMTABLE (CREATE.SKETCH.TERMTABLE))) @@ -4575,10 +4571,13 @@ Click outside the window to stop.") (RETURN (AND VAL (LIST COMMAND VAL]) (\SK.READ.FONT.SIZE1 - [LAMBDA (SELECTEDELTS SKETCHW NEWFAMILY) (* rrb "14-Jul-86 13:43") - - (* reads a font size from the user. If NEWFONT is NIL, use the one of the first - selected element.) + [LAMBDA (SELECTEDELTS SKETCHW NEWFAMILY) (* ; "Edited 6-Nov-2025 22:35 by rmk") + (* rrb "14-Jul-86 13:43") + (* ; + "reads a font size from the user. If NEWFONT is NIL, use the one of the first selected element.") + + (* reads a font size from the user. If NEWFONT is NIL, use the one of the first + selected element.) (PROG (FIRSTTEXTELT NEWSIZE NOWFONT NEWFONT) (OR (SETQ FIRSTTEXTELT (for SCRNELT inside SELECTEDELTS @@ -4606,7 +4605,7 @@ Click outside the window to stop.") (STATUSPRINT SKETCHW NEWFAMILY NEWSIZE " not found.") NIL) (T (CLOSE.PROMPT.WINDOW SKETCHW) - (SK.FONTNAMELIST NEWFONT]) + (FONTPROP NEWFONT 'SPEC]) (SK.TEXT.ELT.WITH.SAME.FIELDS [LAMBDA (NEWONE ORGONE) (* rrb "18-Jul-85 14:16") @@ -4635,26 +4634,33 @@ Click outside the window to stop.") NIL]) (SK.READFONTFAMILY - [LAMBDA (SKW TITLE) (* rrb "21-Nov-85 11:28") - (* reads a font family name.) - (PROG ([KNOWNFAMILIES (UNION (for X in \FONTSONFILE collect (CAR X)) - (for X in \FONTSINCORE collect (CAR X] - FAMILY) (* offers a menu of possible choices.) - (COND - ((AND KNOWNFAMILIES (NEQ (SETQ FAMILY (\CURSOR.IN.MIDDLE.MENU - (create MENU - ITEMS _ - (APPEND '(("other" 'OTHER + [LAMBDA (SKW TITLE) (* ; "Edited 4-Nov-2025 15:08 by rmk") + (* rrb "21-Nov-85 11:28") + + (* ;; "Offers a menu of existing DISPLAY font families, with Other has a way for the user to type one in. Other makes sense only if there are file fonts that are not yet known to Sketch.") + + (* ;; "RMK: Sketch used to keep its own family-by-device cache, separate from \FONTSINCORE. But the way it was set up, those fonts were created in core when they were identified, so FONTSAVAILABLE would find them them on \FONTSINCORE. Here we scan all devices, not just display, to catch whatever might have shown up for a nondisplay device. So this simulates that behavior.") + + (* ;; "But for a user interaction like this, isn't it only DISPLAY families that matter, the descending-font lists for other devices are not relevant. So maybe we really want only DISPLAY here.") + + (LET (KNOWNFAMILIES FAMILY) + (for FS in (FONTSAVAILABLE '* '* NIL NIL '*) do (pushnew KNOWNFAMILIES (fetch (FONTSPEC + FSFAMILY) + of FS))) + (if (AND KNOWNFAMILIES (NEQ (SETQ FAMILY (\CURSOR.IN.MIDDLE.MENU + (create MENU + ITEMS _ [APPEND + (SORT KNOWNFAMILIES) + '(("other" 'OTHER "prompts for a family not on the menu." - )) KNOWNFAMILIES) - TITLE _ (OR TITLE "Choose font") - CENTERFLG _ T))) - 'OTHER)) - (RETURN FAMILY)) - (T (* grab the tty.) - (TTY.PROCESS (THIS.PROCESS)) - (RETURN (CAR (ERSETQ (MKATOM (U-CASE (PROMPTFORWORD "New family: " NIL NIL - (GETPROMPTWINDOW SKW]) + ] + TITLE _ (OR TITLE "Choose font") + CENTERFLG _ T))) + 'OTHER)) + then FAMILY + else (CAR (ERSETQ (MKATOM (U-CASE (TTYINPROMPTFORWORD "New family: " NIL NIL ( + GETPROMPTWINDOW + SKW]) (CLOSE.PROMPT.WINDOW [LAMBDA (WINDOW) (* rrb "28-Oct-84 14:14") @@ -5189,44 +5195,36 @@ Click outside the window to stop.") (RETURN NEWSCREENELT]) (SK.CHANGE.TEXT - [LAMBDA (ELTWITHTEXT HOW SKW) (* ; "Edited 7-Apr-87 13:41 by rrb") + [LAMBDA (ELTWITHTEXT HOW SKW) (* ; "Edited 30-Nov-2025 10:55 by rmk") + (* ; "Edited 8-Nov-2025 14:02 by rmk") + (* ; "Edited 7-Nov-2025 09:05 by rmk") + (* ; "Edited 7-Apr-87 13:41 by rrb") (PROG ((COMMAND (CADR HOW)) (PROPERTY 'FONT) - NEWVALUE GINDTEXTELT NEWGTEXT OLDVALUE OLDFACE GTYPE) - (OR HOW (RETURN)) (* take down the caret before any - change.) + NEWVALUE GINDTEXTELT NEWGTEXT OLDFONT GTYPE) + (CL:UNLESS HOW (RETURN)) (* ; + "take down the caret before any change.") (SKED.CLEAR.SELECTION SKW) - (COND - ((MEMB (SETQ GTYPE (fetch (GLOBALPART GTYPE) of ELTWITHTEXT)) - '(TEXTBOX TEXT)) + (CL:WHEN (MEMB (SETQ GTYPE (fetch (GLOBALPART GTYPE) of ELTWITHTEXT)) + '(TEXTBOX TEXT)) (SETQ GINDTEXTELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of ELTWITHTEXT)) - - (* set the old value to the old font. In the case where the thing that changes - is the justification, this will get re-set) - - (SETQ OLDVALUE (fetch (TEXT FONT) of GINDTEXTELT)) + (SETQ OLDFONT (fetch (TEXT FONT) of GINDTEXTELT)) (SETQ NEWGTEXT (SELECTQ (CAR HOW) (TEXT (SELECTQ COMMAND - ((SMALLER LARGER) (* change the font) + ((SMALLER LARGER) (* ; "change the font") [COND - [[SETQ NEWVALUE (SK.NEXTSIZEFONT COMMAND - (LIST (FONTPROP OLDVALUE 'FAMILY) - (FONTPROP OLDVALUE 'SIZE] - (* if there is an appropriate size - font, use it.) - [SETQ NEWVALUE (LIST (FONTPROP NEWVALUE 'FAMILY) - (FONTPROP NEWVALUE 'SIZE) - (FONTPROP OLDVALUE 'FACE] - (COND - ((EQ GTYPE 'TEXT) - (create TEXT using GINDTEXTELT FONT _ NEWVALUE)) - (T (create TEXTBOX using GINDTEXTELT FONT _ NEWVALUE] - (T (* otherwise just scale the area some.) - (SETQ NEWVALUE (FTIMES (SETQ OLDVALUE (fetch (TEXT + ((SETQ NEWVALUE (SK.NEXTSIZEFONT COMMAND OLDFONT)) + (* ; + "if there is an appropriate size font, use it.") + (OR (SK.CHANGE.FONT SKW ELTWITHTEXT NEWVALUE NIL) + (RETURN))) + (T (* ; + "otherwise just scale the area some.") + (SETQ NEWVALUE (FTIMES (SETQ OLDFONT (fetch (TEXT INITIALSCALE - ) - of GINDTEXTELT)) + ) + of GINDTEXTELT)) (SELECTQ COMMAND (LARGER 1.4) 0.7142858))) @@ -5236,18 +5234,18 @@ Click outside the window to stop.") (create TEXT using GINDTEXTELT INITIALSCALE _ NEWVALUE)) (T (create TEXTBOX using GINDTEXTELT INITIALSCALE _ NEWVALUE]) - ((CENTER LEFT RIGHT) (* change the horizontal justification) - [SETQ NEWVALUE (LIST COMMAND (CADR (SETQ OLDVALUE - (fetch (TEXT TEXTSTYLE) - of GINDTEXTELT] + ((CENTER LEFT RIGHT) (* ; + "change the horizontal justification") + (SETQ OLDFONT (fetch (TEXT TEXTSTYLE) of GINDTEXTELT)) + (SETQ NEWVALUE (LIST COMMAND (CADR OLDFONT))) (SETQ PROPERTY 'JUSTIFICATION) (COND ((EQ GTYPE 'TEXT) (create TEXT using GINDTEXTELT TEXTSTYLE _ NEWVALUE)) (T (create TEXTBOX using GINDTEXTELT TEXTSTYLE _ NEWVALUE)))) - ((TOP BOTTOM MIDDLE BASELINE) (* change the vertical justification) - [SETQ NEWVALUE (LIST (CAR (SETQ OLDVALUE (fetch (TEXT TEXTSTYLE) - of GINDTEXTELT))) + ((TOP BOTTOM MIDDLE BASELINE) (* ; "change the vertical justification") + (SETQ OLDFONT (fetch (TEXT TEXTSTYLE) of GINDTEXTELT)) + [SETQ NEWVALUE (LIST (CAR OLDFONT) (COND ((EQ COMMAND 'MIDDLE) 'CENTER) @@ -5257,28 +5255,27 @@ Click outside the window to stop.") ((EQ GTYPE 'TEXT) (create TEXT using GINDTEXTELT TEXTSTYLE _ NEWVALUE)) (T (create TEXTBOX using GINDTEXTELT TEXTSTYLE _ NEWVALUE)))) - ((BOLD UNBOLD ITALIC UNITALIC) (* change the face) - (SETQ OLDFACE (FONTPROP OLDVALUE 'FACE)) - [SETQ NEWVALUE (LIST (FONTPROP OLDVALUE 'FAMILY) - (FONTPROP OLDVALUE 'SIZE) - (LIST (SELECTQ COMMAND - (BOLD 'BOLD) - (UNBOLD 'MEDIUM) - (CAR OLDFACE)) - (SELECTQ COMMAND - (ITALIC 'ITALIC) - (UNITALIC 'REGULAR) - (CADR OLDFACE)) - (CADDR OLDFACE] - (COND - ((EQ GTYPE 'TEXT) - (create TEXT using GINDTEXTELT FONT _ NEWVALUE)) - (T (create TEXTBOX using GINDTEXTELT FONT _ NEWVALUE)))) - (BOX (* if it is a text element, BOX it) + ((BOLD UNBOLD ITALIC UNITALIC) (* ; "change the face") + (OR [SK.CHANGE.FONT SKW ELTWITHTEXT NIL NIL + (MAKEFONTFACE (SELECTQ COMMAND + (BOLD 'BOLD) + (UNBOLD 'MEDIUM) + NIL) + (SELECTQ COMMAND + (ITALIC 'ITALIC) + (UNITALIC 'REGULAR) + NIL) + NIL + (FONTPROP (fetch (TEXT FONT) of GINDTEXTELT) + 'FACE] + (RETURN))) + (BOX (* ; + "RMK 2025: RETURN MEANS NO HISTORY?") + (* ; "if it is a text element, BOX it") [COND ((EQ GTYPE 'TEXT) (RETURN (SK.TEXTBOX.FROM.TEXT ELTWITHTEXT SKW]) - (UNBOX (* if it is a text box, unbox it.) + (UNBOX (* ; "if it is a text box, unbox it.") [COND ((EQ GTYPE 'TEXTBOX) (RETURN (SK.TEXT.FROM.TEXTBOX ELTWITHTEXT SKW]) @@ -5286,72 +5283,32 @@ Click outside the window to stop.") ((EQ GTYPE 'TEXT) (RETURN (SK.LOOKEDSTRING.FROM.TEXT ELTWITHTEXT SKW]) (SHOULDNT))) - (SETSIZE (SETQ NEWVALUE COMMAND) - (COND - [(EQ (FONTPROP NEWVALUE 'FAMILY) - (FONTPROP OLDVALUE 'FAMILY)) - - (* if the families are the same, change them, otherwise don't as it isn't known - whether or not this family has the right size.) + (SETSIZE + (* ;; "if the families are the same, change them, otherwise don't as it isn't known whether or not this family has the right size.") - (COND - [(EQ GTYPE 'TEXT) - (create TEXT using GINDTEXTELT FONT _ (LIST (FONTPROP - OLDVALUE - 'FAMILY) - (FONTPROP - NEWVALUE - 'SIZE) - (FONTPROP - OLDVALUE - 'FACE] - (T (create TEXTBOX using GINDTEXTELT FONT _ - (LIST (FONTPROP OLDVALUE 'FAMILY) - (FONTPROP NEWVALUE 'SIZE) - (FONTPROP OLDVALUE 'FACE] - (T (RETURN)))) - (NEWFONT (* set the font family) - [SETQ NEWVALUE (LIST COMMAND (FONTPROP OLDVALUE 'SIZE) - (FONTPROP OLDVALUE 'FACE] - (COND - ((NULL (FONTCREATE NEWVALUE NIL NIL NIL NIL T)) - (STATUSPRINT SKW " Couldn't find " (CAR NEWVALUE) - " in size " - (CADR NEWVALUE)) - (RETURN))) - (COND - ((EQ GTYPE 'TEXT) - (create TEXT using GINDTEXTELT FONT _ NEWVALUE)) - (T (create TEXTBOX using GINDTEXTELT FONT _ NEWVALUE)))) - (FAMILY&SIZE (* set the font family and size) - [SETQ NEWVALUE (LIST (CAR COMMAND) - (CADR COMMAND) - (FONTPROP (fetch (TEXT FONT) of GINDTEXTELT) - 'FACE] - (COND - ((EQ GTYPE 'TEXT) - (create TEXT using GINDTEXTELT FONT _ NEWVALUE)) - (T (create TEXTBOX using GINDTEXTELT FONT _ NEWVALUE)))) - (SAME - - (* set all of the font characteristics from the first selected one.) - - (* set the variables to cause the right things to go into the change spec - event.) - - (SETQ OLDVALUE ELTWITHTEXT) + [AND (EQ (FONTPROP COMMAND 'FAMILY) + (FONTPROP OLDFONT 'FAMILY)) + (SK.CHANGE.FONT SKW ELTWITHTEXT NIL (FONTPROP COMMAND 'SIZE]) + (NEWFONT (* ; "set the font family") + (SK.CHANGE.FONT SKW ELTWITHTEXT COMMAND)) + (FAMILY&SIZE (* ; "set the font family and size") + (SK.CHANGE.FONT SKW ELTWITHTEXT (CAR COMMAND) + (CADR COMMAND))) + (SAME (* ; + "set all of the font characteristics from the first selected one.") + (* ; + "set the variables to cause the right things to go into the change spec event.") + (SETQ OLDFONT ELTWITHTEXT) (SETQ PROPERTY 'LOOKSAME) (SETQ NEWVALUE (SK.TEXT.ELT.WITH.SAME.FIELDS (fetch (GLOBALPART INDIVIDUALGLOBALPART ) of COMMAND) GINDTEXTELT))) (SHOULDNT))) + (CL:UNLESS NEWGTEXT (RETURN)) [SETQ NEWGTEXT (COND - [(EQ GTYPE 'TEXT) - - (* adjust the scales at which this appears because font or scale may have - changed.) - + [(EQ GTYPE 'TEXT) (* ; + "adjust the scales at which this appears because font or scale may have changed.") (TEXT.SET.SCALES (create GLOBALPART COMMONGLOBALPART _ (fetch (GLOBALPART COMMONGLOBALPART @@ -5360,11 +5317,8 @@ Click outside the window to stop.") INDIVIDUALGLOBALPART _ ( TEXT.SET.GLOBAL.REGIONS NEWGTEXT] - (T - - (* scaling for text boxes depends on the box size which can't change in this - function.) - + (T (* ; + "scaling for text boxes depends on the box size which can't change in this function.") (create GLOBALPART COMMONGLOBALPART _ (fetch (GLOBALPART COMMONGLOBALPART) of ELTWITHTEXT) @@ -5375,7 +5329,32 @@ Click outside the window to stop.") OLDELT _ ELTWITHTEXT PROPERTY _ PROPERTY NEWVALUE _ NEWVALUE - OLDVALUE _ OLDVALUE]) + OLDVALUE _ OLDFONT)))]) + +(SK.CHANGE.FONT + [LAMBDA (SKW ELTWITHTEXT FAMILY SIZE FACE) (* ; "Edited 30-Nov-2025 10:50 by rmk") + (* ; "Edited 7-Nov-2025 09:09 by rmk") + (LET (NEWFS) + [if (FONTP FAMILY) + then (SETQ NEWFS (FONTPROP FAMILY 'SPEC)) + else [SETQ NEWFS (OR (LISTP FAMILY) + (MAKEFONTSPEC FAMILY SIZE FACE NIL NIL (fetch (TEXT FONT) + of (fetch (GLOBALPART + + INDIVIDUALGLOBALPART + ) of ELTWITHTEXT + ] + (CL:UNLESS (FONTCREATE NEWFS NIL NIL NIL NIL T) + (STATUSPRINT SKW " Couldn't find " (fetch (FONTSPEC FSFAMILY) of NEWFS) + " in size " + (fetch (FONTSPEC FSSIZE) of NEWFS)))] + (CL:WHEN NEWFS + (if (EQ (fetch (GLOBALPART GTYPE) of ELTWITHTEXT) + 'TEXT) + then (create TEXT using (fetch (GLOBALPART INDIVIDUALGLOBALPART) of ELTWITHTEXT) + FONT _ NEWFS) + else (create TEXTBOX using (fetch (GLOBALPART INDIVIDUALGLOBALPART) of ELTWITHTEXT) + FONT _ NEWFS)))]) (TEXT.SET.SCALES [LAMBDA (GTEXTELT) (* rrb "12-May-85 16:29") @@ -5418,321 +5397,188 @@ Click outside the window to stop.") ) (DEFINEQ -(ADD.KNOWN.SKETCH.FONT - [LAMBDA (FAMILY WID DEVICE FONT) (* ; "Edited 10-May-93 16:49 by rmk:") - (* ; "Edited 21-Feb-89 15:06 by snow") - - (* ;; "add to the globally cached font list") - - (DECLARE (GLOBALVARS \KNOWN.SKETCH.FONTSIZES)) - [LET ((CACHE (ASSOC FAMILY \KNOWN.SKETCH.FONTSIZES)) - (CACHED)) - (COND - [(NULL CACHE) - (if \KNOWN.SKETCH.FONTSIZES - then [NCONC1 \KNOWN.SKETCH.FONTSIZES (LIST FAMILY (LIST DEVICE (CONS WID FONT] - else (SETQ \KNOWN.SKETCH.FONTSIZES (LIST (LIST FAMILY (LIST DEVICE - (CONS WID FONT] - (T (COND - ((SETQ CACHED (ASSOC DEVICE CACHE)) - (NCONC1 CACHED (CONS WID FONT))) - (T (NCONC1 CACHE (CONS DEVICE (CONS WID FONT] - FONT]) - (SK.PICK.FONT - [LAMBDA (WID STRING DEVICE DISPLAYGFONT) (* ; "Edited 10-May-93 17:11 by rmk:") - (* ; "Edited 22-Feb-89 07:53 by snow") + [LAMBDA (WID STRING DEVICE DISPLAYFONT) (* ; "Edited 6-Nov-2025 10:41 by rmk") + (* ; "Edited 1-Sep-2025 13:02 by rmk") + (* ; "Edited 10-May-93 17:11 by rmk:") + (* ; "Edited 22-Feb-89 07:53 by snow") - (* ;; "returns the font in FAMILY that text should be printed in to have the text STRING fit into a region WID points wide") + (* ;; "RMK 2025: This is weird, and I'm not sure that the original ever worked. It is called from only one place (SK.CHOOSE.TEXT.FONT), with one constant STRING. I believe it is trying to associate with DISPLAYFONT's family a corresponding DEVICE font for which the width of that string would be closest to WID without being larger than that. It caches that font for WID, since that really is just a constant.") + + (* ;; "Returns the font in DISPLAYFONT's family that text should be printed in to have the text STRING fit into a region WID points wide. The value can also be the atom SHADE, if there is no font small enough for STRING.") (DECLARE (GLOBALVARS \KNOWN.SKETCH.FONTSIZES)) - (LET - [STARTFONT FONTWIDTH SCALE CACHEDFONT SIZE (FAMILY (FONTPROP DISPLAYGFONT 'FAMILY] - (IF [SETQ CACHEDFONT (ASSOC WID (ASSOC DEVICE (ASSOC FAMILY \KNOWN.SKETCH.FONTSIZES] - THEN (CDR CACHEDFONT) - ELSE (SETQ STARTFONT (FONTCOPY DISPLAYGFONT 'DEVICE DEVICE)) - NIL - (SETQ SCALE (FONTPROP STARTFONT 'SCALE)) - (SETQ SIZE (FONTPROP STARTFONT 'SIZE)) - [SETQ FONTWIDTH (COND - (SCALE - (* ;; "IF THERE IS A SCALE, YOU MUST SCALE THE WIDTH.") + (LET ((FAMILY (FONTPROP DISPLAYFONT 'FAMILY)) + STARTFONT FONTWIDTH SCALE CACHEDFONT AVAIL TOOSMALL) + (if (SGETMULTI \KNOWN.SKETCH.FONTSIZES FAMILY DEVICE WID (FONTPROP DISPLAYFONT 'FACE)) + else (SETQ STARTFONT (FONTCOPY DISPLAYFONT 'DEVICE DEVICE)) + (SETQ SCALE (FONTPROP STARTFONT 'SCALE)) + (SETQ FONTWIDTH (STRINGWIDTH STRING STARTFONT)) + (CL:IF SCALE + (SETQ FONTWIDTH (FIXR (QUOTIENT FONTWIDTH SCALE)))) + (if (IEQP FONTWIDTH WID) + then (PUTMULTI \KNOWN.SKETCH.FONTSIZES FAMILY DEVICE WID STARTFONT) + else + (* ;; "FONTSAVAILABLE sorts in increasing size order, so our first guess is either after or before the position of STARTFONT in the list. This assumes that the widths are proportional to font sizes.") - (FIXR (QUOTIENT (STRINGWIDTH STRING STARTFONT) - SCALE))) - (T (STRINGWIDTH STRING STARTFONT] - [SETQ CACHEDFONT - (IF (IGREATERP FONTWIDTH WID) - THEN + (SETQ TOOSMALL (ILESSP FONTWIDTH WID)) + (SETQ AVAIL (FONTSAVAILABLE (create FONTSPEC using (FONTPROP STARTFONT + 'SPEC) + FSSIZE _ '*) + NIL NIL NIL NIL T)) - (* ;; "Font width was too big, try smaller fonts in decreasing size.") + (* ;; + "If STARTFONT width is too big, try smaller fonts, otherwise bigger ones. CDR skips the STARTFONT") - [FOR FONT IN [CDR (FIND F - ON [SORT (FONTSAVAILABLE FAMILY '* - 'MRR 0 DEVICE T) - (FUNCTION (LAMBDA (F1 F2) - (IGREATERP (CADR F1) - (CADR F2] - SUCHTHAT (EQ SIZE (CADR F] - WHEN (ILESSP [SETQ FONTWIDTH (COND - (SCALE - (* ;; - "IF THERE IS A SCALE, YOU MUST SCALE THE WIDTH.") + (for FS FONT (PREVFONT _ STARTFONT) + (PREVWIDTH _ FONTWIDTH) in [CDR (MEMBER (FONTPROP STARTFONT 'SPEC) + (CL:IF TOOSMALL + AVAIL + (REVERSE AVAIL))] + eachtime (SETQ FONT (FONTCREATE FS)) + (SETQ FONTWIDTH (STRINGWIDTH STRING FONT)) + (CL:IF SCALE + (SETQ FONTWIDTH (FIXR (QUOTIENT FONTWIDTH SCALE)))) + until (CL:IF TOOSMALL + (IGREATERP FONTWIDTH WID) + (ILESSP FONTWIDTH WID)) do (SETQ PREVFONT FONT) + (SETQ PREVWIDTH FONTWIDTH) + finally - (FIXR (QUOTIENT (STRINGWIDTH - STRING FONT) - SCALE))) - (T (STRINGWIDTH STRING FONT] - WID) DO (RETURN (ADD.KNOWN.SKETCH.FONT FAMILY WID - DEVICE FONT)) - FINALLY (RETURN (ADD.KNOWN.SKETCH.FONT - FAMILY WID DEVICE - (IF (GREATERP FONTWIDTH (TIMES 1.5 WID)) - THEN 'SHADE - ELSEIF (OR FONT STARTFONT] - ELSEIF (IEQP FONTWIDTH WID) - THEN (ADD.KNOWN.SKETCH.FONT FAMILY WID DEVICE STARTFONT) - ELSE + (* ;; "We ran over, return the previous") - (* ;; "FONT width was too small, try bigger fonts.") - - (FOR FONT PREVFONT - IN [CDR (FIND F ON [SORT (FONTSAVAILABLE FAMILY '* 'MRR 0 DEVICE - T) - (FUNCTION (LAMBDA (F1 F2) - (ILESSP (CADR F1) - (CADR F2] - SUCHTHAT (EQ SIZE (CADR F] - DO (IF (IGREATERP (COND - (SCALE - (* ;; - "IF THERE IS A SCALE, YOU MUST SCALE THE WIDTH.") - - (FIXR (QUOTIENT (STRINGWIDTH STRING FONT - ) - SCALE))) - (T (STRINGWIDTH STRING FONT))) - WID) - THEN (RETURN (ADD.KNOWN.SKETCH.FONT FAMILY WID DEVICE - PREVFONT))) - (SETQ PREVFONT FONT) FINALLY (RETURN (ADD.KNOWN.SKETCH.FONT - FAMILY WID DEVICE - (OR FONT PREVFONT STARTFONT] - (IF (FONTP CACHEDFONT) - THEN (* ; "Could be SHADE") - (FONTCOPY CACHEDFONT 'FACE (FONTPROP DISPLAYGFONT 'FACE)) - ELSE CACHEDFONT]) + (CL:UNLESS TOOSMALL + (CL:WHEN (GREATERP PREVWIDTH (TIMES 1.5 WID)) + (* ; "If we get too small, return SHADE") + (SETQ PREVFONT 'SHADE))) + (SPUTMULTI \KNOWN.SKETCH.FONTSIZES FAMILY DEVICE WID + (FONTPROP DISPLAYFONT 'FACE) + PREVFONT) + (RETURN PREVFONT]) (SK.CHOOSE.TEXT.FONT - [LAMBDA (GTEXT SCALE VIEWER) (* ; "Edited 10-May-93 16:18 by rmk:") - (* ; "Edited 1-Nov-91 16:56 by jds") + [LAMBDA (GTEXT SCALE VIEWER) (* ; "Edited 6-Nov-2025 00:08 by rmk") + (* ; "Edited 10-May-93 16:18 by rmk:") + (* ; "Edited 1-Nov-91 16:56 by jds") - (* ;; "returns the font that text in the individual global part of a text or textbox element GTEXT should be displayed in when shown in VIEWER.") + (* ;; "returns the font that text in the individual global part of a text or textbox element GTEXT should be displayed in when shown in VIEWER.") (PROG ([VIEWERFONTCACHE (OR (AND (WINDOWP VIEWER) (WINDOWPROP VIEWER 'PICKFONTCACHE)) (AND (STREAMP VIEWER) (STREAMPROP VIEWER 'PICKFONTCACHE] (GFONT (fetch (TEXT FONT) of GTEXT)) - LOCALFONT) + (CANONICALTESTSTR "AWIaiw") + LOCALFONT CANONICALWIDTH DEVICE DISPLAYGFONT) + (CL:WHEN (SETQ LOCALFONT (SASSOC GFONT VIEWERFONTCACHE)) + (* ; "look in the viewer's font cache.") + (RETURN (CDR LOCALFONT))) + [SETQ DEVICE (COND + ((STREAMP VIEWER) + (fetch (IMAGEOPS IMAGETYPE) of (fetch (STREAM IMAGEOPS) of VIEWER))) + (T 'DISPLAY] [COND - ((SETQ LOCALFONT (SASSOC GFONT VIEWERFONTCACHE))(* ; - "look in the viewer's font cache.") - (RETURN (CDR LOCALFONT] - (RETURN (PROG ((CANONICALTESTSTR "AWIaiw") - CANONICALWIDTH DEVICE DISPLAYGFONT) - [SETQ DEVICE (COND - ((STREAMP VIEWER) - (fetch (IMAGEOPS IMFONTCREATE) - of (fetch (STREAM IMAGEOPS) of VIEWER))) - (T 'DISPLAY] - [COND - ((EQUAL (TIMES SCALE (DSPSCALE NIL VIEWER)) - (fetch (TEXT INITIALSCALE) of GTEXT)) + ((EQUAL (TIMES SCALE (DSPSCALE NIL VIEWER)) + (fetch (TEXT INITIALSCALE) of GTEXT)) - (* ;; "special case scales being the same so there is not a large delay when first character is typed and to avoid font look up problems when hardcopying at scale 1") + (* ;; "special case scales being the same so there is not a large delay when first character is typed and to avoid font look up problems when hardcopying at scale 1") - (SETQ LOCALFONT (FONTCREATE GFONT NIL NIL NIL DEVICE))) - (T - (* ;; "use a canonical string to determine the font size so that all strings of a given font at a given scale look the same. If font is determined by the width of the particular string, two different string will appear in different fonts. In particular, the string may change fonts as the user is typing into it.") + (SETQ LOCALFONT (FONTCREATE GFONT NIL NIL NIL DEVICE))) + (T + (* ;; "Use a canonical string to determine the font size so that all strings of a given font at a given scale look the same. If font is determined by the width of the particular string, two different strings will appear in different fonts. In particular, the string may change fonts as the user is typing into it.") - (* ;; "don't use the face information when determining string width because in some cases HELVETICA 10, the bold is smaller than the regular.") + (* ;; "The canonical width here is the natural font width having somehow taken into account the scale of the viewer and the initialscale of the text.") - (SETQ DISPLAYGFONT (FONTCREATE GFONT NIL NIL NIL 'DISPLAY)) - [SETQ CANONICALWIDTH - (FIXR (QUOTIENT (TIMES [STRINGWIDTH CANONICALTESTSTR - (LIST (FONTPROP DISPLAYGFONT - 'FAMILY) - (FONTPROP DISPLAYGFONT - 'SIZE] - (fetch (TEXT INITIALSCALE) of GTEXT)) - (TIMES SCALE (DSPSCALE NIL VIEWER] - (* ; "calculate the local font.") - (SETQ LOCALFONT (SK.PICK.FONT CANONICALWIDTH CANONICALTESTSTR - DEVICE DISPLAYGFONT] - [COND - ((WINDOWP VIEWER) - (WINDOWPROP VIEWER 'PICKFONTCACHE (CONS (CONS GFONT LOCALFONT) - VIEWERFONTCACHE))) - ((STREAMP VIEWER) - (STREAMPROP VIEWER 'PICKFONTCACHE (CONS (CONS GFONT LOCALFONT) - VIEWERFONTCACHE] - (RETURN LOCALFONT]) + (SETQ DISPLAYGFONT (FONTCREATE GFONT NIL NIL NIL 'DISPLAY)) + [SETQ CANONICALWIDTH + (FIXR (QUOTIENT (TIMES (STRINGWIDTH CANONICALTESTSTR + (if NIL + then (create FONTSPEC using (FONTPROP DISPLAYGFONT + 'SPEC) + FSFACE _ + (MAKEFONTFACE + 'MEDIUM + 'REGULAR + 'REGULAR)) + else + + (* ;; "Original code didn't use the face information when determining string width because, it said, that in some cases HELVETICA 10, the bold is smaller than the regular. ") + + DISPLAYGFONT)) + (fetch (TEXT INITIALSCALE) of GTEXT)) + (TIMES SCALE (DSPSCALE NIL VIEWER] + (* ; "calculate the local font.") + (SETQ LOCALFONT (SK.PICK.FONT CANONICALWIDTH CANONICALTESTSTR DEVICE DISPLAYGFONT] + [COND + ((WINDOWP VIEWER) + (WINDOWPROP VIEWER 'PICKFONTCACHE (CONS (CONS GFONT LOCALFONT) + VIEWERFONTCACHE))) + ((STREAMP VIEWER) + (STREAMPROP VIEWER 'PICKFONTCACHE (CONS (CONS GFONT LOCALFONT) + VIEWERFONTCACHE] + (RETURN LOCALFONT]) (SK.NEXTSIZEFONT - [LAMBDA (WHICHDIR NOWFONT) (* rrb "14-Jul-86 13:43") - - (* returns the next sized font either SMALLER or LARGER that on of size FONT.) + [LAMBDA (WHICHDIR NOWFONT) (* ; "Edited 6-Nov-2025 22:52 by rmk") + (* rrb "14-Jul-86 13:43") - (PROG [(NOWSIZE (FONTPROP NOWFONT 'HEIGHT)) - (DECREASEFONTLST (SK.DECREASING.FONT.LIST (CAR NOWFONT) - 'DISPLAY] - (RETURN (COND - [(EQ WHICHDIR 'LARGER) - (COND - ((IGEQ NOWSIZE (FONTPROP (CAR DECREASEFONTLST) - 'HEIGHT)) (* nothing larger) - NIL) - (T (for FONTTAIL on DECREASEFONTLST - when [AND (CDR FONTTAIL) - (IGEQ NOWSIZE (FONTPROP (CADR FONTTAIL) - 'HEIGHT] - do (RETURN (SK.FONTNAMELIST (CAR FONTTAIL] - (T (for FONT in DECREASEFONTLST when (LESSP (FONTPROP FONT 'HEIGHT) - NOWSIZE) - do (RETURN (SK.FONTNAMELIST FONT]) + (* ;; "Returns the next sized font either SMALLER or LARGER that on of size FONT. This returns FONTSPEC, not font descriptor") + + (* ;; "RMK 2025: The original code tested HEIGHT, but SK.DECREASING.FONT.LIST orders according to SIZE. Presumably correlated, but if they ever got out of whack, this would be wrong. So changed to SIZE.") + + (* ;; "Also, this returns a FONTSPEC, not the font descriptor.") + + (LET [(NOWSIZE (FONTPROP NOWFONT 'SIZE)) + (DECREASEFONTLST (SK.DECREASING.FONT.LIST (FONTPROP NOWFONT 'FAMILY) + 'DISPLAY] + (COND + [(EQ WHICHDIR 'LARGER) + (CL:WHEN (ILESSP NOWSIZE (FONTPROP (CAR DECREASEFONTLST) + 'SIZE)) (* ; "Otherwise, nothing larger") + [for FONTTAIL on DECREASEFONTLST when [AND (CDR FONTTAIL) + (IGEQ NOWSIZE (FONTPROP (CADR FONTTAIL) + 'SIZE] + do (RETURN (FONTPROP (CAR FONTTAIL) + 'SPEC])] + (T (for FONT in DECREASEFONTLST when (LESSP (FONTPROP FONT 'SIZE) + NOWSIZE) + do (RETURN (FONTPROP FONT 'SPEC]) (SK.DECREASING.FONT.LIST - [LAMBDA (FAMILY DEVICETYPE) (* ; - "Edited 12-Oct-92 12:39 by sybalsky:mv:envos") + [LAMBDA (FAMILY DEVICE) (* ; "Edited 6-Nov-2025 17:40 by rmk") + (* ; "Edited 4-Nov-2025 15:34 by rmk") + (* ; + "Edited 12-Oct-92 12:39 by sybalsky:mv:envos") - (* ;; "returns a list of fonts of family FAMILY which work on device DEVICETYPE") + (* ;; "This is used to find the best font for FAMILY on DEVICE that will allow a string to fit in a box, or to find the next larger/smaller font while editing. ") - [COND - ((NULL FAMILY) - (SETQ FAMILY 'MODERN] + (* ;; "RMK 2025: The original code anticipated the coercions of the PRESS/INTERPRESS/POSTSCRIPT devices, building in e.g. that HELVETICA maps to MODERN on INTERPRESS and not even looking to see if there are any INTERPRESS HELVETICA fonts available or if e.g. INTERPRESS TERMINAL would coerce to MODERN for other sizes. ") - (* ;; "convert to families that exist on the known devices.") + (* ;; "That is, if FAMILY is TERMINAL for INTERPRESS, this would only return fonts for sizes 6 8 10 12 even though coercions to MODERN might give smaller and bigger sizes.") -(* ;;; "NOTE: this is a very bad way to convert the family. It HARDCODES in the conversions for PRESS and INTERPRESS and does nothing for new device types. I have added the conversion for POSTSCRIPT that does things a little cleaner, but it should really look at a property of the device (fontconversions or some such animal.) --was 2/19/89") + (* ;; "This code looks up all of the possible coercions of the given family to get all possible coerceable sizes, then relies on the related coercions in FONTCREATE to produce FAMILY fonts possibly constructed from data in the files for some other font. E.g. TERMINAL 14 will have the data from MODERN 14.") - (LET ((CONVERSION)) - [COND - [(EQ DEVICETYPE 'PRESS) - (COND - ((EQ FAMILY 'MODERN) - (SETQ FAMILY 'HELVETICA)) - ((EQ FAMILY 'CLASSIC) - (SETQ FAMILY 'TIMESROMAN)) - ((EQ FAMILY 'TERMINAL) - (SETQ FAMILY 'GACHA] - [(EQ DEVICETYPE 'INTERPRESS) - (COND - ((EQ FAMILY 'HELVETICA) - (SETQ FAMILY 'MODERN)) - ((EQ FAMILY 'TIMESROMAN) - (SETQ FAMILY 'CLASSIC)) - ((EQ FAMILY 'GACHA) - (SETQ FAMILY 'TERMINAL] - ((EQ DEVICETYPE 'POSTSCRIPT) - (if (SETQ CONVERSION (ASSOC FAMILY POSTSCRIPT.FONT.ALIST)) - then + (* ;; "This is also device independent: should work for HTML (whether or not HTML specifies any CHARCOERCIONS).") - (* ;; - "convert the family here for postscript as well as the other well known devices.") + (* ;; "Note that FONTSAVAILABLE caches its file lookups and FONTCREATE caches its fonts.") - (SETQ FAMILY (CDR CONVERSION] - (for FONT in (SK.GUESS.FONTSAVAILABLE FAMILY DEVICETYPE) - collect (FONTCOPY FONT 'DEVICE DEVICETYPE]) + (CL:UNLESS FAMILY + (SETQ FAMILY 'MODERN)) + (LET ((FAMSPEC (create FONTSPEC + FSFAMILY _ FAMILY + FSSIZE _ '* + FSDEVICE _ DEVICE))) -(SK.GUESS.FONTSAVAILABLE - [LAMBDA (FAMILY HDCPYTYPE) (* rrb " 9-Oct-85 16:10") - - (* returns a list of all fonts of a FAMILY in decreasing order.) + (* ;; "Run through all sizes for all the fonts for FAMILY or any of its coercions on DEVICE. This gives us all the possible sizes for FAMILY, we ask FONTCREATE to create a FAMILY font for each of those sizes.") - (PROG (FILEFONTS CACHE DISPLAYFONTSIZES) - (SETQ HDCPYTYPE (COND - ((NULL HDCPYTYPE) - (PRINTERTYPE)) - ((NLISTP HDCPYTYPE) - HDCPYTYPE) - (T HDCPYTYPE))) (* cache the file fonts.) - [COND - [[SETQ FILEFONTS (ASSOC HDCPYTYPE (CDR (ASSOC FAMILY \FONTSONFILE] - - (* note if a cache has been calculated. Use it even if it is NIL) - - (* \FONTSONFILE seems to group things such as CLASSICTHIN under CLASSIC so make - sure to remove anything that has the wrong family.) - - (SETQ FILEFONTS (SUBSET (CDR FILEFONTS) - (FUNCTION (LAMBDA (X) - (EQ (CAR X) - FAMILY] - (T (RESETFORM (CURSOR WAITINGCURSOR) - (SETQ FILEFONTS (FONTSAVAILABLE FAMILY '* '(MEDIUM REGULAR REGULAR) NIL - HDCPYTYPE T)) - - (* Since there is no way to determine the real sizes for PRESS fonts with size - of 0 {meaning the widths scale}, guess that they are available in 10) - - [COND - [(EQ HDCPYTYPE 'PRESS) - - (* make sure to look for anything that has a display font.) - - (SETQ DISPLAYFONTSIZES (for FONT - in (FONTSAVAILABLE FAMILY '* - '(MEDIUM REGULAR REGULAR) NIL - 'DISPLAY) collect (CADR FONT))) - (SETQ FILEFONTS - (for FONT in FILEFONTS - join (COND - [(EQ (CADR FONT) - 0) - (for SIZE - in (UNION DISPLAYFONTSIZES - '(36 30 24 18 14 12 10 8 6)) - when (FONTCREATE (CAR FONT) - SIZE NIL NIL 'DISPLAY T) - collect (CONS (CAR FONT) - (CONS SIZE (CDDR FONT] - (T (CONS FONT] - ((EQ HDCPYTYPE 'DISPLAY) - - (* patch around the bug in FONTSAVAILABLE. - Remove after J release.) - - (SETQ FILEFONTS (SUBSET FILEFONTS (FUNCTION (LAMBDA (FONT) - (EQUAL (CADDR FONT) - '(MEDIUM REGULAR - REGULAR] - (* remove duplicates and sort) - [SETQ FILEFONTS (SORT (INTERSECTION FILEFONTS FILEFONTS) - (FUNCTION (LAMBDA (A B) - (GREATERP (CADR A) - (CADR B] - (COND - ((NULL (SETQ CACHE (ASSOC FAMILY \FONTSONFILE))) - (SETQ \FONTSONFILE (CONS (LIST FAMILY (CONS HDCPYTYPE FILEFONTS)) - \FONTSONFILE))) - (T (NCONC1 CACHE (CONS HDCPYTYPE FILEFONTS] - - (* reget the fonts in core since they may have changed since last time.) - - (RETURN (SORT (UNION (FONTSAVAILABLE FAMILY '* NIL NIL HDCPYTYPE) - FILEFONTS) - (FUNCTION (LAMBDA (A B) - (COND - ((EQ (CADR A) - (CADR B)) - - (* in case both TIMESROMAN and TIMESROMAND for example make it in.) - - (ALPHORDER (CADR A) - (CADR B))) - (T (GREATERP (CADR A) - (CADR B]) + (for FS SIZES in (for FS in [CONS FAMSPEC (COERCEFONTSPEC FAMSPEC (FONTDEVICEPROP + DEVICE + 'CHARCOERCIONS] + join (FONTSAVAILABLE FS NIL NIL NIL NIL T)) + do (pushnew SIZES (fetch (FONTSPEC FSSIZE) of FS)) + finally (RETURN (for S in [SORT SIZES (FUNCTION (LAMBDA (S1 S2) + (IGREATERP S1 S2] + collect (FONTCREATE FAMILY S NIL NIL DEVICE]) ) (RPAQ? \KNOWN.SKETCH.FONTSIZES ) @@ -5753,37 +5599,28 @@ Click outside the window to stop.") (DEFINEQ (SK.SET.FONT - [LAMBDA (W NEWFONT) (* rrb " 2-Oct-85 14:55") - - (* sets the entire default font. Used when a sketch stream is created. - or any of the defaults are changed. NEWFONT is a list of - (FAMILY SIZE FACE)) + [LAMBDA (W NEWFONT) (* ; "Edited 4-Nov-2025 13:06 by rmk") + (* rrb " 2-Oct-85 14:55") - (COND - (NEWFONT (COND - ((FONTCREATE NEWFONT NIL NIL NIL NIL T) - - (* clear the cache of looked up fonts. This provides the user a way of clearing - the cache that shouldn't happen too much and is documented.) + (* ;; "Sets the default font. Used when a sketch stream is created. or any of the defaults are changed. NEWFONT is a fontspec") - (AND (FASSOC (CAR NEWFONT) - \FONTSONFILE) - (SETQ \FONTSONFILE (for BUCKET in \FONTSONFILE - when (NEQ (CAR BUCKET) - (CAR NEWFONT)) collect BUCKET))) - (replace (SKETCHCONTEXT SKETCHFONT) of (WINDOWPROP W 'SKETCHCONTEXT) with NEWFONT - )) - (T (STATUSPRINT W (CAR NEWFONT) - " " - (CADR NEWFONT) - " " - (SELECTQ (CAR (CADDR NEWFONT)) - (BOLD 'BOLD) - "") - (SELECTQ (CADR (CADDR NEWFONT)) - (ITALIC 'ITALIC) - "") - " not found"]) + (CL:WHEN NEWFONT + (if (FONTCREATE NEWFONT NIL NIL NIL NIL T) + then + (* ;; "Tests to make sure the font exists, but stores the fontspec.") + + (replace (SKETCHCONTEXT SKETCHFONT) of (WINDOWPROP W 'SKETCHCONTEXT) with NEWFONT) + else (STATUSPRINT W (fetch (FONTSPEC FSFAMILY) of NEWFONT) + " " + (fetch (FONTSPEC FSSIZE) of NEWFONT) + " " + (SELECTQ (fetch (FONTFACE WEIGHT) of (fetch (FONTSPEC FSFACE) of NEWFONT)) + (BOLD 'BOLD) + "") + (SELECTQ (fetch (FONTFACE SLOPE) of (fetch (FONTSPEC FSFACE) of NEWFONT)) + (ITALIC 'ITALIC) + "") + " not found")))]) (SK.SET.TEXT.FONT [LAMBDA (W) (* rrb " 4-Oct-85 16:21") @@ -5838,90 +5675,51 @@ Click outside the window to stop.") of SKCONTEXT]) (SK.READFONTSIZE - [LAMBDA (TITLE FONTFAMILY SKW) (* rrb " 6-Nov-85 09:51") - - (* * gets a legal known font size from the user.) - - (* this should have MENUROWS _ 1 when title height bug in menu package gets - fixed.) + [LAMBDA (TITLE FONTFAMILY SKW) (* ; "Edited 4-Nov-2025 20:12 by rmk") + (* rrb " 6-Nov-85 09:51") - (PROG ((FONTSIZES (SK.COLLECT.FONT.SIZES FONTFAMILY)) - NEWSIZE) - (COND - ((NULL FONTSIZES) - (GO MORE))) - (SETQ NEWSIZE (\CURSOR.IN.MIDDLE.MENU (create MENU - TITLE _ (COND - (TITLE) - (FONTFAMILY (CONCAT "new " - FONTFAMILY - " size?")) - (T "New font size?")) - ITEMS _ (CONS '(More 'MORE - "will look on font directories to find more sizes." - ) FONTSIZES) - CENTERFLG _ T))) - (COND - ((NEQ NEWSIZE 'MORE) - (RETURN NEWSIZE))) - MORE - (* do longer search of files) - (SETQ NEWSIZE (SK.COLLECT.FONT.SIZES FONTFAMILY T)) - (COND - ((NULL NEWSIZE) (* could not find any fonts of that - family) - (RETURN NIL)) - ((EQUAL NEWSIZE FONTSIZES) (* not new ones found) - (STATUSPRINT SKW " -No more font sizes found."))) - (RETURN (MENU (create MENU - TITLE _ (OR TITLE "New font size?") - ITEMS _ NEWSIZE - CENTERFLG _ T]) + (* ;; "Gets a legal known font size from the user.") + (* ; "this should have MENUROWS _ 1 when title height bug in menu package gets fixed. RMK 2025: Is this still an issue?") + (CL:UNLESS TITLE + (SETQ TITLE (CONCAT "New " (OR FONTFAMILY "font") + " size?"))) + (LET ((FONTSIZES (SK.COLLECT.FONT.SIZES FONTFAMILY)) + (NEWSIZE 'MORE)) + (CL:WHEN FONTSIZES + (SETQ NEWSIZE (\CURSOR.IN.MIDDLE.MENU (create MENU + TITLE _ TITLE + ITEMS _ (NCONC1 FONTSIZES + '(More 'MORE + "Look on font-file directories to find more sizes" + )) + CENTERFLG _ T)))) + (CL:WHEN (EQ NEWSIZE 'MORE) (* ; "do longer search of files") + (SETQ FONTSIZES (LDIFFERENCE (SK.COLLECT.FONT.SIZES FONTFAMILY 'ONLY) + FONTSIZES)) + (SETQ NEWSIZE + (if FONTSIZES + then (MENU (create MENU + TITLE _ TITLE + ITEMS _ FONTSIZES + CENTERFLG _ T)) + else (STATUSPRINT SKW " +No more font sizes found.") + NIL))) + NEWSIZE]) (SK.COLLECT.FONT.SIZES - [LAMBDA (FAMILY FILESTOOFLG) (* rrb " 2-Oct-85 10:43") - - (* collects all of the sizes that are known. - If FAMILY is given, gets just those sizes.) + [LAMBDA (FAMILY FILESTOOFLG) (* ; "Edited 4-Nov-2025 20:02 by rmk") + (* rrb " 2-Oct-85 10:43") - (PROG (INCORESIZES FILESIZES) - [COND - [FAMILY (for TYPEBUCKET in (CDR (FASSOC FAMILY \FONTSONFILE)) - do (for FFONT in (CDR TYPEBUCKET) do (OR (MEMB (CADR FFONT) - INCORESIZES) - (SETQ INCORESIZES - (CONS (CADR FFONT) - INCORESIZES] - (T (* look at all fonts) - (for FAMILYBUCKET in \FONTSONFILE - do (for TYPEBUCKET in (CDR FAMILYBUCKET) - do (for FFONT in (CDR TYPEBUCKET) do (OR (MEMB (CADR FFONT) - INCORESIZES) - (SETQ INCORESIZES - (CONS (CADR FFONT) - INCORESIZES] - (RETURN (SORT (UNION INCORESIZES - (COND - [FILESTOOFLG - - (* wants those on files too, Flip the cursor to note wait.) + (* ;; "Collects all of the sizes that are known. If FAMILY is given, gets just those sizes.") - (RESETFORM (CURSOR WAITINGCURSOR) - (bind SIZES for FONT - in (FONTSAVAILABLE (OR FAMILY '*) - '* NIL NIL 'DISPLAY T) - do (OR (MEMB (FONTPROP FONT 'SIZE) - SIZES) - (SETQ SIZES (CONS (FONTPROP FONT 'SIZE) - SIZES))) - finally (RETURN SIZES] - (T (bind SIZES for FONT in (FONTSAVAILABLE (OR FAMILY '*) - '* NIL NIL 'DISPLAY FILESTOOFLG) - do (OR (MEMB (FONTPROP FONT 'SIZE) - SIZES) - (SETQ SIZES (CONS (FONTPROP FONT 'SIZE) - SIZES))) finally (RETURN SIZES]) + (* ;; "RMK: Original code seemed confused. The \FONTSONFILE variable (set originally only by SK.GUESS.FONTSAVAILBLE in the call from SK.DECREASING.FONT.LIST) maintained a cache just of the fonts that had already been looked up for particular families and particular devices. But then it called FONTSAVAILABLE only for the DISPLAY device.") + + (for FS SIZES in (FONTSAVAILABLE (OR FAMILY '*) + '* NIL NIL 'DISPLAY FILESTOOFLG) do (pushnew SIZES (fetch (FONTSPEC + FSSIZE) + of FS)) + finally (RETURN (SORT SIZES]) (SK.SET.TEXT.VERT.ALIGN [LAMBDA (SKW NEWALIGN) (* rrb " 6-Nov-85 09:52") @@ -6058,8 +5856,6 @@ No more font sizes found."))) (RPAQ? SK.DEFAULT.TEXT.ALIGNMENT '(CENTER BASELINE)) -(RPAQ? \FONTSONFILE NIL) - (ADDTOVAR SK.HORIZONTAL.STYLES LEFT RIGHT CENTER) (ADDTOVAR SK.VERTICAL.STYLES TOP CENTER BASELINE BOTTOM) @@ -9280,137 +9076,136 @@ No more font sizes found."))) (fetch (REGION TOP) of REGION]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (14510 24920 (INIT.SKETCH.ELEMENTS 14520 . 22083) (CREATE.SKETCH.ELEMENT.TYPE 22085 . -23607) (SKETCH.ELEMENT.TYPEP 23609 . 23997) (SKETCH.ELEMENT.NAMEP 23999 . 24262) ( -\CURSOR.IN.MIDDLE.MENU 24264 . 24918)) (24961 25638 (SKETCHINCOLORP 24971 . 25291) (READ.COLOR.CHANGE -25293 . 25636)) (26147 28926 (SK.CREATE.DEFAULT.FILLING 26157 . 26458) (SKFILLINGP 26460 . 27093) ( -SK.INSURE.FILLING 27095 . 28523) (SK.INSURE.COLOR 28525 . 28924)) (28927 34537 (SK.TRANSLATE.MODE -28937 . 29719) (SK.CHANGE.FILLING.MODE 29721 . 33304) (READ.FILLING.MODE 33306 . 34535)) (34538 65212 -(SKETCH.CREATE.CIRCLE 34548 . 35360) (CIRCLE.EXPANDFN 35362 . 38734) (CIRCLE.DRAWFN 38736 . 41737) ( -\CIRCLE.DRAWFN1 41739 . 44334) (CIRCLE.INPUTFN 44336 . 46185) (SK.UPDATE.CIRCLE.AFTER.CHANGE 46187 . -46546) (SK.READ.CIRCLE.POINT 46548 . 47019) (SK.SHOW.CIRCLE 47021 . 47667) (CIRCLE.INSIDEFN 47669 . -47934) (CIRCLE.REGIONFN 47936 . 49617) (CIRCLE.GLOBALREGIONFN 49619 . 51137) (CIRCLE.TRANSLATE 51139 - . 53000) (CIRCLE.READCHANGEFN 53002 . 57618) (CIRCLE.TRANSFORMFN 57620 . 59473) (CIRCLE.TRANSLATEPTS -59475 . 61089) (SK.CIRCLE.CREATE 61091 . 61934) (SET.CIRCLE.SCALE 61936 . 62702) (SK.BRUSH.READCHANGE -62704 . 65210)) (65213 65942 (SK.INSURE.BRUSH 65223 . 65617) (SK.INSURE.DASHING 65619 . 65940)) (67156 - 96650 (SKETCH.CREATE.ELLIPSE 67166 . 67765) (ELLIPSE.EXPANDFN 67767 . 71379) (ELLIPSE.DRAWFN 71381 . -75558) (ELLIPSE.INPUTFN 75560 . 78000) (SK.READ.ELLIPSE.MAJOR.PT 78002 . 78581) ( -SK.SHOW.ELLIPSE.MAJOR.RADIUS 78583 . 79338) (SK.READ.ELLIPSE.MINOR.PT 79340 . 80033) ( -SK.SHOW.ELLIPSE.MINOR.RADIUS 80035 . 80867) (ELLIPSE.INSIDEFN 80869 . 81139) (ELLIPSE.CREATE 81141 . -82516) (SK.UPDATE.ELLIPSE.AFTER.CHANGE 82518 . 82886) (ELLIPSE.REGIONFN 82888 . 85088) ( -ELLIPSE.GLOBALREGIONFN 85090 . 86903) (ELLIPSE.TRANSLATEFN 86905 . 89451) (ELLIPSE.TRANSFORMFN 89453 - . 90730) (ELLIPSE.TRANSLATEPTS 90732 . 92773) (MARK.SPOT 92775 . 94026) (DISTANCEBETWEEN 94028 . -94623) (SK.DISTANCE.TO 94625 . 95010) (SQUARE 95012 . 95054) (COMPUTE.ELLIPSE.ORIENTATION 95056 . -95775) (SK.COMPUTE.ELLIPSE.MINOR.RADIUS.PT 95777 . 96648)) (97763 138819 (SKETCH.CREATE.OPEN.CURVE -97773 . 98326) (OPENCURVE.INPUTFN 98328 . 99196) (SK.CURVE.CREATE 99198 . 100943) (MAXXEXTENT 100945 - . 101804) (MAXYEXTENT 101806 . 102666) (KNOT.SET.SCALE.FIELD 102668 . 103470) (OPENCURVE.DRAWFN -103472 . 104603) (OPENCURVE.EXPANDFN 104605 . 107920) (OPENCURVE.READCHANGEFN 107922 . 111124) ( -OPENCURVE.TRANSFORMFN 111126 . 113624) (OPENCURVE.TRANSLATEFN 113626 . 114048) ( -OPENCURVE.TRANSLATEPTSFN 114050 . 115431) (SKETCH.CREATE.CLOSED.CURVE 115433 . 115939) ( -CLOSEDCURVE.DRAWFN 115941 . 116725) (CLOSEDCURVE.EXPANDFN 116727 . 119840) (CLOSEDCURVE.REGIONFN -119842 . 120639) (CLOSEDCURVE.GLOBALREGIONFN 120641 . 122074) (READ.LIST.OF.POINTS 122076 . 124055) ( -CLOSEDCURVE.INPUTFN 124057 . 124702) (CLOSEDCURVE.READCHANGEFN 124704 . 127599) ( -CLOSEDCURVE.TRANSFORMFN 127601 . 129401) (CLOSEDCURVE.TRANSLATEPTSFN 129403 . 130748) (INVISIBLEPARTP -130750 . 131103) (SHOWSKETCHPOINT 131105 . 131410) (SHOWSKETCHXY 131412 . 131930) (KNOTS.REGIONFN -131932 . 132833) (OPENWIRE.GLOBALREGIONFN 132835 . 133699) (CURVE.REGIONFN 133701 . 134642) ( -OPENCURVE.GLOBALREGIONFN 134644 . 136051) (KNOTS.TRANSLATEFN 136053 . 137096) (REGION.CONTAINING.PTS -137098 . 138817)) (138820 161096 (CHANGE.ELTS.BRUSH.SIZE 138830 . 139440) (CHANGE.ELTS.BRUSH 139442 . -139959) (CHANGE.ELTS.BRUSH.SHAPE 139961 . 140362) (SK.CHANGE.BRUSH.SHAPE 140364 . 143876) ( -SK.CHANGE.BRUSH.COLOR 143878 . 148324) (SK.CHANGE.BRUSH.SIZE 148326 . 153284) (SK.CHANGE.ANGLE 153286 - . 156266) (SK.CHANGE.ARC.DIRECTION 156268 . 158647) (SK.SET.DEFAULT.BRUSH.SIZE 158649 . 159348) ( -READSIZECHANGE 159350 . 161094)) (161097 162716 (SK.CHANGE.ELEMENT.KNOTS 161107 . 162714)) (162717 -163364 (SK.INSURE.POINT.LIST 162727 . 163180) (SK.INSURE.POSITION 163182 . 163362)) (164732 197055 ( -SKETCH.CREATE.WIRE 164742 . 165232) (CLOSEDWIRE.EXPANDFN 165234 . 167922) (KNOTS.INSIDEFN 167924 . -168645) (OPEN.WIRE.DRAWFN 168647 . 169239) (WIRE.EXPANDFN 169241 . 172488) ( -SK.UPDATE.WIRE.ELT.AFTER.CHANGE 172490 . 173011) (OPENWIRE.READCHANGEFN 173013 . 175506) ( -OPENWIRE.TRANSFORMFN 175508 . 177631) (OPENWIRE.TRANSLATEFN 177633 . 178057) (OPENWIRE.TRANSLATEPTSFN -178059 . 179338) (WIRE.INPUTFN 179340 . 180971) (SK.READ.WIRE.POINTS 180973 . 181504) ( -SK.READ.POINTS.WITH.FEEDBACK 181506 . 184273) (OPENWIRE.FEEDBACKFN 184275 . 185029) ( -CLOSEDWIRE.FEEDBACKFN 185031 . 186387) (CLOSEDWIRE.REGIONFN 186389 . 187374) ( -CLOSEDWIRE.GLOBALREGIONFN 187376 . 188428) (SK.WIRE.CREATE 188430 . 190193) (WIRE.ADD.POINT.TO.END -190195 . 191111) (READ.ARROW.CHANGE 191113 . 196589) (CHANGE.ELTS.ARROWHEADS 196591 . 197053)) (197056 - 208062 (SKETCH.CREATE.CLOSED.WIRE 197066 . 197627) (CLOSED.WIRE.INPUTFN 197629 . 197984) ( -CLOSED.WIRE.DRAWFN 197986 . 200031) (CLOSEDWIRE.READCHANGEFN 200033 . 204938) (CLOSEDWIRE.TRANSFORMFN -204940 . 206734) (CLOSEDWIRE.TRANSLATEPTSFN 206736 . 208060)) (208063 260769 (SK.EXPAND.ARROWHEADS -208073 . 208423) (SK.COMPUTE.ARC.ARROWHEAD.POINTS 208425 . 209806) (ARC.ARROWHEAD.POINTS 209808 . -211031) (SET.ARC.ARROWHEAD.POINTS 211033 . 212014) (SET.OPENCURVE.ARROWHEAD.POINTS 212016 . 212917) ( -SK.COMPUTE.CURVE.ARROWHEAD.POINTS 212919 . 214189) (SET.WIRE.ARROWHEAD.POINTS 214191 . 214944) ( -SK.COMPUTE.WIRE.ARROWHEAD.POINTS 214946 . 216211) (SK.EXPAND.ARROWHEAD 216213 . 217396) (CHANGED.ARROW - 217398 . 220570) (SK.CHANGE.ARROWHEAD 220572 . 221025) (SK.CHANGE.ARROWHEAD1 221027 . 226282) ( -SK.CREATE.ARROWHEAD 226284 . 226804) (SK.ARROWHEAD.CREATE 226806 . 228380) (SK.ARROWHEAD.END.TEST -228382 . 229306) (READ.ARROWHEAD.END 229308 . 231333) (ARROW.HEAD.POSITIONS 231335 . 233175) ( -ARROWHEAD.POINTS.LIST 233177 . 237149) (CURVE.ARROWHEAD.POINTS 237151 . 238014) (LEFT.MOST.IS.BEGINP -238016 . 238897) (WIRE.ARROWHEAD.POINTS 238899 . 240425) (DRAWARROWHEADS 240427 . 242797) ( -\SK.DRAW.TRIANGLE.ARROWHEAD 242799 . 244459) (\SK.ENDPT.OF.ARROW 244461 . 246718) ( -\SK.ADJUST.FOR.ARROWHEADS 246720 . 249225) (SK.SET.ARROWHEAD.LENGTH 249227 . 250371) ( -SK.SET.ARROWHEAD.ANGLE 250373 . 251469) (SK.SET.ARROWHEAD.TYPE 251471 . 254760) (SK.SET.LINE.ARROWHEAD - 254762 . 257175) (SK.UPDATE.ARROWHEAD.FORMAT 257177 . 259287) (SK.SET.LINE.LENGTH.MODE 259289 . -260767)) (260770 262571 (SK.INSURE.ARROWHEADS 260780 . 261962) (SK.ARROWHEADP 261964 . 262569)) ( -265368 327694 (SKETCH.CREATE.TEXT 265378 . 265892) (TEXT.CHANGEFN 265894 . 266286) (TEXT.READCHANGEFN -266288 . 274359) (\SK.READ.FONT.SIZE1 274361 . 276257) (SK.TEXT.ELT.WITH.SAME.FIELDS 276259 . 277899) -(SK.READFONTFAMILY 277901 . 279447) (CLOSE.PROMPT.WINDOW 279449 . 279873) (TEXT.DRAWFN 279875 . 280596 -) (TEXT.DRAWFN1 280598 . 284100) (TEXT.INSIDEFN 284102 . 284491) (TEXT.EXPANDFN 284493 . 286618) ( -SK.TEXT.LINE.REGIONS 286620 . 288494) (TEXT.UPDATE.GLOBAL.REGIONS 288496 . 289728) (REL.MOVE.REGION -289730 . 290267) (LTEXT.LINE.REGIONS 290269 . 293687) (TEXT.INPUTFN 293689 . 294199) (READ.TEXT 294201 - . 294949) (TEXT.POSITION.AND.CREATE 294951 . 297262) (CREATE.TEXT.ELEMENT 297264 . 298082) ( -SK.UPDATE.TEXT.AFTER.CHANGE 298084 . 298486) (SK.TEXT.FROM.TEXTBOX 298488 . 302294) ( -TEXT.SET.GLOBAL.REGIONS 302296 . 303589) (TEXT.REGIONFN 303591 . 304361) (TEXT.GLOBALREGIONFN 304363 - . 305051) (TEXT.TRANSLATEFN 305053 . 306368) (TEXT.TRANSFORMFN 306370 . 307493) (TEXT.TRANSLATEPTSFN -307495 . 308012) (TEXT.UPDATEFN 308014 . 312670) (SK.CHANGE.TEXT 312672 . 325760) (TEXT.SET.SCALES -325762 . 326730) (BREAK.AT.CARRIAGE.RETURNS 326732 . 327692)) (327695 346219 (ADD.KNOWN.SKETCH.FONT -327705 . 328696) (SK.PICK.FONT 328698 . 334230) (SK.CHOOSE.TEXT.FONT 334232 . 338180) (SK.NEXTSIZEFONT - 338182 . 339449) (SK.DECREASING.FONT.LIST 339451 . 341324) (SK.GUESS.FONTSAVAILABLE 341326 . 346217)) - (346638 360781 (SK.SET.FONT 346648 . 348215) (SK.SET.TEXT.FONT 348217 . 349219) (SK.SET.TEXT.SIZE -349221 . 349908) (SK.SET.TEXT.HORIZ.ALIGN 349910 . 351484) (SK.READFONTSIZE 351486 . 353716) ( -SK.COLLECT.FONT.SIZES 353718 . 356636) (SK.SET.TEXT.VERT.ALIGN 356638 . 358680) (SK.SET.TEXT.LOOKS -358682 . 360139) (SK.SET.DEFAULT.TEXT.FACE 360141 . 360779)) (360782 361368 (CREATE.SKETCH.TERMTABLE -360792 . 361366)) (361369 363135 (SK.FONT.LIST 361379 . 361705) (SK.INSURE.FONT 361707 . 362229) ( -SK.INSURE.STYLE 362231 . 362749) (SK.INSURE.TEXT 362751 . 363133)) (363705 420998 ( -SKETCH.CREATE.TEXTBOX 363715 . 365357) (SK.COMPUTE.TEXTBOX.REGION.FOR.STRING 365359 . 367436) ( -SK.BREAK.INTO.LINES 367438 . 378624) (SK.BRUSH.SIZE 378626 . 379007) (SK.TEXTBOX.CREATE 379009 . -379806) (SK.TEXTBOX.CREATE1 379808 . 380872) (SK.UPDATE.TEXTBOX.AFTER.CHANGE 380874 . 381414) ( -SK.TEXTBOX.POSITION.IN.BOX 381416 . 383327) (TEXTBOX.CHANGEFN 383329 . 383803) (TEXTBOX.DRAWFN 383805 - . 385841) (SK.TEXTURE.AROUND.REGIONS 385843 . 391916) (ALL.EMPTY.REGIONS 391918 . 392408) ( -TEXTBOX.EXPANDFN 392410 . 399566) (TEXTBOX.INPUTFN 399568 . 401181) (TEXTBOX.INSIDEFN 401183 . 401596) - (TEXTBOX.REGIONFN 401598 . 402452) (TEXTBOX.GLOBALREGIONFN 402454 . 402782) ( -TEXTBOX.SET.GLOBAL.REGIONS 402784 . 404115) (TEXTBOX.TRANSLATEFN 404117 . 405958) ( -TEXTBOX.TRANSLATEPTSFN 405960 . 408743) (TEXTBOX.TRANSFORMFN 408745 . 410413) (TEXTBOX.UPDATEFN 410415 - . 412308) (TEXTBOX.READCHANGEFN 412310 . 417199) (SK.TEXTBOX.TEXT.POSITION 417201 . 417622) ( -SK.TEXTBOX.FROM.TEXT 417624 . 420229) (ADD.EOLS 420231 . 420996)) (421527 425028 ( -SK.SET.TEXTBOX.VERT.ALIGN 421537 . 423417) (SK.SET.TEXTBOX.HORIZ.ALIGN 423419 . 425026)) (425411 -469886 (SKETCH.CREATE.BOX 425421 . 425904) (SK.BOX.DRAWFN 425906 . 427065) (BOX.DRAWFN1 427067 . -429906) (KNOTS.OF.REGION 429908 . 431142) (SK.DRAWAREABOX 431144 . 437745) (SK.DRAWBOX 437747 . 438936 -) (SK.BOX.EXPANDFN 438938 . 442686) (SK.BOX.GETREGIONFN 442688 . 443874) (BOX.SET.SCALES 443876 . -445116) (SK.BOX.INPUTFN 445118 . 447051) (SK.BOX.CREATE 447053 . 447754) (SK.UPDATE.BOX.AFTER.CHANGE -447756 . 448267) (SK.BOX.INSIDEFN 448269 . 448659) (SK.BOX.REGIONFN 448661 . 449374) ( -SK.BOX.GLOBALREGIONFN 449376 . 450114) (SK.BOX.READCHANGEFN 450116 . 453837) (SK.CHANGE.FILLING 453839 - . 457787) (SK.CHANGE.FILLING.COLOR 457789 . 461445) (SK.BOX.TRANSLATEFN 461447 . 462626) ( -SK.BOX.TRANSFORMFN 462628 . 463573) (SK.BOX.TRANSLATEPTSFN 463575 . 465943) (UNSCALE.REGION.TO.GRID -465945 . 466870) (INCREASEREGION 466872 . 467463) (INSUREREGIONSIZE 467465 . 468636) (EXPANDREGION -468638 . 469518) (REGION.FROM.COORDINATES 469520 . 469884)) (470422 496777 (SKETCH.CREATE.ARC 470432 - . 471241) (ARC.DRAWFN 471243 . 472970) (ARC.EXPANDFN 472972 . 475305) (ARC.INPUTFN 475307 . 479525) ( -SK.INVERT.CIRCLE 479527 . 480387) (SK.READ.ARC.ANGLE.POINT 480389 . 480896) (SK.SHOW.ARC 480898 . -481508) (ARC.CREATE 481510 . 482865) (SK.UPDATE.ARC.AFTER.CHANGE 482867 . 483207) (ARC.MOVEFN 483209 - . 484792) (ARC.TRANSLATEPTS 484794 . 486679) (ARC.INSIDEFN 486681 . 486931) (ARC.REGIONFN 486933 . -488069) (ARC.GLOBALREGIONFN 488071 . 489793) (ARC.TRANSLATE 489795 . 490777) (ARC.TRANSFORMFN 490779 - . 493729) (ARC.READCHANGEFN 493731 . 496775)) (496778 505857 (SK.COMPUTE.ARC.ANGLE.PT 496788 . 497714 -) (SK.COMPUTE.ARC.ANGLE.PT.FROM.ANGLE 497716 . 498709) (SK.COMPUTE.ARC.PTS 498711 . 502283) ( -SK.SET.ARC.DIRECTION 502285 . 502859) (SK.SET.ARC.DIRECTION.CW 502861 . 503035) ( -SK.SET.ARC.DIRECTION.CCW 503037 . 503310) (SK.COMPUTE.SLOPE.OF.LINE 503312 . 503804) ( -SK.CREATE.ARC.USING 503806 . 505043) (SET.ARC.SCALES 505045 . 505855)) (505858 506303 ( -SK.INSURE.DIRECTION 505868 . 506301)) (507674 553533 (GETSKETCHELEMENTPROP 507684 . 508992) ( -\SK.GET.ARC.ANGLEPT 508994 . 509555) (\GETSKETCHELEMENTPROP1 509557 . 509811) (\SK.GET.BRUSH 509813 . -510737) (\SK.GET.FILLING 510739 . 511837) (\SK.GET.ARROWHEADS 511839 . 512618) (\SK.GET.FONT 512620 . -513100) (\SK.GET.JUSTIFICATION 513102 . 513626) (\SK.GET.DIRECTION 513628 . 514105) (\SK.GET.DASHING -514107 . 515126) (PUTSKETCHELEMENTPROP 515128 . 517397) (\SK.PUT.FILLING 517399 . 518669) ( -ADDSKETCHELEMENTPROP 518671 . 519476) (REMOVESKETCHELEMENTPROP 519478 . 520267) (\SK.PUT.FONT 520269 - . 521083) (\SK.PUT.JUSTIFICATION 521085 . 522096) (\SK.PUT.DIRECTION 522098 . 522705) ( -\SK.PUT.DASHING 522707 . 524042) (\SK.PUT.BRUSH 524044 . 525963) (\SK.PUT.ARROWHEADS 525965 . 527931) -(SK.COPY.ELEMENT.PROPERTY.LIST 527933 . 528509) (SKETCH.UPDATE 528511 . 529241) (SKETCH.UPDATE1 529243 - . 530531) (\SKELT.GET.SCALE 530533 . 531521) (\SKELT.PUT.SCALE 531523 . 532830) (\SKELT.PUT.DATA -532832 . 534629) (SK.REPLACE.TEXT.IN.ELEMENT 534631 . 535584) (\SKELT.GET.DATA 535586 . 536653) ( -\SK.GET.1STCONTROLPT 536655 . 538167) (\SK.PUT.1STCONTROLPT 538169 . 543642) (\SK.GET.2NDCONTROLPT -543644 . 544559) (\SK.PUT.2NDCONTROLPT 544561 . 548749) (\SK.GET.3RDCONTROLPT 548751 . 549629) ( -\SK.PUT.3RDCONTROLPT 549631 . 553531)) (553534 554115 (LOWERLEFTCORNER 553544 . 553790) ( -UPPERRIGHTCORNER 553792 . 554113))))) + (FILEMAP (NIL (14197 24607 (INIT.SKETCH.ELEMENTS 14207 . 21770) (CREATE.SKETCH.ELEMENT.TYPE 21772 . +23294) (SKETCH.ELEMENT.TYPEP 23296 . 23684) (SKETCH.ELEMENT.NAMEP 23686 . 23949) ( +\CURSOR.IN.MIDDLE.MENU 23951 . 24605)) (24648 25325 (SKETCHINCOLORP 24658 . 24978) (READ.COLOR.CHANGE +24980 . 25323)) (25834 28613 (SK.CREATE.DEFAULT.FILLING 25844 . 26145) (SKFILLINGP 26147 . 26780) ( +SK.INSURE.FILLING 26782 . 28210) (SK.INSURE.COLOR 28212 . 28611)) (28614 34224 (SK.TRANSLATE.MODE +28624 . 29406) (SK.CHANGE.FILLING.MODE 29408 . 32991) (READ.FILLING.MODE 32993 . 34222)) (34225 64899 +(SKETCH.CREATE.CIRCLE 34235 . 35047) (CIRCLE.EXPANDFN 35049 . 38421) (CIRCLE.DRAWFN 38423 . 41424) ( +\CIRCLE.DRAWFN1 41426 . 44021) (CIRCLE.INPUTFN 44023 . 45872) (SK.UPDATE.CIRCLE.AFTER.CHANGE 45874 . +46233) (SK.READ.CIRCLE.POINT 46235 . 46706) (SK.SHOW.CIRCLE 46708 . 47354) (CIRCLE.INSIDEFN 47356 . +47621) (CIRCLE.REGIONFN 47623 . 49304) (CIRCLE.GLOBALREGIONFN 49306 . 50824) (CIRCLE.TRANSLATE 50826 + . 52687) (CIRCLE.READCHANGEFN 52689 . 57305) (CIRCLE.TRANSFORMFN 57307 . 59160) (CIRCLE.TRANSLATEPTS +59162 . 60776) (SK.CIRCLE.CREATE 60778 . 61621) (SET.CIRCLE.SCALE 61623 . 62389) (SK.BRUSH.READCHANGE +62391 . 64897)) (64900 65629 (SK.INSURE.BRUSH 64910 . 65304) (SK.INSURE.DASHING 65306 . 65627)) (66843 + 96337 (SKETCH.CREATE.ELLIPSE 66853 . 67452) (ELLIPSE.EXPANDFN 67454 . 71066) (ELLIPSE.DRAWFN 71068 . +75245) (ELLIPSE.INPUTFN 75247 . 77687) (SK.READ.ELLIPSE.MAJOR.PT 77689 . 78268) ( +SK.SHOW.ELLIPSE.MAJOR.RADIUS 78270 . 79025) (SK.READ.ELLIPSE.MINOR.PT 79027 . 79720) ( +SK.SHOW.ELLIPSE.MINOR.RADIUS 79722 . 80554) (ELLIPSE.INSIDEFN 80556 . 80826) (ELLIPSE.CREATE 80828 . +82203) (SK.UPDATE.ELLIPSE.AFTER.CHANGE 82205 . 82573) (ELLIPSE.REGIONFN 82575 . 84775) ( +ELLIPSE.GLOBALREGIONFN 84777 . 86590) (ELLIPSE.TRANSLATEFN 86592 . 89138) (ELLIPSE.TRANSFORMFN 89140 + . 90417) (ELLIPSE.TRANSLATEPTS 90419 . 92460) (MARK.SPOT 92462 . 93713) (DISTANCEBETWEEN 93715 . +94310) (SK.DISTANCE.TO 94312 . 94697) (SQUARE 94699 . 94741) (COMPUTE.ELLIPSE.ORIENTATION 94743 . +95462) (SK.COMPUTE.ELLIPSE.MINOR.RADIUS.PT 95464 . 96335)) (97450 138506 (SKETCH.CREATE.OPEN.CURVE +97460 . 98013) (OPENCURVE.INPUTFN 98015 . 98883) (SK.CURVE.CREATE 98885 . 100630) (MAXXEXTENT 100632 + . 101491) (MAXYEXTENT 101493 . 102353) (KNOT.SET.SCALE.FIELD 102355 . 103157) (OPENCURVE.DRAWFN +103159 . 104290) (OPENCURVE.EXPANDFN 104292 . 107607) (OPENCURVE.READCHANGEFN 107609 . 110811) ( +OPENCURVE.TRANSFORMFN 110813 . 113311) (OPENCURVE.TRANSLATEFN 113313 . 113735) ( +OPENCURVE.TRANSLATEPTSFN 113737 . 115118) (SKETCH.CREATE.CLOSED.CURVE 115120 . 115626) ( +CLOSEDCURVE.DRAWFN 115628 . 116412) (CLOSEDCURVE.EXPANDFN 116414 . 119527) (CLOSEDCURVE.REGIONFN +119529 . 120326) (CLOSEDCURVE.GLOBALREGIONFN 120328 . 121761) (READ.LIST.OF.POINTS 121763 . 123742) ( +CLOSEDCURVE.INPUTFN 123744 . 124389) (CLOSEDCURVE.READCHANGEFN 124391 . 127286) ( +CLOSEDCURVE.TRANSFORMFN 127288 . 129088) (CLOSEDCURVE.TRANSLATEPTSFN 129090 . 130435) (INVISIBLEPARTP +130437 . 130790) (SHOWSKETCHPOINT 130792 . 131097) (SHOWSKETCHXY 131099 . 131617) (KNOTS.REGIONFN +131619 . 132520) (OPENWIRE.GLOBALREGIONFN 132522 . 133386) (CURVE.REGIONFN 133388 . 134329) ( +OPENCURVE.GLOBALREGIONFN 134331 . 135738) (KNOTS.TRANSLATEFN 135740 . 136783) (REGION.CONTAINING.PTS +136785 . 138504)) (138507 160783 (CHANGE.ELTS.BRUSH.SIZE 138517 . 139127) (CHANGE.ELTS.BRUSH 139129 . +139646) (CHANGE.ELTS.BRUSH.SHAPE 139648 . 140049) (SK.CHANGE.BRUSH.SHAPE 140051 . 143563) ( +SK.CHANGE.BRUSH.COLOR 143565 . 148011) (SK.CHANGE.BRUSH.SIZE 148013 . 152971) (SK.CHANGE.ANGLE 152973 + . 155953) (SK.CHANGE.ARC.DIRECTION 155955 . 158334) (SK.SET.DEFAULT.BRUSH.SIZE 158336 . 159035) ( +READSIZECHANGE 159037 . 160781)) (160784 162403 (SK.CHANGE.ELEMENT.KNOTS 160794 . 162401)) (162404 +163051 (SK.INSURE.POINT.LIST 162414 . 162867) (SK.INSURE.POSITION 162869 . 163049)) (164419 196742 ( +SKETCH.CREATE.WIRE 164429 . 164919) (CLOSEDWIRE.EXPANDFN 164921 . 167609) (KNOTS.INSIDEFN 167611 . +168332) (OPEN.WIRE.DRAWFN 168334 . 168926) (WIRE.EXPANDFN 168928 . 172175) ( +SK.UPDATE.WIRE.ELT.AFTER.CHANGE 172177 . 172698) (OPENWIRE.READCHANGEFN 172700 . 175193) ( +OPENWIRE.TRANSFORMFN 175195 . 177318) (OPENWIRE.TRANSLATEFN 177320 . 177744) (OPENWIRE.TRANSLATEPTSFN +177746 . 179025) (WIRE.INPUTFN 179027 . 180658) (SK.READ.WIRE.POINTS 180660 . 181191) ( +SK.READ.POINTS.WITH.FEEDBACK 181193 . 183960) (OPENWIRE.FEEDBACKFN 183962 . 184716) ( +CLOSEDWIRE.FEEDBACKFN 184718 . 186074) (CLOSEDWIRE.REGIONFN 186076 . 187061) ( +CLOSEDWIRE.GLOBALREGIONFN 187063 . 188115) (SK.WIRE.CREATE 188117 . 189880) (WIRE.ADD.POINT.TO.END +189882 . 190798) (READ.ARROW.CHANGE 190800 . 196276) (CHANGE.ELTS.ARROWHEADS 196278 . 196740)) (196743 + 207749 (SKETCH.CREATE.CLOSED.WIRE 196753 . 197314) (CLOSED.WIRE.INPUTFN 197316 . 197671) ( +CLOSED.WIRE.DRAWFN 197673 . 199718) (CLOSEDWIRE.READCHANGEFN 199720 . 204625) (CLOSEDWIRE.TRANSFORMFN +204627 . 206421) (CLOSEDWIRE.TRANSLATEPTSFN 206423 . 207747)) (207750 260456 (SK.EXPAND.ARROWHEADS +207760 . 208110) (SK.COMPUTE.ARC.ARROWHEAD.POINTS 208112 . 209493) (ARC.ARROWHEAD.POINTS 209495 . +210718) (SET.ARC.ARROWHEAD.POINTS 210720 . 211701) (SET.OPENCURVE.ARROWHEAD.POINTS 211703 . 212604) ( +SK.COMPUTE.CURVE.ARROWHEAD.POINTS 212606 . 213876) (SET.WIRE.ARROWHEAD.POINTS 213878 . 214631) ( +SK.COMPUTE.WIRE.ARROWHEAD.POINTS 214633 . 215898) (SK.EXPAND.ARROWHEAD 215900 . 217083) (CHANGED.ARROW + 217085 . 220257) (SK.CHANGE.ARROWHEAD 220259 . 220712) (SK.CHANGE.ARROWHEAD1 220714 . 225969) ( +SK.CREATE.ARROWHEAD 225971 . 226491) (SK.ARROWHEAD.CREATE 226493 . 228067) (SK.ARROWHEAD.END.TEST +228069 . 228993) (READ.ARROWHEAD.END 228995 . 231020) (ARROW.HEAD.POSITIONS 231022 . 232862) ( +ARROWHEAD.POINTS.LIST 232864 . 236836) (CURVE.ARROWHEAD.POINTS 236838 . 237701) (LEFT.MOST.IS.BEGINP +237703 . 238584) (WIRE.ARROWHEAD.POINTS 238586 . 240112) (DRAWARROWHEADS 240114 . 242484) ( +\SK.DRAW.TRIANGLE.ARROWHEAD 242486 . 244146) (\SK.ENDPT.OF.ARROW 244148 . 246405) ( +\SK.ADJUST.FOR.ARROWHEADS 246407 . 248912) (SK.SET.ARROWHEAD.LENGTH 248914 . 250058) ( +SK.SET.ARROWHEAD.ANGLE 250060 . 251156) (SK.SET.ARROWHEAD.TYPE 251158 . 254447) (SK.SET.LINE.ARROWHEAD + 254449 . 256862) (SK.UPDATE.ARROWHEAD.FORMAT 256864 . 258974) (SK.SET.LINE.LENGTH.MODE 258976 . +260454)) (260457 262258 (SK.INSURE.ARROWHEADS 260467 . 261649) (SK.ARROWHEADP 261651 . 262256)) ( +265055 327497 (SKETCH.CREATE.TEXT 265065 . 265579) (TEXT.CHANGEFN 265581 . 265973) (TEXT.READCHANGEFN +265975 . 274046) (\SK.READ.FONT.SIZE1 274048 . 276214) (SK.TEXT.ELT.WITH.SAME.FIELDS 276216 . 277856) +(SK.READFONTFAMILY 277858 . 280328) (CLOSE.PROMPT.WINDOW 280330 . 280754) (TEXT.DRAWFN 280756 . 281477 +) (TEXT.DRAWFN1 281479 . 284981) (TEXT.INSIDEFN 284983 . 285372) (TEXT.EXPANDFN 285374 . 287499) ( +SK.TEXT.LINE.REGIONS 287501 . 289375) (TEXT.UPDATE.GLOBAL.REGIONS 289377 . 290609) (REL.MOVE.REGION +290611 . 291148) (LTEXT.LINE.REGIONS 291150 . 294568) (TEXT.INPUTFN 294570 . 295080) (READ.TEXT 295082 + . 295830) (TEXT.POSITION.AND.CREATE 295832 . 298143) (CREATE.TEXT.ELEMENT 298145 . 298963) ( +SK.UPDATE.TEXT.AFTER.CHANGE 298965 . 299367) (SK.TEXT.FROM.TEXTBOX 299369 . 303175) ( +TEXT.SET.GLOBAL.REGIONS 303177 . 304470) (TEXT.REGIONFN 304472 . 305242) (TEXT.GLOBALREGIONFN 305244 + . 305932) (TEXT.TRANSLATEFN 305934 . 307249) (TEXT.TRANSFORMFN 307251 . 308374) (TEXT.TRANSLATEPTSFN +308376 . 308893) (TEXT.UPDATEFN 308895 . 313551) (SK.CHANGE.TEXT 313553 . 323831) (SK.CHANGE.FONT +323833 . 325563) (TEXT.SET.SCALES 325565 . 326533) (BREAK.AT.CARRIAGE.RETURNS 326535 . 327495)) ( +327498 340483 (SK.PICK.FONT 327508 . 331780) (SK.CHOOSE.TEXT.FONT 331782 . 336053) (SK.NEXTSIZEFONT +336055 . 337687) (SK.DECREASING.FONT.LIST 337689 . 340481)) (340902 352576 (SK.SET.FONT 340912 . +342179) (SK.SET.TEXT.FONT 342181 . 343183) (SK.SET.TEXT.SIZE 343185 . 343872) (SK.SET.TEXT.HORIZ.ALIGN + 343874 . 345448) (SK.READFONTSIZE 345450 . 347348) (SK.COLLECT.FONT.SIZES 347350 . 348431) ( +SK.SET.TEXT.VERT.ALIGN 348433 . 350475) (SK.SET.TEXT.LOOKS 350477 . 351934) (SK.SET.DEFAULT.TEXT.FACE +351936 . 352574)) (352577 353163 (CREATE.SKETCH.TERMTABLE 352587 . 353161)) (353164 354930 ( +SK.FONT.LIST 353174 . 353500) (SK.INSURE.FONT 353502 . 354024) (SK.INSURE.STYLE 354026 . 354544) ( +SK.INSURE.TEXT 354546 . 354928)) (355470 412763 (SKETCH.CREATE.TEXTBOX 355480 . 357122) ( +SK.COMPUTE.TEXTBOX.REGION.FOR.STRING 357124 . 359201) (SK.BREAK.INTO.LINES 359203 . 370389) ( +SK.BRUSH.SIZE 370391 . 370772) (SK.TEXTBOX.CREATE 370774 . 371571) (SK.TEXTBOX.CREATE1 371573 . 372637 +) (SK.UPDATE.TEXTBOX.AFTER.CHANGE 372639 . 373179) (SK.TEXTBOX.POSITION.IN.BOX 373181 . 375092) ( +TEXTBOX.CHANGEFN 375094 . 375568) (TEXTBOX.DRAWFN 375570 . 377606) (SK.TEXTURE.AROUND.REGIONS 377608 + . 383681) (ALL.EMPTY.REGIONS 383683 . 384173) (TEXTBOX.EXPANDFN 384175 . 391331) (TEXTBOX.INPUTFN +391333 . 392946) (TEXTBOX.INSIDEFN 392948 . 393361) (TEXTBOX.REGIONFN 393363 . 394217) ( +TEXTBOX.GLOBALREGIONFN 394219 . 394547) (TEXTBOX.SET.GLOBAL.REGIONS 394549 . 395880) ( +TEXTBOX.TRANSLATEFN 395882 . 397723) (TEXTBOX.TRANSLATEPTSFN 397725 . 400508) (TEXTBOX.TRANSFORMFN +400510 . 402178) (TEXTBOX.UPDATEFN 402180 . 404073) (TEXTBOX.READCHANGEFN 404075 . 408964) ( +SK.TEXTBOX.TEXT.POSITION 408966 . 409387) (SK.TEXTBOX.FROM.TEXT 409389 . 411994) (ADD.EOLS 411996 . +412761)) (413292 416793 (SK.SET.TEXTBOX.VERT.ALIGN 413302 . 415182) (SK.SET.TEXTBOX.HORIZ.ALIGN 415184 + . 416791)) (417176 461651 (SKETCH.CREATE.BOX 417186 . 417669) (SK.BOX.DRAWFN 417671 . 418830) ( +BOX.DRAWFN1 418832 . 421671) (KNOTS.OF.REGION 421673 . 422907) (SK.DRAWAREABOX 422909 . 429510) ( +SK.DRAWBOX 429512 . 430701) (SK.BOX.EXPANDFN 430703 . 434451) (SK.BOX.GETREGIONFN 434453 . 435639) ( +BOX.SET.SCALES 435641 . 436881) (SK.BOX.INPUTFN 436883 . 438816) (SK.BOX.CREATE 438818 . 439519) ( +SK.UPDATE.BOX.AFTER.CHANGE 439521 . 440032) (SK.BOX.INSIDEFN 440034 . 440424) (SK.BOX.REGIONFN 440426 + . 441139) (SK.BOX.GLOBALREGIONFN 441141 . 441879) (SK.BOX.READCHANGEFN 441881 . 445602) ( +SK.CHANGE.FILLING 445604 . 449552) (SK.CHANGE.FILLING.COLOR 449554 . 453210) (SK.BOX.TRANSLATEFN +453212 . 454391) (SK.BOX.TRANSFORMFN 454393 . 455338) (SK.BOX.TRANSLATEPTSFN 455340 . 457708) ( +UNSCALE.REGION.TO.GRID 457710 . 458635) (INCREASEREGION 458637 . 459228) (INSUREREGIONSIZE 459230 . +460401) (EXPANDREGION 460403 . 461283) (REGION.FROM.COORDINATES 461285 . 461649)) (462187 488542 ( +SKETCH.CREATE.ARC 462197 . 463006) (ARC.DRAWFN 463008 . 464735) (ARC.EXPANDFN 464737 . 467070) ( +ARC.INPUTFN 467072 . 471290) (SK.INVERT.CIRCLE 471292 . 472152) (SK.READ.ARC.ANGLE.POINT 472154 . +472661) (SK.SHOW.ARC 472663 . 473273) (ARC.CREATE 473275 . 474630) (SK.UPDATE.ARC.AFTER.CHANGE 474632 + . 474972) (ARC.MOVEFN 474974 . 476557) (ARC.TRANSLATEPTS 476559 . 478444) (ARC.INSIDEFN 478446 . +478696) (ARC.REGIONFN 478698 . 479834) (ARC.GLOBALREGIONFN 479836 . 481558) (ARC.TRANSLATE 481560 . +482542) (ARC.TRANSFORMFN 482544 . 485494) (ARC.READCHANGEFN 485496 . 488540)) (488543 497622 ( +SK.COMPUTE.ARC.ANGLE.PT 488553 . 489479) (SK.COMPUTE.ARC.ANGLE.PT.FROM.ANGLE 489481 . 490474) ( +SK.COMPUTE.ARC.PTS 490476 . 494048) (SK.SET.ARC.DIRECTION 494050 . 494624) (SK.SET.ARC.DIRECTION.CW +494626 . 494800) (SK.SET.ARC.DIRECTION.CCW 494802 . 495075) (SK.COMPUTE.SLOPE.OF.LINE 495077 . 495569) + (SK.CREATE.ARC.USING 495571 . 496808) (SET.ARC.SCALES 496810 . 497620)) (497623 498068 ( +SK.INSURE.DIRECTION 497633 . 498066)) (499439 545298 (GETSKETCHELEMENTPROP 499449 . 500757) ( +\SK.GET.ARC.ANGLEPT 500759 . 501320) (\GETSKETCHELEMENTPROP1 501322 . 501576) (\SK.GET.BRUSH 501578 . +502502) (\SK.GET.FILLING 502504 . 503602) (\SK.GET.ARROWHEADS 503604 . 504383) (\SK.GET.FONT 504385 . +504865) (\SK.GET.JUSTIFICATION 504867 . 505391) (\SK.GET.DIRECTION 505393 . 505870) (\SK.GET.DASHING +505872 . 506891) (PUTSKETCHELEMENTPROP 506893 . 509162) (\SK.PUT.FILLING 509164 . 510434) ( +ADDSKETCHELEMENTPROP 510436 . 511241) (REMOVESKETCHELEMENTPROP 511243 . 512032) (\SK.PUT.FONT 512034 + . 512848) (\SK.PUT.JUSTIFICATION 512850 . 513861) (\SK.PUT.DIRECTION 513863 . 514470) ( +\SK.PUT.DASHING 514472 . 515807) (\SK.PUT.BRUSH 515809 . 517728) (\SK.PUT.ARROWHEADS 517730 . 519696) +(SK.COPY.ELEMENT.PROPERTY.LIST 519698 . 520274) (SKETCH.UPDATE 520276 . 521006) (SKETCH.UPDATE1 521008 + . 522296) (\SKELT.GET.SCALE 522298 . 523286) (\SKELT.PUT.SCALE 523288 . 524595) (\SKELT.PUT.DATA +524597 . 526394) (SK.REPLACE.TEXT.IN.ELEMENT 526396 . 527349) (\SKELT.GET.DATA 527351 . 528418) ( +\SK.GET.1STCONTROLPT 528420 . 529932) (\SK.PUT.1STCONTROLPT 529934 . 535407) (\SK.GET.2NDCONTROLPT +535409 . 536324) (\SK.PUT.2NDCONTROLPT 536326 . 540514) (\SK.GET.3RDCONTROLPT 540516 . 541394) ( +\SK.PUT.3RDCONTROLPT 541396 . 545296)) (545299 545880 (LOWERLEFTCORNER 545309 . 545555) ( +UPPERRIGHTCORNER 545557 . 545878))))) STOP diff --git a/library/sketch/SKETCH-ELEMENTS.LCOM b/library/sketch/SKETCH-ELEMENTS.LCOM index 14b7a802..0f9dd78a 100644 Binary files a/library/sketch/SKETCH-ELEMENTS.LCOM and b/library/sketch/SKETCH-ELEMENTS.LCOM differ diff --git a/library/sketch/SKETCH.LCOM b/library/sketch/SKETCH.LCOM index 841eab4c..81c0d2b7 100644 Binary files a/library/sketch/SKETCH.LCOM and b/library/sketch/SKETCH.LCOM differ diff --git a/library/tedit/TEDIT b/library/tedit/TEDIT index 95cb160a..39cb40cc 100644 --- a/library/tedit/TEDIT +++ b/library/tedit/TEDIT @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 8-Sep-2025 22:10:20" {WMEDLEY}TEDIT>TEDIT.;838 145349 +(FILECREATED "13-Nov-2025 21:00:34" {WMEDLEY}TEDIT>TEDIT.;844 144838 :EDIT-BY rmk - :CHANGES-TO (FNS TEDIT.NTHCHARCODE) + :CHANGES-TO (FNS TEDIT.INSERT \TEDIT.INSERT) - :PREVIOUS-DATE " 6-Sep-2025 09:54:48" {WMEDLEY}TEDIT>TEDIT.;837) + :PREVIOUS-DATE "28-Oct-2025 00:29:56" {WMEDLEY}TEDIT>TEDIT.;843) (PRETTYCOMPRINT TEDITCOMS) @@ -75,9 +75,9 @@ (FNS TEDITSYSTEMDATE) (VARS (TEDITSYSTEMDATE (TEDITSYSTEMDATE] (COMS (* ; - "LISTFILES Interface, so the system can decide if a file is a TEdit file.") - (ADDVARS (PRINTFILETYPES (TEDIT (TEST \TEDIT.GET.TRAILER) - (EXTENSION (TEDIT]) + "IMAGETYPE Interface, so the system can decide if a file is a TEdit file.") + (ADDVARS (PRINTFILETYPES (TEDIT (TEST TEDIT.FORMATTEDFILEP) + (EXTENSION (TEDIT TED]) (FILESLOAD (SYSLOAD) POSTSCRIPTSTREAM PDFSTREAM WHEELSCROLL) @@ -441,6 +441,8 @@ (TEDIT-SEE [LAMBDA (FILE WINDOW FORMAT TITLE) + (* ;; "Edited 27-Oct-2025 21:25 by rmk") + (* ;; "Edited 13-Sep-2023 09:04 by rmk: Old code replaced to take advantage of new standard interfaces.") @@ -452,7 +454,8 @@ (* ;; "Edited 1-Feb-88 19:00 by bvm:") - (TEXTSTREAM (TEDIT FILE WINDOW NIL `(READONLY T LEAVETTY T FONT ,DEFAULTFONT]) + (TEXTSTREAM (TEDIT FILE WINDOW NIL `(READONLY T LEAVETTY T FONT ,DEFAULTFONT TITLE ,TITLE FORMAT + ,FORMAT]) (TEDIT.COPY [LAMBDA (FROM TO) (* ; "Edited 2-Dec-2024 09:02 by rmk") @@ -506,7 +509,8 @@ (\TEDIT.DELETE TSTREAM SEL]) (TEDIT.INSERT - [LAMBDA (TSTREAM TEXT CH#ORSEL LOOKS DONTSCROLL) (* ; "Edited 4-Apr-2025 11:22 by rmk") + [LAMBDA (TSTREAM TEXT CH#ORSEL LOOKS DONTSCROLL) (* ; "Edited 13-Nov-2025 20:58 by rmk") + (* ; "Edited 4-Apr-2025 11:22 by rmk") (* ; "Edited 2-Aug-2024 22:17 by rmk") (* ; "Edited 31-Jul-2024 12:13 by rmk") (* ; "Edited 23-Jul-2024 16:35 by rmk") @@ -531,7 +535,7 @@ (* ;; "Nothing to do for an empty string") - (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) + (LET ((TEXTOBJ (FTEXTOBJ TSTREAM))) (if (FIXP CH#ORSEL) then (TEDIT.SETSEL TEXTOBJ CH#ORSEL 1 'LEFT) (* ; "He gave us a ch# to insert before") @@ -540,14 +544,8 @@ then (SETQ CH#ORSEL (TEXTSEL TEXTOBJ))) (SELECTION! CH#ORSEL) (if (FGETSEL CH#ORSEL SET) - then (\TEDIT.INSERT TEXT CH#ORSEL TSTREAM DONTSCROLL) - (CL:WHEN LOOKS - - (* ;; "TEXTSEL now selects the insertion, apply the looks, but don't keep the looks-change as a separate event. We want it to behave as if the looks had been applied to the TEXT before the insertion (e.g. converting first to SELPIECES).") - - (LET ((HISTORY (FGETTOBJ TEXTOBJ TXTHISTORY))) - (\TEDIT.CHANGE.CHARLOOKS TSTREAM LOOKS) - (FSETTOBJ TEXTOBJ TXTHISTORY HISTORY))) + then (CL:WHEN LOOKS (TEDIT.CARETLOOKS TSTREAM LOOKS)) + (\TEDIT.INSERT TEXT CH#ORSEL TSTREAM DONTSCROLL) else (TEDIT.PROMPTPRINT TEXTOBJ "Please select a place for the insertion." T)))) ]) @@ -1240,7 +1238,8 @@ (T TSTREAM)))]) (\TEDIT.INSERT - [LAMBDA (INSERT SEL TSTREAM DONTSCROLL TYPEIN) (* ; "Edited 7-May-2025 00:11 by rmk") + [LAMBDA (INSERT SEL TSTREAM DONTSCROLL TYPEIN) (* ; "Edited 13-Nov-2025 20:57 by rmk") + (* ; "Edited 7-May-2025 00:11 by rmk") (* ; "Edited 21-Apr-2025 20:16 by rmk") (* ; "Edited 20-Apr-2025 13:26 by rmk") (* ; "Edited 6-Apr-2025 14:12 by rmk") @@ -1311,14 +1310,10 @@ (* ;; "Set the caret so that the next insertion should also come in front of that (now displaced) character, and then update the screen.") - (* ;; "If typein, the new selection is a point selection, if from a function e.g. TEDIT.INSERT, the insertion is selected/underlined. TEDIT.INSERT can then apply the looks, if specified.") - - (if TYPEIN - then (\TEDIT.UPDATE.SEL SEL (SUB1 (IPLUS CARETCHNO NCHARSADDED)) - 0 - 'RIGHT - 'NORMAL) - else (\TEDIT.UPDATE.SEL SEL CARETCHNO NCHARSADDED 'RIGHT 'NORMAL)) + (\TEDIT.UPDATE.SEL SEL (SUB1 (IPLUS CARETCHNO NCHARSADDED)) + 0 + 'RIGHT + 'NORMAL) (CL:UNLESS DONTSCROLL (* ;; "All the panes must be updated. SELPANE mayalso need to be scrolled to make the caret visible for the next input.") @@ -2320,32 +2315,32 @@ -(* ; "LISTFILES Interface, so the system can decide if a file is a TEdit file.") +(* ; "IMAGETYPE Interface, so the system can decide if a file is a TEdit file.") -(ADDTOVAR PRINTFILETYPES (TEDIT (TEST \TEDIT.GET.TRAILER) - (EXTENSION (TEDIT)))) +(ADDTOVAR PRINTFILETYPES (TEDIT (TEST TEDIT.FORMATTEDFILEP) + (EXTENSION (TEDIT TED)))) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4823 7217 (MAKE-TEDIT-EXPORTS.ALL 4833 . 5379) (UPDATE-TEDIT 5381 . 6310) (EDIT-TEDIT -6312 . 7215)) (8647 36705 (TEDIT 8657 . 11271) (TEXTSTREAM 11273 . 13162) (TEXTSTREAMP 13164 . 13548) -(COERCETEXTSTREAM 13550 . 17761) (TEDIT.CONCAT 17763 . 21065) (TEDITSTRING 21067 . 21981) (TEDIT-SEE -21983 . 22542) (TEDIT.COPY 22544 . 24689) (TEDIT.DELETE 24691 . 26052) (TEDIT.INSERT 26054 . 29428) ( -TEDIT.TERPRI 29430 . 30544) (TEDIT.KILL 30546 . 31528) (TEDIT.QUIT 31530 . 32896) (TEDIT.MOVE 32898 . -33786) (TEDIT.STRINGWIDTH 33788 . 34459) (TEDIT.CHARWIDTH 34461 . 36703)) (36706 38647 (TEXTOBJ 36716 - . 37181) (COERCETEXTOBJ 37183 . 38645)) (40047 41697 (TDRIBBLE 40057 . 41695)) (41738 53634 ( -TEDIT.INSERT.OBJECT 41748 . 45455) (TEDIT.EDIT.OBJECT 45457 . 48397) (TEDIT.OBJECT.CHANGED 48399 . -51589) (TEDIT.MAP.OBJECTS 51591 . 53162) (\TEDIT.FIRST.OBJPIECE 53164 . 53397) (\TEDIT.NEXT.OBJPIECE -53399 . 53632)) (53657 61100 (\TEDIT.CONCAT.PAGEFRAMES 53667 . 58734) (\TEDIT.GET.PAGE.HEADINGS 58736 - . 59765) (\TEDIT.CONCAT.INSTALL.HEADINGS 59767 . 61098)) (61101 64708 (\TEDIT.MOVE.MSG 61111 . 63192) - (\TEDIT.READONLY 63194 . 64706)) (64709 70600 (TEDIT.NCHARS 64719 . 65092) (TEDIT.RPLCHARCODE 65094 - . 68084) (TEDIT.NTHCHARCODE 68086 . 70129) (TEDIT.NTHCHAR 70131 . 70598)) (70646 127675 (\TEDIT1 -70656 . 72733) (\TEDIT.INSERT 72735 . 79100) (\TEDIT.MOVE 79102 . 87008) (\TEDIT.COPY 87010 . 91541) ( -\TEDIT.REPLACE.SELPIECES 91543 . 96079) (\TEDIT.INSERT.SELPIECES 96081 . 99078) (\TEDIT.RESTARTFN -99080 . 101585) (\TEDIT.CHARDELETE 101587 . 104516) (\TEDIT.COPYPIECE 104518 . 109680) ( -\TEDIT.APPLY.OBJFN 109682 . 112768) (\TEDIT.DELETE 112770 . 117138) (\TEDIT.DIFFUSE.PARALOOKS 117140 - . 119411) (\TEDIT.WORDDELETE 119413 . 121028) (\TEDIT.WORDDELETE.FORWARD 121030 . 122819) ( -\TEDIT.FINISHEDIT? 122821 . 127673)) (127676 128335 (\TEDIT.THELP 127686 . 128333)) (128369 137500 ( -\TEDIT.PARAPIECES 128379 . 130353) (\TEDIT.PARACHNOS 130355 . 131247) (\TEDIT.PARA.FIRST 131249 . -134350) (\TEDIT.PARA.LAST 134352 . 137498)) (137501 144596 (\TEDIT.WORD.FIRST 137511 . 141515) ( -\TEDIT.WORD.LAST 141517 . 144594)) (144797 145074 (TEDITSYSTEMDATE 144807 . 145072))))) + (FILEMAP (NIL (4838 7232 (MAKE-TEDIT-EXPORTS.ALL 4848 . 5394) (UPDATE-TEDIT 5396 . 6325) (EDIT-TEDIT +6327 . 7230)) (8662 36440 (TEDIT 8672 . 11286) (TEXTSTREAM 11288 . 13177) (TEXTSTREAMP 13179 . 13563) +(COERCETEXTSTREAM 13565 . 17776) (TEDIT.CONCAT 17778 . 21080) (TEDITSTRING 21082 . 21996) (TEDIT-SEE +21998 . 22682) (TEDIT.COPY 22684 . 24829) (TEDIT.DELETE 24831 . 26192) (TEDIT.INSERT 26194 . 29163) ( +TEDIT.TERPRI 29165 . 30279) (TEDIT.KILL 30281 . 31263) (TEDIT.QUIT 31265 . 32631) (TEDIT.MOVE 32633 . +33521) (TEDIT.STRINGWIDTH 33523 . 34194) (TEDIT.CHARWIDTH 34196 . 36438)) (36441 38382 (TEXTOBJ 36451 + . 36916) (COERCETEXTOBJ 36918 . 38380)) (39782 41432 (TDRIBBLE 39792 . 41430)) (41473 53369 ( +TEDIT.INSERT.OBJECT 41483 . 45190) (TEDIT.EDIT.OBJECT 45192 . 48132) (TEDIT.OBJECT.CHANGED 48134 . +51324) (TEDIT.MAP.OBJECTS 51326 . 52897) (\TEDIT.FIRST.OBJPIECE 52899 . 53132) (\TEDIT.NEXT.OBJPIECE +53134 . 53367)) (53392 60835 (\TEDIT.CONCAT.PAGEFRAMES 53402 . 58469) (\TEDIT.GET.PAGE.HEADINGS 58471 + . 59500) (\TEDIT.CONCAT.INSTALL.HEADINGS 59502 . 60833)) (60836 64443 (\TEDIT.MOVE.MSG 60846 . 62927) + (\TEDIT.READONLY 62929 . 64441)) (64444 70335 (TEDIT.NCHARS 64454 . 64827) (TEDIT.RPLCHARCODE 64829 + . 67819) (TEDIT.NTHCHARCODE 67821 . 69864) (TEDIT.NTHCHAR 69866 . 70333)) (70381 127158 (\TEDIT1 +70391 . 72468) (\TEDIT.INSERT 72470 . 78583) (\TEDIT.MOVE 78585 . 86491) (\TEDIT.COPY 86493 . 91024) ( +\TEDIT.REPLACE.SELPIECES 91026 . 95562) (\TEDIT.INSERT.SELPIECES 95564 . 98561) (\TEDIT.RESTARTFN +98563 . 101068) (\TEDIT.CHARDELETE 101070 . 103999) (\TEDIT.COPYPIECE 104001 . 109163) ( +\TEDIT.APPLY.OBJFN 109165 . 112251) (\TEDIT.DELETE 112253 . 116621) (\TEDIT.DIFFUSE.PARALOOKS 116623 + . 118894) (\TEDIT.WORDDELETE 118896 . 120511) (\TEDIT.WORDDELETE.FORWARD 120513 . 122302) ( +\TEDIT.FINISHEDIT? 122304 . 127156)) (127159 127818 (\TEDIT.THELP 127169 . 127816)) (127852 136983 ( +\TEDIT.PARAPIECES 127862 . 129836) (\TEDIT.PARACHNOS 129838 . 130730) (\TEDIT.PARA.FIRST 130732 . +133833) (\TEDIT.PARA.LAST 133835 . 136981)) (136984 144079 (\TEDIT.WORD.FIRST 136994 . 140998) ( +\TEDIT.WORD.LAST 141000 . 144077)) (144280 144557 (TEDITSYSTEMDATE 144290 . 144555))))) STOP diff --git a/library/tedit/TEDIT-ABBREV b/library/tedit/TEDIT-ABBREV index d56df6b1..5f3a3cc3 100644 --- a/library/tedit/TEDIT-ABBREV +++ b/library/tedit/TEDIT-ABBREV @@ -1,223 +1,276 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 5-Sep-2025 18:50:19" -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;29 17935 +(FILECREATED "13-Jan-2026 17:51:55" {WMEDLEY}tedit>TEDIT-ABBREV.;55 18063 :EDIT-BY rmk - :CHANGES-TO (VARS TEDIT-ABBREVCOMS) + :CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND) + (VARS TEDIT-ABBREVCOMS) - :PREVIOUS-DATE " 5-Sep-2025 12:24:55" -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;28) + :PREVIOUS-DATE " 8-Jan-2026 09:09:58" {WMEDLEY}tedit>TEDIT-ABBREV.;53) (PRETTYCOMPRINT TEDIT-ABBREVCOMS) (RPAQQ TEDIT-ABBREVCOMS - [(FNS \TEDIT.ABBREV.EXPAND \TEDIT.ABBREV.PARSE \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV) - (GLOBALVARS TEDIT.ABBREVS) - (INITVARS (TEDIT.ABBREVS '(("b" "357,146" Bullet) - ("n" "357,44" Endash) - ("--" "357,44" Endash) - ("m" EMDASH) - ("---" EMDASH) - ("T" THINSPACE) - ("d" "357,60" Dagger) - ("D" "357,61" DoubleDagger) - ("s" "0,247" Section) - ("'" "0,271" RSQ) - ("`" "0,251" LSQ) - ("%"" LEFT-DOUBLEQUOTE) - ("~" RIGHT-DOUBLEQUOTE) - ("1/4" "0,274") - ("1/2" "0,275") - ("3/4" "0,276") - ("1/3" "357,375") - ("2/3" "357,376") - ("c" "0,323" Copyright) - ("c/o" "357,100" c/o) - ("%%" "357,100" c/o) - ("->" "0,256" Rightarrow) - ("ra" "0,256" Rightarrow) - ("|" "0,257" Downarrow) - ("da" "0,257" Downarrow) - ("L" "0,243" English-pound) - ("o" "0,260" Degree) - ("Y" "0,245" Yen) - ("+" "0,261" PlusMinus) - ("x" "0,264" Times) - ("/" "0,270" Divide) - ("=" "357,121") - ("p" "0,266" Paragraph) - ("r" "0,322" Register) - ("t" "0,324" Trademark) - ("tm" "0,324" Trademark) - ("bbox" "42,43" Blackbox) - ("wbox" "43,42" Whitebox) - ("-" SOFT-HYPHEN) - ("=" NONBREAKING-HYPHEN) - (" " NONBREAKING-SPACE) - ("un" "357,127") - ("int" "357,126") - ("subset" "357,131") - ("superset" "357,130") - ("&" "357,266") - ("or" "357,267") - ("not" "357,152") - ("all" "357,265") - ("exist" "357,264") - ("def" "357,162") - ("compose" "357,147") - ("DATE" \TEDIT.EXPAND.DATE) - (">>DATE<<" \TEDIT.EXPAND.DATE]) + [(FNS \TEDIT.ABBREV.EXPAND \TEDIT.ABBREV.EXPANSION \TEDIT.ABBREV.TREE \TEDIT.ABBREV.PARSE + \TEDIT.ABBREV.PARSE.CHARCODE) + (FNS \TEDIT.EXPAND.DATE) + (GLOBALVARS TEDIT.ABBREVS \TEDIT.ABBREVS.TREE \TEDIT.ABBREVS.INTREE) + (INITVARS (\TEDIT.ABBREVS.TREE NIL) + (\TEDIT.ABBREVS.INTREE NIL) + (TEDIT.ABBREVS '(("b" "357,146" Bullet) + ("n" "357,44" Endash) + ("--" "357,44" Endash) + ("m" EMDASH) + ("---" EMDASH) + ("T" THINSPACE) + ("d" "357,60" Dagger) + ("D" "357,61" DoubleDagger) + ("s" "0,247" Section) + ("'" "0,271" RSQ) + ("`" "0,251" LSQ) + ("%"" LEFT-DOUBLEQUOTE) + ("~" RIGHT-DOUBLEQUOTE) + ("1/4" "0,274") + ("1/2" "0,275") + ("3/4" "0,276") + ("1/3" "357,375") + ("2/3" "357,376") + ("c" "0,323" Copyright) + ("c/o" "357,100" c/o) + ("%%" "357,100" c/o) + ("->" "0,256" Rightarrow) + ("ra" "0,256" Rightarrow) + ("|" "0,257" Downarrow) + ("da" "0,257" Downarrow) + ("L" "0,243" English-pound) + ("o" "0,260" Degree) + ("Y" "0,245" Yen) + ("+-" "0,261" PlusMinus) + ("x" "0,264" Times) + ("/" "0,270" Divide) + ("lra" "357,121") + ("p" "0,266" Paragraph) + ("r" "0,322" Register) + ("t" "0,324" Trademark) + ("tm" "0,324" Trademark) + ("bbox" "42,43" Blackbox) + ("wbox" "43,42" Whitebox) + ("-" SOFT-HYPHEN) + ("=" NONBREAKING-HYPHEN) + ("nbsp" NONBREAKING-SPACE) + (" " NONBREAKING-SPACE "original, but deprecated") + ("un" "357,127") + ("int" "357,126") + ("subset" "357,131") + ("superset" "357,130") + ("&" "357,266") + ("or" "357,267") + ("not" "357,152") + ("all" "357,265") + ("exist" "357,264") + ("def" "357,162") + (in "357,112" Member) + ("compose" "357,147") + ("!" "0,241") + (* ; " Inverted !") + ("?" "0,277") + (* ; " Inverted ?") + ("u" "0,265" MicroSign) + ("<<" "0,253") + (* ; " Left double guillemet") + (">>" "0,273") + (* ; " Right double guillemet") + ("DATE" \TEDIT.EXPAND.DATE) + (">>DATE<<" \TEDIT.EXPAND.DATE]) (DEFINEQ (\TEDIT.ABBREV.EXPAND - [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 20-Apr-2025 23:30 by rmk") + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 13-Jan-2026 17:51 by rmk") + (* ; "Edited 8-Jan-2026 09:08 by rmk") + (* ; "Edited 3-Jan-2026 13:13 by rmk") + (* ; "Edited 20-Apr-2025 23:30 by rmk") (* ; "Edited 20-Mar-2025 21:52 by rmk") (* ; "Edited 30-May-91 19:27 by jds") (* ; "Expand an abbvreviation") - (LET ((CANDIDATES (\TEDIT.ABBREV.PARSE TSTREAM SEL)) - CAND EXPANSION) + (\TEDIT.ABBREV.TREE) - (* ;; "Candidates are ordered longest first, so D doesn't override EMDASH.") + (* ;; "If a point selection (DCH <= 1), let the tree control the match, otherwise stop at the beginning of the selection. If the character before the caret is \, then the match string consists of all characters between that \ and the first preceding one.") - (* ;; "Try literal match first, then fiddle the case.") + (LET* ((LASTCHNO (GETSEL SEL CHLAST)) + (POINTSELECTION (ILEQ (FGETSEL SEL DCH) + 1)) + (FIRSTCHNO (CL:IF POINTSELECTION + 1 + (FGETSEL SEL CH#))) + BACKSLASH ABBREV EXPANSION LEN) + (CL:WHEN (MEMB (TEDIT.NTHCHARCODE TSTREAM LASTCHNO) + (CHARCODE (EOL FORM Meta,EOL))) - (* ;; "If we don't find it in abbrevs, try for a character code.") + (* ;; "Line or paragraph selection: back up over the terminator. Maybe we should back up over spaces too--except for the no-breaking space abbreviation?") - [SETQ CAND (OR (find C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV - (CAR C) - TSTREAM))) - (for C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV - (U-CASE (CAR C)) - TSTREAM))) - (for C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV - (L-CASE (CAR C)) - TSTREAM] - (if EXPANSION - then (\TEDIT.UPDATE.SEL SEL (CADR CAND) - (CADDR CAND) - 'RIGHT - 'NORMAL) (* ; "Set the target") - (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.FROM.STRING EXPANSION TEXTOBJ NIL - (PCHARLOOKS (\TEDIT.CHTOPC (CADR CAND) - TEXTOBJ))) - TSTREAM SEL) - else (TEDIT.PROMPTPRINT TSTREAM "No abbreviation to expand" T]) + (add LASTCHNO -1)) + (CL:WHEN (EQ (CHARCODE \) + (TEDIT.NTHCHARCODE TSTREAM LASTCHNO)) (* ; + "But if selection ends with \, go back to previous \ to match/consume \xxx\ ") + (SETQ BACKSLASH T) (* ; + "Started with backslash, extend match") + (SETQ POINTSELECTION NIL) + (for I CH from (SUB1 LASTCHNO) by -1 as J from 1 to 25 + do (SETQ CH (TEDIT.NTHCHARCODE TSTREAM I)) (* ; "Don't cross over an image obj") + (if (IMAGEOBJP CH) + then (RETURN) + elseif (EQ CH (CHARCODE \)) + then (SETQ FIRSTCHNO I) + (RETURN))) + (add LASTCHNO -1)) + (if (AND FIRSTCHNO [SETQ ABBREV (OR (\TEDIT.ABBREV.PARSE TSTREAM FIRSTCHNO LASTCHNO + POINTSELECTION) + (\TEDIT.ABBREV.PARSE TSTREAM FIRSTCHNO LASTCHNO + POINTSELECTION T) + (CL:UNLESS POINTSELECTION (\TEDIT.ABBREV.PARSE.CHARCODE + TSTREAM FIRSTCHNO LASTCHNO] + (SETQ EXPANSION (\TEDIT.ABBREV.EXPANSION ABBREV TSTREAM))) + then (SETQ LEN (NCHARS (CAR ABBREV))) + (SETQ FIRSTCHNO (ADD1 (IDIFFERENCE LASTCHNO LEN))) + (CL:WHEN BACKSLASH (* ; + "LASTCHNO and LEN include the final backslash") + (add LASTCHNO 1) + (add LEN 1)) + (\TEDIT.UPDATE.SEL SEL FIRSTCHNO LEN 'RIGHT 'NORMAL) + (* ; "Set the target") + (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.FROM.STRING EXPANSION TEXTOBJ NIL + (PCHARLOOKS (\TEDIT.CHTOPC FIRSTCHNO TEXTOBJ))) + TSTREAM SEL) + (TEDIT.PROMPTPRINT TSTREAM (CONCAT "Replaced " (CL:IF BACKSLASH + (CONCAT (CAR ABBREV) + "\") + (CAR ABBREV)) + " with " EXPANSION) + T) + else (TEDIT.PROMPTPRINT TSTREAM "No abbreviation to expand" T]) -(\TEDIT.ABBREV.PARSE - [LAMBDA (TSTREAM SEL) (* ; "Edited 11-Aug-2025 14:40 by rmk") - (* ; "Edited 7-Aug-2025 12:50 by rmk") - (* ; "Edited 24-Apr-2025 23:45 by rmk") - (* ; "Edited 28-Mar-2025 10:11 by rmk") - (* ; "Edited 23-Mar-2025 17:08 by rmk") - (* ; "Edited 20-Mar-2025 22:21 by rmk") +(\TEDIT.ABBREV.EXPANSION + [LAMBDA (ABBREV TSTREAM) (* ; "Edited 2-Jan-2026 22:46 by rmk") + (* ; "Edited 6-Sep-2025 00:09 by rmk") + (* ; "Edited 20-Mar-2025 21:52 by rmk") + (* ; "Edited 6-Aug-2020 14:41 by rmk:") + (* jds "11-Jul-85 12:46") - (* ;; "This produces candidate abbreviation-strings by parsing the characters around the point. Each candidate is returned as a list (KEY STARTCH# LEN).") + (* ;; "Decode the expansion:") + + (* ;; " A string may be a character name, otherwise itself. ") (* ;; - "It first backs up over any spaces to find the anchor position. The candidates then include") + " A litatom may be a character name,otherwise it is a function (if it has a GETD) to be applied.") - (* ;; " The immediately preceding singleton character, if a point selection") + (* ;; " Anything else is evaled. ") - (* ;; " The remaining (after backing up) characters of the selection.") + (LET ((KEY (CAR ABBREV)) + (EXPANSION (CADR ABBREV)) + CH) + (CL:WHEN (LISTP EXPANSION) (* ; + "Originally stored in the CDR. Now can be followed by comments") + (SETQ EXPANSION (CAR EXPANSION))) + (if (NULL EXPANSION) + then + (* ;; "So basically you can use any character name to insert its character") - (* ;; " The word that contains the caret (backwards and forwards)") + (CL:WHEN (SETQ CH (CHARCODE.DECODE KEY T)) + (CHARACTER CH)) + elseif (AND (OR (STRINGP EXPANSION) + (LITATOM EXPANSION)) + (SETQ CH (CHARCODE.DECODE EXPANSION T))) + then + (* ;; "Could be a character code") - (* ;; " If the character before a candidate C is a comma, then the word before W before the comma (without or without \) is extracted, and W,C is is added to the list (a possible charname).") + (CHARACTER CH) + elseif (STRINGP EXPANSION) + then + (* ;; " Could be a character code") - (* ;; "If the character before a candidate C is \, the \ is included in the replacement span, and \C is also added to the list (Tex style)") + (CL:IF (SETQ CH (CHARCODE.DECODE EXPANSION T)) + (CHARACTER CH) + EXPANSION) + elseif (SMALLP EXPANSION) + then + (* ;; "Treat a number as a character code.") - (* ;; "If one of the candidates is a character name, the abbreviation exapnds to the corresponding character.") + (CHARACTER EXPANSION) + elseif (AND (LITATOM EXPANSION) + (OR (SETQ CH (CHARCODE.DECODE EXPANSION T)) + (GETD EXPANSION))) + then (* ; + " Either a character name or a function") + (CL:IF CH + (CHARACTER CH) + (APPLY* EXPANSION TSTREAM KEY)) + elseif (LISTP EXPANSION) + then (* ; "Form in the CADR, now") + (EVAL EXPANSION) + elseif (AND (SETQ EXPANSION (CDR (SASSOC KEY TEDIT.ABBREVS))) + (LITATOM (CAR EXPANSION)) + (GETD (CAR EXPANSION))) + then + (* ;; "Form in the CDR, originally. Have to refetch EXPANSION") - (* ;; "Otherwise, the candidates are looked up in TEDIT.ABBREVS to find their expansions.") + (EVAL EXPANSION]) - (PROG ((PT# (SUB1 (TEDIT.GETPOINT TSTREAM SEL))) - FIRST# LAST# LEN CANDIDATES KEY NSPACES) +(\TEDIT.ABBREV.TREE + [LAMBDA (ALWAYS) (* ; "Edited 6-Jan-2026 22:02 by rmk") + (* ; "Edited 4-Jan-2026 09:01 by rmk") + (CL:UNLESS (AND (NOT ALWAYS) + (EQUAL TEDIT.ABBREVS \TEDIT.ABBREVS.INTREE)) + (SETQ \TEDIT.ABBREVS.TREE NIL) + (for A in TEDIT.ABBREVS unless (EQ (CAR A) + '*) + do (STOREMULTI \TEDIT.ABBREVS.TREE [DREVERSE (LIST* 'ABBREV (UNPACK (CAR A] + A) + (CL:UNLESS (EQ '\ (NTHCHAR (CAR A) + 1)) (* ; + "Backslash at the beginning, if not already there, like Tex: \cup") + (SETQ A (CONS (PACK* "\" (CAR A)) + (CDR A))) + (STOREMULTI \TEDIT.ABBREVS.TREE [DREVERSE (LIST* 'ABBREV (UNPACK (CAR A] + A))) + (SETQ \TEDIT.ABBREVS.INTREE TEDIT.ABBREVS) + \TEDIT.ABBREVS.TREE)]) - (* ;; "The abbreviation is taken from the CH# of the current selection. It is either the character just before a point selection, the entire selection, or the word containing the selection.") +(\TEDIT.ABBREV.PARSE + [LAMBDA (TSTREAM FIRSTCHNO LASTCHNO POINTSELECTION CASEINSENSITIVE) + (* ; "Edited 7-Jan-2026 09:55 by rmk") + (* ; "Edited 3-Jan-2026 22:50 by rmk") - (* ;; " The character at CH#, if it is a point selection") + (* ;; "But if LA") - (* ;; " Otherwise either the current selection up to and including CH# or the full word that includes the selection. What works is determined by what it finds in the abbreviations list.") + (for CHNO CH MATCH (DCH _ (ADD1 (IDIFFERENCE LASTCHNO FIRSTCHNO))) + (TREE _ \TEDIT.ABBREVS.TREE) by -1 from LASTCHNO to FIRSTCHNO + while [PROGN (SETQ CH (TEDIT.NTHCHAR TSTREAM CHNO)) + (SETQ TREE (CL:IF CASEINSENSITIVE + (CL:ASSOC CH TREE :TEST (FUNCTION STRING.EQUAL)) + (ASSOC CH TREE))] when (SETQ MATCH (CDR (ASSOC 'ABBREV TREE))) + do (SETQ $$VAL MATCH) finally - (* ;; "Back up over spaces") + (* ;; + "Return NIL for a multi-char selection if the longest match doesn't cover the whole thing") - (SETQ NSPACES (for I from PT# by -1 while (EQ (CHARCODE SPACE) - (\TEDIT.NTHCHARCODE TSTREAM I)) sum 1)) - (add PT# (IMINUS NSPACES)) - (CL:WHEN (ZEROP PT#) (* ; "Beginning of document") - (RETURN)) + (CL:UNLESS [OR POINTSELECTION (EQ DCH (NCHARS (CAR MATCH] + (RETURN NIL]) - (* ;; "Each candidate is a triple containing the key and the starting character and length of the replacement target..") - - (push CANDIDATES (LIST (MKSTRING (TEDIT.NTHCHAR TSTREAM PT#)) - PT# 1)) - (SETQ LEN (IMAX 0 (IDIFFERENCE (FGETSEL SEL DCH) - NSPACES))) (* ; "Last singleton predecessor") - (CL:WHEN (IGEQ LEN 2) (* ; "At least one more character") - (push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM (FGETSEL SEL CH#) - LEN) - (FGETSEL SEL CH#) - LEN))) - (SETQ FIRST# (\TEDIT.WORD.FIRST TSTREAM PT#)) - (SETQ LEN (ADD1 (IDIFFERENCE PT# FIRST#))) - (CL:UNLESS (EQ LEN 1) (* ; "Already there") - (push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM FIRST# LEN) - FIRST# LEN))) - (SETQ LAST# (\TEDIT.WORD.LAST TSTREAM FIRST#)) - (SETQ LEN (ADD1 (IDIFFERENCE LAST# FIRST#))) - (CL:UNLESS (EQ LEN 1) (* ; "Already there") - (push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM FIRST# LEN) - FIRST# LEN))) (* ; "Extend if a ,") - [for C KEY END in CANDIDATES - do - (* ;; "Comma for MCCS character names, - and / - for internal punctuation (3/4 EMDASH). Adjacent character must be text") - - (if [AND (MEMB (\TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C))) - (CHARCODE (%, / -))) - (EQ (\TEDIT.TTC TEXT) - (TEDIT.WORDGET (\TEDIT.NTHCHARCODE TSTREAM (IDIFFERENCE (CADR C) - 2] - then (SETQ END (\TEDIT.WORD.FIRST TSTREAM (IDIFFERENCE (CADR C) - 2))) - (* ; "Comma before, maybe a charname") - (SETQ KEY (CONCAT (TEDIT.SEL.AS.STRING TSTREAM END (IDIFFERENCE (CADR C) - END)) - (CAR C))) - (push CANDIDATES (LIST KEY END (NCHARS KEY))) - elseif [AND (MEMB (\TEDIT.NTHCHARCODE TSTREAM (IPLUS (CADR C) - (CADDR C))) - (CHARCODE (%, / -))) - (EQ (\TEDIT.TTC TEXT) - (TEDIT.WORDGET (\TEDIT.NTHCHARCODE TSTREAM (IPLUS 1 (CADR C) - (CADDR C] - then [SETQ END (\TEDIT.WORD.LAST TSTREAM (ADD1 (IPLUS (CADR C) - (CADDR C] - (* ; "Comma after") - [SETQ KEY (CONCAT (CAR C) - (TEDIT.SEL.AS.STRING TSTREAM (IPLUS (CADR C) - (CADDR C)) - (ADD1 (IDIFFERENCE END (IPLUS (CADR C) - (CADDR C] - (push CANDIDATES (LIST KEY (CADR C) - (NCHARS KEY] (* ; - "If preceded by \, include it optionally in the key, always include it in the replacement") - (for C in CANDIDATES when [EQ (CHARCODE \) - (\TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C] - do (* ; "Match and replace \KEY") - [push CANDIDATES (LIST (CONCAT "\" (CAR C)) - (SUB1 (CADR C)) - (ADD1 (CADDR C] - (change (CADR C) - (SUB1 DATUM)) (* ; "Match KEY but also replace the \") - (change (CADDR C) - (ADD1 DATUM))) - [SORT CANDIDATES (FUNCTION (LAMBDA (C1 C2) - (IGEQ (CADDR C1) - (CADDR C2] (* ; "Look for longest first") - (RETURN CANDIDATES]) +(\TEDIT.ABBREV.PARSE.CHARCODE + [LAMBDA (TSTREAM FIRSTCHNO LASTCHNO) (* ; "Edited 7-Jan-2026 21:53 by rmk") + (LET ((STRING (TEDIT.SEL.AS.STRING TSTREAM FIRSTCHNO (ADD1 (IDIFFERENCE LASTCHNO FIRSTCHNO)) + 0)) + CHARCODE) + (CL:WHEN (SETQ CHARCODE (CHARCODE.DECODE (CL:IF (EQ (CHARCODE \) + (CHCON1 STRING)) + (SUBSTRING STRING 2) + STRING) + T)) + (LIST STRING (CHARACTER CHARCODE)))]) +) +(DEFINEQ (\TEDIT.EXPAND.DATE [LAMBDA (STREAM CH) (* ; "Edited 23-Feb-88 10:41 by jds") @@ -232,54 +285,16 @@ "August" "September" "October" "November" "December") (ADD1 MONTH))) " " DAY ", " YEAR]) - -(\TEDIT.TRY.ABBREV - [LAMBDA (KEY TSTREAM) (* ; "Edited 5-Sep-2025 12:24 by rmk") - (* ; "Edited 20-Mar-2025 21:52 by rmk") - (* ; "Edited 6-Aug-2020 14:41 by rmk:") - (* jds "11-Jul-85 12:46") - - (* ;; "Decode the expansion. A string may be a character name, otherwise itself. A litatom is a function to be applied, anything else is evaled. ") - - (LET [(ABBREV (CDR (SASSOC KEY TEDIT.ABBREVS] - (CL:WHEN (LISTP ABBREV) (* ; "Originally stored in the CDR") - (SETQ ABBREV (CAR ABBREV))) - (if (NULL ABBREV) - then (CL:WHEN (CHARCODE.DECODE KEY T) - (CHARACTER (CHARCODE.DECODE KEY T))) - elseif (STRINGP ABBREV) - then - (* ;; "Could be a character code") - - (LET ((CH (CHARCODE.DECODE ABBREV T))) - (CL:IF CH - (CHARACTER CH) - ABBREV)) - elseif (SMALLP ABBREV) - then - (* ;; "Treat a number as a character code.") - - (CHARACTER ABBREV) - elseif (AND (LITATOM ABBREV) - (GETD ABBREV)) - then (* ; " A function to be applied.") - (APPLY* ABBREV TSTREAM KEY) - elseif (LISTP ABBREV) - then (* ; "Form in the CADR, now") - (EVAL ABBREV) - elseif (AND (SETQ ABBREV (CDR (SASSOC KEY TEDIT.ABBREVS))) - (LITATOM (CAR ABBREV)) - (GETD (CAR ABBREV))) - then - (* ;; "Form in the CDR, originally") - - (EVAL ABBREV]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY -(GLOBALVARS TEDIT.ABBREVS) +(GLOBALVARS TEDIT.ABBREVS \TEDIT.ABBREVS.TREE \TEDIT.ABBREVS.INTREE) ) +(RPAQ? \TEDIT.ABBREVS.TREE NIL) + +(RPAQ? \TEDIT.ABBREVS.INTREE NIL) + (RPAQ? TEDIT.ABBREVS '(("b" "357,146" Bullet) ("n" "357,44" Endash) @@ -309,10 +324,10 @@ ("L" "0,243" English-pound) ("o" "0,260" Degree) ("Y" "0,245" Yen) - ("+" "0,261" PlusMinus) + ("+-" "0,261" PlusMinus) ("x" "0,264" Times) ("/" "0,270" Divide) - ("=" "357,121") + ("lra" "357,121") ("p" "0,266" Paragraph) ("r" "0,322" Register) ("t" "0,324" Trademark) @@ -321,7 +336,8 @@ ("wbox" "43,42" Whitebox) ("-" SOFT-HYPHEN) ("=" NONBREAKING-HYPHEN) - (" " NONBREAKING-SPACE) + ("nbsp" NONBREAKING-SPACE) + (" " NONBREAKING-SPACE "original, but deprecated") ("un" "357,127") ("int" "357,126") ("subset" "357,131") @@ -332,10 +348,21 @@ ("all" "357,265") ("exist" "357,264") ("def" "357,162") + (in "357,112" Member) ("compose" "357,147") + ("!" "0,241") + (* ; " Inverted !") + ("?" "0,277") + (* ; " Inverted ?") + ("u" "0,265" MicroSign) + ("<<" "0,253") + (* ; " Left double guillemet") + (">>" "0,273") + (* ; " Right double guillemet") ("DATE" \TEDIT.EXPAND.DATE) (">>DATE<<" \TEDIT.EXPAND.DATE))) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3630 16182 (\TEDIT.ABBREV.EXPAND 3640 . 5860) (\TEDIT.ABBREV.PARSE 5862 . 13472) ( -\TEDIT.EXPAND.DATE 13474 . 14107) (\TEDIT.TRY.ABBREV 14109 . 16180))))) + (FILEMAP (NIL (4390 14959 (\TEDIT.ABBREV.EXPAND 4400 . 8930) (\TEDIT.ABBREV.EXPANSION 8932 . 11996) ( +\TEDIT.ABBREV.TREE 11998 . 13129) (\TEDIT.ABBREV.PARSE 13131 . 14283) (\TEDIT.ABBREV.PARSE.CHARCODE +14285 . 14957)) (14960 15605 (\TEDIT.EXPAND.DATE 14970 . 15603))))) STOP diff --git a/library/tedit/TEDIT-ABBREV.LCOM b/library/tedit/TEDIT-ABBREV.LCOM index be684734..5cf09f86 100644 Binary files a/library/tedit/TEDIT-ABBREV.LCOM and b/library/tedit/TEDIT-ABBREV.LCOM differ diff --git a/library/tedit/TEDIT-BUTTONS b/library/tedit/TEDIT-BUTTONS index 2f00fe35..f015ff00 100644 --- a/library/tedit/TEDIT-BUTTONS +++ b/library/tedit/TEDIT-BUTTONS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "30-Apr-2025 14:09:18" {WMEDLEY}tedit>TEDIT-BUTTONS.;228 125393 +(FILECREATED "19-Oct-2025 10:44:18" {WMEDLEY}TEDIT>TEDIT-BUTTONS.;229 125526 :EDIT-BY rmk - :CHANGES-TO (FNS MB.NWAY.ADDITEM MB.NWAY.CREATE MB.NWAY.SETSTATEFN MB.NWAY.SELECT) + :CHANGES-TO (FNS MB.ADD) - :PREVIOUS-DATE "14-Apr-2025 23:50:23" {WMEDLEY}tedit>TEDIT-BUTTONS.;226) + :PREVIOUS-DATE "30-Apr-2025 14:09:18" {WMEDLEY}TEDIT>TEDIT-BUTTONS.;228) (PRETTYCOMPRINT TEDIT-BUTTONSCOMS) @@ -67,14 +67,16 @@ (DEFINEQ (MB.ADD - [LAMBDA (MENUDESC MENUTSTREAM WHERE INCREMENTALUPDATES) (* ; "Edited 6-Apr-2025 14:35 by rmk") + [LAMBDA (MENUDESC MENUTSTREAM WHERE INCREMENTALUPDATES MAINTSTREAM) + (* ; "Edited 19-Oct-2025 10:22 by rmk") + (* ; "Edited 6-Apr-2025 14:35 by rmk") (* ; "Edited 5-Jan-2025 11:36 by rmk") (* ; "Edited 22-Oct-2024 09:16 by rmk") (* ; "Edited 21-Oct-2024 00:26 by rmk") (* ; "Edited 18-Oct-2024 13:49 by rmk") (* ; "Edited 6-Oct-2024 15:25 by rmk") (* ; "Edited 24-Aug-2024 21:08 by rmk") - (DECLARE (SPECVARS MENUTSTREAM)) + (DECLARE (SPECVARS MENUTSTREAM MAINTSTREAM)) (SETQ MENUTSTREAM (TEXTSTREAM MENUTSTREAM)) (* ; "Edited 22-Aug-2024 11:10 by rmk") (* ;; "MENUDESC is a Tedit menu specification, a list of items describing one or more elements to be inserted in TSTREAM after WHERE. ") @@ -1969,25 +1971,25 @@ (MB.FIELD.INIT) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3279 19224 (MB.ADD 3289 . 9810) (MB.DELETE 9812 . 10186) (MB.GET 10188 . 16958) ( -MB.GET.MBARG 16960 . 18629) (TEDIT.BACKTOMAIN 18631 . 19222)) (19268 39204 (MB.BUTTONEVENTINFN 19278 - . 20846) (MB.DISPLAYFN 20848 . 22907) (MB.SETIMAGE 22909 . 24077) (MB.SIZEFN 24079 . 25627) ( -MB.WHENOPERATEDONFN 25629 . 27578) (MB.COPYFN 27580 . 28038) (MB.GETFN 28040 . 29001) (MB.PUTFN 29003 - . 30103) (MB.SHOWSELFN 30105 . 31614) (MB.CREATE 31616 . 35639) (MB.CHANGENAME 35641 . 36123) ( -MB.INIT 36125 . 37586) (MB.TRACK.UNTIL 37588 . 38283) (MB.DON'T 38285 . 38581) (MB.SPEC.REMAINDER -38583 . 39202)) (39366 49371 (MB.3STATE.CREATE 39376 . 40240) (MB.3STATE.DISPLAYFN 40242 . 41228) ( -MB.3STATE.SHOWSELFN 41230 . 43541) (MB.3STATE.INIT 43543 . 44954) (MB.3STATE.SETSTATEFN 44956 . 45614) - (MB.3STATE.BUTTONEVENTINFN 45616 . 49369)) (49526 80622 (MB.NWAY.CREATE 49536 . 55719) ( -MB.NWAY.DISPLAYFN 55721 . 56584) (MB.NWAY.WHENOPERATEDONFN 56586 . 58776) (MB.NWAY.SIZEFN 58778 . -62714) (MB.NWAY.SELECT 62716 . 66286) (MB.NWAY.BUTTONEVENTINFN 66288 . 69500) (MB.NWAY.NEWMENUBUTTON -69502 . 70214) (MB.NWAY.COPYFN 70216 . 71183) (MB.NWAY.INIT 71185 . 72676) (MB.NWAY.ARRANGEBUTTONS -72678 . 74649) (MB.NWAY.ADDITEM 74651 . 78800) (MB.NWAY.FINDSUBOBJ 78802 . 79316) (MB.NWAY.SETSTATEFN -79318 . 80620)) (80701 92700 (MB.TOGGLE.CREATE 80711 . 81706) (MB.TOGGLE.DISPLAYFN 81708 . 83191) ( -MB.TOGGLE.INIT 83193 . 84992) (MB.SET.TOGGLE 84994 . 86195) (MB.TOGGLE.SETSTATEFN 86197 . 87037) ( -MB.TOGGLE.BUTTONEVENTINFN 87039 . 91355) (MB.TOGGLE.WHENOPERATEDONFN 91357 . 92698)) (92781 125314 ( -MB.FIELD.CREATE 92791 . 98242) (MB.FIELD.DISPLAYFN 98244 . 99035) (MB.FIELD.IMAGEBOXFN 99037 . 100519) - (MB.FIELD.PREFIXCREATE 100521 . 104457) (MB.FIELD.SUFFIXCREATE 104459 . 106119) (MB.FIELD.INIT 106121 - . 107888) (MB.FIELD.WHENOPERATEDONFN 107890 . 109161) (MB.FIELD.GETSTATEFN 109163 . 113097) ( -MB.FIELD.SETSTATEFN 113099 . 117903) (MB.FIELD.BUTTONEVENTINFN 117905 . 120210) (MB.FIELD.SIZEFN -120212 . 120452) (MB.FIELD.INSURETYPE 120454 . 125312))))) + (FILEMAP (NIL (3221 19357 (MB.ADD 3231 . 9943) (MB.DELETE 9945 . 10319) (MB.GET 10321 . 17091) ( +MB.GET.MBARG 17093 . 18762) (TEDIT.BACKTOMAIN 18764 . 19355)) (19401 39337 (MB.BUTTONEVENTINFN 19411 + . 20979) (MB.DISPLAYFN 20981 . 23040) (MB.SETIMAGE 23042 . 24210) (MB.SIZEFN 24212 . 25760) ( +MB.WHENOPERATEDONFN 25762 . 27711) (MB.COPYFN 27713 . 28171) (MB.GETFN 28173 . 29134) (MB.PUTFN 29136 + . 30236) (MB.SHOWSELFN 30238 . 31747) (MB.CREATE 31749 . 35772) (MB.CHANGENAME 35774 . 36256) ( +MB.INIT 36258 . 37719) (MB.TRACK.UNTIL 37721 . 38416) (MB.DON'T 38418 . 38714) (MB.SPEC.REMAINDER +38716 . 39335)) (39499 49504 (MB.3STATE.CREATE 39509 . 40373) (MB.3STATE.DISPLAYFN 40375 . 41361) ( +MB.3STATE.SHOWSELFN 41363 . 43674) (MB.3STATE.INIT 43676 . 45087) (MB.3STATE.SETSTATEFN 45089 . 45747) + (MB.3STATE.BUTTONEVENTINFN 45749 . 49502)) (49659 80755 (MB.NWAY.CREATE 49669 . 55852) ( +MB.NWAY.DISPLAYFN 55854 . 56717) (MB.NWAY.WHENOPERATEDONFN 56719 . 58909) (MB.NWAY.SIZEFN 58911 . +62847) (MB.NWAY.SELECT 62849 . 66419) (MB.NWAY.BUTTONEVENTINFN 66421 . 69633) (MB.NWAY.NEWMENUBUTTON +69635 . 70347) (MB.NWAY.COPYFN 70349 . 71316) (MB.NWAY.INIT 71318 . 72809) (MB.NWAY.ARRANGEBUTTONS +72811 . 74782) (MB.NWAY.ADDITEM 74784 . 78933) (MB.NWAY.FINDSUBOBJ 78935 . 79449) (MB.NWAY.SETSTATEFN +79451 . 80753)) (80834 92833 (MB.TOGGLE.CREATE 80844 . 81839) (MB.TOGGLE.DISPLAYFN 81841 . 83324) ( +MB.TOGGLE.INIT 83326 . 85125) (MB.SET.TOGGLE 85127 . 86328) (MB.TOGGLE.SETSTATEFN 86330 . 87170) ( +MB.TOGGLE.BUTTONEVENTINFN 87172 . 91488) (MB.TOGGLE.WHENOPERATEDONFN 91490 . 92831)) (92914 125447 ( +MB.FIELD.CREATE 92924 . 98375) (MB.FIELD.DISPLAYFN 98377 . 99168) (MB.FIELD.IMAGEBOXFN 99170 . 100652) + (MB.FIELD.PREFIXCREATE 100654 . 104590) (MB.FIELD.SUFFIXCREATE 104592 . 106252) (MB.FIELD.INIT 106254 + . 108021) (MB.FIELD.WHENOPERATEDONFN 108023 . 109294) (MB.FIELD.GETSTATEFN 109296 . 113230) ( +MB.FIELD.SETSTATEFN 113232 . 118036) (MB.FIELD.BUTTONEVENTINFN 118038 . 120343) (MB.FIELD.SIZEFN +120345 . 120585) (MB.FIELD.INSURETYPE 120587 . 125445))))) STOP diff --git a/library/tedit/TEDIT-BUTTONS.LCOM b/library/tedit/TEDIT-BUTTONS.LCOM index 3b2a83e0..5fd32581 100644 Binary files a/library/tedit/TEDIT-BUTTONS.LCOM and b/library/tedit/TEDIT-BUTTONS.LCOM differ diff --git a/library/tedit/TEDIT-COMMAND b/library/tedit/TEDIT-COMMAND index 3211d03f..96aa3adf 100644 --- a/library/tedit/TEDIT-COMMAND +++ b/library/tedit/TEDIT-COMMAND @@ -1,14 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "17-Jul-2025 00:24:49" -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;165 19015 +(FILECREATED " 8-Nov-2025 10:03:19" {WMEDLEY}TEDIT>TEDIT-COMMAND.;166 19030 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.COMMAND.RESET.SETUP) + :CHANGES-TO (FNS \TEDIT.COMMAND.FUNCTION?) - :PREVIOUS-DATE "23-Mar-2025 15:27:20" -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;163) + :PREVIOUS-DATE "17-Jul-2025 00:24:49" {WMEDLEY}TEDIT>TEDIT-COMMAND.;165) (PRETTYCOMPRINT TEDIT-COMMANDCOMS) @@ -137,7 +135,8 @@ (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))]) (\TEDIT.COMMAND.FUNCTION? - [LAMBDA (TSTREAM CHARCODE) (* ; "Edited 23-Mar-2025 15:27 by rmk") + [LAMBDA (TSTREAM CHARCODE) (* ; "Edited 8-Nov-2025 10:00 by rmk") + (* ; "Edited 23-Mar-2025 15:27 by rmk") (DECLARE (SPECVARS TSTREAM CHARCODE)) (* ;; "If CHARCODE is a function in TSTREAM's read table, execute the function.") @@ -145,7 +144,7 @@ (LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) FN) (DECLARE (SPECVARS TEXTOBJ)) - (CL:WHEN [AND (EQ (\TEDIT.TTC FUNCTIONCALL) + (CL:WHEN [AND (EQ (\TEDIT.TTC FN) (\SYNCODE (fetch READSA of (FGETTOBJ TEXTOBJ TXTRTBL)) CHARCODE)) (SETQ FN (CAR (fetch MACROFN of (GETHASH CHARCODE (fetch READMACRODEFS @@ -303,7 +302,7 @@ (GLOBALVARS || TEDIT.INTERRUPTS) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2709 10263 (\TEDIT.COMMAND.LOOP 2719 . 9060) (\TEDIT.COMMAND.FUNCTION? 9062 . 10261)) ( -10264 18725 (\TEDIT.INTERRUPT.SETUP 10274 . 11921) (\TEDIT.MARKACTIVE 11923 . 12252) ( -\TEDIT.MARKINACTIVE 12254 . 12470) (\TEDIT.COMMAND.RESET.SETUP 12472 . 18723))))) + (FILEMAP (NIL (2625 10278 (\TEDIT.COMMAND.LOOP 2635 . 8976) (\TEDIT.COMMAND.FUNCTION? 8978 . 10276)) ( +10279 18740 (\TEDIT.INTERRUPT.SETUP 10289 . 11936) (\TEDIT.MARKACTIVE 11938 . 12267) ( +\TEDIT.MARKINACTIVE 12269 . 12485) (\TEDIT.COMMAND.RESET.SETUP 12487 . 18738))))) STOP diff --git a/library/tedit/TEDIT-COMMAND.LCOM b/library/tedit/TEDIT-COMMAND.LCOM index 583d13aa..cf5bdabb 100644 Binary files a/library/tedit/TEDIT-COMMAND.LCOM and b/library/tedit/TEDIT-COMMAND.LCOM differ diff --git a/library/tedit/TEDIT-FILE b/library/tedit/TEDIT-FILE index 7ac1a3fe..b529ddc8 100644 --- a/library/tedit/TEDIT-FILE +++ b/library/tedit/TEDIT-FILE @@ -1,14 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Sep-2025 21:32:46" -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-FILE.;655 173148 +(FILECREATED "23-Oct-2025 08:49:06" {WMEDLEY}tedit>TEDIT-FILE.;656 173140 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.GET.FORMATTED.FILE \TEDIT.PUT.SINGLE.CHARLOOKS - \TEDIT.GET.SINGLE.CHARLOOKS) + :CHANGES-TO (FNS \TEDIT.GET.UNFORMATTED.FILE.UTF8) - :PREVIOUS-DATE " 9-Sep-2025 21:49:43" {WMEDLEY}tedit>TEDIT-FILE.;653) + :PREVIOUS-DATE "25-Sep-2025 21:32:46" {WMEDLEY}tedit>TEDIT-FILE.;655) (PRETTYCOMPRINT TEDIT-FILECOMS) @@ -1388,7 +1386,8 @@ (DEFINEQ (\TEDIT.GET.UNFORMATTED.FILE.UTF8 - [LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS) (* ; "Edited 28-Jul-2025 23:45 by rmk") + [LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS) (* ; "Edited 23-Oct-2025 08:48 by rmk") + (* ; "Edited 28-Jul-2025 23:45 by rmk") (* ; "Edited 11-Mar-2024 23:55 by rmk") (* ; "Edited 4-Feb-2024 10:12 by rmk") (* ; "Edited 2-Feb-2024 11:24 by rmk") @@ -1428,7 +1427,7 @@ (SETQ CHAR (\PEEKBIN STRM)) (* ; "Keep CHAR for CR/LF checking, error if EOF") (* ; "Error if invalid header") - (SETQ NEXTCODESIZE (UTF8-SIZE-FROM-BYTE1 CHAR)) + (SETQ NEXTCODESIZE (NUTF8-BYTE1-BYTES CHAR)) (CL:UNLESS (EQ CODESIZE NEXTCODESIZE) (* ; "Header byte hasn't been read") (* ;; "Don't want LF processing if we split because of size change. If next is a CR/LF still in size 1, we pick it up below") @@ -2694,28 +2693,28 @@ (RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5431 35690 (TEDIT.GET 5441 . 11851) (TEDIT.FORMATTEDFILEP 11853 . 13169) ( -TEDIT.FILEDATE 13171 . 14480) (TEDIT.INCLUDE 14482 . 22511) (TEDIT.RAW.INCLUDE 22513 . 23321) ( -TEDIT.PUT 23323 . 31679) (TEDIT.PUT.STREAM 31681 . 35688)) (35691 56965 (\TEDIT.GET.FOREIGN.FILE 35701 - . 39126) (\TEDIT.GET.UNFORMATTED.FILE 39128 . 43434) (\TEDIT.GET.FORMATTED.FILE 43436 . 47079) ( -\TEDIT.FORMATTEDSTREAMP 47081 . 50212) (\ARBIN 50214 . 50934) (\ATMIN 50936 . 51473) (\DWIN 51475 . -51854) (\STRINGIN 51856 . 52564) (\TEDIT.GET.TRAILER 52566 . 55434) (\TEDIT.CACHEFILE 55436 . 56963)) -(57131 73169 (\TEDIT.GET.PIECES3 57141 . 68104) (\TEDIT.GET.PROPS3 68106 . 71328) ( -\TEDIT.MAKE.STRINGPIECE 71330 . 73167)) (73170 86596 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 73180 . 79413) -(\TEDIT.INTERPRET.MCCS.SHIFTS 79415 . 85660) (\TEDIT.CONVERT.XCCSTOMCCS 85662 . 86594)) (86618 92757 ( -\TEDIT.GET.UNFORMATTED.FILE.UTF8 86628 . 92755)) (92780 104122 (\TEDIT.GET.CHARLOOKS.LIST 92790 . -93521) (\TEDIT.GET.SINGLE.CHARLOOKS 93523 . 100595) (\TEDIT.GET.CHARLOOKS 100597 . 102153) ( -\TEDIT.GET.PARALOOKS.INDEX 102155 . 102699) (\TEDIT.GET.CHARLOOKS.INDEX 102701 . 104120)) (104123 -111780 (\TEDIT.GET.PARALOOKS.LIST 104133 . 104755) (\TEDIT.GET.SINGLE.PARALOOKS 104757 . 111778)) ( -111781 115614 (\TEDIT.GET.OBJECT 111791 . 115612)) (115679 148942 (\TEDIT.PUT.PCTB 115689 . 125596) ( -\TEDIT.PUT.PCTB.PIECEDATA 125598 . 128796) (\TEDIT.PUT.TRAILER 128798 . 130126) ( -\TEDIT.PUT.PCTB.MERGEABLE 130128 . 133901) (\TEDIT.PUT.UTF8.SPLITPIECES 133903 . 138605) ( -\TEDIT.PUT.PCTB.NEXTNEW 138607 . 143103) (\TEDIT.INSERT.NEWPIECES 143105 . 146540) (\TEDIT.PUTRESET -146542 . 146784) (\ARBOUT 146786 . 147510) (\ATMOUT 147512 . 148117) (\DWOUT 148119 . 148398) ( -\STRINGOUT 148400 . 148940)) (148943 161677 (\TEDIT.PUT.CHARLOOKS.LIST 148953 . 150625) ( -\TEDIT.PUT.SINGLE.CHARLOOKS 150627 . 156907) (\TEDIT.PUT.CHARLOOKS 156909 . 158248) ( -\TEDIT.PUT.CHARLOOKS1 158250 . 159301) (\TEDIT.PUT.OBJECT 159303 . 161675)) (161678 169317 ( -\TEDIT.PUT.PARALOOKS.LIST 161688 . 162590) (\TEDIT.PUT.SINGLE.PARALOOKS 162592 . 168176) ( -\TEDIT.PUT.PARALOOKS 168178 . 169315)) (169412 172841 (TEDITFROMLISPSOURCE 169422 . 172090) ( -SHELLSCRIPTP 172092 . 172321) (TEDITFROMSHELLSCRIPT 172323 . 172839))))) + (FILEMAP (NIL (5317 35576 (TEDIT.GET 5327 . 11737) (TEDIT.FORMATTEDFILEP 11739 . 13055) ( +TEDIT.FILEDATE 13057 . 14366) (TEDIT.INCLUDE 14368 . 22397) (TEDIT.RAW.INCLUDE 22399 . 23207) ( +TEDIT.PUT 23209 . 31565) (TEDIT.PUT.STREAM 31567 . 35574)) (35577 56851 (\TEDIT.GET.FOREIGN.FILE 35587 + . 39012) (\TEDIT.GET.UNFORMATTED.FILE 39014 . 43320) (\TEDIT.GET.FORMATTED.FILE 43322 . 46965) ( +\TEDIT.FORMATTEDSTREAMP 46967 . 50098) (\ARBIN 50100 . 50820) (\ATMIN 50822 . 51359) (\DWIN 51361 . +51740) (\STRINGIN 51742 . 52450) (\TEDIT.GET.TRAILER 52452 . 55320) (\TEDIT.CACHEFILE 55322 . 56849)) +(57017 73055 (\TEDIT.GET.PIECES3 57027 . 67990) (\TEDIT.GET.PROPS3 67992 . 71214) ( +\TEDIT.MAKE.STRINGPIECE 71216 . 73053)) (73056 86482 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 73066 . 79299) +(\TEDIT.INTERPRET.MCCS.SHIFTS 79301 . 85546) (\TEDIT.CONVERT.XCCSTOMCCS 85548 . 86480)) (86504 92749 ( +\TEDIT.GET.UNFORMATTED.FILE.UTF8 86514 . 92747)) (92772 104114 (\TEDIT.GET.CHARLOOKS.LIST 92782 . +93513) (\TEDIT.GET.SINGLE.CHARLOOKS 93515 . 100587) (\TEDIT.GET.CHARLOOKS 100589 . 102145) ( +\TEDIT.GET.PARALOOKS.INDEX 102147 . 102691) (\TEDIT.GET.CHARLOOKS.INDEX 102693 . 104112)) (104115 +111772 (\TEDIT.GET.PARALOOKS.LIST 104125 . 104747) (\TEDIT.GET.SINGLE.PARALOOKS 104749 . 111770)) ( +111773 115606 (\TEDIT.GET.OBJECT 111783 . 115604)) (115671 148934 (\TEDIT.PUT.PCTB 115681 . 125588) ( +\TEDIT.PUT.PCTB.PIECEDATA 125590 . 128788) (\TEDIT.PUT.TRAILER 128790 . 130118) ( +\TEDIT.PUT.PCTB.MERGEABLE 130120 . 133893) (\TEDIT.PUT.UTF8.SPLITPIECES 133895 . 138597) ( +\TEDIT.PUT.PCTB.NEXTNEW 138599 . 143095) (\TEDIT.INSERT.NEWPIECES 143097 . 146532) (\TEDIT.PUTRESET +146534 . 146776) (\ARBOUT 146778 . 147502) (\ATMOUT 147504 . 148109) (\DWOUT 148111 . 148390) ( +\STRINGOUT 148392 . 148932)) (148935 161669 (\TEDIT.PUT.CHARLOOKS.LIST 148945 . 150617) ( +\TEDIT.PUT.SINGLE.CHARLOOKS 150619 . 156899) (\TEDIT.PUT.CHARLOOKS 156901 . 158240) ( +\TEDIT.PUT.CHARLOOKS1 158242 . 159293) (\TEDIT.PUT.OBJECT 159295 . 161667)) (161670 169309 ( +\TEDIT.PUT.PARALOOKS.LIST 161680 . 162582) (\TEDIT.PUT.SINGLE.PARALOOKS 162584 . 168168) ( +\TEDIT.PUT.PARALOOKS 168170 . 169307)) (169404 172833 (TEDITFROMLISPSOURCE 169414 . 172082) ( +SHELLSCRIPTP 172084 . 172313) (TEDITFROMSHELLSCRIPT 172315 . 172831))))) STOP diff --git a/library/tedit/TEDIT-FILE.LCOM b/library/tedit/TEDIT-FILE.LCOM index b68ce1d0..6809340d 100644 Binary files a/library/tedit/TEDIT-FILE.LCOM and b/library/tedit/TEDIT-FILE.LCOM differ diff --git a/library/tedit/TEDIT-FNKEYS b/library/tedit/TEDIT-FNKEYS index d9da38e1..850b43ba 100644 --- a/library/tedit/TEDIT-FNKEYS +++ b/library/tedit/TEDIT-FNKEYS @@ -1,18 +1,18 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Aug-2025 15:00:51" {WMEDLEY}TEDIT>TEDIT-FNKEYS.;294 106161 +(FILECREATED "24-Nov-2025 08:40:56" {WMEDLEY}TEDIT>TEDIT-FNKEYS.;317 109076 :EDIT-BY rmk - :CHANGES-TO (VARS TEDIT-FNKEYSCOMS) + :CHANGES-TO (VARS TEDIT.BASIC.CHARBINDINGS) - :PREVIOUS-DATE " 6-Aug-2025 08:59:59" {WMEDLEY}TEDIT>TEDIT-FNKEYS.;293) + :PREVIOUS-DATE "24-Nov-2025 00:38:18" {WMEDLEY}TEDIT>TEDIT-FNKEYS.;316) (PRETTYCOMPRINT TEDIT-FNKEYSCOMS) (RPAQQ TEDIT-FNKEYSCOMS - ((COMS (* ; + [(COMS (* ; "Public functions (binding data below)") (FNS TEDIT.INSTALL.CHARBINDINGS TEDIT.CLEAR.CHARBINDINGS TEDIT.GET.CHARACTION TEDIT.GET.CHARBINDING TEDIT.GET.ALL.CHARBINDINGS TEDIT.CHARBINDINGS.INVERT @@ -30,7 +30,7 @@ (FNS \TEDIT.ONECHAR.BACKWARD \TEDIT.ONECHAR.FORWARD \TEDIT.ONELINE.UP \TEDIT.ONELINE.DOWN \TEDIT.ONELINE.MOVE \TEDIT.ONEWORD.BACKWARD \TEDIT.ONEWORD.FORWARD \TEDIT.LINE.BEGIN \TEDIT.LINE.END \TEDIT.DOCUMENT.BEGIN \TEDIT.DOCUMENT.END) - (FNS \TEDIT.LINEDELETE.FORWARD \TEDIT.LINEDELETE.BACKWARD) + (FNS \TEDIT.LINEDELETE.FORWARD \TEDIT.LINEDELETE.BACKWARD \TEDIT.LINEDELETE) (FNS \TEDIT.KEY.NEST) (FNS \TEDIT.KEY.WRAP) (* ; "From TEDITDORADOKEYS") @@ -47,21 +47,39 @@ (FNS \TEDIT.READTABLE \TEDIT.WORDBOUND.READTABLE TEDIT.GETSYNTAX TEDIT.SETSYNTAX TEDIT.GETFUNCTION TEDIT.SETFUNCTION TEDIT.WORDGET TEDIT.WORDSET TEDIT.ATOMBOUND.READTABLE)) - (* ; "Keybindings") - (DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (CONSTANTS \TEDIT.TTCCODES) - (MACROS \TEDIT.TTC))) - (VARS TEDIT.CHARACTIONS TEDIT.BASIC.CHARBINDINGS TEDIT.DORADO.CHARBINDINGS - (TEDIT.CHARBINDINGS (APPEND TEDIT.BASIC.CHARBINDINGS TEDIT.DORADO.CHARBINDINGS))) - (* ; "Installation") - [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.READTABLE (\TEDIT.READTABLE)) - (TEDIT.WORDBOUND.READTABLE (\TEDIT.WORDBOUND.READTABLE] (* ;; "On-screen formatting buttons (TEDIT.BUTTONS.BUILD) creates the default button menu") - (VARS TEDIT.BUTTONS.SPEC) (FNS TEDIT.BUTTONS.BUILD TEDIT.BUTTONBITMAP.FILL) - (INITVARS (TEDIT.BUTTONS.WINDOW NIL)) - (VARS TEDIT.BUTTONBITMAP))) + (INITVARS TEDIT.BUTTONS.WINDOW) + (VARS TEDIT.BUTTONBITMAP) + [INITVARS (TEDIT.BUTTONS.SPEC '((Bold :BOLD.ON :BOLD.OFF) + (Italic :ITALIC.ON :ITALIC.OFF) + (Case :UCASE :LCASE) + ((Strike- out) + :STRIKEOUT.ON :STRIKEOUT.OFF) + ((Under- line) + :UNDERLINE.ON :UNDERLINE.OFF) + ((Super/ Sub) + :SUPERSCRIPT :SUBSCRIPT) + ((Larger Smaller) + :LARGER :SMALLER) + (Justify :QUAD) + (Defaults :DEFAULTS) + (Show :SHOW.CHARLOOKS) + (Redo :REDO] + (* ; "Keybindings") + (DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (CONSTANTS \TEDIT.TTCCODES) + (MACROS \TEDIT.TTC))) + (FNS \TEDIT.TTCCLASS) + (VARS ORIG.TEDIT.CHARACTIONS) + (INITVARS (TEDIT.CHARACTIONS (APPEND ORIG.TEDIT.CHARACTIONS))) + (VARS TEDIT.BASIC.CHARBINDINGS TEDIT.DORADO.CHARBINDINGS) + (INITVARS (TEDIT.CHARBINDINGS (APPEND TEDIT.BASIC.CHARBINDINGS TEDIT.DORADO.CHARBINDINGS))) + (GLOBALVARS TEDIT.CHARBINDINGS TEDIT.CHARACTIONS) + (* ; "Installation") + (DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.READTABLE (\TEDIT.READTABLE)) + (TEDIT.WORDBOUND.READTABLE (\TEDIT.WORDBOUND.READTABLE]) @@ -70,7 +88,9 @@ (DEFINEQ (TEDIT.INSTALL.CHARBINDINGS - [LAMBDA (CHARBINDINGS RDTBL CHARACTIONS) (* ; "Edited 7-Apr-2025 20:01 by rmk") + [LAMBDA (CHARBINDINGS RDTBL CHARACTIONS) (* ; "Edited 24-Nov-2025 00:10 by rmk") + (* ; "Edited 10-Nov-2025 16:47 by rmk") + (* ; "Edited 7-Apr-2025 20:01 by rmk") (* ; "Edited 5-Apr-2025 11:36 by rmk") (* ; "Edited 1-Apr-2025 00:19 by rmk") (* ; "Edited 18-Mar-2025 11:15 by rmk") @@ -86,6 +106,7 @@ (CL:UNLESS CHARBINDINGS (SETQ CHARBINDINGS TEDIT.CHARBINDINGS)) (CL:UNLESS (LISTP CHARBINDINGS) (\ILLEGAL.ARG CHARBINDINGS)) + (CL:UNLESS CHARACTIONS (SETQ CHARACTIONS TEDIT.CHARACTIONS)) (CL:UNLESS (READTABLEP RDTBL) (SETQ RDTBL (if (NULL RDTBL) then TEDIT.READTABLE @@ -94,37 +115,21 @@ TXTRTBL) TEDIT.READTABLE) else (\ILLEGAL.ARG RDTBL)))) - (CL:UNLESS CHARACTIONS (SETQ CHARACTIONS TEDIT.CHARACTIONS)) (TEDIT.CONFLICTING.CHARBINDINGS (APPEND CHARBINDINGS (TEDIT.GET.ALL.CHARBINDINGS RDTBL))) - [for CB A ACTION in CHARBINDINGS first (TEDIT.CONFLICTING.CHARBINDINGS (APPEND CHARBINDINGS - ( - TEDIT.GET.ALL.CHARBINDINGS - RDTBL))) - when (LISTP CB) unless (EQ '* (CAR CB)) when (AND [SETQ ACTION - (find PAIR in CHARACTIONS - suchthat - - (* ;; - "An ASSOC that allows synonym keys") - - (EQMEMB (CAR CB) - (CAR PAIR] - (SETQ A (CADR ACTION))) - do (for CHAR in (CDR CB) do (CL:UNLESS (CHARCODEP CHAR) - (SETQ CHAR (CHARCODE.DECODE CHAR))) - (TEDIT.SETFUNCTION CHAR A RDTBL) + (for CB ACTION in CHARBINDINGS when (LISTP CB) unless (EQ '* (CAR CB)) + when (SETQ ACTION (CADR (ASSOC (CAR CB) + CHARACTIONS))) do (for CHAR in (CDR CB) + do (CL:UNLESS (CHARCODEP CHAR) + (SETQ CHAR (CHARCODE.DECODE CHAR))) + (TEDIT.SETFUNCTION CHAR ACTION RDTBL))) (* ; "Set the method") - (CL:WHEN NIL - (ASSOC (CAR ACTION) - \TEDIT.TTCCODES) - (* ; - "A tag like NEXT, UNDO. Setup the termtable FWIW ") - (TEDIT.SETSYNTAX CHAR (CAR ACTION) - RDTBL))] RDTBL]) (TEDIT.CLEAR.CHARBINDINGS - [LAMBDA (RDTBL BINDINGS) (* ; "Edited 5-Apr-2025 11:36 by rmk") + [LAMBDA (RDTBL BINDINGS) (* ; "Edited 12-Nov-2025 14:44 by rmk") + (* ; "Edited 10-Nov-2025 14:22 by rmk") + (* ; "Edited 8-Nov-2025 10:00 by rmk") + (* ; "Edited 5-Apr-2025 11:36 by rmk") (* ; "Edited 18-Mar-2025 11:10 by rmk") (* ; "Edited 15-Mar-2025 12:02 by rmk") @@ -142,28 +147,31 @@ [if (EQ BINDINGS T) then [MAPHASH (fetch READMACRODEFS of RDTBL) (FUNCTION (LAMBDA (VAL CHARCODE) - (CL:WHEN (EQ (\TEDIT.TTC FUNCTIONCALL) + (CL:WHEN (EQ (\TEDIT.TTC FN) (\SYNCODE (fetch READSA of RDTBL) CHARCODE)) (TEDIT.SETFUNCTION CHARCODE NIL RDTBL) - (CL:WHEN (ASSOC CHARCODE \TEDIT.TTCCODES) + (CL:WHEN (\TEDIT.TTCCLASS CHARCODE) (* ; - "A tag like NEXT, UNDO. Setup the termtable FWIW ") - (TEDIT.SETSYNTAX CHARCODE CHARCODE RDTBL)))] + "A tag like NEXT, UNDO. Normalize and setup the termtable FWIW ") + (TEDIT.SETSYNTAX (\TEDIT.TTCCLASS CHARCODE) + CHARCODE RDTBL)))] BINDINGS else (for CB in BINDINGS when (LISTP CB) unless (EQ '* (CAR CB)) do (for CHARCODE in (CDR CB) do (CL:UNLESS (CHARCODEP CHARCODE) (SETQ CHARCODE (CHARCODE.DECODE CHARCODE))) (TEDIT.SETFUNCTION CHARCODE NIL RDTBL) - (CL:WHEN (ASSOC (CAR CB) - \TEDIT.TTCCODES) + (CL:WHEN (\TEDIT.TTCCLASS (CAR CB)) (* ; - "A tag like NEXT, UNDO. Setup the termtable FWIW ") - (TEDIT.SETSYNTAX CHARCODE (CAR CB) - RDTBL))])]) + "A tag like NEXT, UNDO. Normalize and setup the termtable FWIW ") + (TEDIT.SETSYNTAX (\TEDIT.TTCCLASS (CAR CB)) + CHARCODE RDTBL))])]) (TEDIT.GET.CHARACTION - [LAMBDA (CHARCODE BINDINGS) (* ; "Edited 5-Apr-2025 11:36 by rmk") + [LAMBDA (CHARCODE BINDINGS) (* ; "Edited 12-Nov-2025 14:44 by rmk") + (* ; "Edited 10-Nov-2025 15:55 by rmk") + (* ; "Edited 8-Nov-2025 10:00 by rmk") + (* ; "Edited 5-Apr-2025 11:36 by rmk") (* ; "Edited 19-Mar-2025 14:51 by rmk") (* ; "Edited 18-Mar-2025 11:07 by rmk") (* ; "Edited 17-Mar-2025 09:43 by rmk") @@ -184,39 +192,6 @@ (RETURN (CL:IF (CDR $$VAL) $$VAL (CAR $$VAL))] - else (LET [(RDTBL (if (NULL BINDINGS) - then TEDIT.READTABLE - elseif (TEXTSTREAM BINDINGS T) - then (OR (GETTOBJ (TEXTOBJ BINDINGS) - TXTRTBL) - TEDIT.READTABLE) - elseif (READTABLEP BINDINGS) - else (\ILLEGAL.ARG BINDINGS] - [MAPHASH (fetch READMACRODEFS of RDTBL) - (FUNCTION (LAMBDA (VAL CCODE) - (CL:WHEN (AND (EQ CCODE CHARCODE) - (EQ (\TEDIT.TTC FUNCTIONCALL) - (\SYNCODE (fetch READSA of RDTBL) - CHARCODE))) - (for CA in TEDIT.CHARACTIONS when (EQUAL (CADR CA) - (CADR VAL)) - do (RETFROM (FUNCTION TEDIT.GET.CHARACTION) - (CAR CA))))] - NIL]) - -(TEDIT.GET.CHARBINDING - [LAMBDA (ACTION BINDINGS RETURNCODES) (* ; "Edited 23-Apr-2025 10:11 by rmk") - (* ; "Edited 5-Apr-2025 11:37 by rmk") - (* ; "Edited 18-Mar-2025 20:40 by rmk") - - (* ;; "Returns the bindings for ACTION in BINDINGS, a binding list or a read-table specification. If BINDINGS is a readtable, looks at all currently installed bindings in that readtable. If NIL, uses TEDIT.READTABLE.") - - (if (LISTP BINDINGS) - then (for CB in BINDINGS when (EQ ACTION (CAR CB)) join - (* ;; - "Allow for duplicate bindings for the same action?") - - (APPEND (CDR CB))) else (LET ((RDTBL (if (NULL BINDINGS) then TEDIT.READTABLE elseif (TEXTSTREAM BINDINGS T) @@ -225,25 +200,56 @@ TEDIT.READTABLE) elseif (READTABLEP BINDINGS) else (\ILLEGAL.ARG BINDINGS))) - [IMPL (CADR (find CA in TEDIT.CHARACTIONS suchthat (EQMEMB ACTION (CAR CA] + VAL) + (CL:WHEN [AND (EQ (\TEDIT.TTC FN) + (\SYNCODE (fetch READSA of RDTBL) + CHARCODE)) + (SETQ VAL (fetch MACROFN of (GETHASH CHARCODE (fetch READMACRODEFS + of RDTBL] + [CAR (find ACTION in TEDIT.CHARACTIONS suchthat (EQUAL VAL (CDR ACTION])]) + +(TEDIT.GET.CHARBINDING + [LAMBDA (ACTION BINDINGS RETURNCODES) (* ; "Edited 10-Nov-2025 12:49 by rmk") + (* ; "Edited 9-Nov-2025 10:10 by rmk") + (* ; "Edited 23-Apr-2025 10:11 by rmk") + (* ; "Edited 5-Apr-2025 11:37 by rmk") + (* ; "Edited 18-Mar-2025 20:40 by rmk") + + (* ;; "Returns the character bindings for ACTION in BINDINGS, a binding list or a read-table specification. If BINDINGS is a readtable, looks at all currently installed bindings in that readtable. If NIL, uses TEDIT.READTABLE.") + + (if (LISTP BINDINGS) + then (APPEND (CADR (ASSOC ACTION BINDINGS))) + else (LET ((RDTBL (if (NULL BINDINGS) + then TEDIT.READTABLE + elseif (TEXTSTREAM BINDINGS T) + then (OR (GETTOBJ (TEXTOBJ BINDINGS) + TXTRTBL) + TEDIT.READTABLE) + elseif (READTABLEP BINDINGS) + else (\ILLEGAL.ARG BINDINGS))) + (IMPL (CADR (ASSOC ACTION TEDIT.CHARACTIONS))) CHARS) - (CL:WHEN IMPL + (CL:WHEN IMPL (* ; + "The hashtable doesn't have the action names, just the implementation") [MAPHASH (fetch READMACRODEFS of RDTBL) (FUNCTION (LAMBDA (VAL CCODE) (CL:WHEN (EQUAL IMPL (CADR VAL)) (* ; "charcode, not charname") (push CHARS (CL:IF RETURNCODES CCODE - (CHARCODE.ENCODE CCODE))))] + (CHARCODE.ENCODE CCODE))))] CHARS)]) (TEDIT.GET.ALL.CHARBINDINGS - [LAMBDA (RDTBL RETURNCODES) (* ; "Edited 23-Apr-2025 10:11 by rmk") + [LAMBDA (RDTBL RETURNCODES) (* ; "Edited 12-Nov-2025 14:44 by rmk") + (* ; "Edited 10-Nov-2025 13:07 by rmk") + (* ; "Edited 8-Nov-2025 10:00 by rmk") + (* ; "Edited 23-Apr-2025 10:11 by rmk") (* ; "Edited 7-Apr-2025 22:11 by rmk") (* ; "Edited 5-Apr-2025 11:37 by rmk") (* ; "Edited 18-Mar-2025 20:51 by rmk") - (* ;; "Returns the charbindings instantiated in RDTBL, in the form of TEDIT.CHARBINDINGS: (action . chars)") + (* ;; "Returns the character bindings instantiated in RDTBL, in the form of TEDIT.CHARBINDINGS: (action . chars/codes)") (CL:UNLESS (READTABLEP RDTBL) (SETQ RDTBL (if (NULL RDTBL) @@ -256,27 +262,28 @@ (LET (ACTIONS) [MAPHASH (fetch READMACRODEFS of RDTBL) (FUNCTION (LAMBDA (VAL CCODE) - (CL:WHEN (EQ (\TEDIT.TTC FUNCTIONCALL) + (CL:WHEN (EQ (\TEDIT.TTC FN) (\SYNCODE (fetch READSA of RDTBL) CCODE)) (for CA ANAME in TEDIT.CHARACTIONS when (LISTP CA) unless (EQ '* (CAR CA)) when (EQUAL (CADR CA) (CADR VAL)) - do (SETQ ANAME (CAR (CL:IF (LISTP (CAR CA)) - (CAR CA) - CA))) - (PUSH [CDR (OR (ASSOC ANAME ACTIONS) - (CAR (PUSH ACTIONS (CONS ANAME] - CCODE)))] + do + (* ;; "Same implementation") + + (SETQ ANAME (CAR CA)) + (PUSHMULTI ACTIONS (CAR CA) + CCODE)))] (SORT ACTIONS T) [for A S in ACTIONS do (SETQ S (SORT (CDR A))) (RPLACD A (CL:IF RETURNCODES S - (CHARCODE.ENCODE S))] + (CHARCODE.ENCODE S))] ACTIONS]) (TEDIT.CHARBINDINGS.INVERT - [LAMBDA (CHARBINDINGS RETURNCODES) (* ; "Edited 23-Apr-2025 10:11 by rmk") + [LAMBDA (CHARBINDINGS RETURNCODES) (* ; "Edited 10-Nov-2025 16:21 by rmk") + (* ; "Edited 23-Apr-2025 10:11 by rmk") (* ; "Edited 7-Apr-2025 22:39 by rmk") (* ; "Edited 4-Apr-2025 09:58 by rmk") (* ; "Edited 1-Apr-2025 15:09 by rmk") @@ -284,25 +291,24 @@ (* ;; "Inverts CHARBINDINGS to return a list of (char/code . actions), usually a single action unless there is a conflict.. ") (for CB ACTIONSPERCHAR CA in CHARBINDINGS when (CDR (LISTP CB)) unless (EQ '* (CAR CB)) - do [for CHAR CODE CACTIONS in (CDR CB) do (SETQ CODE (CHARCODE.DECODE CHAR)) - (SETQ CACTIONS (ASSOC CODE ACTIONSPERCHAR)) - (CL:UNLESS CACTIONS - (push ACTIONSPERCHAR (SETQ CACTIONS (CONS CODE)) - )) - (CL:UNLESS (MEMB (CAR CB) - (CDR CACTIONS)) - (push (CDR CACTIONS) - (CAR CB)))] + do (for CHAR CODE CACTIONS in (CDR CB) eachtime (SETQ CODE (CHARCODE.DECODE CHAR)) + do (PUSHMULTI-NEW ACTIONSPERCHAR CODE (CAR CB))) finally (SORT ACTIONSPERCHAR T) (CL:UNLESS RETURNCODES (for APC in ACTIONSPERCHAR do (change (CAR APC) - (CHARCODE.ENCODE DATUM)))) - (RETURN ACTIONSPERCHAR]) + (CHARCODE.ENCODE DATUM)))) + (RETURN (SORT ACTIONSPERCHAR T]) (TEDIT.GET.ALL.CHARACTIONS - [LAMBDA (RDTBL RETURNCODES) (* ; "Edited 23-Apr-2025 10:11 by rmk") + [LAMBDA (RDTBL RETURNCODES) (* ; "Edited 12-Nov-2025 14:44 by rmk") + (* ; "Edited 10-Nov-2025 13:37 by rmk") + (* ; "Edited 8-Nov-2025 10:00 by rmk") + (* ; "Edited 23-Apr-2025 10:11 by rmk") (* ; "Edited 5-Apr-2025 11:37 by rmk") (* ; "Edited 18-Mar-2025 20:51 by rmk") + + (* ;; "Returns an alist containing all of the (character action) bindings in RDTBL.") + (CL:UNLESS (READTABLEP RDTBL) (SETQ RDTBL (if (NULL RDTBL) then TEDIT.READTABLE @@ -311,27 +317,24 @@ TXTRTBL) TEDIT.READTABLE) else (\ILLEGAL.ARG RDTBL)))) - (LET (ACTIONS) + (LET (BINDINGS) [MAPHASH (fetch READMACRODEFS of RDTBL) (FUNCTION (LAMBDA (VAL CCODE) - (CL:WHEN (EQ (\TEDIT.TTC FUNCTIONCALL) + (CL:WHEN (EQ (\TEDIT.TTC FN) (\SYNCODE (fetch READSA of RDTBL) CCODE)) (for CA ANAME in TEDIT.CHARACTIONS when (LISTP CA) unless (EQ '* (CAR CA)) when (EQUAL (CADR CA) (CADR VAL)) - do (SETQ ANAME (CAR (CL:IF (LISTP (CAR CA)) - (CAR CA) - CA))) - (PUSH [CDR (OR (ASSOC ANAME ACTIONS) - (CAR (PUSH ACTIONS (CONS ANAME] - CCODE)))] - (SORT ACTIONS T) - [for A S in ACTIONS do (SETQ S (SORT (CDR A))) - (RPLACD A (CL:IF RETURNCODES - S - (CHARCODE.ENCODE S))] - ACTIONS]) + do (* ; "Match on implementation") + (PUSHMULTI BINDINGS (CL:IF RETURNCODES + CCODE + (CHARCODE.ENCODE CCODE)) + (CAR CA))))] + (SORT BINDINGS T) + (for B in BINDINGS do (change (CDR B) + (SORT DATUM))) + BINDINGS]) (TEDIT.CONFLICTING.CHARBINDINGS [LAMBDA (CHARBINDINGS NOERROR) (* ; "Edited 7-Apr-2025 22:40 by rmk") @@ -846,7 +849,8 @@ (DEFINEQ (\TEDIT.LINEDELETE.FORWARD - [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 6-Apr-2025 14:41 by rmk") + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 12-Nov-2025 16:14 by rmk") + (* ; "Edited 6-Apr-2025 14:41 by rmk") (* ; "Edited 15-Mar-2025 23:02 by rmk") (* ; "Edited 9-Mar-2025 22:11 by rmk") (* ; "Edited 4-Mar-2025 17:22 by rmk") @@ -861,10 +865,11 @@ (\TEDIT.NOSEL TSTREAM) (\TEDIT.UPDATE.SEL SEL HERE (IDIFFERENCE (FGETLD LINE LCHARLIM) HERE)) - (TEDIT.DELETE TSTREAM SEL))]) + (\TEDIT.DELETE TSTREAM SEL))]) (\TEDIT.LINEDELETE.BACKWARD - [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 6-Apr-2025 14:41 by rmk") + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 12-Nov-2025 16:13 by rmk") + (* ; "Edited 6-Apr-2025 14:41 by rmk") (* ; "Edited 15-Mar-2025 23:02 by rmk") (* ; "Edited 9-Mar-2025 22:11 by rmk") (* ; "Edited 4-Mar-2025 17:22 by rmk") @@ -880,7 +885,24 @@ (\TEDIT.NOSEL TSTREAM) (\TEDIT.UPDATE.SEL SEL HERE (IDIFFERENCE (FGETLD LINE LCHAR1) HERE)) - (TEDIT.DELETE TEXTOBJ SEL))]) + (\TEDIT.DELETE TSTREAM SEL))]) + +(\TEDIT.LINEDELETE + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 12-Nov-2025 16:14 by rmk") + (* ; "Edited 6-Apr-2025 14:41 by rmk") + (* ; "Edited 15-Mar-2025 23:02 by rmk") + (* ; "Edited 9-Mar-2025 22:11 by rmk") + (* ; "Edited 4-Mar-2025 17:22 by rmk") + (* gbn "13-Dec-84 11:56") + + (* ;; "Deletes from the beginning of the caret's line to the end of the caret's line. Line must be visible in the selpane.") + + (LET ((LINE (\TEDIT.SEL.L1 SEL NIL TEXTOBJ))) + (CL:WHEN LINE + (\TEDIT.NOSEL TSTREAM) + (\TEDIT.UPDATE.SEL SEL (FGETLD LINE LCHAR1) + (FGETLD LINE LNCH)) + (\TEDIT.DELETE TSTREAM SEL))]) ) (DEFINEQ @@ -1268,7 +1290,8 @@ RTBL]) (\TEDIT.WORDBOUND.READTABLE - [LAMBDA NIL (* ; "Edited 2-Aug-2025 22:06 by rmk") + [LAMBDA NIL (* ; "Edited 12-Nov-2025 14:44 by rmk") + (* ; "Edited 2-Aug-2025 22:06 by rmk") (* ; "Edited 15-Mar-2025 12:00 by rmk") (* ; "Edited 13-Mar-2025 22:24 by rmk") (* ; "Edited 22-May-92 15:10 by jds") @@ -1308,27 +1331,31 @@ RTBL]) (TEDIT.GETSYNTAX - [LAMBDA (CH TABLE) (* ; "Edited 29-May-2025 16:20 by rmk") + [LAMBDA (CH TABLE) (* ; "Edited 12-Nov-2025 14:46 by rmk") + (* ; "Edited 10-Nov-2025 13:36 by rmk") + (* ; "Edited 8-Nov-2025 13:32 by rmk") + (* ; "Edited 29-May-2025 16:20 by rmk") (* ; "Edited 12-Mar-2025 12:55 by rmk") (* ; "Edited 24-Dec-2023 09:47 by rmk") (* ; "Edited 31-Mar-87 10:01 by jds") - (* ;; "Find TEdit's interpretation of a given character") + (* ;; "Map back to documented syntax-class names just for those defined classes, otherwise FN, for compatibility with documentation and history. ") - (CAR (find TTC (SYNCODE _ (\SYNCODE (fetch READSA of (if (NULL TABLE) - then TEDIT.READTABLE - elseif (TEXTSTREAM TABLE T) - then (OR (GETTOBJ (TEXTOBJ TABLE) - TXTRTBL) - TEDIT.READTABLE) - else TABLE)) - (CL:IF (OR (LITATOM CH) - (STRINGP CH)) - (CHARCODE.DECODE CH) - CH))) in \TEDIT.TTCCODES suchthat (EQ SYNCODE (CADR TTC]) + (SELECTQ (TEDIT.GET.CHARACTION CH TABLE) + (:CHARDELETE.BACKWARD + 'CHARDELETE) + (:WORDDELETE.BACKWARD + 'WORDDELETE) + (:DELETE 'DELETE) + (:UNDO 'UNDO) + (:REDO 'REDO) + (:NEXT 'NEXT) + (NIL 'NONE) + 'FN]) (TEDIT.SETSYNTAX - [LAMBDA (CHAR CLASS RDTBL) (* ; "Edited 13-Mar-2025 21:52 by rmk") + [LAMBDA (CHAR CLASS RDTBL) (* ; "Edited 12-Nov-2025 14:44 by rmk") + (* ; "Edited 13-Mar-2025 21:52 by rmk") (* ; "Edited 24-Dec-2023 09:17 by rmk") (* ; "Edited 31-Mar-87 10:00 by jds") (* ; @@ -1351,7 +1378,9 @@ (\TEDIT.TTC NONE))))]) (TEDIT.GETFUNCTION - [LAMBDA (CHARCODE RDTBL) (* ; "Edited 5-Apr-2025 11:37 by rmk") + [LAMBDA (CHARCODE RDTBL) (* ; "Edited 12-Nov-2025 14:44 by rmk") + (* ; "Edited 8-Nov-2025 11:13 by rmk") + (* ; "Edited 5-Apr-2025 11:37 by rmk") (* ; "Edited 13-Mar-2025 22:56 by rmk") (* ; "Edited 7-Mar-2025 12:02 by rmk") (* jds "19-Sep-85 17:06") @@ -1368,14 +1397,17 @@ TEDIT.READTABLE) else RDTBL)) (CL:WHEN (AND (READTABLEP RDTBL) - (EQ (\TEDIT.TTC FUNCTIONCALL) + (EQ (\TEDIT.TTC FN) (\SYNCODE (fetch READSA of RDTBL) CHARCODE)) (fetch READMACRODEFS of RDTBL)) [CAR (FETCH MACROFN OF (GETHASH CHARCODE (fetch READMACRODEFS of RDTBL])]) (TEDIT.SETFUNCTION - [LAMBDA (CHARCODE FN RDTBL) (* ; "Edited 13-Mar-2025 22:51 by rmk") + [LAMBDA (CHARCODE FN RDTBL) (* ; "Edited 24-Nov-2025 00:36 by rmk") + (* ; "Edited 12-Nov-2025 14:44 by rmk") + (* ; "Edited 8-Nov-2025 10:02 by rmk") + (* ; "Edited 13-Mar-2025 22:51 by rmk") (* ; "Edited 7-Mar-2025 12:03 by rmk") (* ; "Edited 31-Mar-87 10:58 by jds") (* ; @@ -1391,12 +1423,11 @@ then (OR (GETTOBJ (TEXTOBJ RDTBL) TXTRTBL) TEDIT.READTABLE) - else RDTBL)) (* ; - "Mark the character as invoking a function") + else RDTBL)) (\SETSYNCODE (fetch READSA of RDTBL) CHARCODE (CL:IF FN - (\TEDIT.TTC FUNCTIONCALL) + (\TEDIT.TTC FN) (\TEDIT.TTC NONE))) (CL:UNLESS (fetch READMACRODEFS of RDTBL) (replace READMACRODEFS of RDTBL with (HARRAY 50))) (* ; @@ -1414,7 +1445,8 @@ (T (CHCON1 CH]) (TEDIT.WORDSET - [LAMBDA (CHARCODE CLASS TABLE) (* ; "Edited 13-Mar-2025 21:43 by rmk") + [LAMBDA (CHARCODE CLASS TABLE) (* ; "Edited 12-Nov-2025 14:45 by rmk") + (* ; "Edited 13-Mar-2025 21:43 by rmk") (* jds " 1-JUN-83 12:23") (* ;; "Sets Tedit syntax bits in a termtable. ") @@ -1450,389 +1482,8 @@ -(* ; "Keybindings") - -(DECLARE%: EVAL@COMPILE DONTCOPY -(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE - -(RPAQQ \TEDIT.TTCCODES - ((NONE 0) - (CHARDELETE 1) - (WORDDELETE 2) - (DELETE 3) - (FUNCTIONCALL 4) - (REDO 5) - (UNDO 6) - (CMD 7) - (NEXT 8) - (EXPAND 9) - (CHARDELETE.FORWARD 10) - (WORDDELETE.FORWARD 11) - (PUNCT 20) - (TEXT 21) - (WHITESPACE 22))) - - -(CONSTANTS \TEDIT.TTCCODES) -) -(DECLARE%: EVAL@COMPILE - -(PUTPROPS \TEDIT.TTC MACRO [(CLASS) - (CONSTANT (CADR (ASSOC 'CLASS \TEDIT.TTCCODES]) -) - -(* "END EXPORTED DEFINITIONS") - -) - -(RPAQQ TEDIT.CHARACTIONS - ((TEDIT-PF PF-TEDIT-FROM-TEXT) - - (* ;; "This defines the implementation of the named actions. They are activated by keybinding specifications given to TEDIT.INSTALL.KEYBINDINGS.") - - - (* ;; "") - - - (* ;; "History") - - (UNDO (TEDIT.UNDO TSTREAM)) - (UNDO.UNDO \TEDIT.UNDO.UNDO) - (* ; "CHECK") - (REDO TEDIT.REDO) - - (* ;; "") - - - (* ;; "Find") - - ((FIND.FORWARD FIND) - (\TEDIT.KEY.FIND TSTREAM)) - (FIND.BACKWARD (\TEDIT.KEY.FIND TSTREAM NIL T)) - (FIND.FORWARD-AGAIN (\TEDIT.KEY.FIND TSTREAM T)) - (FIND.BACKWARD-AGAIN (\TEDIT.KEY.FIND TSTREAM T T)) - (SUBSTITUTE \TEDIT.KEY.SUBSTITUTE) - (NEXT TEDIT.NEXT) - - (* ;; "") - - - (* ;; "Character looks") - - (BOLD.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'BOLD 'ON)) - (BOLD.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'BOLD 'OFF)) - (BOLD.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'BOLD 'TOGGLE)) - (ITALIC.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'ITALIC 'ON)) - (ITALIC.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'ITALIC 'OFF)) - (ITALIC.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'ITALIC 'TOGGLE)) - (UCASE (\TEDIT.KEY.TRANSFORM TSTREAM (FUNCTION U-CASECODE))) - (LCASE (\TEDIT.KEY.TRANSFORM TSTREAM (FUNCTION L-CASECODE))) - (INITIALCAP (\TEDIT.KEY.TRANSFORM TSTREAM (FUNCTION CAP-CASECODE))) - (STRIKEOUT.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'STRIKEOUT 'ON)) - (STRIKEOUT.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'STRIKEOUT 'OFF)) - (STRIKEOUT.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'STRIKEOUT 'TOGGLE)) - (UNDERLINE.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNDERLINE 'ON)) - (UNDERLINE.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNDERLINE 'OFF)) - (UNDERLINE.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNDERLINE 'TOGGLE)) - (OVERLINE.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'OVERLINE 'ON)) - (OVERLINE.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'OVERLINE 'OFF)) - (OVERLINE.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'OVERLINE 'TOGGLE)) - (UNBREAKABLE.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNBREAKABLE 'ON)) - (UNBREAKABLE.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNBREAKABLE 'OFF)) - (UNBREAKABLE.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNBREAKABLE 'TOGGLE)) - (SUBSCRIPT \TEDIT.SUBSCRIPTSEL) - (SUPERSCRIPT \TEDIT.SUPERSCRIPTSEL) - (SMALLER (\TEDIT.KEY.SIZE TSTREAM '-)) - (LARGER (\TEDIT.KEY.SIZE TSTREAM '+)) - (FAMILYN (\TEDIT.KEY.FAMILYN TSTREAM CHARCODE)) - (DEFAULTS \TEDIT.DEFAULTSSEL) - (SHOW.CHARLOOKS \TEDIT.SHOWCARETLOOKS) - - (* ;; "") - - - (* ;; "Paragraph looks") - - (NEST (\TEDIT.KEY.NEST TSTREAM)) - (UNNEST (\TEDIT.KEY.NEST TSTREAM T)) - ((QUAD CENTER) - (\TEDIT.KEY.QUAD TSTREAM)) - (QUAD.REVERSE (\TEDIT.KEY.QUAD TSTREAM T)) - - (* ;; "") - - - (* ;; "Cursor/selection") - - (ONECHAR.BACKWARD \TEDIT.ONECHAR.BACKWARD) - (ONECHAR.FORWARD \TEDIT.ONECHAR.FORWARD) - (LINE.UP \TEDIT.ONELINE.UP) - (LINE.DOWN \TEDIT.ONELINE.DOWN) - (ONEWORD.FORWARD \TEDIT.ONEWORD.FORWARD) - (ONEWORD.BACKWARD \TEDIT.ONEWORD.BACKWARD) - (LINE.BEGIN \TEDIT.LINE.BEGIN) - (LINE.END \TEDIT.LINE.END) - (DOCUMENT.BEGIN \TEDIT.DOCUMENT.BEGIN) - (DOCUMENT.END \TEDIT.DOCUMENT.END) - (ALL \TEDIT.SELECT.ALL) - - (* ;; "") - - - (* ;; "Deletion ") - - ((CHARDELETE CHARDELETE.BACKWORD) - (\TEDIT.CHARDELETE TSTREAM)) - (CHARDELETE.FORWARD (\TEDIT.CHARDELETE TSTREAM T)) - (WORDDELELETE \TEDIT.WORDDELETE) - (WORDDELETE.FORWARD \TEDIT.WORDDELETE.FORWARD) - (LINEDELETE.FORWARD \TEDIT.LINEDELETE.FORWARD) - (LINEDELETE.BACKWARD \TEDIT.LINEDELETE.BACKWARD) - - (* ;; "") - - - (* ;; "Miscellaneous") - - (MANPAGE \TEDIT.MANPAGE) - (OPEN.SEDIT \TEDIT.CALL.ED) - (PRINT.MENU \TEDIT.PRINT.MENU) - (EXPAND \TEDIT.ABBREV.EXPAND) - (GET.OBJECT GET.OBJ.FROM.USER) - (OPENLINE \TEDIT.KEY.OPENLINE) - - (* ;; "") - - - (* ;; "From TEDITDORADOKEYS") - - (WRAP.PARENS (\TEDIT.KEY.WRAP TSTREAM "(" ")")) - (WRAP.NEUTRAL.DOUBLEQUOTES (\TEDIT.KEY.WRAP TSTREAM "%"" "%"")) - [WRAP.REAL.DOUBLEQUOTES (\TEDIT.KEY.WRAP TSTREAM (CHARACTER (CHARCODE LEFT-DOUBLEQUOTE)) - (CHARACTER (CHARCODE RIGHT-DOUBLEQUOTE] - - (* ;; "") - - - (* ;; "Clipboard") - - (CLIPBOARD-PASTE PASTEFROMCLIPBOARD) - (CLIPBOARD-COPY \TEDIT.COPYTOCLIPBOARD) - (CLIPBOARD-EXTRACT \TEDIT.EXTRACTTOCLIPBOARD) - - (* ;; "") - - - (* ;; "Wheelscroll") - - (WHEELSCROLL-UP (WHEELSCROLL 'VERTICAL T)) - (WHEELSCROLL-DOWN (WHEELSCROLL 'VERTICAL)) - (WHEELSCROLL-LEFT (WHEELSCROLL 'HORIZONTAL)) - (WHEELSCROLL-RIGHT (WHEELSCROLL 'HORIZONTAL T)))) - -(RPAQQ TEDIT.BASIC.CHARBINDINGS - ( - (* ;; "Establishes key bindings for particular Tedit key actions. Function,xxx roughly correspond to Koto release notes, but this preserves the immediately preceding assignments if those drifted away from the Koto notes. There is no obvious way of typing Function. Maybe Meta,^xxx instead, as in DORADO.KEYBINDINGS. (But CTRL collapses upper and lower case).") - - - (* ;; "") - - - (* ;; "History") - - (UNDO "Meta,u" "Meta,z" "Function,4" "Function,44") - (UNDO.UNDO "Meta,U" "Meta,Z") - (REDO "Meta,r" "Meta,R" "Function,10" "Function,50") - - (* ;; "") - - - (* ;; "Find") - - (FIND.FORWARD "Meta,f" "Function,3" "Function,43") - (FIND.BACKWARD "Meta,F") - (FIND.FORWARD-AGAIN "Meta,g") - (FIND.BACKWARD-AGAIN "Meta,G") - (SUBSTITUTE "Meta,s" "Meta,S") - (NEXT "Meta,N" "Meta,n" "Function,22") - - (* ;; "") - - - (* ;; "Character looks") - - (BOLD.ON "Function,102") - (BOLD.OFF "Function,142") - (BOLD.TOGGLE) - (ITALIC.ON "Function,103") - (ITALIC.OFF "Function,143") - (ITALIC.TOGGLE) - (UCASE "Function,104") - (LCASE "Function,144") - (STRIKEOUT.ON "Function,105") - (STRIKEOUT.OFF "Function,145") - (STRIKEOUT.TOGGLE) - (UNDERLINE.ON "Function,106") - (UNDERLINE.OFF "Function,146") - (UNDERLINE.TOGGLE) - (OVERLINE.ON) - (OVERLINE.OFF) - (OVERLINE.TOGGLE) - (SUBSCRIPT "Function,114") - (SUPERSCRIPT "Function,113") - (SMALLER "Function,110") - (LARGER "Function,150") - (FAMILYN "Meta,One" "Meta,Two" "Meta,Three" "Meta,Four" "Meta,Five" "Meta,Six") - (DEFAULTS "Function,115" "Function,155") - (SHOW.CHARLOOKS "Function,1") - - (* ;; "") - - - (* ;; "Paragraph looks") - - (QUAD "Function,101") - (NEST "Meta,[") - (UNNEST "Meta,]") - - (* ;; "") - - - (* ;; "Cursor/selection") - - (ONECHAR.BACKWARD "Meta,<" "Meta,,") - (* ; "From arrows") - (ONECHAR.FORWARD "Meta,>" "Meta,.") - (LINE.UP "Meta,^") - (LINE.DOWN "Meta,LF") - (ONEWORD.FORWARD) - (ONEWORD.BACKWARD) - (LINE.BEGIN) - (LINE.END) - (ALL "Meta,a" "Meta,A") - - (* ;; "") - - - (* ;; "Deletion") - - (CHARDELETE "BS" "^A") - (* ; "CHARDELETE/WORDDELETE are TTC") - (CHARDELETE.FORWARD "^W" "^U") - (* ; "keyactions for DEL key ??") - (WORDDELELETE) - (WORDDELETE.FORWARD) - (* ; "^W is used for chardelete forward") - (LINEDELETE.FORWARD) - (LINEDELETE.BACKWARD) - - (* ;; "") - - - (* ;; "Miscellaneous") - - (MANPAGE "Meta,D" "Meta,d") - (OPEN.SEDIT "Meta,O" "Meta,o") - (PRINT.MENU "Meta,P" "Meta,p") - (EXPAND "^X") - (GET.OBJECT "^O") - - (* ;; "") - - - (* ;; "Wheelscroll ") - - (WHEELSCROLL-UP "WHEELSCROLL-UP") - (WHEELSCROLL-DOWN "WHEELSCROLL-DOWN") - (WHEELSCROLL-LEFT "WHEELSCROLL-LEFT") - (WHEELSCROLL-RIGHT "WHEELSCROLL-RIGHT") - - (* ;; "") - - - (* ;; "Clipboard") - - (CLIPBOARD-PASTE "Meta,V" "Meta,v") - (CLIPBOARD-COPY "Meta,C" "Meta,c") - (CLIPBOARD-EXTRACT "Meta,X" "Meta,x"))) - -(RPAQQ TEDIT.DORADO.CHARBINDINGS - ( - (* ;; "Taken from lispusers>TKDORADO, these make the indicated Tedit commands available from the Dorado keyboard.") - - (DEFAULTS "Meta,^V") - (BOLD.ON "Meta,^B" "Meta,b") - (BOLD.OFF "Meta,^N" "Meta,B") - (ITALIC.ON "Meta,^I") - (ITALIC.OFF "Meta,^O") - (OVERLINE.ON "Meta,^D") - (OVERLINE.OFF "Meta,^F") - (STRIKEOUT.ON "Meta,^G") - (STRIKEOUT.OFF "Meta,^H") - (* (UNDERLINE.ON "Meta,^J") - conflicts with LINE.DOWN) - (UNDERLINE.OFF "Meta,^K") - (SMALLER "Meta,^[") - (LARGER "Meta,^^]") - (SUBSCRIPT "Meta,^^") - (SUPERSCRIPT "Meta,^_") - (QUAD "Meta,^C") - - (* ;; "Mappings from lispusers>TEDITDORADOKEYS") - - (* ("Meta,c" QUAD) - ("Meta,C" QUAD) - ("Meta,x" EXPAND) - ("Meta,X" EXPAND) - conflict with clipboard) - (* ("Meta,^" SUBSCRIPT) - conflicts with LINE.UP) - (BOLD.ON "Meta,b") - (BOLD.OFF "Meta,B") - (ITALIC.ON "Meta,i") - (ITALIC.OFF "Meta,I") - (STRIKEOUT.ON "Meta,=") - (STRIKEOUT.OFF "Meta,+") - (UNDERLINE.ON "Meta,-") - (UNDERLINE.OFF "Meta,_") - (WRAP.PARENS "Meta,(" "Meta,Nine") - (WRAP.NEUTRAL.DOUBLEQUOTES "Meta,%"") - (WRAP.REAL.DOUBLEQUOTES "Meta,'"))) - -(RPAQ TEDIT.CHARBINDINGS (APPEND TEDIT.BASIC.CHARBINDINGS TEDIT.DORADO.CHARBINDINGS)) - - - -(* ; "Installation") - -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(RPAQ TEDIT.READTABLE (\TEDIT.READTABLE)) - -(RPAQ TEDIT.WORDBOUND.READTABLE (\TEDIT.WORDBOUND.READTABLE)) -) - - - (* ;; "On-screen formatting buttons (TEDIT.BUTTONS.BUILD) creates the default button menu") - -(RPAQQ TEDIT.BUTTONS.SPEC - ((Bold BOLD.ON BOLD.OFF) - (Italic ITALIC.ON ITALIC.OFF) - (Case UCASE LCASE) - ((Strike- out) - STRIKEOUT.ON STRIKEOUT.OFF) - ((Under- line) - UNDERLINE.ON UNDERLINE.OFF) - ((Super/ Sub) - SUPERSCRIPT SUBSCRIPT) - ((Larger Smaller) - LARGER SMALLER) - (Justify QUAD) - (Defaults DEFAULTS) - (Show SHOW.CHARLOOKS) - (Redo REDO))) (DEFINEQ (TEDIT.BUTTONS.BUILD @@ -1938,30 +1589,427 @@ (RPAQQ TEDIT.BUTTONBITMAP #*(78 48)OOOOOOOOOOOOOOOOOOOLON@@@@@@@@@@@@@@@AOLO@@@@@@@@@@@@@@@@@CLO@@@@@@@@@@@@@@@@@CLMH@@@@@@@@@@@@@@@@DLNLGOOOOOOOOOOOOOOHHLMFL@@@@@@@@@@@@@@M@LJK@@@@@@@@@@@@@@@B@DMF@@@@@@@@@@@@@@@A@DJN@@@@@@@@@@@@@@@AHDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMF@@@@@@@@@@@@@@@AHDJJ@@@@@@@@@@@@@@@A@DMG@@@@@@@@@@@@@@@B@DNEL@@@@@@@@@@@@@@O@LLIGOOOOOOOOOOOOOOMHLOBBJJJJJJJJJJJJJJJLLNDEEEEEEEEEEEEEEEEGLOHJJJJJJJJJJJJJJJJKLOLEEEEEEEEEEEEEEEEOLOOOOOOOOOOOOOOOOOOOL ) + +(RPAQ? TEDIT.BUTTONS.SPEC + '((Bold :BOLD.ON :BOLD.OFF) + (Italic :ITALIC.ON :ITALIC.OFF) + (Case :UCASE :LCASE) + ((Strike- out) + :STRIKEOUT.ON :STRIKEOUT.OFF) + ((Under- line) + :UNDERLINE.ON :UNDERLINE.OFF) + ((Super/ Sub) + :SUPERSCRIPT :SUBSCRIPT) + ((Larger Smaller) + :LARGER :SMALLER) + (Justify :QUAD) + (Defaults :DEFAULTS) + (Show :SHOW.CHARLOOKS) + (Redo :REDO))) + + + +(* ; "Keybindings") + +(DECLARE%: EVAL@COMPILE DONTCOPY +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE + +(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 . 6) + (CMD . 7) + (:CMD . 7) + (NEXT . 8) + (:NEXT . 8) + (EXPAND . 9) + (:EXPAND . 9) + (CHARDELETE.FORWARD . 10) + (:CHARDELETE.FORWARD . 10) + (:WORDDELETE.FORWARD . 11) + (PUNCT . 20) + (TEXT . 21) + (WHITESPACE . 22))) + + +(CONSTANTS \TEDIT.TTCCODES) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS \TEDIT.TTC MACRO [(ACTION) + (CONSTANT (GETMULTI \TEDIT.TTCCODES 'ACTION]) +) + +(* "END EXPORTED DEFINITIONS") + +) +(DEFINEQ + +(\TEDIT.TTCCLASS + [LAMBDA (CODE/CLASS) (* ; "Edited 12-Nov-2025 13:51 by rmk") + (* ; "Edited 10-Nov-2025 14:34 by rmk") + + (* ;; "Class gets the (normalized) class for a CODE (or class atom).") + + (CAR (find TTC in \TEDIT.TTCCODES suchthat (if (FIXP CODE/CLASS) + then (EQ CODE/CLASS (CDR TTC)) + elseif (EQ CODE/CLASS (CAR TTC]) +) + +(RPAQQ ORIG.TEDIT.CHARACTIONS + ( + (* ;; "This defines Tedit's implementation of the named actions. They are activated by keybinding specifications given to TEDIT.INSTALL.KEYBINDINGS.") + + + (* ;; "") + + + (* ;; "History") + + (:UNDO (TEDIT.UNDO TSTREAM)) + (:UNDO.UNDO \TEDIT.UNDO.UNDO) + (* ; "CHECK") + (:REDO TEDIT.REDO) + + (* ;; "") + + + (* ;; "Find") + + (:FIND.FORWARD (\TEDIT.KEY.FIND TSTREAM)) + (:FIND.BACKWARD (\TEDIT.KEY.FIND TSTREAM NIL T)) + (:FIND.FORWARD-AGAIN (\TEDIT.KEY.FIND TSTREAM T)) + (:FIND.BACKWARD-AGAIN (\TEDIT.KEY.FIND TSTREAM T T)) + (:SUBSTITUTE \TEDIT.KEY.SUBSTITUTE) + (:NEXT TEDIT.NEXT) + + (* ;; "") + + + (* ;; "Character looks") + + (:BOLD.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'BOLD 'ON)) + (:BOLD.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'BOLD 'OFF)) + (:BOLD.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'BOLD 'TOGGLE)) + (:ITALIC.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'ITALIC 'ON)) + (:ITALIC.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'ITALIC 'OFF)) + (:ITALIC.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'ITALIC 'TOGGLE)) + (:UCASE (\TEDIT.KEY.TRANSFORM TSTREAM (FUNCTION U-CASECODE))) + (:LCASE (\TEDIT.KEY.TRANSFORM TSTREAM (FUNCTION L-CASECODE))) + (:INITIALCAP (\TEDIT.KEY.TRANSFORM TSTREAM (FUNCTION CAP-CASECODE))) + (:STRIKEOUT.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'STRIKEOUT 'ON)) + (:STRIKEOUT.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'STRIKEOUT 'OFF)) + (:STRIKEOUT.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'STRIKEOUT 'TOGGLE)) + (:UNDERLINE.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNDERLINE 'ON)) + (:UNDERLINE.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNDERLINE 'OFF)) + (:UNDERLINE.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNDERLINE 'TOGGLE)) + (:OVERLINE.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'OVERLINE 'ON)) + (:OVERLINE.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'OVERLINE 'OFF)) + (:OVERLINE.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'OVERLINE 'TOGGLE)) + (:UNBREAKABLE.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNBREAKABLE 'ON)) + (:UNBREAKABLE.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNBREAKABLE 'OFF)) + (:UNBREAKABLE.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNBREAKABLE 'TOGGLE)) + (:SUBSCRIPT \TEDIT.SUBSCRIPTSEL) + (:SUPERSCRIPT \TEDIT.SUPERSCRIPTSEL) + (:SMALLER (\TEDIT.KEY.SIZE TSTREAM '-)) + (:LARGER (\TEDIT.KEY.SIZE TSTREAM '+)) + (:FAMILYN (\TEDIT.KEY.FAMILYN TSTREAM CHARCODE)) + (:DEFAULTS \TEDIT.DEFAULTSSEL) + (:SHOW.CHARLOOKS \TEDIT.SHOWCARETLOOKS) + + (* ;; "") + + + (* ;; "Paragraph looks") + + (:NEST (\TEDIT.KEY.NEST TSTREAM)) + (:UNNEST (\TEDIT.KEY.NEST TSTREAM T)) + (:QUAD (\TEDIT.KEY.QUAD TSTREAM)) + (:QUAD.REVERSE (\TEDIT.KEY.QUAD TSTREAM T)) + + (* ;; "") + + + (* ;; "Cursor/selection") + + (:ONECHAR.BACKWARD \TEDIT.ONECHAR.BACKWARD) + (:ONECHAR.FORWARD \TEDIT.ONECHAR.FORWARD) + (:LINE.UP \TEDIT.ONELINE.UP) + (:LINE.DOWN \TEDIT.ONELINE.DOWN) + (:ONEWORD.FORWARD \TEDIT.ONEWORD.FORWARD) + (:ONEWORD.BACKWARD \TEDIT.ONEWORD.BACKWARD) + (:LINE.BEGIN \TEDIT.LINE.BEGIN) + (:LINE.END \TEDIT.LINE.END) + (:DOCUMENT.BEGIN \TEDIT.DOCUMENT.BEGIN) + (:DOCUMENT.END \TEDIT.DOCUMENT.END) + (:ALL \TEDIT.SELECT.ALL) + + (* ;; "") + + + (* ;; "Deletion ") + + (:CHARDELETE.BACKWARD (\TEDIT.CHARDELETE TSTREAM)) + (:CHARDELETE.FORWARD (\TEDIT.CHARDELETE TSTREAM T)) + (:WORDDELETE.BACKWARD \TEDIT.WORDDELETE) + (:WORDDELETE.FORWARD \TEDIT.WORDDELETE.FORWARD) + (:LINEDELETE.FORWARD \TEDIT.LINEDELETE.FORWARD) + (:LINEDELETE.BACKWARD \TEDIT.LINEDELETE.BACKWARD) + (:LINEDELETE \TEDIT.LINEDELETE) + + (* ;; "") + + + (* ;; "Miscellaneous") + + (:MANPAGE \TEDIT.MANPAGE) + (:OPEN.SEDIT \TEDIT.CALL.ED) + (:PRINT.MENU \TEDIT.PRINT.MENU) + (:EXPAND \TEDIT.ABBREV.EXPAND) + (:GET.OBJECT GET.OBJ.FROM.USER) + (:OPENLINE \TEDIT.KEY.OPENLINE) + + (* ;; "") + + + (* ;; "From TEDITDORADOKEYS") + + (:WRAP.PARENS (\TEDIT.KEY.WRAP TSTREAM "(" ")")) + (:WRAP.NEUTRAL.DOUBLEQUOTES (\TEDIT.KEY.WRAP TSTREAM "%"" "%"")) + [:WRAP.REAL.DOUBLEQUOTES (\TEDIT.KEY.WRAP TSTREAM (CHARACTER (CHARCODE LEFT-DOUBLEQUOTE)) + (CHARACTER (CHARCODE RIGHT-DOUBLEQUOTE] + + (* ;; "") + + + (* ;; "Clipboard") + + (:CLIPBOARD-PASTE PASTEFROMCLIPBOARD) + (:CLIPBOARD-COPY \TEDIT.COPYTOCLIPBOARD) + (:CLIPBOARD-EXTRACT \TEDIT.EXTRACTTOCLIPBOARD) + + (* ;; "") + + + (* ;; "Wheelscroll") + + (:WHEELSCROLL-UP (WHEELSCROLL 'VERTICAL T)) + (:WHEELSCROLL-DOWN (WHEELSCROLL 'VERTICAL)) + (:WHEELSCROLL-LEFT (WHEELSCROLL 'HORIZONTAL)) + (:WHEELSCROLL-RIGHT (WHEELSCROLL 'HORIZONTAL T)))) + +(RPAQ? TEDIT.CHARACTIONS (APPEND ORIG.TEDIT.CHARACTIONS)) + +(RPAQQ TEDIT.BASIC.CHARBINDINGS + ( + (* ;; "Establishes key bindings for particular Tedit key actions. Function,xxx roughly correspond to Koto release notes, but this preserves the immediately preceding assignments if those drifted away from the Koto notes. There is no obvious way of typing Function. Maybe Meta,^xxx instead, as in DORADO.KEYBINDINGS. (But CTRL collapses upper and lower case).") + + + (* ;; "") + + + (* ;; "History") + + (:UNDO "Meta,u" "Meta,z" "Function,4" "Function,44") + (:UNDO.UNDO "Meta,U" "Meta,Z") + (:REDO "Meta,r" "Meta,R" "Function,10" "Function,50") + + (* ;; "") + + + (* ;; "Find") + + (:FIND.FORWARD "Meta,f" "Function,3" "Function,43") + (:FIND.BACKWARD "Meta,F") + (:FIND.FORWARD-AGAIN "Meta,g") + (:FIND.BACKWARD-AGAIN "Meta,G") + (:SUBSTITUTE "Meta,s" "Meta,S") + (:NEXT "Meta,N" "Meta,n" "Function,22") + + (* ;; "") + + + (* ;; "Character looks") + + (:BOLD.ON "Function,102") + (:BOLD.OFF "Function,142") + (:BOLD.TOGGLE) + (:ITALIC.ON "Function,103") + (:ITALIC.OFF "Function,143") + (:ITALIC.TOGGLE) + (:UCASE "Function,104") + (:LCASE "Function,144") + (:STRIKEOUT.ON "Function,105") + (:STRIKEOUT.OFF "Function,145") + (:STRIKEOUT.TOGGLE) + (:UNDERLINE.ON "Function,106") + (:UNDERLINE.OFF "Function,146") + (:UNDERLINE.TOGGLE) + (:OVERLINE.ON) + (:OVERLINE.OFF) + (:OVERLINE.TOGGLE) + (:SUBSCRIPT "Function,114") + (:SUPERSCRIPT "Function,113") + (:SMALLER "Function,110") + (:LARGER "Function,150") + (:FAMILYN "Meta,One" "Meta,Two" "Meta,Three" "Meta,Four" "Meta,Five" "Meta,Six") + (:DEFAULTS "Function,115" "Function,155") + (:SHOW.CHARLOOKS "Function,1") + + (* ;; "") + + + (* ;; "Paragraph looks") + + (:QUAD "Function,101") + (:NEST "Meta,[") + (:UNNEST "Meta,]") + + (* ;; "") + + + (* ;; "Cursor/selection") + + (:ONECHAR.BACKWARD "Meta,<" "Meta,,") + (* ; "From arrows") + (:ONECHAR.FORWARD "Meta,>" "Meta,.") + (:LINE.UP "Meta,^") + (:LINE.DOWN "Meta,LF") + (:ONEWORD.FORWARD) + (:ONEWORD.BACKWARD) + (:LINE.BEGIN) + (:LINE.END) + (:ALL "Meta,a" "Meta,A") + + (* ;; "") + + + (* ;; "Deletion") + + (:CHARDELETE.BACKWARD "BS" "^A") + (:CHARDELETE.FORWARD RUBOUT) + (:WORDDELETE.BACKWARD "^W") + (:WORDDELETE.FORWARD "^U") + (:LINEDELETE.FORWARD) + (:LINEDELETE.BACKWARD) + (:LINEDELETE) + + (* ;; "") + + + (* ;; "Miscellaneous") + + (:MANPAGE "Meta,D" "Meta,d") + (:OPEN.SEDIT "Meta,O" "Meta,o") + (:PRINT.MENU "Meta,P" "Meta,p") + (:EXPAND "^X") + (:GET.OBJECT "^O") + + (* ;; "") + + + (* ;; "Wheelscroll ") + + (:WHEELSCROLL-UP "WHEELSCROLL-UP") + (:WHEELSCROLL-DOWN "WHEELSCROLL-DOWN") + (:WHEELSCROLL-LEFT "WHEELSCROLL-LEFT") + (:WHEELSCROLL-RIGHT "WHEELSCROLL-RIGHT") + + (* ;; "") + + + (* ;; "Clipboard") + + (:CLIPBOARD-PASTE "Meta,V" "Meta,v") + (:CLIPBOARD-COPY "Meta,C" "Meta,c") + (:CLIPBOARD-EXTRACT "Meta,X" "Meta,x"))) + +(RPAQQ TEDIT.DORADO.CHARBINDINGS + ( + (* ;; "Taken from lispusers>TKDORADO, these make the indicated Tedit commands available from the Dorado keyboard.") + + (:DEFAULTS "Meta,^V") + (:BOLD.ON "Meta,^B" "Meta,b") + (:BOLD.OFF "Meta,^N" "Meta,B") + (:ITALIC.ON "Meta,^I" "Meta,i") + (:ITALIC.OFF "Meta,^O" "Meta,I") + (:OVERLINE.ON "Meta,^D") + (:OVERLINE.OFF "Meta,^F") + (:STRIKEOUT.ON "Meta,^G" "Meta,=") + (:STRIKEOUT.OFF "Meta,^H" "Meta,+") + (* (UNDERLINE.ON "Meta,^J") + conflicts with :LINE.DOWN) + (:UNDERLINE.ON "Meta,-") + (:UNDERLINE.OFF "Meta,^K" "Meta,_") + (:SMALLER "Meta,^[") + (:LARGER "Meta,^^]") + (:SUBSCRIPT "Meta,^^") + (:SUPERSCRIPT "Meta,^_") + (:QUAD "Meta,^C") + + (* ;; "Mappings from lispusers>TEDITDORADOKEYS") + + (* ("Meta,c" QUAD) + ("Meta,C" QUAD) + ("Meta,x" EXPAND) + ("Meta,X" EXPAND) + conflict with clipboard) + (* ("Meta,^" SUBSCRIPT) + conflicts with LINE.UP) + (:WRAP.PARENS "Meta,(" "Meta,Nine") + (:WRAP.NEUTRAL.DOUBLEQUOTES "Meta,%"") + (:WRAP.REAL.DOUBLEQUOTES "Meta,'"))) + +(RPAQ? TEDIT.CHARBINDINGS (APPEND TEDIT.BASIC.CHARBINDINGS TEDIT.DORADO.CHARBINDINGS)) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS TEDIT.CHARBINDINGS TEDIT.CHARACTIONS) +) + + + +(* ; "Installation") + +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(RPAQ TEDIT.READTABLE (\TEDIT.READTABLE)) + +(RPAQ TEDIT.WORDBOUND.READTABLE (\TEDIT.WORDBOUND.READTABLE)) +) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3941 22863 (TEDIT.INSTALL.CHARBINDINGS 3951 . 7842) (TEDIT.CLEAR.CHARBINDINGS 7844 . -10522) (TEDIT.GET.CHARACTION 10524 . 13270) (TEDIT.GET.CHARBINDING 13272 . 15411) ( -TEDIT.GET.ALL.CHARBINDINGS 15413 . 17729) (TEDIT.CHARBINDINGS.INVERT 17731 . 19461) ( -TEDIT.GET.ALL.CHARACTIONS 19463 . 21549) (TEDIT.CONFLICTING.CHARBINDINGS 21551 . 22861)) (22923 32978 -(\TEDIT.KEY.CHARLOOKS 22933 . 24125) (\TEDIT.KEY.QUAD 24127 . 26220) (\TEDIT.DEFAULTSSEL 26222 . 26833 -) (\TEDIT.SETDEFAULT.FROM.SEL 26835 . 27512) (\TEDIT.KEY.SIZE 27514 . 28710) (\TEDIT.SUBSCRIPTSEL -28712 . 28915) (\TEDIT.SUPERSCRIPTSEL 28917 . 29121) (\TEDIT.KEY.TRANSFORM 29123 . 31120) ( -\TEDIT.KEY.OPENLINE 31122 . 31576) (\TEDIT.KEY.FAMILYN 31578 . 32976)) (32979 33268 (CAP-CASECODE -32989 . 33266)) (33302 36734 (\TEDIT.SHOWCARETLOOKS 33312 . 35827) (\TEDIT.DESCRIBEFONT 35829 . 36732) -) (36765 51738 (\TEDIT.ONECHAR.BACKWARD 36775 . 37922) (\TEDIT.ONECHAR.FORWARD 37924 . 39160) ( -\TEDIT.ONELINE.UP 39162 . 42123) (\TEDIT.ONELINE.DOWN 42125 . 43782) (\TEDIT.ONELINE.MOVE 43784 . -46071) (\TEDIT.ONEWORD.BACKWARD 46073 . 47261) (\TEDIT.ONEWORD.FORWARD 47263 . 48450) ( -\TEDIT.LINE.BEGIN 48452 . 49531) (\TEDIT.LINE.END 49533 . 50770) (\TEDIT.DOCUMENT.BEGIN 50772 . 51131) - (\TEDIT.DOCUMENT.END 51133 . 51736)) (51739 53781 (\TEDIT.LINEDELETE.FORWARD 51749 . 52748) ( -\TEDIT.LINEDELETE.BACKWARD 52750 . 53779)) (53782 56310 (\TEDIT.KEY.NEST 53792 . 56308)) (56311 57593 -(\TEDIT.KEY.WRAP 56321 . 57591)) (57684 65732 (\TEDIT.KEY.FIND 57694 . 62872) ( -\TEDIT.KEY.FIND.SEARCHSTRING 62874 . 64014) (\TEDIT.GET.TARGET.STRING 64016 . 65730)) (65763 68395 ( -\TEDIT.KEY.SUBSTITUTE 65773 . 65994) (\TEDIT.MANPAGE 65996 . 67243) (\TEDIT.CALL.ED 67245 . 68075) ( -\TEDIT.SELECT.ALL 68077 . 68393)) (68422 74112 (\TEDIT.CLIPBOARD 68432 . 70187) ( -\TEDIT.COPYTOCLIPBOARD 70189 . 70969) (\TEDIT.EXTRACTTOCLIPBOARD 70971 . 71166) (\TEDIT.WRITE.SEL -71168 . 74110)) (74278 86280 (\TEDIT.READTABLE 74288 . 75224) (\TEDIT.WORDBOUND.READTABLE 75226 . -78165) (TEDIT.GETSYNTAX 78167 . 79596) (TEDIT.SETSYNTAX 79598 . 80803) (TEDIT.GETFUNCTION 80805 . -82070) (TEDIT.SETFUNCTION 82072 . 84058) (TEDIT.WORDGET 84060 . 84321) (TEDIT.WORDSET 84323 . 84954) ( -TEDIT.ATOMBOUND.READTABLE 84956 . 86278)) (98109 105097 (TEDIT.BUTTONS.BUILD 98119 . 103365) ( -TEDIT.BUTTONBITMAP.FILL 103367 . 105095))))) + (FILEMAP (NIL (5031 23296 (TEDIT.INSTALL.CHARBINDINGS 5041 . 7892) (TEDIT.CLEAR.CHARBINDINGS 7894 . +10914) (TEDIT.GET.CHARACTION 10916 . 13697) (TEDIT.GET.CHARBINDING 13699 . 15876) ( +TEDIT.GET.ALL.CHARBINDINGS 15878 . 18377) (TEDIT.CHARBINDINGS.INVERT 18379 . 19658) ( +TEDIT.GET.ALL.CHARACTIONS 19660 . 21982) (TEDIT.CONFLICTING.CHARBINDINGS 21984 . 23294)) (23356 33411 +(\TEDIT.KEY.CHARLOOKS 23366 . 24558) (\TEDIT.KEY.QUAD 24560 . 26653) (\TEDIT.DEFAULTSSEL 26655 . 27266 +) (\TEDIT.SETDEFAULT.FROM.SEL 27268 . 27945) (\TEDIT.KEY.SIZE 27947 . 29143) (\TEDIT.SUBSCRIPTSEL +29145 . 29348) (\TEDIT.SUPERSCRIPTSEL 29350 . 29554) (\TEDIT.KEY.TRANSFORM 29556 . 31553) ( +\TEDIT.KEY.OPENLINE 31555 . 32009) (\TEDIT.KEY.FAMILYN 32011 . 33409)) (33412 33701 (CAP-CASECODE +33422 . 33699)) (33735 37167 (\TEDIT.SHOWCARETLOOKS 33745 . 36260) (\TEDIT.DESCRIBEFONT 36262 . 37165) +) (37198 52171 (\TEDIT.ONECHAR.BACKWARD 37208 . 38355) (\TEDIT.ONECHAR.FORWARD 38357 . 39593) ( +\TEDIT.ONELINE.UP 39595 . 42556) (\TEDIT.ONELINE.DOWN 42558 . 44215) (\TEDIT.ONELINE.MOVE 44217 . +46504) (\TEDIT.ONEWORD.BACKWARD 46506 . 47694) (\TEDIT.ONEWORD.FORWARD 47696 . 48883) ( +\TEDIT.LINE.BEGIN 48885 . 49964) (\TEDIT.LINE.END 49966 . 51203) (\TEDIT.DOCUMENT.BEGIN 51205 . 51564) + (\TEDIT.DOCUMENT.END 51566 . 52169)) (52172 55480 (\TEDIT.LINEDELETE.FORWARD 52182 . 53291) ( +\TEDIT.LINEDELETE.BACKWARD 53293 . 54432) (\TEDIT.LINEDELETE 54434 . 55478)) (55481 58009 ( +\TEDIT.KEY.NEST 55491 . 58007)) (58010 59292 (\TEDIT.KEY.WRAP 58020 . 59290)) (59383 67431 ( +\TEDIT.KEY.FIND 59393 . 64571) (\TEDIT.KEY.FIND.SEARCHSTRING 64573 . 65713) (\TEDIT.GET.TARGET.STRING +65715 . 67429)) (67462 70094 (\TEDIT.KEY.SUBSTITUTE 67472 . 67693) (\TEDIT.MANPAGE 67695 . 68942) ( +\TEDIT.CALL.ED 68944 . 69774) (\TEDIT.SELECT.ALL 69776 . 70092)) (70121 75811 (\TEDIT.CLIPBOARD 70131 + . 71886) (\TEDIT.COPYTOCLIPBOARD 71888 . 72668) (\TEDIT.EXTRACTTOCLIPBOARD 72670 . 72865) ( +\TEDIT.WRITE.SEL 72867 . 75809)) (75977 88484 (\TEDIT.READTABLE 75987 . 76923) ( +\TEDIT.WORDBOUND.READTABLE 76925 . 79973) (TEDIT.GETSYNTAX 79975 . 81204) (TEDIT.SETSYNTAX 81206 . +82520) (TEDIT.GETFUNCTION 82522 . 83995) (TEDIT.SETFUNCTION 83997 . 86153) (TEDIT.WORDGET 86155 . +86416) (TEDIT.WORDSET 86418 . 87158) (TEDIT.ATOMBOUND.READTABLE 87160 . 88482)) (88585 95573 ( +TEDIT.BUTTONS.BUILD 88595 . 93841) (TEDIT.BUTTONBITMAP.FILL 93843 . 95571)) (98038 98626 ( +\TEDIT.TTCCLASS 98048 . 98624))))) STOP diff --git a/library/tedit/TEDIT-FNKEYS.LCOM b/library/tedit/TEDIT-FNKEYS.LCOM index 3682e535..1e667aff 100644 Binary files a/library/tedit/TEDIT-FNKEYS.LCOM and b/library/tedit/TEDIT-FNKEYS.LCOM differ diff --git a/library/tedit/TEDIT-MENU b/library/tedit/TEDIT-MENU index f6075e5d..cc340649 100644 --- a/library/tedit/TEDIT-MENU +++ b/library/tedit/TEDIT-MENU @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "10-Sep-2025 17:08:43" {WMEDLEY}TEDIT>TEDIT-MENU.;492 178438 +(FILECREATED "22-Oct-2025 12:55:36" {WMEDLEY}TEDIT>TEDIT-MENU.;498 183397 :EDIT-BY rmk - :CHANGES-TO (VARS TEDIT-MENUCOMS) + :CHANGES-TO (FNS MARGINBAR.NEUTRALIZE \TEDIT.PARALOOKS.TO.MARBAR) - :PREVIOUS-DATE "28-Jul-2025 23:26:01" {WMEDLEY}TEDIT>TEDIT-MENU.;491) + :PREVIOUS-DATE "19-Oct-2025 15:14:00" {WMEDLEY}TEDIT>TEDIT-MENU.;496) (PRETTYCOMPRINT TEDIT-MENUCOMS) @@ -59,7 +59,7 @@ (* ; "PARAMENU") (FNS \TEDIT.PARAMENU.CREATE \TEDIT.PARAMENU.START \TEDIT.APPLY.PARALOOKS - \TEDIT.SHOW.PARALOOKS \TEDIT.PARAMENU.FILLIN) + \TEDIT.SHOW.PARALOOKS \TEDIT.PARAMENU.FILLIN \TEDIT.PARAMENU.RESHAPEFN) (* ;; "") @@ -95,7 +95,7 @@ (DECLARE%: DOEVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE -(RECORD MARGINBAR (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE) +(RECORD MARGINBAR (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE MARBARWIDTH) [TYPE? (AND (IMAGEOBJP DATUM) (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) 'MB.MARGINBAR.DISPLAYFN]) @@ -511,7 +511,9 @@ (MB.MARGINBAR.SHOWTAB W TAB UNIT 'PAINT]) (MARGINBAR.CREATE - [LAMBDA (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE) (* ; "Edited 29-Sep-2024 12:53 by rmk") + [LAMBDA (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE MAINTSTREAM/WIDTH) + (* ; "Edited 19-Oct-2025 15:13 by rmk") + (* ; "Edited 29-Sep-2024 12:53 by rmk") (* ; "Edited 4-Aug-2024 22:36 by rmk") (* ; "Edited 29-Jul-2024 10:13 by rmk") (* ; "Edited 28-Jul-2024 09:18 by rmk") @@ -519,10 +521,16 @@ (* ; "Edited 22-Jul-2024 11:54 by rmk") (* ; "Edited 12-Jun-90 18:59 by mitani") - (* ;; "Create an instance of the margin-setting ruler for TEdit's use.") + (* ;; "Create an instance of the margin-setting ruler for TEdit's use. ") (PROG ((BOX (create IMAGEBOX - XSIZE _ 1008 + XSIZE _ (IDIFFERENCE (OR (FIXP MAINTSTREAM/WIDTH) + (AND MAINTSTREAM/WIDTH (\TEDIT.PRIMARYPANE + MAINTSTREAM/WIDTH) + (PANEWIDTH (\TEDIT.PRIMARYPANE MAINTSTREAM/WIDTH + ))) + SCREENWIDTH) + 18) YSIZE _ 62 YDESC _ 0 XKERN _ 4)) @@ -535,7 +543,8 @@ MARR _ MARR MARTABS _ MARTABS MARUNIT _ MARUNIT - MARTABTYPE _ MARTABTYPE)) + MARTABTYPE _ MARTABTYPE + MARBARWIDTH _ (fetch (IMAGEBOX XSIZE) of BOX))) MARGINBARIMAGEFNS)) (* ; "Create an IMAGEOBJ, containing an instance of the record to hold margin and tab info") (SETQ BITMAP (BITMAPCREATE (fetch XSIZE of BOX) @@ -850,13 +859,15 @@ PC]) (MARGINBAR.NEUTRALIZE - [LAMBDA (OBJ) (* ; "Edited 29-Jul-2024 12:14 by rmk") + [LAMBDA (OBJ) (* ; "Edited 22-Oct-2025 12:55 by rmk") + (* ; "Edited 29-Jul-2024 12:14 by rmk") (* ;; "Neutralizes the settings of the marginbar") (create MARGINBAR smashing (IMAGEOBJPROP OBJ 'OBJECTDATUM) MARL1 _ -0.5 MARLN _ -0.5 MARR _ -39.5 MARTABS _ 'NEUTRAL MARUNIT _ 12 - MARTABTYPE _ NIL]) + MARTABTYPE _ NIL MARBARWIDTH _ (fetch (MARGINBAR MARBARWIDTH) + of (IMAGEOBJPROP OBJ 'OBJECTDATUM]) (MARGINBAR.LOOKS [LAMBDA (OBJ DOTTEDLEADER) (* ; "Edited 20-Oct-2024 15:27 by rmk") @@ -913,13 +924,14 @@ LOOKS]) (MB.MARGINBAR.SIZEFN - [LAMBDA (OBJ) (* ; "Edited 3-Dec-2024 20:03 by rmk") + [LAMBDA (OBJ) (* ; "Edited 19-Oct-2025 09:47 by rmk") + (* ; "Edited 3-Dec-2024 20:03 by rmk") (* jds " 5-Sep-84 14:10") (* ;; "YDESC is 2 so that selecting the bar and highlighting doesn't wipe out the bottom line. Although you shouldn't be able to select it") (LET ((BOX (create IMAGEBOX - XSIZE _ 1008 + XSIZE _ (fetch (MARGINBAR MARBARWIDTH) of (IMAGEOBJPROP OBJ 'OBJECTDATUM)) YSIZE _ 62 YDESC _ 2 XKERN _ 4))) @@ -1070,7 +1082,8 @@ 'MarginRuler]) (\TEDIT.PARALOOKS.TO.MARBAR - [LAMBDA (PARALOOKS UNIT) (* ; "Edited 19-Feb-2025 13:25 by rmk") + [LAMBDA (PARALOOKS UNIT) (* ; "Edited 22-Oct-2025 12:29 by rmk") + (* ; "Edited 19-Feb-2025 13:25 by rmk") (* ; "Edited 8-Feb-2025 21:08 by rmk") (* ; "Edited 4-Aug-2024 22:50 by rmk") @@ -1088,7 +1101,8 @@ MARUNIT _ UNIT MARTABS _ (for TAB in (FGETPLOOKS PARALOOKS FMTTABS) collect (create TAB using TAB TABX _ (QUOTIENT (fetch (TAB TABX) of TAB) - UNIT]) + UNIT))) + MARBARWIDTH _ (FGETPLOOKS PARALOOKS RIGHTMAR]) ) (RPAQQ \TEDIT.LEFTTAB #*(10 8)B@@@B@@@G@@@JH@@B@@@B@@@CN@@@@@@) @@ -1247,7 +1261,8 @@ (DEFINEQ (\TEDIT.MENU.CREATE - [LAMBDA (MENUDESC MENUPROPS) (* ; "Edited 17-Dec-2024 08:53 by rmk") + [LAMBDA (MENUDESC MENUPROPS MAINTSTREAM) (* ; "Edited 19-Oct-2025 10:36 by rmk") + (* ; "Edited 17-Dec-2024 08:53 by rmk") (* ; "Edited 22-Aug-2024 11:09 by rmk") (* ; "Edited 21-Aug-2024 09:54 by rmk") (* ; "Edited 14-Aug-2024 09:40 by rmk") @@ -1263,7 +1278,7 @@ (* ;; "Create the TEXTSTREAM for a menu, given a menu description. That stream is marked as a menu and passed to \TEDIT.MENU.START to get the menu up on screen") (LET [(MENUTSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (OR MENUPROPS '(FONT (MODERN 10] - (MB.ADD MENUDESC MENUTSTREAM) + (MB.ADD MENUDESC MENUTSTREAM NIL NIL MAINTSTREAM) (SETSEL (TEXTSEL (GETTSTR MENUTSTREAM TEXTOBJ)) SET NIL) (SETTOBJ (GETTSTR MENUTSTREAM TEXTOBJ) @@ -1663,7 +1678,8 @@ (DEFINEQ (\TEDIT.PARAMENU.CREATE - [LAMBDA NIL (* ; "Edited 13-Jul-2025 22:35 by rmk") + [LAMBDA (MAINTSTREAM) (* ; "Edited 19-Oct-2025 15:12 by rmk") + (* ; "Edited 13-Jul-2025 22:35 by rmk") (* ; "Edited 7-Jan-2025 15:48 by rmk") (* ; "Edited 8-Nov-2024 08:35 by rmk") (* ; "Edited 20-Oct-2024 23:46 by rmk") @@ -1680,7 +1696,7 @@ (* ; "Edited 27-Jul-2024 10:18 by rmk") (* jds " 2-Aug-84 15:32") - (* ;; "Creates the TEdit Expanded Paragraph Menu. (PROGN to suppress %"value of comment used? compile-time messages.)") + (* ;; "Creates the TEdit Expanded Paragraph Menu for MAINTSTREAM. (PROGN to suppress %"value of comment used? compile-time messages.)") (PROGN (* ;; "Hack so Masterscope knows that these otherwise quoted functions are here.") @@ -1689,88 +1705,97 @@ (FUNCTION \TEDIT.SHOW.PARALOOKS) (FUNCTION \TEDIT.MENU.NEUTRALIZE) (FUNCTION \TEDIT.TABTYPE.SET) - (FUNCTION PRINTERTYPE)) - (\TEDIT.MENU.CREATE `((ACTION (LABEL APPLY) - (IGNORE T) - (SELECTFN \TEDIT.APPLY.PARALOOKS)) - 3 - (ACTION (LABEL SHOW) - (IGNORE T) - (SELECTFN \TEDIT.SHOW.PARALOOKS)) - 3 - (ACTION (LABEL NEUTRAL) - (IGNORE T) - (SELECTFN \TEDIT.MENU.NEUTRALIZE)) - EOL - (NWAY (IDENTIFIER QUAD) - (BUTTONS (Left Right Centered Justified)) - (INITSTATE OFF)) - TAB - (3STATE (IDENTIFIER TYPE) - (LABEL "Page Heading")) - 2 - (FIELD (IDENTIFIER SUBTYPE) - (PRELABEL "type") - (FIELDTYPE SYMBOL)) - EOL - (FIELD (IDENTIFIER LINELEADING) - (PRELABEL "Line leading") - (POSTLABEL "pts") - (FIELDTYPE NUMBER) - (LABELFONT (HELVETICA 8))) - (FIELD (PRELABEL " Para leading") - (POSTLABEL "pts") - (IDENTIFIER PARALEADING) - (FIELDTYPE NUMBER) - (LABELFONT (HELVETICA 8))) - (FIELD (IDENTIFIER SPECIALX) - (PRELABEL " Special Locn: X") - (POSTLABEL "picas") - (FIELDTYPE PICAS) - (LABELFONT (HELVETICA 8))) - (FIELD (IDENTIFIER SPECIALY) - (PRELABEL " Y") - (POSTLABEL "picas") - (FIELDTYPE PICAS) - (LABELFONT (HELVETICA 8))) - EOL - (TEXT (STRING "New Page: ") - (FONT (HELVETICA 8))) - (3STATE (IDENTIFIER NEWPAGEBEFORE) - (LABEL "Before")) - 2 - (3STATE (IDENTIFIER NEWPAGEAFTER) - (LABEL "After")) - 4 - (3STATE (IDENTIFIER HEADINGKEEP) - (LABEL "Keep heading")) - (TEXT (STRING " Display mode: ") - (FONT (HELVETICA 8))) - (3STATE (LABEL "Hardcopy")) (* (FIELD (IDENTIFIER PRINTFILETYPE) + (FUNCTION PRINTERTYPE) + (FUNCTION \TEDIT.PARAMENU.RESHAPEFN)) + (LET (MENUTSTREAM) + (SETQ MENUTSTREAM (\TEDIT.MENU.CREATE `((ACTION (LABEL APPLY) + (IGNORE T) + (SELECTFN \TEDIT.APPLY.PARALOOKS)) + 3 + (ACTION (LABEL SHOW) + (IGNORE T) + (SELECTFN \TEDIT.SHOW.PARALOOKS)) + 3 + (ACTION (LABEL NEUTRAL) + (IGNORE T) + (SELECTFN \TEDIT.MENU.NEUTRALIZE)) + EOL + (NWAY (IDENTIFIER QUAD) + (BUTTONS (Left Right Centered Justified)) + (INITSTATE OFF)) + TAB + (3STATE (IDENTIFIER TYPE) + (LABEL "Page Heading")) + 2 + (FIELD (IDENTIFIER SUBTYPE) + (PRELABEL "type") + (FIELDTYPE SYMBOL)) + EOL + (FIELD (IDENTIFIER LINELEADING) + (PRELABEL "Line leading") + (POSTLABEL "pts") + (FIELDTYPE NUMBER) + (LABELFONT (HELVETICA 8))) + (FIELD (PRELABEL " Para leading") + (POSTLABEL "pts") + (IDENTIFIER PARALEADING) + (FIELDTYPE NUMBER) + (LABELFONT (HELVETICA 8))) + (FIELD (IDENTIFIER SPECIALX) + (PRELABEL " Special Locn: X") + (POSTLABEL "picas") + (FIELDTYPE PICAS) + (LABELFONT (HELVETICA 8))) + (FIELD (IDENTIFIER SPECIALY) + (PRELABEL " Y") + (POSTLABEL "picas") + (FIELDTYPE PICAS) + (LABELFONT (HELVETICA 8))) + EOL + (TEXT (STRING "New Page: ") + (FONT (HELVETICA 8))) + (3STATE (IDENTIFIER NEWPAGEBEFORE) + (LABEL "Before")) + 2 + (3STATE (IDENTIFIER NEWPAGEAFTER) + (LABEL "After")) + 4 + (3STATE (IDENTIFIER HEADINGKEEP) + (LABEL "Keep heading")) + (TEXT (STRING " Display mode: ") + (FONT (HELVETICA 8))) + (3STATE (LABEL "Hardcopy")) + (* (FIELD (IDENTIFIER PRINTFILETYPE) (FIELDTYPE SYMBOL) (INITSTATE (\, (PRINTERTYPE))))) - 4 EOL (TEXT (STRING "Tab Type: ") - (FONT (HELVETICA 8))) - (NWAY (IDENTIFIER TABTYPE) - (BUTTONS (Left Right Centered Decimal)) - (IGNORE T)) - 3 - (TOGGLE (IDENTIFIER DOTTEDLEADER) - (LABEL "Dotted Leader") - (IGNORE T)) - (FIELD (IDENTIFIER DEFAULTTAB) - (PRELABEL " Default Tab:") - (POSTLABEL "pts") - (FIELDTYPE NUMBER) - (LABELFONT (HELVETICA 8))) - EOL - ((PROGN (TEDIT.INSERT.OBJECT (MARGINBAR.CREATE -0.5 -0.5 -39.5 NIL 12) - MENUTSTREAM CH# '(PROTECTED OFF)) - 1)) - EOL]) + 4 EOL (TEXT (STRING "Tab Type: ") + (FONT (HELVETICA 8))) + (NWAY (IDENTIFIER TABTYPE) + (BUTTONS (Left Right Centered Decimal)) + (IGNORE T)) + 3 + (TOGGLE (IDENTIFIER DOTTEDLEADER) + (LABEL "Dotted Leader") + (IGNORE T)) + (FIELD (IDENTIFIER DEFAULTTAB) + (PRELABEL " Default Tab:") + (POSTLABEL "pts") + (FIELDTYPE NUMBER) + (LABELFONT (HELVETICA 8))) + EOL + ((PROGN (TEDIT.INSERT.OBJECT (MARGINBAR.CREATE + -0.5 -0.5 -39.5 NIL 12 + NIL MAINTSTREAM) + MENUTSTREAM CH# '(PROTECTED OFF)) + 1)) + EOL) + NIL MAINTSTREAM)) + [PUTTEXTPROP MENUTSTREAM 'WINDOWPROPS `(RESHAPEFN (\TEDIT.PARAMENU.RESHAPEFN] + MENUTSTREAM]) (\TEDIT.PARAMENU.START - [LAMBDA (TSTREAM) (* ; "Edited 28-May-2025 23:45 by rmk") + [LAMBDA (MAINTSTREAM) (* ; "Edited 19-Oct-2025 10:29 by rmk") + (* ; "Edited 28-May-2025 23:45 by rmk") (* ; "Edited 14-Mar-2025 15:42 by rmk") (* ; "Edited 7-Jan-2025 15:36 by rmk") (* ; "Edited 27-Jul-2024 00:06 by rmk") @@ -1778,9 +1803,9 @@ (* ; "Edited 27-Feb-2024 07:53 by rmk") (* ; "Edited 19-Sep-2023 08:51 by rmk") (* ; "Edited 20-Aug-87 16:51 by jds") - (CL:UNLESS (\TEDIT.MENU.OPEN? "Paragraph-Looks Menu" TSTREAM) - (\TEDIT.MENU.START (\TEDIT.PARAMENU.CREATE) - TSTREAM "Paragraph-Looks Menu" (HEIGHTIFWINDOW 141 T) + (CL:UNLESS (\TEDIT.MENU.OPEN? "Paragraph-Looks Menu" MAINTSTREAM) + (\TEDIT.MENU.START (\TEDIT.PARAMENU.CREATE MAINTSTREAM) + MAINTSTREAM "Paragraph-Looks Menu" (HEIGHTIFWINDOW 141 T) 'PARALOOKS))]) (\TEDIT.APPLY.PARALOOKS @@ -1895,6 +1920,21 @@ (CL:WHEN SETSTATEFN (SETQ PC (APPLY* SETSTATEFN PC VAL MENUSTREAM)) (TEDIT.OBJECT.CHANGED MENUSTREAM OBJ))]) + +(\TEDIT.PARAMENU.RESHAPEFN + [LAMBDA (PANE BITS OLDREGION) (* ; "Edited 19-Oct-2025 14:18 by rmk") + + (* ;; "The marginbar's width may change when the parawindow is reshaped. If PANE is wider than the previous width, extend the margin bar.") + + (LET [(PC (MB.GET 'MARGINBAR PANE 'STARTPC] + (CL:WHEN [AND PC (IGREATERP (PANEWIDTH PANE) + (fetch (MARGINBAR MARBARWIDTH) of (IMAGEOBJPROP (POBJ PC) + 'OBJECTDATUM] + [WITH MARGINBAR (IMAGEOBJPROP (POBJ PC) + 'OBJECTDATUM) + (FSETPC PC POBJ (MARGINBAR.CREATE MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE + (PANEWIDTH PANE]) + (\TEDIT.RESHAPEFN PANE BITS OLDREGION]) ) @@ -2867,32 +2907,32 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4902 16540 (TEDIT.ADD.MENUITEM 4912 . 7029) (TEDIT.DEFAULT.MENUFN 7031 . 13752) ( -TEDIT.REMOVE.MENUITEM 13754 . 14751) (\TEDIT.CREATEMENU 14753 . 15318) (\TEDIT.MENU.WHENHELDFN 15320 - . 16225) (\TEDIT.MENU.WHENSELECTEDFN 16227 . 16538)) (17354 63997 (DRAWMARGINSCALE 17364 . 20823) ( -MARGINBAR 20825 . 27950) (MARGINBAR.CREATE 27952 . 31371) (MB.MARGINBAR.BUTTONEVENTINFN 31373 . 39175) - (MB.MARGINBAR.SELFN.TABS 39177 . 44417) (MB.MARGINBAR.SELFN.TABS.KIND 44419 . 45354) ( -MARGINBAR.GETSTATEFN 45356 . 49343) (MARGINBAR.SETSTATEFN 49345 . 49555) (MARGINBAR.NEUTRALIZE 49557 - . 49970) (MARGINBAR.LOOKS 49972 . 53078) (MB.MARGINBAR.SIZEFN 53080 . 53683) (MB.MARGINBAR.DISPLAYFN -53685 . 56746) (MDESCALE 56748 . 57288) (MSCALE 57290 . 57620) (MB.MARGINBAR.SHOWTAB 57622 . 59945) ( -MB.MARGINBAR.TABTRACK 59947 . 61332) (MARGINBAR.INIT 61334 . 62727) (\TEDIT.PARALOOKS.TO.MARBAR 62729 - . 63995)) (64822 72104 (TEDIT.MENUSTREAM 64832 . 65832) (TEDITMENUP 65834 . 66803) (\TEDIT.MENU.START - 66805 . 71152) (\TEDIT.MENU.OPEN? 71154 . 71528) (\TEDIT.MENU.BUTTONEVENTFN 71530 . 72102)) (72423 -80345 (\TEDIT.MENU.CREATE 72433 . 74244) (\TEDIT.MENU.PARSE 74246 . 77935) (\TEDIT.MENU.NEUTRALIZE -77937 . 80008) (\TEDITMENU.RECORD.UNFORMATTED 80010 . 80343)) (80411 100192 ( -\TEDIT.EXPANDEDMENU.CREATE 80421 . 85888) (\TEDIT.EXPANDEDMENU.START 85890 . 87514) ( -\TEDIT.EXPANDEDMENU.FN 87516 . 90771) (\TEDIT.EXPANDEDMENU.ACTIONFN 90773 . 100190)) (100254 116311 ( -\TEDIT.PARAMENU.CREATE 100264 . 106658) (\TEDIT.PARAMENU.START 106660 . 107785) ( -\TEDIT.APPLY.PARALOOKS 107787 . 108839) (\TEDIT.SHOW.PARALOOKS 108841 . 111558) ( -\TEDIT.PARAMENU.FILLIN 111560 . 116309)) (116516 143358 (\TEDIT.CHARMENU.CREATE 116526 . 119130) ( -\TEDIT.CHARMENU.START 119132 . 120422) (\TEDIT.CHARMENU.SPEC 120424 . 125107) (\TEDIT.CHARMENU.PARSE -125109 . 128277) (\TEDIT.CHARMENU.FILLIN 128279 . 132909) (\TEDIT.SHOW.CHARLOOKS 132911 . 136456) ( -\TEDIT.APPLY.CHARLOOKS 136458 . 137619) (\TEDIT.OFFSETTYPE.STATEFN 137621 . 139584) ( -\TEDIT.OTHER.STATECHANGEFN 139586 . 141231) (\TEDIT.OTHER.SELECTFN 141233 . 143356)) (143420 172478 ( -\TEDIT.PAGEMENU.CREATE 143430 . 151942) (\TEDIT.PAGEMENU.START 151944 . 152295) (\TEDIT.SHOW.PAGELOOKS - 152297 . 154183) (\TEDIT.PAGEMENU.FILLIN 154185 . 155735) (\TEDIT.PAGEREGION.UNPARSE 155737 . 165136) - (\TEDIT.APPLY.PAGELOOKS 165138 . 167065) (\TEDIT.CHANGE.PAGELOOKS 167067 . 171634) ( -\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 171636 . 172476)) (172479 178282 (\TEDIT.PAGEMENU.CREATE.HEADINGS -172489 . 175301) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN 175303 . 176728) ( -\TEDIT.PAGEMENU.HEADINGS.STATEFN 176730 . 178280))))) + (FILEMAP (NIL (4972 16610 (TEDIT.ADD.MENUITEM 4982 . 7099) (TEDIT.DEFAULT.MENUFN 7101 . 13822) ( +TEDIT.REMOVE.MENUITEM 13824 . 14821) (\TEDIT.CREATEMENU 14823 . 15388) (\TEDIT.MENU.WHENHELDFN 15390 + . 16295) (\TEDIT.MENU.WHENSELECTEDFN 16297 . 16608)) (17424 65459 (DRAWMARGINSCALE 17434 . 20893) ( +MARGINBAR 20895 . 28020) (MARGINBAR.CREATE 28022 . 32220) (MB.MARGINBAR.BUTTONEVENTINFN 32222 . 40024) + (MB.MARGINBAR.SELFN.TABS 40026 . 45266) (MB.MARGINBAR.SELFN.TABS.KIND 45268 . 46203) ( +MARGINBAR.GETSTATEFN 46205 . 50192) (MARGINBAR.SETSTATEFN 50194 . 50404) (MARGINBAR.NEUTRALIZE 50406 + . 51081) (MARGINBAR.LOOKS 51083 . 54189) (MB.MARGINBAR.SIZEFN 54191 . 54977) (MB.MARGINBAR.DISPLAYFN +54979 . 58040) (MDESCALE 58042 . 58582) (MSCALE 58584 . 58914) (MB.MARGINBAR.SHOWTAB 58916 . 61239) ( +MB.MARGINBAR.TABTRACK 61241 . 62626) (MARGINBAR.INIT 62628 . 64021) (\TEDIT.PARALOOKS.TO.MARBAR 64023 + . 65457)) (66284 73566 (TEDIT.MENUSTREAM 66294 . 67294) (TEDITMENUP 67296 . 68265) (\TEDIT.MENU.START + 68267 . 72614) (\TEDIT.MENU.OPEN? 72616 . 72990) (\TEDIT.MENU.BUTTONEVENTFN 72992 . 73564)) (73885 +81936 (\TEDIT.MENU.CREATE 73895 . 75835) (\TEDIT.MENU.PARSE 75837 . 79526) (\TEDIT.MENU.NEUTRALIZE +79528 . 81599) (\TEDITMENU.RECORD.UNFORMATTED 81601 . 81934)) (82002 101783 ( +\TEDIT.EXPANDEDMENU.CREATE 82012 . 87479) (\TEDIT.EXPANDEDMENU.START 87481 . 89105) ( +\TEDIT.EXPANDEDMENU.FN 89107 . 92362) (\TEDIT.EXPANDEDMENU.ACTIONFN 92364 . 101781)) (101845 121270 ( +\TEDIT.PARAMENU.CREATE 101855 . 110586) (\TEDIT.PARAMENU.START 110588 . 111842) ( +\TEDIT.APPLY.PARALOOKS 111844 . 112896) (\TEDIT.SHOW.PARALOOKS 112898 . 115615) ( +\TEDIT.PARAMENU.FILLIN 115617 . 120366) (\TEDIT.PARAMENU.RESHAPEFN 120368 . 121268)) (121475 148317 ( +\TEDIT.CHARMENU.CREATE 121485 . 124089) (\TEDIT.CHARMENU.START 124091 . 125381) (\TEDIT.CHARMENU.SPEC +125383 . 130066) (\TEDIT.CHARMENU.PARSE 130068 . 133236) (\TEDIT.CHARMENU.FILLIN 133238 . 137868) ( +\TEDIT.SHOW.CHARLOOKS 137870 . 141415) (\TEDIT.APPLY.CHARLOOKS 141417 . 142578) ( +\TEDIT.OFFSETTYPE.STATEFN 142580 . 144543) (\TEDIT.OTHER.STATECHANGEFN 144545 . 146190) ( +\TEDIT.OTHER.SELECTFN 146192 . 148315)) (148379 177437 (\TEDIT.PAGEMENU.CREATE 148389 . 156901) ( +\TEDIT.PAGEMENU.START 156903 . 157254) (\TEDIT.SHOW.PAGELOOKS 157256 . 159142) (\TEDIT.PAGEMENU.FILLIN + 159144 . 160694) (\TEDIT.PAGEREGION.UNPARSE 160696 . 170095) (\TEDIT.APPLY.PAGELOOKS 170097 . 172024) + (\TEDIT.CHANGE.PAGELOOKS 172026 . 176593) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 176595 . 177435)) ( +177438 183241 (\TEDIT.PAGEMENU.CREATE.HEADINGS 177448 . 180260) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN +180262 . 181687) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 181689 . 183239))))) STOP diff --git a/library/tedit/TEDIT-MENU.LCOM b/library/tedit/TEDIT-MENU.LCOM index 80237952..7be47f74 100644 Binary files a/library/tedit/TEDIT-MENU.LCOM and b/library/tedit/TEDIT-MENU.LCOM differ diff --git a/library/tedit/TEDIT-RELEASENOTES.TEDIT b/library/tedit/TEDIT-RELEASENOTES.TEDIT index de72aa2a..a44d309c 100644 Binary files a/library/tedit/TEDIT-RELEASENOTES.TEDIT and b/library/tedit/TEDIT-RELEASENOTES.TEDIT differ diff --git a/library/tedit/TEDIT-SCREEN b/library/tedit/TEDIT-SCREEN index dbb6599d..c5d199f0 100644 --- a/library/tedit/TEDIT-SCREEN +++ b/library/tedit/TEDIT-SCREEN @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Aug-2025 12:51:00" {WMEDLEY}tedit>TEDIT-SCREEN.;909 186327 +(FILECREATED "31-Dec-2025 23:10:18" {WMEDLEY}tedit>TEDIT-SCREEN.;915 186658 :EDIT-BY rmk :CHANGES-TO (VARS TEDIT-SCREENCOMS) - (FNS \TEDIT.FORMATLINE) - :PREVIOUS-DATE "28-Jul-2025 23:23:33" {WMEDLEY}tedit>TEDIT-SCREEN.;908) + :PREVIOUS-DATE " 7-Dec-2025 16:28:01" {WMEDLEY}tedit>TEDIT-SCREEN.;914) (PRETTYCOMPRINT TEDIT-SCREENCOMS) @@ -23,7 +22,6 @@ LINEDESCRIPTOR!)) (MACROS HCSCALE HCUNSCALE SCALEUP SCALEDOWN) (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS) - (ALISTS (CHARACTERNAMES SOFT-HYPHEN NONBREAKING-HYPHEN NONBREAKING-SPACE)) (MACROS DIACRITICP) (MACROS \TEDIT.LINE.TALLP) (COMS (* ; "Formatting slots held by THISLINE") @@ -37,6 +35,7 @@ (* ;; "incharslots can be used only if THISLINE is properly bound in the environment, to provide upperbound checking. Operand can be THISLINE (= FIRSTCHARSLOT) or a within-range slot pointer. The latter case is not current checked for validity (some \HILOC \LOLOC address calculations?). backcharslots runs backwards.") (I.S.OPRS incharslots backcharslots] + (ALISTS (CHARACTERNAMES SOFT-HYPHEN NONBREAKING-HYPHEN NONBREAKING-SPACE)) (FNS \TEDIT.LINEDESCRIPTOR.DEFPRINT) (INITRECORDS THISLINE LINEDESCRIPTOR LINECACHE) (DECLARE%: EVAL@COMPILE DONTCOPY (* ; "Not exported") @@ -299,10 +298,6 @@ (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS) ) - -(ADDTOVAR CHARACTERNAMES (SOFT-HYPHEN "357,043") - (NONBREAKING-HYPHEN "357,042") - (NONBREAKING-SPACE "357,041")) (DECLARE%: EVAL@COMPILE (PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) @@ -461,6 +456,10 @@ (* "END EXPORTED DEFINITIONS") ) + +(ADDTOVAR CHARACTERNAMES (SOFT-HYPHEN "357,043") + (NONBREAKING-HYPHEN "357,042") + (NONBREAKING-SPACE "357,041")) (DEFINEQ (\TEDIT.LINEDESCRIPTOR.DEFPRINT @@ -655,17 +654,16 @@ (\TEDIT.FORMATLINE [LAMBDA (TSTREAM CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE) + (* ; "Edited 21-Nov-2025 16:36 by rmk") (* ; "Edited 7-Aug-2025 12:49 by rmk") (* ; "Edited 27-Apr-2025 11:24 by rmk") (* ; "Edited 21-Apr-2025 19:03 by rmk") - (* ; "Edited 11-Apr-2025 20:18 by rmk") (* ; "Edited 29-Mar-2025 11:39 by rmk") (* ; "Edited 6-Mar-2025 11:42 by rmk") (* ; "Edited 8-Feb-2025 23:36 by rmk") (* ; "Edited 24-Dec-2024 22:15 by rmk") (* ; "Edited 23-Nov-2024 00:03 by rmk") (* ; "Edited 31-Oct-2024 15:32 by rmk") - (* ; "Edited 26-Oct-2024 10:51 by rmk") (* ; "Edited 2-Sep-2024 16:06 by rmk") (* ; "Edited 4-Aug-2024 18:07 by rmk") (* ; "Edited 21-May-2024 14:45 by rmk") @@ -705,9 +703,11 @@ (* ;; "") + (CL:UNLESS LINE + (SETQ LINE (create LINEDESCRIPTOR))) (CL:UNLESS IMAGESTREAM (SETQ IMAGESTREAM (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM) - 'DSP))) (* ; "For lower image objects?") + 'DSP))) (PROG ((TEXTOBJ (FTEXTOBJ TSTREAM)) (OFFSET 0) (TRUEASCENT -1) @@ -719,17 +719,11 @@ (OVERHANG 0) (SPACELEFT 0) (TX 0) - (BOXSTREAM IMAGESTREAM) CHARLOOKS THISLINE LINETYPE WIDTH WMARGIN SCALE PARALOOKS RIGHTMARGIN HASKERN PC CHARSLOT PREVSP 1STLN CHNOB FORCED-END CHNO LX1 TX TXB FONT CHARSLOTB TABPENDING PREVHYPH PREVDHYPH START-OF-PIECE UNBREAKABLE OLDPIECE OLDPCCHARSLEFT OLDCARETLOOKS FIRSTSEPR) (DECLARE (SPECVARS TEXTOBJ LINETYPE CHARLOOKS CHNO OFFSET ASCENTC DESCENTC FONT START-OF-PIECE HASKERN UNBREAKABLE)) - (CL:UNLESS LINE - - (* ;; "Not needed until the end, but then we might not get the starting values for WRIGHT and WBOTTOM, if those change from piece to piece--check this.") - - (SETQ LINE (create LINEDESCRIPTOR))) (SETQ THISLINE (FGETTOBJ TEXTOBJ THISLINE)) (* ;; @@ -900,9 +894,9 @@ (* ;; "If this isn't TRUEHARDCOPY, we want to do the imageobject in the displaystream with displaystream coordinates, because we don't know what internal size computations the imageobject might make based on its displaystream and fonts. But we do have to down-scale WIDTH (right margin) back to the units of the display stream.") (SETQ BOX (APPLY* (IMAGEOBJPROP CH 'IMAGEBOXFN) - CH BOXSTREAM TX (CL:IF (EQ LINETYPE 'HARDCOPYDISPLAY) - (SCALEDOWN SCALE WIDTH) - WIDTH) + CH IMAGESTREAM TX (CL:IF (EQ LINETYPE 'HARDCOPYDISPLAY) + (SCALEDOWN SCALE WIDTH) + WIDTH) TSTREAM)) (IMAGEOBJPROP CH 'BOUNDBOX BOX) (SETQ TRUEASCENT (IMAX TRUEASCENT (IPLUS (IDIFFERENCE (fetch (IMAGEBOX YSIZE) @@ -1230,7 +1224,8 @@ (RETURN LINE]) (\TEDIT.FORMATLINE.SETUP.PARA - [LAMBDA (TEXTOBJ PC LINE IMAGESTREAM LINETYPE) (* ; "Edited 19-Feb-2025 13:37 by rmk") + [LAMBDA (TEXTOBJ PC LINE IMAGESTREAM LINETYPE) (* ; "Edited 7-Dec-2025 16:26 by rmk") + (* ; "Edited 19-Feb-2025 13:37 by rmk") (* ; "Edited 8-Feb-2025 23:36 by rmk") (* ; "Edited 7-Feb-2025 08:09 by rmk") (* ; "Edited 22-Nov-2024 11:14 by rmk") @@ -1265,9 +1260,8 @@ (* ;; "Coerce the image stream and PARALOOKS for HARDCOPYDISPLAY.") [SETQ IMAGESTREAM (OR (FGETTOBJ TEXTOBJ DISPLAYHCPYDS) - (FSETTOBJ TEXTOBJ DISPLAYHCPYDS (OPENIMAGESTREAM - '{NODIRCORE} - 'POSTSCRIPT] + (FSETTOBJ TEXTOBJ DISPLAYHCPYDS (OPENIMAGESTREAM NIL + DEFAULTPRINTERTYPE] (SETQ SCALE (DSPSCALE NIL IMAGESTREAM)) [SETQ PLOOKS (create PARALOOKS using PLOOKS FMTHARDCOPYSCALE _ SCALE RIGHTMAR _ (SCALEUP SCALE (FGETPLOOKS PLOOKS RIGHTMAR)) @@ -1294,7 +1288,8 @@ IMAGESTREAM]) (\TEDIT.FORMATLINE.HORIZONTAL - [LAMBDA (LINE THISLINE PREVSP SPACELEFT OVERHANG LINETYPE) (* ; "Edited 29-May-2025 15:15 by rmk") + [LAMBDA (LINE THISLINE PREVSP SPACELEFT OVERHANG LINETYPE) (* ; "Edited 18-Oct-2025 20:05 by rmk") + (* ; "Edited 29-May-2025 15:15 by rmk") (* ; "Edited 19-Feb-2025 13:35 by rmk") (* ; "Edited 8-Feb-2025 23:37 by rmk") (* ; "Edited 15-Mar-2024 19:35 by rmk") @@ -1318,6 +1313,8 @@ (* ;; "") + (SETQ SPACELEFT (MAX SPACELEFT 0)) + (* ;; "Also for HARDCOPYDISPLAY the horizontal positions (margins and character widths) are in hardcopy units. At the end we scale them back to screen points. ") (LET* ((PARALOOKS (FGETLD LINE LPARALOOKS)) @@ -2293,7 +2290,9 @@ 1)]) (\TEDIT.UPDATE.LINES - [LAMBDA (TSTREAM REASON FIRSTCHANGEDCHNO NCHARSCHANGED) (* ; "Edited 26-Apr-2025 19:19 by rmk") + [LAMBDA (TSTREAM REASON FIRSTCHANGEDCHNO NCHARSCHANGED) (* ; "Edited 26-Oct-2025 17:10 by rmk") + (* ; "Edited 24-Oct-2025 12:57 by rmk") + (* ; "Edited 26-Apr-2025 19:19 by rmk") (* ; "Edited 21-Apr-2025 20:30 by rmk") (* ; "Edited 9-Apr-2025 12:59 by rmk") (* ; "Edited 6-Apr-2025 14:23 by rmk") @@ -2323,7 +2322,7 @@ (LET ((TEXTOBJ (FTEXTOBJ TSTREAM))) (CL:UNLESS (FGETTOBJ TEXTOBJ TXTDON'TUPDATE) (\TEDIT.NOSEL TSTREAM) - (for PANE LASTVALID NEXTVALID LASTGAPLINE BITMAPLINES (LASTCHANGEDCHNO + [for PANE LASTVALID NEXTVALID LASTGAPLINE BITMAPLINES (LASTCHANGEDCHNO _ (SUB1 (IPLUS FIRSTCHANGEDCHNO NCHARSCHANGED))) @@ -2333,38 +2332,41 @@ ((CHANGED LOOKS) 0) (\TEDIT.THELP "BAD REASONS FOR VALID LINES"))) inpanes TEXTOBJ - when (SETQ LASTVALID (\TEDIT.LASTVALIDLINE FIRSTCHANGEDCHNO LASTCHANGEDCHNO PANE - TSTREAM)) do (* ;; "Create/format/position/display new lines between LASTVALID and NEXTVALID exclusive") - (SETQ NEXTVALID (\TEDIT.NEXTVALIDLINE LASTCHANGEDCHNO PANE TSTREAM)) - (CL:UNLESS (ZEROP DELTA) (* ; + (SETQ LASTVALID (\TEDIT.LASTVALIDLINE FIRSTCHANGEDCHNO LASTCHANGEDCHNO PANE + TSTREAM)) + (if LASTVALID + then (SETQ NEXTVALID (\TEDIT.NEXTVALIDLINE LASTCHANGEDCHNO PANE TSTREAM)) + (CL:UNLESS (ZEROP DELTA) (* ; "Adjust the character numbers of the lower valid lines") - (for L inlines NEXTVALID do (add (FGETLD L LCHAR1) - DELTA) - (add (FGETLD L LCHARLAST) - DELTA))) + (for L inlines NEXTVALID do (add (FGETLD L LCHAR1) + DELTA) + (add (FGETLD L LCHARLAST) + DELTA))) - (* ;; "MEASURED.LINES creates, measures, and links the lines from LASTVALID to the last pre-NEXTVALID character, without displaying. They may be in the bitmap.") + (* ;; "MEASURED.LINES creates, measures, and links the lines from LASTVALID to the last pre-NEXTVALID character, without displaying. They may be in the bitmap.") - [SETQ LASTGAPLINE (\TEDIT.MEASURED.LINES LASTVALID PANE TSTREAM - (CL:IF NEXTVALID - (SUB1 (FGETLD NEXTVALID LCHAR1)) - (TEXTLEN TEXTOBJ))] + [SETQ LASTGAPLINE (\TEDIT.MEASURED.LINES LASTVALID PANE TSTREAM + (CL:IF NEXTVALID + (SUB1 (FGETLD NEXTVALID LCHAR1)) + (TEXTLEN TEXTOBJ))] - (* ;; + (* ;; "The chain that ended at LASTVALID now continues thru LASTGAPLINE to NEXVALID and below.") - (LINKLD LASTGAPLINE NEXTVALID) - (if NEXTVALID - then (SETQ BITMAPLINES (\TEDIT.BITMAPLINES PANE NEXTVALID)) - else (\TEDIT.SUFFIXLINE.CREATE PANE TSTREAM LASTGAPLINE)) + (LINKLD LASTGAPLINE NEXTVALID) + (if NEXTVALID + then (SETQ BITMAPLINES (\TEDIT.BITMAPLINES PANE NEXTVALID)) + else (\TEDIT.SUFFIXLINE.CREATE PANE TSTREAM LASTGAPLINE)) - (* ;; "If LASTVALID is not visible (above the pane), make sure that its NEXT is linked to the PANE's prefix") + (* ;; "If LASTVALID is not visible (above the pane), make sure that its NEXT is linked to the PANE's prefix") - (\TEDIT.SHIFTLINES LASTVALID PANE TSTREAM BITMAPLINES)))]) + (\TEDIT.SHIFTLINES LASTVALID PANE TSTREAM BITMAPLINES) + else (* ; "No lines left in this pane") + (\TEDIT.SCROLLCH.TOP TSTREAM PANE (SUB1 FIRSTCHANGEDCHNO])]) (\TEDIT.PANE.CREATELINES [LAMBDA (TSTREAM PANE LCHARLAST YBOT) (* ; "Edited 28-Jul-2025 23:23 by rmk") @@ -2861,21 +2863,21 @@ (\TEDIT.LINE.TALLP LINE PHEIGHT))))]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (26256 28472 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 26266 . 28470)) (35926 119762 ( -\TEDIT.FORMATLINE 35936 . 71423) (\TEDIT.FORMATLINE.SETUP.PARA 71425 . 76591) ( -\TEDIT.FORMATLINE.HORIZONTAL 76593 . 81261) (\TEDIT.FORMATLINE.VERTICAL 81263 . 83714) ( -\TEDIT.FORMATLINE.JUSTIFY 83716 . 89737) (\TEDIT.FORMATLINE.TABS 89739 . 97767) (\TEDIT.SCALE.TABS -97769 . 98560) (\TEDIT.FORMATLINE.PURGE.SPACES 98562 . 99989) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN -99991 . 101068) (\TEDIT.FORMATLINE.EMPTY 101070 . 105890) (\TEDIT.FORMATLINE.UPDATELOOKS 105892 . -112073) (\TEDIT.FORMATLINE.LASTLEGAL 112075 . 115525) (\TEDIT.LINES.ABOVE 115527 . 119138) ( -\TEDIT.CHNO.TO.YTOP 119140 . 119760)) (120039 140619 (\TEDIT.DISPLAYLINE 120049 . 132559) ( -\TEDIT.DISPLAYLINE.TABS 132561 . 135365) (\TEDIT.LINECACHE 135367 . 136095) (\TEDIT.CREATE.LINECACHE -136097 . 136933) (\TEDIT.BLTCHAR 136935 . 139562) (\TEDIT.DIACRITIC.SHIFT 139564 . 140617)) (141234 -186304 (\TEDIT.BACKFORMAT 141244 . 143798) (\TEDIT.PREVIOUS.LINEBREAK 143800 . 146603) ( -\TEDIT.UPDATE.LINES 146605 . 152320) (\TEDIT.PANE.CREATELINES 152322 . 154612) ( -\TEDIT.SUFFIXLINE.CREATE 154614 . 156229) (\TEDIT.LINES.BELOW 156231 . 160841) (\TEDIT.MEASURED.LINES -160843 . 162852) (\TEDIT.VALID.LASTCHNOS 162854 . 166630) (\TEDIT.VALID.NEXTCHNOS 166632 . 170106) ( -\TEDIT.LASTVALIDLINE 170108 . 174779) (\TEDIT.NEXTVALIDLINE 174781 . 177751) ( -\TEDIT.CLEARPANE.BELOW.LINE 177753 . 179859) (\TEDIT.INSERTLINE 179861 . 181247) (\TEDIT.LINE.BOTTOM -181249 . 184479) (\TEDIT.SHOW.AT.BOTTOMP 184481 . 185591) (\TEDIT.SHOW.AT.TOPP 185593 . 186302))))) + (FILEMAP (NIL (26200 28416 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 26210 . 28414)) (35870 119502 ( +\TEDIT.FORMATLINE 35880 . 70986) (\TEDIT.FORMATLINE.SETUP.PARA 70988 . 76182) ( +\TEDIT.FORMATLINE.HORIZONTAL 76184 . 81001) (\TEDIT.FORMATLINE.VERTICAL 81003 . 83454) ( +\TEDIT.FORMATLINE.JUSTIFY 83456 . 89477) (\TEDIT.FORMATLINE.TABS 89479 . 97507) (\TEDIT.SCALE.TABS +97509 . 98300) (\TEDIT.FORMATLINE.PURGE.SPACES 98302 . 99729) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN +99731 . 100808) (\TEDIT.FORMATLINE.EMPTY 100810 . 105630) (\TEDIT.FORMATLINE.UPDATELOOKS 105632 . +111813) (\TEDIT.FORMATLINE.LASTLEGAL 111815 . 115265) (\TEDIT.LINES.ABOVE 115267 . 118878) ( +\TEDIT.CHNO.TO.YTOP 118880 . 119500)) (119779 140359 (\TEDIT.DISPLAYLINE 119789 . 132299) ( +\TEDIT.DISPLAYLINE.TABS 132301 . 135105) (\TEDIT.LINECACHE 135107 . 135835) (\TEDIT.CREATE.LINECACHE +135837 . 136673) (\TEDIT.BLTCHAR 136675 . 139302) (\TEDIT.DIACRITIC.SHIFT 139304 . 140357)) (140974 +186635 (\TEDIT.BACKFORMAT 140984 . 143538) (\TEDIT.PREVIOUS.LINEBREAK 143540 . 146343) ( +\TEDIT.UPDATE.LINES 146345 . 152651) (\TEDIT.PANE.CREATELINES 152653 . 154943) ( +\TEDIT.SUFFIXLINE.CREATE 154945 . 156560) (\TEDIT.LINES.BELOW 156562 . 161172) (\TEDIT.MEASURED.LINES +161174 . 163183) (\TEDIT.VALID.LASTCHNOS 163185 . 166961) (\TEDIT.VALID.NEXTCHNOS 166963 . 170437) ( +\TEDIT.LASTVALIDLINE 170439 . 175110) (\TEDIT.NEXTVALIDLINE 175112 . 178082) ( +\TEDIT.CLEARPANE.BELOW.LINE 178084 . 180190) (\TEDIT.INSERTLINE 180192 . 181578) (\TEDIT.LINE.BOTTOM +181580 . 184810) (\TEDIT.SHOW.AT.BOTTOMP 184812 . 185922) (\TEDIT.SHOW.AT.TOPP 185924 . 186633))))) STOP diff --git a/library/tedit/TEDIT-SCREEN.LCOM b/library/tedit/TEDIT-SCREEN.LCOM index 904473e7..5181485e 100644 Binary files a/library/tedit/TEDIT-SCREEN.LCOM and b/library/tedit/TEDIT-SCREEN.LCOM differ diff --git a/library/tedit/TEDIT-WINDOW b/library/tedit/TEDIT-WINDOW index f1dfb7d3..00ea577e 100644 --- a/library/tedit/TEDIT-WINDOW +++ b/library/tedit/TEDIT-WINDOW @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 5-Oct-2025 10:56:19" {WMEDLEY}TEDIT>TEDIT-WINDOW.;867 229880 +(FILECREATED "15-Nov-2025 01:27:38" {WMEDLEY}TEDIT>TEDIT-WINDOW.;881 231034 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.SPLITW) + :CHANGES-TO (FNS \TEDIT.WINDOW.CREATE) - :PREVIOUS-DATE "18-Sep-2025 23:09:24" {WMEDLEY}TEDIT>TEDIT-WINDOW.;864) + :PREVIOUS-DATE "25-Oct-2025 10:33:08" {WMEDLEY}TEDIT>TEDIT-WINDOW.;878) (PRETTYCOMPRINT TEDIT-WINDOWCOMS) @@ -354,25 +354,20 @@ (DEFINEQ (\TEDIT.WINDOW.CREATE - [LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 21-Jul-2025 11:55 by rmk") + [LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 15-Nov-2025 01:27 by rmk") + (* ; "Edited 23-Oct-2025 18:22 by rmk") + (* ; "Edited 21-Jul-2025 11:55 by rmk") (* ; "Edited 9-May-2025 12:11 by rmk") (* ; "Edited 25-Apr-2025 21:24 by rmk") - (* ; "Edited 20-Apr-2025 15:21 by rmk") (* ; "Edited 18-Feb-2025 09:49 by rmk") (* ; "Edited 1-Jul-2024 22:55 by rmk") - (* ; "Edited 29-Jun-2024 23:16 by rmk") (* ; "Edited 5-May-2024 21:54 by rmk") (* ; "Edited 20-Mar-2024 09:57 by rmk") (* ; "Edited 14-Jan-2024 22:13 by rmk") (* ; "Edited 18-Dec-2023 23:01 by rmk") (* ; "Edited 25-Nov-2023 10:37 by rmk") (* ; "Edited 23-Oct-2023 22:11 by rmk") - (* ; "Edited 21-Oct-2023 12:20 by rmk") - (* ; "Edited 18-Oct-2023 09:56 by rmk") - (* ; "Edited 1-Jan-2022 23:54 by rmk") - (* ; "Edited 30-Dec-2021 23:00 by rmk") - (* ; "Edited 29-Dec-2021 16:35 by rmk") - (* ; "Edited 24-Dec-2021 19:21 by rmk") + (* ; "Edited 1-Jan-2022 23:54 by rmk") (* jds "23-May-85 15:19") (* ; "Edited 27-Oct-2021 12:25 by rmk:") @@ -383,24 +378,26 @@ (LET ((TEXTOBJ (FTEXTOBJ TSTREAM)) (PHEIGHT 0) - TITLE REGIONTYPE PROMPTPROP REGION FILE PWINDOW PREPROMPT WTEXTOBJ) + REGIONTYPE PROMPTPROP REGION FILE PWINDOW PREPROMPT) + (SETQ FILE (GETTOBJ TEXTOBJ TXTFILE)) (CL:WHEN (WINDOWP WINDOW) (CL:WHEN (GETTSTR (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW) TEXTOBJ) - (* ;; " %"Reusing an existing Tedit window, kill the old process, undo its splits and restore its shape.%" ") + (* ;; " %"Reusing an existing Tedit window, kill the old process, undo its splits and restore its shape. Make sure it has a title%" ") (TEDIT.KILL WINDOW) (\TEDIT.CLOSESPLITS (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW) T)) - [SETQ TITLE (OR (LISTGET PROPS 'TITLE) - (WINDOWPROP WINDOW 'TITLE]) + + (* ;; "Every tedit window has a title bar, maybe one that it had already?") + + (WINDOWPROP WINDOW 'TITLE (OR (LISTGET PROPS 'TITLE) + (WINDOWPROP WINDOW 'TITLE) + (\TEDIT.DEFAULT.TITLE FILE PROPS)))) (SETQ REGIONTYPE (OR (GETTEXTPROP TEXTOBJ 'REGION-TYPE) (AND (LITATOM WINDOW) WINDOW))) - (SETQ FILE (GETTOBJ TEXTOBJ TXTFILE)) - (CL:UNLESS TITLE - (SETQ TITLE (\TEDIT.DEFAULT.TITLE FILE PROPS))) (SETQ PROMPTPROP (GETTEXTPROP TEXTOBJ 'PROMPTWINDOW)) (* ;; "All this prompt-height calculation would be unnecessary if the attachment in GETPROMPTWINDOW does the proper shrinking of the main window.") @@ -420,7 +417,6 @@ (SETQ REGION (if (REGIONP WINDOW) then (PROG1 (COPY WINDOW) (SETQ WINDOW NIL)) - elseif (GRAB-TYPED-REGION REGIONTYPE) else (SETQ REGION (\TEDIT.WINDOW.GETREGION TSTREAM REGIONTYPE PHEIGHT)) (* ; "We don't want the default to keep shrinking") @@ -428,7 +424,8 @@ REGION)) (add (fetch (REGION HEIGHT) of REGION) (IMINUS PHEIGHT)) - (SETQ WINDOW (CREATEW REGION TITLE NIL NIL PROPS)) + (SETQ WINDOW (CREATEW REGION (\TEDIT.DEFAULT.TITLE FILE PROPS) + NIL NIL PROPS)) (* ;; "If we grabbed a typed-region, (maybe just a Tedit region by default. We stash it back onto the window so it will be remembered for next time.") @@ -458,60 +455,95 @@ (FSETTOBJ TEXTOBJ PRIMARYPANE (\TEDIT.MINIMAL.WINDOW.SETUP WINDOW TSTREAM PROPS)) (* ; "This should be PANE") - (WINDOWPROP WINDOW 'TITLE TITLE) WINDOW]) (\TEDIT.WINDOW.GETREGION - [LAMBDA (TSTREAM REGIONTYPE PHEIGHT) (* ; "Edited 14-Apr-2025 00:05 by rmk") + [LAMBDA (TSTREAM REGIONTYPE PHEIGHT) (* ; "Edited 25-Oct-2025 10:27 by rmk") + (* ; "Edited 19-Oct-2025 01:05 by rmk") + (* ; "Edited 14-Apr-2025 00:05 by rmk") (* ; "Edited 31-Mar-2025 22:43 by rmk") (* ; "Edited 24-Mar-2025 11:29 by rmk") (* ; "Edited 18-Mar-2025 21:52 by rmk") (* ; "Edited 19-Feb-2025 16:48 by rmk") (* ; "Edited 18-Feb-2025 10:09 by rmk") (LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + [WIDTHOVERHEAD (IPLUS \TEDIT.LINEREGION.WIDTH (TIMES 2 WBorder) + (if (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE) + then 0 + elseif (ILEQ \TEDIT.OP.WIDTH 0) + then + (* ;; "On both sides, for symmetry") + + \TEDIT.LINEREGION.WIDTH + else + (* ;; + "36 to allow for some spacing between the text and the OPS area on the right.") + + (IPLUS \TEDIT.OP.WIDTH 36] + [HEIGHTOVERHEAD (IPLUS PHEIGHT (ADD1 (TIMES 2 WBorder)) + (FONTPROP WindowTitleDisplayStream 'HEIGHT] WIDTH HEIGHT) - (CLRPROMPT) (* ; "System promptwindow") - (printout PROMPTWINDOW "Please specify a " (OR REGIONTYPE "Tedit") - " window region") - (CL:WHEN (TXTFILE TSTREAM) - (printout PROMPTWINDOW " for " 2 (GETTEXTPROP TSTREAM 'FILENAME))) - (TERPRI PROMPTWINDOW) - (if (IGREATERP (TEXTLEN TEXTOBJ) - 0) - then - (* ;; "Explict user properties covers content") - [SETQ WIDTH (OR (GETTEXTPROP TEXTOBJ 'OPENWIDTH) - (for PARALOOKS in (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST) - largest (GETPLOOKS PARALOOKS RIGHTMAR) - finally (CL:UNLESS (AND $$EXTREME (IGREATERP $$EXTREME 0)) - (SETQ $$EXTREME (TIMES 6 PTSPERINCH))) - (RETURN $$EXTREME] + (* ;; "Explict properties cover content") - (* ;; "Allow for extra stuff. 36 to allow for some spacing.") + [SETQ WIDTH (OR (GETTEXTPROP TEXTOBJ 'OPENWIDTH) + (for PARALOOKS in (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST) + when (IGREATERP (GETPLOOKS PARALOOKS RIGHTMAR) + 0) largest (GETPLOOKS PARALOOKS RIGHTMAR) + finally (RETURN $$EXTREME] + (SETQ HEIGHT (GETTEXTPROP TEXTOBJ 'OPENHEIGHT)) - [add WIDTH (IPLUS \TEDIT.LINEREGION.WIDTH (ADD1 (TIMES 2 WBorder) - 1) - (CL:IF (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE) - 0 - (CL:IF (EQ 0 \TEDIT.OP.WIDTH) - \TEDIT.LINEREGION.WIDTH - (IPLUS \TEDIT.OP.WIDTH 36)))] - [SETQ HEIGHT (if (GETTEXTPROP TEXTOBJ 'OPENHEIGHT) - elseif (ZEROP (TEXTLEN TEXTOBJ)) - then 50 - else (for I L (TEXTLEN _ (TEXTLEN TEXTOBJ)) - (CHNO _ 1) from 1 to 20 while (ILEQ CHNO TEXTLEN) - sum (SETQ L (\TEDIT.FORMATLINE TSTREAM CHNO)) - (SETQ CHNO (FGETLD L LCHARLIM)) - (FGETLD L LHEIGHT) - finally (RETURN (IPLUS $$VAL PHEIGHT (ADD1 (TIMES 2 WBorder) - ) - (FONTPROP WindowTitleDisplayStream - 'HEIGHT] - (GETBOXREGION WIDTH HEIGHT) - else (GETREGION (IMAX 200 (ADD1 (TIMES 2 WBorder))) - (IMAX 100 (ADD1 (TIMES 2 WBorder]) + (* ;; "If still no WIDTH or HEIGHT, look at the first 20 lines") + + (CL:UNLESS (AND HEIGHT WIDTH) + (for I L (TEXTLEN _ (TEXTLEN TEXTOBJ)) + (REG _ (CREATEREGION 0 0 (IDIFFERENCE SCREENWIDTH WIDTHOVERHEAD) + (IDIFFERENCE SCREENHEIGHT HEIGHTOVERHEAD))) + (W _ 0) + (H _ 0) + (CHNO _ 1) from 1 to 20 while (ILEQ CHNO TEXTLEN) + do + (* ;; + "But we start by saying that the right margin is infinite, so we can find the true width") + + (SETQ L (\TEDIT.FORMATLINE TSTREAM CHNO NIL REG)) + (SETQ CHNO (FGETLD L LCHARLIM)) + (add H (FGETLD L LHEIGHT)) + (CL:UNLESS WIDTH + (CL:WHEN (EQ 'LEFT (FGETPLOOKS (FGETLD L LPARALOOKS) + QUAD)) + + (* ;; + "JUSTIFIED, RIGHT and CENTERED involve right margin, which we don't know") + + (SETQ W (IMAX W (FGETLD L LXLIM))))) + finally (CL:UNLESS (OR WIDTH (EQ W 0)) (* ; "Maybe no lefts?") + (SETQ WIDTH W)) + (CL:UNLESS (OR HEIGHT (EQ H 0)) + (SETQ HEIGHT H)))) + + (* ;; "Minimum sizes") + + (SETQ WIDTH (IMAX 200 (OR WIDTH 0))) + (SETQ HEIGHT (IMAX 100 (OR HEIGHT 0))) + + (* ;; "Allow for the extra stuff") + + (add WIDTH WIDTHOVERHEAD) + (add HEIGHT HEIGHTOVERHEAD) + (if (GRAB-TYPED-REGION REGIONTYPE WIDTH HEIGHT 1.1) + else + (* ;; "Maximum new sizes") + + [SETQ WIDTH (IMIN WIDTH (FIXR (FTIMES SCREENWIDTH 0.9] + [SETQ HEIGHT (IMIN HEIGHT (FIXR (FTIMES SCREENHEIGHT 0.9] + (CLRPROMPT) (* ; "System promptwindow") + (printout PROMPTWINDOW "Please specify a " (OR REGIONTYPE "Tedit") + " region") + (CL:WHEN (TXTFILE TSTREAM) + (printout PROMPTWINDOW " for " 2 (GETTEXTPROP TSTREAM 'FILENAME))) + (TERPRI PROMPTWINDOW) + (GETBOXREGION WIDTH HEIGHT]) (\TEDIT.WINDOW.SETUP [LAMBDA (PANE TSTREAM PROPS AFTERPANE LCHAR1) (* ; "Edited 6-May-2025 11:44 by rmk") @@ -576,7 +608,8 @@ (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ PANE]) (\TEDIT.MINIMAL.WINDOW.SETUP - [LAMBDA (PANEWINDOW TSTREAM PROPS) (* ; "Edited 20-Apr-2025 15:19 by rmk") + [LAMBDA (PANEWINDOW TSTREAM PROPS) (* ; "Edited 19-Oct-2025 14:55 by rmk") + (* ; "Edited 20-Apr-2025 15:19 by rmk") (* ; "Edited 30-Nov-2024 13:32 by rmk") (* ; "Edited 4-Nov-2024 19:46 by rmk") (* ; "Edited 26-Oct-2024 11:10 by rmk") @@ -677,6 +710,11 @@ (WINDOWADDPROP PANEWINDOW 'CLOSEFN (FUNCTION TEDIT.DEACTIVATE.WINDOW) T) + + (* ;; "Possible the only WINDOWPROPS client is the MARGINBAR in the paragraph menu") + + (for PTAIL on (GETTEXTPROP TSTREAM 'WINDOWPROPS) do (WINDOWPROP PANEWINDOW (CAR PTAIL) + (CADR PTAIL))) PANEWINDOW]) (\TEDIT.CLEARPANE @@ -3624,36 +3662,36 @@ (RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (17093 17989 (TEDIT.DEFER.UPDATES 17103 . 17987)) (17990 43935 (\TEDIT.WINDOW.CREATE -18000 . 25330) (\TEDIT.WINDOW.GETREGION 25332 . 28822) (\TEDIT.WINDOW.SETUP 28824 . 33154) ( -\TEDIT.MINIMAL.WINDOW.SETUP 33156 . 40567) (\TEDIT.CLEARPANE 40569 . 41286) (\TEDIT.FILL.PANES 41288 - . 43933)) (43936 67637 (\TEDIT.CURSORMOVEDFN 43946 . 49556) (\TEDIT.CURSOROUTFN 49558 . 50246) ( -\TEDIT.ACTIVE.WINDOWP 50248 . 51318) (\TEDIT.EXPANDFN 51320 . 51883) (\TEDIT.MAINW 51885 . 53165) ( -\TEDIT.MAINSTREAM 53167 . 53501) (\TEDIT.PRIMARYPANE 53503 . 54273) (\TEDIT.PANELIST 54275 . 54771) ( -\TEDIT.NEWREGIONFN 54773 . 57289) (\TEDIT.SET.WINDOW.EXTENT 57291 . 62273) (\TEDIT.SHRINK.ICONCREATE -62275 . 65008) (\TEDIT.SHRINKFN 65010 . 65419) (\TEDIT.PANEREGION 65421 . 67635)) (67669 100715 ( -\TEDIT.BUTTONEVENTFN 67679 . 80652) (\TEDIT.BUTTONEVENTFN.DOOPERATION 80654 . 87917) ( -\TEDIT.BUTTONEVENTFN.GETOPERATION 87919 . 89761) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 89763 . 93433) ( -\TEDIT.BUTTONEVENTFN.INACTIVE 93435 . 95865) (\TEDIT.BUTTONEVENTFN.INTITLE 95867 . 97702) ( -\TEDIT.COPYINSERTFN 97704 . 98836) (\TEDIT.FOREIGN.COPY 98838 . 100713)) (100716 118279 ( -\TEDIT.PANE.SPLIT 100726 . 104674) (\TEDIT.SPLITW 104676 . 112735) (\TEDIT.UNSPLITW 112737 . 116936) ( -\TEDIT.LINKPANES 116938 . 117701) (\TEDIT.UNLINKPANE 117703 . 118277)) (119713 120604 (TEDITWINDOWP -119723 . 120602)) (120641 123744 (TEDIT.GETINPUT 120651 . 123094) (\TEDIT.MAKEFILENAME 123096 . 123742 -)) (123793 131443 (TEDIT.PROMPTWINDOW 123803 . 124117) (TEDIT.PROMPTPRINT 124119 . 126746) ( -TEDIT.PROMPTCLEAR 126748 . 128490) (TEDIT.PROMPTFLASH 128492 . 129750) (\TEDIT.PROMPT.PAGEFULLFN -129752 . 131441)) (131681 142259 (\TEDIT.FILENAME 131691 . 132463) (\TEDIT.DEFAULT.TITLE 132465 . -134844) (\TEDIT.WINDOW.TITLE 134846 . 137015) (\TEDIT.LIKELY.FILENAME 137017 . 139741) ( -\TEDIT.UPDATE.TITLE 139743 . 142257)) (142302 154786 (TEDIT.DEACTIVATE.WINDOW 142312 . 147885) ( -\TEDIT.RESHAPEFN 147887 . 149972) (\TEDIT.REPAINTFN 149974 . 150198) (\TEDIT.CLOSESPLITS 150200 . -152645) (\TEDIT.CLOSEPANE 152647 . 154784)) (154787 197586 (\TEDIT.SCROLLFN 154797 . 157028) ( -\TEDIT.SCROLLCH.TOP 157030 . 159141) (\TEDIT.SCROLLCH.BOTTOM 159143 . 163473) (\TEDIT.SCROLLUP 163475 - . 169201) (\TEDIT.TOPLINE.YTOP 169203 . 170872) (\TEDIT.SCROLLDOWN 170874 . 177913) ( -\TEDIT.SCROLL.CARET 177915 . 180753) (\TEDIT.VISIBLECARETP 180755 . 183049) (\TEDIT.VISIBLECHARP -183051 . 184142) (\TEDIT.BITMAPLINES 184144 . 188064) (\TEDIT.SETPANE.TOPLINE 188066 . 188678) ( -\TEDIT.SHIFTLINES 188680 . 197584)) (197587 208456 (\TEDIT.ONSCREEN? 197597 . 202148) ( -\TEDIT.ONSCREEN.REGION 202150 . 205801) (\TEDIT.AFTERMOVEFN 205803 . 206700) (OFFSCREENP 206702 . -208454)) (208498 211312 (\TEDIT.PROCIDLEFN 208508 . 210168) (\TEDIT.PROCENTRYFN 210170 . 210615) ( -\TEDIT.PROCEXITFN 210617 . 211310)) (211391 224616 (\TEDIT.DOWNCARET 211401 . 212194) ( -\TEDIT.FLASHCARET 212196 . 214307) (\TEDIT.UPCARET 214309 . 215413) (TEDIT.NORMALIZECARET 215415 . -218633) (\TEDIT.SETCARET 218635 . 223986) (\TEDIT.CARET 223988 . 224614))))) + (FILEMAP (NIL (17100 17996 (TEDIT.DEFER.UPDATES 17110 . 17994)) (17997 45089 (\TEDIT.WINDOW.CREATE +18007 . 24870) (\TEDIT.WINDOW.GETREGION 24872 . 29576) (\TEDIT.WINDOW.SETUP 29578 . 33908) ( +\TEDIT.MINIMAL.WINDOW.SETUP 33910 . 41721) (\TEDIT.CLEARPANE 41723 . 42440) (\TEDIT.FILL.PANES 42442 + . 45087)) (45090 68791 (\TEDIT.CURSORMOVEDFN 45100 . 50710) (\TEDIT.CURSOROUTFN 50712 . 51400) ( +\TEDIT.ACTIVE.WINDOWP 51402 . 52472) (\TEDIT.EXPANDFN 52474 . 53037) (\TEDIT.MAINW 53039 . 54319) ( +\TEDIT.MAINSTREAM 54321 . 54655) (\TEDIT.PRIMARYPANE 54657 . 55427) (\TEDIT.PANELIST 55429 . 55925) ( +\TEDIT.NEWREGIONFN 55927 . 58443) (\TEDIT.SET.WINDOW.EXTENT 58445 . 63427) (\TEDIT.SHRINK.ICONCREATE +63429 . 66162) (\TEDIT.SHRINKFN 66164 . 66573) (\TEDIT.PANEREGION 66575 . 68789)) (68823 101869 ( +\TEDIT.BUTTONEVENTFN 68833 . 81806) (\TEDIT.BUTTONEVENTFN.DOOPERATION 81808 . 89071) ( +\TEDIT.BUTTONEVENTFN.GETOPERATION 89073 . 90915) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 90917 . 94587) ( +\TEDIT.BUTTONEVENTFN.INACTIVE 94589 . 97019) (\TEDIT.BUTTONEVENTFN.INTITLE 97021 . 98856) ( +\TEDIT.COPYINSERTFN 98858 . 99990) (\TEDIT.FOREIGN.COPY 99992 . 101867)) (101870 119433 ( +\TEDIT.PANE.SPLIT 101880 . 105828) (\TEDIT.SPLITW 105830 . 113889) (\TEDIT.UNSPLITW 113891 . 118090) ( +\TEDIT.LINKPANES 118092 . 118855) (\TEDIT.UNLINKPANE 118857 . 119431)) (120867 121758 (TEDITWINDOWP +120877 . 121756)) (121795 124898 (TEDIT.GETINPUT 121805 . 124248) (\TEDIT.MAKEFILENAME 124250 . 124896 +)) (124947 132597 (TEDIT.PROMPTWINDOW 124957 . 125271) (TEDIT.PROMPTPRINT 125273 . 127900) ( +TEDIT.PROMPTCLEAR 127902 . 129644) (TEDIT.PROMPTFLASH 129646 . 130904) (\TEDIT.PROMPT.PAGEFULLFN +130906 . 132595)) (132835 143413 (\TEDIT.FILENAME 132845 . 133617) (\TEDIT.DEFAULT.TITLE 133619 . +135998) (\TEDIT.WINDOW.TITLE 136000 . 138169) (\TEDIT.LIKELY.FILENAME 138171 . 140895) ( +\TEDIT.UPDATE.TITLE 140897 . 143411)) (143456 155940 (TEDIT.DEACTIVATE.WINDOW 143466 . 149039) ( +\TEDIT.RESHAPEFN 149041 . 151126) (\TEDIT.REPAINTFN 151128 . 151352) (\TEDIT.CLOSESPLITS 151354 . +153799) (\TEDIT.CLOSEPANE 153801 . 155938)) (155941 198740 (\TEDIT.SCROLLFN 155951 . 158182) ( +\TEDIT.SCROLLCH.TOP 158184 . 160295) (\TEDIT.SCROLLCH.BOTTOM 160297 . 164627) (\TEDIT.SCROLLUP 164629 + . 170355) (\TEDIT.TOPLINE.YTOP 170357 . 172026) (\TEDIT.SCROLLDOWN 172028 . 179067) ( +\TEDIT.SCROLL.CARET 179069 . 181907) (\TEDIT.VISIBLECARETP 181909 . 184203) (\TEDIT.VISIBLECHARP +184205 . 185296) (\TEDIT.BITMAPLINES 185298 . 189218) (\TEDIT.SETPANE.TOPLINE 189220 . 189832) ( +\TEDIT.SHIFTLINES 189834 . 198738)) (198741 209610 (\TEDIT.ONSCREEN? 198751 . 203302) ( +\TEDIT.ONSCREEN.REGION 203304 . 206955) (\TEDIT.AFTERMOVEFN 206957 . 207854) (OFFSCREENP 207856 . +209608)) (209652 212466 (\TEDIT.PROCIDLEFN 209662 . 211322) (\TEDIT.PROCENTRYFN 211324 . 211769) ( +\TEDIT.PROCEXITFN 211771 . 212464)) (212545 225770 (\TEDIT.DOWNCARET 212555 . 213348) ( +\TEDIT.FLASHCARET 213350 . 215461) (\TEDIT.UPCARET 215463 . 216567) (TEDIT.NORMALIZECARET 216569 . +219787) (\TEDIT.SETCARET 219789 . 225140) (\TEDIT.CARET 225142 . 225768))))) STOP diff --git a/library/tedit/TEDIT-WINDOW.LCOM b/library/tedit/TEDIT-WINDOW.LCOM index e1030af5..4b6b6bdf 100644 Binary files a/library/tedit/TEDIT-WINDOW.LCOM and b/library/tedit/TEDIT-WINDOW.LCOM differ diff --git a/library/tedit/TEDIT.LCOM b/library/tedit/TEDIT.LCOM index 3f9c88b3..bcfdf700 100644 Binary files a/library/tedit/TEDIT.LCOM and b/library/tedit/TEDIT.LCOM differ diff --git a/library/virtualkeyboards/DANDELIONKEYBOARDS b/library/virtualkeyboards/DANDELIONKEYBOARDS index e958d19c..4834b7da 100644 --- a/library/virtualkeyboards/DANDELIONKEYBOARDS +++ b/library/virtualkeyboards/DANDELIONKEYBOARDS @@ -1,12 +1,10 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 6-Jul-2023 08:52:09" {WMEDLEY}virtualkeyboards>DANDELIONKEYBOARDS.;3 33795 +(FILECREATED "15-Oct-2025 16:50:39" {WMEDLEY}virtualkeyboards>DANDELIONKEYBOARDS.;4 33748 :EDIT-BY rmk - :CHANGES-TO (VARS DANDELIONKEYBOARDSCOMS) - - :PREVIOUS-DATE " 4-Jul-2023 23:18:05" {WMEDLEY}virtualkeyboards>DANDELIONKEYBOARDS.;2 + :PREVIOUS-DATE " 6-Jul-2023 08:52:09" {WMEDLEY}virtualkeyboards>DANDELIONKEYBOARDS.;3 ) @@ -324,7 +322,7 @@ (135 (9850 9818 LOCKSHIFT)) (137 (9841 9809 LOCKSHIFT)) (138 (106 74 LOCKSHIFT)) - (139 (9826 66 LOCKSHIFT)) + (139 (9826 9794 LOCKSHIFT)) (140 (9833 9801 LOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) (142 (46 62 NOLOCKSHIFT)) diff --git a/library/virtualkeyboards/XKEYBOARDS b/library/virtualkeyboards/XKEYBOARDS index 8442d293..a035c92a 100644 Binary files a/library/virtualkeyboards/XKEYBOARDS and b/library/virtualkeyboards/XKEYBOARDS differ diff --git a/lispusers/COMPAREDIRECTORIES b/lispusers/COMPAREDIRECTORIES index 57e7feea..2531735b 100644 --- a/lispusers/COMPAREDIRECTORIES +++ b/lispusers/COMPAREDIRECTORIES @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "24-Aug-2025 13:38:35" {WMEDLEY}COMPAREDIRECTORIES.;268 133743 +(FILECREATED " 8-Nov-2025 13:07:39" {WMEDLEY}COMPAREDIRECTORIES.;285 138536 :EDIT-BY rmk - :CHANGES-TO (FNS CDENTRIES.SELECT CDPRINT.LINE) + :CHANGES-TO (FNS CD-MENUFN CDBROWSER-COPY) - :PREVIOUS-DATE "26-Mar-2025 09:41:31" {WMEDLEY}COMPAREDIRECTORIES.;267) + :PREVIOUS-DATE "28-Oct-2025 14:52:05" {WMEDLEY}COMPAREDIRECTORIES.;280) (PRETTYCOMPRINT COMPAREDIRECTORIESCOMS) @@ -160,6 +160,8 @@ (COMPAREDIRECTORIES.INFOS [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH USEDIRECTORYDATE INCLUDEAUTHOR) + (* ;; "Edited 21-Oct-2025 14:26 by rmk") + (* ;; "Edited 29-Sep-2023 17:25 by rmk") (* ;; "Edited 22-May-2022 14:17 by rmk") @@ -168,43 +170,45 @@ (* ;; "Each entry is a list of the form (matchname . CDINFOS). CDINFOS is guaranteed to be a singleton, unless ALLVERSIONS. ") - (FOR FULLNAME TYPE LDATE STREAM (STARTPOS _ (ADD1 (NCHARS DIR))) - IN (CDFILES DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH) - COLLECT + (CL:WHEN (DIRECTORYNAMEP DIR) + [FOR FULLNAME TYPE LDATE STREAM (STARTPOS _ (ADD1 (NCHARS DIR))) + IN (CDFILES DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH) + COLLECT - (* ;; "GDATE/IDATE in case Y2K") + (* ;; "GDATE/IDATE in case Y2K") - (SETQ STREAM (OPENSTREAM FULLNAME 'INPUT)) (* ; + (SETQ STREAM (OPENSTREAM FULLNAME 'INPUT)) (* ; "So all the GETFILEINFO's, FILEDATES, etc. don't have to do the directory searching.") (* ; "Is it a Lisp file? Get it's internal filecreated date. ") - (CL:MULTIPLE-VALUE-SETQ (TYPE LDATE) - (COMPAREDIRECTORIES.INFOS.TYPE STREAM)) - (PROG1 (LIST (MATCHNAME FULLNAME STARTPOS) - (CREATE CDINFO - FULLNAME _ (FULLNAME STREAM) - DATE _ (GDATE (IDATE (IF (OR USEDIRECTORYDATE (NULL LDATE)) - THEN (GETFILEINFO STREAM 'CREATIONDATE) - ELSE (SETFILEINFO STREAM 'CREATIONDATE LDATE) - LDATE))) - LENGTH _ (GETFILEINFO STREAM 'LENGTH) - AUTHOR _ (AND INCLUDEAUTHOR (GETFILEINFO STREAM 'AUTHOR)) - TYPE _ TYPE - EOL _ (EOLTYPE STREAM))) - (CLOSEF? STREAM)) - FINALLY + (CL:MULTIPLE-VALUE-SETQ (TYPE LDATE) + (COMPAREDIRECTORIES.INFOS.TYPE STREAM)) + (PROG1 (LIST (MATCHNAME FULLNAME STARTPOS) + (CREATE CDINFO + FULLNAME _ (FULLNAME STREAM) + DATE _ (GDATE (IDATE (IF (OR USEDIRECTORYDATE (NULL LDATE)) + THEN (GETFILEINFO STREAM 'CREATIONDATE) + ELSE (SETFILEINFO STREAM 'CREATIONDATE + LDATE) + LDATE))) + LENGTH _ (GETFILEINFO STREAM 'LENGTH) + AUTHOR _ (AND INCLUDEAUTHOR (GETFILEINFO STREAM 'AUTHOR)) + TYPE _ TYPE + EOL _ (EOLTYPE STREAM))) + (CLOSEF? STREAM)) + FINALLY - (* ;; "Sort to get all entries with the same matchname adjacent. Presumably we would only need to collect multiples if ALLVERSIONS, but in a case-sensitive file system we might see files with names that differ in case. We have deliberately given them a case-insensitive matchname, so we can expose this issue in the display.") + (* ;; "Sort to get all entries with the same matchname adjacent. Presumably we would only need to collect multiples if ALLVERSIONS, but in a case-sensitive file system we might see files with names that differ in case. We have deliberately given them a case-insensitive matchname, so we can expose this issue in the display.") - (* ;; "If we see (MN X)(MN Y), smash the Y in after the X") + (* ;; "If we see (MN X)(MN Y), smash the Y in after the X") - (RETURN (FOR ITAIL I VAL MN ON (SORT $$VAL T) - DO (SETQ I (CAR ITAIL)) - (SETQ MN (CAR I)) - [WHILE (EQ MN (CAADR ITAIL)) DO (POP ITAIL) - (PUSH (CDR I) - (CADR (CAR ITAIL] - (PUSH VAL I) FINALLY (RETURN (DREVERSE VAL]) + (RETURN (FOR ITAIL I VAL MN ON (SORT $$VAL T) + DO (SETQ I (CAR ITAIL)) + (SETQ MN (CAR I)) + [WHILE (EQ MN (CAADR ITAIL)) DO (POP ITAIL) + (PUSH (CDR I) + (CADR (CAR ITAIL] + (PUSH VAL I) FINALLY (RETURN (DREVERSE VAL])]) (COMPAREDIRECTORIES.CANDIDATES [LAMBDA (INFOS1 INFOS2) @@ -335,7 +339,9 @@ CDE]) (COMPAREDIRECTORIES.INFOS.TYPE - [LAMBDA (FILE) (* ; "Edited 28-Sep-2023 23:09 by rmk") + [LAMBDA (FILE) (* ; "Edited 22-Oct-2025 08:29 by rmk") + (* ; "Edited 20-Sep-2025 12:59 by rmk") + (* ; "Edited 28-Sep-2023 23:09 by rmk") (* ; "Edited 22-May-2022 14:27 by rmk") (* ; "Edited 25-Apr-2022 09:02 by rmk") (* ; "Edited 4-Jan-2022 13:10 by rmk") @@ -404,7 +410,8 @@ (DEFINEQ (CDFILES - [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 17-Jun-2023 23:04 by rmk") + [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 20-Oct-2025 23:25 by rmk") + (* ; "Edited 17-Jun-2023 23:04 by rmk") (* ; "Edited 3-Oct-2022 12:03 by rmk") (* ; "Edited 25-Apr-2022 08:42 by rmk") (* ; "Edited 5-Mar-2022 15:05 by rmk") @@ -426,8 +433,7 @@ (* ;; "EXCLUDEDFILES is a filepattern with * meaning everything, COM means *.LCOM and *.DFASL") - [SETQ EXCLUDEDFILES `(*>.DS_Store - ,@(MKLIST EXCLUDEDFILES] + [SETQ EXCLUDEDFILES `(*>.DS�Store ,@(MKLIST EXCLUDEDFILES] (CL:UNLESS (EQMEMB '.* INCLUDEDFILES) (* ; "Excluded dot files unless specifically asked for") [SETQ EXCLUDEDFILES `(.* ,@(MKLIST EXCLUDEDFILES]) @@ -1701,6 +1707,8 @@ (CDBROWSER [LAMBDA (CDVALUE TITLE COLHEADINGS BROWSERPROPS SEPARATEDIRECTIONS MENUITEMS) + (* ;; "Edited 28-Oct-2025 14:49 by rmk") + (* ;; "Edited 28-Jan-2022 17:01 by rmk: a table browser for the differences in CDVALUE.") (* ;; "Creates a table browser for the differences in CDVALUE.") @@ -1746,7 +1754,7 @@ [SETQ BROWSER (TB.MAKE.BROWSER (FOR PAIR IN STRINGS COLLECT (CD.TABLEITEM PAIR)) WINDOW `(PRINTFN CD.TABLEITEM.PRINTFN COPYFN CD.TABLEITEM.COPYFN USERDATA - ,(APPEND BROWSERPROPS (LIST 'CDVALUE CDVALUE] + (,@BROWSERPROPS (CDVALUE ,@CDVALUE] (ATTACHMENU (CREATE MENU TITLE _ " CD commands " MENUFONT _ DEFAULTFONT @@ -1887,7 +1895,8 @@ 'DON'T]) (CD.COMMANDSELECTEDFN - [LAMBDA (MENUITEM MENU KEY) (* ; "Edited 6-Mar-2022 19:52 by rmk") + [LAMBDA (MENUITEM MENU KEY) (* ; "Edited 28-Oct-2025 14:34 by rmk") + (* ; "Edited 6-Mar-2022 19:52 by rmk") (* ; "Edited 24-Feb-2022 19:52 by rmk") (* ; "Edited 5-Feb-2022 17:23 by rmk") (* ; "Edited 27-Jan-2022 17:46 by rmk") @@ -1938,7 +1947,8 @@ (LABEL1 (OR (CAR LABELS) FILE1)) (LABEL2 (OR (CADR LABELS) - FILE2))) + FILE2)) + TEMP) (DECLARE (SPECVARS . T)) (* ;; @@ -1952,6 +1962,16 @@ OF (FETCH (CDENTRY INFO2) OF CDENTRY))) (SETQ FILE2 NIL)) + (CL:WHEN (SETQ TEMP (SGETMULTI (fetch (TABLEBROWSER + TBUSERDATA) + of CDBROWSER) + 'ORIGINALFILES FILE1)) + (SETQ FILE1 TEMP)) + (CL:WHEN (SETQ TEMP (SGETMULTI (fetch (TABLEBROWSER + TBUSERDATA) + of CDBROWSER) + 'ORIGINALFILES FILE2)) + (SETQ FILE2 TEMP)) (* ;; "If USERDATA contains a LABELFN, then it is applied to the files and the rest of the USERDATA to produce abbreviated labels for titles and headers.") @@ -1963,6 +1983,10 @@ (CD-MENUFN [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) + (* ;; "Edited 8-Nov-2025 13:06 by rmk") + + (* ;; "Edited 28-Oct-2025 17:35 by rmk") + (* ;; "Edited 26-Mar-2025 09:39 by rmk") (* ;; "Edited 18-Feb-2025 23:36 by rmk") @@ -1990,7 +2014,8 @@ (Compare (IF (AND FILE1 FILE2) THEN (CD-COMPARE-FILES FILE1 FILE2 LABEL1 LABEL2 TYPE (WINDOWPROP WINDOW - 'REGION)) + 'REGION) + CDBROWSER) ELSE (FLASHWINDOW T) (PRIN3 "Only one file" T))) (See% left (IF FILE1 @@ -2054,18 +2079,20 @@ NIL)))) (Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT)) (Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT)) - (Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT T)) + (Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM KEY 'LEFT T)) (|Delete ALL <-| - (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL)) - (Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT T)) + (CDBROWSER-DELETE-FILE CDBROWSER TBITEM KEY 'LEFT NIL)) + (Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM KEY 'RIGHT T)) (|Delete ALL ->| - (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL)) + (CDBROWSER-DELETE-FILE CDBROWSER TBITEM KEY 'RIGHT NIL)) (SHOULDNT))) (CLOSEWITH CHILDREN WINDOW) (MOVEWITH CHILDREN WINDOW]) (CD-COMPARE-FILES - [LAMBDA (FILE1 FILE2 LABEL1 LABEL2 TYPE PARENTREGION) (* ; "Edited 22-May-2022 14:41 by rmk") + [LAMBDA (FILE1 FILE2 LABEL1 LABEL2 TYPE PARENTREGION CDBROWSER) + (* ; "Edited 28-Oct-2025 10:42 by rmk") + (* ; "Edited 22-May-2022 14:41 by rmk") (PROG NIL (SETQ FILE1 (OR (STREAMP FILE1) (INFILEP FILE1))) @@ -2088,7 +2115,7 @@ `(,PARENTREGION 0.125) (IPLUS (FETCH (REGION BOTTOM) OF PARENTREGION ) - 20) + 70) NIL)))) (COMPILED (FLASHWINDOW T) (PRIN3 "Cannot compare compiled files" T)) @@ -2117,17 +2144,22 @@ NIL]) (CDBROWSER-COPY - [LAMBDA (CDBROWSER TBITEM SOURCE) (* ; "Edited 24-May-2022 15:49 by rmk") + [LAMBDA (CDBROWSER TBITEM SOURCE UNIXDEST) (* ; "Edited 28-Oct-2025 17:39 by rmk") + (* ; "Edited 25-Oct-2025 23:58 by rmk") + (* ; "Edited 24-May-2022 15:49 by rmk") (* ; "Edited 25-Apr-2022 09:24 by rmk") (* ; "Edited 5-Feb-2022 17:27 by rmk") (* ; "Edited 2-Feb-2022 22:18 by rmk") (* ;; "Copies the file identified as SOURCE (LEFT or RIGHT) in CDENTRY to the other file of the end. If the destination file is missing, it is assumed to be a new/unversioned file of the same name as the source but with the directory prefix switched. CDVALUE needed to know what directory prefixes are involved.") + (* ;; + "if UNIXDEST, coerces the true destination file to host UNIX--suppresses Medley version numbers") + (* ;; "Returns NIL if the copy fails.") (CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM) - (PROG* ((CDVALUE (LISTGET (TB.USERDATA CDBROWSER) + (PROG* ((CDVALUE (GETMULTI (TB.USERDATA CDBROWSER) 'CDVALUE)) (SOURCEDIR (FETCH (CDVALUE CDDIR1) OF CDVALUE)) (DESTDIR (FETCH (CDVALUE CDDIR2) OF CDVALUE)) @@ -2167,7 +2199,19 @@ (CLEARW T) (CL:UNLESS DESTFILE (SETQ DESTFILE (CD-SWAPDIRS SOURCEFILE SOURCEDIR DESTDIR))) - (SETQ RESULT (COPYFILE SOURCEFILE (PACKFILENAME.STRING 'VERSION NIL 'BODY DESTFILE))) + [SETQ RESULT (if UNIXDEST + then (SPUTMULTI (fetch (TABLEBROWSER TBUSERDATA) of CDBROWSER) + 'ORIGINALFILES DESTFILE (COPYFILE DESTFILE '{NODIRCORE)) + [PSEUDOFILENAME (PACKFILENAME 'HOST 'DSK 'BODY + (COPYFILE SOURCEFILE (PACKFILENAME + 'HOST + 'UNIX + 'VERSION NIL + 'BODY + (TRUEFILENAME + DESTFILE] + else (COPYFILE SOURCEFILE (PACKFILENAME.STRING 'VERSION NIL + 'BODY DESTFILE] (PRIN3 (IF RESULT THEN (TB.DELETE.ITEM CDBROWSER TBITEM) (CONCAT "Copied to " RESULT) @@ -2177,7 +2221,8 @@ (RETURN RESULT)))]) (CDBROWSER-DELETE-FILE - [LAMBDA (CDBROWSER TBITEM SIDE ONLYONE SAVE) (* ; "Edited 25-Apr-2022 09:06 by rmk") + [LAMBDA (CDBROWSER TBITEM KEY SIDE ONLYONE SAVE DONTMARK) (* ; "Edited 28-Oct-2025 13:30 by rmk") + (* ; "Edited 25-Apr-2022 09:06 by rmk") (* ; "Edited 5-Feb-2022 17:46 by rmk") (* ; "Edited 18-Jan-2022 23:02 by rmk") (* ; "Edited 19-Dec-2021 23:33 by rmk") @@ -2190,38 +2235,58 @@ (* ;; "If SAVE, then the files are renamed to a deleted directory, not actually expunged, so that they can be restored if needed. The deleted directory is defined by sticking deleted> on the front of FILE's directory.") + (DECLARE (USEDFREE LABEL1 LABEL2 PWINDOW)) (CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM) - [LET ((CDENTRY (CADR (FETCH TIDATA OF TBITEM))) - FILE OTHERFILE) - (SETQ FILE (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO1) OF CDENTRY))) - (SETQ OTHERFILE (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO2) OF CDENTRY))) - (CL:WHEN (EQ SIDE 'RIGHT) - (SWAP FILE OTHERFILE)) - (CL:WHEN FILE - (FOR F INSIDE (IF (FILENAMEFIELD.STRING FILE 'VERSION) - THEN [IF ONLYONE - THEN FILE - ELSE (DREVERSE (FILDIR (PACKFILENAME.STRING 'VERSION "*" - 'BODY FILE] - ELSE FILE) - COLLECT + [LET + ((CDENTRY (CADR (fetch TIDATA of TBITEM))) + FILE OTHERFILE DELFILES) + (SETQ FILE (fetch (CDINFO FULLNAME) of (fetch (CDENTRY INFO1) of CDENTRY))) + (SETQ OTHERFILE (fetch (CDINFO FULLNAME) of (fetch (CDENTRY INFO2) of CDENTRY))) + (CL:WHEN (EQ SIDE 'RIGHT) + (SWAP FILE OTHERFILE) + (SWAP LABEL1 LABEL2)) + (SETQ DELFILES (if (FILENAMEFIELD.STRING FILE 'VERSION) + then [if ONLYONE + then (MKLIST FILE) + else (DREVERSE (FILDIR (PACKFILENAME.STRING 'VERSION "*" + 'BODY FILE] + else FILE)) + (CL:WHEN DELFILES + (GIVE.TTY.PROCESS PWINDOW) + (CLEARW T) + (FLASHWINDOW T) + (CL:WHEN [OR (EQ KEY 'MIDDLE) + (EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete " (CL:IF (CDR DELFILES) + "ALL versions of " + "") + LABEL1 " ? "] + (for F in DELFILES + collect (* ;; "Delete the earlier ones first, if it goes bad, you don't want them to persist. This preserves the original version numbers, maybe it should start fresh from 1 (or from whatever might have been deleted before).") - (IF SAVE - THEN (CL:UNLESS (RENAMEFILE F (PACKFILENAME.STRING - 'DIRECTORY - (CONCAT "deleted>" (FILENAMEFIELD.STRING - F - 'DIRECTORY)) - 'BODY F)) - (ERROR "Could not delete " F)) - ELSE (DELFILE FILE)) - F FINALLY + (* ;; "Save copies locally in this browser, for potential Undelete. Undelete would have to match all of the versions") + + (CL:UNLESS (if SAVE + then (PUTMULTI (fetch (TABLEBROWSER TBUSERDATA) of CDBROWSER + ) + 'ORIGINALFILES + (RENAMEFILE F (PACKFILENAME.STRING + 'DIRECTORY + (CONCAT "deleted>" + (FILENAMEFIELD.STRING + F + 'DIRECTORY)) + 'BODY F))) + else (PUTMULTI (fetch (TABLEBROWSER TBUSERDATA) of CDBROWSER) + 'ORIGINALFILES FILE (COPYFILE FILE '{NODIRCORE})) + (DELFILE FILE)) + (ERROR "Could not delete " F)) + F finally (* ;; "Perhaps only mark it as deleted if both files are gone?") - (TB.DELETE.ITEM CDBROWSER TBITEM)))])]) + (CL:UNLESS DONTMARK (TB.DELETE.ITEM CDBROWSER TBITEM)))))])]) (CD-SWAPDIRS [LAMBDA (FILE FROMDIR TODIR KEEPVERSION) (* ; "Edited 2-Feb-2022 19:10 by rmk") @@ -2238,38 +2303,43 @@ (RPAQ? CD-LINELENGTH NIL) -(RPAQQ CDTABLEBROWSER.MENUITEMS ((Compare CD-MENUFN) - (Copy% -> CD-MENUFN) - (Copy% <- CD-MENUFN) - (See% left CD-MENUFN) - (See% right CD-MENUFN) - (See% both CD-MENUFN) - (See CD-MENUFN))) +(RPAQQ CDTABLEBROWSER.MENUITEMS + ((Compare CD-MENUFN) + (Copy% -> CD-MENUFN) + (Copy% <- CD-MENUFN) + (See% left CD-MENUFN) + (See% right CD-MENUFN) + (See% both CD-MENUFN) + (See CD-MENUFN) + (Delete% <- CD-MENUFN) + (|Delete ALL <-| CD-MENUFN) + (Delete% -> CD-MENUFN) + (|Delete ALL ->| CD-MENUFN))) (FILESLOAD (SYSLOAD) COMPARESOURCES COMPARETEXT) (MOVD? 'NILL 'TEDIT.FILEDATE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2673 23163 (COMPAREDIRECTORIES 2683 . 8018) (COMPAREDIRECTORIES.INFOS 8020 . 10978) ( -COMPAREDIRECTORIES.CANDIDATES 10980 . 14365) (CDENTRIES.SELECT 14367 . 19269) ( -COMPAREDIRECTORIES.INFOS.TYPE 19271 . 20397) (MATCHNAME 20399 . 21079) (CD.INSURECDVALUE 21081 . 22695 -) (CD.UPDATEWIDTHS 22697 . 23161)) (23164 33786 (CDFILES 23174 . 29188) (CDFILES.MATCH 29190 . 30815) -(CDFILES.PATS 30817 . 33784)) (33787 51805 (CDPRINT 33797 . 36314) (CDPRINT.HEADER 36316 . 37213) ( -CDPRINT.LINE 37215 . 40644) (CDPRINT.MAXWIDTHS 40646 . 44761) (CDPRINT.COLHEADERS 44763 . 46048) ( -CDPRINT.COLUMNS 46050 . 51170) (CDTEDIT 51172 . 51803)) (51806 60927 (CDMAP 51816 . 53248) (CDENTRY -53250 . 53559) (CDSUBSET 53561 . 55000) (CDMERGE 55002 . 58986) (CDMERGE.COMMON 58988 . 60303) ( -CD.SORT 60305 . 60925)) (60928 68466 (BINCOMP 60938 . 65227) (EOLTYPE 65229 . 67791) (EOLTYPE.SHOW -67793 . 68464)) (68994 81521 (FIND-UNCOMPILED-FILES 69004 . 72647) (FIND-UNSOURCED-FILES 72649 . 75033 -) (FIND-SOURCE-FILES 75035 . 76773) (FIND-COMPILED-FILES 76775 . 78652) (FIND-UNLOADED-FILES 78654 . -79507) (FIND-LOADED-FILES 79509 . 79937) (FIND-MULTICOMPILED-FILES 79939 . 81519)) (81522 89953 ( -CREATED-AS 81532 . 86329) (SOURCE-FOR-COMPILED-P 86331 . 89258) (COMPILE-SOURCE-DATE-DIFF 89260 . -89951)) (89954 100717 (FIX-DIRECTORY-DATES 89964 . 93414) (FIX-EQUIV-DATES 93416 . 94941) ( -COPY-COMPARED-FILES 94943 . 96764) (COPY-MISSING-FILES 96766 . 98923) (COMPILED-ON-SAME-SOURCE 98925 - . 100715)) (100911 108749 (CDBROWSER 100921 . 104848) (CDBROWSER.STRINGS 104850 . 108747)) (108911 -110647 (CD.TABLEITEM 108921 . 109141) (CD.TABLEITEM.PRINTFN 109143 . 109342) (CD.TABLEITEM.COPYFN -109344 . 110402) (CDTABLEBROWSER.HEADING.REPAINTFN 110404 . 110645)) (110648 133218 ( -CDTABLEBROWSER.WHENSELECTEDFN 110658 . 111126) (CD.COMMANDSELECTEDFN 111128 . 116229) (CD-MENUFN -116231 . 122457) (CD-COMPARE-FILES 122459 . 125811) (CDBROWSER-COPY 125813 . 129482) ( -CDBROWSER-DELETE-FILE 129484 . 132697) (CD-SWAPDIRS 132699 . 133216))))) + (FILEMAP (NIL (2668 23647 (COMPAREDIRECTORIES 2678 . 8013) (COMPAREDIRECTORIES.INFOS 8015 . 11244) ( +COMPAREDIRECTORIES.CANDIDATES 11246 . 14631) (CDENTRIES.SELECT 14633 . 19535) ( +COMPAREDIRECTORIES.INFOS.TYPE 19537 . 20881) (MATCHNAME 20883 . 21563) (CD.INSURECDVALUE 21565 . 23179 +) (CD.UPDATEWIDTHS 23181 . 23645)) (23648 34353 (CDFILES 23658 . 29755) (CDFILES.MATCH 29757 . 31382) +(CDFILES.PATS 31384 . 34351)) (34354 52372 (CDPRINT 34364 . 36881) (CDPRINT.HEADER 36883 . 37780) ( +CDPRINT.LINE 37782 . 41211) (CDPRINT.MAXWIDTHS 41213 . 45328) (CDPRINT.COLHEADERS 45330 . 46615) ( +CDPRINT.COLUMNS 46617 . 51737) (CDTEDIT 51739 . 52370)) (52373 61494 (CDMAP 52383 . 53815) (CDENTRY +53817 . 54126) (CDSUBSET 54128 . 55567) (CDMERGE 55569 . 59553) (CDMERGE.COMMON 59555 . 60870) ( +CD.SORT 60872 . 61492)) (61495 69033 (BINCOMP 61505 . 65794) (EOLTYPE 65796 . 68358) (EOLTYPE.SHOW +68360 . 69031)) (69561 82088 (FIND-UNCOMPILED-FILES 69571 . 73214) (FIND-UNSOURCED-FILES 73216 . 75600 +) (FIND-SOURCE-FILES 75602 . 77340) (FIND-COMPILED-FILES 77342 . 79219) (FIND-UNLOADED-FILES 79221 . +80074) (FIND-LOADED-FILES 80076 . 80504) (FIND-MULTICOMPILED-FILES 80506 . 82086)) (82089 90520 ( +CREATED-AS 82099 . 86896) (SOURCE-FOR-COMPILED-P 86898 . 89825) (COMPILE-SOURCE-DATE-DIFF 89827 . +90518)) (90521 101284 (FIX-DIRECTORY-DATES 90531 . 93981) (FIX-EQUIV-DATES 93983 . 95508) ( +COPY-COMPARED-FILES 95510 . 97331) (COPY-MISSING-FILES 97333 . 99490) (COMPILED-ON-SAME-SOURCE 99492 + . 101282)) (101478 109356 (CDBROWSER 101488 . 105455) (CDBROWSER.STRINGS 105457 . 109354)) (109518 +111254 (CD.TABLEITEM 109528 . 109748) (CD.TABLEITEM.PRINTFN 109750 . 109949) (CD.TABLEITEM.COPYFN +109951 . 111009) (CDTABLEBROWSER.HEADING.REPAINTFN 111011 . 111252)) (111255 138020 ( +CDTABLEBROWSER.WHENSELECTEDFN 111265 . 111733) (CD.COMMANDSELECTEDFN 111735 . 117908) (CD-MENUFN +117910 . 124301) (CD-COMPARE-FILES 124303 . 127830) (CDBROWSER-COPY 127832 . 132894) ( +CDBROWSER-DELETE-FILE 132896 . 137499) (CD-SWAPDIRS 137501 . 138018))))) STOP diff --git a/lispusers/COMPAREDIRECTORIES.LCOM b/lispusers/COMPAREDIRECTORIES.LCOM index 3a75fdb0..7569b398 100644 Binary files a/lispusers/COMPAREDIRECTORIES.LCOM and b/lispusers/COMPAREDIRECTORIES.LCOM differ diff --git a/lispusers/EDITFONT b/lispusers/EDITFONT index 517fc5c3..2bd3628f 100644 --- a/lispusers/EDITFONT +++ b/lispusers/EDITFONT @@ -1,13 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Oct-2025 14:56:00" {WMEDLEY}EDITFONT.;40 26223 +(FILECREATED "12-Oct-2025 17:39:29" {WMEDLEY}EDITFONT.;41 26261 :EDIT-BY rmk :CHANGES-TO (RECORDS CHARITEM) - (FNS EDITFONT) + (FNS EF.SAVE) - :PREVIOUS-DATE " 6-Oct-2025 15:58:41" {WMEDLEY}EDITFONT.;39) + :PREVIOUS-DATE " 7-Oct-2025 14:56:00" {WMEDLEY}EDITFONT.;40) (PRETTYCOMPRINT EDITFONTCOMS) @@ -242,7 +242,8 @@ (T (LISPERROR "ILLEGAL ARG" BITMAP]) (EF.SAVE - [LAMBDA (WINDOW) (* ; "Edited 2-Sep-2025 23:03 by rmk") + [LAMBDA (WINDOW) (* ; "Edited 12-Oct-2025 17:33 by rmk") + (* ; "Edited 2-Sep-2025 23:03 by rmk") (* ; "Edited 29-Aug-2025 11:35 by rmk") (* ; "Edited 4-Aug-2025 09:22 by rmk") (* ; "Edited 2-Aug-2025 08:47 by rmk") @@ -310,8 +311,7 @@ (* ;; "Can this editing change the descent or ascent?") - (\SETCHARSETINFO (fetch (FONTDESCRIPTOR FONTCHARSETVECTOR) of FONT) - CHARSET CSINFO]) + (\SETCHARSETINFO FONT CHARSET CSINFO]) (COPYFONT [LAMBDA (FONT) (* ; "Edited 3-Aug-2025 17:37 by rmk") @@ -494,10 +494,10 @@ (EF.INIT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1147 16865 (EF.INIT 1157 . 1791) (EF.PROMPT 1793 . 2375) (EF.MESSAGE 2377 . 2589) ( -EF.CLOSEFN 2591 . 3118) (EF.CHARITEMS 3120 . 4956) (EF.BUTTONEVENTFN 4958 . 5370) (EF.WHENSELECTEDFN -5372 . 5776) (EF.EDITBM 5778 . 7272) (EF.MIDDLEBUTTONFN 7274 . 7519) (EF.CHANGESIZE 7521 . 8850) ( -EF.DELETE 8852 . 10033) (EF.ENTER 10035 . 10976) (EF.REPLACE 10978 . 11951) (EF.SAVE 11953 . 16157) ( -COPYFONT 16159 . 16434) (READSTRIKEFONTFILE 16436 . 16863)) (16866 26035 (BLANKCHARSETCREATE 16876 . -22961) (EDITFONT 22963 . 26033))))) + (FILEMAP (NIL (1146 16903 (EF.INIT 1156 . 1790) (EF.PROMPT 1792 . 2374) (EF.MESSAGE 2376 . 2588) ( +EF.CLOSEFN 2590 . 3117) (EF.CHARITEMS 3119 . 4955) (EF.BUTTONEVENTFN 4957 . 5369) (EF.WHENSELECTEDFN +5371 . 5775) (EF.EDITBM 5777 . 7271) (EF.MIDDLEBUTTONFN 7273 . 7518) (EF.CHANGESIZE 7520 . 8849) ( +EF.DELETE 8851 . 10032) (EF.ENTER 10034 . 10975) (EF.REPLACE 10977 . 11950) (EF.SAVE 11952 . 16195) ( +COPYFONT 16197 . 16472) (READSTRIKEFONTFILE 16474 . 16901)) (16904 26073 (BLANKCHARSETCREATE 16914 . +22999) (EDITFONT 23001 . 26071))))) STOP diff --git a/lispusers/EDITFONT.LCOM b/lispusers/EDITFONT.LCOM index ce03d863..589ac6dd 100644 Binary files a/lispusers/EDITFONT.LCOM and b/lispusers/EDITFONT.LCOM differ diff --git a/lispusers/EXAMINEDEFS b/lispusers/EXAMINEDEFS index 4b1a111f..5c5ef0f1 100644 --- a/lispusers/EXAMINEDEFS +++ b/lispusers/EXAMINEDEFS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 6-Apr-2025 23:54:50" {WMEDLEY}EXAMINEDEFS.;57 16827 +(FILECREATED "28-Oct-2025 14:24:17" {WMEDLEY}EXAMINEDEFS.;60 17313 :EDIT-BY rmk - :CHANGES-TO (FNS TEDITDEF) + :CHANGES-TO (FNS EXAMINEFILES) - :PREVIOUS-DATE "31-Mar-2025 13:53:38" {WMEDLEY}EXAMINEDEFS.;56) + :PREVIOUS-DATE "25-Oct-2025 10:24:30" {WMEDLEY}EXAMINEDEFS.;59) (PRETTYCOMPRINT EXAMINEDEFSCOMS) @@ -20,7 +20,8 @@ (DEFINEQ (EXAMINEDEFS - [LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 31-Mar-2025 13:53 by rmk") + [LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 25-Oct-2025 10:24 by rmk") + (* ; "Edited 31-Mar-2025 13:53 by rmk") (* ; "Edited 18-Feb-2025 22:56 by rmk") (* ; "Edited 6-Dec-2024 20:51 by rmk") (* ; "Edited 13-Oct-2023 11:11 by rmk") @@ -148,6 +149,8 @@ DEFAULTFONT))) (TEXTHEIGHT 600)) (DECLARE (SPECVARS COMPARETEXT.ALLCHUNKS)) + (SETQ TITLE1 (CONCAT NAME " from " TITLE1)) + (SETQ TITLE2 (CONCAT NAME " from " TITLE2)) (* ; "Reuse an existing CT graph window for this DEF") (OR [FIND W IN (OPENWINDOWS) @@ -170,7 +173,8 @@ (EDITE DEF2]) (EXAMINEFILES - [LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 19-Jul-2023 13:48 by rmk") + [LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 28-Oct-2025 14:23 by rmk") + (* ; "Edited 19-Jul-2023 13:48 by rmk") (* ; "Edited 1-Feb-2022 23:15 by rmk") (* ; "Edited 25-Jan-2022 10:08 by rmk") (* ; "Edited 2-Jan-2022 23:15 by rmk") @@ -180,7 +184,8 @@ (CL:UNLESS REGION (SETQ REGION (GETREGION))) - (LIST (AND (INFILEP FILE1) + (LIST (AND (OR (STREAMP FILE1) + (INFILEP FILE1)) (TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1) REGION 'RIGHT @@ -188,7 +193,8 @@ `(,REGION 0.5) (FETCH (REGION TOP) OF REGION)) NIL TITLE1)) - (AND (INFILEP FILE2) + (AND (OR (STREAMP FILE2) + (INFILEP FILE2)) (TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1) REGION 'LEFT @@ -281,6 +287,6 @@ (FILESLOAD (SYSLOAD) COMPARETEXT VERSIONDEFS) (DECLARE%: DONTCOPY - (FILEMAP (NIL (662 16596 (EXAMINEDEFS 672 . 10994) (EXAMINEFILES 10996 . 12478) (TEDITDEF 12480 . -14802) (EXVV 14804 . 16594))))) + (FILEMAP (NIL (666 17082 (EXAMINEDEFS 676 . 11291) (EXAMINEFILES 11293 . 12964) (TEDITDEF 12966 . +15288) (EXVV 15290 . 17080))))) STOP diff --git a/lispusers/EXAMINEDEFS.LCOM b/lispusers/EXAMINEDEFS.LCOM index 5e21927c..afc886ac 100644 Binary files a/lispusers/EXAMINEDEFS.LCOM and b/lispusers/EXAMINEDEFS.LCOM differ diff --git a/lispusers/FONTSAMPLER b/lispusers/FONTSAMPLER index ca7925e9..713400c6 100644 --- a/lispusers/FONTSAMPLER +++ b/lispusers/FONTSAMPLER @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 5-Feb-2025 17:03:38" {DSK}matt>Interlisp>medley>lispusers>FONTSAMPLER.;11 9743 +(FILECREATED "26-Dec-2025 16:37:05" {DSK}matt>Interlisp>medley>lispusers>FONTSAMPLER.;4 14367 :EDIT-BY "mth" - :CHANGES-TO (FNS FontSample FontTable) + :CHANGES-TO (FNS FontSample) - :PREVIOUS-DATE " 3-Feb-2025 20:08:40" {DSK}matt>Interlisp>medley>lispusers>FONTSAMPLER.;10 + :PREVIOUS-DATE " 9-Dec-2025 14:00:20" {DSK}matt>Interlisp>medley>lispusers>FONTSAMPLER.;3 ) @@ -20,31 +20,77 @@ (DEFINEQ (FontSample - [LAMBDA (Fonts CharacterSets Printer StreamType Hexadecimal) + [LAMBDA (Fonts CharacterSets Printer StreamType Hexadecimal ColumnMajor NoSlugOnlyCS) + (* ; "Edited 26-Dec-2025 16:25 by mth") + (* ; "Edited 9-Dec-2025 13:48 by mth") + (* ; "Edited 5-Dec-2025 11:06 by mth") (* ; "Edited 5-Feb-2025 17:02 by mth") - (* edited%: "29-Apr-87 22:03") - (LET* [[TitleFont (FONTCREATE NIL 12 'MRR 0 (OR StreamType (PRINTERTYPE Printer] + (* ; "Edited 29-Apr-87 22:03") + (LET* [[TitleFont (FONTCREATE NIL 12 'MRR 0 (SETQ StreamType (OR StreamType (PRINTERTYPE Printer] (FontList (if (LISTP Fonts) else (CONS Fonts))) [Stream (OPENIMAGESTREAM Printer StreamType (LIST 'FONTS (CONS TitleFont FontList] (InchesToPrinterUnits (FTIMES 72.0 (DSPSCALE NIL Stream))) (LastFont (CAR (LAST FontList))) - [CharacterSets (if (LISTP CharacterSets) - then CharacterSets - else (LIST (OR CharacterSets 0] - (LastCharacterSet (CAR (LAST CharacterSets] + (AllCharacterSets (CONSTANT (for CS from 0 to 255 collect CS] + (CL:UNLESS [OR (LISTP CharacterSets) + (MEMB CharacterSets '(T :INCORE :ALL :INTERESTING] + (SETQ CharacterSets (LIST (OR CharacterSets 0)))) (DSPRIGHTMARGIN (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL Stream)) Stream) - (for Font in FontList do (for CharacterSet in CharacterSets - do (FontTable Font CharacterSet Stream (OR (NEQ Font LastFont) - (NEQ CharacterSet - LastCharacterSet - )) - TitleFont InchesToPrinterUnits Hexadecimal)) - finally (CLOSEF Stream]) + (for Font in FontList do + (* ;; "Check for the special charset list builders") + + (LET (FontCharacterSets (SlugCharsetInfo (\GETCHARSETINFO Font + SLUGCHARSET))) + (SETQ FontCharacterSets + (SELECTQ CharacterSets + (:ALL + (* ;; "Forcibly install ALL CharacterSets.") + + (for CS in AllCharacterSets + when (\INSURECHARSETINFO Font CS) collect + CS)) + (:INTERESTING (for CS in *INTERESTING-CHARSETS* + when (\INSURECHARSETINFO Font CS) + collect CS)) + ((T :INCORE) + (for CS in AllCharacterSets + when (\GETCHARSETINFO Font CS) collect CS)) + CharacterSets)) + + (* ;; + "If requested to do so, exclude any CharacterSet known to reference the SlugCharsetInfo") + + (CL:WHEN (AND NoSlugOnlyCS SlugCharsetInfo) + + (* ;; + "Only if SlugCharsetInfo is non-NIL, else it won't load a requested charset") + + (SETQ FontCharacterSets + (for CS in FontCharacterSets + unless (EQ SlugCharsetInfo (\GETCHARSETINFO Font CS)) + collect CS))) + + (* ;; + "Probably ought to report charsets eliminated by the above.") + + (* ;; " At least report if NO charsets remain for this font.") + + (CL:UNLESS FontCharacterSets (printout T + "All requested character sets are empty for this font: " + Font T)) + (for CharacterSet in FontCharacterSets + bind (LastCharacterSet _ (CAR (LAST FontCharacterSets))) + do (FontTable Font CharacterSet Stream + (OR (NEQ Font LastFont) + (NEQ CharacterSet LastCharacterSet)) + TitleFont InchesToPrinterUnits Hexadecimal + ColumnMajor))) finally (CLOSEF Stream]) (FontSampleFaked - [LAMBDA (FontAsList Printer StreamType) (* N.H.Briggs "27-Apr-87 18:12") + [LAMBDA (FontAsList Printer StreamType ColumnMajor) (* ; "Edited 8-Dec-2025 21:19 by mth") + (* ; "Edited 27-Apr-87 18:12 by N.H.Briggs ") (LET* [[TitleFont (FONTCREATE NIL 12 'MRR 0 (OR StreamType (PRINTERTYPE Printer] (Font) [Stream (OPENIMAGESTREAM Printer StreamType (LIST 'FONTS (LIST TitleFont] @@ -53,14 +99,17 @@ (replace FONTFAMILY of Font with (CAR FontAsList)) (replace FONTSIZE of Font with (CADR FontAsList)) (replace FONTFACE of Font with (\FONTFACE (CADDR FontAsList))) - (FontTable Font '(0) Stream NIL TitleFont InchesToPrinterUnits) + (FontTable Font '(0) + Stream NIL TitleFont InchesToPrinterUnits NIL ColumnMajor) (CLOSEF Stream]) (FontTable - [LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits Hexadecimal) + [LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits Hexadecimal ColumnMajor) + (* ; "Edited 9-Dec-2025 13:23 by mth") + (* ; "Edited 5-Dec-2025 11:09 by mth") (* ; "Edited 5-Feb-2025 17:03 by mth") (* ; "Edited 3-Feb-2025 20:07 by mth") - (* edited%: "29-Apr-87 22:36") + (* ; "Edited 29-Apr-87 22:36") (LET* ((Family (FONTPROP Font 'FAMILY)) (Face (FONTPROP Font 'FACE)) @@ -69,14 +118,15 @@ " " (L-CASE Face T) " Character set ")) + (StreamType (IMAGESTREAMTYPE Stream)) [UseDisplayFontBitmaps (AND (EQ (FONTPROP Font 'DEVICE) 'DISPLAY) - (NOT (EQ (IMAGESTREAMTYPE Stream) - 'DISPLAY] + (NOT (EQ StreamType 'DISPLAY] [RelativeDescent (FQUOTIENT (FONTPROP Font 'DESCENT) (FONTPROP Font 'HEIGHT] (XCellSpacing (TIMES 0.45 InchesToPrinterUnits)) - (YCellSpacing (TIMES 0.5 InchesToPrinterUnits))) + (YCellSpacing (TIMES 0.5 InchesToPrinterUnits)) + ColLabelStep RowLabelStep) (printout T Title .I0.8 CharacterSet "Q" T) (RESETLST (RESETSAVE (RADIX (if Hexadecimal @@ -95,15 +145,31 @@ (printout Stream (if Hexadecimal then "16" else "8")) + (if ColumnMajor + then (SETQ ColLabelStep 16) + (SETQ RowLabelStep 1) + else (SETQ ColLabelStep 1) + (SETQ RowLabelStep 16)) (for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as Counter - from 0 to 15 bind (YPosition _ (TIMES 9.5 InchesToPrinterUnits)) - do (MOVETO XPosition YPosition Stream) - (PRIN1 Counter Stream)) - (for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as Counter - from 0 to 240 by 16 bind (XPosition _ (TIMES 0.25 InchesToPrinterUnits)) + from 0 to (ITIMES ColLabelStep 15) by ColLabelStep bind (YPosition _ (TIMES 9.5 + InchesToPrinterUnits + )) do (MOVETO XPosition YPosition Stream) (PRINTNUM (if Hexadecimal then '(FIX 2 16 T) + elseif ColumnMajor + then '(FIX 1 8 NIL T) + else '(FIX 2 8)) + Counter Stream)) + (for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as Counter + from 0 to (ITIMES RowLabelStep 15) by RowLabelStep bind (XPosition _ (TIMES 0.25 + InchesToPrinterUnits + )) + do (MOVETO XPosition YPosition Stream) + (PRINTNUM (if Hexadecimal + then '(FIX 2 16 T) + elseif ColumnMajor + then '(FIX 2 8) else '(FIX 3 8)) Counter Stream))) (DRAWLINE (TIMES 0.25 InchesToPrinterUnits) @@ -119,33 +185,33 @@ (DSPSCALE NIL Stream) 'PAINT Stream) (CL:UNLESS UseDisplayFontBitmaps (DSPFONT Font Stream)) - (for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as YCounter - from 0 to 15 bind (CharacterCode _ 0) + (for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as XCounter from 0 + to 15 bind [RangedCodesStreamType _ (MEMB StreamType '(DISPLAY INTERPRESS] do - (for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as XCounter + [for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as YCounter from 0 to 15 - do [LET ((CCode (IPLUS (ITIMES CharacterSet 256) - CharacterCode))) - (MOVETO XPosition YPosition Stream) - (if UseDisplayFontBitmaps - then (LET* ((Glyph (GETCHARBITMAP CCode Font)) - (ImSize (BITMAPIMAGESIZE Glyph NIL Stream)) - (ImWidth (CAR ImSize)) - (ImHeight (CDR ImSize))) - (BITBLT Glyph 0 0 Stream XPosition (FDIFFERENCE YPosition - (FTIMES ImHeight - RelativeDescent)) - ImWidth ImHeight 'INPUT 'REPLACE)) - else (if (AND (NEQ CharacterCode (CHARCODE FF)) - (if (MEMB (IMAGESTREAMTYPE Stream) - '(DISPLAY INTERPRESS)) - then (OR (AND (IGREATERP CharacterCode 31) - (ILESSP CharacterCode 127)) - (AND (IGREATERP CharacterCode 160) - (ILESSP CharacterCode 255))) - else T)) - then (PRINTCCODE CCode Stream] - (SETQ CharacterCode (ADD1 CharacterCode))) + do (LET* ((CharacterCode (IPLUS (ITIMES YCounter RowLabelStep) + (ITIMES XCounter ColLabelStep))) + (CCode (IPLUS (ITIMES CharacterSet 256) + CharacterCode))) + (MOVETO XPosition YPosition Stream) + (if UseDisplayFontBitmaps + then (LET* ((Glyph (GETCHARBITMAP CCode Font)) + (ImSize (BITMAPIMAGESIZE Glyph NIL Stream)) + (ImWidth (CAR ImSize)) + (ImHeight (CDR ImSize))) + (BITBLT Glyph 0 0 Stream XPosition (FDIFFERENCE YPosition + (FTIMES ImHeight + RelativeDescent)) + ImWidth ImHeight 'INPUT 'REPLACE)) + else (if (AND (NEQ CharacterCode (CHARCODE FF)) + (if RangedCodesStreamType + then (OR (AND (IGREATERP CharacterCode 31) + (ILESSP CharacterCode 127)) + (AND (IGREATERP CharacterCode 160) + (ILESSP CharacterCode 255))) + else T)) + then (PRINTCCODE CCode Stream] (printout T ".")) (MOVETO (FTIMES 0.75 InchesToPrinterUnits) (FTIMES 0.75 InchesToPrinterUnits) @@ -185,6 +251,6 @@ FONT) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (657 9580 (FontSample 667 . 2302) (FontSampleFaked 2304 . 3113) (FontTable 3115 . 9578)) -))) + (FILEMAP (NIL (645 14204 (FontSample 655 . 5488) (FontSampleFaked 5490 . 6448) (FontTable 6450 . 14202 +))))) STOP diff --git a/lispusers/FONTSAMPLER.LCOM b/lispusers/FONTSAMPLER.LCOM index 3f4909fd..e35021ad 100644 Binary files a/lispusers/FONTSAMPLER.LCOM and b/lispusers/FONTSAMPLER.LCOM differ diff --git a/lispusers/GITFNS b/lispusers/GITFNS index aed60533..4b5cbe62 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Sep-2025 21:43:21" {WMEDLEY}GITFNS.;551 134847 +(FILECREATED "28-Oct-2025 14:10:06" {WMEDLEY}GITFNS.;569 131593 :EDIT-BY rmk - :CHANGES-TO (FNS GIT-GET-DIFFERENT-FILES) + :CHANGES-TO (FNS GIT-WORKING-COMPARE-DIRECTORIES GIT-BRANCHES-COMPARE-DIRECTORIES) - :PREVIOUS-DATE "22-Sep-2025 12:52:41" {WMEDLEY}GITFNS.;550) + :PREVIOUS-DATE "28-Oct-2025 13:32:16" {WMEDLEY}GITFNS.;568) (PRETTYCOMPRINT GITFNSCOMS) @@ -59,7 +59,7 @@ (* ;; "File correspondents") (FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS) - (FNS TOGIT FROMGIT GIT-DELETE-FILE MYMEDLEY-DELETE-FILES) + (FNS TOGIT FROMGIT) (FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE) (FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME) @@ -135,22 +135,22 @@ (DEFINEQ (GIT-CLONEP - [LAMBDA (HOST/DIR NOERROR CHECKANCESTORS) (* ; "Edited 1-Oct-2023 18:09 by rmk") + [LAMBDA (HOST/DIR NOERROR CHECKANCESTORS) (* ; "Edited 25-Oct-2025 15:13 by rmk") + (* ; "Edited 14-Oct-2025 11:55 by rmk") + (* ; "Edited 1-Oct-2023 18:09 by rmk") (* ; "Edited 12-May-2022 11:44 by rmk") (* ; "Edited 8-May-2022 16:24 by rmk") - (* ;; "If CHECKANCESTORS, looks back up the directory chain to see if perhaps the .git is somewhere higher up.") + (* ;; "If CHECKANCESTORS, looks back up the directory chain to see if perhaps the .git is somewhere higher up. Returns the full true directory name") - (IF [AND HOST/DIR (LET [(D (SLASHIT (TRUEFILENAME (PACKFILENAME.STRING 'BODY HOST/DIR - 'HOST - 'DSK] - (IF (DIRECTORYNAMEP (CONCAT D "/.git/")) - THEN D - ELSEIF (AND CHECKANCESTORS (FIND-ANCESTOR-DIRECTORY - D - (FUNCTION (LAMBDA (A) - (DIRECTORYNAMEP (CONCAT A - ".git/"] + (IF (AND HOST/DIR (LET [(D (SLASHIT (TRUEFILENAME HOST/DIR] + (CL:WHEN [OR (DIRECTORYNAMEP (CONCAT D "/.git/")) + (SETQ D (AND CHECKANCESTORS + (FIND-ANCESTOR-DIRECTORY D + (FUNCTION (LAMBDA (A) + (DIRECTORYNAMEP (CONCAT + A ".git/"] + D))) ELSEIF NOERROR THEN NIL ELSE (ERROR "NOT A GIT CLONE" HOST/DIR]) @@ -169,6 +169,10 @@ (GIT-MAKE-PROJECT [LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS) + (* ; "Edited 25-Oct-2025 16:53 by rmk") + (* ; "Edited 22-Oct-2025 12:45 by rmk") + (* ; "Edited 20-Oct-2025 18:10 by rmk") + (* ; "Edited 14-Oct-2025 11:51 by rmk") (* ; "Edited 1-Oct-2023 19:33 by rmk") (* ; "Edited 30-Mar-2023 09:06 by rmk") (* ; "Edited 5-Feb-2023 12:43 by rmk") @@ -222,19 +226,14 @@ (ERROR (CONCAT "Can't find a clone directory for " PROJECTNAME)) (PRINTOUT T "Note: Can't find a clone directory for " PROJECTNAME T))) - elseif (GIT-CLONEP [SLASHIT (PACKFILENAME 'HOST 'DSK 'DIRECTORY - (UNPACKFILENAME.STRING (TRUEFILENAME - CLONEPATH) - 'DIRECTORY - 'RETURN] - T T) + elseif (GIT-CLONEP CLONEPATH T T) else (ERROR (CONCAT "Can't find the clone directory " CLONEPATH " for " PROJECTNAME] (CL:WHEN CLONEPATH (LET (GITIGNORE PROJECT WP) (CL:WHEN (SETQ GITIGNORE (INFILEP (PACKFILENAME.STRING 'NAME ".gitignore" 'BODY CLONEPATH))) - (SETQ GITIGNORE (CL:WITH-OPEN-FILE (STREAM GITIGNORE) + (SETQ GITIGNORE (CL:WITH-OPEN-FILE (STREAM GITIGNORE :EXTERNAL-FORMAT :UTF-8) (bind L until (EOFP STREAM) while (SETQ L (CL:READ-LINE STREAM :EOF-ERROR-P NIL :EOF-VALUE NIL)) @@ -270,9 +269,10 @@ then (UNSLASHIT WP) elseif WORKINGPATH then (ERROR (CONCAT "Can't find the working directory " - (AND (EQ WORKINGPATH T) - "") - " for " PROJECTNAME] + (CL:IF WORKINGPATH + (CONCAT WORKINGPATH " ") + "") + "for " PROJECTNAME] (SETQ PROJECT (create GIT-PROJECT PROJECTNAME _ PROJECTNAME GITHOST _ (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH) @@ -720,46 +720,6 @@ (CONCAT GF " cannot be copied")) T) DEST]) - -(GIT-DELETE-FILE - [LAMBDA (FILE PROJECT) (* ; "Edited 8-May-2022 09:27 by rmk") - (* ; "Edited 18-Jan-2022 23:07 by rmk") - (* ; "Edited 19-Dec-2021 16:11 by rmk") - (* ; "Edited 16-Dec-2021 13:00 by rmk") - - (* ;; "This deletes a file in the local checkout git directory {UNIX}... FILE has to already be a full file name, for safety.") - - (* ;; "Since git files are on UNIX, we don't have to worry about older version numbers. ") - - (* ;; "We could make this undoable by copying it to deleted/, but git also can restore.") - - (GIT-CLONEP FILE NIL T) - (DELFILE FILE]) - -(MYMEDLEY-DELETE-FILES - [LAMBDA (FILE PROJECT) (* ; "Edited 13-May-2022 10:40 by rmk") - (* ; "Edited 8-May-2022 23:31 by rmk") - - (* ;; "FILE is presumably the latest version of a file in the MyMedley directory, and we are presumably removing all versions of that file. If we left older versions, we would really trash ourselves.") - - (* ;; "But to guard against mistakes, %"deletion%" consists of moving all versions of the file from its current location to a deleted/ subdirectory of MEDLEYDIR, one that does not correspond to a git subdirectory.") - - (SETQ FILE (CONTRACT.PH FILE (FETCH WHOST OF PROJECT))) - (CL:WHEN (EQ (FILENAMEFIELD (FETCH WHOST OF PROJECT) - 'HOST) - (FILENAMEFIELD FILE 'HOST)) - (FOR F IN (DREVERSE (FILDIR (PACKFILENAME 'VERSION '* 'BODY FILE))) - COLLECT - - (* ;; - "Delete the earlier ones first, if it goes bad, you don't want them to persist") - - (CL:UNLESS (RENAMEFILE F (PACKFILENAME 'DIRECTORY (CONCAT "deleted>" - (FILENAMEFIELD F - 'DIRECTORY)) - 'BODY F)) - (ERROR "Could not delete " F)) - F))]) ) (DEFINEQ @@ -828,10 +788,15 @@ (DEFINEQ (GFILE4MFILE - [LAMBDA (MFILE PROJECT) (* ; "Edited 7-May-2022 23:19 by rmk") + [LAMBDA (MFILE PROJECT) (* ; "Edited 25-Oct-2025 09:18 by rmk") + (* ; "Edited 7-May-2022 23:19 by rmk") (* ; "Edited 4-Feb-2022 18:04 by rmk") - (SLASHIT (PACKFILENAME 'HOST (FETCH GITHOST OF PROJECT) - 'VERSION NIL 'BODY MFILE) + + (* ;; "Switch to UNIX: no versions") + + (SLASHIT (PACKFILENAME 'HOST 'UNIX 'BODY (TRUEFILENAME (PACKFILENAME 'HOST (FETCH GITHOST + OF PROJECT) + 'VERSION NIL 'BODY MFILE))) T]) (MFILE4GFILE @@ -1080,6 +1045,8 @@ (GIT-BRANCH-DIFF [LAMBDA (BRANCH1 BRANCH2 PROJECT) + (* ;; "Edited 21-Oct-2025 18:31 by rmk") + (* ;; "Edited 10-Jun-2024 16:43 by mth") (* ;; "Edited 2-May-2024 11:28 by mth") @@ -1145,7 +1112,7 @@ (GO RETRY)) (ERROR "Incomplete branch differences" (LIST BRANCH1 BRANCH2))) else (for L in ELINES do (PRINTOUT T L T)))) - (RETURN (SORT (for (L FN) in RLINES + (RETURN (SORT (for L FN in RLINES collect (SELCHARQ (CHCON1 L) (A (CL:IF (EQ (CHARCODE TAB) (NTHCHARCODE L 2)) @@ -1156,13 +1123,14 @@ (LIST 'DELETED (SETQ FN (SUBSTRING L 3))) (ERROR "DELETED NOT RECOGNIZED" L))) (M (CL:IF (SETQ POS (STRPOS " " L)) - [LIST 'CHANGED (SETQ FN (SUBSTRING L (ADD1 POS] + [LIST 'MODIFIED (SETQ FN (SUBSTRING L (ADD1 POS] (ERROR "CHANGED NOT RECOGNIZED" L))) - (C (if (AND (EQ (CHARCODE TAB) + (C (* ; + "We coerce a copy to an ADD of the target file") + (if (AND (EQ (CHARCODE TAB) (NTHCHARCODE L 5)) (SETQ POS (STRPOS " " L 7))) - then (LIST 'COPIED (SETQ FN (SUBSTRING L 6 - (SUB1 POS))) + then (LIST 'ADDED (SETQ FN (SUBSTRING L (ADD1 POS))) (OR (FIXP (SUBATOM L 2 4)) (HELP "C without a number" L))) else (HELP "COPY NOT RECOGNIZED" L))) @@ -1431,43 +1399,31 @@ WHENSELECTEDFN _ (FUNCTION GIT-BRANCH-WHENSELECTEDFN)))]) (GIT-BRANCH-WHENSELECTEDFN - [LAMBDA (ITEM MENU BUTTON) (* ; "Edited 21-Mar-2025 19:07 by rmk") + [LAMBDA (ITEM MENU BUTTON) (* ; "Edited 2-Oct-2025 23:08 by rmk") + (* ; "Edited 30-Sep-2025 14:58 by rmk") + (* ; "Edited 21-Mar-2025 19:07 by rmk") (* ; "Edited 11-May-2024 11:05 by rmk") (* ; "Edited 1-May-2024 18:17 by rmk") (* ; "CAR is git key, 4th is project") - (* ;; "This executes the comparison in the current TTY window, either by stuffing the command there or by evaluating there. There probably should be a check to make sure that the TTY is in fact an executive--if not, maybe this should be a no-op. Better than getting the comparison form in the middle of anther SEDIT or TEDIT.") - (* ;; "This could also execute in the mouse process, where the menu is clicked. But in that case a terminal window pops up with the header lines of the compare, and that seems a nuisance.") (LET [(PR (CAR (LAST ITEM] - (if [AND NIL (PROGN (GETMOUSESTATE) - (EQ 'MIDDLE (DECODEBUTTONS] - then (LET [(POS (ADD1 (STRPOS "#" (CAR ITEM] - (ShellBrowse (fetch PRURL of PR))) - elseif (PROGN T) - then - (* ;; "PROGN because DWIM is screwed up") - - (* ;; "The COPYINSERT causes the compare to run in the TTY process, by stuffing the characters in the input line. Somehow it executes even if the parens are not there, but that looks funny. But it also works if I stuff the parens on both sides.") - - (if (EQ BUTTON 'MIDDLE) - then (ShellOpen (CONCAT "https://github.com/Interlisp/medley/pull/" - (fetch (PULLREQUEST PRNUMBER) of PR))) - else (BKSYSBUF '%() - [COPYINSERT `(GIT-PR-COMPARE ,(CADR ITEM) - ',(fetch PRPROJECT of PR] - (BKSYSBUF '%))) + (if (EQ BUTTON 'MIDDLE) + then (ShellOpen (CONCAT "https://github.com/Interlisp/medley/pull/" (fetch (PULLREQUEST + PRNUMBER) + of PR))) else - (* ;; "This puts the print out after the next event number in the TTY window, unfortunately. We go to the default font so we don't get TTYIN's input bold for this.") + (* ;; "This prints notices in its own TTY window") - (PROCESS.EVAL (TTY.PROCESS) - `(RESETLST - [RESETSAVE (DSPFONT DEFAULTFONT T) - '(PROGN (DSPFONT OLDVALUE T])]) + (ADD.PROCESS `[GIT-PR-COMPARE ,(CADR ITEM) + ',(fetch PRPROJECT of PR] + 'NAME + 'prc]) (GIT-PULL-REQUESTS - [LAMBDA (INCLUDEDRAFTS PROJECT) (* ; "Edited 9-May-2025 11:39 by rmk") + [LAMBDA (INCLUDEDRAFTS PROJECT) (* ; "Edited 20-Oct-2025 10:22 by rmk") + (* ; "Edited 9-May-2025 11:39 by rmk") (* ; "Edited 20-May-2024 22:12 by rmk") (* ; "Edited 13-May-2024 18:59 by rmk") (* ; "Edited 11-May-2024 10:51 by rmk") @@ -1495,9 +1451,11 @@ PRDESCRIPTION _ (JSON-GET JSOBJ 'title) PRSTATUS _ (CL:IF DRAFT 'D - (CL:IF (STREQUAL "REVIEW�REQUIRED" - (JSON-GET JSOBJ 'reviewDecision)) - " " + (SELECTQ (MKATOM (JSON-GET JSOBJ 'reviewDecision)) + (CHANGES�REQUESTED + 'C) + (REVIEW�REQUIRED + " ") 'A)) PRPROJECT _ PROJECT PRURL _ (JSON-GET JSOBJ 'url) @@ -1733,6 +1691,8 @@ [LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2 PROJECT) (DECLARE (USEDFREE FROMGITN)) + (* ;; "Edited 21-Oct-2025 18:30 by rmk") + (* ;; "Edited 23-Sep-2025 21:42 by rmk") (* ;; "Edited 22-Sep-2025 12:48 by rmk") @@ -1748,101 +1708,107 @@ (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) (SETQ BRANCH1 (GIT-BRANCH-EXISTS? BRANCH1 NIL PROJECT)) (SETQ BRANCH2 (GIT-BRANCH-EXISTS? BRANCH2 NIL PROJECT)) - (LET (MAPPINGS FROMGIT FROMGITDIR PRNAME (DIFFS (GIT-BRANCH-DIFF BRANCH1 BRANCH2 PROJECT))) - (CL:WHEN DIFFS - (SETQ FROMGIT (PACK* "{FROMGIT" (add FROMGITN 1) - "}")) + (LET + (MAPPINGS FROMGIT FROMGITDIR PRNAME (DIFFS (GIT-BRANCH-DIFF BRANCH1 BRANCH2 PROJECT))) + (CL:WHEN DIFFS + (SETQ FROMGIT (PACK* "{FROMGIT" (add FROMGITN 1) + "}")) - (* ;; "If both origin/, strip it out of subdirectories") + (* ;; "If both origin/, strip it out of subdirectories") - (SETQ PRNAME (MTOUSTRING (CL:IF (AND (STRPOS "origin/" BRANCH1 NIL T) - (STRPOS "origin/" BRANCH2 NIL T)) - (SUBSTRING BRANCH2 (CONSTANT (NCHARS "origin/ "))) - BRANCH2))) - (PSEUDOHOST FROMGIT (CONCAT "{DSK}" (fetch PROJECTNAME of PROJECT) - "-PR--" PRNAME "--" (DATE) - ">")) - (CL:UNLESS DIR1 - (SETQ DIR1 (CONCAT FROMGIT ""))) - (CL:UNLESS DIR2 - (SETQ DIR2 (CONCAT FROMGIT ""))) - (for D in DIFFS - do - (SELECTQ (CAR D) - (ADDED (* ; + (SETQ PRNAME (CL:IF (AND (STRPOS "origin/" BRANCH1 NIL T) + (STRPOS "origin/" BRANCH2 NIL T)) + (SUBSTRING BRANCH2 (CONSTANT (NCHARS "origin/ "))) + BRANCH2)) + (PSEUDOHOST FROMGIT (CONCAT "{DSK}" (fetch PROJECTNAME of PROJECT) + "-PR--" PRNAME "--" (DATE) + ">")) + (CL:UNLESS DIR1 + (SETQ DIR1 (CONCAT FROMGIT ""))) + (CL:UNLESS DIR2 + (SETQ DIR2 (CONCAT FROMGIT ""))) + (for D in DIFFS + do (SELECTQ (CAR D) + (ADDED (* ; "Shouldn't exist in BRANCH2, should exist in BRANCH1, but maybe ADDED and DELETED are mixed up?") - (SETQ D (CADR D)) - (OR (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D) - T PROJECT) - (GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D) - T PROJECT))) - (DELETED - (* ;; "Shouldn't exist in BRANCH1, should exist in BRANCH2. But maybe git is just confused in marking a file that exists in the wrong place as a delete instead of an add, or maybe it may think of a file that doesn't exist at all as having been deleted. Try for both, but don't cause an error.") + (SETQ D (CADR D)) + (OR (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D) + T PROJECT) + (GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D) + T PROJECT))) + (DELETED + (* ;; "Shouldn't exist in BRANCH1, should exist in BRANCH2. But maybe git is just confused in marking a file that exists in the wrong place as a delete instead of an add, or maybe it may think of a file that doesn't exist at all as having been deleted. Try for both, but don't cause an error.") - (SETQ D (CADR D)) - (OR (GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D) - T PROJECT) - (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D) - T PROJECT))) - (CHANGED (* ; "Should exist in both branches") + (SETQ D (CADR D)) + (OR (GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D) + T PROJECT) + (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D) + T PROJECT))) + (MODIFIED (* ; "Should exist in both branches") (SETQ D (CADR D)) (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D) T PROJECT) (GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D) T PROJECT)) - ((RENAMED COPIED) + ((RENAMED COPIED) (* ;; "These entries are from-to filename pairs. If (CADDR) is 100, only need to fetch one, because it presumably has disappeared in BRANCH2 and reappeared in BRANCH1. MAPPINGS is returned so the connection can be reestablished higher up. ") - - (* ;; "If renamed and then changed, for now treat as unrelated adds and deletes: put both files in the fromgit directory. Perhaps the mapping should still figure out how to relate them.") + + (* ;; "If renamed and then changed, for now treat as unrelated adds and deletes: put both files in the fromgit directory. Perhaps the mapping should still figure out how to relate them.") - (* ;; "For copied files, presumably 2 files are exactly the same. But we hope we can show them on the same line, by virtue of the mapping.") + (* ;; "For copied files, presumably 2 files are exactly the same. But we hope we can show them on the same line, by virtue of the mapping.") - [LET ((GFILE (CDR D)) - F1 F2) + (* ;; + "GIT %"copy%" to a target file is coerced to ADDED of that target; the source is ignore") - (* ;; "GFILE is a triple (F2 F1 N )") + (LET ((GFILE (CDR D)) + F1 F2) - (* ;; "F1 is the file in branch 1, if any, F2 is in branch 2") + (* ;; "GFILE is a triple (F2 F1 N )") - (SETQ F1 (GIT-GET-FILE BRANCH1 (CADR GFILE) - (CONCAT DIR1 (CADR GFILE)) - T PROJECT)) - (SETQ F2 (GIT-GET-FILE BRANCH2 (CADR GFILE) - (CONCAT DIR2 (CADR GFILE)) - T PROJECT)) + (* ;; "F1 is the file in branch 1, if any, F2 is in branch 2") - (* ;; "Let the directories figure it out") + (SETQ F1 (GIT-GET-FILE BRANCH1 (CADR GFILE) + (CONCAT DIR1 (CADR GFILE)) + T PROJECT)) + (SETQ F2 (GIT-GET-FILE BRANCH2 (CADR GFILE) + (CONCAT DIR2 (CADR GFILE)) + T PROJECT)) - (AND NIL (if (EQ (CADDR GFILE) - 100) - then + (* ;; "Let the directories figure it out") + + (AND NIL (if (EQ (CADDR GFILE) + 100) + then (* ;; "A little tricky to figure out what corresponds to the real file in the mapping, which directory it belongs to. Maybe the first one should always be one that exists, the second may just be a useful name. But we have to know whether to match against INFO1 or INFO2") - (HELP GFILE 100) - (push MAPPINGS - (LIST (LIST) - (FULLNAME F1) - (SLASHIT (U-CASE (CONCAT DIR2 - (CAR GFILE))) - T) - (NTHCHAR (CAR D) - 1) - 100)) - else - (* ;; + (HELP GFILE 100) + (push MAPPINGS + (LIST (LIST) + (FULLNAME F1) + (SLASHIT (U-CASE (CONCAT DIR2 (CAR GFILE)) + ) + T) + (NTHCHAR (CAR D) + 1) + 100)) + else + (* ;; "If not a perfect match, then the directory should figure it out") - (GIT-GET-FILE BRANCH2 (CAR GFILE) - (CONCAT DIR2 (CAR GFILE)) - T PROJECT]) - (HELP "UNKNOWN GIT-DIFF TAG" D))) - (LIST DIR1 DIR2 MAPPINGS))]) + (GIT-GET-FILE BRANCH2 (CAR GFILE) + (CONCAT DIR2 (CAR GFILE)) + T PROJECT))) + F2)) + (HELP "UNKNOWN GIT-DIFF TAG" D))) + (LIST DIR1 DIR2 MAPPINGS))]) (GIT-BRANCHES-COMPARE-DIRECTORIES - [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 12-Jun-2024 22:52 by mth") + [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 28-Oct-2025 14:01 by rmk") + (* ; "Edited 2-Oct-2025 23:12 by rmk") + (* ; "Edited 12-Jun-2024 22:52 by mth") (* ; "Edited 10-Jun-2024 18:42 by mth") (* ; "Edited 1-May-2024 14:58 by rmk") (* ; "Edited 26-Sep-2023 22:40 by rmk") @@ -1860,8 +1826,10 @@ (SHORT2 (GIT-SHORT-BRANCH-NAME BRANCH2))) (PRINTOUT T "Comparing all " (L-CASE (fetch PROJECTNAME of PROJECT) T) - " subdirectories of " SHORT1 " and " SHORT2 T) - (PRINTOUT T "Fetching differences" T) + " subdirectories of" T) + (PRINTOUT T 5 .FONT BOLDFONT SHORT1 .FONT DEFAULTFONT " and " .FONT BOLDFONT SHORT2 .FONT + DEFAULTFONT T) + (PRINTOUT T "Fetching differences") (SETQ DIRS (GIT-GET-DIFFERENT-FILES BRANCH1 BRANCH2 NIL NIL PROJECT)) (SETQ MAPPINGS (CADDR DIRS)) (if DIRS @@ -1874,10 +1842,10 @@ '(> < ~= -* *-) '(*.* *>*.* .* *>.*) (GIT-GET-PROJECT PROJECT 'EXCLUSIONS) - NIL NIL NIL NIL (LIST (PACKFILENAME 'HOST NIL 'BODY - (CAR DIRS)) - (PACKFILENAME 'HOST NIL 'BODY - (CADR DIRS] + NIL NIL NIL NIL (LIST (FILENAMEFIELD (CAR DIRS) + 'DIRECTORY) + (FILENAMEFIELD (CADR DIRS) + 'DIRECTORY] (* ;; "We know that both sides come from Unix/unversioned, even if they have been copied into versioned FROMGIT, so we make a pass to remove the misleading versions.") @@ -1931,8 +1899,10 @@ (LENGTH (fetch (CDVALUE CDENTRIES) of CDVALUE)) " files") (LIST SHORT1 SHORT2) - `(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2 PROJECT - ,PROJECT) + `((LABELFN . GIT-CD-LABELFN) + (BRANCH1 ,@BRANCH1) + (BRANCH2 ,@BRANCH2) + (PROJECT ,@PROJECT)) GIT-CDBROWSER-SEPARATE-DIRECTIONS `(Compare See)) (SETQ NENTRIES (LENGTH (fetch (CDVALUE CDENTRIES) of CDVALUE))) @@ -1942,100 +1912,108 @@ else '(0 differences)) else '(0 differences]) -(GIT-WORKING-COMPARE-DIRECTORIES +(GIT-WORKING-COMPARE-DIRECTORIES [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT) - (* ;; "Edited 29-Apr-2025 15:14 by rmk") + (* ;; "Edited 28-Oct-2025 14:00 by rmk") - (* ;; "Edited 12-Jun-2024 22:52 by mth") + (* ;; "Edited 25-Oct-2025 23:32 by rmk") - (* ;; "Edited 26-Sep-2023 22:41 by rmk") + (* ;; "Edited 29-Apr-2025 15:14 by rmk") - (* ;; "Edited 17-Jun-2023 22:54 by rmk") + (* ;; "Edited 12-Jun-2024 22:52 by mth") - (* ;; "Edited 10-Jun-2023 21:32 by rmk") + (* ;; "Edited 26-Sep-2023 22:41 by rmk") - (* ;; "Edited 20-Jul-2022 21:18 by rmk") + (* ;; "Edited 17-Jun-2023 22:54 by rmk") - (* ;; "Edited 25-Jun-2022 21:37 by rmk") + (* ;; "Edited 10-Jun-2023 21:32 by rmk") - (* ;; "Edited 17-May-2022 17:39 by rmk") + (* ;; "Edited 20-Jul-2022 21:18 by rmk") - (* ;; "Edited 10-May-2022 10:41 by rmk") + (* ;; "Edited 25-Jun-2022 21:37 by rmk") + + (* ;; "Edited 17-May-2022 17:39 by rmk") + + (* ;; "Edited 10-May-2022 10:41 by rmk") (* ;; - "Edited 29-Mar-2022 13:58 by rmk: working medley subdirectories with the current local git branch.") + "Edited 29-Mar-2022 13:58 by rmk: working medley subdirectories with the current local git branch.") - (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) - (CL:WHEN UPDATE (GIT-REMOTE-UPDATE NIL PROJECT)) (* ; "Doesn't matter if we are looking only at local files in the current branch. We aren't fetching or checking out.") - (CL:UNLESS (AND (fetch GITHOST of PROJECT) - (fetch WHOST of PROJECT)) - (ERROR (fetch PROJECTNAME of PROJECT) + (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + (CL:WHEN UPDATE (GIT-REMOTE-UPDATE NIL PROJECT)) (* ; "Doesn't matter if we are looking only at local files in the current branch. We aren't fetching or checking out.") + (CL:UNLESS (AND (fetch GITHOST of PROJECT) + (fetch WHOST of PROJECT)) + (ERROR (fetch PROJECTNAME of PROJECT) " does not have both git and working directories")) - (CL:WHEN (AND (LISTP SUBDIRS) - (NULL (CDR SUBDIRS))) - (SETQ SUBDIRS (CAR SUBDIRS))) + (CL:WHEN (AND (LISTP SUBDIRS) + (NULL (CDR SUBDIRS))) + (SETQ SUBDIRS (CAR SUBDIRS))) (CL:UNLESS SUBDIRS - (SETQ SUBDIRS (OR (fetch DEFAULTSUBDIRS of PROJECT) + (SETQ SUBDIRS (OR (fetch DEFAULTSUBDIRS of PROJECT) 'ALL))) - (SETQ SUBDIRS (L-CASE SUBDIRS)) - (LET ((SUBDIRSTRING (if (EQ SUBDIRS 'all) - then (SETQ SUBDIRS (ALLSUBDIRS PROJECT)) + (SETQ SUBDIRS (L-CASE SUBDIRS)) + (LET ((SUBDIRSTRING (if (EQ SUBDIRS 'all) + then (SETQ SUBDIRS (ALLSUBDIRS PROJECT)) "ALL subdirectories" - else SUBDIRS))) - (for SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT) + else SUBDIRS))) + (for SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT) T))) (NENTRIES _ 0) - (BRANCH2 _ (GIT-WHICH-BRANCH PROJECT T)) - first (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T) - (BKSYSBUF " ") inside SUBDIRS - collect (TERPRI T) - (SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR SUBDIR T PROJECT) - (GITSUBDIR SUBDIR T PROJECT) - (OR SELECT '(> < ~= -* *-)) + (BRANCH2 _ (GIT-WHICH-BRANCH PROJECT T)) + first (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T) + (BKSYSBUF " ") inside SUBDIRS + collect (TERPRI T) + (SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR SUBDIR T PROJECT) + (GITSUBDIR SUBDIR T PROJECT) + (OR SELECT '(> < ~= -* *-)) '(*.* *>*.* .* *>.*) - (for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS) - collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E + (for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS) + collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E 'DIRECTORY) 1 NIL T T FILEDIRCASEARRAY)) (CL:IF DPOS - (SUBSTRING E (ADD1 DPOS)) + (SUBSTRING E (ADD1 DPOS)) E)) NIL NIL NIL FIXDIRECTORYDATES)) - [for CDE in (fetch CDENTRIES of CDVAL) - do (CL:WHEN (fetch INFO1 of CDE) - (change (fetch (CDINFO FULLNAME) of (fetch INFO1 of CDE)) - (UNSLASHIT DATUM T))) - (CL:WHEN (fetch INFO2 of CDE) - (change (fetch (CDINFO FULLNAME) of (fetch INFO2 of CDE)) - (SLASHIT DATUM T)))] + [for CDE in (fetch CDENTRIES of CDVAL) + do (CL:WHEN (fetch INFO1 of CDE) + (change (fetch (CDINFO FULLNAME) of (fetch INFO1 of CDE)) + (UNSLASHIT DATUM T))) + (CL:WHEN (fetch INFO2 of CDE) + (change (fetch (CDINFO FULLNAME) of (fetch INFO2 of CDE)) + (SLASHIT DATUM T)))] CDVAL - finally + finally - (* ;; "Set up the browsers after everything has been done, otherwise if the user doesn't pay attention it might hang waiting for a region.") + (* ;; "Set up the browsers after everything has been done, otherwise if the user doesn't pay attention it might hang waiting for a region.") - (CL:WHEN (AND (CDR $$VAL) + (CL:WHEN (AND (CDR $$VAL) GIT-MERGE-COMPARES) - (SETQ $$VAL (CDMERGE $$VAL)) - [SETQ SUBDIRS (CONCATLIST (for SUBDIR in SUBDIRS collect (CONCAT SUBDIR " "]) - [for CDVAL TITLE in $$VAL as SUBDIR inside SUBDIRS - do (SETQ TITLE (CONCAT WPROJ " vs. " BRANCH2 " " SUBDIR " " - (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL)) + (SETQ $$VAL (CDMERGE $$VAL)) + [SETQ SUBDIRS (CONCATLIST (for SUBDIR in SUBDIRS collect (CONCAT SUBDIR " "]) + [for CDVAL TITLE in $$VAL as SUBDIR inside SUBDIRS + do (SETQ TITLE (CONCAT WPROJ " vs. " BRANCH2 " " SUBDIR " " + (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL)) " files")) - [CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2) - `(BRANCH1 ,WPROJ BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN - GIT-CD-LABELFN PROJECT ,PROJECT) + [CDBROWSER CDVAL TITLE `(,WPROJ ,@BRANCH2) + `((BRANCH1 ,@WPROJ) + (BRANCH2 ,@BRANCH2) + (SUBDIR ,@SUBDIR) + (LABELFN . GIT-CD-LABELFN) + (PROJECT ,@PROJECT)) GIT-CDBROWSER-SEPARATE-DIRECTIONS `(Compare See "" Copy% <- (|Delete ALL <-| GIT-CD-MENUFN) - ,@(CL:UNLESS (GIT-MAINBRANCH? BRANCH2 PROJECT T) - '("" Copy% -> (Delete% -> GIT-CD-MENUFN)))] - (CONS (CONCAT SUBDIR "/") - (for CDENTRY in (fetch CDENTRIES of CDVAL) - collect (fetch MATCHNAME of CDENTRY))) - (add NENTRIES (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL] - (SETQ LAST-WMEDLEY-CDVALUES $$VAL) - (TERPRI T) - (RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1) + ,@(CL:UNLESS (GIT-MAINBRANCH? BRANCH2 PROJECT T) + '("" (Copy% -> GIT-CD-MENUFN NIL T) + (Delete% -> GIT-CD-MENUFN)))] + (CONS (CONCAT SUBDIR "/") + (for CDENTRY in (fetch CDENTRIES of CDVAL) + collect (fetch MATCHNAME of CDENTRY))) + (add NENTRIES (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL] + (SETQ LAST-WMEDLEY-CDVALUES $$VAL) + (TERPRI T) + (RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1) 'difference 'differences)]) @@ -2203,42 +2181,19 @@ (OR LABEL2 FILE2]) (GIT-CD-MENUFN - [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 21-Sep-2022 21:34 by rmk") + [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 28-Oct-2025 11:50 by rmk") + (* ; "Edited 25-Oct-2025 23:44 by rmk") + (* ; "Edited 21-Sep-2022 21:34 by rmk") (* ; "Edited 22-May-2022 19:13 by rmk") (* ; "Edited 8-May-2022 09:26 by rmk") (* ; "Edited 10-Dec-2021 08:52 by rmk") (* ;; "MENUITEM is of the form (display-atom . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom") - (DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY)) + (DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY USERDATA PWINDOW)) (SELECTQ (OR (CADDR MENUITEM) (CAR MENUITEM)) - (Delete% -> (FLASHWINDOW PWINDOW) - (GIVE.TTY.PROCESS PWINDOW) - (CL:WHEN [OR (EQ KEY 'MIDDLE) - (EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete " LABEL2 " ? "] - (GIT-DELETE-FILE FILE2 (LISTGET USERDATA 'PROJECT)) - (TB.DELETE.ITEM CDBROWSER TBITEM))) - (|Delete ALL <-| - (FLASHWINDOW PWINDOW) - (GIVE.TTY.PROCESS PWINDOW) - (if (NAMEFIELD LABEL1 T) - then (CL:WHEN [OR (EQ KEY 'MIDDLE) - (EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete ALL versions of " - (NAMEFIELD LABEL1 T) - " ? "] - (MYMEDLEY-DELETE-FILES FILE1 (LISTGET USERDATA 'PROJECT)) - (TB.DELETE.ITEM CDBROWSER TBITEM)) - else (PRINTOUT T "Nothing to delete"))) - (Delete% BOTH (FLASHWINDOW PWINDOW) - (GIVE.TTY.PROCESS PWINDOW) - (CL:WHEN (EQ 'Y (ASKUSER NIL 'N (CONCAT - "Delete all Medley and git versions of " - (NAMEFIELD LABEL1 T) - " ? "))) - (GIT-DELETE-FILE FILE2 (LISTGET USERDATA 'PROJECT)) - (MYMEDLEY-DELETE-FILES FILE1 (LISTGET USERDATA 'PROJECT)) - (TB.DELETE.ITEM CDBROWSER TBITEM))) + (Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT (CADDDR MENUITEM))) (SHOULDNT]) (GIT-WORKING-COMPARE-FILES @@ -2439,33 +2394,32 @@ (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4193 20772 (GIT-CLONEP 4203 . 5531) (GIT-INIT 5533 . 6163) (GIT-MAKE-PROJECT 6165 . -13830) (GIT-GET-PROJECT 13832 . 15757) (GIT-PUT-PROJECT-FIELD 15759 . 17400) (GIT-PROJECT-PATH 17402 - . 18446) (FIND-ANCESTOR-DIRECTORY 18448 . 18797) (GIT-FIND-CLONE 18799 . 19880) (GIT-MAINBRANCH 19882 - . 20277) (GIT-MAINBRANCH? 20279 . 20770)) (26235 31164 (PRC-COMMAND 26245 . 31162)) (31220 34008 ( -ALLSUBDIRS 31230 . 32516) (MEDLEYSUBDIRS 32518 . 33211) (GITSUBDIRS 33213 . 34006)) (34009 38799 ( -TOGIT 34019 . 35425) (FROMGIT 35427 . 36408) (GIT-DELETE-FILE 36410 . 37256) (MYMEDLEY-DELETE-FILES -37258 . 38797)) (38800 41803 (MYMEDLEYSUBDIR 38810 . 39266) (GITSUBDIR 39268 . 39711) (STRIPDIR 39713 - . 40084) (STRIPHOST 40086 . 40326) (STRIPNAME 40328 . 41081) (STRIPWHERE 41083 . 41801)) (41804 43706 - (GFILE4MFILE 41814 . 42177) (MFILE4GFILE 42179 . 42748) (GIT-REPO-FILENAME 42750 . 43704)) (43755 -54010 (GIT-COMMIT 43765 . 44591) (GIT-PUSH 44593 . 45353) (GIT-PULL 45355 . 46107) (GIT-APPROVAL 46109 - . 46458) (GIT-GET-FILE 46460 . 48375) (GIT-FILE-EXISTS? 48377 . 48651) (GIT-REMOTE-UPDATE 48653 . -49488) (GIT-REMOTE-ADD 49490 . 49797) (GIT-FILE-DATE 49799 . 50846) (GIT-FILE-HISTORY 50848 . 52782) ( -GIT-PRINT-FILE-HISTORY 52784 . 53834) (GIT-FETCH 53836 . 54008)) (54040 65378 (GIT-BRANCH-DIFF 54050 - . 60797) (GIT-COMMIT-DIFFS 60799 . 61690) (GIT-BRANCH-RELATIONS 61692 . 65376)) (65423 84918 ( -GIT-BRANCH-NUM 65433 . 66006) (GIT-CHECKOUT 66008 . 67294) (GIT-WHICH-BRANCH 67296 . 67703) ( -GIT-MAKE-BRANCH 67705 . 70284) (GIT-BRANCHES 70286 . 72881) (GIT-BRANCH-EXISTS? 72883 . 73754) ( -GIT-PICK-BRANCH 73756 . 74246) (GIT-BRANCH-MENU 74248 . 75129) (GIT-BRANCH-WHENSELECTEDFN 75131 . -77670) (GIT-PULL-REQUESTS 77672 . 81299) (GIT-SHORT-BRANCH-NAME 81301 . 81592) (GIT-LONG-NAME 81594 . -81911) (GIT-PRC-BRANCHES 81913 . 84916)) (84948 88396 (GIT-MY-CURRENT-BRANCH 84958 . 85328) ( -GIT-MY-BRANCHP 85330 . 85948) (GIT-MY-NEXT-BRANCH 85950 . 86444) (GIT-MY-BRANCHES 86446 . 88394)) ( -88442 92517 (GIT-ADD-WORKTREE 88452 . 90059) (GIT-REMOVE-WORKTREE 90061 . 90991) (GIT-LIST-WORKTREES -90993 . 91797) (WORKTREEDIR 91799 . 92515)) (92565 126387 (GIT-GET-DIFFERENT-FILES 92575 . 99428) ( -GIT-BRANCHES-COMPARE-DIRECTORIES 99430 . 106661) (GIT-WORKING-COMPARE-DIRECTORIES 106663 . 112370) ( -GIT-COMPARE-WORKTREE 112372 . 116350) (GITCDOBJBUTTONFN 116352 . 120842) (GIT-CD-LABELFN 120844 . -121926) (GIT-CD-MENUFN 121928 . 124368) (GIT-WORKING-COMPARE-FILES 124370 . 124990) ( -GIT-BRANCHES-COMPARE-FILES 124992 . 126156) (GIT-PR-COMPARE 126158 . 126385)) (126457 134780 (CDGITDIR - 126467 . 127154) (GIT-COMMAND 127156 . 128714) (GITORIGIN 128716 . 129413) (GIT-INITIALS 129415 . -129719) (GIT-COMMAND-TO-FILE 129721 . 133206) (GIT-RESULT-TO-LINES 133208 . 134113) (STRIPLOCAL 134115 - . 134778))))) + (FILEMAP (NIL (4196 21002 (GIT-CLONEP 4206 . 5637) (GIT-INIT 5639 . 6269) (GIT-MAKE-PROJECT 6271 . +14060) (GIT-GET-PROJECT 14062 . 15987) (GIT-PUT-PROJECT-FIELD 15989 . 17630) (GIT-PROJECT-PATH 17632 + . 18676) (FIND-ANCESTOR-DIRECTORY 18678 . 19027) (GIT-FIND-CLONE 19029 . 20110) (GIT-MAINBRANCH 20112 + . 20507) (GIT-MAINBRANCH? 20509 . 21000)) (26465 31394 (PRC-COMMAND 26475 . 31392)) (31450 34238 ( +ALLSUBDIRS 31460 . 32746) (MEDLEYSUBDIRS 32748 . 33441) (GITSUBDIRS 33443 . 34236)) (34239 36640 ( +TOGIT 34249 . 35655) (FROMGIT 35657 . 36638)) (36641 39644 (MYMEDLEYSUBDIR 36651 . 37107) (GITSUBDIR +37109 . 37552) (STRIPDIR 37554 . 37925) (STRIPHOST 37927 . 38167) (STRIPNAME 38169 . 38922) ( +STRIPWHERE 38924 . 39642)) (39645 41880 (GFILE4MFILE 39655 . 40351) (MFILE4GFILE 40353 . 40922) ( +GIT-REPO-FILENAME 40924 . 41878)) (41929 52184 (GIT-COMMIT 41939 . 42765) (GIT-PUSH 42767 . 43527) ( +GIT-PULL 43529 . 44281) (GIT-APPROVAL 44283 . 44632) (GIT-GET-FILE 44634 . 46549) (GIT-FILE-EXISTS? +46551 . 46825) (GIT-REMOTE-UPDATE 46827 . 47662) (GIT-REMOTE-ADD 47664 . 47971) (GIT-FILE-DATE 47973 + . 49020) (GIT-FILE-HISTORY 49022 . 50956) (GIT-PRINT-FILE-HISTORY 50958 . 52008) (GIT-FETCH 52010 . +52182)) (52214 63694 (GIT-BRANCH-DIFF 52224 . 59113) (GIT-COMMIT-DIFFS 59115 . 60006) ( +GIT-BRANCH-RELATIONS 60008 . 63692)) (63739 82478 (GIT-BRANCH-NUM 63749 . 64322) (GIT-CHECKOUT 64324 + . 65610) (GIT-WHICH-BRANCH 65612 . 66019) (GIT-MAKE-BRANCH 66021 . 68600) (GIT-BRANCHES 68602 . 71197 +) (GIT-BRANCH-EXISTS? 71199 . 72070) (GIT-PICK-BRANCH 72072 . 72562) (GIT-BRANCH-MENU 72564 . 73445) ( +GIT-BRANCH-WHENSELECTEDFN 73447 . 74986) (GIT-PULL-REQUESTS 74988 . 78859) (GIT-SHORT-BRANCH-NAME +78861 . 79152) (GIT-LONG-NAME 79154 . 79471) (GIT-PRC-BRANCHES 79473 . 82476)) (82508 85956 ( +GIT-MY-CURRENT-BRANCH 82518 . 82888) (GIT-MY-BRANCHP 82890 . 83508) (GIT-MY-NEXT-BRANCH 83510 . 84004) + (GIT-MY-BRANCHES 84006 . 85954)) (86002 90077 (GIT-ADD-WORKTREE 86012 . 87619) (GIT-REMOVE-WORKTREE +87621 . 88551) (GIT-LIST-WORKTREES 88553 . 89357) (WORKTREEDIR 89359 . 90075)) (90125 123133 ( +GIT-GET-DIFFERENT-FILES 90135 . 97043) (GIT-BRANCHES-COMPARE-DIRECTORIES 97045 . 104672) ( +GIT-WORKING-COMPARE-DIRECTORIES 104674 . 110470) (GIT-COMPARE-WORKTREE 110472 . 114450) ( +GITCDOBJBUTTONFN 114452 . 118942) (GIT-CD-LABELFN 118944 . 120026) (GIT-CD-MENUFN 120028 . 121114) ( +GIT-WORKING-COMPARE-FILES 121116 . 121736) (GIT-BRANCHES-COMPARE-FILES 121738 . 122902) ( +GIT-PR-COMPARE 122904 . 123131)) (123203 131526 (CDGITDIR 123213 . 123900) (GIT-COMMAND 123902 . +125460) (GITORIGIN 125462 . 126159) (GIT-INITIALS 126161 . 126465) (GIT-COMMAND-TO-FILE 126467 . +129952) (GIT-RESULT-TO-LINES 129954 . 130859) (STRIPLOCAL 130861 . 131524))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index c3712246..da2bc98b 100644 Binary files a/lispusers/GITFNS.LCOM and b/lispusers/GITFNS.LCOM differ diff --git a/lispusers/KINETIC b/lispusers/KINETIC index 48cafeaa..ce0a380b 100644 --- a/lispusers/KINETIC +++ b/lispusers/KINETIC @@ -1,16 +1,14 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Sep-2022 08:19:41" {DSK}larry>medley>lispusers>KINETIC.;2 1928 +(FILECREATED " 1-Nov-2025 20:26:43" {DSK}frank>il>medley>lispusers>KINETIC.;5 2264 + + :EDIT-BY "FGH" :CHANGES-TO (FNS KINETIC) - :PREVIOUS-DATE " 2-Apr-86 00:14:01" {DSK}larry>medley>lispusers>KINETIC.;1) + :PREVIOUS-DATE "23-Sep-2022 08:19:41" {DSK}frank>il>medley>lispusers>KINETIC.;1) -(* ; " -Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation. -") - (PRETTYCOMPRINT KINETICCOMS) (RPAQQ KINETICCOMS ((FNS KINETIC) @@ -20,26 +18,31 @@ Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation. (DEFINEQ (KINETIC - [LAMBDA (WINDOW) (* ; "Edited 22-Sep-2022 22:07 by lmm") + [LAMBDA (WINDOW) (* ; "Edited 1-Nov-2025 20:23 by FGH") + (* ; "Edited 22-Sep-2022 22:07 by lmm") (* lmm " 3-Dec-85 14:16") - (* test example (KINETICDEMO) - (SETQ CHECKSHADE (EDITSHADE CHECKSHADE))) [OR (WINDOWP WINDOW) (SETQ WINDOW (OR KINETICWINDOW (SETQ KINETICWINDOW (CREATEW NIL "Kinetic Window"] + [OR (WINDOWPROP WINDOW 'CLOSEFN) + (WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W) + (WINDOWPROP W 'CLOSE T] + [WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W) + (WINDOWPROP W 'CLOSE T] (PROG ((WD (WINDOWPROP WINDOW 'WIDTH)) (HT (WINDOWPROP WINDOW 'HEIGHT)) X Y) - (do (SETQ X (RAND 0 WD)) - (SETQ Y (RAND 0 HT)) - (BITBLT NIL NIL NIL WINDOW (RAND 0 (IDIFFERENCE WD X)) - (RAND 0 (IDIFFERENCE HT Y)) - X Y 'TEXTURE (SELECTQ (RAND 0 5) - (0 'PAINT) - 'INVERT) - (SELECTQ (AND CHECKSHADE (RAND 0 12)) - (0 CHECKSHADE) - BLACKSHADE)) - (BLOCK 100]) + (while (NEQ (WINDOWPROP WINDOW 'CLOSE) + T) do (SETQ X (RAND 0 WD)) + (SETQ Y (RAND 0 HT)) + (BITBLT NIL NIL NIL WINDOW (RAND 0 (IDIFFERENCE WD X)) + (RAND 0 (IDIFFERENCE HT Y)) + X Y 'TEXTURE (SELECTQ (RAND 0 5) + (0 'PAINT) + 'INVERT) + (SELECTQ (AND CHECKSHADE (RAND 0 12)) + (0 CHECKSHADE) + BLACKSHADE)) + (BLOCK 100) finally (WINDOWPROP WINDOW 'CLOSE NIL]) ) (RPAQQ CHECKSHADE 63903) @@ -47,7 +50,6 @@ Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation. (RPAQQ KINETICWINDOW NIL) (ADDTOVAR IDLE.FUNCTIONS (Kinetic 'KINETIC)) -(PUTPROPS KINETIC COPYRIGHT ("Xerox Corporation" 1982 1985 1986 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (573 1723 (KINETIC 583 . 1721))))) + (FILEMAP (NIL (534 2130 (KINETIC 544 . 2128))))) STOP diff --git a/lispusers/KINETIC.LCOM b/lispusers/KINETIC.LCOM index e6e4c426..1e5025ef 100644 Binary files a/lispusers/KINETIC.LCOM and b/lispusers/KINETIC.LCOM differ diff --git a/lispusers/MANAGER b/lispusers/MANAGER index 3f735c76..304f957c 100644 --- a/lispusers/MANAGER +++ b/lispusers/MANAGER @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "21-May-2024 18:45:54" {LU}MANAGER.;4 102968 +(FILECREATED " 5-Jan-2026 12:41:54" {DSK}matt>Interlisp>medley>lispusers>MANAGER.;5 106149 :EDIT-BY "mth" - :CHANGES-TO (FNS Manager.DO.COMMAND) + :CHANGES-TO (ADVICE ADDTOFILES? ADDTOCOMS LOAD LOADFNS MAKEFILE MARKASCHANGED UNMARKASCHANGED + DELFROMCOMS UPDATEFILES \ADDTOFILEBLOCK/ADDNEWCOM ADDFILE) - :PREVIOUS-DATE "20-May-2024 11:16:10" {LU}MANAGER.;3) + :PREVIOUS-DATE " 5-Jan-2026 12:35:04" {DSK}matt>Interlisp>medley>lispusers>MANAGER.;4) (PRETTYCOMPRINT MANAGERCOMS) @@ -1545,66 +1546,105 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB (RPLACA LST (CDAR LST)))]) ) -[XCL:REINSTALL-ADVICE 'ADDFILE :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) - *) - (AND Manager.ACTIVEFLG (Manager.CHECKFILE FILE))) - ] +[XCL:REINSTALL-ADVICE 'ADDFILE :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG) + (Manager.ACTIVEFLG NIL)) + (DECLARE (SPECVARS Manager.ACTIVEFLG)) + (PROG1 * + (AND (SETQ Manager.ACTIVEFLG + Orig.Manager.ACTIVELFG) + (Manager.CHECKFILE FILE)))] -[XCL:REINSTALL-ADVICE 'ADDTOFILES? :AROUND '((:LAST (PROG1 (LET ((MANAGER-ADDTOFILES? T)) - *) - (AND Manager.ACTIVEFLG (Manager.ADDTOFILES?))) - ] +[XCL:REINSTALL-ADVICE 'ADDTOFILES? :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG) + (Manager.ACTIVEFLG NIL)) + (DECLARE (SPECVARS Manager.ACTIVEFLG)) + (PROG1 * + (AND (SETQ Manager.ACTIVEFLG + Orig.Manager.ACTIVELFG) + (Manager.ADDTOFILES?)))] -[XCL:REINSTALL-ADVICE 'MAKEFILE :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) - *) - (AND Manager.ACTIVEFLG (Manager.MAKEFILE.ADV - FILE OPTIONS)))] +[XCL:REINSTALL-ADVICE 'MAKEFILE :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG) + (Manager.ACTIVEFLG NIL)) + (DECLARE (SPECVARS Manager.ACTIVEFLG)) + (PROG1 * + (AND (SETQ Manager.ACTIVEFLG + Orig.Manager.ACTIVELFG) + (Manager.MAKEFILE.ADV FILE OPTIONS))) + ] -[XCL:REINSTALL-ADVICE 'MARKASCHANGED :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) - *) - (AND Manager.ACTIVEFLG - (Manager.ALTERMARKING NAME TYPE - (OR REASON T))))] +[XCL:REINSTALL-ADVICE 'MARKASCHANGED :AROUND + '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG) + (Manager.ACTIVEFLG NIL)) + (DECLARE (SPECVARS Manager.ACTIVEFLG)) + (PROG1 * + (AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG) + (Manager.ALTERMARKING NAME TYPE (OR REASON T))))] [XCL:REINSTALL-ADVICE 'UNMARKASCHANGED :AROUND - '((:LAST (LET (!VALUE) - (PROG1 (LET ((Manager.ACTIVEFLG NIL)) - (SETQ !VALUE *)) - (AND Manager.ACTIVEFLG !VALUE (Manager.ALTERMARKING NAME TYPE NIL)))] + '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG) + (Manager.ACTIVEFLG NIL) + !VALUE) + (DECLARE (SPECVARS Manager.ACTIVEFLG)) + (PROG1 (SETQ !VALUE *) + (AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG) + !VALUE + (Manager.ALTERMARKING NAME TYPE NIL)))] -[XCL:REINSTALL-ADVICE 'UPDATEFILES :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) - *) - (AND Manager.ACTIVEFLG (Manager.MAINUPDATE - T)))] +[XCL:REINSTALL-ADVICE 'UPDATEFILES :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG) + (Manager.ACTIVEFLG NIL)) + (DECLARE (SPECVARS Manager.ACTIVEFLG)) + (PROG1 * + (AND (SETQ Manager.ACTIVEFLG + Orig.Manager.ACTIVELFG) + (Manager.MAINUPDATE T)))] [XCL:REINSTALL-ADVICE 'ADDTOCOMS :AROUND - '((:LAST (LET (!VALUE) - (PROG1 (LET ((Manager.ACTIVEFLG NIL)) - (SETQ !VALUE *)) - (AND Manager.ACTIVEFLG (Manager.ADDADV !VALUE COMS NAME TYPE)))] + '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG) + (Manager.ACTIVEFLG NIL) + !VALUE) + (DECLARE (SPECVARS Manager.ACTIVEFLG)) + (PROG1 (SETQ !VALUE *) + (AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG) + (Manager.ADDADV !VALUE COMS NAME TYPE)))] [XCL:REINSTALL-ADVICE 'DELFROMCOMS :AROUND - '((:LAST (LET (!VALUE) - (PROG1 (LET ((Manager.ACTIVEFLG NIL)) - (SETQ !VALUE *)) - (AND Manager.ACTIVEFLG (Manager.ADDADV !VALUE COMS NAME TYPE)))] + '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG) + (Manager.ACTIVEFLG NIL) + !VALUE) + (DECLARE (SPECVARS Manager.ACTIVEFLG)) + (PROG1 (SETQ !VALUE *) + (AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG) + (Manager.ADDADV !VALUE COMS NAME TYPE)))] [XCL:REINSTALL-ADVICE '\ADDTOFILEBLOCK/ADDNEWCOM :AROUND - '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) - *) - (AND Manager.ACTIVEFLG (Manager.RESETSUBITEMS FILE TYPE)))] + '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG) + (Manager.ACTIVEFLG NIL)) + (DECLARE (SPECVARS Manager.ACTIVEFLG)) + (PROG1 * + (AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG) + (Manager.RESETSUBITEMS FILE TYPE)))] -[XCL:REINSTALL-ADVICE 'LOAD :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) - *) - (if Manager.ACTIVEFLG - then (Manager.REMOVE.DUPLICATE.ADVICE FILE) - (Manager.CHECKFILE FILE)))] +[XCL:REINSTALL-ADVICE 'LOAD :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG) + (Manager.ACTIVEFLG NIL)) + (DECLARE (SPECVARS Manager.ACTIVEFLG)) + (PROG1 * + (AND (SETQ Manager.ACTIVEFLG + Orig.Manager.ACTIVELFG) + (if Manager.ACTIVEFLG + then (Manager.REMOVE.DUPLICATE.ADVICE + FILE) + (Manager.CHECKFILE FILE))))] -[XCL:REINSTALL-ADVICE 'LOADFNS :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) - *) - (if Manager.ACTIVEFLG - then (Manager.REMOVE.DUPLICATE.ADVICE FILE) - (Manager.CHECKFILE FILE)))] +[XCL:REINSTALL-ADVICE 'LOADFNS :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG) + (Manager.ACTIVEFLG NIL)) + (DECLARE (SPECVARS Manager.ACTIVEFLG)) + (PROG1 * + (AND (SETQ Manager.ACTIVEFLG + Orig.Manager.ACTIVELFG) + (if Manager.ACTIVEFLG + then ( + Manager.REMOVE.DUPLICATE.ADVICE + FILE) + (Manager.CHECKFILE FILE))))] [XCL:REINSTALL-ADVICE '(MARKASCHANGED :IN DEFAULT.EDITDEFA0001) :AROUND @@ -1710,20 +1750,20 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB ) (PUTPROPS MANAGER COPYRIGHT (NONE)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (25632 93132 (MANAGER 25642 . 26441) (MANAGER.RESET 26443 . 27957) (Manager.ADDADV 27959 - . 29312) (Manager.ADDTOFILES? 29314 . 29592) (Manager.ALTERMARKING 29594 . 31204) ( -Manager.ANCHORED-SET-POSITION 31206 . 32309) (Manager.DO.COMMAND 32311 . 33918) ( -Manager.DO.COMMAND.PROCFN 33920 . 53275) (Manager.HIGHLIGHT 53277 . 53574) (Manager.PROMPT 53576 . -53889) (Manager.WINDOW 53891 . 54524) (Manager.insurefilehighlights 54526 . 55597) (Manager.CHANGED? -55599 . 56148) (Manager.CHECKFILE 56150 . 57249) (Manager.COLLECTCOMS 57251 . 58689) (Manager.COMS.WSF - 58691 . 61361) (Manager.COMSOPEN 61363 . 66101) (Manager.COMSUPDATE 66103 . 67195) ( -Manager.HIGHLIGHTED 67197 . 67503) (Manager.INSUREHIGHLIGHTS 67505 . 68063) (Manager.FILECHANGES 68065 - . 68364) (Manager.FILELSTCHANGED? 68366 . 68694) (Manager.FILESUBTYPES 68696 . 69334) ( -Manager.GET.ENVIRONMENT 69336 . 71874) (Manager.GETFILE 71876 . 74190) (Manager.INTITLE? 74192 . 74870 -) (Manager.MAIN.WSF 74872 . 77516) (Manager.MAINCLOSE 77518 . 78628) (Manager.MAINMENUITEMS 78630 . -79707) (Manager.MAINOPEN 79709 . 85102) (Manager.MAINUPDATE 85104 . 85740) (Manager.MAKEFILE.ADV 85742 - . 86778) (Manager.MENUCOLUMNS 86780 . 87584) (Manager.MENUHASITEM 87586 . 87943) (Manager.MENUITEMS -87945 . 88190) (Manager.REMOVE.DUPLICATE.ADVICE 88192 . 89798) (Manager.RESETSUBITEMS 89800 . 91037) ( -Manager.SET-ANCHOR 91039 . 91358) (Manager.SORT.COMS 91360 . 91892) (Manager.SORTBYCOLUMN 91894 . -93130))))) + (FILEMAP (NIL (25852 93352 (MANAGER 25862 . 26661) (MANAGER.RESET 26663 . 28177) (Manager.ADDADV 28179 + . 29532) (Manager.ADDTOFILES? 29534 . 29812) (Manager.ALTERMARKING 29814 . 31424) ( +Manager.ANCHORED-SET-POSITION 31426 . 32529) (Manager.DO.COMMAND 32531 . 34138) ( +Manager.DO.COMMAND.PROCFN 34140 . 53495) (Manager.HIGHLIGHT 53497 . 53794) (Manager.PROMPT 53796 . +54109) (Manager.WINDOW 54111 . 54744) (Manager.insurefilehighlights 54746 . 55817) (Manager.CHANGED? +55819 . 56368) (Manager.CHECKFILE 56370 . 57469) (Manager.COLLECTCOMS 57471 . 58909) (Manager.COMS.WSF + 58911 . 61581) (Manager.COMSOPEN 61583 . 66321) (Manager.COMSUPDATE 66323 . 67415) ( +Manager.HIGHLIGHTED 67417 . 67723) (Manager.INSUREHIGHLIGHTS 67725 . 68283) (Manager.FILECHANGES 68285 + . 68584) (Manager.FILELSTCHANGED? 68586 . 68914) (Manager.FILESUBTYPES 68916 . 69554) ( +Manager.GET.ENVIRONMENT 69556 . 72094) (Manager.GETFILE 72096 . 74410) (Manager.INTITLE? 74412 . 75090 +) (Manager.MAIN.WSF 75092 . 77736) (Manager.MAINCLOSE 77738 . 78848) (Manager.MAINMENUITEMS 78850 . +79927) (Manager.MAINOPEN 79929 . 85322) (Manager.MAINUPDATE 85324 . 85960) (Manager.MAKEFILE.ADV 85962 + . 86998) (Manager.MENUCOLUMNS 87000 . 87804) (Manager.MENUHASITEM 87806 . 88163) (Manager.MENUITEMS +88165 . 88410) (Manager.REMOVE.DUPLICATE.ADVICE 88412 . 90018) (Manager.RESETSUBITEMS 90020 . 91257) ( +Manager.SET-ANCHOR 91259 . 91578) (Manager.SORT.COMS 91580 . 92112) (Manager.SORTBYCOLUMN 92114 . +93350))))) STOP diff --git a/lispusers/MANAGER.DFASL b/lispusers/MANAGER.DFASL index 4e8028f1..ea108eab 100644 Binary files a/lispusers/MANAGER.DFASL and b/lispusers/MANAGER.DFASL differ diff --git a/lispusers/MODERNIZE.TEDIT b/lispusers/MODERNIZE.TEDIT index 257c0134..1fbc60d5 100644 Binary files a/lispusers/MODERNIZE.TEDIT and b/lispusers/MODERNIZE.TEDIT differ diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index 229d59d0..3a1d3bdf 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -1,30 +1,34 @@ -(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" (USE "XCL" "LISP") (EXPORT "READ-BDF" -"WRITE-BDF-TO-DISPLAYFONT-FILES") (IMPORT \AVGCHARWIDTH \FGETWIDTH \FONTFACE \FONTFILENAME -\FSETOFFSET \FSETWIDTH \FONTSYMBOL \GETSTREAM \INSTALLCHARSETINFO \PUTBASE BITBLT BITMAPCREATE -BITMAPHEIGHT BITMAPWIDTH BLACKSHADE BLTSHADE BOLD CONDENSED CHARSETINFO DISPLAY FONTDESCRIPTOR FONTP -FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) -READTABLE "XCL" BASE 10) +(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" (USE "XCL" "LISP") (EXPORT "READ-BDF" "BUILD-COMPOSITE" + "WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE") (IMPORT-FROM "IL" "BITBLT" "BITMAPBIT" "BITMAPCREATE" +"BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "CHARSETPROP" +"DISPLAY" "FONTDESCRIPTOR" "FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MCCS" "MEDIUM" +"REGULAR" "TCONC" "UTOMCODE?" "MEDLEYFONT.FILENAME" "MEDLEYFONT.WRITE.FONT")) READTABLE "XCL" BASE +10) -(IL:FILECREATED "30-Apr-2025 13:20:10" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;61| 47500 +(IL:FILECREATED " 8-Dec-2025 12:13:40" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;9| 51309 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS GET-FAMILY-FACE-SIZE-FROM-NAME) + :CHANGES-TO (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR) + (FILE-ENVIRONMENTS "READ-BDF") - :PREVIOUS-DATE "25-Apr-2025 10:10:08" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;60| + :PREVIOUS-DATE " 8-Dec-2025 12:12:47" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;8| ) (IL:PRETTYCOMPRINT IL:READ-BDFCOMS) (IL:RPAQQ IL:READ-BDFCOMS - ((IL:STRUCTURES BDF-FONT GLYPH) + ((IL:STRUCTURES BDF-FONT GLYPH XLFD) (IL:VARIABLES MAXCHARSET MAXTHINCHAR NOMAPPINGCHARSET) - (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-FAMILY-FACE-SIZE-FROM-NAME - GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF READ-DELIMITED-LIST-FROM-STRING - READ-GLYPH SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES) - (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:LOADCOMP) - IL:FONT)) + (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR BUILD-COMPOSITE CHAR-PRESENT-BIT + COUNT-MCHARS GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF + READ-DELIMITED-LIST-FROM-STRING READ-GLYPH WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE + XLFD-SPLIT-FONT-NAME XLFD-TO-FACE) + (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:SYSLOAD) + IL:SYSEDIT) + (IL:FILES (IL:LOADCOMP) + IL:FONT)) (FILE-ENVIRONMENTS "READ-BDF") (IL:PROP (IL:DATABASE) IL:READ-BDF))) @@ -37,95 +41,108 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (METRICSSET 0 :TYPE (INTEGER 0 2)) (PROPERTIES NIL :TYPE LIST) SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR (GLYPHS NIL :TYPE LIST) - (SLUG NIL :TYPE GLYPH)) + (UNMAPPED�GLYPHS NIL :TYPE LIST) + (XLFD NIL :TYPE XLFD) + (MCHAR-PRESENT NIL :TYPE IL:BITMAP)) (DEFSTRUCT GLYPH - "This is an individual BDF glyph. Includes some values calculted for creating CHARSETINFO" + "This is an individual BDF glyph. Includes some values calculated for creating CHARSETINFO" (NAME NIL :TYPE STRING) ENCODING SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR BBW BBH BBXOFF0 BBYOFF0 BITMAP - (XCODE 0 :TYPE INTEGER) + (MCODE 0 :TYPE INTEGER) (WIDTH 0 :TYPE INTEGER) (ASCENT 0 :TYPE INTEGER) (DESCENT 0 :TYPE INTEGER)) +(DEFSTRUCT XLFD + "Hold a parsed XLFD font descriptor" + (FOUNDRY NIL :TYPE STRING) + (FAMILY NIL :TYPE STRING) + (WEIGHT NIL :TYPE STRING) + (SLANT NIL :TYPE STRING) + (SETWIDTH�NAME NIL :TYPE STRING) + (ADD�STYLE�NAME NIL :TYPE STRING) + (PIXEL�SIZE 0 :TYPE INTEGER) + (POINT�SIZE 0 :TYPE INTEGER) + (RESOLUTION�X 0 :TYPE INTEGER) + (RESOLUTION�Y 0 :TYPE INTEGER) + (SPACING NIL :TYPE STRING) + (AVERAGE�WIDTH 0 :TYPE INTEGER) + (CHARSET�REGISTRY NIL :TYPE STRING) + (CHARSET�ENCODING NIL :TYPE STRING)) + (DEFCONSTANT MAXCHARSET 255) (DEFCONSTANT MAXTHINCHAR 255) (DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET)) -(DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUG-OR-WIDTH &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) +(DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUGWIDTH) (IL:* IL:\; "Edited 8-Dec-2025 12:13 by mth") + (IL:* IL:\; "Edited 30-Nov-2025 00:12 by mth") + (IL:* IL:\; "Edited 28-Nov-2025 16:37 by mth") + (IL:* IL:\; "Edited 26-Nov-2025 21:18 by mth") + (IL:* IL:\; "Edited 20-Nov-2025 12:19 by mth") + (IL:* IL:\; "Edited 15-Nov-2025 14:26 by mth") + (IL:* IL:\; "Edited 6-Nov-2025 17:30 by mth") (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") (IL:* IL:\; "Edited 21-Apr-2025 16:23 by mth") (IL:* IL:\; "Edited 30-Jan-2025 16:40 by mth") - (LET (GBCS CSGLYPHS CSLIMITS) + (LET (GBCS CSGLYPHS CSLIMITS SW) (UNLESS (AND (INTEGERP CSET) (<= 0 CSET MAXCHARSET)) (ERROR "Invalid Character set: ~S" CSET) - (IL:* IL:|;;| "Can we get here? I think not!") + (IL:* IL:|;;| "Can we get here? I think not!!") (SETQ CSET 0)) - (SETQ GBCS (COND - ((LISTP FONT) + (COND + ((LISTP FONT) - (IL:* IL:|;;| - "Assuming that FONT is already the LIST of ALIST form of result from GLYPHS-BY-CHARSET") + (IL:* IL:|;;| + "Assuming that FONT is already the LIST of ALIST form of result from GLYPHS-BY-CHARSET") - FONT) - ((BDF-FONT-P FONT) + (SETQ GBCS FONT)) + ((BDF-FONT-P FONT) - (IL:* IL:|;;| - "If passed a BDF-FONT, look only at glyphs in the mapped charsets") + (IL:* IL:|;;| "If passed a BDF-FONT, look only at glyphs in the mapped charsets") - (FIRST (GLYPHS-BY-CHARSET FONT MAP-UNKNOWN-TO-PRIVATE))) - (T (ERROR "Invalid FONT: ~S" FONT)))) + (DESTRUCTURING-SETQ (GBCS SW) + (GLYPHS-BY-CHARSET FONT))) + (T (ERROR "Invalid FONT: ~S" FONT))) + (UNLESS (AND (INTEGERP SLUGWIDTH) + (PLUSP SLUGWIDTH)) + (IF (AND (INTEGERP SW) + (PLUSP SW)) + (SETQ SLUGWIDTH SW) + (ERROR "Invalid SLUGWIDTH: ~D" SLUGWIDTH))) (WHEN (SETQ CSGLYPHS (SECOND (ASSOC CSET GBCS))) (LET ((TOTAL-WIDTH 0) (ASCENT 0) (DESCENT 0) (FIRSTCHAR MOST-POSITIVE-FIXNUM) (LASTCHAR MOST-NEGATIVE-FIXNUM) - (CSINFO (IL:|create| CHARSETINFO)) + (CSINFO (IL:|create| CHARSETINFO + IL:CHARSETNO IL:_ CSET)) + (IMAGEWIDTHS (IL:\\CREATECSINFOELEMENT)) (DLEFT 0) - SLUG SLUGWIDTH GLYPHS-LIMITS BMAP OFFSETS HEIGHT WIDTHS) - (COND - ((GLYPH-P SLUG-OR-WIDTH) - (SETQ SLUG SLUG-OR-WIDTH) - (SETQ SLUGWIDTH (1+ (GLYPH-WIDTH SLUG))) - (SETQ ASCENT (MAX ASCENT (GLYPH-ASCENT SLUG))) - (SETQ DESCENT (MAX DESCENT (GLYPH-DESCENT SLUG)))) - ((INTEGERP SLUG-OR-WIDTH) - (SETQ SLUGWIDTH SLUG-OR-WIDTH)) - (T (ERROR "Invalid SLUG-OR-WIDTH: ~S" SLUG-OR-WIDTH))) - (SETQ CSGLYPHS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT (LET* ((XCODE (CAR XGL)) - (GL (CDR XGL)) - (GWIDTH (GLYPH-WIDTH - GL)) - (ASC (GLYPH-ASCENT GL)) - (DSC (GLYPH-DESCENT - GL))) + GLYPHS-LIMITS BMAP OFFSETS HEIGHT WIDTHS) + (CHARSETPROP CSINFO 'IL:CSCHARENCODING 'MCCS) + (LOOP :FOR XGL :IN CSGLYPHS :DO (LET* ((MCODE (CAR XGL)) + (GL (CDR XGL)) + (GWIDTH (GLYPH-WIDTH GL)) + (ASC (GLYPH-ASCENT GL)) + (DSC (GLYPH-DESCENT GL))) (IL:* IL:|;;| "It's possible that ALL glyphs in the character set are above the baseline. In that case, the GLYPH-DESCENT calculated by READ-GLYPH will not give a useful value, since it is >= 0. Investigate correcting this.") - (IL:* IL:|;;| - - "Is the above statement actually true?") + (IL:* IL:|;;| + "Is the above statement actually true?") - (SETF (GLYPH-XCODE GL) - XCODE) - (SETQ FIRSTCHAR - (MIN FIRSTCHAR XCODE - )) - (SETQ LASTCHAR - (MAX LASTCHAR XCODE) - ) - (INCF TOTAL-WIDTH GWIDTH) - (SETQ ASCENT - (MAX ASCENT ASC)) - (SETQ DESCENT - (MAX DESCENT DSC)) - GL))) + (SETQ FIRSTCHAR (MIN FIRSTCHAR MCODE)) + (SETQ LASTCHAR (MAX LASTCHAR MCODE)) + (INCF TOTAL-WIDTH GWIDTH) + (SETQ ASCENT (MAX ASCENT ASC)) + (SETQ DESCENT (MAX DESCENT DSC)))) (IL:|replace| (CHARSETINFO IL:CHARSETASCENT) IL:|of| CSINFO IL:|with| ASCENT) (IL:|replace| (CHARSETINFO IL:CHARSETDESCENT) IL:|of| CSINFO IL:|with| DESCENT) (SETQ OFFSETS (IL:|fetch| (CHARSETINFO IL:OFFSETS) IL:|of| CSINFO)) @@ -133,15 +150,19 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (IL:* IL:|;;| "Initialize the offsets to the TOTAL-WIDTH (without the SLUG. It will be added later)") - (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETOFFSET OFFSETS I + (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETOFFSET OFFSETS I TOTAL-WIDTH)) + + (IL:* IL:|;;| "Now WIDTHS is NOT the IMAGEWIDTHS array. BDF provides both, and MEDLEYDISPLAYFONT can persist both.") + (SETQ WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO)) (IL:* IL:|;;| "Initialize the widths to SLUGWIDTH") - (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETWIDTH WIDTHS I + (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETWIDTH + IMAGEWIDTHS I SLUGWIDTH)) - (IL:|replace| (CHARSETINFO IL:IMAGEWIDTHS) IL:|of| CSINFO IL:|with| WIDTHS) + (IL:|replace| (CHARSETINFO IL:IMAGEWIDTHS) IL:|of| CSINFO IL:|with| IMAGEWIDTHS) (IL:* IL:|;;| "JDS 12/4/92: Apparently, these fields can be signed values, if all chars, e.g., ride above the base line. ") @@ -151,322 +172,284 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SETQ BMAP (BITMAPCREATE (+ TOTAL-WIDTH SLUGWIDTH) HEIGHT 1)) (IL:|replace| (CHARSETINFO IL:CHARSETBITMAP) IL:|of| CSINFO IL:|with| BMAP) - (LOOP :FOR GL :IN CSGLYPHS :WITH GLBM :WITH GLW :WITH XCODE :DO (SETQ GLBM - (GLYPH-BITMAP - GL)) + (LOOP :FOR XGL :IN CSGLYPHS :WITH GL :WITH GLBM :WITH GLW :WITH MCODE :DO + (SETQ MCODE (CAR XGL)) + (SETQ GL (CDR XGL)) + (SETQ GLBM (GLYPH-BITMAP GL)) (SETQ GLW (GLYPH-WIDTH GL)) - (SETQ XCODE (GLYPH-XCODE GL)) - (BITBLT GLBM 0 0 BMAP (+ DLEFT (MAX 0 (GLYPH-BBXOFF0 GL))) - (+ DESCENT (GLYPH-BBYOFF0 GL)) - (BITMAPWIDTH GLBM) - (BITMAPHEIGHT GLBM) - 'INPUT - 'IL:REPLACE) - (\\FSETOFFSET OFFSETS XCODE DLEFT) - (\\FSETOFFSET WIDTHS XCODE GLW) + (WHEN GLBM + + (IL:* IL:|;;| "Empty bitmap, nothing to copy.") + + (BITBLT GLBM 0 0 BMAP (+ DLEFT (MAX 0 (GLYPH-BBXOFF0 GL))) + (+ DESCENT (GLYPH-BBYOFF0 GL)) + (BITMAPWIDTH GLBM) + (BITMAPHEIGHT GLBM) + 'INPUT + 'IL:REPLACE)) + (IL:\\FSETOFFSET OFFSETS MCODE DLEFT) + (IL:\\FSETOFFSET IMAGEWIDTHS MCODE GLW) + (IL:\\FSETOFFSET WIDTHS MCODE (FIRST (GLYPH-DWIDTH GL))) (INCF DLEFT GLW)) - (IL:* IL:|;;| "Now insert the SLUG glyph into the BMAP, or make a slug (block)") + (IL:* IL:|;;| "Now make a slug (block)") - (IF SLUG - (LET ((GLBM (GLYPH-BITMAP SLUG))) - (BITBLT GLBM 0 0 BMAP (+ TOTAL-WIDTH (MAX 0 (GLYPH-BBXOFF0 SLUG))) - (+ DESCENT (GLYPH-BBYOFF0 SLUG)) - (BITMAPWIDTH GLBM) - (BITMAPHEIGHT GLBM) - 'INPUT - 'IL:REPLACE)) - (BLTSHADE BLACKSHADE BMAP (1+ TOTAL-WIDTH) - 0 - (1- SLUGWIDTH) - (+ ASCENT DESCENT) - 'IL:REPLACE)) + (BLTSHADE BLACKSHADE BMAP (1+ TOTAL-WIDTH) + 0 + (1- SLUGWIDTH) + (+ ASCENT DESCENT) + 'IL:REPLACE) CSINFO)))) -(DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE &OPTIONAL - MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) +(DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE) + (IL:* IL:\; "Edited 8-Dec-2025 12:11 by mth") + (IL:* IL:\; "Edited 2-Dec-2025 16:10 by mth") + (IL:* IL:\; "Edited 30-Nov-2025 15:59 by mth") + (IL:* IL:\; "Edited 28-Nov-2025 18:03 by mth") + (IL:* IL:\; "Edited 20-Nov-2025 12:46 by mth") + (IL:* IL:\; "Edited 5-Nov-2025 16:09 by mth") (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth") (IL:* IL:\; "Edited 30-Jan-2025 21:27 by mth") - (WHEN (AND (BDF-FONT-P BDFONT) - FAMILY) (IL:* IL:\; "FAMILY Cannot be NIL") - (PROG* ((SLUG (BF-SLUG BDFONT)) - (SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG))) - FONTDESC DEV GBCSL CHARSETS) - (WHEN (FONTP FAMILY) - (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FONTPROP FAMILY 'IL:FAMILY) - (OR SIZE (FONTPROP FAMILY 'IL:SIZE)) - (OR FACE (FONTPROP FAMILY 'IL:FACE)) - (OR ROTATION (FONTPROP FAMILY 'IL:ROTATION)) - (OR DEVICE (FONTPROP FAMILY 'IL:DEVICE)) - MAP-UNKNOWN-TO-PRIVATE))) - (WHEN (LISTP FAMILY) - (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FIRST FAMILY) - (OR (SECOND FAMILY) - SIZE) - (OR (THIRD FAMILY) - FACE "MRR") - (OR (FOURTH FAMILY) - ROTATION 0) - (OR (FIFTH FAMILY) - DEVICE - 'DISPLAY) - MAP-UNKNOWN-TO-PRIVATE))) - (SETQ FAMILY (\\FONTSYMBOL FAMILY)) - (UNLESS (AND (INTEGERP SIZE) - (PLUSP SIZE)) - (ERROR "Invalid SIZE: ~S~%" SIZE)) - (COND - ((NULL ROTATION) - (SETQ ROTATION 0)) - ((NOT (AND (INTEGERP ROTATION) - (>= ROTATION 0))) - (IL:\\ILLEGAL.ARG ROTATION))) - (SETQ DEV DEVICE) - (SETQ DEV (COND - ((NULL DEVICE) - 'DISPLAY) - ((AND (SYMBOLP DEVICE) - (NOT (EQ DEVICE T))) - (IL:* IL:|;;| + (IL:* IL:|;;| "Check valid required argument") + + (WHEN (BDF-FONT-P BDFONT) + (WHEN (FONTP FAMILY) + (RETURN-FROM BDF-TO-FONTDESCRIPTOR (BDF-TO-FONTDESCRIPTOR BDFONT (FONTPROP FAMILY + 'IL:FAMILY) + (OR SIZE (FONTPROP FAMILY 'IL:SIZE)) + (OR FACE (FONTPROP FAMILY 'IL:FACE)) + (OR ROTATION (FONTPROP FAMILY 'IL:ROTATION)) + (OR DEVICE (FONTPROP FAMILY 'IL:DEVICE))))) + (WHEN (CONSP FAMILY) (IL:* IL:\; + "Because (LISTP NIL) == T !!!") + + (IL:* IL:|;;| "Assume this is a FONTSPEC.") + + (RETURN-FROM BDF-TO-FONTDESCRIPTOR (BDF-TO-FONTDESCRIPTOR BDFONT (IL:|fetch| (IL:FONTSPEC + IL:FSFAMILY) + IL:|of| FAMILY) + (OR SIZE (IL:|fetch| (IL:FONTSPEC IL:FSSIZE) + IL:|of| FAMILY)) + (OR FACE (IL:|fetch| (IL:FONTSPEC IL:FSFACE) + IL:|of| FAMILY) + 'IL:MRR) + (OR ROTATION (IL:|fetch| (IL:FONTSPEC + IL:FSROTATION) + IL:|of| FAMILY) + 0) + (OR DEVICE (IL:|fetch| (IL:FONTSPEC IL:FSDEVICE) + IL:|of| FAMILY) + 'DISPLAY)))) + (LET ((XLFD (BF-XLFD BDFONT)) + FONTDESC GBCSL CHARSETS SLUGWIDTH) + (SETQ FAMILY (IL:\\FONTSYMBOL (OR FAMILY (XLFD-FAMILY XLFD)))) + (SETQ FACE (OR FACE (XLFD-TO-FACE XLFD))) + (SETQ SIZE (OR SIZE (AND (>= (XLFD-PIXEL�SIZE XLFD) + 0) + (XLFD-PIXEL�SIZE XLFD)) + (AND (>= (XLFD-POINT�SIZE XLFD) + 0) + (CEILING (XLFD-POINT�SIZE XLFD) + 10)) + (FIRST (BF-SIZE BDFONT)))) + (COND + ((NULL ROTATION) + (SETQ ROTATION 0)) + ((NOT (AND (IL:SMALLP ROTATION) + (>= ROTATION 0))) + (IL:\\ILLEGAL.ARG ROTATION))) + (SETQ DEVICE (COND + ((OR (NULL DEVICE) + (EQ DEVICE T)) + 'DISPLAY) + ((SYMBOLP DEVICE) + + (IL:* IL:|;;| + "This PROBABLY isn't a good assumption... BUT it's a very unlikely case.") + + (IL:* IL:|;;| "Maybe wrong case or package, but we bet it's OK and defer expensive coercion until we've failed.") - DEVICE) - ((STRINGP DEVICE) - (INTERN (STRING-UPCASE DEVICE) - "IL")) - (T (IL:\\ILLEGAL.ARG DEVICE)))) - (SETQ FACE (\\FONTFACE FACE NIL DEV)) - (SETQ GBCSL (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)) - (UNLESS SLUGWIDTH + DEVICE) + ((STRINGP DEVICE) + (INTERN (STRING-UPCASE DEVICE) + "IL")) + (T (IL:\\ILLEGAL.ARG DEVICE)))) + (SETQ FACE (IL:\\FONTFACE (OR FACE (XLFD-TO-FACE XLFD) + 'IL:MRR) + NIL DEVICE)) + (DESTRUCTURING-SETQ (GBCSL SLUGWIDTH) + (GLYPHS-BY-CHARSET BDFONT)) + (UNLESS SLUGWIDTH - (IL:* IL:|;;| - "If GLYPHS-BY-CHARSET didn't determine the SLUG width, use 60% of the SIZE, at least 1") + (IL:* IL:|;;| + "If GLYPHS-BY-CHARSET didn't determine the SLUGWIDTH, use 60% of the SIZE, at least 1") - (SETQ SLUGWIDTH (OR (THIRD GBCSL) - (MAX 1 (ROUND (* 0.6 SIZE)))))) - (FLET ((GBCS-TO-FONTDESC - (GBCS FAMILY) - (LET (FONTDESC CHARSETS) - (WHEN GBCS - (SETQ FONTDESC - (IL:|create| FONTDESCRIPTOR - IL:FONTDEVICE IL:_ DEV - IL:FONTFAMILY IL:_ FAMILY - IL:FONTSIZE IL:_ SIZE - IL:FONTFACE IL:_ FACE - IL:|\\SFAscent| IL:_ 0 - IL:|\\SFDescent| IL:_ 0 - IL:|\\SFHeight| IL:_ 0 - IL:ROTATION IL:_ ROTATION - IL:FONTDEVICESPEC IL:_ (LIST FAMILY SIZE FACE ROTATION - DEV))) - (SETQ CHARSETS (LOOP :FOR CS :IN GBCS :WITH CSET :WITH CSINFO :NCONC - (WHEN (<= 0 (SETQ CSET (FIRST CS)) - MAXCHARSET) - (SETQ CSINFO (BDF-TO-CHARSETINFO - GBCS CSET (OR SLUG (1+ - SLUGWIDTH - )))) - (\\INSTALLCHARSETINFO FONTDESC CSINFO CSET) - (LIST CSET))))) - (LIST FONTDESC CHARSETS)))) - (RETURN (VALUES-LIST (NCONC (GBCS-TO-FONTDESC (FIRST GBCSL) - FAMILY) - (GBCS-TO-FONTDESC (SECOND GBCSL) - (\\FONTSYMBOL (CONCATENATE 'STRING - (SYMBOL-NAME FAMILY) - "-UNMAPPED"))) - (LIST (ASSOC NOMAPPINGCHARSET (FIRST GBCSL) - :TEST - #'EQL))))))))) + (SETQ SLUGWIDTH (MAX 1 (ROUND (* 0.6 SIZE))))) + (WHEN GBCSL + (SETQ FONTDESC + (IL:|create| FONTDESCRIPTOR + IL:FONTDEVICE IL:_ DEVICE + IL:FONTFAMILY IL:_ FAMILY + IL:FONTSIZE IL:_ SIZE + IL:FONTFACE IL:_ FACE + IL:|\\SFAscent| IL:_ 0 + IL:|\\SFDescent| IL:_ 0 + IL:|\\SFHeight| IL:_ 0 + IL:ROTATION IL:_ ROTATION + IL:FONTDEVICESPEC IL:_ (LIST FAMILY SIZE FACE ROTATION DEVICE) + IL:FONTSLUGWIDTH IL:_ SLUGWIDTH + IL:FONTCHARENCODING IL:_ 'MCCS)) + (SETQ CHARSETS (LOOP :FOR CS :IN GBCSL :WITH CSET :WITH CSINFO :NCONC + (WHEN (<= 0 (SETQ CSET (FIRST CS)) + MAXCHARSET) + (SETQ CSINFO (BDF-TO-CHARSETINFO GBCSL CSET (1+ SLUGWIDTH))) + (IL:\\INSTALLCHARSETINFO FONTDESC CSINFO CSET) + (LIST CSET))))) + (LIST FONTDESC CHARSETS)))) -(DEFUN GET-FAMILY-FACE-SIZE-FROM-NAME (BDFONT) (IL:* IL:\; "Edited 30-Apr-2025 13:18 by mth") - (IL:* IL:\; "Edited 23-Apr-2025 16:20 by mth") - (IL:* IL:\; "Edited 5-Feb-2025 12:56 by mth") - (UNLESS (TYPEP BDFONT 'BDF-FONT) - (ERROR "Not a BDF-FONT: ~S~%" BDFONT)) - (DESTRUCTURING-BIND (FOUNDRY FAMILY WEIGHT SLANT EXPANSION ADD_STYLE_NAME - PIXEL-SIZE POINT-SIZE) - (SPLIT-FONT-NAME (BF-NAME BDFONT)) (IL:* IL:\; "Parse as XLFD format") - (DECLARE (IGNORE FOUNDRY ADD_STYLE_NAME)) (IL:* IL:\; - "Don't need FOUNDRY or ADD_STYLE_NAME") - (SETQ FAMILY (REMOVE #\Space FAMILY :TEST #'CHAR=)) - (SETQ WEIGHT (OR (AND WEIGHT (CDR (ASSOC (CHAR-UPCASE (ELT WEIGHT 0)) - '((#\R . MEDIUM) - (#\M . MEDIUM) - (#\N . MEDIUM) - (#\B . BOLD) - (#\D . BOLD) - (#\L . LIGHT))))) - 'MEDIUM)) (IL:* IL:\; "DemiBold => BOLD") - (SETQ SLANT (OR (AND SLANT (CDR (ASSOC (CHAR-UPCASE (ELT SLANT 0)) - '((REGULAR) - (#\R . REGULAR) - (#\I . ITALIC) - (#\O . ITALIC))))) - 'REGULAR)) (IL:* IL:\; "Oblique => ITALIC") - (IL:* IL:\; "Ignore others") - (SETQ EXPANSION (OR (AND EXPANSION (CDR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0)) - '((#\R . REGULAR) - (#\N . REGULAR) - (#\B . BOLD) - (#\S . CONDENSED) - (#\C . CONDENSED))))) - 'REGULAR)) (IL:* IL:\; - "S is for \"SemiCondensed\", Assuming \"Condensed\"") +(DEFUN BUILD-COMPOSITE (FONTS &KEY VERBOSE) (IL:* IL:\; "Edited 1-Dec-2025 23:07 by mth") + (IL:* IL:\; "Edited 30-Nov-2025 12:32 by mth") + (IL:* IL:\; "Edited 26-Nov-2025 21:23 by mth") + (IL:* IL:\; "Edited 18-Nov-2025 21:22 by mth") + (IL:* IL:\; "Edited 16-Nov-2025 18:25 by mth") + (IL:* IL:\; "Edited 14-Nov-2025 17:04 by mth") + (LET* ((BASE-FONT (FIRST (SETQ FONTS (IL:MKLIST FONTS)))) + (FILL-FROM (REST FONTS)) + MCHAR-PRESENT CHAR-COUNT FONT) + (COND + ((OR (STRINGP BASE-FONT) + (PATHNAMEP BASE-FONT)) + (UNLESS (IL:INFILEP BASE-FONT) + (ERROR "Initial font file ~S doesn't exist or is unreadable." (NAMESTRING BASE-FONT) + )) + (WHEN VERBOSE + (FORMAT *STANDARD-OUTPUT* "~&Loading initial font file: ~A~%" (NAMESTRING BASE-FONT) + )) + (SETQ BASE-FONT (READ-BDF BASE-FONT :MCCS-ONLY T :VERBOSE VERBOSE))) + ((NOT (BDF-FONT-P BASE-FONT)) + (ERROR "Initial font (~S) is not a BDF-FONT, nor string, nor pathname." BASE-FONT))) + (WHEN VERBOSE + (FORMAT *STANDARD-OUTPUT* "~&Initial font contains ~D MCCS characters.~%" + (SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT)))) + (SETQ MCHAR-PRESENT (BF-MCHAR-PRESENT BASE-FONT)) + (LOOP :FOR FILL-FONT :IN FILL-FROM :WITH PREV-CC :WHEN FILL-FONT :DO + (COND + ((OR (STRINGP FILL-FONT) + (PATHNAMEP FILL-FONT)) + (UNLESS (IL:INFILEP FILL-FONT) + (ERROR "Subsequent font ~S doesn't exist or is unreadable." (NAMESTRING + FILL-FONT))) + (WHEN VERBOSE + (FORMAT *STANDARD-OUTPUT* "~&Loading subsequent font file: ~A~%" (NAMESTRING + FILL-FONT))) + (SETQ FILL-FONT (READ-BDF FILL-FONT :MCCS-ONLY T :VERBOSE VERBOSE))) + ((NOT (BDF-FONT-P FILL-FONT)) + (ERROR "Subsequent font (~S) is not a BDF-FONT, nor string, nor pathname." + FILL-FONT))) + (SETQ PREV-CC CHAR-COUNT) + (LOOP :FOR GL :IN (BF-GLYPHS FILL-FONT) + :WITH V :DO (SETQ V (GLYPH-ENCODING GL)) + (WHEN (AND (LISTP V) + (EQ (FIRST V) + -1)) + (SETQ V (OR (SECOND V) + -1))) - (IL:* IL:|;;| - "Now check for WEIGHT and EXPANSION both BOLD. If so, change Expansion to REGULAR") + (IL:* IL:|;;| + "Need to change this use of UTOMCODE? based on the CHARSET�REGISTRY of the XLFD of FILL-FONT") - (WHEN (AND (EQ WEIGHT EXPANSION) - (EQ EXPANSION 'BOLD)) - (SETQ EXPANSION 'REGULAR)) - (WHEN (ZEROP (LENGTH PIXEL-SIZE)) - (SETQ PIXEL-SIZE NIL)) - (SETQ POINT-SIZE (COND - ((ZEROP (LENGTH POINT-SIZE)) - NIL) - ((SETQ POINT-SIZE (PARSE-INTEGER POINT-SIZE :JUNK-ALLOWED T)) - (CEILING POINT-SIZE 10)) - (T NIL))) - (LIST FAMILY (LIST WEIGHT SLANT EXPANSION) - (OR (AND PIXEL-SIZE (PARSE-INTEGER PIXEL-SIZE :JUNK-ALLOWED T)) - POINT-SIZE - (FIRST (BF-SIZE BDFONT)))))) + (WHEN (AND (UTOMCODE? V) + (ZEROP (CHAR-PRESENT-BIT MCHAR-PRESENT V))) + (CHAR-PRESENT-BIT MCHAR-PRESENT V 1) -(DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) + (IL:* IL:|;;| + "What other bookkeping of BASE-FONT needs to be done when adding a glyph? Any?") + + (PUSH GL (BF-GLYPHS BASE-FONT)))) + (SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT)) + (WHEN VERBOSE + (FORMAT *STANDARD-OUTPUT* "~&Font ~A supplied ~D additional MCCS characters.~%" + (NAMESTRING FILL-FONT) + (- (SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT)) + PREV-CC)))) + BASE-FONT)) + +(DEFUN CHAR-PRESENT-BIT (BM MCODE &OPTIONAL (NEWBIT -1 SBIT) + &AUX CS CC) (IL:* IL:\; "Edited 26-Nov-2025 09:29 by mth") + (COND + ((NOT (TYPEP BM 'IL:BITMAP)) + (ERROR "BM is not a BITMAP")) + ((NOT (AND (INTEGERP MCODE) + (<= 0 MCODE 65535))) + (ERROR "Invalid MCODE")) + (SBIT (COND + ((OR (EQL NEWBIT 1) + (EQ NEWBIT T)) + (SETQ NEWBIT 1)) + ((OR (EQL NEWBIT 0) + (NULL NEWBIT)) + (SETQ NEWBIT 0)) + (T (ERROR "Invalid NEWBIT"))))) + (LET ((CS (- 255 (LRSH MCODE 8))) + (CC (LOGAND MCODE 255))) + (BITMAPBIT BM CC CS (AND SBIT NEWBIT)))) + +(DEFUN COUNT-MCHARS (BDFONT) (IL:* IL:\; "Edited 29-Nov-2025 23:52 by mth") + (WHEN (BDF-FONT-P BDFONT) + (LET ((MCPBM (BF-MCHAR-PRESENT BDFONT))) + (LOOP :FOR MC :FROM 0 :TO 65535 :COUNT (PLUSP (CHAR-PRESENT-BIT MCPBM MC)))))) + +(DEFUN GLYPHS-BY-CHARSET (FONT) (IL:* IL:\; "Edited 30-Nov-2025 17:36 by mth") + (IL:* IL:\; "Edited 28-Nov-2025 17:24 by mth") + (IL:* IL:\; "Edited 26-Nov-2025 20:50 by mth") + (IL:* IL:\; "Edited 20-Nov-2025 12:01 by mth") + (IL:* IL:\; "Edited 6-Nov-2025 18:11 by mth") + (IL:* IL:\; "Edited 5-Nov-2025 16:18 by mth") (IL:* IL:\; "Edited 21-Apr-2025 15:48 by mth") (IL:* IL:\; "Edited 9-Jan-2025 11:23 by mth") (LET* ((NCSETS (+ MAXCHARSET 2)) (CSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT (CONS NIL)))) - (UTOXFN (COND - (RAW-UNICODE-MAPPING #'IDENTITY) - (MAP-UNKNOWN-TO-PRIVATE #'UTOXCODE) - (T #'UTOXCODE?))) - (SLUG (BF-SLUG FONT)) - (SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG))) - NOMAPPINGCSETS ENC XCODE XCS) - (UNLESS (OR MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) - (SETQ NOMAPPINGCSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT - (CONS NIL))))) - (FLET ((PUT-GLYPH-IN-CHARSET-ARRAY (CODE GLYPH CSARRAY) - (TCONC (AREF CSARRAY (LRSH CODE 8)) + SLUGWIDTH ENC MCODE CS-USED) + (FLET ((PUT-GLYPH-IN-CHARSET-ARRAY (CODE GLYPH CSARRAY &AUX CS) + (TCONC (AREF CSARRAY (SETQ CS (LRSH CODE 8))) (CONS (LOGAND CODE 255) - GLYPH)))) + GLYPH)) + (PUSHNEW CS CS-USED :TEST #'EQL))) (LOOP :FOR GL :IN (BF-GLYPHS FONT) - :UNLESS - (EQ GL SLUG) :DO - (SETQ XCS NIL) - (SETQ ENC (GLYPH-ENCODING GL)) - (WHEN (LISTP ENC) + (SETQ MCODE (GLYPH-MCODE GL)) + (COND + ((AND (INTEGERP MCODE) + (<= 0 MCODE 65535)) - (IL:* IL:|;;| - "Should happen only if -1 is first on ENCODING line in BDF file") + (IL:* IL:|;;| "These assoc with the 8 bit character code within the charset") - (SETQ ENC (OR (SECOND ENC) - -1)) + (PUT-GLYPH-IN-CHARSET-ARRAY MCODE GL CSETS) - (IL:* IL:|;;| - "The -1 case of the (OR ...) shouldn't happen. The (EQ GL SLUG) test above should have caught it") + (IL:* IL:|;;| "Default SLUG width is width of A, in charset 0") - ) - (SETQ XCODE (AND (INTEGERP ENC) - (PLUSP ENC) - (FUNCALL UTOXFN ENC))) - (IF RAW-UNICODE-MAPPING - (COND - ((> ENC 65535) - (WARN "~&Unicode encoding is beyond 16 bits: ~5X" ENC) - (TCONC (AREF CSETS NOMAPPINGCHARSET) - (CONS ENC GL))) - ((AND NIL (= 255 (LOGAND ENC 255))) + (WHEN (AND (NOT SLUGWIDTH) + (ZEROP (LRSH MCODE 8)) + (EQL MCODE (CHAR-CODE #\A))) + (SETQ SLUGWIDTH (GLYPH-WIDTH GL)))) + (T + (IL:* IL:|;;| "Shouldn't happen!") - (IL:* IL:|;;| - "Temporarily? disable this warning in RAW-UNICODE-MAPPING mode") + (ERROR "Invalid MCODE: ~A~%"))))) + (SETQ CSETS (LOOP :FOR I :IN CS-USED :NCONC (LET ((CS (CAR (AREF CSETS I)))) - (WARN - "~&Unicode encoding char byte (~2X,FF)=(~O,377) may not =FF in FONTDESCRIPTOR" - (LRSH ENC 8) - (LRSH ENC 8)) - (TCONC (AREF CSETS NOMAPPINGCHARSET) - (CONS ENC GL))) - (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL CSETS))) - (COND - ((NULL XCODE) + (IL:* IL:|;;| + "Extract the lists from the TCONC pointers") - (IL:* IL:|;;| "These assoc with the Unicode encoding") - - (COND - ((OR (> ENC 65535) - (= 255 (LOGAND ENC 255))) - - (IL:* IL:|;;| - "Unicode encoding is > xFFFF, or encoding low byte is FF, put it in the NOMAPPINGCHARSET") - - (TCONC (AREF CSETS NOMAPPINGCHARSET) - (CONS ENC GL))) - (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL NOMAPPINGCSETS)))) - ((AND (INTEGERP XCODE) - (<= 0 XCODE 65535)) - - (IL:* IL:|;;| - "These assoc with the 8 bit character code within the charset") - - (PUT-GLYPH-IN-CHARSET-ARRAY XCODE GL CSETS) - - (IL:* IL:|;;| "Default SLUG width is width of A.") - - (WHEN (AND (NOT SLUGWIDTH) - (= ENC (CHAR-CODE #\A))) - - (IL:* IL:|;;| "A is the same code in XCCS and UNICODE ") - - (IL:* IL:|;;| - "Comparing with ENC, not XCODE, to look only in charset 0") - - (SETQ SLUGWIDTH (GLYPH-WIDTH GL)))) - ((LISTP XCODE) - - (IL:* IL:|;;| - "These assoc with the 8 bit character code within the charset (like above)") - - (LOOP :FOR XC :IN XCODE :WITH CS :UNLESS (MEMBER (SETQ CS - (LRSH XC 8)) - XCS) - :DO - (PUSH CS XCS) - (PUT-GLYPH-IN-CHARSET-ARRAY XC GL CSETS))) - (T (ERROR "Invalid XCODE: ~A~%")))))) - - (IL:* IL:|;;| "Extract the lists from the TCONC pointers") - - (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :DO (SETF (AREF CSETS I) - (SORT (REMOVE-DUPLICATES - (CAR (AREF CSETS I)) - :TEST - #'EQUAL) - #'< :KEY #'CAR))) - (SETQ CSETS (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :NCONC - (LET ((CS (AREF CSETS I))) - (WHEN CS - (LIST (LIST I CS)))))) - - (IL:* IL:|;;| "Likewise for the NOMAPPINGCSETS, if any.") - - (WHEN NOMAPPINGCSETS - (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :DO - (SETF (AREF NOMAPPINGCSETS I) - (SORT (REMOVE-DUPLICATES (CAR (AREF NOMAPPINGCSETS I)) - :TEST - #'EQUAL) - #'< :KEY #'CAR))) - (SETQ NOMAPPINGCSETS (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :NCONC - (LET ((CS (AREF NOMAPPINGCSETS I))) - (WHEN CS - (LIST (LIST I CS))))))) - (LIST CSETS NOMAPPINGCSETS SLUGWIDTH))) + (SETQ CS (SORT (REMOVE-DUPLICATES + CS :TEST #'EQUAL) + #'< :KEY #'CAR)) + (WHEN CS + (LIST (LIST I CS)))))) + (LIST (SORT CSETS #'< :KEY #'CAR) + SLUGWIDTH))) (DEFMACRO PACKFILENAME.STRING (&WHOLE WHOLE) (IL:* IL:\; "Edited 1-Feb-2025 23:17 by mth") `(IL:PACKFILENAME.STRING ,@(LOOP :FOR X :IN (CDR WHOLE) @@ -488,14 +471,29 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST X)) Y)))) -(DEFUN READ-BDF (PATH &OPTIONAL VERBOSE) (IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth") +(DEFUN READ-BDF (PATH &KEY VERBOSE MCCS-ONLY (EXTERNAL-FORMAT :ISO8859/1)) + (IL:* IL:\; "Edited 1-Dec-2025 22:40 by mth") + (IL:* IL:\; "Edited 30-Nov-2025 11:59 by mth") + (IL:* IL:\; "Edited 28-Nov-2025 17:39 by mth") + (IL:* IL:\; "Edited 26-Nov-2025 22:47 by mth") + (IL:* IL:\; "Edited 19-Nov-2025 23:15 by mth") + (IL:* IL:\; "Edited 14-Nov-2025 16:35 by mth") + (IL:* IL:\; "Edited 30-Apr-2025 13:37 by mth") + (IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth") (IL:* IL:\; "Edited 17-Apr-2025 15:10 by mth") (IL:* IL:\; "Edited 12-Jul-2024 23:02 by mth") (LET - (PROPS PROPS-COMPLETE CHARS-COUNT FONT-COMPLETE FONT POS KEY V VV LINE ITEMS GL (NGLYPHS 0) - (*PACKAGE* (FIND-PACKAGE "BDF"))) + ((NGLYPHS 0) + (MCHAR-PRESENT (BITMAPCREATE 256 256 1)) + (*PACKAGE* (FIND-PACKAGE "BDF")) + (MAPPED-GLYPHS (LIST NIL)) + (UNMAPPED-GLYPHS (LIST NIL)) + PROPS PROPS-COMPLETE CHARS-COUNT FONT-COMPLETE FONT POS KEY V VV LINE ITEMS GL XLFD) + + (IL:* IL:|;;| "Note: The EXTERNAL-FORMAT *ought* to be :UTF-8 for the BDF files from otf2bdf, but I'm seeing :ISO8859/1. I don't know why! But I'm setting the default :EXTERNAL-FORMAT appropriately for this.") + (WITH-OPEN-FILE - (FILE-STREAM PATH :ELEMENT-TYPE 'CHARACTER :DIRECTION :INPUT) + (FILE-STREAM PATH :ELEMENT-TYPE 'CHARACTER :DIRECTION :INPUT :EXTERNAL-FORMAT EXTERNAL-FORMAT) (LOOP :WHILE (STRING-EQUAL "COMMENT" (SETQ KEY (READ FILE-STREAM))) :DO @@ -508,7 +506,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (IL:* IL:|;;| "ignore the file format version number") (READ-LINE FILE-STREAM) - (SETQ FONT (MAKE-BDF-FONT)) + (SETQ FONT (MAKE-BDF-FONT :MCHAR-PRESENT MCHAR-PRESENT)) (LOOP :UNTIL FONT-COMPLETE :DO (SETQ LINE (READ-LINE FILE-STREAM)) (WHEN LINE (IL:* IL:\; "Ignore blank lines") @@ -520,7 +518,9 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (COND ((EQ KEY 'FONT) (SETF (BF-NAME FONT) - LINE)) + LINE) + (SETF (BF-XLFD FONT) + (SETQ XLFD (XLFD-SPLIT-FONT-NAME LINE)))) (T (SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE)) (CASE KEY @@ -586,31 +586,56 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (PLUSP NGLYPHS)) (ERROR "Invalid BDF file - CHARS count (~A) is invalid or missing." NGLYPHS)) + (LOOP :REPEAT NGLYPHS :WITH ENC :WITH MC :DO (SETQ GL (READ-GLYPH + FILE-STREAM + FONT)) + (SETQ ENC (GLYPH-ENCODING GL)) + (WHEN (AND (LISTP ENC) + (EQ (FIRST ENC) + -1)) + (SETQ ENC (OR (SECOND ENC) + -1))) + (COND + ((AND (OR (PLUSP (GLYPH-BBW GL)) + (PLUSP (FIRST (GLYPH-DWIDTH GL)))) + (SETQ MC (UTOMCODE? ENC))) + + (IL:* IL:|;;| "This glyph must have either a non-zero-width \"image\" or a non-zero-width \"escapement\", otherwise it cannot be mapped, no matter the UTOMCODE? value.") + + (LOOP :FOR CC :IN (IL:MKLIST MC) + :WITH CGL :DO + + (IL:* IL:|;;| "Copy GL if multiple MCODEs") + + (SETQ CGL (IF (LISTP MC) + (COPY-GLYPH GL) + GL)) + (SETF (GLYPH-MCODE CGL) + CC) + + (IL:* IL:|;;| "It ought to be safe to share the bitmap") + + (TCONC MAPPED-GLYPHS CGL) + (CHAR-PRESENT-BIT MCHAR-PRESENT CC 1))) + (T (TCONC UNMAPPED-GLYPHS GL)))) (SETF (BF-GLYPHS FONT) - (LOOP :REPEAT NGLYPHS :COLLECT - (PROG1 (SETQ GL (READ-GLYPH FILE-STREAM FONT)) - - (IL:* IL:|;;| - "Any GLYPH with ENCODING of -1 is taken as the SLUG glyph. If multiple, the last applies.") - - (SETQ V (GLYPH-ENCODING GL)) - (WHEN (AND (LISTP V) - (EQ (FIRST V) - -1)) - (SETQ V (OR (SECOND V) - -1))) - (WHEN (EQ V -1) - (SETF (BF-SLUG FONT) - GL)))))) + (CAR MAPPED-GLYPHS)) + (SETF (BF-UNMAPPED�GLYPHS FONT) + (CAR UNMAPPED-GLYPHS))) (ENDFONT (SETQ FONT-COMPLETE T)))))))) (WHEN VERBOSE - (DESTRUCTURING-BIND (FAMILY (WEIGHT SLANT EXPANSION) - SIZE) - (GET-FAMILY-FACE-SIZE-FROM-NAME FONT) - (FORMAT *STANDARD-OUTPUT* - "Name: ~A~%Family: ~A~%Size: ~A~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%" - (BF-NAME FONT) - FAMILY SIZE WEIGHT SLANT EXPANSION))) + + (IL:* IL:|;;| "The SIZE reported needs clarification:") + + (FORMAT *STANDARD-OUTPUT* "Name: ~A~%Family: ~A~%Sizes: Font: ~A Pixel: ~A Point: ~A (decipoints)~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%" + (BF-NAME FONT) + (XLFD-FAMILY XLFD) + (FIRST (BF-SIZE FONT)) + (XLFD-PIXEL�SIZE XLFD) + (XLFD-POINT�SIZE XLFD) + (XLFD-WEIGHT XLFD) + (XLFD-SLANT XLFD) + (XLFD-SETWIDTH�NAME XLFD))) FONT))) (DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\])) @@ -618,7 +643,9 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (WITH-INPUT-FROM-STRING (SI (CONCATENATE 'STRING INPUT-STRING " " (STRING DELIMIT))) (READ-DELIMITED-LIST DELIMIT SI))) -(DEFUN READ-GLYPH (FILE-STREAM FONT) (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") +(DEFUN READ-GLYPH (FILE-STREAM FONT) (IL:* IL:\; "Edited 26-Nov-2025 23:32 by mth") + (IL:* IL:\; "Edited 17-Nov-2025 20:03 by mth") + (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") (IL:* IL:\; "Edited 21-Apr-2025 13:37 by mth") (IL:* IL:\; "Edited 19-Apr-2025 09:32 by mth") (IL:* IL:\; "Edited 17-Apr-2025 18:14 by mth") @@ -655,7 +682,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE)) (CASE KEY (ENCODING (SETF (GLYPH-ENCODING GLYPH) - (IF (EQUAL -1 (FIRST ITEMS)) + (IF (EQL -1 (FIRST ITEMS)) ITEMS (FIRST ITEMS)))) (SWIDTH (SETF (GLYPH-SWIDTH GLYPH) @@ -676,37 +703,41 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (THIRD ITEMS) (GLYPH-BBYOFF0 GLYPH) (FOURTH ITEMS))) - (BITMAP (LET* ((BM (BITMAPCREATE BBW BBH 1)) - (BM.BASE (IL:|fetch| IL:BITMAPBASE IL:|of| BM)) - (BM.RASTERWIDTH (IL:|fetch| IL:BITMAPRASTERWIDTH - IL:|of| BM)) - (NBYTES (CEILING BBW 8)) - (NCHARS (* 2 NBYTES)) - (NWORDS (CEILING BBW 16)) - BITS BYTEPOS WORDINDEX) - (LOOP :WITH BITROW = 0 :REPEAT BBH :DO - (SETQ LINE (STRING-TRIM '(#\Space #\Tab) - (READ-LINE FILE-STREAM))) - (UNLESS (AND (EQUAL NCHARS (LENGTH LINE)) - (SETQ BITS - (PARSE-INTEGER LINE :RADIX 16 - :JUNK-ALLOWED T))) - (ERROR + (BITMAP (UNLESS (ZEROP (* BBW BBH)) + + (IL:* IL:|;;| "Don't bother creating a BITMAP with no area") + + (LET* ((BM (BITMAPCREATE BBW BBH 1)) + (BM.BASE (IL:|fetch| IL:BITMAPBASE IL:|of| BM)) + (BM.RASTERWIDTH (IL:|fetch| IL:BITMAPRASTERWIDTH + IL:|of| BM)) + (NBYTES (CEILING BBW 8)) + (NCHARS (* 2 NBYTES)) + (NWORDS (CEILING BBW 16)) + BITS BYTEPOS WORDINDEX) + (LOOP :WITH BITROW = 0 :REPEAT BBH :DO + (SETQ LINE (STRING-TRIM '(#\Space #\Tab) + (READ-LINE FILE-STREAM))) + (UNLESS (AND (EQUAL NCHARS (LENGTH LINE)) + (SETQ BITS + (PARSE-INTEGER LINE :RADIX 16 + :JUNK-ALLOWED T))) + (ERROR "Invalid BDF file - bad line in BITMAP: ~A" - LINE)) - (WHEN (ODDP NBYTES) - (SETQ BITS (ASH BITS 8))) - (SETQ WORDINDEX (* BITROW BM.RASTERWIDTH)) - (SETQ BYTEPOS (* 16 (1- NWORDS))) - (LOOP :REPEAT NWORDS :DO - (\\PUTBASE BM.BASE WORDINDEX - (LDB (BYTE 16 BYTEPOS) - BITS)) - (INCF WORDINDEX) - (DECF BYTEPOS 16)) - (INCF BITROW)) - (SETF (GLYPH-BITMAP GLYPH) - BM))) + LINE)) + (WHEN (ODDP NBYTES) + (SETQ BITS (ASH BITS 8))) + (SETQ WORDINDEX (* BITROW BM.RASTERWIDTH)) + (SETQ BYTEPOS (* 16 (1- NWORDS))) + (LOOP :REPEAT NWORDS :DO + (IL:\\PUTBASE BM.BASE WORDINDEX + (LDB (BYTE 16 BYTEPOS) + BITS)) + (INCF WORDINDEX) + (DECF BYTEPOS 16)) + (INCF BITROW)) + (SETF (GLYPH-BITMAP GLYPH) + BM)))) (ENDCHAR (SETQ CHAR-COMPLETE T))))))) (SETF (GLYPH-ASCENT GLYPH) (+ (GLYPH-BBH GLYPH) @@ -719,114 +750,151 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (FIRST (GLYPH-DWIDTH GLYPH)))) GLYPH)) -(DEFUN SPLIT-FONT-NAME (NAME) (IL:* IL:\; "Edited 23-Apr-2025 16:22 by mth") +(DEFUN WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE + &AUX FULLFILENAME) + (IL:* IL:\; "Edited 2-Dec-2025 14:47 by mth") + (IL:* IL:\; "Edited 30-Nov-2025 16:03 by mth") + (IL:* IL:\; "Edited 28-Nov-2025 17:56 by mth") + (IL:* IL:\; "Edited 26-Nov-2025 21:07 by mth") + (IL:* IL:\; "Edited 16-Nov-2025 17:32 by mth") + (UNLESS (BDF-FONT-P BDFONT) + (ERROR "Not a BDF-FONT: ~S ~%" BDFONT)) + (DESTRUCTURING-BIND (FONTDESC CSETS) + (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE) + (UNLESS FONTDESC + + (IL:* IL:|;;| "Creation of the FONTDESCRIPTOR failed!") + + (HELP "FONTDESC IS NIL")) + + (IL:* IL:|;;| "CSETS correspond to the charsets actually present in the FONTDESC.") + + (SETQ FULLFILENAME (MEDLEYFONT.WRITE.FONT FONTDESC (MEDLEYFONT.FILENAME FONTDESC NIL NIL + DEST-DIR))) + (LIST FULLFILENAME FONTDESC CSETS))) + +(DEFUN XLFD-SPLIT-FONT-NAME (NAME) (IL:* IL:\; "Edited 26-Nov-2025 09:43 by mth") + (IL:* IL:\; "Edited 23-Apr-2025 16:22 by mth") (IL:* IL:\; "Edited 31-Jan-2025 22:20 by mth") + (LET (PARTS (XLFD (MAKE-XLFD))) - (IL:* IL:|;;| "First, check if it COULD be in XLFD format") + (IL:* IL:|;;| "First, check if it COULD be in XLFD format") - (COND - ((POSITION #\- NAME :TEST #'CHAR=) - (LOOP :FOR I = (IF (CHAR= #\- (ELT NAME 0)) - 1 - 0) - THEN - (1+ J) - :AS J = (POSITION #\- NAME :START I :TEST #'CHAR=) - :COLLECT - (SUBSEQ NAME I J) - :WHILE J)) - (T - (IL:* IL:|;;| "Return the NAME as FAMILY with a NIL FOUNDRY") + (SETQ PARTS (IF (POSITION #\- NAME :TEST #'CHAR=) + (LOOP :FOR I = (IF (CHAR= #\- (ELT NAME 0)) + 1 + 0) + THEN + (1+ J) + :AS J = (POSITION #\- NAME :START I :TEST #'CHAR=) + :COLLECT + (SUBSEQ NAME I J) + :WHILE J) + (PROGN + (IL:* IL:|;;| + "There are no -'s, so use the NAME as the FAMILY with a NIL FOUNDRY") - (LIST NIL NAME)))) + (LIST NIL NAME)))) + (FLET ((PARSE-P-SIZE (SZSTR) + (COND + ((ZEROP (LENGTH SZSTR)) + -1) + ((PARSE-INTEGER SZSTR :JUNK-ALLOWED T)) + (T -1)))) + (DESTRUCTURING-BIND (FOUNDRY FAMILY WEIGHT SLANT SETWIDTH�NAME ADD�STYLE�NAME + PIXEL�SIZE POINT�SIZE RESOLUTION�X RESOLUTION�Y SPACING + AVERAGE�WIDTH CHARSET�REGISTRY CHARSET�ENCODING) + PARTS + (SETQ FAMILY (REMOVE #\Space FAMILY :TEST #'CHAR=)) + (SETQ PIXEL�SIZE (PARSE-P-SIZE PIXEL�SIZE)) + (SETQ POINT�SIZE (PARSE-P-SIZE POINT�SIZE)) + (MAKE-XLFD :FOUNDRY FOUNDRY :FAMILY FAMILY :WEIGHT WEIGHT :SLANT SLANT + :SETWIDTH�NAME SETWIDTH�NAME :ADD�STYLE�NAME ADD�STYLE�NAME :PIXEL�SIZE + PIXEL�SIZE :POINT�SIZE POINT�SIZE :RESOLUTION�X RESOLUTION�X + :RESOLUTION�Y RESOLUTION�Y :SPACING SPACING :AVERAGE�WIDTH AVERAGE�WIDTH + :CHARSET�REGISTRY CHARSET�REGISTRY :CHARSET�ENCODING CHARSET�ENCODING))))) -(DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE - (CHAR-SETS T) - MAP-UNKNOWN-TO-PRIVATE WRITE-UNMAPPED - RAW-UNICODE-MAPPING) - (IL:* IL:\; "Edited 25-Apr-2025 10:08 by mth") - (IL:* IL:\; "Edited 24-Apr-2025 00:09 by mth") - (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth") - (IL:* IL:\; "Edited 3-Feb-2025 23:18 by mth") - (UNLESS (TYPEP BDFONT 'BDF-FONT) - (ERROR "Not a BDF-FONT: ~S~%" BDFONT)) - (COND - ((EQ CHAR-SETS T) (IL:* IL:\; "This means ALL charsets") - ) - ((NULL CHAR-SETS) - (SETQ CHAR-SETS '(0)) (IL:* IL:\; "Only charset 0") - ) - ((AND (INTEGERP CHAR-SETS) - (<= 0 CHAR-SETS MAXCHARSET)) (IL:* IL:\; "A single integer charset") - (SETQ CHAR-SETS (LIST CHAR-SETS))) - ((AND (LISTP CHAR-SETS) - (EVERY #'(LAMBDA (CS) - (AND (INTEGERP CS) - (<= 0 CS MAXCHARSET))) - CHAR-SETS))) - (T (ERROR "Invalid specification of :CHAR-SETS ~S~%" CHAR-SETS))) - (DESTRUCTURING-BIND (FN-FAMILY FN-FACE FN-SIZE) - (GET-FAMILY-FACE-SIZE-FROM-NAME BDFONT) - (SETQ FAMILY (OR FAMILY FN-FAMILY)) - (WHEN RAW-UNICODE-MAPPING - (SETQ FAMILY (\\FONTSYMBOL (CONCATENATE 'STRING "RAW-" (STRING FAMILY))))) - (SETQ FACE (OR FACE FN-FACE)) - (SETQ SIZE (OR SIZE FN-SIZE)) - (MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS) - (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE - MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) - (UNLESS (EQ CHAR-SETS T) - (SETQ CSETS (INTERSECTION CHAR-SETS CSETS)) - (SETQ UNICODE-CSETS (INTERSECTION CHAR-SETS UNICODE-CSETS))) - (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS - (PACKFILENAME.STRING :BODY DEST-DIR :NAME - (\\FONTFILENAME FAMILY SIZE FACE - "DISPLAYFONT" CS)))) - (IF WRITE-UNMAPPED - (LOOP :FOR CS :IN UNICODE-CSETS :DO (WRITESTRIKEFONTFILE - UNMAPPED-FONTDESC CS - (PACKFILENAME.STRING - :BODY DEST-DIR :NAME - (\\FONTFILENAME (FONTPROP - UNMAPPED-FONTDESC - 'IL:FAMILY) - SIZE FACE "DISPLAYFONT" CS)))) - (SETQ UNICODE-CSETS NIL)) +(DEFUN XLFD-TO-FACE (XLFD) (IL:* IL:\; "Edited 25-Nov-2025 17:50 by mth") + (UNLESS (TYPEP XLFD 'XLFD) + (ERROR "Not an XLFD object: ~S ~%" XLFD)) + (LET ((WEIGHT (XLFD-WEIGHT XLFD)) + (SLANT (XLFD-SLANT XLFD)) + (EXPANSION (XLFD-SETWIDTH�NAME XLFD))) - (IL:* IL:|;;| "These correspond to the charsets ACTUALLY written.") + (IL:* IL:|;;| "mth 11-25-2025 Brute force hackery now. This needs to be made smarter.") - (IL:* IL:|;;| - "UNMAPPEDGLYPHS are never written. (Unicode encoding is > xFFFF, or encoding low byte is FF)") + (SETQ WEIGHT (OR (AND WEIGHT (CADR (ASSOC (CHAR-UPCASE (ELT WEIGHT 0)) + '((#\R MEDIUM) + (#\M MEDIUM) + (#\N MEDIUM) + (#\B BOLD) + (#\D BOLD + (IL:* IL:\; "DemiBold => BOLD")) + (#\L LIGHT))))) + 'MEDIUM)) + (SETQ SLANT (OR (AND SLANT (CADR (ASSOC (CHAR-UPCASE (ELT SLANT 0)) + '((REGULAR) + (#\R REGULAR) + (#\I ITALIC) + (#\O ITALIC + (IL:* IL:\; "Oblique => ITALIC")))))) + 'REGULAR)) (IL:* IL:\; "Ignore other SLANTs") - (VALUES FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS)))) + (IL:* IL:|;;| "Expansion (SETWIDTH�NAME) has many more options than these, and they aren't 1st character unique! Apparently, there's no set of (semi-)standard names.") + + (SETQ EXPANSION (OR (AND EXPANSION (CADR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0)) + '((#\R REGULAR) + (#\N REGULAR) + (#\E EXPANDED + (IL:* IL:\; + "E could be ExtraCondensed, Expanded, ExtraExpanded!!!") + ) + (#\S COMPRESSED + (IL:* IL:\; + "S is for \"SemiCompressed\", Using \"Condensed\"") + ) + (#\C COMPRESSED))))) + 'REGULAR)) + + (IL:* IL:|;;| + "Now check for WEIGHT and EXPANSION both BOLD. If so, change Expansion to REGULAR") + + (WHEN (AND (EQ WEIGHT EXPANSION) + (EQ EXPANSION 'BOLD)) + (SETQ EXPANSION 'REGULAR)) + (LIST WEIGHT SLANT EXPANSION))) (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY +(IL:FILESLOAD (IL:SYSLOAD) + IL:SYSEDIT) + + (IL:FILESLOAD (IL:LOADCOMP) IL:FONT) ) (DEFINE-FILE-ENVIRONMENT "READ-BDF" :PACKAGE (DEFPACKAGE "BDF" (:USE "XCL" "LISP") - (:EXPORT "READ-BDF" - "WRITE-BDF-TO-DISPLAYFONT-FILES") - (:IMPORT \\AVGCHARWIDTH \\FGETWIDTH \\FONTFACE - \\FONTFILENAME \\FSETOFFSET \\FSETWIDTH - \\FONTSYMBOL \\GETSTREAM - \\INSTALLCHARSETINFO \\PUTBASE BITBLT - BITMAPCREATE BITMAPHEIGHT BITMAPWIDTH - BLACKSHADE BLTSHADE BOLD CONDENSED - CHARSETINFO DISPLAY FONTDESCRIPTOR FONTP - FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM - REGULAR TCONC UTOXCODE UTOXCODE? - WRITESTRIKEFONTFILE)) + (:EXPORT "READ-BDF" "BUILD-COMPOSITE" + "WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE") + (:IMPORT-FROM "IL" "BITBLT" "BITMAPBIT" + "BITMAPCREATE" "BITMAPHEIGHT" + "BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" + "BOLD" "COMPRESSED" "CHARSETINFO" + "CHARSETPROP" "DISPLAY" "FONTDESCRIPTOR" + "FONTP" "FONTPROP" "INPUT" "ITALIC" + "LIGHT" "LRSH" "MCCS" "MEDIUM" "REGULAR" + "TCONC" "UTOMCODE?" "MEDLEYFONT.FILENAME" + "MEDLEYFONT.WRITE.FONT")) :READTABLE "XCL" :COMPILER :COMPILE-FILE) (IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (2316 10275 (BDF-TO-CHARSETINFO 2316 . 10275)) (10277 16147 (BDF-TO-FONTDESCRIPTOR -10277 . 16147)) (16149 19687 (GET-FAMILY-FACE-SIZE-FROM-NAME 16149 . 19687)) (19689 26500 ( -GLYPHS-BY-CHARSET 19689 . 26500)) (26502 27927 (PACKFILENAME.STRING 26502 . 27927)) (27929 34733 ( -READ-BDF 27929 . 34733)) (34735 35058 (READ-DELIMITED-LIST-FROM-STRING 34735 . 35058)) (35060 41548 ( -READ-GLYPH 35060 . 41548)) (41550 42291 (SPLIT-FONT-NAME 41550 . 42291)) (42293 46075 ( -WRITE-BDF-TO-DISPLAYFONT-FILES 42293 . 46075))))) + (IL:FILEMAP (NIL (3116 10226 (BDF-TO-CHARSETINFO 3116 . 10226)) (10228 16847 (BDF-TO-FONTDESCRIPTOR +10228 . 16847)) (16849 20782 (BUILD-COMPOSITE 16849 . 20782)) (20784 21533 (CHAR-PRESENT-BIT 20784 . +21533)) (21535 21819 (COUNT-MCHARS 21535 . 21819)) (21821 24856 (GLYPHS-BY-CHARSET 21821 . 24856)) ( +24858 26283 (PACKFILENAME.STRING 24858 . 26283)) (26285 35760 (READ-BDF 26285 . 35760)) (35762 36085 ( +READ-DELIMITED-LIST-FROM-STRING 35762 . 36085)) (36087 43085 (READ-GLYPH 36087 . 43085)) (43087 44472 +(WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 43087 . 44472)) (44474 46891 (XLFD-SPLIT-FONT-NAME 44474 . 46891) +) (46893 49905 (XLFD-TO-FACE 46893 . 49905))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index 1974ed35..d112551a 100644 Binary files a/lispusers/READ-BDF.DFASL and b/lispusers/READ-BDF.DFASL differ diff --git a/lispusers/READ-BDF.TEDIT b/lispusers/READ-BDF.TEDIT index 8f6e2ec5..1f1add70 100644 Binary files a/lispusers/READ-BDF.TEDIT and b/lispusers/READ-BDF.TEDIT differ diff --git a/lispusers/REGIONMANAGER b/lispusers/REGIONMANAGER index 812f58a2..85b8faba 100644 --- a/lispusers/REGIONMANAGER +++ b/lispusers/REGIONMANAGER @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "20-Apr-2025 12:57:07" {WMEDLEY}REGIONMANAGER.;137 42626 +(FILECREATED "23-Oct-2025 20:12:38" {WMEDLEY}REGIONMANAGER.;139 43219 :EDIT-BY rmk - :CHANGES-TO (FNS RM-CLOSEW) + :CHANGES-TO (FNS GRAB-TYPED-REGION) - :PREVIOUS-DATE "25-Nov-2024 17:59:00" {WMEDLEY}REGIONMANAGER.;135) + :PREVIOUS-DATE "20-Apr-2025 12:57:07" {WMEDLEY}REGIONMANAGER.;137) (PRETTYCOMPRINT REGIONMANAGERCOMS) @@ -88,20 +88,28 @@ else (push TYPED-REGIONS (CONS TYPE REGIONS]) (GRAB-TYPED-REGION - [LAMBDA (REGION-TYPE MINWIDTH MINHEIGHT) (* ; "Edited 10-Oct-2023 13:41 by rmk") + [LAMBDA (REGION-TYPE MINWIDTH MINHEIGHT MARGIN) (* ; "Edited 23-Oct-2025 20:12 by rmk") + (* ; "Edited 10-Oct-2023 13:41 by rmk") (* ; "Edited 14-Sep-2023 07:30 by rmk") - (* ;; "Returns a REGIONTYPE region that satisfies MINWIDTH and MINHEIGHT, if specified") + (* ;; "Returns a REGIONTYPE region that is larger than MINWIDTH and MINHEIGHT, if specified, and smaller than those numbers times MARGIN, if specified. MARGIN=1.1 allows a size 10%% bigger than MINWIDTH.") - (for R in (CDR (ASSOC REGION-TYPE TYPED-REGIONS)) unless (fetch REGION-INUSE of R) - when [AND (OR (NULL MINWIDTH) - (ILEQ MINWIDTH (fetch WIDTH of R))) - (OR (NULL MINHEIGHT) - (ILEQ MINHEIGHT (fetch HEIGHT of R] do + (CL:UNLESS MINWIDTH (SETQ MINWIDTH 0)) + (CL:UNLESS MINHEIGHT (SETQ MINHEIGHT 0)) + (for R MAXWIDTH MAXHEIGHT in (CDR (ASSOC REGION-TYPE TYPED-REGIONS)) + first (if (AND MARGIN (GREATERP MARGIN 1)) + then (SETQ MAXWIDTH (FIXR (FTIMES MARGIN MINWIDTH))) + (SETQ MAXHEIGHT (FIXR (FTIMES MARGIN MINHEIGHT))) + else (SETQ MAXWIDTH MAX.FIXP) + (SETQ MAXHEIGHT MAX.FIXP)) unless (fetch REGION-INUSE of R) + when (AND (<= MINWIDTH (fetch WIDTH of R) + MAXWIDTH) + (<= MINHEIGHT (fetch HEIGHT of R) + MAXHEIGHT)) do (* ;; "We don't mark it as inuse here, leave that gets done by INSTALL-TYPED-REGION when ownership is given to a window. The only downside is that the region could be reallocated before that happens, and 2 window would come up in the same place.") - (RETURN R]) + (RETURN R]) (REGISTER-TYPED-REGION [LAMBDA (REGION REGION-TYPE WINDOW) (* ; "Edited 10-Oct-2023 13:30 by rmk") @@ -752,11 +760,11 @@ ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1611 6729 (SET-TYPED-REGIONS 1621 . 3796) (GRAB-TYPED-REGION 3798 . 4824) ( -REGISTER-TYPED-REGION 4826 . 6123) (REGION-TYPE 6125 . 6727)) (6730 15428 (RM-CREATEW 6740 . 8863) ( -RM-CLOSEW 8865 . 12512) (RM-GETREGION 12514 . 14663) (CLOSE-TYPED-W 14665 . 15426)) (16071 23550 ( -RELCREATEREGION 16081 . 20704) (RELGETREGION 20706 . 23313) (RELCREATEPOSITION 23315 . 23548)) (23551 -31126 (\RELCREATEREGION.REF 23561 . 28083) (\RELCREATEREGION.SIZE 28085 . 31124)) (31179 40521 ( -RM-ATTACHWINDOW 31189 . 40519)) (40522 42256 (CLOSEWITH 40532 . 41059) (CLOSEWITH.DOIT 41061 . 41341) -(MOVEWITH 41343 . 41866) (MOVEWITH.DOIT 41868 . 42254))))) + (FILEMAP (NIL (1619 7322 (SET-TYPED-REGIONS 1629 . 3804) (GRAB-TYPED-REGION 3806 . 5417) ( +REGISTER-TYPED-REGION 5419 . 6716) (REGION-TYPE 6718 . 7320)) (7323 16021 (RM-CREATEW 7333 . 9456) ( +RM-CLOSEW 9458 . 13105) (RM-GETREGION 13107 . 15256) (CLOSE-TYPED-W 15258 . 16019)) (16664 24143 ( +RELCREATEREGION 16674 . 21297) (RELGETREGION 21299 . 23906) (RELCREATEPOSITION 23908 . 24141)) (24144 +31719 (\RELCREATEREGION.REF 24154 . 28676) (\RELCREATEREGION.SIZE 28678 . 31717)) (31772 41114 ( +RM-ATTACHWINDOW 31782 . 41112)) (41115 42849 (CLOSEWITH 41125 . 41652) (CLOSEWITH.DOIT 41654 . 41934) +(MOVEWITH 41936 . 42459) (MOVEWITH.DOIT 42461 . 42847))))) STOP diff --git a/lispusers/REGIONMANAGER.LCOM b/lispusers/REGIONMANAGER.LCOM index 3edae72b..d4753c31 100644 Binary files a/lispusers/REGIONMANAGER.LCOM and b/lispusers/REGIONMANAGER.LCOM differ diff --git a/lispusers/REGIONMANAGER.TEDIT b/lispusers/REGIONMANAGER.TEDIT index 7bab68ae..ce7f08db 100644 --- a/lispusers/REGIONMANAGER.TEDIT +++ b/lispusers/REGIONMANAGER.TEDIT @@ -34,8 +34,9 @@ where each regionsi is a possibly empty list of regions. For convenience, if TY Typically, a call to SET-TYPED-REGIONS would be placed in a user's INIT file to set up the preference order for the regions that the user wants to participate in this reallocation scheme. If an application uses a type that is not on TYPED-REGIONS, then that type-atom is treated as NIL and always gives rise to the normal ghost-region prompting. Thus a user will observe no change in system behavior if TYPED-REGIONS is left with its initial value NIL. A type that is added with an empty region list (as opposed to not being on the list at all) will allow new regions to accumulate for recycling. The function REGION-TYPE returns NIL if X is not a typed-region or not a region of type TYPE. (REGION-TYPE X TYPE) [Function] -In most scenarios the interpretation of a typed region specification is handled automatically by the extended CREATEW and GETREGION functions. Sometimes it may be useful to perform to for the regions dimensions to be entered into other calculations before it is installed in a window. The function GRAB-TYPED-REGION recycles an existing REGION-TYPE window if one meets the optional minimum width and height requirements, otherwise a new region is returned. -(GRAB-TYPED-REGION REGION-TYPE MINWIDTH MINHEIGHT) [Function] +In most scenarios the interpretation of a typed region specification is handled automatically by the extended CREATEW and GETREGION functions. Sometimes it may be useful to perform to for the regions dimensions to be entered into other calculations before it is installed in a window. The function GRAB-TYPED-REGION recycles an existing REGION-TYPE window if one meets the optional minimum width, height , and margin requirements, otherwise a new region is returned. +(GRAB-TYPED-REGION REGION-TYPE MINWIDTH MINHEIGHT MARGIN) [Function] +If MINWIDTH is specified, the recyled window must be at least that wide, and if MARGIN is specified it can be no larger than MARGIN x MINWIDTH. Thus, if MINWIDTH is 200 and MARGIN is 1.1, only regions REGION-TYPE regions of width between 200 and 220 points will satisfy. MINHEIGHT restricts the height in the same way. A type can be assigned to an untyped region and installed in a window by the function REGISTER-TYPED-REGION. That region will then be recycled when the window is closed. (REGISTER-TYPED-REGION REGION REGION-TYPE WINDOW) [Function] If REGION is NIL, the (presumably) untyped region of WINDOW will be registered. An entry in TYPED-REGIONS will be created for REGION-TYPE if it is not already present. @@ -79,14 +80,16 @@ Establishes a link between the PARENT window and any number of CHILDREN windows If NEWPOS is the new position of PARENT, moves each of the move-children so that they stand in the same relation to PARENT after it moves as before. -(SEQUENCE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (ALTERNATE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))))) 1$4�$�4�$�1$�$1�$4�$�4�$�4�$�4�$�1�$1��8$1��8$J�$�PAGEHEADINGRUNNINGHEADMODERN -CLASSIC -TERMINALMODERNTERMINAL��TERMINAL�� -TIMESROMAN$ HRULE.GETFN HRULE.GETFNHRULE.GETFNHRULE.GETFNHRULE.GETFN -@� � � �}/ �[ �C*��T ��@ �1 - -; 3o)� � � 4n �o2V@1%! A &MmIS-g< -3E -" - -l/4v2C � &%"O= , l�)9�� W~�&4!Uh'�2&�$"&( )MDATE:i�*�5V�z� \ No newline at end of file +(SEQUENCE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (ALTERNATE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL)))))))1$4�$�4�$�1$�$1�$4�$�4�$�4�$�4�$�4�$�1�$1��8$1��8$J�$�PAGEHEADINGRUNNINGHEAD1TERMINAL(CHARPROPS (COLOR . BLACK))0CLASSIC +(CHARPROPS (COLOR . BLACK))/MODERN +(CHARPROPS (COLOR . BLACK))/MODERN(CHARPROPS (COLOR . BLACK))1TERMINAL��(CHARPROPS (COLOR . BLACK))1TERMINAL��(CHARPROPS (COLOR . BLACK))3 +TIMESROMAN$(CHARPROPS (COLOR . BLACK))HRULE.GETFNHRULE.GETFNHRULE.GETFN HRULE.GETFNHRULE.GETFN@� +� +� +�}/ �[ �C*��T ��@ �1 + +; 3o)� � � 4n �y9E'<0V@1%! A &MmIS-g< +3E +" + +l/4v2C � &%"O= , l�)9�� W~�&4!Uh'�2&�$"&( )M(((CHARENCODING . MCCS)))PROPS:#DATE:j�"<6��z� \ No newline at end of file diff --git a/lispusers/TEDIT-PF-SEE b/lispusers/TEDIT-PF-SEE index fef23770..89637de6 100644 --- a/lispusers/TEDIT-PF-SEE +++ b/lispusers/TEDIT-PF-SEE @@ -1,25 +1,23 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "29-Jul-2025 22:01:56" -{DSK}kaplan>Local>medley3.5>working-medley>lispusers>TEDIT-PF-SEE.;150 11962 +(FILECREATED "12-Nov-2025 15:49:07" {WMEDLEY}TEDIT-PF-SEE.;156 13422 :EDIT-BY rmk - :CHANGES-TO (FNS PF-TEDIT) + :CHANGES-TO (VARS TEDIT-PF-SEECOMS) - :PREVIOUS-DATE "29-Jul-2025 18:07:48" -{DSK}kaplan>Local>medley3.5>working-medley>lispusers>TEDIT-PF-SEE.;149) + :PREVIOUS-DATE "26-Sep-2025 22:53:59" {WMEDLEY}TEDIT-PF-SEE.;155) (PRETTYCOMPRINT TEDIT-PF-SEECOMS) (RPAQQ TEDIT-PF-SEECOMS [(FNS PF-TEDIT PF-TEDIT-FROM-TEXT) - (COMMANDS ts tf) + (COMMANDS ts tf tc tv tr) (FILES (SYSLOAD) REGIONMANAGER VERSIONDEFS) - (ALISTS (TEDIT.CHARACTIONS TEDIT-PF) - (TEDIT.CHARBINDINGS TEDIT-PF)) + (ALISTS (TEDIT.CHARACTIONS :TEDIT-PF) + (TEDIT.CHARBINDINGS :TEDIT-PF)) (P (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION) (MOVD? 'NILL (FUNCTION TEDIT.SETFUNCTION)) (TEDIT.INSTALL.CHARBINDINGS)) @@ -29,7 +27,9 @@ (DEFINEQ (PF-TEDIT - [LAMBDA (FN IFILES VERSION REPRINT) (* ; "Edited 29-Jul-2025 22:01 by rmk") + [LAMBDA (ITEM IFILES VERSION REPRINT TYPE) (* ; "Edited 23-Sep-2025 11:24 by rmk") + (* ; "Edited 20-Sep-2025 08:56 by rmk") + (* ; "Edited 29-Jul-2025 22:01 by rmk") (* ; "Edited 29-Jun-2025 16:18 by rmk") (* ; "Edited 14-Apr-2025 22:00 by rmk") (* ; "Edited 26-Mar-2025 10:08 by rmk") @@ -46,24 +46,24 @@ (* ; "Edited 12-Jan-2022 13:15 by rmk") (* ; "Edited 30-Dec-2021 23:17 by rmk") - (* ;; "PF* to a read-only TEDIT window. First argument is the function name, second if given is the input file.") + (* ;; "Shows ITEM of type TYPE in a scrollable read-only TEDIT window. First argument is the item name, second if given is the input file.") - (* ;; "This uses PFCOPYBYTES so we see what it looks like on the file. But some functions were not prettyprinted, so they appear as useless garbage.") - - (* ;; "In that case, calling again with REPRINT=T will read and reprint. And, invoking tf again with no arguments at all will also reprint the last function in the same window") + (* ;; "Calling again with REPRINT=T (or ITEM=T) will read and reprint the same item. And, calling again with no arguments at all will also reprint the last item in the same window") (SETQ IFILES (MKLIST IFILES)) - (CL:WHEN (LISTP FN) - (SETQ FN (CAR FN))) - (SELECTQ FN + (CL:WHEN (INTERSECTION TYPE '(FNS FUNCTIONS)) + (SETQ TYPE NIL)) + (CL:WHEN (INTERSECTION TYPE '(FNS FUNCTIONS)) + (SETQ TYPE NIL)) + (SELECTQ ITEM ((t T NIL) (SETQ REPRINT T) - (SETQ FN LASTWORD)) - (if (VERSIONP FN) - then (SETQ IFILES (CONS FN)) - (SETQ FN LASTWORD) - else (SETQ LASTWORD FN))) - (CL:UNLESS FN (ERROR "No function to print")) + (SETQ ITEM LASTWORD)) + (if (VERSIONP ITEM) + then (SETQ IFILES (CONS ITEM)) + (SETQ ITEM LASTWORD) + else (SETQ LASTWORD ITEM))) + (CL:UNLESS ITEM (ERROR "No function to print")) (CL:WHEN (AND (VERSIONP IFILES) (NULL VERSION)) (SETQ VERSION IFILES) @@ -73,91 +73,107 @@ (SETQ REPRINT T) [SETQ IFILES (LDIFFERENCE IFILES '(t T]) (CL:UNLESS IFILES - (SETQ IFILES (WHEREIS FN '(FNS FUNCTIONS) - T))) + [SETQ IFILES (OR (WHEREIS ITEM TYPE T) + (AND (NULL TYPE) + (WHEREIS ITEM 'MACROS T]) (if IFILES - then (* ; "skip compiled files") + then (for IFILE TSTREAM DEF TFPROP WINDOW inside IFILES + eachtime (SETQ IFILE (if (CL:IF (VERSIONP IFILE) + (FINDFILEVERSION (CAR (WHEREIS ITEM TYPE T)) + IFILE) + (FINDFILE IFILE T)) + else (printout T "file " IFILE " not found." T) + (GO $$ITERATE))) unless (MEMB (FILENAMEFIELD IFILE + 'EXTENSION) + *COMPILED-EXTENSIONS*) + do (CL:UNLESS [SETQ DEF (CL:IF TYPE + (GETDEF ITEM TYPE IFILE 'NOERROR) + (OR (GETDEF ITEM 'FNS IFILE 'NOERROR) + (GETDEF ITEM 'FUNCTIONS IFILE 'NOERROR) + (GETDEF ITEM 'MACROS IFILE 'NOERROR)))] + (printout T ITEM " not found on " IFILE "." T) + (GO $$ITERATE)) - (* ;; "Since we are creating readonly Tedits, try to keep the TTY where it is.") + (* ;; "We found ITEM of TYPE on IFILE") - (for IFILE LOC TSTREAM ENV EXPR TFPROP WINDOW inside IFILES - eachtime (CL:IF (VERSIONP IFILE) - (SETQ IFILE (FINDFILEVERSION (CAR (WHEREIS FN NIL T)) - IFILE))) unless (MEMB (FILENAMEFIELD IFILE 'EXTENSION) - *COMPILED-EXTENSIONS*) - do - (SETQ LOC (FINDFNDEF FN IFILE)) - (if (LISTP LOC) - then (SETQ TFPROP (LIST FN (CAR LOC))) - [SETQ WINDOW (find W in (OPENWINDOWS) - suchthat (AND (EQUAL TFPROP (WINDOWPROP W 'TF)) - (TEXTSTREAM W T] - [if (AND WINDOW (NOT REPRINT)) - then - (* ;; - "If already an open PF window on this function in this file, just raise it to the top") + (SETQ TFPROP (LIST ITEM TYPE IFILE)) + [SETQ WINDOW (find W in (OPENWINDOWS) + suchthat (AND (EQUAL TFPROP (WINDOWPROP W 'TF)) + (TEXTSTREAM W T] + (CL:WHEN (AND WINDOW (NOT REPRINT)) - (TOTOPW WINDOW) - (RETURN) - else (CL:WITH-OPEN-FILE - (ISTREAM (POP LOC) - :DIRECTION :INPUT) - (SETQ ENV (LISPSOURCEFILEP ISTREAM)) - (SETFILEINFO ISTREAM 'FORMAT ENV) - [SETQ TSTREAM (OPENTEXTSTREAM - NIL NIL `(PARABREAKCHARS NIL OPENWIDTH - ,(TIMES TEDIT.SOURCE.LINELENGTH - (CHARWIDTH (CHARCODE SPACE) - DEFAULTFONT] - (DSPFONT DEFAULTFONT TSTREAM) - (PRINTOUT TSTREAM 5 "[From " (FULLNAME ISTREAM) - "]" T) - (PRINT-READER-ENVIRONMENT ENV TSTREAM) - (if REPRINT - then (SETFILEPTR ISTREAM (POP LOC)) - (SETQ EXPR (WITH-READER-ENVIRONMENT ENV (READ ISTREAM))) - (WITH-READER-ENVIRONMENT ENV - (if (EQ FN (CAR EXPR)) - then (DSPFONT BOLDFONT TSTREAM) - (PRINT FN TSTREAM) - (DSPFONT DEFAULTFONT TSTREAM) - (SETQ EXPR (CADR EXPR)) - (PRINTDEF EXPR 3 T NIL NIL TSTREAM) - elseif (EQ FN (CADR EXPR)) - then - (* ;; - "Presumably a DEFUN. Print the CAR, boldface the cadr") + (* ;; + "If already an open window on this item in this file, just raise it to the top") - (PRINTOUT TSTREAM "(" .P2 (CAR EXPR) - " " .FONT BOLDFONT .P2 (CADR EXPR) - .FONT DEFAULTFONT " " .P2 (CADDR EXPR) - T 3) - (PRINTDEF (CDDDR EXPR) - 3 T T NIL TSTREAM) - (PRIN3 ")" TSTREAM) - else (PRINTDEF EXPR 3 NIL NIL NIL TSTREAM))) - else (PFI.MAYBE.PP.DEFINITION ISTREAM TSTREAM (POP LOC) - (POP LOC))) - (TERPRI TSTREAM) - [TEDIT TSTREAM (OR WINDOW 'TF) - NIL - `(READONLY T TITLE ,(CONCAT FN " from " (FULLNAME ISTREAM)) - ITEM-NAME - ,FN BOUNDTABLE ,(TEDIT.ATOMBOUND.READTABLE *READTABLE*] + (TOTOPW WINDOW) + (RETURN)) + [SETQ TSTREAM (OPENTEXTSTREAM NIL NIL + `(PARABREAKCHARS NIL OPENWIDTH + ,(TIMES TEDIT.SOURCE.LINELENGTH (CHARWIDTH + (CHARCODE SPACE) + DEFAULTFONT] + (CL:WITH-OPEN-FILE (ISTREAM IFILE :DIRECTION :INPUT) + (* ; "Print the reader environment") + (PRINTOUT TSTREAM .FONT DEFAULTFONT 5) + (PRINT-READER-ENVIRONMENT (LISPSOURCEFILEP ISTREAM) + TSTREAM)) + (DSPFONT DEFAULTFONT TSTREAM) + [if (FNTYP DEF) + then (PRINTOUT TSTREAM "(" .FONT BOLDFONT .P2 ITEM " " .FONT DEFAULTFONT) + (PRINTDEF DEF 3 T NIL NIL TSTREAM) + (PRIN3 ")" TSTREAM) + elseif (SELECTQ (CAR DEF) + ((CL:DEFUN DEFMACRO) (* ; "Could look at :DEFINITION-NAME for definers in general, but we still have to pick out the arguments here (CADDR).") + (PRINTOUT TSTREAM "(" .P2 (CAR DEF) + " " .FONT BOLDFONT .P2 (CADR DEF) + .FONT DEFAULTFONT " " .P2 (CADDR DEF)) + (PRINTDEF (CDDDR DEF) + 3 T T NIL TSTREAM) + (PRIN3 ")" TSTREAM)) + (if (EQ ITEM (CAR DEF)) + then (PRINTOUT TSTREAM "(" .FONT BOLDFONT .P2 ITEM .FONT + DEFAULTFONT) + (PRINTDEF (CADR DEF) + 3 + (NOT TYPE) + NIL NIL TSTREAM) + (PRIN3 ")" TSTREAM) + elseif (EQ ITEM (CADR DEF)) + then (PRINTOUT TSTREAM "(" .P2 (CAR DEF) + " " .FONT BOLDFONT .P2 ITEM .FONT DEFAULTFONT) + (PRINTDEF (CDDR DEF) + 3 + (NEQ TYPE 'VARS) + T NIL TSTREAM) + (PRIN3 ")" TSTREAM) + else (PRINTOUT TSTREAM .FONT BOLDFONT .P2 ITEM ":" .FONT + DEFAULTFONT) + (PRINTDEF DEF 3 (NOT TYPE) + NIL NIL TSTREAM] + (TERPRI TSTREAM) - (* ;; "The windowprop allows for reprinting as a window action, or reprinting from a command that can find and reuse the previous (presumably unprettied) window.") + (* ;; "Since we are creating readonly Tedits, try to keep the TTY where it is.") - (WINDOWPROP (WFROMDS TSTREAM) - 'TF TFPROP) - (TOTOPW (WFROMDS TSTREAM] - elseif (EQ LOC 'FILE.NOT.FOUND) - then (printout T "file " IFILE " not found." T) - else (printout T FN " not found on " LOC "." T))) - (SETQ *LAST-DF* FN) - else (PRINTOUT T FN " has no function definition" T]) + [TEDIT TSTREAM (OR WINDOW 'TF) + NIL + `(READONLY T TITLE ,(CONCAT ITEM " from " IFILE) + ITEM-NAME + ,ITEM BOUNDTABLE ,(TEDIT.ATOMBOUND.READTABLE *READTABLE*] + + (* ;; "The windowprop allows for reprinting as a window action, or reprinting from a command that can find and reuse the previous (presumably unprettied) window.") + + (WINDOWPROP (WFROMDS TSTREAM) + 'TF TFPROP) + (TOTOPW (WFROMDS TSTREAM))) + (SETQ *LAST-DF* ITEM) + else (PRINTOUT T ITEM " has no " (CL:IF TYPE + (L-CASE TYPE) + "function") + " definition" T]) (PF-TEDIT-FROM-TEXT - [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 14-Apr-2025 21:59 by rmk") + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 23-Sep-2025 23:28 by rmk") + (* ; "Edited 14-Apr-2025 21:59 by rmk") (* ; "Edited 7-Apr-2025 23:03 by rmk") (* ; "Edited 5-Dec-2024 22:20 by rmk") (* ; "Edited 26-Aug-2024 23:13 by rmk") @@ -175,7 +191,7 @@ ALLFILES) (if (EQ 0 (NCHARS FN)) then (TEDIT.PROMPTPRINT TSTREAM "Please select a function to display" T) - elseif (SETQ ALLFILES (WHEREIS FN '(FNS FUNCTIONS) + elseif (SETQ ALLFILES (WHEREIS FN '(FNS FUNCTIONS MACROS) T)) then (PF-TEDIT FN (CAR (OR (MEMB (FILENAMEFIELD THISFILE) ALLFILES) @@ -197,12 +213,19 @@ (DEFCOMMAND tf (FN FILE VERSION) (PF-TEDIT FN FILE VERSION)) +(DEFCOMMAND tc (ITEM FILE VERSION) (PF-TEDIT (FILECOMS ITEM) + FILE VERSION T 'VARS)) + +(DEFCOMMAND tv (ITEM FILE VERSION) (PF-TEDIT ITEM FILE VERSION T 'VARS)) + +(DEFCOMMAND tr (ITEM FILE VERSION) (PF-TEDIT ITEM FILE VERSION T 'RECORDS)) + (FILESLOAD (SYSLOAD) REGIONMANAGER VERSIONDEFS) -(ADDTOVAR TEDIT.CHARACTIONS (TEDIT-PF PF-TEDIT-FROM-TEXT)) +(ADDTOVAR TEDIT.CHARACTIONS (:TEDIT-PF PF-TEDIT-FROM-TEXT)) -(ADDTOVAR TEDIT.CHARBINDINGS (TEDIT-PF "Meta,t" "Meta,T")) +(ADDTOVAR TEDIT.CHARBINDINGS (:TEDIT-PF "Meta,t" "Meta,T")) (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION) @@ -218,5 +241,5 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1080 10900 (PF-TEDIT 1090 . 9166) (PF-TEDIT-FROM-TEXT 9168 . 10898))))) + (FILEMAP (NIL (1018 12068 (PF-TEDIT 1028 . 10218) (PF-TEDIT-FROM-TEXT 10220 . 12066))))) STOP diff --git a/lispusers/TEDIT-PF-SEE.LCOM b/lispusers/TEDIT-PF-SEE.LCOM index e8009bfc..71170a2a 100644 Binary files a/lispusers/TEDIT-PF-SEE.LCOM and b/lispusers/TEDIT-PF-SEE.LCOM differ diff --git a/lispusers/WHICHKEY b/lispusers/WHICHKEY index 6b79b9d8..946eb638 100644 --- a/lispusers/WHICHKEY +++ b/lispusers/WHICHKEY @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Jan-2025 15:47:23" {WMEDLEY}WHICHKEY.;3 1037 +(FILECREATED "21-Oct-2025 08:40:16" {WMEDLEY}WHICHKEY.;5 1172 :EDIT-BY rmk - :CHANGES-TO (FNS WHICHKEY) + :CHANGES-TO (FNS DOWNP) - :PREVIOUS-DATE "23-Jan-2025 15:46:57" {WMEDLEY}WHICHKEY.;2) + :PREVIOUS-DATE "12-Oct-2025 20:53:41" {WMEDLEY}WHICHKEY.;4) (PRETTYCOMPRINT WHICHKEYCOMS) @@ -14,15 +14,19 @@ (RPAQQ WHICHKEYCOMS ((FNS DOWNP WHICHKEY))) (DEFINEQ -(DOWNP [LAMBDA (KEYNAME) (* ; "Edited 19-May-2018 20:03 by rmk:") (PROGN (DISMISS 2000) (KEYDOWNP KEYNAME]) +(DOWNP + [LAMBDA (KEYNAME DELAY) (* ; "Edited 21-Oct-2025 08:37 by rmk") + (DISMISS (OR DELAY 3000)) + (KEYDOWNP KEYNAME]) (WHICHKEY - [LAMBDA (DELAY) (* ; "Edited 23-Jan-2025 15:44 by rmk") + [LAMBDA (DELAY) (* ; "Edited 12-Oct-2025 11:52 by rmk") + (* ; "Edited 23-Jan-2025 15:44 by rmk") (* ; "Edited 4-Dec-2023 16:04 by rmk") (* ; "Edited 18-May-2018 13:09 by rmk:") (PROGN (DISMISS (OR DELAY 3000)) - (for X IN \KEYNAMES when (KEYDOWNP (CAR X)) collect X]) + (for X IN \KEYNAMES as I from 0 when (KEYDOWNP (CAR X)) collect (LIST I X]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (368 1014 (DOWNP 378 . 550) (WHICHKEY 552 . 1012))))) + (FILEMAP (NIL (365 1149 (DOWNP 375 . 548) (WHICHKEY 550 . 1147))))) STOP diff --git a/lispusers/WHICHKEY.TEDIT b/lispusers/WHICHKEY.TEDIT new file mode 100644 index 00000000..b98ad1b7 Binary files /dev/null and b/lispusers/WHICHKEY.TEDIT differ diff --git a/lispusers/fontsampler.tedit b/lispusers/fontsampler.tedit index d23d0de0..3e6512d9 100644 Binary files a/lispusers/fontsampler.tedit and b/lispusers/fontsampler.tedit differ diff --git a/lispusers/talk/TALK b/lispusers/talk/TALK index e75b0bc3..6e05a53e 100644 Binary files a/lispusers/talk/TALK and b/lispusers/talk/TALK differ diff --git a/lispusers/talk/TALK-GAP b/lispusers/talk/TALK-GAP index 7b579f48..b211aff4 100644 Binary files a/lispusers/talk/TALK-GAP and b/lispusers/talk/TALK-GAP differ diff --git a/lispusers/talk/TALK-IP b/lispusers/talk/TALK-IP index c07c527a..a69f5829 100644 Binary files a/lispusers/talk/TALK-IP and b/lispusers/talk/TALK-IP differ diff --git a/lispusers/talk/TALK-NS b/lispusers/talk/TALK-NS index 44056bde..9166a377 100644 Binary files a/lispusers/talk/TALK-NS and b/lispusers/talk/TALK-NS differ diff --git a/lispusers/talk/TALK-NSGAP b/lispusers/talk/TALK-NSGAP index 382eba67..2dd3859e 100644 Binary files a/lispusers/talk/TALK-NSGAP and b/lispusers/talk/TALK-NSGAP differ diff --git a/lispusers/talk/TALK-SKETCH b/lispusers/talk/TALK-SKETCH index 11970645..0de5d9cc 100644 Binary files a/lispusers/talk/TALK-SKETCH and b/lispusers/talk/TALK-SKETCH differ diff --git a/lispusers/talk/TALK-TEDIT b/lispusers/talk/TALK-TEDIT index 4fa5a5b7..9e0f73a8 100644 Binary files a/lispusers/talk/TALK-TEDIT and b/lispusers/talk/TALK-TEDIT differ diff --git a/lispusers/talk/TALK-TTY b/lispusers/talk/TALK-TTY index 0132acd8..9346f713 100644 Binary files a/lispusers/talk/TALK-TTY and b/lispusers/talk/TALK-TTY differ diff --git a/loadups/HLDISPLAY b/loadups/HLDISPLAY new file mode 100644 index 00000000..9f05cc58 --- /dev/null +++ b/loadups/HLDISPLAY @@ -0,0 +1,3558 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "26-May-2025 11:01:22" {DSK}frank>il>medley>loadups>HLDISPLAY.;1 205273 + + :EDIT-BY "frank" + + :CHANGES-TO (FNS \GETREGIONTRACKWITHBOX FGH) + (VARS HLDISPLAYCOMS) + + :PREVIOUS-DATE "15-Mar-94 10:48:02" {DSK}frank>il>medley>sources>HLDISPLAY.;1) + + +(PRETTYCOMPRINT HLDISPLAYCOMS) + +(RPAQQ HLDISPLAYCOMS + ( (* ; "GRID functions") + (FNS FGH GRID GRIDXCOORD GRIDYCOORD LEFTOFGRIDCOORD BOTTOMOFGRIDCOORD SHADEGRIDBOX) + (* ; + "Low level compatibility and extensions") + (FNS INSIDE?) + [COMS (* ; "Mouse selection code") + (FNS MOUSESTATE-EXPR MOUSESTATE-NAME) + (PROP ARGNAMES MOUSESTATE LASTMOUSESTATE UNTILMOUSESTATE KEYSETSTATE LASTKEYSETSTATE) + (EXPORT (DECLARE%: DOCOPY (MACROS MOUSESTATE LASTMOUSESTATE UNTILMOUSESTATE KEYSETSTATE + LASTKEYSETSTATE)) + (DECLARE%: DONTCOPY (MACROS WITHIN)) + (ADDVARS (GLOBALVARS LASTMOUSEX LASTMOUSEY LASTMOUSEBUTTONS] + (* ; "High Level Display utilities") + (FNS DECODEBUTTONS) + (FNS PTDIFFERENCE PTPLUS) + (COMS (* ; "User interaction for regions, etc") + (FNS GETPOSITION GETBOXPOSITION DSPYSCREENTOWINDOW DSPXSCREENTOWINDOW GETREGION + \GETREGION.PACKPTS \GETREGION.CHECKBASEPT \GETREGION.CHECKOPPT + \GETREGIONTRACKWITHBOX \UPDATEXYANDBOX GETBOXREGION \TRACKWITHBOX MOVEBOX + DRAWGRAYBOX BLTHLINE BLTVLINE SETCORNER GETSCREENPOSITION GETBOXSCREENPOSITION + GETSCREENREGION GETBOXSCREENREGION) + + (* ;; "Old-medley-window-system versions of generic box/position functions") + + (FNS \MEDW.GETSCREENPOSITION \MEDW.GETBOXSCREENPOSITION \MEDW.GETSCREENREGION) + (FNS GETGRIDBOXREGION \RANGELIMIT) + (FNS MOUSECONFIRM) + (CURSORS MOUSECONFIRMCURSOR)) + (FNS NEAREST/PT/ON/GRID PTON10GRID NEAREST/MULTIPLE) + (EXPORT (MACROS IABS)) + (UGLYVARS DASHEDSHADE) + (GLOBALVARS CROSSHAIRS EXPANDINGBOX FORCEPS BOXCURSOR LOCKEDSPOT OLDEXPANDINGBOX + LowerLeftCursor UpperRightCursor UpperLeftCursor LowerRightCursor) + (CURSORS CROSSHAIRS EXPANDINGBOX FORCEPS BOXCURSOR LOCKEDSPOT OLDEXPANDINGBOX LowerLeftCursor + UpperRightCursor UpperLeftCursor LowerRightCursor) + (FNS \SW2BM COMPOSEREGS TRANSLATEREG) + (COMS (* ; "Bitmap and shade editors") + (FNS EDITBM EDITBMSCROLLFN EDITBMCLOSEFN TILEAREA EDITBMBUTTONFN \EDITBM/PUTUP/DISPLAY + \EDITBMHOWMUCH EDITBMRESHAPEFN EDITBMREPAINTFN UPDATE/SHADE/DISPLAY + UPDATE/BM/DISPLAY/SELECTED/REGION SHOWBUTTON RESETGRID.NEW RESETGRID + \READBMDIMENSIONS EDITSHADE \BITMAPFROMTEXTURE EDITSHADEREPAINTFN GRAYBOXAREA + \SHADEBITS READHOTSPOT WBOX \CLEARBM EDITBMTEXTURE) + (DECLARE%: DONTCOPY (RECORDS BUTTON) + (MACROS BITMASK UPDATE/BM/DISPLAY)) + (DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (DARKBITSHADE 23130) + (NORMALGRIDSQUARE 16) + (NOTINUSEGRAY 42405) + (EDITBMMENU) + (EDITBMWINDOWMENU) + (GRIDSIZEMENU) + (CLICKWAITTIME 250))) + (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS DARKBITSHADE NORMALGRIDSQUARE + NOTINUSEGRAY EDITBMMENU CLICKWAITTIME)) + (CONSTANTS (GRIDTHICKNESS 2) + (MINGRIDSQUARE 8) + (MAXGRIDWIDTH 199) + (MAXGRIDHEIGHT 175) + (BMWINDOWSHADE 33410))) + (FNS SCALEBM BLTPATTERN BLTPATTERN.REPLACEDISPLAY BLTPATTERN.GENERIC) + (FNS EXPANDBITMAP EXPANDBM SHRINKBITMAP \FAST4BIT) + (FUNCTIONS ROTATE-BITMAP ROTATE-BITMAP-LEFT) + (PROP FILETYPE HLDISPLAY) + (UGLYVARS \4BITEXPANSIONTABLE))) + + + +(* ; "GRID functions") + +(DEFINEQ + +(FGH + [LAMBDA NIL (* ; "Edited 26-May-2025 10:51 by frank") + T]) + +(GRID + [LAMBDA (GRIDSPEC WIDTH HEIGHT BORDER DS GRIDSHADE) (* ; "Edited 8-Dec-88 16:12 by SHIH") + + (* ;; "Draws a grid") + + (PROG ((X0 (fetch (REGION LEFT) of GRIDSPEC)) + (Y0 (fetch (REGION BOTTOM) of GRIDSPEC)) + (SQWIDTH (fetch (REGION WIDTH) of GRIDSPEC)) + (SQHEIGHT (fetch (REGION HEIGHT) of GRIDSPEC)) + (GRIDSHADE (COND + ((TEXTUREP GRIDSHADE)) + (T BLACKSHADE))) + LINELENGTH TWICEBORDER MAXIMUMCOLOR TOTALHEIGHT GRIDBM TEMPBM) + (SETQ TOTALHEIGHT (ITIMES HEIGHT SQHEIGHT)) + (COND + ((OR (ZEROP BORDER) + (NULL BORDER)) (* ; "don't draw anything.") + (RETURN)) + [(NUMBERP BORDER) + (SETQ TWICEBORDER (ITIMES BORDER 2)) + (PROGN + (* ;; "draw vertical lines use BITBLT so that we don't have to correct for the width of the line since line drawing will put the coordinate in the middle.") + + (BLTSHADE GRIDSHADE DS X0 Y0 BORDER TOTALHEIGHT 'REPLACE) + (for X from (IDIFFERENCE (IPLUS X0 SQWIDTH) + BORDER) + to (IDIFFERENCE (IPLUS X0 (ITIMES (SUB1 WIDTH) + SQWIDTH)) + BORDER) by SQWIDTH + do (BLTSHADE GRIDSHADE DS X Y0 TWICEBORDER TOTALHEIGHT 'REPLACE)) + (BLTSHADE GRIDSHADE DS (IDIFFERENCE (IPLUS X0 (ITIMES WIDTH SQWIDTH)) + BORDER) + Y0 BORDER TOTALHEIGHT 'REPLACE)) + (PROGN (* ; "draw horizontal lines") + (BLTSHADE GRIDSHADE DS X0 Y0 (SETQ LINELENGTH (ITIMES WIDTH SQWIDTH)) + BORDER + 'REPLACE) + (for Y from (IDIFFERENCE (IPLUS Y0 SQHEIGHT) + BORDER) + to (IDIFFERENCE (IPLUS Y0 (ITIMES (SUB1 HEIGHT) + SQHEIGHT)) + BORDER) by SQHEIGHT + do (BLTSHADE GRIDSHADE DS X0 Y LINELENGTH TWICEBORDER 'REPLACE)) + (BLTSHADE GRIDSHADE DS X0 (IDIFFERENCE (IPLUS Y0 TOTALHEIGHT) + BORDER) + LINELENGTH BORDER 'REPLACE] + [(EQ BORDER 'POINT) (* ; + "put a point in the lower left corner of each box") + (if (WINDOWP DS) + then (SETQ TEMPBM (WINDOWPROP DS 'TEMPBM)) + (SETQ GRIDBM (WINDOWPROP DS 'GRIDBM)) + (if (NOT GRIDBM) + then (SETQ GRIDBM (BITMAPCREATE SQWIDTH SQHEIGHT)) + (WINDOWPROP DS 'GRIDBM GRIDBM)) + (BLTSHADE WHITESHADE GRIDBM 0 0) (* ; "Clear temporary bitmap.") + (BLTSHADE BLACKSHADE GRIDBM 0 0 1 1 'REPLACE) + (* ; "Put spot down.") + (* ; "Fill up temporary bitmap.") + (BLTPATTERN GRIDBM 0 0 SQWIDTH SQHEIGHT DS X0 Y0 (ITIMES WIDTH SQWIDTH) + (ITIMES HEIGHT SQHEIGHT) + 'PAINT TEMPBM) + else [SETQ MAXIMUMCOLOR (MAXIMUMCOLOR (BITSPERPIXEL (DSPDESTINATION NIL DS] + + (* ;; "Crufty slow original code.") + + (for X from X0 to (IPLUS X0 (ITIMES WIDTH SQWIDTH)) by SQWIDTH + do (for Y from Y0 to (IPLUS Y0 TOTALHEIGHT) by SQHEIGHT + do (BITMAPBIT DS X Y MAXIMUMCOLOR] + (T (\ILLEGAL.ARG BORDER]) + +(GRIDXCOORD + [LAMBDA (XPOS GRIDSPEC) (* rrb "21-MAR-83 13:04") + (PROG [(GX (IDIFFERENCE XPOS (fetch (REGION LEFT) of GRIDSPEC] + + (* because (IQUOTIENT -1 2) is 0 instead of -1 like we would like) + + (RETURN (COND + ((IGEQ GX 0) + (IQUOTIENT GX (fetch (REGION WIDTH) of GRIDSPEC))) + (T (SUB1 (IQUOTIENT GX (fetch (REGION WIDTH) of GRIDSPEC]) + +(GRIDYCOORD + [LAMBDA (YPOS GRIDSPEC) (* rrb "21-MAR-83 13:07") + (PROG [(GY (IDIFFERENCE YPOS (fetch (REGION BOTTOM) of GRIDSPEC] + + (* because (IQUOTIENT -1 2) is 0 instead of -1 like we would like) + + (RETURN (COND + ((IGEQ GY 0) + (IQUOTIENT GY (fetch (REGION HEIGHT) of GRIDSPEC))) + (T (SUB1 (IQUOTIENT GY (fetch (REGION HEIGHT) of GRIDSPEC]) + +(LEFTOFGRIDCOORD + [LAMBDA (GRIDX GRIDSPEC) (* rrb "19-MAR-82 09:20") + (* returns the Left position of a grid + location.) + (IPLUS (fetch (REGION LEFT) of GRIDSPEC) + (ITIMES (fetch (REGION WIDTH) of GRIDSPEC) + GRIDX]) + +(BOTTOMOFGRIDCOORD + [LAMBDA (GRIDY GRIDSPEC) (* rrb "19-MAR-82 09:38") + (IPLUS (fetch (REGION BOTTOM) of GRIDSPEC) + (ITIMES (fetch (REGION HEIGHT) of GRIDSPEC) + GRIDY]) + +(SHADEGRIDBOX + [LAMBDA (X Y SHADE OPERATION GRIDSPEC GRIDBORDER DS) (* ; "Edited 1-Sep-87 17:41 by FS") + (* shades the interior of a grid box.) + (PROG ((BORDER (OR (FIXP GRIDBORDER) + 0))) + (BLTSHADE SHADE DS (IPLUS (LEFTOFGRIDCOORD X GRIDSPEC) + BORDER) + (IPLUS (BOTTOMOFGRIDCOORD Y GRIDSPEC) + BORDER) + (IDIFFERENCE (fetch (REGION WIDTH) of GRIDSPEC) + (ITIMES BORDER 2)) + (IDIFFERENCE (fetch (REGION HEIGHT) of GRIDSPEC) + (ITIMES BORDER 2)) + OPERATION) (* if this is POINT grid, set lower + left corner.) + (COND + ((EQ GRIDBORDER 'POINT) + (BITMAPBIT DS (LEFTOFGRIDCOORD X GRIDSPEC) + (BOTTOMOFGRIDCOORD Y GRIDSPEC) + (MAXIMUMCOLOR (BITSPERPIXEL (DSPDESTINATION NIL DS]) +) + + + +(* ; "Low level compatibility and extensions") + +(DEFINEQ + +(INSIDE? + [LAMBDA (BOX X Y) (* rrb "19-MAR-82 09:32") + (AND (WITHIN (OR X LASTMOUSEX) + (fetch (REGION LEFT) of BOX) + (fetch (REGION WIDTH) of BOX)) + (WITHIN (OR Y LASTMOUSEY) + (fetch (REGION BOTTOM) of BOX) + (fetch (REGION HEIGHT) of BOX]) +) + + + +(* ; "Mouse selection code") + +(DEFINEQ + +(MOUSESTATE-EXPR + [LAMBDA (EXPR MOUSEONLYFLG) (* rrb " 5-Apr-84 17:05") + + (* if MOUSEONLYFLG is non-NIL, the testing should be done only on the mouse + buttons. MOUSEONLYFLG will be passed in as T by MOUSESTATE but will get reset + if any of the names are not mouse button names.) + + (PROG (NAMEMASK (MOUSEBUTTONMASK 7)) + (RETURN (COND + [(NLISTP EXPR) + (COND + [(EQ EXPR 'UP) + (LIST 'ZEROP (COND + (MOUSEONLYFLG (LIST 'LOGAND MOUSEBUTTONMASK ' + LASTMOUSEBUTTONS)) + (T 'LASTMOUSEBUTTONS] + (T + + (* MOUSEONLYFLG can be ignored on this branch because it is generating code for + the case where the user is listing the button names and if he includes keyset + names you want to include them anyway.) + + (LIST 'NEQ (LIST 'LOGAND 'LASTMOUSEBUTTONS (MOUSESTATE-NAME EXPR)) + 0] + ((EQ (CAR EXPR) + 'ONLY) + (COND + ((SETQ NAMEMASK (MOUSESTATE-NAME (CADR EXPR) + MOUSEONLYFLG))) + ((SETQ NAMEMASK (MOUSESTATE-NAME (CADR EXPR) + NIL)) (* non-mouse buttons were named, use + all keys.) + (SETQ MOUSEONLYFLG NIL))) + (LIST 'EQ (COND + (MOUSEONLYFLG (LIST 'LOGAND MOUSEBUTTONMASK 'LASTMOUSEBUTTONS)) + (T 'LASTMOUSEBUTTONS)) + NAMEMASK)) + ([EVERY EXPR (FUNCTION (LAMBDA (X) + (AND (ATOM X) + (NEQ X 'UP] + + (* Cant use LOGx trick for UP as it is a disjunct not a key selector) + + (SELECTQ (CAR EXPR) + (OR [LIST 'NEQ 0 (LIST 'LOGAND 'LASTMOUSEBUTTONS + (CONS 'LOGOR (MAPCAR (CDR EXPR) + (FUNCTION MOUSESTATE-NAME]) + (AND [LIST 'EQ (CONS 'LOGOR (MAPCAR (CDR EXPR) + (FUNCTION MOUSESTATE-NAME))) + (LIST 'LOGAND 'LASTMOUSEBUTTONS + (CONS 'LOGOR (MAPCAR (CDR EXPR) + (FUNCTION MOUSESTATE-NAME]) + (NOT (COND + ((CDDR EXPR) + (SHOULDNT))) + [LIST 'ZEROP (LIST 'LOGAND 'LASTMOUSEBUTTONS (MOUSESTATE-NAME + (CADR EXPR]) + (HELP (CAR EXPR) + " unrecognized mouse key operator"))) + (T (CONS (CAR EXPR) + (MAPCAR (CDR EXPR) + (FUNCTION (LAMBDA (OPT) + (MOUSESTATE-EXPR OPT MOUSEONLYFLG]) + +(MOUSESTATE-NAME + [LAMBDA (KEYNAME MOUSEONLYFLG) (* rrb "13-JUN-82 11:17") + + (* return the numeric code for a mouse or keyset key.) + + (SELECTQ KEYNAME + ((LEFT RED) + 4) + ((RIGHT BLUE) + 2) + ((YELLOW MIDDLE) + 1) + (COND + ((NOT MOUSEONLYFLG) (* if wants mouse only, return NIL) + (SELECTQ KEYNAME + (LEFTKEY 128) + (LEFTMIDDLEKEY 64) + (MIDDLEKEY 32) + (RIGHTMIDDLEKEY + 16) + (RIGHTKEY 8) + (HELP KEYNAME " is not a recognized key name."]) +) + +(PUTPROPS MOUSESTATE ARGNAMES (BUTTONFORM)) + +(PUTPROPS LASTMOUSESTATE ARGNAMES (BUTTONFORM)) + +(PUTPROPS UNTILMOUSESTATE ARGNAMES (BUTTONFORM INTERVAL)) + +(PUTPROPS KEYSETSTATE ARGNAMES (BUTTONFORM)) + +(PUTPROPS LASTKEYSETSTATE ARGNAMES (BUTTONFORM)) +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: DOCOPY +(DECLARE%: EVAL@COMPILE + +(PUTPROPS MOUSESTATE MACRO (ARGS (LIST 'PROGN '(GETMOUSESTATE) + (MOUSESTATE-EXPR (CAR ARGS) + T)))) + +(PUTPROPS LASTMOUSESTATE MACRO (ARGS (MOUSESTATE-EXPR (CAR ARGS) + T))) + +(PUTPROPS UNTILMOUSESTATE MACRO [ARGS (COND + [(AND (CDR ARGS) + (CADR ARGS) + (NEQ (CADR ARGS) + T)) + + (* time argument is given and is not T or NIL; + compile in time keeping loop.) + + (LIST 'PROG [LIST (LIST 'TIMEOUT + (LIST 'IPLUS '(CLOCK 0) + (LIST 'OR (LIST 'NUMBERP + (CADR ARGS)) + 100))) + '(NOWTIME (CLOCK 0] + 'LP + [LIST 'COND (LIST (CONS 'MOUSESTATE + (LIST (CAR ARGS) + T)) + '(RETURN T] + '(COND + ((IGREATERP (CLOCK0 NOWTIME) + TIMEOUT) + (RETURN NIL)) + (T (\BACKGROUND))) + '(GO LP] + (T (LIST 'PROG NIL 'LP + [LIST 'COND (LIST (CONS 'MOUSESTATE + (LIST (CAR ARGS) + T)) + '(RETURN T] + '(\BACKGROUND) + '(GO LP]) + +(PUTPROPS KEYSETSTATE MACRO [ARGS (LIST 'PROGN '(GETMOUSESTATE) + (MOUSESTATE-EXPR (CAR ARGS]) + +(PUTPROPS LASTKEYSETSTATE MACRO (ARGS (MOUSESTATE-EXPR (CAR ARGS)))) +) +) +(DECLARE%: DONTCOPY +(DECLARE%: EVAL@COMPILE + +(PUTPROPS WITHIN MACRO [(A B C) + (AND (IGEQ A B) + (ILESSP A (IPLUS B C]) +) +) + +(ADDTOVAR GLOBALVARS LASTMOUSEX LASTMOUSEY LASTMOUSEBUTTONS) + +(* "END EXPORTED DEFINITIONS") + + + + +(* ; "High Level Display utilities") + +(DEFINEQ + +(DECODEBUTTONS + [LAMBDA (BUTTONSTATE) + (DECLARE (GLOBALVARS LASTMOUSEBUTTONS)) (* rrb " 9-JAN-82 14:20") + + (* return a list of the buttons and keys that are down from a button state.) + + (OR (SMALLP BUTTONSTATE) + (SETQ BUTTONSTATE LASTMOUSEBUTTONS)) + (NCONC (AND (NEQ 0 (LOGAND BUTTONSTATE 4)) + (CONS 'LEFT)) + (AND (NEQ 0 (LOGAND BUTTONSTATE 2)) + (CONS 'RIGHT)) + (AND (NEQ 0 (LOGAND BUTTONSTATE 1)) + (CONS 'MIDDLE)) + (AND (NEQ 0 (LOGAND BUTTONSTATE 128)) + (CONS 'LEFTKEY)) + (AND (NEQ 0 (LOGAND BUTTONSTATE 64)) + (CONS 'LEFTMIDDLEKEY)) + (AND (NEQ 0 (LOGAND BUTTONSTATE 32)) + (CONS 'MIDDLEKEY)) + (AND (NEQ 0 (LOGAND BUTTONSTATE 16)) + (CONS 'RIGHTMIDDLEKEY)) + (AND (NEQ 0 (LOGAND BUTTONSTATE 8)) + (CONS 'RIGHTKEY]) +) +(DEFINEQ + +(PTDIFFERENCE + [LAMBDA (PT1 PT2) (* rrb "24-JAN-83 14:54") + (* adds two positions) + (create POSITION + XCOORD _ (DIFFERENCE (fetch (POSITION XCOORD) of PT1) + (fetch (POSITION XCOORD) of PT2)) + YCOORD _ (DIFFERENCE (fetch (POSITION YCOORD) of PT1) + (fetch (POSITION YCOORD) of PT2]) + +(PTPLUS + [LAMBDA (PT1 PT2) (* rrb "24-JAN-83 14:54") + (* adds two positions) + (create POSITION + XCOORD _ (PLUS (fetch (POSITION XCOORD) of PT1) + (fetch (POSITION XCOORD) of PT2)) + YCOORD _ (PLUS (fetch (POSITION YCOORD) of PT1) + (fetch (POSITION YCOORD) of PT2]) +) + + + +(* ; "User interaction for regions, etc") + +(DEFINEQ + +(GETPOSITION + [LAMBDA (WINDOW CURSOR) (* ; "Edited 27-Aug-87 16:56 by FS") + (* ; "Get position with cursor") + + (fetch (SCREENPOSITION POSITION) of (GETSCREENPOSITION WINDOW CURSOR]) + +(GETBOXPOSITION + [LAMBDA (BOXWIDTH BOXHEIGHT ORGX ORGY WINDOW PROMPTMSG) + (* ; + "Edited 17-Jan-94 14:01 by sybalsky:mv:envos") + + (* ;; "gets a box position, returning the lower left corner. During the moving the outline of the box is displayed. If ORGX is given, the box is originally drawn at that location and the nearest corner to the cursor is snapped to the cursor position.") + + (fetch (SCREENPOSITION POSITION) of (GETBOXSCREENPOSITION BOXWIDTH BOXHEIGHT ORGX + ORGY WINDOW PROMPTMSG]) + +(DSPYSCREENTOWINDOW + [LAMBDA (Y DS) (* ; "Edited 15-Mar-94 10:41 by sybalsky") + (* transforms an y coordinate from + screen coordinates into window + coordinates) + (IDIFFERENCE Y (fetch (\DISPLAYDATA DDYOFFSET) of (\GETDISPLAYDATA DS]) + +(DSPXSCREENTOWINDOW + [LAMBDA (X DS) (* ; "Edited 15-Mar-94 10:41 by sybalsky") + (* transforms an x coordinate from + screen coordinates into window + coordinates) + (IDIFFERENCE X (fetch (\DISPLAYDATA DDXOFFSET) of (\GETDISPLAYDATA DS]) + +(GETREGION + [LAMBDA (MINWIDTH MINHEIGHT INITREGION NEWREGIONFN NEWREGIONFNARG INITCORNERS) + (* ; + "Edited 17-Jan-94 14:02 by sybalsky:mv:envos") + (* ; "accepts region from the user.") + (fetch (SCREENREGION REGION) of (GETSCREENREGION MINWIDTH MINHEIGHT INITREGION + NEWREGIONFN NEWREGIONFNARG INITCORNERS]) + +(\GETREGION.PACKPTS + [LAMBDA NIL (* rrb "12-Dec-83 18:01") + (* copy from variable into position + for the constraint checks.) + (replace (POSITION XCOORD) of BASEPT with BASEX) + (replace (POSITION YCOORD) of BASEPT with BASEY) + (replace (POSITION XCOORD) of OPPT with OPPX) + (replace (POSITION YCOORD) of OPPT with OPPY]) + +(\GETREGION.CHECKBASEPT + [LAMBDA (NEWREGFNS BASEPT) (* ; "Edited 15-Mar-94 10:40 by sybalsky") + + (* ;; + "called by GETREGION to check the constraints imposed on the base point by the user functions.") + + (* ;; "if the new region fns is a list, apply them in order.") + + (bind USERPT for FN in NEWREGFNS do + + (* ;; "call user fn on base pt") + + (* ;; +"copying the user return point is time cnsuming but necessary to isolate the system from user code.") + + (SETQ USERPT (APPLY* FN BASEPT NIL + NEWREGIONFNARG)) + (COND + ((NOT (POSITIONP USERPT)) + (ERROR + "non-POSITION returned by NEWREGIONFN" + USERPT)) + (T (replace (POSITION XCOORD) + of BASEPT + with (fetch (POSITION XCOORD) + of USERPT)) + (replace (POSITION YCOORD) + of BASEPT + with (fetch (POSITION YCOORD) + of USERPT]) + +(\GETREGION.CHECKOPPT + [LAMBDA (MINWID MINHGHT NEWREGFNS BASEPT OPPT) (* ; "Edited 15-Mar-94 10:40 by sybalsky") + + (* called by GETREGION to check the constraints imposed by the minimum sizes + and user functions. It assumes BASEPT and OPPT are POSITIONs set to the fixed + corner BASEPT and moving corner OPPT.) + + (PROG ((BASEX (fetch (POSITION XCOORD) of BASEPT)) + (BASEY (fetch (POSITION YCOORD) of BASEPT)) + (OPPX (fetch (POSITION XCOORD) of OPPT)) + (OPPY (fetch (POSITION YCOORD) of OPPT)) + USERPT) (* check for minimum height and + width constraints.) + (AND [COND + [(IGREATERP BASEX OPPX) + (COND + ((ILESSP (IDIFFERENCE BASEX OPPX) + MINWID) + (SETQ OPPX (IDIFFERENCE BASEX MINWID] + ((ILESSP (IDIFFERENCE OPPX BASEX) + MINWID) + (SETQ OPPX (IPLUS BASEX MINWID] + (replace (POSITION XCOORD) of OPPT with OPPX)) + (AND [COND + [(IGREATERP BASEY OPPY) + (COND + ((ILESSP (IDIFFERENCE BASEY OPPY) + MINHGHT) + (SETQ OPPY (IDIFFERENCE BASEY MINHGHT] + ((ILESSP (IDIFFERENCE OPPY BASEY) + MINHGHT) + (SETQ OPPY (IPLUS BASEY MINHGHT] + (replace (POSITION YCOORD) of OPPT with OPPY)) + (* if the new region fns is a list, + apply them in order.) + (for FN in NEWREGFNS do (SETQ USERPT (APPLY* FN BASEPT OPPT NEWREGIONFNARG)) + (COND + ((NOT (POSITIONP USERPT)) + (ERROR "non-POSITION returned by NEWREGIONFN" USERPT + )) + (T (replace (POSITION XCOORD) of OPPT + with (fetch (POSITION XCOORD) + of USERPT)) + (replace (POSITION YCOORD) of OPPT + with (fetch (POSITION YCOORD) + of USERPT]) + +(\GETREGIONTRACKWITHBOX + [LAMBDA NIL (* ; "Edited 26-May-2025 10:52 by frank") + (* hdj "19-Sep-86 14:40") + + (* ;; "tracks a box sized between BASEX BASEY and OPPX OPPY until the left or middle mouse button go down.") + + (DECLARE (GLOBALVARS \CURSORDESTINATION DASHEDSHADE) + (USEDFREE BASEX BASEY OPPX OPPY) + (LOCALVARS . T)) + (PROG (OLDCURSOR NOERROR XTEMP YTEMP OLDMOUSEX OLDMOUSEY POSTEMP THRUONCE WIDTH HEIGHT + DESTINATION MAXX MAXY) + (SETQ WIDTH (IDIFFERENCE BASEX OPPX)) + (SETQ HEIGHT (IDIFFERENCE BASEY OPPY)) + (SETQ DESTINATION \CURSORDESTINATION) + (SETQ MAXX (SUB1 (BITMAPWIDTH DESTINATION))) + (SETQ MAXY (SUB1 (BITMAPHEIGHT DESTINATION))) + (DRAWGRAYBOX OPPX OPPY BASEX BASEY DESTINATION DASHEDSHADE) + + (* ;; "go thru the loop at least once so that checking of user function against the first point is always done.") + + [SETQ NOERROR (ERSETQ (until (AND THRUONCE (MOUSESTATE (OR LEFT MIDDLE))) + do (SETQ THRUONCE T) + (FGH) + (COND + ((LASTMOUSESTATE RIGHT) + (SETQ OLDCURSOR (CURSOR FORCEPS)) + (until (MOUSESTATE (NOT RIGHT))) + (CURSOR OLDCURSOR) (* ; "switch to drag nearest corner") + [COND + ((COND + ((IGREATERP BASEX OPPX) + (IGREATERP LASTMOUSEX (IQUOTIENT (IPLUS OPPX BASEX) + 2))) + (T (IGREATERP (IQUOTIENT (IPLUS OPPX BASEX) + 2) + LASTMOUSEX))) + (* ; "switch X") + (swap OPPX BASEX) + (SETQ WIDTH (IDIFFERENCE BASEX OPPX] + [COND + ((COND + ((IGREATERP BASEY OPPY) + (IGREATERP LASTMOUSEY (IQUOTIENT (IPLUS OPPY BASEY) + 2))) + (T (IGREATERP (IQUOTIENT (IPLUS OPPY BASEY) + 2) + LASTMOUSEY))) + (* ; "switch Y") + (swap OPPY BASEY) + (SETQ HEIGHT (IDIFFERENCE BASEY OPPY] + (\CURSORPOSITION OPPX OPPY)) + ((OR (NOT (EQ LASTMOUSEX OLDMOUSEX)) + (NOT (EQ LASTMOUSEY OLDMOUSEY))) + (* ; + "the cursor has moved, check user constraints.") + (SETQ OLDMOUSEX LASTMOUSEX) + (SETQ OLDMOUSEY LASTMOUSEY) + (* ; + "make sure the base corner {which is opposite the one tracked with the mouse} is on the screen.") + [replace (POSITION XCOORD) of BASEPT + with (IMAX 0 (IMIN MAXX (IPLUS OLDMOUSEX WIDTH] + [replace (POSITION YCOORD) of BASEPT + with (IMAX 0 (IMIN MAXY (IPLUS OLDMOUSEY HEIGHT] + (\GETREGION.CHECKBASEPT NEWREGFNS BASEPT) + (SETQ XTEMP (fetch (POSITION XCOORD) of BASEPT)) + (SETQ YTEMP (fetch (POSITION YCOORD) of BASEPT)) + (COND + ((NOT (AND (IEQP BASEX XTEMP) + (IEQP BASEY YTEMP) + (EQ \CURSORDESTINATION DESTINATION))) + (* ; "move the box") + (SETQ XTEMP (IDIFFERENCE XTEMP BASEX)) + (SETQ YTEMP (IDIFFERENCE YTEMP BASEY)) + (DRAWGRAYBOX OPPX OPPY BASEX BASEY DESTINATION + DASHEDSHADE) + (SETQ DESTINATION \CURSORDESTINATION) + (SETQ MAXX (SUB1 (BITMAPWIDTH DESTINATION))) + (SETQ MAXY (SUB1 (BITMAPHEIGHT DESTINATION))) + (SETQ OPPX (IPLUS OPPX XTEMP)) + (SETQ OPPY (IPLUS OPPY YTEMP)) + (SETQ BASEX (IPLUS BASEX XTEMP)) + (SETQ BASEY (IPLUS BASEY YTEMP)) + (COND + (BACKGROUNDCURSOREXITFN (APPLY* + BACKGROUNDCURSOREXITFN + ))) + (DRAWGRAYBOX OPPX OPPY BASEX BASEY DESTINATION + DASHEDSHADE] + (DRAWGRAYBOX OPPX OPPY BASEX BASEY DESTINATION DASHEDSHADE) + (COND + ((NULL NOERROR) (* ; "pass back ^E") + (ERROR!]) + +(\UPDATEXYANDBOX + [LAMBDA (BASEPTCHANGE? DESTINATION SHADE) (* kbr%: " 3-Feb-86 12:44") + + (* moves the values in BASEPT and OPPT into the variables BASEX BASEY OPPX OPPY + and updates the image on the screen if it has changed.) + + (PROG (TEMPX TEMPY) + (COND + [(EQ DESTINATION \CURSORDESTINATION) (* Cursor destination hasn't changed. + Add to old image. *) + [COND + (BASEPTCHANGE? (* the base point might have changed, + check it too.) + (SETQ TEMPX (fetch (POSITION XCOORD) of BASEPT)) + (SETQ TEMPY (fetch (POSITION YCOORD) of BASEPT)) + (COND + ((NOT (AND (IEQP BASEX TEMPX) + (IEQP BASEY TEMPY))) (* move the box) + (MOVEBOX OPPX OPPY BASEX BASEY (SETQ BASEX TEMPX) + (SETQ BASEY TEMPY) + DESTINATION SHADE] + (SETQ TEMPX (fetch (POSITION XCOORD) of OPPT)) + (SETQ TEMPY (fetch (POSITION YCOORD) of OPPT)) + (COND + ((NOT (AND (IEQP OPPX TEMPX) + (IEQP OPPY TEMPY))) (* move the box) + (MOVEBOX BASEX BASEY OPPX OPPY (SETQ OPPX TEMPX) + (SETQ OPPY TEMPY) + DESTINATION SHADE) + (SETCORNER BASEX BASEY OPPX OPPY] + (T + + (* Cursor moved to new screen. Can't get new image by adding to old image. + *) + + (DRAWGRAYBOX BASEX BASEY OPPX OPPY DESTINATION SHADE) + (SETQ BASEX (fetch (POSITION XCOORD) of BASEPT)) + (SETQ BASEY (fetch (POSITION YCOORD) of BASEPT)) + (SETQ OPPX (fetch (POSITION XCOORD) of OPPT)) + (SETQ OPPY (fetch (POSITION YCOORD) of OPPT)) + (DRAWGRAYBOX BASEX BASEY OPPX OPPY \CURSORDESTINATION SHADE) + (SETCORNER BASEX BASEY OPPX OPPY]) + +(GETBOXREGION + [LAMBDA (WIDTH HEIGHT ORGX ORGY WINDOW PROMPTMSG) + (* ; + "Edited 17-Jan-94 14:02 by sybalsky:mv:envos") + + (* ;; "returns a region width by height positioned where user says.") + + (fetch (SCREENREGION REGION) of (GETBOXSCREENREGION WIDTH HEIGHT ORGX ORGY WINDOW + PROMPTMSG]) + +(\TRACKWITHBOX + [LAMBDA (SHADE) (* ; "Edited 31-Aug-87 12:45 by FS") + + (* ;; "tracks the cursor with a box from corner ORGX ORGY with dimensions BOXWIDTH and BOXHEIGHT until the left or middle button changes. Implements the convention that the RIGHT button can be used to change corners. Returns non-NIL unless an error occurred. Returns the result by setting freely the variables ORGX ORGY BOXWIDTH BOXHEIGHT") + + (DECLARE (SPECVARS ORGX ORGY BOXWIDTH BOXHEIGHT)) + (PROG (OLDCURSOR ORGLEFTMIDDLE NOERROR MLMASK DESTINATION) + [SETQ MLMASK (CONSTANT (LOGOR (MOUSESTATE-NAME 'LEFT) + (MOUSESTATE-NAME 'MIDDLE] + (SETQ DESTINATION \CURSORDESTINATION) + (SETQ ORGLEFTMIDDLE (LOGAND MLMASK LASTMOUSEBUTTONS)) + (DRAWGRAYBOX ORGX ORGY (IPLUS ORGX BOXWIDTH) + (IPLUS ORGY BOXHEIGHT) + DESTINATION SHADE) + [SETQ NOERROR (ERSETQ (until (PROGN (GETMOUSESTATE) + (NOT (EQ (LOGAND MLMASK LASTMOUSEBUTTONS) + ORGLEFTMIDDLE))) + do (COND + ((LASTMOUSESTATE RIGHT) + (SETQ OLDCURSOR (CURSOR FORCEPS)) + (until (MOUSESTATE (NOT RIGHT))) + (CURSOR OLDCURSOR) (* ; "switch to drag nearest corner") + + [COND + ((COND + [(IGREATERP BOXWIDTH 0) + (IGREATERP LASTMOUSEX (IPLUS ORGX (IQUOTIENT + BOXWIDTH 2 + ] + (T (IGREATERP (IPLUS ORGX (IQUOTIENT BOXWIDTH 2)) + LASTMOUSEX))) + (* ; "switch X") + + (SETQ ORGX (IPLUS ORGX BOXWIDTH)) + (SETQ BOXWIDTH (IMINUS BOXWIDTH] + [COND + ((COND + [(IGREATERP BOXHEIGHT 0) + (IGREATERP LASTMOUSEY (IPLUS ORGY (IQUOTIENT + BOXHEIGHT + 2] + (T (IGREATERP (IPLUS ORGY (IQUOTIENT BOXHEIGHT 2)) + LASTMOUSEY))) + (* ; "switch Y") + + (SETQ ORGY (IPLUS ORGY BOXHEIGHT)) + (SETQ BOXHEIGHT (IMINUS BOXHEIGHT] + (\CURSORPOSITION ORGX ORGY)) + (T (COND + ((NOT (AND (IEQP ORGX LASTMOUSEX) + (IEQP ORGY LASTMOUSEY))) + (* ; + "the cursor has moved, move the box by erasing old box and drawing new box. *") + + (DRAWGRAYBOX ORGX ORGY (IPLUS ORGX BOXWIDTH) + (IPLUS ORGY BOXHEIGHT) + DESTINATION SHADE) + (SETQ ORGX LASTMOUSEX) + (SETQ ORGY LASTMOUSEY) + (SETQ DESTINATION \CURSORDESTINATION) + (COND + (BACKGROUNDCURSOREXITFN (APPLY* + BACKGROUNDCURSOREXITFN + ))) + (DRAWGRAYBOX ORGX ORGY (IPLUS ORGX BOXWIDTH) + (IPLUS ORGY BOXHEIGHT) + DESTINATION SHADE] + (DRAWGRAYBOX ORGX ORGY (IPLUS ORGX BOXWIDTH) + (IPLUS ORGY BOXHEIGHT) + DESTINATION SHADE) + (COND + ((NULL NOERROR) (* ; "pass back ^E") + + (ERROR!]) + +(MOVEBOX + [LAMBDA (X1 Y1 X2 Y2 X3 Y3 DESTINATION SHADE) (* ; "Edited 25-Aug-87 15:52 by FS") + (* ; + "moves the opposite corner of a box from {X2,Y2} to {X3,Y3}.") + + (.WHILE.CURSOR.DOWN. (BLTHLINE Y1 X2 X3 DESTINATION SHADE) + (BLTVLINE X1 Y2 Y3 DESTINATION SHADE) + (BLTHLINE Y2 X1 X2 DESTINATION SHADE) + (BLTHLINE Y3 X1 X3 DESTINATION SHADE) + (BLTVLINE X2 Y1 Y2 DESTINATION SHADE) + (BLTVLINE X3 Y1 Y3 DESTINATION SHADE]) + +(DRAWGRAYBOX + [LAMBDA (X1 Y1 X2 Y2 DESTINATION SHADE) (* kbr%: " 3-Feb-86 12:47") + (* Put a gray box in window or bitmap + DESTINATION) + (.WHILE.CURSOR.DOWN. (BLTHLINE Y1 X1 X2 DESTINATION SHADE) + (BLTVLINE X1 Y1 Y2 DESTINATION SHADE) + (BLTHLINE Y2 X1 X2 DESTINATION SHADE) + (BLTVLINE X2 Y1 Y2 DESTINATION SHADE]) + +(BLTHLINE + [LAMBDA (Y XA XB DESTINATION SHADE) (* ; "Edited 1-Sep-87 17:43 by FS") + + (BLTSHADE SHADE DESTINATION (IMIN XA XB) + Y + (IABS (IDIFFERENCE XB XA)) + 2 + 'INVERT]) + +(BLTVLINE + [LAMBDA (X YA YB DESTINATION SHADE) (* ; "Edited 1-Sep-87 17:43 by FS") + + (BLTSHADE SHADE DESTINATION X (IMIN YA YB) + 2 + (IABS (IDIFFERENCE YB YA)) + 'INVERT]) + +(SETCORNER + [LAMBDA (X1 Y1 X2 Y2) (* edited%: "26-Jan-86 13:15") + + (* sets the cursor shape for the box from x1,y1 to x2, y2) + + (DECLARE (GLOBALVARS LowerLeftCursor LowerRightCursor UpperLeftCursor UpperRightCursor)) + (PROG (NEWCURSOR OLDCURSOR) + [SETQ NEWCURSOR (COND + ((IGREATERP X2 X1) (* moving to left) + (COND + ((IGREATERP Y2 Y1) (* moving up) + UpperRightCursor) + (T LowerRightCursor))) + (T (* moving to right) + (COND + ((IGREATERP Y2 Y1) + UpperLeftCursor) + (T LowerLeftCursor] (* only call cursor if it changes + (less flicker on software cursors)) + (SETQ OLDCURSOR (CURSOR)) + (COND + ((NOT (EQ NEWCURSOR OLDCURSOR)) + (CURSOR NEWCURSOR) + (\CURSORPOSITION X2 Y2]) + +(GETSCREENPOSITION + [LAMBDA (WINDOW CURSOR) (* ; + "Edited 17-Jan-94 14:32 by sybalsky:mv:envos") + + (* ;; "Get screenposition with cursor. If WINDOW, then screenposition should be on same screen as WINDOW and in WINDOW's coordinate system. *") + + (OR (NULL WINDOW) + (SETQ WINDOW (WFROMDS WINDOW))) + (WINDOWOP 'SCGETSCREENPOSITION (COND + (WINDOW (FETCH (WINDOW SCREEN) OF WINDOW)) + (T \CURSORSCREEN)) + WINDOW CURSOR]) + +(GETBOXSCREENPOSITION + [LAMBDA (BOXWIDTH BOXHEIGHT ORGX ORGY WINDOW PROMPTMSG) + (* ; + "Edited 17-Jan-94 14:32 by sybalsky:mv:envos") + + (* ;; "gets a box position, returning the lower left corner. During the moving the outline of the box is displayed. If ORGX is given, the box is originally drawn at that location and the nearest corner to the cursor is snapped to the cursor position.") + + (WINDOWOP 'SCGETBOXSCREENPOSITION \CURSORSCREEN BOXWIDTH BOXHEIGHT ORGX ORGY WINDOW PROMPTMSG]) + +(GETSCREENREGION + [LAMBDA (MINWIDTH MINHEIGHT INITREGION NEWREGIONFN NEWREGIONFNARG INITCORNERS) + (* ; + "Edited 17-Jan-94 14:32 by sybalsky:mv:envos") + (* ; "accepts region from the user.") + + (* ;; "accepts region from the user. INITCORNERS lets caller specify size of initial ghost box. It is a list of the form (BASEX BASEY OPPX OPPY)") + + (WINDOWOP 'SCGETSCREENREGION \CURSORSCREEN MINWIDTH MINHEIGHT INITREGION NEWREGIONFN + NEWREGIONFNARG INITCORNERS]) + +(GETBOXSCREENREGION + [LAMBDA (WIDTH HEIGHT ORGX ORGY WINDOW PROMPTMSG) (* ; "Edited 7-Dec-88 16:36 by SHIH") + + (* ;; "returns a screenregion width by height positioned where user says.") + + (PROG (SCREENPOS) + (SETQ SCREENPOS (GETBOXSCREENPOSITION WIDTH HEIGHT ORGX ORGY WINDOW PROMPTMSG)) + (RETURN (create SCREENREGION + SCREEN _ (fetch (SCREENPOSITION SCREEN) of SCREENPOS) + LEFT _ (fetch (SCREENPOSITION XCOORD) of SCREENPOS) + BOTTOM _ (fetch (SCREENPOSITION YCOORD) of SCREENPOS) + WIDTH _ WIDTH + HEIGHT _ HEIGHT]) +) + + + +(* ;; "Old-medley-window-system versions of generic box/position functions") + +(DEFINEQ + +(\MEDW.GETSCREENPOSITION + [LAMBDA (SCREEN WINDOW CURSOR) (* ; + "Edited 17-Jan-94 14:15 by sybalsky:mv:envos") + + (* ;; "Get screenposition with cursor. If WINDOW, then screenposition should be on same screen as WINDOW and in WINDOW's coordinate system. *") + + (OR (NULL WINDOW) + (SETQ WINDOW (WFROMDS WINDOW))) + (RESETFORM (CURSOR (OR CURSOR CROSSHAIRS)) + [until (MOUSESTATE LEFT) do (COND + (BACKGROUNDCURSOREXITFN (APPLY* + BACKGROUNDCURSOREXITFN + ] + (* ; "wait until the cursor is down") + [COND + (WINDOW (until (AND (MOUSESTATE (NOT LEFT)) + (EQ \CURSORSCREEN (fetch (WINDOW SCREEN) of WINDOW))) + do (COND + (BACKGROUNDCURSOREXITFN (APPLY* BACKGROUNDCURSOREXITFN] + + (* ;; "if a window was specified, then wait until the left button comes up, or until the cursor leaves the screen of the window") + + (COND + ((NULL WINDOW) + (until (MOUSESTATE (NOT LEFT))) + (create SCREENPOSITION + SCREEN _ LASTSCREEN + XCOORD _ LASTMOUSEX + YCOORD _ LASTMOUSEY)) + (T (create SCREENPOSITION + SCREEN _ LASTSCREEN + XCOORD _ (LASTMOUSEX WINDOW) + YCOORD _ (LASTMOUSEY WINDOW]) + +(\MEDW.GETBOXSCREENPOSITION + [LAMBDA (SCREEN BOXWIDTH BOXHEIGHT ORGX ORGY WINDOW PROMPTMSG) + (* ; + "Edited 17-Jan-94 14:18 by sybalsky:mv:envos") + + (* ;; "gets a box position, returning the lower left corner. During the moving the outline of the box is displayed. If ORGX is given, the box is originally drawn at that location and the nearest corner to the cursor is snapped to the cursor position.") + + (RESETFORM (CURSOR BOXCURSOR) + (PROG ((MOUSEDOWNFLG (MOUSESTATE (OR LEFT MIDDLE))) + SHADE) + (COND + ((AND (FIXP ORGX) + (FIXP ORGY)) (* ; + "origin given, move cursor to nearest corner.") + [COND + ((IGREATERP LASTMOUSEX (IPLUS ORGX (IQUOTIENT BOXWIDTH 2))) + (SETQ ORGX (IPLUS ORGX BOXWIDTH)) + (SETQ BOXWIDTH (IMINUS BOXWIDTH] + [COND + ((IGREATERP LASTMOUSEY (IPLUS ORGY (IQUOTIENT BOXHEIGHT 2))) + (SETQ ORGY (IPLUS ORGY BOXHEIGHT)) + (SETQ BOXHEIGHT (IMINUS BOXHEIGHT] + (\CURSORPOSITION ORGX ORGY)) + (T (SETQ ORGX LASTMOUSEX) + (SETQ ORGY LASTMOUSEY))) + (AND PROMPTMSG (PROMPTPRINT PROMPTMSG)) + (SETQ SHADE GRAYSHADE) + TRACKLP + (* ; + "track the cursor with a box ghost until the left or middle button changes.") + (\TRACKWITHBOX SHADE) + [COND + ((AND (NULL MOUSEDOWNFLG) + (LASTMOUSESTATE (NOT UP))) + (SETQ MOUSEDOWNFLG T) + (CURSOR CROSSHAIRS)) + ((AND MOUSEDOWNFLG (LASTMOUSESTATE UP)) + (AND PROMPTMSG (CLRPROMPT)) + (RETURN (COND + (WINDOW (create SCREENPOSITION + SCREEN _ LASTSCREEN + XCOORD _ (DSPXSCREENTOWINDOW (IMIN ORGX + (IPLUS ORGX + BOXWIDTH + )) + WINDOW) + YCOORD _ (DSPYSCREENTOWINDOW (IMIN ORGY + (IPLUS ORGY + BOXHEIGHT + )) + WINDOW))) + (T (create SCREENPOSITION + SCREEN _ LASTSCREEN + XCOORD _ (IMIN ORGX (IPLUS ORGX BOXWIDTH)) + YCOORD _ (IMIN ORGY (IPLUS ORGY BOXHEIGHT] + (GO TRACKLP]) + +(\MEDW.GETSCREENREGION + [LAMBDA (SCREEN MINWIDTH MINHEIGHT INITREGION NEWREGIONFN NEWREGIONFNARG INITCORNERS) + (* ; + "Edited 17-Jan-94 14:17 by sybalsky:mv:envos") + (* ; "accepts region from the user.") + + (* ;; "accepts region from the user. INITCORNERS lets caller specify size of initial ghost box. It is a list of the form (BASEX BASEY OPPX OPPY)") + +(* ;;; "Why is INITCORNERS not two positions? gbn") + + (RESETFORM (CURSOR EXPANDINGBOX) + (PROG (DESTINATION SHADE BASEX BASEY OPPX OPPY OLDMOUSEX OLDMOUSEY INITLEFT INITRIGHT + INITBOTTOM INITTOP BASEPT OPPT NEWMOUSEX NEWMOUSEY DOWNFLG BEGCLOCK + NOTTIMEDOUT NEWREGFNS) + (SETQ BASEPT (create POSITION)) + (SETQ OPPT (create POSITION)) + (SETQ MINWIDTH (COND + ((FIXP MINWIDTH)) + (T 0))) + (SETQ MINHEIGHT (COND + ((FIXP MINHEIGHT)) + (T 0))) + (SETQ NEWREGFNS (MKLIST NEWREGIONFN)) + (SETQ SHADE GRAYSHADE) + (SETQ NOTTIMEDOUT T) + (SETQ DESTINATION \CURSORDESTINATION) + [COND + [INITCORNERS (* ; "setup box by initcorners.") + (COND + ((AND (EQ 4 (LENGTH INITCORNERS)) + (for X in INITCORNERS always (FIXP X))) + (SETQ BASEX (CAR INITCORNERS)) + (SETQ BASEY (CADR INITCORNERS)) + (SETQ OPPX (CADDR INITCORNERS)) + (SETQ OPPY (CADDDR INITCORNERS))) + (T (\ILLEGAL.ARG INITCORNERS] + (T (* ; + "start with the cursor in the lower right corner of the ghost box.") + (GETMOUSESTATE) + (SETQ OPPX LASTMOUSEX) + (SETQ OPPY LASTMOUSEY) + [COND + ((ILESSP (SETQ BASEX (IDIFFERENCE OPPX MINWIDTH)) + 0) + + (* ;; "arrange things so that the whole box if possible is on the screen. If this is not possible, the lower right corner is on the screen.") + + (SETQ OPPX (SUB1 (IMIN MINWIDTH \CURSORDESTWIDTH))) + (SETQ BASEX (IDIFFERENCE OPPX MINWIDTH] + (COND + ((IGEQ (SETQ BASEY (IPLUS OPPY MINHEIGHT)) + \CURSORDESTHEIGHT) + + (* ;; "if the top corner would be off the screen, move the bottom corner as low as necessary but limited to the bottom of the screen.") + + (SETQ OPPY (IMAX 0 (IDIFFERENCE \CURSORDESTHEIGHT MINHEIGHT))) + (SETQ BASEY (IPLUS OPPY MINHEIGHT] + (\CURSORPOSITION OPPX OPPY) (* ; + "wait for the user to put down the first corner.") + (\GETREGIONTRACKWITHBOX) + [COND + ((AND INITREGION (LASTMOUSESTATE MIDDLE))(* ; + "switch the nearest corner of INITREGION to the cursor and track it.") + (* ; + "Pull from closest corner, ie. set BASEX,Y to be opposite corner") + (SETQ BASEX (COND + ((ILESSP (SETQ OPPX LASTMOUSEX) + (IQUOTIENT [IPLUS (SETQ INITLEFT (fetch (REGION + LEFT) + of INITREGION)) + (SETQ INITRIGHT + (IPLUS INITLEFT (fetch + (REGION WIDTH) + of INITREGION] + 2)) (* ; + "pointing at left half of box, so make origin be in right") + INITRIGHT) + (T (* ; "pointing at right half of box,") + INITLEFT))) + (SETQ BASEY (COND + ((ILESSP (SETQ OPPY LASTMOUSEY) + (IQUOTIENT [IPLUS (SETQ INITBOTTOM (fetch + (REGION BOTTOM) + of INITREGION)) + (SETQ INITTOP + (IPLUS INITBOTTOM (fetch + (REGION HEIGHT) + of INITREGION + ] + 2)) + INITTOP) + (T INITBOTTOM] (* ; + "copy from variable into position for the constraint checks.") + (\GETREGION.PACKPTS) + (\GETREGION.CHECKOPPT MINWIDTH MINHEIGHT NEWREGFNS BASEPT OPPT) + (SETQ OPPX (fetch (POSITION XCOORD) of OPPT)) + (SETQ OPPY (fetch (POSITION YCOORD) of OPPT)) + (* ; "Now draw the initial box") + (SETQ DESTINATION \CURSORDESTINATION) + (DRAWGRAYBOX BASEX BASEY OPPX OPPY DESTINATION SHADE) + (SETCORNER BASEX BASEY OPPX OPPY) + (SETQ BEGCLOCK (CLOCK 0)) + (COND + [[ERSETQ (until (PROGN (GETMOUSESTATE) + (COND + [NOTTIMEDOUT + (* ; + "wait to see if user was clicking to mark a corner") + (COND + ((\CLOCKGREATERP BEGCLOCK CLICKWAITTIME) + (SETQ NOTTIMEDOUT NIL] + (DOWNFLG (LASTMOUSESTATE UP)) + ((LASTMOUSESTATE (NOT UP)) + (* ; + "mouse button when down, continue tracking until it goes up.") + (SETQ DOWNFLG T) + NIL))) + do (COND + [(LASTMOUSESTATE (AND RIGHT (OR LEFT MIDDLE))) + (CURSOR FORCEPS) + (until (MOUSESTATE (NOT RIGHT))) + (* ; "Switch to nearest corner") + (COND + ((IGEQ (IABS (IDIFFERENCE LASTMOUSEX OPPX)) + (IABS (IDIFFERENCE LASTMOUSEX BASEX))) + (swap BASEX OPPX))) + (COND + ((IGEQ (IABS (IDIFFERENCE LASTMOUSEY OPPY)) + (IABS (IDIFFERENCE LASTMOUSEY BASEY))) + (swap BASEY OPPY))) + (\GETREGION.PACKPTS) + (\GETREGION.CHECKBASEPT NEWREGFNS BASEPT) + (\GETREGION.CHECKOPPT MINWIDTH MINHEIGHT NEWREGFNS + BASEPT OPPT) + (SETCORNER BASEX BASEY OPPX OPPY) + (\UPDATEXYANDBOX T DESTINATION SHADE) + (SETQ DESTINATION \CURSORDESTINATION) + (COND + (BACKGROUNDCURSOREXITFN (APPLY* BACKGROUNDCURSOREXITFN] + ((OR (NOT (EQ LASTMOUSEX OLDMOUSEX)) + (NOT (EQ LASTMOUSEY OLDMOUSEY))) + (* ; + "the cursor has moved, check user constraints.") + (replace (POSITION XCOORD) of OPPT + with (SETQ OLDMOUSEX LASTMOUSEX)) + (replace (POSITION YCOORD) of OPPT + with (SETQ OLDMOUSEY LASTMOUSEY)) + (\GETREGION.CHECKOPPT MINWIDTH MINHEIGHT NEWREGFNS + BASEPT OPPT) + (\UPDATEXYANDBOX NIL DESTINATION SHADE) + (SETQ DESTINATION \CURSORDESTINATION) + (COND + (BACKGROUNDCURSOREXITFN (APPLY* BACKGROUNDCURSOREXITFN] + (* ; "erase box image.") + (DRAWGRAYBOX BASEX BASEY OPPX OPPY DESTINATION SHADE) + (RETURN (create SCREENREGION + SCREEN _ \CURSORSCREEN + LEFT _ (IMIN BASEX OPPX) + BOTTOM _ (IMIN BASEY OPPY) + WIDTH _ (IABS (IDIFFERENCE OPPX BASEX)) + HEIGHT _ (IABS (IDIFFERENCE BASEY OPPY] + (T (* ; "^E take down box.") + (DRAWGRAYBOX BASEX BASEY OPPX OPPY DESTINATION SHADE) + (ERROR!]) +) +(DEFINEQ + +(GETGRIDBOXREGION + [LAMBDA (MINWIDTH MINHEIGHT GRIDSPEC GRIDINTERIOR WINDOW) + (* ; "Edited 15-Mar-94 10:43 by sybalsky") + + (* ;; "Like GETREGION, it lets you sweep out a region, but only within the grid specified by GRIDSPEC and limited to the interior of GRIDREGION within WINDOW.") + + (LET* [NEWREGION [GRIDREGION (create REGION using GRIDINTERIOR LEFT _ + [\DSPTRANSFORMX (fetch (REGION LEFT) + of GRIDINTERIOR) + (fetch (STREAM IMAGEDATA) + of (WINDOWPROP WINDOW + 'DSP] + BOTTOM _ (\DSPTRANSFORMY + (fetch (REGION BOTTOM) + of GRIDINTERIOR) + (fetch (STREAM IMAGEDATA) + of (WINDOWPROP + WINDOW + 'DSP] + (RAWREGION (GETREGION 0 0 NIL (FUNCTION (LAMBDA (BASEPT OPPT FNARG) + (COND + ((AND OPPT + (INSIDE? + GRIDREGION + (fetch (POSITION XCOORD) + of OPPT) + (fetch (POSITION YCOORD) + of OPPT))) + OPPT) + [OPPT + (CREATEPOSITION + (\RANGELIMIT + (fetch (REGION LEFT) + of GRIDREGION) + (fetch (POSITION XCOORD) + of OPPT) + (fetch (REGION RIGHT) + of GRIDREGION)) + (\RANGELIMIT + (fetch (REGION BOTTOM) + of GRIDREGION) + (fetch (POSITION YCOORD) + of OPPT) + (fetch (REGION TOP) + of GRIDREGION] + ((INSIDE? GRIDREGION + (fetch (POSITION XCOORD + ) + of BASEPT) + (fetch (POSITION YCOORD + ) + of BASEPT)) + BASEPT) + (T + (CREATEPOSITION + (\RANGELIMIT + (fetch (REGION LEFT) + of GRIDREGION) + (fetch (POSITION XCOORD) + of BASEPT) + (fetch (REGION RIGHT) + of GRIDREGION)) + (\RANGELIMIT + (fetch (REGION BOTTOM) + of GRIDREGION) + (fetch (POSITION YCOORD) + of BASEPT) + (fetch (REGION TOP) + of GRIDREGION] + (SETQ NEWREGION (CREATEREGION (GRIDXCOORD (DSPXSCREENTOWINDOW (fetch + (REGION LEFT) + of RAWREGION) + WINDOW) + GRIDSPEC) + (GRIDYCOORD (DSPYSCREENTOWINDOW (fetch (REGION BOTTOM) + of RAWREGION) + WINDOW) + GRIDSPEC) + 0 0)) + (replace (REGION WIDTH) of NEWREGION + with (- (ADD1 (GRIDXCOORD (DSPXSCREENTOWINDOW (fetch (REGION RIGHT) + of RAWREGION) + WINDOW) + GRIDSPEC)) + (fetch (REGION LEFT) of NEWREGION))) + (replace (REGION HEIGHT) of NEWREGION + with (- (ADD1 (GRIDYCOORD (DSPYSCREENTOWINDOW (fetch (REGION TOP) + of RAWREGION) + WINDOW) + GRIDSPEC)) + (fetch (REGION BOTTOM) of NEWREGION))) + NEWREGION]) + +(\RANGELIMIT + [LAMBDA (MIN VAL MAX) + (IMAX MIN (IMIN MAX VAL]) +) +(DEFINEQ + +(MOUSECONFIRM + [LAMBDA (PROMPTSTRING HELPSTRING WINDOW DON'TCLEAR/MAINW) (* bvm%: " 2-May-86 15:19") + + (* * Changes the cursor to a "little mouse" ; + prints a prompt; and waits for the user to press and then release a mouse + button. If the LEFT was the final one release then return T otherwise return + NIL -- uses PROMPTWINDOW unless provided a window * *) + + (DECLARE (GLOBALVARS MOUSECONFIRMCURSOR)) + (LET ((HELPSTR (COND + ((EQ HELPSTRING T) + NIL) + ((NULL HELPSTRING) + "Click LEFT to confirm, RIGHT to abort.") + (T HELPSTRING))) + PWINDOW) + (COND + ((EQ PROMPTSTRING T) + (SETQ PROMPTSTRING NIL))) + (COND + [(OR PROMPTSTRING HELPSTR) + [FRESHLINE (OR WINDOW (SETQ WINDOW (COND + [(WINDOWP DON'TCLEAR/MAINW) + (* Open a prompt window from this + window) + (SETQ PWINDOW + (GETPROMPTWINDOW DON'TCLEAR/MAINW + (COND + ((NULL PROMPTSTRING) + HELPSTR) + ((NULL HELPSTR) + PROMPTSTRING) + (T (CONCAT PROMPTSTRING " " HELPSTR] + (T PROMPTWINDOW] + [COND + (PROMPTSTRING (printout WINDOW PROMPTSTRING) + (COND + (HELPSTR (SPACES 2 WINDOW] + (COND + (HELPSTR (printout WINDOW HELPSTR] + (T (* Didn't print anything, so don't + clear anything) + (SETQ DON'TCLEAR/MAINW T))) + (PROG1 (RESETFORM (CURSOR MOUSECONFIRMCURSOR) + (until (MOUSESTATE (OR LEFT MIDDLE RIGHT))) + (bind (LEFTDOWN _ (LASTMOUSESTATE LEFT)) until (MOUSESTATE UP) + do + + (* If buttons are still down, but not LEFT, user must have changed mind) + + (SETQ LEFTDOWN (LASTMOUSESTATE LEFT)) finally (RETURN LEFTDOWN))) + (COND + (PWINDOW (* Close prompt window) + (CLOSEW PWINDOW)) + ((NULL DON'TCLEAR/MAINW) + (CLEARW WINDOW]) +) +(RPAQ MOUSECONFIRMCURSOR (CURSORCREATE (QUOTE #*(16 16)GOOLD@@DELIDELIDELIDELIDELIDELIDELIDD@@DD@@DD@@DD@@DD@@DD@@DGOOL +) (QUOTE NIL) 8 8)) +(DEFINEQ + +(NEAREST/PT/ON/GRID + [LAMBDA (PT GRIDN) (* ; "Edited 15-Mar-94 10:40 by sybalsky") + (* finds the point on a grid of + multiple GRIDN closest to PT.) + (create POSITION + XCOORD _ (NEAREST/MULTIPLE (fetch (POSITION XCOORD) of PT) + GRIDN) + YCOORD _ (NEAREST/MULTIPLE (fetch (POSITION YCOORD) of PT) + GRIDN) smashing PT]) + +(PTON10GRID + [LAMBDA (FIXEDPT MOVINGPT) (* rrb " 6-AUG-81 08:45") + (* insists that a pt be on a 10 grid) + (COND + (MOVINGPT (NEAREST/PT/ON/GRID MOVINGPT 10)) + (T (NEAREST/PT/ON/GRID FIXEDPT 10]) + +(NEAREST/MULTIPLE + [LAMBDA (X N) (* rrb " 6-AUG-81 08:42") + + (* finds the multiple of N that is nearest to X) + + (COND + ((IGREATERP X 0) + (ITIMES (IQUOTIENT (IPLUS X (IQUOTIENT N 2)) + N) + N)) + (T (ITIMES (IQUOTIENT (IDIFFERENCE X (IQUOTIENT N 2)) + N) + N]) +) +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE + +(PUTPROPS IABS MACRO [OPENLAMBDA (A) + (COND + ((IGEQ A 0) + A) + (T (IMINUS A]) +) + +(* "END EXPORTED DEFINITIONS") + + +(READVARS-FROM-STRINGS '(DASHEDSHADE) + "({(READBITMAP)(16 16 +%"@@OO%" +%"@@OO%" +%"@@OO%" +%"@@OO%" +%"@@OO%" +%"@@OO%" +%"@@OO%" +%"@@OO%" +%"OO@@%" +%"OO@@%" +%"OO@@%" +%"OO@@%" +%"OO@@%" +%"OO@@%" +%"OO@@%" +%"OO@@%")}) +") +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS CROSSHAIRS EXPANDINGBOX FORCEPS BOXCURSOR LOCKEDSPOT OLDEXPANDINGBOX LowerLeftCursor + UpperRightCursor UpperLeftCursor LowerRightCursor) +) +(RPAQ CROSSHAIRS (CURSORCREATE (QUOTE #*(16 16)@@@@@GL@AMG@CAAHFA@LDA@DLA@FHA@BOOONHA@BLA@FDA@DFA@LCAAHAMG@@GL@ +) (QUOTE NIL) 7 7)) +(RPAQ EXPANDINGBOX (CURSORCREATE (QUOTE #*(16 16)@@@@@@@@H@@@L@@@N@@@O@@@OHNGOLLCONKMO@BDMHBDIHKM@LLC@LNG@F@@@F@@ +) (QUOTE NIL) 0 13)) +(RPAQ FORCEPS (CURSORCREATE (QUOTE #*(16 16)@NG@@JE@@NG@@DB@@FF@@CL@@AH@@AH@@CL@@FF@ALCHBDBDBDBDBDBDBDBDAHAH +) (QUOTE NIL) 7 15)) +(RPAQ BOXCURSOR (CURSORCREATE (QUOTE #*(16 16)@@@@@@@@COOLCOOLC@@LC@@LC@@LC@@LC@@LC@@LC@@LC@@LCOOLCOOL@@@@@@@@ +) (QUOTE NIL) 7 7)) +(RPAQ LOCKEDSPOT (CURSORCREATE (QUOTE #*(16 16)@@@@@@@@COOLCOOLC@@LC@@LCCLLCCLLCCLLCCLLC@@LC@@LCOOLCOOL@@@@@@@@ +) (QUOTE NIL) 7 7)) +(RPAQ OLDEXPANDINGBOX (CURSORCREATE (QUOTE #*(16 16)@@@@OHCNN@@NO@ANKHCJIMGB@ON@@DD@@LF@@DD@@ON@IMGBKHCJO@ANN@@NOHCN +) (QUOTE NIL) 7 7)) +(RPAQ LowerLeftCursor (CURSORCREATE (QUOTE #*(16 16)@@@@@@@@@@@@@@@@@@@@H@@@L@@@L@@@L@@@L@@@L@@@L@@@L@@@L@@@OOL@OON@ +) (QUOTE NIL) 0 0)) +(RPAQ UpperRightCursor (CURSORCREATE (QUOTE #*(16 16)@COO@AOO@@@C@@@C@@@C@@@C@@@C@@@C@@@C@@@C@@@A@@@@@@@@@@@@@@@@@@@@ +) (QUOTE NIL) 15 15)) +(RPAQ UpperLeftCursor (CURSORCREATE (QUOTE #*(16 16)OOL@OOH@L@@@L@@@L@@@L@@@L@@@L@@@L@@@L@@@H@@@@@@@@@@@@@@@@@@@@@@@ +) (QUOTE NIL) 0 15)) +(RPAQ LowerRightCursor (CURSORCREATE (QUOTE #*(16 16)@@@@@@@@@@@@@@@@@@@@@@@A@@@C@@@C@@@C@@@C@@@C@@@C@@@C@@@C@COO@GOO +) (QUOTE NIL) 15 0)) +(DEFINEQ + +(\SW2BM + [LAMBDA (P PR Q QR) (* edited%: "26-Jan-86 13:23") + + (* Switches the areas of P and Q defined by the regions PR and QR respectively) + + (PROG (PL PH PW PB QL QH QW QB) + [COND + (PR (SETQ PL (fetch (REGION LEFT) of PR)) + (SETQ PB (fetch (REGION BOTTOM) of PR)) + (SETQ PH (fetch (REGION HEIGHT) of PR)) + (SETQ PW (fetch (REGION WIDTH) of PR))) + (T (SETQ PL (SETQ PB 0)) + (SETQ PW (fetch (BITMAP BITMAPWIDTH) of P)) + (SETQ PH (fetch (BITMAP BITMAPHEIGHT) of P] + [COND + (QR (SETQ QL (fetch (REGION LEFT) of QR)) + (SETQ QB (fetch (REGION BOTTOM) of QR)) + (SETQ QW (fetch (REGION WIDTH) of QR)) + (SETQ QH (fetch (REGION HEIGHT) of QR))) + (T (SETQ QL (SETQ QB 0)) + (SETQ QW (fetch (BITMAP BITMAPWIDTH) of Q)) + (SETQ QH (fetch (BITMAP BITMAPHEIGHT) of Q] + (PROG ((CL (IMAX (IMINUS PL) + (IMINUS QL) + 0)) + (CB (IMAX (IMINUS PB) + (IMINUS QB) + 0))) + (PROG ((XP (IPLUS CL PL)) + (YP (IPLUS CB PB)) + (XQ (IPLUS CL QL)) + (YQ (IPLUS CB QB)) + CW CH) + (SETQ CW (IMIN (IDIFFERENCE (IMIN (fetch (BITMAP BITMAPWIDTH) of P) + (IPLUS PL PW)) + XP) + (IDIFFERENCE (IMIN (fetch (BITMAP BITMAPWIDTH) of Q) + (IPLUS QL QW)) + XQ))) + (SETQ CH (IMIN (IDIFFERENCE (IMIN (fetch (BITMAP BITMAPHEIGHT) of P) + (IPLUS PB PH)) + YP) + (IDIFFERENCE (IMIN (fetch (BITMAP BITMAPHEIGHT) of Q) + (IPLUS QB QH)) + YQ))) + (UNINTERRUPTABLY + (BITBLT P XP YP Q XQ YQ CW CH 'INPUT 'INVERT) + (BITBLT Q XQ YQ P XP YP CW CH 'INPUT 'INVERT) + (BITBLT P XP YP Q XQ YQ CW CH 'INPUT 'INVERT))]) + +(COMPOSEREGS + [LAMBDA (INNER OUTER) (* rrb "19-MAR-82 09:35") + + (* Converts INNER from OUTER relative coords to same units as OUTER - + inverse of TRANSLATEREGS) + + (create REGION + LEFT _ (IPLUS (fetch (REGION LEFT) of OUTER) + (fetch (REGION LEFT) of INNER)) + BOTTOM _ (IPLUS (fetch (REGION BOTTOM) of OUTER) + (fetch (REGION BOTTOM) of INNER)) using INNER]) + +(TRANSLATEREG + [LAMBDA (INNER OUTER) (* rrb "19-MAR-82 09:35") + + (* Translates a nested INNER region to OUTER region relative coordinates) + + (create REGION + LEFT _ (IDIFFERENCE (fetch (REGION LEFT) of INNER) + (fetch (REGION LEFT) of OUTER)) + BOTTOM _ (IDIFFERENCE (fetch (REGION BOTTOM) of INNER) + (fetch (REGION BOTTOM) of OUTER)) + WIDTH _ (fetch (REGION WIDTH) of INNER) + HEIGHT _ (fetch (REGION HEIGHT) of INNER]) +) + + + +(* ; "Bitmap and shade editors") + +(DEFINEQ + +(EDITBM + [LAMBDA (BMSPEC) (* ; "Edited 31-Aug-87 12:28 by FS") + +(* ;;; "A simple bitmap editor.") + + (* ;; "The edit part of the display is from 0 to MAXGRIDWIDTH in width and from 0 to MAXGRIDHEIGHT in height. The commands and display area for the bitmap being edited are above the edit region.") + + (DECLARE (GLOBALVARS \CURSORDESTWIDTH \CURSORDESTHEIGHT)) + (PROG (BMW BMWINTERIOR BMWWIDTH BMWHEIGHT WIDTH HEIGHT BM CR ORIGBM GRIDSQUARE BPP ORIGBPP + ORIGWIDTH) (* ; + "set ORIGBM to the input bitmap if any and BM to a copy of it for editting.") + + [COND + ((OR (EQ BMSPEC CursorBitMap) + (AND (EQ BMSPEC 'CursorBitMap) + (SETQ BMSPEC CursorBitMap))) (* ; + "editing cursor, save old value and make changes to the original.") + + (SETQ ORIGBM (BITMAPCOPY CursorBitMap)) + (SETQ BM CursorBitMap)) + [(BITMAPP BMSPEC) + (SETQ BM (BITMAPCOPY (SETQ ORIGBM BMSPEC] + [(LITATOM BMSPEC) + (COND + ([BITMAPP (SETQ ORIGBM (EVALV BMSPEC 'EDITBM] + (* ; "use value.") + + (SETQ BM (BITMAPCOPY ORIGBM))) + (T (SETQ ORIGBM NIL) + (SETQ BM (\READBMDIMENSIONS] + ((REGIONP BMSPEC) (* ; + "if BMSPEC is a region, treat it as a region of the screen.") + + (SETQ BM (BITMAPCREATE (fetch (REGION WIDTH) of BMSPEC) + (fetch (REGION HEIGHT) of BMSPEC) + (BITSPERPIXEL \CURSORDESTINATION))) + (* ; + "note that bm has initial bits in it.") + + (SETQ ORIGBM BMSPEC) + (BITBLT \CURSORDESTINATION (fetch (REGION LEFT) of BMSPEC) + (fetch (REGION BOTTOM) of BMSPEC) + BM 0 0 NIL NIL 'INPUT 'REPLACE)) + ((WINDOWP BMSPEC) + (SETQ ORIGBM BMSPEC) + + (* ;; + "FS: Seems too big below, why not ClipRegion's Width & Height? That's all that's used...") + + (SETQ BM (BITMAPCREATE (WINDOWPROP BMSPEC 'WIDTH) + (WINDOWPROP BMSPEC 'HEIGHT) + (BITSPERPIXEL BMSPEC))) (* ; + "open the window and bring it to the top.") + + (TOTOPW BMSPEC) + (SETQ CR (DSPCLIPPINGREGION NIL BMSPEC)) + (BITBLT BMSPEC (fetch (REGION LEFT) of CR) + (fetch (REGION BOTTOM) of CR) + BM 0 0 (fetch (REGION WIDTH) of CR) + (fetch (REGION HEIGHT) of CR))) + (T (* ; "otherwise create a bitmap") + + (SETQ BM (\READBMDIMENSIONS] + (if (OR (EQ (BITMAPHEIGHT BM) + 0) + (EQ (BITMAPWIDTH BM) + 0)) + then (ERROR "Can't edit a bitmap with no bits in it." BMSPEC)) + (SETQ BPP (BITSPERPIXEL \CURSORDESTINATION)) + (SETQ ORIGBPP (fetch (BITMAP BITMAPBITSPERPIXEL) of BM)) + [COND + ((NOT (EQ BPP ORIGBPP)) + + (* ;; "save the actual number of bits per pixel and set it to BPP in the bitmap being edited so that it can be BITBLT ed on the screen.") + + (SETQ ORIGWIDTH (fetch (BITMAP BITMAPWIDTH) of BM)) + (replace (BITMAP BITMAPBITSPERPIXEL) of BM with BPP) + (SETQ WIDTH (IQUOTIENT (ITIMES ORIGBPP ORIGWIDTH) + BPP)) + (replace (BITMAP BITMAPWIDTH) of BM with WIDTH)) + (T (SETQ WIDTH (fetch (BITMAP BITMAPWIDTH) of BM] + (SETQ HEIGHT (fetch (BITMAP BITMAPHEIGHT) of BM)) + + (* ;; + "Calculate a default window size. Start by calculating the grid size from the bitmap size.") + + (SETQ GRIDSQUARE (IMAX (IMIN (IQUOTIENT (IDIFFERENCE (IQUOTIENT (ITIMES \CURSORDESTWIDTH 2) + 3) + GRIDTHICKNESS) + WIDTH) + (IQUOTIENT (IDIFFERENCE (IQUOTIENT (ITIMES \CURSORDESTHEIGHT 2 + ) + 3) + (ITIMES GRIDTHICKNESS 2)) + (ADD1 HEIGHT)) + NORMALGRIDSQUARE) + MINGRIDSQUARE)) + (SETQ BMWWIDTH (IMIN (IPLUS (ITIMES GRIDSQUARE WIDTH) + GRIDTHICKNESS) + (IQUOTIENT (ITIMES \CURSORDESTWIDTH 2) + 3))) + (SETQ BMWHEIGHT (IMIN (IPLUS (ITIMES HEIGHT (ADD1 GRIDSQUARE)) + (ITIMES GRIDTHICKNESS 2) + 1) + (IQUOTIENT (ITIMES \CURSORDESTHEIGHT 2) + 3))) + (SETQ BMW (CREATEW (GETBOXREGION (WIDTHIFWINDOW BMWWIDTH) + (HEIGHTIFWINDOW BMWHEIGHT T) + NIL NIL NIL "Indicate the position for the Bitmap Edit window.") + "Bitmap Editor")) + (WINDOWPROP BMW 'BM BM) + (WINDOWPROP BMW 'SCROLLFN (FUNCTION EDITBMSCROLLFN)) + (WINDOWPROP BMW 'RESHAPEFN (FUNCTION EDITBMRESHAPEFN)) + (WINDOWPROP BMW 'REPAINTFN (FUNCTION EDITBMREPAINTFN)) + (WINDOWPROP BMW 'BUTTONEVENTFN (FUNCTION EDITBMBUTTONFN)) + (WINDOWPROP BMW 'CLOSEFN (FUNCTION EDITBMCLOSEFN)) + (WINDOWPROP BMW 'XOFFSET 0) + (WINDOWPROP BMW 'YOFFSET 0) + (WINDOWPROP BMW 'DXOFFSET 0) + (WINDOWPROP BMW 'DYOFFSET 0) + (WINDOWPROP BMW 'ORIGINALBITMAP ORIGBM) + (WINDOWPROP BMW 'FINISHEDFLG NIL) + (WINDOWPROP BMW 'COLOR (MAXIMUMCOLOR BPP)) + (WINDOWPROP BMW 'GRIDON T) (* ; + "call reshapefn to initialize the display and values") + + (EDITBMRESHAPEFN BMW NIL NIL NIL (NOT ORIGBM)) (* ; + "start a mouse process in case this process is the mouse process.") + + (SPAWN.MOUSE) + (while (NOT (WINDOWPROP BMW 'FINISHEDFLG)) do (DISMISS 500)) + (* ; + "remove the closefn before closing the window.") + + (WINDOWPROP BMW 'CLOSEFN NIL) + (CLOSEW BMW) + (COND + ((NOT (EQ ORIGBPP BPP)) + (replace (BITMAP BITMAPBITSPERPIXEL) of BM with ORIGBPP) + (replace (BITMAP BITMAPWIDTH) of BM with ORIGWIDTH))) + (RETURN (COND + ((EQ T (WINDOWPROP BMW 'FINISHEDFLG)) (* ; + "editor exited via ok, stuff contents into original bitmap.") + + (COND + ((EQ BMSPEC CursorBitMap) (* ; + "editting happened in original, leave it alone.") + + CursorBitMap) + ((REGIONP ORIGBM) (* ; "put it back into the screen.") + + (BITBLT BM 0 0 \CURSORDESTINATION (fetch (REGION LEFT) of ORIGBM) + (fetch (REGION BOTTOM) of ORIGBM) + (fetch (REGION WIDTH) of ORIGBM) + (fetch (REGION HEIGHT) of ORIGBM) + 'INPUT + 'REPLACE) + BM) + ((WINDOWP ORIGBM) (* ; "put it back into the window") + + (BITBLT BM 0 0 ORIGBM (fetch (REGION LEFT) of CR) + (fetch (REGION BOTTOM) of CR) + (fetch (REGION WIDTH) of CR) + (fetch (REGION HEIGHT) of CR) + 'INPUT + 'REPLACE) + BM) + (ORIGBM (BITBLT BM 0 0 ORIGBM 0 0 WIDTH HEIGHT) + [COND + ((AND BMSPEC (LITATOM BMSPEC)) + (* ; + "if spec was an atom without a bm value, set it. in the environment above EDITBM.") + + (MARKASCHANGED BMSPEC 'VARS) + (STKEVAL 'EDITBM (LIST 'SETQQ BMSPEC BM] + ORIGBM) + (T BM))) + (T (* ; + "error exit, if cursor return it to original value.") + + (COND + ((EQ BMSPEC CursorBitMap) + (BITBLT ORIGBM NIL NIL CursorBitMap))) + (ERROR!]) + +(EDITBMSCROLLFN + [LAMBDA (W DX DY) (* ; "Edited 31-Aug-87 13:29 by FS") + (* ; + "Do scrolling for the bitmap editor.") + + (PROG (GRIDSPEC REG WHEIGHT WWIDTH (DXGRID 0) + (DYGRID 0) + EXTENT EXTENTWIDTH EXTENTHEIGHT GILEFT GIBOTTOM GIHEIGHT GWIDTH GHEIGHT GRIDINTERIOR + EBMXLIMIT EBMYLIMIT EBMXOFFSET EBMYOFFSET BM BITMAPWIDTH BITMAPHEIGHT BITSWIDE + BITSHIGH DXOFFSET DYOFFSET) + (SETQ GRIDSPEC (WINDOWPROP W 'GRIDSPEC)) + (SETQ REG (WINDOWPROP W 'REGION)) + (SETQ WHEIGHT (WINDOWPROP W 'HEIGHT)) + (SETQ WWIDTH (WINDOWPROP W 'WIDTH)) + (SETQ GRIDINTERIOR (WINDOWPROP W 'GRIDINTERIOR)) + (SETQ EBMXOFFSET (WINDOWPROP W 'XOFFSET)) + (SETQ EBMYOFFSET (WINDOWPROP W 'YOFFSET)) + (SETQ BM (WINDOWPROP W 'BM)) + (SETQ BITMAPWIDTH (fetch BITMAPWIDTH of BM)) + (SETQ BITMAPHEIGHT (fetch BITMAPHEIGHT of BM)) + (SETQ BITSWIDE (WINDOWPROP W 'BITSWIDE)) + (SETQ BITSHIGH (WINDOWPROP W 'BITSHIGH)) + (SETQ DXOFFSET (WINDOWPROP W 'DXOFFSET)) + (SETQ DYOFFSET (WINDOWPROP W 'DYOFFSET)) + (SETQ EBMXLIMIT (IPLUS EBMXOFFSET BITSWIDE)) + (SETQ EBMYLIMIT (IPLUS EBMYOFFSET BITSHIGH)) + (COND + (GRIDSPEC (SETQ GILEFT (fetch (REGION LEFT) of GRIDINTERIOR)) + (SETQ GIBOTTOM (fetch (REGION BOTTOM) of GRIDINTERIOR)) + (SETQ GIHEIGHT (fetch (REGION HEIGHT) of GRIDINTERIOR)) + (SETQ GWIDTH (fetch (REGION WIDTH) of GRIDSPEC)) + (SETQ GHEIGHT (fetch (REGION HEIGHT) of GRIDSPEC)) + (SETQ EXTENT (WINDOWPROP W 'EXTENT)) + (SETQ EXTENTWIDTH (fetch (REGION WIDTH) of EXTENT)) + (SETQ EXTENTHEIGHT (fetch (REGION HEIGHT) of EXTENT)) + (* ; "Make a horizontal adjustment") + + (COND + ((FLOATP DX) (* ; "Horizontal thumbing") + + [WINDOWPROP W 'XOFFSET (SETQ EBMXOFFSET (FIX (TIMES (IDIFFERENCE BITMAPWIDTH + BITSWIDE) + DX] + (replace (REGION LEFT) of EXTENT with (IMINUS (QUOTIENT (TIMES EBMXOFFSET + EXTENTWIDTH) + BITMAPWIDTH))) + (* BLTSHADE WHITESHADE W GILEFT + GIBOTTOM SCREENWIDTH SCREENHEIGHT + (QUOTE REPLACE) GRIDINTERIOR) + (RESETGRID.NEW BM GRIDSPEC BITSWIDE BITSHIGH 0 0 W T)) + ((ILESSP DX 0) (* ; "moving to the left.") + (* ; + "determine how many grid points to move.") + + (SETQ DXGRID (IMIN (GRIDXCOORD (IMINUS DX) + GRIDSPEC) + (IDIFFERENCE BITMAPWIDTH EBMXLIMIT))) + (COND + ((NOT (IGREATERP DXGRID 0)) (* ; "right edge is at the right margin") + + (RETURN))) + (WINDOWPROP W 'XOFFSET (SETQ EBMXOFFSET (IPLUS EBMXOFFSET DXGRID))) + (* ; "update EXTENT bar") + + (replace (REGION LEFT) of EXTENT with (IMAX (IMINUS (QUOTIENT (TIMES + EBMXOFFSET + EXTENTWIDTH + ) + BITMAPWIDTH)) + (IMINUS EXTENTWIDTH))) + (* ; "move image to the left.") + + (BITBLT W (IPLUS GILEFT (TIMES DXGRID GWIDTH)) + GIBOTTOM W GILEFT GIBOTTOM SCREENWIDTH SCREENHEIGHT 'INPUT + 'REPLACE NIL GRIDINTERIOR) (* ; "clear the newly exposed area.") + + (BLTSHADE WHITESHADE W (IPLUS GILEFT (TIMES (IDIFFERENCE BITSWIDE DXGRID) + GWIDTH)) + GIBOTTOM SCREENWIDTH SCREENHEIGHT 'REPLACE GRIDINTERIOR) + (RESETGRID.NEW BM GRIDSPEC DXGRID BITSHIGH (IDIFFERENCE BITSWIDE DXGRID) + 0 W)) + ((ILESSP 0 DX) (* ; + "determine how many grid point to the left to move.") + + (SETQ DXGRID (IMIN EBMXOFFSET (GRIDXCOORD DX GRIDSPEC))) + (COND + ((NOT (IGREATERP DXGRID 0)) (* ; "left edge is at the left margin") + + (RETURN))) + (WINDOWPROP W 'XOFFSET (SETQ EBMXOFFSET (IDIFFERENCE EBMXOFFSET DXGRID))) + (* ; "update REGION bar") + + (replace (REGION LEFT) of EXTENT with (IMIN (IMINUS (IQUOTIENT (TIMES + EBMXOFFSET + EXTENTWIDTH + ) + BITMAPWIDTH)) + 0)) + (* ; "move image to the right.") + + (BITBLT W GILEFT GIBOTTOM W (IPLUS GILEFT (TIMES DXGRID GWIDTH)) + GIBOTTOM SCREENWIDTH SCREENHEIGHT 'INPUT 'REPLACE NIL GRIDINTERIOR) + (* ; "clear the newly exposed area.") + + (BLTSHADE WHITESHADE W GILEFT GIBOTTOM (TIMES DXGRID GWIDTH) + GIHEIGHT + 'REPLACE) + (RESETGRID.NEW BM GRIDSPEC DXGRID BITSHIGH 0 0 W))) + (* ; "Make a vertical adjustment") + + (COND + ((FLOATP DY) (* ; "Vertical Thumbing") + + [WINDOWPROP W 'YOFFSET (SETQ EBMYOFFSET (FIX (TIMES (IDIFFERENCE BITMAPHEIGHT + BITSHIGH) + (FDIFFERENCE 1.0 DY] + (* ; "set EXTENT bar") + + (replace (REGION BOTTOM) of EXTENT with (IMINUS (QUOTIENT (TIMES EBMYOFFSET + EXTENTHEIGHT + ) + BITMAPHEIGHT))) + (* ; "Clear Window") + (* BLTSHADE WHITESHADE W GILEFT + GIBOTTOM SCREENWIDTH SCREENHEIGHT + (QUOTE REPLACE) GRIDINTERIOR) + (* ; + "Repaint the image using grid function") + + (RESETGRID.NEW BM GRIDSPEC BITSWIDE BITSHIGH 0 0 W T)) + ((ILESSP DY 0) (* ; + "determine how many squares to move down.") + + (SETQ DYGRID (IMIN (IDIFFERENCE (fetch (BITMAP BITMAPHEIGHT) of BM) + EBMYLIMIT) + (GRIDYCOORD (IMIN GIHEIGHT (IMINUS DY)) + GRIDSPEC))) + (COND + ((NOT (IGREATERP DYGRID 0)) (* ; "top edge is at the top margin") + + (RETURN))) + (WINDOWPROP W 'YOFFSET (SETQ EBMYOFFSET (IPLUS EBMYOFFSET DYGRID))) + (replace (REGION BOTTOM) of EXTENT + with (IMAX (IMINUS (QUOTIENT (TIMES EBMYOFFSET EXTENTHEIGHT) + BITMAPHEIGHT)) + (IMINUS EXTENTHEIGHT))) + (BITBLT W GILEFT (IPLUS GIBOTTOM (ITIMES DYGRID GHEIGHT)) + W GILEFT GIBOTTOM SCREENWIDTH SCREENHEIGHT 'INPUT 'REPLACE NIL + GRIDINTERIOR) (* BLTSHADE WHITESHADE W GILEFT + (IPLUS GIBOTTOM (ITIMES + (IDIFFERENCE BITSHIGH DYGRID) GHEIGHT)) + SCREENWIDTH SCREENHEIGHT + (QUOTE REPLACE) GRIDINTERIOR) + (RESETGRID.NEW BM GRIDSPEC BITSWIDE DYGRID 0 (IDIFFERENCE BITSHIGH DYGRID) + W T)) + ((ILESSP 0 DY) (* ; + "moving up; determine how may grid squares to move.") + + (SETQ DYGRID (IMIN EBMYOFFSET (GRIDYCOORD (IMIN GIHEIGHT DY) + GRIDSPEC))) + (COND + ((NOT (IGREATERP DYGRID 0)) (* ; + "bottom edge is at the bottom margin") + + (RETURN))) + (WINDOWPROP W 'YOFFSET (SETQ EBMYOFFSET (IDIFFERENCE EBMYOFFSET DYGRID))) + (replace (REGION BOTTOM) of EXTENT + with (IMIN (IMINUS (QUOTIENT (TIMES EBMYOFFSET EXTENTHEIGHT) + BITMAPHEIGHT)) + 0)) + (BITBLT W GILEFT GIBOTTOM W GILEFT (IPLUS GIBOTTOM (ITIMES DYGRID GHEIGHT)) + SCREENWIDTH SCREENHEIGHT 'INPUT 'REPLACE NIL GRIDINTERIOR) + (* BLTSHADE WHITESHADE W GILEFT + GIBOTTOM (fetch (REGION WIDTH) of + GRIDINTERIOR) (ITIMES DYGRID GHEIGHT) + (QUOTE REPLACE)) + (RESETGRID.NEW BM GRIDSPEC BITSWIDE DYGRID 0 0 W T))) + + (* ;; "This call to GRID is unnecessary as the grid dots get filled in earlier.") + + (* ;; "(COND ((WINDOWPROP W 'GRIDON) (GRID GRIDSPEC BITSWIDE BITSHIGH 'POINT W)))") + + [COND + ([OR (ILESSP EBMXOFFSET DXOFFSET) + (ILESSP EBMYOFFSET DYOFFSET) + [IGREATERP (IPLUS EBMXOFFSET BITSWIDE) + (IPLUS DXOFFSET (WINDOWPROP W 'BMDISPLAYWIDTH] + (IGREATERP (IPLUS EBMYOFFSET BITSHIGH) + (IPLUS DYOFFSET (WINDOWPROP W 'BMDISPLAYHEIGHT] + (* ; + "Adjust the display region left lower corner so the selected region is near the center.") + + [WINDOWPROP W 'DXOFFSET (SETQ DXOFFSET + (IMAX 0 (IMIN (IDIFFERENCE (fetch (BITMAP + BITMAPWIDTH + ) + of BM) + (WINDOWPROP W 'BMDISPLAYWIDTH)) + (IDIFFERENCE + (IPLUS EBMXOFFSET (LRSH BITSWIDE 1)) + (LRSH (WINDOWPROP W 'BMDISPLAYWIDTH) + 1] + (WINDOWPROP W 'DYOFFSET (SETQ DYOFFSET + (IMAX 0 (IMIN (IDIFFERENCE (fetch (BITMAP + BITMAPHEIGHT + ) + of BM) + (WINDOWPROP W 'BMDISPLAYHEIGHT) + ) + (IDIFFERENCE + (IPLUS EBMYOFFSET (LRSH BITSHIGH 1)) + (LRSH (WINDOWPROP W 'BMDISPLAYHEIGHT) + 1] + (UPDATE/BM/DISPLAY BM W]) + +(EDITBMCLOSEFN + [LAMBDA (BMW) (* ; "Edited 23-Feb-94 16:07 by turpiN:mv:envos") + + (* ;; "the close function for a bitmap edit window. For now do what a STOP would have done.") + + (* ;; "FS: Assuming this window won't be reused, flush the temporary bm.") + + (WINDOWPROP BMW 'TEMPBM NIL) + (WINDOWPROP BMW 'GRIDBM NIL) + (WINDOWPROP BMW 'FINISHEDFLG 'KILL) + (COND + ((WINDOWPROP BMW 'COORDWIN) + (DETACHWINDOW (WINDOWPROP BMW 'COORDWIN) + BMW) + (CLOSEW (WINDOWPROP BMW 'COORDWIN)) + (WINDOWPROP BMW 'COORDWIN NIL]) + +(TILEAREA + [LAMBDA (LFT BTM WDTH HGHT SRCBM WIN) (* ; "Edited 27-Aug-87 21:20 by FS") + + (* ;; + "lays tiles out in an area of a window. This function only provided for backwards compatibility.") + + (BLTPATTERN.REPLACEDISPLAY SRCBM 0 0 (BITMAPWIDTH SRCBM) + (BITMAPHEIGHT SRCBM) + WIN LFT BTM WDTH HGHT]) + +(EDITBMBUTTONFN + [LAMBDA (W) (* ; "Edited 15-Mar-94 10:33 by sybalsky") + (* ; "Edited 5-Mar-92 15:54 by jds") + + (* ;; "inner function of bitmap editor.") + + (DECLARE (GLOBALVARS \CURRENTCURSOR)) + (PROG (GRIDX0 GRIDY0 BITMAPWIDTH BITMAPHEIGHT NEWGRIDSIZE PAINTW ORIGBM GRIDSPEC GRIDINTERIOR BM + BITSWIDE BITSHIGH WREGION XOFFSET YOFFSET DXOFFSET DYOFFSET DISPLAYREGION EXTENT + BITSPERPIXEL CURSORBM) + (SETQ GRIDSPEC (WINDOWPROP W 'GRIDSPEC)) + (SETQ GRIDINTERIOR (WINDOWPROP W 'GRIDINTERIOR)) + (SETQ BM (WINDOWPROP W 'BM)) + (SETQ BITSWIDE (WINDOWPROP W 'BITSWIDE)) + (SETQ BITSHIGH (WINDOWPROP W 'BITSHIGH)) + (SETQ WREGION (WINDOWPROP W 'REGION)) + (SETQ XOFFSET (WINDOWPROP W 'XOFFSET)) + (SETQ YOFFSET (WINDOWPROP W 'YOFFSET)) + (SETQ DXOFFSET (WINDOWPROP W 'DXOFFSET)) + (SETQ DYOFFSET (WINDOWPROP W 'DYOFFSET)) + (SETQ DISPLAYREGION (WINDOWPROP W 'DISPLAYREGION)) + (SETQ EXTENT (WINDOWPROP W 'EXTENT)) + (SETQ GRIDX0 (fetch (REGION LEFT) of GRIDSPEC)) + (SETQ GRIDY0 (fetch (REGION BOTTOM) of GRIDSPEC)) + (SETQ BITMAPWIDTH (fetch (BITMAP BITMAPWIDTH) of BM)) + (SETQ BITMAPHEIGHT (fetch (BITMAP BITMAPHEIGHT) of BM)) + (SETQ BITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL) of BM)) + (SETQ COLOR (WINDOWPROP W 'COLOR)) + + (* ;; "mark the region of the bitmap that is being editted.") + + (COND + ((INSIDE? GRIDINTERIOR (LASTMOUSEX W) + (LASTMOUSEY W)) + + (* ;; "if cursor is inside, shade it.") + + (\SHADEBITS BM GRIDSPEC GRIDINTERIOR W BITSWIDE BITSHIGH COLOR)) + ((INSIDE? DISPLAYREGION (LASTMOUSEX W) + (LASTMOUSEY W)) + + (* ;; "Run the menu foe re-windowing into the whole bitmap") + + (SELECTQ [MENU (COND + ((type? MENU EDITBMWINDOWMENU) + EDITBMWINDOWMENU) + ((SETQ EDITBMWINDOWMENU (create MENU + ITEMS _ '((Move 'Move + "Selects a different part of the bitmap to edit." + )) + CENTERFLG _ T] + (Move (* ; + "move the editing window's location on the bitmap.") + (PROG (POS) + [SETQ POS (GETBOXPOSITION BITSWIDE BITSHIGH + [IPLUS 4 (fetch (REGION LEFT) of WREGION) + (- XOFFSET (WINDOWPROP W 'DXOFFSET] + (IPLUS (WINDOWPROP W 'BMDISPLAYBOTTOM) + (- YOFFSET (WINDOWPROP W 'DYOFFSET)) + 4 + (fetch (REGION BOTTOM) of WREGION] + [WINDOWPROP W 'XOFFSET + (SETQ XOFFSET + (IMIN (IDIFFERENCE BITMAPWIDTH BITSWIDE) + (IMAX [IPLUS (WINDOWPROP W 'DXOFFSET) + (- (fetch (POSITION XCOORD) of + POS) + (IPLUS 4 (fetch (REGION LEFT) + of WREGION] + 0] + [WINDOWPROP + W + 'YOFFSET + (SETQ YOFFSET + (IMAX 0 (IMIN (- BITMAPHEIGHT BITSHIGH) + (- (IPLUS (WINDOWPROP W 'DYOFFSET) + (- (fetch (POSITION YCOORD) of POS) + (IPLUS (fetch (REGION BOTTOM) + of WREGION) + 4))) + (WINDOWPROP W 'BMDISPLAYBOTTOM] + (replace (REGION LEFT) of EXTENT + with (IMINUS (QUOTIENT (TIMES XOFFSET (fetch (REGION WIDTH) + of EXTENT)) + BITMAPWIDTH))) + (replace (REGION BOTTOM) of EXTENT + with (IMINUS (QUOTIENT (TIMES YOFFSET (fetch (REGION HEIGHT) + of EXTENT)) + BITMAPHEIGHT))) + [COND + ([OR (ILESSP XOFFSET DXOFFSET) + (ILESSP YOFFSET DYOFFSET) + [IGREATERP (IPLUS XOFFSET BITSWIDE) + (IPLUS DXOFFSET (WINDOWPROP W 'BMDISPLAYWIDTH] + (IGREATERP (IPLUS YOFFSET BITSHIGH) + (IPLUS DYOFFSET (WINDOWPROP W 'BMDISPLAYHEIGHT] + + (* ;; + "Adjust the display region left lower corner so the selected region is near the center.") + + [WINDOWPROP W 'DXOFFSET + (SETQ DXOFFSET + (IMAX 0 (IMIN (- (fetch (BITMAP BITMAPWIDTH) + of BM) + (WINDOWPROP W 'BMDISPLAYWIDTH)) + (- (IPLUS XOFFSET (LRSH BITSWIDE 1)) + (LRSH (WINDOWPROP W 'BMDISPLAYWIDTH) + 1] + (WINDOWPROP W 'DYOFFSET + (SETQ DYOFFSET + (IMAX 0 (IMIN (- (fetch (BITMAP BITMAPHEIGHT) + of BM) + (WINDOWPROP W 'BMDISPLAYHEIGHT)) + (- (IPLUS YOFFSET (LRSH BITSHIGH 1)) + (LRSH (WINDOWPROP W 'BMDISPLAYHEIGHT) + 1] + (* DSPFILL GRIDINTERIOR WHITESHADE + (QUOTE REPLACE) W) + (UPDATE/BM/DISPLAY BM W) + + (* ;; +"FS: More useless code: (COND ((WINDOWPROP W 'GRIDON) (GRID GRIDSPEC BITSWIDE BITSHIGH 'POINT W)))") + + (RESETGRID.NEW BM GRIDSPEC BITSWIDE BITSHIGH 0 0 W T))) + NIL)) + ((LASTMOUSESTATE LEFT) + (UPDATE/BM/DISPLAY/SELECTED/REGION W) + (SETQ CURSORBM (BITMAPCREATE 16 16 (BITSPERPIXEL BM))) + (BITBLT BM NIL NIL CURSORBM) + [RESETFORM (CURSOR (CURSORCREATE CURSORBM NIL (fetch (CURSOR CUHOTSPOTX) + of \CURRENTCURSOR) + (fetch (CURSOR CUHOTSPOTY) of \CURRENTCURSOR))) + (until (MOUSESTATE (NOT LEFT] + (UPDATE/BM/DISPLAY/SELECTED/REGION W)) + (T + (* ;; "the region being editted is inverted while the menu is active. Each command must make sure that it is recomplemented.") + + (UPDATE/BM/DISPLAY/SELECTED/REGION W) + (SELECTQ [MENU (COND + ((type? MENU EDITBMMENU) + EDITBMMENU) + (T (SETQ EDITBMMENU (create + MENU + ITEMS _ + [APPEND (COND + [(COLORDISPLAYP) + '((Color 'Color + "Choose color to set bits with" + ] + (T NIL)) + '((Paint 'Paint + "Calls the window PAINT command on the bitmap." + ) + (ShowAsTile 'ShowAsTile + "tiles the upper part of the edit window with the bitmap." + ) + (Grid% On/Off 'GridOnOff + "Grid On/Off Switch") + (GridSize_ 'GridSize_ + "Allows setting of the size of a bit in the edit area." + ) + (Reset 'Reset + "Sets the bitmap back to the state at the start of this edit session." + ) + (Clear 'Clear + "Sets the entire bitmap to 0") + (Blacken 'Blacken + "Blacken a region of bits") + (ClearBits 'ClearBits + "Clear a region of bits") + (Show% Coordinates 'ShowCoord + "Toggle coordinate display window, displays on bit-changes" + ) + (Cursor_ 'Cursor_ + "Puts the bitmap into the cursor and exits the editor." + ) + (OK 'OK "Leaves the edit session.") + (Abort 'Abort + "Restores the bitmap to its original values and leaves the editor." + ] + CENTERFLG _ T] + (OK (WINDOWPROP W 'FINISHEDFLG T) + (COND + ((WINDOWPROP W 'COORDWIN) + (DETACHWINDOW (WINDOWPROP W 'COORDWIN) + W) + (CLOSEW (WINDOWPROP W 'COORDWIN)) + (WINDOWPROP W 'COORDWIN NIL)))) + (Abort (WINDOWPROP W 'FINISHEDFLG 'KILL) + (COND + ((WINDOWPROP W 'COORDWIN) + (DETACHWINDOW (WINDOWPROP W 'COORDWIN) + W) + (CLOSEW (WINDOWPROP W 'COORDWIN)) + (WINDOWPROP W 'COORDWIN NIL)))) + (Reset + (* ;; "allow the user to choose between everything or just visible part. This also give the user a chance to change their mind.") + + (COND + ((SELECTQ (\EDITBMHOWMUCH BM BITSWIDE BITSHIGH "RESET how much?") + (VISIBLE [COND + [(SETQ ORIGBM (WINDOWPROP W 'ORIGINALBITMAP)) + (COND + ((REGIONP ORIGBM) + (BITBLT \CURSORDESTINATION + (IPLUS XOFFSET (fetch (REGION LEFT) + of ORIGBM)) + (IPLUS YOFFSET (fetch (REGION BOTTOM) + of ORIGBM)) + BM XOFFSET YOFFSET BITSWIDE BITSHIGH + 'INPUT + 'REPLACE)) + (T (BITBLT ORIGBM XOFFSET YOFFSET BM XOFFSET + YOFFSET BITSWIDE BITSHIGH] + (T (BLTSHADE WHITESHADE BM XOFFSET YOFFSET BITSWIDE + BITSHIGH 'REPLACE] + T) + (WHOLE [COND + [(SETQ ORIGBM (WINDOWPROP W 'ORIGINALBITMAP)) + (COND + ((REGIONP ORIGBM) + (BITBLT \CURSORDESTINATION (fetch (REGION + LEFT) + of ORIGBM) + (fetch (REGION BOTTOM) of ORIGBM) + BM)) + (T (BITBLT ORIGBM NIL NIL BM] + (T (BLTSHADE WHITESHADE BM NIL NIL NIL NIL 'REPLACE] + T) + (PROGN (UPDATE/BM/DISPLAY/SELECTED/REGION W) + NIL)) + (\EDITBM/PUTUP/DISPLAY W BM GRIDSPEC GRIDINTERIOR BITSWIDE + BITSHIGH)))) + (Clear + (* ;; "allow the user to choose between everything or just visible part. This also give the user a chance to change their mind.") + + (COND + ((SELECTQ (\EDITBMHOWMUCH BM BITSWIDE BITSHIGH "CLEAR how much?") + (VISIBLE (BLTSHADE WHITESHADE BM XOFFSET YOFFSET BITSWIDE BITSHIGH + 'REPLACE) + T) + (WHOLE (\CLEARBM BM) + T) + (PROGN (UPDATE/BM/DISPLAY/SELECTED/REGION W) + NIL)) + (DSPFILL GRIDINTERIOR WHITESHADE 'REPLACE W) + (COND + ((WINDOWPROP W 'GRIDON) + (GRID GRIDSPEC BITSWIDE BITSHIGH 'POINT W))) + (UPDATE/BM/DISPLAY BM W)))) + (Blacken (LET ((REG (GETGRIDBOXREGION 0 0 GRIDSPEC GRIDINTERIOR W))) + (BLTSHADE BLACKSHADE BM (+ (fetch (REGION LEFT) of REG) + XOFFSET) + (+ (fetch (REGION BOTTOM) of REG) + YOFFSET) + (fetch (REGION WIDTH) of REG) + (fetch (REGION HEIGHT) of REG) + 'REPLACE) + (UPDATE/BM/DISPLAY BM W) + (RESETGRID.NEW BM GRIDSPEC BITSWIDE BITSHIGH 0 0 W))) + (ClearBits (LET ((REG (GETGRIDBOXREGION 0 0 GRIDSPEC GRIDINTERIOR W))) + (BLTSHADE WHITESHADE BM (+ (fetch (REGION LEFT) of REG) + XOFFSET) + (+ (fetch (REGION BOTTOM) of REG) + YOFFSET) + (fetch (REGION WIDTH) of REG) + (fetch (REGION HEIGHT) of REG) + 'REPLACE) + (UPDATE/BM/DISPLAY BM W) + (RESETGRID.NEW BM GRIDSPEC BITSWIDE BITSHIGH 0 0 W))) + (ShowCoord [LET [(COORDWIN (WINDOWPROP W 'COORDWIN] + (COND + (COORDWIN (DETACHWINDOW COORDWIN W) + (CLOSEW COORDWIN) + (WINDOWPROP W 'COORDWIN NIL)) + (T (ATTACHWINDOW (SETQ COORDWIN + (CREATEW '(0 0 70 32) + "Coordinates" NIL T)) + W + 'TOP + 'LEFT) + (WINDOWPROP W 'COORDWIN COORDWIN]) + (GridOnOff (COND + ((NOT (WINDOWPROP W 'GRIDON)) + (* ; "Turn Grid On") + (WINDOWPROP W 'GRIDON T) + (GRID GRIDSPEC BITSWIDE BITSHIGH 'POINT W) + (UPDATE/BM/DISPLAY BM W) + NIL) + (T (* ; "Turn off grid") + (WINDOWPROP W 'GRIDON NIL) + (* DSPFILL (create REGION LEFT _ 0 + BOTTOM _ 0 WIDTH _ + (ADD1 (fetch (REGION WIDTH) of + GRIDINTERIOR)) HEIGHT _ + (ADD1 (fetch (REGION HEIGHT) of + GRIDINTERIOR))) WHITESHADE + (QUOTE REPLACE) W) + (RESETGRID.NEW BM GRIDSPEC BITSWIDE BITSHIGH 0 0 W T) + (UPDATE/BM/DISPLAY BM W) + NIL))) + (GridSize_ (* ; + "sets the grid square size and calls the reshapefn.") + (COND + ([SETQ NEWGRIDSIZE + (NUMBERP (MENU (COND + ((TYPENAMEP GRIDSIZEMENU 'MENU) + GRIDSIZEMENU) + (T (SETQ GRIDSIZEMENU + (create MENU + ITEMS _ + '(3 4 5 6 7 8 12 16 20 24 28 32) + MENUROWS _ 4] + (WINDOWPROP W 'GRIDSQUARE NEWGRIDSIZE) + (EDITBMRESHAPEFN W)))) + (ShowAsTile (* ; "tiles the upper part of the window with the bitmap so the user can see what it would be as a shade.") + (UPDATE/SHADE/DISPLAY BM W)) + (Paint (* ; + "call the window paint command on the contents of the bitmap.") + [SETQ PAINTW (CREATEW (create REGION + LEFT _ (IQUOTIENT (- SCREENWIDTH BITMAPWIDTH) + 2) + BOTTOM _ (IQUOTIENT (- SCREENHEIGHT + BITMAPHEIGHT) + 2) + WIDTH _ (WIDTHIFWINDOW BITMAPWIDTH) + HEIGHT _ (HEIGHTIFWINDOW BITMAPHEIGHT NIL] + (OPENW PAINTW) + (BITBLT BM 0 0 PAINTW) + (PAINTW PAINTW) + (COND + ((MENU (create MENU + ITEMS _ '((YES T + "Will put the newly painted bits back in the bitmap being editted." + ) + (NO NIL + "Will discard the painted bits, not changing the bitmap being editted." + )) + TITLE _ "Put change into bitmap?" + CENTERFLG _ T)) + (BITBLT PAINTW 0 0 BM) + (\EDITBM/PUTUP/DISPLAY W BM GRIDSPEC GRIDINTERIOR BITSWIDE + BITSHIGH))) + (CLOSEW PAINTW) (* ; + "set PAINTW so that space can be reclaimed") + (SETQ PAINTW)) + (Cursor_ (* ; + "Stuffs lower left part of image into the cursor and sets the hotspot.") + (READHOTSPOT BM GRIDSPEC GRIDINTERIOR W) + (* WINDOWPROP W (QUOTE FINISHEDFLG) + T) + ) + (Color (WINDOWPROP W 'COLOR (OR (MENU (COLORMENU BITSPERPIXEL)) + COLOR))) + (UPDATE/BM/DISPLAY/SELECTED/REGION W]) + +(\EDITBM/PUTUP/DISPLAY + [LAMBDA (WINDOW BM GRIDSPEC GRIDINTERIOR BITSWIDE BITSHIGH)(* ; "Edited 31-Aug-87 13:05 by FS") + (* initializes the display for the + bitmap editor.) + (* DSPFILL GRIDINTERIOR WHITESHADE + (QUOTE REPLACE) WINDOW) + (* COND ((WINDOWPROP WINDOW + (QUOTE GRIDON)) (GRID GRIDSPEC + BITSWIDE BITSHIGH (QUOTE POINT) WINDOW))) + (RESETGRID.NEW BM GRIDSPEC BITSWIDE BITSHIGH 0 0 WINDOW T) + (UPDATE/BM/DISPLAY BM WINDOW]) + +(\EDITBMHOWMUCH + [LAMBDA (BM EDITWIDTH EDITHEIGHT TITLEQ) (* kbr%: " 2-Sep-85 19:44") + (* asks the user how much to clear) + (MENU (COND + ((OR (IGREATERP (fetch (BITMAP BITMAPWIDTH) of BM) + EDITWIDTH) + (IGREATERP (fetch (BITMAP BITMAPHEIGHT) of BM) + EDITHEIGHT)) + (create MENU + TITLE _ TITLEQ + ITEMS _ '((VisiblePart 'VISIBLE + "Operates on just the part visible in the edit region") + (WholeBitmap 'WHOLE "Operates on the entire bitmap")) + CENTERFLG _ T)) + (T (create MENU + TITLE _ TITLEQ + ITEMS _ '((WholeBitmap 'WHOLE "Operates on the entire bitmap")) + CENTERFLG _ T]) + +(EDITBMRESHAPEFN + [LAMBDA (BMEDITWINDOW OLDIMAGE OLDREGION OLDSCREENREGION ZEROBMFLG) + (* ; "Edited 7-Dec-88 17:00 by SHIH") + + (* ;; "allows the bitmap edit window to be reshaped to enlarge the editting area. This is also called to set up the image during initialization.") + + (PROG (BMWINTERIORWIDTH BMWINTERIORHEIGHT EDITAREABITWIDTH EDITAREABITHEIGHT GRIDSQUARE + GRIDINTERIOR BITMAPWIDTH BMDISPLAYWIDTH BMDISPLAYBOTTOM BMDISPLAYHEIGHT BITMAPHEIGHT + (BM (WINDOWPROP BMEDITWINDOW 'BM)) + MINCOMMANDAREAWIDTH EXTENTWIDTH EXTENTHEIGHT TEMPBM) + (SETQ MINCOMMANDAREAWIDTH 30) + (SETQ BITMAPWIDTH (fetch (BITMAP BITMAPWIDTH) of BM)) + (SETQ BITMAPHEIGHT (fetch (BITMAP BITMAPHEIGHT) of BM)) + (SETQ BMWINTERIORWIDTH (WINDOWPROP BMEDITWINDOW 'WIDTH)) + + (* ;; + "leave room at the top for the full size display area. But not more than half of the window.") + + (SETQ BMWINTERIORHEIGHT (IMAX (IDIFFERENCE (WINDOWPROP BMEDITWINDOW 'HEIGHT) + (IPLUS BITMAPHEIGHT GRIDTHICKNESS)) + (IQUOTIENT (WINDOWPROP BMEDITWINDOW 'HEIGHT) + 2))) + + (* ;; "if the user hasn't set it, determine the grid size as the largest size which fits the interior but not larger than NORMALGRIDSQUARE nor smaller than MINGRIDSQUARE. If GRIDSQUARE was specified, reset it to NIL so that if reshaped it will be recalculated.") + + (SETQ GRIDSQUARE (OR (WINDOWPROP BMEDITWINDOW 'GRIDSQUARE NIL) + (IMAX (IMIN (IQUOTIENT BMWINTERIORWIDTH BITMAPWIDTH) + (IQUOTIENT BMWINTERIORHEIGHT BITMAPHEIGHT) + NORMALGRIDSQUARE) + MINGRIDSQUARE))) (* ; + "calculate how many bits will be displayed at once.") + (SETQ EDITAREABITWIDTH (IMIN (IQUOTIENT BMWINTERIORWIDTH GRIDSQUARE) + BITMAPWIDTH)) + (WINDOWPROP BMEDITWINDOW 'BITSWIDE EDITAREABITWIDTH) + (SETQ EDITAREABITHEIGHT (IMIN (IQUOTIENT BMWINTERIORHEIGHT GRIDSQUARE) + BITMAPHEIGHT)) (* ; + "calculate offset of display and command regions at the top of the window.") + (WINDOWPROP BMEDITWINDOW 'BITSHIGH EDITAREABITHEIGHT) + (SETQ BMDISPLAYBOTTOM (IPLUS (ITIMES GRIDSQUARE EDITAREABITHEIGHT) + GRIDTHICKNESS)) + (SETQ BMDISPLAYWIDTH (IMIN BITMAPWIDTH (IDIFFERENCE BMWINTERIORWIDTH MINCOMMANDAREAWIDTH))) + + (* ;; "put the offset --- the lower left coordinate --- in the same place unless the new shape allows more to be shown past the upper right corner.") + + (WINDOWPROP BMEDITWINDOW 'XOFFSET (IMIN (WINDOWPROP BMEDITWINDOW 'XOFFSET) + (IDIFFERENCE BITMAPWIDTH EDITAREABITWIDTH))) + (WINDOWPROP BMEDITWINDOW 'YOFFSET (IMIN (WINDOWPROP BMEDITWINDOW 'YOFFSET) + (IDIFFERENCE BITMAPHEIGHT EDITAREABITHEIGHT))) + (* ; "Center edit square") + (SETQ GRIDINTERIOR (create REGION + LEFT _ (IQUOTIENT (IDIFFERENCE BMWINTERIORWIDTH (ITIMES + EDITAREABITWIDTH + GRIDSQUARE + )) + 2) + BOTTOM _ (IQUOTIENT (IDIFFERENCE BMDISPLAYBOTTOM (ITIMES + EDITAREABITHEIGHT + + GRIDSQUARE + )) + 2) + WIDTH _ (ITIMES EDITAREABITWIDTH GRIDSQUARE) + HEIGHT _ (ITIMES EDITAREABITHEIGHT GRIDSQUARE))) + (WINDOWPROP BMEDITWINDOW 'GRIDINTERIOR GRIDINTERIOR) + (WINDOWPROP BMEDITWINDOW 'BMDISPLAYBOTTOM BMDISPLAYBOTTOM) + (WINDOWPROP BMEDITWINDOW 'BMDISPLAYWIDTH BMDISPLAYWIDTH) + (WINDOWPROP BMEDITWINDOW 'BMDISPLAYHEIGHT (SETQ BMDISPLAYHEIGHT (IDIFFERENCE + (WINDOWPROP BMEDITWINDOW + 'HEIGHT) + BMDISPLAYBOTTOM))) + (WINDOWPROP BMEDITWINDOW 'DISPLAYREGION + (create REGION + LEFT _ 0 + BOTTOM _ BMDISPLAYBOTTOM + WIDTH _ BMDISPLAYWIDTH + HEIGHT _ BMDISPLAYHEIGHT)) + (WINDOWPROP BMEDITWINDOW 'GRIDSPEC (create REGION + LEFT _ (fetch (REGION LEFT) of + GRIDINTERIOR + ) + BOTTOM _ (fetch (REGION BOTTOM) of + GRIDINTERIOR + ) + WIDTH _ GRIDSQUARE + HEIGHT _ GRIDSQUARE)) + (SETQ EXTENTHEIGHT (QUOTIENT (TIMES BITMAPHEIGHT (WINDOWPROP BMEDITWINDOW 'HEIGHT)) + EDITAREABITHEIGHT)) + [SETQ EXTENTWIDTH (IDIFFERENCE (QUOTIENT (TIMES BITMAPWIDTH BMWINTERIORWIDTH) + EDITAREABITWIDTH) + (WINDOWPROP BMEDITWINDOW 'BORDER] + (WINDOWPROP BMEDITWINDOW 'EXTENT (CREATEREGION (MINUS (QUOTIENT (TIMES (WINDOWPROP + BMEDITWINDOW + 'XOFFSET) + EXTENTWIDTH) + BITMAPWIDTH)) + (MINUS (QUOTIENT (TIMES (WINDOWPROP BMEDITWINDOW + 'YOFFSET) + EXTENTHEIGHT) + BITMAPHEIGHT)) + EXTENTWIDTH EXTENTHEIGHT)) + + (* ;; "Build & cache a temporary bitmap.") + + (* ;; "Could make only (min (bitmapheight bm) (iquotient (bitmapheight window) scale)), except if user changes scale, bitmap might be too small. So, make sufficiently large just to be safe.") + + (SETQ TEMPBM (WINDOWPROP BMEDITWINDOW 'TEMPBM)) + (LET ((TEMPBM.W BMWINTERIORWIDTH) + (TEMPBM.H (IMIN BITMAPHEIGHT EDITAREABITHEIGHT))) + (if (OR (NOT TEMPBM) + (OR (< (BITMAPWIDTH TEMPBM) + TEMPBM.W) + (< (BITMAPHEIGHT TEMPBM) + TEMPBM.H))) + then (SETQ TEMPBM (BITMAPCREATE TEMPBM.W TEMPBM.H (FETCH (BITMAP + BITMAPBITSPERPIXEL + ) + OF BM))) + (WINDOWPROP BMEDITWINDOW 'TEMPBM TEMPBM))) + (EDITBMREPAINTFN BMEDITWINDOW NIL ZEROBMFLG]) + +(EDITBMREPAINTFN + [LAMBDA (WIN REGION ZEROBM) (* ; "Edited 8-Dec-88 14:38 by SHIH") + + (* ;; + "redisplays a bitmap editting window If ZEROBM is non-NIL, it doesn't bother to display the bits.") + + (PROG [(GRIDSPEC (WINDOWPROP WIN 'GRIDSPEC)) + (EDITAREABITWIDTH (WINDOWPROP WIN 'BITSWIDE)) + (EDITAREABITHEIGHT (WINDOWPROP WIN 'BITSHIGH)) + (BM (WINDOWPROP WIN 'BM] + (CLEARW WIN) (* ; + "gray the area above the edit grid that is not bitmap display area.") + (BLTSHADE NOTINUSEGRAY WIN (+ (WINDOWPROP WIN 'BMDISPLAYWIDTH) + GRIDTHICKNESS) + (WINDOWPROP WIN 'BMDISPLAYBOTTOM)) + + (* ;; "put in the display of the full sized bitmap.") + + (UPDATE/BM/DISPLAY BM WIN) + + (* ;; "FS: Now that RESETGRID displays the grid, don't need the call to GRID.") + + (if ZEROBM + then (if (WINDOWPROP WIN 'GRIDON) + then (GRID GRIDSPEC EDITAREABITWIDTH EDITAREABITHEIGHT + 'POINT WIN)) + else (RESETGRID.NEW BM GRIDSPEC EDITAREABITWIDTH EDITAREABITHEIGHT 0 0 WIN]) + +(UPDATE/SHADE/DISPLAY + [LAMBDA (BM WIN) (* rrb "20-JUN-82 16:53") + (* displays BM as if it were a shade.) + (PROG [(BOTTOM (WINDOWPROP WIN 'BMDISPLAYBOTTOM] + (TILEAREA 0 BOTTOM (WINDOWPROP WIN 'WIDTH) + (IDIFFERENCE (WINDOWPROP WIN 'HEIGHT) + BOTTOM) + BM WIN]) + +(UPDATE/BM/DISPLAY/SELECTED/REGION + [LAMBDA (W) (* ; "Edited 1-Sep-87 17:48 by FS") + (* Shade the selected region of the + bitmap display area.) + (COND + ([OR (IGREATERP (fetch (BITMAP BITMAPWIDTH) of (WINDOWPROP W 'BM)) + (WINDOWPROP W 'BITSWIDE)) + (IGREATERP (fetch (BITMAP BITMAPHEIGHT) of (WINDOWPROP W 'BM)) + (WINDOWPROP W 'BITSHIGH] + + (* only invert the region being editted if it is less than the entire bitmap.) + + (BLTSHADE BLACKSHADE W (IDIFFERENCE (WINDOWPROP W 'XOFFSET) + (WINDOWPROP W 'DXOFFSET)) + (IDIFFERENCE (IPLUS (WINDOWPROP W 'BMDISPLAYBOTTOM) + (WINDOWPROP W 'YOFFSET)) + (WINDOWPROP W 'DYOFFSET)) + (WINDOWPROP W 'BITSWIDE) + (WINDOWPROP W 'BITSHIGH) + 'INVERT]) + +(SHOWBUTTON + [LAMBDA (BUTTON DS) (* rrb "27-JUL-81 10:59") + (* displays a menu box and its title.) + (PROG ((BLOCK (fetch (BUTTON REGION) of BUTTON))) + (WBOX BLOCK NIL NIL DS) (* Display the title in the middle of + the box) + (CENTERPRINTINREGION (fetch (BUTTON LABEL) of BUTTON) + BLOCK DS]) + +(RESETGRID.NEW + [LAMBDA (BM GRIDSPEC WIDTH HEIGHT ORIGX ORIGY WINDOW DOCLEARFLG) + (* ; "Edited 8-Dec-88 14:36 by SHIH") + + (* ;; "Copies the contents of a bitmap into the edit display grid of window. ORIGX & Y are used to offest into both bitmap and destination window.") + + (LET (XOFFSET YOFFSET MAXX MAXY SHADE XSCALE YSCALE TEMPBM) + (SETQ XSCALE (fetch (REGION WIDTH) of GRIDSPEC)) + (SETQ YSCALE (fetch (REGION HEIGHT) of GRIDSPEC)) + (if (NULL ORIGX) + then (SETQ ORIGX 0)) + (if (NULL ORIGY) + then (SETQ ORIGY 0)) + (SETQ XOFFSET (WINDOWPROP WINDOW 'XOFFSET)) + (SETQ YOFFSET (WINDOWPROP WINDOW 'YOFFSET)) + (SETQ MAXX (IPLUS ORIGX WIDTH -1)) + (SETQ MAXY (IPLUS ORIGY HEIGHT -1)) + (SETQ TEMPBM (WINDOWPROP WINDOW 'TEMPBM)) + + (* ;; "Use SCALEBM. Bitmap destination must be empty (white).") + + (if DOCLEARFLG + then (BLTSHADE WHITESHADE WINDOW (LEFTOFGRIDCOORD ORIGX GRIDSPEC) + (BOTTOMOFGRIDCOORD ORIGY GRIDSPEC) + (CL:* WIDTH XSCALE) + (CL:* HEIGHT YSCALE) + 'REPLACE)) + (SCALEBM BM (+ ORIGX XOFFSET) + (+ ORIGY YOFFSET) + WINDOW + (LEFTOFGRIDCOORD ORIGX GRIDSPEC) + (BOTTOMOFGRIDCOORD ORIGY GRIDSPEC) + WIDTH HEIGHT XSCALE YSCALE TEMPBM) + + (* ;; "Texture the pixels correctly (note that Bltshade has a different meaning on color BMs, so only shade if its B/W). DARKBITSHADE MUST be a number, but try and be robust anyway.") + + (IF (= 1 (BITSPERPIXEL BM)) + THEN (BLTSHADE (if (NUMBERP DARKBITSHADE) + then (- -1 DARKBITSHADE) + else DARKBITSHADE) + WINDOW + (LEFTOFGRIDCOORD ORIGX GRIDSPEC) + (BOTTOMOFGRIDCOORD ORIGY GRIDSPEC) + (CL:* WIDTH XSCALE) + (CL:* HEIGHT YSCALE) + 'ERASE)) + + (* ;; "Add grid") + + (if (WINDOWPROP WINDOW 'GRIDON) + then (if (OR (NEQ ORIGX (CAR GRIDSPEC)) + (NEQ ORIGY (CADR GRIDSPEC))) + then (SETQ GRIDSPEC (COPYALL GRIDSPEC)) + (replace (REGION LEFT) of GRIDSPEC with ( + LEFTOFGRIDCOORD + ORIGX GRIDSPEC)) + (replace (REGION BOTTOM) of GRIDSPEC with ( + BOTTOMOFGRIDCOORD + ORIGY GRIDSPEC + ))) + (GRID GRIDSPEC WIDTH HEIGHT 'POINT WINDOW]) + +(RESETGRID + [LAMBDA (BM GRIDSPEC WIDTH HEIGHT ORGX ORGY W) (* ; "Edited 7-Dec-88 16:58 by SHIH") + + (* ;; "copies the contents of a bitmap into the edit display grid.") + + (* ;; "This is no longer called from HLDISPLAY, and is probably obsolete. Thus code commented out, below.") + + (* ;; "(PROG (XOFFSET YOFFSET MAXX MAXY SHADE) (COND ((NULL ORGX) (SETQ ORGX 0))) (COND ((NULL ORGY) (SETQ ORGY 0))) (SETQ XOFFSET (WINDOWPROP W 'XOFFSET)) (SETQ YOFFSET (WINDOWPROP W 'YOFFSET)) (SETQ MAXX (IPLUS ORGX WIDTH -1)) (SETQ MAXY (IPLUS ORGY HEIGHT -1)) (for Y from ORGY to MAXY do (for X from ORGX to MAXX do (SETQ SHADE (EDITBMTEXTURE BM (IPLUS X XOFFSET) (IPLUS Y YOFFSET))) (SHADEGRIDBOX X Y SHADE 'REPLACE GRIDSPEC (COND ((NULL (WINDOWPROP W 'GRIDON)) 0) (T 'POINT)) W))))") + + NIL]) + +(\READBMDIMENSIONS + [LAMBDA NIL (* gbn%: "26-Jan-86 15:57") + + (* asks the user for dimensions of a bitmap and creates it.) + + (PROG (WIDTH HEIGHT) + WIDTHLP + (PRIN1 "How wide would you like the bitmap to be? " T) + (COND + ([NOT (NUMBERP (SETQ WIDTH (READ T] + (PRIN1 "?" T) + (TERPRI T) + (GO WIDTHLP)) + ((ILESSP WIDTH 1) + (PRIN1 "WIDTH must be positive." T) + (TERPRI T) + (GO WIDTHLP))) + HEIGHTLP + (PRIN1 "How high would you like the bitmap to be? " T) + (COND + ([NOT (NUMBERP (SETQ HEIGHT (READ T] + (PRIN1 "?" T) + (TERPRI T) + (GO HEIGHTLP)) + ((ILESSP HEIGHT 1) + (PRIN1 "HEIGHT must be positive." T) + (TERPRI T) + (GO HEIGHTLP))) + (RETURN (BITMAPCREATE WIDTH HEIGHT (BITSPERPIXEL \CURSORDESTINATION]) + +(EDITSHADE + [LAMBDA (SHADE) (* ; "Edited 10-Oct-89 12:08 by jds") + + (* ;; "a simple shade editor.") + + (PROG (SHADEBM QUITREGION SHADEREGION BMWIDTH BMHEIGHT GRIDINTERIOR GRIDSPEC X Y SEDW BOXSIZE + SHOWREGION) + [SETQ SHADEBM (COND + ((BITMAPP SHADE) + (CREATETEXTUREFROMBITMAP SHADE)) + ((FIXP SHADE) + (\BITMAPFROMTEXTURE SHADE)) + ((EQ SHADE T) + (BITMAPCREATE 16 16)) + ((NULL SHADE) + (BITMAPCREATE 4 4)) + (T (\ILLEGAL.ARG SHADE] + (SETQ QUITREGION (CREATEREGION 72 150 50 20)) + (SETQ SHOWREGION (CREATEREGION 125 150 100 20)) + (SETQ SHADEREGION (CREATEREGION 10 185 272 100)) + (SETQ SEDW (CREATEW (GETBOXREGION 300 300 NIL NIL NIL + "Indicate position of Shade edit window."))) + (SETQ BMWIDTH (BITMAPWIDTH SHADEBM)) + (SETQ BMHEIGHT (BITMAPHEIGHT SHADEBM)) + (SETQ BOXSIZE (IMIN (IQUOTIENT 144 BMHEIGHT) + (IQUOTIENT 256 BMWIDTH))) + (WINDOWPROP SEDW 'PROCESS (THIS.PROCESS)) + (WINDOWPROP SEDW 'REPAINTFN 'EDITSHADEREPAINTFN) + (WINDOWPROP SEDW 'QUITREGION QUITREGION) + (WINDOWPROP SEDW 'SHOWREGION SHOWREGION) + (WINDOWPROP SEDW 'GRIDSPEC (SETQ GRIDSPEC (CREATEREGION (SETQ X + (IQUOTIENT (- 292 (ITIMES BOXSIZE + BMWIDTH)) + 2)) + (SETQ Y (IQUOTIENT (- 150 (ITIMES BOXSIZE + BMHEIGHT) + ) + 2)) + BOXSIZE BOXSIZE))) + [WINDOWPROP SEDW 'GRIDINTERIOR (SETQ GRIDINTERIOR (CREATEREGION X Y (ITIMES BOXSIZE BMWIDTH + ) + (ITIMES BOXSIZE BMHEIGHT] + (WINDOWPROP SEDW 'SHADEBM SHADEBM) + (WINDOWPROP SEDW 'SHADEREGION SHADEREGION) + (WINDOWPROP SEDW 'XOFFSET 0) + (WINDOWPROP SEDW 'YOFFSET 0) + (EDITSHADEREPAINTFN SEDW) + (RESETLST + (RESETSAVE NIL (LIST 'CLOSEW SEDW)) + [do (DSPFILL SHADEREGION (COND + ((EQ BMWIDTH 4)(* ; + "bitblt doesn't like bitmaps that are not 16 by 16.0") + (CREATETEXTUREFROMBITMAP SHADEBM)) + (T SHADEBM)) + 'TEXTURE SEDW) + (until (MOUSESTATE (OR LEFT MIDDLE RIGHT)) do (TOTOPW SEDW) + (BLOCK)) + (COND + [(LASTMOUSESTATE RIGHT) + (ERSETQ (DOWINDOWCOM (WHICHW LASTMOUSEX LASTMOUSEY] + ((EQ 'STOP + (until (MOUSESTATE UP) bind (XPIXEL YPIXEL) + do (TOTOPW SEDW) + [COND + [(INSIDE? GRIDINTERIOR (SETQ X (LASTMOUSEX SEDW)) + (SETQ Y (LASTMOUSEY SEDW))) + (COND + ((AND (STRICTLY/BETWEEN (SETQ XPIXEL (GRIDXCOORD + X GRIDSPEC)) + -1 BMWIDTH) + (STRICTLY/BETWEEN (SETQ YPIXEL (GRIDYCOORD + Y GRIDSPEC)) + -1 BMHEIGHT)) + (SHADEGRIDBOX XPIXEL YPIXEL (COND + ((LASTMOUSESTATE + LEFT) + DARKBITSHADE) + (T WHITESHADE)) + 'REPLACE GRIDSPEC 'POINT SEDW) + (BITMAPBIT SHADEBM XPIXEL YPIXEL (COND + ((LASTMOUSESTATE + LEFT) + 1) + (T 0] + [(INSIDE? QUITREGION X Y) + (DSPFILL QUITREGION BLACKSHADE 'INVERT SEDW) + (RETURN (until (MOUSESTATE UP) + do (COND + ((NOT (INSIDE? QUITREGION + (LASTMOUSEX SEDW) + (LASTMOUSEY SEDW))) + (DSPFILL QUITREGION BLACKSHADE + 'INVERT SEDW) + (RETURN))) + finally (DSPFILL QUITREGION BLACKSHADE + 'INVERT SEDW) + (* ; "close window.") + (RETURN 'STOP] + ((INSIDE? SHOWREGION X Y) + (DSPFILL SHOWREGION BLACKSHADE 'INVERT SEDW) + (RETURN (until (MOUSESTATE UP) + do (COND + ((NOT (INSIDE? SHOWREGION + (LASTMOUSEX SEDW) + (LASTMOUSEY SEDW))) + (DSPFILL SHOWREGION BLACKSHADE + 'INVERT SEDW) + (RETURN))) + finally (DSPFILL SHOWREGION BLACKSHADE + 'INVERT SEDW) + (* ; "close window.") + (PRINTOUT (GETPROMPTWINDOW SEDW 1) + T "Texture: " ( + CREATETEXTUREFROMBITMAP + SHADEBM] + (BLOCK))) + (RETURN]) + (RETURN (COND + ((AND (OR (NUMBERP SHADE) + (NULL SHADE)) + (EQ BMWIDTH 4) + (EQ BMHEIGHT 4)) (* ; + "user passed in a number or NIL, give them a number back.") + (CREATETEXTUREFROMBITMAP SHADEBM)) + (T SHADEBM]) + +(\BITMAPFROMTEXTURE + [LAMBDA (FIXP) (* rrb "16-May-84 14:56") + + (* returns a 4 by 4 bitmap that contains the texture represented by FIXP.) + + (PROG ((SHADE (BITMAPCREATE 4 4))) + [for X from 0 to 3 + do (for Y from 0 to 3 + do (COND + ([NOT (EQ 0 (LOGAND FIXP (\BITMASK (IPLUS (ITIMES (IDIFFERENCE 3 Y) + 4) + X] + (BITMAPBIT SHADE X Y 1] + (RETURN SHADE]) + +(EDITSHADEREPAINTFN + [LAMBDA (WIN) (* ; "Edited 10-Oct-89 12:04 by jds") + (* ; + "redisplays an edit shade window.") + (PROG (GRIDSPEC SHADE BMWIDTH BMHEIGHT) + (SETQ GRIDSPEC (WINDOWPROP WIN 'GRIDSPEC)) + (SETQ SHADE (WINDOWPROP WIN 'SHADEBM)) + (SETQ BMWIDTH (BITMAPWIDTH SHADE)) + (SETQ BMHEIGHT (BITMAPHEIGHT SHADE)) + (SHOWBUTTON (create BUTTON + REGION _ (WINDOWPROP WIN 'QUITREGION) + LABEL _ 'QUIT + HELP _ "Quits") + WIN) + (SHOWBUTTON (create BUTTON + REGION _ (WINDOWPROP WIN 'SHOWREGION) + LABEL _ 'Show% Number + HELP _ "Displays the texture number for the current shade.") + WIN) + (GRAYBOXAREA (fetch (REGION LEFT) of GRIDSPEC) + (fetch (REGION BOTTOM) of GRIDSPEC) + (ITIMES (fetch (REGION WIDTH) of GRIDSPEC) + BMWIDTH) + (ITIMES (fetch (REGION HEIGHT) of GRIDSPEC) + BMHEIGHT) + 2 BLACKSHADE WIN) + (RESETGRID.NEW SHADE GRIDSPEC BMWIDTH BMHEIGHT 0 0 WIN) + (* ; + "GRID GRIDSPEC BMWIDTH BMHEIGHT (QUOTE POINT) WIN") + (DSPFILL (WINDOWPROP WIN 'SHADEREGION) + SHADE + 'TEXTURE WIN]) + +(GRAYBOXAREA + [LAMBDA (X Y WIDTH HEIGHT OUTLINESIZE TEXTURE DS) (* ; "Edited 1-Sep-87 17:49 by FS") + (* outlines an area with a gray box.) + (COND + ((FIXP OUTLINESIZE)) + ((NULL OUTLINESIZE) + (SETQ OUTLINESIZE 1)) + (T (\ILLEGAL.ARG OUTLINESIZE))) + (BLTSHADE (OR TEXTURE BLACKSHADE) + DS + (IDIFFERENCE X OUTLINESIZE) + (IDIFFERENCE Y OUTLINESIZE) + (IPLUS WIDTH (ITIMES 2 OUTLINESIZE)) + (IPLUS HEIGHT (ITIMES 2 OUTLINESIZE)) + 'REPLACE) + (BLTSHADE (DSPTEXTURE NIL DS) + DS X Y WIDTH HEIGHT 'REPLACE]) + +(\SHADEBITS + [LAMBDA (BM GRIDSPEC GRIDINTERIOR W BITSWIDE BITSHIGH COLOR) + (* ; + "Edited 7-Jun-93 11:43 by sybalsky:mv:envos") + + (* cursor is inside the edit grid, so change the bit in the bitmap, change the + edit grid and redisplay the bitmap.) + + (PROG (BITSPERPIXEL XPIXEL YPIXEL OTHERCOLOR SHADE OTHERSHADE USECOLOR USESHADE X Y COORDWIN) + (SETQ BITSPERPIXEL (BITSPERPIXEL BM)) + (SETQ OTHERCOLOR (OPPOSITECOLOR COLOR BITSPERPIXEL)) + (COND + [(EQ BITSPERPIXEL 1) + (COND + ((EQ COLOR 1) + (SETQ SHADE DARKBITSHADE) + (SETQ OTHERSHADE WHITESHADE)) + (T (SETQ SHADE WHITESHADE) + (SETQ OTHERSHADE DARKBITSHADE] + (T (SETQ SHADE COLOR) + (SETQ OTHERSHADE OTHERCOLOR))) + (until (MOUSESTATE UP) + when (AND [NOT (EQ (AND [EQ XPIXEL (SETQ XPIXEL (IMAX 0 (IMIN BITSWIDE + (GRIDXCOORD + (SETQ X (LASTMOUSEX + W)) + GRIDSPEC] + YPIXEL) + (SETQ YPIXEL (IMAX 0 (IMIN BITSHIGH (GRIDYCOORD + (SETQ Y (LASTMOUSEY W)) + GRIDSPEC] + (INSIDE? GRIDINTERIOR X Y)) + do (COND + ((LASTMOUSESTATE LEFT) + (SETQ USECOLOR COLOR) + (SETQ USESHADE SHADE)) + (T (SETQ USECOLOR OTHERCOLOR) + (SETQ USESHADE OTHERSHADE))) + [COND + ((SETQ COORDWIN (WINDOWPROP W 'COORDWIN)) + (CLEARW COORDWIN) + (MOVETO 2 4 COORDWIN) + (PRINTOUT COORDWIN (IPLUS XPIXEL (WINDOWPROP W 'XOFFSET)) + ", " + (IPLUS YPIXEL (WINDOWPROP W 'YOFFSET] + (BITMAPBIT BM (IPLUS XPIXEL (WINDOWPROP W 'XOFFSET)) + (IPLUS YPIXEL (WINDOWPROP W 'YOFFSET)) + USECOLOR) + (UPDATE/BM/DISPLAY BM W) + (SHADEGRIDBOX XPIXEL YPIXEL USESHADE 'REPLACE GRIDSPEC + (COND + ((NULL (WINDOWPROP W 'GRIDON)) + 0) + (T 'POINT)) + W]) + +(READHOTSPOT + [LAMBDA (BM GRIDSPEC GRIDINTERIOR DS) (* ; "Edited 10-Jul-92 16:47 by cat") + (* kbr%: "13-Feb-86 15:21") + (* reads the hotspot from the cursor + and sets cursor) + (UNTILMOUSESTATE UP) + (PROG (NOWCURSOR XPIXEL YPIXEL DOWNYET? CURSORBM) + (SETQ NOWCURSOR (CURSOR)) + (CURSORPOSITION (create POSITION + XCOORD _ (IPLUS (LEFTOFGRIDCOORD (SETQ XPIXEL + (fetch (CURSOR CUHOTSPOTX) + of NOWCURSOR)) + GRIDSPEC) + (IQUOTIENT (fetch (REGION WIDTH) of GRIDSPEC + ) + 2)) + YCOORD _ (IPLUS (BOTTOMOFGRIDCOORD (SETQ YPIXEL + (fetch (CURSOR + CUHOTSPOTY + ) + of NOWCURSOR)) + GRIDSPEC) + (IQUOTIENT (fetch (REGION HEIGHT) of + GRIDSPEC + ) + 2))) + DS) (* SHADEGRIDBOX XPIXEL YPIXEL + NOTINUSEGRAY (QUOTE REPLACE) + GRIDSPEC (QUOTE POINT) DS) + (until (PROGN (BLOCK) + (GETMOUSESTATE) + (AND DOWNYET? (MOUSESTATE UP))) when (INSIDE? GRIDINTERIOR + (LASTMOUSEX DS) + (LASTMOUSEY DS)) + do [OR DOWNYET? (SETQ DOWNYET? (NOT (EQ LASTMOUSEBUTTONS 0] + (* COND (XPIXEL (SHADEGRIDBOX XPIXEL + YPIXEL (EDITBMTEXTURE BM XPIXEL + YPIXEL) (QUOTE REPLACE) GRIDSPEC + (QUOTE POINT) DS))) + (* SHADEGRIDBOX (SETQ XPIXEL + (GRIDXCOORD (LASTMOUSEX DS) GRIDSPEC)) + (SETQ YPIXEL (GRIDYCOORD + (LASTMOUSEY DS) GRIDSPEC)) + NOTINUSEGRAY (QUOTE REPLACE) + GRIDSPEC (QUOTE POINT) DS) + finally (SETQ CURSORBM (BITMAPCREATE 16 16 (BITSPERPIXEL BM))) + (BITBLT BM NIL NIL CURSORBM) + (CURSOR (CURSORCREATE CURSORBM NIL XPIXEL YPIXEL]) + +(WBOX + [LAMBDA (REG THCK TEXTURE DS) (* ; "Edited 1-Sep-87 17:52 by FS") + + (* Draws a box around REG with bounding lines of THCKness) + + (OR THCK (SETQ THCK 2)) + (BLTSHADE BLACKSHADE DS NIL NIL NIL NIL 'REPLACE REG) + (BLTSHADE (OR TEXTURE (DSPTEXTURE NIL DS)) + DS + (IPLUS (fetch (REGION LEFT) of REG) + THCK) + (IPLUS (fetch (REGION BOTTOM) of REG) + THCK) + (IDIFFERENCE (fetch (REGION WIDTH) of REG) + (ITIMES 2 THCK)) + (IDIFFERENCE (fetch (REGION HEIGHT) of REG) + (ITIMES 2 THCK)) + 'REPLACE]) + +(\CLEARBM + [LAMBDA (BM TXT REG) (* ; "Edited 1-Sep-87 17:53 by FS") + + (BLTSHADE (OR TXT WHITESHADE) + BM NIL NIL NIL NIL 'REPLACE REG]) + +(EDITBMTEXTURE + [LAMBDA (BM X Y) (* kbr%: " 9-Jan-86 21:51") + + (* Texture EDITBM should use to represent pixel + (X . Y) of BM. *) + + (PROG (COLOR SHADE) + (SETQ COLOR (BITMAPBIT BM X Y)) + (SETQ SHADE (COND + ((EQ (BITSPERPIXEL BM) + 1) + (COND + ((EQ COLOR 1) + DARKBITSHADE) + (T WHITESHADE))) + (T COLOR))) + (RETURN SHADE]) +) +(DECLARE%: DONTCOPY +(DECLARE%: EVAL@COMPILE + +(RECORD BUTTON (REGION LABEL HELP)) +) + +(DECLARE%: EVAL@COMPILE + +(PUTPROPS BITMASK MACRO ((X) + (LLSH 1 (IDIFFERENCE 15 X)))) + +(PUTPROPS UPDATE/BM/DISPLAY MACRO ((BM W) + (BITBLT BM (WINDOWPROP W 'DXOFFSET) + (WINDOWPROP W 'DYOFFSET) + W 0 (WINDOWPROP W 'BMDISPLAYBOTTOM) + (WINDOWPROP W 'BMDISPLAYWIDTH) + 1000 NIL 'REPLACE))) +) +) +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(RPAQQ DARKBITSHADE 23130) + +(RPAQQ NORMALGRIDSQUARE 16) + +(RPAQQ NOTINUSEGRAY 42405) + +(RPAQQ EDITBMMENU NIL) + +(RPAQQ EDITBMWINDOWMENU NIL) + +(RPAQQ GRIDSIZEMENU NIL) + +(RPAQQ CLICKWAITTIME 250) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS DARKBITSHADE NORMALGRIDSQUARE NOTINUSEGRAY EDITBMMENU CLICKWAITTIME) +) +) +(DECLARE%: EVAL@COMPILE + +(RPAQQ GRIDTHICKNESS 2) + +(RPAQQ MINGRIDSQUARE 8) + +(RPAQQ MAXGRIDWIDTH 199) + +(RPAQQ MAXGRIDHEIGHT 175) + +(RPAQQ BMWINDOWSHADE 33410) + + +(CONSTANTS (GRIDTHICKNESS 2) + (MINGRIDSQUARE 8) + (MAXGRIDWIDTH 199) + (MAXGRIDHEIGHT 175) + (BMWINDOWSHADE 33410)) +) +(DEFINEQ + +(SCALEBM + [LAMBDA (SRCEBM SRCEX SRCEY DESTBM DESTX DESTY SRCEWIDTH SRCEHEIGHT XSCALE YSCALE TEMPBM) + (* ; "Edited 31-Aug-87 10:40 by FS") + + (* ;; "Magnify a bitmap as per EDITBM. Use smearing algorithm.") + + (LET ((DESTWIDTH (BITMAPWIDTH DESTBM)) + (DESTHEIGHT (BITMAPHEIGHT DESTBM)) + XSTEPS YSTEPS POWER) + + (* ;; "Check parameters, apply defaults") + + (if (NUMBERP SRCEWIDTH) + else (SETQ SRCEWIDTH (BITMAPWIDTH SRCEBM))) + (if (NUMBERP SRCEHEIGHT) + else (SETQ SRCEHEIGHT (BITMAPHEIGHT SRCEBM))) + + (* ;; "Save effort by considering min of srce and dest.") + + (SETQ DESTWIDTH (MIN DESTWIDTH (CL:* SRCEWIDTH XSCALE))) + (SETQ DESTHEIGHT (MIN DESTHEIGHT (CL:* SRCEHEIGHT YSCALE))) + (SETQ SRCEWIDTH (MIN SRCEWIDTH (IQUOTIENT DESTWIDTH XSCALE))) + (SETQ SRCEHEIGHT (MIN SRCEHEIGHT (IQUOTIENT DESTHEIGHT YSCALE))) + (if TEMPBM + then (BLTSHADE WHITESHADE TEMPBM) + else (SETQ TEMPBM (BITMAPCREATE DESTWIDTH SRCEHEIGHT))) + + (* ;; "CALL EXPANDBM twice, once for each direction, because we have a spare bitmap which makes it run faster than a single call to EXPANDBM would (I think).") + + (* ;; "") + + (* ;; "Do X Direction Smearing.") + + (* ;; "============") + + (EXPANDBM SRCEBM SRCEX SRCEY SRCEWIDTH SRCEHEIGHT TEMPBM 0 0 DESTWIDTH SRCEHEIGHT XSCALE 1 + XSCALE 1) + + (* ;; "") + + (* ;; "Do Y Direction Smearing.") + + (* ;; "============") + + (EXPANDBM TEMPBM 0 0 DESTWIDTH SRCEHEIGHT DESTBM DESTX DESTY DESTWIDTH DESTHEIGHT 1 YSCALE 1 + YSCALE) + + (* ;; "") + + (* ;; "Return the temporary bitmap for recycling purposes.") + + TEMPBM]) + +(BLTPATTERN + [LAMBDA (SRCE SX SY SW SH DEST DX DY DW DH OPER TEMPBM)(* ; "Edited 8-Dec-88 18:52 by SHIH") + + (* ;; "Fills region of Destination with tiles of Source region, using operation. If Temporary bitmap is provided, use it for optimal performance (this is because bitmaps are much faster to paint than other destinations, e.g. windows).") + + (PROG (W H RX RW TW TH) + (if (NULL SW) + then (SETQ SW (BITMAPWIDTH SRCE))) + (if (NULL SH) + then (SETQ SH (BITMAPHEIGHT SRCE))) + + (* ;; "") + + (if (NULL OPER) + then (SETQ OPER 'REPLACE)) (* ; + "IRM says OPER defaults to replace") + [if TEMPBM + then + + (* ;; "Temp bitmap is only useful if its larger than pattern.") + + (SETQ TW (BITMAPWIDTH TEMPBM)) + (SETQ TH (BITMAPHEIGHT TEMPBM)) + (if [OR (AND (<= SW (BITMAPWIDTH SRCE)) + (<= SH (BITMAPHEIGHT SRCE)) + (>= TW SW) + (>= TH SH)) + (AND (NEQ OPER 'REPLACE) + (>= TW (BITMAPWIDTH SRCE)) + (>= TH (BITMAPHEIGHT SRCE] + then (BLTPATTERN.REPLACEDISPLAY SRCE SX SY SW SH TEMPBM 0 0 TW TH) + + (* ;; "Allow code to fall through using TEMPBM as source area.") + + (SETQ SRCE TEMPBM) + (SETQ SX 0) + (SETQ SY 0) + [SETQ SW (MAX SW (ITIMES SW (IQUOTIENT TW SW] + (SETQ SH (MAX SH (ITIMES SH (IQUOTIENT TH SH] + (if (AND (EQ OPER 'REPLACE) + (<= SW (BITMAPWIDTH SRCE)) + (<= SH (BITMAPHEIGHT SRCE)) + (OR (BITMAPP DEST) + (WINDOWP DEST))) + then (BLTPATTERN.REPLACEDISPLAY SRCE SX SY SW SH DEST DX DY DW DH) + else + + (* ;; "Even if operation is REPLACE, don't know if destination is inexpensively readable (e.g. Interpress stream. SO, this is the general case here.") + + (BLTPATTERN.GENERIC SRCE SX SY SW SH DEST DX DY DW DH OPER]) + +(BLTPATTERN.REPLACEDISPLAY + [LAMBDA (SRCE SX SY SW SH DEST DX DY DW DH) (* ; "Edited 8-Dec-88 16:28 by SHIH") + + (* ;; "This routine only replaces the destination with the source, and assumes the destination itself can be easily read from and blt'ed to.") + + (* ;; "Put initial bitmap into destination. Source should not be within destination area, otherwise it will be overwritten.") + + (LET (RX RY RW RH W H) (* ; "R's are remaining area.") + (SETQ W (MIN SW DW)) + (SETQ H (MIN SH DH)) + + (* ;; "Algorithm below whites out extraneous area. General bltpattern routine leaves overlap areas *alone*, so this routine is not consistent when specified-size > source-size (general routine shouldnt come here if so).") + + (BLTSHADE WHITESHADE DEST DX DY W H 'REPLACE) + (BITBLT SRCE SX SY DEST DX DY W H NIL 'REPLACE) + (SETQ RX (+ DX W)) + (SETQ RW (- DW W)) + + (* ;; "Now power up until width is full.") + + (while (> RW 0) do (SETQ W (MIN SW RW)) + (BITBLT DEST DX DY DEST RX DY W H NIL 'REPLACE) + (SETQ RW (- RW W)) (* ; "Reduce remaining width") + (SETQ RX (+ RX W)) (* ; "Set next starting position") + (SETQ SW (+ SW SW)) (* ; "Can now use 2x area.")) + + (* ;; "") + + (SETQ RY (+ DY H)) + (SETQ RH (- DH H)) + (SETQ SH H) + (SETQ W DW) + + (* ;; "Now power up until height is full.") + + (while (> RH 0) do (SETQ H (MIN SH RH)) + (BITBLT DEST DX DY DEST DX RY W H NIL 'REPLACE) + (SETQ RH (- RH H)) (* ; "Reduce remaining width") + (SETQ RY (+ RY H)) (* ; "Set next starting position") + (SETQ SH (+ SH SH)) (* ; "Can now use 2x area.")]) + +(BLTPATTERN.GENERIC + [LAMBDA (SRCE SX SY SW SH DEST DX DY DW DH OPER) (* ; "Edited 8-Dec-88 16:51 by SHIH") + + (* ;; "Generically repeat pattern from srce over dest.") + + (LET (W H RX RW TW TH) + (if (NULL SW) + then (SETQ SW (BITMAPWIDTH SRCE))) + (if (NULL SH) + then (SETQ SH (BITMAPHEIGHT SRCE))) + (while (> DH 0) + do (SETQ H (MIN SH DH)) + + (* ;; "") + + (SETQ RW DW) + (SETQ RX DX) + + (* ;; "") + + (* ;; "Fill rows") + + (* ;; "") + + (while (> RW 0) + do (SETQ W (MIN SW RW)) + (BITBLT SRCE SX SY DEST RX DY W H NIL OPER) + (SETQ RW (- RW W)) + (SETQ RX (+ RX W))) + + (* ;; "") + + (SETQ DH (- DH H)) + (SETQ DY (+ DY H]) +) +(DEFINEQ + +(EXPANDBITMAP + [LAMBDA (BITMAP WIDTHFACTOR HEIGHTFACTOR) (* ; "Edited 2-Sep-87 17:49 by FS") + + (* ;; "Returns a new bitmap which is WidthFactor and HeightFactor bigger.") + + (* ;; + "FS: This slow piece of code has been replaced with a much faster, general one, EXPAND.l ") + + (LET (WIDTH HEIGHT BITSPERPIXEL NEWWIDTH NEWHEIGHT NEWX NEWY NEWBITMAP) + (OR WIDTHFACTOR (SETQ WIDTHFACTOR 1)) + (OR HEIGHTFACTOR (SETQ HEIGHTFACTOR 1)) + (SETQ HEIGHT (fetch (BITMAP BITMAPHEIGHT) of BITMAP)) + (SETQ WIDTH (fetch (BITMAP BITMAPWIDTH) of BITMAP)) + (SETQ BITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL) of BITMAP)) + (SETQ NEWWIDTH (ITIMES WIDTHFACTOR WIDTH)) + (SETQ NEWHEIGHT (ITIMES HEIGHTFACTOR HEIGHT)) + (SETQ NEWBITMAP (BITMAPCREATE NEWWIDTH NEWHEIGHT BITSPERPIXEL)) + + (* ;; "OLD code commented out here.") + (* LET NIL (* Expand in x-direction. + *) (SETQ NEWX 0) (for X from 0 to + (SUB1 WIDTH) do (for I from 1 to + WIDTHFACTOR do (BITBLT BITMAP X 0 + NEWBITMAP NEWX 0 1 HEIGHT + (QUOTE INPUT) (QUOTE REPLACE)) + (add NEWX 1))) (* Expand in + y-direction. *) (SETQ NEWY + (SUB1 NEWHEIGHT)) (for Y from + (SUB1 HEIGHT) to 0 by -1 do + (for I from 1 to HEIGHTFACTOR do + (BITBLT NEWBITMAP 0 Y NEWBITMAP 0 NEWY + NEWWIDTH 1 (QUOTE INPUT) + (QUOTE REPLACE)) (add NEWY -1)))) + (EXPANDBM BITMAP 0 0 WIDTH HEIGHT NEWBITMAP 0 0 NEWWIDTH NEWHEIGHT WIDTHFACTOR HEIGHTFACTOR + WIDTHFACTOR HEIGHTFACTOR) + NEWBITMAP]) + +(EXPANDBM + [LAMBDA (SRCEBM SRCEX SRCEY SRCEW SRCEH DESTBM DESTX DESTY DESTW DESTH XSCALE YSCALE XSPACE YSPACE) + (* ; "Edited 28-Aug-87 19:00 by FS") + + (* ;; "Expands a region of SrceBM by X&Y scale into a region of DestBM, spaced Xspace by YSpace apart (space must be larger than scale). SrceBM cannot be the same bitmap as DestBM. The entire region inside DestBM is cleared.") + + (PROG (XSTEPS YSTEPS POWER) + + (* ;; "Check parameters, apply defaults") + + (if (NUMBERP SRCEX) + else (SETQ SRCEX 0)) + (if (NUMBERP SRCEY) + else (SETQ SRCEY 0)) + (if (NUMBERP SRCEW) + else (SETQ SRCEW (BITMAPWIDTH SRCEBM))) + (if (NUMBERP SRCEH) + else (SETQ SRCEH (BITMAPHEIGHT SRCEBM))) + (if (NUMBERP DESTX) + else (SETQ SRCEX 0)) + (if (NUMBERP DESTY) + else (SETQ SRCEY 0)) + + (* ;; "Save effort by considering min of srce and dest.") + + [SETQ DESTW (IMIN DESTW (CL:* SRCEW (IMAX XSCALE XSPACE] + [SETQ DESTH (IMIN DESTH (CL:* SRCEH (IMAX YSCALE YSPACE] + [SETQ SRCEW (IMIN SRCEW (+ 1 (IQUOTIENT DESTW (IMAX XSCALE XSPACE] + [SETQ SRCEH (IMIN SRCEH (+ 1 (IQUOTIENT DESTH (IMAX YSCALE YSPACE] + (BLTSHADE WHITESHADE DESTBM DESTX DESTY DESTW DESTH) + (if (AND (EQL XSPACE 1) + (EQL YSPACE 1)) + then (BITBLT SRCEBM SRCEX SRCEY DESTBM DESTX DESTY SRCEW SRCEH) + (RETURN DESTBM)) + + (* ;; "") + + (* ;; "Do X Direction Smearing.") + + (* ;; "============") + + (* ;; + "Spread out bitmap by spacefactor. Start from far side to avoid overwrite (if srce = dest)") + + (if (EQL XSPACE 1) + then + + (* ;; "Don't fill destination, instead use srce in YSmear loop.") + + (* ;; "(BITBLT SRCEBM SRCEX SRCEY DESTBM DESTX DESTY SRCEW SRCEH)") + + + else + + (* ;; + "Spread out bitmap by spacefactor. Start from far side to avoid overwrite (if srce = dest)") + + (for I from (SUB1 SRCEW) to 0 by -1 do (BITBLT SRCEBM (+ SRCEX I) + SRCEY DESTBM (+ DESTX (CL:* I XSPACE)) + DESTY 1 SRCEH))) + + (* ;; "Now smear by scalefactor. Each step smears out a power of two. LSH is in ucode.") + + [if (EQL XSCALE 1) + else (SETQ POWER 1) + (while (<= POWER (LSH XSCALE -1)) do + + (* ;; + "In the X direction, only need to blt SRCEH bits high, and must shorten W to remain within DESTW") + + (BITBLT DESTBM DESTX DESTY DESTBM + (+ DESTX POWER) + DESTY + (- DESTW POWER) + SRCEH NIL 'PAINT) + (SETQ POWER (+ POWER POWER))) + + (* ;; "Clean up for non power of two.") + + (if (ZEROP (- XSCALE POWER)) + else (BITBLT DESTBM DESTX DESTY DESTBM (+ DESTX (- XSCALE POWER)) + DESTY + (- DESTW (- XSCALE POWER)) + SRCEH NIL 'PAINT] + + (* ;; "") + + (* ;; "Do Y Direction Smearing.") + + (* ;; "============") + + (* ;; + "Spread out bitmap by spacefactor. Start from far side to avoid overwrite (if srce = dest)") + + [if (EQL YSPACE 1) + else (if (EQL XSPACE 1) + then + + (* ;; "Didn't need to paint in destination, so can avoid second loop by blting from SRCBM instead of DESTBM.") + + (for J from (SUB1 SRCEH) to 0 by -1 + do (BITBLT SRCEBM SRCEX (+ SRCEY J) + DESTBM DESTX (+ DESTY (CL:* J YSPACE)) + DESTW 1)) + else (for J from (SUB1 SRCEH) to 0 by -1 + do (BITBLT DESTBM DESTX (+ DESTY J) + DESTBM DESTX (+ DESTY (CL:* J YSPACE)) + DESTW 1)) + + (* ;; + "Since we reused DESTBM, parts of the dest have bits in them but shouldn't. So, clear them.") + + (for J from 0 to SRCEH by YSPACE do (BLTSHADE WHITESHADE DESTBM DESTX + (+ DESTY J 1) + DESTW + (SUB1 YSPACE] + + (* ;; "Now smear correctly. Each step smears out a power of two. LSH is in ucode.") + + [if (EQL YSCALE 1) + else (SETQ POWER 1) + (while (<= POWER (LSH YSCALE -1)) do (BITBLT DESTBM DESTX DESTY DESTBM DESTX + (+ DESTY POWER) + DESTW + (- DESTH POWER) + NIL + 'PAINT) + (SETQ POWER (+ POWER POWER))) + + (* ;; "Clean up for non power of two.") + + (if (ZEROP (- YSCALE POWER)) + else (BITBLT DESTBM DESTX DESTY DESTBM DESTX (+ DESTY (- YSCALE POWER)) + DESTW DESTH NIL 'PAINT] + + (* ;; "") + + (* ;; "Return the temporary bitmap for recycling purposes.") + + DESTBM]) + +(SHRINKBITMAP + [LAMBDA (BITMAP WIDTHFACTOR HEIGHTFACTOR DESTINATIONBITMAP)(* hdj "18-Feb-86 14:23") + (LET* [(BITSPP (BITSPERPIXEL BITMAP)) + (WFACTOR (OR WIDTHFACTOR 4)) + (HFACTOR (OR HEIGHTFACTOR 1)) + (HEIGHT (BITMAPHEIGHT BITMAP)) + (WIDTH (BITMAPWIDTH BITMAP)) + (SCRATCH (BITMAPCREATE WIDTH (IQUOTIENT HEIGHT HFACTOR) + BITSPP)) + (DESTINATION (OR DESTINATIONBITMAP (BITMAPCREATE (IQUOTIENT WIDTH WFACTOR) + (IQUOTIENT HEIGHT HFACTOR) + BITSPP] + [if (AND (EQP WFACTOR 1) + (EQP HFACTOR 1)) + then (BITBLT BITMAP NIL NIL DESTINATION) + else (BLTSHADE 0 DESTINATION) + (for Y from 0 to (SUB1 HEIGHT) do (BITBLT BITMAP 0 Y SCRATCH 0 (IQUOTIENT Y HFACTOR) + WIDTH 1 'INPUT 'PAINT)) + (for X from 0 to (SUB1 WIDTH) do (BITBLT SCRATCH X 0 DESTINATION (IQUOTIENT X + WFACTOR) + 0 1 HEIGHT 'INPUT 'PAINT] + DESTINATION]) + +(\FAST4BIT + [LAMBDA (A B N MAP) (* kbr%: "16-May-85 17:14") + (* DECLARATIONS%: (BLOCKRECORD NIBBLE + ((N1 BITS 4) (N2 BITS 4) + (N3 BITS 4) (N4 BITS 4)))) + (bind AW (I _ 0) for J from 0 do (SETQ AW (\ADDBASE A J)) + (OR (IGREATERP N I) + (RETURN)) + (\PUTBASE B I (ELT MAP (fetch (NIBBLE N1) of AW))) + (OR (IGREATERP N (add I 1)) + (RETURN)) + (\PUTBASE B I (ELT MAP (fetch (NIBBLE N2) of AW))) + (OR (IGREATERP N (add I 1)) + (RETURN)) + (\PUTBASE B I (ELT MAP (fetch (NIBBLE N3) of AW))) + (OR (IGREATERP N (add I 1)) + (RETURN)) + (\PUTBASE B I (ELT MAP (fetch (NIBBLE N4) of AW))) + (add I 1]) +) + +(CL:DEFUN ROTATE-BITMAP (SOURCE) + "rotates the bitmap SOURCE by 90 degrees clockwise, returning a new bitmap" + +(* ;;; "This must be compiled to work") + + (* ;; "Rotate a bitmap by 90 degrees clockwise. Uses pilotbitblt hackery for maximum speed and confusion for the reader.") + + (LET* ((SOURCE-HEIGHT (BITMAPHEIGHT SOURCE)) + (DESTINATION (BITMAPCREATE SOURCE-HEIGHT (BITMAPWIDTH SOURCE))) + + (* ;; "The ROTATE-BBT table maps scanlines of the SOURCE bitmap into columns of the DESTINATION bitmap. The topmost scanline (lowest address) maps into the rightmost column of the destination. We proceed from top to bottom in the source, and from right to left in the destination. Refer to the Mesa PrincOps document for a description of Pilot BitBLT, and see also the declaration for the PILOTBBT datatype.") + + (ROTATE-BBT (create PILOTBBT + PBTDISJOINT _ T (* ; "the bitmaps are separate") + PBTDEST _ (ffetch (BITMAP BITMAPBASE) of DESTINATION) + (* ; + "set the destination (held constant)") + PBTSOURCE _ (ffetch (BITMAP BITMAPBASE) of SOURCE) + (* ; + "set the source (incremented by 1 scanline per iteration)") + PBTDESTBPL _ (UNFOLD (ffetch (BITMAP BITMAPRASTERWIDTH) of DESTINATION) + BITSPERWORD)(* ; + "the destination is this many bits between scanlines") + PBTSOURCEBPL _ 1 (* ; + "move 1 bit of each source scanline per 1 scanline of the destination") + PBTSOURCEBIT _ 0 (* ; + "start at the first bit of each source scanline (held constant)") + PBTDESTBIT _ (BITMAPWIDTH DESTINATION) + (* ; + "start putting data into the destination on the right edge (pre-decremented) ") + PBTFLAGS _ 0 (* ; + "replace mode (paint might be faster)") + PBTHEIGHT _ (BITMAPHEIGHT DESTINATION) + (* ; "how high the destination is") + PBTWIDTH _ 1 (* ; + "how wide the destination stripe is"))) + (SOURCE-WORD-WIDTH (ffetch (BITMAP BITMAPRASTERWIDTH) of SOURCE))) + (for I from 1 to SOURCE-HEIGHT do (add (ffetch (PILOTBBT PBTDESTBIT) of ROTATE-BBT) + -1) + (\PILOTBITBLT ROTATE-BBT 0) + + (* ;; "the line below is slower than need be, but works when the source crosses a segment. A faster way (which breaks on a segment cross) is to say") + + (* ;; + " (|add| (|ffetch| (PILOTBBT PBTSOURCELO) |of| ROTATE-BBT) SOURCE-WORD-WIDTH)") + + (FREPLACE (PILOTBBT PBTSOURCE) OF ROTATE-BBT + WITH (\ADDBASE (FFETCH (PILOTBBT PBTSOURCE) + OF ROTATE-BBT) + SOURCE-WORD-WIDTH))) + DESTINATION)) + +(CL:DEFUN ROTATE-BITMAP-LEFT (SOURCE) + "rotates the bitmap SOURCE by 90 degrees counter-clockwise, returning a new bitmap" + +(* ;;; "This must be compiled to work") + + (* ;; "Rotate a bitmap by 90 degrees counter-clockwise. Uses pilotbitblt hackery for maximum speed and confusion for the reader.") + + (LET* ((SOURCE-WIDTH (BITMAPWIDTH SOURCE)) + (DESTINATION (BITMAPCREATE (BITMAPHEIGHT SOURCE) + SOURCE-WIDTH)) + + (* ;; "The ROTATE-BBT table maps columns of the SOURCE bitmap into rows of the DESTINATION bitmap. The rightmost column maps into the topmost row(lowest address) of the destination. We proceed from right to left in the source, and from top to bottom in the destination. Refer to the Mesa PrincOps document for a description of Pilot BitBLT, and see also the declaration for the PILOTBBT datatype. ") + + (ROTATE-BBT (CREATE PILOTBBT + PBTDISJOINT _ T (* ; "the bitmaps are separate") + PBTDEST _ (FFETCH (BITMAP BITMAPBASE) OF DESTINATION) + (* ; + "set the destination (held constant)") + PBTSOURCE _ (FFETCH (BITMAP BITMAPBASE) OF SOURCE) + (* ; "set the source") + PBTDESTBPL _ 1 (* ; + "the destination is this many bits between scanlines") + PBTSOURCEBPL _ (UNFOLD (FFETCH (BITMAP BITMAPRASTERWIDTH) OF SOURCE) + BITSPERWORD) + (* ; "move a scanline at a time.") + PBTSOURCEBIT _ (BITMAPWIDTH SOURCE) + (* ; + "start getting data at the right edge of the source") + PBTDESTBIT _ 0 (* ; + "start putting data into the destination on the left edge ") + PBTFLAGS _ 0 (* ; + "replace mode (paint might be faster)") + PBTHEIGHT _ (BITMAPHEIGHT SOURCE) + (* ; "how high the stripe is") + PBTWIDTH _ 1 (* ; + "how wide the destination stripe is"))) + (DEST-WORD-WIDTH (FFETCH (BITMAP BITMAPRASTERWIDTH) OF DESTINATION))) + (FOR I FROM 1 TO SOURCE-WIDTH DO (add (FFETCH (PILOTBBT PBTSOURCEBIT) OF ROTATE-BBT) + -1) + (\PILOTBITBLT ROTATE-BBT 0) + + (* ;; "the line below is slower than need be, but works when the source crosses a segment. A faster way (which breaks on a segment cross) is to say") + + (* ;; + " (|add| (|ffetch| (PILOTBBT PBTSOURCELO) |of| ROTATE-BBT) SOURCE-WORD-WIDTH)") + + (FREPLACE (PILOTBBT PBTDEST) OF ROTATE-BBT + WITH (\ADDBASE (FFETCH (PILOTBBT PBTDEST) OF ROTATE-BBT) + DEST-WORD-WIDTH))) + DESTINATION)) + +(PUTPROPS HLDISPLAY FILETYPE CL:COMPILE-FILE) + +(READVARS-FROM-STRINGS '(\4BITEXPANSIONTABLE) + "({Y16 SMALLPOSP 0 0 15 240 255 3840 3855 4080 4095 61440 61455 61680 61695 65280 65295 65520 65535 }) +") +(DECLARE%: DONTCOPY + (FILEMAP (NIL (4748 12038 (FGH 4758 . 4883) (GRID 4885 . 9156) (GRIDXCOORD 9158 . 9663) (GRIDYCOORD +9665 . 10174) (LEFTOFGRIDCOORD 10176 . 10613) (BOTTOMOFGRIDCOORD 10615 . 10876) (SHADEGRIDBOX 10878 . +12036)) (12094 12502 (INSIDE? 12104 . 12500)) (12540 16936 (MOUSESTATE-EXPR 12550 . 16205) ( +MOUSESTATE-NAME 16207 . 16934)) (20426 21411 (DECODEBUTTONS 20436 . 21409)) (21412 22424 (PTDIFFERENCE + 21422 . 21931) (PTPLUS 21933 . 22422)) (22475 50493 (GETPOSITION 22485 . 22793) (GETBOXPOSITION 22795 + . 23478) (DSPYSCREENTOWINDOW 23480 . 23964) (DSPXSCREENTOWINDOW 23966 . 24450) (GETREGION 24452 . +25001) (\GETREGION.PACKPTS 25003 . 25571) (\GETREGION.CHECKBASEPT 25573 . 27516) (\GETREGION.CHECKOPPT + 27518 . 30328) (\GETREGIONTRACKWITHBOX 30330 . 36976) (\UPDATEXYANDBOX 36978 . 39357) (GETBOXREGION +39359 . 39833) (\TRACKWITHBOX 39835 . 44973) (MOVEBOX 44975 . 45605) (DRAWGRAYBOX 45607 . 46129) ( +BLTHLINE 46131 . 46381) (BLTVLINE 46383 . 46622) (SETCORNER 46624 . 47890) (GETSCREENPOSITION 47892 . +48505) (GETBOXSCREENPOSITION 48507 . 49118) (GETSCREENREGION 49120 . 49776) (GETBOXSCREENREGION 49778 + . 50491)) (50579 67395 (\MEDW.GETSCREENPOSITION 50589 . 52382) (\MEDW.GETBOXSCREENPOSITION 52384 . +55938) (\MEDW.GETSCREENREGION 55940 . 67393)) (67396 75134 (GETGRIDBOXREGION 67406 . 75060) ( +\RANGELIMIT 75062 . 75132)) (75135 78185 (MOUSECONFIRM 75145 . 78183)) (78326 79695 ( +NEAREST/PT/ON/GRID 78336 . 78931) (PTON10GRID 78933 . 79258) (NEAREST/MULTIPLE 79260 . 79693)) (81739 +85641 (\SW2BM 81749 . 84447) (COMPOSEREGS 84449 . 85003) (TRANSLATEREG 85005 . 85639)) (85683 176334 ( +EDITBM 85693 . 95818) (EDITBMSCROLLFN 95820 . 110973) (EDITBMCLOSEFN 110975 . 111592) (TILEAREA 111594 + . 111985) (EDITBMBUTTONFN 111987 . 136814) (\EDITBM/PUTUP/DISPLAY 136816 . 137718) (\EDITBMHOWMUCH +137720 . 138706) (EDITBMRESHAPEFN 138708 . 147394) (EDITBMREPAINTFN 147396 . 148715) ( +UPDATE/SHADE/DISPLAY 148717 . 149164) (UPDATE/BM/DISPLAY/SELECTED/REGION 149166 . 150280) (SHOWBUTTON +150282 . 150840) (RESETGRID.NEW 150842 . 154191) (RESETGRID 154193 . 155017) (\READBMDIMENSIONS 155019 + . 156056) (EDITSHADE 156058 . 164784) (\BITMAPFROMTEXTURE 164786 . 165484) (EDITSHADEREPAINTFN 165486 + . 167260) (GRAYBOXAREA 167262 . 167945) (\SHADEBITS 167947 . 170912) (READHOTSPOT 170914 . 174779) ( +WBOX 174781 . 175505) (\CLEARBM 175507 . 175706) (EDITBMTEXTURE 175708 . 176332)) (177679 185386 ( +SCALEBM 177689 . 179755) (BLTPATTERN 179757 . 182275) (BLTPATTERN.REPLACEDISPLAY 182277 . 184366) ( +BLTPATTERN.GENERIC 184368 . 185384)) (185387 197206 (EXPANDBITMAP 185397 . 187921) (EXPANDBM 187923 . +194478) (SHRINKBITMAP 194480 . 195824) (\FAST4BIT 195826 . 197204)) (197208 201197 (ROTATE-BITMAP +197208 . 201197)) (201199 205035 (ROTATE-BITMAP-LEFT 201199 . 205035))))) +STOP diff --git a/loadups/hcfiles-fails.txt b/loadups/hcfiles-fails.txt new file mode 100644 index 00000000..cf58dfee --- /dev/null +++ b/loadups/hcfiles-fails.txt @@ -0,0 +1,34 @@ +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN IRM.GET.CREFIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN IRM.GET.CREFIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN IRM.GET.CREFIL:FAIL +Cannot read image object with GETFN IRM.GET.CREFIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN HRULE.GETFNIL:FAIL +Cannot read image object with GETFN NUMBER.GETFNIL:FAIL +Image object with unknown GETFN COLOROBJ.GETFNIL:FAIL +IL:FAIL +Image object with unknown GETFN HRULE.GTFNIL:FAIL diff --git a/scripts/loadups/loadup-init.sh b/scripts/loadups/loadup-init.sh index 4a42bd00..c1d5b75e 100755 --- a/scripts/loadups/loadup-init.sh +++ b/scripts/loadups/loadup-init.sh @@ -11,6 +11,7 @@ main() { (* "make init files; this file is loaded as a 'greet' file by scripts/loadup-init.sh") (SETQ MEDLEYDIR NIL) + (SETATOMVAL (QUOTE MEDLEY-INIT-VARS) (QUOTE NOBIND)) (LOAD (CONCAT (UNIX-GETENV "MEDLEYDIR") "/sources/MEDLEYDIR.LCOM")) (MEDLEY-INIT-VARS) (PUTASSOC (QUOTE MEDLEY) (LIST (UNIX-GETENV (QUOTE LOADUP_COMMIT_ID))) SYSOUTCOMMITS) diff --git a/scripts/loadups/loadup-lisp-from-mid.sh b/scripts/loadups/loadup-lisp-from-mid.sh index df4999b6..42ddb959 100755 --- a/scripts/loadups/loadup-lisp-from-mid.sh +++ b/scripts/loadups/loadup-lisp-from-mid.sh @@ -12,6 +12,7 @@ main() { (PROGN (SETQ LOADUP-SUCCESS NIL) + (SETATOMVAL (QUOTE MEDLEY-INIT-VARS) (QUOTE NOBIND)) (LOAD (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE MEDLEYDIR)) (QUOTE /sources/MEDLEYDIR.LCOM))) (MEDLEY-INIT-VARS) (LOAD (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) (QUOTE /LOADUP-LISP.LCOM))) diff --git a/sources/ADIR b/sources/ADIR index 944285b5..5dc4d1ab 100644 --- a/sources/ADIR +++ b/sources/ADIR @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 6-Feb-2025 17:48:54" {DSK}frank>il>medley>sources>ADIR.;6 70091 +(FILECREATED "15-Oct-2025 15:20:48" {WMEDLEY}ADIR.;62 70135 - :CHANGES-TO (FNS INTERPRET.REM.CM) + :EDIT-BY rmk - :PREVIOUS-DATE "20-Jan-2025 13:37:28" {DSK}frank>il>medley>sources>ADIR.;3) + :CHANGES-TO (MACROS \UPF.EXTRACT) + + :PREVIOUS-DATE " 6-Feb-2025 17:48:54" {WMEDLEY}ADIR.;61) (PRETTYCOMPRINT ADIRCOMS) @@ -742,7 +744,8 @@ OFFST _ STARTOFFSET LENGTH _ (ADD1 (IDIFFERENCE ENDOFFSET STARTOFFSET)) BASE _ $$BASE - READONLY _ $$READONLY))) + READONLY _ $$READONLY + FATSTRINGP _ $$FATP))) (PUTPROPS \UPF.DIRTYPE MACRO [(DIRSTART) (* ; "Edited 20-Apr-2022 20:14 by rmk") (SELCHARQ (\GETBASECHAR $$FATP $$BASE DIRSTART) @@ -1279,14 +1282,14 @@ (ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3183 16010 (DELFILE 3193 . 3354) (FULLNAME 3356 . 3723) (INFILE 3725 . 3984) (INFILEP -3986 . 4121) (IOFILE 4123 . 4374) (OPENFILE 4376 . 4679) (OPENSTREAM 4681 . 9021) (OUTFILE 9023 . 9285 -) (OUTFILEP 9287 . 9423) (RENAMEFILE 9425 . 9731) (SIMPLE.FINDFILE 9733 . 10143) (VMEMSIZE 10145 . -10312) (\COPYSYS 10314 . 14605) (\FLUSHVM 14607 . 15679) (\LOGOUT0 15681 . 16008)) (16509 41169 ( -UNPACKFILENAME.STRING 16519 . 38355) (\UPF.DIRECTORY 38357 . 41167)) (42697 45003 (UNPACKFILENAME -42707 . 42893) (LASTCHPOS 42895 . 43589) (FILENAMEFIELD 43591 . 43885) (FILENAMEFIELD.STRING 43887 . -44291) (PACKFILENAME 44293 . 44636) (PACKFILENAME.STRING 44638 . 45001)) (59473 60386 ( -FILEDIRCASEARRAY 59483 . 60384)) (60553 67850 (LOGOUT 60563 . 61608) (MAKESYS 61610 . 63239) (SYSOUT -63241 . 64793) (SAVEVM 64795 . 65595) (HERALD 65597 . 65757) (INTERPRET.REM.CM 65759 . 67473) ( -\USEREVENT 67475 . 67848)) (68032 69759 (USERNAME 68042 . 68998) (SETUSERNAME 69000 . 69757))))) + (FILEMAP (NIL (3170 15997 (DELFILE 3180 . 3341) (FULLNAME 3343 . 3710) (INFILE 3712 . 3971) (INFILEP +3973 . 4108) (IOFILE 4110 . 4361) (OPENFILE 4363 . 4666) (OPENSTREAM 4668 . 9008) (OUTFILE 9010 . 9272 +) (OUTFILEP 9274 . 9410) (RENAMEFILE 9412 . 9718) (SIMPLE.FINDFILE 9720 . 10130) (VMEMSIZE 10132 . +10299) (\COPYSYS 10301 . 14592) (\FLUSHVM 14594 . 15666) (\LOGOUT0 15668 . 15995)) (16496 41156 ( +UNPACKFILENAME.STRING 16506 . 38342) (\UPF.DIRECTORY 38344 . 41154)) (42741 45047 (UNPACKFILENAME +42751 . 42937) (LASTCHPOS 42939 . 43633) (FILENAMEFIELD 43635 . 43929) (FILENAMEFIELD.STRING 43931 . +44335) (PACKFILENAME 44337 . 44680) (PACKFILENAME.STRING 44682 . 45045)) (59517 60430 ( +FILEDIRCASEARRAY 59527 . 60428)) (60597 67894 (LOGOUT 60607 . 61652) (MAKESYS 61654 . 63283) (SYSOUT +63285 . 64837) (SAVEVM 64839 . 65639) (HERALD 65641 . 65801) (INTERPRET.REM.CM 65803 . 67517) ( +\USEREVENT 67519 . 67892)) (68076 69803 (USERNAME 68086 . 69042) (SETUSERNAME 69044 . 69801))))) STOP diff --git a/sources/ADIR.LCOM b/sources/ADIR.LCOM index 11d3df85..8deb5dba 100644 Binary files a/sources/ADIR.LCOM and b/sources/ADIR.LCOM differ diff --git a/sources/AINTERRUPT b/sources/AINTERRUPT index ce480721..83ca8e6f 100644 --- a/sources/AINTERRUPT +++ b/sources/AINTERRUPT @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "31-Mar-2024 09:38:10" |{DSK}larry>il>medley>sources>AINTERRUPT.;7| 41133 +(FILECREATED "12-Nov-2025 11:10:44" |{WMEDLEY}AINTERRUPT.;4| 41235 - :EDIT-BY "lmm" + :EDIT-BY |rmk| :CHANGES-TO (VARS AINTERRUPTCOMS) - :PREVIOUS-DATE "31-Mar-2024 09:27:57" |{DSK}larry>il>medley>sources>AINTERRUPT.;5|) + :PREVIOUS-DATE "31-Mar-2024 09:38:10" |{WMEDLEY}AINTERRUPT.;3|) (PRETTYCOMPRINT AINTERRUPTCOMS) @@ -22,8 +22,8 @@ (5 ERROR MOUSE) (7 HELP T) (16 PRINTLEVEL) - (20 (CONTROL-T)) - (127 RUBOUT T))))) + (20 (CONTROL-T)))))) + (* \; "RMK2025: Removed (127 RUBOUT T)") (GLOBALVARS LISPINTERRUPTS) (COMS (* |;;| "^T this is actually not very useful any more, and the percentages are wrong") @@ -538,14 +538,17 @@ (prog1 \\interruptable (setq \\interruptable flag)))) ) -(RPAQ? LISPINTERRUPTS - '((LISPINTERRUPTS (2 BREAK MOUSE) - (4 RESET MOUSE) - (5 ERROR MOUSE) - (7 HELP T) - (16 PRINTLEVEL) - (20 (CONTROL-T)) - (127 RUBOUT T)))) +(RPAQ? LISPINTERRUPTS '((LISPINTERRUPTS (2 BREAK MOUSE) + (4 RESET MOUSE) + (5 ERROR MOUSE) + (7 HELP T) + (16 PRINTLEVEL) + (20 (CONTROL-T))))) + + + +(* \; "RMK2025: Removed (127 RUBOUT T)") + (DECLARE\: DOEVAL@COMPILE DONTCOPY (GLOBALVARS LISPINTERRUPTS) @@ -803,10 +806,10 @@ DONTCOPY (INTCHAR T) ) (DECLARE\: DONTCOPY - (FILEMAP (NIL (2924 29142 (INTCHAR 2934 . 7957) (INTERRUPTCHAR 7959 . 8233) (INTERRUPTED 8235 . 15814) - (LISPINTERRUPTS 15816 . 16343) (\\DOHELPINTERRUPT 16345 . 17243) (\\DOHELPINTERRUPT1 17245 . 18643) ( -\\DOINTERRUPTHERE 18645 . 19825) (\\PROC.FINDREALFRAME 19827 . 20631) (\\SETPRINTLEVEL 20633 . 22585) -(\\SETRECLAIMMIN 22587 . 23460) (GETINTERRUPT 23462 . 24818) (CURRENTINTERRUPTS 24820 . 25030) ( -SETINTERRUPT 25032 . 27010) (RESET.INTERRUPTS 27012 . 28969) (INTERRUPTABLE 28971 . 29140)) (29562 -35546 (CONTROL-T 29572 . 35013) (\\CONTROL-T.PRINTRATIO 35015 . 35544))))) + (FILEMAP (NIL (2939 29157 (INTCHAR 2949 . 7972) (INTERRUPTCHAR 7974 . 8248) (INTERRUPTED 8250 . 15829) + (LISPINTERRUPTS 15831 . 16358) (\\DOHELPINTERRUPT 16360 . 17258) (\\DOHELPINTERRUPT1 17260 . 18658) ( +\\DOINTERRUPTHERE 18660 . 19840) (\\PROC.FINDREALFRAME 19842 . 20646) (\\SETPRINTLEVEL 20648 . 22600) +(\\SETRECLAIMMIN 22602 . 23475) (GETINTERRUPT 23477 . 24833) (CURRENTINTERRUPTS 24835 . 25045) ( +SETINTERRUPT 25047 . 27025) (RESET.INTERRUPTS 27027 . 28984) (INTERRUPTABLE 28986 . 29155)) (29664 +35648 (CONTROL-T 29674 . 35115) (\\CONTROL-T.PRINTRATIO 35117 . 35646))))) STOP diff --git a/sources/AINTERRUPT.LCOM b/sources/AINTERRUPT.LCOM index 49635ec4..0f244ef7 100644 Binary files a/sources/AINTERRUPT.LCOM and b/sources/AINTERRUPT.LCOM differ diff --git a/sources/AOFD b/sources/AOFD index 411e85aa..0493ebb5 100644 --- a/sources/AOFD +++ b/sources/AOFD @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "17-May-2023 08:29:55" {DSK}larry>il>medley>sources>AOFD.;5 36263 +(FILECREATED "24-Apr-2025 21:46:04" {WMEDLEY}AOFD.;10 36381 - :EDIT-BY "lmm" + :EDIT-BY rmk - :PREVIOUS-DATE "17-May-2023 08:05:56" {DSK}larry>il>medley>sources>AOFD.;4) + :CHANGES-TO (FNS MAKE-STRING-FORMAT) + + :PREVIOUS-DATE "17-May-2023 08:29:55" {WMEDLEY}AOFD.;9) (PRETTYCOMPRINT AOFDCOMS) @@ -558,9 +560,10 @@ STREAM]) (MAKE-STRING-FORMAT - [LAMBDA NIL (* ; "Edited 8-Aug-2021 00:10 by rmk:") + [LAMBDA NIL (* ; "Edited 24-Apr-2025 21:45 by rmk") + (* ; "Edited 8-Aug-2021 00:10 by rmk:") - (* ;; "We are looking at an in-core string, we know that EOL is CR, that the characters have the internal (XCCS) encoding, and that the string is fat. ") + (* ;; "We are looking at an in-core string, we know that EOL is CR, that the characters have the internal (MCCS) encoding, and that the string is fat. ") (MAKE-EXTERNALFORMAT :STRING [FUNCTION (LAMBDA (STRM COUNTP) (DECLARE (USEDFREE *BYTECOUNTER*)) @@ -761,15 +764,15 @@ (ADDTOVAR LAMA WHENCLOSE) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2363 3482 (\ADD-OPEN-STREAM 2373 . 2654) (\GENERIC-UNREGISTER-STREAM 2656 . 3480)) ( -3523 10587 (CLOSEALL 3533 . 4011) (CLOSEF 4013 . 5227) (EOFCLOSEF 5229 . 5529) (INPUT 5531 . 6301) ( -OPENP 6303 . 6706) (OUTPUT 6708 . 7480) (POSITION 7482 . 8290) (RANDACCESSP 8292 . 8682) (\IOMODEP -8684 . 9313) (WHENCLOSE 9315 . 10585)) (10588 10710 (STREAMADDPROP 10598 . 10708)) (11668 24521 ( -\BASEBYTES.IO.INIT 11678 . 14878) (\MAKEBASEBYTESTREAM 14880 . 17808) (\MBS.OUTCHARFN 17810 . 18210) ( -\BASEBYTES.NAME.FROM.STREAM 18212 . 18671) (\BASEBYTES.BOUT 18673 . 19427) (\BASEBYTES.SETFILEPTR -19429 . 20050) (\BASEBYTES.READP 20052 . 20696) (\BASEBYTES.BIN 20698 . 21205) (\BASEBYTES.PEEKBIN -21207 . 22037) (\BASEBYTES.TRUNCATEFN 22039 . 22547) (\BASEBYTES.OPENFN 22549 . 23343) ( -\BASEBYTES.BLOCKIO 23345 . 24519)) (24644 27948 (OPENSTRINGSTREAM 24654 . 26363) (MAKE-STRING-FORMAT -26365 . 27946)) (28220 32528 (\STRINGSTREAM.INIT 28230 . 32526)) (32605 35305 (GETSTREAM 32615 . 32846 -) (\CLEAROFD 32848 . 33141) (\GETSTREAM 33143 . 35303))))) + (FILEMAP (NIL (2372 3491 (\ADD-OPEN-STREAM 2382 . 2663) (\GENERIC-UNREGISTER-STREAM 2665 . 3489)) ( +3532 10596 (CLOSEALL 3542 . 4020) (CLOSEF 4022 . 5236) (EOFCLOSEF 5238 . 5538) (INPUT 5540 . 6310) ( +OPENP 6312 . 6715) (OUTPUT 6717 . 7489) (POSITION 7491 . 8299) (RANDACCESSP 8301 . 8691) (\IOMODEP +8693 . 9322) (WHENCLOSE 9324 . 10594)) (10597 10719 (STREAMADDPROP 10607 . 10717)) (11677 24530 ( +\BASEBYTES.IO.INIT 11687 . 14887) (\MAKEBASEBYTESTREAM 14889 . 17817) (\MBS.OUTCHARFN 17819 . 18219) ( +\BASEBYTES.NAME.FROM.STREAM 18221 . 18680) (\BASEBYTES.BOUT 18682 . 19436) (\BASEBYTES.SETFILEPTR +19438 . 20059) (\BASEBYTES.READP 20061 . 20705) (\BASEBYTES.BIN 20707 . 21214) (\BASEBYTES.PEEKBIN +21216 . 22046) (\BASEBYTES.TRUNCATEFN 22048 . 22556) (\BASEBYTES.OPENFN 22558 . 23352) ( +\BASEBYTES.BLOCKIO 23354 . 24528)) (24653 28066 (OPENSTRINGSTREAM 24663 . 26372) (MAKE-STRING-FORMAT +26374 . 28064)) (28338 32646 (\STRINGSTREAM.INIT 28348 . 32644)) (32723 35423 (GETSTREAM 32733 . 32964 +) (\CLEAROFD 32966 . 33259) (\GETSTREAM 33261 . 35421))))) STOP diff --git a/sources/AOFD.LCOM b/sources/AOFD.LCOM index 52305183..d6269a08 100644 Binary files a/sources/AOFD.LCOM and b/sources/AOFD.LCOM differ diff --git a/sources/ATBL b/sources/ATBL index a3dc9fc0..b8edac7d 100644 --- a/sources/ATBL +++ b/sources/ATBL @@ -1,16 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "26-Dec-2021 14:32:50" {DSK}kaplan>Local>medley3.5>my-medley>sources>ATBL.;32 91860 +(FILECREATED "24-Apr-2025 21:52:35" {WMEDLEY}ATBL.;33 91754 - :CHANGES-TO (FNS MAKE-READER-ENVIRONMENT) + :EDIT-BY rmk - :PREVIOUS-DATE "19-Dec-2021 14:09:43" -{DSK}kaplan>Local>medley3.5>my-medley>sources>ATBL.;31) + :CHANGES-TO (FNS \ATBLSET EQUAL-READER-ENVIRONMENT) + :PREVIOUS-DATE "26-Dec-2021 14:32:50" {WMEDLEY}ATBL.;32) -(* ; " -Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. -") (PRETTYCOMPRINT ATBLCOMS) @@ -1733,26 +1730,27 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (DEFINEQ (\ATBLSET - [LAMBDA NIL (* ; "Edited 28-Jun-2021 09:29 by rmk:") - (* ; "Edited 3-Dec-86 18:07 by Pavel") + [LAMBDA NIL (* ; "Edited 24-Apr-2025 21:51 by rmk") + (* ; "Edited 28-Jun-2021 09:29 by rmk:") + (* ; "Edited 3-Dec-86 18:07 by Pavel") (DECLARE (GLOBALVARS \ORIGREADTABLE \ORIGTERMTABLE)) (COND ((NULL (BOUNDP '\PRIMREADTABLE)) (initrecord CHARTABLE) - (* ;; "Read tables") + (* ;; "Read tables") - (* ;; "RMK: If reloading, don't smash an existing hash table") + (* ;; "RMK: If reloading, don't smash an existing hash table") [OR (HARRAYP \READTABLEHASH) (SETQ \READTABLEHASH (HASHARRAY 20 NIL (FUNCTION STRING-EQUAL-HASHBITS) (FUNCTION STRING-EQUAL] (LET (TRDTBL NEW-IL-RDTBL) - (PROGN (* ; "The ORIG read table") + (PROGN (* ; "The ORIG read table") (SETQ \ORIGREADTABLE (\ORIGREADTABLE)) (READTABLEPROP \ORIGREADTABLE 'NAME 'ORIG)) - (PROGN (* ; - "The old Interlisp T read table. May not have a use for this any more") + (PROGN (* ; + "The old Interlisp T read table. May not have a use for this any more") (SETQ TRDTBL (COPYREADTABLE \ORIGREADTABLE)) (SETSYNTAX (CHARCODE "|") '(MACRO READVBAR) @@ -1767,9 +1765,9 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. '(MACRO FIRST READQUOTE) TRDTBL) (READTABLEPROP TRDTBL 'NAME "OLD-INTERLISP-T") - (PROGN (* ; "Temporary") + (PROGN (* ; "Temporary") (SETTOPVAL '%#CURRENTRDTBL# TRDTBL))) - (PROGN (* ; "The old FILERDTBL") + (PROGN (* ; "The old FILERDTBL") (SETQ FILERDTBL (COPYREADTABLE \ORIGREADTABLE)) (SETSYNTAX (CHARCODE "|") TRDTBL FILERDTBL) @@ -1778,12 +1776,12 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (create READER-ENVIRONMENT REREADTABLE _ FILERDTBL REBASE _ 10 - REFORMAT _ :XCCS)) (* ; - "need this to read files in the loadup") + REFORMAT _ :MCCS)) (* ; + "need this to read files in the loadup") ) (PROGN (SETQ NEW-IL-RDTBL (COPYREADTABLE TRDTBL)) - (* ; - "The new Interlisp read table is more common lispy") + (* ; + "The new Interlisp read table is more common lispy") (READTABLEPROP NEW-IL-RDTBL 'MULTIPLE-ESCAPECHAR (CHARCODE "|")) (READTABLEPROP NEW-IL-RDTBL 'HASHMACROCHAR (CHARCODE "#")) (SET-DEFAULT-HASHMACRO-SETTINGS NEW-IL-RDTBL) @@ -1791,11 +1789,11 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (READTABLEPROP NEW-IL-RDTBL 'USESILPACKAGE NIL) (READTABLEPROP NEW-IL-RDTBL 'NAME "INTERLISP") (for I from 1 to 26 do (SETSYNTAX I 'SEPRCHAR FILERDTBL) - (* ; "Make font switch chars seprs") - (SETSYNTAX I 'SEPRCHAR NEW-IL-RDTBL)) + (* ; "Make font switch chars seprs") + (SETSYNTAX I 'SEPRCHAR NEW-IL-RDTBL)) (SETQ *READTABLE* NEW-IL-RDTBL)) - (* ;; "Make ^Y like #. in the old T readtable and the new INTERLISP one.") + (* ;; "Make ^Y like #. in the old T readtable and the new INTERLISP one.") (SETSYNTAX (CHARCODE ^Y) '[MACRO ALWAYS (LAMBDA (FILE RDTBL) @@ -1805,7 +1803,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. TRDTBL NEW-IL-RDTBL) (DEFPRINT 'READTABLEP '\READTABLEP.DEFPRINT)) - (* ;; "Terminal tables") + (* ;; "Terminal tables") (SETQ \ORIGTERMTABLE (\ORIGTERMTABLE)) (SETQ \PRIMTERMTABLE (COPYTERMTABLE \ORIGTERMTABLE)) @@ -1868,7 +1866,9 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (EQUAL-READER-ENVIRONMENT [LAMBDA (ENV1 ENV2) - (* ;; "Edited 19-Dec-2021 14:09 by rmk: Replace constant :XCCS with *DEFAULT-EXTERNALFORMAT*") + (* ;; "Edited 24-Apr-2025 21:52 by rmk") + + (* ;; "Edited 19-Dec-2021 14:09 by rmk: Use *DEFAULT-EXTERNALFORMAT*") (* ;; "Edited 19-Dec-2021 14:01 by rmk") @@ -1921,25 +1921,23 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (ADDTOVAR LAMA READTABLEPROP) ) -(PUTPROPS ATBL COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1993 2018 -2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (17749 28901 (GETSYNTAX 17759 . 22590) (SETSYNTAX 22592 . 23665) (SYNTAXP 23667 . 26164) - (\COPYSYNTAX 26166 . 26883) (\GETCHARCODE 26885 . 27173) (\SETFATSYNCODE 27175 . 28466) ( -\MAPCHARTABLE 28468 . 28899)) (28934 43900 (CONTROL 28944 . 29196) (COPYTERMTABLE 29198 . 29565) ( -DELETECONTROL 29567 . 32208) (GETDELETECONTROL 32210 . 33172) (ECHOCHAR 33174 . 34615) (ECHOCONTROL -34617 . 35074) (ECHOMODE 35076 . 35322) (GETECHOMODE 35324 . 35488) (GETCONTROL 35490 . 35656) ( -GETTERMTABLE 35658 . 35725) (RAISE 35727 . 36153) (GETRAISE 36155 . 36317) (RESETTERMTABLE 36319 . -37403) (SETTERMTABLE 37405 . 37639) (TERMTABLEP 37641 . 37802) (\GETTERMSYNTAX 37804 . 38075) ( -\GTTERMTABLE 38077 . 38413) (\ORIGTERMTABLE 38415 . 42025) (\SETTERMSYNTAX 42027 . 42662) ( -\TERMCLASSTOCODE 42664 . 43093) (\TERMCODETOCLASS 43095 . 43482) (\LITCHECK 43484 . 43898)) (46411 -70235 (COPYREADTABLE 46421 . 46619) (FIND-READTABLE 46621 . 46768) (IN-READTABLE 46770 . 46930) ( -ESCAPE 46932 . 47185) (GETBRK 47187 . 47325) (GETREADTABLE 47327 . 47463) (GETSEPR 47465 . 47603) ( -READMACROS 47605 . 47868) (READTABLEP 47870 . 48033) (READTABLEPROP 48035 . 53193) (RESETREADTABLE -53195 . 57442) (SETBRK 57444 . 59054) (SETREADTABLE 59056 . 59244) (SETSEPR 59246 . 60788) ( -\GETREADSYNTAX 60790 . 63480) (\GTREADTABLE 63482 . 63707) (\GTREADTABLE1 63709 . 63965) ( -\ORIGREADTABLE 63967 . 65875) (\READCLASSTOCODE 65877 . 66328) (\SETMACROSYNTAX 66330 . 68125) ( -\SETREADSYNTAX 68127 . 69188) (\READTABLEP.DEFPRINT 69190 . 70233)) (83067 87520 (\ATBLSET 83077 . -87518)) (87967 91384 (MAKE-READER-ENVIRONMENT 87977 . 89634) (EQUAL-READER-ENVIRONMENT 89636 . 90786) -(SET-READER-ENVIRONMENT 90788 . 91382))))) + (FILEMAP (NIL (17619 28771 (GETSYNTAX 17629 . 22460) (SETSYNTAX 22462 . 23535) (SYNTAXP 23537 . 26034) + (\COPYSYNTAX 26036 . 26753) (\GETCHARCODE 26755 . 27043) (\SETFATSYNCODE 27045 . 28336) ( +\MAPCHARTABLE 28338 . 28769)) (28804 43770 (CONTROL 28814 . 29066) (COPYTERMTABLE 29068 . 29435) ( +DELETECONTROL 29437 . 32078) (GETDELETECONTROL 32080 . 33042) (ECHOCHAR 33044 . 34485) (ECHOCONTROL +34487 . 34944) (ECHOMODE 34946 . 35192) (GETECHOMODE 35194 . 35358) (GETCONTROL 35360 . 35526) ( +GETTERMTABLE 35528 . 35595) (RAISE 35597 . 36023) (GETRAISE 36025 . 36187) (RESETTERMTABLE 36189 . +37273) (SETTERMTABLE 37275 . 37509) (TERMTABLEP 37511 . 37672) (\GETTERMSYNTAX 37674 . 37945) ( +\GTTERMTABLE 37947 . 38283) (\ORIGTERMTABLE 38285 . 41895) (\SETTERMSYNTAX 41897 . 42532) ( +\TERMCLASSTOCODE 42534 . 42963) (\TERMCODETOCLASS 42965 . 43352) (\LITCHECK 43354 . 43768)) (46281 +70105 (COPYREADTABLE 46291 . 46489) (FIND-READTABLE 46491 . 46638) (IN-READTABLE 46640 . 46800) ( +ESCAPE 46802 . 47055) (GETBRK 47057 . 47195) (GETREADTABLE 47197 . 47333) (GETSEPR 47335 . 47473) ( +READMACROS 47475 . 47738) (READTABLEP 47740 . 47903) (READTABLEPROP 47905 . 53063) (RESETREADTABLE +53065 . 57312) (SETBRK 57314 . 58924) (SETREADTABLE 58926 . 59114) (SETSEPR 59116 . 60658) ( +\GETREADSYNTAX 60660 . 63350) (\GTREADTABLE 63352 . 63577) (\GTREADTABLE1 63579 . 63835) ( +\ORIGREADTABLE 63837 . 65745) (\READCLASSTOCODE 65747 . 66198) (\SETMACROSYNTAX 66200 . 67995) ( +\SETREADSYNTAX 67997 . 69058) (\READTABLEP.DEFPRINT 69060 . 70103)) (82937 87494 (\ATBLSET 82947 . +87492)) (87941 91385 (MAKE-READER-ENVIRONMENT 87951 . 89608) (EQUAL-READER-ENVIRONMENT 89610 . 90787) +(SET-READER-ENVIRONMENT 90789 . 91383))))) STOP diff --git a/sources/ATBL.LCOM b/sources/ATBL.LCOM index 49a09944..0ca35895 100644 Binary files a/sources/ATBL.LCOM and b/sources/ATBL.LCOM differ diff --git a/sources/ATERM.LCOM b/sources/ATERM.LCOM index ca077bac..c4e8dec5 100644 Binary files a/sources/ATERM.LCOM and b/sources/ATERM.LCOM differ diff --git a/sources/DIRECTORY b/sources/DIRECTORY index b5067edf..7bb1bf2e 100644 --- a/sources/DIRECTORY +++ b/sources/DIRECTORY @@ -1,16 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "29-Mar-2022 10:53:16" {DSK}kaplan>Local>medley3.5>my-medley>sources>DIRECTORY.;15 28665 +(FILECREATED " 6-Nov-2025 00:13:55" {WMEDLEY}DIRECTORY.;17 28439 - :CHANGES-TO (FNS DIRECTORY) + :EDIT-BY rmk - :PREVIOUS-DATE "29-Mar-2022 08:29:33" -{DSK}kaplan>Local>medley3.5>my-medley>sources>DIRECTORY.;14) + :CHANGES-TO (VARS DIRCOMMANDS) + :PREVIOUS-DATE "22-Oct-2025 22:07:27" {WMEDLEY}DIRECTORY.;16) -(* ; " -Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation. -") (PRETTYCOMPRINT DIRECTORYCOMS) @@ -419,7 +416,7 @@ Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation. DELETE (DELETE? PROMPT " delete? " DELETE) DELETED - (LE LENGTH "(" BYTESIZE ")") + (LE . LENGTH) NEWERTHAN OLDVERSIONS (OLD OLDERTHAN 90) OLDERTHAN (OU . OUT) @@ -463,12 +460,11 @@ Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation. (GLOBALVARS DIRCOMMANDS ASKUSERTTBL FILEINFOTYPES) ) ) -(PUTPROPS DIRECTORY COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1992)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1325 27144 (DODIR 1335 . 1882) (FILDIR 1884 . 2164) (DIRECTORY 2166 . 12883) ( -DIRECTORY.PARSE 12885 . 14179) (DIRECTORY.FILL.PATTERN 14181 . 14711) (DIRCONJ 14713 . 14933) ( -DIRECTORY.NEXTFILE 14935 . 15528) (DMATCH 15530 . 15905) (DIRECTORY.MATCH.SETUP 15907 . 16441) ( -DIRECTORY.MATCH 16443 . 16860) (DIRECTORY.MATCH1 16862 . 18975) (DODIRCOMMANDS 18977 . 24447) ( -DIRPRINTNAME 24449 . 25865) (DPRIN1 25867 . 25952) (DIRFILENAME 25954 . 26675) (DIRGETFILEINFO 26677 - . 26829) (DREAD 26831 . 27142))))) + (FILEMAP (NIL (1200 27019 (DODIR 1210 . 1757) (FILDIR 1759 . 2039) (DIRECTORY 2041 . 12758) ( +DIRECTORY.PARSE 12760 . 14054) (DIRECTORY.FILL.PATTERN 14056 . 14586) (DIRCONJ 14588 . 14808) ( +DIRECTORY.NEXTFILE 14810 . 15403) (DMATCH 15405 . 15780) (DIRECTORY.MATCH.SETUP 15782 . 16316) ( +DIRECTORY.MATCH 16318 . 16735) (DIRECTORY.MATCH1 16737 . 18850) (DODIRCOMMANDS 18852 . 24322) ( +DIRPRINTNAME 24324 . 25740) (DPRIN1 25742 . 25827) (DIRFILENAME 25829 . 26550) (DIRGETFILEINFO 26552 + . 26704) (DREAD 26706 . 27017))))) STOP diff --git a/sources/DIRECTORY.LCOM b/sources/DIRECTORY.LCOM index 0348d4da..579f3e1b 100644 Binary files a/sources/DIRECTORY.LCOM and b/sources/DIRECTORY.LCOM differ diff --git a/sources/FONT b/sources/FONT index d3db7f6f..ab26c93f 100644 --- a/sources/FONT +++ b/sources/FONT @@ -1,14 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Oct-2025 17:51:13" {WMEDLEY}FONT.;617 284869 +(FILECREATED " 8-Dec-2025 22:19:01" {WMEDLEY}FONT.;645 281352 :EDIT-BY rmk - :CHANGES-TO (FNS \CREATECHARSET.DISPLAY COMPLETE.FONT \COERCECHARSET) - (MACROS LEGACYFONTS LEGACYFONT) - (VARS FONTCOMS) + :CHANGES-TO (MACROS SPREADFONTSPEC) - :PREVIOUS-DATE " 7-Oct-2025 12:43:05" {WMEDLEY}FONT.;614) + :PREVIOUS-DATE " 4-Dec-2025 09:46:06" {WMEDLEY}FONT.;644) (PRETTYCOMPRINT FONTCOMS) @@ -17,27 +15,24 @@ [ (* ;; "font functions ") - (DECLARE%: EVAL@COMPILE DONTCOPY (* ; - "Can't be loaded/not needed during INIT, load at end of LOAD-LISP.") - (FILES (SYSLOAD) - MULTI-ALIST)) (FNS CHARWIDTH CHARWIDTHY STRINGWIDTH \CHARWIDTH.DISPLAY \STRINGWIDTH.DISPLAY \STRINGWIDTH.GENERIC) (COMS (FNS DEFAULTFONT FONTCLASS FONTCLASSUNPARSE FONTCLASSCOMPONENT SETFONTCLASSCOMPONENT GETFONTCLASSCOMPONENT) (MACROS \GETFONTCLASSCOMPONENT \SETFONTCLASSCOMPONENT)) (VARS NSFONTFAMILIES ALTOFONTFAMILIES) + (INITVARS MCCSFONTFAMILIES) (COMS (* ;; "Creation: ") - (FNS FONTCREATE FONTCREATE1 FONTCREATE.SLUGFD \FONT.CHECKARGS \FONT.CHECKARGS1 - \FONTCREATE1.NOFN FONTFILEP \READCHARSET) + (FNS FONTCREATE FONTCREATE1 FONTCREATE.SLUGFD \FONT.CHECKARGS1 \FONTCREATE1.NOFN + FONTFILEP \READCHARSET) (FNS \FONT.CHECKARGS \CHARSET.CHECK) (FNS COERCEFONTSPEC) (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS COERCEFONTSPEC.MATCH COERCEFONTSPEC.TARGET)) (MACROS SPREADFONTSPEC) (FNS MAKEFONTSPEC) - (FNS COMPLETE.FONT COMPLETEFONTP COMPLETE.CHARSET PRUNESLUGCSINFOS)) + (FNS COMPLETE.FONT COMPLETEFONTP COMPLETE.CHARSET PRUNESLUGCSINFOS MONOSPACEFONTP)) (COMS (* ;; "Property extraction:") @@ -64,15 +59,20 @@ (FNS FONTCOPY FONTP FONTUNPARSE SETFONTDESCRIPTOR \STREAMCHARWIDTH \COERCECHARSET \BUILDSLUGCSINFO \FONTSYMBOL \DEVICESYMBOL \FONTFACE \FONTFACE.COLOR SETFONTCHARENCODING ) - (FNS FONTSAVAILABLE FONTEXISTS? \SEARCHFONTFILES FLUSHFONTSINCORE FINDFONTFILES SORTFONTSPECS - ) + (FNS FONTSAVAILABLE FONTEXISTS? \SEARCHFONTFILES FLUSHFONTCACHE FLUSHFONTSINCORE + FINDFONTFILES SORTFONTSPECS) (FNS MATCHFONTFACE MAKEFONTFACE FONTFACETOATOM) - (INITVARS \FONTSINCORE \FONTEXISTS?-CACHE \DEFAULTDEVICEFONTS) + (INITVARS \FONTSINCORE \FONTEXISTS?-CACHE \FONTSAVAILABLEFILECACHE \DEFAULTDEVICEFONTS) + + (* ;; "The INITVARS value of MEDLEY-INIT-VARS in MEDLEY dalso includes these entries. That's because FONT is in the INIT, so these entries would be lost when MEDLEY-INIT-VARS is reinitialized when the Lisp loadup starts") + + (ADDVARS (MEDLEY-INIT-VARS (\FONTEXISTS?-CACHE NIL RESET) + (\FONTSAVAILABLEFILECACHE NIL RESET))) [COMS (GLOBALVARS \DEFAULTDEVICEFONTS \UNITWIDTHSVECTOR) (INITVARS \UNITWIDTHSVECTOR) (FNS \UNITWIDTHSVECTOR) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\UNITWIDTHSVECTOR] - (DECLARE%: DONTCOPY (EXPORT (RECORDS FONTCLASS FONTDESCRIPTOR FONTFACE CHARSETINFO FONTSPEC) + (DECLARE%: DONTCOPY [EXPORT (RECORDS FONTCLASS FONTDESCRIPTOR FONTFACE CHARSETINFO FONTSPEC) (MACROS FONTASCENT FONTDESCENT FONTHEIGHT \FGETOFFSET \FSETOFFSET \FGETWIDTH \FSETWIDTH \FGETCHARWIDTH \FSETCHARWIDTH \FGETIMAGEWIDTH \FSETIMAGEWIDTH) @@ -80,8 +80,7 @@ \CREATECSINFOELEMENT \CREATEFONTCHARSETVECTOR CHARSETPROP) (PROP ARGNAMES CHARSETPROP) (CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR)) - (SLUGCHARSET (ADD1 \MAXCHARSET))) - (MACROS LEGACYFONTS)) + (SLUGCHARSET (ADD1 \MAXCHARSET] (MACROS INDIRECTCHARSETP)) (FNS FONTDESCRIPTOR.DEFPRINT FONTCLASS.DEFPRINT) (INITRECORDS FONTCLASS FONTDESCRIPTOR CHARSETINFO) @@ -157,7 +156,7 @@ (PALATINO CLASSIC) (OPTIMA MODERN) (BOLDPS CLASSIC) - (PCTERMINAL) + (PCTERMINAL CLASSIC) (TITANLEGAL CLASSIC] (\DEFAULTCHARSET 0)) @@ -211,11 +210,6 @@ (* ;; "font functions ") -(DECLARE%: EVAL@COMPILE DONTCOPY - -(FILESLOAD (SYSLOAD) - MULTI-ALIST) -) (DEFINEQ (CHARWIDTH @@ -506,6 +500,8 @@ (RPAQQ ALTOFONTFAMILIES (TIMESROMAN TIMESROMAND HELVETICA HELVETICAD CLARITY BRAVOX TONTO CREAM OLDENGLISH)) +(RPAQ? MCCSFONTFAMILIES NIL) + (* ;; "Creation: ") @@ -621,111 +617,6 @@ else (for CS from 0 to (ADD1 \MAXCHARSET) do (\SETCHARSETINFO FONTDESC CS SLUGCSINFO))) FONTDESC]) -(\FONT.CHECKARGS - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 28-Aug-2025 14:46 by rmk") - (* ; "Edited 23-Aug-2025 11:54 by rmk") - (* ; "Edited 17-Aug-2025 19:15 by rmk") - (* ; "Edited 12-Aug-2025 22:36 by rmk") - (* ; "Edited 10-Aug-2025 12:06 by rmk") - (* ; "Edited 8-Aug-2025 09:57 by rmk") - (* ; "Edited 27-Jul-2025 13:30 by rmk") - (* ; "Edited 22-Jul-2025 23:07 by rmk") - (* ; "Edited 21-Jul-2025 09:22 by rmk") - (* ; "Edited 14-Jul-2025 20:09 by rmk") - (* ; "Edited 11-Jul-2025 10:15 by rmk") - (* ; "Edited 5-Jul-2025 13:37 by rmk") - (* ; "Edited 2-Jul-2025 16:50 by rmk") - (* ; "Edited 27-Jun-2025 10:42 by rmk") - (* ; "Edited 15-Jun-2025 00:25 by rmk") - - (* ;; "DON'T BREAK, TRACE, OR UNSAVE THIS UNLESS ALL SYSTEM FONTS HAVE ALREADY BEEN INSTANTIATED") - - (* ;; "Decodes and checks the various ways of specifying the arguments to font lookup functions.") - - (* ;; "If FAMILY can be coerced to a font descriptor and none of its properties are overwritten by the other aguments, then that font descriptor is returned. Otherwise the value is the coerced fontspec (family size face rotation device).") - - (LET (FONTX) - (CL:WHEN (AND (EQ 'CLASS (CAR (LISTP FAMILY))) - (LITATOM (CADR FAMILY))) - - (* ;; "This used to be at the entry to FONTCREATE, and it returned the FONTCLASS. That seemed wrong--FONTCREATE should always return a fontdescriptor. So here we build a throwaway fontclass, coerce it to its device font, and fall through.") - - (SETQ FAMILY (\FONT.CHECKARGS1 (FONTCLASS (CADR FAMILY) - (CDDR FAMILY)) - DEVICE))) - (CL:UNLESS (AND FAMILY (LITATOM FAMILY) - (NEQ FAMILY T)) - - (* ;; "FAMILY T or NIL produces an error below") - - [if (LISTP FAMILY) - then - (* ;; "Presumably a FONTSPEC. The variables here override the FONTX properties, as with the fontdescriptor below ") - - (SETQ FONTX (CL:IF (EQ 'FONT (CAR FAMILY)) - (CDR FAMILY) - FAMILY)) - (SETQ FAMILY (fetch (FONTSPEC FSFAMILY) of FONTX)) - (SETQ SIZE (OR SIZE (fetch (FONTSPEC FSSIZE) of FONTX))) - (SETQ FACE (OR FACE (fetch (FONTSPEC FSFACE) of FONTX))) - (SETQ ROTATION (OR ROTATION (fetch (FONTSPEC FSROTATION) of FONTX))) - (SETQ DEVICE (OR DEVICE (fetch (FONTSPEC FSDEVICE) of FONTX))) - (SETQ FONTX NIL) - elseif (SETQ FONTX (CL:IF (type? FONTDESCRIPTOR FAMILY) - FAMILY - (\FONT.CHECKARGS1 FAMILY DEVICE T))) - then - (* ;; - "FAMILY was a spec for a font descriptor. Are any of its properties overwritten?") - - (SETQ FAMILY (fetch (FONTDESCRIPTOR FONTFAMILY) of FONTX)) - (CL:UNLESS SIZE - (SETQ SIZE (fetch (FONTDESCRIPTOR FONTSIZE) of FONTX))) - (CL:UNLESS FACE - (SETQ FACE (fetch (FONTDESCRIPTOR FONTFACE) of FONTX))) - (CL:UNLESS ROTATION - (SETQ ROTATION (fetch (FONTDESCRIPTOR ROTATION) of FONTX))) - (CL:UNLESS DEVICE - (SETQ DEVICE (fetch (FONTDESCRIPTOR FONTDEVICE) of FONTX)))]) - - (* ;; "We have decoded the arguments, fill in defaults and validate") - - (SETQ DEVICE (if (NULL DEVICE) - then 'DISPLAY - elseif (OR (AND (LITATOM DEVICE) - (NEQ DEVICE T)) - (STRINGP DEVICE)) - then (\DEVICESYMBOL DEVICE) - elseif [AND (SETQ DEVICE (\GETSTREAM DEVICE 'OUTPUT T)) - (CAR (MKLIST (IMAGESTREAMTYPE DEVICE] - else (\ILLEGAL.ARG DEVICE))) - (CL:UNLESS (AND FAMILY (LITATOM FAMILY) - (NEQ FAMILY T)) - (ERROR "Illegal font family" FAMILY)) - (SETQ FAMILY (U-CASE FAMILY)) - (CL:UNLESS (OR (AND (FIXP SIZE) - (IGREATERP SIZE 0)) - (EQ SIZE '*)) - (ERROR "Illegal font size" SIZE)) - (CL:UNLESS (EQ FACE '*) - (SETQ FACE (\FONTFACE FACE NIL DEVICE))) - (if (NULL ROTATION) - then (SETQ ROTATION 0) - elseif (AND (FIXP ROTATION) - (IGEQ ROTATION 0)) - elseif (EQ ROTATION '*) - else (\ILLEGAL.ARG ROTATION)) - (CL:WHEN FONTX - - (* ;; "Return FONTX only if no fields were overwritten") - - (CL:UNLESS (AND (EQ SIZE (fetch (FONTDESCRIPTOR FONTSIZE) of FONTX)) - (EQUAL FACE (fetch (FONTDESCRIPTOR FONTFACE) of FONTX)) - (EQ ROTATION (fetch (FONTDESCRIPTOR ROTATION) of FONTX)) - (EQ DEVICE (fetch (FONTDESCRIPTOR FONTDEVICE) of FONTX))) - (SETQ FONTX NIL))) - (OR FONTX (MAKEFONTSPEC FAMILY SIZE FACE ROTATION DEVICE]) - (\FONT.CHECKARGS1 [LAMBDA (SPEC STREAM NOERRORFLG) (* ; "Edited 22-Jul-2025 18:47 by rmk") (* ; "Edited 14-Jul-2025 19:40 by rmk") @@ -822,7 +713,8 @@ (CLOSEF? STRM))))]) (\READCHARSET - [LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 2-Sep-2025 23:57 by rmk") + [LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 11-Nov-2025 14:30 by rmk") + (* ; "Edited 2-Sep-2025 23:57 by rmk") (* ; "Edited 28-Aug-2025 23:17 by rmk") (* ; "Edited 25-Aug-2025 12:03 by rmk") (* ; "Edited 16-Aug-2025 18:00 by rmk") @@ -856,17 +748,15 @@ (* ;; "The file didn't know its own encoding") (SETQ FAMILY (fetch (FONTSPEC FSFAMILY) of FONTSPEC)) - (CHARSETPROP CSINFO 'CSCHARENCODING (if (NEQ CHARSET 0) - then 'MCCS - elseif (MEMB FAMILY - NSFONTFAMILIES - ) - then 'XCCS$ - elseif (MEMB FAMILY - ALTOFONTFAMILIES - ) - then 'ALTOTEXT - else FAMILY))) + (CHARSETPROP CSINFO 'CSCHARENCODING + (if (OR (NEQ CHARSET 0) + (MEMB FAMILY MCCSFONTFAMILIES)) + then 'MCCS + elseif (MEMB FAMILY NSFONTFAMILIES) + then 'XCCS$ + elseif (MEMB FAMILY ALTOFONTFAMILIES) + then 'ALTOTEXT + else FAMILY))) (* ;; "Remember the file that this basic charset information came from, before any character coercions, for informational purposes. Path and version won't be valid if sysout moves, or if PSEUDOFILENAME's aren't aligned. Don't want files to be new atoms, for loadup.") @@ -884,7 +774,8 @@ (DEFINEQ (\FONT.CHECKARGS - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 28-Aug-2025 14:46 by rmk") + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE ALWAYSFONTSPEC) (* ; "Edited 22-Nov-2025 11:31 by rmk") + (* ; "Edited 28-Aug-2025 14:46 by rmk") (* ; "Edited 23-Aug-2025 11:54 by rmk") (* ; "Edited 17-Aug-2025 19:15 by rmk") (* ; "Edited 12-Aug-2025 22:36 by rmk") @@ -981,7 +872,8 @@ (* ;; "Return FONTX only if no fields were overwritten") - (CL:UNLESS (AND (EQ SIZE (fetch (FONTDESCRIPTOR FONTSIZE) of FONTX)) + (CL:UNLESS (AND (NOT ALWAYSFONTSPEC) + (EQ SIZE (fetch (FONTDESCRIPTOR FONTSIZE) of FONTX)) (EQUAL FACE (fetch (FONTDESCRIPTOR FONTFACE) of FONTX)) (EQ ROTATION (fetch (FONTDESCRIPTOR ROTATION) of FONTX)) (EQ DEVICE (fetch (FONTDESCRIPTOR FONTDEVICE) of FONTX))) @@ -999,7 +891,8 @@ (DEFINEQ (COERCEFONTSPEC - [LAMBDA (FONTSPEC COERCIONS) (* ; "Edited 5-Oct-2025 09:41 by rmk") + [LAMBDA (FONTSPEC COERCIONS) (* ; "Edited 9-Nov-2025 17:54 by rmk") + (* ; "Edited 5-Oct-2025 09:41 by rmk") (* ; "Edited 28-Aug-2025 14:41 by rmk") (* ; "Edited 25-Aug-2025 10:22 by rmk") (* ; "Edited 17-Aug-2025 19:15 by rmk") @@ -1013,11 +906,14 @@ (* ;; "Doesn't make sense to coerce the device, DEVICE and also CHARSET are just carried along.") + (CL:WHEN (LITATOM COERCIONS) + [SETQ COERCIONS (FONTDEVICEPROP FONTSPEC (OR COERCIONS 'FONTCOERCIONS]) + (* ;; "A NIL match component matches everything, and a NIL target component denotes the corresponding argument.") (for C MATCH TARGET MFAMILY MSIZE MFACE MROTATION TFAMILY TSIZE TFACE TROTATION COERCED FAMILY - SIZE FACE ROTATION DEVICE in (OR COERCIONS (FONTDEVICEPROP FONTSPEC 'FONTCOERCIONS)) - first (SPREADFONTSPEC FONTSPEC) eachtime (SETQ MATCH (MKLIST (CAR C))) + SIZE FACE ROTATION DEVICE in COERCIONS first (SPREADFONTSPEC FONTSPEC) + eachtime (SETQ MATCH (MKLIST (CAR C))) when [AND (COERCEFONTSPEC.MATCH (pop MATCH) FAMILY) (COERCEFONTSPEC.MATCH (pop MATCH) @@ -1077,33 +973,38 @@ ) (DECLARE%: EVAL@COMPILE -(PUTPROPS SPREADFONTSPEC MACRO [(FONTSPEC) - (LET ((FS FONTSPEC)) +(PUTPROPS SPREADFONTSPEC MACRO [(FSPEC) + (LET ((FS FSPEC)) - (* ;; "Unwrap a FONTSPEC sequentially") + (* ;; "Unwrap a FONTSPEC ") (CL:WHEN (type? FONTDESCRIPTOR FS) (SETQ FS (FONTPROP FS 'SPEC))) - (SETQ FAMILY (pop FS)) - (SETQ SIZE (pop FS)) - (SETQ FACE (pop FS)) - (SETQ ROTATION (pop FS)) - (SETQ DEVICE (pop FS]) + (SETQ FAMILY (fetch (FONTSPEC FSFAMILY) of FS)) + (SETQ SIZE (fetch (FONTSPEC FSSIZE) of FS)) + (SETQ FACE (fetch (FONTSPEC FSFACE) of FS)) + (SETQ ROTATION (fetch (FONTSPEC FSROTATION) of FS)) + (SETQ DEVICE (fetch (FONTSPEC FSDEVICE) of FS]) ) (DEFINEQ (MAKEFONTSPEC - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 28-Aug-2025 14:32 by rmk") + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE BASE) (* ; "Edited 7-Nov-2025 07:52 by rmk") + (* ; "Edited 28-Aug-2025 14:32 by rmk") (* ; "Edited 17-Aug-2025 20:44 by rmk") (* ;; "This is a function, not a macro, so that it can be used in the loadup sequence to create the FONTSPEC for the \GUARANTEEDDISPLAYFONT. That font is created by \CREATEFONT and therefore is not dependent on \FONT.CHECKARGS or on the multi-alist multi-key indexing functions. The strategy might change if MULTI-ALIST is moved earlier in the loadup sequence.") + (* ;; "BASE (fontspec or font) provides defaults for NIL arguments, essentialy models a (create using BASE...)") + + (CL:WHEN (FONTP BASE) + (SETQ BASE (FONTPROP BASE 'SPEC))) (create FONTSPEC - FSFAMILY _ FAMILY - FSSIZE _ SIZE - FSFACE _ FACE - FSROTATION _ ROTATION - FSDEVICE _ DEVICE]) + FSFAMILY _ (OR FAMILY (fetch (FONTSPEC FSFAMILY) of BASE)) + FSSIZE _ (OR SIZE (fetch (FONTSPEC FSSIZE) of BASE)) + FSFACE _ (OR FACE (fetch (FONTSPEC FSFACE) of BASE)) + FSROTATION _ (OR ROTATION (fetch (FONTSPEC FSROTATION) of BASE)) + FSDEVICE _ (OR DEVICE (fetch (FONTSPEC FSDEVICE) of BASE]) ) (DEFINEQ @@ -1190,6 +1091,30 @@ (fetch (CHARSETINFO CSSLUGP) of CSINFO)) do (\SETCHARSETINFO FONT CS NIL)) FONT]) + +(MONOSPACEFONTP + [LAMBDA (FONT CODES SKIPSLUGS RETURNVARIABLES) (* ; "Edited 12-Oct-2025 21:13 by rmk") + + (* ;; "Returns T if all the CODES are the same width. Skips slugs if SKIPSLUGHTS, returns the list of variable width characters if RETURNVARIABLES (instead of NIL).") + + (* ;; "If CODES is a charset, checks all the codes in that charset. Otherwise, can be a (firstcode lastcode) list (e.g. (0 127) to check 7-bit ascii.FIX") + + (SETQ FONT (FONTCREATE FONT)) + [SETQ CODES (if (LISTP CODES) + then [LIST (OR (CHARCODEP (CAR CODES)) + (CHARCODE.DECODE (CAR CODES))) + (OR (CHARCODEP (CADR CODES)) + (CHARCODE.DECODE (CADR CODES] + else (SETQ CODES (\CHARSET.CHECK CODES)) + (LIST (FIRSTCHARSETCODE CODES) + (LASTCHARSETCODE CODES] + (for CODE WIDTH from (CAR CODES) to (CADR CODES) + unless (OR (AND SKIPSLUGS (SLUGCHARP.DISPLAY CODE FONT)) + (EQ (OR WIDTH (SETQ WIDTH (CHARWIDTH CODE FONT))) + (CHARWIDTH CODE FONT))) collect CODE + finally (RETURN (if (NULL $$VAL) + elseif RETURNVARIABLES + then (SORT $$VAL]) ) @@ -1218,7 +1143,8 @@ (fetch (FONTDESCRIPTOR \SFHeight) of (FONTCREATE FONTSPEC]) (FONTPROP - [LAMBDA (FONT PROP) (* ; "Edited 2-Sep-2025 22:21 by rmk") + [LAMBDA (FONT PROP) (* ; "Edited 2-Dec-2025 16:01 by rmk") + (* ; "Edited 2-Sep-2025 22:21 by rmk") (* ; "Edited 12-Aug-2025 21:10 by rmk") (* ; "Edited 10-Aug-2025 13:28 by rmk") (* ; "Edited 23-Jul-2025 17:01 by rmk") @@ -1253,6 +1179,9 @@ elseif (MEMB (fetch (FONTDESCRIPTOR FONTFAMILY) of FONT) ALTOFONTFAMILIES) then 'ALTOTEXT + elseif (MEMB (fetch (FONTDESCRIPTOR FONTFAMILY) of FONT) + MCCSFONTFAMILIES) + then 'MCCS else (fetch (FONTDESCRIPTOR FONTFAMILY) of FONT]) (SPEC (create FONTSPEC FSFAMILY _ (ffetch FONTFAMILY of FONT) @@ -1888,24 +1817,34 @@ (\FINDFONTFILE [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET DIRLST EXTLST) + (* ; "Edited 3-Dec-2025 23:38 by rmk") (* ; "Edited 9-Jun-2025 09:40 by rmk") (* ; "Edited 15-May-2025 22:41 by rmk") (* ; "Edited 14-Sep-96 10:53 by rmk:") (* ; "Edited 6-Oct-89 11:18 by bvm") + (* ;; "This doesn't call FINDFILE because the hyphens separating the family from the face would get confused with the hyphen in TEDIT-STREAM file names.") + + (CL:UNLESS DIRLST + (SETQ DIRLST (CONS NIL))) + (* ;; "Find any font file on any directory with any naming convention with any extension. Note that ROTATION and DEVICE are just place holders. DEVICE is irrelevant because DIRLST already incorporates the device information. The variable *OLD-FONT-EXTENSIONS* can be set to suppress using the old-style lookup. If set to a list of extensions, just those will be looked up with old-style conventions.") - (for EXT FONTFILE inside EXTLST - when (SETQ FONTFILE (FINDFILE (if (FMEMB EXT *OLD-FONT-EXTENSIONS*) - then (\FONTFILENAME.OLD FAMILY SIZE FACE EXT CHARSET) - else (\FONTFILENAME FAMILY SIZE FACE EXT CHARSET)) - T DIRLST)) collect FONTFILE finally + (for EXT FONTFILE inside EXTLST join (SETQ FONTFILE (if (FMEMB EXT *OLD-FONT-EXTENSIONS*) + then (\FONTFILENAME.OLD FAMILY SIZE FACE + EXT CHARSET) + else (\FONTFILENAME FAMILY SIZE FACE EXT + CHARSET))) + (for DIR FOUND inside DIRLST + when (SETQ FOUND (INFILEP (PACKFILENAME.STRING + 'DIRECTORY DIR 'BODY FONTFILE) + )) collect FOUND) + finally - (* ;; - "Backward compatibility for devices that expect a single file") + (* ;; "Backward compatibility for devices that expect a single file") - (CL:UNLESS (CDR $$VAL) - (RETURN (CAR $$VAL)))]) + (CL:UNLESS (CDR $$VAL) + (RETURN (CAR $$VAL)))]) (\FONTFILENAMES [LAMBDA (FAMILY SIZE FACE DEVICE EXTENSIONS) (* ; "Edited 7-Oct-2025 12:21 by rmk") @@ -2069,7 +2008,8 @@ 'EXTENSION EXTENSION]) (FONTSPECFROMFILENAME - [LAMBDA (FONTFILE DEVICE) (* ; "Edited 30-Aug-2025 10:05 by rmk") + [LAMBDA (FONTFILE DEVICE) (* ; "Edited 23-Nov-2025 21:42 by rmk") + (* ; "Edited 30-Aug-2025 10:05 by rmk") (* ; "Edited 28-Aug-2025 14:28 by rmk") (* ; "Edited 25-Aug-2025 10:16 by rmk") (* ; "Edited 23-Aug-2025 10:42 by rmk") @@ -2105,17 +2045,23 @@ (SETQ NAME (U-CASE NAME)) (SETQ FACE (SUBSTRING NAME SIZEEND)) (* ; "don't need name, but checks for lowercase face") - [SETQ FACE (LIST (SELCHARQ (NTHCHARCODE FACE 1) + (SETQ FACE (LIST (SELCHARQ (NTHCHARCODE FACE 1) (B 'BOLD) (L 'LIGHT) - 'MEDIUM) + (M 'MEDIUM) + NIL) (SELCHARQ (NTHCHARCODE FACE 2) (I 'ITALIC) - 'REGULAR) + (R 'REGULAR) + NIL) (SELCHARQ (NTHCHARCODE FACE 3) (C 'COMPRESSED) (E 'EXPANDED) - 'REGULAR] + (R 'REGULAR) + NIL))) + (CL:WHEN (MEMB NIL FACE) (* ; + "Named didn't have a recognizable face") + (SETQ FACE NIL)) (CL:WHEN (SETQ CHARSET (STRPOS "-c" NAME NIL NIL NIL T UPPERCASEARRAY)) [SETQ CHARSET (FIXP (MKATOM (CONCAT (SUBSTRING NAME CHARSET) "Q"]) @@ -2772,7 +2718,9 @@ (DEFINEQ (FONTSAVAILABLE - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHECKFILESTOO?) (* ; "Edited 25-Sep-2025 18:39 by rmk") + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHECKFILESTOO?) (* ; "Edited 22-Nov-2025 11:32 by rmk") + (* ; "Edited 6-Nov-2025 13:50 by rmk") + (* ; "Edited 25-Sep-2025 18:39 by rmk") (* ; "Edited 30-Aug-2025 13:55 by rmk") (* ; "Edited 28-Aug-2025 14:43 by rmk") (* ; "Edited 23-Aug-2025 10:51 by rmk") @@ -2787,48 +2735,63 @@ (* ;;; "returns a list of the fonts fitting a description that are available. FAMILY SIZE FACE or ROTATION can be * which means get them all. if CHECKFILESTOO? is NIL, only fonts in core will be considered. If ONLY, fonts in memory will be ignored. ") - (DECLARE (GLOBALVARS \FONTSINCORE)) - (LET ((FONTSPEC (\FONT.CHECKARGS FAMILY SIZE FACE ROTATION DEVICE))) - (if (EQ '* (fetch (FONTSPEC FSDEVICE) of FONTSPEC)) - then - (* ;; + (DECLARE (GLOBALVARS \FONTSINCORE \FONTSAVAILABLEFILECACHE)) + (LET + ((FONTSPEC (\FONT.CHECKARGS FAMILY SIZE FACE ROTATION DEVICE T)) + FILEFONTS) + (if (EQ '* (fetch (FONTSPEC FSDEVICE) of FONTSPEC)) + then + (* ;; "The results for each device will be grouped together, because the sort happens in the clause below") - (for I in IMAGESTREAMTYPES join (FONTSAVAILABLE FONTSPEC NIL NIL NIL (CAR I) - CHECKFILESTOO?)) - else (SPREADFONTSPEC FONTSPEC) (* ; "For easier matching code") - (SORTFONTSPECS (UNION (CL:UNLESS (EQ 'ONLY CHECKFILESTOO?) - [COLLECTMULTI \FONTSINCORE - (FUNCTION (LAMBDA (FM S FC R D FONT) - (DECLARE (USEDFREE $$COLLECT)) - (CL:WHEN - [AND (OR (EQ FAMILY FM) - (EQ FAMILY '*)) - (OR (EQ SIZE S) - (EQ SIZE '*)) - (MATCHFONTFACE FACE FC) - (OR (EQ ROTATION R) - (EQ ROTATION '*)) - (OR (EQ DEVICE D) - (EQ DEVICE '*] - (push $$COLLECT - (create FONTSPEC - FSFAMILY _ FM - FSSIZE _ S - FSFACE _ FC - FSROTATION _ R - FSDEVICE _ D)))]) - (CL:WHEN CHECKFILESTOO?(* ; + (for I in IMAGESTREAMTYPES join (FONTSAVAILABLE FONTSPEC NIL NIL NIL (CAR I) + CHECKFILESTOO?)) + else + (SPREADFONTSPEC FONTSPEC) (* ; "For easier matching code") + (SORTFONTSPECS + (UNION (CL:UNLESS (EQ 'ONLY CHECKFILESTOO?) + [COLLECTMULTI \FONTSINCORE + (FUNCTION (LAMBDA (FM S FC R D FONT) + (DECLARE (USEDFREE $$COLLECT)) + (CL:WHEN [AND (OR (EQ FAMILY FM) + (EQ FAMILY '*)) + (OR (EQ SIZE S) + (EQ SIZE '*)) + (MATCHFONTFACE FACE FC) + (OR (EQ ROTATION R) + (EQ ROTATION '*)) + (OR (EQ DEVICE D) + (EQ DEVICE '*] + (push $$COLLECT + (create FONTSPEC + FSFAMILY _ FM + FSSIZE _ S + FSFACE _ FC + FSROTATION _ R + FSDEVICE _ D)))]) + (CL:WHEN CHECKFILESTOO? (* ; "apply the device font lookup function.") - (LET [(FN (OR (CAR (GETMULTI IMAGESTREAMTYPES DEVICE - 'FONTSAVAILABLE)) - (FUNCTION \SEARCHFONTFILES] + (SETQ FILEFONTS (SGETMULTI \FONTSAVAILABLEFILECACHE FAMILY SIZE FACE ROTATION + DEVICE)) - (* ;; "Until all the device functions take a FONTSPEC") + (* ;; "APPEND the cache value because of the SORT") - (CL:IF (EQ 1 (NARGS FN)) - (APPLY* FN FONTSPEC) - (APPLY* FN FAMILY SIZE FACE ROTATION DEVICE))))]) + (APPEND (if (NULL FILEFONTS) + then (LET [(FN (OR (CAR (GETMULTI IMAGESTREAMTYPES DEVICE + 'FONTSAVAILABLE)) + (FUNCTION \SEARCHFONTFILES] + + (* ;; "Until all the device functions take a FONTSPEC") + + (SETQ FILEFONTS (CL:IF (EQ 1 (NARGS FN)) + (APPLY* FN FONTSPEC) + (APPLY* FN FAMILY SIZE FACE ROTATION + DEVICE))) + (SPUTMULTI \FONTSAVAILABLEFILECACHE FAMILY SIZE FACE + ROTATION DEVICE (OR FILEFONTS 'NONE)) + FILEFONTS) + elseif (NEQ FILEFONTS 'NONE) + then FILEFONTS)))]) (FONTEXISTS? [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE NOCOERCIONS) (* ; "Edited 26-Sep-2025 10:10 by rmk") @@ -2929,47 +2892,52 @@ FONTSFOUND) do (push FONTSFOUND THISFONT))) finally (RETURN (DREVERSE FONTSFOUND]) +(FLUSHFONTCACHE + [LAMBDA (TYPE FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 27-Nov-2025 10:02 by rmk") + (* ; "Edited 22-Nov-2025 15:52 by rmk") + + (* ;; + "Removes information for font(s) from the TYPE cache, if TYPE is NIL, all caches are flushed") + + (CL:UNLESS TYPE + (SETQ TYPE '(:INCORE :EXISTS :AVAILABLE))) + (if (LISTP TYPE) + then (for TY in TYPE collect (FLUSHFONTCACHE TY FAMILY SIZE FACE ROTATION DEVICE)) + else + (* ;; "If all NILs, don't want the default font") + + (SPREADFONTSPEC (\FONT.CHECKARGS (OR FAMILY '*) + (OR SIZE '*) + (OR FACE '*) + (OR ROTATION '*) + (OR DEVICE '*) + T)) + (LET ((NFLUSHED 0) + FONTX) + (DECLARE (SPECVARS NFLUSHED)) + [MAPMULTI (SELECTQ TYPE + (:INCORE \FONTSINCORE) + (:EXISTS \FONTEXISTS?-CACHE) + (:AVAILABLE \FONTSAVAILABLEFILECACHE) + (\ILLEGAL.ARG TYPE)) + (FUNCTION (LAMBDA (FM S FC R DPAIR) + (CL:WHEN (AND (OR (EQ FAMILY FM) + (EQ FAMILY '*)) + (OR (EQ SIZE S) + (EQ SIZE '*)) + (MATCHFONTFACE FACE FC) + (OR (EQ ROTATION R) + (EQ ROTATION '*)) + (OR (EQ DEVICE (CAR DPAIR)) + (EQ DEVICE '*)) + (CDR DPAIR)) + (ADD NFLUSHED 1) + (RPLACD DPAIR))] + (LIST TYPE NFLUSHED]) + (FLUSHFONTSINCORE - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 26-Sep-2025 10:04 by rmk") - (* ; "Edited 4-Sep-2025 10:14 by rmk") - (* ; "Edited 28-Aug-2025 14:44 by rmk") - (* ; "Edited 18-Aug-2025 00:33 by rmk") - (* ; "Edited 12-Aug-2025 21:07 by rmk") - (* ; "Edited 21-Jul-2025 08:59 by rmk") - (* ; "Edited 21-Jun-2025 11:19 by rmk") - (DECLARE (SPECVARS . T) - (GLOBALVARS \FONTSINCORE \FONTEXISTS?-CACHE)) - (SPREADFONTSPEC (\FONT.CHECKARGS FAMILY SIZE FACE ROTATION DEVICE)) - (LET ((INCOREFLUSHED 0) - (EXISTSFLUSHED 0)) - (DECLARE (SPECVARS INCOREFLUSHED EXISTSFLUSHED)) - [MAPMULTI \FONTSINCORE (FUNCTION (LAMBDA (FM S FC R DPAIR) - (CL:WHEN (AND (OR (EQ FAMILY FM) - (EQ FAMILY '*)) - (OR (EQ SIZE S) - (EQ SIZE '*)) - (MATCHFONTFACE FACE FC) - (OR (EQ ROTATION R) - (EQ ROTATION '*)) - (OR (EQ DEVICE (CAR DPAIR)) - (EQ DEVICE '*)) - (CDR DPAIR)) - (ADD INCOREFLUSHED 1) - (RPLACD DPAIR))] - [MAPMULTI \FONTEXISTS?-CACHE (FUNCTION (LAMBDA (FM S FC R DPAIR) - (CL:WHEN (AND (OR (EQ FAMILY FM) - (EQ FAMILY '*)) - (OR (EQ SIZE S) - (EQ SIZE '*)) - (MATCHFONTFACE FACE FC) - (OR (EQ ROTATION R) - (EQ ROTATION '*)) - (OR (EQ DEVICE (CAR DPAIR)) - (EQ DEVICE '*)) - (CDR DPAIR)) - (ADD EXISTSFLUSHED 1) - (RPLACD DPAIR))] - (LIST INCOREFLUSHED EXISTSFLUSHED]) + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 22-Nov-2025 10:23 by rmk") + (FLUSHFONTCACHE :INCORE FAMILY SIZE FACE ROTATION DEVICE]) (FINDFONTFILES [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE DIRLST EXTLST) (* ; "Edited 28-Aug-2025 14:45 by rmk") @@ -3072,7 +3040,10 @@ (EQ PEXPANSION '*]) (MAKEFONTFACE - [LAMBDA (WEIGHT SLOPE EXPANSION BASE COLOR) (* ; "Edited 30-Aug-2025 10:22 by rmk") + [LAMBDA (WEIGHT SLOPE EXPANSION BASE COLOR) (* ; "Edited 7-Nov-2025 08:50 by rmk") + (* ; "Edited 30-Aug-2025 10:22 by rmk") + (CL:WHEN (FONTP BASE) + (SETQ BASE (FONTPROP BASE 'FACE))) (CL:UNLESS WEIGHT (SETQ WEIGHT (CL:IF BASE (fetch (FONTFACE WEIGHT) of BASE) @@ -3131,7 +3102,19 @@ (RPAQ? \FONTEXISTS?-CACHE NIL) +(RPAQ? \FONTSAVAILABLEFILECACHE NIL) + (RPAQ? \DEFAULTDEVICEFONTS NIL) + + + +(* ;; +"The INITVARS value of MEDLEY-INIT-VARS in MEDLEY dalso includes these entries. That's because FONT is in the INIT, so these entries would be lost when MEDLEY-INIT-VARS is reinitialized when the Lisp loadup starts" +) + + +(ADDTOVAR MEDLEY-INIT-VARS (\FONTEXISTS?-CACHE NIL RESET) + (\FONTSAVAILABLEFILECACHE NIL RESET)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \DEFAULTDEVICEFONTS \UNITWIDTHSVECTOR) @@ -3399,19 +3382,6 @@ (CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR)) (SLUGCHARSET (ADD1 \MAXCHARSET))) ) -(DECLARE%: EVAL@COMPILE - -(PUTPROPS LEGACYFONTS MACRO ((F . FORMS) (* ; - "Execute FORMS in a legacy font environment") - (RESETLST - (RESETSAVE \FONTSINCORE NIL) - (RESETSAVE \FONTEXISTS?-CACHE) - (RESETSAVE DISPLAYFONTCOERCIONS) - (RESETSAVE DISPLAYCHARCOERCIONS) - (RESETSAVE DISPLAYFONTEXTENSIONS '(DISPLAYFONT)) - (RESETSAVE DISPLAYFONTDIRECTORIES (MEDLEYDIR "fonts>displayfonts>")) - (PROGN F . FORMS)))) -) (* "END EXPORTED DEFINITIONS") @@ -4563,7 +4533,7 @@ (PALATINO CLASSIC) (OPTIMA MODERN) (BOLDPS CLASSIC) - (PCTERMINAL) + (PCTERMINAL CLASSIC) (TITANLEGAL CLASSIC))) (RPAQ? \DEFAULTCHARSET 0) @@ -4627,43 +4597,44 @@ (ADDTOVAR LAMA FONTCOPY) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (12196 21909 (CHARWIDTH 12206 . 12991) (CHARWIDTHY 12993 . 14510) (STRINGWIDTH 14512 . -15605) (\CHARWIDTH.DISPLAY 15607 . 16020) (\STRINGWIDTH.DISPLAY 16022 . 16446) (\STRINGWIDTH.GENERIC -16448 . 21907)) (21910 28430 (DEFAULTFONT 21920 . 23205) (FONTCLASS 23207 . 25369) (FONTCLASSUNPARSE -25371 . 26270) (FONTCLASSCOMPONENT 26272 . 26860) (SETFONTCLASSCOMPONENT 26862 . 27304) ( -GETFONTCLASSCOMPONENT 27306 . 28428)) (30109 54490 (FONTCREATE 30119 . 33364) (FONTCREATE1 33366 . -35981) (FONTCREATE.SLUGFD 35983 . 37465) (\FONT.CHECKARGS 37467 . 44057) (\FONT.CHECKARGS1 44059 . -48582) (\FONTCREATE1.NOFN 48584 . 48798) (FONTFILEP 48800 . 49688) (\READCHARSET 49690 . 54488)) ( -54491 61408 (\FONT.CHECKARGS 54501 . 61091) (\CHARSET.CHECK 61093 . 61406)) (61409 64492 ( -COERCEFONTSPEC 61419 . 64490)) (66562 67352 (MAKEFONTSPEC 66572 . 67350)) (67353 74127 (COMPLETE.FONT -67363 . 69886) (COMPLETEFONTP 69888 . 70511) (COMPLETE.CHARSET 70513 . 73198) (PRUNESLUGCSINFOS 73200 - . 74125)) (74166 82087 (FONTASCENT 74176 . 74560) (FONTDESCENT 74562 . 75047) (FONTHEIGHT 75049 . -75451) (FONTPROP 75453 . 81364) (\AVGCHARWIDTH 81366 . 82085)) (82744 83652 (FONTDEVICEPROP 82754 . -83650)) (83698 84552 (EDITCHAR 83708 . 84550)) (84598 96788 (GETCHARBITMAP 84608 . 85732) ( -PUTCHARBITMAP 85734 . 87892) (\GETCHARBITMAP.CSINFO 87894 . 89910) (\PUTCHARBITMAP.CSINFO 89912 . -96786)) (96789 117269 (MOVECHARBITMAP 96799 . 98693) (MOVEFONTCHARS 98695 . 102655) (\MOVEFONTCHAR -102657 . 107500) (\MOVEFONTCHARS.SOURCEDATA 107502 . 113607) (\MAKESLUGCHAR 113609 . 116144) ( -SLUGCHARP.DISPLAY 116146 . 117267)) (118202 138340 (FONTFILES 118212 . 120045) (\FINDFONTFILE 120047 - . 121764) (\FONTFILENAMES 121766 . 122761) (\FONTFILENAME 122763 . 126746) (\FONTFILENAME.OLD 126748 - . 129697) (\FONTFILENAME.NEW 129699 . 131956) (FONTSPECFROMFILENAME 131958 . 136059) ( -\FONTINFOFROMFILENAME.OLD 136061 . 138338)) (138607 174410 (FONTCOPY 138617 . 143680) (FONTP 143682 . -143981) (FONTUNPARSE 143983 . 145702) (SETFONTDESCRIPTOR 145704 . 147168) (\STREAMCHARWIDTH 147170 . -151334) (\COERCECHARSET 151336 . 153931) (\BUILDSLUGCSINFO 153933 . 157556) (\FONTSYMBOL 157558 . -158208) (\DEVICESYMBOL 158210 . 159079) (\FONTFACE 159081 . 166271) (\FONTFACE.COLOR 166273 . 173193) -(SETFONTCHARENCODING 173195 . 174408)) (174411 194962 (FONTSAVAILABLE 174421 . 179276) (FONTEXISTS? -179278 . 183256) (\SEARCHFONTFILES 183258 . 186343) (FLUSHFONTSINCORE 186345 . 189518) (FINDFONTFILES -189520 . 192734) (SORTFONTSPECS 192736 . 194960)) (194963 198386 (MATCHFONTFACE 194973 . 195788) ( -MAKEFONTFACE 195790 . 196630) (FONTFACETOATOM 196632 . 198384)) (198614 199106 (\UNITWIDTHSVECTOR -198624 . 199104)) (214449 216516 (FONTDESCRIPTOR.DEFPRINT 214459 . 216038) (FONTCLASS.DEFPRINT 216040 - . 216514)) (220345 223135 (\CREATEKERNELEMENT 220355 . 220713) (\FSETLEFTKERN 220715 . 221206) ( -\FGETLEFTKERN 221208 . 223133)) (223136 232772 (\CREATEFONT 223146 . 224585) (\CREATECHARSET 224587 . -228523) (\INSTALLCHARSETINFO 228525 . 231859) (\INSTALLCHARSETINFO.CHARENCODING 231861 . 232770)) ( -233094 234458 (\FONTRESETCHARWIDTHS 233104 . 234456)) (235088 245135 (\CREATEDISPLAYFONT 235098 . -236947) (\CREATECHARSET.DISPLAY 236949 . 242658) (\FONTEXISTS?.DISPLAY 242660 . 245133)) (245136 -260001 (STRIKEFONT.FILEP 245146 . 246034) (STRIKEFONT.GETCHARSET 246036 . 251628) (WRITESTRIKEFONTFILE - 251630 . 256541) (STRIKECSINFO 256543 . 259999)) (260032 276349 (MAKEBOLD.CHARSET 260042 . 263691) ( -MAKEBOLD.CHAR 263693 . 265445) (MAKEITALIC.CHARSET 265447 . 269120) (MAKEITALIC.CHAR 269122 . 271468) -(\SFMAKEBOLD 271470 . 273694) (\SFMAKEITALIC 273696 . 276347)) (276350 280499 (\SFMAKEROTATEDFONT -276360 . 277761) (\SFROTATECSINFO 277763 . 278400) (\SFROTATEFONTCHARACTERS 278402 . 278782) ( -\SFROTATECSINFOOFFSETS 278784 . 280497)) (280500 281881 (\SFMAKECOLOR 280510 . 281879))))) + (FILEMAP (NIL (12152 21865 (CHARWIDTH 12162 . 12947) (CHARWIDTHY 12949 . 14466) (STRINGWIDTH 14468 . +15561) (\CHARWIDTH.DISPLAY 15563 . 15976) (\STRINGWIDTH.DISPLAY 15978 . 16402) (\STRINGWIDTH.GENERIC +16404 . 21863)) (21866 28386 (DEFAULTFONT 21876 . 23161) (FONTCLASS 23163 . 25325) (FONTCLASSUNPARSE +25327 . 26226) (FONTCLASSCOMPONENT 26228 . 26816) (SETFONTCLASSCOMPONENT 26818 . 27260) ( +GETFONTCLASSCOMPONENT 27262 . 28384)) (30099 47603 (FONTCREATE 30109 . 33354) (FONTCREATE1 33356 . +35971) (FONTCREATE.SLUGFD 35973 . 37455) (\FONT.CHECKARGS1 37457 . 41980) (\FONTCREATE1.NOFN 41982 . +42196) (FONTFILEP 42198 . 43086) (\READCHARSET 43088 . 47601)) (47604 54680 (\FONT.CHECKARGS 47614 . +54363) (\CHARSET.CHECK 54365 . 54678)) (54681 57941 (COERCEFONTSPEC 54691 . 57939)) (60136 61475 ( +MAKEFONTSPEC 60146 . 61473)) (61476 69653 (COMPLETE.FONT 61486 . 64009) (COMPLETEFONTP 64011 . 64634) +(COMPLETE.CHARSET 64636 . 67321) (PRUNESLUGCSINFOS 67323 . 68248) (MONOSPACEFONTP 68250 . 69651)) ( +69692 77947 (FONTASCENT 69702 . 70086) (FONTDESCENT 70088 . 70573) (FONTHEIGHT 70575 . 70977) ( +FONTPROP 70979 . 77224) (\AVGCHARWIDTH 77226 . 77945)) (78604 79512 (FONTDEVICEPROP 78614 . 79510)) ( +79558 80412 (EDITCHAR 79568 . 80410)) (80458 92648 (GETCHARBITMAP 80468 . 81592) (PUTCHARBITMAP 81594 + . 83752) (\GETCHARBITMAP.CSINFO 83754 . 85770) (\PUTCHARBITMAP.CSINFO 85772 . 92646)) (92649 113129 ( +MOVECHARBITMAP 92659 . 94553) (MOVEFONTCHARS 94555 . 98515) (\MOVEFONTCHAR 98517 . 103360) ( +\MOVEFONTCHARS.SOURCEDATA 103362 . 109467) (\MAKESLUGCHAR 109469 . 112004) (SLUGCHARP.DISPLAY 112006 + . 113127)) (114062 135227 (FONTFILES 114072 . 115905) (\FINDFONTFILE 115907 . 118216) (\FONTFILENAMES + 118218 . 119213) (\FONTFILENAME 119215 . 123198) (\FONTFILENAME.OLD 123200 . 126149) ( +\FONTFILENAME.NEW 126151 . 128408) (FONTSPECFROMFILENAME 128410 . 132946) (\FONTINFOFROMFILENAME.OLD +132948 . 135225)) (135494 171297 (FONTCOPY 135504 . 140567) (FONTP 140569 . 140868) (FONTUNPARSE +140870 . 142589) (SETFONTDESCRIPTOR 142591 . 144055) (\STREAMCHARWIDTH 144057 . 148221) ( +\COERCECHARSET 148223 . 150818) (\BUILDSLUGCSINFO 150820 . 154443) (\FONTSYMBOL 154445 . 155095) ( +\DEVICESYMBOL 155097 . 155966) (\FONTFACE 155968 . 163158) (\FONTFACE.COLOR 163160 . 170080) ( +SETFONTCHARENCODING 170082 . 171295)) (171298 191597 (FONTSAVAILABLE 171308 . 176662) (FONTEXISTS? +176664 . 180642) (\SEARCHFONTFILES 180644 . 183729) (FLUSHFONTCACHE 183731 . 185954) (FLUSHFONTSINCORE + 185956 . 186153) (FINDFONTFILES 186155 . 189369) (SORTFONTSPECS 189371 . 191595)) (191598 195207 ( +MATCHFONTFACE 191608 . 192423) (MAKEFONTFACE 192425 . 193451) (FONTFACETOATOM 193453 . 195205)) ( +195838 196330 (\UNITWIDTHSVECTOR 195848 . 196328)) (210924 212991 (FONTDESCRIPTOR.DEFPRINT 210934 . +212513) (FONTCLASS.DEFPRINT 212515 . 212989)) (216820 219610 (\CREATEKERNELEMENT 216830 . 217188) ( +\FSETLEFTKERN 217190 . 217681) (\FGETLEFTKERN 217683 . 219608)) (219611 229247 (\CREATEFONT 219621 . +221060) (\CREATECHARSET 221062 . 224998) (\INSTALLCHARSETINFO 225000 . 228334) ( +\INSTALLCHARSETINFO.CHARENCODING 228336 . 229245)) (229569 230933 (\FONTRESETCHARWIDTHS 229579 . +230931)) (231563 241610 (\CREATEDISPLAYFONT 231573 . 233422) (\CREATECHARSET.DISPLAY 233424 . 239133) +(\FONTEXISTS?.DISPLAY 239135 . 241608)) (241611 256476 (STRIKEFONT.FILEP 241621 . 242509) ( +STRIKEFONT.GETCHARSET 242511 . 248103) (WRITESTRIKEFONTFILE 248105 . 253016) (STRIKECSINFO 253018 . +256474)) (256507 272824 (MAKEBOLD.CHARSET 256517 . 260166) (MAKEBOLD.CHAR 260168 . 261920) ( +MAKEITALIC.CHARSET 261922 . 265595) (MAKEITALIC.CHAR 265597 . 267943) (\SFMAKEBOLD 267945 . 270169) ( +\SFMAKEITALIC 270171 . 272822)) (272825 276974 (\SFMAKEROTATEDFONT 272835 . 274236) (\SFROTATECSINFO +274238 . 274875) (\SFROTATEFONTCHARACTERS 274877 . 275257) (\SFROTATECSINFOOFFSETS 275259 . 276972)) ( +276975 278356 (\SFMAKECOLOR 276985 . 278354))))) STOP diff --git a/sources/FONT.LCOM b/sources/FONT.LCOM index b3e2cb0d..7cb640d7 100644 Binary files a/sources/FONT.LCOM and b/sources/FONT.LCOM differ diff --git a/sources/HLDISPLAY b/sources/HLDISPLAY index c51c6c01..be755ffb 100644 --- a/sources/HLDISPLAY +++ b/sources/HLDISPLAY @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "29-Aug-2025 11:38:16" {WMEDLEY}HLDISPLAY.;3 205136 +(FILECREATED "24-Dec-2025 21:06:38" {WMEDLEY}HLDISPLAY.;4 205147 :EDIT-BY rmk - :CHANGES-TO (FNS EDITBM) + :CHANGES-TO (VARS HLDISPLAYCOMS) - :PREVIOUS-DATE " 2-Aug-2025 10:16:35" {WMEDLEY}HLDISPLAY.;2) + :PREVIOUS-DATE "29-Aug-2025 11:38:16" {WMEDLEY}HLDISPLAY.;3) (PRETTYCOMPRINT HLDISPLAYCOMS) @@ -3508,38 +3508,38 @@ DEST-WORD-WIDTH))) DESTINATION)) -(PUTPROPS HLDISPLAY FILETYPE CL:COMPILE-FILE) +(PUTPROPS HLDISPLAY FILETYPE :FAKE-COMPILE-FILE) (READVARS-FROM-STRINGS '(\4BITEXPANSIONTABLE) "({Y16 SMALLPOSP 0 0 15 240 255 3840 3855 4080 4095 61440 61455 61680 61695 65280 65295 65520 65535 }) ") (DECLARE%: DONTCOPY - (FILEMAP (NIL (4649 11812 (GRID 4659 . 8930) (GRIDXCOORD 8932 . 9437) (GRIDYCOORD 9439 . 9948) ( -LEFTOFGRIDCOORD 9950 . 10387) (BOTTOMOFGRIDCOORD 10389 . 10650) (SHADEGRIDBOX 10652 . 11810)) (11868 -12276 (INSIDE? 11878 . 12274)) (12314 16710 (MOUSESTATE-EXPR 12324 . 15979) (MOUSESTATE-NAME 15981 . -16708)) (20200 21185 (DECODEBUTTONS 20210 . 21183)) (21186 22198 (PTDIFFERENCE 21196 . 21705) (PTPLUS -21707 . 22196)) (22249 50152 (GETPOSITION 22259 . 22567) (GETBOXPOSITION 22569 . 23252) ( -DSPYSCREENTOWINDOW 23254 . 23738) (DSPXSCREENTOWINDOW 23740 . 24224) (GETREGION 24226 . 24775) ( -\GETREGION.PACKPTS 24777 . 25345) (\GETREGION.CHECKBASEPT 25347 . 27290) (\GETREGION.CHECKOPPT 27292 - . 30102) (\GETREGIONTRACKWITHBOX 30104 . 36635) (\UPDATEXYANDBOX 36637 . 39016) (GETBOXREGION 39018 - . 39492) (\TRACKWITHBOX 39494 . 44632) (MOVEBOX 44634 . 45264) (DRAWGRAYBOX 45266 . 45788) (BLTHLINE -45790 . 46040) (BLTVLINE 46042 . 46281) (SETCORNER 46283 . 47549) (GETSCREENPOSITION 47551 . 48164) ( -GETBOXSCREENPOSITION 48166 . 48777) (GETSCREENREGION 48779 . 49435) (GETBOXSCREENREGION 49437 . 50150) -) (50238 67054 (\MEDW.GETSCREENPOSITION 50248 . 52041) (\MEDW.GETBOXSCREENPOSITION 52043 . 55597) ( -\MEDW.GETSCREENREGION 55599 . 67052)) (67055 74793 (GETGRIDBOXREGION 67065 . 74719) (\RANGELIMIT 74721 - . 74791)) (74794 77844 (MOUSECONFIRM 74804 . 77842)) (77985 79354 (NEAREST/PT/ON/GRID 77995 . 78590) -(PTON10GRID 78592 . 78917) (NEAREST/MULTIPLE 78919 . 79352)) (81398 85300 (\SW2BM 81408 . 84106) ( -COMPOSEREGS 84108 . 84662) (TRANSLATEREG 84664 . 85298)) (85342 176197 (EDITBM 85352 . 95681) ( -EDITBMSCROLLFN 95683 . 110836) (EDITBMCLOSEFN 110838 . 111455) (TILEAREA 111457 . 111848) ( -EDITBMBUTTONFN 111850 . 136677) (\EDITBM/PUTUP/DISPLAY 136679 . 137581) (\EDITBMHOWMUCH 137583 . -138569) (EDITBMRESHAPEFN 138571 . 147257) (EDITBMREPAINTFN 147259 . 148578) (UPDATE/SHADE/DISPLAY -148580 . 149027) (UPDATE/BM/DISPLAY/SELECTED/REGION 149029 . 150143) (SHOWBUTTON 150145 . 150703) ( -RESETGRID.NEW 150705 . 154054) (RESETGRID 154056 . 154880) (\READBMDIMENSIONS 154882 . 155919) ( -EDITSHADE 155921 . 164647) (\BITMAPFROMTEXTURE 164649 . 165347) (EDITSHADEREPAINTFN 165349 . 167123) ( -GRAYBOXAREA 167125 . 167808) (\SHADEBITS 167810 . 170775) (READHOTSPOT 170777 . 174642) (WBOX 174644 - . 175368) (\CLEARBM 175370 . 175569) (EDITBMTEXTURE 175571 . 176195)) (177542 185249 (SCALEBM 177552 - . 179618) (BLTPATTERN 179620 . 182138) (BLTPATTERN.REPLACEDISPLAY 182140 . 184229) ( -BLTPATTERN.GENERIC 184231 . 185247)) (185250 197069 (EXPANDBITMAP 185260 . 187784) (EXPANDBM 187786 . -194341) (SHRINKBITMAP 194343 . 195687) (\FAST4BIT 195689 . 197067)) (197071 201060 (ROTATE-BITMAP -197071 . 201060)) (201062 204898 (ROTATE-BITMAP-LEFT 201062 . 204898))))) + (FILEMAP (NIL (4657 11820 (GRID 4667 . 8938) (GRIDXCOORD 8940 . 9445) (GRIDYCOORD 9447 . 9956) ( +LEFTOFGRIDCOORD 9958 . 10395) (BOTTOMOFGRIDCOORD 10397 . 10658) (SHADEGRIDBOX 10660 . 11818)) (11876 +12284 (INSIDE? 11886 . 12282)) (12322 16718 (MOUSESTATE-EXPR 12332 . 15987) (MOUSESTATE-NAME 15989 . +16716)) (20208 21193 (DECODEBUTTONS 20218 . 21191)) (21194 22206 (PTDIFFERENCE 21204 . 21713) (PTPLUS +21715 . 22204)) (22257 50160 (GETPOSITION 22267 . 22575) (GETBOXPOSITION 22577 . 23260) ( +DSPYSCREENTOWINDOW 23262 . 23746) (DSPXSCREENTOWINDOW 23748 . 24232) (GETREGION 24234 . 24783) ( +\GETREGION.PACKPTS 24785 . 25353) (\GETREGION.CHECKBASEPT 25355 . 27298) (\GETREGION.CHECKOPPT 27300 + . 30110) (\GETREGIONTRACKWITHBOX 30112 . 36643) (\UPDATEXYANDBOX 36645 . 39024) (GETBOXREGION 39026 + . 39500) (\TRACKWITHBOX 39502 . 44640) (MOVEBOX 44642 . 45272) (DRAWGRAYBOX 45274 . 45796) (BLTHLINE +45798 . 46048) (BLTVLINE 46050 . 46289) (SETCORNER 46291 . 47557) (GETSCREENPOSITION 47559 . 48172) ( +GETBOXSCREENPOSITION 48174 . 48785) (GETSCREENREGION 48787 . 49443) (GETBOXSCREENREGION 49445 . 50158) +) (50246 67062 (\MEDW.GETSCREENPOSITION 50256 . 52049) (\MEDW.GETBOXSCREENPOSITION 52051 . 55605) ( +\MEDW.GETSCREENREGION 55607 . 67060)) (67063 74801 (GETGRIDBOXREGION 67073 . 74727) (\RANGELIMIT 74729 + . 74799)) (74802 77852 (MOUSECONFIRM 74812 . 77850)) (77993 79362 (NEAREST/PT/ON/GRID 78003 . 78598) +(PTON10GRID 78600 . 78925) (NEAREST/MULTIPLE 78927 . 79360)) (81406 85308 (\SW2BM 81416 . 84114) ( +COMPOSEREGS 84116 . 84670) (TRANSLATEREG 84672 . 85306)) (85350 176205 (EDITBM 85360 . 95689) ( +EDITBMSCROLLFN 95691 . 110844) (EDITBMCLOSEFN 110846 . 111463) (TILEAREA 111465 . 111856) ( +EDITBMBUTTONFN 111858 . 136685) (\EDITBM/PUTUP/DISPLAY 136687 . 137589) (\EDITBMHOWMUCH 137591 . +138577) (EDITBMRESHAPEFN 138579 . 147265) (EDITBMREPAINTFN 147267 . 148586) (UPDATE/SHADE/DISPLAY +148588 . 149035) (UPDATE/BM/DISPLAY/SELECTED/REGION 149037 . 150151) (SHOWBUTTON 150153 . 150711) ( +RESETGRID.NEW 150713 . 154062) (RESETGRID 154064 . 154888) (\READBMDIMENSIONS 154890 . 155927) ( +EDITSHADE 155929 . 164655) (\BITMAPFROMTEXTURE 164657 . 165355) (EDITSHADEREPAINTFN 165357 . 167131) ( +GRAYBOXAREA 167133 . 167816) (\SHADEBITS 167818 . 170783) (READHOTSPOT 170785 . 174650) (WBOX 174652 + . 175376) (\CLEARBM 175378 . 175577) (EDITBMTEXTURE 175579 . 176203)) (177550 185257 (SCALEBM 177560 + . 179626) (BLTPATTERN 179628 . 182146) (BLTPATTERN.REPLACEDISPLAY 182148 . 184237) ( +BLTPATTERN.GENERIC 184239 . 185255)) (185258 197077 (EXPANDBITMAP 185268 . 187792) (EXPANDBM 187794 . +194349) (SHRINKBITMAP 194351 . 195695) (\FAST4BIT 195697 . 197075)) (197079 201068 (ROTATE-BITMAP +197079 . 201068)) (201070 204906 (ROTATE-BITMAP-LEFT 201070 . 204906))))) STOP diff --git a/sources/HLDISPLAY.LCOM b/sources/HLDISPLAY.LCOM index 2148f3ee..62054aa4 100644 Binary files a/sources/HLDISPLAY.LCOM and b/sources/HLDISPLAY.LCOM differ diff --git a/sources/LLKEY b/sources/LLKEY index 032f719b..c45b64c8 100644 --- a/sources/LLKEY +++ b/sources/LLKEY @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 5-May-2025 20:57:08" {WMEDLEY}LLKEY.;15 199508 +(FILECREATED "12-Nov-2025 16:40:50" {WMEDLEY}LLKEY.;18 199501 :EDIT-BY rmk - :CHANGES-TO (VARS \MAIKOKEYACTIONS \KEYNAMES) + :CHANGES-TO (VARS \ORIGKEYACTIONS) - :PREVIOUS-DATE " 4-Apr-2025 17:10:10" {WMEDLEY}LLKEY.;11) + :PREVIOUS-DATE "12-Nov-2025 15:56:25" {WMEDLEY}LLKEY.;17) (PRETTYCOMPRINT LLKEYCOMS) @@ -1591,7 +1591,7 @@ (12 ("/" "?" NOLOCKSHIFT)) (13 ("\" "|" NOLOCKSHIFT)) (14 ("LF" "`" NOLOCKSHIFT)) - (15 ("Bs" "Bs" NOLOCKSHIFT)) + (15 ("Bs" "^W" NOLOCKSHIFT)) (16 ("3" "#" NOLOCKSHIFT)) (17 ("2" "@" NOLOCKSHIFT)) (18 ("w" "W" LOCKSHIFT)) @@ -1771,7 +1771,7 @@ (66 ("Function,G" "Function,g" NOLOCKSHIFT)) (104 ("Function,H" "Function,h" NOLOCKSHIFT)) (80 ("Function,I" "Function,i" NOLOCKSHIFT)) - (13 ("^W" "^U" NOLOCKSHIFT)) + (13 (RUBOUT "^U" NOLOCKSHIFT)) (33 ("Esc" "Esc" NOLOCKSHIFT)) (65 ("Esc" "Esc" NOLOCKSHIFT)) (2 ("6" "^" NOLOCKSHIFT)) @@ -1851,9 +1851,9 @@ (4 ("7" "'" NOLOCKSHIFT)) (8 ("0" "0" NOLOCKSHIFT)) (10 ("\" "_" NOLOCKSHIFT)) - (13 ("^W" "^U" NOLOCKSHIFT)) + (13 (RUBOUT "^U" NOLOCKSHIFT)) (14 METADOWN . METAUP) - (15 ("Bs" "Bs" NOLOCKSHIFT)) + (15 ("Bs" "^W" NOLOCKSHIFT)) (17 ("2" "%"" NOLOCKSHIFT)) (22 ("9" ")" NOLOCKSHIFT)) (28 (":" "*" NOLOCKSHIFT)) @@ -3916,33 +3916,33 @@ (ADDTOVAR LAMA CURSORPROP METASHIFT MOUSECHORDWAIT) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (14602 21918 (BKSYSCHARCODE 14612 . 14961) (\CLEARSYSBUF 14963 . 15521) (\GETKEY 15523 - . 16698) (\NSYSBUFCHARS 16700 . 17442) (\SAVESYSBUF 17444 . 19053) (\SYSBUFP 19055 . 19359) ( -\GETSYSBUF 19361 . 19541) (\PUTSYSBUF 19543 . 20756) (\PEEKSYSBUF 20758 . 21916)) (23203 60761 ( -\KEYBOARDINIT 23213 . 24933) (\KEYBOARDEVENTFN 24935 . 29635) (\ALLOCLOCKED 29637 . 30227) ( -\SETIOPOINTERS 30229 . 34765) (\KEYBOARDOFF 34767 . 35181) (\KEYBOARDON 35183 . 35562) (\KEYHANDLER -35564 . 35695) (\KEYHANDLER1 35697 . 43143) (\RESETKEYBOARD 43145 . 44793) (\DOMOUSECHORDING 44795 . -48615) (\DOTRANSITIONS 48617 . 49294) (\DECODETRANSITION 49296 . 56709) (MOUSECHORDWAIT 56711 . 57375) - (\TRACKCURSOR 57377 . 60759)) (95227 117100 (KEYACTION 95237 . 96090) (KEYACTIONTABLE 96092 . 97274) -(KEYBOARDTYPE 97276 . 98378) (RESETKEYACTION 98380 . 100139) (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS -100141 . 102043) (\KEYACTION1 102045 . 112161) (KEYDOWNP 112163 . 112498) (KEYNUMBERP 112500 . 112698) - (\KEYNAMETONUMBER 112700 . 113394) (\KEYNUMBERTONAME 113396 . 113586) (MODIFY.KEYACTIONS 113588 . -114449) (METASHIFT 114451 . 115395) (SHIFTDOWNP 115397 . 117098)) (117163 117459 ( -SETUP.OFFICE.KEYBOARD 117173 . 117457)) (120438 122150 (\INIT.KEYBOARD.STREAM 120448 . 122148)) ( -122415 138792 (\DOBUFFEREDTRANSITIONS 122425 . 137855) (\TIMER.INTERRUPTFRAME 137857 . 138582) ( -\PERIODIC.INTERRUPTFRAME 138584 . 138790)) (139046 143123 (\HARDCURSORUP 139056 . 140938) ( -\HARDCURSORPOSITION 140940 . 142976) (\HARDCURSORDOWN 142978 . 143121)) (143124 167184 (CURSOR.INIT -143134 . 146834) (\CURSORDESTINATION 146836 . 149154) (\SOFTCURSORUP 149156 . 154410) ( -\SOFTCURSORUPCURRENT 154412 . 161448) (\SOFTCURSORPOSITION 161450 . 162215) (\SOFTCURSORDOWN 162217 . -162925) (CURSORPROP 162927 . 163269) (GETCURSORPROP 163271 . 163459) (PUTCURSORPROP 163461 . 164616) ( -\CURSORBITSPERPIXEL 164618 . 166734) (\CURSORIMAGEPROPNAME 166736 . 166960) (\CURSORMASKPROPNAME -166962 . 167182)) (167185 185135 (CURSORCREATE 167195 . 169870) (CURSOR 169872 . 171684) ( -\CURSOR-VALID-P 171686 . 172773) (\CURSORUP 172775 . 174490) (\CURSORPOSITION 174492 . 177020) ( -\CURSORDOWN 177022 . 177255) (ADJUSTCURSORPOSITION 177257 . 177835) (CURSORPOSITION 177837 . 179379) ( -CURSORSCREEN 179381 . 180037) (CURSOREXIT 180039 . 181430) (FLIPCURSOR 181432 . 182558) (FLIPCURSORBAR - 182560 . 183540) (LASTMOUSEX 183542 . 183796) (LASTMOUSEY 183798 . 184052) (CREATEPOSITION 184054 . -184260) (POSITIONP 184262 . 184546) (CURSORHOTSPOT 184548 . 185133)) (186373 187921 (GETMOUSESTATE -186383 . 187042) (\EVENTKEYS 187044 . 187919)) (194120 194916 (MACHINETYPE 194130 . 194530) ( -SETMAINTPANEL 194532 . 194914)) (194946 196085 (BEEPON 194956 . 195609) (BEEPOFF 195611 . 196083)) ( -196536 196799 (WITHOUT-INTERRUPTS 196546 . 196797))))) + (FILEMAP (NIL (14591 21907 (BKSYSCHARCODE 14601 . 14950) (\CLEARSYSBUF 14952 . 15510) (\GETKEY 15512 + . 16687) (\NSYSBUFCHARS 16689 . 17431) (\SAVESYSBUF 17433 . 19042) (\SYSBUFP 19044 . 19348) ( +\GETSYSBUF 19350 . 19530) (\PUTSYSBUF 19532 . 20745) (\PEEKSYSBUF 20747 . 21905)) (23192 60750 ( +\KEYBOARDINIT 23202 . 24922) (\KEYBOARDEVENTFN 24924 . 29624) (\ALLOCLOCKED 29626 . 30216) ( +\SETIOPOINTERS 30218 . 34754) (\KEYBOARDOFF 34756 . 35170) (\KEYBOARDON 35172 . 35551) (\KEYHANDLER +35553 . 35684) (\KEYHANDLER1 35686 . 43132) (\RESETKEYBOARD 43134 . 44782) (\DOMOUSECHORDING 44784 . +48604) (\DOTRANSITIONS 48606 . 49283) (\DECODETRANSITION 49285 . 56698) (MOUSECHORDWAIT 56700 . 57364) + (\TRACKCURSOR 57366 . 60748)) (95220 117093 (KEYACTION 95230 . 96083) (KEYACTIONTABLE 96085 . 97267) +(KEYBOARDTYPE 97269 . 98371) (RESETKEYACTION 98373 . 100132) (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS +100134 . 102036) (\KEYACTION1 102038 . 112154) (KEYDOWNP 112156 . 112491) (KEYNUMBERP 112493 . 112691) + (\KEYNAMETONUMBER 112693 . 113387) (\KEYNUMBERTONAME 113389 . 113579) (MODIFY.KEYACTIONS 113581 . +114442) (METASHIFT 114444 . 115388) (SHIFTDOWNP 115390 . 117091)) (117156 117452 ( +SETUP.OFFICE.KEYBOARD 117166 . 117450)) (120431 122143 (\INIT.KEYBOARD.STREAM 120441 . 122141)) ( +122408 138785 (\DOBUFFEREDTRANSITIONS 122418 . 137848) (\TIMER.INTERRUPTFRAME 137850 . 138575) ( +\PERIODIC.INTERRUPTFRAME 138577 . 138783)) (139039 143116 (\HARDCURSORUP 139049 . 140931) ( +\HARDCURSORPOSITION 140933 . 142969) (\HARDCURSORDOWN 142971 . 143114)) (143117 167177 (CURSOR.INIT +143127 . 146827) (\CURSORDESTINATION 146829 . 149147) (\SOFTCURSORUP 149149 . 154403) ( +\SOFTCURSORUPCURRENT 154405 . 161441) (\SOFTCURSORPOSITION 161443 . 162208) (\SOFTCURSORDOWN 162210 . +162918) (CURSORPROP 162920 . 163262) (GETCURSORPROP 163264 . 163452) (PUTCURSORPROP 163454 . 164609) ( +\CURSORBITSPERPIXEL 164611 . 166727) (\CURSORIMAGEPROPNAME 166729 . 166953) (\CURSORMASKPROPNAME +166955 . 167175)) (167178 185128 (CURSORCREATE 167188 . 169863) (CURSOR 169865 . 171677) ( +\CURSOR-VALID-P 171679 . 172766) (\CURSORUP 172768 . 174483) (\CURSORPOSITION 174485 . 177013) ( +\CURSORDOWN 177015 . 177248) (ADJUSTCURSORPOSITION 177250 . 177828) (CURSORPOSITION 177830 . 179372) ( +CURSORSCREEN 179374 . 180030) (CURSOREXIT 180032 . 181423) (FLIPCURSOR 181425 . 182551) (FLIPCURSORBAR + 182553 . 183533) (LASTMOUSEX 183535 . 183789) (LASTMOUSEY 183791 . 184045) (CREATEPOSITION 184047 . +184253) (POSITIONP 184255 . 184539) (CURSORHOTSPOT 184541 . 185126)) (186366 187914 (GETMOUSESTATE +186376 . 187035) (\EVENTKEYS 187037 . 187912)) (194113 194909 (MACHINETYPE 194123 . 194523) ( +SETMAINTPANEL 194525 . 194907)) (194939 196078 (BEEPON 194949 . 195602) (BEEPOFF 195604 . 196076)) ( +196529 196792 (WITHOUT-INTERRUPTS 196539 . 196790))))) STOP diff --git a/sources/LLKEY.LCOM b/sources/LLKEY.LCOM index aba3cfe8..23744f5f 100644 Binary files a/sources/LLKEY.LCOM and b/sources/LLKEY.LCOM differ diff --git a/sources/LLPACKAGE b/sources/LLPACKAGE index e8ff841d..e7031140 100644 --- a/sources/LLPACKAGE +++ b/sources/LLPACKAGE @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10) -(IL:FILECREATED " 5-Sep-2024 17:42:20" IL:|{DSK}matt>Interlisp>medley>sources>LLPACKAGE.;3| 87515 +(IL:FILECREATED " 2-Nov-2025 19:49:02" IL:|{DSK}matt>Interlisp>medley>sources>LLPACKAGE.;2| 92970 :EDIT-BY "mth" :CHANGES-TO (IL:FNS XCL:DEFPACKAGE) - :PREVIOUS-DATE " 4-Sep-2024 13:17:23" IL:|{DSK}matt>Interlisp>medley>sources>LLPACKAGE.;2| + :PREVIOUS-DATE "30-Oct-2025 14:25:43" IL:|{DSK}matt>Interlisp>medley>sources>LLPACKAGE.;1| ) @@ -524,7 +524,9 @@ (IL:DEFINEQ (XCL:DEFPACKAGE - (IL:NLAMBDA IL:ARGS (IL:* IL:\; "Edited 4-Sep-2024 13:17 by mth") + (IL:NLAMBDA IL:ARGS (IL:* IL:\; "Edited 2-Nov-2025 19:48 by mth") + (IL:* IL:\; "Edited 30-Oct-2025 11:34 by mth") + (IL:* IL:\; "Edited 4-Sep-2024 13:17 by mth") (IL:* IL:\; "Edited 2-Dec-87 10:39 by raf") (IL:SETQ IL:ARGS (XCL:REMOVE-COMMENTS IL:ARGS)) (LET @@ -571,6 +573,30 @@ IL:SYMBOL))) PACKAGE)) (:IMPORT (IMPORT VALUES PACKAGE)) + (:IMPORT-FROM (LET* ((PACKAGE-NAME (POP VALUES)) + (XCL::PACKAGE-FROM (FIND-PACKAGE PACKAGE-NAME))) + (IMPORT (IL:MAPCAR VALUES + (IL:FUNCTION (IL:LAMBDA (XCL::SN) + (COND + ((IL:LITATOM XCL::SN) + (SETQ XCL::SN + (SYMBOL-NAME + XCL::SN)))) + (COND + ((IL:STRINGP XCL::SN) + (OR (FIND-SYMBOL + XCL::SN + XCL::PACKAGE-FROM + ) + (ERROR + "Symbol ~S not found in package ~S in :import-from option of defpackage" + XCL::SN + PACKAGE-NAME + ))) + (T (IL:ERROR + "Bad object in :import-from option of defpackage " + XCL::SN)))))) + PACKAGE))) ((:SHADOW :SHADOWING-IMPORT) (LET ((IL:SYMBOLS-TO-SHADOW (IL:MAPCONC VALUES @@ -620,7 +646,8 @@ ((:PREFIX-NAME :INTERNAL-SYMBOLS :EXTERNAL-SYMBOLS :EXTERNAL-ONLY) (LIST IL:KEY (CAR VALUES))) - ((:SHADOW :EXPORT :IMPORT :SHADOWING-IMPORT) + ((:SHADOW :EXPORT :IMPORT :IMPORT-FROM + :SHADOWING-IMPORT) (IL:SETQ IL:POST-MAKE-FORMS (CONS (CONS IL:KEY VALUES) IL:POST-MAKE-FORMS)) @@ -648,6 +675,37 @@ PACKAGE)) (:IMPORT (IMPORT (CDR IL:FORM) PACKAGE)) + (:IMPORT-FROM (LET* ((PACKAGE-NAME (CADR IL:FORM)) + (XCL::PACKAGE-FROM (FIND-PACKAGE PACKAGE-NAME))) + (IMPORT (IL:MAPCAR (CDDR IL:FORM) + (IL:FUNCTION (IL:LAMBDA (XCL::SN) + (COND + ((IL:LITATOM + XCL::SN) + (SETQ + XCL::SN + (SYMBOL-NAME + XCL::SN)))) + (COND + ((IL:STRINGP + XCL::SN) + (OR + (FIND-SYMBOL + XCL::SN + XCL::PACKAGE-FROM + ) + (ERROR + "Symbol ~S not found in package ~S in :import-from option of defpackage" + XCL::SN + + PACKAGE-NAME + ))) + (T (IL:ERROR + + "Bad object in :import-from option of defpackage " + XCL::SN))))) + ) + PACKAGE))) (:SHADOWING-IMPORT (SHADOWING-IMPORT (CDR IL:FORM) PACKAGE)) @@ -1663,7 +1721,7 @@ (IL:* IL:|;;| "Proper compiler, readtable and package environment") -(IL:PUTPROPS IL:LLPACKAGE IL:FILETYPE COMPILE-FILE) +(IL:PUTPROPS IL:LLPACKAGE IL:FILETYPE :FAKE-COMPILE-FILE) (IL:PUTPROPS IL:LLPACKAGE IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "LISP")) (IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY IL:COMPILERVARS @@ -1691,23 +1749,23 @@ IL:\\PKG-FIND-FREE-PACKAGE-INDEX 17838 . 18248)) (18305 18451 (IL:SETF-SYMBOL-PA IL:ENTRY-HASH 20528 . 20919)) (20968 21314 (IL:COUNT-PACKAGE-HASHTABLE 20968 . 21314)) (21316 21488 ( IL:INTERNAL-SYMBOL-COUNT 21316 . 21488)) (21490 21608 (IL:EXTERNAL-SYMBOL-COUNT 21490 . 21608)) (21610 22766 (IL:ENTER-NEW-NICKNAMES 21610 . 22766)) (22768 23194 (IL:MAKE-PRIME-HASHTABLE-SIZE 22768 . -23194)) (23196 24845 (MAKE-PACKAGE 23196 . 24845)) (24846 34317 (XCL:DEFPACKAGE 24859 . 34315)) (34366 - 34588 (FIND-PACKAGE 34366 . 34588)) (34590 37951 (USE-PACKAGE 34590 . 37951)) (37953 38433 ( -IN-PACKAGE 37953 . 38433)) (38435 38709 (XCL:PKG-GOTO 38435 . 38709)) (38711 39811 (RENAME-PACKAGE -38711 . 39811)) (39813 41264 (XCL:DELETE-PACKAGE 39813 . 41264)) (41266 44212 (EXPORT 41266 . 44212)) -(44214 45457 (UNEXPORT 44214 . 45457)) (45459 47103 (IMPORT 45459 . 47103)) (47105 48385 ( -SHADOWING-IMPORT 47105 . 48385)) (48387 49441 (SHADOW 48387 . 49441)) (49443 50098 (UNUSE-PACKAGE -49443 . 50098)) (50162 50468 (LIST-ALL-PACKAGES 50162 . 50468)) (50525 54208 (IL:ADD-SYMBOL 50525 . -54208)) (54210 58263 (IL:WITH-SYMBOL 54210 . 58263)) (58265 59568 (IL:INTERN* 58265 . 59568)) (59570 -65402 (IL:FIND-SYMBOL* 59570 . 65402)) (65404 66855 (INTERN 65404 . 66855)) (66857 67435 (FIND-SYMBOL -66857 . 67435)) (67493 68389 (IL:NUKE-SYMBOL 67493 . 68389)) (68391 70505 (UNINTERN 68391 . 70505)) ( -70507 71650 (IL:MOBY-UNINTERN 70507 . 71650)) (71709 71781 (IL:\\INDEXATOMPNAME 71709 . 71781)) (71893 - 72040 (IL:MAKE-DO-SYMBOLS-VARS 71893 . 72040)) (72042 73497 (IL:MAKE-DO-SYMBOLS-CODE 72042 . 73497)) -(73501 74279 (DO-EXTERNAL-SYMBOLS 73501 . 74279)) (74281 75627 (XCL:DO-LOCAL-SYMBOLS 74281 . 75627)) ( -75629 76745 (XCL:DO-INTERNAL-SYMBOLS 75629 . 76745)) (76747 79045 (DO-SYMBOLS 76747 . 79045)) (79047 -80729 (DO-ALL-SYMBOLS 79047 . 80729)) (80797 81322 (FIND-ALL-SYMBOLS 80797 . 81322)) (81324 81603 ( -IL:BRIEFLY-DESCRIBE-SYMBOL 81324 . 81603)) (81605 83119 (APROPOS 81605 . 83119)) (83121 84688 ( -APROPOS-LIST 83121 . 84688)) (84792 86319 (IL:FIND-EXTERNAL-SYMBOL 84792 . 86319)) (86321 86841 ( -IL:FIND-EXACT-SYMBOL 86321 . 86841)) (86843 86923 (IL:PACKAGE-NAME-AS-SYMBOL 86843 . 86923)) (86925 -87074 (IL:\\FIND.PACKAGE.INTERNAL 86925 . 87074))))) +23194)) (23196 24845 (MAKE-PACKAGE 23196 . 24845)) (24846 39766 (XCL:DEFPACKAGE 24859 . 39764)) (39815 + 40037 (FIND-PACKAGE 39815 . 40037)) (40039 43400 (USE-PACKAGE 40039 . 43400)) (43402 43882 ( +IN-PACKAGE 43402 . 43882)) (43884 44158 (XCL:PKG-GOTO 43884 . 44158)) (44160 45260 (RENAME-PACKAGE +44160 . 45260)) (45262 46713 (XCL:DELETE-PACKAGE 45262 . 46713)) (46715 49661 (EXPORT 46715 . 49661)) +(49663 50906 (UNEXPORT 49663 . 50906)) (50908 52552 (IMPORT 50908 . 52552)) (52554 53834 ( +SHADOWING-IMPORT 52554 . 53834)) (53836 54890 (SHADOW 53836 . 54890)) (54892 55547 (UNUSE-PACKAGE +54892 . 55547)) (55611 55917 (LIST-ALL-PACKAGES 55611 . 55917)) (55974 59657 (IL:ADD-SYMBOL 55974 . +59657)) (59659 63712 (IL:WITH-SYMBOL 59659 . 63712)) (63714 65017 (IL:INTERN* 63714 . 65017)) (65019 +70851 (IL:FIND-SYMBOL* 65019 . 70851)) (70853 72304 (INTERN 70853 . 72304)) (72306 72884 (FIND-SYMBOL +72306 . 72884)) (72942 73838 (IL:NUKE-SYMBOL 72942 . 73838)) (73840 75954 (UNINTERN 73840 . 75954)) ( +75956 77099 (IL:MOBY-UNINTERN 75956 . 77099)) (77158 77230 (IL:\\INDEXATOMPNAME 77158 . 77230)) (77342 + 77489 (IL:MAKE-DO-SYMBOLS-VARS 77342 . 77489)) (77491 78946 (IL:MAKE-DO-SYMBOLS-CODE 77491 . 78946)) +(78950 79728 (DO-EXTERNAL-SYMBOLS 78950 . 79728)) (79730 81076 (XCL:DO-LOCAL-SYMBOLS 79730 . 81076)) ( +81078 82194 (XCL:DO-INTERNAL-SYMBOLS 81078 . 82194)) (82196 84494 (DO-SYMBOLS 82196 . 84494)) (84496 +86178 (DO-ALL-SYMBOLS 84496 . 86178)) (86246 86771 (FIND-ALL-SYMBOLS 86246 . 86771)) (86773 87052 ( +IL:BRIEFLY-DESCRIBE-SYMBOL 86773 . 87052)) (87054 88568 (APROPOS 87054 . 88568)) (88570 90137 ( +APROPOS-LIST 88570 . 90137)) (90241 91768 (IL:FIND-EXTERNAL-SYMBOL 90241 . 91768)) (91770 92290 ( +IL:FIND-EXACT-SYMBOL 91770 . 92290)) (92292 92372 (IL:PACKAGE-NAME-AS-SYMBOL 92292 . 92372)) (92374 +92523 (IL:\\FIND.PACKAGE.INTERNAL 92374 . 92523))))) IL:STOP diff --git a/sources/LLPACKAGE.LCOM b/sources/LLPACKAGE.LCOM index aab75ccf..f0f9a44b 100644 Binary files a/sources/LLPACKAGE.LCOM and b/sources/LLPACKAGE.LCOM differ diff --git a/sources/MEDLEYDIR b/sources/MEDLEYDIR index 124a06c6..ef363133 100644 --- a/sources/MEDLEYDIR +++ b/sources/MEDLEYDIR @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Aug-2025 17:25:03" {DSK}larry>il>medley>sources>MEDLEYDIR.;36 12210 +(FILECREATED "26-Nov-2025 21:51:39" {WMEDLEY}MEDLEYDIR.;43 15970 - :EDIT-BY "lmm" + :EDIT-BY rmk - :CHANGES-TO (FNS MEDLEYDIR) + :CHANGES-TO (VARS MEDLEYDIRCOMS) - :PREVIOUS-DATE "18-Aug-2025 11:19:10" {DSK}larry>il>medley>sources>MEDLEYDIR.;34) + :PREVIOUS-DATE "26-Nov-2025 17:12:16" {WMEDLEY}MEDLEYDIR.;42) (PRETTYCOMPRINT MEDLEYDIRCOMS) @@ -25,7 +25,47 @@ (* ;; "**WARNING** The EVALed expressions get run early in the lodup.") - (VARS MEDLEY-INIT-VARS) + + (* ;; "The INITVARS prevents this from accumulating entries from other files that happen to have been loaded when this is worked on and saved. The loadup scripts set MEDLEY-INIT-VARS to NOBIND to make sure that these are the initial values (as opposed to whatever there was in the startup sysout. But the FONT cache variables have to be specified here, because FONT is in the INIT and the resetting to NOBIND would wipe out these entries even if they were already correct in the init sysout.") + + [INITVARS (MEDLEY-INIT-VARS '((\FONTEXISTS?-CACHE NIL RESET) + (\FONTSAVAILABLEFILECACHE NIL RESET) + [LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" + "internal" + "greetfiles" + "doctools"] + [LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"] + (LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES)) + (IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo")) + (IRM.DINFOGRAPH) + (DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES + )) + (LOGINHOST/DIR (LET [(LHD (DIRECTORYNAME (OR (UNIX-GETENV + "LOGINDIR") + (UNIX-GETENV + "HOME"] + (AND (GETD 'PSEUDOHOSTS) + (TARGETHOST 'LI) + (PSEUDOHOST 'LI LHD)) + LHD) + RESET) + (USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM)) + (CONS LOGINHOST/DIR '("INIT"] + RESET) + (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/medleydisplayfonts" + "fonts/displayfonts") + NIL NIL T)) + (POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts" + ) + NIL NIL T)) + (INTERPRESSFONTDIRECTORIES (MEDLEYDIR '("fonts/ipfonts") + NIL NIL T)) + (UNICODEDIRECTORIES (MEDLEYDIR '("unicode/xerox") + NIL NIL T)) + (XCL::*WHERE-IS-CASH-FILES* (MEDLEYDIR '("loadups") + "whereis.hash" NIL T)) + (LOADUPSDIRECTORIES (MEDLEYDIR '("loadups") + NIL NIL T] (DECLARE%: EVAL@COMPILE DOCOPY (ADDVARS (GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS]) @@ -201,50 +241,49 @@ (* ;; "**WARNING** The EVALed expressions get run early in the lodup.") -(RPAQQ MEDLEY-INIT-VARS - ((ShellBrowser) - (ShellOpener) - [LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"] - [LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"] - (LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES)) - (IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo")) - (IRM.DINFOGRAPH) - (DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES)) - (LOGINHOST/DIR (LET [(LHD (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR") - (UNIX-GETENV "HOME"] - (AND (GETD 'PSEUDOHOSTS) - (TARGETHOST 'LI) - (PSEUDOHOST 'LI LHD)) - LHD)) - [USERGREETFILES (LIST (CONS LOGINHOST/DIR '("INIT" COM)) - (CONS LOGINHOST/DIR '("INIT"] - (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/medleydisplayfonts" "fonts/displayfonts") - NIL NIL T)) - (POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts") - NIL NIL T)) - (INTERPRESSFONTDIRECTORIES (MEDLEYDIR '("fonts/ipfonts") - NIL NIL T)) - (UNICODEDIRECTORIES (MEDLEYDIR '("unicode/xerox") - NIL NIL T)) - (LOGINHOST/DIR (LET [(LHD (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR") - (UNIX-GETENV "HOME"] - (AND (GETD 'PSEUDOHOSTS) - (TARGETHOST 'LI) - (PSEUDOHOST 'LI LHD)) - LHD) - RESET) - (USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM)) - (CONS LOGINHOST/DIR '("INIT"] - RESET) - (XCL::*WHERE-IS-CASH-FILES* (MEDLEYDIR '("loadups") - "whereis.hash" NIL T)) - (LOADUPSDIRECTORIES (MEDLEYDIR '("loadups") - NIL NIL T)))) + + +(* ;; +"The INITVARS prevents this from accumulating entries from other files that happen to have been loaded when this is worked on and saved. The loadup scripts set MEDLEY-INIT-VARS to NOBIND to make sure that these are the initial values (as opposed to whatever there was in the startup sysout. But the FONT cache variables have to be specified here, because FONT is in the INIT and the resetting to NOBIND would wipe out these entries even if they were already correct in the init sysout." +) + + +(RPAQ? MEDLEY-INIT-VARS + '((\FONTEXISTS?-CACHE NIL RESET) + (\FONTSAVAILABLEFILECACHE NIL RESET) + [LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"] + [LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"] + (LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES)) + (IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo")) + (IRM.DINFOGRAPH) + (DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES)) + (LOGINHOST/DIR (LET [(LHD (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR") + (UNIX-GETENV "HOME"] + (AND (GETD 'PSEUDOHOSTS) + (TARGETHOST 'LI) + (PSEUDOHOST 'LI LHD)) + LHD) + RESET) + (USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM)) + (CONS LOGINHOST/DIR '("INIT"] + RESET) + (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/medleydisplayfonts" "fonts/displayfonts") + NIL NIL T)) + (POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts") + NIL NIL T)) + (INTERPRESSFONTDIRECTORIES (MEDLEYDIR '("fonts/ipfonts") + NIL NIL T)) + (UNICODEDIRECTORIES (MEDLEYDIR '("unicode/xerox") + NIL NIL T)) + (XCL::*WHERE-IS-CASH-FILES* (MEDLEYDIR '("loadups") + "whereis.hash" NIL T)) + (LOADUPSDIRECTORIES (MEDLEYDIR '("loadups") + NIL NIL T)))) (DECLARE%: EVAL@COMPILE DOCOPY (ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1675 9578 (MEDLEY-INIT-VARS 1685 . 5163) (MEDLEYDIR 5165 . 8378) (MEDLEYSUBSTDIR 8380 - . 9358) (SET-SYSOUT-COMMIT 9360 . 9576))))) + (FILEMAP (NIL (5329 13232 (MEDLEY-INIT-VARS 5339 . 8817) (MEDLEYDIR 8819 . 12032) (MEDLEYSUBSTDIR +12034 . 13012) (SET-SYSOUT-COMMIT 13014 . 13230))))) STOP diff --git a/sources/MEDLEYDIR.LCOM b/sources/MEDLEYDIR.LCOM index c6e924a0..8ad061fb 100644 Binary files a/sources/MEDLEYDIR.LCOM and b/sources/MEDLEYDIR.LCOM differ diff --git a/sources/SEDIT-COMMANDS b/sources/SEDIT-COMMANDS index 873ddfa0..1a35d083 100644 --- a/sources/SEDIT-COMMANDS +++ b/sources/SEDIT-COMMANDS @@ -1,14 +1,13 @@ (DEFINE-FILE-INFO PACKAGE (DEFPACKAGE SEDIT (USE LISP XCL)) READTABLE "XCL" BASE 10) -(IL:FILECREATED "15-Aug-2021 21:22:22" -IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;7| 125181 - IL:|changes| IL:|to:| (IL:VARS IL:SEDIT-COMMANDSCOMS) +(IL:FILECREATED "13-Nov-2025 00:19:24" IL:|{WMEDLEY}SEDIT-COMMANDS.;5| 124301 - IL:|previous| IL:|date:| "14-Aug-2021 12:59:29" -IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) + :EDIT-BY IL:|rmk| + :CHANGES-TO (IL:VARIABLES COMMAND-TABLE-SPEC) + + :PREVIOUS-DATE "13-Nov-2025 00:14:31" IL:|{WMEDLEY}SEDIT-COMMANDS.;4|) -; Copyright (c) 1986-1988, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (IL:PRETTYCOMPRINT IL:SEDIT-COMMANDSCOMS) @@ -30,18 +29,18 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) IL:\; < > IL:\.)))) (IL:FUNCTIONS - (IL:* IL:|;;| "pseudo-selections") + (IL:* IL:|;;| "pseudo-selections") PSEUDO-SELECTION-FROM-SELECTION COMPOSE-PSEUDO-SELECTION DECOMPOSE-PSEUDO-SELECTION SELECTION-FROM-PSEUDO-SELECTION SELECT-PSEUDO-SEGMENT) - (IL:* IL:|;;| "user interface to adding new commands") + (IL:* IL:|;;| "user interface to adding new commands") (IL:FUNCTIONS ADD-COMMAND GET-SELECTION REPLACE-SELECTION RESET-COMMANDS DEFAULT-COMMANDS) (IL:VARIABLES DEFAULT-COMMAND-TABLE-SPEC FIRST-ADD-COMMAND FIRST-ADD-COMMAND-MENU-ENTRY) (IL:FUNCTIONS - (IL:* IL:|;;| "building help menu") + (IL:* IL:|;;| "building help menu") EQUALIZE-STRING-WIDTHS MINIMUM-STRING-WIDTH MAXIMUM-STRING-WIDTH) (IL:FUNCTIONS FIND-AND-DISPLAY-STRUCTURE FIND-AND-DISPLAY-STRUCTURE-BACKWARDS @@ -65,8 +64,8 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (IL:PUTPROPS IL:SEDIT-COMMANDS IL:FILETYPE :COMPILE-FILE) (IL:PUTPROPS IL:SEDIT-COMMANDS IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE - (DEFPACKAGE IL:SEDIT - (:USE IL:LISP IL:XCL)))) + (DEFPACKAGE IL:SEDIT (:USE IL:LISP + IL:XCL)))) (IL:DECLARE\: IL:DOEVAL@COMPILE IL:DONTCOPY (IL:LOCALVARS . T) @@ -78,10 +77,10 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFPARAMETER COMMAND-TABLE-SPEC -(IL:* IL:|;;;| "each entry in the COMMAND-TABLE-SPEC should be of the form: ( +) where is an atom function name or a list whose car is the function name and the rest are the extra arguments (beyond context and charcode), is a list of strings for the name, key-name, and help-string, is T if the caret should be normalized after this command, and + is one or more key specifier which can be passed to charcode (if non-list) or whose car is a termtable syntax (if a list).") +(IL:* IL:|;;;| "each entry in the COMMAND-TABLE-SPEC should be of the form: ( +) where is an atom function name or a list whose car is the function name and the rest are the extra arguments (beyond context and charcode), is a list of strings for the name, key-name, and help-string, is T if the caret should be normalized after this command, and + is one or more key specifier which can be passed to charcode (if non-list) or whose car is a termtable syntax (if a list).") '( - (IL:* IL:|;;| "STRUCTURE CONTROL") + (IL:* IL:|;;| "STRUCTURE CONTROL") (INSERT-NULL-LIST NIL T (IL:LEFTPAREN)) (CLOSE-LIST NIL NIL (IL:RIGHTPAREN)) @@ -104,7 +103,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) ((INPUT-QUOTE COMMA-AT) NIL NIL "@") - (IL:* IL:|;;| "EDIT CONTROL") + (IL:* IL:|;;| "EDIT CONTROL") (DELETE-SELECTION NIL T IL:DEL) (BACKSPACE NIL T IL:BS "^A") @@ -114,7 +113,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) ((VERIFY-STRUCTURE NIL T NIL) NIL NIL "Meta,^L") - (IL:* IL:|;;| "COMPLETION") + (IL:* IL:|;;| "COMPLETION") ((COMPLETE :ABORT NIL) ("Abort" "M-A" "Complete this edit without installing changes.") @@ -134,14 +133,14 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) ("Done, Compile, & Close" "C-M-C" "Complete this edit, compile, and close the window.") NIL "Meta,^C") - (IL:* IL:|;;| "COMMANDS") + (IL:* IL:|;;| "COMMANDS") (NULL ("" "" "") NIL 0) (UNDO ("Undo" "M-U" "Undo the last change made.") - NIL "Meta,U" "Meta,u" "Function,^D" (UNDO)) + NIL "Meta,U" "Meta,u" "Function,^D" (UNDO)) (REDO ("Redo" "M-R" "Redo the last change undone.") - NIL "Meta,R" "Meta,r" "Function,Bs" (REDO)) + NIL "Meta,R" "Meta,r" "Function,Bs" (REDO)) (NULL ("" "" "") NIL 0) (FIND-OBJ ("Find" "M-F" "Find the current selection, or prompt for structure to Find.") @@ -161,7 +160,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (EDIT-HELP ("Arglist" "M-H" "Show the argument list for the selected function.") NIL "Meta,H" "Meta,h" "Function,^A" (ARGLIST)) (CONVERT-COMMENT ("Convert Comment" "M-;" - "Convert the old style comments in the current selection.") + "Convert the old style comments in the current selection.") NIL "Meta,;") (COMMENT-OUT-SELECTION NIL NIL "Meta,^;") (EDIT-SELECTION ("Edit" "M-O" "Edit the definition of the current selection.") @@ -173,13 +172,13 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) NIL "Meta,E" "Meta,e" (EVAL)) (EXPAND ("Expand" "M-X" "Replace the current selection with its definition.") NIL "Meta,X" "Meta,x" IL:ESC "Function,^T" (EXPAND)) - (EXTRACT-CURRENT-SELECTION ("Extract" "M-/" - "Extract one level of structure: unquote or unlist.") + (EXTRACT-CURRENT-SELECTION ("Extract" "M-/" "Extract one level of structure: unquote or unlist." + ) NIL "Meta,/" (EXTRACT)) (INSPECT-SELECTION ("Inspect" "M-I" "Inspect the current selection.") NIL "Meta,I" "Meta,i" (INSPECT)) (JOIN ("Join" "M-J" "Join selected items together.") - NIL "Meta,J" "Meta,j" (JOIN)) + NIL "Meta,J" "Meta,j" (JOIN)) (MUTATE ("Mutate" "M-Z" "Prompt for a function to operate on the current selection.") NIL "Meta,Z" "Meta,z") ((PARENTHESIZE-CURRENT-SELECTION NIL) @@ -209,7 +208,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (ADD-MENU ("Attach Menu" "M-M" "Attach a command menu.") NIL "Meta,M" "Meta,m") - (IL:* IL:|;;| "RANDOM: tells Meta-Space or Meta-Return to scroll to the selection, using the auto-scroller for free.") + (IL:* IL:|;;| "RANDOM: tells Meta-Space or Meta-Return to scroll to the selection, using the auto-scroller for free.") (TRUE NIL T "Meta, " "Meta,CR"))) @@ -269,19 +268,18 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (IL:RPAQ? MENUS NIL) (IL:DECLARE\: IL:EVAL@COMPILE -(IL:RPAQ WORD-DELIM-CHARS (IL:CHARCODE (IL:SPACE IL:CR IL:TAB - IL:{ IL:} IL:[ IL:] IL:\; < > - IL:\.))) +(IL:RPAQ WORD-DELIM-CHARS (IL:CHARCODE (IL:SPACE IL:CR IL:TAB - IL:{ IL:} IL:[ IL:] IL:\; < > IL:\.))) -(IL:CONSTANTS (WORD-DELIM-CHARS (IL:CHARCODE (IL:SPACE IL:CR IL:TAB - IL:{ IL:} IL:[ IL:] IL:\; < - > IL:\.)))) +(IL:CONSTANTS (WORD-DELIM-CHARS (IL:CHARCODE (IL:SPACE IL:CR IL:TAB - IL:{ IL:} IL:[ IL:] IL:\; < > + IL:\.)))) ) (DEFUN PSEUDO-SELECTION-FROM-SELECTION (SEL) -(IL:* IL:|;;;| "A pseudo-selection is either a node or a list of a node and two integers. It's interpreted as the select-node, select-start, and select-end fields of a selection.") +(IL:* IL:|;;;| "A pseudo-selection is either a node or a list of a node and two integers. It's interpreted as the select-node, select-start, and select-end fields of a selection.") -(IL:* IL:|;;;| "This function takes a selection and creates a pseudo selection from it.") +(IL:* IL:|;;;| "This function takes a selection and creates a pseudo selection from it.") (COMPOSE-PSEUDO-SELECTION (IL:FETCH SELECT-NODE IL:OF SEL) (IL:FETCH SELECT-START IL:OF SEL) @@ -290,9 +288,9 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN COMPOSE-PSEUDO-SELECTION (NODE &OPTIONAL START END) -(IL:* IL:|;;;| "A pseudo-selection is either a node or a list of a node and two integers. It's interpreted as the select-node, select-start, and select-end fields of a selection.") +(IL:* IL:|;;;| "A pseudo-selection is either a node or a list of a node and two integers. It's interpreted as the select-node, select-start, and select-end fields of a selection.") -(IL:* IL:|;;;| "This function takes the fields of a pseudo selection and hands back one.") +(IL:* IL:|;;;| "This function takes the fields of a pseudo selection and hands back one.") (COND ((LISTP NODE) @@ -308,9 +306,9 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN DECOMPOSE-PSEUDO-SELECTION (PSEL) -(IL:* IL:|;;;| "A pseudo-selection is either a node or a list of a node and two integers. It's interpreted as the select-node, select-start, and select-end fields of a selection.") +(IL:* IL:|;;;| "A pseudo-selection is either a node or a list of a node and two integers. It's interpreted as the select-node, select-start, and select-end fields of a selection.") -(IL:* IL:|;;;| "This function takes a pseudo selection and hands its fields back as values.") +(IL:* IL:|;;;| "This function takes a pseudo selection and hands its fields back as values.") (IF (LISTP PSEL) (VALUES (FIRST PSEL) @@ -322,9 +320,9 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN SELECTION-FROM-PSEUDO-SELECTION (PSEL &OPTIONAL SEL) -(IL:* IL:|;;;| "A pseudo-selection is either a node or a list of a node and two integers. It's interpreted as the select-node, select-start, and select-end fields of a selection.") +(IL:* IL:|;;;| "A pseudo-selection is either a node or a list of a node and two integers. It's interpreted as the select-node, select-start, and select-end fields of a selection.") -(IL:* IL:|;;;| "This function takes a pseudo-selection and constructs the corresponding selection. If you don't hand it a selection structure, it conses one.") +(IL:* IL:|;;;| "This function takes a pseudo-selection and constructs the corresponding selection. If you don't hand it a selection structure, it conses one.") (UNLESS SEL (SETF SEL (IL:CREATE EDIT-SELECTION))) @@ -350,13 +348,13 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN ADD-COMMAND (KEY-CODE FORM &OPTIONAL SCROLL? KEY-NAME COMMAND-NAME HELP-STRING) (WHEN FIRST-ADD-COMMAND - (IL:* IL:|;;| "cache the command-table-spec so the user can undo this!") + (IL:* IL:|;;| "cache the command-table-spec so the user can undo this!") (SETQ DEFAULT-COMMAND-TABLE-SPEC (COPY-TREE COMMAND-TABLE-SPEC)) (SETQ FIRST-ADD-COMMAND NIL)) (WHEN (AND KEY-NAME COMMAND-NAME FIRST-ADD-COMMAND-MENU-ENTRY) - (IL:* IL:|;;| "add another separation line to the help menu.") + (IL:* IL:|;;| "add another separation line to the help menu.") (NCONC COMMAND-TABLE-SPEC (LIST (LIST 'NULL (LIST "-----" "" "") NIL 0))) @@ -366,8 +364,8 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) SCROLL? KEY-CODE))) (OR COMMAND-NAME FORM)) -(DEFUN GET-SELECTION (CONTEXT) (IL:* IL:\; "Edited 23-Apr-2018 18:11 by rmk:") - (IL:* IL:\; "Edited 22-Apr-2018 16:48 by rmk:") +(DEFUN GET-SELECTION (CONTEXT) (IL:* IL:\; "Edited 23-Apr-2018 18:11 by rmk:") + (IL:* IL:\; "Edited 22-Apr-2018 16:48 by rmk:") (LET* ((SELECTION (IL:FETCH SELECTION IL:OF CONTEXT)) (NODE (IL:FETCH SELECT-NODE IL:OF SELECTION)) (CHARS (IL:FETCH STRUCTURE IL:OF NODE)) @@ -377,7 +375,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (TYPE (IL:FETCH SELECT-TYPE IL:OF SELECTION)) NOT-ALL-SELECTED) - (IL:* IL:|;;| "All except NODE are needed for the atom/string cases") + (IL:* IL:|;;| "All except NODE are needed for the atom/string cases") (COND ((NULL NODE) @@ -388,7 +386,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (START :SUB-LIST) (T T)))) (T - (IL:* IL:|;;| "RMK: a single character-atom or a substring of characters in an atom or string. Full multicharacter atoms are structures. Code copies from COPY-SELECTION-LITATOM") + (IL:* IL:|;;| "RMK: a single character-atom or a substring of characters in an atom or string. Full multicharacter atoms are structures. Code copies from COPY-SELECTION-LITATOM") (WHEN (IL:TYPE? BROKEN-ATOM CHARS) (IL:SETQ CHARS (IL:FETCH ATOM-CHARS IL:OF CHARS))) @@ -396,7 +394,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (IL:NCHARS STRING)) (IL:NEQ START 1))) - (IL:* IL:|;;| "some subset of the atom/string has been selected") + (IL:* IL:|;;| "some subset of the atom/string has been selected") (IL:SETQ NOT-ALL-SELECTED T)) (VALUES (IL:MKSTRING (IF NOT-ALL-SELECTED @@ -428,16 +426,14 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (PENDING-DELETE POINT SELECTION) (INSERT POINT CONTEXT (COPY-LIST NEW-NODES)) - (IL:* IL:|;;| "try to select the stuff that was just inserted.") + (IL:* IL:|;;| "try to select the stuff that was just inserted.") (SELECT-PSEUDO-SEGMENT CONTEXT (COMPOSE-PSEUDO-SELECTION NEW-NODES)))) (DEFUN RESET-COMMANDS () (LET ((COMMANDS (CREATE-COMMAND-TABLE COMMAND-TABLE-SPEC))) - (IL:REPLACE (EDIT-ENV COMMAND-TABLE) IL:OF LISP-EDIT-ENVIRONMENT IL:WITH - (FIRST COMMANDS)) - (IL:REPLACE (EDIT-ENV HELP-MENU) IL:OF LISP-EDIT-ENVIRONMENT IL:WITH (SECOND - COMMANDS))) + (IL:REPLACE (EDIT-ENV COMMAND-TABLE) IL:OF LISP-EDIT-ENVIRONMENT IL:WITH (FIRST COMMANDS)) + (IL:REPLACE (EDIT-ENV HELP-MENU) IL:OF LISP-EDIT-ENVIRONMENT IL:WITH (SECOND COMMANDS))) T) (DEFUN DEFAULT-COMMANDS () @@ -456,13 +452,12 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) "Used in Add-Command to signal the first time a new command is added to the middle button menu, so that the user entries can be separated from the default entries" ) -(DEFUN EQUALIZE-STRING-WIDTHS (STRING-LIST FONT &OPTIONAL PRIN2? (DESIRED-WIDTH ( - MAXIMUM-STRING-WIDTH - STRING-LIST FONT - PRIN2?)) - (PAD-CHAR #\Space)) +(DEFUN EQUALIZE-STRING-WIDTHS (STRING-LIST FONT &OPTIONAL PRIN2? (DESIRED-WIDTH (MAXIMUM-STRING-WIDTH + STRING-LIST FONT + PRIN2?)) + (PAD-CHAR #\Space)) -(IL:* IL:|;;;| "Increase the width of all the strings in STRING-LIST to DESIRED-WIDTH by padding them on the right with PAD-CHAR.") +(IL:* IL:|;;;| "Increase the width of all the strings in STRING-LIST to DESIRED-WIDTH by padding them on the right with PAD-CHAR.") (DO ((PAD-CHAR-WIDTH (IL:CHARWIDTH (CHAR-CODE PAD-CHAR) FONT)) @@ -488,7 +483,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN FIND-AND-DISPLAY-STRUCTURE (CONTEXT STR &OPTIONAL SCOPE START WRAP?) -(IL:* IL:|;;;| "Find structure and display it by selecting it (point after) and normalizing the selection in the window. SCOPE defaults to the root structure of the CONTEXT. The WRAP? flag says to wrap failing searches around and try them again (i.e., ignore start and try again).") +(IL:* IL:|;;;| "Find structure and display it by selecting it (point after) and normalizing the selection in the window. SCOPE defaults to the root structure of the CONTEXT. The WRAP? flag says to wrap failing searches around and try them again (i.e., ignore start and try again).") (LET* ((PROMPTWINDOW (GET-PROMPT-WINDOW CONTEXT)) (TOP (SUBNODE 1 (IL:FETCH ROOT IL:OF CONTEXT))) @@ -503,7 +498,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN FIND-AND-DISPLAY-STRUCTURE-BACKWARDS (CONTEXT STR &OPTIONAL SCOPE END WRAP?) -(IL:* IL:|;;;| "Like find-and-display-structure, but searches backwards") +(IL:* IL:|;;;| "Like find-and-display-structure, but searches backwards") (LET* ((PROMPTWINDOW (GET-PROMPT-WINDOW CONTEXT)) (TOP (SUBNODE 1 (IL:FETCH ROOT IL:OF CONTEXT))) @@ -518,7 +513,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN FIND-AND-DISPLAY-SUBSTRUCTURE (CONTEXT STR &OPTIONAL SCOPE START WRAP?) -(IL:* IL:|;;;| "Find substructure and display it by selecting it (pending delete) and normalizing the selection in the window. SCOPE defaults to the root structure of the CONTEXT. The WRAP? flag says to wrap failing searches around and try them again (i.e., ignore start and try again).") +(IL:* IL:|;;;| "Find substructure and display it by selecting it (pending delete) and normalizing the selection in the window. SCOPE defaults to the root structure of the CONTEXT. The WRAP? flag says to wrap failing searches around and try them again (i.e., ignore start and try again).") (LET* ((PROMPTWINDOW (GET-PROMPT-WINDOW CONTEXT)) (TOP (SUBNODE 1 (IL:FETCH ROOT IL:OF CONTEXT))) @@ -533,7 +528,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS (CONTEXT STR &OPTIONAL SCOPE END WRAP?) -(IL:* IL:|;;;| "Like find-and-display-substructure but searches backwards") +(IL:* IL:|;;;| "Like find-and-display-substructure but searches backwards") (LET* ((PROMPTWINDOW (GET-PROMPT-WINDOW CONTEXT)) (TOP (SUBNODE 1 (IL:FETCH ROOT IL:OF CONTEXT))) @@ -548,7 +543,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN FIND-NTH-STRUCTURE (CONTEXT CHARCODE STRUCTURE N) -(IL:* IL:|;;;| "Find the Nth occurance of Structure in this edit, always starting from the beginning. This function is used as an external command to set the selection to a desired structure. Find, select, and normalize.") +(IL:* IL:|;;;| "Find the Nth occurance of Structure in this edit, always starting from the beginning. This function is used as an external command to set the selection to a desired structure. Find, select, and normalize.") (LET ((TOP (SUBNODE 1 (IL:FETCH ROOT IL:OF CONTEXT)))) (DO ((M 1 (+ M 1)) @@ -561,13 +556,13 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN FIND-NODE-SUBSTRUCTURE (STR STRLEN NODE &OPTIONAL START END CONTINUATION?) -(IL:* IL:|;;;| "STR is a list of structures of length STRLEN. NODE, together with START and END (which are subnode indices), is taken to indicate a subtree. We return a pseudo-selection which selects the first sequence of sibling nodes in that subtree whose successive structures match the successive elements of STR.") +(IL:* IL:|;;;| "STR is a list of structures of length STRLEN. NODE, together with START and END (which are subnode indices), is taken to indicate a subtree. We return a pseudo-selection which selects the first sequence of sibling nodes in that subtree whose successive structures match the successive elements of STR.") -(IL:* IL:|;;;| "\"First\" here is taken to mean \"first in linearization order\", so we have to do a careful recursion which: (1a) recursively checks the subtree rooted at the START subnode of NODE (default the first), (1b) checks if the START subnode starts a matching sibling sequence, (2a) recursively checks the subtree rooted at the START+1 subnode of NODE, (2b) checks if the START+1 subnode starts a matching sibling sequence, . . ., (Na) recusively checks the subtree rooted at the END subnode of NODE (default the last), (Nb) checks if the END subnode starts a matching sibling sequence [note that such a sequence could be only 1 node long since END is the right end of the subtree being checked].") +(IL:* IL:|;;;| "\"First\" here is taken to mean \"first in linearization order\", so we have to do a careful recursion which: (1a) recursively checks the subtree rooted at the START subnode of NODE (default the first), (1b) checks if the START subnode starts a matching sibling sequence, (2a) recursively checks the subtree rooted at the START+1 subnode of NODE, (2b) checks if the START+1 subnode starts a matching sibling sequence, . . ., (Na) recusively checks the subtree rooted at the END subnode of NODE (default the last), (Nb) checks if the END subnode starts a matching sibling sequence [note that such a sequence could be only 1 node long since END is the right end of the subtree being checked].") -(IL:* IL:|;;;| "N.B. It might seem that, to get true linearization order, we should check to see if a node starts a matching sibling sequence before we check its subtree. But since node structures can not be circular, we know that if a match is found in the subtree below a node then that node could not have started a matching sequence.") +(IL:* IL:|;;;| "N.B. It might seem that, to get true linearization order, we should check to see if a node starts a matching sibling sequence before we check its subtree. But since node structures can not be circular, we know that if a match is found in the subtree below a node then that node could not have started a matching sequence.") -(IL:* IL:|;;;| "The CONTINUATION? flag means that we are continuing a search that has already recursively checked the START subnode, so we skip that particular recursion. This generally happens when we are working our way up and to the right in some subtree which has already been partially checked.") +(IL:* IL:|;;;| "The CONTINUATION? flag means that we are continuing a search that has already recursively checked the START subnode, so we skip that particular recursion. This generally happens when we are working our way up and to the right in some subtree which has already been partially checked.") (SETF START (OR START 1)) (LET* ((SUBNODES (IL:FETCH SUB-NODES IL:OF NODE)) @@ -593,7 +588,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN FIND-NODE-SUBSTRUCTURE-BACKWARDS (STR STRLEN NODE &OPTIONAL START END CONTINUATION?) -(IL:* IL:|;;;| "Like find-node-substructure but searches in reverse linearization order.") +(IL:* IL:|;;;| "Like find-node-substructure but searches in reverse linearization order.") (LET* ((SUBNODES (IL:FETCH SUB-NODES IL:OF NODE)) (SUBLENGTH (FIRST SUBNODES))) @@ -610,8 +605,8 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) ((OR (NULL SUBS) (AND START (< INDEX START))) NIL) - (WHEN (AND DOSUBS? (SETF MATCH (FIND-NODE-SUBSTRUCTURE-BACKWARDS STR STRLEN - (FIRST SUBS)))) + (WHEN (AND DOSUBS? (SETF MATCH (FIND-NODE-SUBSTRUCTURE-BACKWARDS STR STRLEN (FIRST SUBS))) + ) (RETURN MATCH)) (UNLESS (OR (< STARTINDEX 1) (MISMATCH STR SUBS :END2 STRLEN :TEST @@ -621,7 +616,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN FIND-OBJ (CONTEXT &OPTIONAL CHARCODE FIND-STRING BACKWARDS?) -(IL:* IL:|;;;| "Find either the passed structure, the selected structure, or a prompted-for structure. The search direction is forward unless BACKWARDS? is specified.") +(IL:* IL:|;;;| "Find either the passed structure, the selected structure, or a prompted-for structure. The search direction is forward unless BACKWARDS? is specified.") (CLOSE-OPEN-NODE CONTEXT) (LET ((SELECTION (IL:|fetch| SELECTION IL:|of| CONTEXT)) @@ -632,7 +627,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (EQ (IL:|fetch| SELECT-TYPE IL:|of| SELECTION) 'STRUCTURE)) - (IL:* IL:|;;| "there is a non-string selection") + (IL:* IL:|;;| "there is a non-string selection") (IF BACKWARDS? (FIND-SELECTION-BACKWARDS CONTEXT WRAP?) @@ -644,7 +639,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN FIND-SELECTION (CONTEXT &OPTIONAL WRAP?) -(IL:* IL:|;;;| "Find the next match of the current selection and display it.") +(IL:* IL:|;;;| "Find the next match of the current selection and display it.") (LET* ((PROMPTWINDOW (GET-PROMPT-WINDOW CONTEXT)) (SELECTION (IL:|fetch| SELECTION IL:|of| CONTEXT)) @@ -652,32 +647,31 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (START (IL:|fetch| SELECT-START IL:|of| SELECTION))) (IF START - (IL:* IL:|;;| "a sibling sequence is selected, look for a matching sequence after it") + (IL:* IL:|;;| "a sibling sequence is selected, look for a matching sequence after it") (FIND-AND-DISPLAY-SUBSTRUCTURE CONTEXT (STRUCTURE-FROM-SELECTION SELECTION) NIL (LIST NODE (1+ START)) WRAP?) - (IL:* IL:|;;| "a node is selected, look for a matching node ") + (IL:* IL:|;;| "a node is selected, look for a matching node ") (IF (SETF START (NEXT-NODE NODE T)) - (IL:* IL:|;;| "start the search with the following node") + (IL:* IL:|;;| "start the search with the following node") (FIND-AND-DISPLAY-STRUCTURE CONTEXT (STRUCTURE-FROM-SELECTION SELECTION) NIL START WRAP?) - (IL:* IL:|;;| "there are no more nodes, either wrap or give up") + (IL:* IL:|;;| "there are no more nodes, either wrap or give up") (IF WRAP? - (FIND-AND-DISPLAY-STRUCTURE CONTEXT (STRUCTURE-FROM-SELECTION SELECTION) - ) + (FIND-AND-DISPLAY-STRUCTURE CONTEXT (STRUCTURE-FROM-SELECTION SELECTION)) (FORMAT PROMPTWINDOW "~%At end; no more structure to search.")))))) (DEFUN FIND-SELECTION-BACKWARDS (CONTEXT &OPTIONAL WRAP?) -(IL:* IL:|;;;| "Find the previous match of the current selection and display it.") +(IL:* IL:|;;;| "Find the previous match of the current selection and display it.") (LET* ((PROMPTWINDOW (GET-PROMPT-WINDOW CONTEXT)) (SELECTION (IL:|fetch| SELECTION IL:|of| CONTEXT)) @@ -686,36 +680,34 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (IL:|fetch| SELECT-END IL:|of| SELECTION)))) (IF END - (IL:* IL:|;;| "a sibling sequence is selected, look for a matching sequence before it") + (IL:* IL:|;;| "a sibling sequence is selected, look for a matching sequence before it") - (FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS CONTEXT (STRUCTURE-FROM-SELECTION - SELECTION) + (FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS CONTEXT (STRUCTURE-FROM-SELECTION SELECTION) NIL (LIST NODE (1- END)) WRAP?) - (IL:* IL:|;;| "a node is selected, look for a matching node ") + (IL:* IL:|;;| "a node is selected, look for a matching node ") (IF (SETF END (PREV-NODE NODE T)) - (IL:* IL:|;;| "start the search with the previous node") + (IL:* IL:|;;| "start the search with the previous node") - (FIND-AND-DISPLAY-STRUCTURE-BACKWARDS CONTEXT (STRUCTURE-FROM-SELECTION - SELECTION) + (FIND-AND-DISPLAY-STRUCTURE-BACKWARDS CONTEXT (STRUCTURE-FROM-SELECTION SELECTION) NIL END WRAP?) - (IL:* IL:|;;| "there are no more nodes, either wrap or give up") + (IL:* IL:|;;| "there are no more nodes, either wrap or give up") (IF WRAP? - (FIND-AND-DISPLAY-STRUCTURE-BACKWARDS CONTEXT (STRUCTURE-FROM-SELECTION - SELECTION)) + (FIND-AND-DISPLAY-STRUCTURE-BACKWARDS CONTEXT (STRUCTURE-FROM-SELECTION + SELECTION)) (FORMAT PROMPTWINDOW "~%At beginning; no more structure to search.")))))) (DEFUN FIND-STRUCTURE (STR SCOPE &OPTIONAL START) -(IL:* IL:|;;;| "Search forward in linearization order for a node whose structure matches STR. The search is bounded by SCOPE (a pseudo-selection taken to indicate a subtree) and starts at START (a pseudo-selection taken to indicate its left-most node). START defaults to SCOPE. The return value is the first node in SCOPE at or after START whose structure is IL:EQUAL to STR.") +(IL:* IL:|;;;| "Search forward in linearization order for a node whose structure matches STR. The search is bounded by SCOPE (a pseudo-selection taken to indicate a subtree) and starts at START (a pseudo-selection taken to indicate its left-most node). START defaults to SCOPE. The return value is the first node in SCOPE at or after START whose structure is IL:EQUAL to STR.") -(IL:* IL:|;;;| "N.B. Since node structures can not be circular, no subnode of a node can have structure matching that node. Thus looking for a matching node in pre-order is the same as looking for one in linearization order. So we do a pre-order search here.") +(IL:* IL:|;;;| "N.B. Since node structures can not be circular, no subnode of a node can have structure matching that node. Thus looking for a matching node in pre-order is the same as looking for one in linearization order. So we do a pre-order search here.") (MULTIPLE-VALUE-BIND (SCOPE-NODE SCOPE-START SCOPE-END) (DECOMPOSE-PSEUDO-SELECTION SCOPE) @@ -727,11 +719,11 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (EQ START-NODE SCOPE-NODE))) (IL:EQUAL STR (IL:FETCH STRUCTURE IL:OF SCOPE-NODE))) - (IL:* IL:|;;| "special case: the scope includes its root node, we're starting at the root of the scope, and the root of the scope matches the passed structure.") + (IL:* IL:|;;| "special case: the scope includes its root node, we're starting at the root of the scope, and the root of the scope matches the passed structure.") (RETURN-FROM FIND-STRUCTURE SCOPE-NODE)) - (IL:* IL:|;;| "normal case: check all the nodes in the scope subtree in preorder.") + (IL:* IL:|;;| "normal case: check all the nodes in the scope subtree in preorder.") (DO* ((MIN-DEPTH (1+ (IL:FETCH DEPTH IL:OF SCOPE-NODE))) (NODE (OR (IF START-START @@ -755,7 +747,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN FIND-STRUCTURE-BACKWARDS (STR SCOPE &OPTIONAL END) -(IL:* IL:|;;;| "like find-structure but searches in reverse linearization order. Actually we search in postorder rather than reverse linearization order but this works just as well for the same reasons that preorder matches linearization order.") +(IL:* IL:|;;;| "like find-structure but searches in reverse linearization order. Actually we search in postorder rather than reverse linearization order but this works just as well for the same reasons that preorder matches linearization order.") (MULTIPLE-VALUE-BIND (SCOPE-NODE SCOPE-START SCOPE-END) (DECOMPOSE-PSEUDO-SELECTION SCOPE) @@ -767,12 +759,11 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (EQ END-NODE SCOPE-NODE))) (IL:EQUAL STR (IL:FETCH STRUCTURE IL:OF SCOPE-NODE))) - (IL:* IL:|;;| "special case: the scope includes its root node, we're ending at the root of the scope, and the root of the scope matches the passed structure.") + (IL:* IL:|;;| "special case: the scope includes its root node, we're ending at the root of the scope, and the root of the scope matches the passed structure.") (RETURN-FROM FIND-STRUCTURE-BACKWARDS SCOPE-NODE)) - (IL:* IL:|;;| - "normal case: check all the nodes in the scope subtree in postorder.") + (IL:* IL:|;;| "normal case: check all the nodes in the scope subtree in postorder.") (DO* ((MIN-DEPTH (1+ (IL:FETCH DEPTH IL:OF SCOPE-NODE))) (NODE (OR (IF END-END @@ -796,9 +787,9 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN FIND-SUBSTRUCTURE (STR SCOPE &OPTIONAL START) -(IL:* IL:|;;;| "Search forward in linearization order for a sequence of nodes whose successive structures match the successive elements of STR. The search is bounded by SCOPE (a pseudo-selection taken to indicate a subtree) and starts at START (a pseudo-selection taken to indicate the left edge of a subtree). START defauts to SCOPE. The return value is a pseudo-selection indicating the sibling sequence of nodes in SCOPE at or to the right of START whose successive node structures are IL:EQUAL to the successive members of STR.") +(IL:* IL:|;;;| "Search forward in linearization order for a sequence of nodes whose successive structures match the successive elements of STR. The search is bounded by SCOPE (a pseudo-selection taken to indicate a subtree) and starts at START (a pseudo-selection taken to indicate the left edge of a subtree). START defauts to SCOPE. The return value is a pseudo-selection indicating the sibling sequence of nodes in SCOPE at or to the right of START whose successive node structures are IL:EQUAL to the successive members of STR.") -(IL:* IL:|;;;| "N.B. For a sequence of sibling nodes, first in linearization order can not be found by doing a preorder search. See find-node-substructure for details about the correct search method.") +(IL:* IL:|;;;| "N.B. For a sequence of sibling nodes, first in linearization order can not be found by doing a preorder search. See find-node-substructure for details about the correct search method.") (MULTIPLE-VALUE-BIND (SCOPE-NODE SCOPE-START SCOPE-END) (DECOMPOSE-PSEUDO-SELECTION SCOPE) @@ -807,18 +798,18 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (COND ((NULL START-NODE) - (IL:* IL:|;;| "just check the entire scope") + (IL:* IL:|;;| "just check the entire scope") (FIND-NODE-SUBSTRUCTURE STR (LENGTH STR) SCOPE-NODE SCOPE-START SCOPE-END)) ((EQ START-NODE SCOPE-NODE) - (IL:* IL:|;;| "just check a terminal subtree of the scope") + (IL:* IL:|;;| "just check a terminal subtree of the scope") (FIND-NODE-SUBSTRUCTURE STR (LENGTH STR) SCOPE-NODE START-START SCOPE-END)) (T - (IL:* IL:|;;| "check each node from the start subtree up and to the right in the scope subtree. We carefully resume the recursion that would have happened if we had started from the root of the subtree. This means checking remaining structure in super-nodes on our way from the start node back up the subtree.") + (IL:* IL:|;;| "check each node from the start subtree up and to the right in the scope subtree. We carefully resume the recursion that would have happened if we had started from the root of the subtree. This means checking remaining structure in super-nodes on our way from the start node back up the subtree.") (DO ((NODE START-NODE SUPER-NODE) (SUPER-NODE (IL:FETCH SUPER-NODE IL:OF START-NODE) @@ -839,7 +830,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN FIND-SUBSTRUCTURE-BACKWARDS (STR SCOPE &OPTIONAL END) -(IL:* IL:|;;;| "Like find-substructure but searches in reverse linearization order.") +(IL:* IL:|;;;| "Like find-substructure but searches in reverse linearization order.") (MULTIPLE-VALUE-BIND (SCOPE-NODE SCOPE-START SCOPE-END) (DECOMPOSE-PSEUDO-SELECTION SCOPE) @@ -848,18 +839,18 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (COND ((NULL END-NODE) - (IL:* IL:|;;| "just check the entire scope") + (IL:* IL:|;;| "just check the entire scope") (FIND-NODE-SUBSTRUCTURE-BACKWARDS STR (LENGTH STR) SCOPE-NODE SCOPE-START SCOPE-END)) ((EQ END-NODE SCOPE-NODE) - (IL:* IL:|;;| "just check an initial subtree of the scope") + (IL:* IL:|;;| "just check an initial subtree of the scope") (FIND-NODE-SUBSTRUCTURE-BACKWARDS STR (LENGTH STR) SCOPE-NODE SCOPE-START END-END)) (T - (IL:* IL:|;;| "check each node in the initial subtree of scope terminated by the end subtree. We carefully resume the recursion that would have happened if we had started from the root of the scope subtree. This means checking remaining structure in super-nodes on our way from the end node back up the subtree.") + (IL:* IL:|;;| "check each node in the initial subtree of scope terminated by the end subtree. We carefully resume the recursion that would have happened if we had started from the root of the scope subtree. This means checking remaining structure in super-nodes on our way from the end node back up the subtree.") (DO ((NODE END-NODE SUPER-NODE) (SUPER-NODE (IL:FETCH SUPER-NODE IL:OF END-NODE) @@ -873,8 +864,8 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (STRLEN (LENGTH STR)) MATCH) ((OR (NULL NODE) - (SETF MATCH (FIND-NODE-SUBSTRUCTURE-BACKWARDS STR STRLEN NODE - START END CONTINUATION?)) + (SETF MATCH (FIND-NODE-SUBSTRUCTURE-BACKWARDS STR STRLEN NODE START + END CONTINUATION?)) (EQ NODE SCOPE-NODE)) MATCH))))))) @@ -885,15 +876,14 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN SEARCH-OBJ (CONTEXT &OPTIONAL SEARCH-STRING WRAP?) -(IL:* IL:|;;;| "Search for the the structure(s) in the string SEARCH-OBJ and display them. The search starts just after the current point or selection, if any.") +(IL:* IL:|;;;| "Search for the the structure(s) in the string SEARCH-OBJ and display them. The search starts just after the current point or selection, if any.") (MULTIPLE-VALUE-BIND (STR STRLEN) (STRUCTURE-FROM-STRING (OR SEARCH-STRING (SETF SEARCH-STRING - (GET-USER-STRING CONTEXT "Find: " - (OR (IL:|fetch| - FIND-CANDIDATE - IL:|of| CONTEXT) - FIND-CANDIDATE))))) + (GET-USER-STRING CONTEXT "Find: " + (OR (IL:|fetch| FIND-CANDIDATE + IL:|of| CONTEXT) + FIND-CANDIDATE))))) (COND ((< STRLEN 0) (FORMAT (GET-PROMPT-WINDOW CONTEXT) @@ -904,12 +894,12 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) "-- aborted.") (RETURN-FROM SEARCH-OBJ))) - (IL:* IL:|;;| "update the remembered defaults") + (IL:* IL:|;;| "update the remembered defaults") - (IL:|replace| FIND-CANDIDATE IL:|of| CONTEXT IL:|with| (IL:SETQ FIND-CANDIDATE - SEARCH-STRING)) + (IL:|replace| FIND-CANDIDATE IL:|of| CONTEXT IL:|with| (IL:SETQ FIND-CANDIDATE + SEARCH-STRING)) - (IL:* IL:|;;| "figure out where to search and where to start") + (IL:* IL:|;;| "figure out where to search and where to start") (LET* ((SCOPE (SUBNODE 1 (IL:FETCH ROOT IL:OF CONTEXT))) (START (LET* ((POINT (IL:|fetch| CARET-POINT IL:|of| CONTEXT)) @@ -933,36 +923,35 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (T SCOPE))))) (UNLESS (OR WRAP? START) - (IL:* IL:|;;| "Nothing left to search, and we're not supposed to wrap") + (IL:* IL:|;;| "Nothing left to search, and we're not supposed to wrap") (FORMAT (GET-PROMPT-WINDOW CONTEXT) "~%At end; no more structure to search.") (RETURN-FROM SEARCH-OBJ)) - (IL:* IL:|;;| "do the search") + (IL:* IL:|;;| "do the search") (IF (> STRLEN 1) - (IL:* IL:|;;| "substructure search") + (IL:* IL:|;;| "substructure search") (FIND-AND-DISPLAY-SUBSTRUCTURE CONTEXT STR SCOPE START WRAP?) - (IL:* IL:|;;| "structure search") + (IL:* IL:|;;| "structure search") (FIND-AND-DISPLAY-STRUCTURE CONTEXT (FIRST STR) SCOPE START WRAP?))))) (DEFUN SEARCH-OBJ-BACKWARDS (CONTEXT &OPTIONAL SEARCH-STRING WRAP?) -(IL:* IL:|;;;| "Like search-obj but searches backwards.") +(IL:* IL:|;;;| "Like search-obj but searches backwards.") (MULTIPLE-VALUE-BIND (STR STRLEN) (STRUCTURE-FROM-STRING (OR SEARCH-STRING (SETF SEARCH-STRING - (GET-USER-STRING CONTEXT "Find: " - (OR (IL:|fetch| - FIND-CANDIDATE - IL:|of| CONTEXT) - FIND-CANDIDATE))))) + (GET-USER-STRING CONTEXT "Find: " + (OR (IL:|fetch| FIND-CANDIDATE + IL:|of| CONTEXT) + FIND-CANDIDATE))))) (COND ((< STRLEN 0) (FORMAT (GET-PROMPT-WINDOW CONTEXT) @@ -973,12 +962,12 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) "-- aborted.") (RETURN-FROM SEARCH-OBJ-BACKWARDS))) - (IL:* IL:|;;| "update the remembered defaults") + (IL:* IL:|;;| "update the remembered defaults") - (IL:|replace| FIND-CANDIDATE IL:|of| CONTEXT IL:|with| (IL:SETQ FIND-CANDIDATE - SEARCH-STRING)) + (IL:|replace| FIND-CANDIDATE IL:|of| CONTEXT IL:|with| (IL:SETQ FIND-CANDIDATE + SEARCH-STRING)) - (IL:* IL:|;;| "figure out where to search and where to start") + (IL:* IL:|;;| "figure out where to search and where to start") (LET* ((SCOPE (SUBNODE 1 (IL:FETCH ROOT IL:OF CONTEXT))) (END (LET* ((POINT (IL:|fetch| CARET-POINT IL:|of| CONTEXT)) @@ -1002,30 +991,30 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (T SCOPE))))) (UNLESS (OR WRAP? END) - (IL:* IL:|;;| "Nothing left to search, and we're not supposed to wrap") + (IL:* IL:|;;| "Nothing left to search, and we're not supposed to wrap") (FORMAT (GET-PROMPT-WINDOW CONTEXT) "~%At beginning; no more structure to search.") (RETURN-FROM SEARCH-OBJ-BACKWARDS)) - (IL:* IL:|;;| "do the search") + (IL:* IL:|;;| "do the search") (IF (> STRLEN 1) - (IL:* IL:|;;| "substructure search") + (IL:* IL:|;;| "substructure search") (FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS CONTEXT STR SCOPE END WRAP?) - (IL:* IL:|;;| "structure search") + (IL:* IL:|;;| "structure search") (FIND-AND-DISPLAY-STRUCTURE-BACKWARDS CONTEXT (FIRST STR) SCOPE END WRAP?))))) (DEFUN SUBSTITUTE-OBJ (CONTEXT &OPTIONAL CHARCODE OLDSTR NEWSTR REMOVE?) -(IL:* IL:|;;;| "OLDSTR and NEWSTR are strings. In the scope of the selection, replace every occurence of structure matching OLDSTR by structure parsed from NEWSTR. If REMOVE? is specified, just remove structure matching OLD.") +(IL:* IL:|;;;| "OLDSTR and NEWSTR are strings. In the scope of the selection, replace every occurence of structure matching OLDSTR by structure parsed from NEWSTR. If REMOVE? is specified, just remove structure matching OLD.") -(IL:* IL:|;;;| "We preserve the selection as best we can. Point gets thrown away.") +(IL:* IL:|;;;| "We preserve the selection as best we can. Point gets thrown away.") (CLOSE-OPEN-NODE CONTEXT) (LET* ((PROMPTWINDOW (GET-PROMPT-WINDOW CONTEXT)) @@ -1033,7 +1022,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (SCOPE NIL) (TYPE (IF REMOVE? "delet" - "substitut"))) (IL:* IL:\; "hack!!!") + "substitut"))) (IL:* IL:\; "hack!!!") (UNLESS (AND (IL:|fetch| SELECT-NODE IL:|of| SELECTION) (EQ (IL:|fetch| SELECT-TYPE IL:|of| SELECTION) 'STRUCTURE)) @@ -1041,14 +1030,13 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (RETURN-FROM SUBSTITUTE-OBJ T)) (SETQ SCOPE (PSEUDO-SELECTION-FROM-SELECTION SELECTION)) (MULTIPLE-VALUE-BIND (OLD OLDLEN) - (STRUCTURE-FROM-STRING (OR OLDSTR (SETF OLDSTR - (GET-USER-STRING CONTEXT - (IF REMOVE? - "Delete form: " - "Replace old form: ") - (OR (IL:|fetch| FIND-CANDIDATE - IL:|of| CONTEXT) - FIND-CANDIDATE))))) + (STRUCTURE-FROM-STRING (OR OLDSTR (SETF OLDSTR (GET-USER-STRING CONTEXT + (IF REMOVE? + "Delete form: " + "Replace old form: ") + (OR (IL:|fetch| FIND-CANDIDATE + IL:|of| CONTEXT) + FIND-CANDIDATE))))) (COND ((< OLDLEN 0) (FORMAT PROMPTWINDOW " -- Invalid structure.") @@ -1060,13 +1048,13 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (IF REMOVE? (VALUES NIL 0) (STRUCTURE-FROM-STRING (OR NEWSTR - (SETF NEWSTR - (GET-USER-STRING - CONTEXT "with new form: " - (OR (IL:|fetch| - SUBSTITUTE-CANDIDATE - IL:|of| CONTEXT) - SUBSTITUTE-CANDIDATE)))))) + (SETF NEWSTR + (GET-USER-STRING CONTEXT + "with new form: " + (OR (IL:|fetch| + SUBSTITUTE-CANDIDATE + IL:|of| CONTEXT) + SUBSTITUTE-CANDIDATE)))))) (COND ((< NEWLEN 0) (FORMAT PROMPTWINDOW " -- Invalid structure.") @@ -1076,16 +1064,16 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (FORMAT PROMPTWINDOW "-- aborted.") (RETURN-FROM SUBSTITUTE-OBJ T))) - (IL:* IL:|;;| "update defaults ") + (IL:* IL:|;;| "update defaults ") - (IL:|replace| FIND-CANDIDATE IL:|of| CONTEXT IL:|with| (IL:SETQ - FIND-CANDIDATE - OLDSTR)) + (IL:|replace| FIND-CANDIDATE IL:|of| CONTEXT IL:|with| (IL:SETQ FIND-CANDIDATE + OLDSTR)) (UNLESS REMOVE? - (IL:|replace| SUBSTITUTE-CANDIDATE IL:|of| CONTEXT - IL:|with| (IL:SETQ SUBSTITUTE-CANDIDATE NEWSTR))) + (IL:|replace| SUBSTITUTE-CANDIDATE IL:|of| CONTEXT IL:|with| (IL:SETQ + SUBSTITUTE-CANDIDATE + NEWSTR))) - (IL:* IL:|;;| "do the substitution, report, and reselect.") + (IL:* IL:|;;| "do the substitution, report, and reselect.") (MULTIPLE-VALUE-BIND (NEW-SCOPE SUBCOUNT) (IF (> OLDLEN 1) @@ -1101,14 +1089,14 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN SUBSTITUTE-STRUCTURE (CONTEXT OLD NEW SCOPE &OPTIONAL REMOVE?) -(IL:* IL:|;;;| "Inside SCOPE, replace any node with structure OLD by nodes gotten from parsing NEW. If REMOVE? is given, just delete the old nodes. Returns two values: the final scope after all substitutions are made, and the number of substitutions/deletions made.") +(IL:* IL:|;;;| "Inside SCOPE, replace any node with structure OLD by nodes gotten from parsing NEW. If REMOVE? is given, just delete the old nodes. Returns two values: the final scope after all substitutions are made, and the number of substitutions/deletions made.") -(IL:* IL:|;;;| "The substitution is done as a single undoable operation, and the current selection and point are thrown away.") +(IL:* IL:|;;;| "The substitution is done as a single undoable operation, and the current selection and point are thrown away.") (MULTIPLE-VALUE-BIND (SCOPE-NODE SCOPE-START SCOPE-END) (DECOMPOSE-PSEUDO-SELECTION SCOPE) - (LET* ((ROOT (IL:FETCH ROOT IL:OF CONTEXT))(IL:* IL:\; - "substituting for root is special") + (LET* ((ROOT (IL:FETCH ROOT IL:OF CONTEXT)) (IL:* IL:\; + "substituting for root is special") (POINT (IL:FETCH CARET-POINT IL:OF CONTEXT)) (SELECTION (IL:FETCH SELECTION IL:OF CONTEXT)) (NEWLEN (IF REMOVE? @@ -1139,14 +1127,14 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (SET-SELECTION-NOWHERE SELECTION) (VALUES SCOPE NUMSUBS)) - (IL:* IL:|;;| "replace the target ") + (IL:* IL:|;;| "replace the target ") (SELECT-NODE CONTEXT TARGET) (COND (REMOVE? (COND ((EQ TARGET-SUPER ROOT) - (IL:* IL:|;;| "\"delete\" the root structure by making it nil") + (IL:* IL:|;;| "\"delete\" the root structure by making it nil") (PENDING-DELETE POINT SELECTION) (INSERT-NULL-LIST CONTEXT)) @@ -1154,19 +1142,19 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (T (PENDING-DELETE POINT SELECTION) (INSERT POINT CONTEXT (COPY-LIST NEW-NODES)))) - (IL:* IL:|;;| "fix up the scope, if necessary") + (IL:* IL:|;;| "fix up the scope, if necessary") (COND ((EQ TARGET SCOPE-NODE) - (IL:* IL:|;;| "matched the scope, so we're done") + (IL:* IL:|;;| "matched the scope, so we're done") (COND (REMOVE? (SETF SCOPE NIL)) ((= NEWLEN 1) (SETF SCOPE (SUBNODE TARGET-INDEX TARGET-SUPER))) (T - (IL:* IL:|;;| "replacing the root structure with multiple nodes inserts a new level of list between the root (target-super) and the multiple nodes inserted. In this case, make the scope node be the new list node instead of the root itself.") + (IL:* IL:|;;| "replacing the root structure with multiple nodes inserts a new level of list between the root (target-super) and the multiple nodes inserted. In this case, make the scope node be the new list node instead of the root itself.") (SETF SCOPE (LIST (IF (EQ TARGET-SUPER ROOT) (SUBNODE 1 ROOT) @@ -1176,7 +1164,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (SETF RESUME NIL)) ((AND SCOPE-START (EQ TARGET-SUPER SCOPE-NODE)) - (IL:* IL:|;;| "matched a direct subnode of an extended scope") + (IL:* IL:|;;| "matched a direct subnode of an extended scope") (WHEN (= TARGET-INDEX SCOPE-END) (SETF RESUME NIL)) @@ -1185,9 +1173,9 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN SUBSTITUTE-SUBSTRUCTURE (CONTEXT OLD NEW SCOPE &OPTIONAL REMOVE?) -(IL:* IL:|;;;| "Inside SCOPE, replace any sequences of nodes whose structures sequentially match the elements of OLD by nodes gotten from parsing NEW. If REMOVE? is given, just delete the old sequences. Returns two values: the final scope after all substitutions are made, and the number of substitutions/deletions made.") +(IL:* IL:|;;;| "Inside SCOPE, replace any sequences of nodes whose structures sequentially match the elements of OLD by nodes gotten from parsing NEW. If REMOVE? is given, just delete the old sequences. Returns two values: the final scope after all substitutions are made, and the number of substitutions/deletions made.") -(IL:* IL:|;;;| "The substitution is done as a single undoable operation, and the current selection and point are thrown away.") +(IL:* IL:|;;;| "The substitution is done as a single undoable operation, and the current selection and point are thrown away.") (MULTIPLE-VALUE-BIND (SCOPE-NODE SCOPE-START SCOPE-END) (DECOMPOSE-PSEUDO-SELECTION SCOPE) @@ -1218,7 +1206,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (MULTIPLE-VALUE-BIND (TNODE TSTART TEND) (DECOMPOSE-PSEUDO-SELECTION TARGET) - (IL:* IL:|;;| "replace the target ") + (IL:* IL:|;;| "replace the target ") (SELECT-PSEUDO-SEGMENT CONTEXT TARGET) (COND @@ -1226,13 +1214,12 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (T (PENDING-DELETE POINT SELECTION) (INSERT POINT CONTEXT (COPY-LIST NEW-NODES)))) - (IL:* IL:|;;| - "fix up the scope, if necessary, and figure where to resume") + (IL:* IL:|;;| "fix up the scope, if necessary, and figure where to resume") (COND ((AND SCOPE-START (EQ TNODE SCOPE-NODE)) - (IL:* IL:|;;| "matched direct subnodes of an extended scope") + (IL:* IL:|;;| "matched direct subnodes of an extended scope") (IF (= TEND SCOPE-END) (SETF RESUME NIL) @@ -1243,7 +1230,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN STRUCTURE-FROM-SELECTION (SELECTION) -(IL:* IL:|;;;| "selection must be a structure selection. Return the structure encompassed by selection, which if the selection is a node is the structure of that node, and if the selection is a segment a list of the structures of the nodes in that segment.") +(IL:* IL:|;;;| "selection must be a structure selection. Return the structure encompassed by selection, which if the selection is a node is the structure of that node, and if the selection is a segment a list of the structures of the nodes in that segment.") (LET* ((NODE (IL:FETCH SELECT-NODE IL:OF SELECTION)) (START (IL:FETCH SELECT-START IL:OF SELECTION)) @@ -1263,7 +1250,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN STRUCTURE-FROM-STRING (STR) -(IL:* IL:|;;;| "return all the structures that can be read from string as a list. return a second value saying how many structures there were. If an error is encountered, a second value of -1 is returned. ") +(IL:* IL:|;;;| "return all the structures that can be read from string as a list. return a second value saying how many structures there were. If an error is encountered, a second value of -1 is returned. ") (COND ((NULL STR) @@ -1285,7 +1272,7 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (DEFUN COMMENT-OUT-SELECTION (CONTEXT CHARCODE) -(IL:* IL:|;;;| "given a sequence of whole structure selections, build a 5 level comment node and replace the nodes with the comment.") +(IL:* IL:|;;;| "given a sequence of whole structure selections, build a 5 level comment node and replace the nodes with the comment.") (LET* ((SELECTION (IL:FETCH SELECTION IL:OF CONTEXT)) (POINT (IL:FETCH CARET-POINT IL:OF CONTEXT)) @@ -1301,14 +1288,14 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (START (WITH-OUTPUT-TO-STRING (S) (IL:BIND BLANK-BEFORE IL:FOR I IL:FROM START IL:TO (OR (IL:FETCH SELECT-END IL:OF SELECTION) - START) IL:AS X + START) IL:AS X IL:ON (CDR (IL:NTH (IL:FETCH SUB-NODES IL:OF NODE) - START)) - IL:DO (IF BLANK-BEFORE - (WRITE-CHAR #\Space S) - (SETQ BLANK-BEFORE T)) - (PRIN1 (IL:FETCH STRUCTURE IL:OF (CAR X)) - S)))) + START)) IL:DO (IF BLANK-BEFORE + (WRITE-CHAR #\Space S) + (SETQ BLANK-BEFORE T)) + (PRIN1 (IL:FETCH STRUCTURE + IL:OF (CAR X)) + S)))) (T (FORMAT NIL "~S" (IL:FETCH STRUCTURE IL:OF NODE)))))) (WHEN STR (LET ((NEW-NODE (PARSE-NEW (LIST 'IL:* 'IL:\| STR) @@ -1585,42 +1572,40 @@ IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|) (il:lambda (context node subnodes) (il:* il:\; "Edited 7-Jul-87 09:39 by DCB") (il:* il:|;;;| "sticks subnodes back into node and revives them. ") (rplacd (il:fetch sub-nodes il:of node) subnodes) (il:for subnode il:in subnodes il:as index il:from 1 il:do (il:replace super-node il:of subnode il:with node) (il:replace sub-node-index il:of subnode il:with index) (detach-node subnode) (revive-node subnode (il:fetch depth il:of node))) (il:* il:|;;| "used to reparse here. now if we simply note the change, the format types, format values, and linear forms will be recomputed.") (note-change node context)) ) ) -(IL:PUTPROPS IL:SEDIT-COMMANDS IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 2018 - 2021)) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (13643 14213 (PSEUDO-SELECTION-FROM-SELECTION 13643 . 14213)) (14215 14969 ( -COMPOSE-PSEUDO-SELECTION 14215 . 14969)) (14971 15510 (DECOMPOSE-PSEUDO-SELECTION 14971 . 15510)) ( -15512 16309 (SELECTION-FROM-PSEUDO-SELECTION 15512 . 16309)) (16311 16614 (SELECT-PSEUDO-SEGMENT 16311 - . 16614)) (16679 17569 (ADD-COMMAND 16679 . 17569)) (17571 19734 (GET-SELECTION 17571 . 19734)) ( -19736 20916 (REPLACE-SELECTION 19736 . 20916)) (20918 21410 (RESET-COMMANDS 20918 . 21410)) (21412 -21581 (DEFAULT-COMMANDS 21412 . 21581)) (22059 23162 (EQUALIZE-STRING-WIDTHS 22059 . 23162)) (23164 -23362 (MINIMUM-STRING-WIDTH 23164 . 23362)) (23364 23562 (MAXIMUM-STRING-WIDTH 23364 . 23562)) (23564 -24435 (FIND-AND-DISPLAY-STRUCTURE 23564 . 24435)) (24437 25121 (FIND-AND-DISPLAY-STRUCTURE-BACKWARDS -24437 . 25121)) (25123 26027 (FIND-AND-DISPLAY-SUBSTRUCTURE 25123 . 26027)) (26029 26732 ( -FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS 26029 . 26732)) (26734 27375 (FIND-NTH-STRUCTURE 26734 . 27375 -)) (27377 30107 (FIND-NODE-SUBSTRUCTURE 27377 . 30107)) (30109 31362 (FIND-NODE-SUBSTRUCTURE-BACKWARDS - 30109 . 31362)) (31364 32343 (FIND-OBJ 31364 . 32343)) (32345 33745 (FIND-SELECTION 32345 . 33745)) ( -33747 35439 (FIND-SELECTION-BACKWARDS 33747 . 35439)) (35441 38170 (FIND-STRUCTURE 35441 . 38170)) ( -38172 40519 (FIND-STRUCTURE-BACKWARDS 38172 . 40519)) (40521 43450 (FIND-SUBSTRUCTURE 40521 . 43450)) -(43452 45752 (FIND-SUBSTRUCTURE-BACKWARDS 43452 . 45752)) (45754 45990 (GET-USER-STRING 45754 . 45990) -) (45992 49700 (SEARCH-OBJ 45992 . 49700)) (49702 53367 (SEARCH-OBJ-BACKWARDS 49702 . 53367)) (53369 -58195 (SUBSTITUTE-OBJ 53369 . 58195)) (58197 62853 (SUBSTITUTE-STRUCTURE 58197 . 62853)) (62855 66027 -(SUBSTITUTE-SUBSTRUCTURE 62855 . 66027)) (66029 67191 (STRUCTURE-FROM-SELECTION 66029 . 67191)) (67193 - 68036 (STRUCTURE-FROM-STRING 67193 . 68036)) (68038 70179 (COMMENT-OUT-SELECTION 68038 . 70179)) ( -70180 125041 (ADD-MENU 70193 . 70856) (BACKSPACE 70858 . 71837) (CHANGE-PACKAGE 71839 . 74639) ( -CHANGE-PRINTBASE 74641 . 76823) (CHANGE-QUOTE 76825 . 77180) (CONVERT-COMMENT 77182 . 78942) ( -CONVERT-COMMENT-STRUCTURE 78944 . 80247) (CONVERT-COMMENT-TAIL 80249 . 81649) (CREATE-COMMAND-TABLE -81651 . 83629) (DEFAULT-EDIT-FN 83631 . 83768) (DELETE-SELECTION 83770 . 84452) (DELETE-WORD 84454 . -86555) (DO-MUTATION 86557 . 87105) (EDIT-SELECTION 87107 . 87555) (EVAL-SELECTION 87557 . 89426) ( -EXPAND 89428 . 90557) (EXTRACT-CURRENT-SELECTION 90559 . 92927) (FIND-COMMENT 92929 . 93623) (GET-MENU - 93625 . 94002) (EDIT-HELP 94004 . 95079) (HELPMENU 95081 . 97870) (INPUT-DOT 97872 . 100004) ( -INPUT-ESCAPE 100006 . 100254) (INPUT-NORMAL-CHAR 100256 . 102289) (INPUT-QUOTE 102291 . 105373) ( -INPUT-SQUARE-BRACKET 105375 . 105726) (INPUT-STRINGDELIM 105728 . 107127) (INPUT-TOKENDELIM 107129 . -108109) (INSERT-MULTI-ESCAPE 108111 . 109239) (INSERT-SPECIAL-CHARACTER 109241 . 110501) ( -INSPECT-SELECTION 110503 . 111038) (JOIN 111040 . 114710) (MENU-CLOSEFN 114712 . 114930) ( -MENU-FIND-SELECTEDFN 114932 . 115632) (MENU-INIT-STATE 115634 . 116441) (MENU-PACKAGE-SELECTEDFN -116443 . 117494) (MENU-PRINTBASE-SELECTEDFN 117496 . 118372) (MENU-SELECTEDFN 118374 . 118800) ( -MENU-SUBSTITUTE-SELECTEDFN 118802 . 119762) (MUTATE 119764 . 120874) (QUOTE-CURRENT-SELECTION 120876 - . 121643) (REDISPLAY 121645 . 121884) (REDO 121886 . 122380) (SELECTED-FN-NAME 122382 . 122827) ( -SKIP-TO-GAP 122829 . 123606) (UNDO 123608 . 124408) (UNDO-EXTRACT 124410 . 125039))))) + (IL:FILEMAP (NIL (13440 14010 (PSEUDO-SELECTION-FROM-SELECTION 13440 . 14010)) (14012 14766 ( +COMPOSE-PSEUDO-SELECTION 14012 . 14766)) (14768 15307 (DECOMPOSE-PSEUDO-SELECTION 14768 . 15307)) ( +15309 16106 (SELECTION-FROM-PSEUDO-SELECTION 15309 . 16106)) (16108 16411 (SELECT-PSEUDO-SEGMENT 16108 + . 16411)) (16476 17366 (ADD-COMMAND 16476 . 17366)) (17368 19539 (GET-SELECTION 17368 . 19539)) ( +19541 20721 (REPLACE-SELECTION 19541 . 20721)) (20723 21044 (RESET-COMMANDS 20723 . 21044)) (21046 +21215 (DEFAULT-COMMANDS 21046 . 21215)) (21693 22701 (EQUALIZE-STRING-WIDTHS 21693 . 22701)) (22703 +22901 (MINIMUM-STRING-WIDTH 22703 . 22901)) (22903 23101 (MAXIMUM-STRING-WIDTH 22903 . 23101)) (23103 +23974 (FIND-AND-DISPLAY-STRUCTURE 23103 . 23974)) (23976 24660 (FIND-AND-DISPLAY-STRUCTURE-BACKWARDS +23976 . 24660)) (24662 25566 (FIND-AND-DISPLAY-SUBSTRUCTURE 24662 . 25566)) (25568 26271 ( +FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS 25568 . 26271)) (26273 26914 (FIND-NTH-STRUCTURE 26273 . 26914 +)) (26916 29646 (FIND-NODE-SUBSTRUCTURE 26916 . 29646)) (29648 30875 (FIND-NODE-SUBSTRUCTURE-BACKWARDS + 29648 . 30875)) (30877 31856 (FIND-OBJ 30877 . 31856)) (31858 33229 (FIND-SELECTION 31858 . 33229)) ( +33231 34791 (FIND-SELECTION-BACKWARDS 33231 . 34791)) (34793 37522 (FIND-STRUCTURE 34793 . 37522)) ( +37524 39851 (FIND-STRUCTURE-BACKWARDS 37524 . 39851)) (39853 42782 (FIND-SUBSTRUCTURE 39853 . 42782)) +(42784 45084 (FIND-SUBSTRUCTURE-BACKWARDS 42784 . 45084)) (45086 45322 (GET-USER-STRING 45086 . 45322) +) (45324 48925 (SEARCH-OBJ 45324 . 48925)) (48927 52485 (SEARCH-OBJ-BACKWARDS 48927 . 52485)) (52487 +57315 (SUBSTITUTE-OBJ 52487 . 57315)) (57317 61983 (SUBSTITUTE-STRUCTURE 57317 . 61983)) (61985 65128 +(SUBSTITUTE-SUBSTRUCTURE 61985 . 65128)) (65130 66292 (STRUCTURE-FROM-SELECTION 65130 . 66292)) (66294 + 67137 (STRUCTURE-FROM-STRING 66294 . 67137)) (67139 69410 (COMMENT-OUT-SELECTION 67139 . 69410)) ( +69411 124272 (ADD-MENU 69424 . 70087) (BACKSPACE 70089 . 71068) (CHANGE-PACKAGE 71070 . 73870) ( +CHANGE-PRINTBASE 73872 . 76054) (CHANGE-QUOTE 76056 . 76411) (CONVERT-COMMENT 76413 . 78173) ( +CONVERT-COMMENT-STRUCTURE 78175 . 79478) (CONVERT-COMMENT-TAIL 79480 . 80880) (CREATE-COMMAND-TABLE +80882 . 82860) (DEFAULT-EDIT-FN 82862 . 82999) (DELETE-SELECTION 83001 . 83683) (DELETE-WORD 83685 . +85786) (DO-MUTATION 85788 . 86336) (EDIT-SELECTION 86338 . 86786) (EVAL-SELECTION 86788 . 88657) ( +EXPAND 88659 . 89788) (EXTRACT-CURRENT-SELECTION 89790 . 92158) (FIND-COMMENT 92160 . 92854) (GET-MENU + 92856 . 93233) (EDIT-HELP 93235 . 94310) (HELPMENU 94312 . 97101) (INPUT-DOT 97103 . 99235) ( +INPUT-ESCAPE 99237 . 99485) (INPUT-NORMAL-CHAR 99487 . 101520) (INPUT-QUOTE 101522 . 104604) ( +INPUT-SQUARE-BRACKET 104606 . 104957) (INPUT-STRINGDELIM 104959 . 106358) (INPUT-TOKENDELIM 106360 . +107340) (INSERT-MULTI-ESCAPE 107342 . 108470) (INSERT-SPECIAL-CHARACTER 108472 . 109732) ( +INSPECT-SELECTION 109734 . 110269) (JOIN 110271 . 113941) (MENU-CLOSEFN 113943 . 114161) ( +MENU-FIND-SELECTEDFN 114163 . 114863) (MENU-INIT-STATE 114865 . 115672) (MENU-PACKAGE-SELECTEDFN +115674 . 116725) (MENU-PRINTBASE-SELECTEDFN 116727 . 117603) (MENU-SELECTEDFN 117605 . 118031) ( +MENU-SUBSTITUTE-SELECTEDFN 118033 . 118993) (MUTATE 118995 . 120105) (QUOTE-CURRENT-SELECTION 120107 + . 120874) (REDISPLAY 120876 . 121115) (REDO 121117 . 121611) (SELECTED-FN-NAME 121613 . 122058) ( +SKIP-TO-GAP 122060 . 122837) (UNDO 122839 . 123639) (UNDO-EXTRACT 123641 . 124270))))) IL:STOP diff --git a/sources/SEDIT-COMMANDS.DFASL b/sources/SEDIT-COMMANDS.DFASL index 490401d3..1940a761 100644 Binary files a/sources/SEDIT-COMMANDS.DFASL and b/sources/SEDIT-COMMANDS.DFASL differ diff --git a/sources/UFS b/sources/UFS index c2302b71..c5f9f58a 100644 --- a/sources/UFS +++ b/sources/UFS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "18-Dec-2024 12:52:23" {WMEDLEY}UFS.;39 79633 +(FILECREATED "27-Oct-2025 11:10:55" {WMEDLEY}UFS.;61 91949 :EDIT-BY rmk - :CHANGES-TO (FNS \UFSRenameFile) + :CHANGES-TO (FNS \UFSDeleteFile) - :PREVIOUS-DATE "16-Sep-2023 09:22:55" {WMEDLEY}UFS.;38) + :PREVIOUS-DATE "17-Oct-2025 08:49:57" {WMEDLEY}UFS.;60) (PRETTYCOMPRINT UFSCOMS) @@ -14,6 +14,11 @@ (RPAQQ UFSCOMS [(PROP (FILETYPE MAKEFILE-ENVIRONMENT) UFS) + [COMS + (* ;; "For filename coercion before UNICODE-TABLES and UNICODE are loaded. Until then, only files with 7-bit MCCS names are allowed.") + + (P (MOVD? 'EVQ 'UTF8TOMSTRING) + (MOVD? 'EVQ 'MTOUTF8STRING] (DECLARE%: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY (FILES (LOADCOMP) DIRECTORY FILEIO)) (INITVARS (\UFS.DEFAULT.EOLC NIL)) @@ -130,6 +135,17 @@ (PUTPROPS UFS FILETYPE :BCOMPL) (PUTPROPS UFS MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)) + + + +(* ;; +"For filename coercion before UNICODE-TABLES and UNICODE are loaded. Until then, only files with 7-bit MCCS names are allowed." +) + + +(MOVD? 'EVQ 'UTF8TOMSTRING) + +(MOVD? 'EVQ 'MTOUTF8STRING) (DECLARE%: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY (FILESLOAD (LOADCOMP) @@ -274,23 +290,160 @@ (DEFINEQ (\UFSOpenFile -(LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* ; "Edited 6-Jun-90 12:18 by nm") (* ;;; "Open a file.") (WITH.MONITOR (\UFSGetMonitor FDEV) (PROG ((ACC (SELECTQ ACCESS (INPUT ACCESS-INPUT) (OUTPUT ACCESS-OUTPUT) (BOTH ACCESS-BOTH) (APPEND ACCESS-APPEND) ACCESS-OTHER)) (REC (SELECTQ RECOG (OLD RECOG-OLD) (OLDEST RECOG-OLDEST) (NEW RECOG-NEW) (OLD/NEW RECOG-NEW-OLD) (SELECTQ ACCESS (INPUT RECOG-OLD) (OUTPUT RECOG-NEW) ((BOTH APPEND) RECOG-NEW-OLD) RECOG-OTHER))) (EOF-FN (FUNCTION \EOSERROR)) (ERRNO (CREATECELL \FIXP)) OTHER FILEID BYTESIZE CDATE FULLNAME CINFO STRM CASE.CORRECT.NAME CASE.CORRECT.FULLFILENAME) (SETQ CASE.CORRECT.NAME (if (type? STREAM FILE) then (COND ((fetch (UFSSTREAM FILEID) of FILE) (* ; "Already open--this really ought to be an error") (RETURN FILE)) (T (LET ((FULLNAME (fetch (UFSSTREAM UNIXNAME) of FILE))) (SETQ STRM FILE) (* ; "Re use the old stream") (SUBSTRING FULLNAME (ADD1 (STRPOS "}" FULLNAME)))))) else (\UFS.RECOGNIZE.FILE FILE RECOG FDEV))) (COND ((NOT CASE.CORRECT.NAME) (RETURN NIL)) ((AND (NULL OLDSTREAM) (EQ (fetch (FDEV DEVICENAME) of FDEV) (QUOTE DSK)) (SETQ OTHER (\UFS.OPENP CASE.CORRECT.NAME FDEV)) (SELECTQ ACCESS (INPUT (* ; "ok if other file is also input") (DIRTYABLE OTHER)) T)) (* ; "Access conflict. Don't check this when just revalidating, of course. I also don't mess with this on UNIX device--let user get in trouble...") (CL:ERROR (QUOTE XCL:FILE-WONT-OPEN) :PATHNAME (\UFS.FULLNAME CASE.CORRECT.NAME FDEV)))) (SETQ CASE.CORRECT.FULLFILENAME (\UFS.ADD.HOST.FIELD CASE.CORRECT.NAME FDEV)) (* ;; "DSK cannot open a directory.") (AND (DSKP FDEV) (DIRECTORYNAMEP CASE.CORRECT.FULLFILENAME) (PROGN (PROMPTPRINT "{DSK} cannot open a directory file. Use {UNIX} device.") (\UFSError CASE.CORRECT.NAME 23 FDEV))) (SETQ CDATE (CREATECELL \FIXP)) (SETQ BYTESIZE (CREATECELL \FIXP)) (SETQ FILEID (OR (\UFSOpenFile-C CASE.CORRECT.FULLFILENAME REC ACC CDATE BYTESIZE ERRNO) (RETURN (\UFSError CASE.CORRECT.NAME ERRNO FDEV)))) (if (= (IPLUS BYTESIZE 0) -1) then (SETQ EOF-FN (FUNCTION \DEVICEFILE.EOSERROR)) (SETQ BYTESIZE 0) elseif (EQ ACCESS (QUOTE OUTPUT)) then (SETQ BYTESIZE 0)) (if STRM then (replace (STREAM FULLFILENAME) of STRM with (\UFS.FULLNAME CASE.CORRECT.NAME FDEV T)) (replace (STREAM DEVICE) of STRM with FDEV) (replace (STREAM EPAGE) of STRM with (FOLDLO BYTESIZE BYTESPERPAGE)) (replace (STREAM EOFFSET) of STRM with (IMOD BYTESIZE BYTESPERPAGE)) (replace (STREAM EOLCONVENTION) of STRM with (\UFSeol CASE.CORRECT.NAME (FASSOC (QUOTE TYPE) OTHERINFO))) (replace (STREAM VALIDATION) of STRM with CDATE) (replace (STREAM ENDOFSTREAMOP) of STRM with EOF-FN) else (SETQ STRM (create STREAM FULLFILENAME _ (\UFS.FULLNAME CASE.CORRECT.NAME FDEV T) DEVICE _ FDEV EPAGE _ (FOLDLO BYTESIZE BYTESPERPAGE) EOFFSET _ (IMOD BYTESIZE BYTESPERPAGE) EOLCONVENTION _ (\UFSeol CASE.CORRECT.NAME (FASSOC (QUOTE TYPE) OTHERINFO)) VALIDATION _ CDATE ENDOFSTREAMOP _ EOF-FN))) (replace (UFSSTREAM FILEID) of STRM with FILEID) (replace (UFSSTREAM CDATE) of STRM with (if (SETQ CINFO (FASSOC (QUOTE CREATIONDATE) OTHERINFO)) then (IDATE (CADR CINFO)) else 0)) (replace (UFSSTREAM UNIXNAME) of STRM with CASE.CORRECT.FULLFILENAME) (* ; "Save the case sensitive full file name for closef & getfileinfo.") (RETURN STRM)))) -) + [LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* ; "Edited 16-Oct-2025 08:52 by rmk") + (* ; "Edited 6-Jun-90 12:18 by nm") + +(* ;;; "Open a file.") + + (WITH.MONITOR (\UFSGetMonitor FDEV) + (PROG ((ACC (SELECTQ ACCESS + (INPUT ACCESS-INPUT) + (OUTPUT ACCESS-OUTPUT) + (BOTH ACCESS-BOTH) + (APPEND ACCESS-APPEND) + ACCESS-OTHER)) + (REC (SELECTQ RECOG + (OLD RECOG-OLD) + (OLDEST RECOG-OLDEST) + (NEW RECOG-NEW) + (OLD/NEW RECOG-NEW-OLD) + (SELECTQ ACCESS + (INPUT RECOG-OLD) + (OUTPUT RECOG-NEW) + ((BOTH APPEND) + RECOG-NEW-OLD) + RECOG-OTHER))) + (EOF-FN (FUNCTION \EOSERROR)) + (ERRNO (CREATECELL \FIXP)) + OTHER FILEID BYTESIZE CDATE FULLNAME CINFO STRM CASE.CORRECT.NAME + CASE.CORRECT.FULLFILENAME) + + (* ;; "CASE.CORRECT.NAME is MCCS") + + (SETQ CASE.CORRECT.NAME (if (type? STREAM FILE) + then [COND + ((fetch (UFSSTREAM FILEID) of FILE) + (* ; + "Already open--this really ought to be an error") + (RETURN FILE)) + (T (LET ((FULLNAME (fetch (UFSSTREAM UNIXNAME) + of FILE))) + (SETQ STRM FILE) + (* ; "Re use the old stream") + (SUBSTRING FULLNAME (ADD1 (STRPOS "}" + FULLNAME] + else (\UFS.RECOGNIZE.FILE FILE RECOG FDEV))) + [COND + ((NOT CASE.CORRECT.NAME) + (RETURN NIL)) + ((AND (NULL OLDSTREAM) + (EQ (fetch (FDEV DEVICENAME) of FDEV) + 'DSK) + (SETQ OTHER (\UFS.OPENP CASE.CORRECT.NAME FDEV)) + (SELECTQ ACCESS + (INPUT (* ; "ok if other file is also input") + (DIRTYABLE OTHER)) + T)) (* ; "Access conflict. Don't check this when just revalidating, of course. I also don't mess with this on UNIX device--let user get in trouble...") + (CL:ERROR 'XCL:FILE-WONT-OPEN :PATHNAME (\UFS.FULLNAME CASE.CORRECT.NAME FDEV] + (SETQ CASE.CORRECT.FULLFILENAME (\UFS.ADD.HOST.FIELD CASE.CORRECT.NAME FDEV)) + + (* ;; "DSK cannot open a directory.") + + (AND (DSKP FDEV) + (DIRECTORYNAMEP CASE.CORRECT.FULLFILENAME) + (PROGN (PROMPTPRINT "{DSK} cannot open a directory file. Use {UNIX} device.") + (\UFSError CASE.CORRECT.NAME 23 FDEV))) + (SETQ CDATE (CREATECELL \FIXP)) + (SETQ BYTESIZE (CREATECELL \FIXP)) + [SETQ FILEID (OR (\UFSOpenFile-C (MTOUTF8STRING CASE.CORRECT.FULLFILENAME) + REC ACC CDATE BYTESIZE ERRNO) + (RETURN (\UFSError CASE.CORRECT.NAME ERRNO FDEV] + (if (= (IPLUS BYTESIZE 0) + -1) + then (SETQ EOF-FN (FUNCTION \DEVICEFILE.EOSERROR)) + (SETQ BYTESIZE 0) + elseif (EQ ACCESS 'OUTPUT) + then (SETQ BYTESIZE 0)) + (if STRM + then (replace (STREAM FULLFILENAME) of STRM with (\UFS.FULLNAME CASE.CORRECT.NAME + FDEV T)) + (replace (STREAM DEVICE) of STRM with FDEV) + (replace (STREAM EPAGE) of STRM with (FOLDLO BYTESIZE BYTESPERPAGE)) + (replace (STREAM EOFFSET) of STRM with (IMOD BYTESIZE BYTESPERPAGE)) + (replace (STREAM EOLCONVENTION) of STRM with (\UFSeol CASE.CORRECT.NAME + (FASSOC 'TYPE OTHERINFO))) + (replace (STREAM VALIDATION) of STRM with CDATE) + (replace (STREAM ENDOFSTREAMOP) of STRM with EOF-FN) + else (SETQ STRM (create STREAM + FULLFILENAME _ (\UFS.FULLNAME CASE.CORRECT.NAME FDEV T) + DEVICE _ FDEV + EPAGE _ (FOLDLO BYTESIZE BYTESPERPAGE) + EOFFSET _ (IMOD BYTESIZE BYTESPERPAGE) + EOLCONVENTION _ (\UFSeol CASE.CORRECT.NAME (FASSOC + 'TYPE OTHERINFO)) + VALIDATION _ CDATE + ENDOFSTREAMOP _ EOF-FN))) + (replace (UFSSTREAM FILEID) of STRM with FILEID) + (replace (UFSSTREAM CDATE) of STRM with (if (SETQ CINFO (FASSOC 'CREATIONDATE OTHERINFO + )) + then (IDATE (CADR CINFO)) + else 0)) + (replace (UFSSTREAM UNIXNAME) of STRM with CASE.CORRECT.FULLFILENAME) + (* ; + "Save the case sensitive full file name for closef & getfileinfo.") + (RETURN STRM)))]) (\UFS.OPENP (LAMBDA (UNIXNAME DEV) (* ; "Edited 3-Mar-89 11:47 by bvm") (* ;; "Returns first open file having specified unix name") (for S in (fetch (FDEV OPENFILELST) of DEV) bind (COMPAREFN _ (if (EQ (fetch (FDEV DEVICENAME) of DEV) (QUOTE DSK)) then (* ; "We're case-insensitive, and it seems like not all functions return the correct Unix case") (FUNCTION STRING-EQUAL) else (* ; "Exact") (FUNCTION STREQUAL))) thereis (CL:FUNCALL COMPAREFN UNIXNAME (fetch (UFSSTREAM UNIXNAME) of S)))) ) (\UFS.RECOGNIZE.FILE -(LAMBDA (FILENAME RECOG DEV) (* ; "Edited 13-Mar-90 11:19 by nm") (* ;; "Perform recognition on FILENAME, returning the %"true%" name for the file, or NIL. The result file name is following the Xerox Lisp file naming convention but does not include HOST field. It will be supplied by \UFS.FULLNAME.") (WITH.MONITOR (\UFSGetMonitor DEV) (LET ((NAMEAREA (ALLOCSTRING MAX-PATHNAME-LEN)) (ERRNO (CREATECELL \FIXP)) LEN) (SETQ LEN (CL:FUNCALL (\UFS.FILE.RECOGNIZER DEV) (\UFS.REMOVE.HOST.FIELD FILENAME DEV) (SELECTQ RECOG (OLD RECOG-OLD) (OLDEST RECOG-OLDEST) (NEW RECOG-NEW) (OLD/NEW RECOG-NEW-OLD) (NON RECOG-NON) RECOG-NEW-OLD) NAMEAREA ERRNO)) (COND ((FIXP LEN) (SUBSTRING NAMEAREA 1 LEN)) (T (\UFSError FILENAME ERRNO)))))) -) + [LAMBDA (FILENAME RECOG DEV) (* ; "Edited 16-Oct-2025 10:19 by rmk") + (* ; "Edited 13-Mar-90 11:19 by nm") + + (* ;; "This assumes that input FILENAME is MCCS, returns MCCS") + + (* ;; "Perform recognition on FILENAME, returning the %"true%" name for the file, or NIL. The result file name is following the Xerox Lisp file naming convention but does not include HOST field. It will be supplied by \UFS.FULLNAME.") + + (WITH.MONITOR (\UFSGetMonitor DEV) + [LET ((NAMEAREA (ALLOCSTRING MAX-PATHNAME-LEN)) + (ERRNO (CREATECELL \FIXP)) + LEN) + (SETQ LEN (CL:FUNCALL (\UFS.FILE.RECOGNIZER DEV) + (MTOUTF8STRING (\UFS.REMOVE.HOST.FIELD FILENAME DEV)) + (SELECTQ RECOG + (OLD RECOG-OLD) + (OLDEST RECOG-OLDEST) + (NEW RECOG-NEW) + (OLD/NEW RECOG-NEW-OLD) + (NON RECOG-NON) + RECOG-NEW-OLD) + NAMEAREA ERRNO)) + (COND + ((FIXP LEN) + (UTF8TOMSTRING (SUBSTRING NAMEAREA 1 LEN))) + (T (\UFSError FILENAME ERRNO])]) (\UFS.DIRECTORY.NAME -(LAMBDA (DIRSTRING NAMEAREA DEV) (* ; "Edited 1-Apr-90 23:36 by nm") (* ;;; "Accepts a Xerox Lisp canonical directory name, and recognize it. If such directory exists, sets the %"ture%" name of the directory in NAMEAREA and returns the length of the name. If such directory does not exist, returns NIL. The canonical directory name does not include the initial directory delimiter and the trail directory delimiter, but the result %"ture%" name includes both of them. If DIRSTRING is %"<%", it means the root directory.") (if (STREQUAL DIRSTRING "<") then (RPLSTRING NAMEAREA 1 "<") 1 else (WITH.MONITOR (\UFSGetMonitor DEV) (CL:FUNCALL (\UFS.DIRECTORY.RECOGNIZER DEV) DIRSTRING NAMEAREA (CREATECELL \FIXP))))) -) + [LAMBDA (DIRSTRING NAMEAREA DEV) (* ; "Edited 15-Oct-2025 16:30 by rmk") + (* ; "Edited 1-Apr-90 23:36 by nm") + +(* ;;; "Accepts a Xerox Lisp canonical directory name, and recognize it. If such directory exists, sets the %"true%" name of the directory in NAMEAREA and returns the length of the name. If such directory does not exist, returns NIL. The canonical directory name does not include the initial directory delimiter and the trail directory delimiter, but the result %"true%" name includes both of them. If DIRSTRING is %"<%", it means the root directory.") + + (* ;; "DIRSTRING is MCCS, the true name is not") + + (if (STREQUAL DIRSTRING "<") + then (RPLSTRING NAMEAREA 1 "<") + 1 + else (WITH.MONITOR (\UFSGetMonitor DEV) + (CL:FUNCALL (\UFS.DIRECTORY.RECOGNIZER DEV) + (MTOUTF8STRING DIRSTRING) + NAMEAREA + (CREATECELL \FIXP)))]) (\UFSCloseFile - [LAMBDA (STREAMFILE) (* ; "Edited 16-Sep-2023 09:21 by briggs") + [LAMBDA (STREAMFILE) (* ; "Edited 16-Oct-2025 13:47 by rmk") + (* ; "Edited 16-Sep-2023 09:21 by briggs") (* ; "Edited 30-Mar-90 10:39 by nm") (* ; "return stream") @@ -314,7 +467,8 @@ then (* ; "Open for output") (FDEVOP 'TRUNCATEFILE DEVICE STREAMFILE) (SETQ CDATE (fetch (UFSSTREAM CDATE) of STREAMFILE))) - (RETURN (if (\UFSCloseFile-C UNIXNAME (fetch (UFSSTREAM FILEID) of STREAMFILE) + (RETURN (if (\UFSCloseFile-C (MTOUTF8STRING UNIXNAME) + (fetch (UFSSTREAM FILEID) of STREAMFILE) CDATE ERRNO) then (replace (UFSSTREAM FILEID) of STREAMFILE with NIL) (replace (UFSSTREAM CDATE) of STREAMFILE with NIL) @@ -328,11 +482,26 @@ ) (\UFSDeleteFile -(LAMBDA (FILENAME DEV) (* ; "Edited 30-Mar-90 10:46 by nm") (* ; "return deleted file name") (* ; "if error, return NIL") (WITH.MONITOR (\UFSGetMonitor DEV) (LET ((NAME (\UFS.RECOGNIZE.FILE FILENAME (QUOTE OLDEST) DEV))) (COND ((AND NAME (NOT (\UFS.OPENP NAME DEV))) (* ; "file found and not open, so try to delete") (LET ((ERRNO (CREATECELL \FIXP))) (COND ((\UFSDeleteFile-C (\UFS.REMOVE.HOST.FIELD NAME DEV) DEV ERRNO) (* ; "Success") (\UFS.FULLNAME NAME DEV T)) (T (* ; "Failure") (\UFSError NAME ERRNO DEV))))))))) -) + [LAMBDA (FILENAME DEV) (* ; "Edited 27-Oct-2025 11:10 by rmk") + (* ; "Edited 30-Mar-90 10:46 by nm") + (* ; "return deleted file name") + (* ; "if error, return NIL") + (WITH.MONITOR (\UFSGetMonitor DEV) + [LET ((NAME (\UFS.RECOGNIZE.FILE FILENAME 'OLDEST DEV))) + (COND + ((AND NAME (NOT (\UFS.OPENP NAME DEV))) (* ; + "file found and not open, so try to delete") + (LET ((ERRNO (CREATECELL \FIXP))) + (COND + ((\UFSDeleteFile-C (MTOUTF8STRING (\UFS.REMOVE.HOST.FIELD NAME DEV)) + DEV ERRNO) (* ; "Success") + (\UFS.FULLNAME NAME DEV T)) + (T (* ; "Failure") + (\UFSError NAME ERRNO DEV])]) (\UFSRenameFile - [LAMBDA (OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME) (* ; "Edited 18-Dec-2024 12:52 by rmk") + [LAMBDA (OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME) (* ; "Edited 16-Oct-2025 08:46 by rmk") + (* ; "Edited 18-Dec-2024 12:52 by rmk") (* ; "Edited 16-Apr-90 13:46 by nm") (if (NEQ OLD-DEVICE NEW-DEVICE) then @@ -349,8 +518,10 @@ (LET ((NEWUNIXNAME (\UFS.RECOGNIZE.FILE NEW-NAME 'NEW NEW-DEVICE)) (ERRNO (CREATECELL \FIXP))) (COND - ((\UFSRenameFile-C (\UFS.REMOVE.HOST.FIELD OLDUNIXNAME OLD-DEVICE) - (\UFS.REMOVE.HOST.FIELD NEWUNIXNAME NEW-DEVICE) + ((\UFSRenameFile-C (MTOUTF8STRING (\UFS.REMOVE.HOST.FIELD + OLDUNIXNAME OLD-DEVICE)) + (MTOUTF8STRING (\UFS.REMOVE.HOST.FIELD NEWUNIXNAME + NEW-DEVICE)) NEW-DEVICE ERRNO) (\UFS.FULLNAME NEWUNIXNAME NEW-DEVICE)) (T (if (EQL (IPLUS ERRNO 0) @@ -372,32 +543,200 @@ ) (\UFSTruncateFile -(LAMBDA (STREAM PAGE# OFFSET) (* ; "Edited 22-Aug-90 16:46 by nm") (* ;;; "Used to shorten or lengthen STREAM. If lengthening, pad the file with nulls. Used by SETEOFPTR and FORCEOUTPUT.") (\UPDATEOF STREAM) (OR (FIXP PAGE#) (SETQ PAGE# (fetch (STREAM EPAGE) of STREAM))) (OR (FIXP OFFSET) (SETQ OFFSET (fetch (STREAM EOFFSET) of STREAM))) (* ; "Truncate size was set to PAGE# and OFFSET") (PROG ((curEof (+ (UNFOLD (fetch (STREAM EPAGE) of STREAM) BYTESPERPAGE) (fetch (STREAM EOFFSET) of STREAM))) (needSize (+ (UNFOLD PAGE# BYTESPERPAGE) OFFSET)) (ERRNO (CREATECELL \FIXP))) (if (> needSize curEof) then (* ; "Push 0 to extend file.") (LET ((FILEPTR (\GETFILEPTR STREAM))) (\SETFILEPTR STREAM curEof) (to (- needSize curEof) do (\BOUT STREAM 0)) (\SETFILEPTR STREAM FILEPTR)) elseif T then (* ; "Call c to shorten file. It would be good if we kept track of the file's eof, so that we wouldn't have to do this on closef when nothing had changed") (OR (\UFSGetSize-C (fetch (UFSSTREAM FILEID) of STREAM) needSize ERRNO) (RETURN (\UFSError STREAM ERRNO))) else (RETURN)) (* ;; "Set new value to stream") (replace (STREAM EPAGE) of STREAM with PAGE#) (replace (STREAM EOFFSET) of STREAM with OFFSET) (LET ((DT (CREATECELL \FIXP))) (* ;; "Set new validation value. UNIX mtime is updated, so Lisp stream validation must be updated.") (if (\UFSGetFileInfo-C (fetch (UFSSTREAM UNIXNAME) of STREAM) ATTR-WDATE DT ERRNO) then (replace (STREAM VALIDATION) of STREAM with DT))))) -) + [LAMBDA (STREAM PAGE# OFFSET) (* ; "Edited 16-Oct-2025 08:56 by rmk") + (* ; "Edited 22-Aug-90 16:46 by nm") + +(* ;;; "Used to shorten or lengthen STREAM. If lengthening, pad the file with nulls. Used by SETEOFPTR and FORCEOUTPUT.") + + (\UPDATEOF STREAM) + (OR (FIXP PAGE#) + (SETQ PAGE# (fetch (STREAM EPAGE) of STREAM))) + (OR (FIXP OFFSET) + (SETQ OFFSET (fetch (STREAM EOFFSET) of STREAM))) (* ; + "Truncate size was set to PAGE# and OFFSET") + (PROG ((curEof (+ (UNFOLD (fetch (STREAM EPAGE) of STREAM) + BYTESPERPAGE) + (fetch (STREAM EOFFSET) of STREAM))) + (needSize (+ (UNFOLD PAGE# BYTESPERPAGE) + OFFSET)) + (ERRNO (CREATECELL \FIXP))) + (if (> needSize curEof) + then (* ; "Push 0 to extend file.") + (LET ((FILEPTR (\GETFILEPTR STREAM))) + (\SETFILEPTR STREAM curEof) + (to (- needSize curEof) do (\BOUT STREAM 0)) + (\SETFILEPTR STREAM FILEPTR)) + else (* ; "Call c to shorten file. It would be good if we kept track of the file's eof, so that we wouldn't have to do this on closef when nothing had changed") + (OR (\UFSGetSize-C (fetch (UFSSTREAM FILEID) of STREAM) + needSize ERRNO) + (RETURN (\UFSError STREAM ERRNO))) + else (RETURN)) + + (* ;; "Set new value to stream") + + (replace (STREAM EPAGE) of STREAM with PAGE#) + (replace (STREAM EOFFSET) of STREAM with OFFSET) + (LET ((DT (CREATECELL \FIXP))) + + (* ;; + "Set new validation value. UNIX mtime is updated, so Lisp stream validation must be updated.") + + (if (\UFSGetFileInfo-C (MTOUTF8STRING (fetch (UFSSTREAM UNIXNAME) of STREAM)) + ATTR-WDATE DT ERRNO) + then (replace (STREAM VALIDATION) of STREAM with DT]) (\UFSDirectoryNameP -(LAMBDA (DIRSPEC DEV) (* ; "Edited 21-Sep-92 15:27 by jds") (* ;;; " DIRECTORYNAMEP FDEV method. Performs a recognition as well and returns the %"true%" name if it exists.") (LET ((DIRECTORY (CONCAT (OR (UNPACKFILENAME.STRING DIRSPEC (QUOTE DEVICE)) "") (OR (UNPACKFILENAME.STRING DIRSPEC (QUOTE DIRECTORY) (QUOTE RETURN)) (\UFS.HANDLE.RELATIVEDIRECTORY (UNPACKFILENAME.STRING DIRSPEC (QUOTE RELATIVEDIRECTORY) (QUOTE RETURN)) DEV) (\UFS.DEFAULT.DIR DEV)))) NAMEAREA LEN) (* ;; " HOST field of DIRSPEC has been defaulted by the generic file system code. Thus we don't have to worry about the subdirectory case.") (COND (DIRECTORY (SETQ NAMEAREA (ALLOCSTRING MAX-PATHNAME-LEN)) (* ; "NAMEAREA will be modified by C code and hold the %"true%" name of DIRECTORY if DIRECTORY is recognized as a valid directory name.") (SETQ LEN (\UFS.DIRECTORY.NAME DIRECTORY NAMEAREA DEV)) (COND ((FIXP LEN) (* ; "LEN holds the length of the %"true%" name of DIRECTORY.") (\UFS.FULLNAME (SUBSTRING NAMEAREA 1 LEN) DEV NIL)) (T NIL))) (T NIL)))) -) + [LAMBDA (DIRSPEC DEV) (* ; "Edited 16-Oct-2025 10:23 by rmk") + (* ; "Edited 21-Sep-92 15:27 by jds") + +(* ;;; " DIRECTORYNAMEP FDEV method. Performs a recognition as well and returns the %"true%" name if it exists.") + + (LET ([DIRECTORY (CONCAT (OR (UNPACKFILENAME.STRING DIRSPEC 'DEVICE) + "") + (OR (UNPACKFILENAME.STRING DIRSPEC 'DIRECTORY 'RETURN) + (\UFS.HANDLE.RELATIVEDIRECTORY (UNPACKFILENAME.STRING DIRSPEC + 'RELATIVEDIRECTORY + 'RETURN) + DEV) + (\UFS.DEFAULT.DIR DEV] + NAMEAREA LEN) + + (* ;; " HOST field of DIRSPEC has been defaulted by the generic file system code. Thus we don't have to worry about the subdirectory case.") + + (COND + (DIRECTORY (SETQ NAMEAREA (ALLOCSTRING MAX-PATHNAME-LEN)) + (* ; "NAMEAREA will be modified by C code and hold the %"true%" name of DIRECTORY if DIRECTORY is recognized as a valid directory name.") + (SETQ LEN (\UFS.DIRECTORY.NAME DIRECTORY NAMEAREA DEV)) + (COND + ((FIXP LEN) (* ; + "LEN holds the length of the %"true%" name of DIRECTORY.") + (UTF8TOMSTRING (\UFS.FULLNAME (SUBSTRING NAMEAREA 1 LEN) + DEV NIL))) + (T NIL))) + (T NIL]) (\UFSEventFn (LAMBDA (Dev Event) (DECLARE (GLOBALVARS \UFS.GFS.TABLE)) (* ; "Edited 3-May-90 17:35 by nm") (WITH.MONITOR \UFStopMonitor (SELECTQ Event ((AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM) (\UFSCloseDevice) (SELECTQ (MACHINETYPE) ((MAIKO) (\UFSOpenDevice) (* ;; "revalidate open streams (should probably move this into the SELECTQ above) ") (\UNVISIBLE.PAGED.REVALIDATEFILELST Dev) (\PAGED.REVALIDATEFILELST Dev) (MAPHASH \UFS.GFS.TABLE (FUNCTION (LAMBDA (VAL KEY) (\UFS.UNREGISTER.GFS VAL)))) (CLRHASH \UFS.GFS.TABLE)) NIL)) ((BEFORELOGOUT) (\UNVISIBLE.FLUSH.OPEN.STREAMS Dev) (* ; "flush output buffers.") (\FLUSH.OPEN.STREAMS Dev)) NIL))) ) (\UFSGetFileInfo -(LAMBDA (STREAM ATTRIBUTE DEVICE) (* ; "Edited 30-Mar-90 12:27 by nm") (* ;;; "Get the value of the attribute for a file.") (* ;;; "Allocate buffer to store the value.") (* ;;; "If attribute is AUTHOR, the type of the buffer is STRING.") (* ;;; "Otherwise the type of the buffer is FIXP.") (WITH.MONITOR (\UFSGetMonitor DEVICE) (LET ((FILENAME (if (type? STREAM STREAM) then (fetch (UFSSTREAM UNIXNAME) of STREAM) else (\UFS.FULLNAME (\UFS.RECOGNIZE.FILE STREAM (QUOTE OLD) DEVICE) DEVICE NIL))) (ERRNO (CREATECELL \FIXP)) BUFFER NAMESIZE) (if FILENAME then (SELECTQ ATTRIBUTE (LENGTH (SETQ BUFFER (CREATECELL \FIXP)) (if (\UFSGetFileInfo-C FILENAME ATTR-LENGTH BUFFER ERRNO) then BUFFER else (\UFSError FILENAME ERRNO DEVICE))) (SIZE (SETQ BUFFER (CREATECELL \FIXP)) (if (\UFSGetFileInfo-C FILENAME ATTR-LENGTH BUFFER ERRNO) then (FOLDHI BUFFER BYTESPERPAGE) else (\UFSError FILENAME ERRNO DEVICE))) (TYPE (\UFSGetFileType FILENAME)) ((CREATIONDATE WRITEDATE) (SETQ BUFFER (CREATECELL \FIXP)) (if (\UFSGetFileInfo-C FILENAME ATTR-WDATE BUFFER ERRNO) then (GDATE BUFFER) else (\UFSError FILENAME ERRNO DEVICE))) (READDATE (SETQ BUFFER (CREATECELL \FIXP)) (if (\UFSGetFileInfo-C FILENAME ATTR-RDATE BUFFER ERRNO) then (GDATE BUFFER) else (\UFSError FILENAME ERRNO DEVICE))) ((ICREATIONDATE IWRITEDATE) (SETQ BUFFER (CREATECELL \FIXP)) (if (\UFSGetFileInfo-C FILENAME ATTR-WDATE BUFFER ERRNO) then BUFFER else (\UFSError FILENAME ERRNO DEVICE))) (IREADDATE (SETQ BUFFER (CREATECELL \FIXP)) (if (\UFSGetFileInfo-C FILENAME ATTR-RDATE BUFFER ERRNO) then BUFFER else (\UFSError FILENAME ERRNO DEVICE))) (AUTHOR (SETQ BUFFER (ALLOCSTRING MAX-UNAME-LEN)) (if (SETQ NAMESIZE (\UFSGetFileInfo-C FILENAME ATTR-AUTHOR BUFFER ERRNO)) then (CL:SUBSEQ BUFFER 0 NAMESIZE) else (\UFSError FILENAME ERRNO DEVICE))) (PROTECTION (SETQ BUFFER (CREATECELL \FIXP)) (if (\UFSGetFileInfo-C FILENAME ATTR-PROTECTION BUFFER ERRNO) then BUFFER else (\UFSError FILENAME ERRNO DEVICE))) (ALL (SETQ BUFFER (\UFS.CREATE.PROPS)) (if (SETQ NAMESIZE (\UFSGetFileInfo-C FILENAME ATTR-ALL BUFFER ERRNO)) then (LET ((ALIST (ASSOC (QUOTE AUTHOR) BUFFER))) (* ; "Copy string out of buffer") (RPLACD ALIST (CL:SUBSEQ (CDR ALIST) 0 NAMESIZE)) BUFFER) else (\UFSError FILENAME ERRNO DEVICE))) NIL))))) -) + [LAMBDA (STREAM ATTRIBUTE DEVICE) (* ; "Edited 16-Oct-2025 08:49 by rmk") + (* ; "Edited 30-Mar-90 12:27 by nm") + +(* ;;; "Get the value of the attribute for a file.") + +(* ;;; "Allocate buffer to store the value.") + +(* ;;; "If attribute is AUTHOR, the type of the buffer is STRING.") + +(* ;;; "Otherwise the type of the buffer is FIXP.") + + (WITH.MONITOR (\UFSGetMonitor DEVICE) + (LET ((FILENAME (if (type? STREAM STREAM) + then (fetch (UFSSTREAM UNIXNAME) of STREAM) + else (\UFS.FULLNAME (\UFS.RECOGNIZE.FILE STREAM 'OLD DEVICE) + DEVICE NIL))) + (ERRNO (CREATECELL \FIXP)) + BUFFER NAMESIZE) + (if FILENAME + then (SETQ FILENAME (MTOUTF8STRING FILENAME)) + (SELECTQ ATTRIBUTE + (LENGTH (SETQ BUFFER (CREATECELL \FIXP)) + (if (\UFSGetFileInfo-C FILENAME ATTR-LENGTH BUFFER ERRNO) + then BUFFER + else (\UFSError FILENAME ERRNO DEVICE))) + (SIZE (SETQ BUFFER (CREATECELL \FIXP)) + (if (\UFSGetFileInfo-C FILENAME ATTR-LENGTH BUFFER ERRNO) + then (FOLDHI BUFFER BYTESPERPAGE) + else (\UFSError FILENAME ERRNO DEVICE))) + (TYPE (\UFSGetFileType FILENAME)) + ((CREATIONDATE WRITEDATE) + (SETQ BUFFER (CREATECELL \FIXP)) + (if (\UFSGetFileInfo-C FILENAME ATTR-WDATE BUFFER ERRNO) + then (GDATE BUFFER) + else (\UFSError FILENAME ERRNO DEVICE))) + (READDATE (SETQ BUFFER (CREATECELL \FIXP)) + (if (\UFSGetFileInfo-C FILENAME ATTR-RDATE BUFFER ERRNO) + then (GDATE BUFFER) + else (\UFSError FILENAME ERRNO DEVICE))) + ((ICREATIONDATE IWRITEDATE) + (SETQ BUFFER (CREATECELL \FIXP)) + (if (\UFSGetFileInfo-C FILENAME ATTR-WDATE BUFFER ERRNO) + then BUFFER + else (\UFSError FILENAME ERRNO DEVICE))) + (IREADDATE (SETQ BUFFER (CREATECELL \FIXP)) + (if (\UFSGetFileInfo-C FILENAME ATTR-RDATE BUFFER ERRNO) + then BUFFER + else (\UFSError FILENAME ERRNO DEVICE))) + (AUTHOR (SETQ BUFFER (ALLOCSTRING MAX-UNAME-LEN)) + (if (SETQ NAMESIZE (\UFSGetFileInfo-C FILENAME ATTR-AUTHOR BUFFER + ERRNO)) + then (UTF8TOMSTRING (CL:SUBSEQ BUFFER 0 NAMESIZE)) + else (\UFSError FILENAME ERRNO DEVICE))) + (PROTECTION (SETQ BUFFER (CREATECELL \FIXP)) + (if (\UFSGetFileInfo-C FILENAME ATTR-PROTECTION BUFFER ERRNO) + then BUFFER + else (\UFSError FILENAME ERRNO DEVICE))) + (ALL (SETQ BUFFER (\UFS.CREATE.PROPS)) + (if (SETQ NAMESIZE (\UFSGetFileInfo-C FILENAME ATTR-ALL BUFFER ERRNO)) + then (LET ((ALIST (ASSOC 'AUTHOR BUFFER))) + (* ; "Copy string out of buffer") + (RPLACD ALIST (CL:SUBSEQ (CDR ALIST) + 0 NAMESIZE)) + BUFFER) + else (\UFSError FILENAME ERRNO DEVICE))) + NIL))))]) (\UFS.CREATE.PROPS (LAMBDA NIL (* ; "Edited 2-Mar-89 12:10 by bvm") (* ;; "Returns a data structure suitable for passing to the GetFileInfo ALL routine") (BQUOTE ((LENGTH (\,@ (CREATECELL \FIXP))) (WDATE (\,@ (CREATECELL \FIXP))) (RDATE (\,@ (CREATECELL \FIXP))) (PROTECTION (\,@ (CREATECELL \FIXP))) (AUTHOR (\,@ (ALLOCSTRING MAX-UNAME-LEN)))))) ) (\UFSSetFileInfo -(LAMBDA (STREAM ATTRIBUTE VALUE DEVICE) (* ; "Edited 30-Mar-90 12:31 by nm") (* ;;; "Get the VALUE of the ATTRIBUTE for a file.") (* ;;; "Allocate buffer to store the value.") (* ;;; "If attribute is AUTOR, the type of the buffer is STRING.") (* ;;; " Otherwise the type of the buffer is FIXP.") (WITH.MONITOR (\UFSGetMonitor DEVICE) (LET ((FILENAME (if (type? STREAM STREAM) then (fetch (UFSSTREAM UNIXNAME) of STREAM) else (\UFS.FULLNAME (\UFS.RECOGNIZE.FILE STREAM (QUOTE OLD) DEVICE) DEVICE NIL))) (ERRNO (CREATECELL \FIXP)) BUFFER NAMESIZE PATHNAME) (if FILENAME then (SELECTQ ATTRIBUTE (TYPE (\UFSSetFileType FILENAME VALUE)) ((CREATIONDATE WRITEDATE) (if (AND (STRINGP VALUE) (SETQ VALUE (IDATE VALUE))) then (OR (\UFSSetFileInfo-C FILENAME ATTR-WDATE VALUE ERRNO) (\UFSError FILENAME ERRNO DEVICE)) else (ERROR "Invalid argument" VALUE))) ((ICREATIONDATE IWRITEDATE) (if (FIXP VALUE) then (OR (\UFSSetFileInfo-C FILENAME ATTR-WDATE VALUE ERRNO) (\UFSError FILENAME ERRNO DEVICE)) else (ERROR "Invalid argument" VALUE))) (PROTECTION (if (FIXP VALUE) then (OR (\UFSSetFileInfo-C FILENAME ATTR-PROTECTION VALUE ERRNO) (\UFSError FILENAME ERRNO DEVICE)) else (ERROR "Invalid argument" VALUE))) NIL))))) -) + [LAMBDA (STREAM ATTRIBUTE VALUE DEVICE) (* ; "Edited 16-Oct-2025 08:51 by rmk") + (* ; "Edited 30-Mar-90 12:31 by nm") + +(* ;;; "Get the VALUE of the ATTRIBUTE for a file.") + +(* ;;; "Allocate buffer to store the value.") + +(* ;;; "If attribute is AUTOR, the type of the buffer is STRING.") + +(* ;;; " Otherwise the type of the buffer is FIXP.") + + (WITH.MONITOR (\UFSGetMonitor DEVICE) + (LET ((FILENAME (if (type? STREAM STREAM) + then (fetch (UFSSTREAM UNIXNAME) of STREAM) + else (\UFS.FULLNAME (\UFS.RECOGNIZE.FILE STREAM 'OLD DEVICE) + DEVICE NIL))) + (ERRNO (CREATECELL \FIXP)) + BUFFER NAMESIZE PATHNAME) + (if FILENAME + then (SETQ FILENAME (MTOUTF8STRING FILENAME)) + (SELECTQ ATTRIBUTE + (TYPE (\UFSSetFileType FILENAME VALUE)) + ((CREATIONDATE WRITEDATE) + (if (AND (STRINGP VALUE) + (SETQ VALUE (IDATE VALUE))) + then (OR (\UFSSetFileInfo-C FILENAME ATTR-WDATE VALUE ERRNO) + (\UFSError FILENAME ERRNO DEVICE)) + else (ERROR "Invalid argument" VALUE))) + ((ICREATIONDATE IWRITEDATE) + (if (FIXP VALUE) + then (OR (\UFSSetFileInfo-C FILENAME ATTR-WDATE VALUE ERRNO) + (\UFSError FILENAME ERRNO DEVICE)) + else (ERROR "Invalid argument" VALUE))) + (PROTECTION (if (FIXP VALUE) + then (OR (\UFSSetFileInfo-C FILENAME ATTR-PROTECTION VALUE + ERRNO) + (\UFSError FILENAME ERRNO DEVICE)) + else (ERROR "Invalid argument" VALUE))) + NIL))))]) (\UFSGenerateFiles [LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) + (* ;; "Edited 16-Oct-2025 11:06 by rmk") + (* ;; "Edited 27-Mar-2022 15:55 by rmk: Use the EXTENSION and VERFSION in the pattern instead of the inherited defaults") (* ;; "rmk; Use the EXTENSION and VERFSION in the pattern instead of the inherited defaults") @@ -435,19 +774,22 @@ (COND ((STREQUAL DIRECTORY "/") (SETQ DIRECTORY "<"))) - [SETQ FILTER (COND - ((STREQUAL DIRECTORY "<") - (CONCAT "{" (LISTGET PARSED 'HOST) - "}" - (OR DEVICE "") - "<" - (PACKFILENAME.STRING 'NAME NAME 'EXTENSION EXTENSION - 'VERSION VERSION))) - (T (PACKFILENAME.STRING 'DIRECTORY DIRECTORY 'HOST (LISTGET - PARSED - 'HOST) - 'DEVICE DEVICE 'NAME NAME 'EXTENSION EXTENSION 'VERSION - VERSION] + + (* ;; "DIRECTORY is MCCS, FILTER is UTF8") + + [SETQ FILTER (MTOUTF8STRING (COND + ((STREQUAL DIRECTORY "<") + (CONCAT "{" (LISTGET PARSED 'HOST) + "}" + (OR DEVICE "") + "<" + (PACKFILENAME.STRING 'NAME NAME 'EXTENSION + EXTENSION 'VERSION VERSION))) + (T (PACKFILENAME.STRING 'DIRECTORY DIRECTORY + 'HOST + (LISTGET PARSED 'HOST) + 'DEVICE DEVICE 'NAME NAME 'EXTENSION + EXTENSION 'VERSION VERSION] (SETQ LEN (\UFS.DIRECTORY.NAME (CONCAT (OR DEVICE "") DIRECTORY) NAMEAREA FDEV)) @@ -455,7 +797,7 @@ ((NOT (FIXP LEN)) (* ; "No such directory. We go thru this recognition step so that \UFSFindFile gives us name in the correct case") (PRINTOUT PROMPTWINDOW T "Can't enumerate " PATTERN " because no such directory") (RETURN (\NULLFILEGENERATOR] - (SETQ DIRECTORY (SUBSTRING NAMEAREA 1 LEN)) + (SETQ DIRECTORY (SUBSTRING NAMEAREA 1 LEN)) (* ; "DIRECTORY is now UTF8") (* ;; "The information about enumerated files are cached in the emulator. We receive the ID and the total number of enumerated files. The ID is used to identify the object corresponding to the enumerated file.") @@ -466,7 +808,8 @@ (SETQ TOTALNUM (\UFSReadDir-C FILTER PROPP ID ERRNO)) (COND [(< TOTALNUM 0) - (OR (\UFSError DIRECTORY ERRNO FDEV) + (OR (\UFSError (UTF8TOMSTRING DIRECTORY) + ERRNO FDEV) (RETURN (\NULLFILEGENERATOR] (T (COND ((ZEROP TOTALNUM) @@ -475,6 +818,9 @@ (EQ OPTIONS 'RESETLST)) (FMEMB 'RESETLST OPTIONS)) (RESETSAVE NIL '(AND RESETSTATE (\UFSFinishFileInfo-C ID] + + (* ;; "Everything in FILEGENOBJ is UTF8") + (RETURN (create FILEGENOBJ NEXTFILEFN _ (FUNCTION \UFS.NEXTFILEFN) FILEINFOFN _ (FUNCTION \UFS.FILEINFOFN) @@ -496,24 +842,31 @@ CURRENT-DEPTH _ 1 MAX-DEPTH _ FILING.ENUMERATION.DEPTH - FILTER _ ( - PACKFILENAME.STRING - 'NAME NAME - 'EXTENSION - EXTENSION - 'VERSION VERSION]) - ]) + FILTER _ + (PACKFILENAME.STRING + 'NAME + (AND NAME (MTOUTF8STRING + NAME)) + 'EXTENSION + (AND EXTENSION ( + MTOUTF8STRING + EXTENSION)) + 'VERSION VERSION])]) (\UFS.NEXTFILEFN [LAMBDA (GENFILESTATE NAMEONLY) + (* ;; "Edited 16-Oct-2025 16:59 by rmk") + (* ;; "Edited 27-Mar-2022 21:59 by rmk: Add FILTER to construct proper generator for subdirectories") (* ;; "Edited 7-Oct-93 14:31 by jds") (* ;; "Given a UFS filesystem generator, return the %"next%" file in line.") - (* ; "") + + (* ;; "All the fields of the UFSGENFILESTATE are UTF8. FILENAME is MCCS") + (LET ((SUBGEN (fetch (UFSGENFILESTATE SUBGENERATOR) of GENFILESTATE)) FILENAME NAMELEN NEWNAME) (COND @@ -556,6 +909,9 @@ GENFILESTATE ) 0 NAMELEN)) + + (* ;; "NEWNAME and DIRECTORY are both UTF8") + (SETQ FILENAME (\UFS.FULLNAME.M (fetch (UFSGENFILESTATE DIRECTORY) of GENFILESTATE) NEWNAME @@ -607,8 +963,8 @@ (* ;; "We're set up to recurse into the SUBGEN above") (\UFS.NEXTFILEFN GENFILESTATE NAMEONLY)) - (NAMEONLY NEWNAME) - (T FILENAME))) + (NAMEONLY (UTF8TOMSTRING NEWNAME)) + (T (UTF8TOMSTRING FILENAME)))) (AND RESETSTATE (\UFS.UNREGISTER.GFS GENFILESTATE T)))]) (\UFS.FILEINFOFN @@ -720,8 +1076,25 @@ (DEFINEQ (CHDIR -(LAMBDA (PATHNAME) (* ; "Edited 2-Apr-90 01:07 by nm") (* ;;; "(\CALL-C SUBR-UFS-DIRECTORYNAMEP ..) returns T(=1) or NIL.") (WITH.MONITOR \UFStopMonitor (LET ((PATH (\ADD.CONNECTED.DIR PATHNAME)) HOST) (if PATH then (SETQ HOST (U-CASE (FILENAMEFIELD PATH (QUOTE HOST)))) (if (OR (EQ HOST (QUOTE DSK)) (EQ HOST (QUOTE UNIX))) then (if (SETQ PATH (DIRECTORYNAME PATH)) then (if (\UFSCHDIR-C PATH) then (DIRECTORYNAME PATH) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)) else (ERROR "Bad Host Name" HOST)) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME))))) -) + [LAMBDA (PATHNAME) (* ; "Edited 16-Oct-2025 18:22 by rmk") + (* ; "Edited 2-Apr-90 01:07 by nm") + +(* ;;; "(\CALL-C SUBR-UFS-DIRECTORYNAMEP ..) returns T(=1) or NIL.") + + (WITH.MONITOR \UFStopMonitor + (LET ((PATH (\ADD.CONNECTED.DIR PATHNAME)) + HOST) + (if PATH + then [SETQ HOST (U-CASE (FILENAMEFIELD PATH 'HOST] + (if (OR (EQ HOST 'DSK) + (EQ HOST 'UNIX)) + then (if (SETQ PATH (DIRECTORYNAME PATH)) + then (if (\UFSCHDIR-C (MTOUTF8STRING PATH)) + then (DIRECTORYNAME PATH) + else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)) + else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)) + else (ERROR "Bad Host Name" HOST)) + else (ERROR "NO-SUCH-DIRECTORY" PATHNAME))))]) ) @@ -1184,23 +1557,23 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (8857 10410 (\UFSCreateDevice 8867 . 9232) (\UFS.CREATE.DEVICE 9234 . 10090) ( -\UFSOpenDevice 10092 . 10269) (\UFSCloseDevice 10271 . 10408)) (14673 52047 (\UFSOpenFile 14683 . -17977) (\UFS.OPENP 17979 . 18476) (\UFS.RECOGNIZE.FILE 18478 . 19231) (\UFS.DIRECTORY.NAME 19233 . -19976) (\UFSCloseFile 19978 . 21883) (\UFSGetFileName 21885 . 22084) (\UFSDeleteFile 22086 . 22626) ( -\UFSRenameFile 22628 . 24665) (\UFSReadPages 24667 . 25802) (\UFSWritePages 25804 . 27024) ( -\UFSTruncateFile 27026 . 28523) (\UFSDirectoryNameP 28525 . 29579) (\UFSEventFn 29581 . 30243) ( -\UFSGetFileInfo 30245 . 32527) (\UFS.CREATE.PROPS 32529 . 32882) (\UFSSetFileInfo 32884 . 34113) ( -\UFSGenerateFiles 34115 . 40995) (\UFS.NEXTFILEFN 40997 . 48635) (\UFS.FILEINFOFN 48637 . 50086) ( -\UFS.VALID.PROPP 50088 . 50380) (\UFS.REGISTER.GFS 50382 . 50637) (\UFS.UNREGISTER.GFS 50639 . 51222) -(\UFS.ABORT.DIRECTORY 51224 . 51572) (\UFS.ABORT.CL-DIRECTORY 51574 . 51861) (\UFS.CLEANUP.GFS.TABLE -51863 . 52045)) (52082 58766 (\UFSMakeUnixFormatName 52092 . 53113) (\UFSParseNameString 53115 . 53489 -) (\UFSParse-Directory 53491 . 54032) (\UFS.PARSE.BODY 54034 . 54579) (\UFS.ADJUST.HOST 54581 . 54740) - (\UFS.FULLNAME 54742 . 55950) (\UFS.ADD.HOST.FIELD 55952 . 56312) (\UFS.REMOVE.HOST.FIELD 56314 . -57984) (\UFS.HANDLE.RELATIVEDIRECTORY 57986 . 58764)) (59582 60195 (CHDIR 59592 . 60193)) (60267 61253 - (\DEVICEFILE.EOSERROR 60277 . 61251)) (61326 62563 (\UNVISIBLE.PAGED.REVALIDATEFILELST 61336 . 62181) - (\UNVISIBLE.FLUSH.OPEN.STREAMS 62183 . 62561)) (62596 64222 (\UFSError 62606 . 64220)) (64266 66681 ( -\UFSGetFileType 64276 . 64877) (\UFSSetFileType 64879 . 65476) (\UFSeol 65478 . 66679)) (75328 76452 ( -\UFSGetPrintFileType 75338 . 75750) (\UFSGetFileTypeConfirm 75752 . 76200) (\UFSPrintTypeMenu 76202 . -76450)) (76482 79320 (\UFStoOtherCopyMess 76492 . 78170) (\UFStoOtherRenameMess 78172 . 79318))))) + (FILEMAP (NIL (9321 10874 (\UFSCreateDevice 9331 . 9696) (\UFS.CREATE.DEVICE 9698 . 10554) ( +\UFSOpenDevice 10556 . 10733) (\UFSCloseDevice 10735 . 10872)) (15137 63831 (\UFSOpenFile 15147 . +21723) (\UFS.OPENP 21725 . 22222) (\UFS.RECOGNIZE.FILE 22224 . 23654) (\UFS.DIRECTORY.NAME 23656 . +24746) (\UFSCloseFile 24748 . 26807) (\UFSGetFileName 26809 . 27008) (\UFSDeleteFile 27010 . 28204) ( +\UFSRenameFile 28206 . 30523) (\UFSReadPages 30525 . 31660) (\UFSWritePages 31662 . 32882) ( +\UFSTruncateFile 32884 . 35290) (\UFSDirectoryNameP 35292 . 37155) (\UFSEventFn 37157 . 37819) ( +\UFSGetFileInfo 37821 . 42284) (\UFS.CREATE.PROPS 42286 . 42639) (\UFSSetFileInfo 42641 . 44987) ( +\UFSGenerateFiles 44989 . 52601) (\UFS.NEXTFILEFN 52603 . 60419) (\UFS.FILEINFOFN 60421 . 61870) ( +\UFS.VALID.PROPP 61872 . 62164) (\UFS.REGISTER.GFS 62166 . 62421) (\UFS.UNREGISTER.GFS 62423 . 63006) +(\UFS.ABORT.DIRECTORY 63008 . 63356) (\UFS.ABORT.CL-DIRECTORY 63358 . 63645) (\UFS.CLEANUP.GFS.TABLE +63647 . 63829)) (63866 70550 (\UFSMakeUnixFormatName 63876 . 64897) (\UFSParseNameString 64899 . 65273 +) (\UFSParse-Directory 65275 . 65816) (\UFS.PARSE.BODY 65818 . 66363) (\UFS.ADJUST.HOST 66365 . 66524) + (\UFS.FULLNAME 66526 . 67734) (\UFS.ADD.HOST.FIELD 67736 . 68096) (\UFS.REMOVE.HOST.FIELD 68098 . +69768) (\UFS.HANDLE.RELATIVEDIRECTORY 69770 . 70548)) (71366 72511 (CHDIR 71376 . 72509)) (72583 73569 + (\DEVICEFILE.EOSERROR 72593 . 73567)) (73642 74879 (\UNVISIBLE.PAGED.REVALIDATEFILELST 73652 . 74497) + (\UNVISIBLE.FLUSH.OPEN.STREAMS 74499 . 74877)) (74912 76538 (\UFSError 74922 . 76536)) (76582 78997 ( +\UFSGetFileType 76592 . 77193) (\UFSSetFileType 77195 . 77792) (\UFSeol 77794 . 78995)) (87644 88768 ( +\UFSGetPrintFileType 87654 . 88066) (\UFSGetFileTypeConfirm 88068 . 88516) (\UFSPrintTypeMenu 88518 . +88766)) (88798 91636 (\UFStoOtherCopyMess 88808 . 90486) (\UFStoOtherRenameMess 90488 . 91634))))) STOP diff --git a/sources/UFS.LCOM b/sources/UFS.LCOM index 850c76ef..628ddcbe 100644 Binary files a/sources/UFS.LCOM and b/sources/UFS.LCOM differ diff --git a/sources/XCL-EXTRAS b/sources/XCL-EXTRAS index 1312a13b..97655218 100644 --- a/sources/XCL-EXTRAS +++ b/sources/XCL-EXTRAS @@ -1,13 +1,14 @@ -(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "XCL") -(IL:FILECREATED "18-May-90 01:15:40" IL:|{DSK}local>lde>lispcore>sources>XCL-EXTRAS.;2| 15315 +(DEFINE-FILE-INFO PACKAGE "XEROX-COMMON-LISP" READTABLE "XCL" BASE 10) - IL:|changes| IL:|to:| (IL:VARS IL:XCL-EXTRASCOMS) +(IL:FILECREATED "11-Dec-2025 22:27:58" IL:|{DSK}matt>Interlisp>medley>sources>XCL-EXTRAS.;2| 15547 - IL:|previous| IL:|date:| "11-Jan-88 16:59:17" -IL:|{DSK}local>lde>lispcore>sources>XCL-EXTRAS.;1|) + :EDIT-BY "mth" + :CHANGES-TO (IL:FUNCTIONS DEFINE-RECORD) + + :PREVIOUS-DATE "18-May-90 01:15:40" IL:|{DSK}matt>Interlisp>medley>sources>XCL-EXTRAS.;1| +) -; Copyright (c) 1987, 1988, 1990 by Venue & Xerox Corporation. All rights reserved. (IL:PRETTYCOMPRINT IL:XCL-EXTRASCOMS) @@ -145,8 +146,7 @@ IL:|{DSK}local>lde>lispcore>sources>XCL-EXTRAS.;1|) IL:*INTERLISP-PACKAGE*)) (COLLECT KEYWORD-SYMBOL) (IF (NOT (MEMBER KEYWORD-SYMBOL '(IL:USING IL:COPYING - IL:REUSING IL:SMASHING - ) + IL:REUSING IL:SMASHING) :TEST #'EQ)) (COLLECT 'IL:_)) @@ -162,12 +162,12 @@ IL:|{DSK}local>lde>lispcore>sources>XCL-EXTRAS.;1|) (DEFDEFINER DEFINE-RECORD IL:STRUCTURES (RECORD-NAME INTERLISP-RECORD-NAME &KEY (CONC-NAME NIL - CONC-NAME-P - ) - (CONSTRUCTOR NIL CONSTRUCTOR-P) - (PREDICATE NIL PREDICATE-P) - (FAST-ACCESSORS NIL) - (PACKAGE *PACKAGE*)) + CONC-NAME-P) + (CONSTRUCTOR NIL CONSTRUCTOR-P) + (PREDICATE NIL PREDICATE-P) + (FAST-ACCESSORS NIL) + (PACKAGE *PACKAGE*)) + (IL:* IL:\; "Edited 11-Dec-2025 21:43 by mth") (IF (NOT (PACKAGEP PACKAGE)) (SETQ PACKAGE (FIND-PACKAGE PACKAGE))) (SETQ CONC-NAME (IF CONC-NAME-P @@ -195,7 +195,8 @@ IL:|{DSK}local>lde>lispcore>sources>XCL-EXTRAS.;1|) 'SETF-RECORD-ACCESS-MACRO) (SETF (GET ',NEW-NAME :SLOT-INFO) ',`((,INTERLISP-RECORD-NAME ,FIELD-NAME) - ,FAST-ACCESSORS)))))) + ,FAST-ACCESSORS)) + (IL:CLSMARTEN '((,NEW-NAME IL:OBJECT))))))) FIELD-NAMES) ,@(LET ((NEW-NAME (IF PREDICATE-P PREDICATE @@ -214,7 +215,8 @@ IL:|{DSK}local>lde>lispcore>sources>XCL-EXTRAS.;1|) `((SETF (MACRO-FUNCTION ',NEW-NAME) 'RECORD-PREDICATE-MACRO) (SETF (GET ',NEW-NAME :TYPE-INFO) - ',INTERLISP-RECORD-NAME)))) + ',INTERLISP-RECORD-NAME) + (IL:CLSMARTEN '((,NEW-NAME IL:OBJECT)))))) ,@(LET ((NEW-NAME (IF CONSTRUCTOR-P CONSTRUCTOR (INTERN (CONCATENATE 'STRING "MAKE-" (STRING RECORD-NAME)) @@ -234,7 +236,8 @@ IL:|{DSK}local>lde>lispcore>sources>XCL-EXTRAS.;1|) `((SETF (MACRO-FUNCTION ',NEW-NAME) 'RECORD-CONSTRUCTOR-MACRO) (SETF (GET ',NEW-NAME :FIELD-INFO) - '(,INTERLISP-RECORD-NAME ,FIELD-NAMES)))))))) + '(,INTERLISP-RECORD-NAME ,FIELD-NAMES)) + (IL:CLSMARTEN '((,NEW-NAME &KEY ,@FIELD-NAMES))))))))) (DEFUN RECORD-ACCESS-MACRO (FORM &OPTIONAL ENV) (DECLARE (IGNORE ENV)) @@ -257,8 +260,8 @@ IL:|{DSK}local>lde>lispcore>sources>XCL-EXTRAS.;1|) (DEFUN RECORD-PREDICATE-MACRO (FORM &OPTIONAL ENV) (DECLARE (IGNORE ENV)) `(IL:|type?| ,(OR (GET (CAR FORM) - :TYPE-INFO) - (ERROR "No type information cached.")) + :TYPE-INFO) + (ERROR "No type information cached.")) ,(SECOND FORM))) (DEFUN RECORD-CONSTRUCTOR-MACRO (FORM &OPTIONAL ENV) @@ -267,32 +270,35 @@ IL:|{DSK}local>lde>lispcore>sources>XCL-EXTRAS.;1|) (OR (GET (CAR FORM) :FIELD-INFO) (ERROR "No field information cached.")) - `(IL:|create| ,TYPE - ,@(WITH-COLLECTION (DO* ((KEYWORD (CDR FORM) - (CDDR KEYWORD)) - (KEYWORD-SYMBOL (CAR KEYWORD) - (CAR KEYWORD)) - (VALUE (CADR KEYWORD) - (CADR KEYWORD)) - RESERVED-WORD) - ((NULL KEYWORD)) - (SETQ RESERVED-WORD - (CAR (MEMBER KEYWORD-SYMBOL - '(IL:USING IL:COPYING IL:REUSING - IL:SMASHING) - :TEST - 'STRING=))) - (COLLECT (OR RESERVED-WORD (CAR (MEMBER KEYWORD-SYMBOL - FIELD-NAMES :TEST - 'STRING=)))) - (IF (NOT RESERVED-WORD) - (COLLECT 'IL:_)) - (COLLECT VALUE)))))) + `(IL:|create| ,TYPE ,@(WITH-COLLECTION (DO* ((KEYWORD (CDR FORM) + (CDDR KEYWORD)) + (KEYWORD-SYMBOL (CAR KEYWORD) + (CAR KEYWORD)) + (VALUE (CADR KEYWORD) + (CADR KEYWORD)) + RESERVED-WORD) + ((NULL KEYWORD)) + (SETQ RESERVED-WORD + (CAR (MEMBER KEYWORD-SYMBOL + '(IL:USING IL:COPYING + IL:REUSING IL:SMASHING) + :TEST + 'STRING=))) + (COLLECT (OR RESERVED-WORD + (CAR (MEMBER KEYWORD-SYMBOL + FIELD-NAMES :TEST + 'STRING=)))) + (IF (NOT RESERVED-WORD) + (COLLECT 'IL:_)) + (COLLECT VALUE)))))) (IL:PUTPROPS IL:XCL-EXTRAS IL:FILETYPE :COMPILE-FILE) (IL:PUTPROPS IL:XCL-EXTRAS IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "XCL")) -(IL:PUTPROPS IL:XCL-EXTRAS IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1990)) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL))) + (IL:FILEMAP (NIL (2264 4771 (ONCE-ONLY 2264 . 4771)) (4828 5137 (RECORD-FETCH 4828 . 5137)) (5139 5483 + (SETF-FETCH 5139 . 5483)) (5485 5796 (RECORD-FFETCH 5485 . 5796)) (5798 6144 (SETF-FFETCH 5798 . 6144 +)) (6146 7341 (RECORD-CREATE 6146 . 7341)) (12279 12699 (RECORD-ACCESS-MACRO 12279 . 12699)) (13146 +13397 (RECORD-PREDICATE-MACRO 13146 . 13397)) (13399 15360 (RECORD-CONSTRUCTOR-MACRO 13399 . 15360)))) +) IL:STOP diff --git a/sources/XCL-EXTRAS.DFASL b/sources/XCL-EXTRAS.DFASL index ffaff01b..ad835e6e 100644 Binary files a/sources/XCL-EXTRAS.DFASL and b/sources/XCL-EXTRAS.DFASL differ diff --git a/sources/XCL-LOOP b/sources/XCL-LOOP index c6a90142..8f818518 100644 --- a/sources/XCL-LOOP +++ b/sources/XCL-LOOP @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "LOOP" (USE "LISP" "XCL")) READTABLE "XCL" BASE 10) -(il:filecreated "14-Jun-2024 23:09:54" il:|{DSK}matt>Interlisp>medley>sources>XCL-LOOP.;4| 62255 +(il:filecreated " 3-Dec-2025 12:36:20" il:|{DSK}matt>Interlisp>medley>sources>XCL-LOOP.;3| 62357 :edit-by "mth" - :changes-to (il:functions default-type default-value) + :changes-to (il:functions cl::symbol-macrolet) - :previous-date " 8-Apr-2024 19:38:27" il:|{DSK}matt>Interlisp>medley>sources>XCL-LOOP.;2| + :previous-date " 3-Dec-2025 11:51:58" il:|{DSK}matt>Interlisp>medley>sources>XCL-LOOP.;2| ) @@ -1202,12 +1202,13 @@ (defun stray-of-type-error () (loop-error "OF-TYPE keyword should be followed by a type spec.")) -(defmacro cl::symbol-macrolet (vardefs &body body) (il:* il:\; "Edited 24-Mar-2024 21:46 by lmm") +(defmacro cl::symbol-macrolet (vardefs &body body) (il:* il:\; "Edited 3-Dec-2025 12:34 by mth") + (il:* il:\; "Edited 24-Mar-2024 21:46 by lmm") (il:* il:|;;| "") - `(progn ,@(il:subpair (cons 'setq (mapcar vardefs #'car)) - (cons 'setf (mapcar vardefs #'cadr)) + `(progn ,@(il:subpair (cons 'setq (mapcar #'car vardefs)) + (cons 'setf (mapcar #'cadr vardefs)) body))) (defun type-spec? () @@ -1426,56 +1427,56 @@ ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.") (il:declare\: il:dontcopy - (il:filemap (nil (6777 6862 (%keyword 6777 . 6862)) (6864 7047 (%list 6864 . 7047)) (7049 8306 ( -accumulate-in-list 7049 . 8306)) (8308 9988 (accumulation-clause 8308 . 9988)) (9990 10224 ( -accumulator-kind 9990 . 10224)) (10226 12115 (accumulator-spec 10226 . 12115)) (12117 12586 ( -along-with 12117 . 12586)) (12588 13080 (always-never-thereis-clause 12588 . 13080)) (13082 13441 ( -ambiguous-loop-result-error 13082 . 13441)) (13443 13658 (append-context 13443 . 13658)) (13737 14114 -(bindings 13737 . 14114)) (14116 14456 (bound-variables 14116 . 14456)) (14458 14548 (by-step-fun -14458 . 14548)) (14550 14656 (car-type 14550 . 14656)) (14658 14764 (cdr-type 14658 . 14764)) (14766 -15163 (check-multiple-bindings 14766 . 15163)) (15165 15385 (cl-external-p 15165 . 15385)) (15387 -15516 (clause* 15387 . 15516)) (15518 15918 (clause1 15518 . 15918)) (15920 16077 (compound-forms* -15920 . 16077)) (16079 16203 (compound-forms+ 16079 . 16203)) (16205 17463 (conditional-clause 16205 - . 17463)) (17465 18176 (constant-bindings 17465 . 18176)) (18178 18549 (constant-function-p 18178 . -18549)) (18551 18745 (constant-vector 18551 . 18745)) (18747 18838 (constant-vector-p 18747 . 18838)) -(18840 19032 (d-var-spec-p 18840 . 19032)) (19034 19264 (d-var-spec1 19034 . 19264)) (19266 19591 ( -d-var-type-spec 19266 . 19591)) (19593 20153 (declarations 19593 . 20153)) (20155 20265 ( -default-binding 20155 . 20265)) (20267 20880 (default-bindings 20267 . 20880)) (20882 21530 ( -default-type 20882 . 21530)) (21532 22302 (default-value 21532 . 22302)) (22304 23794 ( -destructuring-multiple-value-bind 22304 . 23794)) (23796 25081 (destructuring-multiple-value-setq -23796 . 25081)) (25083 25610 (dispatch-for-as-subclause 25083 . 25610)) (25612 25681 (do-clause 25612 - . 25681)) (25683 25859 (empty-p 25683 . 25859)) (25861 26135 (enumerate 25861 . 26135)) (26137 27863 -(extended-loop 26137 . 27863)) (27865 28036 (fill-in 27865 . 28036)) (28038 28115 (finally-clause -28038 . 28115)) (28117 28235 (for 28117 . 28235)) (28237 29593 (for-as-across-subclause 28237 . 29593) -) (29595 30517 (for-as-arithmetic-possible-prepositions 29595 . 30517)) (30519 31235 ( -for-as-arithmetic-step-and-test-functions 30519 . 31235)) (31237 33182 (for-as-arithmetic-subclause -31237 . 33182)) (33184 33634 (for-as-being-subclause 33184 . 33634)) (33636 34852 (for-as-clause 33636 - . 34852)) (34854 36382 (for-as-equals-then-subclause 34854 . 36382)) (36384 36662 (for-as-fill-in -36384 . 36662)) (36664 38630 (for-as-hash-subclause 36664 . 38630)) (38632 38878 ( -for-as-in-list-subclause 38632 . 38878)) (38880 40373 (for-as-on-list-subclause 38880 . 40373)) (40375 - 42077 (for-as-package-subclause 40375 . 42077)) (42079 42310 (for-as-parallel-p 42079 . 42310)) ( -42312 42460 (form-or-it 42312 . 42460)) (42462 42581 (form1 42462 . 42581)) (42583 42683 ( -gensym-ignorable 42583 . 42683)) (42685 42796 (globally-special-p 42685 . 42796)) (42798 42977 ( -hash-d-var-spec 42798 . 42977)) (42979 43060 (initially-clause 42979 . 43060)) (43062 43219 ( -invalid-accumulator-combination-error 43062 . 43219)) (43221 43838 (keyword1 43221 . 43838)) (43840 -44310 (keyword? 43840 . 44310)) (44312 44421 (let-form 44312 . 44421)) (44423 44577 (loop-error 44423 - . 44577)) (44579 44770 (loop-finish-test-forms 44579 . 44770)) (44772 44924 (loop-warn 44772 . 44924) -) (44926 45130 (lp 44926 . 45130)) (45132 45569 (main-clause* 45132 . 45569)) (45571 45667 (mapappend -45571 . 45667)) (45669 46199 (multiple-value-list-argument-form 45669 . 46199)) (46201 46594 ( -multiple-value-list-form-p 46201 . 46594)) (46596 46934 (name-clause? 46596 . 46934)) (46936 47215 ( -one 46936 . 47215)) (47217 48862 (ordinary-bindings 47217 . 48862)) (48864 49081 (preposition1 48864 - . 49081)) (49083 49284 (preposition? 49083 . 49284)) (49286 49446 (psetq-forms 49286 . 49446)) (49448 - 49628 (quoted-form-p 49448 . 49628)) (49630 49885 (quoted-object 49630 . 49885)) (49887 50691 ( -reduce-redundant-code 49887 . 50691)) (50693 50922 (repeat-clause 50693 . 50922)) (50924 51014 ( -return-clause 50924 . 51014)) (51016 51851 (selectable-clause 51016 . 51851)) (51853 52004 ( -simple-loop 51853 . 52004)) (52006 52084 (simple-var-p 52006 . 52084)) (52086 52270 (simple-var1 52086 - . 52270)) (52272 52379 (stray-of-type-error 52272 . 52379)) (52381 52666 (cl::symbol-macrolet 52381 - . 52666)) (52668 53102 (type-spec? 52668 . 53102)) (53104 53170 (until-clause 53104 . 53170)) (53172 -53753 (using-other-var 53172 . 53753)) (53755 53949 (variable-clause* 53755 . 53949)) (53951 54055 ( -while-clause 53951 . 54055)) (54057 54236 (with 54057 . 54236)) (54238 54683 (with-accumulators 54238 - . 54683)) (54685 54935 (with-binding-forms 54685 . 54935)) (54937 56168 (with-clause 54937 . 56168)) -(56170 56429 (with-iterator-forms 56170 . 56429)) (56431 57578 (with-list-accumulator 56431 . 57578)) -(57580 58017 (with-loop-context 57580 . 58017)) (58019 59257 (with-numeric-accumulator 58019 . 59257)) - (59259 59780 (with-temporaries 59259 . 59780)) (59782 60062 (zero 59782 . 60062)) (60064 60197 (loop -60064 . 60197))))) + (il:filemap (nil (6770 6855 (%keyword 6770 . 6855)) (6857 7040 (%list 6857 . 7040)) (7042 8299 ( +accumulate-in-list 7042 . 8299)) (8301 9981 (accumulation-clause 8301 . 9981)) (9983 10217 ( +accumulator-kind 9983 . 10217)) (10219 12108 (accumulator-spec 10219 . 12108)) (12110 12579 ( +along-with 12110 . 12579)) (12581 13073 (always-never-thereis-clause 12581 . 13073)) (13075 13434 ( +ambiguous-loop-result-error 13075 . 13434)) (13436 13651 (append-context 13436 . 13651)) (13730 14107 +(bindings 13730 . 14107)) (14109 14449 (bound-variables 14109 . 14449)) (14451 14541 (by-step-fun +14451 . 14541)) (14543 14649 (car-type 14543 . 14649)) (14651 14757 (cdr-type 14651 . 14757)) (14759 +15156 (check-multiple-bindings 14759 . 15156)) (15158 15378 (cl-external-p 15158 . 15378)) (15380 +15509 (clause* 15380 . 15509)) (15511 15911 (clause1 15511 . 15911)) (15913 16070 (compound-forms* +15913 . 16070)) (16072 16196 (compound-forms+ 16072 . 16196)) (16198 17456 (conditional-clause 16198 + . 17456)) (17458 18169 (constant-bindings 17458 . 18169)) (18171 18542 (constant-function-p 18171 . +18542)) (18544 18738 (constant-vector 18544 . 18738)) (18740 18831 (constant-vector-p 18740 . 18831)) +(18833 19025 (d-var-spec-p 18833 . 19025)) (19027 19257 (d-var-spec1 19027 . 19257)) (19259 19584 ( +d-var-type-spec 19259 . 19584)) (19586 20146 (declarations 19586 . 20146)) (20148 20258 ( +default-binding 20148 . 20258)) (20260 20873 (default-bindings 20260 . 20873)) (20875 21523 ( +default-type 20875 . 21523)) (21525 22295 (default-value 21525 . 22295)) (22297 23787 ( +destructuring-multiple-value-bind 22297 . 23787)) (23789 25074 (destructuring-multiple-value-setq +23789 . 25074)) (25076 25603 (dispatch-for-as-subclause 25076 . 25603)) (25605 25674 (do-clause 25605 + . 25674)) (25676 25852 (empty-p 25676 . 25852)) (25854 26128 (enumerate 25854 . 26128)) (26130 27856 +(extended-loop 26130 . 27856)) (27858 28029 (fill-in 27858 . 28029)) (28031 28108 (finally-clause +28031 . 28108)) (28110 28228 (for 28110 . 28228)) (28230 29586 (for-as-across-subclause 28230 . 29586) +) (29588 30510 (for-as-arithmetic-possible-prepositions 29588 . 30510)) (30512 31228 ( +for-as-arithmetic-step-and-test-functions 30512 . 31228)) (31230 33175 (for-as-arithmetic-subclause +31230 . 33175)) (33177 33627 (for-as-being-subclause 33177 . 33627)) (33629 34845 (for-as-clause 33629 + . 34845)) (34847 36375 (for-as-equals-then-subclause 34847 . 36375)) (36377 36655 (for-as-fill-in +36377 . 36655)) (36657 38623 (for-as-hash-subclause 36657 . 38623)) (38625 38871 ( +for-as-in-list-subclause 38625 . 38871)) (38873 40366 (for-as-on-list-subclause 38873 . 40366)) (40368 + 42070 (for-as-package-subclause 40368 . 42070)) (42072 42303 (for-as-parallel-p 42072 . 42303)) ( +42305 42453 (form-or-it 42305 . 42453)) (42455 42574 (form1 42455 . 42574)) (42576 42676 ( +gensym-ignorable 42576 . 42676)) (42678 42789 (globally-special-p 42678 . 42789)) (42791 42970 ( +hash-d-var-spec 42791 . 42970)) (42972 43053 (initially-clause 42972 . 43053)) (43055 43212 ( +invalid-accumulator-combination-error 43055 . 43212)) (43214 43831 (keyword1 43214 . 43831)) (43833 +44303 (keyword? 43833 . 44303)) (44305 44414 (let-form 44305 . 44414)) (44416 44570 (loop-error 44416 + . 44570)) (44572 44763 (loop-finish-test-forms 44572 . 44763)) (44765 44917 (loop-warn 44765 . 44917) +) (44919 45123 (lp 44919 . 45123)) (45125 45562 (main-clause* 45125 . 45562)) (45564 45660 (mapappend +45564 . 45660)) (45662 46192 (multiple-value-list-argument-form 45662 . 46192)) (46194 46587 ( +multiple-value-list-form-p 46194 . 46587)) (46589 46927 (name-clause? 46589 . 46927)) (46929 47208 ( +one 46929 . 47208)) (47210 48855 (ordinary-bindings 47210 . 48855)) (48857 49074 (preposition1 48857 + . 49074)) (49076 49277 (preposition? 49076 . 49277)) (49279 49439 (psetq-forms 49279 . 49439)) (49441 + 49621 (quoted-form-p 49441 . 49621)) (49623 49878 (quoted-object 49623 . 49878)) (49880 50684 ( +reduce-redundant-code 49880 . 50684)) (50686 50915 (repeat-clause 50686 . 50915)) (50917 51007 ( +return-clause 50917 . 51007)) (51009 51844 (selectable-clause 51009 . 51844)) (51846 51997 ( +simple-loop 51846 . 51997)) (51999 52077 (simple-var-p 51999 . 52077)) (52079 52263 (simple-var1 52079 + . 52263)) (52265 52372 (stray-of-type-error 52265 . 52372)) (52374 52768 (cl::symbol-macrolet 52374 + . 52768)) (52770 53204 (type-spec? 52770 . 53204)) (53206 53272 (until-clause 53206 . 53272)) (53274 +53855 (using-other-var 53274 . 53855)) (53857 54051 (variable-clause* 53857 . 54051)) (54053 54157 ( +while-clause 54053 . 54157)) (54159 54338 (with 54159 . 54338)) (54340 54785 (with-accumulators 54340 + . 54785)) (54787 55037 (with-binding-forms 54787 . 55037)) (55039 56270 (with-clause 55039 . 56270)) +(56272 56531 (with-iterator-forms 56272 . 56531)) (56533 57680 (with-list-accumulator 56533 . 57680)) +(57682 58119 (with-loop-context 57682 . 58119)) (58121 59359 (with-numeric-accumulator 58121 . 59359)) + (59361 59882 (with-temporaries 59361 . 59882)) (59884 60164 (zero 59884 . 60164)) (60166 60299 (loop +60166 . 60299))))) il:stop diff --git a/sources/XCL-LOOP.DFASL b/sources/XCL-LOOP.DFASL index 7a16e7c7..470e4f31 100644 Binary files a/sources/XCL-LOOP.DFASL and b/sources/XCL-LOOP.DFASL differ diff --git a/sources/test01. b/sources/test01. new file mode 100644 index 00000000..299ebbab --- /dev/null +++ b/sources/test01. @@ -0,0 +1,33 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED " 1-Nov-2025 13:41:38" {DSK}frank>il>medley>START-KINETIC.;2 1112 + + :EDIT-BY "FGH" + + :CHANGES-TO (FNS START-KINETIC) + + :PREVIOUS-DATE " 1-Nov-2025 13:21:22" {DSK}frank>il>medley>START-KINETIC.;1) + + +(PRETTYCOMPRINT START-KINETICCOMS) + +(RPAQQ START-KINETICCOMS ((FILES KINETIC) + (FNS START-KINETIC) + (P (START-KINETIC)))) + +(FILESLOAD KINETIC) +(DEFINEQ + +(START-KINETIC + [LAMBDA NIL (* ; "Edited 1-Nov-2025 13:41 by FGH") + (* ; "Edited 1-Nov-2025 13:15 by FGH") + (ADD.PROCESS '(KINETIC (CREATEW (CREATEREGION (FIX (TIMES 0.25 SCREENWIDTH)) + (FIX (TIMES 0.25 SCREENHEIGHT)) + (FIX (TIMES 0.5 SCREENWIDTH)) + (FIX (TIMES 0.5 SCREENHEIGHT]) +) + +(START-KINETIC) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (517 1068 (START-KINETIC 527 . 1066))))) +STOP diff --git a/sources/test02. b/sources/test02. new file mode 100644 index 00000000..299ebbab --- /dev/null +++ b/sources/test02. @@ -0,0 +1,33 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED " 1-Nov-2025 13:41:38" {DSK}frank>il>medley>START-KINETIC.;2 1112 + + :EDIT-BY "FGH" + + :CHANGES-TO (FNS START-KINETIC) + + :PREVIOUS-DATE " 1-Nov-2025 13:21:22" {DSK}frank>il>medley>START-KINETIC.;1) + + +(PRETTYCOMPRINT START-KINETICCOMS) + +(RPAQQ START-KINETICCOMS ((FILES KINETIC) + (FNS START-KINETIC) + (P (START-KINETIC)))) + +(FILESLOAD KINETIC) +(DEFINEQ + +(START-KINETIC + [LAMBDA NIL (* ; "Edited 1-Nov-2025 13:41 by FGH") + (* ; "Edited 1-Nov-2025 13:15 by FGH") + (ADD.PROCESS '(KINETIC (CREATEW (CREATEREGION (FIX (TIMES 0.25 SCREENWIDTH)) + (FIX (TIMES 0.25 SCREENHEIGHT)) + (FIX (TIMES 0.5 SCREENWIDTH)) + (FIX (TIMES 0.5 SCREENHEIGHT]) +) + +(START-KINETIC) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (517 1068 (START-KINETIC 527 . 1066))))) +STOP diff --git a/sources/test02.txt b/sources/test02.txt new file mode 100644 index 00000000..299ebbab --- /dev/null +++ b/sources/test02.txt @@ -0,0 +1,33 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED " 1-Nov-2025 13:41:38" {DSK}frank>il>medley>START-KINETIC.;2 1112 + + :EDIT-BY "FGH" + + :CHANGES-TO (FNS START-KINETIC) + + :PREVIOUS-DATE " 1-Nov-2025 13:21:22" {DSK}frank>il>medley>START-KINETIC.;1) + + +(PRETTYCOMPRINT START-KINETICCOMS) + +(RPAQQ START-KINETICCOMS ((FILES KINETIC) + (FNS START-KINETIC) + (P (START-KINETIC)))) + +(FILESLOAD KINETIC) +(DEFINEQ + +(START-KINETIC + [LAMBDA NIL (* ; "Edited 1-Nov-2025 13:41 by FGH") + (* ; "Edited 1-Nov-2025 13:15 by FGH") + (ADD.PROCESS '(KINETIC (CREATEW (CREATEREGION (FIX (TIMES 0.25 SCREENWIDTH)) + (FIX (TIMES 0.25 SCREENHEIGHT)) + (FIX (TIMES 0.5 SCREENWIDTH)) + (FIX (TIMES 0.5 SCREENHEIGHT]) +) + +(START-KINETIC) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (517 1068 (START-KINETIC 527 . 1066))))) +STOP diff --git a/sources/test03 b/sources/test03 new file mode 100644 index 00000000..299ebbab --- /dev/null +++ b/sources/test03 @@ -0,0 +1,33 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED " 1-Nov-2025 13:41:38" {DSK}frank>il>medley>START-KINETIC.;2 1112 + + :EDIT-BY "FGH" + + :CHANGES-TO (FNS START-KINETIC) + + :PREVIOUS-DATE " 1-Nov-2025 13:21:22" {DSK}frank>il>medley>START-KINETIC.;1) + + +(PRETTYCOMPRINT START-KINETICCOMS) + +(RPAQQ START-KINETICCOMS ((FILES KINETIC) + (FNS START-KINETIC) + (P (START-KINETIC)))) + +(FILESLOAD KINETIC) +(DEFINEQ + +(START-KINETIC + [LAMBDA NIL (* ; "Edited 1-Nov-2025 13:41 by FGH") + (* ; "Edited 1-Nov-2025 13:15 by FGH") + (ADD.PROCESS '(KINETIC (CREATEW (CREATEREGION (FIX (TIMES 0.25 SCREENWIDTH)) + (FIX (TIMES 0.25 SCREENHEIGHT)) + (FIX (TIMES 0.5 SCREENWIDTH)) + (FIX (TIMES 0.5 SCREENHEIGHT]) +) + +(START-KINETIC) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (517 1068 (START-KINETIC 527 . 1066))))) +STOP diff --git a/sources/test03. b/sources/test03. new file mode 100644 index 00000000..299ebbab --- /dev/null +++ b/sources/test03. @@ -0,0 +1,33 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED " 1-Nov-2025 13:41:38" {DSK}frank>il>medley>START-KINETIC.;2 1112 + + :EDIT-BY "FGH" + + :CHANGES-TO (FNS START-KINETIC) + + :PREVIOUS-DATE " 1-Nov-2025 13:21:22" {DSK}frank>il>medley>START-KINETIC.;1) + + +(PRETTYCOMPRINT START-KINETICCOMS) + +(RPAQQ START-KINETICCOMS ((FILES KINETIC) + (FNS START-KINETIC) + (P (START-KINETIC)))) + +(FILESLOAD KINETIC) +(DEFINEQ + +(START-KINETIC + [LAMBDA NIL (* ; "Edited 1-Nov-2025 13:41 by FGH") + (* ; "Edited 1-Nov-2025 13:15 by FGH") + (ADD.PROCESS '(KINETIC (CREATEW (CREATEREGION (FIX (TIMES 0.25 SCREENWIDTH)) + (FIX (TIMES 0.25 SCREENHEIGHT)) + (FIX (TIMES 0.5 SCREENWIDTH)) + (FIX (TIMES 0.5 SCREENHEIGHT]) +) + +(START-KINETIC) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (517 1068 (START-KINETIC 527 . 1066))))) +STOP