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