Fix MEDLEYDIR to handle filename if given (#2268)
This commit is contained in:
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "18-Aug-2025 11:19:10" {DSK}<home>frank>il>xmedley>sources>MEDLEYDIR.;2 11928
|
||||
(FILECREATED "23-Aug-2025 17:25:03" {DSK}<home>larry>il>medley>sources>MEDLEYDIR.;36 12210
|
||||
|
||||
:EDIT-BY "FGH"
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (FNS MEDLEYDIR)
|
||||
|
||||
:PREVIOUS-DATE "11-Jul-2025 00:17:20" {DSK}<home>frank>il>xmedley>sources>MEDLEYDIR.;1)
|
||||
:PREVIOUS-DATE "18-Aug-2025 11:19:10" {DSK}<home>larry>il>medley>sources>MEDLEYDIR.;34)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEYDIRCOMS)
|
||||
@@ -99,7 +99,8 @@
|
||||
NIL])
|
||||
|
||||
(MEDLEYDIR
|
||||
[LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 18-Aug-2025 11:15 by FGH")
|
||||
[LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 23-Aug-2025 17:21 by lmm")
|
||||
(* ; "Edited 18-Aug-2025 11:15 by FGH")
|
||||
(* ; "Edited 29-Jun-2023 22:48 by rmk")
|
||||
(* ; "Edited 18-Oct-2022 17:49 by lmm")
|
||||
(* ; "Edited 5-Mar-2022 12:43 by larry")
|
||||
@@ -108,20 +109,40 @@
|
||||
(* ;; "RMK: MEDLEYDIR defaults to DSK")
|
||||
|
||||
(COND
|
||||
((NULL DIRNAME)
|
||||
((NULL DIRNAME) (* ;
|
||||
"Call to (MEDLEYDIR) or (MEDLEYDIR NIL ...) just set it ")
|
||||
(if (OR (NOT (BOUNDP 'MEDLEYDIR))
|
||||
(NOT MEDLEYDIR))
|
||||
then [SETQ MEDLEYDIR (DIRECTORYNAME (if (SETQ MEDLEYDIR (UNIX-GETENV "MEDLEYDIR"))
|
||||
then (DIRECTORYNAME (PACKFILENAME 'BODY MEDLEYDIR
|
||||
'HOST
|
||||
'DSK))
|
||||
else (DIRECTORYNAME T]
|
||||
then (SETQ MEDLEYDIR (DIRECTORYNAME (if (SETQ MEDLEYDIR (UNIX-GETENV "MEDLEYDIR"))
|
||||
then (PACKFILENAME 'BODY MEDLEYDIR 'HOST
|
||||
'DSK)
|
||||
else T)))
|
||||
elseif (STRPOS "/" MEDLEYDIR)
|
||||
then (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR))
|
||||
else MEDLEYDIR))
|
||||
[(EQUAL DIRNAME "login") (* ; "special case for login dir")
|
||||
((LISTP DIRNAME)
|
||||
|
||||
(* ;; "(MEDLEYDIR a list -- recurse")
|
||||
|
||||
(for X Y in DIRNAME when (SETQ Y (MEDLEYDIR X FILENAME OUTPUT NOERROR)) collect Y))
|
||||
[FILENAME
|
||||
|
||||
(* ;; " if FILENAME, find it as a file. ")
|
||||
|
||||
(if (NULL (SETQ DIRNAME (MEDLEYDIR DIRNAME NIL OUTPUT NOERROR)))
|
||||
then (OR NOERROR (SHOULDNT))
|
||||
NIL
|
||||
else (SETQ FILENAME (CONCAT DIRNAME FILENAME))
|
||||
(if OUTPUT
|
||||
then FILENAME
|
||||
else (OR (INFILEP FILENAME)
|
||||
(if NOERROR
|
||||
then NIL
|
||||
else (ERROR "No such medley file" FILENAME]
|
||||
((EQUAL DIRNAME "login") (* ; "special case for login dir")
|
||||
(DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
|
||||
(UNIX-GETENV "HOME"]
|
||||
(UNIX-GETENV "HOME")
|
||||
DIRNAME)))
|
||||
[(EQUAL DIRNAME "loadups") (* ; "special case for loadups dir")
|
||||
(OR (DIRECTORYNAME (UNIX-GETENV "MEDLEY_LOADUPS_DIR"))
|
||||
(DIRECTORYNAME (CONCAT (MEDLEYDIR)
|
||||
@@ -130,18 +151,6 @@
|
||||
(if NOERROR
|
||||
then NIL
|
||||
else (ERROR "Cannot find medley loadups directory" (MEDLEYDIR]
|
||||
((LISTP DIRNAME)
|
||||
(for X Y in DIRNAME when (SETQ Y (MEDLEYDIR X FILENAME OUTPUT NOERROR)) collect Y))
|
||||
[FILENAME (if (NULL (SETQ DIRNAME (MEDLEYDIR DIRNAME NIL OUTPUT NOERROR)))
|
||||
then (OR NOERROR (SHOULDNT))
|
||||
NIL
|
||||
else (SETQ FILENAME (CONCAT DIRNAME FILENAME))
|
||||
(if OUTPUT
|
||||
then FILENAME
|
||||
else (OR (INFILEP FILENAME)
|
||||
(if NOERROR
|
||||
then NIL
|
||||
else (ERROR "No such medley file" FILENAME]
|
||||
(T (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR)
|
||||
DIRNAME ">")
|
||||
NIL OUTPUT)
|
||||
@@ -236,6 +245,6 @@
|
||||
(ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1675 9296 (MEDLEY-INIT-VARS 1685 . 5163) (MEDLEYDIR 5165 . 8096) (MEDLEYSUBSTDIR 8098
|
||||
. 9076) (SET-SYSOUT-COMMIT 9078 . 9294)))))
|
||||
(FILEMAP (NIL (1675 9578 (MEDLEY-INIT-VARS 1685 . 5163) (MEDLEYDIR 5165 . 8378) (MEDLEYSUBSTDIR 8380
|
||||
. 9358) (SET-SYSOUT-COMMIT 9360 . 9576)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user