github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-27 04:41:54 +00:00
Code Issues Projects Releases Wiki Activity

TEDITKEY TKDORADO TEDITDORADOKEYS EDITKEYS are obsoleted by new Tedit keybinding architecture (#2088)

Browse Source
This commit is contained in:
rmkaplan
2025-04-05 12:32:33 -07:00
committed by GitHub
parent b0c00e0636
commit b072b6ef52
11 changed files with 0 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

141
lispusers/EDITKEYS
View File

@@ -1,141 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Dec-2023 21:06:15" {WMEDLEY}<lispusers>EDITKEYS.;6 7146
:EDIT-BY rmk
:CHANGES-TO (VARS EDITKEYSCOMS)
:PREVIOUS-DATE "25-Oct-2022 10:58:27" {WMEDLEY}<lispusers>EDITKEYS.;5)
(PRETTYCOMPRINT EDITKEYSCOMS)
(RPAQQ EDITKEYSCOMS
((VARS KEY.TEMPLATE)
(FNS BUILDFNKEYS KEY.BITMAP)
(P (* ; "could have (STRIKEOUT)")
(* ; "RMK: Removed (HELP HELP)")
(BUILDFNKEYS '((BOLD BOLD)
(ITALICS ITALICS)
(CASE CASE)
(STRIKEOUT (STRIKE- OUT))
(UNDERLINE (UNDER- LINE))
(SUPERSCRIPT (SUPER/ SUB))
(LARGER (LARGER SMALLER))
(DEFAULTS DEFAULTS)
(CENTER JUSTIFY)
(AGAIN REDO))
'(Tedit Keys)
1))))
(RPAQQ KEY.TEMPLATE #*(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
)
(DEFINEQ
(BUILDFNKEYS
[LAMBDA (KEYS TITLE NROWS)
(* ;; "Edited 20-Jul-2022 08:40 by rmk: BKSYSBUF only if the TTY is TEDIT, change title to Tedit Keys, expand with left button. Move with background menu")
(* ;; "Edited 20-Jul-2022 07:56 by rmk")
(* lmm " 5-Nov-85 15:35")
(LET
(ICONWINDOW)
[SETQ ICONWINDOW
(SHRINKW
(ADDMENU
[create
MENU
ITEMS _
[for KEY in KEYS
collect
(LIST (KEY.BITMAP (CADR KEY))
(LET [(KEYN (OR (SMALLP (CAR KEY))
(\KEYNAMETONUMBER (CAR KEY]
(for LST in (LIST \DOVEKEYACTIONS \DLIONKEYACTIONS \ORIGKEYACTIONS)
do (AND [SETQ $$VAL (for KEY in LST
when (EQ (OR (SMALLP (CAR KEY))
(\KEYNAMETONUMBER (CAR KEY)))
KEYN) do (RETURN (CADR KEY]
(RETURN (LIST (OR (SMALLP (CAR $$VAL))
(CHARCODE.DECODE (CAR $$VAL)))
(OR (SMALLP (CADR $$VAL))
(CHARCODE.DECODE (CADR $$VAL]
TITLE _ (SUBSTRING TITLE 2 -2)
MENUROWS _ NROWS
WHENSELECTEDFN _ (FUNCTION (LAMBDA (X)
(CL:WHEN (EQ '\TEDIT.PROCENTRYFN (FETCH (PROCESS PROCTTYENTRYFN
) OF (
TTY.PROCESS
)))
[BKSYSCHARCODE (if (SHIFTDOWNP 'SHIFT)
then (CADR (CADR X))
else (CAR (CADR X])]
NIL
(create POSITION
XCOORD _ (PLUS (DIFFERENCE (QUOTIENT SCREENWIDTH 2)
(QUOTIENT (TIMES (BITMAPWIDTH KEY.TEMPLATE)
(LENGTH KEYS))
2))
(TIMES 2 WBorder))
YCOORD _ 0))
(KEY.BITMAP TITLE)
'(0 . 0]
[WINDOWPROP ICONWINDOW 'BUTTONEVENTFN (FUNCTION (LAMBDA (ICONW)
(CL:WHEN (LASTMOUSESTATE (OR LEFT MIDDLE))
(CURSOR (PROG1 (CURSOR WAITINGCURSOR)
(EXPANDW ICONW))))]
ICONWINDOW])
(KEY.BITMAP
[LAMBDA (X) (* lmm " 5-Nov-85 14:04")
(PROG ((BITMAP (BITMAPCOPY KEY.TEMPLATE))
DS QUARTER REGION)
(SETQ DS (DSPCREATE BITMAP))
(DSPFONT MENUFONT DS)
(COND
((LISTP X)
(* this is supposed to have two labels, one on top of the other)
(SETQ QUARTER (IQUOTIENT (BITMAPHEIGHT BITMAP)
4))
(CENTERPRINTINREGION (CADR X)
(SETQ REGION (create REGION
LEFT _ 0
BOTTOM _ QUARTER
WIDTH _ (BITMAPWIDTH BITMAP)
HEIGHT _ QUARTER))
DS)
(replace BOTTOM of REGION with (ITIMES 2 QUARTER))
(CENTERPRINTINREGION (CAR X)
REGION DS))
(T (CENTERPRINTINREGION X (create REGION
LEFT _ 0
BOTTOM _ 0
WIDTH _ (BITMAPWIDTH BITMAP)
HEIGHT _ (BITMAPHEIGHT BITMAP))
DS)))
(RETURN BITMAP])
)
(* ; "could have (STRIKEOUT)")
(* ; "RMK: Removed (HELP HELP)")
(BUILDFNKEYS '((BOLD BOLD)
(ITALICS ITALICS)
(CASE CASE)
(STRIKEOUT (STRIKE- OUT))
(UNDERLINE (UNDER- LINE))
(SUPERSCRIPT (SUPER/ SUB))
(LARGER (LARGER SMALLER))
(DEFAULTS DEFAULTS)
(CENTER JUSTIFY)
(AGAIN REDO))
'(Tedit Keys)
1)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2120 6542 (BUILDFNKEYS 2130 . 5158) (KEY.BITMAP 5160 . 6540)))))
STOP

BIN
lispusers/EDITKEYS.LCOM
View File

Binary file not shown.

BIN
lispusers/EDITKEYS.TEDIT
View File

Binary file not shown.

124
lispusers/TEDITDORADOKEYS
View File

@@ -1,124 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "26-Feb-2024 11:19:15" |{WMEDLEY}<lispusers>TEDITDORADOKEYS.;8| 5385
:EDIT-BY |rmk|
:CHANGES-TO (VARS TEDITDORADOKEYSCOMS)
:PREVIOUS-DATE "15-Sep-2022 10:10:07" |{WMEDLEY}<lispusers>TEDITDORADOKEYS.;4|)
(PRETTYCOMPRINT TEDITDORADOKEYSCOMS)
(RPAQQ TEDITDORADOKEYSCOMS
((DECLARE\: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL))
(COMS
(* |;;| "Specialized functions for this module")
(FNS \\TEDIT.DK.ABORT \\TEDIT.DK.INSERT-PARENS \\TEDIT.DK.INSERT-NEUTRAL-DOUBLEQUOTES
\\TEDIT.DK.INSERT-REAL-DOUBLEQUOTES))
(VARS (\\TEDIT.DORADO.KEYS '(("Meta,x" EXPAND)
("Meta,X" EXPAND)
("Meta,c" FN \\TEDIT.CENTER.SEL)
("Meta,C" FN \\TEDIT.CENTER.SEL.REV)
("Meta,b" FN \\TEDIT.BOLD.SEL.ON)
("Meta,B" FN \\TEDIT.BOLD.SEL.OFF)
("Meta,i" FN \\TEDIT.ITALIC.SEL.ON)
("Meta,I" FN \\TEDIT.ITALIC.SEL.OFF)
("Meta,=" FN \\TEDIT.STRIKEOUT.SEL.ON)
("Meta,+" FN \\TEDIT.STRIKEOUT.SEL.OFF)
("Meta,-" FN \\TEDIT.UNDERLINE.SEL.ON)
("Meta,_" FN \\TEDIT.UNDERLINE.SEL.OFF)
("Meta,^" FN \\TEDIT.SUBSCRIPTSEL)
("Meta,|" FN \\TEDIT.SUPERSCRIPTSEL)
("Meta,SPACE" FN \\TEDIT.DEFAULTSSEL)
("Meta,?" FN \\TEDIT.SHOWCARETLOOKS)
("Meta,(" FN \\TEDIT.DK.INSERT-PARENS)
("Meta,\"" FN \\TEDIT.DK.INSERT-NEUTRAL-DOUBLEQUOTES)
("Meta,'" FN \\TEDIT.DK.INSERT-REAL-DOUBLEQUOTES))))
(P (FOR ENTRY IN \\TEDIT.DORADO.KEYS DO (SELECTQ (CADR ENTRY)
(FN (TEDIT.SETFUNCTION (CAR ENTRY)
(CADDR ENTRY)))
(TEDIT.SETSYNTAX (CAR ENTRY)
(CADR ENTRY)))))))
(DECLARE\: EVAL@COMPILE DONTCOPY
(FILESLOAD TEDIT-EXPORTS.ALL)
)
(* |;;| "Specialized functions for this module")
(DEFINEQ
(\\TEDIT.DK.ABORT
(LAMBDA (TEXTOBJ)
(TEDIT.GET TEXTOBJ)))
(\\TEDIT.DK.INSERT-PARENS
(LAMBDA (TEXTOBJ TEXTSTREAM SEL) (* \; "Edited 28-Oct-87 19:42 by jds")
(LET ((CH1 (|fetch| CH# |of| SEL))
(CHLIM (|fetch| CHLIM |of| SEL)))
(TEDIT.INSERT TEXTSTREAM ")" CHLIM)
(TEDIT.INSERT TEXTSTREAM "(" CH1)
(TEDIT.SETSEL TEXTSTREAM CH1 (+ 2 (- CHLIM CH1))))))
(\\TEDIT.DK.INSERT-NEUTRAL-DOUBLEQUOTES
(LAMBDA (TEXTOBJ TEXTSTREAM SEL) (* \; "Edited 28-Oct-87 19:45 by jds")
(* |;;| "Insert ASCII double-quotes (\") around the selection")
(LET ((CH1 (|fetch| CH# |of| SEL))
(CHLIM (|fetch| CHLIM |of| SEL)))
(TEDIT.INSERT TEXTSTREAM "\"" CHLIM)
(TEDIT.INSERT TEXTSTREAM "\"" CH1)
(TEDIT.SETSEL TEXTSTREAM CH1 (+ 2 (- CHLIM CH1))))))
(\\TEDIT.DK.INSERT-REAL-DOUBLEQUOTES
(LAMBDA (TEXTOBJ TEXTSTREAM SEL) (* \; "Edited 28-Oct-87 19:44 by jds")
(* |;;| "Insert NS double quotes around the selection.")
(LET ((CH1 (|fetch| CH# |of| SEL))
(CHLIM (|fetch| CHLIM |of| SEL)))
(TEDIT.INSERT TEXTSTREAM (CHARCODE 0\,252)
CHLIM)
(TEDIT.INSERT TEXTSTREAM (CHARCODE 0\,272)
CH1)
(TEDIT.SETSEL TEXTSTREAM CH1 (+ 2 (- CHLIM CH1))))))
)
(RPAQQ \\TEDIT.DORADO.KEYS
(("Meta,x" EXPAND)
("Meta,X" EXPAND)
("Meta,c" FN \\TEDIT.CENTER.SEL)
("Meta,C" FN \\TEDIT.CENTER.SEL.REV)
("Meta,b" FN \\TEDIT.BOLD.SEL.ON)
("Meta,B" FN \\TEDIT.BOLD.SEL.OFF)
("Meta,i" FN \\TEDIT.ITALIC.SEL.ON)
("Meta,I" FN \\TEDIT.ITALIC.SEL.OFF)
("Meta,=" FN \\TEDIT.STRIKEOUT.SEL.ON)
("Meta,+" FN \\TEDIT.STRIKEOUT.SEL.OFF)
("Meta,-" FN \\TEDIT.UNDERLINE.SEL.ON)
("Meta,_" FN \\TEDIT.UNDERLINE.SEL.OFF)
("Meta,^" FN \\TEDIT.SUBSCRIPTSEL)
("Meta,|" FN \\TEDIT.SUPERSCRIPTSEL)
("Meta,SPACE" FN \\TEDIT.DEFAULTSSEL)
("Meta,?" FN \\TEDIT.SHOWCARETLOOKS)
("Meta,(" FN \\TEDIT.DK.INSERT-PARENS)
("Meta,\"" FN \\TEDIT.DK.INSERT-NEUTRAL-DOUBLEQUOTES)
("Meta,'" FN \\TEDIT.DK.INSERT-REAL-DOUBLEQUOTES)))
(FOR ENTRY IN \\TEDIT.DORADO.KEYS DO (SELECTQ (CADR ENTRY)
(FN (TEDIT.SETFUNCTION (CAR ENTRY)
(CADDR ENTRY)))
(TEDIT.SETSYNTAX (CAR ENTRY)
(CADR ENTRY))))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (2626 4130 (\\TEDIT.DK.ABORT 2636 . 2703) (\\TEDIT.DK.INSERT-PARENS 2705 . 3092) (
\\TEDIT.DK.INSERT-NEUTRAL-DOUBLEQUOTES 3094 . 3586) (\\TEDIT.DK.INSERT-REAL-DOUBLEQUOTES 3588 . 4128))
)))
STOP

BIN
lispusers/TEDITDORADOKEYS.LCOM
View File

Binary file not shown.

1862
lispusers/TEDITKEY
View File

File diff suppressed because it is too large Load Diff

BIN
lispusers/TEDITKEY.LCOM
View File

Binary file not shown.

149
lispusers/TEDITKEY.TEDIT
View File

File diff suppressed because one or more lines are too long

BIN
lispusers/teditdoradokeys.tedit
View File

Binary file not shown.

243
lispusers/tkdorado
View File

@@ -1,243 +0,0 @@
(DEFINE-FILE-INFO §PACKAGE "INTERLISP" §READTABLE "INTERLISP" §BASE 10)
(FILECREATED "16-Apr-87 17:28:48" {ERIS}<LISPUSERS>LYRIC>TKDORADO.;5 14764
changes to%: (VARS TKDORADOCOMS)
(FNS \TKD.SETLOOKS)
previous date%: "14-Apr-87 17:10:44" {ERIS}<LISPUSERS>LYRIC>TKDORADO.;4)
(* "
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT TKDORADOCOMS)
(RPAQQ TKDORADOCOMS [(FILES TEDITKEY)
(FNS \TKD.SETLOOKS)
(P [SETQ TEDITKEY.KEYBINDINGS
(UNION (APPEND TEDITKEY.KEYBINDINGS '(NIL))
'(([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(if (ZEROP (fetch DCH of SEL))
then
(\TK.DEFAULTS.CARET TEXTSTREAM TEXTOBJ SEL)
else
(\TK.DEFAULTSSEL TEXTSTREAM TEXTOBJ SEL]
(%##^V)
"default looks")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL
'(OVERLINE ON]
(%##^D)
"overbar on")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL
'(OVERLINE OFF]
(%##^F)
"overbar off")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL
'(STRIKEOUT ON]
(%##^G)
"strikethru on")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL
'(STRIKEOUT OFF]
(%##^H)
"strikethru off")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL
'(UNDERLINE ON]
(%##^J)
"underlining on")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL
'(UNDERLINE OFF]
(%##^K)
"underlining off")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL
'(WEIGHT BOLD]
(%##^B)
"bold on")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL
'(WEIGHT MEDIUM]
(%##^N)
"bold off")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL
'(SLOPE ITALIC]
(%##^I)
"italics on")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL
'(SLOPE REGULAR]
(%##^O)
"italics off")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(IF (ZEROP (FETCH DCH OF SEL))
then
(\TK.SMALLER.CARET TEXTSTREAM TEXTOBJ SEL)
else
(\TK.SMALLERSEL TEXTSTREAM TEXTOBJ SEL]
(|##^[|)
"smaller font")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(IF (ZEROP (FETCH DCH OF SEL))
then
(\TK.LARGER.CARET TEXTSTREAM TEXTOBJ SEL)
else
(\TK.LARGERSEL TEXTSTREAM TEXTOBJ SEL]
(|##^]|)
"larger font")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(IF (ZEROP (FETCH DCH OF SEL))
then
(\TK.SUPERSCRIPT.CARET TEXTSTREAM TEXTOBJ SEL)
else
(\TK.SUPERSCRIPTSEL TEXTSTREAM TEXTOBJ SEL]
(%##^^)
"superscript")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(IF (ZEROP (FETCH DCH OF SEL))
then
(\TK.SUBSCRIPT.CARET TEXTSTREAM TEXTOBJ SEL)
else
(\TK.SUBSCRIPTSEL TEXTSTREAM TEXTOBJ SEL]
(%##^_)
"subscript")
(\TK.CENTER.SEL (%##^C)
"center, justify, ... "]
(\TK.BUILD.MENU)
(TEDITKEY.INSTALL)
(AND (BOUNDP 'DLIONFNKEYS)
(OPENWP DLIONFNKEYS)
(CLOSEW DLIONFNKEYS))
(TEDIT.SETSYNTAX (CHARCODE ESC)
'REDO])
(FILESLOAD TEDITKEY)
(DEFINEQ
(\TKD.SETLOOKS
[LAMBDA (TEXTSTREAM TEXTOBJ SEL LOOKS) (* ; "Edited 16-Apr-87 17:26 by mdd")
(if (ZEROP (fetch DCH of SEL))
then [LET [(charlooks (create CHARLOOKS using (fetch CARETLOOKS of TEXTOBJ]
[REPLACEFIELD (LISTGET [CONSTANT (LIST 'UNDERLINE (CADADR (RECORDACCESSFORM
'CLULINE))
'OVERLINE
(CADADR (RECORDACCESSFORM 'CLOLINE))
'STRIKEOUT
(CADADR (RECORDACCESSFORM 'CLSTRIKE))
'SLOPE
(CADADR (RECORDACCESSFORM 'CLITAL))
'WEIGHT
(CADADR (RECORDACCESSFORM 'CLBOLD]
(CAR LOOKS))
charlooks
(FMEMB (CADR LOOKS)
'(ITALIC BOLD ON]
(if (OR (AND (NEQ (CAR LOOKS)
'SLOPE)
(NEQ (CAR LOOKS)
'WEIGHT))
(\TK.SETFONTINLOOKS TEXTSTREAM charlooks))
then (TEDIT.CARETLOOKS TEXTSTREAM charlooks)
(if TEDITKEY.VERBOSE
then (\TK.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]
else (TEDIT.LOOKS TEXTSTREAM LOOKS SEL])
)
[SETQ TEDITKEY.KEYBINDINGS (UNION (APPEND TEDITKEY.KEYBINDINGS '(NIL))
'(([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(if (ZEROP (fetch DCH of SEL))
then
(\TK.DEFAULTS.CARET TEXTSTREAM TEXTOBJ SEL)
else
(\TK.DEFAULTSSEL TEXTSTREAM TEXTOBJ SEL]
(%##^V)
"default looks")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL '(OVERLINE ON]
(%##^D)
"overbar on")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL '(OVERLINE OFF]
(%##^F)
"overbar off")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL '(STRIKEOUT ON]
(%##^G)
"strikethru on")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL '(STRIKEOUT OFF]
(%##^H)
"strikethru off")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL '(UNDERLINE ON]
(%##^J)
"underlining on")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL '(UNDERLINE OFF]
(%##^K)
"underlining off")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL '(WEIGHT BOLD]
(%##^B)
"bold on")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL '(WEIGHT MEDIUM]
(%##^N)
"bold off")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL '(SLOPE ITALIC]
(%##^I)
"italics on")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(\TKD.SETLOOKS TEXTSTREAM TEXTOBJ SEL '(SLOPE REGULAR]
(%##^O)
"italics off")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(IF (ZEROP (FETCH DCH OF SEL))
then
(\TK.SMALLER.CARET TEXTSTREAM TEXTOBJ SEL)
else
(\TK.SMALLERSEL TEXTSTREAM TEXTOBJ SEL]
(|##^[|)
"smaller font")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(IF (ZEROP (FETCH DCH OF SEL))
then
(\TK.LARGER.CARET TEXTSTREAM TEXTOBJ SEL)
else
(\TK.LARGERSEL TEXTSTREAM TEXTOBJ SEL]
(|##^]|)
"larger font")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(IF (ZEROP (FETCH DCH OF SEL))
then
(\TK.SUPERSCRIPT.CARET TEXTSTREAM TEXTOBJ SEL)
else
(\TK.SUPERSCRIPTSEL TEXTSTREAM TEXTOBJ SEL]
(%##^^)
"superscript")
([LAMBDA (TEXTSTREAM TEXTOBJ SEL)
(IF (ZEROP (FETCH DCH OF SEL))
then
(\TK.SUBSCRIPT.CARET TEXTSTREAM TEXTOBJ SEL)
else
(\TK.SUBSCRIPTSEL TEXTSTREAM TEXTOBJ SEL]
(%##^_)
"subscript")
(\TK.CENTER.SEL (%##^C)
"center, justify, ... "]
(\TK.BUILD.MENU)
(TEDITKEY.INSTALL)
(AND (BOUNDP 'DLIONFNKEYS)
(OPENWP DLIONFNKEYS)
(CLOSEW DLIONFNKEYS))
(TEDIT.SETSYNTAX (CHARCODE ESC)
'REDO)
(PUTPROPS TKDORADO COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (7206 9013 (\TKD.SETLOOKS 7216 . 9011)))))
STOP

BIN
lispusers/tkdorado.tedit
View File

Binary file not shown.