github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-12 00:42:56 +00:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into fgh_fix-maikodir_msg

Browse Source
This commit is contained in:
Frank Halasz 2024-06-03 14:58:31 -07:00 committed by GitHub
commit 9962a9ca0a
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
24 changed files with 2218 additions and 959 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
library/BROWSER
View File

@ -1,16 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Apr-2023 12:41:36" {DSK}<home>larry>il>medley>library>BROWSER.;6 29801
(FILECREATED "21-May-2024 18:46:31" {LIB}BROWSER.;2 29502
:EDIT-BY "lmm"
:EDIT-BY "mth"
:CHANGES-TO (FNS BROWSER.LEFTFN NUMSPATHS STBROWSER MSPATHS.DISPATCH BROWSER
BROWSER.WHENFNSCHANGED BRPATHS1 GET.BROWSE.PP.WINDOW
GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN DESCRIBEREPAINTFN
BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP REDRAWBROWSEGRAPH)
(VARS BROWSERCOMS BROWSER.BORDERS)
:CHANGES-TO (FNS BROWSER.LEFTFN)
:PREVIOUS-DATE "15-Apr-2023 18:55:36" {DSK}<home>larry>il>medley>library>BROWSER.;1)
:PREVIOUS-DATE "26-Apr-2023 12:41:36" {LIB}BROWSER.;1)
(PRETTYCOMPRINT BROWSERCOMS)
@ -202,28 +198,29 @@
(RETURN ENTRY])
(BROWSER.LEFTFN
[LAMBDA (NODE NWINDOW) (* ; "Edited 26-Apr-2023 12:41 by lmm")
[LAMBDA (NODE NWINDOW) (* ; "Edited 21-May-2024 18:40 by mth")
(* ; "Edited 26-Apr-2023 12:41 by lmm")
(* ; "Edited 31-Mar-87 11:16 by jop")
(* ;
 "function that is applied upon selection of a node.")
(PROG (FN SELECTION)
(IF (NULL NODE)
THEN (RETURN)
(if (NULL NODE)
then (RETURN)
(MOVEW NWINDOW) (* ;
 " really want to just drag the content around")
(RETURN))
(IF (NULL (SETQ FN (FETCH NODELABEL OF NODE)))
THEN (RETURN))
[SETQ SELECTION (MENU (CREATE MENU
(if (NULL (SETQ FN (fetch NODELABEL of NODE)))
then (RETURN))
[SETQ SELECTION (MENU (create MENU
ITEMS _ '(CallsFrom CallsTo Edit Show InspectCode]
(* ;; "Mot implemented: Ignore Avoid")
(DESTRUCTURING-BIND (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING DEPTH)
(FOR BW IN BROWSERWINDOWS WHEN (EQ (FETCH (BROWSEWIN WINDOW) OF BW)
NWINDOW) DO (RETURN (FETCH (BROWSEWIN ARGS)
OF BW))
FINALLY (PROMPTPRINT "No browser window found for" FN)
(for BW in BROWSERWINDOWS when (EQ (fetch (BROWSEWIN WINDOW) of BW)
NWINDOW) do (RETURN (fetch (BROWSEWIN ARGS)
of BW))
finally (PROMPTPRINT "No browser window found for" FN)
(RETURN))
(* ;; "Now we have the arguments to MSPATHS .. insert this node?")
@ -245,11 +242,11 @@
NIL
(Ignore (* ; "local ignore"))
(Avoid (* ; " global ignore"))
(Edit (ED FN (IF (HASDEF FN 'FNS)
THEN 'FNS
ELSEIF (HASDEF FN 'FUNCTIONS)
THEN 'FUNCTIONS
ELSE (PROMPTPRINT FN "no definition")
(Edit (ED FN (if (HASDEF FN 'FNS)
then '(FNS :DONTWAIT)
elseif (HASDEF FN 'FUNCTIONS)
then '(FUNCTIONS :DONTWAIT)
else (PROMPTPRINT FN "no definition")
NIL)))
(Show (CL:UNLESS (EQ FN (WINDOWPROP (GET.BROWSE.PP.WINDOW)
'FNBROWSED))
@ -544,10 +541,10 @@
(BROWSER T)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2085 28437 (MSPATHS.DISPATCH 2095 . 2569) (NUMSPATHS 2571 . 6158) (BROWSER 6160 . 6731)
(BROWSER.WHENFNSCHANGED 6733 . 8518) (BRPATHS1 8520 . 11171) (BROWSER.LEFTFN 11173 . 14599) (
GET.BROWSE.PP.WINDOW 14601 . 15426) (GET.BROWSE.DESCRIBE.WINDOW 15428 . 16176) (BROWSEPP 16178 . 17052
) (PPREPAINTFN 17054 . 20180) (PPRESHAPEFN 20182 . 20358) (DESCRIBEREPAINTFN 20360 . 21064) (
BROWSERDESCRIBE 21066 . 21808) (BROWSER.MIDDLEFN 21810 . 23125) (DEDITPROCESSRUNNINGP 23127 . 23382) (
REDRAWBROWSEGRAPH 23384 . 24148) (STBROWSER 24150 . 28435)))))
(FILEMAP (NIL (1653 28138 (MSPATHS.DISPATCH 1663 . 2137) (NUMSPATHS 2139 . 5726) (BROWSER 5728 . 6299)
(BROWSER.WHENFNSCHANGED 6301 . 8086) (BRPATHS1 8088 . 10739) (BROWSER.LEFTFN 10741 . 14300) (
GET.BROWSE.PP.WINDOW 14302 . 15127) (GET.BROWSE.DESCRIBE.WINDOW 15129 . 15877) (BROWSEPP 15879 . 16753
) (PPREPAINTFN 16755 . 19881) (PPRESHAPEFN 19883 . 20059) (DESCRIBEREPAINTFN 20061 . 20765) (
BROWSERDESCRIBE 20767 . 21509) (BROWSER.MIDDLEFN 21511 . 22826) (DEDITPROCESSRUNNINGP 22828 . 23083) (
REDRAWBROWSEGRAPH 23085 . 23849) (STBROWSER 23851 . 28136)))))
STOP

BIN
library/BROWSER.LCOM
View File

Binary file not shown.

170
lispusers/GITFNS
View File

@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 2-May-2024 23:35:36" {WMEDLEY}<lispusers>GITFNS.;511 129269
(FILECREATED "20-May-2024 22:13:04" {WMEDLEY}<lispusers>GITFNS.;530 131382
:EDIT-BY rmk
:CHANGES-TO (FNS GIT-PUSH GIT-PULL GIT-GET-FILE GIT-FILE-DATE GIT-BRANCH-DIFF GIT-COMMIT-DIFFS
GIT-CHECKOUT GIT-MAKE-BRANCH GIT-BRANCHES GIT-BRANCH-EXISTS? GIT-ADD-WORKTREE)
:CHANGES-TO (FNS GIT-PULL-REQUESTS)
:PREVIOUS-DATE " 2-May-2024 22:57:39" {WMEDLEY}<lispusers>GITFNS.;510)
:PREVIOUS-DATE "13-May-2024 19:31:18" {WMEDLEY}<lispusers>GITFNS.;529)
(PRETTYCOMPRINT GITFNSCOMS)
@ -404,7 +403,7 @@
(TYPERECORD GIT-PROJECT (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH))
(RECORD PULLREQUEST (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT))
(RECORD PULLREQUEST (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT PRURL PRLOGIN))
)
)
@ -536,7 +535,8 @@
(DEFINEQ
(PRC-COMMAND
[LAMBDA (REMOTEBRANCH DRAFTS PROJECT) (* ; "Edited 2-May-2024 11:44 by rmk")
[LAMBDA (REMOTEBRANCH DRAFTS PROJECT) (* ; "Edited 13-May-2024 18:49 by rmk")
(* ; "Edited 2-May-2024 11:44 by rmk")
(* ; "Edited 1-Apr-2024 20:24 by rmk")
(* ; "Edited 28-Jul-2023 09:03 by rmk")
@ -566,22 +566,30 @@
(SETQ PRS (GIT-PULL-REQUESTS (NEQ 'NODRAFTS DRAFTS)
PROJECT))
(CL:WHEN (AND REMOTEBRANCH (NEQ REMOTEBRANCH 'PinMenu))
(* ;; "Filter by the REMOTEBRANCH string")
(* ;; "Filter by REMOTEBRANCH properties")
(SETQ PRS (for PR in PRS when (OR (STRPOS REMOTEBRANCH (fetch PRDESCRIPTION of PR)
NIL NIL NIL NIL FILEDIRCASEARRAY)
(STRPOS REMOTEBRANCH (fetch PRNAME of PR)
NIL NIL NIL NIL FILEDIRCASEARRAY)) collect
PR)))
(SETQ PRS (for PR FOUND in PRS
when (if (STRING-EQUAL "Interlisp" (fetch PRLOGIN of PR))
then (OR (NULL REMOTEBRANCH)
(STRPOS REMOTEBRANCH (fetch PRDESCRIPTION of PR)
NIL NIL NIL NIL FILEDIRCASEARRAY)
(STRPOS REMOTEBRANCH (fetch PRNAME of PR)
NIL NIL NIL NIL FILEDIRCASEARRAY))
else (CL:UNLESS FOUND
(SETQ FOUND T)
(PRINTOUT T "Ignored because not owned by Interlisp: " T))
(PRINTOUT T 3 (fetch PRDESCRIPTION of PR)
" ("
(fetch PRLOGIN of PR)
")" T)
NIL) collect PR))
(IF PRS
THEN (if (CDR PRS)
then (SETQ MENUWINDOW (ADDMENU (GIT-BRANCH-MENU (GIT-PRC-BRANCHES DRAFTS
PROJECT PRS)
(CONCAT (LENGTH PRS)
" pull requests")
NIL PROJECT)
" pull requests"))
NIL NIL T))
(* ;; "Position the new menu just under the current TTY window, to keep it out of the way of the comparison windows. If we have menus open for other projects, those probably should be pushed down to make room for the new menu, and moved up when a higher menu is closed. An edge case that is not worth the effort. ")
@ -1408,40 +1416,52 @@
WHENSELECTEDFN _ (FUNCTION GIT-BRANCH-WHENSELECTEDFN)))])
(GIT-BRANCH-WHENSELECTEDFN
[LAMBDA (ITEM) (* ; "Edited 1-May-2024 18:17 by rmk")
[LAMBDA (ITEM) (* ; "Edited 11-May-2024 11:05 by rmk")
(* ; "Edited 1-May-2024 18:17 by rmk")
(* ; "CAR is git key, 4th is project")
(* ;; "This executes the comparison in the current TTY window, either by stuffing the command there or by evaluating there. There probably should be a check to make sure that the TTY is in fact an executive--if not, maybe this should be a no-op. Better than getting the comparison form in the middle of anther SEDIT or TEDIT.")
(* ;; "This could also execute in the mouse process, where the menu is clicked. But in that case a terminal window pops up with the header lines of the compare, and that seems a nuisance.")
(if T
then
(* ;; "The COPYINSERT causes the compare to run in the TTY process, by stuffing the characters in the input line. Somehow it executes even if the parens are not there, but that looks funny. But it also works if I stuff the parens on both sides.")
(LET [(PR (CAR (LAST ITEM]
(if [AND NIL (PROGN (GETMOUSESTATE)
(EQ 'MIDDLE (DECODEBUTTONS]
then (LET [(POS (ADD1 (STRPOS "#" (CAR ITEM]
(ShellBrowse (fetch PRURL of PR)))
elseif (PROGN T)
then
(* ;; "PROGN because DWIM is screwed up")
(BKSYSBUF '%()
[COPYINSERT `(GIT-PR-COMPARE ,(CADR ITEM)
',(CADR (CDDDR ITEM]
(BKSYSBUF '%))
else
(* ;; "This puts the print out after the next event number in the TTY window, unfortunately. We go to the default font so we don't get TTYIN's input bold for this.")
(* ;; "The COPYINSERT causes the compare to run in the TTY process, by stuffing the characters in the input line. Somehow it executes even if the parens are not there, but that looks funny. But it also works if I stuff the parens on both sides.")
(PROCESS.EVAL (TTY.PROCESS)
`(RESETLST
[RESETSAVE (DSPFONT DEFAULTFONT T)
'(PROGN (DSPFONT OLDVALUE T])])
(BKSYSBUF '%()
[COPYINSERT `(GIT-PR-COMPARE ,(CADR ITEM)
',(fetch PRPROJECT of PR]
(BKSYSBUF '%))
else
(* ;; "This puts the print out after the next event number in the TTY window, unfortunately. We go to the default font so we don't get TTYIN's input bold for this.")
(PROCESS.EVAL (TTY.PROCESS)
`(RESETLST
[RESETSAVE (DSPFONT DEFAULTFONT T)
'(PROGN (DSPFONT OLDVALUE T])])
(GIT-PULL-REQUESTS
[LAMBDA (INCLUDEDRAFTS PROJECT) (* ; "Edited 1-May-2024 09:23 by rmk")
[LAMBDA (INCLUDEDRAFTS PROJECT) (* ; "Edited 20-May-2024 22:12 by rmk")
(* ; "Edited 13-May-2024 18:59 by rmk")
(* ; "Edited 11-May-2024 10:51 by rmk")
(* ; "Edited 1-May-2024 09:23 by rmk")
(* ; "Edited 8-Aug-2022 13:12 by rmk")
(* ; "Edited 4-Aug-2022 19:01 by rmk")
(* ; "Edited 17-Jul-2022 11:12 by rmk")
(* ; "Edited 9-May-2022 16:54 by rmk")
(* ; "Edited 25-Feb-2022 09:26 by rmk")
(* ; "Edited 9-May-2022 16:54 by rmk")
(* ;; "Returns a list of PULLREQUEST records, one for each pull request")
 (* ; "Edited 25-Feb-2022 09:26 by rmk")
(CL:UNLESS (EQ 0 (PROCESS-COMMAND "command -v gh"))
(ERROR "gh must be installed in order to enumerate pull requests:"))
(LET [(JPARSE (JSON-PARSE (CAR (GIT-COMMAND
"gh pr list --json number,headRefName,title,isDraft,reviewDecision"
(LET [(JPARSE (JSON-PARSE (CAR (GIT-COMMAND "gh pr list --json number,headRefName,title,isDraft,reviewDecision,url,headRepository,headRepositoryOwner"
T NIL PROJECT]
(FOR JSOBJ DRAFT PR IN (SELECTQ (CAR JPARSE)
(ARRAY (CDR JPARSE))
@ -1449,7 +1469,7 @@
(ERROR "UNRECOGNIZED PRC LIST FROM GIT" JPARSE))
EACHTIME [SETQ DRAFT (EQ 'true (JSON-GET JSOBJ 'isDraft] WHEN (OR INCLUDEDRAFTS
(NOT DRAFT))
COLLECT (SETQ PR (CREATE PULLREQUEST
COLLECT [SETQ PR (CREATE PULLREQUEST
PRNUMBER _ (JSON-GET JSOBJ 'number)
PRNAME _ (JSON-GET JSOBJ 'headRefName)
PRDESCRIPTION _ (JSON-GET JSOBJ 'title)
@ -1459,8 +1479,19 @@
(JSON-GET JSOBJ 'reviewDecision))
" "
'A))
PRPROJECT _ PROJECT))
PRPROJECT _ PROJECT
PRURL _ (JSON-GET JSOBJ 'url)
PRLOGIN _ (JSON-GET JSOBJ '(headRepositoryOwner login]
(CL:WHEN (STRPOS ":" (fetch (PULLREQUEST PRNAME) of PR))
(* ;; "From Nick: Git commands to bring install and deal with the remotes:")
(* ;; "git remote add [PRLOGIN] https://github.com/[PRLOGIN]/[PROJECT]")
(* ;; " (project in lower-case)")
(* ;; "git remote update [PRLOGIN]")
(PRINTOUT T "Ignoring PR for forked repo %%%" #" (JSON-GET JSOBJ 'number)
" "
(fetch (PULLREQUEST PRNAME) of PR)
@ -1484,7 +1515,9 @@
(FIND B IN (GIT-BRANCHES WHERE PROJECT EXCLUDEMERGED) SUCHTHAT (STRPOS BRANCH B])
(GIT-PRC-BRANCHES
[LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 1-May-2024 21:06 by rmk")
[LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 13-May-2024 19:30 by rmk")
(* ; "Edited 11-May-2024 10:52 by rmk")
(* ; "Edited 1-May-2024 21:06 by rmk")
(* ; "Edited 1-Apr-2024 17:09 by rmk")
(* ; "Edited 8-Aug-2022 18:15 by rmk")
(* ; "Edited 4-Aug-2022 18:55 by rmk")
@ -1496,7 +1529,8 @@
(CL:UNLESS PRS
(SETQ PRS (GIT-PULL-REQUESTS T PROJECT)))
(CL:WHEN PRS
(LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR)))
(LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS
COLLECT (GITORIGIN (fetch PRNAME of PR)))
NIL T PROJECT)))
(SORT (FOR PR REL LABEL PRNAME STATUS (SUPERSETS _ (CAR RELATIONS))
(EQUALS _ (CADR RELATIONS)) IN PRS
@ -1517,7 +1551,7 @@
(CONCAT " " STATUS " #" (FETCH PRNUMBER OF PR)
" "
(FETCH PRDESCRIPTION OF PR))
NIL PROJECT))
NIL PR))
T)))])
)
@ -2368,33 +2402,33 @@
(PUTPROPS GITFNS FILETYPE :TCOMPL)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4348 20927 (GIT-CLONEP 4358 . 5686) (GIT-INIT 5688 . 6318) (GIT-MAKE-PROJECT 6320 .
13985) (GIT-GET-PROJECT 13987 . 15912) (GIT-PUT-PROJECT-FIELD 15914 . 17555) (GIT-PROJECT-PATH 17557
. 18601) (FIND-ANCESTOR-DIRECTORY 18603 . 18952) (GIT-FIND-CLONE 18954 . 20035) (GIT-MAINBRANCH 20037
. 20432) (GIT-MAINBRANCH? 20434 . 20925)) (26376 30458 (PRC-COMMAND 26386 . 30456)) (30514 33302 (
ALLSUBDIRS 30524 . 31810) (MEDLEYSUBDIRS 31812 . 32505) (GITSUBDIRS 32507 . 33300)) (33303 38093 (
TOGIT 33313 . 34719) (FROMGIT 34721 . 35702) (GIT-DELETE-FILE 35704 . 36550) (MYMEDLEY-DELETE-FILES
36552 . 38091)) (38094 41097 (MYMEDLEYSUBDIR 38104 . 38560) (GITSUBDIR 38562 . 39005) (STRIPDIR 39007
. 39378) (STRIPHOST 39380 . 39620) (STRIPNAME 39622 . 40375) (STRIPWHERE 40377 . 41095)) (41098 43000
(GFILE4MFILE 41108 . 41471) (MFILE4GFILE 41473 . 42042) (GIT-REPO-FILENAME 42044 . 42998)) (43049
53300 (GIT-COMMIT 43059 . 43885) (GIT-PUSH 43887 . 44647) (GIT-PULL 44649 . 45401) (GIT-APPROVAL 45403
. 45752) (GIT-GET-FILE 45754 . 47776) (GIT-FILE-EXISTS? 47778 . 48052) (GIT-REMOTE-UPDATE 48054 .
48778) (GIT-REMOTE-ADD 48780 . 49087) (GIT-FILE-DATE 49089 . 50136) (GIT-FILE-HISTORY 50138 . 52072) (
GIT-PRINT-FILE-HISTORY 52074 . 53124) (GIT-FETCH 53126 . 53298)) (53330 64103 (GIT-BRANCH-DIFF 53340
. 59740) (GIT-COMMIT-DIFFS 59742 . 60415) (GIT-BRANCH-RELATIONS 60417 . 64101)) (64148 80865 (
GIT-BRANCH-NUM 64158 . 64731) (GIT-CHECKOUT 64733 . 65908) (GIT-WHICH-BRANCH 65910 . 66208) (
GIT-MAKE-BRANCH 66210 . 68539) (GIT-BRANCHES 68541 . 71031) (GIT-BRANCH-EXISTS? 71033 . 71904) (
GIT-PICK-BRANCH 71906 . 72396) (GIT-BRANCH-MENU 72398 . 73279) (GIT-BRANCH-WHENSELECTEDFN 73281 .
74916) (GIT-PULL-REQUESTS 74918 . 77527) (GIT-SHORT-BRANCH-NAME 77529 . 77820) (GIT-LONG-NAME 77822 .
78139) (GIT-PRC-BRANCHES 78141 . 80863)) (80895 84230 (GIT-MY-CURRENT-BRANCH 80905 . 81275) (
GIT-MY-BRANCHP 81277 . 81782) (GIT-MY-NEXT-BRANCH 81784 . 82278) (GIT-MY-BRANCHES 82280 . 84228)) (
84276 88351 (GIT-ADD-WORKTREE 84286 . 85893) (GIT-REMOVE-WORKTREE 85895 . 86825) (GIT-LIST-WORKTREES
86827 . 87631) (WORKTREEDIR 87633 . 88349)) (88399 121103 (GIT-GET-DIFFERENT-FILES 88409 . 94833) (
GIT-BRANCHES-COMPARE-DIRECTORIES 94835 . 101688) (GIT-WORKING-COMPARE-DIRECTORIES 101690 . 107086) (
GIT-COMPARE-WORKTREE 107088 . 111066) (GITCDOBJBUTTONFN 111068 . 115558) (GIT-CD-LABELFN 115560 .
116642) (GIT-CD-MENUFN 116644 . 119084) (GIT-WORKING-COMPARE-FILES 119086 . 119706) (
GIT-BRANCHES-COMPARE-FILES 119708 . 120872) (GIT-PR-COMPARE 120874 . 121101)) (121173 129202 (CDGITDIR
121183 . 121870) (GIT-COMMAND 121872 . 123430) (GITORIGIN 123432 . 124129) (GIT-INITIALS 124131 .
124435) (GIT-COMMAND-TO-FILE 124437 . 127926) (GIT-RESULT-TO-LINES 127928 . 128535) (STRIPLOCAL 128537
. 129200)))))
(FILEMAP (NIL (4187 20766 (GIT-CLONEP 4197 . 5525) (GIT-INIT 5527 . 6157) (GIT-MAKE-PROJECT 6159 .
13824) (GIT-GET-PROJECT 13826 . 15751) (GIT-PUT-PROJECT-FIELD 15753 . 17394) (GIT-PROJECT-PATH 17396
. 18440) (FIND-ANCESTOR-DIRECTORY 18442 . 18791) (GIT-FIND-CLONE 18793 . 19874) (GIT-MAINBRANCH 19876
. 20271) (GIT-MAINBRANCH? 20273 . 20764)) (26229 30851 (PRC-COMMAND 26239 . 30849)) (30907 33695 (
ALLSUBDIRS 30917 . 32203) (MEDLEYSUBDIRS 32205 . 32898) (GITSUBDIRS 32900 . 33693)) (33696 38486 (
TOGIT 33706 . 35112) (FROMGIT 35114 . 36095) (GIT-DELETE-FILE 36097 . 36943) (MYMEDLEY-DELETE-FILES
36945 . 38484)) (38487 41490 (MYMEDLEYSUBDIR 38497 . 38953) (GITSUBDIR 38955 . 39398) (STRIPDIR 39400
. 39771) (STRIPHOST 39773 . 40013) (STRIPNAME 40015 . 40768) (STRIPWHERE 40770 . 41488)) (41491 43393
(GFILE4MFILE 41501 . 41864) (MFILE4GFILE 41866 . 42435) (GIT-REPO-FILENAME 42437 . 43391)) (43442
53693 (GIT-COMMIT 43452 . 44278) (GIT-PUSH 44280 . 45040) (GIT-PULL 45042 . 45794) (GIT-APPROVAL 45796
. 46145) (GIT-GET-FILE 46147 . 48169) (GIT-FILE-EXISTS? 48171 . 48445) (GIT-REMOTE-UPDATE 48447 .
49171) (GIT-REMOTE-ADD 49173 . 49480) (GIT-FILE-DATE 49482 . 50529) (GIT-FILE-HISTORY 50531 . 52465) (
GIT-PRINT-FILE-HISTORY 52467 . 53517) (GIT-FETCH 53519 . 53691)) (53723 64496 (GIT-BRANCH-DIFF 53733
. 60133) (GIT-COMMIT-DIFFS 60135 . 60808) (GIT-BRANCH-RELATIONS 60810 . 64494)) (64541 82978 (
GIT-BRANCH-NUM 64551 . 65124) (GIT-CHECKOUT 65126 . 66301) (GIT-WHICH-BRANCH 66303 . 66601) (
GIT-MAKE-BRANCH 66603 . 68932) (GIT-BRANCHES 68934 . 71424) (GIT-BRANCH-EXISTS? 71426 . 72297) (
GIT-PICK-BRANCH 72299 . 72789) (GIT-BRANCH-MENU 72791 . 73672) (GIT-BRANCH-WHENSELECTEDFN 73674 .
75839) (GIT-PULL-REQUESTS 75841 . 79359) (GIT-SHORT-BRANCH-NAME 79361 . 79652) (GIT-LONG-NAME 79654 .
79971) (GIT-PRC-BRANCHES 79973 . 82976)) (83008 86343 (GIT-MY-CURRENT-BRANCH 83018 . 83388) (
GIT-MY-BRANCHP 83390 . 83895) (GIT-MY-NEXT-BRANCH 83897 . 84391) (GIT-MY-BRANCHES 84393 . 86341)) (
86389 90464 (GIT-ADD-WORKTREE 86399 . 88006) (GIT-REMOVE-WORKTREE 88008 . 88938) (GIT-LIST-WORKTREES
88940 . 89744) (WORKTREEDIR 89746 . 90462)) (90512 123216 (GIT-GET-DIFFERENT-FILES 90522 . 96946) (
GIT-BRANCHES-COMPARE-DIRECTORIES 96948 . 103801) (GIT-WORKING-COMPARE-DIRECTORIES 103803 . 109199) (
GIT-COMPARE-WORKTREE 109201 . 113179) (GITCDOBJBUTTONFN 113181 . 117671) (GIT-CD-LABELFN 117673 .
118755) (GIT-CD-MENUFN 118757 . 121197) (GIT-WORKING-COMPARE-FILES 121199 . 121819) (
GIT-BRANCHES-COMPARE-FILES 121821 . 122985) (GIT-PR-COMPARE 122987 . 123214)) (123286 131315 (CDGITDIR
123296 . 123983) (GIT-COMMAND 123985 . 125543) (GITORIGIN 125545 . 126242) (GIT-INITIALS 126244 .
126548) (GIT-COMMAND-TO-FILE 126550 . 130039) (GIT-RESULT-TO-LINES 130041 . 130648) (STRIPLOCAL 130650
. 131313)))))
STOP

BIN
lispusers/GITFNS.LCOM
View File

Binary file not shown.

24
lispusers/JSON
View File

@ -1,15 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Apr-2024 14:42:30" {WMEDLEY}<lispusers>JSON.;31 9030
(FILECREATED "13-May-2024 22:37:13" {WMEDLEY}<lispusers>JSON.;36 9198
:EDIT-BY rmk
:CHANGES-TO (FNS JSON-STRING JSON-GET JSON-VALUE JSON-ARRAY JSON-OBJECT JSON-AVPAIR JSON-NUMBER
JSON-ATOM JSSKIP JSON-SKIP JSON-PARSE)
(VARS JSONCOMS)
(MACROS JSBIN JSPEEK JSBINC JSPEEKC)
:CHANGES-TO (FNS JSON-GET)
:PREVIOUS-DATE "30-Apr-2024 00:54:21" {WMEDLEY}<lispusers>JSON.;9)
:PREVIOUS-DATE "13-May-2024 19:23:02" {WMEDLEY}<lispusers>JSON.;33)
(PRETTYCOMPRINT JSONCOMS)
@ -180,11 +177,14 @@
NIL])
(JSON-GET
[LAMBDA (OBJECT ATTRIBUTE) (* ; "Edited 30-Apr-2024 14:26 by rmk")
[LAMBDA (OBJECT ATTRIBUTES) (* ; "Edited 13-May-2024 22:35 by rmk")
(* ; "Edited 30-Apr-2024 14:26 by rmk")
(* ;; "Returns the value of ATTRIBUTE in OBJECT")
(* ;; "Returns the value at the end of a chain of ATTRIBUTES in OBJECT")
(CADR (ASSOC ATTRIBUTE OBJECT])
(for A (OBJ _ OBJECT) inside ATTRIBUTES do (if (EQ 'OBJECT (CAR (LISTP OBJ)))
then [SETQ OBJ (CADR (ASSOC A (CDR OBJ]
else (RETURN NIL)) finally (RETURN OBJ])
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
@ -201,7 +201,7 @@
)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (778 8671 (JSON-PARSE 788 . 1134) (JSON-VALUE 1136 . 1505) (JSON-SKIP 1507 . 1781) (
JSON-STRING 1783 . 2581) (JSON-ARRAY 2583 . 3721) (JSON-OBJECT 3723 . 5180) (JSON-AVPAIR 5182 . 5624)
(JSON-NUMBER 5626 . 7140) (JSON-ATOM 7142 . 8449) (JSON-GET 8451 . 8669)))))
(FILEMAP (NIL (559 8839 (JSON-PARSE 569 . 915) (JSON-VALUE 917 . 1286) (JSON-SKIP 1288 . 1562) (
JSON-STRING 1564 . 2362) (JSON-ARRAY 2364 . 3502) (JSON-OBJECT 3504 . 4961) (JSON-AVPAIR 4963 . 5405)
(JSON-NUMBER 5407 . 6921) (JSON-ATOM 6923 . 8230) (JSON-GET 8232 . 8837)))))
STOP

BIN
lispusers/JSON.LCOM
View File

Binary file not shown.

711
lispusers/MANAGER
View File

@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "17-May-2024 09:44:49" {LU}MANAGER.;2 112772
(FILECREATED "21-May-2024 18:45:54" {LU}MANAGER.;4 102968
:EDIT-BY "mth"
:CHANGES-TO (FNS Manager.DO.COMMAND)
:PREVIOUS-DATE "13-Oct-2023 16:41:52" {LU}MANAGER.;1)
:PREVIOUS-DATE "20-May-2024 11:16:10" {LU}MANAGER.;3)
(PRETTYCOMPRINT MANAGERCOMS)
@ -81,15 +81,15 @@
COMMON-MAKE)
(* ; "FILEBROWSER for SEE command")
(FNS MANAGER MANAGER.RESET Manager.ADDADV Manager.ADDTOFILES? Manager.ALTERMARKING
Manager.ANCHORED-SET-POSITION Manager.DO.COMMAND Manager.HIGHLIGHT Manager.PROMPT
Manager.WINDOW Manager.insurefilehighlights Manager.CHANGED? Manager.CHECKFILE
Manager.COLLECTCOMS Manager.COMS.WSF Manager.COMSOPEN Manager.COMSUPDATE
Manager.HIGHLIGHTED Manager.INSUREHIGHLIGHTS Manager.FILECHANGES Manager.FILELSTCHANGED?
Manager.FILESUBTYPES Manager.GET.ENVIRONMENT Manager.GETFILE Manager.INTITLE?
Manager.MAIN.WSF Manager.MAINCLOSE Manager.MAINMENUITEMS Manager.MAINOPEN
Manager.MAINUPDATE Manager.MAKEFILE.ADV Manager.MENUCOLUMNS Manager.MENUHASITEM
Manager.MENUITEMS Manager.REMOVE.DUPLICATE.ADVICE Manager.RESETSUBITEMS
Manager.SET-ANCHOR Manager.SORT.COMS Manager.SORTBYCOLUMN)
Manager.ANCHORED-SET-POSITION Manager.DO.COMMAND Manager.DO.COMMAND.PROCFN
Manager.HIGHLIGHT Manager.PROMPT Manager.WINDOW Manager.insurefilehighlights
Manager.CHANGED? Manager.CHECKFILE Manager.COLLECTCOMS Manager.COMS.WSF Manager.COMSOPEN
Manager.COMSUPDATE Manager.HIGHLIGHTED Manager.INSUREHIGHLIGHTS Manager.FILECHANGES
Manager.FILELSTCHANGED? Manager.FILESUBTYPES Manager.GET.ENVIRONMENT Manager.GETFILE
Manager.INTITLE? Manager.MAIN.WSF Manager.MAINCLOSE Manager.MAINMENUITEMS
Manager.MAINOPEN Manager.MAINUPDATE Manager.MAKEFILE.ADV Manager.MENUCOLUMNS
Manager.MENUHASITEM Manager.MENUITEMS Manager.REMOVE.DUPLICATE.ADVICE
Manager.RESETSUBITEMS Manager.SET-ANCHOR Manager.SORT.COMS Manager.SORTBYCOLUMN)
(ADVISE ADDFILE ADDTOFILES? MAKEFILE MARKASCHANGED UNMARKASCHANGED UPDATEFILES ADDTOCOMS
DELFROMCOMS \ADDTOFILEBLOCK/ADDNEWCOM LOAD LOADFNS (MARKASCHANGED :IN
DEFAULT.EDITDEFA0001))
@ -562,7 +562,8 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
YCOORD _ YPOS])
(Manager.DO.COMMAND
[LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 17-May-2024 09:41 by mth")
[LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 21-May-2024 17:56 by mth")
(* ; "Edited 17-May-2024 09:41 by mth")
(* ; "Edited 13-Oct-2023 16:28 by mth")
(if (EQ COMSTYPE 'FILEVARS)
then (SETQ COMSTYPE 'VARS) (* ; "The Manager currently does unnatural things with the FILEVARS type, this is a hack to compensate for it. E.g., editing a FILEVARS = editing the VARS, etc.")
@ -573,386 +574,321 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
then (Manager.GET.ENVIRONMENT FILE)
else (MAKE-READER-ENVIRONMENT *PACKAGE* *READTABLE*
*READ-BASE*))
(* ; "SEdit does not use *package*. ")
(* ;; "SEdit does not use *package*. ")
[COND
((EQ COMSTYPE 'FILES)
(ED ITEM 'PROPERTY-LIST))
((NULL COMSTYPE)
(EDITDEF 'FILELST 'VARS))
(T (EDITDEF ITEM COMSTYPE NIL NIL '(:DONTWAIT]))
(ADD.PROCESS
`[CL:APPLY
',[FUNCTION (LAMBDA (COMMAND ITEM COMSTYPE FILE MENU)
(WITH-READER-ENVIRONMENT (if FILE
then (Manager.GET.ENVIRONMENT FILE)
else (MAKE-READER-ENVIRONMENT *PACKAGE*
*READTABLE* *READ-BASE*))
[LET
((ACTIVITY-WINDOW NIL)
(ACTIVITY-WINDOW-WAS-SHRUNK NIL))
(RESETLST
(RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
[if [NOT (FMEMB COMMAND
'(BREAK TRACE UNBREAK CHANGED DELETED DEFINED
UNMARK SEE LIST HARDCOPY REMOVE NIL]
then (* ; "steal the TTY, if we really need it (there are also further complementary lists at the bottom of the following BLOCK).")
(TTYDISPLAYSTREAM (SETQ ACTIVITY-WINDOW (Manager.WINDOW)))
(SETQ ACTIVITY-WINDOW-WAS-SHRUNK (NOT (OPENWP
ACTIVITY-WINDOW
]
(CL:BLOCK NIL
(CL:ECASE COMMAND
(READVISE (APPLY* (FUNCTION READVISE)
ITEM))
(UNADVISE (APPLY* (FUNCTION UNADVISE)
ITEM))
(SHOWADVICE
(printout T .FONT LAMBDAFONT
"Advised and traced fns and functions:" .FONT
DEFAULTFONT T)
(for ITEM in ADVISEDFNS
do (printout T 10 ITEM T)))
(RESET (COND
((MOUSECONFIRM
"Reset the Manager destroying all the menus? "
NIL T)
(CL:FORMAT T
"Expunging and reconstructing the Manager's menus~%%Please Stand By."
)
(MANAGER.RESET T)
(CL:FORMAT T "~&Done.~%%-----")
(CLOSEW T))))
(QUIT (COND
((MOUSECONFIRM "Quit the Manager? " NIL T)
(Manager.MAINCLOSE T)
(CLOSEW T))))
(RELOAD
(CL:FORMAT T "~&Loading ~A definition of ~S from ~A."
ITEM COMSTYPE FILE)
(LOADDEF ITEM COMSTYPE FILE))
(SHOWDEF
(printout T .FONT LAMBDAFONT COMSTYPE " definition of "
ITEM .FONT DEFAULTFONT " (source file format):" T
)
(SHOWDEF ITEM COMSTYPE))
(BREAK (APPLY* 'BREAK ITEM))
(TRACE (EVAL (LIST 'TRACE ITEM)))
(UNBREAK (EVAL (LIST 'UNBREAK ITEM)))
(DISASSEMBLE
(printout T .FONT LAMBDAFONT "Compiled code for " ITEM
":" .FONT DEFAULTFONT T)
(INSPECTCODE ITEM))
(PV (printout T .FONT LAMBDAFONT "Value of " ITEM ":" .FONT
DEFAULTFONT T (if (BOUNDP ITEM)
then (EVAL ITEM)
else "Not bound!")))
(PF
(printout T .FONT LAMBDAFONT "Function definition of "
ITEM ":" .FONT DEFAULTFONT T)
(PF ITEM))
(PL
(printout T .FONT LAMBDAFONT "Property list for " ITEM
":" .FONT DEFAULTFONT T)
(PRINTPROPS (if (EQ COMSTYPE 'PROPS)
then (CAR ITEM)
else ITEM)))
(CLDESCRIBE
(printout T .FONT LAMBDAFONT "Description of " ITEM ":"
.FONT DEFAULTFONT T)
(CL:DESCRIBE ITEM))
(CLDOC (printout T .FONT LAMBDAFONT "Documentation for "
ITEM ":" .FONT DEFAULTFONT T (
CL:DOCUMENTATION
ITEM)))
(FIELDS (printout T .FONT LAMBDAFONT "Fields of " ITEM ":"
.FONT DEFAULTFONT T (REVERSE (
RECORDFIELDNAMES
ITEM))))
(ARGS (printout T .FONT LAMBDAFONT "Arguments of " ITEM
": " .FONT DEFAULTFONT T 10 (SMARTARGLIST
ITEM)
T))
(EDITCALLERS (EDITCALLERS ITEM FILE))
(COPYDEF (LET [(FILENAME (Manager.PROMPT (CONCAT "Rename "
ITEM
" to: "]
(if FILENAME
then (COPYDEF ITEM FILENAME COMSTYPE))))
(RENAME (LET [(FILENAME (Manager.PROMPT (CONCAT "Rename "
ITEM " to: "
]
(if FILENAME
then (RENAME ITEM FILENAME COMSTYPE FILE))
))
(RENAME-ALL (LET [(FILENAME (Manager.PROMPT (CONCAT
"Rename "
ITEM
" to: "]
(if FILENAME
then (RENAME ITEM FILENAME COMSTYPE
FILELST))))
(DELETE (if (MOUSECONFIRM (CONCAT "DELETE the " COMSTYPE
" " ITEM " from " FILE "?"
))
then (DELFROMFILES ITEM COMSTYPE FILE)))
(LOAD (LET ((FILENAME (Manager.PROMPT "Filename: ")))
(if FILENAME
then (LOAD FILENAME))))
(LOADFNSLATER [LET ((FILENAME (Manager.PROMPT "Filename: ")
))
(if FILENAME
then (LOADFNS NIL FILENAME
'ALLPROP
'VARS])
(LOADFNSNOW [LET ((FILENAME (Manager.PROMPT "Filename: ")))
(if FILENAME
then (LOADFNS T FILENAME 'ALLPROP
'VARS])
(LOADFROMLATER (LET ((FILENAME (Manager.PROMPT "Filename: "
)))
(if FILENAME
then (LOADFROM FILENAME))))
(LOADFROMNOW (LET ((FILENAME (Manager.PROMPT "Filename: "))
)
(if FILENAME
then (LOADFROM FILENAME T))))
(ADDFILE (LET ((FILENAME (Manager.PROMPT "Filename: ")))
(if FILENAME
then (ADDFILE FILENAME))))
(SYSLOAD [COND
((MOUSECONFIRM (CONCAT
"Do you really want to SYSLOAD "
FILE "?" NIL T))
NIL
(LOAD FILE 'SYSLOAD])
(MOVE (LET [(ANSWER (Manager.GETFILE (CONCAT
"File to move "
COMSTYPE " "
ITEM " to"]
(AND ANSWER (MOVETOFILE ANSWER ITEM COMSTYPE
FILE))))
(COPY (LET [(ANSWER (Manager.GETFILE (CONCAT
"File to copy "
COMSTYPE " "
ITEM " to"]
(AND ANSWER (ADDTOFILE ITEM COMSTYPE ANSWER))))
((CHANGED DELETED DEFINED)
(if COMSTYPE
then (MARKASCHANGED ITEM COMSTYPE COMMAND)
else (MARKASCHANGED (FILECOMS ITEM)
'VARS COMMAND)
(UPDATEFILES)
(* ; "This is needed because the main menu is a special case. Its not in the open windows list, nor does it carry %"type%" information (like that it contains filevars).")
))
(UNMARK (if (EQ COMSTYPE 'FILES)
then (* ; "whole file")
(COND
((MOUSECONFIRM (CONCAT
"Unmark entire contents of "
FILE "?" NIL T))
(/RPLACD (GETPROP FILE 'FILE)
NIL)
(Manager.insurefilehighlights FILE)
(Manager.HIGHLIGHT FILE MENU)))
else (* ; "single item")
(UNMARKASCHANGED ITEM COMSTYPE)))
(SEE (LET ((FULLNAME (OR (CDAR (GETPROP FILE 'FILEDATES))
FILE)))
(ADD.PROCESS `[CL:APPLY #'Manager.DO.COMMAND.PROCFN '(,COMMAND ,ITEM ,COMSTYPE ,FILE
,MENU]
'NAME
'MANAGER-COMMAND))
NIL])
(* ;;
(Manager.DO.COMMAND.PROCFN
[LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 20-May-2024 11:15 by mth")
(WITH-READER-ENVIRONMENT (if FILE
then (Manager.GET.ENVIRONMENT FILE)
else (MAKE-READER-ENVIRONMENT *PACKAGE* *READTABLE* *READ-BASE*))
[LET
((ACTIVITY-WINDOW NIL)
(ACTIVITY-WINDOW-WAS-SHRUNK NIL))
(RESETLST
(RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
[if [NOT (FMEMB COMMAND
'(BREAK TRACE UNBREAK CHANGED DELETED DEFINED UNMARK SEE LIST HARDCOPY
REMOVE NIL]
then (* ; "steal the TTY, if we really need it (there are also further complementary lists at the bottom of the following BLOCK).")
(TTYDISPLAYSTREAM (SETQ ACTIVITY-WINDOW (Manager.WINDOW)))
(SETQ ACTIVITY-WINDOW-WAS-SHRUNK (NOT (OPENWP ACTIVITY-WINDOW]
(CL:BLOCK NIL
(CL:ECASE COMMAND
(READVISE (APPLY* (FUNCTION READVISE)
ITEM))
(UNADVISE (APPLY* (FUNCTION UNADVISE)
ITEM))
(SHOWADVICE
(printout T .FONT LAMBDAFONT "Advised and traced fns and functions:" .FONT
DEFAULTFONT T)
(for ITEM in ADVISEDFNS do (printout T 10 ITEM T)))
(RESET (COND
((MOUSECONFIRM "Reset the Manager destroying all the menus? " NIL T)
(CL:FORMAT T
"Expunging and reconstructing the Manager's menus~%%Please Stand By."
)
(MANAGER.RESET T)
(CL:FORMAT T "~&Done.~%%-----")
(CLOSEW T))))
(QUIT (COND
((MOUSECONFIRM "Quit the Manager? " NIL T)
(Manager.MAINCLOSE T)
(CLOSEW T))))
(RELOAD
(CL:FORMAT T "~&Loading ~A definition of ~S from ~A." ITEM COMSTYPE FILE)
(LOADDEF ITEM COMSTYPE FILE))
(SHOWDEF
(printout T .FONT LAMBDAFONT COMSTYPE " definition of " ITEM .FONT
DEFAULTFONT " (source file format):" T)
(SHOWDEF ITEM COMSTYPE))
(BREAK (APPLY* 'BREAK ITEM))
(TRACE (EVAL (LIST 'TRACE ITEM)))
(UNBREAK (EVAL (LIST 'UNBREAK ITEM)))
(DISASSEMBLE
(printout T .FONT LAMBDAFONT "Compiled code for " ITEM ":" .FONT DEFAULTFONT
T)
(INSPECTCODE ITEM))
(PV (printout T .FONT LAMBDAFONT "Value of " ITEM ":" .FONT DEFAULTFONT T
(if (BOUNDP ITEM)
then (EVAL ITEM)
else "Not bound!")))
(PF
(printout T .FONT LAMBDAFONT "Function definition of " ITEM ":" .FONT
DEFAULTFONT T)
(APPLY* #'PF ITEM))
(PL
(printout T .FONT LAMBDAFONT "Property list for " ITEM ":" .FONT DEFAULTFONT
T)
(PRINTPROPS (if (EQ COMSTYPE 'PROPS)
then (CAR ITEM)
else ITEM)))
(CLDESCRIBE
(printout T .FONT LAMBDAFONT "Description of " ITEM ":" .FONT DEFAULTFONT T)
(CL:DESCRIBE ITEM))
(CLDOC (printout T .FONT LAMBDAFONT "Documentation for " ITEM ":" .FONT
DEFAULTFONT T (CL:DOCUMENTATION ITEM)))
(FIELDS (printout T .FONT LAMBDAFONT "Fields of " ITEM ":" .FONT DEFAULTFONT T
(REVERSE (RECORDFIELDNAMES ITEM))))
(ARGS (printout T .FONT LAMBDAFONT "Arguments of " ITEM ": " .FONT DEFAULTFONT T
10 (SMARTARGLIST ITEM)
T))
(EDITCALLERS (EDITCALLERS ITEM FILE))
(COPYDEF (LET [(FILENAME (Manager.PROMPT (CONCAT "Copy " ITEM " as name: "]
(if FILENAME
then (COPYDEF ITEM FILENAME COMSTYPE))))
(RENAME (LET [(FILENAME (Manager.PROMPT (CONCAT "Rename " ITEM " to: "]
(if FILENAME
then (RENAME ITEM FILENAME COMSTYPE FILE))))
(RENAME-ALL (LET [(FILENAME (Manager.PROMPT (CONCAT
"Rename (in ALL loaded files) "
ITEM " to: "]
(if FILENAME
then (RENAME ITEM FILENAME COMSTYPE FILELST))))
(DELETE (if (MOUSECONFIRM (CONCAT "DELETE the " COMSTYPE " " ITEM " from " FILE
"?"))
then (DELFROMFILES ITEM COMSTYPE FILE)))
(LOAD (LET ((FILENAME (Manager.PROMPT "Filename: ")))
(if FILENAME
then (LOAD FILENAME))))
(LOADFNSLATER [LET ((FILENAME (Manager.PROMPT "Filename: ")))
(if FILENAME
then (LOADFNS NIL FILENAME 'ALLPROP 'VARS])
(LOADFNSNOW [LET ((FILENAME (Manager.PROMPT "Filename: ")))
(if FILENAME
then (LOADFNS T FILENAME 'ALLPROP 'VARS])
(LOADFROMLATER (LET ((FILENAME (Manager.PROMPT "Filename: ")))
(if FILENAME
then (LOADFROM FILENAME))))
(LOADFROMNOW (LET ((FILENAME (Manager.PROMPT "Filename: ")))
(if FILENAME
then (LOADFROM FILENAME T))))
(ADDFILE (LET ((FILENAME (Manager.PROMPT "Filename: ")))
(if FILENAME
then (ADDFILE FILENAME))))
(SYSLOAD [COND
((MOUSECONFIRM (CONCAT "Do you really want to SYSLOAD " FILE "?" NIL
T))
NIL
(LOAD FILE 'SYSLOAD])
(MOVE (LET [(ANSWER (Manager.GETFILE (CONCAT "File to move " COMSTYPE " " ITEM
" to"]
(AND ANSWER (MOVETOFILE ANSWER ITEM COMSTYPE FILE))))
(COPY (LET [(ANSWER (Manager.GETFILE (CONCAT "File to copy " COMSTYPE " " ITEM
" to"]
(AND ANSWER (ADDTOFILE ITEM COMSTYPE ANSWER))))
((CHANGED DELETED DEFINED) (if COMSTYPE
then (MARKASCHANGED ITEM COMSTYPE COMMAND)
else (MARKASCHANGED (FILECOMS ITEM)
'VARS COMMAND)
(UPDATEFILES)
(* ; "This is needed because the main menu is a special case. Its not in the open windows list, nor does it carry %"type%" information (like that it contains filevars).")
))
(UNMARK (if (EQ COMSTYPE 'FILES)
then (* ; "whole file")
(COND
((MOUSECONFIRM (CONCAT "Unmark entire contents of " FILE "?"
NIL T))
(/RPLACD (GETPROP FILE 'FILE)
NIL)
(Manager.insurefilehighlights FILE)
(Manager.HIGHLIGHT FILE MENU)))
else (* ; "single item")
(UNMARKASCHANGED ITEM COMSTYPE)))
(SEE (LET ((FULLNAME (OR (CDAR (GETPROP FILE 'FILEDATES))
FILE)))
(* ;;
 "I'm assuming that the CAR of the FILEDATES list is the most recent...")
(FB.FASTSEE.ONEFILE
NIL FULLNAME
(LET [(W (CREATEW NIL (CONCAT "Seeing " FULLNAME
"..."]
(DSPSCROLL 'ON W)
(WINDOWPROP W 'PAGEFULLFN 'FB.SEEFULLFN)
(TTYDISPLAYSTREAM W)
W))))
(TEDIT-SEE (TEDIT-SEE (OR (CDAR (GETPROP FILE 'FILEDATES))
FILE)))
(LOAD
(printout T .FONT LAMBDAFONT "Loading file " FILE "."
.FONT DEFAULTFONT T)
(LOAD FILE))
((MAKEFILE NEW FAST)
(if FILE
then (printout T .FONT LAMBDAFONT "Writing file "
FILE "." .FONT DEFAULTFONT T)
(PRINT (MAKEFILE
FILE
(if (EQ COMMAND 'MAKEFILE)
then NIL
else COMMAND))
T)
else (printout T .FONT LAMBDAFONT "Writing files ")
[PRINT (MAKEFILES
(if (EQ COMMAND 'MAKEFILE)
then NIL
else (LIST COMMAND]
(printout T .FONT DEFAULTFONT T)))
(COMMON-MAKEFILE (if FILE
then (printout T .FONT LAMBDAFONT
"Writing CommonLisp source into "
FILE ".LSP" .FONT
DEFAULTFONT T)
(PRINT (COMMON-MAKEFILE FILE)
T)
else (CL:FORMAT T
(FB.FASTSEE.ONEFILE NIL FULLNAME
(LET [(W (CREATEW NIL (CONCAT "Seeing " FULLNAME "..."]
(DSPSCROLL 'ON W)
(WINDOWPROP W 'PAGEFULLFN 'FB.SEEFULLFN)
(TTYDISPLAYSTREAM W)
W))))
(TEDIT-SEE (TEDIT-SEE (OR (CDAR (GETPROP FILE 'FILEDATES))
FILE)))
(LOAD
(printout T .FONT LAMBDAFONT "Loading file " FILE "." .FONT DEFAULTFONT T)
(LOAD FILE))
((MAKEFILE NEW FAST)
(if FILE
then (printout T .FONT LAMBDAFONT "Writing file " FILE "." .FONT
DEFAULTFONT T)
(PRINT (MAKEFILE FILE (if (EQ COMMAND 'MAKEFILE)
then NIL
else COMMAND))
T)
else (printout T .FONT LAMBDAFONT "Writing files ")
[PRINT (MAKEFILES (if (EQ COMMAND 'MAKEFILE)
then NIL
else (LIST COMMAND]
(printout T .FONT DEFAULTFONT T)))
(COMMON-MAKEFILE (if FILE
then (printout T .FONT LAMBDAFONT
"Writing CommonLisp source into " FILE ".LSP"
.FONT DEFAULTFONT T)
(PRINT (COMMON-MAKEFILE FILE)
T)
else (CL:FORMAT T
"~&CommonLispify must be selected separately for each file"
)))
((LIST HARDCOPY) (LISTFILES1 FILE))
((ANCHOR-TL ANCHOR-TR ANCHOR-BL ANCHOR-BR) (
 Manager.SET-ANCHOR
COMMAND))
(CLEANUP
(printout T .FONT LAMBDAFONT "Cleanup..." .FONT
DEFAULTFONT T)
)))
((LIST HARDCOPY) (LISTFILES1 FILE))
((ANCHOR-TL ANCHOR-TR ANCHOR-BL ANCHOR-BR) (Manager.SET-ANCHOR COMMAND))
(CLEANUP
(printout T .FONT LAMBDAFONT "Cleanup..." .FONT DEFAULTFONT T)
(* ;
 "These are different, presumably because CLEANUP is an NLAMBDA.")
(if FILE
then (APPLY* (FUNCTION CLEANUP)
FILE)
else (CLEANUP)))
(CLEANUPT (printout T .FONT LAMBDAFONT
"Changing default cleanup compiler:" .FONT
DEFAULTFONT T "Old value "
*DEFAULT-CLEANUP-COMPILER* T "New value: "
(SETQ *DEFAULT-CLEANUP-COMPILER*
'TCOMPL)
T))
(CLEANUPC (printout T .FONT LAMBDAFONT
"Changing default cleanup compiler:" .FONT
DEFAULTFONT T "Old value "
*DEFAULT-CLEANUP-COMPILER* T "New value: "
(SETQ *DEFAULT-CLEANUP-COMPILER*
'COMPILE-FILE)
T))
(if FILE
then (APPLY* (FUNCTION CLEANUP)
FILE)
else (CLEANUP)))
(CLEANUPT (printout T .FONT LAMBDAFONT "Changing default cleanup compiler:"
.FONT DEFAULTFONT T "Old value " *DEFAULT-CLEANUP-COMPILER* T
"New value: " (SETQ *DEFAULT-CLEANUP-COMPILER* 'TCOMPL)
T))
(CLEANUPC (printout T .FONT LAMBDAFONT "Changing default cleanup compiler:"
.FONT DEFAULTFONT T "Old value " *DEFAULT-CLEANUP-COMPILER* T
"New value: " (SETQ *DEFAULT-CLEANUP-COMPILER* 'COMPILE-FILE)
T))
(* ;; " Masterscope stuff")
(* ;; " Masterscope stuff")
(ANALYZE
(printout T .FONT LAMBDAFONT "Analyzing the file " FILE
" with MasterScope..." .FONT DEFAULTFONT T)
(MASTERSCOPE `(ANALYZE FNS ON %, FILE)))
(CHECK
(printout T .FONT LAMBDAFONT "Checking the file " FILE
" with MasterScope..." .FONT DEFAULTFONT T)
(MASTERSCOPE `(CHECK %, FILE)))
(DESCRIBE
(SELECTQ COMSTYPE
(VARS [CL:FORMAT
T "~&~a is used by:~%% ~a" ITEM
(MASTERSCOPE
`(WHO USES ',ITEM])
(PROGN NIL
(printout T .FONT LAMBDAFONT
"MasterScope analysis of " ITEM ":"
.FONT DEFAULTFONT T)
(MSDESCRIBE ITEM))))
(SHOWPATHTO
(printout T .FONT LAMBDAFONT "Showing who calls " ITEM
" with MasterScope..." .FONT DEFAULTFONT T)
(MASTERSCOPE `(SHOW PATHS TO %, ITEM)))
(SHOWPATHFROM
(printout T .FONT LAMBDAFONT "Showing who is called by "
ITEM " with MasterScope..." .FONT DEFAULTFONT T)
(MASTERSCOPE `(SHOW PATHS FROM %, ITEM)))
(SHOWPATHFILE
(printout T .FONT LAMBDAFONT
"Showing who is called by functions in the file "
ITEM " with MasterScope..." .FONT DEFAULTFONT T)
(MASTERSCOPE `(SHOW PATHS FROM ON %, FILE)))
(ANALYZE
(printout T .FONT LAMBDAFONT "Analyzing the file " FILE
" with MasterScope..." .FONT DEFAULTFONT T)
(MASTERSCOPE `(ANALYZE FNS ON %, FILE)))
(CHECK
(printout T .FONT LAMBDAFONT "Checking the file " FILE " with MasterScope..."
.FONT DEFAULTFONT T)
(MASTERSCOPE `(CHECK %, FILE)))
(DESCRIBE (SELECTQ COMSTYPE
(VARS [CL:FORMAT T "~&~a is used by:~%% ~a" ITEM
(MASTERSCOPE `(WHO USES ',ITEM])
(PROGN NIL (printout T .FONT LAMBDAFONT "MasterScope analysis of "
ITEM ":" .FONT DEFAULTFONT T)
(MSDESCRIBE ITEM))))
(SHOWPATHTO
(printout T .FONT LAMBDAFONT "Showing who calls " ITEM " with MasterScope..."
.FONT DEFAULTFONT T)
(MASTERSCOPE `(SHOW PATHS TO %, ITEM)))
(SHOWPATHFROM
(printout T .FONT LAMBDAFONT "Showing who is called by " ITEM
" with MasterScope..." .FONT DEFAULTFONT T)
(MASTERSCOPE `(SHOW PATHS FROM %, ITEM)))
(SHOWPATHFILE
(printout T .FONT LAMBDAFONT
"Showing who is called by functions in the file " ITEM
" with MasterScope..." .FONT DEFAULTFONT T)
(MASTERSCOPE `(SHOW PATHS FROM ON %, FILE)))
(* ;; "DATABASEFNS stuff")
(* ;; "DATABASEFNS stuff")
(DB (CL:FORMAT T
"~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a"
SAVEDBFLG LOADDBFLG))
(DBFILE
(CL:FORMAT T "~&The DATABASE prop for ~a is: ~a" FILE
(GETPROP FILE 'DATABASE))
(CL:FORMAT T
"~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a"
SAVEDBFLG LOADDBFLG))
(DBON
(SETQ LOADDBFLG 'ON)
(SETQ SAVEDBFLG 'ON))
(DBOFF
(SETQ LOADDBFLG 'NO)
(SETQ SAVEDBFLG 'NO))
(DBASK
(SETQ LOADDBFLG 'ASK)
(SETQ SAVEDBFLG 'ASK))
(DBLOADON (SETQ LOADDBFLG 'YES))
(DBSAVEON (SETQ SAVEDBFLG 'YES))
(DBLOADOFF (SETQ LOADDBFLG 'NO))
(DBSAVEOFF (SETQ SAVEDBFLG 'NO))
(DBLOADASK (SETQ LOADDBFLG 'ASK))
(DBSAVEASK (SETQ SAVEDBFLG 'ASK))
(DBFILEON (PUTPROP FILE 'DATABASE 'YES))
(DBFILEOFF (PUTPROP FILE 'DATABASE 'NO))
(DBFILEASK (PUTPROP FILE 'DATABASE 'ASK))
(DUMPDB
(printout T .FONT LAMBDAFONT
"Dumping the Masterscope Database for file " FILE
.FONT DEFAULTFONT T)
(DUMPDB FILE))
(LOADDB
(printout T .FONT LAMBDAFONT
"Loading the Masterscope Database for file " FILE
.FONT DEFAULTFONT T)
(LOADDB FILE))
(COMPILE
(printout T .FONT LAMBDAFONT "Compiling..." .FONT
DEFAULTFONT T)
(if (EQ COMSTYPE 'FILES)
then (APPLY* (FUNCTION COMPILEFILES)
FILE)
(Manager.REMOVE.DUPLICATE.ADVICE FILE)
else (PRINT (CL:COMPILE ITEM)
T)))
(CL:COMPILE-FILE
(printout T .FONT LAMBDAFONT
"Compiling using compile-file..." .FONT
DEFAULTFONT T)
(CL:COMPILE-FILE FILE)
(Manager.REMOVE.DUPLICATE.ADVICE FILE))
(REMOVE (DELDEF FILE 'FILE))
(CHANGES (* ; "FILE is NIL from main menu")
(Manager.CHANGED? FILE))
(FILES?
(printout T .FONT LAMBDAFONT "Files and their changes:"
.FONT DEFAULTFONT T)
(FILES?)))
(DB (CL:FORMAT T "~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a"
SAVEDBFLG LOADDBFLG))
(DBFILE
(CL:FORMAT T "~&The DATABASE prop for ~a is: ~a" FILE (GETPROP FILE
'DATABASE))
(CL:FORMAT T "~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a"
SAVEDBFLG LOADDBFLG))
(DBON
(SETQ LOADDBFLG 'ON)
(SETQ SAVEDBFLG 'ON))
(DBOFF
(SETQ LOADDBFLG 'NO)
(SETQ SAVEDBFLG 'NO))
(DBASK
(SETQ LOADDBFLG 'ASK)
(SETQ SAVEDBFLG 'ASK))
(DBLOADON (SETQ LOADDBFLG 'YES))
(DBSAVEON (SETQ SAVEDBFLG 'YES))
(DBLOADOFF (SETQ LOADDBFLG 'NO))
(DBSAVEOFF (SETQ SAVEDBFLG 'NO))
(DBLOADASK (SETQ LOADDBFLG 'ASK))
(DBSAVEASK (SETQ SAVEDBFLG 'ASK))
(DBFILEON (PUTPROP FILE 'DATABASE 'YES))
(DBFILEOFF (PUTPROP FILE 'DATABASE 'NO))
(DBFILEASK (PUTPROP FILE 'DATABASE 'ASK))
(DUMPDB
(printout T .FONT LAMBDAFONT "Dumping the Masterscope Database for file "
FILE .FONT DEFAULTFONT T)
(DUMPDB FILE))
(LOADDB
(printout T .FONT LAMBDAFONT "Loading the Masterscope Database for file "
FILE .FONT DEFAULTFONT T)
(LOADDB FILE))
(COMPILE
(printout T .FONT LAMBDAFONT "Compiling..." .FONT DEFAULTFONT T)
(if (EQ COMSTYPE 'FILES)
then (APPLY* (FUNCTION COMPILEFILES)
FILE)
(Manager.REMOVE.DUPLICATE.ADVICE FILE)
else (PRINT (CL:COMPILE ITEM)
T)))
(CL:COMPILE-FILE
(printout T .FONT LAMBDAFONT "Compiling using compile-file..." .FONT
DEFAULTFONT T)
(CL:COMPILE-FILE FILE)
(Manager.REMOVE.DUPLICATE.ADVICE FILE))
(REMOVE (DELDEF FILE 'FILE))
(CHANGES (* ; "FILE is NIL from main menu")
(Manager.CHANGED? FILE))
(FILES?
(printout T .FONT LAMBDAFONT "Files and their changes:" .FONT DEFAULTFONT T)
(FILES?)))
(* ;; "Relase the window now, but get ready to shrink it back down unless another manager command comes along and need the window.")
(* ;; "Relase the window now, but get ready to shrink it back down unless another manager command comes along and need the window.")
(if [NOT (FMEMB COMMAND
'(BREAK TRACE UNBREAK CHANGED DELETED DEFINED
UNMARK SEE LIST HARDCOPY REMOVE QUIT
RESET RENAME COPY NIL]
then (CL:FORMAT T "~&------"))))
(if [NOT (FMEMB COMMAND
'(BREAK TRACE UNBREAK CHANGED DELETED DEFINED UNMARK SEE LIST
HARDCOPY REMOVE QUIT RESET RENAME COPY NIL]
then (CL:FORMAT T "~&------"))))
(* ;;
(* ;;
 "Shink the dialog window after ten seconds so long as its not in use by another manager command.")
(if ACTIVITY-WINDOW-WAS-SHRUNK
then (if (FMEMB COMMAND
'(SHOWDEF SHOWADVICE PV PF PL CLDESCRIBE CLDOC
FIELDS ARGS DB DBFILE MAKEFILE NEW FAST
COMMON-MAKEFILE CLEANUPT CLEANUPC CLEANUP
ANALYZE CHECK DESCRIBE CHANGES FILES?
COMPILE CL:COMPILE NIL))
then (DISMISS 10000)
else (DISMISS NIL))
(if (EQ ACTIVITY-WINDOW (CAR MANAGER-WINDOWS))
then (SHRINKW T])]
'(,COMMAND ,ITEM ,COMSTYPE ,FILE ,MENU]
'NAME
'MANAGER-COMMAND))
NIL])
(if ACTIVITY-WINDOW-WAS-SHRUNK
then (if (FMEMB COMMAND
'(SHOWDEF SHOWADVICE PV PF PL CLDESCRIBE CLDOC FIELDS ARGS DB DBFILE
MAKEFILE NEW FAST COMMON-MAKEFILE CLEANUPT CLEANUPC CLEANUP
ANALYZE CHECK DESCRIBE CHANGES FILES? COMPILE CL:COMPILE NIL))
then (DISMISS 10000)
else (DISMISS NIL))
(if (EQ ACTIVITY-WINDOW (CAR MANAGER-WINDOWS))
then (SHRINKW T])])
(Manager.HIGHLIGHT
[LAMBDA (ITEM MENU ON) (* ; "Edited 31-Jul-87 17:33 by raf")
@ -1772,21 +1708,22 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(ADDTOVAR LAMA )
)
(PUTPROPS MANAGER COPYRIGHT (NONE))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (25606 102972 (MANAGER 25616 . 26415) (MANAGER.RESET 26417 . 27931) (Manager.ADDADV
27933 . 29286) (Manager.ADDTOFILES? 29288 . 29566) (Manager.ALTERMARKING 29568 . 31178) (
Manager.ANCHORED-SET-POSITION 31180 . 32283) (Manager.DO.COMMAND 32285 . 63115) (Manager.HIGHLIGHT
63117 . 63414) (Manager.PROMPT 63416 . 63729) (Manager.WINDOW 63731 . 64364) (
Manager.insurefilehighlights 64366 . 65437) (Manager.CHANGED? 65439 . 65988) (Manager.CHECKFILE 65990
. 67089) (Manager.COLLECTCOMS 67091 . 68529) (Manager.COMS.WSF 68531 . 71201) (Manager.COMSOPEN 71203
. 75941) (Manager.COMSUPDATE 75943 . 77035) (Manager.HIGHLIGHTED 77037 . 77343) (
Manager.INSUREHIGHLIGHTS 77345 . 77903) (Manager.FILECHANGES 77905 . 78204) (Manager.FILELSTCHANGED?
78206 . 78534) (Manager.FILESUBTYPES 78536 . 79174) (Manager.GET.ENVIRONMENT 79176 . 81714) (
Manager.GETFILE 81716 . 84030) (Manager.INTITLE? 84032 . 84710) (Manager.MAIN.WSF 84712 . 87356) (
Manager.MAINCLOSE 87358 . 88468) (Manager.MAINMENUITEMS 88470 . 89547) (Manager.MAINOPEN 89549 . 94942
) (Manager.MAINUPDATE 94944 . 95580) (Manager.MAKEFILE.ADV 95582 . 96618) (Manager.MENUCOLUMNS 96620
. 97424) (Manager.MENUHASITEM 97426 . 97783) (Manager.MENUITEMS 97785 . 98030) (
Manager.REMOVE.DUPLICATE.ADVICE 98032 . 99638) (Manager.RESETSUBITEMS 99640 . 100877) (
Manager.SET-ANCHOR 100879 . 101198) (Manager.SORT.COMS 101200 . 101732) (Manager.SORTBYCOLUMN 101734
. 102970)))))
(FILEMAP (NIL (25632 93132 (MANAGER 25642 . 26441) (MANAGER.RESET 26443 . 27957) (Manager.ADDADV 27959
. 29312) (Manager.ADDTOFILES? 29314 . 29592) (Manager.ALTERMARKING 29594 . 31204) (
Manager.ANCHORED-SET-POSITION 31206 . 32309) (Manager.DO.COMMAND 32311 . 33918) (
Manager.DO.COMMAND.PROCFN 33920 . 53275) (Manager.HIGHLIGHT 53277 . 53574) (Manager.PROMPT 53576 .
53889) (Manager.WINDOW 53891 . 54524) (Manager.insurefilehighlights 54526 . 55597) (Manager.CHANGED?
55599 . 56148) (Manager.CHECKFILE 56150 . 57249) (Manager.COLLECTCOMS 57251 . 58689) (Manager.COMS.WSF
58691 . 61361) (Manager.COMSOPEN 61363 . 66101) (Manager.COMSUPDATE 66103 . 67195) (
Manager.HIGHLIGHTED 67197 . 67503) (Manager.INSUREHIGHLIGHTS 67505 . 68063) (Manager.FILECHANGES 68065
. 68364) (Manager.FILELSTCHANGED? 68366 . 68694) (Manager.FILESUBTYPES 68696 . 69334) (
Manager.GET.ENVIRONMENT 69336 . 71874) (Manager.GETFILE 71876 . 74190) (Manager.INTITLE? 74192 . 74870
) (Manager.MAIN.WSF 74872 . 77516) (Manager.MAINCLOSE 77518 . 78628) (Manager.MAINMENUITEMS 78630 .
79707) (Manager.MAINOPEN 79709 . 85102) (Manager.MAINUPDATE 85104 . 85740) (Manager.MAKEFILE.ADV 85742
. 86778) (Manager.MENUCOLUMNS 86780 . 87584) (Manager.MENUHASITEM 87586 . 87943) (Manager.MENUITEMS
87945 . 88190) (Manager.REMOVE.DUPLICATE.ADVICE 88192 . 89798) (Manager.RESETSUBITEMS 89800 . 91037) (
Manager.SET-ANCHOR 91039 . 91358) (Manager.SORT.COMS 91360 . 91892) (Manager.SORTBYCOLUMN 91894 .
93130)))))
STOP

BIN
lispusers/MANAGER.DFASL
View File

Binary file not shown.

178
scripts/copy-all.sh
View File

@ -1,35 +1,151 @@
#!/bin/sh
if [ ! -x run-medley ] ; then
echo run from MEDLEYDIR
exit 1
main() {
# shellcheck source=./loadup-setup.sh
. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
echo ">>>>> START ${script_name}"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/full.sysout "${LOADUP_OUTDIR}" \
| sed -e "s#${MEDLEYDIR}/##g"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/lisp.sysout "${LOADUP_OUTDIR}" \
| sed -e "s#${MEDLEYDIR}/##g"
if [ "${1}" = "-apps" ]; then
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/apps.sysout "${LOADUP_OUTDIR}" \
| sed -e "s#${MEDLEYDIR}/##g"
fi
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/whereis.hash "${LOADUP_OUTDIR}" \
| sed -e "s#${MEDLEYDIR}/##g"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/exports.all "${LOADUP_OUTDIR}" \
| sed -e "s#${MEDLEYDIR}/##g"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/init.dribble "${LOADUP_OUTDIR}" \
| sed -e "s#${MEDLEYDIR}/##g"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/lisp.dribble "${LOADUP_OUTDIR}" \
| sed -e "s#${MEDLEYDIR}/##g"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/full.dribble "${LOADUP_OUTDIR}" \
| sed -e "s#${MEDLEYDIR}/##g"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/whereis.dribble "${LOADUP_OUTDIR}" \
| sed -e "s#${MEDLEYDIR}/##g"
if [ "${1}" = "-apps" ]; then
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/apps.dribble "${LOADUP_OUTDIR}" \
| sed -e "s#${MEDLEYDIR}/##g"
fi
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/RDSYS library \
| sed -e "s#${MEDLEYDIR}/##g"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/RDSYS.LCOM library \
| sed -e "s#${MEDLEYDIR}/##g"
echo "<<<<< END ${script_name}"
echo ""
exit 0
}
# shellcheck disable=SC2164,SC2034
if [ -z "${LOADUP_SCRIPTDIR}" ]
then
#
#
# Some functions to determine what directory this script is being executed from
#
#
get_abs_filename() {
# $1 : relative filename
echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
}
# This function taken from
# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
rreadlink() (
# Execute this function in a *subshell* to localize variables and the effect of `cd`.
target=$1
fname=
targetDir=
CDPATH=
# Try to make the execution environment as predictable as possible:
# All commands below are invoked via `command`, so we must make sure that `command`
# itself is not redefined as an alias or shell function.
# (Note that command is too inconsistent across shells, so we don't use it.)
# `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
# an external utility version of it (e.g, Ubuntu).
# `command` bypasses aliases and shell functions and also finds builtins
# in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
# to happen.
{ \unalias command; \unset -f command; } >/dev/null 2>&1
[ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
while :; do # Resolve potential symlinks until the ultimate target is found.
[ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
fname=$(command basename -- "$target") # Extract filename.
[ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
if [ -L "$fname" ]; then
# Extract [next] target path, which may be defined
# *relative* to the symlink's own directory.
# Note: We parse `ls -l` output to find the symlink target
# which is the only POSIX-compliant, albeit somewhat fragile, way.
target=$(command ls -l "$fname")
target=${target#* -> }
continue # Resolve [next] symlink target.
fi
break # Ultimate target reached.
done
targetDir=$(command pwd -P) # Get canonical dir. path
# Output the ultimate target's canonical path.
# Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
if [ "$fname" = '.' ]; then
command printf '%s\n' "${targetDir%/}"
elif [ "$fname" = '..' ]; then
# Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
# AFTER canonicalization.
command printf '%s\n' "$(command dirname -- "${targetDir}")"
else
command printf '%s\n' "${targetDir%/}/$fname"
fi
)
get_script_dir() {
# call this with $0 (from main script) as its (only) parameter
# if you need to preserve cwd, run this is a subshell since
# it can change cwd
# set -x
local_SCRIPT_PATH="$( get_abs_filename "$1" )";
while [ -h "$local_SCRIPT_PATH" ];
do
cd "$( dirname -- "$local_SCRIPT_PATH"; )";
local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
done
cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
local_SCRIPT_PATH="$( pwd; )";
# set +x
echo "${local_SCRIPT_PATH}"
}
# end of script directory functions
###############################################################################
# figure out the script dir
LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
export LOADUP_SCRIPTDIR
fi
. scripts/loadup-setup.sh
echo ">>>>> START ${script_name}"
./scripts/cpv "${LOADUP_WORKDIR}"/full.sysout "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
./scripts/cpv "${LOADUP_WORKDIR}"/lisp.sysout "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
if [ "${1}" = "-apps" ]; then
./scripts/cpv "${LOADUP_WORKDIR}"/apps.sysout "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
fi
./scripts/cpv "${LOADUP_WORKDIR}"/whereis.hash "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
./scripts/cpv "${LOADUP_WORKDIR}"/exports.all "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
./scripts/cpv "${LOADUP_WORKDIR}"/init.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
./scripts/cpv "${LOADUP_WORKDIR}"/lisp.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
./scripts/cpv "${LOADUP_WORKDIR}"/full.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
./scripts/cpv "${LOADUP_WORKDIR}"/whereis.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
if [ "${1}" = "-apps" ]; then
./scripts/cpv "${LOADUP_WORKDIR}"/apps.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
fi
./scripts/cpv "${LOADUP_WORKDIR}"/RDSYS library | sed -e "s#${MEDLEYDIR}/##g"
./scripts/cpv "${LOADUP_WORKDIR}"/RDSYS.LCOM library | sed -e "s#${MEDLEYDIR}/##g"
echo "<<<<< END ${script_name}"
echo ""
exit 0
main "$@"

127
scripts/copy-db.sh
View File

@ -1,17 +1,118 @@
#!/bin/sh
if [ ! -x run-medley ] ; then
echo run from MEDLEYDIR
exit 1
main() {
# shellcheck source=./loadup-setup.sh
. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
echo ">>>>> START ${script_name}"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/fuller.database "${LOADUP_OUTDIR}"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/fuller.dribble "${LOADUP_OUTDIR}"
echo "<<<<< END ${script_name}"
echo ""
exit 0
}
# shellcheck disable=SC2164,SC2034
if [ -z "${LOADUP_SCRIPTDIR}" ]
then
#
#
# Some functions to determine what directory this script is being executed from
#
#
get_abs_filename() {
# $1 : relative filename
echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
}
# This function taken from
# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
rreadlink() (
# Execute this function in a *subshell* to localize variables and the effect of `cd`.
target=$1
fname=
targetDir=
CDPATH=
# Try to make the execution environment as predictable as possible:
# All commands below are invoked via `command`, so we must make sure that `command`
# itself is not redefined as an alias or shell function.
# (Note that command is too inconsistent across shells, so we don't use it.)
# `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
# an external utility version of it (e.g, Ubuntu).
# `command` bypasses aliases and shell functions and also finds builtins
# in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
# to happen.
{ \unalias command; \unset -f command; } >/dev/null 2>&1
[ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
while :; do # Resolve potential symlinks until the ultimate target is found.
[ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
fname=$(command basename -- "$target") # Extract filename.
[ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
if [ -L "$fname" ]; then
# Extract [next] target path, which may be defined
# *relative* to the symlink's own directory.
# Note: We parse `ls -l` output to find the symlink target
# which is the only POSIX-compliant, albeit somewhat fragile, way.
target=$(command ls -l "$fname")
target=${target#* -> }
continue # Resolve [next] symlink target.
fi
break # Ultimate target reached.
done
targetDir=$(command pwd -P) # Get canonical dir. path
# Output the ultimate target's canonical path.
# Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
if [ "$fname" = '.' ]; then
command printf '%s\n' "${targetDir%/}"
elif [ "$fname" = '..' ]; then
# Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
# AFTER canonicalization.
command printf '%s\n' "$(command dirname -- "${targetDir}")"
else
command printf '%s\n' "${targetDir%/}/$fname"
fi
)
get_script_dir() {
# call this with $0 (from main script) as its (only) parameter
# if you need to preserve cwd, run this is a subshell since
# it can change cwd
# set -x
local_SCRIPT_PATH="$( get_abs_filename "$1" )";
while [ -h "$local_SCRIPT_PATH" ];
do
cd "$( dirname -- "$local_SCRIPT_PATH"; )";
local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
done
cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
local_SCRIPT_PATH="$( pwd; )";
# set +x
echo "${local_SCRIPT_PATH}"
}
# end of script directory functions
###############################################################################
# figure out the script dir
LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
export LOADUP_SCRIPTDIR
fi
. scripts/loadup-setup.sh
echo ">>>>> START ${script_name}"
./scripts/cpv "${LOADUP_WORKDIR}"/fuller.database "${LOADUP_OUTDIR}"
./scripts/cpv "${LOADUP_WORKDIR}"/fuller.dribble "${LOADUP_OUTDIR}"
echo "<<<<< END ${script_name}"
echo ""
exit 0
main "$@"

146
scripts/copy-full.sh
View File

@ -1,24 +1,130 @@
#!/bin/sh
if [ ! -x run-medley ] ; then
echo run from MEDLEYDIR
exit 1
main() {
# shellcheck source=./loadup-setup.sh
. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
echo ">>>>> START ${script_name}"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/full.sysout "${LOADUP_OUTDIR}" \
| sed -e "s#${MEDLEYDIR}/##g"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/lisp.sysout "${LOADUP_OUTDIR}" \
| sed -e "s#${MEDLEYDIR}/##g"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/init.dribble "${LOADUP_OUTDIR}" \
| sed -e "s#${MEDLEYDIR}/##g"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/lisp.dribble "${LOADUP_OUTDIR}" \
| sed -e "s#${MEDLEYDIR}/##g"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/full.dribble "${LOADUP_OUTDIR}" \
| sed -e "s#${MEDLEYDIR}/##g"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/RDSYS library \
| sed -e "s#${MEDLEYDIR}/##g"
/bin/sh "${LOADUP_SCRIPTDIR}/cpv" "${LOADUP_WORKDIR}"/RDSYS.LCOM library \
| sed -e "s#${MEDLEYDIR}/##g"
echo "<<<<< END ${script_name}"
echo ""
exit 0
}
# shellcheck disable=SC2164,SC2034
if [ -z "${LOADUP_SCRIPTDIR}" ]
then
#
#
# Some functions to determine what directory this script is being executed from
#
#
get_abs_filename() {
# $1 : relative filename
echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
}
# This function taken from
# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
rreadlink() (
# Execute this function in a *subshell* to localize variables and the effect of `cd`.
target=$1
fname=
targetDir=
CDPATH=
# Try to make the execution environment as predictable as possible:
# All commands below are invoked via `command`, so we must make sure that `command`
# itself is not redefined as an alias or shell function.
# (Note that command is too inconsistent across shells, so we don't use it.)
# `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
# an external utility version of it (e.g, Ubuntu).
# `command` bypasses aliases and shell functions and also finds builtins
# in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
# to happen.
{ \unalias command; \unset -f command; } >/dev/null 2>&1
[ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
while :; do # Resolve potential symlinks until the ultimate target is found.
[ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
fname=$(command basename -- "$target") # Extract filename.
[ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
if [ -L "$fname" ]; then
# Extract [next] target path, which may be defined
# *relative* to the symlink's own directory.
# Note: We parse `ls -l` output to find the symlink target
# which is the only POSIX-compliant, albeit somewhat fragile, way.
target=$(command ls -l "$fname")
target=${target#* -> }
continue # Resolve [next] symlink target.
fi
break # Ultimate target reached.
done
targetDir=$(command pwd -P) # Get canonical dir. path
# Output the ultimate target's canonical path.
# Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
if [ "$fname" = '.' ]; then
command printf '%s\n' "${targetDir%/}"
elif [ "$fname" = '..' ]; then
# Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
# AFTER canonicalization.
command printf '%s\n' "$(command dirname -- "${targetDir}")"
else
command printf '%s\n' "${targetDir%/}/$fname"
fi
)
get_script_dir() {
# call this with $0 (from main script) as its (only) parameter
# if you need to preserve cwd, run this is a subshell since
# it can change cwd
# set -x
local_SCRIPT_PATH="$( get_abs_filename "$1" )";
while [ -h "$local_SCRIPT_PATH" ];
do
cd "$( dirname -- "$local_SCRIPT_PATH"; )";
local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
done
cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
local_SCRIPT_PATH="$( pwd; )";
# set +x
echo "${local_SCRIPT_PATH}"
}
# end of script directory functions
###############################################################################
# figure out the script dir
LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
export LOADUP_SCRIPTDIR
fi
. scripts/loadup-setup.sh
echo ">>>>> START ${script_name}"
./scripts/cpv "${LOADUP_WORKDIR}"/full.sysout "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
./scripts/cpv "${LOADUP_WORKDIR}"/lisp.sysout "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
./scripts/cpv "${LOADUP_WORKDIR}"/init.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
./scripts/cpv "${LOADUP_WORKDIR}"/lisp.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
./scripts/cpv "${LOADUP_WORKDIR}"/full.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g"
./scripts/cpv "${LOADUP_WORKDIR}"/RDSYS library | sed -e "s#${MEDLEYDIR}/##g"
./scripts/cpv "${LOADUP_WORKDIR}"/RDSYS.LCOM library | sed -e "s#${MEDLEYDIR}/##g"
echo "<<<<< END ${script_name}"
echo ""
exit 0
main "$@"

184
scripts/loadup-all.sh
View File

@ -1,50 +1,146 @@
#!/bin/sh
# shellcheck disable=SC2181
if [ ! -h ./medley ] || [ ! -d ./lispusers ]
main() {
# shellcheck source=./loadup-setup.sh
. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
# look thru args looking to see if -apps, --apps, or -a was specified in args
apps=""
j=1
jmax=$#
while [ "$j" -le "$jmax" ]
do
if [ "$(eval "printf %s \${${j}}")" = "-a" ] || \
[ "$(eval "printf %s \${${j}}")" = "-apps" ] || \
[ "$(eval "printf %s \${${j}}")" = "--apps" ]
then
apps="-apps"
break
fi
done
# Do loadup components
/bin/sh "${LOADUP_SCRIPTDIR}/loadup-init.sh" \
&& /bin/sh "${LOADUP_SCRIPTDIR}/loadup-mid-from-init.sh" \
&& /bin/sh "${LOADUP_SCRIPTDIR}/loadup-lisp-from-mid.sh" \
&& /bin/sh "${LOADUP_SCRIPTDIR}/loadup-full-from-lisp.sh" \
&& { \
if [ -n "${apps}" ]; \
then \
/bin/sh "${LOADUP_SCRIPTDIR}/loadup-apps-from-full.sh"; \
fi; \
} \
&& /bin/sh "${LOADUP_SCRIPTDIR}/loadup-aux.sh" \
&& /bin/sh "${LOADUP_SCRIPTDIR}/copy-all.sh" "${apps}"
if [ $? -eq 0 ]
then
echo "+++++ loadup-all.sh: SUCCESS +++++"
else
echo "----- loadup-all.sh: FAILURE -----"
fi
}
# shellcheck disable=SC2164,SC2034
if [ -z "${LOADUP_SCRIPTDIR}" ]
then
echo "*** ERROR ***"
echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
echo "The cwd ($(pwd)) is not a Medley top-level directory."
echo "Exiting."
exit 1
#
#
# Some functions to determine what directory this script is being executed from
#
#
get_abs_filename() {
# $1 : relative filename
echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
}
# This function taken from
# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
rreadlink() (
# Execute this function in a *subshell* to localize variables and the effect of `cd`.
target=$1
fname=
targetDir=
CDPATH=
# Try to make the execution environment as predictable as possible:
# All commands below are invoked via `command`, so we must make sure that `command`
# itself is not redefined as an alias or shell function.
# (Note that command is too inconsistent across shells, so we don't use it.)
# `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
# an external utility version of it (e.g, Ubuntu).
# `command` bypasses aliases and shell functions and also finds builtins
# in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
# to happen.
{ \unalias command; \unset -f command; } >/dev/null 2>&1
[ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
while :; do # Resolve potential symlinks until the ultimate target is found.
[ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
fname=$(command basename -- "$target") # Extract filename.
[ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
if [ -L "$fname" ]; then
# Extract [next] target path, which may be defined
# *relative* to the symlink's own directory.
# Note: We parse `ls -l` output to find the symlink target
# which is the only POSIX-compliant, albeit somewhat fragile, way.
target=$(command ls -l "$fname")
target=${target#* -> }
continue # Resolve [next] symlink target.
fi
break # Ultimate target reached.
done
targetDir=$(command pwd -P) # Get canonical dir. path
# Output the ultimate target's canonical path.
# Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
if [ "$fname" = '.' ]; then
command printf '%s\n' "${targetDir%/}"
elif [ "$fname" = '..' ]; then
# Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
# AFTER canonicalization.
command printf '%s\n' "$(command dirname -- "${targetDir}")"
else
command printf '%s\n' "${targetDir%/}/$fname"
fi
)
get_script_dir() {
# call this with $0 (from main script) as its (only) parameter
# if you need to preserve cwd, run this is a subshell since
# it can change cwd
# set -x
local_SCRIPT_PATH="$( get_abs_filename "$1" )";
while [ -h "$local_SCRIPT_PATH" ];
do
cd "$( dirname -- "$local_SCRIPT_PATH"; )";
local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
done
cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
local_SCRIPT_PATH="$( pwd; )";
# set +x
echo "${local_SCRIPT_PATH}"
}
# end of script directory functions
###############################################################################
# figure out the script dir
LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
export LOADUP_SCRIPTDIR
fi
# shellcheck source=./loadup-setup.sh
. scripts/loadup-setup.sh
# look thru args looking to see if -apps, --apps, or -a was specified in args
apps=true
j=1
jmax=$#
while [ "$j" -le "$jmax" ]
do
if [ "$(eval "printf %s \${${j}}")" = "-a" ] || \
[ "$(eval "printf %s \${${j}}")" = "-apps" ] || \
[ "$(eval "printf %s \${${j}}")" = "--apps" ]
then
apps="./scripts/loadup-apps-from-full.sh"
break
fi
done
# Do loadup components
./scripts/loadup-init.sh && \
./scripts/loadup-mid-from-init.sh && \
./scripts/loadup-lisp-from-mid.sh && \
./scripts/loadup-full-from-lisp.sh && \
${apps} && \
./scripts/loadup-aux.sh && \
./scripts/copy-all.sh "$1"
if [ $? -eq 0 ]
then
echo "+++++ loadup-all.sh: SUCCESS +++++"
else
echo "----- loadup-all.sh: FAILURE -----"
fi
main "$@"

237
scripts/loadup-apps-from-full.sh
View File

@ -1,76 +1,171 @@
#!/bin/sh
if [ ! -h ./medley ] || [ ! -d ./lispusers ]
main() {
# shellcheck source=./loadup-setup.sh
. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
loadup_start
export ROOMSDIR="${MEDLEYDIR}/rooms"
export CLOSDIR="${MEDLEYDIR}/clos"
export NOTECARDSDIR="${MEDLEYDIR}/notecards"
if [ ! -e "${NOTECARDSDIR}" ]
then
NOTECARDSDIR=$(cd "${MEDLEYDIR}/../" && pwd)/notecards
if [ ! -e "${NOTECARDSDIR}" ]
then
NOTECARDSDIR=$(cd "${MEDLEYDIR}/../../" && pwd)/notecards
if [ ! -e "${NOTECARDSDIR}" ]
then
NOTECARDSDIR=""
fi
fi
fi
if [ -z "${NOTECARDSDIR}" ]
then
echo "Error: Cannot find the Notecards directory"
echo "It should be located at ${MEDLEYDIR}/../notecards or"
echo "${MEDLEYDIR}/../../notecards. But its not."
echo "Exiting"
exit 1
fi
cat >"${cmfile}" <<-"EOF"
"
(PROGN
(IL:MEDLEY-INIT-VARS 'IL:GREET)
(IL:DRIBBLE (IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /apps.dribble))))
(IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE ROOMSDIR))(QUOTE /ROOMS)) 'IL:SYSLOAD)
(IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE NOTECARDSDIR))(QUOTE |/system/NOTECARDS.LCOM|)) 'IL:SYSLOAD)
(IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE CLOSDIR))(QUOTE /DEFSYS.DFASL)) 'IL:SYSLOAD)
(IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE MEDLEYDIR))(QUOTE |lispusers/BUTTONS.LCOM|)) 'IL:SYSLOAD)
(IL:LOAD
(IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) (QUOTE /LOADUP-APPS.LCOM))
'IL:SYSLOAD
)
(IL:HARDRESET)
)
SHH
(PROGN
(IL:ENDLOADUP)
(CLOS::LOAD-CLOS)
(IL:|Apps.LOADUP|)
(IL:DRIBBLE)
(IL:MAKESYS
(IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /apps.sysout)))
:APPS)
)
(IL:LOGOUT T)
"
EOF
run_medley "${LOADUP_WORKDIR}/full.sysout"
loadup_finish "apps.sysout" "apps.*"
}
# shellcheck disable=SC2164,SC2034
if [ -z "${LOADUP_SCRIPTDIR}" ]
then
echo "*** ERROR ***"
echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
echo "The cwd ($(pwd)) is not a Medley top-level directory."
echo "Exiting."
exit 1
#
#
# Some functions to determine what directory this script is being executed from
#
#
get_abs_filename() {
# $1 : relative filename
echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
}
# This function taken from
# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
rreadlink() (
# Execute this function in a *subshell* to localize variables and the effect of `cd`.
target=$1
fname=
targetDir=
CDPATH=
# Try to make the execution environment as predictable as possible:
# All commands below are invoked via `command`, so we must make sure that `command`
# itself is not redefined as an alias or shell function.
# (Note that command is too inconsistent across shells, so we don't use it.)
# `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
# an external utility version of it (e.g, Ubuntu).
# `command` bypasses aliases and shell functions and also finds builtins
# in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
# to happen.
{ \unalias command; \unset -f command; } >/dev/null 2>&1
[ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
while :; do # Resolve potential symlinks until the ultimate target is found.
[ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
fname=$(command basename -- "$target") # Extract filename.
[ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
if [ -L "$fname" ]; then
# Extract [next] target path, which may be defined
# *relative* to the symlink's own directory.
# Note: We parse `ls -l` output to find the symlink target
# which is the only POSIX-compliant, albeit somewhat fragile, way.
target=$(command ls -l "$fname")
target=${target#* -> }
continue # Resolve [next] symlink target.
fi
break # Ultimate target reached.
done
targetDir=$(command pwd -P) # Get canonical dir. path
# Output the ultimate target's canonical path.
# Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
if [ "$fname" = '.' ]; then
command printf '%s\n' "${targetDir%/}"
elif [ "$fname" = '..' ]; then
# Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
# AFTER canonicalization.
command printf '%s\n' "$(command dirname -- "${targetDir}")"
else
command printf '%s\n' "${targetDir%/}/$fname"
fi
)
get_script_dir() {
# call this with $0 (from main script) as its (only) parameter
# if you need to preserve cwd, run this is a subshell since
# it can change cwd
# set -x
local_SCRIPT_PATH="$( get_abs_filename "$1" )";
while [ -h "$local_SCRIPT_PATH" ];
do
cd "$( dirname -- "$local_SCRIPT_PATH"; )";
local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
done
cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
local_SCRIPT_PATH="$( pwd; )";
# set +x
echo "${local_SCRIPT_PATH}"
}
# end of script directory functions
###############################################################################
# figure out the script dir
LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
export LOADUP_SCRIPTDIR
fi
# shellcheck source=./loadup-setup.sh
. scripts/loadup-setup.sh
loadup_start
export ROOMSDIR="${MEDLEYDIR}/rooms"
export CLOSDIR="${MEDLEYDIR}/clos"
export NOTECARDSDIR="${MEDLEYDIR}/notecards"
if [ ! -e "${NOTECARDSDIR}" ]
then
NOTECARDSDIR=$(cd "${MEDLEYDIR}/../" && pwd)/notecards
if [ ! -e "${NOTECARDSDIR}" ]
then
NOTECARDSDIR=$(cd "${MEDLEYDIR}/../../" && pwd)/notecards
if [ ! -e "${NOTECARDSDIR}" ]
then
NOTECARDSDIR=""
fi
fi
fi
if [ -z "${NOTECARDSDIR}" ]
then
echo "Error: Cannot find the Notecards directory"
echo "It should be located at ${MEDLEYDIR}/../notecards or"
echo "${MEDLEYDIR}/../../notecards. But its not."
echo "Exiting"
exit 1
fi
cat >"${cmfile}" <<"EOF"
"
(PROGN
(IL:MEDLEY-INIT-VARS 'IL:GREET)
(IL:DRIBBLE (IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /apps.dribble))))
(IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE ROOMSDIR))(QUOTE /ROOMS)) 'IL:SYSLOAD)
(IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE NOTECARDSDIR))(QUOTE |/system/NOTECARDS.LCOM|)) 'IL:SYSLOAD)
(IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE CLOSDIR))(QUOTE /DEFSYS.DFASL)) 'IL:SYSLOAD)
(IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE MEDLEYDIR))(QUOTE |lispusers/BUTTONS.LCOM|)) 'IL:SYSLOAD)
(IL:LOAD
(IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) (QUOTE /LOADUP-APPS.LCOM))
'IL:SYSLOAD
)
(IL:HARDRESET)
)
SHH
(PROGN
(IL:ENDLOADUP)
(CLOS::LOAD-CLOS)
(IL:|Apps.LOADUP|)
(IL:DRIBBLE)
(IL:MAKESYS
(IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /apps.sysout)))
:APPS)
)
(IL:LOGOUT T)
"
EOF
run_medley "${LOADUP_WORKDIR}/full.sysout"
loadup_finish "apps.sysout" "apps.*"
main "$@"

161
scripts/loadup-aux.sh
View File

@ -1,36 +1,135 @@
#!/bin/sh
if [ ! -h ./medley ] || [ ! -d ./lispusers ]
main() {
# shellcheck source=./loadup-setup.sh
. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
loadup_start
cat >"${cmfile}" <<-"EOF"
"
(PROG
((WORKDIR (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_WORKDIR)) (QUOTE /))))
(IL:MEDLEY-INIT-VARS)
(IL:LOAD(QUOTE MEDLEY-UTILS))
(DRIBBLE (QUOTE {DSK}<TMP>FOOBAR))
(IL:MAKE-EXPORTS-ALL (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE exports.all))))
(DRIBBLE)
(IL:MAKE-WHEREIS-HASH
(IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.dribble)))
(IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.hash-tmp)))
(IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.hash)))
)
(IL:LOGOUT T)
)
"
EOF
run_medley "${LOADUP_WORKDIR}/full.sysout"
loadup_finish "whereis.hash" "whereis.hash" "exports.all"
}
# shellcheck disable=SC2164,SC2034
if [ -z "${LOADUP_SCRIPTDIR}" ]
then
echo "*** ERROR ***"
echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
echo "The cwd ($(pwd)) is not a Medley top-level directory."
echo "Exiting."
exit 1
#
#
# Some functions to determine what directory this script is being executed from
#
#
get_abs_filename() {
# $1 : relative filename
echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
}
# This function taken from
# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
rreadlink() (
# Execute this function in a *subshell* to localize variables and the effect of `cd`.
target=$1
fname=
targetDir=
CDPATH=
# Try to make the execution environment as predictable as possible:
# All commands below are invoked via `command`, so we must make sure that `command`
# itself is not redefined as an alias or shell function.
# (Note that command is too inconsistent across shells, so we don't use it.)
# `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
# an external utility version of it (e.g, Ubuntu).
# `command` bypasses aliases and shell functions and also finds builtins
# in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
# to happen.
{ \unalias command; \unset -f command; } >/dev/null 2>&1
[ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
while :; do # Resolve potential symlinks until the ultimate target is found.
[ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
fname=$(command basename -- "$target") # Extract filename.
[ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
if [ -L "$fname" ]; then
# Extract [next] target path, which may be defined
# *relative* to the symlink's own directory.
# Note: We parse `ls -l` output to find the symlink target
# which is the only POSIX-compliant, albeit somewhat fragile, way.
target=$(command ls -l "$fname")
target=${target#* -> }
continue # Resolve [next] symlink target.
fi
break # Ultimate target reached.
done
targetDir=$(command pwd -P) # Get canonical dir. path
# Output the ultimate target's canonical path.
# Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
if [ "$fname" = '.' ]; then
command printf '%s\n' "${targetDir%/}"
elif [ "$fname" = '..' ]; then
# Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
# AFTER canonicalization.
command printf '%s\n' "$(command dirname -- "${targetDir}")"
else
command printf '%s\n' "${targetDir%/}/$fname"
fi
)
get_script_dir() {
# call this with $0 (from main script) as its (only) parameter
# if you need to preserve cwd, run this is a subshell since
# it can change cwd
# set -x
local_SCRIPT_PATH="$( get_abs_filename "$1" )";
while [ -h "$local_SCRIPT_PATH" ];
do
cd "$( dirname -- "$local_SCRIPT_PATH"; )";
local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
done
cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
local_SCRIPT_PATH="$( pwd; )";
# set +x
echo "${local_SCRIPT_PATH}"
}
# end of script directory functions
###############################################################################
# figure out the script dir
LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
export LOADUP_SCRIPTDIR
fi
# shellcheck source=./loadup-setup.sh
. scripts/loadup-setup.sh
loadup_start
cat >"${cmfile}" <<"EOF"
"
(PROG
((WORKDIR (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_WORKDIR)) (QUOTE /))))
(IL:MEDLEY-INIT-VARS)
(IL:LOAD(QUOTE MEDLEY-UTILS))
(IL:MAKE-EXPORTS-ALL (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE exports.all))))
(IL:MAKE-WHEREIS-HASH
(IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.dribble)))
(IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.hash-tmp)))
(IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.hash)))
)
(IL:LOGOUT T)
)
"
EOF
run_medley "${LOADUP_WORKDIR}/full.sysout"
loadup_finish "whereis.hash" "whereis.hash" "exports.all"
main "$@"

177
scripts/loadup-db-from-full.sh
View File

@ -1,46 +1,141 @@
#!/bin/sh
if [ ! -h ./medley ] || [ ! -d ./lispusers ]
main() {
# shellcheck source=./loadup-setup.sh
. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
loadup_start
SYSOUT="${MEDLEYDIR}/loadups/full.sysout"
if [ ! -f "${SYSOUT}" ];
then
echo "Error: cannot find ${SYSOUT}. Exiting."
exit 1
fi
cat >"${cmfile}" <<-"EOF"
"
(PROG
((WORKDIR (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_WORKDIR)) (QUOTE /))))
(IL:MEDLEY-INIT-VARS)
(IL:FILESLOAD MEDLEY-UTILS)
(SETQ IL:DIRECTORIES (CONS (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) IL:DIRECTORIES))
(IL:MAKE-FULLER-DB
(IL:CONCAT WORKDIR (IL:L-CASE (QUOTE fuller.dribble)))
(IL:CONCAT WORKDIR (IL:L-CASE (QUOTE fuller.database)))
(IL:CONCAT WORKDIR (IL:L-CASE (QUOTE fuller.sysout)))
)
(IL:LOGOUT T)
)
"
EOF
run_medley "${SYSOUT}"
loadup_finish "fuller.database" "fuller*"
}
# shellcheck disable=SC2164,SC2034
if [ -z "${LOADUP_SCRIPTDIR}" ]
then
echo "*** ERROR ***"
echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
echo "The cwd ($(pwd)) is not a Medley top-level directory."
echo "Exiting."
exit 1
#
#
# Some functions to determine what directory this script is being executed from
#
#
get_abs_filename() {
# $1 : relative filename
echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
}
# This function taken from
# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
rreadlink() (
# Execute this function in a *subshell* to localize variables and the effect of `cd`.
target=$1
fname=
targetDir=
CDPATH=
# Try to make the execution environment as predictable as possible:
# All commands below are invoked via `command`, so we must make sure that `command`
# itself is not redefined as an alias or shell function.
# (Note that command is too inconsistent across shells, so we don't use it.)
# `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
# an external utility version of it (e.g, Ubuntu).
# `command` bypasses aliases and shell functions and also finds builtins
# in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
# to happen.
{ \unalias command; \unset -f command; } >/dev/null 2>&1
[ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
while :; do # Resolve potential symlinks until the ultimate target is found.
[ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
fname=$(command basename -- "$target") # Extract filename.
[ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
if [ -L "$fname" ]; then
# Extract [next] target path, which may be defined
# *relative* to the symlink's own directory.
# Note: We parse `ls -l` output to find the symlink target
# which is the only POSIX-compliant, albeit somewhat fragile, way.
target=$(command ls -l "$fname")
target=${target#* -> }
continue # Resolve [next] symlink target.
fi
break # Ultimate target reached.
done
targetDir=$(command pwd -P) # Get canonical dir. path
# Output the ultimate target's canonical path.
# Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
if [ "$fname" = '.' ]; then
command printf '%s\n' "${targetDir%/}"
elif [ "$fname" = '..' ]; then
# Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
# AFTER canonicalization.
command printf '%s\n' "$(command dirname -- "${targetDir}")"
else
command printf '%s\n' "${targetDir%/}/$fname"
fi
)
get_script_dir() {
# call this with $0 (from main script) as its (only) parameter
# if you need to preserve cwd, run this is a subshell since
# it can change cwd
# set -x
local_SCRIPT_PATH="$( get_abs_filename "$1" )";
while [ -h "$local_SCRIPT_PATH" ];
do
cd "$( dirname -- "$local_SCRIPT_PATH"; )";
local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
done
cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
local_SCRIPT_PATH="$( pwd; )";
# set +x
echo "${local_SCRIPT_PATH}"
}
# end of script directory functions
###############################################################################
# figure out the script dir
LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
export LOADUP_SCRIPTDIR
fi
# shellcheck source=./loadup-setup.sh
. scripts/loadup-setup.sh
loadup_start
SYSOUT="${MEDLEYDIR}/loadups/full.sysout"
if [ ! -f "${SYSOUT}" ];
then
echo "Error: cannot find ${SYSOUT}. Exiting."
exit 1
fi
cat >"${cmfile}" <<"EOF"
"
(PROG
((WORKDIR (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_WORKDIR)) (QUOTE /))))
(IL:MEDLEY-INIT-VARS)
(IL:FILESLOAD MEDLEY-UTILS)
(SETQ IL:DIRECTORIES (CONS (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) IL:DIRECTORIES))
(IL:MAKE-FULLER-DB
(IL:CONCAT WORKDIR (IL:L-CASE (QUOTE fuller.dribble)))
(IL:CONCAT WORKDIR (IL:L-CASE (QUOTE fuller.database)))
(IL:CONCAT WORKDIR (IL:L-CASE (QUOTE fuller.sysout)))
)
(IL:LOGOUT T)
)
"
EOF
run_medley "${SYSOUT}"
loadup_finish "fuller.database" "fuller*"
main "$@"

131
scripts/loadup-db.sh
View File

@ -1,26 +1,121 @@
#!/bin/sh
# shellcheck disable=SC2181
if [ ! -h ./medley ] || [ ! -d ./lispusers ]
main () {
# shellcheck source=./loadup-setup.sh
. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
/bin/sh "${LOADUP_SCRIPTDIR}/loadup-db-from-full.sh" \
&& /bin/sh "${LOADUP_SCRIPTDIR}/copy-db.sh"
# shellcheck disable=SC2181
if [ $? -eq 0 ];
then
echo "+++++ loadup-db.sh: SUCCESS +++++"
else
echo "----- loadup-db.sh: FAILURE -----"
fi
}
# shellcheck disable=SC2164,SC2034
if [ -z "${LOADUP_SCRIPTDIR}" ]
then
echo "*** ERROR ***"
echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
echo "The cwd ($(pwd)) is not a Medley top-level directory."
echo "Exiting."
exit 1
#
#
# Some functions to determine what directory this script is being executed from
#
#
get_abs_filename() {
# $1 : relative filename
echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
}
# This function taken from
# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
rreadlink() (
# Execute this function in a *subshell* to localize variables and the effect of `cd`.
target=$1
fname=
targetDir=
CDPATH=
# Try to make the execution environment as predictable as possible:
# All commands below are invoked via `command`, so we must make sure that `command`
# itself is not redefined as an alias or shell function.
# (Note that command is too inconsistent across shells, so we don't use it.)
# `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
# an external utility version of it (e.g, Ubuntu).
# `command` bypasses aliases and shell functions and also finds builtins
# in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
# to happen.
{ \unalias command; \unset -f command; } >/dev/null 2>&1
[ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
while :; do # Resolve potential symlinks until the ultimate target is found.
[ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
fname=$(command basename -- "$target") # Extract filename.
[ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
if [ -L "$fname" ]; then
# Extract [next] target path, which may be defined
# *relative* to the symlink's own directory.
# Note: We parse `ls -l` output to find the symlink target
# which is the only POSIX-compliant, albeit somewhat fragile, way.
target=$(command ls -l "$fname")
target=${target#* -> }
continue # Resolve [next] symlink target.
fi
break # Ultimate target reached.
done
targetDir=$(command pwd -P) # Get canonical dir. path
# Output the ultimate target's canonical path.
# Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
if [ "$fname" = '.' ]; then
command printf '%s\n' "${targetDir%/}"
elif [ "$fname" = '..' ]; then
# Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
# AFTER canonicalization.
command printf '%s\n' "$(command dirname -- "${targetDir}")"
else
command printf '%s\n' "${targetDir%/}/$fname"
fi
)
get_script_dir() {
# call this with $0 (from main script) as its (only) parameter
# if you need to preserve cwd, run this is a subshell since
# it can change cwd
# set -x
local_SCRIPT_PATH="$( get_abs_filename "$1" )";
while [ -h "$local_SCRIPT_PATH" ];
do
cd "$( dirname -- "$local_SCRIPT_PATH"; )";
local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
done
cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
local_SCRIPT_PATH="$( pwd; )";
# set +x
echo "${local_SCRIPT_PATH}"
}
# end of script directory functions
###############################################################################
# figure out the script dir
LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
export LOADUP_SCRIPTDIR
fi
# shellcheck source=./loadup-setup.sh
. scripts/loadup-setup.sh
./scripts/loadup-db-from-full.sh && ./scripts/copy-db.sh
if [ $? -eq 0 ];
then
echo "+++++ loadup-db.sh: SUCCESS +++++"
else
echo "----- loadup-db.sh: FAILURE -----"
fi
main "$@"

160
scripts/loadup-full-from-lisp.sh
View File

@ -1,38 +1,132 @@
#!/bin/sh
if [ ! -h ./medley ] || [ ! -d ./lispusers ]
main() {
# shellcheck source=./loadup-setup.sh
. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
loadup_start
cat >"${cmfile}" <<-"EOF"
"
(PROGN
(IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR))(QUOTE /LOADUP-FULL.LCOM)))
(IL:LOADUP-FULL (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /full.dribble))))
(IL:HARDRESET)
)
SHH
(PROGN
(IL:ENDLOADUP)
(IL:MAKESYS (IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /full.sysout))) :FULL))
(IL:LOGOUT T)
)
"
EOF
run_medley "${LOADUP_WORKDIR}/lisp.sysout"
loadup_finish "full.sysout" "full.*"
}
# shellcheck disable=SC2164,SC2034
if [ -z "${LOADUP_SCRIPTDIR}" ]
then
echo "*** ERROR ***"
echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
echo "The cwd ($(pwd)) is not a Medley top-level directory."
echo "Exiting."
exit 1
#
#
# Some functions to determine what directory this script is being executed from
#
#
get_abs_filename() {
# $1 : relative filename
echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
}
# This function taken from
# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
rreadlink() (
# Execute this function in a *subshell* to localize variables and the effect of `cd`.
target=$1
fname=
targetDir=
CDPATH=
# Try to make the execution environment as predictable as possible:
# All commands below are invoked via `command`, so we must make sure that `command`
# itself is not redefined as an alias or shell function.
# (Note that command is too inconsistent across shells, so we don't use it.)
# `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
# an external utility version of it (e.g, Ubuntu).
# `command` bypasses aliases and shell functions and also finds builtins
# in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
# to happen.
{ \unalias command; \unset -f command; } >/dev/null 2>&1
[ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
while :; do # Resolve potential symlinks until the ultimate target is found.
[ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
fname=$(command basename -- "$target") # Extract filename.
[ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
if [ -L "$fname" ]; then
# Extract [next] target path, which may be defined
# *relative* to the symlink's own directory.
# Note: We parse `ls -l` output to find the symlink target
# which is the only POSIX-compliant, albeit somewhat fragile, way.
target=$(command ls -l "$fname")
target=${target#* -> }
continue # Resolve [next] symlink target.
fi
break # Ultimate target reached.
done
targetDir=$(command pwd -P) # Get canonical dir. path
# Output the ultimate target's canonical path.
# Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
if [ "$fname" = '.' ]; then
command printf '%s\n' "${targetDir%/}"
elif [ "$fname" = '..' ]; then
# Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
# AFTER canonicalization.
command printf '%s\n' "$(command dirname -- "${targetDir}")"
else
command printf '%s\n' "${targetDir%/}/$fname"
fi
)
get_script_dir() {
# call this with $0 (from main script) as its (only) parameter
# if you need to preserve cwd, run this is a subshell since
# it can change cwd
# set -x
local_SCRIPT_PATH="$( get_abs_filename "$1" )";
while [ -h "$local_SCRIPT_PATH" ];
do
cd "$( dirname -- "$local_SCRIPT_PATH"; )";
local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
done
cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
local_SCRIPT_PATH="$( pwd; )";
# set +x
echo "${local_SCRIPT_PATH}"
}
# end of script directory functions
###############################################################################
# figure out the script dir
LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
export LOADUP_SCRIPTDIR
fi
# shellcheck source=./loadup-setup.sh
. scripts/loadup-setup.sh
loadup_start
cat >"${cmfile}" <<"EOF"
"
(PROGN
(IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR))(QUOTE /LOADUP-FULL.LCOM)))
(IL:LOADUP-FULL (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /full.dribble))))
(IL:HARDRESET)
)
SHH
(PROGN
(IL:ENDLOADUP)
(IL:MAKESYS (IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /full.sysout))) :FULL))
(IL:LOGOUT T)
)
"
EOF
run_medley "${LOADUP_WORKDIR}/lisp.sysout"
loadup_finish "full.sysout" "full.*"
main "$@"

140
scripts/loadup-full.sh
View File

@ -1,29 +1,121 @@
#!/bin/sh
# shellcheck disable=SC2181
if [ ! -h ./medley ] || [ ! -d ./lispusers ]
main() {
# shellcheck source=./loadup-setup.sh
. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
/bin/sh "${LOADUP_SCRIPTDIR}/loadup-init.sh" \
&& /bin/sh "${LOADUP_SCRIPTDIR}/loadup-mid-from-init.sh" \
&& /bin/sh "${LOADUP_SCRIPTDIR}/loadup-lisp-from-mid.sh" \
&& /bin/sh "${LOADUP_SCRIPTDIR}/loadup-full-from-lisp.sh" \
&& /bin/sh "${LOADUP_SCRIPTDIR}/copy-full.sh" ;
# shellcheck disable=SC2181
if [ $? -eq 0 ];
then
echo "+++++ loadup-full.sh: SUCCESS +++++"
else
echo "----- loadup-full.sh: FAILURE -----"
fi
}
# shellcheck disable=SC2164,SC2034
if [ -z "${LOADUP_SCRIPTDIR}" ]
then
echo "*** ERROR ***"
echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
echo "The cwd ($(pwd)) is not a Medley top-level directory."
echo "Exiting."
exit 1
#
#
# Some functions to determine what directory this script is being executed from
#
#
get_abs_filename() {
# $1 : relative filename
echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
}
# This function taken from
# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
rreadlink() (
# Execute this function in a *subshell* to localize variables and the effect of `cd`.
target=$1
fname=
targetDir=
CDPATH=
# Try to make the execution environment as predictable as possible:
# All commands below are invoked via `command`, so we must make sure that `command`
# itself is not redefined as an alias or shell function.
# (Note that command is too inconsistent across shells, so we don't use it.)
# `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
# an external utility version of it (e.g, Ubuntu).
# `command` bypasses aliases and shell functions and also finds builtins
# in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
# to happen.
{ \unalias command; \unset -f command; } >/dev/null 2>&1
[ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
while :; do # Resolve potential symlinks until the ultimate target is found.
[ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
fname=$(command basename -- "$target") # Extract filename.
[ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
if [ -L "$fname" ]; then
# Extract [next] target path, which may be defined
# *relative* to the symlink's own directory.
# Note: We parse `ls -l` output to find the symlink target
# which is the only POSIX-compliant, albeit somewhat fragile, way.
target=$(command ls -l "$fname")
target=${target#* -> }
continue # Resolve [next] symlink target.
fi
break # Ultimate target reached.
done
targetDir=$(command pwd -P) # Get canonical dir. path
# Output the ultimate target's canonical path.
# Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
if [ "$fname" = '.' ]; then
command printf '%s\n' "${targetDir%/}"
elif [ "$fname" = '..' ]; then
# Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
# AFTER canonicalization.
command printf '%s\n' "$(command dirname -- "${targetDir}")"
else
command printf '%s\n' "${targetDir%/}/$fname"
fi
)
get_script_dir() {
# call this with $0 (from main script) as its (only) parameter
# if you need to preserve cwd, run this is a subshell since
# it can change cwd
# set -x
local_SCRIPT_PATH="$( get_abs_filename "$1" )";
while [ -h "$local_SCRIPT_PATH" ];
do
cd "$( dirname -- "$local_SCRIPT_PATH"; )";
local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
done
cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
local_SCRIPT_PATH="$( pwd; )";
# set +x
echo "${local_SCRIPT_PATH}"
}
# end of script directory functions
###############################################################################
# figure out the script dir
LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
export LOADUP_SCRIPTDIR
fi
# shellcheck source=./loadup-setup.sh
. ./scripts/loadup-setup.sh
./scripts/loadup-init.sh && \
./scripts/loadup-mid-from-init.sh && \
./scripts/loadup-lisp-from-mid.sh && \
./scripts/loadup-full-from-lisp.sh && \
./scripts/copy-full.sh
if [ $? -eq 0 ];
then
echo "+++++ loadup-full.sh: SUCCESS +++++"
else
echo "----- loadup-full.sh: FAILURE -----"
fi
main "$@"

185
scripts/loadup-init.sh
View File

@ -1,50 +1,145 @@
#!/bin/sh
if [ ! -h ./medley ] || [ ! -d ./lispusers ]
main() {
# shellcheck source=./loadup-setup.sh
. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
loadup_start
cat >"${cmfile}" <<-"EOF"
(* "make init files; this file is loaded as a 'greet' file by scripts/loadup-init.sh")
(SETQ MEDLEYDIR NIL)
(LOAD (CONCAT (UNIX-GETENV "MEDLEYDIR") "/sources/MEDLEYDIR.LCOM"))
(MEDLEY-INIT-VARS)
(CNDIR (UNIX-GETENV "LOADUP_WORKDIR"))
(DRIBBLE "init.dribble")
(UNADVISE)
(ADVISE 'PAGEFULLFN '(RETURN))
(ADVISE '(ERROR IN \DO-DEFINE-FILE-INFO) '(RETURN))
(MOVD? 'NILL 'SETTEMPLATE)
(DEFINEQ (RRE (LAMBDA (X Y) Y)))
(MOVD? 'RRE 'READ-READER-ENVIRONMENT)
(LOAD (CONCAT "{DSK}" (UNIX-GETENV "LOADUP_SOURCEDIR") "/" "MAKEINIT.LCOM"))
(PROG
((WORKDIR (CONCAT "{DSK}" (UNIX-GETENV "LOADUP_WORKDIR") "/"))
(LOADUP-SOURCE-DIR (CONCAT "{DSK}" (UNIX-GETENV "LOADUP_SOURCEDIR") "/"))
)
(SETQ DIRECTORIES (CONS LOADUP-SOURCE-DIR DIRECTORIES))
(RESETLST (RESETSAVE OK.TO.MODIFY.FNS T)
(MAKEINITGREET (CONCAT WORKDIR "init.sysout") (CONCAT WORKDIR "init.dlinit"))
)
)
(DRIBBLE)
(LOGOUT T)
STOP
EOF
run_medley "${LOADUP_SOURCEDIR}/starter.sysout"
loadup_finish "init.dlinit" "init.*" "RDSYS*" "I-NEW*"
}
# shellcheck disable=SC2164,SC2034
if [ -z "${LOADUP_SCRIPTDIR}" ]
then
echo "*** ERROR ***"
echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
echo "The cwd ($(pwd)) is not a Medley top-level directory."
echo "Exiting."
exit 1
#
#
# Some functions to determine what directory this script is being executed from
#
#
get_abs_filename() {
# $1 : relative filename
echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
}
# This function taken from
# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
rreadlink() (
# Execute this function in a *subshell* to localize variables and the effect of `cd`.
target=$1
fname=
targetDir=
CDPATH=
# Try to make the execution environment as predictable as possible:
# All commands below are invoked via `command`, so we must make sure that `command`
# itself is not redefined as an alias or shell function.
# (Note that command is too inconsistent across shells, so we don't use it.)
# `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
# an external utility version of it (e.g, Ubuntu).
# `command` bypasses aliases and shell functions and also finds builtins
# in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
# to happen.
{ \unalias command; \unset -f command; } >/dev/null 2>&1
[ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
while :; do # Resolve potential symlinks until the ultimate target is found.
[ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
fname=$(command basename -- "$target") # Extract filename.
[ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
if [ -L "$fname" ]; then
# Extract [next] target path, which may be defined
# *relative* to the symlink's own directory.
# Note: We parse `ls -l` output to find the symlink target
# which is the only POSIX-compliant, albeit somewhat fragile, way.
target=$(command ls -l "$fname")
target=${target#* -> }
continue # Resolve [next] symlink target.
fi
break # Ultimate target reached.
done
targetDir=$(command pwd -P) # Get canonical dir. path
# Output the ultimate target's canonical path.
# Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
if [ "$fname" = '.' ]; then
command printf '%s\n' "${targetDir%/}"
elif [ "$fname" = '..' ]; then
# Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
# AFTER canonicalization.
command printf '%s\n' "$(command dirname -- "${targetDir}")"
else
command printf '%s\n' "${targetDir%/}/$fname"
fi
)
get_script_dir() {
# call this with $0 (from main script) as its (only) parameter
# if you need to preserve cwd, run this is a subshell since
# it can change cwd
# set -x
local_SCRIPT_PATH="$( get_abs_filename "$1" )";
while [ -h "$local_SCRIPT_PATH" ];
do
cd "$( dirname -- "$local_SCRIPT_PATH"; )";
local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
done
cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
local_SCRIPT_PATH="$( pwd; )";
# set +x
echo "${local_SCRIPT_PATH}"
}
# end of script directory functions
###############################################################################
# figure out the script dir
LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
export LOADUP_SCRIPTDIR
fi
# shellcheck source=./loadup-setup.sh
. scripts/loadup-setup.sh
loadup_start
cat >"${cmfile}" <<"EOF"
(* "make init files; this file is loaded as a 'greet' file by scripts/loadup-init.sh")
(SETQ MEDLEYDIR NIL)
(LOAD (CONCAT (UNIX-GETENV "MEDLEYDIR") "/sources/MEDLEYDIR.LCOM"))
(MEDLEY-INIT-VARS)
(CNDIR (UNIX-GETENV "LOADUP_WORKDIR"))
(DRIBBLE "init.dribble")
(UNADVISE)
(ADVISE 'PAGEFULLFN '(RETURN))
(ADVISE '(ERROR IN \DO-DEFINE-FILE-INFO) '(RETURN))
(MOVD? 'NILL 'SETTEMPLATE)
(DEFINEQ (RRE (LAMBDA (X Y) Y)))
(MOVD? 'RRE 'READ-READER-ENVIRONMENT)
(LOAD (CONCAT "{DSK}" (UNIX-GETENV "LOADUP_SOURCEDIR") "/" "MAKEINIT.LCOM"))
(PROG
((WORKDIR (CONCAT "{DSK}" (UNIX-GETENV "LOADUP_WORKDIR") "/"))
(LOADUP-SOURCE-DIR (CONCAT "{DSK}" (UNIX-GETENV "LOADUP_SOURCEDIR") "/"))
)
(SETQ DIRECTORIES (CONS LOADUP-SOURCE-DIR DIRECTORIES))
(RESETLST (RESETSAVE OK.TO.MODIFY.FNS T)
(MAKEINITGREET (CONCAT WORKDIR "init.sysout") (CONCAT WORKDIR "init.dlinit"))
)
)
(DRIBBLE)
(LOGOUT T)
STOP
EOF
run_medley "${LOADUP_SOURCEDIR}/starter.sysout"
loadup_finish "init.dlinit" "init.*" "RDSYS*" "I-NEW*"
main "$@"

163
scripts/loadup-lisp-from-mid.sh
View File

@ -1,39 +1,134 @@
#!/bin/sh
if [ ! -h ./medley ] || [ ! -d ./lispusers ]
main() {
# shellcheck source=./loadup-setup.sh
. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
loadup_start
cat >"${cmfile}" <<-"EOF"
"
(PROGN
(LOAD (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE MEDLEYDIR)) (QUOTE /sources/MEDLEYDIR.LCOM)))
(MEDLEY-INIT-VARS)
(LOAD (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) (QUOTE /LOADUP-LISP.LCOM)))
(LOADUP-LISP (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE LOADUP_WORKDIR)) (QUOTE /lisp.dribble)))
(HARDRESET)
)
SHH
(PROGN
(IL:ENDLOADUP)
(IL:MAKESYS (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR)) (IL:L-CASE (QUOTE /lisp.sysout))) :LISP)
(IL:LOGOUT T)
)
"
EOF
run_medley "${LOADUP_WORKDIR}/init-mid.sysout"
loadup_finish "lisp.sysout" "lisp.*"
}
# shellcheck disable=SC2164,SC2034
if [ -z "${LOADUP_SCRIPTDIR}" ]
then
echo "*** ERROR ***"
echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
echo "The cwd ($(pwd)) is not a Medley top-level directory."
echo "Exiting."
exit 1
#
#
# Some functions to determine what directory this script is being executed from
#
#
get_abs_filename() {
# $1 : relative filename
echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
}
# This function taken from
# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
rreadlink() (
# Execute this function in a *subshell* to localize variables and the effect of `cd`.
target=$1
fname=
targetDir=
CDPATH=
# Try to make the execution environment as predictable as possible:
# All commands below are invoked via `command`, so we must make sure that `command`
# itself is not redefined as an alias or shell function.
# (Note that command is too inconsistent across shells, so we don't use it.)
# `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
# an external utility version of it (e.g, Ubuntu).
# `command` bypasses aliases and shell functions and also finds builtins
# in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
# to happen.
{ \unalias command; \unset -f command; } >/dev/null 2>&1
[ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
while :; do # Resolve potential symlinks until the ultimate target is found.
[ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
fname=$(command basename -- "$target") # Extract filename.
[ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
if [ -L "$fname" ]; then
# Extract [next] target path, which may be defined
# *relative* to the symlink's own directory.
# Note: We parse `ls -l` output to find the symlink target
# which is the only POSIX-compliant, albeit somewhat fragile, way.
target=$(command ls -l "$fname")
target=${target#* -> }
continue # Resolve [next] symlink target.
fi
break # Ultimate target reached.
done
targetDir=$(command pwd -P) # Get canonical dir. path
# Output the ultimate target's canonical path.
# Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
if [ "$fname" = '.' ]; then
command printf '%s\n' "${targetDir%/}"
elif [ "$fname" = '..' ]; then
# Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
# AFTER canonicalization.
command printf '%s\n' "$(command dirname -- "${targetDir}")"
else
command printf '%s\n' "${targetDir%/}/$fname"
fi
)
get_script_dir() {
# call this with $0 (from main script) as its (only) parameter
# if you need to preserve cwd, run this is a subshell since
# it can change cwd
# set -x
local_SCRIPT_PATH="$( get_abs_filename "$1" )";
while [ -h "$local_SCRIPT_PATH" ];
do
cd "$( dirname -- "$local_SCRIPT_PATH"; )";
local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
done
cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
local_SCRIPT_PATH="$( pwd; )";
# set +x
echo "${local_SCRIPT_PATH}"
}
# end of script directory functions
###############################################################################
# figure out the script dir
LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
export LOADUP_SCRIPTDIR
fi
# shellcheck source=./loadup-setup.sh
. scripts/loadup-setup.sh
loadup_start
cat >"${cmfile}" <<"EOF"
"
(PROGN
(LOAD (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE MEDLEYDIR)) (QUOTE /sources/MEDLEYDIR.LCOM)))
(MEDLEY-INIT-VARS)
(LOAD (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) (QUOTE /LOADUP-LISP.LCOM)))
(LOADUP-LISP (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE LOADUP_WORKDIR)) (QUOTE /lisp.dribble)))
(HARDRESET)
)
SHH
(PROGN
(IL:ENDLOADUP)
(IL:MAKESYS (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR)) (IL:L-CASE (QUOTE /lisp.sysout))) :LISP)
(IL:LOGOUT T)
)
"
EOF
run_medley "${LOADUP_WORKDIR}/init-mid.sysout"
loadup_finish "lisp.sysout" "lisp.*"
main "$@"

151
scripts/loadup-mid-from-init.sh
View File

@ -1,30 +1,131 @@
#!/bin/sh
if [ ! -h ./medley ] || [ ! -d ./lispusers ]
main() {
# shellcheck source=./loadup-setup.sh
. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
loadup_start
cat >"${cmfile}" <<-"EOF"
"
(MOVD? (QUOTE NILL) (QUOTE PROMPTPRINT))
(MOVD? (QUOTE NILL) (QUOTE CURSORP))
(MOVD? (QUOTE NILL) (QUOTE CHANGEBACKGROUNDBORDER))
(LOGOUT)
"
EOF
run_medley "${LOADUP_WORKDIR}/init.dlinit" -NF -prog ldeinit --vmem "${LOADUP_WORKDIR}/init-mid.sysout"
if [ "${exit_code}" -eq 54 ]
then
echo "NOTE: The loadup script $0 requires the ldeinit executable"
echo "in addition to the lde executable be available in MAIKODIR."
echo "The ldeinit executable could not be found."
fi
echo " "
loadup_finish "init-mid.sysout" "init-mid.sysout"
}
# shellcheck disable=SC2164,SC2034
if [ -z "${LOADUP_SCRIPTDIR}" ]
then
echo "*** ERROR ***"
echo "You must run $(basename "$0") while the cwd is a Medley top-level directory."
echo "The cwd ($(pwd)) is not a Medley top-level directory."
echo "Exiting."
exit 1
#
#
# Some functions to determine what directory this script is being executed from
#
#
get_abs_filename() {
# $1 : relative filename
echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
}
# This function taken from
# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
rreadlink() (
# Execute this function in a *subshell* to localize variables and the effect of `cd`.
target=$1
fname=
targetDir=
CDPATH=
# Try to make the execution environment as predictable as possible:
# All commands below are invoked via `command`, so we must make sure that `command`
# itself is not redefined as an alias or shell function.
# (Note that command is too inconsistent across shells, so we don't use it.)
# `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
# an external utility version of it (e.g, Ubuntu).
# `command` bypasses aliases and shell functions and also finds builtins
# in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
# to happen.
{ \unalias command; \unset -f command; } >/dev/null 2>&1
[ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
while :; do # Resolve potential symlinks until the ultimate target is found.
[ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
fname=$(command basename -- "$target") # Extract filename.
[ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
if [ -L "$fname" ]; then
# Extract [next] target path, which may be defined
# *relative* to the symlink's own directory.
# Note: We parse `ls -l` output to find the symlink target
# which is the only POSIX-compliant, albeit somewhat fragile, way.
target=$(command ls -l "$fname")
target=${target#* -> }
continue # Resolve [next] symlink target.
fi
break # Ultimate target reached.
done
targetDir=$(command pwd -P) # Get canonical dir. path
# Output the ultimate target's canonical path.
# Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
if [ "$fname" = '.' ]; then
command printf '%s\n' "${targetDir%/}"
elif [ "$fname" = '..' ]; then
# Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
# AFTER canonicalization.
command printf '%s\n' "$(command dirname -- "${targetDir}")"
else
command printf '%s\n' "${targetDir%/}/$fname"
fi
)
get_script_dir() {
# call this with $0 (from main script) as its (only) parameter
# if you need to preserve cwd, run this is a subshell since
# it can change cwd
# set -x
local_SCRIPT_PATH="$( get_abs_filename "$1" )";
while [ -h "$local_SCRIPT_PATH" ];
do
cd "$( dirname -- "$local_SCRIPT_PATH"; )";
local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
done
cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
local_SCRIPT_PATH="$( pwd; )";
# set +x
echo "${local_SCRIPT_PATH}"
}
# end of script directory functions
###############################################################################
# figure out the script dir
LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
export LOADUP_SCRIPTDIR
fi
# shellcheck source=./loadup-setup.sh
. scripts/loadup-setup.sh
loadup_start
cat >"${cmfile}" <<"EOF"
"
(MOVD? (QUOTE NILL) (QUOTE PROMPTPRINT))
(MOVD? (QUOTE NILL) (QUOTE CURSORP))
(MOVD? (QUOTE NILL) (QUOTE CHANGEBACKGROUNDBORDER))
(LOGOUT)
"
EOF
run_medley "${LOADUP_WORKDIR}/init.dlinit" -NF -prog ldeinit --vmem "${LOADUP_WORKDIR}/init-mid.sysout"
echo " "
loadup_finish "init-mid.sysout" "init-mid.sysout"
main "$@"

23
scripts/loadup-setup.sh
View File

@ -1,7 +1,7 @@
#!sh
#!to_be_sourced_only
# shellcheck shell=sh
MEDLEYDIR="$(pwd)"
MEDLEYDIR=$(cd "${LOADUP_SCRIPTDIR}/.."; pwd)
export MEDLEYDIR
if [ -z "${LOADUP_WORKDIR}" ]
@ -141,18 +141,19 @@ loadup_finish () {
run_medley () {
if [ ! "${LOADUP_OLDSCHOOL}" = true ]
then
./medley --config - \
--id loadup_+ \
--geometry "${geometry}" \
--noscroll \
--logindir "${LOADUP_LOGINDIR}" \
--greet "${cmfile}" \
--sysout "$1" \
"$2" "$3" "$4" "$5" "$6" "$7" ;
/bin/sh "${MEDLEYDIR}/scripts/medley/medley.command" \
--config - \
--id loadup_+ \
--geometry "${geometry}" \
--noscroll \
--logindir "${LOADUP_LOGINDIR}" \
--greet "${cmfile}" \
--sysout "$1" \
"$2" "$3" "$4" "$5" "$6" "$7" ;
exit_code=$?
else
# shellcheck disable=SC2086
./run-medley ${scr} $2 $3 $4 $5 $6 $7 -loadup "${cmfile}" "$1"
"${MEDLEYDIR}/run-medley" ${scr} $2 $3 $4 $5 $6 $7 -loadup "${cmfile}" "$1"
exit_code=$?
fi

54
sources/EDITINTERFACE
View File

@ -1,16 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "22-Jun-2022 13:32:08" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EDITINTERFACE.;45 47672
(FILECREATED "21-May-2024 22:10:45" {DSK}<home>matt>Interlisp>medley>sources>EDITINTERFACE.;2 47745
:CHANGES-TO (FNS FIXEDITDATE)
:EDIT-BY "mth"
:PREVIOUS-DATE "13-May-2022 08:16:23"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EDITINTERFACE.;44)
:CHANGES-TO (FNS EDITLOADFNS?)
:PREVIOUS-DATE "22-Jun-2022 13:32:08" {DSK}<home>matt>Interlisp>medley>sources>EDITINTERFACE.;1
)
(* ; "
Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
Copyright (c) 1986-1988, 1990-1991, 2024 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT EDITINTERFACECOMS)
@ -374,12 +375,18 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
(CDR X])
(EDITLOADFNS?
[LAMBDA (FN STR ASKFLG FILES) (* lmm "20-Nov-86 21:23")
(* ;; "Value is name of file from which function or functions can be loaded. If STR is non-NIL, user is asked to approve, and STR used in the message. EDITLOADFNS? is also used by prettyprint")
[LAMBDA (FN STR ASKFLG FILES) (* ; "Edited 21-May-2024 18:18 by mth")
(* lmm "20-Nov-86 21:23")
(* ;; "Value is name of file from which function or functions can be loaded. If STR is non-NIL, user is asked to approve, and STR used in the message. EDITLOADFNS? is also used by prettyprint")
(AND FN FILEPKGFLG (PROG ((LST (WHEREIS FN 'FNS FILES))
FILE DATES FD)
(OR (COND
((EQ FILES T) (* ;; "if FILES = T, means consult data base. if user has removed a function from one of those files, as evidenced by the fact that editloafns? was called with files=T, then dont offer that file.")
((EQ FILES T)
(* ;; "if FILES = T, means consult data base. if user has removed a function from one of those files, as evidenced by the fact that editloafns? was called with files=T, then dont offer that file.")
(SETQ LST (LDIFFERENCE LST FILELST)))
(T LST))
(RETURN))
@ -394,8 +401,10 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
(RETURN)))
(T (CAR LST]
[SETQ DATES (LISTP (GETPROP FILE 'FILEDATES]
(* ;;
 "only look at file in FILEDATES if the file has been LOADed or LOADFROMd")
(* ;;
 "only look at file in FILEDATES if the file has been LOADed or LOADFROMd")
(SETQ FILE (OR (AND DATES (FMEMB (CDAR (GETPROP FILE 'FILE))
'(LOADFNS T))
(INFILEP (CDAR DATES)))
@ -412,15 +421,16 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
 "found a goood version of file on a different name. smash name")
(/RPLACD (CAR DATES)
FILE))
(T (CL:FORMAT *TERMINAL-IO* "*** Note: loading definition from ~A dated ~A~&while file ~A dated ~A is the version currently loaded."
(T (CL:FORMAT *TERMINAL-IO* "*** Note: loading definition from ~A dated ~A~&while file ~A dated ~A is the version currently loaded."
FILE FD (CDAR DATES)
(CAAR DATES]
(COND
((STREQUAL STR ""))
((NULL ASKFLG)
(if STR
then (EXEC-FORMAT "~&~A~A" STR FILE)
else (EXEC-FORMAT "~&Loading definition of ~S from ~A." FN FILE)))
then (EXEC-FORMAT "~&~A~A~&" STR FILE)
else (EXEC-FORMAT "~&Loading definition of ~S from ~A.~&" FN FILE)
))
((NEQ (ASKUSER DWIMWAIT 'Y (LIST FN STR FILE)
NIL T)
'Y)
@ -942,13 +952,13 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
(ADDTOVAR LAMA )
)
(PUTPROPS EDITINTERFACE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991))
(PUTPROPS EDITINTERFACE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 2024))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4089 10388 (ED 4089 . 10388)) (10390 14366 (INSTALL-PROTOTYPE-DEFN 10390 . 14366)) (
14367 31150 (EDITDEF.FNS 14377 . 15713) (EDITF 15715 . 16595) (EDITFB 16597 . 17445) (EDITFNS 17447 .
18767) (EDITLOADFNS? 18769 . 22569) (EDITMODE 22571 . 24581) (EDITP 24583 . 25094) (EDITV 25096 .
25735) (DC 25737 . 26418) (DF 26420 . 27462) (DP 27464 . 28548) (DV 28550 . 29122) (EDITPROP 29124 .
29343) (EF 29345 . 29674) (EP 29676 . 29859) (EV 29861 . 30040) (EDITE 30042 . 30920) (EDITL 30922 .
31148)) (31500 46817 (NEW/EDITDATE 31510 . 31732) (FIXEDITDATE 31734 . 40341) (EDITDATE? 40343 . 43371
) (EDITDATE 43373 . 44820) (SETINITIALS 44822 . 46815)))))
(FILEMAP (NIL (4081 10380 (ED 4081 . 10380)) (10382 14358 (INSTALL-PROTOTYPE-DEFN 10382 . 14358)) (
14359 31218 (EDITDEF.FNS 14369 . 15705) (EDITF 15707 . 16587) (EDITFB 16589 . 17437) (EDITFNS 17439 .
18759) (EDITLOADFNS? 18761 . 22637) (EDITMODE 22639 . 24649) (EDITP 24651 . 25162) (EDITV 25164 .
25803) (DC 25805 . 26486) (DF 26488 . 27530) (DP 27532 . 28616) (DV 28618 . 29190) (EDITPROP 29192 .
29411) (EF 29413 . 29742) (EP 29744 . 29927) (EV 29929 . 30108) (EDITE 30110 . 30988) (EDITL 30990 .
31216)) (31568 46885 (NEW/EDITDATE 31578 . 31800) (FIXEDITDATE 31802 . 40409) (EDITDATE? 40411 . 43439
) (EDITDATE 43441 . 44888) (SETINITIALS 44890 . 46883)))))
STOP

BIN
sources/EDITINTERFACE.LCOM
View File

Binary file not shown.