Define {MEDLEY} as MEDLEYDIR, function MEDLEYDIR produces {MEDLEY} names
This commit is contained in:
rmkaplan
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "31-Jan-2026 23:43:06" {WMEDLEY}<sources>MEDLEYDIR.;44 16074
|
||||
(FILECREATED "15-Apr-2026 17:27:14" {WMEDLEY}<sources>MEDLEYDIR.;51 17370
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MEDLEYDIR)
|
||||
(VARS MEDLEYDIRCOMS)
|
||||
|
||||
:PREVIOUS-DATE "26-Nov-2025 21:51:39" {WMEDLEY}<sources>MEDLEYDIR.;43)
|
||||
:PREVIOUS-DATE "15-Apr-2026 16:44:33" {WMEDLEY}<sources>MEDLEYDIR.;50)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEYDIRCOMS)
|
||||
@@ -15,6 +16,8 @@
|
||||
[
|
||||
(* ;; "set up initialization for file paths relative to where Medley is installed. This assumes that the environment variable MEDLEYDIR is set (usually by the ./run-medley script) to the (unix path) and all of the other directories variables are set relative to that (by MEDLEY-INIT-VARS)")
|
||||
|
||||
(P (MOVD? 'EVQ 'PSEUDOHOST))
|
||||
(* ; "For loadup")
|
||||
(FNS MEDLEY-INIT-VARS MEDLEYDIR MEDLEYSUBSTDIR SET-SYSOUT-COMMIT)
|
||||
[INITVARS (MEDLEYDIR)
|
||||
(\SAVE.MEDLEYDIR)
|
||||
@@ -53,7 +56,7 @@
|
||||
(CONS LOGINHOST/DIR '("INIT"]
|
||||
RESET)
|
||||
(DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/medleydisplayfonts"
|
||||
"fonts/displayfonts")
|
||||
)
|
||||
NIL NIL T))
|
||||
(POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts"
|
||||
)
|
||||
@@ -75,10 +78,18 @@
|
||||
"set up initialization for file paths relative to where Medley is installed. This assumes that the environment variable MEDLEYDIR is set (usually by the ./run-medley script) to the (unix path) and all of the other directories variables are set relative to that (by MEDLEY-INIT-VARS)"
|
||||
)
|
||||
|
||||
|
||||
(MOVD? 'EVQ 'PSEUDOHOST)
|
||||
|
||||
|
||||
|
||||
(* ; "For loadup")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(MEDLEY-INIT-VARS
|
||||
[LAMBDA (EVENT) (* ; "Edited 22-Nov-2022 20:38 by FGH")
|
||||
[LAMBDA (EVENT) (* ; "Edited 15-Apr-2026 16:44 by rmk")
|
||||
(* ; "Edited 22-Nov-2022 20:38 by FGH")
|
||||
(* ; "Edited 21-Nov-2022 17:31 by FGH")
|
||||
(* ; "Edited 21-Nov-2022 15:39 by frank")
|
||||
(* ; "Edited 21-Nov-2022 14:33 by FGH")
|
||||
@@ -105,6 +116,7 @@
|
||||
(* ;;
|
||||
"Any old values, restore them, substituting the new MEDLEYDIR")
|
||||
|
||||
(PSEUDOHOST 'MEDLEY MEDLEYDIR)
|
||||
(PROG (OLDMD NEWMD SAME TMP)
|
||||
(IF (EQ \SAVE.MEDLEYDIR T)
|
||||
THEN (* ; " Already restored")
|
||||
@@ -139,7 +151,8 @@
|
||||
NIL])
|
||||
|
||||
(MEDLEYDIR
|
||||
[LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 31-Jan-2026 23:42 by rmk")
|
||||
[LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 15-Apr-2026 17:13 by rmk")
|
||||
(* ; "Edited 31-Jan-2026 23:42 by rmk")
|
||||
(* ; "Edited 23-Aug-2025 17:21 by lmm")
|
||||
(* ; "Edited 18-Aug-2025 11:15 by FGH")
|
||||
(* ; "Edited 29-Jun-2023 22:48 by rmk")
|
||||
@@ -149,55 +162,60 @@
|
||||
|
||||
(* ;; "RMK: MEDLEYDIR defaults to DSK")
|
||||
|
||||
(COND
|
||||
((NULL DIRNAME) (* ;
|
||||
(LET (MED)
|
||||
[SETQ MED (COND
|
||||
((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 (PACKFILENAME 'BODY MEDLEYDIR 'HOST
|
||||
'DSK)
|
||||
else T)))
|
||||
elseif (STRPOS "/" MEDLEYDIR)
|
||||
then (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR))
|
||||
else MEDLEYDIR))
|
||||
((LISTP DIRNAME)
|
||||
(if (OR (NOT (BOUNDP 'MEDLEYDIR))
|
||||
(NOT MEDLEYDIR))
|
||||
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))
|
||||
((LISTP DIRNAME)
|
||||
|
||||
(* ;; "(MEDLEYDIR a list -- recurse")
|
||||
(* ;; "(MEDLEYDIR a list -- recurse")
|
||||
|
||||
(for X Y in DIRNAME when (SETQ Y (MEDLEYDIR X FILENAME OUTPUT NOERROR)) collect Y))
|
||||
[FILENAME
|
||||
(for X Y in DIRNAME when (SETQ Y (MEDLEYDIR X FILENAME OUTPUT NOERROR))
|
||||
collect Y))
|
||||
[FILENAME
|
||||
|
||||
(* ;; " if FILENAME, find it as a file. ")
|
||||
(* ;; " 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")
|
||||
DIRNAME)))
|
||||
[(EQUAL DIRNAME "loadups") (* ; "special case for loadups dir")
|
||||
(OR (DIRECTORYNAME (UNIX-GETENV "MEDLEY¬LOADUPS¬DIR"))
|
||||
(DIRECTORYNAME (CONCAT (MEDLEYDIR)
|
||||
"loadups" ">")
|
||||
NIL OUTPUT)
|
||||
(if NOERROR
|
||||
then NIL
|
||||
else (ERROR "Cannot find medley loadups directory" (MEDLEYDIR]
|
||||
(T (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR)
|
||||
DIRNAME ">")
|
||||
NIL OUTPUT)
|
||||
(if NOERROR
|
||||
then NIL
|
||||
else (ERROR "No such medley directory" DIRNAME])
|
||||
(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")
|
||||
DIRNAME)))
|
||||
[(EQUAL DIRNAME "loadups") (* ; "special case for loadups dir")
|
||||
(OR (DIRECTORYNAME (UNIX-GETENV "MEDLEY¬LOADUPS¬DIR"))
|
||||
(DIRECTORYNAME (CONCAT (MEDLEYDIR)
|
||||
"loadups" ">")
|
||||
NIL OUTPUT)
|
||||
(if NOERROR
|
||||
then NIL
|
||||
else (ERROR "Cannot find medley loadups directory" (MEDLEYDIR]
|
||||
(T (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR)
|
||||
DIRNAME ">")
|
||||
NIL OUTPUT)
|
||||
(if NOERROR
|
||||
then NIL
|
||||
else (ERROR "No such medley directory" DIRNAME]
|
||||
(CL:WHEN MED (PSEUDOFILENAME MED])
|
||||
|
||||
(MEDLEYSUBSTDIR
|
||||
[LAMBDA (OLD NEW BODY) (* ;
|
||||
@@ -268,7 +286,7 @@
|
||||
(USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM))
|
||||
(CONS LOGINHOST/DIR '("INIT"]
|
||||
RESET)
|
||||
(DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/medleydisplayfonts" "fonts/displayfonts")
|
||||
(DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/medleydisplayfonts")
|
||||
NIL NIL T))
|
||||
(POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts")
|
||||
NIL NIL T))
|
||||
@@ -285,6 +303,6 @@
|
||||
(ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5324 13336 (MEDLEY-INIT-VARS 5334 . 8812) (MEDLEYDIR 8814 . 12136) (MEDLEYSUBSTDIR
|
||||
12138 . 13116) (SET-SYSOUT-COMMIT 13118 . 13334)))))
|
||||
(FILEMAP (NIL (5517 14653 (MEDLEY-INIT-VARS 5527 . 9158) (MEDLEYDIR 9160 . 13453) (MEDLEYSUBSTDIR
|
||||
13455 . 14433) (SET-SYSOUT-COMMIT 14435 . 14651)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user