github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-03-05 11:14:38 +00:00
Code Issues Projects Releases Wiki Activity

Better control of modern windows (#527)

Browse Source 
* MODERNIZE, FILEBROWSER: Better control of modern windows

Also fixed Y2K bug in FILEBROWSER, updated COMPAREDIRECTORIES and WHEELSCROLL documentation.  MODERNWINDOWS allows separate specification of the hot-corner region and the top margin for siphoning off left-button clicks

* MODERNIZE.LCOM: didn't get included
This commit is contained in:
rmkaplan
2021-10-21 10:02:43 -07:00
committed by GitHub
parent bf5689be2a
commit 31d9473184
6 changed files with 236 additions and 135 deletions
Download Patch File Download Diff File Expand all files Collapse all files

154
library/FILEBROWSER
View File

@@ -1,11 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "19-Sep-2021 18:08:05" 
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;9| 260675
|changes| |to:| (FNS FB.EDITCOMMAND.ONEFILE)
(FILECREATED "16-Oct-2021 15:04:31" 
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;13| 261677
|previous| |date:| "21-Aug-2021 23:33:58"
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;7|)
|changes| |to:| (VARS FILEBROWSERCOMS)
(FNS FB.GETWINDOW FB.SET.BROWSER.TITLE FB.DATE)
|previous| |date:| "19-Sep-2021 18:08:05"
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;10|)
; Copyright (c) 1983-1991, 1993-1994, 1999-2001, 2021 by Venue & Xerox Corporation.
@@ -205,6 +207,7 @@ You specify how many versions to keep.")))
FB.SHAPECOMMAND FB.REMOVE.FILE FB.COUNT.FILE.CHANGE FB.SETNEWPATTERN
FB.GET.NEWPATTERN FB.OPTIONSCOMMAND))
(COMS (* \; "window functions")
(FNS FB.GETWINDOW)
(FNS FB.INFOMENU.SHADEINITIALSELECTIONS FB.INFO.ITEM.NAMED)
(FNS FB.MAKECOUNTERWINDOW FB.COUNTERW.REDISPLAYFN FB.UPDATE.COUNTERS
FB.DISPLAY.COUNTERS FB.COUNTER.STRING)
@@ -2253,21 +2256,15 @@ Do you want to expunge them first?")
(FB.DISPLAY.COUNTERS BROWSER)))))
(FB.DATE
(LAMBDA NIL (* \; "Edited 21-Jan-88 18:40 by bvm")
(LET ((DT (DATE (DATEFORMAT DAY.OF.WEEK DAY.SHORT NO.SECONDS))))
(LAMBDA NIL (* \; "Edited 16-Oct-2021 14:06 by rmk:")
(* |;;|
 "DT is in the form \"dd-mon-yy hh:mm (day)\". Turn it into \"hh:mm day dd-mon-yy\".")
(* |;;| "RMK: Tried to decode and rearrange with Y2K error. Now just pass it through. It used to include the short day of week, that seems silly. It is today's date...or at least the date of the last recompute")
(CONCAT (SUBSTRING DT 11 16)
(SUBSTRING DT 18 20)
" "
(SUBSTRING DT (|if| (EQ (CHCON1 DT)
(CHARCODE SPACE))
|then| (* \; "Trim leading space from date")
2
|else| 1)
9)))))
(* |;;| "(DATEFORMAT NO.LEADING.SPACES NO.SECONDS DAY.OF.WEEK DAY.SHORT)")
(* |;;| "I think this only goes in the title bar, which is perhaps odd in itself.")
(DATE (DATEFORMAT NO.LEADING.SPACES NO.SECONDS))))
(FB.ADJUST.DATE.WIDTH
(LAMBDA (BROWSER INFOWANTED) (* \; "Edited 30-Aug-94 19:40 by jds")
@@ -2307,9 +2304,11 @@ Do you want to expunge them first?")
|finally| (RETURN RESULT))))
(FB.SET.BROWSER.TITLE
(LAMBDA (BROWSER TIME) (* \; "Edited 21-Jan-88 18:37 by bvm")
(LAMBDA (BROWSER TIME) (* \; "Edited 16-Oct-2021 14:10 by rmk:")
(* |;;| "(Re)display the title on BROWSER's window. If Time is supplied, it is the time at which the enumeration happened, and we include it in the title. Title is not changed if user supplied own title.")
(* |;;| "(Re)display the title on BROWSER's window. If Time is supplied, it is the time at which the enumeration happened, and we include it in the title. Title is not changed if user supplied own title.")
(* |;;| "RMK: Move the date over a bit, so that path stands out")
(COND
((NOT (|fetch| (FILEBROWSER FIXEDTITLE) |of| BROWSER))
@@ -2317,7 +2316,7 @@ Do you want to expunge them first?")
'TITLE
(|if| TIME
|then| (CONCAT (|fetch| (FILEBROWSER PATTERN) |of| BROWSER)
" at " TIME)
" at " TIME)
|else| (CONCAT (|fetch| (FILEBROWSER PATTERN) |of| BROWSER)
" browser")))))))
@@ -3294,6 +3293,25 @@ then click Recompute"))))
(DEFINEQ
(FB.GETWINDOW
(LAMBDA (WINDOW WHICH) (* \; "Edited 16-Oct-2021 15:02 by rmk:")
(* |;;| "Closed function to get at filebrowser attached windows by type, without need record declarations at runtime. Helps MODERNIZE get the right regions.")
(LET* ((FBWINDOW (CENTRALWINDOW WINDOW))
(FILEBROWSER (WINDOWPROP FBWINDOW 'FILEBROWSER)))
(CL:WHEN FILEBROWSER
(SELECTQ WHICH
(HEADING (FETCH (FILEBROWSER HEADINGWINDOW) OF FILEBROWSER))
(COUNTER (FETCH (FILEBROWSER COUNTERWINDOW) OF FILEBROWSER))
(BROWSER FBWINDOW)
(PROMPT (FETCH (FILEBROWSER PROMPTWINDOW) OF FILEBROWSER))
(COMMAND (FIND W IN (WINDOWPROP FBWINDOW 'ATTACHEDWINDOWS)
SUCHTHAT (EQ 'MENUBUTTONFN (WINDOWPROP W 'BUTTONEVENTFN))))
NIL)))))
)
(DEFINEQ
(FB.INFOMENU.SHADEINITIALSELECTIONS
(LAMBDA (MENUWINDOW INITIALSELECTIONS) (* \; "Edited 21-Jan-88 18:36 by bvm")
(LET* ((MENU (CAR (WINDOWPROP MENUWINDOW 'MENU)))
@@ -4202,51 +4220,51 @@ then click Recompute"))))
(PUTPROPS FILEBROWSER COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
1991 1993 1994 1999 2000 2001 2021))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (28618 51254 (FB 28628 . 29584) (FB.COPYBINARYCOMMAND 29586 . 29932) (FB.COPYTEXTCOMMAND
29934 . 30276) (FILEBROWSER 30278 . 43384) (FB.TABLEBROWSER 43386 . 43603) (FB.SELECTEDFILES 43605 .
44242) (FB.FETCHFILENAME 44244 . 44636) (FB.DIRECTORYP 44638 . 44966) (FB.PROMPTWPRINT 44968 . 46014)
(FB.PROMPTW.FORMAT 46016 . 46753) (FB.PROMPTFORINPUT 46755 . 49007) (FB.YES-OR-NO-P 49009 . 50043) (
FB.ALLOW.ABORT 50045 . 50899) (\\FB.HARDCOPY.TOFILE.EXTENSION 50901 . 51252)) (51278 52231 (FB.STARTUP
51288 . 51803) (FB.MAKERIGIDWINDOW 51805 . 52229)) (52232 57604 (FB.PRINTFN 52242 . 57395) (FB.COPYFN
57397 . 57602)) (57654 63696 (FB.MENU.WHENSELECTEDFN 57664 . 58022) (FB.COMMANDSELECTEDFN 58024 .
59563) (FB.SUBITEMP 59565 . 60000) (FB.MAKE.BROWSER.BUSY 60002 . 60740) (FB.FINISH.COMMAND 60742 .
62707) (FB.HANDLE.ABORT.BUTTON 62709 . 63694)) (63697 69213 (FB.DELETECOMMAND 63707 . 63988) (
FB.DELVERCOMMAND 63990 . 67183) (FB.IS.NOT.SUBDIRECTORY.ITEM 67185 . 67366) (FB.DELVER.FILES 67368 .
68457) (FB.DELETE.FILE 68459 . 69211)) (69214 70539 (FB.UNDELETECOMMAND 69224 . 69509) (
FB.UNDELETEALLCOMMAND 69511 . 69790) (FB.UNDELETE.FILE 69792 . 70537)) (70540 94721 (FB.COPYCOMMAND
70550 . 70819) (FB.RENAMECOMMAND 70821 . 71096) (FB.COPY/RENAME.COMMAND 71098 . 72021) (
FB.COPY/RENAME.ONE 72023 . 74345) (FB.COPY/RENAME.MANY 74347 . 80567) (FB.MERGE.DIRECTORIES 80569 .
80987) (FB.GREATEST.PREFIX 80989 . 82345) (FB.MAYBE.INSERT.FILE 82347 . 89787) (FB.GET.NEW.FILE.SPEC
89789 . 93620) (FB.CANONICAL.DIRECTORY 93622 . 94719)) (94722 102506 (FB.HARDCOPYCOMMAND 94732 . 95862
) (FB.HARDCOPY.TOFILE 95864 . 102504)) (102507 112384 (FB.EDITCOMMAND 102517 . 103318) (
FB.EDITCOMMAND.ONEFILE 103320 . 106600) (FB.EDITLISPFILE 106602 . 107641) (FB.BROWSECOMMAND 107643 .
112382)) (112385 124178 (FB.FASTSEECOMMAND 112395 . 115845) (FB.FASTSEE.ONEFILE 115847 . 118876) (
FB.SEEFULLFN 118878 . 123009) (FB.SEEBUTTONFN 123011 . 124176)) (124179 125925 (FB.LOADCOMMAND 124189
. 124696) (FB.COMPILECOMMAND 124698 . 125236) (FB.OPERATE.ON.FILES 125238 . 125923)) (125926 173584 (
FB.UPDATECOMMAND 125936 . 126161) (FB.FIX-DIRECTORY-DATES 126163 . 126770) (FB.MAYBE.EXPUNGE 126772 .
127767) (FB.UPDATEBROWSERITEMS 127769 . 140984) (FB.DATE 140986 . 141727) (FB.ADJUST.DATE.WIDTH 141729
. 144697) (FB.SET.BROWSER.TITLE 144699 . 145556) (FB.MAYBE.WIDEN.NAMES 145558 . 147677) (
FB.SET.DEFAULT.NAME.WIDTH 147679 . 149043) (FB.CREATE.FILEBUCKET 149045 . 156265) (
FB.CHECK.NAME.LENGTH 156267 . 158688) (FB.ADD.FILEGROUP 158690 . 160217) (FB.INSERT.DIRECTORY 160219
. 160457) (FB.MAKE.SUBDIRECTORY.ITEM 160459 . 161868) (FB.ADD.FILE 161870 . 162483) (FB.INSERT.FILE
162485 . 165897) (FB.ANALYZE.PATTERN 165899 . 171163) (FB.CANONICALIZE.PATTERN 171165 . 172477) (
FB.GETALLFILEINFO 172479 . 173582)) (173585 181744 (FB.SORT.VERSIONS 173595 . 176366) (
FB.DECREASING.VERSION 176368 . 177037) (FB.INCREASING.VERSION 177039 . 177660) (
FB.NAMES.DECREASING.VERSION 177662 . 178697) (FB.NAMES.INCREASING.VERSION 178699 . 179696) (
FB.DECREASING.NUMERIC.ATTR 179698 . 180378) (FB.INCREASING.NUMERIC.ATTR 180380 . 181054) (
FB.ALPHABETIC.ATTR 181056 . 181742)) (181745 191587 (FB.SORTCOMMAND 181755 . 188585) (
FB.INSERT.SUBDIRECTORIES 188587 . 189384) (FB.GET.SORT.MENU 189386 . 191585)) (191588 207677 (
FB.EXPUNGECOMMAND 191598 . 194117) (FB.NEWPATTERNCOMMAND 194119 . 194517) (FB.NEWINFOCOMMAND 194519 .
197285) (FB.DEPTHCOMMAND 197287 . 199062) (FB.SHAPECOMMAND 199064 . 202406) (FB.REMOVE.FILE 202408 .
204229) (FB.COUNT.FILE.CHANGE 204231 . 205676) (FB.SETNEWPATTERN 205678 . 206848) (FB.GET.NEWPATTERN
206850 . 207434) (FB.OPTIONSCOMMAND 207436 . 207675)) (207712 208724 (
FB.INFOMENU.SHADEINITIALSELECTIONS 207722 . 208369) (FB.INFO.ITEM.NAMED 208371 . 208722)) (208725
218191 (FB.MAKECOUNTERWINDOW 208735 . 210197) (FB.COUNTERW.REDISPLAYFN 210199 . 210786) (
FB.UPDATE.COUNTERS 210788 . 212860) (FB.DISPLAY.COUNTERS 212862 . 217922) (FB.COUNTER.STRING 217924 .
218189)) (218192 222835 (FB.MAKEHEADINGWINDOW 218202 . 219750) (FB.HEADINGW.REDISPLAYFN 219752 .
220018) (FB.HEADINGW.RESHAPEFN 220020 . 220396) (FB.HEADINGW.DISPLAY 220398 . 222833)) (222836 227019
(FB.ICONFN 222846 . 223193) (FB.INFOMENU.WHENSELECTEDFN 223195 . 223925) (FB.CLOSEFN 223927 . 225130)
(FB.EXPUNGE?.MENU 225132 . 225544) (FB.AFTERCLOSEFN 225546 . 225907) (FB.CLOSE&EXPUNGE 225909 . 227017
)) (227020 239078 (FB.HARDCOPY.DIRECTORY 227030 . 237387) (FB.HARDCOPY.PRINT.TITLE 237389 . 237715) (
FB.HARDCOPY.MAXWIDTH 237717 . 239076)))))
(FILEMAP (NIL (28719 51355 (FB 28729 . 29685) (FB.COPYBINARYCOMMAND 29687 . 30033) (FB.COPYTEXTCOMMAND
30035 . 30377) (FILEBROWSER 30379 . 43485) (FB.TABLEBROWSER 43487 . 43704) (FB.SELECTEDFILES 43706 .
44343) (FB.FETCHFILENAME 44345 . 44737) (FB.DIRECTORYP 44739 . 45067) (FB.PROMPTWPRINT 45069 . 46115)
(FB.PROMPTW.FORMAT 46117 . 46854) (FB.PROMPTFORINPUT 46856 . 49108) (FB.YES-OR-NO-P 49110 . 50144) (
FB.ALLOW.ABORT 50146 . 51000) (\\FB.HARDCOPY.TOFILE.EXTENSION 51002 . 51353)) (51379 52332 (FB.STARTUP
51389 . 51904) (FB.MAKERIGIDWINDOW 51906 . 52330)) (52333 57705 (FB.PRINTFN 52343 . 57496) (FB.COPYFN
57498 . 57703)) (57755 63797 (FB.MENU.WHENSELECTEDFN 57765 . 58123) (FB.COMMANDSELECTEDFN 58125 .
59664) (FB.SUBITEMP 59666 . 60101) (FB.MAKE.BROWSER.BUSY 60103 . 60841) (FB.FINISH.COMMAND 60843 .
62808) (FB.HANDLE.ABORT.BUTTON 62810 . 63795)) (63798 69314 (FB.DELETECOMMAND 63808 . 64089) (
FB.DELVERCOMMAND 64091 . 67284) (FB.IS.NOT.SUBDIRECTORY.ITEM 67286 . 67467) (FB.DELVER.FILES 67469 .
68558) (FB.DELETE.FILE 68560 . 69312)) (69315 70640 (FB.UNDELETECOMMAND 69325 . 69610) (
FB.UNDELETEALLCOMMAND 69612 . 69891) (FB.UNDELETE.FILE 69893 . 70638)) (70641 94822 (FB.COPYCOMMAND
70651 . 70920) (FB.RENAMECOMMAND 70922 . 71197) (FB.COPY/RENAME.COMMAND 71199 . 72122) (
FB.COPY/RENAME.ONE 72124 . 74446) (FB.COPY/RENAME.MANY 74448 . 80668) (FB.MERGE.DIRECTORIES 80670 .
81088) (FB.GREATEST.PREFIX 81090 . 82446) (FB.MAYBE.INSERT.FILE 82448 . 89888) (FB.GET.NEW.FILE.SPEC
89890 . 93721) (FB.CANONICAL.DIRECTORY 93723 . 94820)) (94823 102607 (FB.HARDCOPYCOMMAND 94833 . 95963
) (FB.HARDCOPY.TOFILE 95965 . 102605)) (102608 112485 (FB.EDITCOMMAND 102618 . 103419) (
FB.EDITCOMMAND.ONEFILE 103421 . 106701) (FB.EDITLISPFILE 106703 . 107742) (FB.BROWSECOMMAND 107744 .
112483)) (112486 124279 (FB.FASTSEECOMMAND 112496 . 115946) (FB.FASTSEE.ONEFILE 115948 . 118977) (
FB.SEEFULLFN 118979 . 123110) (FB.SEEBUTTONFN 123112 . 124277)) (124280 126026 (FB.LOADCOMMAND 124290
. 124797) (FB.COMPILECOMMAND 124799 . 125337) (FB.OPERATE.ON.FILES 125339 . 126024)) (126027 173598 (
FB.UPDATECOMMAND 126037 . 126262) (FB.FIX-DIRECTORY-DATES 126264 . 126871) (FB.MAYBE.EXPUNGE 126873 .
127868) (FB.UPDATEBROWSERITEMS 127870 . 141085) (FB.DATE 141087 . 141662) (FB.ADJUST.DATE.WIDTH 141664
. 144632) (FB.SET.BROWSER.TITLE 144634 . 145570) (FB.MAYBE.WIDEN.NAMES 145572 . 147691) (
FB.SET.DEFAULT.NAME.WIDTH 147693 . 149057) (FB.CREATE.FILEBUCKET 149059 . 156279) (
FB.CHECK.NAME.LENGTH 156281 . 158702) (FB.ADD.FILEGROUP 158704 . 160231) (FB.INSERT.DIRECTORY 160233
. 160471) (FB.MAKE.SUBDIRECTORY.ITEM 160473 . 161882) (FB.ADD.FILE 161884 . 162497) (FB.INSERT.FILE
162499 . 165911) (FB.ANALYZE.PATTERN 165913 . 171177) (FB.CANONICALIZE.PATTERN 171179 . 172491) (
FB.GETALLFILEINFO 172493 . 173596)) (173599 181758 (FB.SORT.VERSIONS 173609 . 176380) (
FB.DECREASING.VERSION 176382 . 177051) (FB.INCREASING.VERSION 177053 . 177674) (
FB.NAMES.DECREASING.VERSION 177676 . 178711) (FB.NAMES.INCREASING.VERSION 178713 . 179710) (
FB.DECREASING.NUMERIC.ATTR 179712 . 180392) (FB.INCREASING.NUMERIC.ATTR 180394 . 181068) (
FB.ALPHABETIC.ATTR 181070 . 181756)) (181759 191601 (FB.SORTCOMMAND 181769 . 188599) (
FB.INSERT.SUBDIRECTORIES 188601 . 189398) (FB.GET.SORT.MENU 189400 . 191599)) (191602 207691 (
FB.EXPUNGECOMMAND 191612 . 194131) (FB.NEWPATTERNCOMMAND 194133 . 194531) (FB.NEWINFOCOMMAND 194533 .
197299) (FB.DEPTHCOMMAND 197301 . 199076) (FB.SHAPECOMMAND 199078 . 202420) (FB.REMOVE.FILE 202422 .
204243) (FB.COUNT.FILE.CHANGE 204245 . 205690) (FB.SETNEWPATTERN 205692 . 206862) (FB.GET.NEWPATTERN
206864 . 207448) (FB.OPTIONSCOMMAND 207450 . 207689)) (207726 208713 (FB.GETWINDOW 207736 . 208711)) (
208714 209726 (FB.INFOMENU.SHADEINITIALSELECTIONS 208724 . 209371) (FB.INFO.ITEM.NAMED 209373 . 209724
)) (209727 219193 (FB.MAKECOUNTERWINDOW 209737 . 211199) (FB.COUNTERW.REDISPLAYFN 211201 . 211788) (
FB.UPDATE.COUNTERS 211790 . 213862) (FB.DISPLAY.COUNTERS 213864 . 218924) (FB.COUNTER.STRING 218926 .
219191)) (219194 223837 (FB.MAKEHEADINGWINDOW 219204 . 220752) (FB.HEADINGW.REDISPLAYFN 220754 .
221020) (FB.HEADINGW.RESHAPEFN 221022 . 221398) (FB.HEADINGW.DISPLAY 221400 . 223835)) (223838 228021
(FB.ICONFN 223848 . 224195) (FB.INFOMENU.WHENSELECTEDFN 224197 . 224927) (FB.CLOSEFN 224929 . 226132)
(FB.EXPUNGE?.MENU 226134 . 226546) (FB.AFTERCLOSEFN 226548 . 226909) (FB.CLOSE&EXPUNGE 226911 . 228019
)) (228022 240080 (FB.HARDCOPY.DIRECTORY 228032 . 238389) (FB.HARDCOPY.PRINT.TITLE 238391 . 238717) (
FB.HARDCOPY.MAXWIDTH 238719 . 240078)))))
STOP

BIN
library/FILEBROWSER.LCOM
View File

Binary file not shown.

11
lispusers/COMPAREDIRECTORIES.TEDIT
View File

File diff suppressed because one or more lines are too long

196
lispusers/MODERNIZE
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "12-Oct-2021 14:57:29" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;28 25303
(FILECREATED "16-Oct-2021 15:42:11" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;41 30305
changes to%: (FNS MODERNWINDOW.BUTTONEVENTFN \MODERNIZED.TEDIT.BUTTONEVENTFN)
changes to%: (FNS MODERNIZED.TB.BUTTONEVENTFN)
previous date%: "12-Oct-2021 08:34:48"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;26)
previous date%: "16-Oct-2021 15:29:38"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;40)
(PRETTYCOMPRINT MODERNIZECOMS)
@@ -15,7 +15,8 @@
[
(* ;; "Externals")
(COMS (FNS MODERNWINDOW MODERNWINDOW.SETUP UNMODERNWINDOW MODERNWINDOW.UNSETUP)
(COMS (FNS MODERNWINDOW MODERNWINDOW.SETUP UNMODERNWINDOW MODERNWINDOW.UNSETUP
\MODERNIZED.FREEMENU.BUTTONEVENTFN)
(INITVARS (MODERN-WINDOW-MARGIN 25)))
(* ;; "Internals")
@@ -25,6 +26,7 @@
(* ;; "Behavior for some known window creators")
(FNS MODERN-ADD-EXEC MODERN-SNAPW TOTOPW.MODERNIZE MODERN-MENUBUTTONFN)
(FNS \MODERNIZED.FREEMENU.BUTTONEVENTFN MODERNIZED.TB.BUTTONEVENTFN)
(* ;; "Add some Meta commands")
@@ -44,9 +46,10 @@
(* (MODERNWINDOW.SETUP 'ONEDINSPECT.BUTTONEVENTFN))
(MODERNWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN)
(* ;; "Freemenu")
(* ;; "File browser")
(MODERNWINDOW.SETUP '\FM.BUTTONEVENTFN)
(MODERNWINDOW.SETUP '\FM.BUTTONEVENTFN
'\MODERNIZED.FREEMENU.BUTTONEVENTFN)
(* ;; "SEDIT")
@@ -69,9 +72,10 @@
(MODERNWINDOW (PROCESSPROP (TTY.PROCESS)
'WINDOW))
(* ;; "Table browser (for filebrowser)")
(* ;; "Table browser and filebrowser)")
(MODERNWINDOW.SETUP 'TB.BUTTONEVENTFN)
(MODERNWINDOW.SETUP 'TB.BUTTONEVENTFN
'MODERNIZED.TB.BUTTONEVENTFN)
(* ;; "Grapher")
@@ -190,6 +194,17 @@
PKGNAME))
(CL:WHEN (GETD RENAMEDORIG)
(MOVD RENAMEDORIG ORIGFN])
(\MODERNIZED.FREEMENU.BUTTONEVENTFN
[LAMBDA (W STREAM) (* ; "Edited 13-Oct-2021 15:15 by rmk:")
(* ;; "If a free menu is attached to another window, we don't want the corners of the free menu that abut another window to be hot-spots for moving or reshaping. In fact, if the menu window has a main window, use the main window's region as the cornerregion")
(MODERNWINDOW.BUTTONEVENTFN W (FUNCTION MODERN-ORIG-\FM.BUTTONEVENTFN)
NIL NIL (WINDOWPROP (CENTRALWINDOW W)
'REGION)
(WINDOWPROP (CENTRALWINDOW W)
'TITLE])
)
(RPAQ? MODERN-WINDOW-MARGIN 25)
@@ -201,27 +216,49 @@
(DEFINEQ
(MODERNWINDOW.BUTTONEVENTFN
[LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION)
(* ; "Edited 12-Oct-2021 14:56 by rmk:")
[LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION TOPMARGIN)
(* ; "Edited 16-Oct-2021 15:25 by rmk:")
(* ;; "CORNERREGION is the region that determines the identification of corner and title clicks, presumably excludes uninteresting menus and other attachments that would also be part of the moving and reshaping region (the ATTACHEDREGION below).")
(* ;; "WINDOW is the window that received the click and that should be passed through to the original function, if we don't pick it off here.")
(if (AND (MOUSESTATE (ONLY LEFT))
(EQ LASTKEYBOARD 0))
then (TOTOPW WINDOW)
(CL:UNLESS CORNERREGION (* ;
 "Could cover a bunch of Tedit split-panes")
(SETQ CORNERREGION (WINDOWPROP WINDOW 'REGION)))
(LET [CORNER TOPMARGIN (ATTACHEDREGION (ATTACHEDWINDOWREGION (CENTRALWINDOW WINDOW]
(* ;; "However, that window may be an auxiliary window (an attached menu? or a lower split-pane in Tedit) whose region and title intuitively should not be used to control shaping and moving behavior. That behavior is determined by the CORNERREGION and TITLED parameters.")
(* ;; "If CORNERREGION is given, we know that there are two windows in play. In that case also TOPMARGIN tells us the hotband at the top of the cornerregion where the move/shaping click is recognized, T to mean that it has an ordinary title bar. .")
(* ;; "For windows without a top margin, the shape/move region is MODERN-WINDOW-MARGIN points below the top, in the clipping region of the window. ")
(* ;; "Not sure about using MODERN-WINDOW-MARGIN for the top region of an untitle window. Maybe it should be 2 times the border width in that case, and the MODERN-WINDOW-MARGIN separately defines the rectangle that constitutes a corner.")
(LET (CORNER ATTACHEDREGION)
(IF CORNERREGION
THEN
(* ;; "Caller tells us whether the corner window has a title.")
(CL:UNLESS (FIXP TOPMARGIN)
(SETQ TOPMARGIN (if TOPMARGIN
then (FONTPROP WindowTitleDisplayStream 'HEIGHT)
else MODERN-WINDOW-MARGIN)))
ELSE (SETQ CORNERREGION (WINDOWPROP WINDOW 'REGION))
(* ; "WINDOW is the corner window")
(SETQ TOPMARGIN (if (WINDOWPROP WINDOW 'TOPMARGIN)
elseif (WINDOWPROP WINDOW 'TITLE)
then (FONTPROP WindowTitleDisplayStream 'HEIGHT)
else MODERN-WINDOW-MARGIN)))
(if (AND (MOUSESTATE (ONLY LEFT))
(EQ LASTKEYBOARD 0)
(INSIDE? CORNERREGION LASTMOUSEX LASTMOUSEY))
then
(* ;; "INSIDE? check because we may be called by a click in WINDOW that is outside the corner region, we just pass it through.")
(TOTOPW WINDOW)
(SETQ ATTACHEDREGION (ATTACHEDWINDOWREGION (CENTRALWINDOW WINDOW)))
(* ;; "If the window has a TOPMARGIN property, that tells us that it does not have a canonical title but may still have a title-like attached window just above the main window. The TOPMARGIN should be 0 in that case.")
(* ;; "This is particularly the case of FILEBROWSER windows, where the modified ATTACHEDWINDOWTOTOPFN drives the click here. ")
(SETQ TOPMARGIN (if (WINDOWPROP WINDOW 'TOPMARGIN)
elseif (WINDOWPROP WINDOW 'TITLE)
then (FONTPROP WindowTitleDisplayStream 'HEIGHT)
else MODERN-WINDOW-MARGIN))
(SETQ CORNER (INCORNER.REGION CORNERREGION TOPMARGIN))
(if CORNER
then
@@ -262,31 +299,28 @@
STARTINGREGION))
T
elseif (OR ANYWHERE (NEARTOP CORNERREGION TOPMARGIN TITLEPROPORTION))
then
(* ;; "")
(NEARESTCORNER ATTACHEDREGION)
then (NEARESTCORNER ATTACHEDREGION)
(MOVEW (CENTRALWINDOW WINDOW))
T
elseif [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW
'PREMODERN-BUTTONEVENTFN]
then (APPLY* ORIGFUNCTION WINDOW)))
elseif [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN]
then (APPLY* ORIGFUNCTION WINDOW])
then (APPLY* ORIGFUNCTION WINDOW))
elseif [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW
'PREMODERN-BUTTONEVENTFN]
then (APPLY* ORIGFUNCTION WINDOW])
(NEARTOP
[LAMBDA (MAINREGION TOPMARGIN TITLEPROPORTION) (* ; "Edited 24-Jun-2021 14:51 by rmk:")
[LAMBDA (CORNERREGION TOPMARGIN TITLEPROPORTION) (* ; "Edited 13-Oct-2021 21:28 by rmk:")
(* ;; "True if the MOUSEY is near the top of MAINREGION. That means in the title bar for titled windows, otherwise a short distance below the top of the window. (Could be in the border?)")
(* ;; "True if the MOUSEY is near the top of CORNERREGION. That means in the title bar for titled windows, otherwise a short distance below the top of the window. (Could be in the border?)")
(* ;; "If TITLEPROPORTION is N, then the click must be within that proportion of the window-width from either edge. ")
(* ;; "If TITLEPROPORTION is N, then the click must be within that proportion of the window-width from either edge. ")
(AND (IGREATERP LASTMOUSEY (IDIFFERENCE (FETCH TOP OF MAINREGION)
(AND (IGREATERP LASTMOUSEY (IDIFFERENCE (FETCH TOP OF CORNERREGION)
TOPMARGIN))
(OR (NOT TITLEPROPORTION)
(LET ((WIDTH (FETCH WIDTH of MAINREGION))
(LEFT (FETCH LEFT OF MAINREGION)))
(LET ((WIDTH (FETCH WIDTH of CORNERREGION))
(LEFT (FETCH LEFT OF CORNERREGION)))
(OR (ILESSP LASTMOUSEX (IPLUS LEFT (TIMES WIDTH TITLEPROPORTION)))
(IGREATERP LASTMOUSEX (IPLUS LEFT (TIMES WIDTH (DIFFERENCE 1 TITLEPROPORTION])
@@ -308,25 +342,25 @@
(FETCH TOP OF REGION))])
(INCORNER.REGION
[LAMBDA (MAINREGION TOPMARGIN) (* ; "Edited 22-Feb-2021 16:27 by rmk:")
[LAMBDA (CORNERREGION TOPMARGIN) (* ; "Edited 13-Oct-2021 15:04 by rmk:")
(* ;; "MAINREGION, LASTMOUSEX, LASTMOUSEY in screen coordinates.")
(* ;; "CORNERREGION, LASTMOUSEX, LASTMOUSEY in screen coordinates.")
(* ;; "TOPMARGIN is the height of the titlebar for titled windows, otherwise the margin at the top of the window's content that we regard as the top. ")
(* ;; "TOPMARGIN is the height of the titlebar for titled windows, otherwise the margin at the top of the window's content that we regard as the top. ")
(IF (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH LEFT OF MAINREGION)))
(IF (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH LEFT OF CORNERREGION)))
MODERN-WINDOW-MARGIN)
THEN (IF (NEARTOP MAINREGION TOPMARGIN)
THEN (IF (NEARTOP CORNERREGION TOPMARGIN)
THEN 'LEFTTOP
ELSEIF (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (FETCH BOTTOM
OF MAINREGION)))
OF CORNERREGION)))
THEN 'LEFTBOTTOM)
ELSEIF (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH RIGHT OF MAINREGION)))
ELSEIF (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH RIGHT OF CORNERREGION)))
MODERN-WINDOW-MARGIN)
THEN (IF (NEARTOP MAINREGION TOPMARGIN)
THEN (IF (NEARTOP CORNERREGION TOPMARGIN)
THEN 'RIGHTTOP
ELSEIF (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (FETCH BOTTOM
OF MAINREGION)))
OF CORNERREGION)))
THEN 'RIGHTBOTTOM])
)
@@ -388,6 +422,44 @@
THEN (MOVEW WINDOW)
ELSE (MODERN-ORIG-MENUBUTTONFN WINDOW])
)
(DEFINEQ
(\MODERNIZED.FREEMENU.BUTTONEVENTFN
[LAMBDA (W STREAM) (* ; "Edited 13-Oct-2021 15:15 by rmk:")
(* ;; "If a free menu is attached to another window, we don't want the corners of the free menu that abut another window to be hot-spots for moving or reshaping. In fact, if the menu window has a main window, use the main window's region as the cornerregion")
(MODERNWINDOW.BUTTONEVENTFN W (FUNCTION MODERN-ORIG-\FM.BUTTONEVENTFN)
NIL NIL (WINDOWPROP (CENTRALWINDOW W)
'REGION)
(WINDOWPROP (CENTRALWINDOW W)
'TITLE])
(MODERNIZED.TB.BUTTONEVENTFN
[LAMBDA (W STREAM) (* ; "Edited 16-Oct-2021 15:40 by rmk:")
(* ;; "If a free menu is attached to another window, we don't want the corners of the free menu that abut another window to be hot-spots for moving or reshaping. In fact, if the menu window has a main window, use the main window's region as the cornerregion")
(LET ((CW (CENTRALWINDOW W))
CORNERREG TOPMARGIN)
(CL:WHEN (WINDOWPROP CW 'FILEBROWSER)
[SETQ CORNERREG (UNIONREGIONS (WINDOWPROP (FB.GETWINDOW CW 'HEADING)
'REGION)
(WINDOWPROP (FB.GETWINDOW CW 'COUNTER)
'REGION)
(WINDOWPROP (FB.GETWINDOW CW 'BROWSER)
'REGION]
[SETQ TOPMARGIN (IPLUS (FETCH (REGION HEIGHT) OF (WINDOWPROP (FB.GETWINDOW
CW
'HEADING)
'REGION))
(FETCH (REGION HEIGHT) OF (WINDOWPROP (FB.GETWINDOW
CW
'COUNTER)
'REGION])
(MODERNWINDOW.BUTTONEVENTFN W (FUNCTION MODERN-ORIG-TB.BUTTONEVENTFN)
NIL NIL CORNERREG TOPMARGIN])
)
@@ -420,17 +492,19 @@
TEDIT.READTABLE))])
(\MODERNIZED.TEDIT.BUTTONEVENTFN
[LAMBDA (W STREAM) (* ; "Edited 12-Oct-2021 14:27 by rmk:")
[LAMBDA (W STREAM) (* ; "Edited 13-Oct-2021 21:43 by rmk:")
(* ;; "If a TEDIT window has been split, we have to make sure that movement happens only for clicks at the top of the main window and at the bottom of the bottom-most split window. Clicks near the split lines must be ignored. Essentially, the %"region%" of the Tedit window is the union of the regions of all of its split-panes.")
(* ;; "We pass the pain that received the click, because that's what the original \TEDIT.BUTTONEVENTFN needs to see, if we decide not to shape or move.")
(MODERNWINDOW.BUTTONEVENTFN W (FUNCTION MODERN-ORIG-\TEDIT.BUTTONEVENTFN)
NIL NIL (APPLY (FUNCTION UNIONREGIONS)
NIL NIL [APPLY (FUNCTION UNIONREGIONS)
(bind PANE _ (CENTRALWINDOW W) collect (WINDOWPROP PANE
'REGION)
repeatwhile (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN])
repeatwhile (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN]
(WINDOWPROP (CENTRALWINDOW W)
'TITLE])
(TEDIT.SELECTALL
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 3-May-2020 17:29 by rmk:")
@@ -463,10 +537,10 @@
(MODERNWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN)
(* ;; "Freemenu")
(* ;; "File browser")
(MODERNWINDOW.SETUP '\FM.BUTTONEVENTFN)
(MODERNWINDOW.SETUP '\FM.BUTTONEVENTFN '\MODERNIZED.FREEMENU.BUTTONEVENTFN)
(* ;; "SEDIT")
@@ -500,10 +574,10 @@
'WINDOW))
(* ;; "Table browser (for filebrowser)")
(* ;; "Table browser and filebrowser)")
(MODERNWINDOW.SETUP 'TB.BUTTONEVENTFN)
(MODERNWINDOW.SETUP 'TB.BUTTONEVENTFN 'MODERNIZED.TB.BUTTONEVENTFN)
(* ;; "Grapher")
@@ -538,10 +612,12 @@
(ADDTOVAR LAMA MODERN-ADD-EXEC)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4845 10473 (MODERNWINDOW 4855 . 6310) (MODERNWINDOW.SETUP 6312 . 9261) (UNMODERNWINDOW
9263 . 9657) (MODERNWINDOW.UNSETUP 9659 . 10471)) (10538 18976 (MODERNWINDOW.BUTTONEVENTFN 10548 .
15873) (NEARTOP 15875 . 16795) (NEARESTCORNER 16797 . 17676) (INCORNER.REGION 17678 . 18974)) (19034
21356 (MODERN-ADD-EXEC 19044 . 19475) (MODERN-SNAPW 19477 . 20020) (TOTOPW.MODERNIZE 20022 . 20450) (
MODERN-MENUBUTTONFN 20452 . 21354)) (21397 23609 (TEDIT.MODERNIZE 21407 . 22221) (
\MODERNIZED.TEDIT.BUTTONEVENTFN 22223 . 23278) (TEDIT.SELECTALL 23280 . 23607)))))
(FILEMAP (NIL (5135 11412 (MODERNWINDOW 5145 . 6600) (MODERNWINDOW.SETUP 6602 . 9551) (UNMODERNWINDOW
9553 . 9947) (MODERNWINDOW.UNSETUP 9949 . 10761) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10763 . 11410)) (
11477 21412 (MODERNWINDOW.BUTTONEVENTFN 11487 . 18287) (NEARTOP 18289 . 19217) (NEARESTCORNER 19219 .
20098) (INCORNER.REGION 20100 . 21410)) (21470 23792 (MODERN-ADD-EXEC 21480 . 21911) (MODERN-SNAPW
21913 . 22456) (TOTOPW.MODERNIZE 22458 . 22886) (MODERN-MENUBUTTONFN 22888 . 23790)) (23793 26222 (
\MODERNIZED.FREEMENU.BUTTONEVENTFN 23803 . 24450) (MODERNIZED.TB.BUTTONEVENTFN 24452 . 26220)) (26263
28542 (TEDIT.MODERNIZE 26273 . 27087) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27089 . 28211) (TEDIT.SELECTALL
28213 . 28540)))))
STOP

BIN
lispusers/MODERNIZE.LCOM
View File

Binary file not shown.

10
lispusers/WHEELSCROLL.TXT
View File

@@ -2,7 +2,7 @@ lispusers/WHEELSCROLL
Written by Ron Kaplan, February 2021.
This small file adds the ability to scroll (scrollable) windows by rotating the wheel on a wheel mouse or by moving fingers on a track pad.
This small file adds the ability to scroll (scrollable) windows by rotating the wheel on a wheel mouse or by moving (2?) fingers on a track pad.
The capability is enabled when WHEELSCROLL.LCOM is loaded.
@@ -13,11 +13,13 @@ It is toggled on and off by
The scrolling speed is controlled by the variable
WHEELSCROLLDELTA (initially 20)
The number of points to scroll for each click of the wheel. Higher values give faster scrolling. A negative value reverses the scrolling direction.
The number of points to scroll for each click of the wheel. Higher values give faster scrolling. A negative value reverses the scrolling direction.
Implementation:
Lisp receives a key transition on PAD1 or PAD2 for vertical scrolling when the wheel rotates and no other keys are down. (ENABLEWHEELSCROLL T) modifies the keyaction table that maps these to characters 520 and 521, and those characters are defined as interrupts that invoke the scrolling action. (ENABLEWHEELSCROLL NIL) causes PAD1 and PAD2 to be ignored.
Lisp receives a key transition on PAD1 or PAD2 for vertical scrolling when the wheel rotates and no other keys are down. (ENABLEWHEELSCROLL T) modifies the keyaction table so that it maps these transitions to characters 156 and 157. Those characters are defined as interrupts that invoke the vertical scrolling action. For horizontal scrolling sideways pushes of a wheel (if it has that) produce transitions on PAD4 and PAD5, which map to interrupt-characters 158 and 159. (156-159 are the highest right-panel characters of character-set 0 that correspond to left-panel control characters, so typically have no other conflicting meaning.)
(ENABLEWHEELSCROLL NIL) causes PAD1, PAD2, PAD4, and PAD5 to be ignored.
Current negative features:
@@ -25,4 +27,4 @@ Current negative features:
We need to develop a strategy, either in Lisp, Maiko, or X, to discriminate intended middle-button pushes from intended scrolling. This is not an issue for track-pad scrolling.
2. When the wheel is rotated over a window that partially occludes a Tedit window with a caret blinking in its unoccluded region, both the target window and the Tedit window may scroll.
2. When the wheel is rotated over a window that partially occludes a Tedit window with a caret blinking in its unoccluded region, both the target window and the partially obscured Tedit window may scroll.