github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-18 17:36:53 +00:00
Code Issues Projects Releases Wiki Activity

Merge pull request #435 from Interlisp/LLKEY-with-Meta-and-Function

Browse Source 
LLKEY with meta and function
This commit is contained in:
rmkaplan 2021-08-25 14:55:48 -07:00 committed by GitHub
commit 3d7905905b
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
6 changed files with 467 additions and 418 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

309
library/TEDITWINDOW
View File

@ -1,13 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "21-Jun-99 20:00:42" {DSK}<project>medley3.5>library>TEDITWINDOW.;3 185046
(FILECREATED "24-Aug-2021 23:30:39" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;3 185251
changes to%: (FNS \TEDIT.WINDOW.SETUP)
changes to%: (FNS \TEDIT.BUTTONEVENTFN TEXTSTREAM.TITLE \TEDIT.ORIGINAL.WINDOW.TITLE)
previous date%: "25-Aug-94 10:56:22" {DSK}<project>medley3.5>library>TEDITWINDOW.;2)
previous date%: "21-Jun-99 20:00:42"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;1)
(* ; "
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994, 1999 by John Sybalsky & Xerox Corporation. All rights reserved.
Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporation.
")
(PRETTYCOMPRINT TEDITWINDOWCOMS)
@ -452,9 +454,9 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
(PROCESSP (WINDOWPROP W 'PROCESS])
(\TEDIT.BUTTONEVENTFN
[LAMBDA (W STREAM) (* ; "Edited 5-Sep-91 18:52 by jds")
[LAMBDA (W STREAM) (* ; "Edited 24-Aug-2021 23:30 by rmk:")
(* ;; "Handle button events for a TEdit window")
(* ;; "Handle button events for a TEdit window")
(AND STREAM (SETQ STREAM (TEXTOBJ STREAM)))
(PROG* ((OSEL NIL)
@ -473,15 +475,15 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
(OLDY -32000)
SELFINALFN PROC NOSEL)
(COND
((NOT (MOUSESTATE (OR LEFT MIDDLE RIGHT))) (* ;
 "No button is down -- we got control on button-up transition, so ignore it.")
((NOT (MOUSESTATE (OR LEFT MIDDLE RIGHT))) (* ;
 "No button is down -- we got control on button-up transition, so ignore it.")
(RETURN))
(TEDIT.SELPENDING (* ;
 "There is already a selection in progress. Don't allow another to interfere.")
(TEDIT.SELPENDING (* ;
 "There is already a selection in progress. Don't allow another to interfere.")
(RETURN)))
(replace (SELECTION CH#) of TEDIT.SCRATCHSELECTION with 0)
(* ;
 "Mark the user-visible scratch selection fresh, so changes can be detected...")
(* ;
 "Mark the user-visible scratch selection fresh, so changes can be detected...")
(COND
[[OR (NOT TEXTOBJ)
(fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)
@ -491,17 +493,17 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
(NOT (SHIFTDOWNP 'CTRL))
(NOT (SHIFTDOWNP 'META))
(NOT (KEYDOWNP 'MOVE))
(NOT (KEYDOWNP 'COPY] (* ; "There's no edit session behind this window. You can only do window ops, or re-establish a session.")
(NOT (KEYDOWNP 'COPY] (* ; "There's no edit session behind this window. You can only do window ops, or re-establish a session.")
(TOTOPW W)
(COND
((\TEDIT.MOUSESTATE RIGHT) (* ;
 "Right button gets the window command menu")
((\TEDIT.MOUSESTATE RIGHT) (* ;
 "Right button gets the window command menu")
(DOWINDOWCOM W))
((AND TEXTOBJ (NOT (TEXTPROP TEXTOBJ 'READONLY))
(NOT (TEXTPROP TEXTOBJ 'SELECTONLY))
[NOT (PROCESSP (WINDOWPROP W 'PROCESS]
(\TEDIT.MOUSESTATE MIDDLE)) (* ;
 "Middle button on a dead window gives a menu for re-starting TEDIT")
(\TEDIT.MOUSESTATE MIDDLE)) (* ;
 "Middle button on a dead window gives a menu for re-starting TEDIT")
(COND
((EQ (MENU TEDIT.RESTART.MENU)
'NewEditProcess)
@ -509,89 +511,94 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
(TEDIT (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
W]
[(IGREATERP Y (fetch TOP of CLIPREGION))
(* ;
 "It's not inside the window's REAL region, so call on a menu.")
(* ;
 "It's not inside the window's REAL region, so call on a menu.")
(TOTOPW W)
(* ;; "RMK: This comment was originally just after the DON'T below, which generated a value-of-comment used message.")
(* ;; "HAD BEEN: (COND ((AND (SETQ PROC (WINDOWPROP W 'PROCESS)) (PROCESSP PROC)) ; This window has a live process behind it; go evaluate the button fn there. (PROCESS.APPLY PROC USERFN (LIST W))) (T ; Otherwise, create a new process to handle the menu. (ADD.PROCESS (LIST USERFN (KWOTE W)))))")
(COND
((\TEDIT.MOUSESTATE RIGHT)
(DOWINDOWCOM W))
((MOUSESTATE (OR LEFT MIDDLE))
(AND TEXTOBJ (SETQ USERFN (WINDOWPROP W 'TEDIT.TITLEMENUFN))
(NEQ USERFN 'DON'T) (* ; "HAD BEEN: (COND ((AND (SETQ PROC (WINDOWPROP W 'PROCESS)) (PROCESSP PROC)) ; This window has a live process behind it; go evaluate the button fn there. (PROCESS.APPLY PROC USERFN (LIST W))) (T ; Otherwise, create a new process to handle the menu. (ADD.PROCESS (LIST USERFN (KWOTE W)))))")
(NEQ USERFN 'DON'T)
(ADD.PROCESS (LIST USERFN (KWOTE W]
((AND TEXTOBJ (EQ (fetch (TEXTOBJ MOUSEREGION) of TEXTOBJ)
'WINDOW)) (* ;
 "We're in the window-ops region of the window. Do a window split or something")
'WINDOW)) (* ;
 "We're in the window-ops region of the window. Do a window split or something")
(\TEDIT.WINDOW.OPS TEXTOBJ W))
((AND TEXTOBJ (NOT (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ)))
(* ;
 "Usual case -- he's really selecting something. And there's nothing else going on now.")
(TOTOPW W) (* ;
 "Move the editing window to the top, so he can select wherever he wants.")
(\CARET.DOWN) (* ;
 "Make sure the caret isn't being displayed.")
(* ;
 "Usual case -- he's really selecting something. And there's nothing else going on now.")
(TOTOPW W) (* ;
 "Move the editing window to the top, so he can select wherever he wants.")
(\CARET.DOWN) (* ;
 "Make sure the caret isn't being displayed.")
(RESETLST
(RESETSAVE TEDIT.SELPENDING TEXTOBJ)
(* ;; "Tell all TEdits not to run, since there is a selection in progress. This is reset to NIL on return from here, to re-enable TEdit runs.")
(* ;; "Tell all TEdits not to run, since there is a selection in progress. This is reset to NIL on return from here, to re-enable TEdit runs.")
(RESETSAVE (for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ)
do (replace TCCARET of CARET with (\CARET.CREATE
BXHICARET)))
(LIST '\TEDIT.CARET (fetch (TEXTOBJ CARET) of TEXTOBJ)))
(* ;
 "Then make the caret be the special, tall one so he can see it.")
(* ;
 "Then make the caret be the special, tall one so he can see it.")
(COND
((KEYDOWNP 'COPY) (* ;
 "In a read-only document, you can only copy.")
((KEYDOWNP 'COPY) (* ;
 "In a read-only document, you can only copy.")
(SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
(SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))
(SETQ SELOPERATION 'COPY))
((AND (KEYDOWNP 'MOVE)
(NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)))
(* ;
 "The MOVE key is down, so set MOVE mode.")
(* ;
 "The MOVE key is down, so set MOVE mode.")
(SETQ GLOBALSEL TEDIT.MOVESELECTION)
(SETQ OSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))
(SETQ SELOPERATION 'MOVE))
[(SHIFTDOWNP 'SHIFT) (* ;
 "the SHIFT key is down; mark this selection for COPY or MOVE.")
[(SHIFTDOWNP 'SHIFT) (* ;
 "the SHIFT key is down; mark this selection for COPY or MOVE.")
(COND
((AND (SHIFTDOWNP 'CTRL)
(NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)))
(* ; "CTRL-SHIFT select means MOVE.")
(* ; "CTRL-SHIFT select means MOVE.")
(SETQ GLOBALSEL TEDIT.MOVESELECTION)
(SETQ OSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))
(SETQ SELOPERATION 'MOVE))
(T (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
(SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))
(SETQ SELOPERATION 'COPY]
((SHIFTDOWNP 'META) (* ;
 "He's holding the meta key down , do a copylooks selection")
((SHIFTDOWNP 'META) (* ;
 "He's holding the meta key down , do a copylooks selection")
(SETQ GLOBALSEL TEDIT.COPYLOOKSSELECTION)
(SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))
(SETQ SELOPERATION 'COPYLOOKS))
((AND (SHIFTDOWNP 'CTRL)
(NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)))
(* ;
 "He's holding the control key down; note the fact.")
(* ;
 "He's holding the control key down; note the fact.")
(\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
NIL NIL)
(SETQ GLOBALSEL TEDIT.DELETESELECTION)
[COND
((fetch (SELECTION SET) of (fetch (TEXTOBJ DELETESEL)
of TEXTOBJ))
(* ;
 "There's a pending delete selection. Use it, and turn off the existing normal selection.")
(* ;
 "There's a pending delete selection. Use it, and turn off the existing normal selection.")
)
(T (* ;
 "No existing delete selection. Use the normal selection as a starting point.")
(T (* ;
 "No existing delete selection. Use the normal selection as a starting point.")
(\COPYSEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
(fetch (TEXTOBJ DELETESEL) of TEXTOBJ]
(replace (SELECTION SET) of (fetch (TEXTOBJ SEL) of TEXTOBJ)
with NIL)
(* ;; "Remember to turn off the normal selection, since we'll be moving it to a new spot after the deletion.")
(* ;; "Remember to turn off the normal selection, since we'll be moving it to a new spot after the deletion.")
(SETQ OSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ))
(SETQ SELOPERATION 'DELETE)
@ -599,7 +606,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with NIL))
(T (SETQ OSEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with NIL)
(* ; "Reset the pending-delete flag.")
(* ; "Reset the pending-delete flag.")
))
(\COPYSEL OSEL GLOBALSEL)
(bind (OSELOP _ SELOPERATION)
@ -609,36 +616,36 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
(KEYDOWNP 'MOVE)
(KEYDOWNP 'COPY)
(NOT (ZEROP (LOGAND LASTMOUSEBUTTONS 7]
do (* ;
 "Poll the selection & display its current state")
do (* ;
 "Poll the selection & display its current state")
[COND
((ZEROP (LOGAND LASTMOUSEBUTTONS 7))
(* ;
 "No mouse buttons are down; don't try anything.")
(SETQ OLDX -32000) (* ;
 "However, remember that pushing a mouse button is a change of status that we should notice.")
(* ;
 "No mouse buttons are down; don't try anything.")
(SETQ OLDX -32000) (* ;
 "However, remember that pushing a mouse button is a change of status that we should notice.")
)
((KEYDOWNP 'MOVE) (* ;
 "the MOVE key is down; mark this selection for MOVE.")
((KEYDOWNP 'MOVE) (* ;
 "the MOVE key is down; mark this selection for MOVE.")
(SETQ SELOPERATION 'MOVE))
[(OR (SHIFTDOWNP 'SHIFT)
(KEYDOWNP 'COPY)) (* ;
 "the SHIFT key is down; mark this selection for COPY or MOVE.")
(KEYDOWNP 'COPY)) (* ;
 "the SHIFT key is down; mark this selection for COPY or MOVE.")
(COND
((SHIFTDOWNP 'CTRL) (* ;
 "He's holding down both ctrl and shift -- do a move.")
((SHIFTDOWNP 'CTRL) (* ;
 "He's holding down both ctrl and shift -- do a move.")
(SETQ SELOPERATION 'MOVE))
(T (* ;
 "Just the SHIFT key. It's a COPY")
(T (* ;
 "Just the SHIFT key. It's a COPY")
(SETQ SELOPERATION 'COPY]
((SHIFTDOWNP 'META) (* ;
 "He's holding the meta key down; note the fact.")
((SHIFTDOWNP 'META) (* ;
 "He's holding the meta key down; note the fact.")
(SETQ SELOPERATION 'COPYLOOKS))
((SHIFTDOWNP 'CTRL) (* ;
 "He's holding only the CTRL key -- mark the selection for deletion.")
((SHIFTDOWNP 'CTRL) (* ;
 "He's holding only the CTRL key -- mark the selection for deletion.")
(SETQ SELOPERATION 'DELETE))
(T (* ;
 "No key being held down; revert to normal selection.")
(T (* ;
 "No key being held down; revert to normal selection.")
(SETQ SELOPERATION 'NORMAL]
(COND
[(AND (OR [NOT (IEQP OLDX (SETQ X (LASTMOUSEX DS]
@ -646,15 +653,15 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
(NEQ OSELOP SELOPERATION))
(INSIDEP CLIPREGION X Y))
(* ;; "Only do selection if (1) the mouse is inside the window proper and (2) the mouse has moved, or the kind of selection has changed")
(* ;; "Only do selection if (1) the mouse is inside the window proper and (2) the mouse has moved, or the kind of selection has changed")
(* ;; "Must precede the scroll-region test, so that we don't try to scroll while the mouse is inside the main window, even if the scroll bar overlaps the window (at left edge of screen, say)")
(* ;; "Must precede the scroll-region test, so that we don't try to scroll while the mouse is inside the main window, even if the scroll bar overlaps the window (at left edge of screen, say)")
(SETQ OLDX X)
(SETQ OLDY Y)
[COND
((\TEDIT.MOUSESTATE LEFT) (* ;
 "Left button is character selection")
((\TEDIT.MOUSESTATE LEFT) (* ;
 "Left button is character selection")
(SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch (TEXTOBJ
MOUSEREGION
)
@ -662,18 +669,18 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
NIL SELOPERATION W))
(SETQ EXTENDFLG NIL))
((\TEDIT.MOUSESTATE MIDDLE)
(* ; "Middle button is word selection")
(* ; "Middle button is word selection")
(SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch (TEXTOBJ
MOUSEREGION
)
of TEXTOBJ)
T SELOPERATION W))
(SETQ EXTENDFLG NIL))
[(\TEDIT.MOUSESTATE RIGHT)(* ; "RIght button extends selections")
[(\TEDIT.MOUSESTATE RIGHT)(* ; "RIght button extends selections")
(COND
((NEQ SELOPERATION OSELOP)
(* ;; "Things changed since the last selection. Grab the prior selection info, so that the extension is taken from the selection NOW being made, rather than the last existing old-type selection.")
(* ;; "Things changed since the last selection. Grab the prior selection info, so that the extension is taken from the selection NOW being made, rather than the last existing old-type selection.")
(\COPYSEL OSEL GLOBALSEL)))
(COND
@ -682,36 +689,36 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
'NORMAL)
(SETQ SELOPERATION 'PENDINGDEL)
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ
with T)) (* ;
 "If TeditBluePendingDelete flag is set, then simulate Laurel's blue-pending-delete feature.")
with T)) (* ;
 "If TeditBluePendingDelete flag is set, then simulate Laurel's blue-pending-delete feature.")
(SETQ SEL (TEDIT.EXTEND.SEL X Y GLOBALSEL TEXTOBJ
SELOPERATION W))
(SETQ EXTENDFLG T]
(T (* ;
 "The mouse buttons are up, leaving us with a pro-tem 'permanent' selection")
(T (* ;
 "The mouse buttons are up, leaving us with a pro-tem 'permanent' selection")
(\COPYSEL OSEL GLOBALSEL)
(* ;
 "And SEL is NOT SET ANY LONGER, so it won't get copied into OSEL down below")
(* ;
 "And SEL is NOT SET ANY LONGER, so it won't get copied into OSEL down below")
(AND SEL (replace (SELECTION SET) of SEL with
NIL]
[COND
((AND SEL (fetch (SELECTION SET) of SEL)
SELFN) (* ;
 "The selection was set, but there's a SELFN that has veto authority")
SELFN) (* ;
 "The selection was set, but there's a SELFN that has veto authority")
(COND
((EQ (APPLY* SELFN TEXTOBJ SEL SELOPERATION 'TENTATIVE)
'DON'T) (* ;
 "The selfn vetoed this selection, so mark it un-set.")
'DON'T) (* ;
 "The selfn vetoed this selection, so mark it un-set.")
(replace (SELECTION SET) of SEL with NIL]
(COND
((\TEDIT.SEL.CHANGED? SEL OSEL OSELOP SELOPERATION)
(* ;
 "Something interesting about the selection changed. We have to re-display its image.")
(* ;
 "Something interesting about the selection changed. We have to re-display its image.")
(COND
((OR (EQ SELOPERATION 'NORMAL)
(EQ SELOPERATION 'PENDINGDEL))
(* ;
 "For a normal selection, set the 'window last selected in' for the TEXTOBJ")
(* ;
 "For a normal selection, set the 'window last selected in' for the TEXTOBJ")
(replace (TEXTOBJ SELWINDOW) of TEXTOBJ with
W)))
(SETQ OSEL (\TEDIT.REFRESH.SHOWSEL TEXTOBJ SEL OSEL OSELOP
@ -723,56 +730,56 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
(OR (NOT SEL)
(NOT (fetch (SELECTION SET) of SEL]
(* ;; "There is an old selection around, but it is VOLATILE -- i.e., it shouldn't last longer than something is pointing at it. Turn it off.")
(* ;; "There is an old selection around, but it is VOLATILE -- i.e., it shouldn't last longer than something is pointing at it. Turn it off.")
(\SHOWSEL OSEL NIL NIL)
(replace (SELECTION SET) of OSEL with NIL]
((IN/SCROLL/BAR? W LASTMOUSEX LASTMOUSEY)
(* ;
 "If he moves to the scroll bar, let him scroll without trouble")
(* ;
 "If he moves to the scroll bar, let him scroll without trouble")
(SCROLL.HANDLER W)))
(BLOCK) (* ; "Give other processes a chance")
(GETMOUSESTATE) (* ; "And get the new mouse info")
(BLOCK) (* ; "Give other processes a chance")
(GETMOUSESTATE) (* ; "And get the new mouse info")
(TEDIT.CURSORMOVEDFN W))
(\COPYSEL OSEL GLOBALSEL)
(COND
((fetch (SELECTION SET) of OSEL)
(* ;
 "Only if a selection REALLY got made should we do this....")
(* ;
 "Only if a selection REALLY got made should we do this....")
(SELECTQ SELOPERATION
(COPY (* ;
 "A COPY selection -- set the copy flag, and see if this is a copy to a non-TEdit window")
(COPY (* ;
 "A COPY selection -- set the copy flag, and see if this is a copy to a non-TEdit window")
(SETQ TEDIT.COPY.PENDING T)
(replace (SELECTION SET) of OSEL with NIL)
(* ;
 "And turn off OSEL, to avoid spurious highlighting")
(* ;
 "And turn off OSEL, to avoid spurious highlighting")
(\TEDIT.FOREIGN.COPY? GLOBALSEL)
(* ;
 "Maybe copy into the SYSBUF, if the recipient isn't a TEdit window.")
(* ;
 "Maybe copy into the SYSBUF, if the recipient isn't a TEdit window.")
)
(COPYLOOKS (* ; "A COPYLOOKS selection")
(COPYLOOKS (* ; "A COPYLOOKS selection")
(SETQ TEDIT.COPYLOOKS.PENDING T)
(* ;
 "And turn off OSEL, to avoid spurious highlighting")
(* ;
 "And turn off OSEL, to avoid spurious highlighting")
(replace (SELECTION SET) of OSEL with NIL))
(MOVE (* ;
 "A MOVE selection -- set the flag to signal the TEdit command loop,")
(SETQ TEDIT.MOVE.PENDING T) (* ;
 "And turn off OSEL, to avoid spurious highlighting")
(MOVE (* ;
 "A MOVE selection -- set the flag to signal the TEdit command loop,")
(SETQ TEDIT.MOVE.PENDING T) (* ;
 "And turn off OSEL, to avoid spurious highlighting")
(replace (SELECTION SET) of OSEL with NIL))
(DELETE (SETQ TEDIT.DEL.PENDING T)
(replace (SELECTION SET) of OSEL with NIL)
(* ;
 "And turn off OSEL, to avoid spurious highlighting")
(* ;
 "And turn off OSEL, to avoid spurious highlighting")
)
(NORMAL (* ;
 "This is a normal selection; set the caret looks")
(NORMAL (* ;
 "This is a normal selection; set the caret looks")
(replace (TEXTOBJ CARETLOOKS) of TEXTOBJ
with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ OSEL)))
NIL)))
(AND SELFN (APPLY* SELFN TEXTOBJ GLOBALSEL SELOPERATION 'FINAL))
(* ;
 "Give a user exit routine control, perhaps for logging of selections.")
(* ;
 "Give a user exit routine control, perhaps for logging of selections.")
(for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ)
do (OR (fetch TCUP of CARET)
(\EDIT.FLIPCARET CARET T))))
@ -1578,36 +1585,36 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
(DEFINEQ
(TEXTSTREAM.TITLE
[LAMBDA (STREAM) (* ; "Edited 30-May-91 23:34 by jds")
[LAMBDA (STREAM) (* ; "Edited 24-Aug-2021 23:25 by rmk:")
(* ;; "returns a string with which you can talk to the user about this stream")
(* ;; "returns a string with which you can talk to the user about this stream")
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
TXTFILE)
(SETQ TXTFILE (fetch (TEXTOBJ TXTFILE) of TEXTOBJ))
(RETURN (OR (CL:TYPECASE TXTFILE
(STRINGP TXTFILE)
(STREAM (fetch FULLNAME of TXTFILE))
(STREAM (fetch (STREAM FULLNAME) of TXTFILE))
(LITATOM TXTFILE)
(T TXTFILE))
""])
(\TEDIT.ORIGINAL.WINDOW.TITLE
[LAMBDA (FILE DIRTY?) (* ; "Edited 26-Apr-91 13:05 by jds")
[LAMBDA (FILE DIRTY?) (* ; "Edited 24-Aug-2021 23:25 by rmk:")
(* ;; "Given a file name, derive a title for the TEdit window that is editing it.")
(* ;; "Given a file name, derive a title for the TEdit window that is editing it.")
(PROG (TITLE)
(RETURN (COND
((NULL FILE) (* ;
 "Just calling (TEDIT) should give a 'Text Editor Window'")
((NULL FILE) (* ;
 "Just calling (TEDIT) should give a 'Text Editor Window'")
(CONCAT (COND
(DIRTY? "* ")
(T ""))
"Text Editor Window"))
((AND (STRINGP FILE)
(ZEROP (NCHARS FILE))) (* ;
 "So should editing an empty string")
(ZEROP (NCHARS FILE))) (* ;
 "So should editing an empty string")
(CONCAT (COND
(DIRTY? "* ")
(T ""))
@ -1615,19 +1622,19 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
((WINDOWP FILE)
(COND
((SETQ TITLE (WINDOWPROP FILE 'TITLE))
(* ;
 "if \TEDIT.WINDOW.SETUP has assigned a title, use it")
(* ;
 "if \TEDIT.WINDOW.SETUP has assigned a title, use it")
TITLE)
(T "Text Editor Window")))
(T (* ;
 "Strings use the string itself, otherwise grab the full file name.")
(T (* ;
 "Strings use the string itself, otherwise grab the full file name.")
(CONCAT (COND
(DIRTY? "* ")
(T ""))
"Edit Window for: "
(CL:TYPECASE FILE
(STRINGP FILE)
(STREAM (fetch FULLNAME of FILE))
(STREAM (fetch (STREAM FULLNAME) of FILE))
(LITATOM FILE)
(T FILE))])
@ -2817,27 +2824,27 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (CONS TEDITICON (CONS TEDITMASK (CONS TEDIT.ICON.TITLE.REGION
NIL))))
(PUTPROPS TEDITWINDOW COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988
1989 1990 1991 1993 1994 1999))
1989 1990 1991 1993 1994 1999 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (7130 91759 (TEDIT.CREATEW 7140 . 8276) (\TEDIT.CREATEW.FROM.REGION 8278 . 9262) (
TEDIT.CURSORMOVEDFN 9264 . 19916) (TEDIT.CURSOROUTFN 19918 . 20453) (TEDIT.WINDOW.SETUP 20455 . 22264)
(TEDIT.MINIMAL.WINDOW.SETUP 22266 . 30055) (\TEDIT.ACTIVE.WINDOWP 30057 . 31038) (
\TEDIT.BUTTONEVENTFN 31040 . 54735) (\TEDIT.WINDOW.OPS 54737 . 58540) (\TEDIT.EXPANDFN 58542 . 58945)
(\TEDIT.MAINW 58947 . 60236) (\TEDIT.PRIMARYW 60238 . 61450) (\TEDIT.COPYINSERTFN 61452 . 62423) (
\TEDIT.NEWREGIONFN 62425 . 64892) (\TEDIT.SET.WINDOW.EXTENT 64894 . 70996) (\TEDIT.SHRINK.ICONCREATE
70998 . 73270) (\TEDIT.SHRINKFN 73272 . 73847) (\TEDIT.SPLITW 73849 . 79950) (\TEDIT.UNSPLITW 79952 .
85646) (\TEDIT.WINDOW.SETUP 85648 . 91368) (\SAFE.FIRST 91370 . 91757)) (92905 93812 (TEDITWINDOWP
92915 . 93810)) (93849 96345 (TEDIT.GETINPUT 93859 . 95842) (\TEDIT.MAKEFILENAME 95844 . 96343)) (
96394 102845 (TEDIT.PROMPTPRINT 96404 . 99308) (TEDIT.PROMPTFLASH 99310 . 101265) (
\TEDIT.PROMPT.PAGEFULLFN 101267 . 102843)) (103080 107120 (TEXTSTREAM.TITLE 103090 . 103700) (
\TEDIT.ORIGINAL.WINDOW.TITLE 103702 . 105736) (\TEDIT.WINDOW.TITLE 105738 . 106408) (
\TEXTSTREAM.FILENAME 106410 . 107118)) (107163 151887 (TEDIT.DEACTIVATE.WINDOW 107173 . 114322) (
\TEDIT.REPAINTFN 114324 . 117181) (\TEDIT.RESHAPEFN 117183 . 122803) (\TEDIT.SCROLLFN 122805 . 151885)
) (151929 153978 (\TEDIT.PROCIDLEFN 151939 . 153288) (\TEDIT.PROCENTRYFN 153290 . 153583) (
\TEDIT.PROCEXITFN 153585 . 153976)) (154057 165057 (\EDIT.DOWNCARET 154067 . 154748) (\EDIT.FLIPCARET
154750 . 156285) (TEDIT.FLASHCARET 156287 . 157401) (\EDIT.UPCARET 157403 . 157856) (
TEDIT.NORMALIZECARET 157858 . 163809) (\SETCARET 163811 . 164731) (\TEDIT.CARET 164733 . 165055)) (
165091 178846 (TEDIT.ADD.MENUITEM 165101 . 167016) (TEDIT.DEFAULT.MENUFN 167018 . 176285) (
TEDIT.REMOVE.MENUITEM 176287 . 177288) (\TEDIT.CREATEMENU 177290 . 177743) (\TEDIT.MENU.WHENHELDFN
177745 . 178515) (\TEDIT.MENU.WHENSELECTEDFN 178517 . 178844)))))
(FILEMAP (NIL (7165 91937 (TEDIT.CREATEW 7175 . 8311) (\TEDIT.CREATEW.FROM.REGION 8313 . 9297) (
TEDIT.CURSORMOVEDFN 9299 . 19951) (TEDIT.CURSOROUTFN 19953 . 20488) (TEDIT.WINDOW.SETUP 20490 . 22299)
(TEDIT.MINIMAL.WINDOW.SETUP 22301 . 30090) (\TEDIT.ACTIVE.WINDOWP 30092 . 31073) (
\TEDIT.BUTTONEVENTFN 31075 . 54913) (\TEDIT.WINDOW.OPS 54915 . 58718) (\TEDIT.EXPANDFN 58720 . 59123)
(\TEDIT.MAINW 59125 . 60414) (\TEDIT.PRIMARYW 60416 . 61628) (\TEDIT.COPYINSERTFN 61630 . 62601) (
\TEDIT.NEWREGIONFN 62603 . 65070) (\TEDIT.SET.WINDOW.EXTENT 65072 . 71174) (\TEDIT.SHRINK.ICONCREATE
71176 . 73448) (\TEDIT.SHRINKFN 73450 . 74025) (\TEDIT.SPLITW 74027 . 80128) (\TEDIT.UNSPLITW 80130 .
85824) (\TEDIT.WINDOW.SETUP 85826 . 91546) (\SAFE.FIRST 91548 . 91935)) (93083 93990 (TEDITWINDOWP
93093 . 93988)) (94027 96523 (TEDIT.GETINPUT 94037 . 96020) (\TEDIT.MAKEFILENAME 96022 . 96521)) (
96572 103023 (TEDIT.PROMPTPRINT 96582 . 99486) (TEDIT.PROMPTFLASH 99488 . 101443) (
\TEDIT.PROMPT.PAGEFULLFN 101445 . 103021)) (103258 107320 (TEXTSTREAM.TITLE 103268 . 103889) (
\TEDIT.ORIGINAL.WINDOW.TITLE 103891 . 105936) (\TEDIT.WINDOW.TITLE 105938 . 106608) (
\TEXTSTREAM.FILENAME 106610 . 107318)) (107363 152087 (TEDIT.DEACTIVATE.WINDOW 107373 . 114522) (
\TEDIT.REPAINTFN 114524 . 117381) (\TEDIT.RESHAPEFN 117383 . 123003) (\TEDIT.SCROLLFN 123005 . 152085)
) (152129 154178 (\TEDIT.PROCIDLEFN 152139 . 153488) (\TEDIT.PROCENTRYFN 153490 . 153783) (
\TEDIT.PROCEXITFN 153785 . 154176)) (154257 165257 (\EDIT.DOWNCARET 154267 . 154948) (\EDIT.FLIPCARET
154950 . 156485) (TEDIT.FLASHCARET 156487 . 157601) (\EDIT.UPCARET 157603 . 158056) (
TEDIT.NORMALIZECARET 158058 . 164009) (\SETCARET 164011 . 164931) (\TEDIT.CARET 164933 . 165255)) (
165291 179046 (TEDIT.ADD.MENUITEM 165301 . 167216) (TEDIT.DEFAULT.MENUFN 167218 . 176485) (
TEDIT.REMOVE.MENUITEM 176487 . 177488) (\TEDIT.CREATEMENU 177490 . 177943) (\TEDIT.MENU.WHENHELDFN
177945 . 178715) (\TEDIT.MENU.WHENSELECTEDFN 178717 . 179044)))))
STOP

BIN
library/TEDITWINDOW.LCOM
View File

Binary file not shown.

398
sources/LLKEY
View File

@ -1,7 +1,9 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "11-Jun-2021 09:43:22" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLKEY.;6 197710
(FILECREATED "24-Aug-2021 16:54:52" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLKEY.;6 199507
previous date%: " 9-Jun-2021 20:18:50"
changes to%: (FNS KEYACTION)
previous date%: "24-Aug-2021 16:43:30"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLKEY.;5)
@ -71,7 +73,7 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
(COMS (* ; "Key interpretation")
(FNS KEYACTION KEYACTIONTABLE KEYBOARDTYPE RESETKEYACTION
\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS \KEYACTION1 KEYDOWNP KEYNUMBERP
\KEYNAMETONUMBER MODIFY.KEYACTIONS METASHIFT SHIFTDOWNP)
\KEYNAMETONUMBER \KEYNUMBERTONAME MODIFY.KEYACTIONS METASHIFT SHIFTDOWNP)
(* ;
 "To support office style 1108 & 1186 keyboards")
(FNS SETUP.OFFICE.KEYBOARD)
@ -1650,144 +1652,144 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
(103 LOCKUP)))
(RPAQQ \DLIONKEYACTIONS
((2 (54 "^" NOLOCKSHIFT))
((2 ("6" "^" NOLOCKSHIFT))
(10 ("-" "_" NOLOCKSHIFT))
(33 ("\" "|" NOLOCKSHIFT))
(45 (96 "~" NOLOCKSHIFT))
(45 ("`" "~" NOLOCKSHIFT))
(OPEN METADOWN . METAUP)
(PROP'S CTRLDOWN . CTRLUP)
(SAME METADOWN . METAUP)
(FIND ("2,3" "2,43" NOLOCKSHIFT))
(UNDO ("2,4" "2,44" NOLOCKSHIFT))
(STOP (5 7 NOLOCKSHIFT))
(FIND ("Function,^C" "Function,#" NOLOCKSHIFT))
(UNDO ("Function,^D" "Function,$" NOLOCKSHIFT))
(STOP ("^E" "Bell" NOLOCKSHIFT))
(MOVE)
(COPY)
(AGAIN ("2,10" "2,50" NOLOCKSHIFT))
(CENTER ("2,101" "2,141" NOLOCKSHIFT))
(BOLD ("2,102" "2,142" NOLOCKSHIFT))
(ITALICS ("2,103" "2,143" NOLOCKSHIFT))
(UNDERLINE ("2,106" "2,146" NOLOCKSHIFT))
(SUPERSCRIPT ("2,113" "2,153" NOLOCKSHIFT))
(SUBSCRIPT ("2,114" "2,154" NOLOCKSHIFT))
(LARGER ("2,110" "2,150" NOLOCKSHIFT))
(DEFAULTS ("2,115" "2,155" NOLOCKSHIFT))
(93 (27 "2,64" NOLOCKSHIFT))
(47 ("2,22" "2,62" NOLOCKSHIFT))
(31 ("2,5" "2,45" NOLOCKSHIFT))
(92 ("2,1" "2,41" NOLOCKSHIFT))
(80 ("2,13" "2,53" NOLOCKSHIFT))
(FONT ("2,112" "2,152" NOLOCKSHIFT))))
(AGAIN ("Function,Bs" "Function,(" NOLOCKSHIFT))
(CENTER ("Function,A" "Function,a" NOLOCKSHIFT))
(BOLD ("Function,B" "Function,b" NOLOCKSHIFT))
(ITALICS ("Function,C" "Function,c" NOLOCKSHIFT))
(UNDERLINE ("Function,F" "Function,f" NOLOCKSHIFT))
(SUPERSCRIPT ("Function,K" "Function,k" NOLOCKSHIFT))
(SUBSCRIPT ("Function,L" "Function,l" NOLOCKSHIFT))
(LARGER ("Function,H" "Function,h" NOLOCKSHIFT))
(DEFAULTS ("Function,M" "Function,m" NOLOCKSHIFT))
(93 ("Esc" "Function,64" NOLOCKSHIFT))
(47 ("Function,^R" "Function,62" NOLOCKSHIFT))
(31 ("Function,^E" "Function,%%" NOLOCKSHIFT))
(92 ("Function,^A" "Function,!" NOLOCKSHIFT))
(80 ("Function,^K" "Function,+" NOLOCKSHIFT))
(FONT ("Function,J" "Function,j" NOLOCKSHIFT))))
(RPAQQ \DLIONOSDKEYACTIONS ((56 LOCKTOGGLE)))
(RPAQQ \DORADOKEYACTIONS
((2 (54 "~" NOLOCKSHIFT))
((2 ("6" "~" NOLOCKSHIFT))
(10 ("-" "-" NOLOCKSHIFT))
(13 ("\" "|" NOLOCKSHIFT))
(14 (10 96 NOLOCKSHIFT))
(33 (27 27 NOLOCKSHIFT))
(14 ("LF" "`" NOLOCKSHIFT))
(33 ("Esc" "Esc" NOLOCKSHIFT))
(45 ("_" "^" NOLOCKSHIFT))))
(RPAQQ \DOVEKEYACTIONS
((2 (54 "^" NOLOCKSHIFT))
((2 ("6" "^" NOLOCKSHIFT))
(10 ("-" "_" NOLOCKSHIFT))
(33 (27 27 NOLOCKSHIFT))
(33 ("Esc" "Esc" NOLOCKSHIFT))
(56 CTRLDOWN . CTRLUP)
(65 (27 27 NOLOCKSHIFT))
(71 (39 34 NOLOCKSHIFT))
(93 ("2,24" "2,64" NOLOCKSHIFT))
(108 (96 126 NOLOCKSHIFT))
(65 ("Esc" "Esc" NOLOCKSHIFT))
(71 ("'" "%"" NOLOCKSHIFT))
(93 ("Function,^T" "Function,64" NOLOCKSHIFT))
(108 ("`" "~" NOLOCKSHIFT))
(DBK-META METADOWN . METAUP)
(DBK-HELP ("2,1" "2,41" NOLOCKSHIFT))
(DBK-HELP ("Function,^A" "Function,!" NOLOCKSHIFT))
(SAME METADOWN . METAUP)
(FIND ("2,3" "2,43" NOLOCKSHIFT))
(UNDO ("2,4" "2,44" NOLOCKSHIFT))
(STOP (5 7 NOLOCKSHIFT))
(EDIT ("2,5" "2,45" NOLOCKSHIFT))
(FIND ("Function,^C" "Function,#" NOLOCKSHIFT))
(UNDO ("Function,^D" "Function,$" NOLOCKSHIFT))
(STOP ("^E" "Bell" NOLOCKSHIFT))
(EDIT ("Function,^E" "Function,%%" NOLOCKSHIFT))
(MOVE)
(COPY)
(AGAIN ("2,10" "2,50" NOLOCKSHIFT))
(CENTER ("2,101" "2,141" NOLOCKSHIFT))
(BOLD ("2,102" "2,142" NOLOCKSHIFT))
(ITALICS ("2,103" "2,143" NOLOCKSHIFT))
(CASE ("2,104" "2,144" NOLOCKSHIFT))
(STRIKEOUT ("2,105" "2,145" NOLOCKSHIFT))
(UNDERLINE ("2,106" "2,146" NOLOCKSHIFT))
(SUPER/SUB ("2,107" "2,147" NOLOCKSHIFT))
(LARGER ("2,110" "2,150" NOLOCKSHIFT))
(MARGINS ("2,111" "2,151" NOLOCKSHIFT))
(LOOKS ("2,112" "2,152" NOLOCKSHIFT))
(AGAIN ("Function,Bs" "Function,(" NOLOCKSHIFT))
(CENTER ("Function,A" "Function,a" NOLOCKSHIFT))
(BOLD ("Function,B" "Function,b" NOLOCKSHIFT))
(ITALICS ("Function,C" "Function,c" NOLOCKSHIFT))
(CASE ("Function,D" "Function,d" NOLOCKSHIFT))
(STRIKEOUT ("Function,E" "Function,e" NOLOCKSHIFT))
(UNDERLINE ("Function,F" "Function,f" NOLOCKSHIFT))
(SUPER/SUB ("Function,G" "Function,g" NOLOCKSHIFT))
(LARGER ("Function,H" "Function,h" NOLOCKSHIFT))
(MARGINS ("Function,I" "Function,i" NOLOCKSHIFT))
(LOOKS ("Function,J" "Function,j" NOLOCKSHIFT))
(CAPSLOCK LOCKTOGGLE)
(NUMLOCK ("2,11" "-" NOLOCKSHIFT))
(SCROLLLOCK ("2,12" 180 NOLOCKSHIFT))
(BREAK (2 184 NOLOCKSHIFT))
(DOIT ("2,13" "2,53" NOLOCKSHIFT))
(KEYPAD7 ("2,14" 55 NOLOCKSHIFT))
(KEYPAD8 (173 56 NOLOCKSHIFT))
(KEYPAD9 ("2,15" 57 NOLOCKSHIFT))
(KEYPAD4 (172 52 NOLOCKSHIFT))
(KEYPAD5 ("2,16" 53 NOLOCKSHIFT))
(KEYPAD6 (174 54 NOLOCKSHIFT))
(KEYPAD1 ("2,17" 49 NOLOCKSHIFT))
(KEYPAD2 (175 50 NOLOCKSHIFT))
(KEYPAD3 ("2,20" 51 NOLOCKSHIFT))
(KEYPAD0 ("2,21" 48 NOLOCKSHIFT))
(KEYPAD%| ("|" 46 NOLOCKSHIFT))
(KEYPAD\ ("\" 44 NOLOCKSHIFT))
(47 ("2,22" "2,62" NOLOCKSHIFT))))
(NUMLOCK ("Function,Tab" "-" NOLOCKSHIFT))
(SCROLLLOCK ("Function,LF" "#4" NOLOCKSHIFT))
(BREAK ("^B" "#8" NOLOCKSHIFT))
(DOIT ("Function,^K" "Function,+" NOLOCKSHIFT))
(KEYPAD7 ("Function,FF" "7" NOLOCKSHIFT))
(KEYPAD8 ("#-" "8" NOLOCKSHIFT))
(KEYPAD9 ("Function,CR" "9" NOLOCKSHIFT))
(KEYPAD4 ("#," "4" NOLOCKSHIFT))
(KEYPAD5 ("Function,^N" "5" NOLOCKSHIFT))
(KEYPAD6 ("#." "6" NOLOCKSHIFT))
(KEYPAD1 ("Function,^O" "1" NOLOCKSHIFT))
(KEYPAD2 ("#/" "2" NOLOCKSHIFT))
(KEYPAD3 ("Function,^P" "3" NOLOCKSHIFT))
(KEYPAD0 ("Function,^Q" "0" NOLOCKSHIFT))
(KEYPAD%| ("|" "." NOLOCKSHIFT))
(KEYPAD\ ("\" "," NOLOCKSHIFT))
(47 ("Function,^R" "Function,62" NOLOCKSHIFT))))
(RPAQQ \DOVEOSDKEYACTIONS ((56 LOCKDOWN . LOCKUP)
(36 CTRLDOWN . CTRLUP)
(CAPSLOCK ("2,5" "2,45" NOLOCKSHIFT))))
(CAPSLOCK ("Function,^E" "Function,%%" NOLOCKSHIFT))))
(RPAQQ \MAIKOKEYACTIONS
((61 (5 7 NOLOCKSHIFT))
(91 (520 552 NOLOCKSHIFT))
(92 (513 545 NOLOCKSHIFT))
(30 (513 545 NOLOCKSHIFT))
(63 (516 548 NOLOCKSHIFT))
(93 (532 564 NOLOCKSHIFT))
((61 ("^E" "Bell" NOLOCKSHIFT))
(91 ("Function,Bs" "Function,(" NOLOCKSHIFT))
(92 ("Function,^A" "Function,!" NOLOCKSHIFT))
(30 ("Function,^A" "Function,!" NOLOCKSHIFT))
(63 ("Function,^D" "Function,$" NOLOCKSHIFT))
(93 ("Function,^T" "Function,64" NOLOCKSHIFT))
(62)
(111 (329 263 NOLOCKSHIFT))
(111 ("Meta,I" "Meta,Bell" NOLOCKSHIFT))
(89)
(90 (515 547 NOLOCKSHIFT))
(73 (521 521 NOLOCKSHIFT))
(74 (522 522 NOLOCKSHIFT))
(75 (2 2 NOLOCKSHIFT))
(81 (524 55 NOLOCKSHIFT))
(82 (173 56 NOLOCKSHIFT))
(83 (525 57 NOLOCKSHIFT))
(84 (172 52 NOLOCKSHIFT))
(85 (526 53 NOLOCKSHIFT))
(87 (174 54 NOLOCKSHIFT))
(94 (527 49 NOLOCKSHIFT))
(69 (175 50 NOLOCKSHIFT))
(70 (528 51 NOLOCKSHIFT))
(98 (529 48 NOLOCKSHIFT))
(76 (523 555 NOLOCKSHIFT))
(90 ("Function,^C" "Function,#" NOLOCKSHIFT))
(73 ("Function,Tab" "Function,Tab" NOLOCKSHIFT))
(74 ("Function,LF" "Function,LF" NOLOCKSHIFT))
(75 ("^B" "^B" NOLOCKSHIFT))
(81 ("Function,FF" "7" NOLOCKSHIFT))
(82 ("#-" "8" NOLOCKSHIFT))
(83 ("Function,CR" "9" NOLOCKSHIFT))
(84 ("#," "4" NOLOCKSHIFT))
(85 ("Function,^N" "5" NOLOCKSHIFT))
(87 ("#." "6" NOLOCKSHIFT))
(94 ("Function,^O" "1" NOLOCKSHIFT))
(69 ("#/" "2" NOLOCKSHIFT))
(70 ("Function,^P" "3" NOLOCKSHIFT))
(98 ("Function,^Q" "0" NOLOCKSHIFT))
(76 ("Function,^K" "Function,+" NOLOCKSHIFT))
(72 LOCKTOGGLE)
(97 (577 609 NOLOCKSHIFT))
(99 (578 610 NOLOCKSHIFT))
(100 (579 611 NOLOCKSHIFT))
(67 (580 612 NOLOCKSHIFT))
(68 (581 613 NOLOCKSHIFT))
(101 (582 614 NOLOCKSHIFT))
(66 (583 615 NOLOCKSHIFT))
(104 (584 616 NOLOCKSHIFT))
(80 (585 617 NOLOCKSHIFT))
(13 (23 21 NOLOCKSHIFT))
(33 (27 27 NOLOCKSHIFT))
(65 (27 27 NOLOCKSHIFT))
(2 (54 94 NOLOCKSHIFT))
(10 (45 95 NOLOCKSHIFT))
(97 ("Function,A" "Function,a" NOLOCKSHIFT))
(99 ("Function,B" "Function,b" NOLOCKSHIFT))
(100 ("Function,C" "Function,c" NOLOCKSHIFT))
(67 ("Function,D" "Function,d" NOLOCKSHIFT))
(68 ("Function,E" "Function,e" NOLOCKSHIFT))
(101 ("Function,F" "Function,f" NOLOCKSHIFT))
(66 ("Function,G" "Function,g" NOLOCKSHIFT))
(104 ("Function,H" "Function,h" NOLOCKSHIFT))
(80 ("Function,I" "Function,i" NOLOCKSHIFT))
(13 ("^W" "^U" NOLOCKSHIFT))
(33 ("Esc" "Esc" NOLOCKSHIFT))
(65 ("Esc" "Esc" NOLOCKSHIFT))
(2 ("6" "^" NOLOCKSHIFT))
(10 ("-" "_" NOLOCKSHIFT))
(36 CTRLDOWN . CTRLUP)
(56 LOCKTOGGLE . IGNORE)
(45 (96 126 NOLOCKSHIFT))
(45 ("`" "~" NOLOCKSHIFT))
(31 METADOWN . METAUP)
(14 METADOWN . METAUP)
(71 (10 10 NOLOCKSHIFT))
(47 (530 562 NOLOCKSHIFT))
(105 (92 124 NOLOCKSHIFT))))
(71 ("LF" "LF" NOLOCKSHIFT))
(47 ("Function,^R" "Function,62" NOLOCKSHIFT))
(105 ("\" "|" NOLOCKSHIFT))))
(RPAQQ \MAIKOKEYACTIONST4
((61 ("^E" "^G" NOLOCKSHIFT))
@ -1799,7 +1801,7 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
(14 METADOWN . METAUP)
(93 ("2,24" "2,64" NOLOCKSHIFT))
(62)
(111 ("1,111" "1,79" NOLOCKSHIFT))
(111 ("1,o" "1,O" NOLOCKSHIFT))
(89)
(90 ("2,3" "2,43" NOLOCKSHIFT))
(73 ("2,11" "2,11" NOLOCKSHIFT))
@ -1856,63 +1858,63 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
(10 ("\" "_" NOLOCKSHIFT))
(13 ("^W" "^U" NOLOCKSHIFT))
(14 METADOWN . METAUP)
(15 (8 8 NOLOCKSHIFT))
(15 ("Bs" "Bs" NOLOCKSHIFT))
(17 ("2" "%"" NOLOCKSHIFT))
(22 ("9" ")" NOLOCKSHIFT))
(28 (":" "*" NOLOCKSHIFT))
(29 ("[" "{" NOLOCKSHIFT))
(30 ("]" "}" NOLOCKSHIFT))
(31 METADOWN . METAUP)
(33 ("ESC" "ESC" NOLOCKSHIFT))
(33 ("Esc" "Esc" NOLOCKSHIFT))
(36 CTRLDOWN . CTRLUP)
(43 (";" "+" NOLOCKSHIFT))
(45 ("^" "~" NOLOCKSHIFT))
(47 ("2,22" "2,62" NOLOCKSHIFT))
(47 ("Function,^R" "Function,62" NOLOCKSHIFT))
(53 ("8" "(" NOLOCKSHIFT))
(56 LOCKTOGGLE . IGNORE)
(58 ("@" "`" NOLOCKSHIFT))
(59 ("-" "=" NOLOCKSHIFT))
(61 ("^E" "^G" NOLOCKSHIFT))
(61 ("^E" "Bell" NOLOCKSHIFT))
(62)
(63 ("2,4" "2,44" NOLOCKSHIFT))
(64 ("2,14" 55 NOLOCKSHIFT))
(65 (27 27 NOLOCKSHIFT))
(66 ("2,107" "2,147" NOLOCKSHIFT))
(67 ("2,104" "2,144" NOLOCKSHIFT))
(69 ("2,13" "2,53" NOLOCKSHIFT))
(70 ("2,20" 51 NOLOCKSHIFT))
(71 (10 10 NOLOCKSHIFT))
(72 (766 766 NOLOCKSHIFT))
(73 ("2,11" "2,11" NOLOCKSHIFT))
(74 ("2,12" "2,12" NOLOCKSHIFT))
(63 ("Function,^D" "Function,$" NOLOCKSHIFT))
(64 ("Function,FF" "7" NOLOCKSHIFT))
(65 ("Esc" "Esc" NOLOCKSHIFT))
(66 ("Function,G" "Function,g" NOLOCKSHIFT))
(67 ("Function,D" "Function,d" NOLOCKSHIFT))
(69 ("Function,^K" "Function,+" NOLOCKSHIFT))
(70 ("Function,^P" "3" NOLOCKSHIFT))
(71 ("LF" "LF" NOLOCKSHIFT))
(72 ("Function,#~" "Function,#~" NOLOCKSHIFT))
(73 ("Function,Tab" "Function,Tab" NOLOCKSHIFT))
(74 ("Function,LF" "Function,LF" NOLOCKSHIFT))
(75 ("^B" "^B" NOLOCKSHIFT))
(80 ("2,111" "2,151" NOLOCKSHIFT))
(81 ("2,14" 55 NOLOCKSHIFT))
(82 (173 56 NOLOCKSHIFT))
(83 ("2,15" 57 NOLOCKSHIFT))
(84 (172 52 NOLOCKSHIFT))
(85 ("2,16" 53 NOLOCKSHIFT))
(86 (765 765 NOLOCKSHIFT))
(87 (174 54 NOLOCKSHIFT))
(88 (770 771 NOLOCKSHIFT))
(90 ("2,3" "2,43" NOLOCKSHIFT))
(91 ("2,10" "2,50" NOLOCKSHIFT))
(92 ("2,1" "2,41" NOLOCKSHIFT))
(93 ("2,24" "2,64" NOLOCKSHIFT))
(80 ("Function,I" "Function,i" NOLOCKSHIFT))
(81 ("Function,FF" "7" NOLOCKSHIFT))
(82 ("#-" "8" NOLOCKSHIFT))
(83 ("Function,CR" "9" NOLOCKSHIFT))
(84 ("#," "4" NOLOCKSHIFT))
(85 ("Function,^N" "5" NOLOCKSHIFT))
(86 ("Function,#}" "Function,#}" NOLOCKSHIFT))
(87 ("#." "6" NOLOCKSHIFT))
(88 ("3,^B" "3,^C" NOLOCKSHIFT))
(90 ("Function,^C" "Function,#" NOLOCKSHIFT))
(91 ("Function,Bs" "Function,(" NOLOCKSHIFT))
(92 ("Function,^A" "Function,!" NOLOCKSHIFT))
(93 ("Function,^T" "Function,64" NOLOCKSHIFT))
(96 IGNORE . IGNORE)
(98 ("2,21" 48 NOLOCKSHIFT))
(99 ("2,102" "2,142" NOLOCKSHIFT))
(101 ("2,106" "2,146" NOLOCKSHIFT))
(98 ("Function,^Q" "0" NOLOCKSHIFT))
(99 ("Function,B" "Function,b" NOLOCKSHIFT))
(101 ("Function,F" "Function,f" NOLOCKSHIFT))
(102 IGNORE . IGNORE)
(103 (767 768 NOLOCKSHIFT))
(104 ("2,110" "2,150" NOLOCKSHIFT))
(103 ("Function,#Del" "3,Null" NOLOCKSHIFT))
(104 ("Function,H" "Function,h" NOLOCKSHIFT))
(105 ("\" "|" NOLOCKSHIFT))
(106 ("2,113" "2,153" NOLOCKSHIFT))
(107 ("2,114" "2,154" NOLOCKSHIFT))
(108 ("2,115" "2,155" NOLOCKSHIFT))
(109 (769 769 NOLOCKSHIFT))
(110 ("2,53" "2,53" NOLOCKSHIFT))
(111 ("1,111" "1,79" NOLOCKSHIFT))))
(106 ("Function,K" "Function,k" NOLOCKSHIFT))
(107 ("Function,L" "Function,l" NOLOCKSHIFT))
(108 ("Function,M" "Function,m" NOLOCKSHIFT))
(109 ("3,^A" "3,^A" NOLOCKSHIFT))
(110 ("Function,+" "Function,+" NOLOCKSHIFT))
(111 ("Meta,o" "Meta,O" NOLOCKSHIFT))))
(RPAQQ \TOSHIBA-KEYACTIONS
((2 ("6" "&" NOLOCKSHIFT))
@ -1929,26 +1931,26 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
(105 ("]" "}" NOLOCKSHIFT))
(43 (";" "+" NOLOCKSHIFT))
(28 (":" "*" NOLOCKSHIFT))
(15 (23 95 NOLOCKSHIFT))
(13 (8 8 NOLOCKSHIFT))
(15 ("^W" "_" NOLOCKSHIFT))
(13 ("Bs" "Bs" NOLOCKSHIFT))
(86 METADOWN . METAUP)
(73 (530 562 NOLOCKSHIFT))
(88 ("2,24" "2,64" NOLOCKSHIFT))
(73 ("Function,^R" "Function,62" NOLOCKSHIFT))
(88 ("Function,^T" "Function,64" NOLOCKSHIFT))
(98 IGNORE . IGNORE)
(75 ("2,11" "2,11" NOLOCKSHIFT))
(110 ("2,12" "2,12" NOLOCKSHIFT))
(75 ("Function,Tab" "Function,Tab" NOLOCKSHIFT))
(110 ("Function,LF" "Function,LF" NOLOCKSHIFT))
(74 ("^B" "^B" NOLOCKSHIFT))
(64 ("2,14" 55 NOLOCKSHIFT))
(65 (173 56 NOLOCKSHIFT))
(95 ("2,15" 57 NOLOCKSHIFT))
(81 (172 52 NOLOCKSHIFT))
(82 ("2,16" 53 NOLOCKSHIFT))
(83 (174 54 NOLOCKSHIFT))
(84 ("2,17" 49 NOLOCKSHIFT))
(85 (175 50 NOLOCKSHIFT))
(87 ("2,20" 51 NOLOCKSHIFT))
(94 ("2,21" 48 NOLOCKSHIFT))
(69 ("2,13" "2,53" NOLOCKSHIFT))
(64 ("Function,FF" "7" NOLOCKSHIFT))
(65 ("#-" "8" NOLOCKSHIFT))
(95 ("Function,CR" "9" NOLOCKSHIFT))
(81 ("#," "4" NOLOCKSHIFT))
(82 ("Function,^N" "5" NOLOCKSHIFT))
(83 ("#." "6" NOLOCKSHIFT))
(84 ("Function,^O" "1" NOLOCKSHIFT))
(85 ("#/" "2" NOLOCKSHIFT))
(87 ("Function,^P" "3" NOLOCKSHIFT))
(94 ("Function,^Q" "0" NOLOCKSHIFT))
(69 ("Function,^K" "Function,+" NOLOCKSHIFT))
(70 LOCKTOGGLE)))
(RPAQQ KEYBOARD.APPLICATION-SPECIFIC-KEYACTIONS NIL)
@ -1975,13 +1977,13 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
(DEFINEQ
(KEYACTION
[LAMBDA (KEYNAME ACTIONS TABLE) (* ; "Edited 19-Nov-87 16:19 by Snow")
(LET ((NUMB (OR (SMALLP KEYNAME)
[LAMBDA (KEYNAME ACTIONS TABLE) (* ; "Edited 24-Aug-2021 16:54 by rmk:")
(LET ((NUMB (OR (KEYNUMBERP KEYNAME)
(\KEYNAMETONUMBER KEYNAME)))
(TABLE (OR TABLE \CURRENTKEYACTION)))
(OR (TYPE? KEYACTION TABLE)
(\ILLEGAL.ARG TABLE)) (* ;
 "Make sure he supplied a valid TABLE argument.")
(\ILLEGAL.ARG TABLE)) (* ;
 "Make sure he supplied a valid TABLE argument.")
(CONS (\KEYACTION1 (\TRANSINDEX NUMB T)
(AND ACTIONS (OR (CAR ACTIONS)
'IGNORE))
@ -2318,6 +2320,11 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
when (EQMEMB N Y) do (RETURN I)))
(\ILLEGAL.ARG KEYNAME])
(\KEYNUMBERTONAME
[LAMBDA (KEYNUMBER)
(DECLARE (GLOBALVARS \KEYNAMES)) (* ; "Edited 24-Aug-2021 16:03 by rmk:")
(CAR (NTH \KEYNAMES (ADD1 KEYNUMBER])
(MODIFY.KEYACTIONS
[LAMBDA (KeyActions SaveCurrent?) (* ; "Edited 2-Feb-89 15:38 by GADENER")
(PROG1 [if SaveCurrent?
@ -3917,32 +3924,33 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
(PUTPROPS LLKEY COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1989 1990
1992 1999 1920 2000 2018 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (14679 21995 (BKSYSCHARCODE 14689 . 15038) (\CLEARSYSBUF 15040 . 15598) (\GETKEY 15600
. 16775) (\NSYSBUFCHARS 16777 . 17519) (\SAVESYSBUF 17521 . 19130) (\SYSBUFP 19132 . 19436) (
\GETSYSBUF 19438 . 19618) (\PUTSYSBUF 19620 . 20833) (\PEEKSYSBUF 20835 . 21993)) (23292 60126 (
\KEYBOARDINIT 23302 . 25022) (\KEYBOARDEVENTFN 25024 . 29724) (\ALLOCLOCKED 29726 . 30316) (
\SETIOPOINTERS 30318 . 34854) (\KEYBOARDOFF 34856 . 35270) (\KEYBOARDON 35272 . 35651) (\KEYHANDLER
35653 . 35784) (\KEYHANDLER1 35786 . 43232) (\RESETKEYBOARD 43234 . 44882) (\DOMOUSECHORDING 44884 .
48704) (\DOTRANSITIONS 48706 . 49383) (\DECODETRANSITION 49385 . 56074) (MOUSECHORDWAIT 56076 . 56740)
(\TRACKCURSOR 56742 . 60124)) (93868 115217 (KEYACTION 93878 . 94722) (KEYACTIONTABLE 94724 . 95906)
(KEYBOARDTYPE 95908 . 97010) (RESETKEYACTION 97012 . 98771) (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS
98773 . 100675) (\KEYACTION1 100677 . 110793) (KEYDOWNP 110795 . 111130) (KEYNUMBERP 111132 . 111330)
(\KEYNAMETONUMBER 111332 . 112026) (MODIFY.KEYACTIONS 112028 . 112889) (METASHIFT 112891 . 113835) (
SHIFTDOWNP 113837 . 115215)) (115280 115576 (SETUP.OFFICE.KEYBOARD 115290 . 115574)) (118279 119991 (
\INIT.KEYBOARD.STREAM 118289 . 119989)) (120256 136633 (\DOBUFFEREDTRANSITIONS 120266 . 135696) (
\TIMER.INTERRUPTFRAME 135698 . 136423) (\PERIODIC.INTERRUPTFRAME 136425 . 136631)) (136887 140964 (
\HARDCURSORUP 136897 . 138779) (\HARDCURSORPOSITION 138781 . 140817) (\HARDCURSORDOWN 140819 . 140962)
) (140965 165025 (CURSOR.INIT 140975 . 144675) (\CURSORDESTINATION 144677 . 146995) (\SOFTCURSORUP
146997 . 152251) (\SOFTCURSORUPCURRENT 152253 . 159289) (\SOFTCURSORPOSITION 159291 . 160056) (
\SOFTCURSORDOWN 160058 . 160766) (CURSORPROP 160768 . 161110) (GETCURSORPROP 161112 . 161300) (
PUTCURSORPROP 161302 . 162457) (\CURSORBITSPERPIXEL 162459 . 164575) (\CURSORIMAGEPROPNAME 164577 .
164801) (\CURSORMASKPROPNAME 164803 . 165023)) (165026 182976 (CURSORCREATE 165036 . 167711) (CURSOR
167713 . 169525) (\CURSOR-VALID-P 169527 . 170614) (\CURSORUP 170616 . 172331) (\CURSORPOSITION 172333
. 174861) (\CURSORDOWN 174863 . 175096) (ADJUSTCURSORPOSITION 175098 . 175676) (CURSORPOSITION 175678
. 177220) (CURSORSCREEN 177222 . 177878) (CURSOREXIT 177880 . 179271) (FLIPCURSOR 179273 . 180399) (
FLIPCURSORBAR 180401 . 181381) (LASTMOUSEX 181383 . 181637) (LASTMOUSEY 181639 . 181893) (
CREATEPOSITION 181895 . 182101) (POSITIONP 182103 . 182387) (CURSORHOTSPOT 182389 . 182974)) (184214
185762 (GETMOUSESTATE 184224 . 184883) (\EVENTKEYS 184885 . 185760)) (192189 192985 (MACHINETYPE
192199 . 192599) (SETMAINTPANEL 192601 . 192983)) (193015 194154 (BEEPON 193025 . 193678) (BEEPOFF
193680 . 194152)) (194605 194868 (WITHOUT-INTERRUPTS 194615 . 194866)))))
(FILEMAP (NIL (14733 22049 (BKSYSCHARCODE 14743 . 15092) (\CLEARSYSBUF 15094 . 15652) (\GETKEY 15654
. 16829) (\NSYSBUFCHARS 16831 . 17573) (\SAVESYSBUF 17575 . 19184) (\SYSBUFP 19186 . 19490) (
\GETSYSBUF 19492 . 19672) (\PUTSYSBUF 19674 . 20887) (\PEEKSYSBUF 20889 . 22047)) (23346 60180 (
\KEYBOARDINIT 23356 . 25076) (\KEYBOARDEVENTFN 25078 . 29778) (\ALLOCLOCKED 29780 . 30370) (
\SETIOPOINTERS 30372 . 34908) (\KEYBOARDOFF 34910 . 35324) (\KEYBOARDON 35326 . 35705) (\KEYHANDLER
35707 . 35838) (\KEYHANDLER1 35840 . 43286) (\RESETKEYBOARD 43288 . 44936) (\DOMOUSECHORDING 44938 .
48758) (\DOTRANSITIONS 48760 . 49437) (\DECODETRANSITION 49439 . 56128) (MOUSECHORDWAIT 56130 . 56794)
(\TRACKCURSOR 56796 . 60178)) (95464 117014 (KEYACTION 95474 . 96327) (KEYACTIONTABLE 96329 . 97511)
(KEYBOARDTYPE 97513 . 98615) (RESETKEYACTION 98617 . 100376) (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS
100378 . 102280) (\KEYACTION1 102282 . 112398) (KEYDOWNP 112400 . 112735) (KEYNUMBERP 112737 . 112935)
(\KEYNAMETONUMBER 112937 . 113631) (\KEYNUMBERTONAME 113633 . 113823) (MODIFY.KEYACTIONS 113825 .
114686) (METASHIFT 114688 . 115632) (SHIFTDOWNP 115634 . 117012)) (117077 117373 (
SETUP.OFFICE.KEYBOARD 117087 . 117371)) (120076 121788 (\INIT.KEYBOARD.STREAM 120086 . 121786)) (
122053 138430 (\DOBUFFEREDTRANSITIONS 122063 . 137493) (\TIMER.INTERRUPTFRAME 137495 . 138220) (
\PERIODIC.INTERRUPTFRAME 138222 . 138428)) (138684 142761 (\HARDCURSORUP 138694 . 140576) (
\HARDCURSORPOSITION 140578 . 142614) (\HARDCURSORDOWN 142616 . 142759)) (142762 166822 (CURSOR.INIT
142772 . 146472) (\CURSORDESTINATION 146474 . 148792) (\SOFTCURSORUP 148794 . 154048) (
\SOFTCURSORUPCURRENT 154050 . 161086) (\SOFTCURSORPOSITION 161088 . 161853) (\SOFTCURSORDOWN 161855 .
162563) (CURSORPROP 162565 . 162907) (GETCURSORPROP 162909 . 163097) (PUTCURSORPROP 163099 . 164254) (
\CURSORBITSPERPIXEL 164256 . 166372) (\CURSORIMAGEPROPNAME 166374 . 166598) (\CURSORMASKPROPNAME
166600 . 166820)) (166823 184773 (CURSORCREATE 166833 . 169508) (CURSOR 169510 . 171322) (
\CURSOR-VALID-P 171324 . 172411) (\CURSORUP 172413 . 174128) (\CURSORPOSITION 174130 . 176658) (
\CURSORDOWN 176660 . 176893) (ADJUSTCURSORPOSITION 176895 . 177473) (CURSORPOSITION 177475 . 179017) (
CURSORSCREEN 179019 . 179675) (CURSOREXIT 179677 . 181068) (FLIPCURSOR 181070 . 182196) (FLIPCURSORBAR
182198 . 183178) (LASTMOUSEX 183180 . 183434) (LASTMOUSEY 183436 . 183690) (CREATEPOSITION 183692 .
183898) (POSITIONP 183900 . 184184) (CURSORHOTSPOT 184186 . 184771)) (186011 187559 (GETMOUSESTATE
186021 . 186680) (\EVENTKEYS 186682 . 187557)) (193986 194782 (MACHINETYPE 193996 . 194396) (
SETMAINTPANEL 194398 . 194780)) (194812 195951 (BEEPON 194822 . 195475) (BEEPOFF 195477 . 195949)) (
196402 196665 (WITHOUT-INTERRUPTS 196412 . 196663)))))
STOP

BIN
sources/LLKEY.LCOM
View File

Binary file not shown.

178
sources/LLREAD
View File

@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "21-Aug-2021 13:00:01" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;98 103410
(FILECREATED "24-Aug-2021 10:04:18" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;103 105490
changes to%: (FNS CHARCODE.DECODE)
previous date%: "20-Aug-2021 00:02:20"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;96)
previous date%: "24-Aug-2021 08:32:13"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;101)
(* ; "
@ -35,6 +35,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
ESTIMATE-DIMENSIONALITY SKIP.HASH.COMMENT CMLREAD.FEATURE.PARSER))
(COMS (* ; "Reading characters with #\")
(FNS CHARACTER.READ CHARCODE.DECODE)
(FNS HEXNUM? OCTALNUM?)
(VARS CHARACTERNAMES CHARACTERSETNAMES))
(DECLARE%: DOEVAL@COMPILE DONTCOPY (CONSTANTS * READTYPES)
(MACROS .CALL.SUBREAD. FIXDOT RBCONTEXT PROPRB \RDCONC)
@ -1396,7 +1397,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(READ-EXTENDED-TOKEN STREAM])
(CHARCODE.DECODE
[LAMBDA (C NOERROR) (* ; "Edited 21-Aug-2021 12:59 by rmk:")
[LAMBDA (C NOERROR) (* ; "Edited 24-Aug-2021 10:03 by rmk:")
(* ; "Edited 18-Feb-87 22:03 by bvm:")
(DECLARE (GLOBALVARS CHARACTERNAMES CHARACTERSETNAMES))
@ -1425,16 +1426,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
 "LITATOM instead of ATOM stops numbers right here. ")
(AND (NOT NOERROR)
(ERROR "BAD CHARACTER SPECIFICATION" C)))
[(AND (SELCHARQ (CHCON1 C)
(0 (* ; "Hex? 0X or 0x")
(FMEMB (NTHCHARCODE C 2)
(CHARCODE (x X))))
((U u) (* ; "Unicode U+ or u+")
(EQ (NTHCHARCODE C 2)
(CHARCODE +)))
NIL)
(CAR (NLSETQ (CL:PARSE-INTEGER (SUBSTRING C 3)
:RADIX 16]
((HEXNUM? C T))
(T
(SELCHARQ (CHCON1 C)
(^ (AND (SETQ C (CHARCODE.DECODE (SUBSTRING C 2 -1)
@ -1453,52 +1445,94 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
do (RETURN (OR (NUMBERP (CADR X))
(CHARCODE.DECODE (CADR X)
NOERROR)))
finally
(RETURN (LET ((POS (STRPOSL '(%, - "." "|")
C))
CH CSET SSTR) (* ; "In the form charset,char")
finally (RETURN
(LET ([POS (find I from 1
suchthat (FMEMB (OR (NTHCHARCODE C I)
(RETURN))
(CHARCODE (%, - %. %|]
CH CSET SSTR) (* ; "In the form charset,char")
(* ;; "The character set loop is like the character loop with a different search list and no recursion for character sets.")
(* ;;
 "Don't use STRPOSL because CHARTABLE is not available in loadup sequence.")
(COND
((AND POS (SETQ CH (OR (CAR (NLSETQ (CL:PARSE-INTEGER
(SETQ SSTR (SUBSTRING
C
(ADD1 POS)))
:RADIX 8)))
(CHARCODE.DECODE SSTR NOERROR)))
(< CH 256)
(>= CH 0)
[SETQ CSET
(OR (CAR (NLSETQ (CL:PARSE-INTEGER (SETQ SSTR
(SUBSTRING
C 1 (SUB1 POS)))
:RADIX 8)))
(CADR (find PAIR in CHARACTERSETNAMES
suchthat
(* ;; "The character set loop is like the character loop with a different search list and no recursion for character sets.")
(* ;;
 "No recursion, if not a number the list is bad, not C")
(COND
((AND POS (SETQ CH (OR [OCTALNUM? (SETQ SSTR
(SUBSTRING C (ADD1 POS]
(CHARCODE.DECODE SSTR NOERROR)))
(< CH 256)
(>= CH 0)
(SETQ CSET (OR [OCTALNUM? (SETQ SSTR
(SUBSTRING C 1 (SUB1 POS]
(CADR (find PAIR in
CHARACTERSETNAMES
suchthat
(STRING.EQUAL (CAR PAIR)
SSTR)))
(AND (SELCHARQ (CHCON1 SSTR)
(0 (* ; "Hex? 0X or 0x")
(FMEMB (NTHCHARCODE SSTR 2)
(CHARCODE (x X))))
((U u) (* ; "Unicode U+ or u+")
(EQ (NTHCHARCODE SSTR 2)
(CHARCODE +)))
NIL)
(CAR (NLSETQ (CL:PARSE-INTEGER (SUBSTRING SSTR 3)
:RADIX 16]
(< CSET 256)
(>= CSET 0)) (* ;
(* ;;
 "No recursion. If not a number the list is bad even if C is OK")
(STRING.EQUAL (CAR PAIR)
SSTR)))
(HEXNUM? SSTR T)))
(< CSET 256)
(>= CSET 0)) (* ;
 "parsed the charset part as an octal, standard charset name, or hex")
(LOGOR (LLSH CSET 8)
CH))
((NOT NOERROR)
(ERROR "BAD CHARACTER SPECIFICATION" C])
(LOGOR (LLSH CSET 8)
CH))
((NOT NOERROR)
(ERROR "BAD CHARACTER SPECIFICATION" C])
)
(DEFINEQ
(HEXNUM?
[LAMBDA (STR PREFIXED?) (* ; "Edited 24-Aug-2021 08:31 by rmk:")
(* ;; "Returns the number encoded as a hex representation in STR, NIL if it is not an unsigned hex string. The hex digits can be upper or lower case.")
(* ;; "If PREFIXED?, then hex ending must follow one of 0x, 0X, u+, U+ prefixes")
(* ;; "CL:PARSE-INTEGER with JUNK-ALLOWED would also return NIL, but it would trim commonlisp seprs...and also depends on CHARTABLE which is not available at the right place in the loadup.")
(CL:WHEN [OR (NOT PREFIXED?)
(AND (SELCHARQ (CHCON1 STR)
(0 (* ; "Hex? 0X or 0x")
(FMEMB (NTHCHARCODE STR 2)
(CHARCODE (x X))))
((U u) (* ; "Unicode U+ or u+")
(EQ (NTHCHARCODE STR 2)
(CHARCODE +)))
NIL)
(SETQ STR (SUBSTRING STR 3 NIL (CONSTANT (CONCAT]
(FOR I C (NUM _ 0) FROM 1 WHILE (SETQ C (NTHCHARCODE STR I))
DO [SETQ C (IDIFFERENCE C (IF (AND (IGEQ C (CHARCODE 0))
(ILEQ C (CHARCODE 9)))
THEN (CHARCODE 0)
ELSEIF (IF (AND (IGEQ C (CHARCODE a))
(ILEQ C (CHARCODE f)))
THEN (IDIFFERENCE (CHARCODE a)
10)
ELSEIF (AND (IGEQ C (CHARCODE A))
(ILEQ C (CHARCODE F)))
THEN (IDIFFERENCE (CHARCODE A)
10))
ELSE (RETURN NIL]
(SETQ NUM (IPLUS (LLSH NUM 4)
C)) FINALLY (RETURN NUM)))])
(OCTALNUM?
[LAMBDA (STR) (* ; "Edited 24-Aug-2021 08:25 by rmk:")
(* ;; "Returns the number encoded as an octal representation in STR, NIL if it is not an unsigned octal string.")
(* ;; "CL:PARSE-INTEGER with JUNK-ALLOWED would also return NIL, but it would trim commonlisp seprs...and also depends on CHARTABLE which is not available at the right place in the loadup.")
(FOR I C (NUM _ 0) FROM 1 WHILE (SETQ C (NTHCHARCODE STR I))
DO (IF (AND (IGEQ C (CHARCODE 0))
(ILEQ C (CHARCODE 7)))
THEN [SETQ NUM (IPLUS (LLSH NUM 3)
(IDIFFERENCE C (CHARCODE 0]
ELSE (RETURN NIL)) FINALLY (RETURN NUM])
)
(RPAQQ CHARACTERNAMES
@ -1912,20 +1946,20 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(PUTPROPS LLREAD COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990
1991 1993 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3476 11705 (LASTC 3486 . 3792) (PEEKC 3794 . 4182) (PEEKCCODE 4184 . 4477) (RATOM 4479
. 5560) (READ 5562 . 6122) (READC 6124 . 6765) (READCCODE 6767 . 7526) (READP 7528 . 8080) (
SETREADMACROFLG 8082 . 8381) (SKIPSEPRCODES 8383 . 9366) (SKIPSEPRS 9368 . 9754) (SKREAD 9756 . 11703)
) (11751 20360 (CL:READ 11761 . 12310) (CL:READ-PRESERVING-WHITESPACE 12312 . 13034) (
CL:READ-DELIMITED-LIST 13036 . 13951) (CL:PARSE-INTEGER 13953 . 20358)) (20453 32930 (RSTRING 20463 .
21195) (READ-EXTENDED-TOKEN 21197 . 25069) (\RSTRING2 25071 . 32928)) (32966 64106 (\TOP-LEVEL-READ
32976 . 34959) (\SUBREAD 34961 . 60522) (\SUBREADCONCAT 60524 . 61147) (\ORIG-READ.SYMBOL 61149 .
62217) (\ORIG-INVALID.SYMBOL 62219 . 63118) (\APPLYREADMACRO 63120 . 63536) (INREADMACROP 63538 .
64104)) (64265 64440 (READQUOTE 64275 . 64438)) (64465 76369 (READVBAR 64475 . 65806) (READHASHMACRO
65808 . 71618) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71620 . 71840) (DIGITBASEP 71842 . 72576) (
READNUMBERINBASE 72578 . 74464) (ESTIMATE-DIMENSIONALITY 74466 . 74791) (SKIP.HASH.COMMENT 74793 .
75761) (CMLREAD.FEATURE.PARSER 75763 . 76367)) (76413 83888 (CHARACTER.READ 76423 . 77677) (
CHARCODE.DECODE 77679 . 83886)) (88360 100854 (\OUTCHAR 88370 . 89506) (\INCCODE 89508 . 90694) (
\BACKCCODE 90696 . 91590) (\BACKCCODE.EOLC 91592 . 94355) (\PEEKCCODE 94357 . 94673) (
\PEEKCCODE.NOEOLC 94675 . 94937) (\INCCODE.EOLC 94939 . 96798) (\FORMATBYTESTREAM 96800 . 98286) (
\CHECKEOLC.CRLF 98288 . 100852)))))
(FILEMAP (NIL (3516 11745 (LASTC 3526 . 3832) (PEEKC 3834 . 4222) (PEEKCCODE 4224 . 4517) (RATOM 4519
. 5600) (READ 5602 . 6162) (READC 6164 . 6805) (READCCODE 6807 . 7566) (READP 7568 . 8120) (
SETREADMACROFLG 8122 . 8421) (SKIPSEPRCODES 8423 . 9406) (SKIPSEPRS 9408 . 9794) (SKREAD 9796 . 11743)
) (11791 20400 (CL:READ 11801 . 12350) (CL:READ-PRESERVING-WHITESPACE 12352 . 13074) (
CL:READ-DELIMITED-LIST 13076 . 13991) (CL:PARSE-INTEGER 13993 . 20398)) (20493 32970 (RSTRING 20503 .
21235) (READ-EXTENDED-TOKEN 21237 . 25109) (\RSTRING2 25111 . 32968)) (33006 64146 (\TOP-LEVEL-READ
33016 . 34999) (\SUBREAD 35001 . 60562) (\SUBREADCONCAT 60564 . 61187) (\ORIG-READ.SYMBOL 61189 .
62257) (\ORIG-INVALID.SYMBOL 62259 . 63158) (\APPLYREADMACRO 63160 . 63576) (INREADMACROP 63578 .
64144)) (64305 64480 (READQUOTE 64315 . 64478)) (64505 76409 (READVBAR 64515 . 65846) (READHASHMACRO
65848 . 71658) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71660 . 71880) (DIGITBASEP 71882 . 72616) (
READNUMBERINBASE 72618 . 74504) (ESTIMATE-DIMENSIONALITY 74506 . 74831) (SKIP.HASH.COMMENT 74833 .
75801) (CMLREAD.FEATURE.PARSER 75803 . 76407)) (76453 82797 (CHARACTER.READ 76463 . 77717) (
CHARCODE.DECODE 77719 . 82795)) (82798 85968 (HEXNUM? 82808 . 85151) (OCTALNUM? 85153 . 85966)) (90440
102934 (\OUTCHAR 90450 . 91586) (\INCCODE 91588 . 92774) (\BACKCCODE 92776 . 93670) (\BACKCCODE.EOLC
93672 . 96435) (\PEEKCCODE 96437 . 96753) (\PEEKCCODE.NOEOLC 96755 . 97017) (\INCCODE.EOLC 97019 .
98878) (\FORMATBYTESTREAM 98880 . 100366) (\CHECKEOLC.CRLF 100368 . 102932)))))
STOP

BIN
sources/LLREAD.LCOM
View File

Binary file not shown.