1
0
mirror of synced 2026-01-28 21:11:37 +00:00

Rmk150 update to tedit.abbrevs (#2439)

* Improved matching for TEDIT-ABBREVS

* Make CHARACTERNAMES available at runtime (SOFT-HYPHEN etc)

* TEDIT-ABBREV: Better parsing strategy

* Added backslash markup

* Document new abbreviation conventions

* Glitch

* Responded to @MattHeffron

* Include backslash in promptwindow message

* Updated edit date
This commit is contained in:
rmkaplan
2026-01-14 08:44:03 -08:00
committed by GitHub
parent 8292d3287b
commit 65c482bc06
5 changed files with 319 additions and 292 deletions

View File

@@ -1,223 +1,276 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 5-Sep-2025 18:50:19" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;29 17935
(FILECREATED "13-Jan-2026 17:51:55" {WMEDLEY}<library>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}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;28)
:PREVIOUS-DATE " 8-Jan-2026 09:09:58" {WMEDLEY}<library>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

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Oct-2025 00:07:29" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;910 186445
(FILECREATED "31-Dec-2025 23:10:18" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;915 186658
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.FORMATLINE.HORIZONTAL)
:CHANGES-TO (VARS TEDIT-SCREENCOMS)
:PREVIOUS-DATE " 7-Aug-2025 12:51:00" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;909)
:PREVIOUS-DATE " 7-Dec-2025 16:28:01" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;914)
(PRETTYCOMPRINT TEDIT-SCREENCOMS)
@@ -22,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")
@@ -36,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")
@@ -298,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)
@@ -460,6 +456,10 @@
(* "END EXPORTED DEFINITIONS")
)
(ADDTOVAR CHARACTERNAMES (SOFT-HYPHEN "357,043")
(NONBREAKING-HYPHEN "357,042")
(NONBREAKING-SPACE "357,041"))
(DEFINEQ
(\TEDIT.LINEDESCRIPTOR.DEFPRINT
@@ -654,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")
@@ -704,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)
@@ -718,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))
(* ;;
@@ -899,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)
@@ -1229,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")
@@ -1264,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))
@@ -2295,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")
@@ -2325,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)))
@@ -2335,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")
@@ -2863,21 +2863,21 @@
(\TEDIT.LINE.TALLP LINE PHEIGHT))))])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (26225 28441 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 26235 . 28439)) (35895 119880 (
\TEDIT.FORMATLINE 35905 . 71392) (\TEDIT.FORMATLINE.SETUP.PARA 71394 . 76560) (
\TEDIT.FORMATLINE.HORIZONTAL 76562 . 81379) (\TEDIT.FORMATLINE.VERTICAL 81381 . 83832) (
\TEDIT.FORMATLINE.JUSTIFY 83834 . 89855) (\TEDIT.FORMATLINE.TABS 89857 . 97885) (\TEDIT.SCALE.TABS
97887 . 98678) (\TEDIT.FORMATLINE.PURGE.SPACES 98680 . 100107) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
100109 . 101186) (\TEDIT.FORMATLINE.EMPTY 101188 . 106008) (\TEDIT.FORMATLINE.UPDATELOOKS 106010 .
112191) (\TEDIT.FORMATLINE.LASTLEGAL 112193 . 115643) (\TEDIT.LINES.ABOVE 115645 . 119256) (
\TEDIT.CHNO.TO.YTOP 119258 . 119878)) (120157 140737 (\TEDIT.DISPLAYLINE 120167 . 132677) (
\TEDIT.DISPLAYLINE.TABS 132679 . 135483) (\TEDIT.LINECACHE 135485 . 136213) (\TEDIT.CREATE.LINECACHE
136215 . 137051) (\TEDIT.BLTCHAR 137053 . 139680) (\TEDIT.DIACRITIC.SHIFT 139682 . 140735)) (141352
186422 (\TEDIT.BACKFORMAT 141362 . 143916) (\TEDIT.PREVIOUS.LINEBREAK 143918 . 146721) (
\TEDIT.UPDATE.LINES 146723 . 152438) (\TEDIT.PANE.CREATELINES 152440 . 154730) (
\TEDIT.SUFFIXLINE.CREATE 154732 . 156347) (\TEDIT.LINES.BELOW 156349 . 160959) (\TEDIT.MEASURED.LINES
160961 . 162970) (\TEDIT.VALID.LASTCHNOS 162972 . 166748) (\TEDIT.VALID.NEXTCHNOS 166750 . 170224) (
\TEDIT.LASTVALIDLINE 170226 . 174897) (\TEDIT.NEXTVALIDLINE 174899 . 177869) (
\TEDIT.CLEARPANE.BELOW.LINE 177871 . 179977) (\TEDIT.INSERTLINE 179979 . 181365) (\TEDIT.LINE.BOTTOM
181367 . 184597) (\TEDIT.SHOW.AT.BOTTOMP 184599 . 185709) (\TEDIT.SHOW.AT.TOPP 185711 . 186420)))))
(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

Binary file not shown.