(FILECREATED " 1-Apr-86 22:36:26" {ERIS}<LISPUSERS>KOTO>TEDITKEY.;3 99856
changes to: (FNS TEDITKEY.INSTALL)
previous date: "24-Feb-86 17:22:24" {ERIS}<LISPUSERS>KOTO>TEDITKEY.;2)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TEDITKEYCOMS)
(RPAQQ TEDITKEYCOMS
[[COMS (* * This is the KOTO version of TEditKey)
(P (if (LESSP (IDATE MAKESYSDATE)
(IDATE " 7-Oct-85 21:15:34"))
THEN
(* blow up, the user is loading this teditkey into an incompatible LISP)
(ERROR "This is KOTO TEditKey. Your Lisp is too old for this version. Load an earlier version of TEditKey"
]
(COMS (* functions for affecting the selection)
(FNS NTHCAR \TEXTOBJ.WINDEX \TK.PREVSCREEN \TK.UNDERLINE.SEL.ON \TK.UNDERLINE.SEL.OFF
\TK.BOLD.SEL.ON \TK.BOLD.SEL.OFF \TK.ITALIC.SEL.ON \TK.ITALIC.SEL.OFF
\TK.SMALLERSEL \TK.LARGERSEL \TK.SUPERSCRIPTSEL \TK.SUBSCRIPTSEL \TK.DEFAULTSSEL
\TK.DEL.WORD.FORWARD \TK.UCASE.SEL \TK.CAPITALISE.SEL \CAPITALISE \TK.LCASE.SEL)
(* functions for affecting the paralooks of the selection)
(FNS \TK.CENTER.SEL \TK.CENTER.SEL.REV \TK.NEST \TK.UNNEST))
(COMS (* functions for affecting (and displaying)
the caret character looks)
(FNS \TK.SHOWCARETLOOKS \TK.BOLD.CARET.ON \TK.BOLD.CARET.OFF \TK.ITALIC.CARET.ON
\TK.ITALIC.CARET.OFF \TK.UNDERLINE.CARET.ON \TK.UNDERLINE.CARET.OFF
\TK.SUPERSCRIPT.CARET \TK.SUBSCRIPT.CARET \TK.SMALLER.CARET \TK.LARGER.CARET
\TK.DEFAULTS.CARET \TK.FONT1 \TK.FONT2 \TK.FONT3 \TK.SETCARETFONT \TK.FONT4
\TK.FONT5 \TK.FONT6 \TK.FONT7 \TK.FONT8)
(* the functions which aren't currently used, which toggle the caret looks)
(FNS \TK.BOLDTOGGLE \TK.ITALICTOGGLE \TK.UNDERLINETOGGLE))
(COMS (* functions dealing with the default looks)
(FNS \TK.SETDEFAULTLOOKS))
(COMS (* functions for positioning within a document)
(FNS GOTONEXTTTYWINDOW \TK.NEXTLINE \TK.PREVLINE \TK.GOTODOCBEGIN \TK.GOTODOCEND
\TK.GOTOLINEBEGIN \TK.GOTOLINEEND \TK.PREVCHAR \TK.NEXTCHAR \TK.FORWARD.WORD
\TK.BACK.WORD \TK.SELECT.ALL))
(COMS (* other utilities)
(FNS \TK.FIND \TK.REDISPLAY \TK.DELLINEFORWARD \TK.OPENLINE \TK.DELCHARFORWARD
\TK.TRANSPOSECHARS))
(COMS (* little selection utilities etc., for building hacks)
(FNS \SEL.LIMIT \TK.SETFILEPTR.TO.CARET \SEL.LINEDESC \TK.DESCRIBEFONT \PARAS.IN.SEL)
(MACROS \SEL.LIMIT.FORWARD \TK.ONOROFF \LINEDESC.LAST.REAL.CHAR))
(COMS (* fns for the key interface itself)
(FNS \SHIFTACTION \ACTION TEDITKEY.INSTALL TEDITKEY.DEINSTALL \TK.ACTIONTOCHARCODE
\TK.BUILD.MENU \TK.HELP \TK.SETFONTINLOOKS WRITE.CHARDESC.AUX CHARDESC
TEDITKEY.CONFIGURE \TK.ADDKEY \TK.CHANGEKEY \TK.APPLYPENDING \TK.NTHFONT)
(* redefinition of system junk)
(FNS METASHIFT))
(* (\TK.BOLDTOGGLE (##H ##h)
"toggle Bold caret looks")
(\TK.ITALICTOGGLE (##i ##I)
"toggle Italic caret looks")
(\TK.SUPERSCRIPT.CARET (##↑)
"Superscript the caret looks")
(\TK.SUBSCRIPT.CARET (##←)
"Subscript the caret looks"))
(FNS TEDIT.FULL.FIND)
[VARS \TK.WHITESPACE (TEDIT.INTERRUPTS (BQUOTE ((, (CHARCODE ↑G)
ERROR)
(, (CHARCODE ↑C)
HELP]
(CONSTANTS (\TK.WHITESPACE 22))
(INITVARS (TEDITKEY.VERBOSE T)
(TEDITKEY.METAKEY (QUOTE TAB))
(TEDITKEY.LOCKTOGGLEKEY NIL)
(TEDITKEY.NESTWIDTH 36)
(\TK.SIZEINCREMENT 2)
(TEDITKEY.OFFSETINCREMENT 3)
(TEDITKEY.FONTS (QUOTE (TIMESROMAN HELVETICA GACHA MODERN CLASSIC TERMINAL SYMBOL
HIPPO)))
(TEDITKEY.FNKEYFLG T))
(MACROS METACODE CONTROLCODE LCMETACODE)
(INITVARS (\TK.SELKEY (QUOTE OPEN))
(\TK.PENDING))
[INITVARS [TEDITKEY.KEYBINDINGS (BQUOTE ((\TK.FONT1 (##1)
,
(CONCAT "change to font " (\TK.NTHFONT 1)))
(\TK.FONT2 (##2)
,
(CONCAT "change to font " (\TK.NTHFONT 2)))
(\TK.FONT3 (##3)
,
(CONCAT "change to font " (\TK.NTHFONT 3)))
(\TK.FONT4 (##4)
,
(CONCAT "change to font " (\TK.NTHFONT 4)))
(\TK.FONT5 (##5)
,
(CONCAT "change to font " (\TK.NTHFONT 5)))
(\TK.FONT6 (##6)
,
(CONCAT "change to font " (\TK.NTHFONT 6)))
(\TK.FONT7 (##7)
,
(CONCAT "change to font " (\TK.NTHFONT 7)))
(\TK.FONT8 (##8)
,
(CONCAT "change to font " (\TK.NTHFONT 8)))
NIL
(\TK.DEFAULTS.CARET (##/)
"restore the default caret looks")
(\TK.SMALLER.CARET (##9)
"decrease the caret font size")
(\TK.LARGER.CARET (##0)
"increase the caret font size")
(\TK.SHOWCARETLOOKS (##=)
"display the current caret looks")
NIL
(\TK.REDISPLAY (##R ##r)
"Restore the display")
(\TK.HELP (##?)
"displays the current key bindings")
NIL
(\TK.PREVCHAR (↑B ↑b)
"Back one character")
(\TK.NEXTCHAR (↑F ↑f)
"Forward one character")
(\TK.FORWARD.WORD (##F ##f)
"Forward one word")
(\TK.BACK.WORD (##B ##b)
"Back one word")
(\TK.GOTOLINEBEGIN (↑A ↑a)
"go to stArt of line")
(\TK.GOTOLINEEND (↑E ↑e)
"go to End of line")
(\TK.PREVLINE (↑P ↑p)
"go to Previous line")
(\TK.NEXTLINE (↑N ↑n)
"go to Next line")
(\TK.GOTODOCBEGIN (##<)
"start of document")
(\TK.GOTODOCEND (##>)
"end of document")
(\TK.SELECT.ALL (##S ##s)
"Select whole document")
NIL
(\TK.DELLINEFORWARD (↑K ↑k)
"Kill line")
(\TK.OPENLINE (↑O ↑o)
"Open up blank line")
(\TK.DELCHARFORWARD (↑D ↑d)
"Delete character forward")
(\TK.DEL.WORD.FORWARD (##D ##d)
"Delete word forward")
(\TK.TRANSPOSECHARS (↑T ↑t)
"Transpose characters")
NIL NIL (\TK.NEST (##%[)
"indents margins (nest)")
(\TK.UNNEST (##%])
"exdents margins (unnest)")
(\TK.CENTER.SEL (##J ##j)
"alter Justification")
(\TK.UCASE.SEL (##U ##u)
"Uppercasify selection")
(\TK.CAPITALISE.SEL (##C ##c)
"Capitalize selection")
(\TK.LCASE.SEL (##L ##l)
"Lowercasify selection")
(GET.OBJ.FROM.USER (##O ##o)
"insert Object"]
[TEDITKEY.DLION.KEYACTIONS (BQUOTE ((STOP (, (CHARCODE ↑G)
,
(CHARCODE ↑C)
NOLOCKSHIFT))
(OPEN (, (CHARCODE 2,1)
,
(CHARCODE 2,41)
NOLOCKSHIFT))
(FONT FONTDOWN . FONTUP)
(KEYBOARD USERMODE1DOWN . USERMODE1UP]
[COMS (* (TEDITKEY.FNKEYACTIONS (BQUOTE ((CENTER (, (CHARCODE ##↑B)
,
(CHARCODE ##↑C)))
(BOLD (, (CHARCODE ##↑D)
,
(CHARCODE ##↑E)
NOLOCKSHIFT))
(ITALICS (, (CHARCODE ##↑F)
,
(CHARCODE ##↑G)
NOLOCKSHIFT))
(UNDERLINE (, (CHARCODE ##↑H)
,
(CHARCODE ##↑I)
NOLOCKSHIFT))
(SUPERSCRIPT (, (CHARCODE ##↑J)
,
(CHARCODE ##↑K)
NOLOCKSHIFT))
(SUBSCRIPT (, (CHARCODE ##↑L)
,
(CHARCODE ##↑N)
NOLOCKSHIFT))
(LARGER (, (CHARCODE ##↑O)
,
(CHARCODE ##↑P)
NOLOCKSHIFT))
(DEFAULTS (, (CHARCODE ##↑Q)
,
(CHARCODE ##↑R)
NOLOCKSHIFT))
(BS (, (CHARCODE ↑H)
,
(CHARCODE ↑D)
NOLOCKSHIFT]
[TEDITKEY.DLION.KEYBINDINGS (QUOTE (((\ACTION (QUOTE OPEN))
\TK.OPENLINE)
((\ACTION (QUOTE HELP))
\TK.HELP)
((\ACTION (QUOTE MARGINS))
\TK.NEST)
((\SHIFTACTION (QUOTE MARGINS))
\TK.UNNEST)
((\SHIFTACTION (QUOTE NEXT))
GOTONEXTTTYWINDOW]
[TEDITKEY.FNKEYBINDINGS (QUOTE (((\ACTION (QUOTE DEFAULTS))
\TK.DEFAULTSSEL)
((\SHIFTACTION (QUOTE DEFAULTS))
\TK.SETDEFAULTLOOKS]
[COMS (* NOT NEEDED (TEDITKEY.DLION.KEYSYNTAX (QUOTE (((\ACTION (QUOTE NEXT))
NEXT)
((\ACTION (QUOTE UNDO))
UNDO)
((\ACTION (QUOTE BS))
CHARDELETE]
[TEDITKEY.DORADO.KEYACTIONS (BQUOTE ((BS (, (CHARCODE ↑H)
,
(CHARCODE ↑H)))
(BLANK-BOTTOM (, (CHARCODE ##↑A)
,
(CHARCODE ##↑A)))
(BLANK-TOP FONTDOWN . FONTUP)
(BLANK-MIDDLE USERMODE1DOWN . USERMODE1UP)
(CENTER (2,101 2,141 NOLOCKSHIFT))
(BOLD (2,102 2,142 NOLOCKSHIFT))
(ITALICS (2,103 2,143 NOLOCKSHIFT))
(UNDERLINE (2,106 2,146 NOLOCKSHIFT))
(SUPERSCRIPT (2,113 2,153 NOLOCKSHIFT))
(SUBSCRIPT (2,114 2,154 NOLOCKSHIFT))
(LARGER (2,110 2,150 NOLOCKSHIFT))
(DEFAULTS (2,115 2,155 NOLOCKSHIFT]
(TEDITKEY.DORADO.KEYSYNTAX (QUOTE (((CHARCODE ##N)
NEXT)
((CHARCODE ##n)
NEXT)
((\ACTION (QUOTE BLANK-BOTTOM))
UNDO)
((\ACTION (QUOTE BS))
CHARDELETE]
(P (TEDITKEY.INSTALL))
(P (\TK.BUILD.MENU))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA METASHIFT])
(* * This is the KOTO version of TEditKey)
(if (LESSP (IDATE MAKESYSDATE)
(IDATE " 7-Oct-85 21:15:34"))
THEN
(* blow up, the user is loading this teditkey into an incompatible LISP)
(ERROR "This is KOTO TEditKey. Your Lisp is too old for this version. Load an earlier version of TEditKey"
))
(* functions for affecting the selection)
(DEFINEQ
(NTHCAR
[LAMBDA (LIST N) (* gbn "10-Oct-85 20:54")
(CAR (NTH LIST N])
(\TEXTOBJ.WINDEX
[LAMBDA (TEXTOBJ) (* gbn "10-Oct-85 20:51")
(* * returns the number which is the position in the list textobj:\window indicating which window had the last
selection in it. This number is then an index into line descriptor lists etc.)
(bind (CURW ←(fetch SELWINDOW of TEXTOBJ)) for J from 1 as W
in (fetch \WINDOW of TEXTOBJ) until (EQ W CURW) do NIL finally (RETURN J])
(\TK.PREVSCREEN
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "10-Oct-85 00:10")
(* moves the selection up one line)
(PROG (THIS PREV) (* get the selection on the screen so that it has a
line descriptor)
(TEDIT.NORMALIZECARET STREAM SEL)
(if [SETQ THIS (CAR (MKLIST (fetch L1 of SEL]
then (* empty docs have no line descriptors)
(SETQ PREV (fetch PREVLINE of THIS))
[if (ZEROP (fetch CHARLIM of PREV))
then (* we need to back format because this is a fake line
descriptor)
(\BACKFORMAT (CAR (fetch LINES of TEXTOBJ))
TEXTOBJ
(fetch SELWINDOW of TEXTOBJ))
(SETQ PREV (fetch PREVLINE of THIS))
(* (SETQ PREV (replace PREVLINE of THIS with
(\FORMATLINE TEXTOBJ NIL (ADD1
(fetch CHARLIM of THIS))))))]
(TEDIT.NORMALIZECARET STREAM
(TEDIT.SETSEL STREAM
(IMIN (IPLUS (fetch CHAR1
of PREV)
(IDIFFERENCE
(\SEL.LIMIT
SEL)
(fetch CHAR1
of THIS)))
(fetch CHARLIM of PREV))
0])
(\TK.UNDERLINE.SEL.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "19-Mar-85 12:01")
(COND
((SHIFTDOWNP (QUOTE FONT))
(\TK.FONT4 TEXTSTREAM TEXTOBJ SEL))
((SHIFTDOWNP (QUOTE USERMODE1))
(\TK.UNDERLINE.CARET.ON TEXTSTREAM TEXTOBJ SEL))
(T (* do the real function of \tk.underlineon which
happens when neither Keyboard nor font is held)
(TEDIT.LOOKS TEXTSTREAM (QUOTE (UNDERLINE ON))
SEL])
(\TK.UNDERLINE.SEL.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "19-Mar-85 12:01")
(COND
((SHIFTDOWNP (QUOTE FONT))
(\TK.FONT4 TEXTSTREAM TEXTOBJ SEL))
((SHIFTDOWNP (QUOTE USERMODE1))
(\TK.UNDERLINE.CARET.OFF TEXTSTREAM TEXTOBJ SEL))
(T (* do the real function of \tk.underlineon which
happens when neither Keyboard nor font is held)
(TEDIT.LOOKS TEXTSTREAM (QUOTE (UNDERLINE OFF))
SEL])
(\TK.BOLD.SEL.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "19-Mar-85 12:01")
(COND
((SHIFTDOWNP (QUOTE FONT))
(\TK.FONT2 TEXTSTREAM TEXTOBJ SEL))
((SHIFTDOWNP (QUOTE USERMODE1)) (* do the caret looks case)
(\TK.BOLD.CARET.ON TEXTSTREAM TEXTOBJ SEL))
(T (* do the real function of \tk.boldon which happens
when neither Keyboard nor font is held)
(* acts on the selection)
(TEDIT.LOOKS TEXTSTREAM (QUOTE (WEIGHT BOLD))
SEL])
(\TK.BOLD.SEL.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* gbn "19-Mar-85 12:02")
(COND
((SHIFTDOWNP (QUOTE FONT))
(\TK.FONT2 TEXTSTREAM TEXTOBJ SEL))
((SHIFTDOWNP (QUOTE USERMODE1)) (* do the caret looks case)
(\TK.BOLD.CARET.OFF TEXTSTREAM TEXTOBJ SEL))
(T (* do the real function of \tk.boldon which happens
when neither Keyboard nor font is held)
(* acts on the selection)
(TEDIT.LOOKS TEXTSTREAM (QUOTE (WEIGHT MEDIUM))
SEL])
(\TK.ITALIC.SEL.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "19-Mar-85 12:02")
(COND
((SHIFTDOWNP (QUOTE FONT))
(\TK.FONT3 TEXTSTREAM TEXTOBJ SEL))
((SHIFTDOWNP (QUOTE USERMODE1))
(\TK.ITALIC.CARET.ON TEXTSTREAM TEXTOBJ SEL))
(T (TEDIT.LOOKS TEXTSTREAM (QUOTE (SLOPE ITALIC))
SEL])
(\TK.ITALIC.SEL.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* gbn "19-Mar-85 12:02")
(COND
((SHIFTDOWNP (QUOTE FONT))
(\TK.FONT3 TEXTSTREAM TEXTOBJ SEL))
((SHIFTDOWNP (QUOTE USERMODE1))
(\TK.ITALIC.CARET.OFF TEXTSTREAM TEXTOBJ SEL))
(T (TEDIT.LOOKS TEXTSTREAM (QUOTE (SLOPE REGULAR))
SEL])
(\TK.SMALLERSEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 21:47")
(COND
((SHIFTDOWNP (QUOTE FONT))
(\TK.FONT7 TEXTSTREAM TEXTOBJ SEL))
((SHIFTDOWNP (QUOTE USERMODE1)) (* do the caret looks case)
(\TK.SMALLER.CARET TEXTSTREAM TEXTOBJ SEL))
(T (* do the real function of \TK.SUPERSCRIPTSEL which
happens when neither Keyboard nor font is held)
(* acts on the selection)
(TEDIT.LOOKS TEXTSTREAM (LIST (QUOTE SIZEINCREMENT)
(IMINUS \TK.SIZEINCREMENT))
SEL])
(\TK.LARGERSEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 21:47")
(COND
((SHIFTDOWNP (QUOTE FONT))
(\TK.FONT7 TEXTSTREAM TEXTOBJ SEL))
((SHIFTDOWNP (QUOTE USERMODE1)) (* do the caret looks case)
(\TK.LARGER.CARET TEXTSTREAM TEXTOBJ SEL))
(T (* do the real function of \TK.LARGER.SEL which happens
when neither Keyboard nor font is held)
(* acts on the selection)
(TEDIT.LOOKS TEXTSTREAM (LIST (QUOTE SIZEINCREMENT)
\TK.SIZEINCREMENT)
SEL])
(\TK.SUPERSCRIPTSEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 21:56")
(COND
((SHIFTDOWNP (QUOTE FONT))
(\TK.FONT5 TEXTSTREAM TEXTOBJ SEL))
((SHIFTDOWNP (QUOTE USERMODE1)) (* do the caret looks case)
(\TK.SUPERSCRIPT.CARET TEXTSTREAM TEXTOBJ SEL))
(T (* do the real function of \TK.SUPERSCRIPTSEL which
happens when neither Keyboard nor font is held)
(* acts on the selection)
(TEDIT.LOOKS TEXTSTREAM (LIST (QUOTE OFFSETINCREMENT)
TEDITKEY.OFFSETINCREMENT)
SEL])
(\TK.SUBSCRIPTSEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 21:42")
(COND
((SHIFTDOWNP (QUOTE FONT))
(\TK.FONT6 TEXTSTREAM TEXTOBJ SEL))
((SHIFTDOWNP (QUOTE USERMODE1)) (* do the caret looks case)
(\TK.SUBSCRIPT.CARET TEXTSTREAM TEXTOBJ SEL))
(T (* do the real function of \TK.SUPERSCRIPTSEL which
happens when neither Keyboard nor font is held)
(* acts on the selection)
(TEDIT.LOOKS TEXTSTREAM (LIST (QUOTE OFFSETINCREMENT)
(MINUS TEDITKEY.OFFSETINCREMENT))
SEL])
(\TK.DEFAULTSSEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 21:55")
(* acts on the selection)
(COND
((SHIFTDOWNP (QUOTE FONT))
(\TK.FONT8 TEXTSTREAM TEXTOBJ SEL))
((SHIFTDOWNP (QUOTE USERMODE1)) (* do the caret looks case)
(\TK.DEFAULTS.CARET TEXTSTREAM TEXTOBJ SEL))
(T (* acts on the selection)
(PROG ((LOOKS (create CHARLOOKS using TEDIT.DEFAULT.CHARLOOKS)))
(TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(TEDIT.LOOKS TEXTSTREAM LOOKS SEL])
(\TK.DEL.WORD.FORWARD
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "20-Mar-85 00:45")
(* * Deletes from here to the end of the first word Refers to the syntax classes of the characters according to the
TEDIT.WORDBOUND.READTABLE)
(PROG (HERE) (* position the file ptr at the
(character after the) caret of the selection)
(\TK.SETFILEPTR.TO.CARET TEXTSTREAM TEXTOBJ SEL) (* record this position as the beginning of the word
(to make the beginning of the selection))
(SETQ HERE (ADD1 (GETFILEPTR TEXTSTREAM))) (* skip the whitespace)
(while [AND (NOT (EOFP TEXTSTREAM))
(EQ \TK.WHITESPACE (TEDIT.WORDGET (\PEEKBIN TEXTSTREAM T]
do (BIN TEXTSTREAM))
(* find out what syntax class the first letter of the word has. The end of the word is marked by a change of syntax
classes)
(if (NOT (EOFP TEXTSTREAM))
then (SETQ CLASS (TEDIT.WORDGET (\PEEKBIN TEXTSTREAM T)))
(while [AND (NOT (EOFP TEXTSTREAM))
(EQ CLASS (TEDIT.WORDGET (\PEEKBIN TEXTSTREAM T]
do (BIN TEXTSTREAM)))
(TEDIT.SETSEL TEXTSTREAM HERE (ADD1 (IDIFFERENCE (GETFILEPTR TEXTSTREAM)
HERE))
(QUOTE RIGHT))
(TEDIT.DELETE TEXTSTREAM)
(TEDIT.NORMALIZECARET TEXTOBJ])
(\TK.UCASE.SEL
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "20-Mar-85 00:46")
(* uppercasifies the selection)
(PROG ((STR (TEDIT.SEL.AS.STRING STREAM SEL))
(POS (fetch CH# of SEL))
(LEN (fetch DCH of SEL))
(POINT (fetch POINT of SEL)))
(TEDIT.DELETE STREAM SEL)
(TEDIT.INSERT STREAM (U-CASE STR))
(TEDIT.SETSEL STREAM POS LEN POINT)
(TEDIT.NORMALIZECARET TEXTOBJ])
(\TK.CAPITALISE.SEL
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn
"24-Feb-86 16:57")
(* capitalises the
selection)
(PROG ((STR (TEDIT.SEL.AS.STRING STREAM SEL))
(POS (fetch (SELECTION CH#) of SEL))
(LEN (fetch (SELECTION DCH) of SEL))
(POINT (fetch (SELECTION POINT) of SEL)))
(TEDIT.DELETE STREAM SEL)
(TEDIT.INSERT STREAM (\CAPITALISE STR))
(TEDIT.SETSEL STREAM POS LEN POINT)
(TEDIT.NORMALIZECARET TEXTOBJ])
(\CAPITALISE
[LAMBDA (STR) (* gbn
"24-Feb-86 16:56")
(* * capitalises a string)
(SELECTQ (NCHARS STR)
(0 STR)
(1 (U-CASE STR))
(CONCAT (U-CASE (NTHCHAR STR 1))
(L-CASE (SUBSTRING STR 2])
(\TK.LCASE.SEL
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "20-Mar-85 00:46")
(* uppercasifies the selection)
(PROG ((STR (TEDIT.SEL.AS.STRING STREAM SEL))
(POS (fetch CH# of SEL))
(LEN (fetch DCH of SEL))
(POINT (fetch POINT of SEL)))
(TEDIT.DELETE STREAM SEL)
(TEDIT.INSERT STREAM (L-CASE STR))
(TEDIT.SETSEL STREAM POS LEN POINT)
(TEDIT.NORMALIZECARET TEXTOBJ])
)
(* functions for affecting the paralooks of the selection)
(DEFINEQ
(\TK.CENTER.SEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "27-Feb-85 18:17")
(COND
((SHIFTDOWNP (QUOTE FONT))
(\TK.FONT1 TEXTSTREAM TEXTOBJ SEL))
(T (* makes the current paragraph centered)
(PROG (LOOKS OLDQUAD NEWQUAD NEWQUADS (SAVECH# (fetch CH# of SEL))
(SAVEDCH (fetch DCH of SEL)))
(for PARA in (\PARAS.IN.SEL SEL TEXTOBJ)
do (SETQ LOOKS (TEDIT.GET.PARALOOKS TEXTSTREAM PARA))
(SETQ OLDQUAD (LISTGET LOOKS (QUOTE QUAD)))
[SETQ NEWQUAD (CADR (MEMB OLDQUAD (CONSTANT (QUOTE (LEFT JUSTIFIED CENTERED LEFT]
(LISTPUT LOOKS (QUOTE QUAD)
NEWQUAD)
(SETQ PARASEL (TEDIT.SETSEL TEXTSTREAM PARA 1))
(TEDIT.PARALOOKS TEXTSTREAM LOOKS PARASEL)
(push NEWQUADS NEWQUAD))
(TEDIT.SETSEL TEXTSTREAM SAVECH# SAVEDCH)
(if TEDITKEY.VERBOSE
then (TEDIT.PROMPTPRINT TEXTSTREAM (DREVERSE NEWQUADS)
T])
(\TK.CENTER.SEL.REV
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn " 7-Jun-85 21:34")
(COND
((SHIFTDOWNP (QUOTE FONT))
(\TK.FONT1 TEXTSTREAM TEXTOBJ SEL))
(T
(* * acts like center.sel but cycles in the opposite direction)
(PROG (LOOKS OLDQUAD NEWQUAD NEWQUADS (SAVECH# (fetch CH# of SEL))
(SAVEDCH (fetch DCH of SEL)))
(for PARA in (\PARAS.IN.SEL SEL TEXTOBJ)
do (SETQ LOOKS (TEDIT.GET.PARALOOKS TEXTSTREAM PARA))
(SETQ OLDQUAD (LISTGET LOOKS (QUOTE QUAD)))
[SETQ NEWQUAD (CADR (MEMB OLDQUAD (CONSTANT (QUOTE (LEFT CENTERED JUSTIFIED LEFT]
(LISTPUT LOOKS (QUOTE QUAD)
NEWQUAD)
(SETQ PARASEL (TEDIT.SETSEL TEXTSTREAM PARA 1))
(TEDIT.PARALOOKS TEXTSTREAM LOOKS PARASEL)
(push NEWQUADS NEWQUAD))
(TEDIT.SETSEL TEXTSTREAM SAVECH# SAVEDCH)
(if TEDITKEY.VERBOSE
then (TEDIT.PROMPTPRINT TEXTSTREAM (DREVERSE NEWQUADS)
T])
(\TK.NEST
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "27-Feb-85 18:24")
(PROG (LOOKS (SAVECH# (fetch CH# of SEL))
(SAVEDCH (fetch DCH of SEL)))
(for PARA in (\PARAS.IN.SEL SEL TEXTOBJ)
do (SETQ LOOKS (TEDIT.GET.PARALOOKS TEXTSTREAM PARA))
(LISTPUT LOOKS (QUOTE LEFTMARGIN)
(IPLUS (LISTGET LOOKS (QUOTE LEFTMARGIN))
TEDITKEY.NESTWIDTH))
(LISTPUT LOOKS (QUOTE 1STLEFTMARGIN)
(IPLUS (LISTGET LOOKS (QUOTE 1STLEFTMARGIN))
TEDITKEY.NESTWIDTH))
(LISTPUT LOOKS (QUOTE RIGHTMARGIN)
(IMAX 0 (IDIFFERENCE (LISTGET LOOKS (QUOTE RIGHTMARGIN))
TEDITKEY.NESTWIDTH)))
(TEDIT.SETSEL TEXTSTREAM PARA 1)
(TEDIT.PARALOOKS TEXTOBJ LOOKS))
(TEDIT.SETSEL TEXTSTREAM SAVECH# SAVEDCH])
(\TK.UNNEST
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "27-Feb-85 18:26")
(PROG (LOOKS RIGHT (SAVECH# (fetch CH# of SEL))
(SAVEDCH (fetch DCH of SEL)))
(for PARA in (\PARAS.IN.SEL SEL TEXTOBJ)
do (SETQ LOOKS (TEDIT.GET.PARALOOKS TEXTSTREAM PARA))
(LISTPUT LOOKS (QUOTE LEFTMARGIN)
(IMAX (IDIFFERENCE (LISTGET LOOKS (QUOTE LEFTMARGIN))
TEDITKEY.NESTWIDTH)
0))
(LISTPUT LOOKS (QUOTE 1STLEFTMARGIN)
(IMAX (IDIFFERENCE (LISTGET LOOKS (QUOTE 1STLEFTMARGIN))
TEDITKEY.NESTWIDTH)
0))
(SETQ RIGHT (LISTGET LOOKS (QUOTE RIGHTMARGIN)))
(if (NOT (ZEROP RIGHT))
then (LISTPUT LOOKS (QUOTE RIGHTMARGIN)
(IPLUS (LISTGET LOOKS (QUOTE RIGHTMARGIN))
TEDITKEY.NESTWIDTH)))
(TEDIT.SETSEL TEXTSTREAM PARA 1)
(TEDIT.PARALOOKS TEXTOBJ LOOKS))
(TEDIT.SETSEL TEXTSTREAM SAVECH# SAVEDCH])
)
(* functions for affecting (and displaying) the caret character looks)
(DEFINEQ
(\TK.SHOWCARETLOOKS
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "30-Jan-85 16:06")
(* * comment)
(PROG ((LOOKS (fetch CARETLOOKS of TEXTOBJ)))
(TEDIT.PROMPTPRINT TEXTSTREAM (CONCAT (\TK.DESCRIBEFONT (fetch CLFONT of LOOKS))
(if (AND (fetch CLOFFSET of LOOKS)
(NEQ (fetch CLOFFSET of LOOKS)
0))
then (CONCAT " offset " (fetch CLOFFSET
of LOOKS))
else "")
(if (fetch CLOLINE of LOOKS)
then " overlined"
else "")
(if (fetch CLULINE of LOOKS)
then " underlined"
else ""))
T)
(RETURN])
(\TK.BOLD.CARET.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 20:54")
(PROG [(LOOKS (create CHARLOOKS using (fetch CARETLOOKS of TEXTOBJ]
(replace CLBOLD of LOOKS with T)
(if (\TK.SETFONTINLOOKS TEXTSTREAM LOOKS)
then (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(if TEDITKEY.VERBOSE
then (\TK.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))
(RETURN)
else (RETURN])
(\TK.BOLD.CARET.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 20:54")
(PROG [(LOOKS (create CHARLOOKS using (fetch CARETLOOKS of TEXTOBJ]
(replace CLBOLD of LOOKS with NIL)
(if (\TK.SETFONTINLOOKS TEXTSTREAM LOOKS)
then (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(if TEDITKEY.VERBOSE
then (\TK.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))
(RETURN)
else (RETURN])
(\TK.ITALIC.CARET.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 22:20")
(PROG [(LOOKS (create CHARLOOKS using (fetch CARETLOOKS of TEXTOBJ]
(replace CLITAL of LOOKS with T)
(if (\TK.SETFONTINLOOKS TEXTSTREAM LOOKS)
then (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(if TEDITKEY.VERBOSE
then (\TK.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))
(RETURN)
else (RETURN])
(\TK.ITALIC.CARET.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 22:19")
(PROG [(LOOKS (create CHARLOOKS using (fetch CARETLOOKS of TEXTOBJ]
(replace CLITAL of LOOKS with NIL)
(if (\TK.SETFONTINLOOKS TEXTSTREAM LOOKS)
then (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(if TEDITKEY.VERBOSE
then (\TK.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))
(RETURN)
else (RETURN])
(\TK.UNDERLINE.CARET.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 17:59")
(PROG [(LOOKS (create CHARLOOKS using (fetch CARETLOOKS of TEXTOBJ]
(replace CLULINE of LOOKS with T)
(TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(if TEDITKEY.VERBOSE
then (\TK.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))
(RETURN])
(\TK.UNDERLINE.CARET.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 18:01")
(PROG [(LOOKS (create CHARLOOKS using (fetch CARETLOOKS of TEXTOBJ]
(replace CLULINE of LOOKS with NIL)
(TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(if TEDITKEY.VERBOSE
then (\TK.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))
(RETURN])
(\TK.SUPERSCRIPT.CARET
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 22:25")
(PROG [(LOOKS (create CHARLOOKS using (fetch CARETLOOKS of TEXTOBJ]
(if (fetch CLOFFSET of LOOKS)
then (add (fetch CLOFFSET of LOOKS)
TEDITKEY.OFFSETINCREMENT)
else (replace CLOFFSET of LOOKS with TEDITKEY.OFFSETINCREMENT))
(TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(if TEDITKEY.VERBOSE
then (\TK.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))
(RETURN])
(\TK.SUBSCRIPT.CARET
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 22:26")
(PROG [(LOOKS (create CHARLOOKS using (fetch CARETLOOKS of TEXTOBJ]
(if (fetch CLOFFSET of LOOKS)
then (add (fetch CLOFFSET of LOOKS)
(IMINUS TEDITKEY.OFFSETINCREMENT))
else (replace CLOFFSET of LOOKS with (IMINUS TEDITKEY.OFFSETINCREMENT)))
(TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(if TEDITKEY.VERBOSE
then (\TK.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))
(RETURN])
(\TK.SMALLER.CARET
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 21:45")
(PROG [(LOOKS (create CHARLOOKS using (fetch CARETLOOKS of TEXTOBJ]
(replace CLSIZE of LOOKS with (IMAX 4 (IDIFFERENCE (fetch CLSIZE of LOOKS)
2)))
(if (NOT (\TK.SETFONTINLOOKS TEXTSTREAM LOOKS))
then (RETURN))
(TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(if TEDITKEY.VERBOSE
then (\TK.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))
(RETURN])
(\TK.LARGER.CARET
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 22:37")
(PROG [(LOOKS (create CHARLOOKS using (fetch CARETLOOKS of TEXTOBJ]
(replace CLSIZE of LOOKS with (IPLUS \TK.SIZEINCREMENT (fetch CLSIZE of LOOKS)))
(if (NOT (\TK.SETFONTINLOOKS TEXTSTREAM LOOKS))
then (RETURN))
(TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(if TEDITKEY.VERBOSE
then (\TK.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))
(RETURN])
(\TK.DEFAULTS.CARET
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 21:54")
(PROGN (TEDIT.CARETLOOKS TEXTSTREAM (create CHARLOOKS using TEDIT.DEFAULT.CHARLOOKS))
(if TEDITKEY.VERBOSE
then (\TK.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TK.FONT1
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "27-Jan-85 17:39")
(\TK.SETCARETFONT TEXTOBJ (CAR (NTH TEDITKEY.FONTS 1])
(\TK.FONT2
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "27-Jan-85 17:43")
(\TK.SETCARETFONT TEXTOBJ (CAR (NTH TEDITKEY.FONTS 2])
(\TK.FONT3
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "27-Jan-85 17:40")
(\TK.SETCARETFONT TEXTOBJ (CAR (NTH TEDITKEY.FONTS 3])
(\TK.SETCARETFONT
[LAMBDA (TEXTOBJ FONTNAME) (* gbn "19-Mar-85 12:02")
(* temporary hack. If this function is called when the
keyboard shift is down, then it refers to the caret
looks, otherwise the selection)
(if (SHIFTDOWNP (QUOTE USERMODE1))
then [PROG [(LOOKS (create CHARLOOKS using (fetch CARETLOOKS of TEXTOBJ]
(replace CLNAME of LOOKS with FONTNAME)
(if (\TK.SETFONTINLOOKS TEXTOBJ LOOKS)
then (* we found the font, install it as the caret font and
tell the user)
(if TEDITKEY.VERBOSE
then (TEDIT.PROMPTPRINT TEXTOBJ FONTNAME T))
(RETURN (TEDIT.CARETLOOKS TEXTSTREAM LOOKS]
else (TEDIT.LOOKS TEXTSTREAM (LIST (QUOTE FAMILY)
FONTNAME)
SEL])
(\TK.FONT4
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "27-Jan-85 17:40")
(\TK.SETCARETFONT TEXTOBJ (CAR (NTH TEDITKEY.FONTS 4])
(\TK.FONT5
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "27-Jan-85 17:41")
(\TK.SETCARETFONT TEXTOBJ (CAR (NTH TEDITKEY.FONTS 5])
(\TK.FONT6
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "27-Jan-85 17:41")
(\TK.SETCARETFONT TEXTOBJ (CAR (NTH TEDITKEY.FONTS 6])
(\TK.FONT7
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "27-Jan-85 17:42")
(\TK.SETCARETFONT TEXTOBJ (CAR (NTH TEDITKEY.FONTS 7])
(\TK.FONT8
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "27-Jan-85 17:43")
(\TK.SETCARETFONT TEXTOBJ (CAR (NTH TEDITKEY.FONTS 8])
)
(* the functions which aren't currently used, which toggle the caret looks)
(DEFINEQ
(\TK.BOLDTOGGLE
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 20:54")
(* * toggles boldness in the caret looks)
(PROG [(LOOKS (create CHARLOOKS using (fetch CARETLOOKS of TEXTOBJ]
(replace CLBOLD of LOOKS with (NOT (fetch CLBOLD of LOOKS)))
(if (\TK.SETFONTINLOOKS TEXTSTREAM LOOKS)
then (if TEDITKEY.VERBOSE
then (TEDIT.PROMPTPRINT TEXTSTREAM (CONCAT "bold: "
(\TK.ONOROFF (fetch CLBOLD
of LOOKS)))
T))
(RETURN (TEDIT.CARETLOOKS TEXTSTREAM LOOKS))
else (RETURN])
(\TK.ITALICTOGGLE
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "27-Jan-85 19:23")
(PROG [(LOOKS (create CHARLOOKS using (fetch CARETLOOKS of TEXTOBJ]
(replace CLITAL of LOOKS with (NOT (fetch CLITAL of LOOKS)))
(if (\TK.SETFONTINLOOKS TEXTSTREAM LOOKS)
then (if TEDITKEY.VERBOSE
then (TEDIT.PROMPTPRINT TEXTSTREAM (CONCAT "italic: "
(\TK.ONOROFF (fetch CLITAL
of LOOKS)))
T))
(RETURN (TEDIT.CARETLOOKS TEXTSTREAM LOOKS))
else (RETURN])
(\TK.UNDERLINETOGGLE
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "27-Jan-85 19:23")
(PROG [(LOOKS (create CHARLOOKS using (fetch CARETLOOKS of TEXTOBJ]
(replace CLULINE of LOOKS with (NOT (fetch CLULINE of LOOKS)))
(if TEDITKEY.VERBOSE
then (TEDIT.PROMPTPRINT TEXTSTREAM (CONCAT "underline: " (\TK.ONOROFF (fetch CLULINE
of LOOKS)))
T))
(RETURN (TEDIT.CARETLOOKS TEXTSTREAM LOOKS])
)
(* functions dealing with the default looks)
(DEFINEQ
(\TK.SETDEFAULTLOOKS
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 23:00")
(* * sets TEDIT.DEFAULT.CHARLOOKS to have the looks of the current selection)
(PROG NIL
(SETQ TEDIT.DEFAULT.CHARLOOKS (COPY (fetch CARETLOOKS of TEXTOBJ)))
(if TEDITKEY.VERBOSE
then (\TK.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))
(RETURN])
)
(* functions for positioning within a document)
(DEFINEQ
(GOTONEXTTTYWINDOW
[LAMBDA NIL (* gbn " 7-May-85 16:19")
(* * puts the tty in the next appropriate process in the chain)
(PROG ((CURRENT (TTY.PROCESS)))
(SETQ CANDIDATES (LIST NIL))
[MAP.PROCESSES (FUNCTION (LAMBDA (PROC)
(PROG (W)
(if (AND (SETQ W (PROCESSPROP PROC (QUOTE WINDOW)))
(OPENWP W)
(WINDOWPROP W (QUOTE PROCESS)))
then (NCONC1 CANDIDATES PROC]
(SETQ NEW (CDR (MEMBER CURRENT CANDIDATES)))
(SETQ NEW (if NEW
then (CAR NEW)
else (CADR CANDIDATES)))
(TTY.PROCESS NEW)
(FLASHWINDOW (PROCESSPROP NEW (QUOTE WINDOW))
1 1 GRAYSHADE)
(* for (PROC ← CURRENT) repeatwhile (NEQ PROC CURRENT) do (SETQ W (PROCESSPROP (SETQ PROC (fetch NEXTPROCHANDLE of
PROC)) (QUOTE WINDOW))) (PRINTOUT T (PROCESSPROP PROC (QUOTE NAME))) (if (AND W (OPENWP W) (WINDOWPROP W
(QUOTE PROCESS))) then (* this window would probably be willing to take the tty if clicked in, so give the process
the tty) (TTY.PROCESS PROC) (FLASHWINDOW W 1 NIL GRAYSHADE) (RETURN)))
])
(\TK.NEXTLINE
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "10-Oct-85 22:47")
(* moves the selection down one line)
(PROG (THIS NEXT) (* get the selection on the screen so that it has a
line descriptor)
(TEDIT.NORMALIZECARET STREAM SEL)
(SETQ THIS (\SEL.LINEDESC SEL))
(if THIS
then (* an empty doc has no line descriptors, even after
normalizing)
(SETQ NEXT (fetch NEXTLINE of THIS))
[if (NOT NEXT)
then (* there isn't already a descriptor for this line)
(SETQ NEXT (replace NEXTLINE of THIS
with (\FORMATLINE TEXTOBJ NIL
(ADD1 (fetch CHARLIM
of THIS]
(if NEXT
then (* if there are no more characters, then there still
may not be a descriptor when we call \formatline)
(TEDIT.NORMALIZECARET STREAM
(TEDIT.SETSEL
STREAM
(IMIN (IPLUS (fetch CHAR1
of NEXT)
(IDIFFERENCE
(\SEL.LIMIT SEL)
(fetch CHAR1
of THIS)))
(ADD1 (\LINEDESC.LAST.REAL.CHAR
NEXT)))
0
(QUOTE LEFT])
(\TK.PREVLINE
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "10-Oct-85 22:15")
(* moves the selection up one line)
(PROG (THIS PREV) (* get the selection on the screen so that it has a
line descriptor)
(TEDIT.NORMALIZECARET STREAM SEL)
(if (SETQ THIS (\SEL.LINEDESC SEL))
then (* empty docs have no line descriptors)
(SETQ PREV (fetch PREVLINE of THIS))
[if (ZEROP (fetch CHARLIM of PREV))
then (* we need to back format because this is a fake line
descriptor)
[\BACKFORMAT (NTHCAR (fetch LINES of TEXTOBJ)
(\TEXTOBJ.WINDEX TEXTOBJ))
TEXTOBJ
(fetch PTOP of (DSPCLIPPINGREGION
NIL
(fetch SELWINDOW
of TEXTOBJ]
(SETQ PREV (fetch PREVLINE of THIS))
(* (SETQ PREV (replace PREVLINE of THIS with
(\FORMATLINE TEXTOBJ NIL (ADD1
(fetch CHARLIM of THIS))))))]
(TEDIT.NORMALIZECARET STREAM
(TEDIT.SETSEL STREAM
(IMIN (IPLUS (fetch CHAR1
of PREV)
(IDIFFERENCE
(\SEL.LIMIT
SEL)
(fetch CHAR1
of THIS)))
(fetch CHARLIM of PREV))
0])
(\TK.GOTODOCBEGIN
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "13-Dec-84 11:24")
(* positions at the beginning of a document)
(TEDIT.SETSEL STREAM 0 0)
(TEDIT.NORMALIZECARET TEXTOBJ])
(\TK.GOTODOCEND
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn " 7-Jun-85 16:32")
(* positions at the end of a document)
(TEDIT.SETSEL STREAM (ADD1 (fetch TEXTLEN of TEXTOBJ))
0
(QUOTE LEFT))
(TEDIT.NORMALIZECARET STREAM])
(\TK.GOTOLINEBEGIN
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "11-Mar-85 15:04")
(* * positions the cursor at the beginning of line)
(PROG (CH)
(TEDIT.NORMALIZECARET TEXTOBJ SEL)
(SETQ CH (fetch CHAR1 of (\SEL.LINEDESC SEL)))
(* (if (fetch CR\END of (fetch L1 of SEL)) then (* there is a CR at the end of this line, we want to position before
it) (SETQ CH (SUB1 CH))))
(TEDIT.SETSEL TEXTSTREAM CH 0 (QUOTE LEFT])
(\TK.GOTOLINEEND
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn " 7-Jun-85 15:47")
(* * positions the cursor at the end of line)
(PROG ((POINT (QUOTE RIGHT))
LN)
(TEDIT.NORMALIZECARET TEXTOBJ SEL)
(if (SETQ LN (\SEL.LINEDESC SEL))
then (* empty docs have no linedescriptors)
(SETQ CH (fetch CHARLIM of LN))
(if (fetch CR\END of LN)
then (* there is not a CR at the end of this line, we want
to position to the right of the last char)
(SETQ POINT (QUOTE LEFT)))
(TEDIT.SETSEL TEXTSTREAM CH 1 POINT])
(\TK.PREVCHAR
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "19-Mar-85 12:16")
(* moves the selection back one char)
(PROG NIL
(TEDIT.SETSEL STREAM (IMAX 0 (SUB1 (\SEL.LIMIT.FORWARD SEL)))
0
(QUOTE LEFT)) (* I don't think this should be necessary, but there
are cases where the caret is not normalised)
(TEDIT.NORMALIZECARET TEXTOBJ SEL])
(\TK.NEXTCHAR
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "20-Mar-85 00:48")
(* moves the selection back one char)
(PROG NIL (* Note: addition. does *not* distribute with Min Do
not pessimize this!)
(TEDIT.SETSEL STREAM (IMIN (ADD1 (fetch TEXTLEN of TEXTOBJ))
(ADD1 (\SEL.LIMIT.FORWARD SEL)))
0
(QUOTE LEFT))
(TEDIT.NORMALIZECARET TEXTOBJ])
(\TK.FORWARD.WORD
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "20-Mar-85 00:48")
(* * moves the caret one word forward. Refers to the syntax classes of the characters according to the
TEDIT.WORDBOUND.READTABLE)
(PROG (HERE) (* position the file ptr at the
(character after the) caret of the selection)
(\TK.SETFILEPTR.TO.CARET TEXTSTREAM TEXTOBJ SEL) (* skip the whitespace)
(while [AND (NOT (EOFP TEXTSTREAM))
(EQ \TK.WHITESPACE (TEDIT.WORDGET (\PEEKBIN TEXTSTREAM T]
do (BIN TEXTSTREAM)) (* record this position as the beginning of the word
(to make the beginning of the selection))
(SETQ HERE (ADD1 (GETFILEPTR TEXTSTREAM)))
(* find out what syntax class the first letter of the word has. The end of the word is marked by a change of syntax
classes)
(if (NOT (EOFP TEXTSTREAM))
then (SETQ CLASS (TEDIT.WORDGET (\PEEKBIN TEXTSTREAM T)))
(while [AND (NOT (EOFP TEXTSTREAM))
(EQ CLASS (TEDIT.WORDGET (\PEEKBIN TEXTSTREAM T]
do (BIN TEXTSTREAM)))
(TEDIT.SETSEL TEXTSTREAM HERE (ADD1 (IDIFFERENCE (GETFILEPTR TEXTSTREAM)
HERE))
(QUOTE RIGHT))
(TEDIT.NORMALIZECARET TEXTOBJ])
(\TK.BACK.WORD
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "20-Mar-85 00:49")
(* * moves the caret one word back Refers to the syntax classes of the characters according to the
TEDIT.WORDBOUND.READTABLE)
(PROG (HERE) (* position the file ptr at the
(character after the) caret of the selection)
(\TK.SETFILEPTR.TO.CARET TEXTSTREAM TEXTOBJ SEL) (* skip the whitespace)
(while [AND (NOT (ZEROP (GETFILEPTR TEXTSTREAM)))
(EQ \TK.WHITESPACE (TEDIT.WORDGET (\BACKPEEKBIN TEXTSTREAM T]
do (\BACKBIN TEXTSTREAM)) (* record this position as the beginning of the word
(to make the beginning of the selection))
(SETQ HERE (GETFILEPTR TEXTSTREAM))
(* find out what syntax class the last letter of the word has. The end of the word is marked by a change of syntax
classes)
(if (NOT (ZEROP (GETFILEPTR TEXTSTREAM)))
then (SETQ CLASS (TEDIT.WORDGET (\BACKPEEKBIN TEXTSTREAM T)))
(while [AND (NOT (ZEROP (GETFILEPTR TEXTSTREAM)))
(EQ CLASS (TEDIT.WORDGET (\BACKPEEKBIN TEXTSTREAM T]
do (\BACKBIN TEXTSTREAM)))
(TEDIT.SETSEL TEXTSTREAM (ADD1 (GETFILEPTR TEXTSTREAM))
(IDIFFERENCE HERE (GETFILEPTR TEXTSTREAM))
(QUOTE LEFT))
(TEDIT.NORMALIZECARET TEXTOBJ])
(\TK.SELECT.ALL
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn
"24-Feb-86 17:11")
(* positions at the
end of a document)
(TEDIT.SETSEL STREAM 0 (ADD1 (fetch TEXTLEN of TEXTOBJ))
(QUOTE LEFT])
)
(* other utilities)
(DEFINEQ
(\TK.FIND
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "10-Dec-84 12:38")
(* just calls the normal tedit.find starting at the
right of the current selection)
(TEDIT.FULL.FIND TEXTSTREAM])
(\TK.REDISPLAY
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "12-Mar-85 14:27")
(* * simply redisplays the window in question.)
(\TEDIT.REPAINTFN (CAR (MKATOM (fetch \WINDOW of TEXTOBJ])
(\TK.DELLINEFORWARD
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "13-Dec-84 11:56")
(* deletes from the caret to the end of this line)
(PROG (HERE DESC)
(TEDIT.NORMALIZECARET TEXTOBJ)
(SETQ HERE (\SEL.LIMIT.FORWARD SEL))
(SETQ DESC (\SEL.LINEDESC SEL))
(SETQ SEL (TEDIT.SETSEL STREAM HERE (IDIFFERENCE (fetch CHARLIM of DESC)
HERE)))
(TEDIT.DELETE STREAM SEL])
(\TK.OPENLINE
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "30-Jan-85 18:36")
(TEDIT.INSERT STREAM (CONSTANT (CHARCODE EOL)))
(\TK.PREVCHAR STREAM TEXTOBJ SEL])
(\TK.DELCHARFORWARD
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "20-Mar-85 00:50")
(* * deletes one character forward from the caret)
(PROG (HERE)
(SETQ SEL (TEDIT.SETSEL STREAM (\SEL.LIMIT.FORWARD SEL)
1))
(TEDIT.DELETE STREAM SEL)
(TEDIT.NORMALIZECARET TEXTOBJ])
(\TK.TRANSPOSECHARS
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "20-Mar-85 00:51")
(* * transposes the two characters on either side of the point, unless it is the end of a line, in which case it
transposes the two characters before the point)
(PROG ((KEEPCHARPOS (\SEL.LIMIT.FORWARD SEL))
KEEPCHAR LINEDESC)
(TEDIT.NORMALIZECARET TEXTOBJ SEL) (* get the line that the point of the selection is on)
(SETQ LINEDESC (\SEL.LINEDESC SEL))
(if (ILESSP (\LINEDESC.LAST.REAL.CHAR LINEDESC)
KEEPCHARPOS)
then (* the point is after the last real char on this line,
so transpose the two before the point.)
(add KEEPCHARPOS -1))
(SETQ KEEPCHAR (TEDIT.SEL.AS.STRING STREAM (TEDIT.SETSEL STREAM KEEPCHARPOS 1)))
(if (AND (IGREATERP KEEPCHARPOS 1)
(IGEQ (fetch TEXTLEN of TEXTOBJ)
KEEPCHARPOS))
then (TEDIT.DELETE STREAM)
(TEDIT.INSERT STREAM KEEPCHAR (SUB1 KEEPCHARPOS))
(TEDIT.SETSEL STREAM KEEPCHARPOS 1 (QUOTE RIGHT)))
(TEDIT.NORMALIZECARET TEXTOBJ SEL])
)
(* little selection utilities etc., for building hacks)
(DEFINEQ
(\SEL.LIMIT
[LAMBDA (SEL) (* gbn " 8-Mar-85 12:58")
(* returns the character that delimits this selection.
The first char if the point is left else the last)
(if (EQ (fetch POINT of SEL)
(QUOTE LEFT))
then (fetch CH# of SEL)
else (SUB1 (fetch CHLIM of SEL])
(\TK.SETFILEPTR.TO.CARET
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "23-Feb-85 15:24")
(* * makes sure that the fileptr is positioned at character on the right of the CARET of the selection)
(* NOTE THAT FILEPTR's are one less than the
corresponding char# in a sel)
(SETFILEPTR TEXTSTREAM (SUB1 (\SEL.LIMIT.FORWARD SEL])
(\SEL.LINEDESC
[LAMBDA (SEL) (* gbn "10-Oct-85 20:57")
(* * Returns the line descriptor of the point of the selection in the last selected window)
(NTHCAR (if (EQ (fetch POINT of SEL)
(QUOTE LEFT))
then (fetch L1 of SEL)
else (fetch LN of SEL))
(\TEXTOBJ.WINDEX (fetch \TEXTOBJ of SEL])
(\TK.DESCRIBEFONT
[LAMBDA (FONT) (* gbn "15-Dec-84 17:54")
(* * returns a string which describes a font (in short. If it's not italic then no mention is made of slope, etc.))
(CONCAT (L-CASE (FONTPROP FONT (QUOTE FAMILY)))
" "
(FONTPROP FONT (QUOTE SIZE))
(if (NEQ (FONTPROP FONT (QUOTE WEIGHT))
(QUOTE MEDIUM))
then [CONCAT " " (L-CASE (FONTPROP FONT (QUOTE WEIGHT]
else "")
(if (NEQ (FONTPROP FONT (QUOTE SLOPE))
(QUOTE REGULAR))
then [CONCAT " " (L-CASE (FONTPROP FONT (QUOTE SLOPE]
else ""])
(\PARAS.IN.SEL
[LAMBDA (SEL TEXTOBJ) (* gbn " 7-Jun-85 16:05")
(* returns a list which contains one character number
for each paragraph included in the selection)
(PROG ((PARAS)
PARAENDED PCS (POS (fetch CH# of SEL)))
(if (ZEROP (fetch DCH of SEL))
then
(* there are not really any pieces in this selection, however, effect the change to the para containing this
selection by starting the selection one character earlier. This is not the right soln, but TEdit has no looks on the
empty last para as yet.)
(replace CH# of SEL with (IDIFFERENCE (fetch CH# of SEL)
1))
(replace DCH of SEL with 1)
(\FIXSEL SEL TEXTOBJ))
(SETQ PCS (TEDIT.SELECTED.PIECES TEXTOBJ SEL)) (* to include the first char)
(SETQ PARAENDED T)
(for PC in PCS
do (if PARAENDED
then (* the last piece ended a paragraph, so include this
character in the list)
(SETQ PARAENDED NIL)
(push PARAS POS))
(SETQ PARAENDED (fetch PPARALAST of PC))
(add POS (fetch PLEN of PC)))
(RETURN (DREVERSE PARAS])
)
(DECLARE: EVAL@COMPILE
[PUTPROPS \SEL.LIMIT.FORWARD MACRO (LAMBDA (SEL)
(* gbn "13-Dec-84 11:43")
(* returns the character in front of the caret
(ch# for left and chlim for right))
(if (EQ (fetch POINT of SEL)
(QUOTE LEFT))
then
(fetch CH# of SEL)
else
(fetch CHLIM of SEL]
[PUTPROPS \TK.ONOROFF MACRO (LAMBDA (FLG)
(if FLG then "on" else "off"]
[PUTPROPS \LINEDESC.LAST.REAL.CHAR MACRO (LAMBDA (LINEDESC)
(if (fetch CR\END of LINEDESC)
then
(* there is a CR at the end so the last real char
CHLIM-1)
(SUB1 (fetch CHARLIM of LINEDESC))
else
(fetch CHARLIM of LINEDESC]
)
(* fns for the key interface itself)
(DEFINEQ
(\SHIFTACTION
[LAMBDA (KEYNAME) (* gbn "16-Feb-85 16:55")
(* returns the character code generated by this keyname
when typed shifted)
(CADAR (KEYACTION KEYNAME])
(\ACTION
[LAMBDA (KEYNAME) (* gbn "16-Feb-85 16:54")
(* RETURNS THE CHARACTER CODE GENERATED BY THIS KEYNAME
WHEN TYPED UNSHIFTED)
(CAAR (KEYACTION KEYNAME])
(TEDITKEY.INSTALL
[LAMBDA (READTABLE) (* gbn " 1-Apr-86 22:36")
(* * installs the TEDITKEYBINDINGS on the readtable)
(PROG [(READTABLE (OR READTABLE TEDIT.READTABLE))
INTERRUPT
(FNKEYITEM (QUOTE (Function% Keys (QUOTE BUILDFNKEYS)
"Bring up the DLion fn keys window"]
(* I think that in Koto, all this is done by the system.
The times, they are a-changin'! (PROGN (* Tell everyone who cares to let ↑h be
the backspace character) (if (SETQ INTERRUPT
(GETINTERRUPT (CHARCODE ↑H))) then (printout T "Interrupt on ↑H disabled")
(SETINTERRUPT (CHARCODE ↑H) (QUOTE NIL)))
(SETSYNTAX 8 (QUOTE CHARDELETE) \PROMPTFORWORDTTBL)
(SETSYNTAX 8 (QUOTE CHARDELETE) ASKUSERTTBL)
(SETSYNTAX 8 (QUOTE CHARDELETE) \ORIGTERMTABLE)
(SETSYNTAX 8 (QUOTE CHARDELETE) \PRIMTERMTABLE)
(SETSYNTAX 8 (QUOTE CHARDELETE) DEDITTTBL)
(SETINTERRUPT (CHARCODE ↑G) (QUOTE HELP))))
(METASHIFT T) (* TEditKey redefines METASHIFT to
operate on TEDITKEY.METAKEY instead of
the swat (bottom-blank) key)
(* install the functions on the main
keyboard, that is, not the extra dlion
keys)
[for TRIPLE in TEDITKEY.KEYBINDINGS
do (if TRIPLE
then (* NILs in the list are for formatting
the menu)
(for KEY in (CADR TRIPLE) do (APPLY* (QUOTE TEDIT.SETFUNCTION)
(EVAL (BQUOTE (CHARCODE , KEY)))
(CAR TRIPLE)
READTABLE]
(* the function keys are set up by
default (MODIFY.KEYACTIONS
TEDITKEY.FNKEYACTIONS))
(PROGN (* install the nextttywindow hack)
(* INTERRUPTCHAR (\SHIFTACTION
(QUOTE NEXT)) (QUOTE
(GOTONEXTTTYWINDOW)))
(* So that non-tedits know about the
game)
)
(SELECTQ (MACHINETYPE)
(DANDELION [if TEDITKEY.LOCKTOGGLEKEY
then (KEYACTION TEDITKEY.LOCKTOGGLEKEY (QUOTE (LOCKTOGGLE]
(if (AND (BOUNDP (QUOTE DLIONFNKEYS))
(OPENWP DLIONFNKEYS))
then (* this machine has real fn keys so
close the fake ones)
(CLOSEW DLIONFNKEYS)) (* adjust so that the dlion extra keys
return meta control codes)
(MODIFY.KEYACTIONS TEDITKEY.DLION.KEYACTIONS)
(for PAIR in TEDITKEY.DLION.KEYBINDINGS
do (TEDIT.SETFUNCTION (EVAL (CAR PAIR))
(CADR PAIR)
READTABLE)) (* hang functions off the dlion extra
keys (e.g. italics, bold))
(for PAIR in TEDITKEY.FNKEYBINDINGS do (TEDIT.SETFUNCTION
(EVAL (CAR PAIR))
(CADR PAIR)
READTABLE))
(* set next to do next, undo to do
undo etc)
(* unnecessary in KOTO
(for PAIR in TEDITKEY.DLION.KEYSYNTAX
do (TEDIT.SETSYNTAX (EVAL
(CAR PAIR)) (CADR PAIR) READTABLE)))
(* remove the menu item that may have
already been installed)
(* you can remove non-existent items
with impunity)
(TEDIT.REMOVE.MENUITEM TEDIT.DEFAULT.MENU FNKEYITEM)
(PROGN (* install the nextttywindow hack)
(INTERRUPTCHAR (\SHIFTACTION (QUOTE NEXT))
(QUOTE (GOTONEXTTTYWINDOW)))
(* So that non-tedits know about the
game)
))
(PROGN (MODIFY.KEYACTIONS TEDITKEY.DORADO.KEYACTIONS)
(for PAIR in TEDITKEY.DORADO.KEYSYNTAX do (TEDIT.SETSYNTAX (EVAL (CAR PAIR))
(CADR PAIR)
READTABLE))
(for PAIR in TEDITKEY.FNKEYBINDINGS do (TEDIT.SETFUNCTION (EVAL (CAR PAIR))
(CADR PAIR)
READTABLE))
(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU FNKEYITEM)))
(SELECTQ (MACHINETYPE)
((DORADO DOLPHIN)
(* bring up the fake function keys)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
DLIONFNKEYS)
(if [AND TEDITKEY.FNKEYFLG (NOT (AND (BOUNDP (QUOTE DLIONFNKEYS))
(OPENWP DLIONFNKEYS]
then
(* if he has the flag set to do so, then check if there is a fnkey window up
yet, and build one if there isn't)
(BUILDFNKEYS)))
(PROGN NIL)) (* install the forms necessary to
re-establish the correct bindings on a
new machine if this is sysout'ed)
(* if (NOT (ASSOC (QUOTE
TEDITKEY.INSTALL) AFTERMAKESYSFORMS))
then (push AFTERMAKESYSFORMS
(QUOTE (TEDITKEY.INSTALL))))
[if (NOT (ASSOC (QUOTE TEDITKEY.INSTALL)
AFTERSYSOUTFORMS))
then (push AFTERSYSOUTFORMS (QUOTE (TEDITKEY.INSTALL]
(RETURN (CONCAT TEDITKEY.METAKEY "'s action is now Meta. TEditKey actions and key bindings installed. Type #? or press the HELP key to see keybindings"
])
(TEDITKEY.DEINSTALL
[LAMBDA (ARGS ...) (* gbn "10-Oct-85 00:04")
(MODIFY.KEYACTIONS \ORIGKEYACTIONS)
(SELECTQ (MACHINETYPE)
(DANDELION (MODIFY.KEYACTIONS \DLIONKEYACTIONS))
(PROGN NIL])
(\TK.ACTIONTOCHARCODE
[LAMBDA (FN) (* gbn "23-Feb-85 17:17")
(* takes the name of the function and looks in
TEDITKEY.KEYBINDINGS to find out which CHARCODE
generates that behaviour)
(PROG ((PAIR (ASSOC FN TEDITKEY.KEYBINDINGS)))
(RETURN (if PAIR
then [EVAL (BQUOTE (CHARCODE , (CAADR PAIR]
else NIL])
(\TK.BUILD.MENU
[LAMBDA (KEYBINDINGS) (* gbn "23-Feb-85 17:17")
(* builds a menu to display the key bindings)
(PROG (ITEMS)
[for TRIPLE in TEDITKEY.KEYBINDINGS do (if TRIPLE
then (push ITEMS (LIST (CADDR TRIPLE)
(BQUOTE (QUOTE , TRIPLE))
"Function which is performed by the key(s) to the right of the mouse"))
(push ITEMS (LIST (for DESC
in (CADR TRIPLE)
collect (CHARDESC
DESC))
NIL))
else (* insert a space since NIL marks logical divisions in
the list)
(push ITEMS (QUOTE ("" NIL "")))
(push ITEMS (QUOTE ("" NIL ""]
(SETQ \TK.MENU (create MENU
ITEMS ←(DREVERSE ITEMS)
MENUCOLUMNS ← 2
CENTERFLG ← T
MENUFONT ←(FONTCREATE (QUOTE HELVETICA)
10])
(\TK.HELP
[LAMBDA (WHATEVER) (* gbn " 5-Nov-84 18:17")
(* brings up a menu of the available key bindings)
(MENU \TK.MENU])
(\TK.SETFONTINLOOKS
[LAMBDA (TEXTSTREAM LOOKS) (* gbn "11-Oct-85 07:12")
(* * rebuilds the font field of looks according to the values in the fields)
(PROG (NEWFONT)
(SETQ NEWFONT (FONTCREATE (OR (fetch CLNAME of LOOKS)
(FONTPROP (fetch CLFONT of LOOKS)
(QUOTE FAMILY)))
(fetch CLSIZE of LOOKS)
(LIST (if (fetch CLBOLD of LOOKS)
then (QUOTE BOLD)
else (QUOTE MEDIUM))
(if (fetch CLITAL of LOOKS)
then (QUOTE ITALIC)
else (QUOTE REGULAR))
(QUOTE REGULAR))
NIL NIL T))
(if (CAR NEWFONT)
then (* we got the font, so now replace it)
(RETURN (replace CLFONT of LOOKS with NEWFONT))
else (* we lost, print a msg and return NIL so that the
caller knows.)
(TEDIT.PROMPTPRINT TEXTSTREAM
(CONCAT "Font not found: "
(CONCAT [L-CASE (OR (fetch CLNAME
of LOOKS)
(FONTPROP
(fetch CLFONT
of LOOKS)
(QUOTE FAMILY]
" "
(fetch CLSIZE of LOOKS)
(if (fetch CLBOLD of LOOKS)
then (QUOTE BOLD)
" bold"
else "")
(if (fetch CLITAL of LOOKS)
then " italic"
else "")))
T)
(RETURN NIL])
(WRITE.CHARDESC.AUX
[LAMBDA (TOKENS) (* gbn "10-Oct-85 00:20")
(if (EQ (LENGTH TOKENS)
1)
then (CONS (CAR TOKENS)
NIL)
else (SELECTQ (CAR TOKENS)
[# (CONS "meta " (WRITE.CHARDESC.AUX (if (AND (CDR TOKENS)
(EQ (CADR TOKENS)
(QUOTE #)))
then (CDDR TOKENS]
[↑ (CONS "control " (WRITE.CHARDESC.AUX (CDR TOKENS]
(ERROR CHARDESC " is a misunderstood character descriptor"])
(CHARDESC
[LAMBDA (CHARDESC) (* gbn " 7-Nov-84 14:21")
(* takes a description in the form taken as input to
charcode and writes out a human readable form)
(PACK (WRITE.CHARDESC.AUX (UNPACK CHARDESC])
(TEDITKEY.CONFIGURE
[LAMBDA NIL (* gbn " 5-Nov-84 18:58")
(PROMPTPRINT "not implemented"])
(\TK.ADDKEY
[LAMBDA (TRIPLE) (* gbn " 5-Nov-84 18:41")
(* dummy for now)
])
(\TK.CHANGEKEY
[LAMBDA (THIS) (* gbn " 5-Nov-84 18:42")
(* DUMMY)
])
(\TK.APPLYPENDING
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "10-Dec-84 15:58")
(* * takes the entries on \TK.PENDING, reverses them and applies them as incremental changes to the selection.)
(PROG ((PENDING (DREVERSE \TK.PENDING))
(LOOKS (LIST NIL)))
(for ENTRY in PENDING do (SELECTQ ENTRY
(BOLDON (LISTPUT LOOKS (QUOTE WEIGHT)
(QUOTE BOLD)))
(BOLDOFF (LISTPUT LOOKS (QUOTE WEIGHT)
(QUOTE MEDIUM)))
(ITALICON (LISTPUT LOOKS (QUOTE SLOPE)
(QUOTE ITALIC)))
(ITALICOFF (LISTPUT LOOKS (QUOTE SLOPE)
(QUOTE REGULAR)))
(UNDERLINEON (LISTPUT LOOKS (QUOTE UNDERLINE)
(QUOTE ON)))
(UNDERLINEOFF (LISTPUT LOOKS (QUOTE UNDERLINE)
(QUOTE OFF)))
(SUPERSCRIPT (* nothing for the moment)
NIL)
(SUBSCRIPT (* nothing for the moment)
NIL)
(LARGER (* nothing for the moment)
NIL)
(SMALLER (* nothing for the moment)
NIL)
(DEFAULTS (SETQ LOOKS (\TEDIT.UNPARSE.CHARLOOKS.LIST
TEDIT.DEFAULT.CHARLOOKS)))
((TIMESROMAN HELVETICA GACHA MODERN CLASSIC TERMINAL
HIPPO MATH)
(LISTPUT LOOKS (QUOTE FAMILY)
ENTRY))
(\LISPERROR "Illegal pending operation in \TK.PENDING"
ENTRY)))
(SETQ \TK.PENDING NIL)
(RETURN (TEDIT.LOOKS TEXTSTREAM LOOKS SEL])
(\TK.NTHFONT
[LAMBDA (N) (* gbn "27-Jan-85 17:51")
(* returns the name of the nth teditkey font)
(CAR (NTH TEDITKEY.FONTS N])
)
(* redefinition of system junk)
(DEFINEQ
(METASHIFT
[LAMBDA FLG (* gbn " 6-Mar-85 15:43")
(* Sets interpretation of TEDITKEY.METAKEY key to first
arg, where T means meta-shift, NIL means original
setting. Returns previous setting)
(PROG ((METASTATUS (QUOTE (METADOWN . METAUP)))
OLDSETTING)
[SETQ OLDSETTING (KEYACTION TEDITKEY.METAKEY
(AND (IGREATERP FLG 0)
(COND
((EQ (ARG FLG 1)
T)
METASTATUS)
(T (OR (ARG FLG 1)
(CDR (ASSOC TEDITKEY.METAKEY \ORIGKEYACTIONS]
(RETURN (COND
((EQUAL OLDSETTING METASTATUS)
T)
(T OLDSETTING])
)
(* (\TK.BOLDTOGGLE (##H ##h) "toggle Bold caret looks") (\TK.ITALICTOGGLE (##i ##I)
"toggle Italic caret looks") (\TK.SUPERSCRIPT.CARET (##↑) "Superscript the caret looks") (
\TK.SUBSCRIPT.CARET (##←) "Subscript the caret looks"))
(DEFINEQ
(TEDIT.FULL.FIND
[LAMBDA (TEXTSTREAM SEARCHSTRING) (* gbn " 8-Mar-85 12:56")
(PROG (TARGET (TEXTOBJ (TEXTOBJ TEXTSTREAM))
SEL CH W) (* Case sensitive search, with * and # wildcards)
[SETQ W (CAR (MKLIST (fetch \WINDOW of TEXTOBJ]
[SETQ TARGET (OR SEARCHSTRING (TEDIT.GETINPUT TEXTOBJ "Text to find: " (WINDOWPROP
W
(QUOTE TEDIT.LAST.FIND.STRING))
(CHARCODE (EOL LF ESC]
[COND
(TARGET (SETQ SEL (fetch SEL of TEXTOBJ))
(\SHOWSEL SEL NIL NIL)
(TEDIT.PROMPTPRINT TEXTOBJ "Searching..." T)
(SETQ CH (TEDIT.FIND TEXTOBJ (MKSTRING TARGET)
NIL NIL T))
(COND
(CH (* We found the target text.)
(TEDIT.PROMPTPRINT TEXTOBJ "Done.")
(replace CH# of SEL with (CAR CH))
(* Set up SELECTION to be the found text)
(replace CHLIM of SEL with (ADD1 (CADR CH)))
[replace DCH of SEL with (ADD1 (IDIFFERENCE (CADR CH)
(CAR CH]
(replace POINT of SEL with (QUOTE RIGHT))
(replace CARETLOOKS of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ
SEL))
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL)
(* And never pending a deletion.)
(\FIXSEL SEL TEXTOBJ)
(TEDIT.NORMALIZECARET TEXTOBJ)
(\SHOWSEL SEL NIL T)
(WINDOWPROP W (QUOTE TEDIT.LAST.FIND.STRING)
TARGET) (* And get it into the window)
)
(T (TEDIT.PROMPTPRINT TEXTOBJ "(not found)")
(\SHOWSEL SEL NIL T]
(replace \INSERTNEXTCH of TEXTOBJ with -1])
)
(RPAQQ \TK.WHITESPACE 22)
(RPAQ TEDIT.INTERRUPTS (BQUOTE ((, (CHARCODE ↑G)
ERROR)
(, (CHARCODE ↑C)
HELP))))
(DECLARE: EVAL@COMPILE
(RPAQQ \TK.WHITESPACE 22)
(CONSTANTS (\TK.WHITESPACE 22))
)
(RPAQ? TEDITKEY.VERBOSE T)
(RPAQ? TEDITKEY.METAKEY (QUOTE TAB))
(RPAQ? TEDITKEY.LOCKTOGGLEKEY NIL)
(RPAQ? TEDITKEY.NESTWIDTH 36)
(RPAQ? \TK.SIZEINCREMENT 2)
(RPAQ? TEDITKEY.OFFSETINCREMENT 3)
(RPAQ? TEDITKEY.FONTS (QUOTE (TIMESROMAN HELVETICA GACHA MODERN CLASSIC TERMINAL SYMBOL HIPPO)))
(RPAQ? TEDITKEY.FNKEYFLG T)
(DECLARE: EVAL@COMPILE
[PUTPROPS METACODE MACRO (LAMBDA (CHARCODE)
(LOGOR CHARCODE 128]
[PUTPROPS CONTROLCODE MACRO (LAMBDA (CHARCODE)
(LOGAND CHARCODE 31]
[PUTPROPS LCMETACODE MACRO (LAMBDA (CHARCODE)
(LOGOR 160 CHARCODE]
)
(RPAQ? \TK.SELKEY (QUOTE OPEN))
(RPAQ? \TK.PENDING )
(RPAQ? TEDITKEY.KEYBINDINGS (BQUOTE ((\TK.FONT1 (##1)
,
(CONCAT "change to font " (\TK.NTHFONT 1)))
(\TK.FONT2 (##2)
,
(CONCAT "change to font " (\TK.NTHFONT 2)))
(\TK.FONT3 (##3)
,
(CONCAT "change to font " (\TK.NTHFONT 3)))
(\TK.FONT4 (##4)
,
(CONCAT "change to font " (\TK.NTHFONT 4)))
(\TK.FONT5 (##5)
,
(CONCAT "change to font " (\TK.NTHFONT 5)))
(\TK.FONT6 (##6)
,
(CONCAT "change to font " (\TK.NTHFONT 6)))
(\TK.FONT7 (##7)
,
(CONCAT "change to font " (\TK.NTHFONT 7)))
(\TK.FONT8 (##8)
,
(CONCAT "change to font " (\TK.NTHFONT 8)))
NIL
(\TK.DEFAULTS.CARET (##/)
"restore the default caret looks")
(\TK.SMALLER.CARET (##9)
"decrease the caret font size")
(\TK.LARGER.CARET (##0)
"increase the caret font size")
(\TK.SHOWCARETLOOKS (##=)
"display the current caret looks")
NIL
(\TK.REDISPLAY (##R ##r)
"Restore the display")
(\TK.HELP (##?)
"displays the current key bindings")
NIL
(\TK.PREVCHAR (↑B ↑b)
"Back one character")
(\TK.NEXTCHAR (↑F ↑f)
"Forward one character")
(\TK.FORWARD.WORD (##F ##f)
"Forward one word")
(\TK.BACK.WORD (##B ##b)
"Back one word")
(\TK.GOTOLINEBEGIN (↑A ↑a)
"go to stArt of line")
(\TK.GOTOLINEEND (↑E ↑e)
"go to End of line")
(\TK.PREVLINE (↑P ↑p)
"go to Previous line")
(\TK.NEXTLINE (↑N ↑n)
"go to Next line")
(\TK.GOTODOCBEGIN (##<)
"start of document")
(\TK.GOTODOCEND (##>)
"end of document")
(\TK.SELECT.ALL (##S ##s)
"Select whole document")
NIL
(\TK.DELLINEFORWARD (↑K ↑k)
"Kill line")
(\TK.OPENLINE (↑O ↑o)
"Open up blank line")
(\TK.DELCHARFORWARD (↑D ↑d)
"Delete character forward")
(\TK.DEL.WORD.FORWARD (##D ##d)
"Delete word forward")
(\TK.TRANSPOSECHARS (↑T ↑t)
"Transpose characters")
NIL NIL (\TK.NEST (##%[)
"indents margins (nest)")
(\TK.UNNEST (##%])
"exdents margins (unnest)")
(\TK.CENTER.SEL (##J ##j)
"alter Justification")
(\TK.UCASE.SEL (##U ##u)
"Uppercasify selection")
(\TK.CAPITALISE.SEL (##C ##c)
"Capitalize selection")
(\TK.LCASE.SEL (##L ##l)
"Lowercasify selection")
(GET.OBJ.FROM.USER (##O ##o)
"insert Object"))))
(RPAQ? TEDITKEY.DLION.KEYACTIONS (BQUOTE ((STOP (, (CHARCODE ↑G)
,
(CHARCODE ↑C)
NOLOCKSHIFT))
(OPEN (, (CHARCODE 2,1)
,
(CHARCODE 2,41)
NOLOCKSHIFT))
(FONT FONTDOWN . FONTUP)
(KEYBOARD USERMODE1DOWN . USERMODE1UP))))
(RPAQ? COMS [* (TEDITKEY.FNKEYACTIONS (BQUOTE ((CENTER (, (CHARCODE ##↑B)
,
(CHARCODE ##↑C)))
(BOLD (, (CHARCODE ##↑D)
,
(CHARCODE ##↑E)
NOLOCKSHIFT))
(ITALICS (, (CHARCODE ##↑F)
,
(CHARCODE ##↑G)
NOLOCKSHIFT))
(UNDERLINE (, (CHARCODE ##↑H)
,
(CHARCODE ##↑I)
NOLOCKSHIFT))
(SUPERSCRIPT (, (CHARCODE ##↑J)
,
(CHARCODE ##↑K)
NOLOCKSHIFT))
(SUBSCRIPT (, (CHARCODE ##↑L)
,
(CHARCODE ##↑N)
NOLOCKSHIFT))
(LARGER (, (CHARCODE ##↑O)
,
(CHARCODE ##↑P)
NOLOCKSHIFT))
(DEFAULTS (, (CHARCODE ##↑Q)
,
(CHARCODE ##↑R)
NOLOCKSHIFT))
(BS (, (CHARCODE ↑H)
,
(CHARCODE ↑D)
NOLOCKSHIFT])
(RPAQ? TEDITKEY.DLION.KEYBINDINGS (QUOTE (((\ACTION (QUOTE OPEN))
\TK.OPENLINE)
((\ACTION (QUOTE HELP))
\TK.HELP)
((\ACTION (QUOTE MARGINS))
\TK.NEST)
((\SHIFTACTION (QUOTE MARGINS))
\TK.UNNEST)
((\SHIFTACTION (QUOTE NEXT))
GOTONEXTTTYWINDOW))))
(RPAQ? TEDITKEY.FNKEYBINDINGS (QUOTE (((\ACTION (QUOTE DEFAULTS))
\TK.DEFAULTSSEL)
((\SHIFTACTION (QUOTE DEFAULTS))
\TK.SETDEFAULTLOOKS))))
(RPAQ? COMS [* NOT NEEDED (TEDITKEY.DLION.KEYSYNTAX (QUOTE (((\ACTION (QUOTE NEXT))
NEXT)
((\ACTION (QUOTE UNDO))
UNDO)
((\ACTION (QUOTE BS))
CHARDELETE])
(RPAQ? TEDITKEY.DORADO.KEYACTIONS [BQUOTE ((BS (, (CHARCODE ↑H)
,
(CHARCODE ↑H)))
(BLANK-BOTTOM (, (CHARCODE ##↑A)
,
(CHARCODE ##↑A)))
(BLANK-TOP FONTDOWN . FONTUP)
(BLANK-MIDDLE USERMODE1DOWN . USERMODE1UP)
(CENTER (2,101 2,141 NOLOCKSHIFT))
(BOLD (2,102 2,142 NOLOCKSHIFT))
(ITALICS (2,103 2,143 NOLOCKSHIFT))
(UNDERLINE (2,106 2,146 NOLOCKSHIFT))
(SUPERSCRIPT (2,113 2,153 NOLOCKSHIFT))
(SUBSCRIPT (2,114 2,154 NOLOCKSHIFT))
(LARGER (2,110 2,150 NOLOCKSHIFT))
(DEFAULTS (2,115 2,155 NOLOCKSHIFT])
(RPAQ? TEDITKEY.DORADO.KEYSYNTAX (QUOTE (((CHARCODE ##N)
NEXT)
((CHARCODE ##n)
NEXT)
((\ACTION (QUOTE BLANK-BOTTOM))
UNDO)
((\ACTION (QUOTE BS))
CHARDELETE))))
(TEDITKEY.INSTALL)
(\TK.BUILD.MENU)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA METASHIFT)
)
(PUTPROPS TEDITKEY COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (18657 31898 (NTHCAR 18667 . 18802) (\TEXTOBJ.WINDEX 18804 . 19335) (\TK.PREVSCREEN
19337 . 20903) (\TK.UNDERLINE.SEL.ON 20905 . 21471) (\TK.UNDERLINE.SEL.OFF 21473 . 22042) (
\TK.BOLD.SEL.ON 22044 . 22740) (\TK.BOLD.SEL.OFF 22742 . 23442) (\TK.ITALIC.SEL.ON 23444 . 23832) (
\TK.ITALIC.SEL.OFF 23834 . 24225) (\TK.SMALLERSEL 24227 . 24983) (\TK.LARGERSEL 24985 . 25721) (
\TK.SUPERSCRIPTSEL 25723 . 26483) (\TK.SUBSCRIPTSEL 26485 . 27253) (\TK.DEFAULTSSEL 27255 . 27974) (
\TK.DEL.WORD.FORWARD 27976 . 29556) (\TK.UCASE.SEL 29558 . 30127) (\TK.CAPITALISE.SEL 30129 . 30919) (
\CAPITALISE 30921 . 31325) (\TK.LCASE.SEL 31327 . 31896)) (31966 36188 (\TK.CENTER.SEL 31976 . 33107)
(\TK.CENTER.SEL.REV 33109 . 34229) (\TK.NEST 34231 . 35123) (\TK.UNNEST 35125 . 36186)) (36268 45341 (
\TK.SHOWCARETLOOKS 36278 . 37076) (\TK.BOLD.CARET.ON 37078 . 37601) (\TK.BOLD.CARET.OFF 37603 . 38129)
(\TK.ITALIC.CARET.ON 38131 . 38656) (\TK.ITALIC.CARET.OFF 38658 . 39186) (\TK.UNDERLINE.CARET.ON
39188 . 39632) (\TK.UNDERLINE.CARET.OFF 39634 . 40081) (\TK.SUPERSCRIPT.CARET 40083 . 40695) (
\TK.SUBSCRIPT.CARET 40697 . 41333) (\TK.SMALLER.CARET 41335 . 41948) (\TK.LARGER.CARET 41950 . 42547)
(\TK.DEFAULTS.CARET 42549 . 42868) (\TK.FONT1 42870 . 43050) (\TK.FONT2 43052 . 43232) (\TK.FONT3
43234 . 43414) (\TK.SETCARETFONT 43416 . 44429) (\TK.FONT4 44431 . 44611) (\TK.FONT5 44613 . 44793) (
\TK.FONT6 44795 . 44975) (\TK.FONT7 44977 . 45157) (\TK.FONT8 45159 . 45339)) (45426 47358 (
\TK.BOLDTOGGLE 45436 . 46141) (\TK.ITALICTOGGLE 46143 . 46793) (\TK.UNDERLINETOGGLE 46795 . 47356)) (
47412 47874 (\TK.SETDEFAULTLOOKS 47422 . 47872)) (47931 59242 (GOTONEXTTTYWINDOW 47941 . 49264) (
\TK.NEXTLINE 49266 . 50808) (\TK.PREVLINE 50810 . 52482) (\TK.GOTODOCBEGIN 52484 . 52780) (
\TK.GOTODOCEND 52782 . 53138) (\TK.GOTOLINEBEGIN 53140 . 53696) (\TK.GOTOLINEEND 53698 . 54480) (
\TK.PREVCHAR 54482 . 55013) (\TK.NEXTCHAR 55015 . 55595) (\TK.FORWARD.WORD 55597 . 57139) (
\TK.BACK.WORD 57141 . 58750) (\TK.SELECT.ALL 58752 . 59240)) (59271 62316 (\TK.FIND 59281 . 59593) (
\TK.REDISPLAY 59595 . 59856) (\TK.DELLINEFORWARD 59858 . 60426) (\TK.OPENLINE 60428 . 60643) (
\TK.DELCHARFORWARD 60645 . 61018) (\TK.TRANSPOSECHARS 61020 . 62314)) (62381 65943 (\SEL.LIMIT 62391
. 62848) (\TK.SETFILEPTR.TO.CARET 62850 . 63317) (\SEL.LINEDESC 63319 . 63759) (\TK.DESCRIBEFONT
63761 . 64495) (\PARAS.IN.SEL 64497 . 65941)) (67365 83798 (\SHIFTACTION 67375 . 67680) (\ACTION 67682
. 67983) (TEDITKEY.INSTALL 67985 . 76549) (TEDITKEY.DEINSTALL 76551 . 76830) (\TK.ACTIONTOCHARCODE
76832 . 77355) (\TK.BUILD.MENU 77357 . 78444) (\TK.HELP 78446 . 78691) (\TK.SETFONTINLOOKS 78693 .
80385) (WRITE.CHARDESC.AUX 80387 . 80971) (CHARDESC 80973 . 81324) (TEDITKEY.CONFIGURE 81326 . 81481)
(\TK.ADDKEY 81483 . 81679) (\TK.CHANGEKEY 81681 . 81872) (\TK.APPLYPENDING 81874 . 83535) (\TK.NTHFONT
83537 . 83796)) (83839 84670 (METASHIFT 83849 . 84668)) (84911 86924 (TEDIT.FULL.FIND 84921 . 86922))
)))
STOP