(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "16-Jun-2023 17:20:09" {DSK}frank>il>medley>gmedley>greetfiles>APPS-INIT.;11 21130 :CHANGES-TO (FNS Apps.DoInit) :PREVIOUS-DATE "19-Jan-2023 12:44:20" {DSK}frank>il>medley>gmedley>greetfiles>APPS-INIT.;10) (PRETTYCOMPRINT APPS-INITCOMS) (RPAQQ APPS-INITCOMS [(FILES (SYSLOAD) MEDLEYDIR-INIT) (GLOBALVARS Apps.NotecardsActivated Apps.RoomsActivated) (INITVARS (Apps.NotecardsActivated NIL) (Apps.RoomsActivated NIL)) (FNS Apps.InitNotecards Apps.DoInit Apps.CreateButtons Apps.CreateLabel Apps.ActivateCLOS Apps.ActivateRooms Apps.ShowDoc XCL-USER::EXEC_INTERLISP) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (Apps.DoInit))) (DECLARE%: FIRST DONTEVAL@LOAD DOCOPY (P (BKSYSBUF " "]) (FILESLOAD (SYSLOAD) MEDLEYDIR-INIT) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS Apps.NotecardsActivated Apps.RoomsActivated) ) (RPAQ? Apps.NotecardsActivated NIL) (RPAQ? Apps.RoomsActivated NIL) (DEFINEQ (Apps.InitNotecards [LAMBDA (DoNotRefreshButtons) (DECLARE (GLOBALVARS BackgroundMenuCommands BackgroundMenu)) (* ; "Edited 19-Jan-2023 11:57 by FGH") (* ; "Edited 7-Dec-2022 11:14 by FGH") (* ; "Edited 12-Nov-2022 14:41 by FGH") (* ; "Edited 11-Sep-2022 01:09 by fgh") (* ; "Edited 7-Feb-2022 20:22 by tp7") (LET* [[SRCDIR (OR (UNIX-GETENV 'NOTEFILESSRC) (AND (UNIX-GETENV 'NC_INSTALLDIR) (CONCAT (UNIX-GETENV 'NC_INSTALLDIR) "/notefiles")) (LET ((SUBDIR "notecards/notefiles")) (for DIR in (LIST (CONCAT (MEDLEYDIR) SUBDIR) (CONCAT (MEDLEYDIR) "../" SUBDIR) (CONCAT (MEDLEYDIR) "../../" SUBDIR)) thereis (DIRECTORYNAME DIR] (DESTDIR (OR (UNIX-GETENV 'NOTEFILESDIR) (AND (UNIX-GETENV 'MEDLEY_USERDIR) (CONCAT (UNIX-GETENV 'MEDLEY_USERDIR) "/notefiles")) (CONCAT LOGINDIR "notefiles"] [if (AND (NOT (DIRECTORYNAME DESTDIR)) (DIRECTORYNAME SRCDIR)) then (for NF in (DIRECTORY (CONCAT SRCDIR "/*")) do (COPYFILE NF (PACKFILENAME 'HOST "DSK" 'DIRECTORY DESTDIR 'NAME (FILENAMEFIELD NF 'NAME) 'EXTENSION (FILENAMEFIELD NF 'EXTENSION) 'VERSION (FILENAMEFIELD NF 'VERSION] (LET* ((PW-REGION (WINDOWPROP PROMPTWINDOW 'REGION)) (LEFT (IPLUS (fetch (REGION RIGHT) of PW-REGION) 20)) (BOTTOM (fetch (REGION BOTTOM) of PW-REGION))) (NC.BringUpNoteCardsIcon (create POSITION XCOORD _ LEFT YCOORD _ BOTTOM))) (NC.FileBrowserMenu NC.NoteCardsIconWindow (PACKFILENAME 'HOST "DSK" 'DIRECTORY DESTDIR 'NAME "*" 'EXTENSION "notefile") (CREATEREGION 50 (IDIFFERENCE SCREENHEIGHT 700) 550 220)) (if (NULL (SASSOC 'NoteCards BackgroundMenuCommands)) then (PROGN [SETQ BackgroundMenuCommands (APPEND BackgroundMenuCommands (LIST '(NoteCards ( NC.BringUpNoteCardsIcon ) "Bring up the NoteCards control icon." ] (SETQ BackgroundMenu NIL))) (SETQ Apps.NotecardsActivated T) (if (NOT DoNotRefreshButtons) then (Apps.CreateButtons]) (Apps.DoInit [LAMBDA NIL (* ;; "Edited 19-Jan-2023 12:43 by FGH") (* ;; "Edited 17-Jan-2023 23:23 by FGH") (* ;; "Edited 7-Dec-2022 11:14 by FGH") (* ;; "Edited 12-Nov-2022 13:57 by FGH") (* ;; "Edited 12-Oct-2022 20:23 by fgh") (* ;; "Edited 6-Sep-2022 17:22 by fgh") (* ;; "Edited 4-Sep-2022 16:44 by larry") (* ;; "Edited 18-Mar-2022 18:53 by fgh") (* ;; "Edited 17-Dec-2021 22:05 by fgh") (PROGN (* ;; " Adjust windows so that the exec window and the prompt window don't overlap") [MAPC (OPENWINDOWS) (FUNCTION (LAMBDA (W) (COND ((EQ (WINDOWPROP W 'BUTTONEVENTFN) 'WHEN-WHO-LINE-SELECTED-FN) (MOVEW W (CAR (WINDOWPROP W 'REGION)) (IDIFFERENCE SCREENHEIGHT 18))) ((STREQUAL (WINDOWPROP W 'TITLE) "Prompt Window") (PROGN (MOVEW W (create POSITION XCOORD _ 50 YCOORD _ (IDIFFERENCE SCREENHEIGHT 120))) (CLEARW W))) ((STREQUAL (WINDOWPROP W 'TITLE) "Exec (XCL)") (PROGN (WINDOWPROP W 'TITLE "Exec (INTERLISP)") (MOVEW W (create POSITION XCOORD _ 50 YCOORD _ (IDIFFERENCE SCREENHEIGHT 460] (* ;; " Set up INITIALSLST based on information passed in from the Linux environment") [SETQ INITIALSLST (LIST (LIST USERNAME (UNIX-GETENV 'MEDLEY_FIRSTNAME) (UNIX-GETENV 'MEDLEY_INITIALS] (LOAD '{DSK}/usr/local/interlisp/medley/lispusers/HELPSYS.LCOM T) (* ;; "change to interlisp exec if required") (COND ((OR (STRING-EQUAL (UNIX-GETENV 'MEDLEY_EXEC) "inter") (STRING-EQUAL (UNIX-GETENV 'NCO) "true")) (BKSYSBUF "(EXEC_INTERLISP)"))) (* ;; "Always Activate CLOS") (Apps.ActivateCLOS) (* ;; " activate Notecards if requested") (COND ((STRING-EQUAL (UNIX-GETENV 'RUN_NOTECARDS) "true") (Apps.InitNotecards T))) (* ;; " activate Rooms if requested") (COND ((STRING-EQUAL (UNIX-GETENV 'RUN_ROOMS) "true") (Apps.ActivateRooms T))) (* ;; " create the Documentation and ROOMS, Notecards Activation Buttons, if needed") (Apps.CreateButtons T) (* ;; " Make sure Notecards doesn't try to load its HASH file in NC.PostGreet") (SETTOPVAL '\NC.SourceAccessFlg NIL]) (Apps.CreateButtons [LAMBDA (DoDocsToo) (* ; "Edited 13-Dec-2022 12:51 by frank") (* ; "Edited 7-Dec-2022 11:28 by FGH") (* ; "Edited 5-Dec-2022 17:31 by FGH") (* ; "Edited 12-Nov-2022 14:52 by FGH") (* ;; " Create buttons for Documentation and to activate Rooms, Notecards ") (* ;; "Note: due to bug in DELETE-BUTTON need to create Doc buttons last. This will make sure that the NoteCards/Rooms buttons get properl deleted when they are activated. But the Doc buttons will not necessariy get deleted properly (but then there is never a need for them to be deleted).") (LET* ((FEATURES (LIST (LIST Apps.NotecardsActivated '(Apps.InitNotecards) "NOTECARDS") (LIST Apps.RoomsActivated '(Apps.ActivateRooms) "ROOMS"))) (FEATURES-LABELS (for FEATURE in FEATURES collect (CADDR FEATURE))) (DOCS (LIST (LIST "https://interlisp.org/docs/medley/orientation/" "BASICS") (LIST "https://interlisp.org/documentation/Medley-Primer.pdf" "PRIMER") (LIST "https://interlisp.org/documentation/IRM.pdf" "MANUAL") (LIST "https://interlisp.org/documentation/notecards_user_guide_v1.2.pdf" "NOTECARDS") (LIST "https://interlisp.org/documentation/ROOMSTECHDESC.pdf" "ROOMS"))) (DOCS-LABELS (for DOC in DOCS collect (CADR DOC))) (RIGHTMARGINISH 140) (SECTION1YPOS 225) (YPOSDELTA 55) (SECTION2YPOS (IPLUS SECTION1YPOS (ITIMES (IPLUS (LENGTH DOCS) 1) YPOSDELTA))) (BUTTONY-FEATURES SECTION2YPOS) (BUTTONY-DOCS SECTION1YPOS) (FEATURES-REQUIREDP (OR (NOT Apps.RoomsActivated) (NOT Apps.NotecardsActivated))) (IWS NIL) (BUTTONS NIL)) (* ;; "First remove/re-create feature buttons") (for W in (OPENWINDOWS) when (MEMBER (WINDOWPROP W 'ICONLABEL) (LIST "ACTIVATE" "FEATURES")) do (CLOSEW W)) (for B in *ALL-BUTTONS* when (AND (EQ (WINDOWPROP B 'Apps.BUTTON) 'FEATURE) (MEMBER (BUTTON-LABEL B) FEATURES-LABELS)) do (DELETE-BUTTON B)) [if FEATURES-REQUIREDP then [SETQ IWS (LIST (Apps.CreateLabel "ACTIVATE" (IDIFFERENCE SCREENWIDTH (IDIFFERENCE RIGHTMARGINISH 50 )) (IDIFFERENCE SCREENHEIGHT (IDIFFERENCE SECTION2YPOS 20))) (Apps.CreateLabel "FEATURES" (IDIFFERENCE SCREENWIDTH (IDIFFERENCE RIGHTMARGINISH 50 )) (IDIFFERENCE SCREENHEIGHT SECTION2YPOS] (SETQ BUTTONS (for FEATURE in FEATURES collect (OR (CAR FEATURE) (LET (B) (SETQ BUTTONY-FEATURES (IPLUS BUTTONY-FEATURES YPOSDELTA)) [SETQ B (CREATE-BUTTON (CADR FEATURE) (CADDR FEATURE) (create POSITION XCOORD _ (IDIFFERENCE SCREENWIDTH RIGHTMARGINISH) YCOORD _ (IDIFFERENCE SCREENHEIGHT BUTTONY-FEATURES ] (WINDOWPROP B 'Apps.BUTTON 'FEATURE) B] (* ;; "Then if needed, remove/recreate documentation buttons") (if DoDocsToo then (for W in (OPENWINDOWS) when (MEMBER (WINDOWPROP W 'ICONLABEL) (LIST "DOCUMENTATION")) do (CLOSEW W)) (for B in *ALL-BUTTONS* when (AND (EQ (WINDOWPROP B 'Apps.BUTTON) 'DOC) (MEMBER (BUTTON-LABEL B) DOCS-LABELS)) do (DELETE-BUTTON B)) (SETQ IWS (CONS (Apps.CreateLabel "DOCUMENTATION" (IDIFFERENCE SCREENWIDTH (IDIFFERENCE RIGHTMARGINISH 50) ) (IDIFFERENCE SCREENHEIGHT SECTION1YPOS)) IWS)) (SETQ BUTTONS (APPEND (for DOC in DOCS collect (LET (B) (SETQ BUTTONY-DOCS (IPLUS BUTTONY-DOCS YPOSDELTA)) [SETQ B (CREATE-BUTTON (LIST 'Apps.ShowDoc (CAR DOC)) (CADR DOC) (create POSITION XCOORD _ (IDIFFERENCE SCREENWIDTH RIGHTMARGINISH) YCOORD _ (IDIFFERENCE SCREENHEIGHT BUTTONY-DOCS] (WINDOWPROP B 'Apps.BUTTON 'DOC) B)) BUTTONS))) [for B in BUTTONS do (COND ((WINDOWP B) (WINDOWPROP B 'RIGHTBUTTONFN 'NILL) (WINDOWPROP B 'BUTTONEVENTFN (FUNCTION (LAMBDA (BUTTON) (if (LASTMOUSESTATE (ONLY LEFT)) then (EXECUTE-BUTTON BUTTON] [for IW in IWS do (COND ((WINDOWP IW) (WINDOWPROP IW 'RIGHTBUTTONFN 'NILL] (for B in BUTTONS when (WINDOWP B) collect B]) (Apps.CreateLabel [LAMBDA (Text CenterX BottomY) (* ; "Edited 5-Dec-2022 16:49 by FGH") (LET* ((DS (DSPCREATE)) (FONT (DSPFONT '(HELVETICA 18 BOLD) DS)) (SR (STRINGREGION Text DS)) (BMW (fetch (REGION WIDTH) of SR)) (BMH (IPLUS (fetch (REGION HEIGHT) of SR) (fetch (REGION BOTTOM) of SR))) (BM (BITMAPCREATE BMW BMH)) (POS (create POSITION XCOORD _ (IDIFFERENCE CenterX (IQUOTIENT BMW 2)) YCOORD _ BottomY)) IW) (DSPDESTINATION BM DS) (PRIN1 Text DS) (SETQ IW (ICONW BM BM POS)) (WINDOWPROP IW 'ICONLABEL Text) IW]) (Apps.ActivateCLOS [LAMBDA NIL (DECLARE (GLOBALVARS BackgroundMenuCommands BackgroundMenu)) (* ; "Edited 12-Nov-2022 14:41 by FGH") (if (NULL (SASSOC "CLOS Browse Class" BackgroundMenuCommands)) then (PROGN [SETQ BackgroundMenuCommands (APPEND BackgroundMenuCommands (LIST '("CLOS Browse Class" (CLOS-BROWSER::BROWSE-CLASS) "Bring up a class browser." (SUBITEMS (|all in a package| (CLOS-BROWSER::BROWSE-CLASS ( CLOS-BROWSER::CLASSES-IN-PACKAGE ( CLOS-BROWSER::IN-SELECT-PACKAGE ))) "Select a package and browse all the classes defined in that package." ] (SETQ BackgroundMenu NIL]) (Apps.ActivateRooms [LAMBDA (DoNotRefreshButtons) (DECLARE (GLOBALVARS BackgroundMenuCommands ROOMS:*SUITE-DIRECTORIES*)) (* ; "Edited 7-Dec-2022 11:13 by FGH") (* ; "Edited 12-Nov-2022 14:56 by FGH") (if (NULL (SASSOC "Rooms" BackgroundMenuCommands)) then (ROOMS:RESET)) (SETQ ROOMS:*SUITE-DIRECTORIES* (CONS (CONCAT (UNIX-GETENV 'MEDLE_USERDIR) "/suites") ROOMS:*SUITE-DIRECTORIES*)) (SETQ Apps.RoomsActivated T) (PROMPTPRINT " ROOMS functionality is now available via the Background Menu") (if (NOT DoNotRefreshButtons) then (Apps.CreateButtons]) (Apps.ShowDoc [LAMBDA (URL) (* ; "Edited 18-Jan-2023 20:26 by FGH") (ShellBrowse URL]) (XCL-USER::EXEC_INTERLISP [LAMBDA NIL (* ; "Edited 18-Mar-2022 18:53 by fgh") (PROGN [MAPC (OPENWINDOWS) (FUNCTION (LAMBDA (W) (COND ((STREQUAL (WINDOWPROP W 'TITLE) "Exec (XCL)") (PROGN (WINDOWPROP W 'TITLE "Exec (INTERLISP)") (MOVEW W (create POSITION XCOORD _ 50 YCOORD _ (IDIFFERENCE SCREENHEIGHT 460] (XCL:SET-DEFAULT-EXEC-TYPE 'INTERLISP) (XCL:SET-EXEC-TYPE 'INTERLISP]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (Apps.DoInit) ) (DECLARE%: FIRST DONTEVAL@LOAD DOCOPY (BKSYSBUF " ") ) (DECLARE%: DONTCOPY (FILEMAP (NIL (1109 20996 (Apps.InitNotecards 1119 . 4981) (Apps.DoInit 4983 . 8227) ( Apps.CreateButtons 8229 . 17053) (Apps.CreateLabel 17055 . 17865) (Apps.ActivateCLOS 17867 . 19216) ( Apps.ActivateRooms 19218 . 20069) (Apps.ShowDoc 20071 . 20220) (XCL-USER::EXEC_INTERLISP 20222 . 20994 ))))) STOP