(FILECREATED "25-Sep-86 22:15:38" {ERIS}<TEDIT>TEDITFNKEYS.;12 27429
changes to: (VARS TEDITFNKEYSCOMS)
previous date: " 8-Nov-85 15:24:22" {ERIS}<TEDIT>TEDITFNKEYS.;11)
(* "
Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT TEDITFNKEYSCOMS)
(RPAQQ TEDITFNKEYSCOMS
[(FILES TEDITDECLS)
(FNS \TEDIT.BOLD.CARET.OFF \TEDIT.BOLD.CARET.ON \TEDIT.ITALIC.CARET.OFF
\TEDIT.ITALIC.CARET.ON \TEDIT.LARGER.CARET \TEDIT.SMALLER.CARET \TEDIT.SUBSCRIPT.CARET
\TEDIT.SUPERSCRIPT.CARET \TEDIT.UNDERLINE.CARET.OFF \TEDIT.UNDERLINE.CARET.ON
\TEDIT.STRIKEOUT.CARET.OFF \TEDIT.STRIKEOUT.CARET.ON)
(FNS \TEDIT.BOLD.SEL.OFF \TEDIT.BOLD.SEL.ON \TEDIT.CENTER.SEL \TEDIT.CENTER.SEL.REV
\TEDIT.DEFAULTS.CARET \TEDIT.DEFAULTSSEL \TEDIT.SETDEFAULT.FROM.SEL
\TEDIT.DEL.WORD.FORWARD \TEDIT.DELCHARFORWARD \TEDIT.FIND \TEDIT.ITALIC.SEL.OFF
\TEDIT.ITALIC.SEL.ON \TEDIT.LARGERSEL \TEDIT.LCASE.SEL \TEDIT.SHOWCARETLOOKS
\TEDIT.SMALLERSEL \TEDIT.SUBSCRIPTSEL \TEDIT.SUPERSCRIPTSEL \TEDIT.UCASE.SEL
\TEDIT.UNDERLINE.SEL.OFF \TEDIT.UNDERLINE.SEL.ON \TEDIT.STRIKEOUT.SEL.ON
\TEDIT.STRIKEOUT.SEL.OFF)
(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))
[VARS (TEDIT.FNKEY.VERBOSE T)
(\TEDIT.KEYS (QUOTE ((2,4 UNDO)
(2,44 UNDO)
(2,3 FN \TEDIT.FIND)
(2,43 FN \TEDIT.FIND)
(2,10 REDO)
(2,50 REDO)
(2,22 NEXT)
(2,62 NEXT)
(ESC EXPAND)
(2,24 EXPAND)
(2,101 FN \TEDIT.CENTER.SEL)
(2,141 FN \TEDIT.CENTER.SEL.REV)
(2,102 FN \TEDIT.BOLD.SEL.ON)
(2,142 FN \TEDIT.BOLD.SEL.OFF)
(2,103 FN \TEDIT.ITALIC.SEL.ON)
(2,143 FN \TEDIT.ITALIC.SEL.OFF)
(2,104 FN \TEDIT.UCASE.SEL)
(2,144 FN \TEDIT.LCASE.SEL)
(2,105 FN \TEDIT.STRIKEOUT.SEL.ON)
(2,145 FN \TEDIT.STRIKEOUT.SEL.OFF)
(2,106 FN \TEDIT.UNDERLINE.SEL.ON)
(2,146 FN \TEDIT.UNDERLINE.SEL.OFF)
(2,107 FN \TEDIT.SUBSCRIPTSEL)
(2,147 FN \TEDIT.SUPERSCRIPTSEL)
(2,110 FN \TEDIT.SMALLERSEL)
(2,150 FN \TEDIT.LARGERSEL)
(2,113 FN \TEDIT.SUPERSCRIPTSEL)
(2,153 FN \TEDIT.SUBSCRIPTSEL)
(2,114 FN \TEDIT.SUBSCRIPTSEL)
(2,154 FN \TEDIT.SUPERSCRIPTSEL)
(2,115 FN \TEDIT.DEFAULTSSEL)
(2,155 FN \TEDIT.SETDEFAULT.FROM.SEL)
(2,1 FN \TEDIT.SHOWCARETLOOKS]
(P (FOR ENTRY IN \TEDIT.KEYS DO (SELECTQ (CADR ENTRY)
(FN (TEDIT.SETFUNCTION (CAR ENTRY)
(CADDR ENTRY)))
(TEDIT.SETSYNTAX (CAR ENTRY)
(CADR ENTRY])
(FILESLOAD TEDITDECLS)
(DEFINEQ
(\TEDIT.BOLD.CARET.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:12")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (WEIGHT MEDIUM))
(fetch CARETLOOKS of TEXTOBJ)
TEXTOBJ)))
(COND
(LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.BOLD.CARET.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:12")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (WEIGHT BOLD))
(fetch CARETLOOKS of TEXTOBJ)
TEXTOBJ)))
(COND
(LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.ITALIC.CARET.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:24")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (SLOPE REGULAR))
(fetch CARETLOOKS of TEXTOBJ)
TEXTOBJ)))
(COND
(LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.ITALIC.CARET.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:12")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (SLOPE ITALIC))
(fetch CARETLOOKS of TEXTOBJ)
TEXTOBJ)))
(COND
(LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.LARGER.CARET
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:13")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (SIZEINCREMENT 2))
(fetch CARETLOOKS of TEXTOBJ)
TEXTOBJ)))
(COND
(LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.SMALLER.CARET
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:13")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (SIZEINCREMENT -2))
(fetch CARETLOOKS of TEXTOBJ)
TEXTOBJ)))
(COND
(LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.SUBSCRIPT.CARET
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:13")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (OFFSETINCREMENT -2))
(fetch CARETLOOKS of TEXTOBJ)
TEXTOBJ)))
(COND
(LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.SUPERSCRIPT.CARET
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:13")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (OFFSETINCREMENT 2))
(fetch CARETLOOKS of TEXTOBJ)
TEXTOBJ)))
(COND
(LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.UNDERLINE.CARET.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:13")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (UNDERLINE OFF))
(fetch CARETLOOKS of TEXTOBJ)
TEXTOBJ)))
(COND
(LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.UNDERLINE.CARET.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:13")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (UNDERLINE ON))
(fetch CARETLOOKS of TEXTOBJ)
TEXTOBJ)))
(COND
(LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.STRIKEOUT.CARET.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds " 5-Nov-85 20:33")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (STRIKEOUT OFF))
(fetch CARETLOOKS of TEXTOBJ)
TEXTOBJ)))
(COND
(LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.STRIKEOUT.CARET.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds " 5-Nov-85 20:32")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (STRIKEOUT ON))
(fetch CARETLOOKS of TEXTOBJ)
TEXTOBJ)))
(COND
(LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
)
(DEFINEQ
(\TEDIT.BOLD.SEL.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* jds "21-Sep-85 09:00")
(COND
((SHIFTDOWNP (QUOTE META))
(\TEDIT.BOLD.CARET.OFF TEXTSTREAM TEXTOBJ SEL))
(T (TEDIT.LOOKS TEXTSTREAM (QUOTE (WEIGHT MEDIUM))
SEL])
(\TEDIT.BOLD.SEL.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:59")
(COND
((SHIFTDOWNP (QUOTE META))
(\TEDIT.BOLD.CARET.ON TEXTSTREAM TEXTOBJ SEL))
(T (TEDIT.LOOKS TEXTSTREAM (QUOTE (WEIGHT BOLD))
SEL])
(\TEDIT.CENTER.SEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "19-Sep-85 16:42")
(* 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)
(COND
(TEDIT.FNKEY.VERBOSE (TEDIT.PROMPTPRINT TEXTSTREAM (DREVERSE NEWQUADS)
T])
(\TEDIT.CENTER.SEL.REV
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "19-Sep-85 16:51")
(* * 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)
(COND
(TEDIT.FNKEY.VERBOSE (TEDIT.PROMPTPRINT TEXTSTREAM (DREVERSE NEWQUADS)
T])
(\TEDIT.DEFAULTS.CARET
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:24")
(PROGN (TEDIT.CARETLOOKS TEXTSTREAM (create CHARLOOKS using TEDIT.DEFAULT.CHARLOOKS))
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.DEFAULTSSEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "19-Sep-85 13:35")
(* acts on the selection)
(PROG ((LOOKS (create CHARLOOKS using TEDIT.DEFAULT.CHARLOOKS)))
(TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(TEDIT.LOOKS TEXTSTREAM LOOKS SEL])
(\TEDIT.SETDEFAULT.FROM.SEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds " 8-Nov-85 15:22")
(* Set the defaults from the current selection.)
(PROG ((LOOKS (TEDIT.GET.LOOKS TEXTSTREAM SEL)))
(SETQ TEDIT.DEFAULT.CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST LOOKS])
(\TEDIT.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)
[COND
((NOT (EOFP TEXTSTREAM))
(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])
(\TEDIT.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])
(\TEDIT.FIND
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "26-Sep-85 14:23")
(* just calls the normal tedit.find starting at the
right of the current selection)
(PROG (TARGET (TEXTOBJ (TEXTOBJ TEXTSTREAM))
SEL CH W) (* Case sensitive search, with * and # wildcards)
[SETQ W (CAR (MKLIST (fetch \WINDOW of TEXTOBJ]
[SETQ TARGET (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])
(\TEDIT.ITALIC.SEL.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* jds "21-Sep-85 08:59")
(COND
((SHIFTDOWNP (QUOTE META))
(\TEDIT.ITALIC.CARET.OFF TEXTSTREAM TEXTOBJ SEL))
(T (TEDIT.LOOKS TEXTSTREAM (QUOTE (SLOPE REGULAR))
SEL])
(\TEDIT.ITALIC.SEL.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:59")
(COND
((SHIFTDOWNP (QUOTE META))
(\TEDIT.ITALIC.CARET.ON TEXTSTREAM TEXTOBJ SEL))
(T (TEDIT.LOOKS TEXTSTREAM (QUOTE (SLOPE ITALIC))
SEL])
(\TEDIT.LARGERSEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:58")
(COND
((SHIFTDOWNP (QUOTE META))
(\TEDIT.LARGER.CARET TEXTSTREAM TEXTOBJ SEL))
(T (TEDIT.LOOKS TEXTSTREAM (LIST (QUOTE SIZEINCREMENT)
2)
SEL])
(\TEDIT.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])
(\TEDIT.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))
(COND
((AND (fetch CLOFFSET of LOOKS)
(NEQ (fetch CLOFFSET of LOOKS)
0))
(CONCAT " offset " (fetch CLOFFSET of LOOKS)))
(T ""))
(COND
((fetch CLOLINE of LOOKS)
" overlined")
(T ""))
(COND
((fetch CLULINE of LOOKS)
" underlined")
(T "")))
T)
(RETURN])
(\TEDIT.SMALLERSEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:58")
(COND
((SHIFTDOWNP (QUOTE META))
(\TEDIT.SMALLER.CARET TEXTSTREAM TEXTOBJ SEL))
(T (TEDIT.LOOKS TEXTSTREAM (LIST (QUOTE SIZEINCREMENT)
-2)
SEL])
(\TEDIT.SUBSCRIPTSEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:58")
(COND
((SHIFTDOWNP (QUOTE META))
(\TEDIT.SUBSCRIPT.CARET TEXTSTREAM TEXTOBJ SEL))
(T (TEDIT.LOOKS TEXTSTREAM (LIST (QUOTE OFFSETINCREMENT)
-2)
SEL])
(\TEDIT.SUPERSCRIPTSEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:57")
(COND
((SHIFTDOWNP (QUOTE META))
(\TEDIT.SUPERSCRIPT.CARET TEXTSTREAM TEXTOBJ SEL))
(T (TEDIT.LOOKS TEXTSTREAM (LIST (QUOTE OFFSETINCREMENT)
2)
SEL])
(\TEDIT.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])
(\TEDIT.UNDERLINE.SEL.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:20")
(COND
((SHIFTDOWNP (QUOTE META))
(\TEDIT.UNDERLINE.CARET.OFF TEXTSTREAM TEXTOBJ SEL))
(T (TEDIT.LOOKS TEXTSTREAM (QUOTE (UNDERLINE OFF))
SEL])
(\TEDIT.UNDERLINE.SEL.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:20")
(COND
((SHIFTDOWNP (QUOTE META))
(\TEDIT.UNDERLINE.CARET.ON TEXTSTREAM TEXTOBJ SEL))
(T (TEDIT.LOOKS TEXTSTREAM (QUOTE (UNDERLINE ON))
SEL])
(\TEDIT.STRIKEOUT.SEL.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds " 5-Nov-85 20:32")
(COND
((SHIFTDOWNP (QUOTE META))
(\TEDIT.STRIKEOUT.CARET.ON TEXTSTREAM TEXTOBJ SEL))
(T (TEDIT.LOOKS TEXTSTREAM (QUOTE (STRIKEOUT ON))
SEL])
(\TEDIT.STRIKEOUT.SEL.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds " 5-Nov-85 20:33")
(COND
((SHIFTDOWNP (QUOTE META))
(\TEDIT.STRIKEOUT.CARET.OFF TEXTSTREAM TEXTOBJ SEL))
(T (TEDIT.LOOKS TEXTSTREAM (QUOTE (STRIKEOUT OFF))
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)
(COND
((EQ (fetch POINT of SEL)
(QUOTE LEFT))
(fetch CH# of SEL))
(T (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)
(COND
[(EQ (fetch POINT of SEL)
(QUOTE LEFT))
(CAR (MKLIST (fetch L1 of SEL]
(T (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))
(COND
[(NEQ (FONTPROP FONT (QUOTE WEIGHT))
(QUOTE MEDIUM))
(CONCAT " " (L-CASE (FONTPROP FONT (QUOTE WEIGHT]
(T ""))
(COND
[(NEQ (FONTPROP FONT (QUOTE SLOPE))
(QUOTE REGULAR))
(CONCAT " " (L-CASE (FONTPROP FONT (QUOTE SLOPE]
(T ""])
(\PARAS.IN.SEL
[LAMBDA (SEL TEXTOBJ) (* gbn " 7-Jun-85 16:05")
(* returns a list which contains one character number
for each paragraph included in the selection)
(PROG ((PARAS)
PARAENDED PCS (POS (fetch CH# of SEL)))
(COND
((ZEROP (fetch DCH of SEL))
(* there are not really any pieces in this selection, however, effect the change to the para containing this
selection by starting the selection one character earlier. This is not the right soln, but TEdit has no looks on the
empty last para as yet.)
(replace CH# of SEL with (IDIFFERENCE (fetch CH# of SEL)
1))
(replace DCH of SEL with 1)
(\FIXSEL SEL TEXTOBJ)))
(SETQ PCS (TEDIT.SELECTED.PIECES TEXTOBJ SEL)) (* to include the first char)
(SETQ PARAENDED T)
(for PC in PCS
do (COND
(PARAENDED (* 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
NIL
NIL
NIL
)
(RPAQQ TEDIT.FNKEY.VERBOSE T)
(RPAQQ \TEDIT.KEYS ((2,4 UNDO)
(2,44 UNDO)
(2,3 FN \TEDIT.FIND)
(2,43 FN \TEDIT.FIND)
(2,10 REDO)
(2,50 REDO)
(2,22 NEXT)
(2,62 NEXT)
(ESC EXPAND)
(2,24 EXPAND)
(2,101 FN \TEDIT.CENTER.SEL)
(2,141 FN \TEDIT.CENTER.SEL.REV)
(2,102 FN \TEDIT.BOLD.SEL.ON)
(2,142 FN \TEDIT.BOLD.SEL.OFF)
(2,103 FN \TEDIT.ITALIC.SEL.ON)
(2,143 FN \TEDIT.ITALIC.SEL.OFF)
(2,104 FN \TEDIT.UCASE.SEL)
(2,144 FN \TEDIT.LCASE.SEL)
(2,105 FN \TEDIT.STRIKEOUT.SEL.ON)
(2,145 FN \TEDIT.STRIKEOUT.SEL.OFF)
(2,106 FN \TEDIT.UNDERLINE.SEL.ON)
(2,146 FN \TEDIT.UNDERLINE.SEL.OFF)
(2,107 FN \TEDIT.SUBSCRIPTSEL)
(2,147 FN \TEDIT.SUPERSCRIPTSEL)
(2,110 FN \TEDIT.SMALLERSEL)
(2,150 FN \TEDIT.LARGERSEL)
(2,113 FN \TEDIT.SUPERSCRIPTSEL)
(2,153 FN \TEDIT.SUBSCRIPTSEL)
(2,114 FN \TEDIT.SUBSCRIPTSEL)
(2,154 FN \TEDIT.SUPERSCRIPTSEL)
(2,115 FN \TEDIT.DEFAULTSSEL)
(2,155 FN \TEDIT.SETDEFAULT.FROM.SEL)
(2,1 FN \TEDIT.SHOWCARETLOOKS)))
[FOR ENTRY IN \TEDIT.KEYS DO (SELECTQ (CADR ENTRY)
(FN (TEDIT.SETFUNCTION (CAR ENTRY)
(CADDR ENTRY)))
(TEDIT.SETSYNTAX (CAR ENTRY)
(CADR ENTRY]
(PUTPROPS TEDITFNKEYS COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3983 8901 (\TEDIT.BOLD.CARET.OFF 3993 . 4399) (\TEDIT.BOLD.CARET.ON 4401 . 4804) (
\TEDIT.ITALIC.CARET.OFF 4806 . 5214) (\TEDIT.ITALIC.CARET.ON 5216 . 5622) (\TEDIT.LARGER.CARET 5624 .
6030) (\TEDIT.SMALLER.CARET 6032 . 6440) (\TEDIT.SUBSCRIPT.CARET 6442 . 6854) (
\TEDIT.SUPERSCRIPT.CARET 6856 . 7269) (\TEDIT.UNDERLINE.CARET.OFF 7271 . 7682) (
\TEDIT.UNDERLINE.CARET.ON 7684 . 8093) (\TEDIT.STRIKEOUT.CARET.OFF 8095 . 8497) (
\TEDIT.STRIKEOUT.CARET.ON 8499 . 8899)) (8902 21798 (\TEDIT.BOLD.SEL.OFF 8912 . 9218) (
\TEDIT.BOLD.SEL.ON 9220 . 9522) (\TEDIT.CENTER.SEL 9524 . 10531) (\TEDIT.CENTER.SEL.REV 10533 . 11519)
(\TEDIT.DEFAULTS.CARET 11521 . 11804) (\TEDIT.DEFAULTSSEL 11806 . 12196) (\TEDIT.SETDEFAULT.FROM.SEL
12198 . 12577) (\TEDIT.DEL.WORD.FORWARD 12579 . 14151) (\TEDIT.DELCHARFORWARD 14153 . 14529) (
\TEDIT.FIND 14531 . 16672) (\TEDIT.ITALIC.SEL.OFF 16674 . 16984) (\TEDIT.ITALIC.SEL.ON 16986 . 17293)
(\TEDIT.LARGERSEL 17295 . 17618) (\TEDIT.LCASE.SEL 17620 . 18192) (\TEDIT.SHOWCARETLOOKS 18194 . 18971
) (\TEDIT.SMALLERSEL 18973 . 19299) (\TEDIT.SUBSCRIPTSEL 19301 . 19633) (\TEDIT.SUPERSCRIPTSEL 19635
. 19970) (\TEDIT.UCASE.SEL 19972 . 20544) (\TEDIT.UNDERLINE.SEL.OFF 20546 . 20862) (
\TEDIT.UNDERLINE.SEL.ON 20864 . 21177) (\TEDIT.STRIKEOUT.SEL.ON 21179 . 21485) (
\TEDIT.STRIKEOUT.SEL.OFF 21487 . 21796)) (21863 25420 (\SEL.LIMIT 21873 . 22324) (
\TK.SETFILEPTR.TO.CARET 22326 . 22793) (\SEL.LINEDESC 22795 . 23250) (\TK.DESCRIBEFONT 23252 . 23975)
(\PARAS.IN.SEL 23977 . 25418)))))
STOP