(FILECREATED "12-Mar-85 14:28:07" {IVY}<TEDIT>TEDITKEY.;51 77922
changes to: (FNS \TK.REDISPLAY \TK.TRANSPOSECHARS \TK.NEXTLINE \TK.PREVLINE \TK.GOTOLINEEND
\TK.GOTOLINEBEGIN \TK.NEXTCHAR)
previous date: " 8-Mar-85 12:59:37" {IVY}<TEDIT>TEDITKEY.;48)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TEDITKEYCOMS)
(RPAQQ TEDITKEYCOMS [(COMS (* * This is the intermezzo release 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 \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 #↑U)
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]
[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 intermezzo release version of TEditKey)
(* functions for affecting the selection)
(DEFINEQ
(\TK.UNDERLINE.SEL.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 18:08")
(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)
(PROG [(LOOKS (TEDIT.GET.LOOKS TEXTOBJ (fetch CH# of SEL]
(LISTPUT LOOKS (QUOTE UNDERLINE)
(QUOTE ON))
(TEDIT.LOOKS TEXTSTREAM LOOKS SEL)
(RETURN (TEDIT.CARETLOOKS TEXTSTREAM LOOKS])
(\TK.UNDERLINE.SEL.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 22:23")
(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)
(PROG [(LOOKS (TEDIT.GET.LOOKS TEXTOBJ (fetch CH# of SEL]
(LISTPUT LOOKS (QUOTE UNDERLINE)
(QUOTE OFF))
(TEDIT.LOOKS TEXTSTREAM LOOKS SEL)
(RETURN (TEDIT.CARETLOOKS TEXTSTREAM LOOKS])
(\TK.BOLD.SEL.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 20:54")
(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)
(PROG [(LOOKS (TEDIT.GET.LOOKS TEXTOBJ (fetch CH# of SEL]
(LISTPUT LOOKS (QUOTE WEIGHT)
(QUOTE BOLD))
(TEDIT.LOOKS TEXTSTREAM LOOKS SEL)
(RETURN (TEDIT.CARETLOOKS TEXTSTREAM LOOKS])
(\TK.BOLD.SEL.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* gbn "16-Feb-85 22:16")
(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)
(PROG [(LOOKS (TEDIT.GET.LOOKS TEXTOBJ (fetch CH# of SEL]
(LISTPUT LOOKS (QUOTE WEIGHT)
(QUOTE MEDIUM))
(TEDIT.LOOKS TEXTSTREAM LOOKS SEL)
(RETURN (TEDIT.CARETLOOKS TEXTSTREAM LOOKS])
(\TK.ITALIC.SEL.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "16-Feb-85 22:03")
(COND
((SHIFTDOWNP (QUOTE FONT))
(\TK.FONT3 TEXTSTREAM TEXTOBJ SEL))
((SHIFTDOWNP (QUOTE USERMODE1))
(\TK.ITALIC.CARET.ON TEXTSTREAM TEXTOBJ SEL))
(T (PROG [(LOOKS (TEDIT.GET.LOOKS TEXTOBJ (fetch CH# of SEL]
(LISTPUT LOOKS (QUOTE SLOPE)
(QUOTE ITALIC))
(TEDIT.LOOKS TEXTSTREAM LOOKS SEL)
(RETURN (TEDIT.CARETLOOKS TEXTSTREAM LOOKS])
(\TK.ITALIC.SEL.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* gbn "16-Feb-85 22:03")
(COND
((SHIFTDOWNP (QUOTE FONT))
(\TK.FONT3 TEXTSTREAM TEXTOBJ SEL))
((SHIFTDOWNP (QUOTE USERMODE1))
(\TK.ITALIC.CARET.OFF TEXTSTREAM TEXTOBJ SEL))
(T (PROG [(LOOKS (TEDIT.GET.LOOKS TEXTOBJ (fetch CH# of SEL]
(LISTPUT LOOKS (QUOTE SLOPE)
(QUOTE REGULAR))
(TEDIT.LOOKS TEXTSTREAM LOOKS SEL)
(RETURN (TEDIT.CARETLOOKS TEXTSTREAM LOOKS])
(\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 "23-Feb-85 16:06")
(* * 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])
(\TK.UCASE.SEL
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "23-Feb-85 17:07")
(* 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])
(\TK.LCASE.SEL
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "23-Feb-85 17:08")
(* 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])
)
(* 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 "16-Feb-85 18:07")
(* 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 (PROG [(LOOKS (TEDIT.GET.LOOKS TEXTOBJ (fetch CH# of SEL]
(LISTPUT LOOKS (QUOTE FAMILY)
FONTNAME)
(TEDIT.LOOKS TEXTSTREAM LOOKS SEL)
(RETURN (TEDIT.CARETLOOKS TEXTSTREAM LOOKS])
(\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
(\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 "11-Mar-85 14:57")
(* 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 LN 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 "16-Dec-84 20:17")
(* moves the selection back one char)
(PROG NIL
(TEDIT.SETSEL STREAM (IMAX 0 (SUB1 (\SEL.LIMIT.FORWARD SEL)))
0
(QUOTE LEFT])
(\TK.NEXTCHAR
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "11-Mar-85 14:32")
(* 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])
(\TK.FORWARD.WORD
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "23-Feb-85 15:36")
(* * 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])
(\TK.BACK.WORD
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* gbn "23-Feb-85 16:02")
(* * 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])
)
(* 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 "16-Jan-85 13:31")
(* * deletes one character forward from the caret)
(PROG (HERE)
(SETQ SEL (TEDIT.SETSEL STREAM (\SEL.LIMIT.FORWARD SEL)
1))
(TEDIT.DELETE STREAM SEL])
(\TK.TRANSPOSECHARS
[LAMBDA (STREAM TEXTOBJ SEL) (* gbn "11-Mar-85 14:47")
(* * 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])
)
(* 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 " 6-Mar-85 15:48")
(* * 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)
(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))
(* disable synonymy of CENTER and middle mousekey)
(MIDDLEMOUSEKEY (QUOTE NONE))
(* 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 (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 #↑U)
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))))
(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 (10740 21496 (\TK.UNDERLINE.SEL.ON 10750 . 11497) (\TK.UNDERLINE.SEL.OFF 11499 . 12249)
(\TK.BOLD.SEL.ON 12251 . 13128) (\TK.BOLD.SEL.OFF 13130 . 14011) (\TK.ITALIC.SEL.ON 14013 . 14582) (
\TK.ITALIC.SEL.OFF 14584 . 15156) (\TK.SMALLERSEL 15158 . 15914) (\TK.LARGERSEL 15916 . 16652) (
\TK.SUPERSCRIPTSEL 16654 . 17414) (\TK.SUBSCRIPTSEL 17416 . 18184) (\TK.DEFAULTSSEL 18186 . 18905) (
\TK.DEL.WORD.FORWARD 18907 . 20442) (\TK.UCASE.SEL 20444 . 20968) (\TK.LCASE.SEL 20970 . 21494)) (
21564 25782 (\TK.CENTER.SEL 21574 . 22705) (\TK.CENTER.SEL.REV 22707 . 23823) (\TK.NEST 23825 . 24717)
(\TK.UNNEST 24719 . 25780)) (25862 35102 (\TK.SHOWCARETLOOKS 25872 . 26670) (\TK.BOLD.CARET.ON 26672
. 27195) (\TK.BOLD.CARET.OFF 27197 . 27723) (\TK.ITALIC.CARET.ON 27725 . 28250) (\TK.ITALIC.CARET.OFF
28252 . 28780) (\TK.UNDERLINE.CARET.ON 28782 . 29226) (\TK.UNDERLINE.CARET.OFF 29228 . 29675) (
\TK.SUPERSCRIPT.CARET 29677 . 30289) (\TK.SUBSCRIPT.CARET 30291 . 30927) (\TK.SMALLER.CARET 30929 .
31542) (\TK.LARGER.CARET 31544 . 32141) (\TK.DEFAULTS.CARET 32143 . 32462) (\TK.FONT1 32464 . 32644) (
\TK.FONT2 32646 . 32826) (\TK.FONT3 32828 . 33008) (\TK.SETCARETFONT 33010 . 34190) (\TK.FONT4 34192
. 34372) (\TK.FONT5 34374 . 34554) (\TK.FONT6 34556 . 34736) (\TK.FONT7 34738 . 34918) (\TK.FONT8
34920 . 35100)) (35187 37119 (\TK.BOLDTOGGLE 35197 . 35902) (\TK.ITALICTOGGLE 35904 . 36554) (
\TK.UNDERLINETOGGLE 36556 . 37117)) (37173 37635 (\TK.SETDEFAULTLOOKS 37183 . 37633)) (37692 46755 (
\TK.NEXTLINE 37702 . 39337) (\TK.PREVLINE 39339 . 40825) (\TK.GOTODOCBEGIN 40827 . 41123) (
\TK.GOTODOCEND 41125 . 41471) (\TK.GOTOLINEBEGIN 41473 . 42029) (\TK.GOTOLINEEND 42031 . 42813) (
\TK.PREVCHAR 42815 . 43154) (\TK.NEXTCHAR 43156 . 43690) (\TK.FORWARD.WORD 43692 . 45188) (
\TK.BACK.WORD 45190 . 46753)) (46784 49733 (\TK.FIND 46794 . 47106) (\TK.REDISPLAY 47108 . 47369) (
\TK.DELLINEFORWARD 47371 . 47939) (\TK.OPENLINE 47941 . 48156) (\TK.DELCHARFORWARD 48158 . 48486) (
\TK.TRANSPOSECHARS 48488 . 49731)) (49798 52852 (\SEL.LIMIT 49808 . 50265) (\TK.SETFILEPTR.TO.CARET
50267 . 50734) (\SEL.LINEDESC 50736 . 51200) (\TK.DESCRIBEFONT 51202 . 51936) (\PARAS.IN.SEL 51938 .
52850)) (53807 66909 (\SHIFTACTION 53817 . 54122) (\ACTION 54124 . 54425) (TEDITKEY.INSTALL 54427 .
60103) (\TK.ACTIONTOCHARCODE 60105 . 60628) (\TK.BUILD.MENU 60630 . 61717) (\TK.HELP 61719 . 61964) (
\TK.SETFONTINLOOKS 61966 . 63616) (WRITE.CHARDESC.AUX 63618 . 64082) (CHARDESC 64084 . 64435) (
TEDITKEY.CONFIGURE 64437 . 64592) (\TK.ADDKEY 64594 . 64790) (\TK.CHANGEKEY 64792 . 64983) (
\TK.APPLYPENDING 64985 . 66646) (\TK.NTHFONT 66648 . 66907)) (66950 67781 (METASHIFT 66960 . 67779)) (
68016 70029 (TEDIT.FULL.FIND 68026 . 70027)))))
STOP