github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-20 01:52:57 +00:00
Code Issues Projects Releases Wiki Activity

Manager (Lispusers) grow anchor, icon, and fix typo. (#1346)

Browse Source 
* File See operations use full path to loaded file.
Add Manager.WINDOW-ANCHOR to fix corner from which MANAGER-MAIN-WINDOW grows, and (attempt) to keep it on-screen.

* Improved handling of the ICONW for MANAGER-MAIN-WINDOW.

* Fix typo in MasterScope functions (multiple occurrences: LOADBFLG should be LOADDBFLG).
Changed to CL compiler by default (not need to go to submenu). This is my preference, so I should remove it before setting pull request.

* Manual cleanup of multiple "Edited" comments in 4 FNS.
Reverted: Changed to CL compiler by default (not need to go to submenu). (From commit f60c6362)

* Update MANAGER.TEDIT documentation file.
Fix error in previous commit. (Changes that I thought were there, were not.)
Cleanup COMMON-MAKE COMS so it can be handled by the file package, and add .LCOM file to the repo.
This commit is contained in:
Matt Heffron
2023-10-14 06:39:13 -07:00
committed by GitHub
parent f1833861cc
commit d92aa6395a
8 changed files with 466 additions and 450 deletions
Download Patch File Download Diff File Expand all files Collapse all files

330
installers/win/editpath/EditPath.iss
View File

@@ -1,165 +1,165 @@
; Copyright (C) 2021-2023 by Bill Stewart (bstewart at iname.com) ; Copyright (C) 2021-2023 by Bill Stewart (bstewart at iname.com)
; ;
; This program is free software; you can redistribute it and/or modify it under ; This program is free software; you can redistribute it and/or modify it under
; the terms of the GNU Lesser General Public License as published by the Free ; the terms of the GNU Lesser General Public License as published by the Free
; Software Foundation; either version 3 of the License, or (at your option) any ; Software Foundation; either version 3 of the License, or (at your option) any
; later version. ; later version.
; ;
; This program is distributed in the hope that it will be useful, but WITHOUT ; This program is distributed in the hope that it will be useful, but WITHOUT
; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS ; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
; FOR A PARTICULAR PURPOSE. See the GNU General Lesser Public License for more ; FOR A PARTICULAR PURPOSE. See the GNU General Lesser Public License for more
; details. ; details.
; ;
; You should have received a copy of the GNU Lesser General Public License ; You should have received a copy of the GNU Lesser General Public License
; along with this program. If not, see https://www.gnu.org/licenses/. ; along with this program. If not, see https://www.gnu.org/licenses/.
; Sample Inno Setup (https://www.jrsoftware.org/isinfo.php) script ; Sample Inno Setup (https://www.jrsoftware.org/isinfo.php) script
; demonstrating use of PathMgr.dll. ; demonstrating use of PathMgr.dll.
; ;
; This script uses PathMgr.dll in the following ways: ; This script uses PathMgr.dll in the following ways:
; * Copies PathMgr.dll to the target machine (required for uninstall) ; * Copies PathMgr.dll to the target machine (required for uninstall)
; * Defines a task in [Tasks] that should modify the Path ; * Defines a task in [Tasks] that should modify the Path
; * Imports the AddDirToPath() DLL function at setup time ; * Imports the AddDirToPath() DLL function at setup time
; * Imports the RemoveDirFromPath() DLL function at uninstall time ; * Imports the RemoveDirFromPath() DLL function at uninstall time
; * Stores task state as custom setting using RegisterPreviousData() ; * Stores task state as custom setting using RegisterPreviousData()
; * Retrieves task state custom setting during setup and uninstall initialize ; * Retrieves task state custom setting during setup and uninstall initialize
; * At post install, adds app dir to Path if task selected ; * At post install, adds app dir to Path if task selected
; * At uninstall, removes dir from Path if custom setting present ; * At uninstall, removes dir from Path if custom setting present
; * Unloads and deletes DLL and removes app dir at uninstall deinitialize ; * Unloads and deletes DLL and removes app dir at uninstall deinitialize
#if Ver < EncodeVer(6,0,0,0) #if Ver < EncodeVer(6,0,0,0)
#error This script requires Inno Setup 6 or later #error This script requires Inno Setup 6 or later
#endif #endif
[Setup] [Setup]
AppId={{A17D2D05-C729-4F2A-9CC7-E04906C5A842} AppId={{A17D2D05-C729-4F2A-9CC7-E04906C5A842}
AppName=EditPath AppName=EditPath
AppVersion=4.0.4.0 AppVersion=4.0.4.0
UsePreviousAppDir=false UsePreviousAppDir=false
DefaultDirName={autopf}\EditPath DefaultDirName={autopf}\EditPath
Uninstallable=true Uninstallable=true
OutputDir=. OutputDir=.
OutputBaseFilename=EditPath_Setup OutputBaseFilename=EditPath_Setup
ArchitecturesInstallIn64BitMode=x64 ArchitecturesInstallIn64BitMode=x64
PrivilegesRequired=none PrivilegesRequired=none
PrivilegesRequiredOverridesAllowed=dialog PrivilegesRequiredOverridesAllowed=dialog
[Files] [Files]
; Install PathMgr.dll for use with both setup and uninstall; use ; Install PathMgr.dll for use with both setup and uninstall; use
; uninsneveruninstall flag because DeinitializeSetup() will delete after ; uninsneveruninstall flag because DeinitializeSetup() will delete after
; unloading the DLL; install the 32-bit version of PathMgr.dll because both ; unloading the DLL; install the 32-bit version of PathMgr.dll because both
; setup and uninstall executables are 32-bit ; setup and uninstall executables are 32-bit
Source: "i386\PathMgr.dll"; DestDir: "{app}"; Flags: uninsneveruninstall Source: "i386\PathMgr.dll"; DestDir: "{app}"; Flags: uninsneveruninstall
; Other files to install on target system ; Other files to install on target system
Source: "i386\EditPath.exe"; DestDir: "{app}"; Check: not Is64BitInstallMode() Source: "i386\EditPath.exe"; DestDir: "{app}"; Check: not Is64BitInstallMode()
Source: "x86_64\EditPath.exe"; DestDir: "{app}"; Check: Is64BitInstallMode() Source: "x86_64\EditPath.exe"; DestDir: "{app}"; Check: Is64BitInstallMode()
Source: "EditPath.md"; DestDir: "{app}" Source: "EditPath.md"; DestDir: "{app}"
[Tasks] [Tasks]
Name: modifypath; Description: "&Add to Path" Name: modifypath; Description: "&Add to Path"
[Code] [Code]
const const
MODIFY_PATH_TASK_NAME = 'modifypath'; // Specify name of task MODIFY_PATH_TASK_NAME = 'modifypath'; // Specify name of task
var var
PathIsModified: Boolean; // Cache task selection from previous installs PathIsModified: Boolean; // Cache task selection from previous installs
ApplicationUninstalled: Boolean; // Has application been uninstalled? ApplicationUninstalled: Boolean; // Has application been uninstalled?
// Import AddDirToPath() at setup time ('files:' prefix) // Import AddDirToPath() at setup time ('files:' prefix)
function DLLAddDirToPath(DirName: string; PathType, AddType: DWORD): DWORD; function DLLAddDirToPath(DirName: string; PathType, AddType: DWORD): DWORD;
external 'AddDirToPath@files:PathMgr.dll stdcall setuponly'; external 'AddDirToPath@files:PathMgr.dll stdcall setuponly';
// Import RemoveDirFromPath() at uninstall time ('{app}\' prefix) // Import RemoveDirFromPath() at uninstall time ('{app}\' prefix)
function DLLRemoveDirFromPath(DirName: string; PathType: DWORD): DWORD; function DLLRemoveDirFromPath(DirName: string; PathType: DWORD): DWORD;
external 'RemoveDirFromPath@{app}\PathMgr.dll stdcall uninstallonly'; external 'RemoveDirFromPath@{app}\PathMgr.dll stdcall uninstallonly';
// Wrapper for AddDirToPath() DLL function // Wrapper for AddDirToPath() DLL function
function AddDirToPath(const DirName: string): DWORD; function AddDirToPath(const DirName: string): DWORD;
var var
PathType, AddType: DWORD; PathType, AddType: DWORD;
begin begin
// PathType = 0 - use system Path // PathType = 0 - use system Path
// PathType = 1 - use user Path // PathType = 1 - use user Path
// AddType = 0 - add to end of Path // AddType = 0 - add to end of Path
// AddType = 1 - add to beginning of Path // AddType = 1 - add to beginning of Path
if IsAdminInstallMode() then if IsAdminInstallMode() then
PathType := 0 PathType := 0
else else
PathType := 1; PathType := 1;
AddType := 0; AddType := 0;
result := DLLAddDirToPath(DirName, PathType, AddType); result := DLLAddDirToPath(DirName, PathType, AddType);
end; end;
// Wrapper for RemoveDirFromPath() DLL function // Wrapper for RemoveDirFromPath() DLL function
function RemoveDirFromPath(const DirName: string): DWORD; function RemoveDirFromPath(const DirName: string): DWORD;
var var
PathType: DWORD; PathType: DWORD;
begin begin
// PathType = 0 - use system Path // PathType = 0 - use system Path
// PathType = 1 - use user Path // PathType = 1 - use user Path
if IsAdminInstallMode() then if IsAdminInstallMode() then
PathType := 0 PathType := 0
else else
PathType := 1; PathType := 1;
result := DLLRemoveDirFromPath(DirName, PathType); result := DLLRemoveDirFromPath(DirName, PathType);
end; end;
procedure RegisterPreviousData(PreviousDataKey: Integer); procedure RegisterPreviousData(PreviousDataKey: Integer);
begin begin
// Store previous or current task selection as custom user setting // Store previous or current task selection as custom user setting
if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then
SetPreviousData(PreviousDataKey, MODIFY_PATH_TASK_NAME, 'true'); SetPreviousData(PreviousDataKey, MODIFY_PATH_TASK_NAME, 'true');
end; end;
function InitializeSetup(): Boolean; function InitializeSetup(): Boolean;
begin begin
result := true; result := true;
// Was task selected during a previous install? // Was task selected during a previous install?
PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true'; PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true';
end; end;
function InitializeUninstall(): Boolean; function InitializeUninstall(): Boolean;
begin begin
result := true; result := true;
// Was task selected during a previous install? // Was task selected during a previous install?
PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true'; PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true';
ApplicationUninstalled := false; ApplicationUninstalled := false;
end; end;
procedure CurStepChanged(CurStep: TSetupStep); procedure CurStepChanged(CurStep: TSetupStep);
begin begin
if CurStep = ssPostInstall then if CurStep = ssPostInstall then
begin begin
// Add app directory to Path at post-install step if task selected // Add app directory to Path at post-install step if task selected
if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then
AddDirToPath(ExpandConstant('{app}')); AddDirToPath(ExpandConstant('{app}'));
end; end;
end; end;
procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep); procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
begin begin
if CurUninstallStep = usUninstall then if CurUninstallStep = usUninstall then
begin begin
// Remove app directory from path during uninstall if task was selected; // Remove app directory from path during uninstall if task was selected;
// use variable because we can't use WizardIsTaskSelected() at uninstall // use variable because we can't use WizardIsTaskSelected() at uninstall
if PathIsModified then if PathIsModified then
RemoveDirFromPath(ExpandConstant('{app}')); RemoveDirFromPath(ExpandConstant('{app}'));
end end
else if CurUninstallStep = usPostUninstall then else if CurUninstallStep = usPostUninstall then
begin begin
ApplicationUninstalled := true; ApplicationUninstalled := true;
end; end;
end; end;
procedure DeinitializeUninstall(); procedure DeinitializeUninstall();
begin begin
if ApplicationUninstalled then if ApplicationUninstalled then
begin begin
// Unload and delete PathMgr.dll and remove app dir when uninstalling // Unload and delete PathMgr.dll and remove app dir when uninstalling
UnloadDLL(ExpandConstant('{app}\PathMgr.dll')); UnloadDLL(ExpandConstant('{app}\PathMgr.dll'));
DeleteFile(ExpandConstant('{app}\PathMgr.dll')); DeleteFile(ExpandConstant('{app}\PathMgr.dll'));
RemoveDir(ExpandConstant('{app}')); RemoveDir(ExpandConstant('{app}'));
end; end;
end; end;

236
installers/win/editpath/EditPath.md
View File

@@ -1,118 +1,118 @@
# EditPath # EditPath
EditPath is a Windows console (text-based, command-line) program for managing the system Path and user Path. EditPath is a Windows console (text-based, command-line) program for managing the system Path and user Path.
# Author # Author
Bill Stewart - bstewart at iname dot com Bill Stewart - bstewart at iname dot com
# License # License
EditPath.exe is covered by the GNU Lesser Public License (LPGL). See the file `LICENSE` for details. EditPath.exe is covered by the GNU Lesser Public License (LPGL). See the file `LICENSE` for details.
# Download # Download
https://github.com/Bill-Stewart/PathMgr/releases/ https://github.com/Bill-Stewart/PathMgr/releases/
# Background # Background
The system Path is found in the following location in the Windows registry: The system Path is found in the following location in the Windows registry:
Root: `HKEY_LOCAL_MACHINE` Root: `HKEY_LOCAL_MACHINE`
Subkey: `SYSTEM\CurrentControlSet\Control\Session Manager\Environment` Subkey: `SYSTEM\CurrentControlSet\Control\Session Manager\Environment`
Value name: `Path` Value name: `Path`
The current user Path is found in the following location in the registry: The current user Path is found in the following location in the registry:
Root: `HKEY_CURRENT_USER` Root: `HKEY_CURRENT_USER`
Subkey: `Environment` Subkey: `Environment`
Value name: `Path` Value name: `Path`
In both cases, the `Path` value is (or should be) the registry type `REG_EXPAND_SZ`, which means that it is a string that can contain values surrounded by `%` characters that Windows will automatically expand to environment variable values. (For example, `%SystemRoot%` will be expanded to `C:\Windows` on most systems.) In both cases, the `Path` value is (or should be) the registry type `REG_EXPAND_SZ`, which means that it is a string that can contain values surrounded by `%` characters that Windows will automatically expand to environment variable values. (For example, `%SystemRoot%` will be expanded to `C:\Windows` on most systems.)
The `Path` value contains a `;`-delimited list of directory names that the system should search for executables, library files, scripts, etc. Windows appends the content of the current user Path to the system Path and expands the environment variable references. The resulting string is set as the `Path` environment variable for processes. The `Path` value contains a `;`-delimited list of directory names that the system should search for executables, library files, scripts, etc. Windows appends the content of the current user Path to the system Path and expands the environment variable references. The resulting string is set as the `Path` environment variable for processes.
EditPath provides a command-line interface for managing the `Path` value in the system location (in `HKEY_LOCAL_MACHINE`) and the current user location (in `HKEY_CURRENT_USER`). EditPath provides a command-line interface for managing the `Path` value in the system location (in `HKEY_LOCAL_MACHINE`) and the current user location (in `HKEY_CURRENT_USER`).
# Usage # Usage
The following describes the command-line usage for the program. Parameters are case-sensitive. The following describes the command-line usage for the program. Parameters are case-sensitive.
**EditPath** [_options_] _type_ _action_ **EditPath** [_options_] _type_ _action_
You must specify only one of the following _type_ parameters: You must specify only one of the following _type_ parameters:
| _type_ | Abbreviation | Description | _type_ | Abbreviation | Description
| ------- | ------------ | ----------- | ------- | ------------ | -----------
| **--system** | **-s** | Specifies the system Path | **--system** | **-s** | Specifies the system Path
| **--user** | **-u** | Specifies the user Path | **--user** | **-u** | Specifies the user Path
You must specify only one of the following _action_ parameters: You must specify only one of the following _action_ parameters:
| _action_ | Abbreviation | Description | _action_ | Abbreviation | Description
| -------- | ------------ | ----------- | -------- | ------------ | -----------
| **--list** | **-l** | Lists directories in Path | **--list** | **-l** | Lists directories in Path
| **--test "**_dirname_**"** | **-t "**_dirname_**"** | Tests if directory exists in Path | **--test "**_dirname_**"** | **-t "**_dirname_**"** | Tests if directory exists in Path
| **--add "**_dirname_**"** | **-a "**_dirname_**"** | Adds directory to Path | **--add "**_dirname_**"** | **-a "**_dirname_**"** | Adds directory to Path
| **--remove "**_dirname_**"** | **-r "**_dirname_**"** | Removes directory from Path | **--remove "**_dirname_**"** | **-r "**_dirname_**"** | Removes directory from Path
The following parameters are optional: The following parameters are optional:
| _options_ | Abbreviation | Description | _options_ | Abbreviation | Description
| --------- | ------------ | ----------- | --------- | ------------ | -----------
| **--quiet** | **-q** | Suppresses result messages | **--quiet** | **-q** | Suppresses result messages
| **--expand** | **-x** | Expands environment variables (**--list** only) | **--expand** | **-x** | Expands environment variables (**--list** only)
| **--beginning** | **-b** | Adds to beginning of Path (**--add** only) | **--beginning** | **-b** | Adds to beginning of Path (**--add** only)
# Exit Codes # Exit Codes
The following table lists typical exit codes when not using **--test** (**-t**). The following table lists typical exit codes when not using **--test** (**-t**).
| Exit Code | Description | Exit Code | Description
| --------- | ----------- | --------- | -----------
| 0 | No errors | 0 | No errors
| 2 | The Path value is not present in the registry | 2 | The Path value is not present in the registry
| 3 | The specified directory does not exist in the Path | 3 | The specified directory does not exist in the Path
| 5 | Access is denied | 5 | Access is denied
| 87 | Incorrect parameter(s) | 87 | Incorrect parameter(s)
| 183 | The specified directory already exists in the Path | 183 | The specified directory already exists in the Path
The following table lists typical exit codes when using **--test** (**-t**). The following table lists typical exit codes when using **--test** (**-t**).
| Exit Code | Description | Exit Code | Description
| --------- | ----------- | --------- | -----------
| 1 | The specified directory exists in the unexpanded Path | 1 | The specified directory exists in the unexpanded Path
| 2 | The specified directory exists in the expanded Path | 2 | The specified directory exists in the expanded Path
| 3 | The specified directory does not exist in the Path | 3 | The specified directory does not exist in the Path
# Remarks # Remarks
* Anything on the command line after **--test**, **--add**, or **--remove** is considered to be the argument for the parameter. To avoid ambiguity, specify the _action_ parameter last on the command line. * Anything on the command line after **--test**, **--add**, or **--remove** is considered to be the argument for the parameter. To avoid ambiguity, specify the _action_ parameter last on the command line.
* Uexpanded vs. expanded refers to whether the environment variable references (i.e., names between `%` characters) are expanded after retrieving the Path value from the registry. For example, `%SystemRoot%` is unexpanded but `C:\Windows` is expanded. * Uexpanded vs. expanded refers to whether the environment variable references (i.e., names between `%` characters) are expanded after retrieving the Path value from the registry. For example, `%SystemRoot%` is unexpanded but `C:\Windows` is expanded.
* The **--add** (**-a**) parameter checks whether the specified directory exists in both the unexpanded and expanded copies of the Path before adding the directory. For example, if the environment variable `TESTAPP` is set to `C:\TestApp` and `%TESTAPP%` is in the Path, specifying `--add C:\TestApp` will return exit code 183 (i.e., the directory already exists in the Path) because `%TESTAPP%` expands to `C:\TestApp`. * The **--add** (**-a**) parameter checks whether the specified directory exists in both the unexpanded and expanded copies of the Path before adding the directory. For example, if the environment variable `TESTAPP` is set to `C:\TestApp` and `%TESTAPP%` is in the Path, specifying `--add C:\TestApp` will return exit code 183 (i.e., the directory already exists in the Path) because `%TESTAPP%` expands to `C:\TestApp`.
* The **--remove** (**-r**) parameter does not expand environment variable references. For example, if the environment variable `TESTAPP` is set to `C:\TestApp` and `%TESTAPP%` is in the Path, specifying `--remove "C:\TestApp"` will return exit code 3 (i.e., the directory does not exist in the Path) because **--remove** does not expand `%TESTAPP%` to `C:\TestApp`. For the command to succeed, you would have to specify `--remove "%TESTAPP%"` instead. * The **--remove** (**-r**) parameter does not expand environment variable references. For example, if the environment variable `TESTAPP` is set to `C:\TestApp` and `%TESTAPP%` is in the Path, specifying `--remove "C:\TestApp"` will return exit code 3 (i.e., the directory does not exist in the Path) because **--remove** does not expand `%TESTAPP%` to `C:\TestApp`. For the command to succeed, you would have to specify `--remove "%TESTAPP%"` instead.
* The program will exit with error code 87 if a parameter (or an argument to a parameter) is missing or not valid, if mutually exclusive parameters are specified, etc. * The program will exit with error code 87 if a parameter (or an argument to a parameter) is missing or not valid, if mutually exclusive parameters are specified, etc.
* The program will exit with error code 5 if the current user does not have permission to update the Path value in the registry (for example, if you try to update the system Path using a standard user account or an unelevated administrator account). * The program will exit with error code 5 if the current user does not have permission to update the Path value in the registry (for example, if you try to update the system Path using a standard user account or an unelevated administrator account).
# Examples # Examples
1. `EditPath --expand --system --list` 1. `EditPath --expand --system --list`
This command outputs the directories in the system Path, with environment variables expanded. You can also write this command as `EditPath -x -s -l`. This command outputs the directories in the system Path, with environment variables expanded. You can also write this command as `EditPath -x -s -l`.
2. `EditPath --user --add "%LOCALAPPDATA%\Programs\MyApp"` 2. `EditPath --user --add "%LOCALAPPDATA%\Programs\MyApp"`
Adds the specified directory name to the user Path. Adds the specified directory name to the user Path.
3. `EditPath -s -r "C:\Program Files\MyApp\bin"` 3. `EditPath -s -r "C:\Program Files\MyApp\bin"`
Removes the specified directory from the system Path. Removes the specified directory from the system Path.
4. `EditPath -s --test "C:\Program Files (x86)\MyApp\bin"` 4. `EditPath -s --test "C:\Program Files (x86)\MyApp\bin"`
Returns an exit code of 3 if the specified directory is not in the system Path, 1 if the specified directory is in the unexpanded copy of the system Path, or 2 if the specified directory is in the expanded copy of the system Path. Returns an exit code of 3 if the specified directory is not in the system Path, 1 if the specified directory is in the unexpanded copy of the system Path, or 2 if the specified directory is in the expanded copy of the system Path.

57
lispusers/COMMON-MAKE
View File

@@ -1,27 +1,26 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "11-Dec-87 14:48:16" {DSK}<XAVIER>COMMON-MAKE.;5 15290
changes to%: (VARS COMMON-MAKECOMS) (FILECREATED "13-Oct-2023 16:40:48" {LU}COMMON-MAKE.;2 14315
(FNS COMMON-FILE-COMMAND COMMON-MAKEFILE)
(PROPS (COMMON-MAKE MAKEFILE-ENVIRONMENT))
previous date%: "11-Dec-87 12:53:46" {DSK}<XAVIER>COMMON-MAKE.;1) :EDIT-BY "mth"
:CHANGES-TO (VARS COMMON-MAKECOMS)
:PREVIOUS-DATE "11-Dec-87 14:48:16" {LU}COMMON-MAKE.;1)
(* "
Copyright (c) 1987 by Unisys Corp.. All rights reserved.
")
(PRETTYCOMPRINT COMMON-MAKECOMS) (PRETTYCOMPRINT COMMON-MAKECOMS)
(RPAQQ COMMON-MAKECOMS ((* FUNCTIONS TO HANDLE WRITING STANDARD COMMONLISP SOURCE FILES) (RPAQQ COMMON-MAKECOMS [
(* ;; "FUNCTIONS TO HANDLE WRITING STANDARD COMMONLISP SOURCE FILES")
(FNS COMMON-FILE-COMMAND COMMON-MAKEFILE) (FNS COMMON-FILE-COMMAND COMMON-MAKEFILE)
(PROP MAKEFILE-ENVIRONMENT COMMON-MAKE) (PROP MAKEFILE-ENVIRONMENT COMMON-MAKE)
(EDITHIST COMMON-MAKE))) (DECLARE%: DONTCOPY (ALISTS (EDITHISTALIST COMMON-MAKE])
(* FUNCTIONS TO HANDLE WRITING STANDARD COMMONLISP SOURCE FILES) (* ;; "FUNCTIONS TO HANDLE WRITING STANDARD COMMONLISP SOURCE FILES")
(DEFINEQ (DEFINEQ
@@ -227,30 +226,20 @@ Copyright (c) 1987 by Unisys Corp.. All rights reserved.
(CLOSEF *STANDARD-OUTPUT*]) (CLOSEF *STANDARD-OUTPUT*])
) )
(PUTPROPS COMMON-MAKE MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP")) (PUTPROPS COMMON-MAKE MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(ADDTOVAR EDITHISTALIST (COMMON-MAKE ("11-Dec-87 12:54:22" DJVB {DSK}<XAVIER>COMMON-MAKE.;1 (ADDTOVAR EDITHISTALIST
(COMMON-FILE-COMMAND COMMON-MAKEFILE)) (COMMON-MAKE ("11-Dec-87 12:54:22" DJVB {DSK}<XAVIER>COMMON-MAKE.;1 (COMMON-FILE-COMMAND
("11-Dec-87 13:35:35" DJVB {DSK}<XAVIER>COMMON-MAKE.;2 ( COMMON-MAKEFILE))
COMMON-FILE-COMMAND ("11-Dec-87 13:35:35" DJVB {DSK}<XAVIER>COMMON-MAKE.;2 (COMMON-FILE-COMMAND
COMMON-MAKEFILE)
COMMON-MAKEFILE (GETTING DETAILS RIGHT))
) ("11-Dec-87 13:40:48" DJVB {DSK}<XAVIER>COMMON-MAKE.;3 (COMMON-FILE-COMMAND))
(GETTING DETAILS RIGHT)) ("11-Dec-87 14:09:04" DJVB {DSK}<XAVIER>COMMON-MAKE.;4 (COMMON-FILE-COMMAND))
("11-Dec-87 13:40:48" DJVB {DSK}<XAVIER>COMMON-MAKE.;3 ( ("11-Dec-87 14:48:44" DJVB {DSK}<XAVIER>COMMON-MAKE.;5 (COMMON-FILE-COMMAND)
COMMON-FILE-COMMAND (FIXED FILE COMMENTS AND CL:DEFVAR ET AL))))
))
("11-Dec-87 14:09:04" DJVB {DSK}<XAVIER>COMMON-MAKE.;4 (
COMMON-FILE-COMMAND
))
("11-Dec-87 14:48:44" DJVB {DSK}<XAVIER>COMMON-MAKE.;5 (
COMMON-FILE-COMMAND
)
(FIXED FILE COMMENTS AND CL:DEFVAR ET AL))))
) )
(PUTPROPS COMMON-MAKE COPYRIGHT ("Unisys Corp." 1987))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (829 13460 (COMMON-FILE-COMMAND 839 . 9055) (COMMON-MAKEFILE 9057 . 13458))))) (FILEMAP (NIL (722 13353 (COMMON-FILE-COMMAND 732 . 8948) (COMMON-MAKEFILE 8950 . 13351)))))
STOP STOP
ÿ

BIN
lispusers/COMMON-MAKE.LCOM Normal file
View File

Binary file not shown.

287
lispusers/MANAGER
View File

@@ -1,16 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "15-Sep-2022 23:39:36" {DSK}<home>matt>medley>LISPUSERS>MANAGER.;2 111145 (FILECREATED "13-Oct-2023 16:41:52" {LU}MANAGER.;3 112648
:EDIT-BY "mth"
:CHANGES-TO (FNS Manager.DO.COMMAND) :CHANGES-TO (FNS Manager.DO.COMMAND)
(VARS MANAGERCOMS MANAGER-FILE-OPERATIONS-COMMANDS)
:PREVIOUS-DATE "10-Feb-2022 22:17:51" {DSK}<home>matt>medley>LISPUSERS>MANAGER.;1) :PREVIOUS-DATE "10-Oct-2023 11:27:25" {LU}MANAGER.;1)
(* ; "
Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation.
")
(PRETTYCOMPRINT MANAGERCOMS) (PRETTYCOMPRINT MANAGERCOMS)
(RPAQQ MANAGERCOMS (RPAQQ MANAGERCOMS
@@ -52,11 +51,12 @@ Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation.
(* ;; "") (* ;; "")
(SPECVARS Manager.ACTIVEFLG MANAGER-CASES MANAGER-ADDTOFILES?) (SPECVARS Manager.ACTIVEFLG MANAGER-CASES MANAGER-ADDTOFILES?)
(GLOBALVARS LAMBDAFONT DEFAULTFONT MENUFONT BOLDMENUFONT MANAGER-WINDOWS LOADBFLG SAVEDBFLG (GLOBALVARS LAMBDAFONT DEFAULTFONT MENUFONT BOLDMENUFONT MANAGER-WINDOWS LOADDBFLG SAVEDBFLG
MANAGER-ITEM-OPERATION-COMMANDS MANAGER-ITEM-FILE-RELATION-COMMANDS MANAGER-ITEM-OPERATION-COMMANDS MANAGER-ITEM-FILE-RELATION-COMMANDS
MANAGER-FILE-OPERATIONS-COMMANDS MANAGER-FILE-FILE-RELATION-COMMANDS MANAGER-FILE-OPERATIONS-COMMANDS MANAGER-FILE-FILE-RELATION-COMMANDS
MANAGER-MAIN-MENU-ITEMS MANAGER-ACTIVITY-WINDOW-TITLE BackgroundMenuCommands MANAGER-MAIN-MENU-ITEMS MANAGER-ACTIVITY-WINDOW-TITLE MANAGER-MAIN-WINDOW
BackgroundMenu) MANAGER-MAIN-ICONW Manager.WINDOW-ANCHOR MANAGER.BM MANAGER.BM.MASK
BackgroundMenuCommands BackgroundMenu)
(VARS *UNMANAGED-TYPES* MANAGER-ACTIVITY-WINDOW-TITLE (MANAGER-CASES) (VARS *UNMANAGED-TYPES* MANAGER-ACTIVITY-WINDOW-TITLE (MANAGER-CASES)
(MANAGER-ADDTOFILES?) (MANAGER-ADDTOFILES?)
MANAGER-FILE-FILE-RELATION-COMMANDS MANAGER-FILE-OPERATIONS-COMMANDS MANAGER-FILE-FILE-RELATION-COMMANDS MANAGER-FILE-OPERATIONS-COMMANDS
@@ -64,28 +64,33 @@ Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation.
MANAGER-MAIN-MENU-ITEMS MANAGER.BM MANAGER.BM.MASK) MANAGER-MAIN-MENU-ITEMS MANAGER.BM MANAGER.BM.MASK)
(INITVARS (Manager.ACTIVEFLG NIL) (INITVARS (Manager.ACTIVEFLG NIL)
(Manager.SORTFILELSTFLG T) (Manager.SORTFILELSTFLG T)
(Manager.WINDOW-ANCHOR 'ANCHOR-BL)
(Manager.MENUROWS 20) (Manager.MENUROWS 20)
(Manager.DATASPACE NIL) (Manager.DATASPACE NIL)
(MANAGER-WINDOWS NIL) (MANAGER-WINDOWS NIL)
(MANAGER-MAIN-WINDOW NIL) (MANAGER-MAIN-WINDOW NIL)
(MANAGER-MAIN-ICONW (ICONW MANAGER.BM MANAGER.BM.MASK
(create POSITION XCOORD _ 0 YCOORD _ 0)
T))
(MANAGER-OPEN-WINDOWS NIL) (MANAGER-OPEN-WINDOWS NIL)
(MANAGER-FILE-MENU NIL) (MANAGER-FILE-MENU NIL)
(MANAGER-FILELST-MENU NIL) (MANAGER-FILELST-MENU NIL)
(MANAGER-FILE-OPERATIONS-MENU NIL) (MANAGER-FILE-OPERATIONS-MENU NIL)
(MANAGER-FILE-FILE-RELATION-MENU NIL) (MANAGER-FILE-FILE-RELATION-MENU NIL)
(MANAGER-MARKED-SHADE BOLDMENUFONT)) (MANAGER-MARKED-SHADE BOLDMENUFONT))
(FILES FILEBROWSER) (FILES DATABASEFNS FILEBROWSER (FROM LISPUSERS)
(* ; "for SEE command") COMMON-MAKE)
(* ; "FILEBROWSER for SEE command")
(FNS MANAGER MANAGER.RESET Manager.ADDADV Manager.ADDTOFILES? Manager.ALTERMARKING (FNS MANAGER MANAGER.RESET Manager.ADDADV Manager.ADDTOFILES? Manager.ALTERMARKING
Manager.DO.COMMAND Manager.HIGHLIGHT Manager.PROMPT Manager.WINDOW Manager.ANCHORED-SET-POSITION Manager.DO.COMMAND Manager.HIGHLIGHT Manager.PROMPT
Manager.insurefilehighlights Manager.CHANGED? Manager.CHECKFILE Manager.COLLECTCOMS Manager.WINDOW Manager.insurefilehighlights Manager.CHANGED? Manager.CHECKFILE
Manager.COMS.WSF Manager.COMSOPEN Manager.COMSUPDATE Manager.HIGHLIGHTED Manager.COLLECTCOMS Manager.COMS.WSF Manager.COMSOPEN Manager.COMSUPDATE
Manager.INSUREHIGHLIGHTS Manager.FILECHANGES Manager.FILELSTCHANGED? Manager.HIGHLIGHTED Manager.INSUREHIGHLIGHTS Manager.FILECHANGES Manager.FILELSTCHANGED?
Manager.FILESUBTYPES Manager.GET.ENVIRONMENT Manager.GETFILE Manager.INTITLE? Manager.FILESUBTYPES Manager.GET.ENVIRONMENT Manager.GETFILE Manager.INTITLE?
Manager.MAIN.WSF Manager.MAINCLOSE Manager.MAINMENUITEMS Manager.MAINOPEN Manager.MAIN.WSF Manager.MAINCLOSE Manager.MAINMENUITEMS Manager.MAINOPEN
Manager.MAINUPDATE Manager.MAKEFILE.ADV Manager.MENUCOLUMNS Manager.MENUHASITEM Manager.MAINUPDATE Manager.MAKEFILE.ADV Manager.MENUCOLUMNS Manager.MENUHASITEM
Manager.MENUITEMS Manager.REMOVE.DUPLICATE.ADVICE Manager.RESETSUBITEMS Manager.MENUITEMS Manager.REMOVE.DUPLICATE.ADVICE Manager.RESETSUBITEMS
Manager.SORT.COMS Manager.SORTBYCOLUMN) Manager.SET-ANCHOR Manager.SORT.COMS Manager.SORTBYCOLUMN)
(ADVISE ADDFILE ADDTOFILES? MAKEFILE MARKASCHANGED UNMARKASCHANGED UPDATEFILES ADDTOCOMS (ADVISE ADDFILE ADDTOFILES? MAKEFILE MARKASCHANGED UNMARKASCHANGED UPDATEFILES ADDTOCOMS
DELFROMCOMS \ADDTOFILEBLOCK/ADDNEWCOM LOAD LOADFNS (MARKASCHANGED :IN DELFROMCOMS \ADDTOFILEBLOCK/ADDNEWCOM LOAD LOADFNS (MARKASCHANGED :IN
DEFAULT.EDITDEFA0001)) DEFAULT.EDITDEFA0001))
@@ -181,10 +186,11 @@ Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation.
) )
(DECLARE%: DOEVAL@COMPILE DONTCOPY (DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS LAMBDAFONT DEFAULTFONT MENUFONT BOLDMENUFONT MANAGER-WINDOWS LOADBFLG SAVEDBFLG (GLOBALVARS LAMBDAFONT DEFAULTFONT MENUFONT BOLDMENUFONT MANAGER-WINDOWS LOADDBFLG SAVEDBFLG
MANAGER-ITEM-OPERATION-COMMANDS MANAGER-ITEM-FILE-RELATION-COMMANDS MANAGER-ITEM-OPERATION-COMMANDS MANAGER-ITEM-FILE-RELATION-COMMANDS
MANAGER-FILE-OPERATIONS-COMMANDS MANAGER-FILE-FILE-RELATION-COMMANDS MANAGER-MAIN-MENU-ITEMS MANAGER-FILE-OPERATIONS-COMMANDS MANAGER-FILE-FILE-RELATION-COMMANDS MANAGER-MAIN-MENU-ITEMS
MANAGER-ACTIVITY-WINDOW-TITLE BackgroundMenuCommands BackgroundMenu) MANAGER-ACTIVITY-WINDOW-TITLE MANAGER-MAIN-WINDOW MANAGER-MAIN-ICONW Manager.WINDOW-ANCHOR
MANAGER.BM MANAGER.BM.MASK BackgroundMenuCommands BackgroundMenu)
) )
(RPAQQ *UNMANAGED-TYPES* (EXPRESSIONS FILES FIELDS FILEVARS-ARE-NOW-OK)) (RPAQQ *UNMANAGED-TYPES* (EXPRESSIONS FILES FIELDS FILEVARS-ARE-NOW-OK))
@@ -368,6 +374,12 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
("Edit FILELST" 'EDIT ("Edit FILELST" 'EDIT
"Edit the variable which lists the files noticed by the file package"))) "Edit the variable which lists the files noticed by the file package")))
("Advice" 'SHOWADVICE "Display the list of advised or traced fns and functions.") ("Advice" 'SHOWADVICE "Display the list of advised or traced fns and functions.")
("Set Window Anchor" 'ANCHOR-BL
"Set the anchor corner for window growth to Bottom Left (default)"
(SUBITEMS (" Top Left " 'ANCHOR-TL "Set the anchor corner to Top Left")
(" Top Right " 'ANCHOR-TR "Set the anchor corner to Top Right")
(" Bottom Left " 'ANCHOR-BL "Set the anchor corner to Bottom Left")
(" Bottom Right " 'ANCHOR-BR "Set the anchor corner to Bottom Right")))
("Quit" 'QUIT "Shut down all manager windows" (SUBITEMS ("Quit" 'QUIT ("Quit" 'QUIT "Shut down all manager windows" (SUBITEMS ("Quit" 'QUIT
"Shut down all manager windows" "Shut down all manager windows"
) )
@@ -385,6 +397,8 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(RPAQ? Manager.SORTFILELSTFLG T) (RPAQ? Manager.SORTFILELSTFLG T)
(RPAQ? Manager.WINDOW-ANCHOR 'ANCHOR-BL)
(RPAQ? Manager.MENUROWS 20) (RPAQ? Manager.MENUROWS 20)
(RPAQ? Manager.DATASPACE NIL) (RPAQ? Manager.DATASPACE NIL)
@@ -393,6 +407,9 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(RPAQ? MANAGER-MAIN-WINDOW NIL) (RPAQ? MANAGER-MAIN-WINDOW NIL)
(RPAQ? MANAGER-MAIN-ICONW (ICONW MANAGER.BM MANAGER.BM.MASK (create POSITION XCOORD _ 0 YCOORD _ 0)
T))
(RPAQ? MANAGER-OPEN-WINDOWS NIL) (RPAQ? MANAGER-OPEN-WINDOWS NIL)
(RPAQ? MANAGER-FILE-MENU NIL) (RPAQ? MANAGER-FILE-MENU NIL)
@@ -405,11 +422,12 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(RPAQ? MANAGER-MARKED-SHADE BOLDMENUFONT) (RPAQ? MANAGER-MARKED-SHADE BOLDMENUFONT)
(FILESLOAD FILEBROWSER) (FILESLOAD DATABASEFNS FILEBROWSER (FROM LISPUSERS)
COMMON-MAKE)
(* ; "for SEE command") (* ; "FILEBROWSER for SEE command")
(DEFINEQ (DEFINEQ
@@ -522,11 +540,30 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(Manager.HIGHLIGHT ITEM MENU MARKING?))) finally (Manager.MAINUPDATE (Manager.HIGHLIGHT ITEM MENU MARKING?))) finally (Manager.MAINUPDATE
UPDATEFILES]) UPDATEFILES])
(Manager.ANCHORED-SET-POSITION
[LAMBDA (IW IH) (* ; "Edited 10-Oct-2023 11:22 by mth")
(LET (WREGION XPOS YPOS TEMP)
(SETQ WREGION (WINDOWPROP MANAGER-MAIN-WINDOW 'REGION))
(SETQ YPOS (fetch (REGION BOTTOM) of WREGION))
(if (FMEMB Manager.WINDOW-ANCHOR '(ANCHOR-TL ANCHOR-TR))
then (SETQ YPOS (- (+ YPOS (fetch (REGION HEIGHT) of WREGION))
IH)))
(SETQ TEMP (+ YPOS IH))
(if (>= TEMP SCREENHEIGHT)
then (SETQ YPOS (- SCREENHEIGHT 1)))
(SETQ XPOS (fetch (REGION LEFT) of WREGION))
(if (FMEMB Manager.WINDOW-ANCHOR '(ANCHOR-TR ANCHOR-BR))
then (SETQ XPOS (- (+ XPOS (fetch (REGION WIDTH) of WREGION))
IW)))
(SETQ TEMP (+ XPOS IW))
(if (>= TEMP SCREENWIDTH)
then (SETQ XPOS (- SCREENWIDTH 1)))
(create POSITION
XCOORD _ XPOS
YCOORD _ YPOS])
(Manager.DO.COMMAND (Manager.DO.COMMAND
[LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 15-Sep-2022 23:35 by Matt Heffron") [LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 13-Oct-2023 16:28 by mth")
(* ; "Edited 15-Sep-2022 23:32 by Matt Heffron")
(* ; "Edited 15-Sep-2022 23:19 by Matt Heffron")
(* ; "Edited 18-Nov-87 14:30 by raf")
(if (EQ COMSTYPE 'FILEVARS) (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.") 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.")
) )
@@ -719,15 +756,22 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(Manager.HIGHLIGHT FILE MENU))) (Manager.HIGHLIGHT FILE MENU)))
else (* ; "single item") else (* ; "single item")
(UNMARKASCHANGED ITEM COMSTYPE))) (UNMARKASCHANGED ITEM COMSTYPE)))
(SEE (FB.FASTSEE.ONEFILE (SEE (LET ((FULLNAME (OR (CDAR (GETPROP FILE 'FILEDATES))
NIL FILE (LET [(W (CREATEW NIL (CONCAT "Seeing " FILE FILE)))
"..."]
(DSPSCROLL 'ON W) (* ;;
(WINDOWPROP W 'PAGEFULLFN  "I'm assuming that the CAR of the FILEDATES list is the most recent...")
'FB.SEEFULLFN)
(TTYDISPLAYSTREAM W) (FB.FASTSEE.ONEFILE
W))) NIL FULLNAME
(TEDIT-SEE (TEDIT-SEE FILE)) (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 (LOAD
(printout T .FONT LAMBDAFONT "Loading file " FILE "." (printout T .FONT LAMBDAFONT "Loading file " FILE "."
.FONT DEFAULTFONT T) .FONT DEFAULTFONT T)
@@ -748,18 +792,20 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
then NIL then NIL
else (LIST COMMAND] else (LIST COMMAND]
(printout T .FONT DEFAULTFONT T))) (printout T .FONT DEFAULTFONT T)))
(COMMON-MAKEFILE (COMMON-MAKEFILE (if FILE
(FILESLOAD 'COMMON-MAKEFILE) then (printout T .FONT LAMBDAFONT
(if FILE "Writing CommonLisp source into "
then (printout T .FONT LAMBDAFONT FILE ".LSP" .FONT
"Writing CommonLisp source into " FILE DEFAULTFONT T)
".LSP" .FONT DEFAULTFONT T) (PRINT (COMMON-MAKEFILE FILE)
(PRINT (USER::COMMON-MAKEFILE FILE) T)
T) else (CL:FORMAT T
else (CL:FORMAT T
"~&CommonLispify must be selected separately for each file" "~&CommonLispify must be selected separately for each file"
))) )))
((LIST HARDCOPY) (LISTFILES1 FILE)) ((LIST HARDCOPY) (LISTFILES1 FILE))
((ANCHOR-TL ANCHOR-TR ANCHOR-BL ANCHOR-BR) (
 Manager.SET-ANCHOR
COMMAND))
(CLEANUP (CLEANUP
(printout T .FONT LAMBDAFONT "Cleanup..." .FONT (printout T .FONT LAMBDAFONT "Cleanup..." .FONT
DEFAULTFONT T) DEFAULTFONT T)
@@ -821,68 +867,42 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(* ;; "DATABASEFNS stuff") (* ;; "DATABASEFNS stuff")
(DB (DB (CL:FORMAT T
(FILESLOAD 'DATABASEFNS)
(CL:FORMAT T
"~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a" "~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a"
SAVEDBFLG LOADBFLG)) SAVEDBFLG LOADDBFLG))
(DBFILE (DBFILE
(FILESLOAD 'DATABASEFNS)
(CL:FORMAT T "~&The DATABASE prop for ~a is: ~a" FILE (CL:FORMAT T "~&The DATABASE prop for ~a is: ~a" FILE
(GETPROP FILE 'DATABASE)) (GETPROP FILE 'DATABASE))
(CL:FORMAT T (CL:FORMAT T
"~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a" "~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a"
SAVEDBFLG LOADBFLG)) SAVEDBFLG LOADDBFLG))
(DBON (DBON
(FILESLOAD 'DATABASEFNS) (SETQ LOADDBFLG 'ON)
(SETQ LOADBFLG 'ON)
(SETQ SAVEDBFLG 'ON)) (SETQ SAVEDBFLG 'ON))
(DBOFF (DBOFF
(FILESLOAD 'DATABASEFNS) (SETQ LOADDBFLG 'NO)
(SETQ LOADBFLG 'OFF) (SETQ SAVEDBFLG 'NO))
(SETQ SAVEDBFLG 'OFF))
(DBASK (DBASK
(FILESLOAD 'DATABASEFNS) (SETQ LOADDBFLG 'ASK)
(SETQ LOADBFLG 'ASK)
(SETQ SAVEDBFLG 'ASK)) (SETQ SAVEDBFLG 'ASK))
(DBLOADON (DBLOADON (SETQ LOADDBFLG 'YES))
(FILESLOAD 'DATABASEFNS) (DBSAVEON (SETQ SAVEDBFLG 'YES))
(SETQ LOADBFLG 'ON)) (DBLOADOFF (SETQ LOADDBFLG 'NO))
(DBSAVEON (DBSAVEOFF (SETQ SAVEDBFLG 'NO))
(FILESLOAD 'DATABASEFNS) (DBLOADASK (SETQ LOADDBFLG 'ASK))
(SETQ SAVEDBFLG 'ON)) (DBSAVEASK (SETQ SAVEDBFLG 'ASK))
(DBLOADOFF (DBFILEON (PUTPROP FILE 'DATABASE 'YES))
(FILESLOAD 'DATABASEFNS) (DBFILEOFF (PUTPROP FILE 'DATABASE 'NO))
(SETQ LOADBFLG 'OFF)) (DBFILEASK (PUTPROP FILE 'DATABASE 'ASK))
(DBSAVEOFF
(FILESLOAD 'DATABASEFNS)
(SETQ SAVEDBFLG 'OFF))
(DBLOADASK
(FILESLOAD 'DATABASEFNS)
(SETQ LOADBFLG 'ASK))
(DBSAVEASK
(FILESLOAD 'DATABASEFNS)
(SETQ SAVEDBFLG 'ASK))
(DBFILEON
(FILESLOAD 'DATABASEFNS)
(PUTPROP FILE 'DATABASE 'ON))
(DBFILEOFF
(FILESLOAD 'DATABASEFNS)
(PUTPROP FILE 'DATABASE 'OFF))
(DBFILEASK
(FILESLOAD 'DATABASEFNS)
(PUTPROP FILE 'DATABASE 'ASK))
(DUMPDB (DUMPDB
(printout T .FONT LAMBDAFONT (printout T .FONT LAMBDAFONT
"Dumping the Masterscope Database for file " FILE "Dumping the Masterscope Database for file " FILE
.FONT DEFAULTFONT T) .FONT DEFAULTFONT T)
(FILESLOAD 'DATABASEFNS)
(DUMPDB FILE)) (DUMPDB FILE))
(LOADDB (LOADDB
(printout T .FONT LAMBDAFONT (printout T .FONT LAMBDAFONT
"Loading the Masterscope Database for file " FILE "Loading the Masterscope Database for file " FILE
.FONT DEFAULTFONT T) .FONT DEFAULTFONT T)
(FILESLOAD 'DATABASEFNS)
(LOADDB FILE)) (LOADDB FILE))
(COMPILE (COMPILE
(printout T .FONT LAMBDAFONT "Compiling..." .FONT (printout T .FONT LAMBDAFONT "Compiling..." .FONT
@@ -1372,7 +1392,7 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
FILE]) FILE])
(Manager.MAINOPEN (Manager.MAINOPEN
[LAMBDA (POSITION) (* ; "Edited 17-Aug-87 13:59 by raf") [LAMBDA (POSITION) (* ; "Edited 10-Oct-2023 11:23 by mth")
(* ;;; "Builds the manager main (FILELST) menu at the indicated position.") (* ;;; "Builds the manager main (FILELST) menu at the indicated position.")
@@ -1387,31 +1407,30 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(ADDMENU MANAGER-FILE-MENU (ADDMENU MANAGER-FILE-MENU
(SETQ MANAGER-MAIN-WINDOW (SETQ MANAGER-MAIN-WINDOW
(CREATEW (with POSITION (CREATEW (with POSITION (with MENU MANAGER-FILE-MENU (SETQ IW (MIN (WIDTHIFWINDOW
(with MENU MANAGER-FILE-MENU (SETQ IW (MIN (WIDTHIFWINDOW IMAGEWIDTH) IMAGEWIDTH)
SCREENWIDTH)) SCREENWIDTH))
(* ; (* ;
 "width of file menu. Actually unlikely to be wider than screenwidth (!)")  "width of file menu. Actually unlikely to be wider than screenwidth (!)")
(SETQ IH (MIN (HEIGHTIFWINDOW IMAGEHEIGHT T) (SETQ IH (MIN (HEIGHTIFWINDOW IMAGEHEIGHT T)
SCREENHEIGHT)) SCREENHEIGHT))
(* ; (* ;
 "height of window; could possibly be higher than screen if lots of files")  "height of window; could possibly be higher than screen if lots of files")
(if (POSITIONP POSITION) (if (POSITIONP POSITION)
then (* ; then (* ;
 "gave an initial position for the manager file menu")  "gave an initial position for the manager file menu")
POSITION POSITION
elseif (WINDOWP MANAGER-MAIN-WINDOW) elseif (WINDOWP MANAGER-MAIN-WINDOW)
then (* ; then (* ;
 "if there was a window, put the new one in the same place (and close the old one)")  "if there was a window, put the new one in the same place (and close the old one)")
(PROG1 (with REGION (WINDOWPROP MANAGER-MAIN-WINDOW (PROG1 (Manager.ANCHORED-SET-POSITION IW IH)
'REGION)
(create POSITION (* ;; "(with REGION (WINDOWPROP MANAGER-MAIN-WINDOW (QUOTE REGION)) (create POSITION XCOORD _ LEFT YCOORD _ BOTTOM))")
XCOORD _ LEFT
YCOORD _ BOTTOM)) (CLOSEW MANAGER-MAIN-WINDOW))
(CLOSEW MANAGER-MAIN-WINDOW)) else (* ;
else (* ;
 "let user say where to put the menu")  "let user say where to put the menu")
(GETBOXPOSITION IW IH))) (GETBOXPOSITION IW IH)))
(create REGION (create REGION
LEFT _ XCOORD LEFT _ XCOORD
WIDTH _ IW WIDTH _ IW
@@ -1434,17 +1453,18 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(* ;; "Shrink to the manager icon, and remember to update when the expanding") (* ;; "Shrink to the manager icon, and remember to update when the expanding")
[WINDOWPROP MANAGER-MAIN-WINDOW 'ICONFN (FUNCTION (LAMBDA (WIN OICON) [WINDOWPROP MANAGER-MAIN-WINDOW 'ICONFN (FUNCTION (LAMBDA (WIN OICON)
(LET ((IW (if (NULL OICON) (SETQ MANAGER-MAIN-ICONW
then (ICONW MANAGER.BM (if (NULL OICON)
MANAGER.BM.MASK then (OR MANAGER-MAIN-ICONW
) (ICONW MANAGER.BM
else OICON))) MANAGER.BM.MASK))
[WINDOWPROP IW 'EXPANDFN else OICON))
(FUNCTION (LAMBDA NIL [WINDOWPROP MANAGER-MAIN-ICONW
( 'EXPANDFN
 Manager.MAINUPDATE (FUNCTION (LAMBDA NIL
NIL] (Manager.MAINUPDATE
IW] NIL]
MANAGER-MAIN-ICONW]
(SETQ Manager.ACTIVEFLG T) (SETQ Manager.ACTIVEFLG T)
(Manager.MAINUPDATE T]) (Manager.MAINUPDATE T])
@@ -1545,6 +1565,12 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(CONCAT "Creates a " TYPE (CONCAT "Creates a " TYPE
" submenu for the file " FILE]) " submenu for the file " FILE])
(Manager.SET-ANCHOR
[LAMBDA (NEWANCHOR) (* ; "Edited 10-Oct-2023 11:24 by mth")
(if (AND (FMEMB NEWANCHOR '(ANCHOR-TL ANCHOR-TR ANCHOR-BL ANCHOR-BR))
(NEQ Manager.WINDOW-ANCHOR NEWANCHOR))
then (SETQ Manager.WINDOW-ANCHOR NEWANCHOR])
(Manager.SORT.COMS (Manager.SORT.COMS
[LAMBDA (A B) (* ; "Edited 18-Nov-87 15:12 by raf") [LAMBDA (A B) (* ; "Edited 18-Nov-87 15:12 by raf")
@@ -1746,20 +1772,21 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(ADDTOVAR LAMA ) (ADDTOVAR LAMA )
) )
(PUTPROPS MANAGER COPYRIGHT ("Xerox Corporation" 1986 1987 1900 2022))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (24415 101274 (MANAGER 24425 . 25224) (MANAGER.RESET 25226 . 26740) (Manager.ADDADV (FILEMAP (NIL (25676 102848 (MANAGER 25686 . 26485) (MANAGER.RESET 26487 . 28001) (Manager.ADDADV
26742 . 28095) (Manager.ADDTOFILES? 28097 . 28375) (Manager.ALTERMARKING 28377 . 29987) ( 28003 . 29356) (Manager.ADDTOFILES? 29358 . 29636) (Manager.ALTERMARKING 29638 . 31248) (
Manager.DO.COMMAND 29989 . 61755) (Manager.HIGHLIGHT 61757 . 62054) (Manager.PROMPT 62056 . 62369) ( Manager.ANCHORED-SET-POSITION 31250 . 32353) (Manager.DO.COMMAND 32355 . 62991) (Manager.HIGHLIGHT
Manager.WINDOW 62371 . 63004) (Manager.insurefilehighlights 63006 . 64077) (Manager.CHANGED? 64079 . 62993 . 63290) (Manager.PROMPT 63292 . 63605) (Manager.WINDOW 63607 . 64240) (
64628) (Manager.CHECKFILE 64630 . 65729) (Manager.COLLECTCOMS 65731 . 67169) (Manager.COMS.WSF 67171 Manager.insurefilehighlights 64242 . 65313) (Manager.CHANGED? 65315 . 65864) (Manager.CHECKFILE 65866
. 69841) (Manager.COMSOPEN 69843 . 74581) (Manager.COMSUPDATE 74583 . 75675) (Manager.HIGHLIGHTED . 66965) (Manager.COLLECTCOMS 66967 . 68405) (Manager.COMS.WSF 68407 . 71077) (Manager.COMSOPEN 71079
75677 . 75983) (Manager.INSUREHIGHLIGHTS 75985 . 76543) (Manager.FILECHANGES 76545 . 76844) ( . 75817) (Manager.COMSUPDATE 75819 . 76911) (Manager.HIGHLIGHTED 76913 . 77219) (
Manager.FILELSTCHANGED? 76846 . 77174) (Manager.FILESUBTYPES 77176 . 77814) (Manager.GET.ENVIRONMENT Manager.INSUREHIGHLIGHTS 77221 . 77779) (Manager.FILECHANGES 77781 . 78080) (Manager.FILELSTCHANGED?
77816 . 80354) (Manager.GETFILE 80356 . 82670) (Manager.INTITLE? 82672 . 83350) (Manager.MAIN.WSF 78082 . 78410) (Manager.FILESUBTYPES 78412 . 79050) (Manager.GET.ENVIRONMENT 79052 . 81590) (
83352 . 85996) (Manager.MAINCLOSE 85998 . 87108) (Manager.MAINMENUITEMS 87110 . 88187) ( Manager.GETFILE 81592 . 83906) (Manager.INTITLE? 83908 . 84586) (Manager.MAIN.WSF 84588 . 87232) (
Manager.MAINOPEN 88189 . 93565) (Manager.MAINUPDATE 93567 . 94203) (Manager.MAKEFILE.ADV 94205 . 95241 Manager.MAINCLOSE 87234 . 88344) (Manager.MAINMENUITEMS 88346 . 89423) (Manager.MAINOPEN 89425 . 94818
) (Manager.MENUCOLUMNS 95243 . 96047) (Manager.MENUHASITEM 96049 . 96406) (Manager.MENUITEMS 96408 . ) (Manager.MAINUPDATE 94820 . 95456) (Manager.MAKEFILE.ADV 95458 . 96494) (Manager.MENUCOLUMNS 96496
96653) (Manager.REMOVE.DUPLICATE.ADVICE 96655 . 98261) (Manager.RESETSUBITEMS 98263 . 99500) ( . 97300) (Manager.MENUHASITEM 97302 . 97659) (Manager.MENUITEMS 97661 . 97906) (
Manager.SORT.COMS 99502 . 100034) (Manager.SORTBYCOLUMN 100036 . 101272))))) Manager.REMOVE.DUPLICATE.ADVICE 97908 . 99514) (Manager.RESETSUBITEMS 99516 . 100753) (
Manager.SET-ANCHOR 100755 . 101074) (Manager.SORT.COMS 101076 . 101608) (Manager.SORTBYCOLUMN 101610
. 102846)))))
STOP STOP

BIN
lispusers/MANAGER.DFASL
View File

Binary file not shown.

BIN
lispusers/MANAGER.TEDIT
View File

Binary file not shown.

6
scripts/medley/medley.cmd
View File

@@ -1,3 +1,3 @@
@echo off @echo off
powershell medley.ps1 %* powershell medley.ps1 %*