Merge pull request #1256 from Interlisp/Minor-updates-to-LLREAD-and-SEDIT
Minor updates to llread and sedit
This commit is contained in:
Larry Masinter
GitHub
commit
d21dfe1061
103
sources/LLREAD
103
sources/LLREAD
@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Jul-2022 23:36:54"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLREAD.;102 89980
|
||||
(FILECREATED "17-Jun-2023 13:12:06" {WMEDLEY}<sources>LLREAD.;104 90176
|
||||
|
||||
:CHANGES-TO (FNS PEEKCCODE SKIPSEPRCODES \SUBREAD)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "10-Sep-2021 19:41:58"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLREAD.;101)
|
||||
:CHANGES-TO (VARS LLREADCOMS CHARACTERNAMES)
|
||||
|
||||
:PREVIOUS-DATE "19-Jul-2022 23:36:54" {WMEDLEY}<sources>LLREAD.;102)
|
||||
|
||||
|
||||
(* ; "
|
||||
@ -37,7 +37,10 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
|
||||
(COMS (* ; "Reading characters with #\")
|
||||
(FNS CHARACTER.READ CHARCODE.DECODE)
|
||||
(FNS HEXNUM? OCTALNUM?)
|
||||
(VARS CHARACTERNAMES CHARACTERSETNAMES))
|
||||
(ALISTS (CHARACTERNAMES Page Form FF Rubout Del Null Escape Esc Bell Tab Backspace Bs
|
||||
Newline CR EOL Return Tenexeol Space Sp Linefeed LF)
|
||||
(CHARACTERSETNAMES Meta Function Greek Cyrillic Hira Hiragana Kata Katakana
|
||||
Kanji)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (CONSTANTS * READTYPES)
|
||||
(MACROS .CALL.SUBREAD. FIXDOT RBCONTEXT PROPRB \RDCONC)
|
||||
(SPECVARS *READ-NEWLINE-SUPPRESS* \RefillBufferFn)
|
||||
@ -1523,38 +1526,38 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
|
||||
ELSE (RETURN NIL)) FINALLY (RETURN NUM])
|
||||
)
|
||||
|
||||
(RPAQQ CHARACTERNAMES
|
||||
(("Page" 12)
|
||||
("Form" 12)
|
||||
("FF" 12)
|
||||
("Rubout" 127)
|
||||
("Del" 127)
|
||||
("Null" 0)
|
||||
("Escape" 27)
|
||||
("Esc" 27)
|
||||
("Bell" 7)
|
||||
("Tab" 9)
|
||||
("Backspace" 8)
|
||||
("Bs" 8)
|
||||
("Newline" 13)
|
||||
("CR" 13)
|
||||
("EOL" 13)
|
||||
("Return" 13)
|
||||
("Tenexeol" 31)
|
||||
("Space" 32)
|
||||
("Sp" 32)
|
||||
("Linefeed" 10)
|
||||
("LF" 10)))
|
||||
(ADDTOVAR CHARACTERNAMES
|
||||
(Page 12)
|
||||
(Form 12)
|
||||
(FF 12)
|
||||
(Rubout 127)
|
||||
(Del 127)
|
||||
(Null 0)
|
||||
(Escape 27)
|
||||
(Esc 27)
|
||||
(Bell 7)
|
||||
(Tab 9)
|
||||
(Backspace 8)
|
||||
(Bs 8)
|
||||
(Newline 13)
|
||||
(CR 13)
|
||||
(EOL 13)
|
||||
(Return 13)
|
||||
(Tenexeol 31)
|
||||
(Space 32)
|
||||
(Sp 32)
|
||||
(Linefeed 10)
|
||||
(LF 10))
|
||||
|
||||
(RPAQQ CHARACTERSETNAMES (("Meta" 1)
|
||||
("Function" 2)
|
||||
("Greek" 38)
|
||||
("Cyrillic" 39)
|
||||
("Hira" 36)
|
||||
("Hiragana" 36)
|
||||
("Kata" 37)
|
||||
("Katakana" 37)
|
||||
("Kanji" 48)))
|
||||
(ADDTOVAR CHARACTERSETNAMES (Meta 1)
|
||||
(Function 2)
|
||||
(Greek 38)
|
||||
(Cyrillic 39)
|
||||
(Hira 36)
|
||||
(Hiragana 36)
|
||||
(Kata 37)
|
||||
(Katakana 37)
|
||||
(Kanji 48))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(RPAQQ READTYPES (READ.RT RATOM.RT NOPROPRB.RT PROPRB.RT))
|
||||
@ -1660,17 +1663,17 @@ 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 (3265 11709 (LASTC 3275 . 3581) (PEEKC 3583 . 3971) (PEEKCCODE 3973 . 4384) (RATOM 4386
|
||||
. 5467) (READ 5469 . 6029) (READC 6031 . 6672) (READCCODE 6674 . 7433) (READP 7435 . 7987) (
|
||||
SETREADMACROFLG 7989 . 8288) (SKIPSEPRCODES 8290 . 9370) (SKIPSEPRS 9372 . 9758) (SKREAD 9760 . 11707)
|
||||
) (11755 20364 (CL:READ 11765 . 12314) (CL:READ-PRESERVING-WHITESPACE 12316 . 13038) (
|
||||
CL:READ-DELIMITED-LIST 13040 . 13955) (CL:PARSE-INTEGER 13957 . 20362)) (20457 32934 (RSTRING 20467 .
|
||||
21199) (READ-EXTENDED-TOKEN 21201 . 25073) (\RSTRING2 25075 . 32932)) (32970 63584 (\TOP-LEVEL-READ
|
||||
32980 . 34963) (\SUBREAD 34965 . 60000) (\SUBREADCONCAT 60002 . 60625) (\ORIG-READ.SYMBOL 60627 .
|
||||
61695) (\ORIG-INVALID.SYMBOL 61697 . 62596) (\APPLYREADMACRO 62598 . 63014) (INREADMACROP 63016 .
|
||||
63582)) (63743 63918 (READQUOTE 63753 . 63916)) (63943 75847 (READVBAR 63953 . 65284) (READHASHMACRO
|
||||
65286 . 71096) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71098 . 71318) (DIGITBASEP 71320 . 72054) (
|
||||
READNUMBERINBASE 72056 . 73942) (ESTIMATE-DIMENSIONALITY 73944 . 74269) (SKIP.HASH.COMMENT 74271 .
|
||||
75239) (CMLREAD.FEATURE.PARSER 75241 . 75845)) (75891 82235 (CHARACTER.READ 75901 . 77155) (
|
||||
CHARCODE.DECODE 77157 . 82233)) (82236 85406 (HEXNUM? 82246 . 84589) (OCTALNUM? 84591 . 85404)))))
|
||||
(FILEMAP (NIL (3460 11904 (LASTC 3470 . 3776) (PEEKC 3778 . 4166) (PEEKCCODE 4168 . 4579) (RATOM 4581
|
||||
. 5662) (READ 5664 . 6224) (READC 6226 . 6867) (READCCODE 6869 . 7628) (READP 7630 . 8182) (
|
||||
SETREADMACROFLG 8184 . 8483) (SKIPSEPRCODES 8485 . 9565) (SKIPSEPRS 9567 . 9953) (SKREAD 9955 . 11902)
|
||||
) (11950 20559 (CL:READ 11960 . 12509) (CL:READ-PRESERVING-WHITESPACE 12511 . 13233) (
|
||||
CL:READ-DELIMITED-LIST 13235 . 14150) (CL:PARSE-INTEGER 14152 . 20557)) (20652 33129 (RSTRING 20662 .
|
||||
21394) (READ-EXTENDED-TOKEN 21396 . 25268) (\RSTRING2 25270 . 33127)) (33165 63779 (\TOP-LEVEL-READ
|
||||
33175 . 35158) (\SUBREAD 35160 . 60195) (\SUBREADCONCAT 60197 . 60820) (\ORIG-READ.SYMBOL 60822 .
|
||||
61890) (\ORIG-INVALID.SYMBOL 61892 . 62791) (\APPLYREADMACRO 62793 . 63209) (INREADMACROP 63211 .
|
||||
63777)) (63938 64113 (READQUOTE 63948 . 64111)) (64138 76042 (READVBAR 64148 . 65479) (READHASHMACRO
|
||||
65481 . 71291) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71293 . 71513) (DIGITBASEP 71515 . 72249) (
|
||||
READNUMBERINBASE 72251 . 74137) (ESTIMATE-DIMENSIONALITY 74139 . 74464) (SKIP.HASH.COMMENT 74466 .
|
||||
75434) (CMLREAD.FEATURE.PARSER 75436 . 76040)) (76086 82430 (CHARACTER.READ 76096 . 77350) (
|
||||
CHARCODE.DECODE 77352 . 82428)) (82431 85601 (HEXNUM? 82441 . 84784) (OCTALNUM? 84786 . 85599)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@ -1,14 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "SEDIT" READTABLE "XCL" BASE 10)
|
||||
(IL:FILECREATED "17-May-90 11:08:07" IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;2| 9591
|
||||
|
||||
IL:|changes| IL:|to:| (IL:FILES IL:SEDIT-INDENT)
|
||||
(IL:VARS IL:SEDIT-LIST-FORMATSCOMS)
|
||||
(IL:FILECREATED "17-Jun-2023 19:46:35" IL:|{WMEDLEY}<sources>SEDIT-LIST-FORMATS.;2| 9581
|
||||
|
||||
IL:|previous| IL:|date:| "18-Nov-88 10:56:22"
|
||||
IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;1|)
|
||||
:EDIT-BY IL:|rmk|
|
||||
|
||||
:CHANGES-TO (IL:SEDIT-FORMATS IL:SELECTC)
|
||||
(IL:VARS IL:SEDIT-LIST-FORMATSCOMS)
|
||||
|
||||
:PREVIOUS-DATE "17-May-90 11:08:07" IL:|{WMEDLEY}<sources>SEDIT-LIST-FORMATS.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1987, 1988, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
; Copyright (c) 1987-1988, 1990 by Venue & Xerox Corporation.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:SEDIT-LIST-FORMATSCOMS)
|
||||
|
||||
@ -19,7 +21,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;1|)
|
||||
(IL:SEDIT-FORMATS RETURN-FROM THROW BLOCK
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"some handy formats under names we don't expect to find as CAR of form")
|
||||
"some handy formats under names we don't expect to find as CAR of form")
|
||||
|
||||
:DEFAULT :DATA :BINDING :BINDING-LIST :LAMBDA-LIST :FBINDING :FBINDING-LIST
|
||||
:COND-CLAUSE :CASE-CLAUSE :HORIZONTAL :HORIZONTAL-NOBREAK :VERTICAL
|
||||
@ -36,9 +38,9 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;1|)
|
||||
ECASE ERROR ETYPECASE EVAL-WHEN FLET FORMAT IF IGNORE-ERRORS LABELS LAMBDA
|
||||
IL:LAMBDA LET LET* LOCALLY LIST LIST* MACROLET MULTIPLE-VALUE-BIND
|
||||
MULTIPLE-VALUE-SETQ IL:NLAMBDA IL:OPENLAMBDA OR IL:P PROCEED-CASE PROG PROG* PROGN
|
||||
PROGV RESTART-CASE IL:SELCHARQ IL:SELECTQ TAGBODY THE TYPECASE UNDOABLY UNLESS
|
||||
UNWIND-PROTECT WHEN WITH-INPUT-FROM-STRING WITH-OUTPUT-TO-STRING WITH-OPEN-FILE
|
||||
WITH-OPEN-STREAM IL:WITH.MONITOR IL:WITH.FAST.MONITOR IL:WITH.SPY)))
|
||||
PROGV RESTART-CASE IL:SELCHARQ IL:SELECTQ IL:SELECTC TAGBODY THE TYPECASE UNDOABLY
|
||||
UNLESS UNWIND-PROTECT WHEN WITH-INPUT-FROM-STRING WITH-OUTPUT-TO-STRING
|
||||
WITH-OPEN-FILE WITH-OPEN-STREAM IL:WITH.MONITOR IL:WITH.FAST.MONITOR IL:WITH.SPY)))
|
||||
|
||||
(IL:PUTPROPS IL:SEDIT-LIST-FORMATS IL:FILETYPE :COMPILE-FILE)
|
||||
|
||||
@ -148,7 +150,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;1|)
|
||||
(DEF-LIST-FORMAT DEFCONSTANT DEFVAR)
|
||||
|
||||
(DEF-LIST-FORMAT DEFDEFINER :INDENT ((2)
|
||||
1)
|
||||
1)
|
||||
:ARGS (:KEYWORD :CASE-CLAUSE NIL :LAMBDA-LIST NIL))
|
||||
|
||||
(DEF-LIST-FORMAT DEFUN :INDENT ((2))
|
||||
@ -309,6 +311,8 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;1|)
|
||||
:ARGS (:KEYWORD NIL :CASE-CLAUSE)
|
||||
:LAST NIL)
|
||||
|
||||
(DEF-LIST-FORMAT IL:SELECTC IL:SELECTQ)
|
||||
|
||||
(DEF-LIST-FORMAT TAGBODY :INDENT (:TAGBODY :STEP 0)
|
||||
:ARGS (:KEYWORD NIL))
|
||||
|
||||
|
||||
Binary file not shown.
@ -1,18 +1,19 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE SEDIT ( USE LISP XCL)))
|
||||
(IL:FILECREATED "14-May-2018 14:12:02"
|
||||
IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;2| 84658
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE SEDIT ( USE LISP XCL)) READTABLE "XCL" BASE 10)
|
||||
|
||||
IL:|changes| IL:|to:| (IL:FNS BUTTONEVENTFN)
|
||||
(IL:FILECREATED "20-Jun-2023 21:10:34" IL:|{WMEDLEY}<sources>SEDIT-WINDOW.;3| 87531
|
||||
|
||||
IL:|previous| IL:|date:| " 2-Apr-92 11:08:50"
|
||||
IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
|
||||
:EDIT-BY IL:|rmk|
|
||||
|
||||
:CHANGES-TO (IL:FNS BUTTONEVENTFN)
|
||||
|
||||
:PREVIOUS-DATE "17-Jun-2023 19:59:30" IL:|{WMEDLEY}<sources>SEDIT-WINDOW.;2|)
|
||||
|
||||
|
||||
; Copyright (c) 1986, 1987, 1988, 1990, 1991, 1992, 2018 by Venue & Xerox Corporation. All rights reserved.
|
||||
; Copyright (c) 1986-1988, 1990-1992, 2018 by Venue & Xerox Corporation.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:SEDIT-WINDOWCOMS)
|
||||
|
||||
(IL:RPAQQ IL:SEDIT-WINDOWCOMS
|
||||
(IL:RPAQQ IL:SEDIT-WINDOWCOMS
|
||||
((IL:PROP IL:FILETYPE IL:SEDIT-WINDOW)
|
||||
(IL:PROP IL:MAKEFILE-ENVIRONMENT IL:SEDIT-WINDOW)
|
||||
(IL:LOCALVARS . T)
|
||||
@ -36,11 +37,11 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
|
||||
SET-SELECTION-NOWHERE SHIFT-DOWN SHOW-CARET SHRINKFN STRING-OFFSET TRACK-EXTEND
|
||||
TRACK-SELECT UNDERLINE-SELECTION UPDATE-TITLE)))
|
||||
|
||||
(IL:PUTPROPS IL:SEDIT-WINDOW IL:FILETYPE :COMPILE-FILE)
|
||||
(IL:PUTPROPS IL:SEDIT-WINDOW IL:FILETYPE :COMPILE-FILE)
|
||||
|
||||
(IL:PUTPROPS IL:SEDIT-WINDOW IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE
|
||||
(DEFPACKAGE IL:SEDIT (:USE IL:LISP
|
||||
IL:XCL))))
|
||||
(IL:PUTPROPS IL:SEDIT-WINDOW IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE
|
||||
(DEFPACKAGE IL:SEDIT (:USE IL:LISP IL:XCL
|
||||
))))
|
||||
(IL:DECLARE\: IL:DOEVAL@COMPILE IL:DONTCOPY
|
||||
|
||||
(IL:LOCALVARS . T)
|
||||
@ -58,40 +59,64 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
|
||||
|
||||
(IL:RPAQQ ICON-TITLE-REGION (5 16 130 24))
|
||||
|
||||
(IL:RPAQ TITLED-ICON (IL:CREATE IL:TITLEDICON IL:ICON IL:_ ICON IL:MASK IL:_ ICON-MASK
|
||||
IL:TITLEREG IL:_ ICON-TITLE-REGION))
|
||||
(IL:RPAQ TITLED-ICON (IL:CREATE IL:TITLEDICON IL:ICON IL:_ ICON IL:MASK IL:_ ICON-MASK IL:TITLEREG
|
||||
IL:_ ICON-TITLE-REGION))
|
||||
|
||||
(IL:RPAQQ KEEP-WINDOW-REGION T)
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:DECLARE\: IL:EVAL@COMPILE
|
||||
|
||||
(IL:PUTPROPS IN-TITLE-BAR IL:MACRO ((WINDOW)
|
||||
(IL:PUTPROPS IN-TITLE-BAR IL:MACRO ((WINDOW)
|
||||
(NOT (IL:INSIDEP (IL:DSPCLIPPINGREGION NIL WINDOW)
|
||||
(IL:LASTMOUSEX WINDOW)
|
||||
(IL:LASTMOUSEY WINDOW)))))
|
||||
|
||||
(IL:PUTPROPS TRACK-BAR-IN-TRACK-SELECT IL:MACRO
|
||||
(NIL (WHEN (OR (IL:NEQ POINT? (IL:|fetch| POINT-TYPE IL:|of| PENDING-CARET))
|
||||
(IL:NEQ BAR-X (IL:|fetch| POINT-X IL:|of| PENDING-CARET))
|
||||
(IL:NEQ BAR-LINE (IL:|fetch| POINT-LINE IL:|of| PENDING-CARET)))
|
||||
(WHEN POINT?
|
||||
(IL:BLTSHADE IL:BLACKSHADE WINDOW BAR-X BAR-Y 1 BAR-HEIGHT 'IL:INVERT))
|
||||
(WHEN (IL:SETQ POINT? (IL:|fetch| POINT-TYPE IL:|of| PENDING-CARET))
|
||||
(IL:SETQ BAR-X (IL:|fetch| POINT-X IL:|of| PENDING-CARET))
|
||||
(IL:SETQ BAR-LINE (IL:|fetch| POINT-LINE IL:|of| PENDING-CARET))
|
||||
(IL:SETQ BAR-HEIGHT (IL:IPLUS (IL:|fetch| LINE-ASCENT IL:|of| BAR-LINE)
|
||||
(IL:|fetch| LINE-DESCENT IL:|of| BAR-LINE)))
|
||||
(IL:SETQ BAR-Y (IL:IDIFFERENCE (IL:|fetch| YCOORD IL:|of| BAR-LINE)
|
||||
(IL:IPLUS (IL:|fetch| LINE-SKIP IL:|of| BAR-LINE)
|
||||
BAR-HEIGHT)))
|
||||
(IL:BLTSHADE IL:BLACKSHADE WINDOW BAR-X BAR-Y 1 BAR-HEIGHT 'IL:INVERT)))))
|
||||
(IL:PUTPROPS TRACK-BAR-IN-TRACK-SELECT IL:MACRO (NIL (WHEN (OR (IL:NEQ POINT? (IL:|fetch| POINT-TYPE
|
||||
IL:|of|
|
||||
PENDING-CARET)
|
||||
)
|
||||
(IL:NEQ BAR-X (IL:|fetch| POINT-X
|
||||
IL:|of| PENDING-CARET
|
||||
))
|
||||
(IL:NEQ BAR-LINE (IL:|fetch|
|
||||
POINT-LINE
|
||||
IL:|of|
|
||||
PENDING-CARET
|
||||
)))
|
||||
(WHEN POINT?
|
||||
(IL:BLTSHADE IL:BLACKSHADE WINDOW BAR-X
|
||||
BAR-Y 1 BAR-HEIGHT 'IL:INVERT))
|
||||
(WHEN (IL:SETQ POINT? (IL:|fetch| POINT-TYPE
|
||||
IL:|of|
|
||||
PENDING-CARET
|
||||
))
|
||||
(IL:SETQ BAR-X (IL:|fetch| POINT-X
|
||||
IL:|of| PENDING-CARET)
|
||||
)
|
||||
(IL:SETQ BAR-LINE (IL:|fetch| POINT-LINE
|
||||
IL:|of|
|
||||
PENDING-CARET
|
||||
))
|
||||
(IL:SETQ BAR-HEIGHT
|
||||
(IL:IPLUS (IL:|fetch| LINE-ASCENT
|
||||
IL:|of| BAR-LINE)
|
||||
(IL:|fetch| LINE-DESCENT
|
||||
IL:|of| BAR-LINE)))
|
||||
(IL:SETQ BAR-Y
|
||||
(IL:IDIFFERENCE (IL:|fetch| YCOORD
|
||||
IL:|of| BAR-LINE)
|
||||
(IL:IPLUS (IL:|fetch| LINE-SKIP
|
||||
IL:|of| BAR-LINE)
|
||||
BAR-HEIGHT)))
|
||||
(IL:BLTSHADE IL:BLACKSHADE WINDOW BAR-X
|
||||
BAR-Y 1 BAR-HEIGHT 'IL:INVERT)))))
|
||||
)
|
||||
)
|
||||
|
||||
(DEFUN SELECT-NODE-SEGMENT (CONTEXT NODE &OPTIONAL (START 1)
|
||||
END)
|
||||
END)
|
||||
|
||||
(IL:* IL:|;;;| "set the current selection to be a segment under this node")
|
||||
(IL:* IL:|;;;| "set the current selection to be a segment under this node")
|
||||
|
||||
(LET ((SELECTION (IL:FETCH SELECTION IL:OF CONTEXT))
|
||||
(POINT (IL:FETCH CARET-POINT IL:OF CONTEXT)))
|
||||
@ -100,7 +125,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
|
||||
(IL:|replace| SELECT-END IL:|of| SELECTION IL:|with| END)
|
||||
(SELECT-SEGMENT SELECTION CONTEXT NODE)
|
||||
|
||||
(IL:* IL:|;;| "set point to be the selection. This should really be done by select-segment but it doesn't because it expects finalization code to be run after it cause it's generally called from the mouse tracking code which finalizes.")
|
||||
(IL:* IL:|;;| "set point to be the selection. This should really be done by select-segment but it doesn't because it expects finalization code to be run after it cause it's generally called from the mouse tracking code which finalizes.")
|
||||
|
||||
(PENDING-DELETE POINT SELECTION)))
|
||||
(IL:DEFINEQ
|
||||
@ -182,9 +207,11 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
|
||||
(IL:DSPRIGHTMARGIN 64000 DISPLAY-WINDOW))))
|
||||
|
||||
(BUTTONEVENTFN
|
||||
(IL:LAMBDA (WINDOW) (IL:* IL:\; "Edited 23-Apr-2018 09:37 by rmk:")
|
||||
(IL:LAMBDA (WINDOW) (IL:* IL:\; "Edited 20-Jun-2023 21:10 by rmk")
|
||||
(IL:* IL:\; "Edited 17-Jun-2023 19:59 by rmk")
|
||||
(IL:* IL:\; "Edited 23-Apr-2018 09:37 by rmk:")
|
||||
|
||||
(IL:* IL:|;;| "called by the window system whenever the user hits a mouse button in an SEdit window. allows selection and setting the caret point")
|
||||
(IL:* IL:|;;| "called by the window system whenever the user hits a mouse button in an SEdit window. allows selection and setting the caret point")
|
||||
|
||||
(LET* ((CONTEXT (IL:WINDOWPROP WINDOW 'EDIT-CONTEXT))
|
||||
(LOCK (AND CONTEXT (IL:|fetch| CONTEXT-LOCK IL:|of| CONTEXT)))
|
||||
@ -192,12 +219,12 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
|
||||
(COND
|
||||
((IL:LASTMOUSESTATE IL:UP)
|
||||
|
||||
(IL:* IL:|;;| "oops, no mouse buttons down. what are we doing here?")
|
||||
(IL:* IL:|;;| "oops, no mouse buttons down. what are we doing here?")
|
||||
|
||||
NIL)
|
||||
((NOT (AND CONTEXT (IL:WINDOWPROP WINDOW 'IL:PROCESS)))
|
||||
|
||||
(IL:* IL:|;;| "this context or process is dead. make it a dead SEdit.")
|
||||
(IL:* IL:|;;| "this context or process is dead. make it a dead SEdit.")
|
||||
|
||||
(IL:|printout| (IL:GETPROMPTWINDOW WINDOW)
|
||||
T "This SEdit is dead.")
|
||||
@ -209,21 +236,32 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
|
||||
((AND (IL:LASTMOUSESTATE IL:RIGHT)
|
||||
(IN-TITLE-BAR WINDOW))
|
||||
|
||||
(IL:* IL:|;;| "right buttoning the title bar or window border gives the default menu of window commands. Not interlocked because want to be able to move window under a break that has the lock.")
|
||||
(IL:* IL:|;;| "right buttoning the title bar or window border gives the default menu of window commands. Not interlocked because want to be able to move window under a break that has the lock.")
|
||||
|
||||
(IL:\\CARET.DOWN)
|
||||
(IL:DOWINDOWCOM WINDOW))
|
||||
((AND (NOT (IL:TTY.PROCESSP (IL:WINDOWPROP WINDOW 'IL:PROCESS)))
|
||||
(NOT SHIFT-DOWN))
|
||||
|
||||
(IL:* IL:|;;| "just grab the tty and don't change state")
|
||||
(IL:* IL:|;;| "just grab the tty and don't change state")
|
||||
|
||||
(IL:TOTOPW WINDOW)
|
||||
(IL:TTY.PROCESS (IL:WINDOWPROP WINDOW 'IL:PROCESS)))
|
||||
((AND (EQ SHIFT-DOWN 'COPY)
|
||||
(IL:MOUSESTATE IL:LEFT)
|
||||
(IN-TITLE-BAR WINDOW))
|
||||
|
||||
(IL:* IL:|;;| "RMK: copy-select in the title bar: return the thing being edited")
|
||||
|
||||
(LET ((NAME (IL:LISTGET (IL:WINDOWPROP WINDOW 'TITLE-INFO)
|
||||
:|name|)))
|
||||
(WHEN NAME (IL:* IL:\;
|
||||
"Not sure about FLG and RDTBL")
|
||||
(IL:COPYINSERT NAME))))
|
||||
((OR (EQ SHIFT-DOWN 'COPY)
|
||||
(IL:OBTAIN.MONITORLOCK LOCK T))
|
||||
|
||||
(IL:* IL:|;;| "at this point we must have the lock, unless we're shift selecting (Copy only: Move and Delete are non-passive operation and must lock)")
|
||||
(IL:* IL:|;;| "at this point we must have the lock, unless we're shift selecting (Copy only: Move and Delete are non-passive operation and must lock)")
|
||||
|
||||
(IL:\\CARET.DOWN)
|
||||
(IL:TOTOPW WINDOW)
|
||||
@ -233,31 +271,27 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
|
||||
(AND (IL:LASTMOUSESTATE IL:LEFT)
|
||||
(IL:KEYDOWNP 'IL:CTRL))))
|
||||
|
||||
(IL:* IL:|;;| "popup help command menu here.")
|
||||
(IL:* IL:|;;| "popup help command menu here.")
|
||||
|
||||
(IL:* IL:|;;| "RMK: CTRL-LEFT = MIDDLE")
|
||||
(IL:* IL:|;;| "RMK: CTRL-LEFT = MIDDLE")
|
||||
|
||||
(HELPMENU CONTEXT))
|
||||
(T (WITH-PROFILE (IL:|fetch| PROFILE IL:|of| CONTEXT)
|
||||
(PROG NIL
|
||||
(CLOSE-OPEN-NODE CONTEXT)
|
||||
|
||||
(IL:* IL:|;;| "record that we're busy making a selection in this window, and make sure that variables we use for recording our temporary state are all ready for action. note that these are global vars, and hence all this code is nonrentrant. shouldn't be a problem, since there's only one mouse")
|
||||
(IL:* IL:|;;| "record that we're busy making a selection in this window, and make sure that variables we use for recording our temporary state are all ready for action. note that these are global vars, and hence all this code is nonrentrant. shouldn't be a problem, since there's only one mouse")
|
||||
|
||||
(IL:SETQ SELECTION-PENDING? CONTEXT)
|
||||
(IL:SETQ PENDING-LAST-X (IL:|fetch| LAST-MOUSE-X IL:|of|
|
||||
CONTEXT))
|
||||
(IL:SETQ PENDING-LAST-Y (IL:|fetch| LAST-MOUSE-Y IL:|of|
|
||||
CONTEXT))
|
||||
(IL:SETQ PENDING-TYPE (IL:|fetch| LAST-MOUSE-TYPE IL:|of|
|
||||
CONTEXT))
|
||||
(IL:SETQ PENDING-LAST-X (IL:|fetch| LAST-MOUSE-X IL:|of| CONTEXT))
|
||||
(IL:SETQ PENDING-LAST-Y (IL:|fetch| LAST-MOUSE-Y IL:|of| CONTEXT))
|
||||
(IL:SETQ PENDING-TYPE (IL:|fetch| LAST-MOUSE-TYPE IL:|of| CONTEXT))
|
||||
(IL:SETQ PENDING-SHIFT SHIFT-DOWN)
|
||||
(IL:|replace| SELECT-NODE IL:|of| PENDING-SELECTION
|
||||
IL:|with| NIL)
|
||||
(IL:|replace| SELECT-NODE IL:|of| PENDING-SELECTION IL:|with| NIL)
|
||||
(WHEN (NOT PENDING-SHIFT)
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"if they're setting a new selection take down the main selection")
|
||||
(IL:* IL:|;;|
|
||||
"if they're setting a new selection take down the main selection")
|
||||
|
||||
(SELECTION-DOWN CONTEXT))
|
||||
(IL:SETQ LAST-MOVE-CLOCK NIL)
|
||||
@ -268,15 +302,15 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
|
||||
(TRACK-SELECT CONTEXT WINDOW))
|
||||
(IL:|until| (CHECK-SELECTION-SHIFT CONTEXT T)
|
||||
IL:|do| (WHEN (NOT (IL:MOUSESTATE IL:UP))
|
||||
(GO MOUSE-BUTTON-DOWN))
|
||||
(GO MOUSE-BUTTON-DOWN))
|
||||
(WHEN (IL:IN/SCROLL/BAR? WINDOW IL:LASTMOUSEX IL:LASTMOUSEY
|
||||
) (IL:* IL:\;
|
||||
"let them scroll while making a selection")
|
||||
) (IL:* IL:\;
|
||||
"let them scroll while making a selection")
|
||||
(IL:SCROLL.HANDLER WINDOW))
|
||||
(IL:BLOCK))
|
||||
(IL:SETQ SELECTION-PENDING? NIL)
|
||||
(IL:* IL:\;
|
||||
"figure out what we should do")
|
||||
(IL:* IL:\;
|
||||
"figure out what we should do")
|
||||
(FINALIZE-MOUSE-SELECTION CONTEXT WINDOW)))))
|
||||
(OR (EQ SHIFT-DOWN 'COPY)
|
||||
(IL:RELEASE.MONITORLOCK LOCK)))))))
|
||||
@ -781,22 +815,22 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
|
||||
(IL:PUTPROPS IL:SEDIT-WINDOW IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 1992
|
||||
2018))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL (9049 9957 (SELECT-NODE-SEGMENT 9049 . 9957)) (9958 84520 (BUILD-WINDOW 9971 . 15811)
|
||||
(BUTTONEVENTFN 15813 . 21522) (CHECK-SELECTION 21524 . 23564) (CHECK-SELECTION-SHIFT 23566 . 24689) (
|
||||
CLOSEFN 24691 . 27694) (CONFLICTING-SELECTION? 27696 . 28457) (DISPLAY-SELECTION 28459 . 29486) (
|
||||
DRAW-HIGHLIGHT 29488 . 30618) (DRAW-OUTLINE 30620 . 31975) (DRAW-UNDERLINE 31977 . 32752) (EXPANDFN
|
||||
32754 . 33261) (EXPANDREGIONFN 33263 . 33853) (EXTEND-SELECTION 33855 . 36432) (
|
||||
FINALIZE-MOUSE-SELECTION 36434 . 42980) (FIND-LINE-START 42982 . 43673) (FIND-NODE 43675 . 44950) (
|
||||
GET-DESTINATION-CONTEXT 44952 . 45504) (GRAY 45506 . 45893) (GROW-CLICK? 45895 . 47880) (
|
||||
GROW-SELECTION 47882 . 48225) (GROW-SELECTION-DEFAULT 48227 . 48598) (HIGHLIGHT-SELECTION 48600 .
|
||||
48893) (ICON-COPYFN 48895 . 49239) (LESS-PROMPT-WINDOW 49241 . 49610) (NORMALIZE-SELECTION 49612 .
|
||||
50978) (OUTLINE-SELECTION 50980 . 52118) (PENDING-DELETE 52120 . 52454) (PLACE-CARET-AND-SELECTION
|
||||
52456 . 54016) (PUNT-SET-POINT 54018 . 54476) (PUNT-SET-SELECTION 54478 . 54927) (REPAINTFN 54929 .
|
||||
56207) (RESHAPEFN 56209 . 58547) (SCAN-FOR-BOUNDS 58549 . 61092) (SELECT-NODE 61094 . 61464) (
|
||||
SELECT-SEGMENT 61466 . 61906) (SELECT-SEGMENT-DEFAULT 61908 . 63935) (SELECTION-DOWN 63937 . 64347) (
|
||||
SELECTION-UP 64349 . 64775) (SET-POINT 64777 . 65536) (SET-POINT-NOWHERE 65538 . 65797) (
|
||||
SET-POINT-UNKNOWN 65799 . 66420) (SET-SELECTION 66422 . 66855) (SET-SELECTION-ME 66857 . 67949) (
|
||||
SET-SELECTION-NOWHERE 67951 . 68149) (SHIFT-DOWN 68151 . 68692) (SHOW-CARET 68694 . 74252) (SHRINKFN
|
||||
74254 . 76989) (STRING-OFFSET 76991 . 78351) (TRACK-EXTEND 78353 . 80409) (TRACK-SELECT 80411 . 82900)
|
||||
(UNDERLINE-SELECTION 82902 . 83304) (UPDATE-TITLE 83306 . 84518)))))
|
||||
(IL:FILEMAP (NIL (11430 12334 (SELECT-NODE-SEGMENT 11430 . 12334)) (12335 87393 (BUILD-WINDOW 12348 .
|
||||
18188) (BUTTONEVENTFN 18190 . 24395) (CHECK-SELECTION 24397 . 26437) (CHECK-SELECTION-SHIFT 26439 .
|
||||
27562) (CLOSEFN 27564 . 30567) (CONFLICTING-SELECTION? 30569 . 31330) (DISPLAY-SELECTION 31332 . 32359
|
||||
) (DRAW-HIGHLIGHT 32361 . 33491) (DRAW-OUTLINE 33493 . 34848) (DRAW-UNDERLINE 34850 . 35625) (EXPANDFN
|
||||
35627 . 36134) (EXPANDREGIONFN 36136 . 36726) (EXTEND-SELECTION 36728 . 39305) (
|
||||
FINALIZE-MOUSE-SELECTION 39307 . 45853) (FIND-LINE-START 45855 . 46546) (FIND-NODE 46548 . 47823) (
|
||||
GET-DESTINATION-CONTEXT 47825 . 48377) (GRAY 48379 . 48766) (GROW-CLICK? 48768 . 50753) (
|
||||
GROW-SELECTION 50755 . 51098) (GROW-SELECTION-DEFAULT 51100 . 51471) (HIGHLIGHT-SELECTION 51473 .
|
||||
51766) (ICON-COPYFN 51768 . 52112) (LESS-PROMPT-WINDOW 52114 . 52483) (NORMALIZE-SELECTION 52485 .
|
||||
53851) (OUTLINE-SELECTION 53853 . 54991) (PENDING-DELETE 54993 . 55327) (PLACE-CARET-AND-SELECTION
|
||||
55329 . 56889) (PUNT-SET-POINT 56891 . 57349) (PUNT-SET-SELECTION 57351 . 57800) (REPAINTFN 57802 .
|
||||
59080) (RESHAPEFN 59082 . 61420) (SCAN-FOR-BOUNDS 61422 . 63965) (SELECT-NODE 63967 . 64337) (
|
||||
SELECT-SEGMENT 64339 . 64779) (SELECT-SEGMENT-DEFAULT 64781 . 66808) (SELECTION-DOWN 66810 . 67220) (
|
||||
SELECTION-UP 67222 . 67648) (SET-POINT 67650 . 68409) (SET-POINT-NOWHERE 68411 . 68670) (
|
||||
SET-POINT-UNKNOWN 68672 . 69293) (SET-SELECTION 69295 . 69728) (SET-SELECTION-ME 69730 . 70822) (
|
||||
SET-SELECTION-NOWHERE 70824 . 71022) (SHIFT-DOWN 71024 . 71565) (SHOW-CARET 71567 . 77125) (SHRINKFN
|
||||
77127 . 79862) (STRING-OFFSET 79864 . 81224) (TRACK-EXTEND 81226 . 83282) (TRACK-SELECT 83284 . 85773)
|
||||
(UNDERLINE-SELECTION 85775 . 86177) (UPDATE-TITLE 86179 . 87391)))))
|
||||
IL:STOP
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user