(FILECREATED " 8-May-85 23:03:53" {IVY}<TEDIT>TEDITKEY.;54 78849
changes to: (VARS TEDITKEYCOMS)
(FNS TEDITKEY.INSTALL)
previous date: "20-Mar-85 00:53:08" {IVY}<TEDIT>TEDITKEY.;52)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TEDITKEYCOMS)
(RPAQQ TEDITKEYCOMS [(COMS (* * This is the Jazz <lc>n> version of TEditKey))
(COMS (* functions for affecting the selection)
(FNS \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.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))
(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 \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 #↑Z)
ERROR)
(, (CHARCODE #↑S)
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")
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.LCASE.SEL (#L #l)
"Lowercasify selection")
(GET.OBJ.FROM.USER (#O #o)
"insert Object"]
[TEDITKEY.DLION.KEYACTIONS (BQUOTE ((OPEN (, (CHARCODE LF)
,
(CHARCODE LF)
NOLOCKSHIFT))
(SAME METADOWN . METAUP)
(FIND (, (CHARCODE #↑A)
,
(CHARCODE #↑A)))
(AGAIN (, (CHARCODE ESC)
,
(CHARCODE ESC)))
(COPY NIL)
(MOVE NIL)
(NEXT (, (CHARCODE #↑U)
,
(CHARCODE #↑T)
NOLOCKSHIFT))
(EXPAND (, (CHARCODE ↑X)
,
(CHARCODE ↑X)
NOLOCKSHIFT))
(UNDO (, (CHARCODE #↑V)
,
(CHARCODE #↑V)
NOLOCKSHIFT))
(MARGINS (, (CHARCODE #↑W)
,
(CHARCODE #↑X)
NOLOCKSHIFT))
(HELP (, (CHARCODE #↑Y)
,
(CHARCODE #↑Y)
NOLOCKSHIFT))
(STOP (, (CHARCODE #↑Z)
,
(CHARCODE #↑S)
NOLOCKSHIFT))
(FONT FONTDOWN . FONTUP)
(KEYBOARD USERMODE1DOWN . USERMODE1UP)
(ESC (, (CHARCODE \)
,
(CHARCODE %|)
NOLOCKSHIFT]
[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 FIND))
\TK.FIND)
((\ACTION (QUOTE HELP))
\TK.HELP)
((\ACTION (QUOTE MARGINS))
\TK.NEST)
((\SHIFTACTION (QUOTE MARGINS))
\TK.UNNEST)
((\SHIFTACTION (QUOTE NEXT))
GOTONEXTTTYWINDOW]
[TEDITKEY.FNKEYBINDINGS (QUOTE (((\ACTION (QUOTE CENTER))
\TK.CENTER.SEL)
((\SHIFTACTION (QUOTE CENTER))
\TK.CENTER.SEL.REV)
((\ACTION (QUOTE BOLD))
\TK.BOLD.SEL.ON)
((\SHIFTACTION (QUOTE BOLD))
\TK.BOLD.SEL.OFF)
((\ACTION (QUOTE ITALICS))
\TK.ITALIC.SEL.ON)
((\SHIFTACTION (QUOTE ITALICS))
\TK.ITALIC.SEL.OFF)
((\ACTION (QUOTE UNDERLINE))
\TK.UNDERLINE.SEL.ON)
((\SHIFTACTION (QUOTE UNDERLINE))
\TK.UNDERLINE.SEL.OFF)
((\ACTION (QUOTE SUPERSCRIPT))
\TK.SUPERSCRIPTSEL)
((\SHIFTACTION (QUOTE SUPERSCRIPT))
\TK.SUBSCRIPTSEL)
((\ACTION (QUOTE SUBSCRIPT))
\TK.SUBSCRIPTSEL)
((\SHIFTACTION (QUOTE SUBSCRIPT))
\TK.SUPERSCRIPTSEL)
((\ACTION (QUOTE SMALLER))
\TK.SMALLERSEL)
((\SHIFTACTION (QUOTE SMALLER))
\TK.LARGERSEL)
((\ACTION (QUOTE DEFAULTS))
\TK.DEFAULTSSEL)
((\SHIFTACTION (QUOTE DEFAULTS))
\TK.SETDEFAULTLOOKS)
((\SHIFTACTION (QUOTE BS))
\TK.DELCHARFORWARD]
[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]
(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 Jazz <lc>n> version of TEditKey)
(* functions for affecting the selection)
(DEFINEQ
(\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.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 (STREAM TEXTOBJ SEL) (* gbn "27-Feb-85 18:19")
(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 "11-Mar-85 14:53")
(* 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 (CAR (MKLIST (fetch LN of 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 is 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)))
(fetch CHARLIM of NEXT))
0
(if (fetch CR\END of NEXT)
then (QUOTE LEFT)
else (QUOTE RIGHT])
(\TK.PREVLINE
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "19-Mar-85 12:08")
(* 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 (fetch LINES of TEXTOBJ)
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 "16-Dec-84 22:17")
(* positions at the end of a document)
(TEDIT.SETSEL STREAM (fetch TEXTLEN of TEXTOBJ)
0
(QUOTE RIGHT))
(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 "11-Mar-85 15:00")
(* * 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 0 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])
)
(* 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 "16-Feb-85 23:20")
(* returns the first line descriptor if the point is
left, otherwise the last)
(if (EQ (fetch POINT of SEL)
(QUOTE LEFT))
then (CAR (MKLIST (fetch L1 of SEL)))
else (CAR (MKLIST (fetch LN 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 "27-Feb-85 18:08")
(* returns a list which contains one character number
for each paragraph included in the selection)
(PROG ((PARAS)
PARAENDED PCS (POS (fetch CH# of SEL)))
(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 " 7-May-85 17:16")
(* * 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"]
(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]
(MODIFY.KEYACTIONS TEDITKEY.FNKEYACTIONS)
(for PAIR in TEDITKEY.FNKEYBINDINGS do (TEDIT.SETFUNCTION (EVAL (CAR PAIR))
(CADR PAIR)
READTABLE))
(* install these even on the alto keyboards so that
DLIONFNKEYS can fake them in the window)
(PROGN (* install the nextttywindow hack)
(INTERRUPTCHAR (CHARCODE #↑T)
(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)
(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 (CHARCODE #↑T)
(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))
(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU FNKEYITEM)))
(if (NEQ (MACHINETYPE)
(QUOTE DANDELION))
then (* 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))) (* 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"
])
(\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 "15-Dec-84 17:50")
(* * rebuilds the font field of looks according to the values in the fields)
(PROG (NEWFONT)
[SETQ NEWFONT (NLSETQ (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]
(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 "16-Dec-84 23:02")
(if (EQ (LENGTH TOKENS)
1)
then (CONS (CAR TOKENS)
NIL)
else (SELECTQ (CAR TOKENS)
[# (CONS "meta " (WRITE.CHARDESC.AUX (CDR 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 #↑Z)
ERROR)
(, (CHARCODE #↑S)
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")
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.LCASE.SEL (#L #l)
"Lowercasify selection")
(GET.OBJ.FROM.USER (#O #o)
"insert Object"))))
(RPAQ? TEDITKEY.DLION.KEYACTIONS [BQUOTE ((OPEN (, (CHARCODE LF)
,
(CHARCODE LF)
NOLOCKSHIFT))
(SAME METADOWN . METAUP)
(FIND (, (CHARCODE #↑A)
,
(CHARCODE #↑A)))
(AGAIN (, (CHARCODE ESC)
,
(CHARCODE ESC)))
(COPY NIL)
(MOVE NIL)
(NEXT (, (CHARCODE #↑U)
,
(CHARCODE #↑T)
NOLOCKSHIFT))
(EXPAND (, (CHARCODE ↑X)
,
(CHARCODE ↑X)
NOLOCKSHIFT))
(UNDO (, (CHARCODE #↑V)
,
(CHARCODE #↑V)
NOLOCKSHIFT))
(MARGINS (, (CHARCODE #↑W)
,
(CHARCODE #↑X)
NOLOCKSHIFT))
(HELP (, (CHARCODE #↑Y)
,
(CHARCODE #↑Y)
NOLOCKSHIFT))
(STOP (, (CHARCODE #↑Z)
,
(CHARCODE #↑S)
NOLOCKSHIFT))
(FONT FONTDOWN . FONTUP)
(KEYBOARD USERMODE1DOWN . USERMODE1UP)
(ESC (, (CHARCODE \)
,
(CHARCODE %|)
NOLOCKSHIFT])
(RPAQ? 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 FIND))
\TK.FIND)
((\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 CENTER))
\TK.CENTER.SEL)
((\SHIFTACTION (QUOTE CENTER))
\TK.CENTER.SEL.REV)
((\ACTION (QUOTE BOLD))
\TK.BOLD.SEL.ON)
((\SHIFTACTION (QUOTE BOLD))
\TK.BOLD.SEL.OFF)
((\ACTION (QUOTE ITALICS))
\TK.ITALIC.SEL.ON)
((\SHIFTACTION (QUOTE ITALICS))
\TK.ITALIC.SEL.OFF)
((\ACTION (QUOTE UNDERLINE))
\TK.UNDERLINE.SEL.ON)
((\SHIFTACTION (QUOTE UNDERLINE))
\TK.UNDERLINE.SEL.OFF)
((\ACTION (QUOTE SUPERSCRIPT))
\TK.SUPERSCRIPTSEL)
((\SHIFTACTION (QUOTE SUPERSCRIPT))
\TK.SUBSCRIPTSEL)
((\ACTION (QUOTE SUBSCRIPT))
\TK.SUBSCRIPTSEL)
((\SHIFTACTION (QUOTE SUBSCRIPT))
\TK.SUPERSCRIPTSEL)
((\ACTION (QUOTE SMALLER))
\TK.SMALLERSEL)
((\SHIFTACTION (QUOTE SMALLER))
\TK.LARGERSEL)
((\ACTION (QUOTE DEFAULTS))
\TK.DEFAULTSSEL)
((\SHIFTACTION (QUOTE DEFAULTS))
\TK.SETDEFAULTLOOKS)
((\SHIFTACTION (QUOTE BS))
\TK.DELCHARFORWARD))))
(RPAQ? 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))))
(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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (10755 20560 (\TK.UNDERLINE.SEL.ON 10765 . 11331) (\TK.UNDERLINE.SEL.OFF 11333 . 11902)
(\TK.BOLD.SEL.ON 11904 . 12600) (\TK.BOLD.SEL.OFF 12602 . 13302) (\TK.ITALIC.SEL.ON 13304 . 13692) (
\TK.ITALIC.SEL.OFF 13694 . 14085) (\TK.SMALLERSEL 14087 . 14843) (\TK.LARGERSEL 14845 . 15581) (
\TK.SUPERSCRIPTSEL 15583 . 16343) (\TK.SUBSCRIPTSEL 16345 . 17113) (\TK.DEFAULTSSEL 17115 . 17834) (
\TK.DEL.WORD.FORWARD 17836 . 19416) (\TK.UCASE.SEL 19418 . 19987) (\TK.LCASE.SEL 19989 . 20558)) (
20628 24846 (\TK.CENTER.SEL 20638 . 21769) (\TK.CENTER.SEL.REV 21771 . 22887) (\TK.NEST 22889 . 23781)
(\TK.UNNEST 23783 . 24844)) (24926 33999 (\TK.SHOWCARETLOOKS 24936 . 25734) (\TK.BOLD.CARET.ON 25736
. 26259) (\TK.BOLD.CARET.OFF 26261 . 26787) (\TK.ITALIC.CARET.ON 26789 . 27314) (\TK.ITALIC.CARET.OFF
27316 . 27844) (\TK.UNDERLINE.CARET.ON 27846 . 28290) (\TK.UNDERLINE.CARET.OFF 28292 . 28739) (
\TK.SUPERSCRIPT.CARET 28741 . 29353) (\TK.SUBSCRIPT.CARET 29355 . 29991) (\TK.SMALLER.CARET 29993 .
30606) (\TK.LARGER.CARET 30608 . 31205) (\TK.DEFAULTS.CARET 31207 . 31526) (\TK.FONT1 31528 . 31708) (
\TK.FONT2 31710 . 31890) (\TK.FONT3 31892 . 32072) (\TK.SETCARETFONT 32074 . 33087) (\TK.FONT4 33089
. 33269) (\TK.FONT5 33271 . 33451) (\TK.FONT6 33453 . 33633) (\TK.FONT7 33635 . 33815) (\TK.FONT8
33817 . 33997)) (34084 36016 (\TK.BOLDTOGGLE 34094 . 34799) (\TK.ITALICTOGGLE 34801 . 35451) (
\TK.UNDERLINETOGGLE 35453 . 36014)) (36070 36532 (\TK.SETDEFAULTLOOKS 36080 . 36530)) (36589 47307 (
GOTONEXTTTYWINDOW 36599 . 37922) (\TK.NEXTLINE 37924 . 39559) (\TK.PREVLINE 39561 . 41047) (
\TK.GOTODOCBEGIN 41049 . 41345) (\TK.GOTODOCEND 41347 . 41693) (\TK.GOTOLINEBEGIN 41695 . 42251) (
\TK.GOTOLINEEND 42253 . 43035) (\TK.PREVCHAR 43037 . 43568) (\TK.NEXTCHAR 43570 . 44150) (
\TK.FORWARD.WORD 44152 . 45694) (\TK.BACK.WORD 45696 . 47305)) (47336 50381 (\TK.FIND 47346 . 47658) (
\TK.REDISPLAY 47660 . 47921) (\TK.DELLINEFORWARD 47923 . 48491) (\TK.OPENLINE 48493 . 48708) (
\TK.DELCHARFORWARD 48710 . 49083) (\TK.TRANSPOSECHARS 49085 . 50379)) (50446 53500 (\SEL.LIMIT 50456
. 50913) (\TK.SETFILEPTR.TO.CARET 50915 . 51382) (\SEL.LINEDESC 51384 . 51848) (\TK.DESCRIBEFONT
51850 . 52584) (\PARAS.IN.SEL 52586 . 53498)) (54289 67815 (\SHIFTACTION 54299 . 54604) (\ACTION 54606
. 54907) (TEDITKEY.INSTALL 54909 . 61009) (\TK.ACTIONTOCHARCODE 61011 . 61534) (\TK.BUILD.MENU 61536
. 62623) (\TK.HELP 62625 . 62870) (\TK.SETFONTINLOOKS 62872 . 64522) (WRITE.CHARDESC.AUX 64524 .
64988) (CHARDESC 64990 . 65341) (TEDITKEY.CONFIGURE 65343 . 65498) (\TK.ADDKEY 65500 . 65696) (
\TK.CHANGEKEY 65698 . 65889) (\TK.APPLYPENDING 65891 . 67552) (\TK.NTHFONT 67554 . 67813)) (67856
68687 (METASHIFT 67866 . 68685)) (68922 70935 (TEDIT.FULL.FIND 68932 . 70933)))))
STOP