Merge branch 'master' into rmk122--FONT-next-round
This commit is contained in:
rmkaplan
@@ -1,13 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "21-Apr-2024 09:12:04" {WMEDLEY}<library>CLIPBOARD.;18 7248
|
||||
(FILECREATED "25-Sep-2025 15:00:01"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>CLIPBOARD.;28 8305
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS INSTALL-CLIPBOARD)
|
||||
(VARS CLIPBOARDCOMS)
|
||||
:CHANGES-TO (FNS PUTCLIPBOARD CLIPBOARD-COPY-STREAM)
|
||||
|
||||
:PREVIOUS-DATE " 2-Apr-2024 17:02:09" {WMEDLEY}<library>CLIPBOARD.;17)
|
||||
:PREVIOUS-DATE "21-Apr-2024 09:12:04" {WMEDLEY}<library>CLIPBOARD.;18)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT CLIPBOARDCOMS)
|
||||
@@ -58,12 +58,29 @@
|
||||
(CONCATCODES (BIND C WHILE (SETQ C (READCCODE s)) COLLECT C])
|
||||
|
||||
(PUTCLIPBOARD
|
||||
[LAMBDA (OBJECT PRINTFN) (* ; "Edited 23-Feb-2021 11:32 by rmk:")
|
||||
(* ; "Edited 25-Apr-2018 16:49 by rmk:")
|
||||
(CL:WITH-OPEN-STREAM (s (CLIPBOARD-COPY-STREAM))
|
||||
(IF PRINTFN
|
||||
THEN (APPLY* PRINTFN OBJECT s)
|
||||
ELSE (PRIN3 OBJECT s])
|
||||
[LAMBDA (OBJECT PRINTFN) (* ; "Edited 25-Sep-2025 14:59 by rmk")
|
||||
(* ; "Edited 23-Feb-2021 11:32 by rmk:")
|
||||
(* ; "Edited 25-Apr-2018 16:49 by rmk:")
|
||||
(if (STRPOS "darwin" (UNIX-GETENV "OSTYPE"))
|
||||
then
|
||||
(* ;; "pbpaste doesn't seem to take a file argument.")
|
||||
|
||||
(CL:WITH-OPEN-STREAM (S (CREATE-PROCESS-STREAM "pbcopy"))
|
||||
(CL:IF PRINTFN
|
||||
(APPLY* PRINTFN OBJECT S)
|
||||
(PRIN3 OBJECT S)))
|
||||
else
|
||||
(* ;; "Try to make xclip more reliable by passing a file that already contains the input.")
|
||||
|
||||
(LET ((TEMPFILE (OUTFILEP "{DSK}/tmp/xclip-copy.txt")))
|
||||
(CL:WITH-OPEN-FILE (S TEMPFILE :DIRECTION :OUTPUT :EXTERNAL-FORMAT (
|
||||
SYSTEM-EXTERNALFORMAT
|
||||
))
|
||||
(CL:IF PRINTFN
|
||||
(APPLY* PRINTFN OBJECT S)
|
||||
(PRIN3 OBJECT S)))
|
||||
(ShellCommand (CONCAT "xclip -i -selection clipboard " (UNIX-FILE-NAME TEMPFILE)))
|
||||
(DELFILE TEMPFILE])
|
||||
|
||||
(PASTEFROMCLIPBOARD
|
||||
[LAMBDA NIL (* ; "Edited 15-Feb-2021 23:43 by rmk:")
|
||||
@@ -81,13 +98,12 @@
|
||||
ELSE (BIND C WHILE (SETQ C (GNCCODE STR)) DO (BKSYSCHARCODE C])
|
||||
|
||||
(CLIPBOARD-COPY-STREAM
|
||||
[LAMBDA NIL (* ; "Edited 7-Jul-2022 23:51 by rmk")
|
||||
[LAMBDA NIL (* ; "Edited 24-Sep-2025 14:27 by rmk")
|
||||
(* ; "Edited 7-Jul-2022 23:51 by rmk")
|
||||
(* ; "Edited 23-Feb-2021 22:11 by rmk:")
|
||||
(LET (STRM (OST (UNIX-GETENV "OSTYPE")))
|
||||
(SETQ STRM (CREATE-PROCESS-STREAM (CL:IF (STRPOS "darwin" OST)
|
||||
"pbcopy"
|
||||
"xclip -i -selection clipboard")))
|
||||
STRM])
|
||||
(CREATE-PROCESS-STREAM (CL:IF (STRPOS "darwin" (UNIX-GETENV "OSTYPE"))
|
||||
"pbcopy"
|
||||
"xclip -i -selection clipboard")])
|
||||
|
||||
(CLIPBOARD-PASTE-STREAM
|
||||
[LAMBDA NIL (* ; "Edited 7-Jul-2022 23:51 by rmk")
|
||||
@@ -146,7 +162,7 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1148 5429 (INSTALL-CLIPBOARD 1158 . 2485) (GETCLIPBOARD 2487 . 2861) (PUTCLIPBOARD 2863
|
||||
. 3268) (PASTEFROMCLIPBOARD 3270 . 4188) (CLIPBOARD-COPY-STREAM 4190 . 4705) (CLIPBOARD-PASTE-STREAM
|
||||
4707 . 5427)) (5430 6969 (SEDIT.COPYTOCLIPBOARD 5440 . 6967)))))
|
||||
(FILEMAP (NIL (1167 6486 (INSTALL-CLIPBOARD 1177 . 2504) (GETCLIPBOARD 2506 . 2880) (PUTCLIPBOARD 2882
|
||||
. 4306) (PASTEFROMCLIPBOARD 4308 . 5226) (CLIPBOARD-COPY-STREAM 5228 . 5762) (CLIPBOARD-PASTE-STREAM
|
||||
5764 . 6484)) (6487 8026 (SEDIT.COPYTOCLIPBOARD 6497 . 8024)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "18-Jan-2024 10:40:56" {WMEDLEY}<sources>MACHINEINDEPENDENT.;38 117576
|
||||
(FILECREATED "29-Sep-2025 12:51:06"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>MACHINEINDEPENDENT.;39 119579
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS LISPSOURCEFILEP)
|
||||
:CHANGES-TO (VARS MACHINEINDEPENDENTCOMS)
|
||||
|
||||
:PREVIOUS-DATE "20-Jul-2022 19:55:30" {WMEDLEY}<sources>MACHINEINDEPENDENT.;36)
|
||||
:PREVIOUS-DATE "18-Jan-2024 10:40:56"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>MACHINEINDEPENDENT.;38)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MACHINEINDEPENDENTCOMS)
|
||||
@@ -28,10 +30,10 @@
|
||||
(INITVARS (OK.TO.MODIFY.FNS))
|
||||
[COMS (* ;
|
||||
"FILEDATE, for finding out the creation date of source files, from the compiled files.")
|
||||
(FNS FILEDATE COMPILEFILETYPE)
|
||||
|
||||
(* ;; "FASL isn't loaded when MACHINEINDEPENDENT is, so we have to fake the FASL checker for now. It's defined in FASLOAD.")
|
||||
|
||||
(FNS FILEDATE)
|
||||
(P (MOVD? 'NILL 'FASL-FILEDATE]
|
||||
(P (MOVD? 'CL:FMAKUNBOUND 'UNDOABLY-FMAKUNBOUND))
|
||||
(* ;
|
||||
@@ -1348,13 +1350,6 @@ WRITEFILE OF ")
|
||||
|
||||
(* ; "FILEDATE, for finding out the creation date of source files, from the compiled files.")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"FASL isn't loaded when MACHINEINDEPENDENT is, so we have to fake the FASL checker for now. It's defined in FASLOAD."
|
||||
)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(FILEDATE
|
||||
@@ -1403,8 +1398,45 @@ WRITEFILE OF ")
|
||||
(COND
|
||||
(OLDPTR (SETFILEPTR STREAM OLDPTR)))
|
||||
(RETURN VALUE)))])
|
||||
|
||||
(COMPILEFILETYPE
|
||||
[LAMBDA (CFILE) (* ; "Edited 29-Sep-2025 12:26 by rmk")
|
||||
|
||||
(* ;; "Returns the type of compiler used to compile the compiled-file CFILE: CL:COMPILE-FILE IL:FAKE-COMPILE-FILE IL:BCOMP")
|
||||
|
||||
(CL:WHEN CFILE
|
||||
[CAR (NLSETQ
|
||||
(RESETLST
|
||||
[LET (STREAM COMPILER)
|
||||
[if (SETQ STREAM (\GETSTREAM CFILE 'INPUT T))
|
||||
then [RESETSAVE NIL `(PROGN (SETFILEPTR ,STREAM ,(GETFILEPTR STREAM]
|
||||
else (* ;
|
||||
"OPENSTREAM used instead of INFILEP to allow for error correction.")
|
||||
(RESETSAVE (SETQ STREAM (OPENSTREAM CFILE 'INPUT))
|
||||
`(PROGN (CLOSEF? OLDVALUE]
|
||||
(CL:WHEN (RANDACCESSP STREAM)
|
||||
(SETFILEPTR STREAM 0)
|
||||
[if (FASL-FILEDATE STREAM T)
|
||||
then (* ; " A Dfasl file")
|
||||
'CL:COMPILE-FILE
|
||||
else (SETFILEPTR STREAM 0) (* ; "Any other filetype")
|
||||
(CL:MULTIPLE-VALUE-BIND (ENV FORM)
|
||||
(\PARSE-FILE-HEADER STREAM 'RETURN)
|
||||
(CL:WHEN (LISTP FORM)
|
||||
(* ;
|
||||
"First expression is for compiled file")
|
||||
(SELECTQ (MKATOM (CADDDR (CDR FORM)))
|
||||
(COMPILE-FILEd 'FAKE-COMPILE-FILE)
|
||||
'BCOMPL))])])])])
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"FASL isn't loaded when MACHINEINDEPENDENT is, so we have to fake the FASL checker for now. It's defined in FASLOAD."
|
||||
)
|
||||
|
||||
|
||||
(MOVD? 'NILL 'FASL-FILEDATE)
|
||||
|
||||
(MOVD? 'CL:FMAKUNBOUND 'UNDOABLY-FMAKUNBOUND)
|
||||
@@ -2463,23 +2495,23 @@ This has little hope of working any more.")
|
||||
(LOCALVARS . T)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (12537 25962 (LOAD? 12547 . 14398) (FILESLOAD 14400 . 14689) (DOFILESLOAD 14691 . 22317)
|
||||
(FINDFILE-WITH-EXTENSIONS 22319 . 25518) (READ-FILECREATED 25520 . 25960)) (26079 31400 (DMPHASH
|
||||
26089 . 27683) (HASHOVERFLOW 27685 . 31398)) (32156 64264 (BKBUFS 32166 . 33285) (CHANGENAME 33287 .
|
||||
33548) (CHNGNM 33550 . 35398) (CLBUFS 35400 . 36673) (DEFINE 36675 . 37399) (FNS.PUTDEF 37401 . 40816)
|
||||
(EQMEMB 40818 . 41000) (EQUALN 41002 . 41831) (FNCHECK 41833 . 43840) (FNTYP1 43842 . 43939) (LCSKIP
|
||||
43941 . 44785) (MAPRINT 44787 . 45733) (MKLIST 45735 . 45885) (NAMEFIELD 45887 . 47412) (NLIST 47414
|
||||
. 47749) (PRINTBELLS 47751 . 47877) (PROMPTCHAR 47879 . 49769) (RAISEP 49771 . 50032) (READFILE 50034
|
||||
. 52378) (READLINE 52380 . 57820) (REMPROPLIST 57822 . 58710) (RESETBUFS 58712 . 59162) (TAB 59164 .
|
||||
59760) (UNSAVED1 59762 . 60867) (WRITEFILE 60869 . 62611) (CLOSE-AND-MAYBE-DELETE 62613 . 62957) (
|
||||
UNSAFE.TO.MODIFY 62959 . 64262)) (66619 69563 (FILEDATE 66629 . 69561)) (69793 96996 (FILEMAP 69803 .
|
||||
70273) (\PARSE-FILE-HEADER 70275 . 74090) (GET-ENVIRONMENT-AND-FILEMAP 74092 . 76319) (
|
||||
LOOKUP-ENVIRONMENT-AND-FILEMAP 76321 . 78512) (GET-FILEMAP-FROM-FILECREATED 78514 . 79338) (
|
||||
\FILEMAP-HASHOVERFLOW 79340 . 84004) (FLUSHFILEMAPS 84006 . 84629) (LISPSOURCEFILEP 84631 . 86023) (
|
||||
LISPFILETYPE 86025 . 89274) (GETFILEMAP 89276 . 89695) (PUTFILEMAP 89697 . 91888) (UPDATEFILEMAP 91890
|
||||
. 96994)) (97662 101248 (LVLPRINT 97672 . 97845) (LVLPRIN1 97847 . 98029) (LVLPRIN2 98031 . 98263) (
|
||||
LVLPRIN 98265 . 99279) (LVLPRIN0 99281 . 101246)) (101282 106199 (FLUSHRIGHT 101292 . 102107) (
|
||||
PRINTPARA 102109 . 103207) (PRINTPARA1 103209 . 106197)) (106235 108520 (SUBLIS 106245 . 106853) (
|
||||
SUBPAIR 106855 . 108083) (DSUBLIS 108085 . 108518)) (108543 109143 (CONSTANTOK 108553 . 109141)) (
|
||||
110896 111601 (NLAMBDA.ARGS 110906 . 111599)))))
|
||||
(FILEMAP (NIL (12643 26068 (LOAD? 12653 . 14504) (FILESLOAD 14506 . 14795) (DOFILESLOAD 14797 . 22423)
|
||||
(FINDFILE-WITH-EXTENSIONS 22425 . 25624) (READ-FILECREATED 25626 . 26066)) (26185 31506 (DMPHASH
|
||||
26195 . 27789) (HASHOVERFLOW 27791 . 31504)) (32262 64370 (BKBUFS 32272 . 33391) (CHANGENAME 33393 .
|
||||
33654) (CHNGNM 33656 . 35504) (CLBUFS 35506 . 36779) (DEFINE 36781 . 37505) (FNS.PUTDEF 37507 . 40922)
|
||||
(EQMEMB 40924 . 41106) (EQUALN 41108 . 41937) (FNCHECK 41939 . 43946) (FNTYP1 43948 . 44045) (LCSKIP
|
||||
44047 . 44891) (MAPRINT 44893 . 45839) (MKLIST 45841 . 45991) (NAMEFIELD 45993 . 47518) (NLIST 47520
|
||||
. 47855) (PRINTBELLS 47857 . 47983) (PROMPTCHAR 47985 . 49875) (RAISEP 49877 . 50138) (READFILE 50140
|
||||
. 52484) (READLINE 52486 . 57926) (REMPROPLIST 57928 . 58816) (RESETBUFS 58818 . 59268) (TAB 59270 .
|
||||
59866) (UNSAVED1 59868 . 60973) (WRITEFILE 60975 . 62717) (CLOSE-AND-MAYBE-DELETE 62719 . 63063) (
|
||||
UNSAFE.TO.MODIFY 63065 . 64368)) (66589 71430 (FILEDATE 66599 . 69531) (COMPILEFILETYPE 69533 . 71428)
|
||||
) (71796 98999 (FILEMAP 71806 . 72276) (\PARSE-FILE-HEADER 72278 . 76093) (GET-ENVIRONMENT-AND-FILEMAP
|
||||
76095 . 78322) (LOOKUP-ENVIRONMENT-AND-FILEMAP 78324 . 80515) (GET-FILEMAP-FROM-FILECREATED 80517 .
|
||||
81341) (\FILEMAP-HASHOVERFLOW 81343 . 86007) (FLUSHFILEMAPS 86009 . 86632) (LISPSOURCEFILEP 86634 .
|
||||
88026) (LISPFILETYPE 88028 . 91277) (GETFILEMAP 91279 . 91698) (PUTFILEMAP 91700 . 93891) (
|
||||
UPDATEFILEMAP 93893 . 98997)) (99665 103251 (LVLPRINT 99675 . 99848) (LVLPRIN1 99850 . 100032) (
|
||||
LVLPRIN2 100034 . 100266) (LVLPRIN 100268 . 101282) (LVLPRIN0 101284 . 103249)) (103285 108202 (
|
||||
FLUSHRIGHT 103295 . 104110) (PRINTPARA 104112 . 105210) (PRINTPARA1 105212 . 108200)) (108238 110523 (
|
||||
SUBLIS 108248 . 108856) (SUBPAIR 108858 . 110086) (DSUBLIS 110088 . 110521)) (110546 111146 (
|
||||
CONSTANTOK 110556 . 111144)) (112899 113604 (NLAMBDA.ARGS 112909 . 113602)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
132
sources/MENU
132
sources/MENU
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "14-Jul-2025 22:35:12" {DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>MENU.;3 101431
|
||||
(FILECREATED " 2-Oct-2025 17:53:41" {SOURCES}MENU.;2 102104
|
||||
|
||||
:EDIT-BY rmk
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS MENUTITLEFONT UPDATE/MENU/IMAGE)
|
||||
:CHANGES-TO (FNS ADDMENU CHECK/MENU/IMAGE UPDATE/MENU/IMAGE MENU)
|
||||
|
||||
:PREVIOUS-DATE "16-Jul-99 15:51:36"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>MENU.;1)
|
||||
:PREVIOUS-DATE "14-Jul-2025 22:35:12" {SOURCES}MENU.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MENUCOMS)
|
||||
@@ -92,12 +91,16 @@
|
||||
(T 0] finally (RETURN ANSWER])
|
||||
|
||||
(MENU
|
||||
[LAMBDA (MENU POSITION RELEASECONTROLFLG NESTEDFLG)(* ; "Edited 21-Jun-88 19:00 by jds")
|
||||
[LAMBDA (MENU POSITION RELEASECONTROLFLG NESTEDFLG) (* ; "Edited 2-Oct-2025 17:49 by mth")
|
||||
(* ; "Edited 21-Jun-88 19:00 by jds")
|
||||
(DECLARE (LOCALVARS . T))
|
||||
|
||||
(* ;; "puts a menu on the screen and waits for the user to select one of the items")
|
||||
|
||||
(\DTEST MENU 'MENU)
|
||||
(COND
|
||||
((NOT (LISTP (fetch (MENU ITEMS) of MENU)))
|
||||
(ERROR 'MENU "ITEMS list is empty")))
|
||||
(PROG (IMAGE SELVAL DSP) (* ; "make sure the image is a window")
|
||||
[SETQ IMAGE (COND
|
||||
((NOT (EQ POSITION 'INPLACE))
|
||||
@@ -119,18 +122,18 @@
|
||||
(RETURN NIL))
|
||||
(GETMOUSESTATE)
|
||||
(* ;
|
||||
"if mouse state is up, then someone came into the window with the mouse down. Ignore it.")
|
||||
"if mouse state is up, then someone came into the window with the mouse down. Ignore it.")
|
||||
(OR (MOUSESTATE (OR LEFT RIGHT MIDDLE))
|
||||
(GO LP))
|
||||
(* ;
|
||||
"MVAL will be NIL only if the user clicked up outside the window")
|
||||
(OR (SETQ MVAL (MENU.HANDLER MENU DSP NIL
|
||||
T NESTEDFLG))
|
||||
"MVAL will be NIL only if the user clicked up outside the window")
|
||||
(OR (SETQ MVAL (MENU.HANDLER MENU DSP NIL T
|
||||
NESTEDFLG))
|
||||
(GO LP))
|
||||
(RETURN MVAL)))
|
||||
(T (MENU.HANDLER MENU DSP T T NESTEDFLG))))]
|
||||
(* ;
|
||||
"evaluate menu form after image has been taken down.")
|
||||
"evaluate menu form after image has been taken down.")
|
||||
(RETURN (COND
|
||||
(NESTEDFLG SELVAL)
|
||||
(SELVAL (DOSELECTEDITEM MENU (CAR SELVAL)
|
||||
@@ -159,24 +162,28 @@
|
||||
(T (DSPFONT NIL (fetch (SCREEN SCTITLEDS) of SCREEN])
|
||||
|
||||
(ADDMENU
|
||||
[LAMBDA (ADDEDMENU W POSITION DONTOPENFLG) (* kbr%: "24-Jan-86 18:00")
|
||||
[LAMBDA (ADDEDMENU W POSITION DONTOPENFLG) (* ; "Edited 2-Oct-2025 17:51 by mth")
|
||||
(* kbr%: "24-Jan-86 18:00")
|
||||
|
||||
(* adds a menu to a window. If W is not given, it is created;
|
||||
sized a necessary.)
|
||||
sized a necessary.)
|
||||
|
||||
(OR (TYPENAMEP ADDEDMENU 'MENU)
|
||||
(\ILLEGAL.ARG ADDEDMENU))
|
||||
(COND
|
||||
((NOT (LISTP (fetch (MENU ITEMS) of ADDEDMENU)))
|
||||
(ERROR 'ADDEDMENU "ITEMS list is empty")))
|
||||
(PROG (IMAGEWIDTH IMAGEHEIGHT SCREEN)
|
||||
(SETQ IMAGEWIDTH (fetch (MENU IMAGEWIDTH) of ADDEDMENU))
|
||||
(SETQ IMAGEHEIGHT (fetch (MENU IMAGEHEIGHT) of ADDEDMENU))
|
||||
(* put menu at POSITION if argument,
|
||||
otherwise its stored position,
|
||||
otherwise at cursorposition)
|
||||
otherwise its stored position,
|
||||
otherwise at cursorposition)
|
||||
[COND
|
||||
((POSITIONP POSITION))
|
||||
((SETQ POSITION (fetch (MENU MENUPOSITION) of ADDEDMENU)))
|
||||
(W (* if a window is given, put it in
|
||||
the lower left corner.)
|
||||
(W (* if a window is given, put it in the
|
||||
lower left corner.)
|
||||
(SETQ POSITION (create POSITION
|
||||
XCOORD _ 0
|
||||
YCOORD _ 0)))
|
||||
@@ -187,20 +194,20 @@
|
||||
((WINDOWP W)
|
||||
|
||||
(* adding to an existing window. To avoid partial images when window is partly
|
||||
off the screen, this case could close window then blt to save region then
|
||||
reopen window.)
|
||||
off the screen, this case could close window then blt to save region then reopen
|
||||
window.)
|
||||
(* locate menu grid in MENU.)
|
||||
(replace (REGION LEFT) of (fetch (MENU MENUGRID) of ADDEDMENU)
|
||||
with (IPLUS (fetch (POSITION XCOORD) of POSITION)
|
||||
(fetch (MENU MENUOUTLINESIZE) of ADDEDMENU)))
|
||||
(fetch (MENU MENUOUTLINESIZE) of ADDEDMENU)))
|
||||
(replace (REGION BOTTOM) of (fetch (MENU MENUGRID) of ADDEDMENU)
|
||||
with (IPLUS (fetch (POSITION YCOORD) of POSITION)
|
||||
(fetch (MENU MENUOUTLINESIZE) of ADDEDMENU)))
|
||||
(fetch (MENU MENUOUTLINESIZE) of ADDEDMENU)))
|
||||
(* Blt image into Window.)
|
||||
(BLTMENUIMAGE ADDEDMENU (WINDOWPROP W 'DSP)
|
||||
DONTOPENFLG))
|
||||
(T (* have to create new window.
|
||||
Put position at Origin.)
|
||||
Put position at Origin.)
|
||||
(SETQ SCREEN (COND
|
||||
((type? SCREEN W)
|
||||
W)
|
||||
@@ -221,29 +228,27 @@
|
||||
(OR DONTOPENFLG (OPENW W]
|
||||
|
||||
(* put MENUBUTTONFN in CURSORINFN so it will get called if button is down and
|
||||
moves into W.)
|
||||
moves into W.)
|
||||
|
||||
(WINDOWPROP W 'CURSORINFN (FUNCTION MENUBUTTONFN)) (* Set ButtonEventFn to activate
|
||||
menu selection.)
|
||||
(WINDOWPROP W 'CURSORINFN (FUNCTION MENUBUTTONFN)) (* Set ButtonEventFn to activate menu
|
||||
selection.)
|
||||
(WINDOWPROP W 'BUTTONEVENTFN (FUNCTION MENUBUTTONFN))
|
||||
(WINDOWPROP W 'CURSORMOVEDFN (FUNCTION MENUBUTTONFN))
|
||||
(* put ADDEDMENU on USERDATA so
|
||||
MENUBUTTONFN can get at it.)
|
||||
MENUBUTTONFN can get at it.)
|
||||
(WINDOWADDPROP W 'MENU ADDEDMENU)
|
||||
(WINDOWADDPROP W 'REPAINTFN (FUNCTION MENUREPAINTFN))
|
||||
[COND
|
||||
((NULL (fetch (MENU WHENSELECTEDFN) of ADDEDMENU))
|
||||
|
||||
(* make the default selection function call EVAL.AS.PROCESS instead of EVAL so
|
||||
it won't tie up background.)
|
||||
(* make the default selection function call EVAL.AS.PROCESS instead of EVAL so it
|
||||
won't tie up background.)
|
||||
|
||||
(replace (MENU WHENSELECTEDFN) of ADDEDMENU with (FUNCTION
|
||||
BACKGROUNDWHENSELECTEDFN
|
||||
]
|
||||
(replace (MENU WHENSELECTEDFN) of ADDEDMENU with (FUNCTION BACKGROUNDWHENSELECTEDFN]
|
||||
[COND
|
||||
((NOT (SUBREGIONP (DSPCLIPPINGREGION NIL W)
|
||||
(MENUREGION ADDEDMENU))) (* if the menu didn't fit, make it
|
||||
scrollable.)
|
||||
(MENUREGION ADDEDMENU))) (* if the menu didn't fit, make it
|
||||
scrollable.)
|
||||
(WINDOWPROP W 'SCROLLFN (FUNCTION SCROLLBYREPAINTFN))
|
||||
(EXTENDEXTENT W (MENUREGION ADDEDMENU]
|
||||
(RETURN W])
|
||||
@@ -748,14 +753,18 @@
|
||||
MENU ITEM])
|
||||
|
||||
(CHECK/MENU/IMAGE
|
||||
[LAMBDA (MENU MAKEWINDOWFLG SCREEN) (* kbr%: " 5-Sep-85 20:31")
|
||||
[LAMBDA (MENU MAKEWINDOWFLG SCREEN) (* ; "Edited 2-Oct-2025 17:50 by mth")
|
||||
(* kbr%: " 5-Sep-85 20:31")
|
||||
|
||||
(* returns menus image, creating one if necessary.
|
||||
The image field will be a WINDOW for popup menus.)
|
||||
The image field will be a WINDOW for popup menus.)
|
||||
|
||||
(PROG (IMAGE DSP WINDOW)
|
||||
(OR (type? MENU MENU)
|
||||
(\ILLEGAL.ARG MENU))
|
||||
(COND
|
||||
((NOT (LISTP (fetch (MENU ITEMS) of MENU)))
|
||||
(ERROR 'MENU "ITEMS list is empty")))
|
||||
(SETQ IMAGE (fetch (MENU IMAGE) of MENU))
|
||||
[OR SCREEN (SETQ SCREEN (COND
|
||||
((type? WINDOW IMAGE)
|
||||
@@ -765,7 +774,7 @@
|
||||
((OR (NULL IMAGE)
|
||||
(NOT (EQ (fetch (WINDOW SCREEN) of IMAGE)
|
||||
SCREEN))) (* Switched screens.
|
||||
*)
|
||||
*)
|
||||
(UPDATE/MENU/IMAGE MENU SCREEN)
|
||||
(SETQ IMAGE (fetch (MENU IMAGE) of MENU]
|
||||
(COND
|
||||
@@ -774,9 +783,8 @@
|
||||
(UPDATEWFROMIMAGE IMAGE))
|
||||
(T (SETQ IMAGE (CREATEWFROMIMAGE IMAGE SCREEN))
|
||||
(replace (MENU IMAGE) of MENU with IMAGE)))
|
||||
(SETQ DSP (fetch (WINDOW DSP) of IMAGE))
|
||||
(* set the offset in the display
|
||||
stream to agree with the region.)
|
||||
(SETQ DSP (fetch (WINDOW DSP) of IMAGE)) (* set the offset in the display
|
||||
stream to agree with the region.)
|
||||
(DSPXOFFSET (fetch (WINDOW WBORDER) of IMAGE)
|
||||
DSP)
|
||||
(DSPYOFFSET (fetch (WINDOW WBORDER) of IMAGE)
|
||||
@@ -796,7 +804,8 @@
|
||||
(PROMPTPRINT (CADR ITEM])
|
||||
|
||||
(UPDATE/MENU/IMAGE
|
||||
[LAMBDA (MNU SCREEN) (* ; "Edited 14-Jul-2025 22:34 by rmk")
|
||||
[LAMBDA (MNU SCREEN) (* ; "Edited 2-Oct-2025 17:49 by mth")
|
||||
(* ; "Edited 14-Jul-2025 22:34 by rmk")
|
||||
(* ; "Edited 16-Jul-99 15:51 by rmk:")
|
||||
(* ; "Edited 10-Dec-93 16:01 by sybalsky")
|
||||
(* ;
|
||||
@@ -811,6 +820,9 @@
|
||||
(SETQ SCREEN (fetch (WINDOW SCREEN) of (fetch (MENU IMAGE) of MNU]
|
||||
(T (SETQ SCREEN LASTSCREEN]
|
||||
(SETQ MENUITEMS (fetch (MENU ITEMS) of MNU))
|
||||
(COND
|
||||
((NOT (LISTP MENUITEMS))
|
||||
(ERROR 'MENU "ITEMS list is empty")))
|
||||
(SETQ CENTER? (fetch (MENU CENTERFLG) of MNU)) (* ; "check the font.")
|
||||
(COND
|
||||
[(FONTP (SETQ FONT (AND (fetch (MENU MENUFONT) of MNU)
|
||||
@@ -1710,24 +1722,24 @@
|
||||
(MENU 42 POINTER))
|
||||
'44)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2583 86884 (MAXMENUITEMHEIGHT 2593 . 3530) (MAXMENUITEMWIDTH 3532 . 5231) (MENU 5233 .
|
||||
8130) (MENUTITLEFONT 8132 . 9572) (ADDMENU 9574 . 15012) (DELETEMENU 15014 . 16495) (MENUREGION 16497
|
||||
. 17357) (BLTMENUIMAGE 17359 . 19387) (ERASEMENUIMAGE 19389 . 20311) (DEFAULTMENUHELDFN 20313 . 20603
|
||||
) (DEFAULTWHENSELECTEDFN 20605 . 21016) (BACKGROUNDWHENSELECTEDFN 21018 . 21453) (GETMENUITEM 21455 .
|
||||
22044) (MENUBUTTONFN 22046 . 22677) (MENU.HANDLER 22679 . 40781) (DOSELECTEDITEM 40783 . 41208) (
|
||||
SHOWSHADEDITEMS 41210 . 42627) (\AddShade 42629 . 43821) (\DelShade 43823 . 44094) (\FDECODE/BUTTON
|
||||
44096 . 44483) (MENUITEMREGION 44485 . 47220) (\MENUITEMLABEL 47222 . 47568) (\MENUSUBITEMS 47570 .
|
||||
47808) (CHECK/MENU/IMAGE 47810 . 49816) (PPROMPT2 49818 . 50207) (UPDATE/MENU/IMAGE 50209 . 65643) (
|
||||
\MAKE.ITEMS.VERT.ORDER 65645 . 67172) (\SHOWMENULABEL 67174 . 71101) (\POSITION.MENU.IMAGE 71103 .
|
||||
73958) (\SMASHMENUIMAGEONRESET 73960 . 74308) (CLOSE.PROCESS.MENU 74310 . 74492) (DEFAULTSUBITEMFN
|
||||
74494 . 75214) (GETMENUPROP 75216 . 75408) (PUTMENUPROP 75410 . 75783) (WAKE.MY.PROCESS 75785 . 75968)
|
||||
(\INVERTITEM 75970 . 76426) (\MENU.ITEM.SELECT 76428 . 77991) (\MENU.ITEM.DESELECT 77993 . 78695) (
|
||||
\ItemNumber 78697 . 79264) (\BOXITEM 79266 . 80813) (NESTED.SUBMENU 80815 . 83533) (NESTED.SUBMENU.POS
|
||||
83535 . 86506) (WFROMMENU 86508 . 86882)) (88093 88513 (MENUREPAINTFN 88103 . 88511)) (88548 91597 (
|
||||
MAXSTRINGWIDTH 88558 . 88801) (CENTEREDPRIN1 88803 . 89240) (CENTERPRINTINREGION 89242 . 89771) (
|
||||
CENTERPRINTINAREA 89773 . 91230) (STRICTLY/BETWEEN 91232 . 91595)) (91631 97573 (UNREADITEM 91641 .
|
||||
91963) (TYPEINMENU 91965 . 92166) (SHADEITEM 92168 . 93912) (RESHADEITEM 93914 . 95007) (
|
||||
MOST/VISIBLE/OPERATION 95009 . 95280) (%#BITSON 95282 . 96000) (BUTTONPANEL 96002 . 96794) (
|
||||
BUTTONPANEL/SELECTION/FN 96796 . 97348) (GETSELECTEDITEMS 97350 . 97571)) (97889 98430 (MENUDESELECT
|
||||
97899 . 98116) (MENUSELECT 98118 . 98428)))))
|
||||
(FILEMAP (NIL (2504 87557 (MAXMENUITEMHEIGHT 2514 . 3451) (MAXMENUITEMWIDTH 3453 . 5152) (MENU 5154 .
|
||||
8294) (MENUTITLEFONT 8296 . 9736) (ADDMENU 9738 . 15275) (DELETEMENU 15277 . 16758) (MENUREGION 16760
|
||||
. 17620) (BLTMENUIMAGE 17622 . 19650) (ERASEMENUIMAGE 19652 . 20574) (DEFAULTMENUHELDFN 20576 . 20866
|
||||
) (DEFAULTWHENSELECTEDFN 20868 . 21279) (BACKGROUNDWHENSELECTEDFN 21281 . 21716) (GETMENUITEM 21718 .
|
||||
22307) (MENUBUTTONFN 22309 . 22940) (MENU.HANDLER 22942 . 41044) (DOSELECTEDITEM 41046 . 41471) (
|
||||
SHOWSHADEDITEMS 41473 . 42890) (\AddShade 42892 . 44084) (\DelShade 44086 . 44357) (\FDECODE/BUTTON
|
||||
44359 . 44746) (MENUITEMREGION 44748 . 47483) (\MENUITEMLABEL 47485 . 47831) (\MENUSUBITEMS 47833 .
|
||||
48071) (CHECK/MENU/IMAGE 48073 . 50274) (PPROMPT2 50276 . 50665) (UPDATE/MENU/IMAGE 50667 . 66316) (
|
||||
\MAKE.ITEMS.VERT.ORDER 66318 . 67845) (\SHOWMENULABEL 67847 . 71774) (\POSITION.MENU.IMAGE 71776 .
|
||||
74631) (\SMASHMENUIMAGEONRESET 74633 . 74981) (CLOSE.PROCESS.MENU 74983 . 75165) (DEFAULTSUBITEMFN
|
||||
75167 . 75887) (GETMENUPROP 75889 . 76081) (PUTMENUPROP 76083 . 76456) (WAKE.MY.PROCESS 76458 . 76641)
|
||||
(\INVERTITEM 76643 . 77099) (\MENU.ITEM.SELECT 77101 . 78664) (\MENU.ITEM.DESELECT 78666 . 79368) (
|
||||
\ItemNumber 79370 . 79937) (\BOXITEM 79939 . 81486) (NESTED.SUBMENU 81488 . 84206) (NESTED.SUBMENU.POS
|
||||
84208 . 87179) (WFROMMENU 87181 . 87555)) (88766 89186 (MENUREPAINTFN 88776 . 89184)) (89221 92270 (
|
||||
MAXSTRINGWIDTH 89231 . 89474) (CENTEREDPRIN1 89476 . 89913) (CENTERPRINTINREGION 89915 . 90444) (
|
||||
CENTERPRINTINAREA 90446 . 91903) (STRICTLY/BETWEEN 91905 . 92268)) (92304 98246 (UNREADITEM 92314 .
|
||||
92636) (TYPEINMENU 92638 . 92839) (SHADEITEM 92841 . 94585) (RESHADEITEM 94587 . 95680) (
|
||||
MOST/VISIBLE/OPERATION 95682 . 95953) (%#BITSON 95955 . 96673) (BUTTONPANEL 96675 . 97467) (
|
||||
BUTTONPANEL/SELECTION/FN 97469 . 98021) (GETSELECTEDITEMS 98023 . 98244)) (98562 99103 (MENUDESELECT
|
||||
98572 . 98789) (MENUSELECT 98791 . 99101)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user