Compare commits
28 Commits
medley-240
...
medley-240
| Author | SHA1 | Date | |
|---|---|---|---|
|
ff25001814 | ||
|
9793e48c4e | ||
|
2f6499317b | ||
|
|
6398c2b8d4 | ||
|
|
fcd40bc409 | ||
|
|
c8133ebb96 | ||
|
|
9962a9ca0a | ||
|
|
014c34959f | ||
|
|
4c18373229 | ||
|
1148cd5945 | ||
|
|
f44b96e870 | ||
|
|
e9bea32fa3 | ||
|
|
10cd51e5b1 | ||
|
|
ee57eabe21 | ||
|
|
eda9863432 | ||
|
|
a9a8c35827 | ||
|
|
40306a3fe8 | ||
|
|
eb7d34784b | ||
|
|
ba8aac6321 | ||
|
|
c578bfd983 | ||
|
|
dab6f2635f | ||
|
|
40ae5fb9b3 | ||
|
|
1c2f9bc395 | ||
|
|
9214a6335a | ||
|
|
a9941b36aa | ||
|
|
3129597058 | ||
|
|
0d8e5ae9f6 | ||
|
|
354c7f035a |
18
.github/workflows/buildReleaseInclDocker.yml
vendored
18
.github/workflows/buildReleaseInclDocker.yml
vendored
@@ -3,6 +3,7 @@
|
||||
#
|
||||
# Interlisp webflow to build a Medley release and push it to github.
|
||||
# And to build a multiplatform Docker image for the release and push it to Docker Hub.
|
||||
# And to kickoff a build and deploy workflow for Medley-online within the online repo.
|
||||
#
|
||||
# This workflow just calls two reuseable workflows to the two task:
|
||||
# buildLoadup.yml and buildDocker.yml
|
||||
@@ -14,12 +15,12 @@
|
||||
# ******************************************************************************
|
||||
|
||||
|
||||
name: "Build/Push Release & Docker"
|
||||
name: "Build/Push Release, Docker, OIO"
|
||||
|
||||
# Run this workflow on ...
|
||||
on:
|
||||
schedule:
|
||||
- cron: '0 9 * * 1'
|
||||
- cron: '17 9 * * 3'
|
||||
|
||||
workflow_dispatch:
|
||||
inputs:
|
||||
@@ -111,3 +112,16 @@ jobs:
|
||||
|
||||
######################################################################################
|
||||
|
||||
# Kickoff workflow in online repo to build and deploy Medley docker image to oio
|
||||
do_oio:
|
||||
runs-on: ubuntu-latest
|
||||
needs: [inputs, do_docker]
|
||||
steps:
|
||||
- name: trigger-oio-buildAndDeploy
|
||||
run: |
|
||||
if [ ! "${{ needs.inputs.outputs.draft }}" = "true" ]
|
||||
then
|
||||
gh workflow run buildAndDeployMedleyDocker.yml --repo Interlisp/online --ref master
|
||||
fi
|
||||
env:
|
||||
GITHUB_TOKEN: ${{ secrets.ONLINE_TOKEN }}
|
||||
|
||||
7
.gitignore
vendored
7
.gitignore
vendored
@@ -5,6 +5,10 @@ tmp/*
|
||||
# releases directory
|
||||
releases/*
|
||||
|
||||
# maiko directory
|
||||
maiko/
|
||||
|
||||
|
||||
# all PDFs (those explicitly checked in aren't ignored
|
||||
# normally when you have derived files, you ignore them from git
|
||||
# because they will get regenerated when you rebuild.
|
||||
@@ -19,7 +23,8 @@ loadups/exports.all
|
||||
library/RDSYS*
|
||||
loadups/lisp.sysout
|
||||
loadups/full.sysout
|
||||
loadups/fuller.sysout # not currently included but might as well ignore it
|
||||
# not currently included but might as well ignore it
|
||||
loadups/fuller.sysout
|
||||
loadups/*.dribble
|
||||
loadups/whereis.hash
|
||||
loadups/apps.sysout
|
||||
|
||||
@@ -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
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED " 4-Nov-2023 23:55:27" |{WMEDLEY}<library>FILEBROWSER.;27| 266102
|
||||
(FILECREATED "29-May-2024 15:30:07" {LIB}FILEBROWSER.\;2 266071
|
||||
|
||||
:EDIT-BY |rmk|
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (VARS FILEBROWSERCOMS)
|
||||
(FNS FB.EDITCOMMAND.ONEFILE)
|
||||
:CHANGES-TO (FNS FB.PROMPTW.FORMAT FB.FASTSEE.ONEFILE)
|
||||
|
||||
:PREVIOUS-DATE " 4-Nov-2023 23:50:29" |{WMEDLEY}<library>FILEBROWSER.;26|)
|
||||
:PREVIOUS-DATE " 4-Nov-2023 23:55:27" {LIB}FILEBROWSER.\;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT FILEBROWSERCOMS)
|
||||
@@ -729,14 +728,17 @@ Your deletions are thus ignored.")))
|
||||
(PRIN1 THING WINDOW))))))))
|
||||
|
||||
(FB.PROMPTW.FORMAT
|
||||
(CL:LAMBDA (BROWSER FORMAT-STRING &REST ARGS) (* \; "Edited 4-Feb-88 23:15 by bvm:")
|
||||
(CL:LAMBDA (BROWSER FORMAT-STRING &REST ARGS) (* \; "Edited 29-May-2024 15:16 by mth")
|
||||
(* \; "Edited 4-Feb-88 23:15 by bvm:")
|
||||
|
||||
(* |;;| "Outputs to FOLDER's prompt window using FORMAT.")
|
||||
|
||||
(LET ((*PRINT-CASE* :UPCASE)
|
||||
(*PRINT-BASE* 10)
|
||||
(WINDOW (|ffetch| (FILEBROWSER PROMPTWINDOW) |of| (\\DTEST BROWSER
|
||||
'FILEBROWSER))))
|
||||
(WINDOW (OR (AND (|type?| FILEBROWSER BROWSER)
|
||||
(|ffetch| (FILEBROWSER PROMPTWINDOW) |of| (\\DTEST BROWSER
|
||||
'FILEBROWSER)))
|
||||
PROMPTWINDOW)))
|
||||
|
||||
(* |;;| "*PRINT-CASE* is bound so symbols get printed in \"expected\" case. *PRINT-BASE* is 10 for benefit of printing numbers in the non-format case.")
|
||||
|
||||
@@ -1896,10 +1898,9 @@ Your deletions are thus ignored.")))
|
||||
SEEWINDOW UNFORMATTED (CDR TAIL)))))))
|
||||
|
||||
(FB.FASTSEE.ONEFILE
|
||||
(LAMBDA (BROWSER FILE WINDOW UNFORMATTED MORE) (* \;
|
||||
"Edited 21-Feb-2021 14:46 by rmk:")
|
||||
(* \;
|
||||
"Edited 20-Nov-2000 14:23 by rmk:")
|
||||
(LAMBDA (BROWSER FILE WINDOW UNFORMATTED MORE) (* \; "Edited 29-May-2024 15:28 by mth")
|
||||
(* \; "Edited 21-Feb-2021 14:46 by rmk:")
|
||||
(* \; "Edited 20-Nov-2000 14:23 by rmk:")
|
||||
(* \; "Edited 19-Aug-91 13:06 by jds")
|
||||
(COND
|
||||
((DIRECTORYNAMEP FILE)
|
||||
@@ -1921,32 +1922,30 @@ Your deletions are thus ignored.")))
|
||||
|
||||
(* |;;| "Failed on this file. If this was the only file, the message can be a little more terse (which is desirable, because the typical message is \"File not found xxx\")")
|
||||
|
||||
(FB.PROMPTW.FORMAT BROWSER "~:[Failed~;~:*Couldn't see ~A~] because ~A"
|
||||
(FB.PROMPTW.FORMAT BROWSER "~&~:[Failed~;~:*Couldn't see ~A~] because ~A"
|
||||
(AND MORE FILE)
|
||||
CONDITION)
|
||||
|else| (RESETLST
|
||||
(RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM WINDOW)
|
||||
(AND RESETSTATE (OPENWP WINDOW)
|
||||
(WINDOWPROP
|
||||
WINDOW
|
||||
'TITLE
|
||||
(CONCAT (WINDOWPROP WINDOW
|
||||
'TITLE)
|
||||
" -- " "Aborted")))
|
||||
(CLOSEF STREAM)))
|
||||
STREAM WINDOW))
|
||||
(WINDOWPROP WINDOW 'MORETYPE (COND
|
||||
(MORE 'YETMOREBUTTONS)
|
||||
(T 'LASTMOREBUTTONS)))
|
||||
(COND
|
||||
(UNFORMATTED (COPYCHARS STREAM WINDOW))
|
||||
(T (PFCOPYBYTES STREAM WINDOW)))
|
||||
(WINDOWPROP WINDOW 'TITLE (CONCAT (WINDOWPROP WINDOW 'TITLE)
|
||||
" -- " "Finished"))
|
||||
(COND
|
||||
(MORE (* \; "Wait for OK to proceed")
|
||||
(FB.SEEFULLFN (WINDOWPROP WINDOW 'DSP)
|
||||
'FINISHEDMOREBUTTONS))))))))))
|
||||
(RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM WINDOW)
|
||||
(AND RESETSTATE (OPENWP WINDOW)
|
||||
(WINDOWPROP WINDOW 'TITLE
|
||||
(CONCAT (WINDOWPROP WINDOW
|
||||
'TITLE)
|
||||
" -- " "Aborted")))
|
||||
(CLOSEF STREAM)))
|
||||
STREAM WINDOW))
|
||||
(WINDOWPROP WINDOW 'MORETYPE (COND
|
||||
(MORE 'YETMOREBUTTONS)
|
||||
(T 'LASTMOREBUTTONS)))
|
||||
(COND
|
||||
(UNFORMATTED (COPYCHARS STREAM WINDOW))
|
||||
(T (PFCOPYBYTES STREAM WINDOW)))
|
||||
(WINDOWPROP WINDOW 'TITLE (CONCAT (WINDOWPROP WINDOW 'TITLE)
|
||||
" -- " "Finished"))
|
||||
(COND
|
||||
(MORE (* \; "Wait for OK to proceed")
|
||||
(FB.SEEFULLFN (WINDOWPROP WINDOW 'DSP)
|
||||
'FINISHEDMOREBUTTONS))))))))))
|
||||
|
||||
(FB.SEEFULLFN
|
||||
(LAMBDA (DSP PROP) (* |bvm:| "18-Sep-85 23:29")
|
||||
@@ -4250,51 +4249,51 @@ then click Recompute"))))
|
||||
(ADDTOVAR LAMA FB.PROMPTW.FORMAT FB.PROMPTWPRINT)
|
||||
)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (31928 54809 (FB 31938 . 33073) (FB.COPYBINARYCOMMAND 33075 . 33421) (FB.COPYTEXTCOMMAND
|
||||
33423 . 33765) (FILEBROWSER 33767 . 46873) (FB.TABLEBROWSER 46875 . 47092) (FB.SELECTEDFILES 47094 .
|
||||
47731) (FB.FETCHFILENAME 47733 . 48125) (FB.DIRECTORYP 48127 . 48521) (FB.PROMPTWPRINT 48523 . 49569)
|
||||
(FB.PROMPTW.FORMAT 49571 . 50308) (FB.PROMPTFORINPUT 50310 . 52562) (FB.YES-OR-NO-P 52564 . 53598) (
|
||||
FB.ALLOW.ABORT 53600 . 54454) (\\FB.HARDCOPY.TOFILE.EXTENSION 54456 . 54807)) (54833 55786 (FB.STARTUP
|
||||
54843 . 55358) (FB.MAKERIGIDWINDOW 55360 . 55784)) (55787 61270 (FB.PRINTFN 55797 . 60950) (FB.COPYFN
|
||||
60952 . 61268)) (61320 67660 (FB.MENU.WHENSELECTEDFN 61330 . 61688) (FB.COMMANDSELECTEDFN 61690 .
|
||||
63229) (FB.SUBITEMP 63231 . 63832) (FB.MAKE.BROWSER.BUSY 63834 . 64638) (FB.FINISH.COMMAND 64640 .
|
||||
66671) (FB.HANDLE.ABORT.BUTTON 66673 . 67658)) (67661 73177 (FB.DELETECOMMAND 67671 . 67952) (
|
||||
FB.DELVERCOMMAND 67954 . 71147) (FB.IS.NOT.SUBDIRECTORY.ITEM 71149 . 71330) (FB.DELVER.FILES 71332 .
|
||||
72421) (FB.DELETE.FILE 72423 . 73175)) (73178 74503 (FB.UNDELETECOMMAND 73188 . 73473) (
|
||||
FB.UNDELETEALLCOMMAND 73475 . 73754) (FB.UNDELETE.FILE 73756 . 74501)) (74504 98685 (FB.COPYCOMMAND
|
||||
74514 . 74783) (FB.RENAMECOMMAND 74785 . 75060) (FB.COPY/RENAME.COMMAND 75062 . 75985) (
|
||||
FB.COPY/RENAME.ONE 75987 . 78309) (FB.COPY/RENAME.MANY 78311 . 84531) (FB.MERGE.DIRECTORIES 84533 .
|
||||
84951) (FB.GREATEST.PREFIX 84953 . 86309) (FB.MAYBE.INSERT.FILE 86311 . 93751) (FB.GET.NEW.FILE.SPEC
|
||||
93753 . 97584) (FB.CANONICAL.DIRECTORY 97586 . 98683)) (98686 106470 (FB.HARDCOPYCOMMAND 98696 . 99826
|
||||
) (FB.HARDCOPY.TOFILE 99828 . 106468)) (106471 116680 (FB.EDITCOMMAND 106481 . 107348) (
|
||||
FB.EDITCOMMAND.ONEFILE 107350 . 110764) (FB.EDITLISPFILE 110766 . 111871) (FB.BROWSECOMMAND 111873 .
|
||||
116678)) (116681 128602 (FB.FASTSEECOMMAND 116691 . 120141) (FB.FASTSEE.ONEFILE 120143 . 123300) (
|
||||
FB.SEEFULLFN 123302 . 127433) (FB.SEEBUTTONFN 127435 . 128600)) (128603 130349 (FB.LOADCOMMAND 128613
|
||||
. 129120) (FB.COMPILECOMMAND 129122 . 129660) (FB.OPERATE.ON.FILES 129662 . 130347)) (130350 178535 (
|
||||
FB.UPDATECOMMAND 130360 . 130585) (FB.FIX-DIRECTORY-DATES 130587 . 131610) (FB.MAYBE.EXPUNGE 131612 .
|
||||
132673) (FB.UPDATEBROWSERITEMS 132675 . 145890) (FB.DATE 145892 . 146533) (FB.ADJUST.DATE.WIDTH 146535
|
||||
. 149503) (FB.SET.BROWSER.TITLE 149505 . 150507) (FB.MAYBE.WIDEN.NAMES 150509 . 152628) (
|
||||
FB.SET.DEFAULT.NAME.WIDTH 152630 . 153994) (FB.CREATE.FILEBUCKET 153996 . 161216) (
|
||||
FB.CHECK.NAME.LENGTH 161218 . 163639) (FB.ADD.FILEGROUP 163641 . 165168) (FB.INSERT.DIRECTORY 165170
|
||||
. 165408) (FB.MAKE.SUBDIRECTORY.ITEM 165410 . 166819) (FB.ADD.FILE 166821 . 167434) (FB.INSERT.FILE
|
||||
167436 . 170848) (FB.ANALYZE.PATTERN 170850 . 176114) (FB.CANONICALIZE.PATTERN 176116 . 177428) (
|
||||
FB.GETALLFILEINFO 177430 . 178533)) (178536 186695 (FB.SORT.VERSIONS 178546 . 181317) (
|
||||
FB.DECREASING.VERSION 181319 . 181988) (FB.INCREASING.VERSION 181990 . 182611) (
|
||||
FB.NAMES.DECREASING.VERSION 182613 . 183648) (FB.NAMES.INCREASING.VERSION 183650 . 184647) (
|
||||
FB.DECREASING.NUMERIC.ATTR 184649 . 185329) (FB.INCREASING.NUMERIC.ATTR 185331 . 186005) (
|
||||
FB.ALPHABETIC.ATTR 186007 . 186693)) (186696 196538 (FB.SORTCOMMAND 186706 . 193536) (
|
||||
FB.INSERT.SUBDIRECTORIES 193538 . 194335) (FB.GET.SORT.MENU 194337 . 196536)) (196539 212760 (
|
||||
FB.EXPUNGECOMMAND 196549 . 199134) (FB.NEWPATTERNCOMMAND 199136 . 199534) (FB.NEWINFOCOMMAND 199536 .
|
||||
202368) (FB.DEPTHCOMMAND 202370 . 204145) (FB.SHAPECOMMAND 204147 . 207489) (FB.REMOVE.FILE 207491 .
|
||||
209312) (FB.COUNT.FILE.CHANGE 209314 . 210759) (FB.SETNEWPATTERN 210761 . 211931) (FB.GET.NEWPATTERN
|
||||
211933 . 212517) (FB.OPTIONSCOMMAND 212519 . 212758)) (212795 213848 (FB.GETWINDOW 212805 . 213846)) (
|
||||
213849 214861 (FB.INFOMENU.SHADEINITIALSELECTIONS 213859 . 214506) (FB.INFO.ITEM.NAMED 214508 . 214859
|
||||
)) (214862 224394 (FB.MAKECOUNTERWINDOW 214872 . 216400) (FB.COUNTERW.REDISPLAYFN 216402 . 216989) (
|
||||
FB.UPDATE.COUNTERS 216991 . 219063) (FB.DISPLAY.COUNTERS 219065 . 224125) (FB.COUNTER.STRING 224127 .
|
||||
224392)) (224395 229104 (FB.MAKEHEADINGWINDOW 224405 . 226019) (FB.HEADINGW.REDISPLAYFN 226021 .
|
||||
226287) (FB.HEADINGW.RESHAPEFN 226289 . 226665) (FB.HEADINGW.DISPLAY 226667 . 229102)) (229105 233288
|
||||
(FB.ICONFN 229115 . 229462) (FB.INFOMENU.WHENSELECTEDFN 229464 . 230194) (FB.CLOSEFN 230196 . 231399)
|
||||
(FB.EXPUNGE?.MENU 231401 . 231813) (FB.AFTERCLOSEFN 231815 . 232176) (FB.CLOSE&EXPUNGE 232178 . 233286
|
||||
)) (233289 245347 (FB.HARDCOPY.DIRECTORY 233299 . 243656) (FB.HARDCOPY.PRINT.TITLE 243658 . 243984) (
|
||||
FB.HARDCOPY.MAXWIDTH 243986 . 245345)))))
|
||||
(FILEMAP (NIL (31871 54979 (FB 31881 . 33016) (FB.COPYBINARYCOMMAND 33018 . 33364) (FB.COPYTEXTCOMMAND
|
||||
33366 . 33708) (FILEBROWSER 33710 . 46816) (FB.TABLEBROWSER 46818 . 47035) (FB.SELECTEDFILES 47037 .
|
||||
47674) (FB.FETCHFILENAME 47676 . 48068) (FB.DIRECTORYP 48070 . 48464) (FB.PROMPTWPRINT 48466 . 49512)
|
||||
(FB.PROMPTW.FORMAT 49514 . 50478) (FB.PROMPTFORINPUT 50480 . 52732) (FB.YES-OR-NO-P 52734 . 53768) (
|
||||
FB.ALLOW.ABORT 53770 . 54624) (\\FB.HARDCOPY.TOFILE.EXTENSION 54626 . 54977)) (55003 55956 (FB.STARTUP
|
||||
55013 . 55528) (FB.MAKERIGIDWINDOW 55530 . 55954)) (55957 61440 (FB.PRINTFN 55967 . 61120) (FB.COPYFN
|
||||
61122 . 61438)) (61490 67830 (FB.MENU.WHENSELECTEDFN 61500 . 61858) (FB.COMMANDSELECTEDFN 61860 .
|
||||
63399) (FB.SUBITEMP 63401 . 64002) (FB.MAKE.BROWSER.BUSY 64004 . 64808) (FB.FINISH.COMMAND 64810 .
|
||||
66841) (FB.HANDLE.ABORT.BUTTON 66843 . 67828)) (67831 73347 (FB.DELETECOMMAND 67841 . 68122) (
|
||||
FB.DELVERCOMMAND 68124 . 71317) (FB.IS.NOT.SUBDIRECTORY.ITEM 71319 . 71500) (FB.DELVER.FILES 71502 .
|
||||
72591) (FB.DELETE.FILE 72593 . 73345)) (73348 74673 (FB.UNDELETECOMMAND 73358 . 73643) (
|
||||
FB.UNDELETEALLCOMMAND 73645 . 73924) (FB.UNDELETE.FILE 73926 . 74671)) (74674 98855 (FB.COPYCOMMAND
|
||||
74684 . 74953) (FB.RENAMECOMMAND 74955 . 75230) (FB.COPY/RENAME.COMMAND 75232 . 76155) (
|
||||
FB.COPY/RENAME.ONE 76157 . 78479) (FB.COPY/RENAME.MANY 78481 . 84701) (FB.MERGE.DIRECTORIES 84703 .
|
||||
85121) (FB.GREATEST.PREFIX 85123 . 86479) (FB.MAYBE.INSERT.FILE 86481 . 93921) (FB.GET.NEW.FILE.SPEC
|
||||
93923 . 97754) (FB.CANONICAL.DIRECTORY 97756 . 98853)) (98856 106640 (FB.HARDCOPYCOMMAND 98866 . 99996
|
||||
) (FB.HARDCOPY.TOFILE 99998 . 106638)) (106641 116850 (FB.EDITCOMMAND 106651 . 107518) (
|
||||
FB.EDITCOMMAND.ONEFILE 107520 . 110934) (FB.EDITLISPFILE 110936 . 112041) (FB.BROWSECOMMAND 112043 .
|
||||
116848)) (116851 128571 (FB.FASTSEECOMMAND 116861 . 120311) (FB.FASTSEE.ONEFILE 120313 . 123269) (
|
||||
FB.SEEFULLFN 123271 . 127402) (FB.SEEBUTTONFN 127404 . 128569)) (128572 130318 (FB.LOADCOMMAND 128582
|
||||
. 129089) (FB.COMPILECOMMAND 129091 . 129629) (FB.OPERATE.ON.FILES 129631 . 130316)) (130319 178504 (
|
||||
FB.UPDATECOMMAND 130329 . 130554) (FB.FIX-DIRECTORY-DATES 130556 . 131579) (FB.MAYBE.EXPUNGE 131581 .
|
||||
132642) (FB.UPDATEBROWSERITEMS 132644 . 145859) (FB.DATE 145861 . 146502) (FB.ADJUST.DATE.WIDTH 146504
|
||||
. 149472) (FB.SET.BROWSER.TITLE 149474 . 150476) (FB.MAYBE.WIDEN.NAMES 150478 . 152597) (
|
||||
FB.SET.DEFAULT.NAME.WIDTH 152599 . 153963) (FB.CREATE.FILEBUCKET 153965 . 161185) (
|
||||
FB.CHECK.NAME.LENGTH 161187 . 163608) (FB.ADD.FILEGROUP 163610 . 165137) (FB.INSERT.DIRECTORY 165139
|
||||
. 165377) (FB.MAKE.SUBDIRECTORY.ITEM 165379 . 166788) (FB.ADD.FILE 166790 . 167403) (FB.INSERT.FILE
|
||||
167405 . 170817) (FB.ANALYZE.PATTERN 170819 . 176083) (FB.CANONICALIZE.PATTERN 176085 . 177397) (
|
||||
FB.GETALLFILEINFO 177399 . 178502)) (178505 186664 (FB.SORT.VERSIONS 178515 . 181286) (
|
||||
FB.DECREASING.VERSION 181288 . 181957) (FB.INCREASING.VERSION 181959 . 182580) (
|
||||
FB.NAMES.DECREASING.VERSION 182582 . 183617) (FB.NAMES.INCREASING.VERSION 183619 . 184616) (
|
||||
FB.DECREASING.NUMERIC.ATTR 184618 . 185298) (FB.INCREASING.NUMERIC.ATTR 185300 . 185974) (
|
||||
FB.ALPHABETIC.ATTR 185976 . 186662)) (186665 196507 (FB.SORTCOMMAND 186675 . 193505) (
|
||||
FB.INSERT.SUBDIRECTORIES 193507 . 194304) (FB.GET.SORT.MENU 194306 . 196505)) (196508 212729 (
|
||||
FB.EXPUNGECOMMAND 196518 . 199103) (FB.NEWPATTERNCOMMAND 199105 . 199503) (FB.NEWINFOCOMMAND 199505 .
|
||||
202337) (FB.DEPTHCOMMAND 202339 . 204114) (FB.SHAPECOMMAND 204116 . 207458) (FB.REMOVE.FILE 207460 .
|
||||
209281) (FB.COUNT.FILE.CHANGE 209283 . 210728) (FB.SETNEWPATTERN 210730 . 211900) (FB.GET.NEWPATTERN
|
||||
211902 . 212486) (FB.OPTIONSCOMMAND 212488 . 212727)) (212764 213817 (FB.GETWINDOW 212774 . 213815)) (
|
||||
213818 214830 (FB.INFOMENU.SHADEINITIALSELECTIONS 213828 . 214475) (FB.INFO.ITEM.NAMED 214477 . 214828
|
||||
)) (214831 224363 (FB.MAKECOUNTERWINDOW 214841 . 216369) (FB.COUNTERW.REDISPLAYFN 216371 . 216958) (
|
||||
FB.UPDATE.COUNTERS 216960 . 219032) (FB.DISPLAY.COUNTERS 219034 . 224094) (FB.COUNTER.STRING 224096 .
|
||||
224361)) (224364 229073 (FB.MAKEHEADINGWINDOW 224374 . 225988) (FB.HEADINGW.REDISPLAYFN 225990 .
|
||||
226256) (FB.HEADINGW.RESHAPEFN 226258 . 226634) (FB.HEADINGW.DISPLAY 226636 . 229071)) (229074 233257
|
||||
(FB.ICONFN 229084 . 229431) (FB.INFOMENU.WHENSELECTEDFN 229433 . 230163) (FB.CLOSEFN 230165 . 231368)
|
||||
(FB.EXPUNGE?.MENU 231370 . 231782) (FB.AFTERCLOSEFN 231784 . 232145) (FB.CLOSE&EXPUNGE 232147 . 233255
|
||||
)) (233258 245316 (FB.HARDCOPY.DIRECTORY 233268 . 243625) (FB.HARDCOPY.PRINT.TITLE 243627 . 243953) (
|
||||
FB.HARDCOPY.MAXWIDTH 243955 . 245314)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
170
lispusers/GITFNS
170
lispusers/GITFNS
@@ -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
|
||||
|
||||
Binary file not shown.
@@ -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
|
||||
|
||||
Binary file not shown.
@@ -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
|
||||
|
||||
Binary file not shown.
@@ -1,19 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "24-Sep-2023 14:26:57" {WMEDLEY}<lispusers>UNDIGESTIFY.;3 17040
|
||||
(FILECREATED " 3-Jun-2024 23:02:57" {WMEDLEY}<lispusers>UNDIGESTIFY.;5 16776
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS UNDIGESTIFYCOMS)
|
||||
(FNS OPEN-SPACE-IN-FILE)
|
||||
|
||||
:PREVIOUS-DATE "29-Jul-87 08:47:18" {WMEDLEY}<lispusers>UNDIGESTIFY.;1)
|
||||
:PREVIOUS-DATE " 3-Jun-2024 23:01:00" {WMEDLEY}<lispusers>UNDIGESTIFY.;4)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986-1987 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT UNDIGESTIFYCOMS)
|
||||
|
||||
(RPAQQ UNDIGESTIFYCOMS
|
||||
@@ -22,8 +17,7 @@ Copyright (c) 1986-1987 by Xerox Corporation.
|
||||
(FNS INSTALL-UNDIGESTIFY LAFITE-DISPLAY LAFITE-TRUNCATE-FILE LAFITE-UNDIGESTIFY MOVE-TO-EOL
|
||||
OPEN-SPACE-IN-FILE PARSE-AND-MAYBE-MERGE-HEADER SKIP-EOLS BACKUP-PTR
|
||||
TEDIT.FIND.NOT.CASELESS)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM library/LAFITE)
|
||||
LAFITEDECLS))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES LAFITE-DECLS))
|
||||
(P (INSTALL-UNDIGESTIFY))))
|
||||
|
||||
(RPAQ? *DELETE-DIGEST-FLAG* NIL)
|
||||
@@ -312,15 +306,13 @@ Copyright (c) 1986-1987 by Xerox Corporation.
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(FILESLOAD (FROM library/LAFITE)
|
||||
LAFITEDECLS)
|
||||
(FILESLOAD LAFITE-DECLS)
|
||||
)
|
||||
|
||||
(INSTALL-UNDIGESTIFY)
|
||||
(PUTPROPS UNDIGESTIFY COPYRIGHT ("Xerox Corporation" 1986 1987))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1183 16831 (INSTALL-UNDIGESTIFY 1193 . 3206) (LAFITE-DISPLAY 3208 . 3507) (
|
||||
LAFITE-TRUNCATE-FILE 3509 . 3920) (LAFITE-UNDIGESTIFY 3922 . 13578) (MOVE-TO-EOL 13580 . 14040) (
|
||||
OPEN-SPACE-IN-FILE 14042 . 14762) (PARSE-AND-MAYBE-MERGE-HEADER 14764 . 15984) (SKIP-EOLS 15986 .
|
||||
16297) (BACKUP-PTR 16299 . 16461) (TEDIT.FIND.NOT.CASELESS 16463 . 16829)))))
|
||||
(FILEMAP (NIL (1016 16664 (INSTALL-UNDIGESTIFY 1026 . 3039) (LAFITE-DISPLAY 3041 . 3340) (
|
||||
LAFITE-TRUNCATE-FILE 3342 . 3753) (LAFITE-UNDIGESTIFY 3755 . 13411) (MOVE-TO-EOL 13413 . 13873) (
|
||||
OPEN-SPACE-IN-FILE 13875 . 14595) (PARSE-AND-MAYBE-MERGE-HEADER 14597 . 15817) (SKIP-EOLS 15819 .
|
||||
16130) (BACKUP-PTR 16132 . 16294) (TEDIT.FIND.NOT.CASELESS 16296 . 16662)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -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 "$@"
|
||||
|
||||
@@ -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 "$@"
|
||||
|
||||
@@ -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 "$@"
|
||||
|
||||
@@ -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 "$@"
|
||||
|
||||
@@ -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 "$@"
|
||||
|
||||
@@ -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 "$@"
|
||||
|
||||
@@ -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 "$@"
|
||||
|
||||
@@ -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 "$@"
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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 "$@"
|
||||
|
||||
@@ -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 "$@"
|
||||
|
||||
@@ -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 "$@"
|
||||
|
||||
@@ -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 "$@"
|
||||
|
||||
@@ -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 "$@"
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -1256,47 +1256,63 @@ fi
|
||||
|
||||
# Figure out the maiko directory maiko
|
||||
check_if_maiko_dir () {
|
||||
if [ -d "$1/bin" ]
|
||||
if [ -d "$1" ] \
|
||||
&& [ -d "$1/bin" ] \
|
||||
&& [ -x "$1/bin/osversion" ] \
|
||||
&& [ -x "$1/bin/machinetype" ]
|
||||
then
|
||||
maiko_exe_subdir="$("$1/bin/osversion").$("$1/bin/machinetype")"
|
||||
return 0
|
||||
fi
|
||||
return 1
|
||||
}
|
||||
|
||||
check_for_maiko_exe () {
|
||||
if ! check_if_maiko_dir "$1"
|
||||
then
|
||||
cd "$1/bin"
|
||||
else
|
||||
return 1
|
||||
fi
|
||||
if [ -x ./osversion ] && [ -x ./machinetype ]
|
||||
maiko_exe="$1/${maiko_exe_subdir}/${maikoprog_arg}"
|
||||
if [ -x "${maiko_exe}" ]
|
||||
then
|
||||
maiko_exe="$1/$(./osversion).$(./machinetype)/${maikoprog_arg}"
|
||||
if [ -x "${maiko_exe}" ]
|
||||
then
|
||||
cd ${OLDPWD}
|
||||
return 0
|
||||
fi
|
||||
return 0
|
||||
else
|
||||
maiko_exe=""
|
||||
return 1
|
||||
fi
|
||||
maiko_exe=""
|
||||
cd ${OLDPWD}
|
||||
return 1
|
||||
}
|
||||
|
||||
if [ -z "${maikodir_arg}" ]
|
||||
then
|
||||
if [ -d "${MEDLEYDIR}/maiko" ] && check_if_maiko_dir "${MEDLEYDIR}/maiko"
|
||||
if check_for_maiko_exe "${MEDLEYDIR}/maiko"
|
||||
then
|
||||
maikodir_arg="${MEDLEYDIR}/maiko"
|
||||
elif [ -d "${MEDLEYDIR}/../maiko" ] && check_if_maiko_dir "${MEDLEYDIR}/../maiko"
|
||||
elif check_for_maiko_exe "${MEDLEYDIR}/../maiko"
|
||||
then
|
||||
maikodir_arg="$(cd "${MEDLEYDIR}/../maiko"; pwd)"
|
||||
else
|
||||
err_msg="ERROR: Cannot find the directory containing the Maiko emulator in either
|
||||
if ! check_if_maiko_dir "${MEDLEYDIR}/maiko" && ! check_if_maiko_dir "${MEDLEYDIR}/../maiko"
|
||||
then
|
||||
err_msg="ERROR: Cannot find the Maiko directory at either
|
||||
\"${MEDLEYDIR}/maiko\" or \"${MEDLEYDIR}/../maiko\".
|
||||
Please use the --maikodir argument to specify the correct Maiko directory.
|
||||
You can use the --maikodir argument to specify the Maiko directory.
|
||||
Exiting."
|
||||
output_error_msg "${err_msg}"
|
||||
exit 53
|
||||
output_error_msg "${err_msg}"
|
||||
exit 53
|
||||
else
|
||||
err_msg="ERROR: Cannot find the Maiko executable (${maiko_exe_subdir}/${maikoprog_arg}) in either
|
||||
\"${MEDLEYDIR}/maiko\" or \"${MEDLEYDIR}/../maiko\".
|
||||
Exiting."
|
||||
output_error_msg "${err_msg}"
|
||||
exit 54
|
||||
fi
|
||||
fi
|
||||
elif ! check_if_maiko_dir "${maikodir_arg}"
|
||||
elif ! check_if_maiko_dir "${maikodir_arg}" || ! check_for_maiko_exe "${maikodir_arg}"
|
||||
then
|
||||
err_msg="In ${maikodir_stage}:
|
||||
ERROR: The value of the --maikodir argument is not in fact a directory containing
|
||||
the Maiko emulator. Exiting."
|
||||
the Maiko emulator (${maiko_exe_subdir}/${maikoprog_arg}).
|
||||
Exiting."
|
||||
output_error_msg "${err_msg}"
|
||||
exit 53
|
||||
fi
|
||||
|
||||
@@ -203,47 +203,63 @@ fi
|
||||
|
||||
# Figure out the maiko directory maiko
|
||||
check_if_maiko_dir () {
|
||||
if [ -d "$1/bin" ]
|
||||
if [ -d "$1" ] \
|
||||
&& [ -d "$1/bin" ] \
|
||||
&& [ -x "$1/bin/osversion" ] \
|
||||
&& [ -x "$1/bin/machinetype" ]
|
||||
then
|
||||
maiko_exe_subdir="$("$1/bin/osversion").$("$1/bin/machinetype")"
|
||||
return 0
|
||||
fi
|
||||
return 1
|
||||
}
|
||||
|
||||
check_for_maiko_exe () {
|
||||
if ! check_if_maiko_dir "$1"
|
||||
then
|
||||
cd "$1/bin"
|
||||
else
|
||||
return 1
|
||||
fi
|
||||
if [ -x ./osversion ] && [ -x ./machinetype ]
|
||||
maiko_exe="$1/${maiko_exe_subdir}/${maikoprog_arg}"
|
||||
if [ -x "${maiko_exe}" ]
|
||||
then
|
||||
maiko_exe="$1/$(./osversion).$(./machinetype)/${maikoprog_arg}"
|
||||
if [ -x "${maiko_exe}" ]
|
||||
then
|
||||
cd ${OLDPWD}
|
||||
return 0
|
||||
fi
|
||||
return 0
|
||||
else
|
||||
maiko_exe=""
|
||||
return 1
|
||||
fi
|
||||
maiko_exe=""
|
||||
cd ${OLDPWD}
|
||||
return 1
|
||||
}
|
||||
|
||||
if [ -z "${maikodir_arg}" ]
|
||||
then
|
||||
if [ -d "${MEDLEYDIR}/maiko" ] && check_if_maiko_dir "${MEDLEYDIR}/maiko"
|
||||
if check_for_maiko_exe "${MEDLEYDIR}/maiko"
|
||||
then
|
||||
maikodir_arg="${MEDLEYDIR}/maiko"
|
||||
elif [ -d "${MEDLEYDIR}/../maiko" ] && check_if_maiko_dir "${MEDLEYDIR}/../maiko"
|
||||
elif check_for_maiko_exe "${MEDLEYDIR}/../maiko"
|
||||
then
|
||||
maikodir_arg="$(cd "${MEDLEYDIR}/../maiko"; pwd)"
|
||||
else
|
||||
err_msg="ERROR: Cannot find the directory containing the Maiko emulator in either
|
||||
if ! check_if_maiko_dir "${MEDLEYDIR}/maiko" && ! check_if_maiko_dir "${MEDLEYDIR}/../maiko"
|
||||
then
|
||||
err_msg="ERROR: Cannot find the Maiko directory at either
|
||||
\"${MEDLEYDIR}/maiko\" or \"${MEDLEYDIR}/../maiko\".
|
||||
Please use the --maikodir argument to specify the correct Maiko directory.
|
||||
You can use the --maikodir argument to specify the Maiko directory.
|
||||
Exiting."
|
||||
output_error_msg "${err_msg}"
|
||||
exit 53
|
||||
output_error_msg "${err_msg}"
|
||||
exit 53
|
||||
else
|
||||
err_msg="ERROR: Cannot find the Maiko executable (${maiko_exe_subdir}/${maikoprog_arg}) in either
|
||||
\"${MEDLEYDIR}/maiko\" or \"${MEDLEYDIR}/../maiko\".
|
||||
Exiting."
|
||||
output_error_msg "${err_msg}"
|
||||
exit 54
|
||||
fi
|
||||
fi
|
||||
elif ! check_if_maiko_dir "${maikodir_arg}"
|
||||
elif ! check_if_maiko_dir "${maikodir_arg}" || ! check_for_maiko_exe "${maikodir_arg}"
|
||||
then
|
||||
err_msg="In ${maikodir_stage}:
|
||||
ERROR: The value of the --maikodir argument is not in fact a directory containing
|
||||
the Maiko emulator. Exiting."
|
||||
the Maiko emulator (${maiko_exe_subdir}/${maikoprog_arg}).
|
||||
Exiting."
|
||||
output_error_msg "${err_msg}"
|
||||
exit 53
|
||||
fi
|
||||
|
||||
@@ -1,15 +1,17 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Dec-2021 09:48:29" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>CMLEXEC.;5 91886
|
||||
(FILECREATED "24-May-2024 20:54:49" {MEDLEY}<SOURCES>CMLEXEC.;3 92134
|
||||
|
||||
:CHANGES-TO (VARS CMLEXECCOMS)
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:PREVIOUS-DATE " 8-Oct-2021 10:51:35"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>CMLEXEC.;3)
|
||||
:CHANGES-TO (FUNCTIONS PRINT-ALL-DOCUMENTATION)
|
||||
(VARS CMLEXECCOMS)
|
||||
|
||||
:PREVIOUS-DATE "20-May-2024 21:28:00" {MEDLEY}<SOURCES>CMLEXEC.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
|
||||
Copyright (c) 1985-1988, 1990-1991, 1993, 2021, 2024 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT CMLEXECCOMS)
|
||||
@@ -58,9 +60,11 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
|
||||
(* ;; "Arrange to use the correct compiler")
|
||||
|
||||
(PROP FILETYPE CMLEXEC)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA DIR)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA DIR)
|
||||
(NLAML)
|
||||
(LAMA PROCESS-EXEC-ID PRINT-EVENT PRINT-HISTORY EXEC-PRIN1 EVENTS-INPUT
|
||||
EVAL-INPUT EXEC-READ])
|
||||
|
||||
(FILESLOAD CMLUNDO PROFILE)
|
||||
|
||||
@@ -422,12 +426,13 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
|
||||
IT)))
|
||||
(CL:VALUES-LIST VALUES)))
|
||||
|
||||
(CL:DEFUN PRINT-ALL-DOCUMENTATION (NAME)
|
||||
(CL:DEFUN PRINT-ALL-DOCUMENTATION (NAME) (* ; "Edited 24-May-2024 20:52 by mth")
|
||||
"Print all documentation strings for NAME (as symbol and string)."
|
||||
(LET ((FOUND NIL))
|
||||
(CL:DOLIST (TYPE FILEPKGTYPES)
|
||||
(CL:WHEN (AND (CL:SYMBOLP TYPE)
|
||||
(GET TYPE 'DEFINED-BY)
|
||||
(OR (GET TYPE :DEFINED-BY)
|
||||
(GET TYPE 'DEFINED-BY))
|
||||
(HASH-TABLE-FOR-DOC-TYPE TYPE))
|
||||
(SETQ FOUND (OR (PRINT-DOCUMENTATION NAME TYPE)
|
||||
FOUND))
|
||||
@@ -1737,26 +1742,28 @@ Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
(ADDTOVAR LAMA PROCESS-EXEC-ID PRINT-EVENT PRINT-HISTORY EXEC-PRIN1 EVENTS-INPUT EVAL-INPUT EXEC-READ)
|
||||
)
|
||||
(PUTPROPS CMLEXEC COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991 1993 2021 2024)
|
||||
)
|
||||
(PUTPROPS CMLEXEC COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991 1993 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4002 4407 (XCL::EXEC-CLOSEFN 4002 . 4407)) (4409 4745 (XCL::EXEC-SHRINKFN 4409 . 4745))
|
||||
(4747 4987 (XCL::SETUP-EXEC-WINDOW 4747 . 4987)) (4989 5235 (XCL::EXEC-TITLE-FUNCTION 4989 . 5235)) (
|
||||
5237 8404 (FIX-FORM 5237 . 8404)) (8406 8526 (XCL::GET-PROCESS-PROFILE 8406 . 8526)) (8528 8809 (
|
||||
XCL::SAVE-CURRENT-EXEC-PROFILE 8528 . 8809)) (8811 9097 (XCL::SETF-GET-PROCESS-PROFILE 8811 . 9097)) (
|
||||
9099 9666 (XCL:SET-EXEC-TYPE 9099 . 9666)) (9668 9750 (XCL:SET-DEFAULT-EXEC-TYPE 9668 . 9750)) (9752
|
||||
10159 (XCL::ENTER-EXEC-FUNCTION 9752 . 10159)) (10234 16465 (DO-EVENT 10234 . 16465)) (16467 23064 (
|
||||
EXEC 16467 . 23064)) (23066 24317 (EXEC-EVAL 23066 . 24317)) (24319 25050 (PRINT-ALL-DOCUMENTATION
|
||||
24319 . 25050)) (25052 25494 (PRINT-DOCUMENTATION 25052 . 25494)) (25577 26652 (ADD-EXEC 25577 . 26652
|
||||
)) (26654 30264 (EXEC-READ-LINE 26654 . 30264)) (30335 30821 (FIND-EXEC-COMMAND 30335 . 30821)) (30823
|
||||
32709 (CIRCLAR-COPYER 30823 . 32709)) (32710 33664 (COPY-CIRCLE 32720 . 33662)) (33742 37047 (
|
||||
EXEC-READ 33752 . 36913) (DIR 36915 . 37045)) (39301 66435 (DO-APPLY-EVENT 39311 . 39873) (
|
||||
DO-HISTORY-SEARCH 39875 . 41332) (EVAL-INPUT 41334 . 46763) (EVENTS-INPUT 46765 . 48143) (EXEC-PRIN1
|
||||
48145 . 48321) (EXEC-VALUE-OF 48323 . 48662) (GET-NEXT-HISTORY-EVENT 48664 . 50159) (
|
||||
HISTORY-ADD-TO-SPELLING-LISTS 50161 . 51149) (HISTORY-NTH 51151 . 51901) (PRINT-HISTORY 51903 . 52524)
|
||||
(FIND-HISTORY-EVENTS 52526 . 57587) (PRINT-EVENT 57589 . 61810) (PRINT-EVENT-PROMPT 61812 . 63016) (
|
||||
PROCESS-EXEC-ID 63018 . 63963) (SEARCH-FOR-EVENT-NUMBER 63965 . 64593) (\PICK.EVALQT 64595 . 65106) (
|
||||
LISPXREPRINT 65108 . 66433)) (67615 67714 (EXEC-PRINT 67615 . 67714)) (67716 67981 (EXEC-FORMAT 67716
|
||||
. 67981)))))
|
||||
(FILEMAP (NIL (4032 4437 (XCL::EXEC-CLOSEFN 4032 . 4437)) (4439 4775 (XCL::EXEC-SHRINKFN 4439 . 4775))
|
||||
(4777 5017 (XCL::SETUP-EXEC-WINDOW 4777 . 5017)) (5019 5265 (XCL::EXEC-TITLE-FUNCTION 5019 . 5265)) (
|
||||
5267 8434 (FIX-FORM 5267 . 8434)) (8436 8556 (XCL::GET-PROCESS-PROFILE 8436 . 8556)) (8558 8839 (
|
||||
XCL::SAVE-CURRENT-EXEC-PROFILE 8558 . 8839)) (8841 9127 (XCL::SETF-GET-PROCESS-PROFILE 8841 . 9127)) (
|
||||
9129 9696 (XCL:SET-EXEC-TYPE 9129 . 9696)) (9698 9780 (XCL:SET-DEFAULT-EXEC-TYPE 9698 . 9780)) (9782
|
||||
10189 (XCL::ENTER-EXEC-FUNCTION 9782 . 10189)) (10264 16495 (DO-EVENT 10264 . 16495)) (16497 23094 (
|
||||
EXEC 16497 . 23094)) (23096 24347 (EXEC-EVAL 23096 . 24347)) (24349 25206 (PRINT-ALL-DOCUMENTATION
|
||||
24349 . 25206)) (25208 25650 (PRINT-DOCUMENTATION 25208 . 25650)) (25652 25731 (VALUE-OF 25652 . 25731
|
||||
)) (25733 26808 (ADD-EXEC 25733 . 26808)) (26810 30420 (EXEC-READ-LINE 26810 . 30420)) (30422 30489 (
|
||||
EXEC-EVENT-ID-PROMPT 30422 . 30489)) (30491 30977 (FIND-EXEC-COMMAND 30491 . 30977)) (30979 32865 (
|
||||
CIRCLAR-COPYER 30979 . 32865)) (32866 33820 (COPY-CIRCLE 32876 . 33818)) (33898 37203 (EXEC-READ 33908
|
||||
. 37069) (DIR 37071 . 37201)) (39457 66591 (DO-APPLY-EVENT 39467 . 40029) (DO-HISTORY-SEARCH 40031 .
|
||||
41488) (EVAL-INPUT 41490 . 46919) (EVENTS-INPUT 46921 . 48299) (EXEC-PRIN1 48301 . 48477) (
|
||||
EXEC-VALUE-OF 48479 . 48818) (GET-NEXT-HISTORY-EVENT 48820 . 50315) (HISTORY-ADD-TO-SPELLING-LISTS
|
||||
50317 . 51305) (HISTORY-NTH 51307 . 52057) (PRINT-HISTORY 52059 . 52680) (FIND-HISTORY-EVENTS 52682 .
|
||||
57743) (PRINT-EVENT 57745 . 61966) (PRINT-EVENT-PROMPT 61968 . 63172) (PROCESS-EXEC-ID 63174 . 64119)
|
||||
(SEARCH-FOR-EVENT-NUMBER 64121 . 64749) (\PICK.EVALQT 64751 . 65262) (LISPXREPRINT 65264 . 66589)) (
|
||||
66723 67717 (CASE-EQUALP 66723 . 67717)) (67719 67769 (EXEC-EVENT-PROPS 67719 . 67769)) (67771 67870 (
|
||||
EXEC-PRINT 67771 . 67870)) (67872 68137 (EXEC-FORMAT 67872 . 68137)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -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
|
||||
|
||||
Binary file not shown.
505
sources/NSFILING
505
sources/NSFILING
@@ -1,19 +1,18 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "28-Jun-99 17:07:34" {DSK}<project>medley3.5>sources>NSFILING.;2 294552
|
||||
|
||||
changes to%: (FNS \NSFILING.GENERATEFILES)
|
||||
(FILECREATED "23-May-2024 23:20:49" {DSK}<home>frank>il>medley>sources>NSFILING.;2 293309
|
||||
|
||||
previous date%: "19-Jan-93 10:59:09" {DSK}<project>medley3.5>sources>NSFILING.;1)
|
||||
:EDIT-BY "frank"
|
||||
|
||||
:CHANGES-TO (FNS \NSRANDOM.CREATE.STREAM \NSFILING.GETFILE)
|
||||
|
||||
:PREVIOUS-DATE "28-Jun-99 17:07:34" {DSK}<home>frank>il>medley>sources>NSFILING.;1)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT NSFILINGCOMS)
|
||||
|
||||
(RPAQQ NSFILINGCOMS
|
||||
[(COMS (* ; "Filing Protocol")
|
||||
[(COMS (* ; "Filing Protocol")
|
||||
(COURIERPROGRAMS FILING FILING.4)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS * NSFILINGCONSTANTS)
|
||||
(RECORDS NSFILINGSTREAM FILINGSESSION FILINGHANDLE NSFILESERVER
|
||||
@@ -54,24 +53,24 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
(*NSFILING-PAGE-CACHE-INCREMENT* 4)
|
||||
(*NSFILING-SESSION-TIMEOUT* '(900 . 21600))
|
||||
(\NSRANDOM.CHECK.CACHE))
|
||||
(COMS (* ; "Connection maintenance")
|
||||
(COMS (* ; "Connection maintenance")
|
||||
(FNS \GETFILINGCONNECTION \NSFILING.GET.NEW.SESSION \NSFILING.GET.STREAM
|
||||
\NSFILING.COURIER.OPEN \NSFILING.CLOSE.BULKSTREAM \NSFILING.RELEASE.BULKSTREAM
|
||||
FILING.CALL \NSFILING.LOGIN \NSFILING.AFTER.LOGIN \NSFILING.SET.CONTINUANCE
|
||||
\NSFILING.LOGOUT \NSFILING.DISCARD.SESSION \VALID.FILING.CONNECTIONP
|
||||
\NSFILING.CLOSE.CONNECTIONS BREAK.NSFILING.CONNECTION)
|
||||
(ADDVARS (\AFTERLOGINFNS \NSFILING.AFTER.LOGIN)))
|
||||
(COMS (* ; "Support")
|
||||
(COMS (* ; "Support")
|
||||
(FNS \NSFILING.CONNECT \NSFILING.MAYBE.CREATE \NSFILING.REMOVEQUOTES
|
||||
\NSFILING.ADDQUOTES \FILING.ATTRIBUTE.TYPE.SEQUENCE \FILING.ATTRIBUTE.TYPE
|
||||
\LISP.TO.NSFILING.ATTRIBUTE))
|
||||
(COMS (* ; "FILINGHANDLE stuff")
|
||||
(COMS (* ; "FILINGHANDLE stuff")
|
||||
(FNS \NSFILING.GETFILE \NSFILING.LOOKUP.CACHE \NSFILING.ADD.TO.CACHE
|
||||
\NSFILING.OPEN.HANDLE \NSFILING.CONFLICTP \NSFILING.CHECK.ACCESS
|
||||
\NSFILING.FILLIN.ATTRIBUTES \NSFILING.COMPOSE.PATHNAME \NSFILING.PARSE.FILENAME
|
||||
\NSFILING.ERRORHANDLER \NSFILING.WHENCLOSED \NSFILING.CLOSE.HANDLE
|
||||
\NSFILING.FULLNAME))
|
||||
(COMS (* ; "NSFILING device")
|
||||
(COMS (* ; "NSFILING device")
|
||||
(FNS \NSFILING.OPENFILE \NSFILING.HANDLE.ERROR \NSFILING.CLOSEFILE \NSFILING.EVENTFN
|
||||
\NSFILING.DELETEFILE \NSFILING.CHILDLESS-P \NSFILING.DIRECTORYNAMEP
|
||||
\NSFILING.HOSTNAMEP \NSFILING.GETFILENAME \NSFILING.GETFILEINFO
|
||||
@@ -80,21 +79,20 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
\NSFILING.GETEOFPTR \NSFILING.GENERATEFILES \NSFILING.GENERATE.STARS
|
||||
\NSFILING.NEXTFILE \NSFILING.FILEINFOFN \NSFILING.RENAMEFILE \NSFILING.COPYFILE
|
||||
\NSFILING.COPY/RENAME))
|
||||
(COMS (* ; "Random access methods")
|
||||
(COMS (* ; "Random access methods")
|
||||
(FNS \NSRANDOM.CLOSEFILE \NSRANDOM.RELEASE.HANDLE \NSRANDOM.RELEASE.LOCK
|
||||
\NSRANDOM.RELEASE.IF.ERROR \NSRANDOM.CREATE.STREAM \NSRANDOM.READPAGES
|
||||
\NSRANDOM.READ.SEGMENT \NSRANDOM.PREPARE.CACHE \NSRANDOM.FETCH.CACHE
|
||||
\NSRANDOM.CHECK.CACHE \NSRANDOM.WRITEPAGES \NSRANDOM.WRITE.SEGMENT
|
||||
\NSRANDOM.WROTE.HANDLE \NSRANDOM.SETEOFPTR \NSRANDOM.TRUNCATEFILE
|
||||
\NSRANDOM.UPDATE.VALIDATION \NSRANDOM.OPENFILE)
|
||||
(* ; "error handling")
|
||||
(* ; "error handling")
|
||||
(FNS \NSRANDOM.HANDLE.ERROR \NSRANDOM.PROCEEDABLE.ERROR \NSRANDOM.REESTABLISH
|
||||
\NSRANDOM.STREAM.CHANGED \NSRANDOM.DESTROY.STREAM \NSRANDOM.SESSION.WATCHER
|
||||
\NSRANDOM.ENSURE.WATCHER))
|
||||
(COMS (* ; "Cleaning up directories")
|
||||
(COMS (* ; "Cleaning up directories")
|
||||
(FNS GC-FILING-DIRECTORY \NSGC.COLLECT.DIRECTORIES))
|
||||
(COMS (* ;
|
||||
"Deserialize (special for NSMAIL)")
|
||||
(COMS (* ; "Deserialize (special for NSMAIL)")
|
||||
(FNS \NSFILING.DESERIALIZE \NSFILING.DESERIALIZE1))
|
||||
[COMS (FNS \NSFILING.INIT)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\NSFILING.INIT]
|
||||
@@ -418,106 +416,100 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS NSFILINGSTREAM ( (* ;
|
||||
"Overlays STREAM. F1-2 and FW6-8 are used by the bulkdata device")
|
||||
(NSFILING.CONNECTION (fetch F3 of DATUM)
|
||||
(replace F3 of DATUM with NEWVALUE))
|
||||
(* ;
|
||||
"Session on which this stream is open")
|
||||
(NSFILING.HANDLE (fetch F4 of DATUM)
|
||||
(replace F4 of DATUM with NEWVALUE))
|
||||
(* ; "Filing HANDLE")
|
||||
(NSFILING.NEW.ATTRIBUTES (fetch F5 of DATUM)
|
||||
(replace F5 of DATUM with NEWVALUE))
|
||||
(* ;
|
||||
"For output sequential files, the attributes to install after we write the file")
|
||||
(NSFILING.PAGE.CACHE (fetch F1 of DATUM)
|
||||
(replace F1 of DATUM with NEWVALUE))
|
||||
(* ;
|
||||
"Cache of pages read from server but not yet read by client")
|
||||
(NSFILING.SERVER.LENGTH (fetch F2 of DATUM)
|
||||
(replace F2 of DATUM with NEWVALUE))
|
||||
(* ;
|
||||
"For random-access streams, actual length of file on server")
|
||||
(NSFILING.LAST.REQUEST (fetch FW6 of DATUM)
|
||||
(replace FW6 of DATUM with NEWVALUE))
|
||||
(* ;
|
||||
"Last page requested to be read or written")
|
||||
))
|
||||
(ACCESSFNS NSFILINGSTREAM ( (* ;
|
||||
"Overlays STREAM. F1-2 and FW6-8 are used by the bulkdata device")
|
||||
(NSFILING.CONNECTION (fetch F3 of DATUM)
|
||||
(replace F3 of DATUM with NEWVALUE))
|
||||
(* ;
|
||||
"Session on which this stream is open")
|
||||
(NSFILING.HANDLE (fetch F4 of DATUM)
|
||||
(replace F4 of DATUM with NEWVALUE))
|
||||
(* ; "Filing HANDLE")
|
||||
(NSFILING.NEW.ATTRIBUTES (fetch F5 of DATUM)
|
||||
(replace F5 of DATUM with NEWVALUE))
|
||||
(* ;
|
||||
"For output sequential files, the attributes to install after we write the file")
|
||||
(NSFILING.PAGE.CACHE (fetch F1 of DATUM)
|
||||
(replace F1 of DATUM with NEWVALUE))
|
||||
(* ;
|
||||
"Cache of pages read from server but not yet read by client")
|
||||
(NSFILING.SERVER.LENGTH (fetch F2 of DATUM)
|
||||
(replace F2 of DATUM with NEWVALUE))
|
||||
(* ;
|
||||
"For random-access streams, actual length of file on server")
|
||||
(NSFILING.LAST.REQUEST (fetch FW6 of DATUM)
|
||||
(replace FW6 of DATUM with NEWVALUE))
|
||||
(* ;
|
||||
"Last page requested to be read or written")
|
||||
))
|
||||
|
||||
(DATATYPE FILINGSESSION ((FSLOGINCHANGED FLAG) (* ;
|
||||
"True if login info changes for this host")
|
||||
(FSREALACTIVITY FLAG) (* ;
|
||||
"Set true when there have been non-CONTINUE calls made on this session")
|
||||
(NIL BITS 6)
|
||||
(FSPARSEDNAME POINTER) (* ; "Canonical NSNAME of server")
|
||||
(FSNAMESTRING POINTER) (* ; "same as a Lisp string")
|
||||
(FSADDRESS POINTER) (* ; "NSADDRESS of server")
|
||||
(FSPROCESSNAME POINTER) (* ;
|
||||
"Courier stream open for this session, or NIL if none")
|
||||
(FSSESSIONHANDLE POINTER) (* ; "Handle for this session")
|
||||
(FSSESSIONLOCK POINTER)
|
||||
(FSLASTREALACTIVITYTIMER POINTER)
|
||||
(* ;
|
||||
"Time of last interesting activity")
|
||||
(FSDEVICENAME POINTER)
|
||||
(FSCOURIERSTREAMS POINTER) (* ;
|
||||
"Courier streams usable by session")
|
||||
(FSCACHEDHANDLES POINTER) (* ;
|
||||
"Zero or more instances of FILINGHANDLE describing handles we have open in this session")
|
||||
(FSLOGINNAME POINTER) (* ;
|
||||
"Name under which this session is logged in")
|
||||
(FSPROTOCOLNAME POINTER) (* ; "FILING or OLDFILING")
|
||||
(FSPROTOCOLDEF POINTER) (* ;
|
||||
"Courier def for FILING.CALL to use")
|
||||
(FSSESSIONTIMER POINTER) (* ;
|
||||
"Time we last did anything at all in this session")
|
||||
(FSCONTINUANCE WORD) (* ;
|
||||
"How long in msecs we can be idle without having server close session")
|
||||
(FSVERSION WORD) (* ;
|
||||
"Version of the protocol in use by this server")
|
||||
(* ; "Spares")
|
||||
(NIL POINTER)
|
||||
(NIL POINTER)
|
||||
(NIL POINTER)))
|
||||
(DATATYPE FILINGSESSION ((FSLOGINCHANGED FLAG) (* ;
|
||||
"True if login info changes for this host")
|
||||
(FSREALACTIVITY FLAG) (* ;
|
||||
"Set true when there have been non-CONTINUE calls made on this session")
|
||||
(NIL BITS 6)
|
||||
(FSPARSEDNAME POINTER) (* ; "Canonical NSNAME of server")
|
||||
(FSNAMESTRING POINTER) (* ; "same as a Lisp string")
|
||||
(FSADDRESS POINTER) (* ; "NSADDRESS of server")
|
||||
(FSPROCESSNAME POINTER) (* ;
|
||||
"Courier stream open for this session, or NIL if none")
|
||||
(FSSESSIONHANDLE POINTER) (* ; "Handle for this session")
|
||||
(FSSESSIONLOCK POINTER)
|
||||
(FSLASTREALACTIVITYTIMER POINTER) (* ; "Time of last interesting activity")
|
||||
(FSDEVICENAME POINTER)
|
||||
(FSCOURIERSTREAMS POINTER) (* ; "Courier streams usable by session")
|
||||
(FSCACHEDHANDLES POINTER) (* ;
|
||||
"Zero or more instances of FILINGHANDLE describing handles we have open in this session")
|
||||
(FSLOGINNAME POINTER) (* ;
|
||||
"Name under which this session is logged in")
|
||||
(FSPROTOCOLNAME POINTER) (* ; "FILING or OLDFILING")
|
||||
(FSPROTOCOLDEF POINTER) (* ;
|
||||
"Courier def for FILING.CALL to use")
|
||||
(FSSESSIONTIMER POINTER) (* ;
|
||||
"Time we last did anything at all in this session")
|
||||
(FSCONTINUANCE WORD) (* ;
|
||||
"How long in msecs we can be idle without having server close session")
|
||||
(FSVERSION WORD) (* ;
|
||||
"Version of the protocol in use by this server")
|
||||
(* ; "Spares")
|
||||
(NIL POINTER)
|
||||
(NIL POINTER)
|
||||
(NIL POINTER)))
|
||||
|
||||
(DATATYPE FILINGHANDLE ((NSHDIRECTORYP FLAG) (* ; "Handle is a directory")
|
||||
(NSHWASREAD FLAG) (* ;
|
||||
"True if we have read file since we obtained the handle (in which case read date has been updated)")
|
||||
(NSHWASWRITTEN FLAG)
|
||||
(NSHWASMODIFIED FLAG)
|
||||
(NIL BITS 4)
|
||||
(NSHDATUM POINTER) (* ;
|
||||
"The file handle datum used in Courier calls")
|
||||
(NSHFILEID POINTER) (* ; "FILE.ID of file")
|
||||
(NSHNAME POINTER) (* ;
|
||||
"Full name of the file referenced")
|
||||
(NSHPATHNAME POINTER) (* ; "Canonical pathname of file")
|
||||
(NSHATTRIBUTES POINTER) (* ; "Cached attributes")
|
||||
(NSHACCESS POINTER) (* ;
|
||||
"Current access controls on handle")
|
||||
(NSHTIMER POINTER) (* ; "Last reference to this handle")
|
||||
(NSHBUSYCOUNT WORD) (* ;
|
||||
"Number of current users of handle")
|
||||
(NIL WORD)
|
||||
(NSHDIRECTORYPATH POINTER) (* ;
|
||||
"For directories, the list of component dirs")
|
||||
(NIL POINTER))
|
||||
NSHTIMER _ (SETUPTIMER 0)
|
||||
NSHDIRECTORYPATH _ T)
|
||||
(DATATYPE FILINGHANDLE ((NSHDIRECTORYP FLAG) (* ; "Handle is a directory")
|
||||
(NSHWASREAD FLAG) (* ;
|
||||
"True if we have read file since we obtained the handle (in which case read date has been updated)")
|
||||
(NSHWASWRITTEN FLAG)
|
||||
(NSHWASMODIFIED FLAG)
|
||||
(NIL BITS 4)
|
||||
(NSHDATUM POINTER) (* ;
|
||||
"The file handle datum used in Courier calls")
|
||||
(NSHFILEID POINTER) (* ; "FILE.ID of file")
|
||||
(NSHNAME POINTER) (* ; "Full name of the file referenced")
|
||||
(NSHPATHNAME POINTER) (* ; "Canonical pathname of file")
|
||||
(NSHATTRIBUTES POINTER) (* ; "Cached attributes")
|
||||
(NSHACCESS POINTER) (* ; "Current access controls on handle")
|
||||
(NSHTIMER POINTER) (* ; "Last reference to this handle")
|
||||
(NSHBUSYCOUNT WORD) (* ; "Number of current users of handle")
|
||||
(NIL WORD)
|
||||
(NSHDIRECTORYPATH POINTER) (* ;
|
||||
"For directories, the list of component dirs")
|
||||
(NIL POINTER))
|
||||
NSHTIMER _ (SETUPTIMER 0)
|
||||
NSHDIRECTORYPATH _ T)
|
||||
|
||||
(RECORD NSFILESERVER (NSFSPARSEDNAME . NSFSADDRESSES))
|
||||
|
||||
(RECORD NSFILINGDEVICEINFO (NSFILESERVER NSWATCHERPROC NSFILINGLOCK NSFILINGNAME NSRANDOMDEVICE
|
||||
. NSCONNECTIONS))
|
||||
|
||||
(RECORD \NSFILING.GENFILESTATE (CURRENTINFO NSCONNECTION NSGENERATOR NSFILTER NSIGNOREDIRECTORIES
|
||||
NSBULKSTREAM))
|
||||
(RECORD \NSFILING.GENFILESTATE (CURRENTINFO NSCONNECTION NSGENERATOR NSFILTER NSIGNOREDIRECTORIES
|
||||
NSBULKSTREAM))
|
||||
|
||||
(RECORD NSFILINGPARSE (NSDIRECTORIES NSROOTNAME NSVERSION NSDIRECTORYP NSHASPERIOD))
|
||||
|
||||
(RECORD NSPAGECACHE (NSPSIZE . NSPHEADER)
|
||||
(RECORD NSPHEADER (NSPTAIL . NSPBUFFERS)))
|
||||
(RECORD NSPHEADER (NSPTAIL . NSPBUFFERS)))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'FILINGSESSION
|
||||
@@ -571,13 +563,12 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS WITHOUT.SESSION.MONITOR MACRO
|
||||
[(SESSION . FORMS)
|
||||
(LET ((LOCK (fetch FSSESSIONLOCK of SESSION)))
|
||||
(DECLARE (LOCALVARS LOCK))
|
||||
(RELEASE.MONITORLOCK LOCK)
|
||||
(PROG1 (PROGN . FORMS)
|
||||
(OBTAIN.MONITORLOCK LOCK])
|
||||
(PUTPROPS WITHOUT.SESSION.MONITOR MACRO [(SESSION . FORMS)
|
||||
(LET ((LOCK (fetch FSSESSIONLOCK of SESSION)))
|
||||
(DECLARE (LOCALVARS LOCK))
|
||||
(RELEASE.MONITORLOCK LOCK)
|
||||
(PROG1 (PROGN . FORMS)
|
||||
(OBTAIN.MONITORLOCK LOCK])
|
||||
)
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
@@ -749,10 +740,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
(RPAQQ \NSFILING.NULL.HANDLE (0 0))
|
||||
|
||||
(RPAQQ \NSFILING.PROTECTION.BITS ((READ . 16)
|
||||
(WRITE . 8)
|
||||
(DELETE . 1)
|
||||
(CREATE . 2)
|
||||
(MODIFY . 4)))
|
||||
(WRITE . 8)
|
||||
(DELETE . 1)
|
||||
(CREATE . 2)
|
||||
(MODIFY . 4)))
|
||||
|
||||
(RPAQQ \NSFILING.ATTRIBUTES
|
||||
((CHECKSUM 0 CARDINAL)
|
||||
@@ -801,11 +792,9 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
(FILETYPE FILE.TYPE)))
|
||||
|
||||
(RPAQ \NSFILING.USEFUL.ATTRIBUTE.TYPES (\FILING.ATTRIBUTE.TYPE.SEQUENCE '(CREATED.ON FILE.ID
|
||||
IS.DIRECTORY
|
||||
PATHNAME
|
||||
SIZE.IN.BYTES
|
||||
FILE.TYPE VERSION
|
||||
)))
|
||||
IS.DIRECTORY PATHNAME
|
||||
SIZE.IN.BYTES
|
||||
FILE.TYPE VERSION)))
|
||||
)
|
||||
|
||||
(RPAQ? FILING.CACHE.LIMIT 6)
|
||||
@@ -1608,6 +1597,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
|
||||
(\NSFILING.GETFILE
|
||||
[LAMBDA (DEVICE FILENAME ACCESS RECOG OPTION PARAMETERS DIROK SEQUENTIAL OLDSTREAM)
|
||||
(* ; "Edited 23-May-2024 23:12 by frank")
|
||||
(* ; "Edited 19-Aug-88 17:17 by bvm")
|
||||
|
||||
(* ;; "Opens FILENAME for specified ACCESS and RECOG, returning a stream. If OPTION is NAME, ATTRIBUTES, or HANDLE, just return the appropriate information instead of a stream. If OPTION is DIRECTORY, return T or NIL if FILENAME is a directory or not -- PARAMETERS gives the CREATE? option in case the directory doesn't exist. If ACCESS is not NONE, then PARAMETERS gives extra parameters for the open.")
|
||||
@@ -1621,56 +1611,53 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
(RETURN NIL)))
|
||||
[COND
|
||||
((EQ ACCESS 'SERIALIZE) (* ;
|
||||
"Like INPUT, but retrieve a serialized stream on file")
|
||||
"Like INPUT, but retrieve a serialized stream on file")
|
||||
(SETQ ACCESS 'INPUT)
|
||||
(SETQ SERIALIZE 'SERIALIZE)
|
||||
(SETQ SEQUENTIAL T))
|
||||
((AND (NOT SEQUENTIAL)
|
||||
(NOT OPTION)
|
||||
*NSFILING-RANDOM-ACCESS*) (* ;
|
||||
"RANDEVICE set if we want to open a randaccess stream")
|
||||
(SETQ RANDEVICE (fetch NSRANDOMDEVICE of (fetch DEVICEINFO of
|
||||
DEVICE]
|
||||
"RANDEVICE set if we want to open a randaccess stream")
|
||||
(SETQ RANDEVICE (fetch NSRANDOMDEVICE of (fetch DEVICEINFO of DEVICE]
|
||||
RETRY
|
||||
[COND
|
||||
[(SETQ HANDLE (\NSFILING.LOOKUP.CACHE SESSION FILENAME))
|
||||
(* ; "Cache hit")
|
||||
(COND
|
||||
(OPTION (* ;
|
||||
"Got handle, so just do what the option said (else fall thru and try to open a file)")
|
||||
"Got handle, so just do what the option said (else fall thru and try to open a file)")
|
||||
(GO HANDLE.OPTION]
|
||||
((AND (LISTP FILENAME)
|
||||
(EQ (CAR FILENAME)
|
||||
'FILE.ID)) (* ; "Identifying file by ID, take shortcut. Do this second just in case we have cached this file already")
|
||||
(SETQ FILE.ID (CADR FILENAME)))
|
||||
(T (* ;
|
||||
"Parse the name and go thru all this hassle")
|
||||
"Parse the name and go thru all this hassle")
|
||||
(SETQ PARSE (\NSFILING.PARSE.FILENAME FILENAME))
|
||||
(SETQ DIRPATH (fetch NSDIRECTORIES of PARSE))
|
||||
(COND
|
||||
((NULL DIRPATH) (* ;
|
||||
"No directories specified, so is illegal name")
|
||||
"No directories specified, so is illegal name")
|
||||
(GO FILE.NOT.FOUND))
|
||||
[(EQ OPTION 'DIRECTORY)
|
||||
(RETURN (AND (fetch NSDIRECTORYP of PARSE)
|
||||
(SETQ HANDLE (\NSFILING.CONNECT SESSION DIRPATH T PARAMETERS
|
||||
))
|
||||
(SETQ HANDLE (\NSFILING.CONNECT SESSION DIRPATH T PARAMETERS))
|
||||
(GO HANDLE.OPTION]
|
||||
((AND (fetch NSDIRECTORYP of PARSE)
|
||||
(NOT DIROK)) (* ;
|
||||
"No name, just a directory. Failure unless caller said a directory file is ok")
|
||||
"No name, just a directory. Failure unless caller said a directory file is ok")
|
||||
(GO FILE.NOT.FOUND)))
|
||||
(SETQ EXPLICIT-VERSION (fetch NSVERSION of PARSE))
|
||||
(SETQ ROOTNAME (fetch NSROOTNAME of PARSE]
|
||||
[COND
|
||||
(HANDLE (* ;
|
||||
"We have an open file handle from the cache")
|
||||
"We have an open file handle from the cache")
|
||||
)
|
||||
[FILE.ID (* ;
|
||||
"Try to open an existing file by ID.")
|
||||
"Try to open an existing file by ID.")
|
||||
(COND
|
||||
([SETQ HANDLE (\NSFILING.OPEN.HANDLE SESSION
|
||||
`((FILE.ID ,FILE.ID))
|
||||
([SETQ HANDLE (\NSFILING.OPEN.HANDLE SESSION `((FILE.ID ,FILE.ID))
|
||||
(AND RANDEVICE (SELECTQ ACCESS
|
||||
((BOTH APPEND)
|
||||
'OUTPUT)
|
||||
@@ -1680,16 +1667,15 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
(T (* ; "open by name")
|
||||
(SETQ OLDHANDLE (\NSFILING.OPEN.HANDLE
|
||||
SESSION
|
||||
[\NSFILING.COMPOSE.PATHNAME
|
||||
DIRPATH ROOTNAME (OR EXPLICIT-VERSION
|
||||
(SELECTQ RECOG
|
||||
(OLDEST '-)
|
||||
'+]
|
||||
[\NSFILING.COMPOSE.PATHNAME DIRPATH ROOTNAME
|
||||
(OR EXPLICIT-VERSION (SELECTQ RECOG
|
||||
(OLDEST '-)
|
||||
'+]
|
||||
(AND RANDEVICE (SETQ HAVELOCK
|
||||
(SELECTQ ACCESS
|
||||
((OUTPUT BOTH APPEND)
|
||||
(* ;
|
||||
"When opening for output, only get lock right now if we know we will be playing with the old file.")
|
||||
"When opening for output, only get lock right now if we know we will be playing with the old file.")
|
||||
(AND (OR EXPLICIT-VERSION
|
||||
(NEQ RECOG 'NEW))
|
||||
'OUTPUT))
|
||||
@@ -1703,18 +1689,18 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
'ACCESS.ERROR)
|
||||
(EQ (CADDR OLDHANDLE)
|
||||
'FileNotFound] (* ;
|
||||
"No file of any version exists by this name")
|
||||
"No file of any version exists by this name")
|
||||
(SETQ HAVELOCK NIL)
|
||||
(SELECTQ RECOG
|
||||
((OLD OLDEST) (* ;
|
||||
"No version exists, so certainly this one doesn't")
|
||||
"No version exists, so certainly this one doesn't")
|
||||
(RETURN NIL))
|
||||
(COND
|
||||
((EQ ACCESS 'INPUT) (* ;
|
||||
"Version given explicitly, file does not exist")
|
||||
"Version given explicitly, file does not exist")
|
||||
(RETURN NIL))
|
||||
((NULL EXPLICIT-VERSION) (* ;
|
||||
"No extant version, so create number 1")
|
||||
"No extant version, so create number 1")
|
||||
(OR RANDEVICE (SETQ VERSION 1)))
|
||||
(T (SETQ VERSION EXPLICIT-VERSION]
|
||||
((LISTP OLDHANDLE) (* ; "Error case")
|
||||
@@ -1723,11 +1709,11 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
(GO HANDLE.ERROR))
|
||||
((AND (fetch NSHDIRECTORYP of OLDHANDLE)
|
||||
(NOT DIROK)) (* ;
|
||||
"It's a directory, don't try to treat as ordinary file")
|
||||
"It's a directory, don't try to treat as ordinary file")
|
||||
(GO FILE.NOT.FOUND))
|
||||
[(OR EXPLICIT-VERSION (NEQ RECOG 'NEW))
|
||||
(* ;
|
||||
"Old file exists, use it unless we explicitly requested a new version")
|
||||
"Old file exists, use it unless we explicitly requested a new version")
|
||||
(SETQ HANDLE OLDHANDLE)
|
||||
(COND
|
||||
(EXPLICIT-VERSION (SETQ VERSION EXPLICIT-VERSION]
|
||||
@@ -1735,7 +1721,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
(SETQ VERSION (ADD1 (OR [CADR (ASSOC 'VERSION (OR (fetch NSHATTRIBUTES
|
||||
of OLDHANDLE)
|
||||
(
|
||||
\NSFILING.FILLIN.ATTRIBUTES
|
||||
\NSFILING.FILLIN.ATTRIBUTES
|
||||
SESSION OLDHANDLE]
|
||||
(GO FILE.NOT.FOUND]
|
||||
|
||||
@@ -1745,7 +1731,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
VERSION))
|
||||
(COND
|
||||
(OPTION (* ;
|
||||
"Not opening file, something simpler")
|
||||
"Not opening file, something simpler")
|
||||
(GO HANDLE.OPTION))
|
||||
((AND HANDLE (NOT OLDSTREAM)
|
||||
(\NSFILING.CONFLICTP DEVICE SESSION HANDLE ACCESS))
|
||||
@@ -1753,10 +1739,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
(SELECTQ ACCESS
|
||||
(INPUT (COND
|
||||
((NULL HANDLE) (* ;
|
||||
"Odd to get here. E.g., open for INPUT recog NEW.")
|
||||
"Odd to get here. E.g., open for INPUT recog NEW.")
|
||||
(GO FILE.NOT.FOUND))
|
||||
(RANDEVICE (SETQ FILESTREAM (\NSRANDOM.CREATE.STREAM SESSION HANDLE
|
||||
'INPUT HAVELOCK OLDSTREAM)))
|
||||
(RANDEVICE (SETQ FILESTREAM (\NSRANDOM.CREATE.STREAM SESSION HANDLE
|
||||
RANDEVICE 'INPUT HAVELOCK OLDSTREAM)))
|
||||
[(NEQ (fetch NSHACCESS of HANDLE)
|
||||
'OUTPUT) (* ; "Just retrieve old file")
|
||||
(SETQ FILESTREAM (FILING.CALL SESSION (OR SERIALIZE 'RETRIEVE)
|
||||
@@ -1767,18 +1753,18 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
(COND
|
||||
((AND (NEQ ACCESS 'OUTPUT)
|
||||
(NOT RANDEVICE)) (* ;
|
||||
"Sequential can only write whole files")
|
||||
"Sequential can only write whole files")
|
||||
(GO FILE.WONT.OPEN)))
|
||||
(COND
|
||||
[HANDLE (* ;
|
||||
"File already exists, need to overwrite")
|
||||
"File already exists, need to overwrite")
|
||||
(COND
|
||||
(RANDEVICE (SETQ FILESTREAM (\NSRANDOM.CREATE.STREAM SESSION
|
||||
HANDLE ACCESS HAVELOCK
|
||||
OLDSTREAM T)))
|
||||
(RANDEVICE (SETQ FILESTREAM
|
||||
(\NSRANDOM.CREATE.STREAM SESSION HANDLE RANDEVICE
|
||||
ACCESS HAVELOCK OLDSTREAM T)))
|
||||
[(NULL (fetch NSHACCESS of HANDLE))
|
||||
(* ;
|
||||
"Overwrite existing file sequentially")
|
||||
"Overwrite existing file sequentially")
|
||||
[SETQ FILESTREAM (OR (\NSFILING.CHECK.ACCESS SESSION HANDLE
|
||||
'WRITE)
|
||||
(FILING.CALL SESSION 'REPLACE
|
||||
@@ -1788,15 +1774,16 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
(COND
|
||||
((type? STREAM FILESTREAM)
|
||||
(* ;
|
||||
"Cache of saved attributes is now wrong")
|
||||
"Cache of saved attributes is now wrong")
|
||||
(replace NSHATTRIBUTES of HANDLE with NIL)
|
||||
(* ;
|
||||
"Save attributes to change after file is stored")
|
||||
(replace NSFILING.NEW.ATTRIBUTES of FILESTREAM
|
||||
with PARAMETERS]
|
||||
"Save attributes to change after file is stored")
|
||||
(replace NSFILING.NEW.ATTRIBUTES of FILESTREAM with
|
||||
PARAMETERS
|
||||
]
|
||||
(T (GO FILE.BUSY]
|
||||
(OLDSTREAM (* ;
|
||||
"Trying to reopen old stream, failed.")
|
||||
"Trying to reopen old stream, failed.")
|
||||
(RETURN NIL))
|
||||
[(SETQ OLDHANDLE (\NSFILING.CONNECT SESSION DIRPATH T T))
|
||||
(* ; "Need to create the file, so first had to get a handle on the parent (CREATE and STORE procedures do not permit PATHNAME as one of the specifying attributes).")
|
||||
@@ -1808,7 +1795,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
'CREATE
|
||||
(fetch NSHDATUM of OLDHANDLE)
|
||||
`([NAME ,(\NSFILING.REMOVEQUOTES (fetch NSROOTNAME
|
||||
of PARSE]
|
||||
of PARSE]
|
||||
,@[AND VERSION `((VERSION ,VERSION]
|
||||
,@PARAMETERS)
|
||||
'((LOCK EXCLUSIVE))
|
||||
@@ -1824,43 +1811,41 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
NSHDATUM _ HANDLE
|
||||
NSHACCESS _ 'OUTPUT]
|
||||
(* ;
|
||||
"Create failed or we can't read its attributes! Fall thru to error handler")
|
||||
"Create failed or we can't read its attributes! Fall thru to error handler")
|
||||
(SETQ FILESTREAM HANDLE)
|
||||
(GO HANDLE.ERROR))
|
||||
((type? STREAM (SETQ FILESTREAM
|
||||
(\NSRANDOM.CREATE.STREAM SESSION
|
||||
HANDLE ACCESS T)))
|
||||
(\NSRANDOM.CREATE.STREAM SESSION HANDLE
|
||||
RANDEVICE ACCESS T)))
|
||||
(* ;
|
||||
"Succeeded in opening stream, i.e., no further conflicts detected.")
|
||||
"Succeeded in opening stream, i.e., no further conflicts detected.")
|
||||
(SETQ FULLNAME (\NSFILING.FULLNAME SESSION HANDLE)))
|
||||
(T (GO HANDLE.ERROR]
|
||||
(T (* ; "Start writing new file, guessing the version. Ideally we shouldn't guess the version, but Lisp wants a full file name NOW (grumble).")
|
||||
(SETQ FILESTREAM
|
||||
(OR (\NSFILING.CHECK.ACCESS SESSION OLDHANDLE 'ADD)
|
||||
(FILING.CALL SESSION 'STORE (fetch NSHDATUM
|
||||
of OLDHANDLE)
|
||||
`([NAME ,(\NSFILING.REMOVEQUOTES (fetch
|
||||
NSROOTNAME
|
||||
of PARSE]
|
||||
(FILING.CALL SESSION 'STORE (fetch NSHDATUM of OLDHANDLE)
|
||||
`([NAME ,(\NSFILING.REMOVEQUOTES (fetch NSROOTNAME
|
||||
of PARSE]
|
||||
(VERSION ,VERSION)
|
||||
,@PARAMETERS)
|
||||
NIL NIL SESSION 'RETURNERRORS 'KEEPSTREAM]
|
||||
(T (GO FILE.NOT.FOUND))))
|
||||
(\ILLEGAL.ARG ACCESS))
|
||||
(COND
|
||||
((NOT (type? STREAM FILESTREAM)) (* ;
|
||||
"Had handle, but failed to open it.")
|
||||
((NOT (type? STREAM FILESTREAM)) (* ;
|
||||
"Had handle, but failed to open it.")
|
||||
(GO HANDLE.ERROR)))
|
||||
(replace FULLFILENAME of FILESTREAM with (COND
|
||||
(*UPPER-CASE-FILE-NAMES*
|
||||
(MKATOM (U-CASE FULLNAME)))
|
||||
(T FULLNAME)))
|
||||
(*UPPER-CASE-FILE-NAMES*
|
||||
(MKATOM (U-CASE FULLNAME)))
|
||||
(T FULLNAME)))
|
||||
(replace NSFILING.CONNECTION of FILESTREAM with SESSION)
|
||||
(replace NSFILING.HANDLE of FILESTREAM with HANDLE)
|
||||
(replace DEVICE of FILESTREAM with (OR RANDEVICE DEVICE))
|
||||
(COND
|
||||
(HANDLE (add (fetch NSHBUSYCOUNT of HANDLE)
|
||||
1)))
|
||||
1)))
|
||||
(RETURN FILESTREAM)
|
||||
HANDLE.OPTION
|
||||
|
||||
@@ -1870,12 +1855,12 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
(RETURN (SELECTQ OPTION
|
||||
(NAME (if HANDLE
|
||||
then (\NSFILING.FULLNAME SESSION HANDLE NIL
|
||||
*UPPER-CASE-FILE-NAMES*)
|
||||
else (* ;
|
||||
"OUTFILEP case: no handle, but we have computed the name")
|
||||
FULLNAME))
|
||||
*UPPER-CASE-FILE-NAMES*)
|
||||
else (* ;
|
||||
"OUTFILEP case: no handle, but we have computed the name")
|
||||
FULLNAME))
|
||||
(DIRECTORY (* ;
|
||||
"I'm pretty sure HANDLE can't be NIL at this point, but a little test never hurt anyone.")
|
||||
"I'm pretty sure HANDLE can't be NIL at this point, but a little test never hurt anyone.")
|
||||
(AND HANDLE (fetch NSHDIRECTORYP of HANDLE)
|
||||
(\NSFILING.FULLNAME SESSION HANDLE NIL
|
||||
*UPPER-CASE-FILE-NAMES*)))
|
||||
@@ -1898,7 +1883,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
(SETQ HAVELOCK (SETQ HANDLE (SETQ VERSION NIL)))
|
||||
(GO RETRY))
|
||||
(T (* ;
|
||||
"Can't get connection at all? OH well, die as if it were true from the start.")
|
||||
"Can't get connection at all? OH well, die as if it were true from the start.")
|
||||
(RETURN NIL)))
|
||||
FILE.NOT.FOUND
|
||||
(COND
|
||||
@@ -3480,7 +3465,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
(AND RESETSTATE (\NSRANDOM.RELEASE.LOCK SESSION HANDLE])
|
||||
|
||||
(\NSRANDOM.CREATE.STREAM
|
||||
[LAMBDA (SESSION HANDLE ACCESS GOTCONTROLS OLDSTREAM CHECKACCESS)
|
||||
[LAMBDA (SESSION HANDLE DEVICE ACCESS GOTCONTROLS OLDSTREAM CHECKACCESS)
|
||||
(* ; "Edited 23-May-2024 23:07 by frank")
|
||||
(* ; "Edited 19-Aug-88 17:24 by bvm")
|
||||
(PROG NIL
|
||||
[COND
|
||||
@@ -3492,38 +3478,35 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
ERROR)
|
||||
[COND
|
||||
((SELECTQ OLDACCESS
|
||||
((NIL) (* ;
|
||||
"Just a cached handle, no controls")
|
||||
((NIL) (* ; "Just a cached handle, no controls")
|
||||
NIL)
|
||||
(OUTPUT (* ;
|
||||
"Handle already open for write, can't do anything else")
|
||||
"Handle already open for write, can't do anything else")
|
||||
T)
|
||||
(INPUT (* ;
|
||||
"Open for input, so only other input streams allowed.")
|
||||
"Open for input, so only other input streams allowed.")
|
||||
(NEQ ACCESS 'INPUT))
|
||||
(SHOULDNT))
|
||||
(RETURN (LISPERROR "FILE WON'T OPEN" (\NSFILING.FULLNAME SESSION HANDLE]
|
||||
(COND
|
||||
((NEQ OLDACCESS 'INPUT) (* ;
|
||||
"Get a share/exclusive control. If OLDACCESS is INPUT, we have already obtained this control")
|
||||
"Get a share/exclusive control. If OLDACCESS is INPUT, we have already obtained this control")
|
||||
(COND
|
||||
((SETQ ERROR (FILING.CALL
|
||||
SESSION
|
||||
'CHANGE.CONTROLS
|
||||
(fetch NSHDATUM of HANDLE)
|
||||
`[(LOCK ,(SELECTQ ACCESS
|
||||
(INPUT 'SHARE)
|
||||
'EXCLUSIVE]
|
||||
SESSION
|
||||
'RETURNERRORS))
|
||||
((SETQ ERROR (FILING.CALL SESSION 'CHANGE.CONTROLS (fetch NSHDATUM
|
||||
of HANDLE)
|
||||
`[(LOCK ,(SELECTQ ACCESS
|
||||
(INPUT 'SHARE)
|
||||
'EXCLUSIVE]
|
||||
SESSION
|
||||
'RETURNERRORS))
|
||||
(RETURN ERROR)))
|
||||
(RESETSAVE NIL (LIST (FUNCTION \NSRANDOM.RELEASE.IF.ERROR)
|
||||
SESSION HANDLE)) (* ;
|
||||
"If this open doesn't succeed, be sure to release this lock.")
|
||||
"If this open doesn't succeed, be sure to release this lock.")
|
||||
(replace NSHACCESS of HANDLE with (SELECTQ ACCESS
|
||||
((BOTH APPEND)
|
||||
'OUTPUT)
|
||||
ACCESS]
|
||||
((BOTH APPEND)
|
||||
'OUTPUT)
|
||||
ACCESS]
|
||||
[COND
|
||||
(CHECKACCESS
|
||||
|
||||
@@ -3536,37 +3519,33 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
(LEN (CADR (ASSOC 'SIZE.IN.BYTES ATTRS)))
|
||||
S EOF)
|
||||
[COND
|
||||
(OLDSTREAM [LET [(OLDATTRS (fetch NSHATTRIBUTES of (fetch
|
||||
NSFILING.HANDLE
|
||||
of OLDSTREAM]
|
||||
(OLDSTREAM [LET [(OLDATTRS (fetch NSHATTRIBUTES of (fetch NSFILING.HANDLE
|
||||
of OLDSTREAM]
|
||||
(COND
|
||||
([OR (NOT (EQUAL LEN (fetch NSFILING.SERVER.LENGTH
|
||||
of OLDSTREAM)))
|
||||
([OR (NOT (EQUAL LEN (fetch NSFILING.SERVER.LENGTH of OLDSTREAM
|
||||
)))
|
||||
(NOT (EQUAL (CADR (ASSOC 'CREATED.ON ATTRS))
|
||||
(CADR (ASSOC 'CREATED.ON OLDATTRS]
|
||||
(* ; "file has changed!")
|
||||
(\NSRANDOM.STREAM.CHANGED OLDSTREAM HANDLE]
|
||||
(* ;
|
||||
"If got here, user let us continue")
|
||||
(* ; "If got here, user let us continue")
|
||||
(replace NSFILING.HANDLE of (SETQ S OLDSTREAM) with HANDLE))
|
||||
(T (SETQ EOF (SELECTQ ACCESS
|
||||
(OUTPUT 0)
|
||||
LEN))
|
||||
(SETQ S (create STREAM
|
||||
DEVICE _ DEVICE
|
||||
EPAGE _ (FOLDLO EOF BYTESPERPAGE)
|
||||
EOFFSET _ (IMOD EOF BYTESPERPAGE)
|
||||
MULTIBUFFERHINT _ T))
|
||||
(if (EQ ACCESS 'APPEND)
|
||||
then (* ; "File pos at end")
|
||||
(freplace (STREAM CPAGE) of S with (fetch
|
||||
(STREAM EPAGE)
|
||||
of S))
|
||||
(freplace (STREAM COFFSET) of S with (fetch
|
||||
(STREAM EOFFSET)
|
||||
of S))
|
||||
else (* ; "File pos at start")
|
||||
(freplace (STREAM CPAGE) of S with 0)
|
||||
(freplace (STREAM COFFSET) of S with 0]
|
||||
then (* ; "File pos at end")
|
||||
(freplace (STREAM CPAGE) of S with (fetch (STREAM EPAGE) of S))
|
||||
(freplace (STREAM COFFSET) of S with (fetch (STREAM EOFFSET)
|
||||
of S))
|
||||
else (* ; "File pos at start")
|
||||
(freplace (STREAM CPAGE) of S with 0)
|
||||
(freplace (STREAM COFFSET) of S with 0]
|
||||
(replace NSFILING.SERVER.LENGTH of S with LEN)
|
||||
(RETURN S])
|
||||
|
||||
@@ -4657,49 +4636,47 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
|
||||
|
||||
(ADDTOVAR LAMA FILING.CALL)
|
||||
)
|
||||
(PUTPROPS NSFILING COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1993 1999
|
||||
))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (34234 35080 (\FILINGSESSION.DEFPRINT 34244 . 34758) (\FILINGHANDLE.DEFPRINT 34760 .
|
||||
35078)) (35081 38808 (\GET.FILING.ATTRIBUTE 35091 . 36404) (\PUT.FILING.ATTRIBUTE 36406 . 37604) (
|
||||
\GET.SESSION.HANDLE 37606 . 38025) (\PUT.SESSION.HANDLE 38027 . 38806)) (41840 77789 (
|
||||
\GETFILINGCONNECTION 41850 . 43745) (\NSFILING.GET.NEW.SESSION 43747 . 44232) (\NSFILING.GET.STREAM
|
||||
44234 . 46010) (\NSFILING.COURIER.OPEN 46012 . 46277) (\NSFILING.CLOSE.BULKSTREAM 46279 . 46557) (
|
||||
\NSFILING.RELEASE.BULKSTREAM 46559 . 47488) (FILING.CALL 47490 . 56089) (\NSFILING.LOGIN 56091 . 69270
|
||||
) (\NSFILING.AFTER.LOGIN 69272 . 69803) (\NSFILING.SET.CONTINUANCE 69805 . 70478) (\NSFILING.LOGOUT
|
||||
70480 . 70661) (\NSFILING.DISCARD.SESSION 70663 . 72360) (\VALID.FILING.CONNECTIONP 72362 . 73958) (
|
||||
\NSFILING.CLOSE.CONNECTIONS 73960 . 76822) (BREAK.NSFILING.CONNECTION 76824 . 77787)) (77867 91247 (
|
||||
\NSFILING.CONNECT 77877 . 80294) (\NSFILING.MAYBE.CREATE 80296 . 83335) (\NSFILING.REMOVEQUOTES 83337
|
||||
. 83962) (\NSFILING.ADDQUOTES 83964 . 86702) (\FILING.ATTRIBUTE.TYPE.SEQUENCE 86704 . 86918) (
|
||||
\FILING.ATTRIBUTE.TYPE 86920 . 87423) (\LISP.TO.NSFILING.ATTRIBUTE 87425 . 91245)) (91283 144407 (
|
||||
\NSFILING.GETFILE 91293 . 112576) (\NSFILING.LOOKUP.CACHE 112578 . 114640) (\NSFILING.ADD.TO.CACHE
|
||||
114642 . 117005) (\NSFILING.OPEN.HANDLE 117007 . 119110) (\NSFILING.CONFLICTP 119112 . 120606) (
|
||||
\NSFILING.CHECK.ACCESS 120608 . 121971) (\NSFILING.FILLIN.ATTRIBUTES 121973 . 123720) (
|
||||
\NSFILING.COMPOSE.PATHNAME 123722 . 124223) (\NSFILING.PARSE.FILENAME 124225 . 129762) (
|
||||
\NSFILING.ERRORHANDLER 129764 . 134582) (\NSFILING.WHENCLOSED 134584 . 135856) (\NSFILING.CLOSE.HANDLE
|
||||
135858 . 136151) (\NSFILING.FULLNAME 136153 . 144405)) (144440 212555 (\NSFILING.OPENFILE 144450 .
|
||||
149642) (\NSFILING.HANDLE.ERROR 149644 . 150522) (\NSFILING.CLOSEFILE 150524 . 153147) (
|
||||
\NSFILING.EVENTFN 153149 . 155907) (\NSFILING.DELETEFILE 155909 . 157577) (\NSFILING.CHILDLESS-P
|
||||
157579 . 158282) (\NSFILING.DIRECTORYNAMEP 158284 . 158691) (\NSFILING.HOSTNAMEP 158693 . 161788) (
|
||||
\NSFILING.GETFILENAME 161790 . 162050) (\NSFILING.GETFILEINFO 162052 . 165460) (
|
||||
\NSFILING.GET.ATTRIBUTES 165462 . 165858) (\NSFILING.GETFILEINFO.FROM.PLIST 165860 . 168820) (
|
||||
\NSFILING.GDATE 168822 . 169012) (\NSFILING.SETFILEINFO 169014 . 172196) (\NSFILING.GET/SETINFO 172198
|
||||
. 173662) (\NSFILING.UPDATE.ATTRIBUTES 173664 . 174635) (\NSFILING.GETEOFPTR 174637 . 175171) (
|
||||
\NSFILING.GENERATEFILES 175173 . 191035) (\NSFILING.GENERATE.STARS 191037 . 191627) (
|
||||
\NSFILING.NEXTFILE 191629 . 193207) (\NSFILING.FILEINFOFN 193209 . 193436) (\NSFILING.RENAMEFILE
|
||||
193438 . 194038) (\NSFILING.COPYFILE 194040 . 194638) (\NSFILING.COPY/RENAME 194640 . 212553)) (212594
|
||||
263202 (\NSRANDOM.CLOSEFILE 212604 . 214400) (\NSRANDOM.RELEASE.HANDLE 214402 . 215595) (
|
||||
\NSRANDOM.RELEASE.LOCK 215597 . 215936) (\NSRANDOM.RELEASE.IF.ERROR 215938 . 216138) (
|
||||
\NSRANDOM.CREATE.STREAM 216140 . 222206) (\NSRANDOM.READPAGES 222208 . 226998) (\NSRANDOM.READ.SEGMENT
|
||||
227000 . 237526) (\NSRANDOM.PREPARE.CACHE 237528 . 244860) (\NSRANDOM.FETCH.CACHE 244862 . 247035) (
|
||||
\NSRANDOM.CHECK.CACHE 247037 . 248082) (\NSRANDOM.WRITEPAGES 248084 . 253627) (\NSRANDOM.WRITE.SEGMENT
|
||||
253629 . 255223) (\NSRANDOM.WROTE.HANDLE 255225 . 257031) (\NSRANDOM.SETEOFPTR 257033 . 258562) (
|
||||
\NSRANDOM.TRUNCATEFILE 258564 . 261478) (\NSRANDOM.UPDATE.VALIDATION 261480 . 262383) (
|
||||
\NSRANDOM.OPENFILE 262385 . 263200)) (263234 277742 (\NSRANDOM.HANDLE.ERROR 263244 . 265690) (
|
||||
\NSRANDOM.PROCEEDABLE.ERROR 265692 . 266948) (\NSRANDOM.REESTABLISH 266950 . 268422) (
|
||||
\NSRANDOM.STREAM.CHANGED 268424 . 269694) (\NSRANDOM.DESTROY.STREAM 269696 . 270466) (
|
||||
\NSRANDOM.SESSION.WATCHER 270468 . 276377) (\NSRANDOM.ENSURE.WATCHER 276379 . 277740)) (277783 288993
|
||||
(GC-FILING-DIRECTORY 277793 . 285216) (\NSGC.COLLECT.DIRECTORIES 285218 . 288991)) (289043 293734 (
|
||||
\NSFILING.DESERIALIZE 289053 . 291155) (\NSFILING.DESERIALIZE1 291157 . 293732)) (293735 294222 (
|
||||
\NSFILING.INIT 293745 . 294220)))))
|
||||
(FILEMAP (NIL (33827 34673 (\FILINGSESSION.DEFPRINT 33837 . 34351) (\FILINGHANDLE.DEFPRINT 34353 .
|
||||
34671)) (34674 38401 (\GET.FILING.ATTRIBUTE 34684 . 35997) (\PUT.FILING.ATTRIBUTE 35999 . 37197) (
|
||||
\GET.SESSION.HANDLE 37199 . 37618) (\PUT.SESSION.HANDLE 37620 . 38399)) (41234 77183 (
|
||||
\GETFILINGCONNECTION 41244 . 43139) (\NSFILING.GET.NEW.SESSION 43141 . 43626) (\NSFILING.GET.STREAM
|
||||
43628 . 45404) (\NSFILING.COURIER.OPEN 45406 . 45671) (\NSFILING.CLOSE.BULKSTREAM 45673 . 45951) (
|
||||
\NSFILING.RELEASE.BULKSTREAM 45953 . 46882) (FILING.CALL 46884 . 55483) (\NSFILING.LOGIN 55485 . 68664
|
||||
) (\NSFILING.AFTER.LOGIN 68666 . 69197) (\NSFILING.SET.CONTINUANCE 69199 . 69872) (\NSFILING.LOGOUT
|
||||
69874 . 70055) (\NSFILING.DISCARD.SESSION 70057 . 71754) (\VALID.FILING.CONNECTIONP 71756 . 73352) (
|
||||
\NSFILING.CLOSE.CONNECTIONS 73354 . 76216) (BREAK.NSFILING.CONNECTION 76218 . 77181)) (77261 90641 (
|
||||
\NSFILING.CONNECT 77271 . 79688) (\NSFILING.MAYBE.CREATE 79690 . 82729) (\NSFILING.REMOVEQUOTES 82731
|
||||
. 83356) (\NSFILING.ADDQUOTES 83358 . 86096) (\FILING.ATTRIBUTE.TYPE.SEQUENCE 86098 . 86312) (
|
||||
\FILING.ATTRIBUTE.TYPE 86314 . 86817) (\LISP.TO.NSFILING.ATTRIBUTE 86819 . 90639)) (90677 143609 (
|
||||
\NSFILING.GETFILE 90687 . 111778) (\NSFILING.LOOKUP.CACHE 111780 . 113842) (\NSFILING.ADD.TO.CACHE
|
||||
113844 . 116207) (\NSFILING.OPEN.HANDLE 116209 . 118312) (\NSFILING.CONFLICTP 118314 . 119808) (
|
||||
\NSFILING.CHECK.ACCESS 119810 . 121173) (\NSFILING.FILLIN.ATTRIBUTES 121175 . 122922) (
|
||||
\NSFILING.COMPOSE.PATHNAME 122924 . 123425) (\NSFILING.PARSE.FILENAME 123427 . 128964) (
|
||||
\NSFILING.ERRORHANDLER 128966 . 133784) (\NSFILING.WHENCLOSED 133786 . 135058) (\NSFILING.CLOSE.HANDLE
|
||||
135060 . 135353) (\NSFILING.FULLNAME 135355 . 143607)) (143642 211757 (\NSFILING.OPENFILE 143652 .
|
||||
148844) (\NSFILING.HANDLE.ERROR 148846 . 149724) (\NSFILING.CLOSEFILE 149726 . 152349) (
|
||||
\NSFILING.EVENTFN 152351 . 155109) (\NSFILING.DELETEFILE 155111 . 156779) (\NSFILING.CHILDLESS-P
|
||||
156781 . 157484) (\NSFILING.DIRECTORYNAMEP 157486 . 157893) (\NSFILING.HOSTNAMEP 157895 . 160990) (
|
||||
\NSFILING.GETFILENAME 160992 . 161252) (\NSFILING.GETFILEINFO 161254 . 164662) (
|
||||
\NSFILING.GET.ATTRIBUTES 164664 . 165060) (\NSFILING.GETFILEINFO.FROM.PLIST 165062 . 168022) (
|
||||
\NSFILING.GDATE 168024 . 168214) (\NSFILING.SETFILEINFO 168216 . 171398) (\NSFILING.GET/SETINFO 171400
|
||||
. 172864) (\NSFILING.UPDATE.ATTRIBUTES 172866 . 173837) (\NSFILING.GETEOFPTR 173839 . 174373) (
|
||||
\NSFILING.GENERATEFILES 174375 . 190237) (\NSFILING.GENERATE.STARS 190239 . 190829) (
|
||||
\NSFILING.NEXTFILE 190831 . 192409) (\NSFILING.FILEINFOFN 192411 . 192638) (\NSFILING.RENAMEFILE
|
||||
192640 . 193240) (\NSFILING.COPYFILE 193242 . 193840) (\NSFILING.COPY/RENAME 193842 . 211755)) (211796
|
||||
262065 (\NSRANDOM.CLOSEFILE 211806 . 213602) (\NSRANDOM.RELEASE.HANDLE 213604 . 214797) (
|
||||
\NSRANDOM.RELEASE.LOCK 214799 . 215138) (\NSRANDOM.RELEASE.IF.ERROR 215140 . 215340) (
|
||||
\NSRANDOM.CREATE.STREAM 215342 . 221069) (\NSRANDOM.READPAGES 221071 . 225861) (\NSRANDOM.READ.SEGMENT
|
||||
225863 . 236389) (\NSRANDOM.PREPARE.CACHE 236391 . 243723) (\NSRANDOM.FETCH.CACHE 243725 . 245898) (
|
||||
\NSRANDOM.CHECK.CACHE 245900 . 246945) (\NSRANDOM.WRITEPAGES 246947 . 252490) (\NSRANDOM.WRITE.SEGMENT
|
||||
252492 . 254086) (\NSRANDOM.WROTE.HANDLE 254088 . 255894) (\NSRANDOM.SETEOFPTR 255896 . 257425) (
|
||||
\NSRANDOM.TRUNCATEFILE 257427 . 260341) (\NSRANDOM.UPDATE.VALIDATION 260343 . 261246) (
|
||||
\NSRANDOM.OPENFILE 261248 . 262063)) (262097 276605 (\NSRANDOM.HANDLE.ERROR 262107 . 264553) (
|
||||
\NSRANDOM.PROCEEDABLE.ERROR 264555 . 265811) (\NSRANDOM.REESTABLISH 265813 . 267285) (
|
||||
\NSRANDOM.STREAM.CHANGED 267287 . 268557) (\NSRANDOM.DESTROY.STREAM 268559 . 269329) (
|
||||
\NSRANDOM.SESSION.WATCHER 269331 . 275240) (\NSRANDOM.ENSURE.WATCHER 275242 . 276603)) (276646 287856
|
||||
(GC-FILING-DIRECTORY 276656 . 284079) (\NSGC.COLLECT.DIRECTORIES 284081 . 287854)) (287906 292597 (
|
||||
\NSFILING.DESERIALIZE 287916 . 290018) (\NSFILING.DESERIALIZE1 290020 . 292595)) (292598 293085 (
|
||||
\NSFILING.INIT 292608 . 293083)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user