Compare commits
32 Commits
medley-230
...
medley-231
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
d92aa6395a | ||
|
|
f1833861cc | ||
|
|
270fee89e3 | ||
|
|
cba04e168c | ||
|
|
1e847ec274 | ||
|
|
f765676ec4 | ||
|
|
17c72a1f2f | ||
|
|
995c6de04e | ||
|
|
877c6fbf17 | ||
|
|
97b19f1b96 | ||
|
|
948b0e09d1 | ||
|
|
de4e5f5ca4 | ||
|
|
af912247b3 | ||
|
|
bf2e34841b | ||
|
|
9ed6448591 | ||
|
|
445de6745d | ||
|
|
68ed78a9f9 | ||
|
|
1ae08139c9 | ||
|
|
bb4e230df4 | ||
|
|
781709e4e1 | ||
|
|
9b4c4a3bf7 | ||
|
|
51d554c67e | ||
|
|
ca39ccf27b | ||
|
|
e1cd9260b4 | ||
|
|
b0aa518a41 | ||
|
|
9e0bfabc52 | ||
|
|
ebff4f7268 | ||
|
|
c281728c65 | ||
|
|
c4554894b3 | ||
|
|
58196b4011 | ||
|
|
f6a9b88b34 | ||
|
|
bad19ab45f |
99
.github/workflows/buildLoadup.yml
vendored
99
.github/workflows/buildLoadup.yml
vendored
@@ -128,6 +128,8 @@ jobs:
|
||||
combined_release_tag: ${{ steps.job_outputs.outputs.COMBINED_RELEASE_TAG }}
|
||||
medley_release_tag: ${{ steps.job_outputs.outputs.MEDLEY_RELEASE_TAG }}
|
||||
medley_short_release_tag: ${{ steps.job_outputs.outputs.MEDLEY_SHORT_RELEASE_TAG }}
|
||||
debs_filename_base: ${{ steps.debs.outputs.DEBS_FILENAME_BASE }}
|
||||
maiko_release_tag: ${{ steps.job_outputs.outputs.MAIKO_RELEASE_TAG }}
|
||||
artifacts_filename_template: ${{ steps.job_outputs.outputs.ARTIFACTS_FILENAME_TEMPLATE }}
|
||||
release_url: ${{ steps.push.outputs.html_url }}
|
||||
|
||||
@@ -154,7 +156,7 @@ jobs:
|
||||
id: tag
|
||||
uses: ./../actions/release-tag-action
|
||||
|
||||
# Get Maiko release information, retrieves the name of the latest
|
||||
# Get Maiko release information, retrieves the name of the latest (draft)
|
||||
# release. Used to download the correct Maiko release
|
||||
# Find latest release (draft or normal)
|
||||
- name: Get maiko release information
|
||||
@@ -176,7 +178,6 @@ jobs:
|
||||
echo "maiko_tag=${tag}" >> ${GITHUB_OUTPUT}
|
||||
env:
|
||||
GITHUB_TOKEN: ${{ secrets.MAIKO_TOKEN }}
|
||||
|
||||
# Setup environment variables & establish job outputs
|
||||
- name: Setup Environment Variables
|
||||
run: |
|
||||
@@ -198,6 +199,7 @@ jobs:
|
||||
echo "COMBINED_RELEASE_TAG=${COMBINED_RELEASE_TAG}" >> ${GITHUB_OUTPUT}
|
||||
echo "MEDLEY_RELEASE_TAG=${MEDLEY_RELEASE_TAG}" >> ${GITHUB_OUTPUT}
|
||||
echo "MEDLEY_SHORT_RELEASE_TAG=${MEDLEY_SHORT_RELEASE_TAG}" >> ${GITHUB_OUTPUT}
|
||||
echo "MAIKO_RELEASE_TAG=${MAIKO_RELEASE_TAG}" >> $GITHUB_OUTPUT;
|
||||
echo "ARTIFACTS_FILENAME_TEMPLATE=${ARTIFACTS_FILENAME_TEMPLATE}" >> ${GITHUB_OUTPUT}
|
||||
|
||||
# Setup some needed dirs in workspace
|
||||
@@ -337,6 +339,17 @@ jobs:
|
||||
omitNameDuringUpdate: true
|
||||
omitPrereleaseDuringUpdate: true
|
||||
|
||||
- name: Rename medley tar for the x86_64 platform
|
||||
run: |
|
||||
cd ${{ env.TARS_DIR }}
|
||||
mv medley-full-linux-x86_64-*.tgz medley.tgz
|
||||
|
||||
- name: Save medley tar for use in cygwin installers
|
||||
uses: actions/upload-artifact@v3
|
||||
with:
|
||||
name: medley-tar
|
||||
path: |
|
||||
${{ env.TARS_DIR }}/medley.tgz
|
||||
|
||||
|
||||
# JOB: macos_installer ##############################################################
|
||||
@@ -371,8 +384,7 @@ jobs:
|
||||
echo "MACOS_DIR=${MACOS_DIR}" >>${GITHUB_ENV}
|
||||
echo "ARTIFACTS_DIR=${MACOS_DIR}/artifacts" >>${GITHUB_ENV}
|
||||
echo "TARBALL_DIR=${MACOS_DIR}/tmp/tarballs" >>${GITHUB_ENV}
|
||||
echo "MEDLEY_RELEASE_TAG=${{ needs.loadup.outputs.medley_release_tag }}" \
|
||||
>>${GITHUB_ENV}
|
||||
echo "MEDLEY_RELEASE_TAG=${{ needs.loadup.outputs.medley_release_tag }}" >>${GITHUB_ENV}
|
||||
echo "ARTIFACTS_FILENAME_TEMPLATE=${{ needs.loadup.outputs.artifacts_filename_template }}" >>${GITHUB_ENV}
|
||||
|
||||
# Create tarball dir
|
||||
@@ -410,23 +422,23 @@ jobs:
|
||||
|
||||
|
||||
|
||||
# JOB: windows_installer #############################################################
|
||||
# JOB: cygwin_installer #############################################################
|
||||
|
||||
#
|
||||
# Create the Windows installer, push it up to the release on github and
|
||||
# update the downloads page on OIO
|
||||
#
|
||||
windows_installer:
|
||||
cygwin_installer:
|
||||
|
||||
runs-on: windows-latest
|
||||
runs-on: windows-2022
|
||||
|
||||
needs: [inputs, sentry, loadup]
|
||||
needs: [inputs, sentry, loadup, linux_installer]
|
||||
if: |
|
||||
needs.sentry.outputs.release_not_built == 'true'
|
||||
|| needs.inputs.outputs.force == 'true'
|
||||
|
||||
outputs:
|
||||
windows_installer_filename: ${{ steps.jobout.outputs.INSTALLER_FILENAME }}
|
||||
cygwin_installer: ${{ steps.compile_iss.outputs.CYGWIN_INSTALLER }}
|
||||
|
||||
steps:
|
||||
|
||||
@@ -446,21 +458,57 @@ jobs:
|
||||
echo "MEDLEY_SHORT_RELEASE_TAG=$msrt" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append
|
||||
$aft="${{ needs.loadup.outputs.artifacts_filename_template }}"
|
||||
echo "ARTIFACTS_FILENAME_TEMPLATE=$aft" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append
|
||||
$debs="${{ needs.loadup.outputs.debs_filename_base }}"
|
||||
echo "DEBS_FILENAME_BASE=$debs" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append
|
||||
|
||||
# Retrieve medley tars from artifact store
|
||||
- name: Retrieve medley tar
|
||||
uses: actions/download-artifact@v3
|
||||
with:
|
||||
name: medley-tar
|
||||
path: installers/cygwin/
|
||||
|
||||
# Download maiko cygwin build
|
||||
- name: Retrieve maiko cygwin build
|
||||
shell: powershell
|
||||
env:
|
||||
GH_TOKEN: ${{ secrets.MAIKO_TOKEN }}
|
||||
run: |
|
||||
gh release download ${{ needs.loadup.outputs.maiko_release_tag }} --repo interlisp/maiko --pattern ${{ needs.loadup.outputs.maiko_release_tag }}-cygwin.x86_64.tgz --output installers\cygwin\maiko-cygwin.x86_64.tgz
|
||||
|
||||
# Download cygwin installer to be included by medley.iss
|
||||
- name: Download cygwin installer
|
||||
id: cygwin
|
||||
shell: powershell
|
||||
run: |
|
||||
wget https://cygwin.com/setup-x86_64.exe -OutFile installers\cygwin\setup-x86_64.exe
|
||||
|
||||
# Download vnc viewer
|
||||
- name: Download vncviewer
|
||||
shell: powershell
|
||||
run: |
|
||||
$url = "https://online.interlisp.org/downloads/vncviewer64-1.12.0.exe"
|
||||
$output = "installers\win\vncviewer64-1.12.0.exe"
|
||||
(New-Object System.Net.WebClient).DownloadFile($url, $output)
|
||||
#- name: Download vncviewer
|
||||
# shell: powershell
|
||||
# run: |
|
||||
# $url = "https://sourceforge.net/projects/tigervnc/files/stable/1.12.0/vncviewer64-1.12.0.exe"
|
||||
# $output = "installers\win\vncviewer64-1.12.0.exe"
|
||||
# (New-Object System.Net.WebClient).DownloadFile($url, $output)
|
||||
|
||||
# Run iscc.exe to compile the installer
|
||||
- name: Compile medley.iss
|
||||
#- name: Compile medley.iss
|
||||
# shell: powershell
|
||||
# run: |
|
||||
# iscc installers\win\medley.iss
|
||||
# $filename="medley-install_${env:COMBINED_RELEASE_TAG}_x64.exe"
|
||||
# echo "INSTALLER_FILENAME=$filename" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append
|
||||
|
||||
# Run iscc.exe to compile the installer
|
||||
- name: Compile cygwin_medley.iss
|
||||
id: compile_iss
|
||||
shell: powershell
|
||||
run: |
|
||||
iscc installers\win\medley.iss
|
||||
|
||||
$Env:CYGWIN_INSTALLER_BASE="medley-full-cygwin-x86_64-${env:COMBINED_RELEASE_TAG}"
|
||||
$CYGWIN_INSTALLER="${Env:CYGWIN_INSTALLER_BASE}.exe"
|
||||
echo "CYGWIN_INSTALLER=$CYGWIN_INSTALLER" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append
|
||||
echo "CYGWIN_INSTALLER=$CYGWIN_INSTALLER" | Out-File -FilePath $Env:GITHUB_OUTPUT -Encoding utf8 -Append
|
||||
iscc installers\cygwin\medley.iss
|
||||
|
||||
# Upload windows installer to release
|
||||
- name: Upload windows installer to release
|
||||
@@ -468,7 +516,7 @@ jobs:
|
||||
uses: ncipollo/release-action@v1
|
||||
with:
|
||||
allowUpdates: true
|
||||
artifacts: installers/win/medley-*.exe
|
||||
artifacts: installers/cygwin/${{ env.CYGWIN_INSTALLER }}
|
||||
tag: ${{ env.MEDLEY_RELEASE_TAG }}
|
||||
token: ${{ secrets.GITHUB_TOKEN }}
|
||||
omitBodyDuringUpdate: true
|
||||
@@ -487,7 +535,7 @@ jobs:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
|
||||
needs: [inputs, sentry, loadup, linux_installer, macos_installer, windows_installer]
|
||||
needs: [inputs, sentry, loadup, linux_installer, macos_installer, cygwin_installer]
|
||||
if: |
|
||||
needs.sentry.outputs.release_not_built == 'true'
|
||||
|| needs.inputs.outputs.force == 'true'
|
||||
@@ -503,6 +551,8 @@ jobs:
|
||||
echo "MEDLEY_RELEASE_TAG=${mrt}" >>${GITHUB_ENV}
|
||||
msrt="${{ needs.loadup.outputs.medley_short_release_tag }}"
|
||||
echo "MEDLEY_SHORT_RELEASE_TAG=${msrt}" >>${GITHUB_ENV}
|
||||
cyginst="${{ needs.cygwin_installer.outputs.cygwin_installer }}"
|
||||
echo "CYGWIN_INSTALLER=${cyginst}" >>${GITHUB_ENV}
|
||||
|
||||
# Checkout latest commit
|
||||
- name: Checkout Medley
|
||||
@@ -514,7 +564,7 @@ jobs:
|
||||
# So this will be the final update before creating downloads page
|
||||
# and we can use its url for the page
|
||||
- run: echo "placeholder" >placeholder.txt
|
||||
- name: Upload windows installer to release
|
||||
- name: Upload windows placeholder.txt to release
|
||||
id: pushph
|
||||
uses: ncipollo/release-action@v1
|
||||
with:
|
||||
@@ -552,6 +602,7 @@ jobs:
|
||||
-e "s/@@@MEDLEY.SHORT.RELEASE.TAG@@@/${MEDLEY_SHORT_RELEASE_TAG}/g" \
|
||||
-e "s/@@@COMBINED.RELEASE.TAG@@@/${COMBINED_RELEASE_TAG}/g" \
|
||||
-e "s~@@@DOWNLOAD_URL@@@~${download_url}~g" \
|
||||
-e "s~@@@CYGWIN.INSTALLER@@@~${CYGWIN_INSTALLER}~g" \
|
||||
< "${local_template}" > "${local_filename}"
|
||||
# Create sftp instruction file
|
||||
echo "-rm ${remote_filepath}.oldold" > batch
|
||||
@@ -566,6 +617,12 @@ jobs:
|
||||
env:
|
||||
SSH_KEY: ${{ secrets.OIO_SSH_KEY }}
|
||||
|
||||
# Remove placeholder.txt
|
||||
- name: Remove placeholder.txt
|
||||
run: |
|
||||
gh release delete-asset ${{ env.MEDLEY_RELEASE_TAG }} placeholder.txt --yes
|
||||
env:
|
||||
GH_TOKEN: ${{ secrets.GITHUB_TOKEN }}
|
||||
|
||||
|
||||
# JOB: complete #####################################################################
|
||||
|
||||
@@ -1,12 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Jan-2023 12:44:20" {DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;9 21022
|
||||
(FILECREATED "16-Jun-2023 17:20:09" {DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;11 21130
|
||||
|
||||
:CHANGES-TO (VARS APPS-INITCOMS)
|
||||
(FNS Apps.DoInit)
|
||||
:CHANGES-TO (FNS Apps.DoInit)
|
||||
|
||||
:PREVIOUS-DATE "19-Jan-2023 11:57:40" {DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;8
|
||||
)
|
||||
:PREVIOUS-DATE "19-Jan-2023 12:44:20"
|
||||
{DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;10)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT APPS-INITCOMS)
|
||||
@@ -170,7 +169,11 @@
|
||||
|
||||
(* ;; " create the Documentation and ROOMS, Notecards Activation Buttons, if needed")
|
||||
|
||||
(Apps.CreateButtons T])
|
||||
(Apps.CreateButtons T)
|
||||
|
||||
(* ;; " Make sure Notecards doesn't try to load its HASH file in NC.PostGreet")
|
||||
|
||||
(SETTOPVAL '\NC.SourceAccessFlg NIL])
|
||||
|
||||
(Apps.CreateButtons
|
||||
[LAMBDA (DoDocsToo) (* ; "Edited 13-Dec-2022 12:51 by frank")
|
||||
@@ -373,8 +376,8 @@
|
||||
(BKSYSBUF " ")
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1146 20888 (Apps.InitNotecards 1156 . 5018) (Apps.DoInit 5020 . 8119) (
|
||||
Apps.CreateButtons 8121 . 16945) (Apps.CreateLabel 16947 . 17757) (Apps.ActivateCLOS 17759 . 19108) (
|
||||
Apps.ActivateRooms 19110 . 19961) (Apps.ShowDoc 19963 . 20112) (XCL-USER::EXEC_INTERLISP 20114 . 20886
|
||||
(FILEMAP (NIL (1109 20996 (Apps.InitNotecards 1119 . 4981) (Apps.DoInit 4983 . 8227) (
|
||||
Apps.CreateButtons 8229 . 17053) (Apps.CreateLabel 17055 . 17865) (Apps.ActivateCLOS 17867 . 19216) (
|
||||
Apps.ActivateRooms 19218 . 20069) (Apps.ShowDoc 20071 . 20220) (XCL-USER::EXEC_INTERLISP 20222 . 20994
|
||||
)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
6
installers/cygwin/.gitignore
vendored
Normal file
6
installers/cygwin/.gitignore
vendored
Normal file
@@ -0,0 +1,6 @@
|
||||
medley*.exe
|
||||
medley*.tgz
|
||||
maiko*.tgz
|
||||
setup-x86_64.exe
|
||||
medley.bat
|
||||
|
||||
BIN
installers/cygwin/Medley.ico
Normal file
BIN
installers/cygwin/Medley.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 155 KiB |
165
installers/cygwin/editpath/EditPath.iss
Normal file
165
installers/cygwin/editpath/EditPath.iss
Normal file
@@ -0,0 +1,165 @@
|
||||
; 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
|
||||
; 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
|
||||
; later version.
|
||||
;
|
||||
; 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
|
||||
; FOR A PARTICULAR PURPOSE. See the GNU General Lesser Public License for more
|
||||
; details.
|
||||
;
|
||||
; 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/.
|
||||
|
||||
; Sample Inno Setup (https://www.jrsoftware.org/isinfo.php) script
|
||||
; demonstrating use of PathMgr.dll.
|
||||
;
|
||||
; This script uses PathMgr.dll in the following ways:
|
||||
; * Copies PathMgr.dll to the target machine (required for uninstall)
|
||||
; * Defines a task in [Tasks] that should modify the Path
|
||||
; * Imports the AddDirToPath() DLL function at setup time
|
||||
; * Imports the RemoveDirFromPath() DLL function at uninstall time
|
||||
; * Stores task state as custom setting using RegisterPreviousData()
|
||||
; * Retrieves task state custom setting during setup and uninstall initialize
|
||||
; * At post install, adds app dir to Path if task selected
|
||||
; * At uninstall, removes dir from Path if custom setting present
|
||||
; * Unloads and deletes DLL and removes app dir at uninstall deinitialize
|
||||
|
||||
#if Ver < EncodeVer(6,0,0,0)
|
||||
#error This script requires Inno Setup 6 or later
|
||||
#endif
|
||||
|
||||
[Setup]
|
||||
AppId={{A17D2D05-C729-4F2A-9CC7-E04906C5A842}
|
||||
AppName=EditPath
|
||||
AppVersion=4.0.4.0
|
||||
UsePreviousAppDir=false
|
||||
DefaultDirName={autopf}\EditPath
|
||||
Uninstallable=true
|
||||
OutputDir=.
|
||||
OutputBaseFilename=EditPath_Setup
|
||||
ArchitecturesInstallIn64BitMode=x64
|
||||
PrivilegesRequired=none
|
||||
PrivilegesRequiredOverridesAllowed=dialog
|
||||
|
||||
[Files]
|
||||
; Install PathMgr.dll for use with both setup and uninstall; use
|
||||
; uninsneveruninstall flag because DeinitializeSetup() will delete after
|
||||
; unloading the DLL; install the 32-bit version of PathMgr.dll because both
|
||||
; setup and uninstall executables are 32-bit
|
||||
Source: "i386\PathMgr.dll"; DestDir: "{app}"; Flags: uninsneveruninstall
|
||||
|
||||
; Other files to install on target system
|
||||
Source: "i386\EditPath.exe"; DestDir: "{app}"; Check: not Is64BitInstallMode()
|
||||
Source: "x86_64\EditPath.exe"; DestDir: "{app}"; Check: Is64BitInstallMode()
|
||||
Source: "EditPath.md"; DestDir: "{app}"
|
||||
|
||||
[Tasks]
|
||||
Name: modifypath; Description: "&Add to Path"
|
||||
|
||||
[Code]
|
||||
const
|
||||
MODIFY_PATH_TASK_NAME = 'modifypath'; // Specify name of task
|
||||
|
||||
var
|
||||
PathIsModified: Boolean; // Cache task selection from previous installs
|
||||
ApplicationUninstalled: Boolean; // Has application been uninstalled?
|
||||
|
||||
// Import AddDirToPath() at setup time ('files:' prefix)
|
||||
function DLLAddDirToPath(DirName: string; PathType, AddType: DWORD): DWORD;
|
||||
external 'AddDirToPath@files:PathMgr.dll stdcall setuponly';
|
||||
|
||||
// Import RemoveDirFromPath() at uninstall time ('{app}\' prefix)
|
||||
function DLLRemoveDirFromPath(DirName: string; PathType: DWORD): DWORD;
|
||||
external 'RemoveDirFromPath@{app}\PathMgr.dll stdcall uninstallonly';
|
||||
|
||||
// Wrapper for AddDirToPath() DLL function
|
||||
function AddDirToPath(const DirName: string): DWORD;
|
||||
var
|
||||
PathType, AddType: DWORD;
|
||||
begin
|
||||
// PathType = 0 - use system Path
|
||||
// PathType = 1 - use user Path
|
||||
// AddType = 0 - add to end of Path
|
||||
// AddType = 1 - add to beginning of Path
|
||||
if IsAdminInstallMode() then
|
||||
PathType := 0
|
||||
else
|
||||
PathType := 1;
|
||||
AddType := 0;
|
||||
result := DLLAddDirToPath(DirName, PathType, AddType);
|
||||
end;
|
||||
|
||||
// Wrapper for RemoveDirFromPath() DLL function
|
||||
function RemoveDirFromPath(const DirName: string): DWORD;
|
||||
var
|
||||
PathType: DWORD;
|
||||
begin
|
||||
// PathType = 0 - use system Path
|
||||
// PathType = 1 - use user Path
|
||||
if IsAdminInstallMode() then
|
||||
PathType := 0
|
||||
else
|
||||
PathType := 1;
|
||||
result := DLLRemoveDirFromPath(DirName, PathType);
|
||||
end;
|
||||
|
||||
procedure RegisterPreviousData(PreviousDataKey: Integer);
|
||||
begin
|
||||
// Store previous or current task selection as custom user setting
|
||||
if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then
|
||||
SetPreviousData(PreviousDataKey, MODIFY_PATH_TASK_NAME, 'true');
|
||||
end;
|
||||
|
||||
function InitializeSetup(): Boolean;
|
||||
begin
|
||||
result := true;
|
||||
// Was task selected during a previous install?
|
||||
PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true';
|
||||
end;
|
||||
|
||||
function InitializeUninstall(): Boolean;
|
||||
begin
|
||||
result := true;
|
||||
// Was task selected during a previous install?
|
||||
PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true';
|
||||
ApplicationUninstalled := false;
|
||||
end;
|
||||
|
||||
procedure CurStepChanged(CurStep: TSetupStep);
|
||||
begin
|
||||
if CurStep = ssPostInstall then
|
||||
begin
|
||||
// Add app directory to Path at post-install step if task selected
|
||||
if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then
|
||||
AddDirToPath(ExpandConstant('{app}'));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
|
||||
begin
|
||||
if CurUninstallStep = usUninstall then
|
||||
begin
|
||||
// Remove app directory from path during uninstall if task was selected;
|
||||
// use variable because we can't use WizardIsTaskSelected() at uninstall
|
||||
if PathIsModified then
|
||||
RemoveDirFromPath(ExpandConstant('{app}'));
|
||||
end
|
||||
else if CurUninstallStep = usPostUninstall then
|
||||
begin
|
||||
ApplicationUninstalled := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DeinitializeUninstall();
|
||||
begin
|
||||
if ApplicationUninstalled then
|
||||
begin
|
||||
// Unload and delete PathMgr.dll and remove app dir when uninstalling
|
||||
UnloadDLL(ExpandConstant('{app}\PathMgr.dll'));
|
||||
DeleteFile(ExpandConstant('{app}\PathMgr.dll'));
|
||||
RemoveDir(ExpandConstant('{app}'));
|
||||
end;
|
||||
end;
|
||||
118
installers/cygwin/editpath/EditPath.md
Normal file
118
installers/cygwin/editpath/EditPath.md
Normal file
@@ -0,0 +1,118 @@
|
||||
# EditPath
|
||||
|
||||
EditPath is a Windows console (text-based, command-line) program for managing the system Path and user Path.
|
||||
|
||||
# Author
|
||||
|
||||
Bill Stewart - bstewart at iname dot com
|
||||
|
||||
# License
|
||||
|
||||
EditPath.exe is covered by the GNU Lesser Public License (LPGL). See the file `LICENSE` for details.
|
||||
|
||||
# Download
|
||||
|
||||
https://github.com/Bill-Stewart/PathMgr/releases/
|
||||
|
||||
# Background
|
||||
|
||||
The system Path is found in the following location in the Windows registry:
|
||||
|
||||
Root: `HKEY_LOCAL_MACHINE`
|
||||
Subkey: `SYSTEM\CurrentControlSet\Control\Session Manager\Environment`
|
||||
Value name: `Path`
|
||||
|
||||
The current user Path is found in the following location in the registry:
|
||||
|
||||
Root: `HKEY_CURRENT_USER`
|
||||
Subkey: `Environment`
|
||||
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.)
|
||||
|
||||
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`).
|
||||
|
||||
# Usage
|
||||
|
||||
The following describes the command-line usage for the program. Parameters are case-sensitive.
|
||||
|
||||
**EditPath** [_options_] _type_ _action_
|
||||
|
||||
You must specify only one of the following _type_ parameters:
|
||||
|
||||
| _type_ | Abbreviation | Description
|
||||
| ------- | ------------ | -----------
|
||||
| **--system** | **-s** | Specifies the system Path
|
||||
| **--user** | **-u** | Specifies the user Path
|
||||
|
||||
You must specify only one of the following _action_ parameters:
|
||||
|
||||
| _action_ | Abbreviation | Description
|
||||
| -------- | ------------ | -----------
|
||||
| **--list** | **-l** | Lists directories in Path
|
||||
| **--test "**_dirname_**"** | **-t "**_dirname_**"** | Tests if directory exists in Path
|
||||
| **--add "**_dirname_**"** | **-a "**_dirname_**"** | Adds directory to Path
|
||||
| **--remove "**_dirname_**"** | **-r "**_dirname_**"** | Removes directory from Path
|
||||
|
||||
The following parameters are optional:
|
||||
|
||||
| _options_ | Abbreviation | Description
|
||||
| --------- | ------------ | -----------
|
||||
| **--quiet** | **-q** | Suppresses result messages
|
||||
| **--expand** | **-x** | Expands environment variables (**--list** only)
|
||||
| **--beginning** | **-b** | Adds to beginning of Path (**--add** only)
|
||||
|
||||
# Exit Codes
|
||||
|
||||
The following table lists typical exit codes when not using **--test** (**-t**).
|
||||
|
||||
| Exit Code | Description
|
||||
| --------- | -----------
|
||||
| 0 | No errors
|
||||
| 2 | The Path value is not present in the registry
|
||||
| 3 | The specified directory does not exist in the Path
|
||||
| 5 | Access is denied
|
||||
| 87 | Incorrect parameter(s)
|
||||
| 183 | The specified directory already exists in the Path
|
||||
|
||||
The following table lists typical exit codes when using **--test** (**-t**).
|
||||
|
||||
| Exit Code | Description
|
||||
| --------- | -----------
|
||||
| 1 | The specified directory exists in the unexpanded Path
|
||||
| 2 | The specified directory exists in the expanded Path
|
||||
| 3 | The specified directory does not exist in the Path
|
||||
|
||||
# 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.
|
||||
|
||||
* 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 **--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 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
|
||||
|
||||
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`.
|
||||
|
||||
2. `EditPath --user --add "%LOCALAPPDATA%\Programs\MyApp"`
|
||||
|
||||
Adds the specified directory name to the user Path.
|
||||
|
||||
3. `EditPath -s -r "C:\Program Files\MyApp\bin"`
|
||||
|
||||
Removes the specified directory from the system Path.
|
||||
|
||||
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.
|
||||
3
installers/cygwin/editpath/README.TXT
Normal file
3
installers/cygwin/editpath/README.TXT
Normal file
@@ -0,0 +1,3 @@
|
||||
Editpath installed here is extracted from Release 1.04 from https://github.com/Bill-Stewart/PathMgr.
|
||||
|
||||
|
||||
BIN
installers/cygwin/editpath/i386/EditPath.exe
Normal file
BIN
installers/cygwin/editpath/i386/EditPath.exe
Normal file
Binary file not shown.
BIN
installers/cygwin/editpath/x86_64/EditPath.exe
Normal file
BIN
installers/cygwin/editpath/x86_64/EditPath.exe
Normal file
Binary file not shown.
128
installers/cygwin/makeflix.iss
Normal file
128
installers/cygwin/makeflix.iss
Normal file
@@ -0,0 +1,128 @@
|
||||
; -- makeflix.iss --
|
||||
; fgh 2016-08-19
|
||||
|
||||
#define x86_or_x64 "x86"
|
||||
#define version "1.0.1"
|
||||
|
||||
#if x86_or_x64 == "x86"
|
||||
#define exe_dir "Win32"
|
||||
#else
|
||||
#define exe_dir "x64"
|
||||
#endif
|
||||
|
||||
[Setup]
|
||||
ArchitecturesAllowed={#x86_or_x64}
|
||||
AppName=Makeflix
|
||||
AppVersion={#version}
|
||||
AppPublisher=Lellan, Inc.
|
||||
AppPublisherURL=http://www.lellan.com/
|
||||
AppCopyright=Copyright (C) 2012-2017 Lellan, Inc.
|
||||
DefaultDirName={pf}\Lellan\Makeflix
|
||||
DefaultGroupName=Lellan
|
||||
UninstallDisplayIcon={app}\makeflix.exe
|
||||
Compression=lzma2
|
||||
SolidCompression=yes
|
||||
; "ArchitecturesInstallIn64BitMode=x64" requests that the install be
|
||||
; done in "64-bit mode" on x64, meaning it should use the native
|
||||
; 64-bit Program Files directory and the 64-bit view of the registry.
|
||||
ArchitecturesInstallIn64BitMode=x64
|
||||
; Source Dir is lellan/toolchain/makeflix/windows
|
||||
SourceDir="..\"
|
||||
OutputDir="deploy"
|
||||
OutputBaseFilename="makeflix_v{#version}_{#x86_or_x64}"
|
||||
SetupIconFile="..\images\Lellan_Logo_20130221.ico"
|
||||
LicenseFile="..\deploy\EULA.rtf"
|
||||
DisableWelcomePage=no
|
||||
|
||||
[Files]
|
||||
Source: "makeflix\{#exe_dir}\Release\makeflix.exe"; DestDir: "{app}"; DestName: "makeflix.exe"; Flags: ignoreversion
|
||||
Source: "deploy\DLLs\{#x86_or_x64}\Qt5Core.dll"; DestDir: "{app}"; Flags: ignoreversion
|
||||
Source: "deploy\DLLs\{#x86_or_x64}\Qt5Gui.dll"; DestDir: "{app}"; Flags: ignoreversion
|
||||
Source: "deploy\DLLs\{#x86_or_x64}\Qt5Widgets.dll"; DestDir: "{app}"; Flags: ignoreversion
|
||||
Source: "deploy\DLLs\{#x86_or_x64}\Qt5Network.dll"; DestDir: "{app}"; Flags: ignoreversion
|
||||
Source: "deploy\DLLs\{#x86_or_x64}\platforms\qwindows.dll"; DestDir: "{app}\platforms"; Flags: ignoreversion
|
||||
Source: "deploy\gstreamer\{#x86_or_x64}\*"; DestDir: "{app}\gstreamer"; Flags: recursesubdirs ignoreversion
|
||||
Source: "deploy\vc_redist\vc_redist.{#x86_or_x64}.exe"; DestDir: "{tmp}"; Flags: deleteafterinstall
|
||||
Source: "deploy\bonjour\Bonjour.{#x86_or_x64}.msi"; DestDir: "{tmp}" ; Flags: deleteafterinstall
|
||||
|
||||
Source: "..\deploy\Makeflix_Open_Source_Libraries.pdf"; DestDir: "{app}"
|
||||
|
||||
[Icons]
|
||||
Name: "{group}\Makeflix"; Filename: "{app}\makeflix.exe"
|
||||
Name: "{group}\Uninstall Makeflix"; Filename: "{uninstallexe}"
|
||||
|
||||
|
||||
[Run]
|
||||
#define VCmsg "Installing Microsoft Visual C++ Redistributable ..."
|
||||
Filename: "{tmp}\vc_redist{#x86_or_x64}.exe"; StatusMsg: "{#VCmsg}"; Check: not VCinstalled
|
||||
#define BonjourMsg "Installing Apple Bonjour support ..."
|
||||
Filename: "msiexec"; Parameters: "/i {tmp}\Bonjour.{#x86_or_x64}.msi"; StatusMsg: "{#BonjourMsg}"; Check: not BonjourInstalled
|
||||
|
||||
[Registry]
|
||||
Root: HKLM; Subkey: "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\makeflix.exe"; ValueType: string; ValueName: "(Default)"; ValueData: "{app}\makeflix.exe"; Flags: uninsdeletekey
|
||||
Root: HKLM; Subkey: "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\makeflix.exe"; ValueType: string; ValueName: "Path"; ValueData: "{app}\gstreamer\bin"; Flags: uninsdeletekey
|
||||
|
||||
[Code]
|
||||
function VCinstalled: Boolean;
|
||||
// By Michael Weiner <mailto:spam@cogit.net>
|
||||
// Function for Inno Setup Compiler
|
||||
// 13 November 2015
|
||||
// Modified by Frank G Halasz to handle WOW case
|
||||
// 23 August 2016
|
||||
// Returns True if Microsoft Visual C++ Redistributable is installed, otherwise False.
|
||||
// The programmer may set the year of redistributable to find; see below.
|
||||
var
|
||||
names: TArrayOfString;
|
||||
i: Integer;
|
||||
dName, key, year, platfm: String;
|
||||
begin
|
||||
// Year of redistributable to find; leave null to find installation for any year.
|
||||
year := '2015';
|
||||
Result := False;
|
||||
if Is64BitInstallMode then
|
||||
begin
|
||||
platfm := 'x64';
|
||||
key := 'Software\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall';
|
||||
end
|
||||
else if not IsWin64 then
|
||||
begin
|
||||
platfm := 'x86';
|
||||
key := 'Software\Microsoft\Windows\CurrentVersion\Uninstall';
|
||||
end
|
||||
else
|
||||
begin
|
||||
platfm := 'x86';
|
||||
key := 'Software\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall';
|
||||
end;
|
||||
// Get an array of all of the uninstall subkey names.
|
||||
if RegGetSubkeyNames(HKEY_LOCAL_MACHINE, key, names) then
|
||||
// Uninstall subkey names were found.
|
||||
begin
|
||||
i := 0
|
||||
while ((i < GetArrayLength(names)) and (Result = False)) do
|
||||
// The loop will end as soon as one instance of a Visual C++ redistributable is found.
|
||||
begin
|
||||
// For each uninstall subkey, look for a DisplayName value.
|
||||
// If not found, then the subkey name will be used instead.
|
||||
if not RegQueryStringValue(HKEY_LOCAL_MACHINE, key + '\' + names[i], 'DisplayName', dName) then
|
||||
dName := names[i];
|
||||
// See if the value contains both of the strings below.
|
||||
Result := (Pos(Trim('Visual C++ ' + year),dName) * Pos('Redistributable',dName) * Pos(platfm, dName) <> 0)
|
||||
i := i + 1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function BonjourInstalled: Boolean;
|
||||
// Returns True if Apple Bonjour is installed, otherwise False.
|
||||
// Ignores date/version of Bonjour.
|
||||
begin
|
||||
Result := False;
|
||||
// If this key exists, then
|
||||
// bonjour services must already be installed
|
||||
if RegKeyExists(HKEY_LOCAL_MACHINE, 'SYSTEM\CurrentControlSet\Services\Bonjour Service') then
|
||||
// Uninstall subkey names were found.
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
end;
|
||||
85
installers/cygwin/medley.iss
Normal file
85
installers/cygwin/medley.iss
Normal file
@@ -0,0 +1,85 @@
|
||||
;###############################################################################
|
||||
;#
|
||||
;# medley.iss - Inno Setup compiler script for creating a Windows
|
||||
;# installer for cygwin and Medley on cygwin
|
||||
;#
|
||||
;# 2023-06-03 Frank Halasz
|
||||
;#
|
||||
;# Copyright 2023 Interlisp.org
|
||||
;#
|
||||
;###############################################################################
|
||||
|
||||
#define x86_or_x64 "x64"
|
||||
#if GetEnv('COMBINED_RELEASE_TAG') != ""
|
||||
#define VERSION=GetEnv('COMBINED_RELEASE_TAG')
|
||||
#else
|
||||
#define VERSION="local"
|
||||
#endif
|
||||
|
||||
#if GetEnv('CYGWIN_INSTALLER_BASE') != ""
|
||||
#define OUTFILE=GetEnv('CYGWIN_INSTALLER_BASE')
|
||||
#else
|
||||
#define OUTFILE="medley-full-cygwin-x86_64-local"
|
||||
#endif
|
||||
|
||||
[Setup]
|
||||
PrivilegesRequired=lowest
|
||||
ArchitecturesAllowed={#x86_or_x64}
|
||||
AppName=Medley
|
||||
AppVersion={#version}
|
||||
AppPublisher=Interlisp.org
|
||||
AppPublisherURL=https://interlisp.org/
|
||||
AppCopyright=Copyright (C) 2023 Interlisp.org
|
||||
DefaultDirName={%USERPROFILE}\il
|
||||
DefaultGroupName=Medley
|
||||
Compression=lzma2
|
||||
SolidCompression=yes
|
||||
; "ArchitecturesInstallIn64BitMode=x64" requests that the install be
|
||||
; done in "64-bit mode" on x64, meaning it should use the native
|
||||
; 64-bit Program Files directory and the 64-bit view of the registry.
|
||||
ArchitecturesInstallIn64BitMode=x64
|
||||
OutputDir="."
|
||||
OutputBaseFilename={#OUTFILE}
|
||||
SetupIconFile="Medley.ico"
|
||||
DisableWelcomePage=no
|
||||
MissingRunOnceIdsWarning=no
|
||||
DisableProgramGroupPage=yes
|
||||
WizardImageFile=medley_logo.bmp
|
||||
WizardSmallImageFile=medley_logo_small.bmp
|
||||
WizardImageStretch=no
|
||||
UninstallDisplayIcon="{app}\Medley.ico"
|
||||
UninstallFilesDir={app}\uninstall
|
||||
UsePreviousAppDir=no
|
||||
|
||||
[Dirs]
|
||||
Name: "{app}\install"; Permissions: everyone-full
|
||||
Name: "{app}\uninstall"; Permissions: everyone-full
|
||||
Name: "{app}\cygwin"; Permissions: everyone-full
|
||||
|
||||
[Files]
|
||||
Source: "setup-x86_64.exe"; DestDir: "{app}\cygwin"; DestName: "setup-x86_64.exe"; Flags: ignoreversion
|
||||
Source: "maiko-cygwin.x86_64.tgz"; DestDir: "{app}\install"; DestName: "maiko-cygwin.x86_64.tgz"; Flags: ignoreversion
|
||||
Source: "medley.tgz"; DestDir: "{app}\install"; DestName: "medley.tgz"; Flags: ignoreversion
|
||||
Source: "..\win\editpath\x86_64\EditPath.exe"; DestDir: "{app}\uninstall"; DestName: "EditPath.exe"; Flags: ignoreversion
|
||||
Source: "Medley.ico"; DestDir: "{app}"; DestName: "Medley.ico"; Flags: ignoreversion
|
||||
|
||||
[Icons]
|
||||
Name: "{group}\Medley\Uninstall_Medley"; Filename: "{uninstallexe}"
|
||||
; Name: "{group}\Medley\Medley"; Filename: "powershell"; Parameters: "-NoExit -File {app}\medley.ps1 --help"; IconFilename: "{app}\Medley.ico"
|
||||
|
||||
[Run]
|
||||
Filename: "{app}\cygwin\setup-x86_64.exe"; Parameters: "--quiet-mode --no-admin --wait --no-shortcuts --no-write-registry --verbose --root {app} --site http://www.gtlib.gatech.edu/pub/cygwin/ --only-site --local-package-dir {app}\cygwin --packages nano,xdg-utils"; StatusMsg: "Installing Cygwin ..."
|
||||
Filename: "{app}\bin\bash"; Parameters: "-login -c 'sed -i -e s/^none/#none/ /etc/fstab && echo none / cygdrive binary,posix=0,user 0 0 >>/etc/fstab'"; Flags: runhidden
|
||||
Filename: "tar"; Parameters: "-x -z -C {app} -f {app}\install\medley.tgz"; Flags: runhidden; StatusMsg: "Installing Medley ..."
|
||||
Filename: "powershell"; Parameters: "remove-item -force -recurse {app}\maiko"; Flags: runhidden; StatusMsg: "Installing Maiko ..."
|
||||
Filename: "tar"; Parameters: "-x -z -C {app} -f {app}\install\maiko-cygwin.x86_64.tgz"; Flags: runhidden; StatusMsg: "Installing Maiko ..."
|
||||
; Recreate medley symbolic links (lost in tars)
|
||||
Filename: "{app}\bin\bash"; Parameters: "-login -c 'cd /medley/scripts/medley && ln -s medley.command medley.sh && cd ../.. && ln -s /medley/scripts/medley/medley.sh medley'"; Flags: runhidden
|
||||
; Create medley.bat
|
||||
Filename: "powershell"; Parameters: "write-output \""{app}\bin\bash -login -c '/medley/scripts/medley/medley.sh %*'\"" | out-file medley.bat -Encoding ascii"; WorkingDir: "{app}"; Flags: runhidden; StatusMsg: "Creating medley.bat ..."
|
||||
Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --add {app}"; Flags: runhidden; StatusMsg: "Adding to PATH ..."
|
||||
Filename: "powershell"; Parameters: "remove-item -recurse -force {app}\install"; Flags: runhidden; StatusMsg: "Cleaning up ..."
|
||||
|
||||
[UninstallRun]
|
||||
Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --remove {app}"; Flags: runhidden
|
||||
|
||||
BIN
installers/cygwin/medley_logo.bmp
Normal file
BIN
installers/cygwin/medley_logo.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 53 KiB |
BIN
installers/cygwin/medley_logo.png
Normal file
BIN
installers/cygwin/medley_logo.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 10 KiB |
BIN
installers/cygwin/medley_logo_small.bmp
Normal file
BIN
installers/cygwin/medley_logo_small.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 13 KiB |
@@ -38,6 +38,9 @@
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-wsl-aarch64-@@@COMBINED.RELEASE.TAG@@@.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p></li>
|
||||
</ul></li>
|
||||
</ul></li>
|
||||
<li><h2>WINDOWS 10/11 (Single install based on cygwin - Docker install deprecated)</h2>
|
||||
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/@@@CYGWIN.INSTALLER@@@">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for Windows x64 machines</a></p></li>
|
||||
<li><h2>macOS 11 (Big Sur) and later - for both Intel and Apple Silicon</h2>
|
||||
|
||||
<ul>
|
||||
@@ -48,8 +51,5 @@
|
||||
|
||||
<p><a href="@@@DOWNLOAD_URL@@@/medley-full-macos-universal-@@@COMBINED.RELEASE.TAG@@@.zip">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@</a></p></li>
|
||||
</ul></li>
|
||||
<li><h2>WINDOWS 10/11 (Medley running within Cygwin)</h2>
|
||||
|
||||
<p>Not available</p></li>
|
||||
</ul></li>
|
||||
</ul>
|
||||
|
||||
@@ -34,6 +34,10 @@
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/medley-full-wsl-aarch64-@@@COMBINED.RELEASE.TAG@@@.tgz)
|
||||
|
||||
* ## WINDOWS 10/11 (Single install based on cygwin - Docker install deprecated)
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for Windows x64 machines](@@@DOWNLOAD_URL@@@/@@@CYGWIN.INSTALLER@@@)
|
||||
|
||||
* ## macOS 11 (Big Sur) and later - for both Intel and Apple Silicon
|
||||
|
||||
* ### DMG Installer
|
||||
@@ -43,12 +47,3 @@
|
||||
* ### ZIP Installer
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@](@@@DOWNLOAD_URL@@@/medley-full-macos-universal-@@@COMBINED.RELEASE.TAG@@@.zip)
|
||||
|
||||
* ## WINDOWS 10/11 (Medley running within Cygwin)
|
||||
|
||||
Not available
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -1,165 +1,165 @@
|
||||
; 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
|
||||
; 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
|
||||
; later version.
|
||||
;
|
||||
; 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
|
||||
; FOR A PARTICULAR PURPOSE. See the GNU General Lesser Public License for more
|
||||
; details.
|
||||
;
|
||||
; 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/.
|
||||
|
||||
; Sample Inno Setup (https://www.jrsoftware.org/isinfo.php) script
|
||||
; demonstrating use of PathMgr.dll.
|
||||
;
|
||||
; This script uses PathMgr.dll in the following ways:
|
||||
; * Copies PathMgr.dll to the target machine (required for uninstall)
|
||||
; * Defines a task in [Tasks] that should modify the Path
|
||||
; * Imports the AddDirToPath() DLL function at setup time
|
||||
; * Imports the RemoveDirFromPath() DLL function at uninstall time
|
||||
; * Stores task state as custom setting using RegisterPreviousData()
|
||||
; * Retrieves task state custom setting during setup and uninstall initialize
|
||||
; * At post install, adds app dir to Path if task selected
|
||||
; * At uninstall, removes dir from Path if custom setting present
|
||||
; * Unloads and deletes DLL and removes app dir at uninstall deinitialize
|
||||
|
||||
#if Ver < EncodeVer(6,0,0,0)
|
||||
#error This script requires Inno Setup 6 or later
|
||||
#endif
|
||||
|
||||
[Setup]
|
||||
AppId={{A17D2D05-C729-4F2A-9CC7-E04906C5A842}
|
||||
AppName=EditPath
|
||||
AppVersion=4.0.4.0
|
||||
UsePreviousAppDir=false
|
||||
DefaultDirName={autopf}\EditPath
|
||||
Uninstallable=true
|
||||
OutputDir=.
|
||||
OutputBaseFilename=EditPath_Setup
|
||||
ArchitecturesInstallIn64BitMode=x64
|
||||
PrivilegesRequired=none
|
||||
PrivilegesRequiredOverridesAllowed=dialog
|
||||
|
||||
[Files]
|
||||
; Install PathMgr.dll for use with both setup and uninstall; use
|
||||
; uninsneveruninstall flag because DeinitializeSetup() will delete after
|
||||
; unloading the DLL; install the 32-bit version of PathMgr.dll because both
|
||||
; setup and uninstall executables are 32-bit
|
||||
Source: "i386\PathMgr.dll"; DestDir: "{app}"; Flags: uninsneveruninstall
|
||||
|
||||
; Other files to install on target system
|
||||
Source: "i386\EditPath.exe"; DestDir: "{app}"; Check: not Is64BitInstallMode()
|
||||
Source: "x86_64\EditPath.exe"; DestDir: "{app}"; Check: Is64BitInstallMode()
|
||||
Source: "EditPath.md"; DestDir: "{app}"
|
||||
|
||||
[Tasks]
|
||||
Name: modifypath; Description: "&Add to Path"
|
||||
|
||||
[Code]
|
||||
const
|
||||
MODIFY_PATH_TASK_NAME = 'modifypath'; // Specify name of task
|
||||
|
||||
var
|
||||
PathIsModified: Boolean; // Cache task selection from previous installs
|
||||
ApplicationUninstalled: Boolean; // Has application been uninstalled?
|
||||
|
||||
// Import AddDirToPath() at setup time ('files:' prefix)
|
||||
function DLLAddDirToPath(DirName: string; PathType, AddType: DWORD): DWORD;
|
||||
external 'AddDirToPath@files:PathMgr.dll stdcall setuponly';
|
||||
|
||||
// Import RemoveDirFromPath() at uninstall time ('{app}\' prefix)
|
||||
function DLLRemoveDirFromPath(DirName: string; PathType: DWORD): DWORD;
|
||||
external 'RemoveDirFromPath@{app}\PathMgr.dll stdcall uninstallonly';
|
||||
|
||||
// Wrapper for AddDirToPath() DLL function
|
||||
function AddDirToPath(const DirName: string): DWORD;
|
||||
var
|
||||
PathType, AddType: DWORD;
|
||||
begin
|
||||
// PathType = 0 - use system Path
|
||||
// PathType = 1 - use user Path
|
||||
// AddType = 0 - add to end of Path
|
||||
// AddType = 1 - add to beginning of Path
|
||||
if IsAdminInstallMode() then
|
||||
PathType := 0
|
||||
else
|
||||
PathType := 1;
|
||||
AddType := 0;
|
||||
result := DLLAddDirToPath(DirName, PathType, AddType);
|
||||
end;
|
||||
|
||||
// Wrapper for RemoveDirFromPath() DLL function
|
||||
function RemoveDirFromPath(const DirName: string): DWORD;
|
||||
var
|
||||
PathType: DWORD;
|
||||
begin
|
||||
// PathType = 0 - use system Path
|
||||
// PathType = 1 - use user Path
|
||||
if IsAdminInstallMode() then
|
||||
PathType := 0
|
||||
else
|
||||
PathType := 1;
|
||||
result := DLLRemoveDirFromPath(DirName, PathType);
|
||||
end;
|
||||
|
||||
procedure RegisterPreviousData(PreviousDataKey: Integer);
|
||||
begin
|
||||
// Store previous or current task selection as custom user setting
|
||||
if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then
|
||||
SetPreviousData(PreviousDataKey, MODIFY_PATH_TASK_NAME, 'true');
|
||||
end;
|
||||
|
||||
function InitializeSetup(): Boolean;
|
||||
begin
|
||||
result := true;
|
||||
// Was task selected during a previous install?
|
||||
PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true';
|
||||
end;
|
||||
|
||||
function InitializeUninstall(): Boolean;
|
||||
begin
|
||||
result := true;
|
||||
// Was task selected during a previous install?
|
||||
PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true';
|
||||
ApplicationUninstalled := false;
|
||||
end;
|
||||
|
||||
procedure CurStepChanged(CurStep: TSetupStep);
|
||||
begin
|
||||
if CurStep = ssPostInstall then
|
||||
begin
|
||||
// Add app directory to Path at post-install step if task selected
|
||||
if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then
|
||||
AddDirToPath(ExpandConstant('{app}'));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
|
||||
begin
|
||||
if CurUninstallStep = usUninstall then
|
||||
begin
|
||||
// Remove app directory from path during uninstall if task was selected;
|
||||
// use variable because we can't use WizardIsTaskSelected() at uninstall
|
||||
if PathIsModified then
|
||||
RemoveDirFromPath(ExpandConstant('{app}'));
|
||||
end
|
||||
else if CurUninstallStep = usPostUninstall then
|
||||
begin
|
||||
ApplicationUninstalled := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DeinitializeUninstall();
|
||||
begin
|
||||
if ApplicationUninstalled then
|
||||
begin
|
||||
// Unload and delete PathMgr.dll and remove app dir when uninstalling
|
||||
UnloadDLL(ExpandConstant('{app}\PathMgr.dll'));
|
||||
DeleteFile(ExpandConstant('{app}\PathMgr.dll'));
|
||||
RemoveDir(ExpandConstant('{app}'));
|
||||
end;
|
||||
end;
|
||||
; 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
|
||||
; 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
|
||||
; later version.
|
||||
;
|
||||
; 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
|
||||
; FOR A PARTICULAR PURPOSE. See the GNU General Lesser Public License for more
|
||||
; details.
|
||||
;
|
||||
; 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/.
|
||||
|
||||
; Sample Inno Setup (https://www.jrsoftware.org/isinfo.php) script
|
||||
; demonstrating use of PathMgr.dll.
|
||||
;
|
||||
; This script uses PathMgr.dll in the following ways:
|
||||
; * Copies PathMgr.dll to the target machine (required for uninstall)
|
||||
; * Defines a task in [Tasks] that should modify the Path
|
||||
; * Imports the AddDirToPath() DLL function at setup time
|
||||
; * Imports the RemoveDirFromPath() DLL function at uninstall time
|
||||
; * Stores task state as custom setting using RegisterPreviousData()
|
||||
; * Retrieves task state custom setting during setup and uninstall initialize
|
||||
; * At post install, adds app dir to Path if task selected
|
||||
; * At uninstall, removes dir from Path if custom setting present
|
||||
; * Unloads and deletes DLL and removes app dir at uninstall deinitialize
|
||||
|
||||
#if Ver < EncodeVer(6,0,0,0)
|
||||
#error This script requires Inno Setup 6 or later
|
||||
#endif
|
||||
|
||||
[Setup]
|
||||
AppId={{A17D2D05-C729-4F2A-9CC7-E04906C5A842}
|
||||
AppName=EditPath
|
||||
AppVersion=4.0.4.0
|
||||
UsePreviousAppDir=false
|
||||
DefaultDirName={autopf}\EditPath
|
||||
Uninstallable=true
|
||||
OutputDir=.
|
||||
OutputBaseFilename=EditPath_Setup
|
||||
ArchitecturesInstallIn64BitMode=x64
|
||||
PrivilegesRequired=none
|
||||
PrivilegesRequiredOverridesAllowed=dialog
|
||||
|
||||
[Files]
|
||||
; Install PathMgr.dll for use with both setup and uninstall; use
|
||||
; uninsneveruninstall flag because DeinitializeSetup() will delete after
|
||||
; unloading the DLL; install the 32-bit version of PathMgr.dll because both
|
||||
; setup and uninstall executables are 32-bit
|
||||
Source: "i386\PathMgr.dll"; DestDir: "{app}"; Flags: uninsneveruninstall
|
||||
|
||||
; Other files to install on target system
|
||||
Source: "i386\EditPath.exe"; DestDir: "{app}"; Check: not Is64BitInstallMode()
|
||||
Source: "x86_64\EditPath.exe"; DestDir: "{app}"; Check: Is64BitInstallMode()
|
||||
Source: "EditPath.md"; DestDir: "{app}"
|
||||
|
||||
[Tasks]
|
||||
Name: modifypath; Description: "&Add to Path"
|
||||
|
||||
[Code]
|
||||
const
|
||||
MODIFY_PATH_TASK_NAME = 'modifypath'; // Specify name of task
|
||||
|
||||
var
|
||||
PathIsModified: Boolean; // Cache task selection from previous installs
|
||||
ApplicationUninstalled: Boolean; // Has application been uninstalled?
|
||||
|
||||
// Import AddDirToPath() at setup time ('files:' prefix)
|
||||
function DLLAddDirToPath(DirName: string; PathType, AddType: DWORD): DWORD;
|
||||
external 'AddDirToPath@files:PathMgr.dll stdcall setuponly';
|
||||
|
||||
// Import RemoveDirFromPath() at uninstall time ('{app}\' prefix)
|
||||
function DLLRemoveDirFromPath(DirName: string; PathType: DWORD): DWORD;
|
||||
external 'RemoveDirFromPath@{app}\PathMgr.dll stdcall uninstallonly';
|
||||
|
||||
// Wrapper for AddDirToPath() DLL function
|
||||
function AddDirToPath(const DirName: string): DWORD;
|
||||
var
|
||||
PathType, AddType: DWORD;
|
||||
begin
|
||||
// PathType = 0 - use system Path
|
||||
// PathType = 1 - use user Path
|
||||
// AddType = 0 - add to end of Path
|
||||
// AddType = 1 - add to beginning of Path
|
||||
if IsAdminInstallMode() then
|
||||
PathType := 0
|
||||
else
|
||||
PathType := 1;
|
||||
AddType := 0;
|
||||
result := DLLAddDirToPath(DirName, PathType, AddType);
|
||||
end;
|
||||
|
||||
// Wrapper for RemoveDirFromPath() DLL function
|
||||
function RemoveDirFromPath(const DirName: string): DWORD;
|
||||
var
|
||||
PathType: DWORD;
|
||||
begin
|
||||
// PathType = 0 - use system Path
|
||||
// PathType = 1 - use user Path
|
||||
if IsAdminInstallMode() then
|
||||
PathType := 0
|
||||
else
|
||||
PathType := 1;
|
||||
result := DLLRemoveDirFromPath(DirName, PathType);
|
||||
end;
|
||||
|
||||
procedure RegisterPreviousData(PreviousDataKey: Integer);
|
||||
begin
|
||||
// Store previous or current task selection as custom user setting
|
||||
if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then
|
||||
SetPreviousData(PreviousDataKey, MODIFY_PATH_TASK_NAME, 'true');
|
||||
end;
|
||||
|
||||
function InitializeSetup(): Boolean;
|
||||
begin
|
||||
result := true;
|
||||
// Was task selected during a previous install?
|
||||
PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true';
|
||||
end;
|
||||
|
||||
function InitializeUninstall(): Boolean;
|
||||
begin
|
||||
result := true;
|
||||
// Was task selected during a previous install?
|
||||
PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true';
|
||||
ApplicationUninstalled := false;
|
||||
end;
|
||||
|
||||
procedure CurStepChanged(CurStep: TSetupStep);
|
||||
begin
|
||||
if CurStep = ssPostInstall then
|
||||
begin
|
||||
// Add app directory to Path at post-install step if task selected
|
||||
if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then
|
||||
AddDirToPath(ExpandConstant('{app}'));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
|
||||
begin
|
||||
if CurUninstallStep = usUninstall then
|
||||
begin
|
||||
// Remove app directory from path during uninstall if task was selected;
|
||||
// use variable because we can't use WizardIsTaskSelected() at uninstall
|
||||
if PathIsModified then
|
||||
RemoveDirFromPath(ExpandConstant('{app}'));
|
||||
end
|
||||
else if CurUninstallStep = usPostUninstall then
|
||||
begin
|
||||
ApplicationUninstalled := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DeinitializeUninstall();
|
||||
begin
|
||||
if ApplicationUninstalled then
|
||||
begin
|
||||
// Unload and delete PathMgr.dll and remove app dir when uninstalling
|
||||
UnloadDLL(ExpandConstant('{app}\PathMgr.dll'));
|
||||
DeleteFile(ExpandConstant('{app}\PathMgr.dll'));
|
||||
RemoveDir(ExpandConstant('{app}'));
|
||||
end;
|
||||
end;
|
||||
|
||||
@@ -1,118 +1,118 @@
|
||||
# EditPath
|
||||
|
||||
EditPath is a Windows console (text-based, command-line) program for managing the system Path and user Path.
|
||||
|
||||
# Author
|
||||
|
||||
Bill Stewart - bstewart at iname dot com
|
||||
|
||||
# License
|
||||
|
||||
EditPath.exe is covered by the GNU Lesser Public License (LPGL). See the file `LICENSE` for details.
|
||||
|
||||
# Download
|
||||
|
||||
https://github.com/Bill-Stewart/PathMgr/releases/
|
||||
|
||||
# Background
|
||||
|
||||
The system Path is found in the following location in the Windows registry:
|
||||
|
||||
Root: `HKEY_LOCAL_MACHINE`
|
||||
Subkey: `SYSTEM\CurrentControlSet\Control\Session Manager\Environment`
|
||||
Value name: `Path`
|
||||
|
||||
The current user Path is found in the following location in the registry:
|
||||
|
||||
Root: `HKEY_CURRENT_USER`
|
||||
Subkey: `Environment`
|
||||
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.)
|
||||
|
||||
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`).
|
||||
|
||||
# Usage
|
||||
|
||||
The following describes the command-line usage for the program. Parameters are case-sensitive.
|
||||
|
||||
**EditPath** [_options_] _type_ _action_
|
||||
|
||||
You must specify only one of the following _type_ parameters:
|
||||
|
||||
| _type_ | Abbreviation | Description
|
||||
| ------- | ------------ | -----------
|
||||
| **--system** | **-s** | Specifies the system Path
|
||||
| **--user** | **-u** | Specifies the user Path
|
||||
|
||||
You must specify only one of the following _action_ parameters:
|
||||
|
||||
| _action_ | Abbreviation | Description
|
||||
| -------- | ------------ | -----------
|
||||
| **--list** | **-l** | Lists directories in Path
|
||||
| **--test "**_dirname_**"** | **-t "**_dirname_**"** | Tests if directory exists in Path
|
||||
| **--add "**_dirname_**"** | **-a "**_dirname_**"** | Adds directory to Path
|
||||
| **--remove "**_dirname_**"** | **-r "**_dirname_**"** | Removes directory from Path
|
||||
|
||||
The following parameters are optional:
|
||||
|
||||
| _options_ | Abbreviation | Description
|
||||
| --------- | ------------ | -----------
|
||||
| **--quiet** | **-q** | Suppresses result messages
|
||||
| **--expand** | **-x** | Expands environment variables (**--list** only)
|
||||
| **--beginning** | **-b** | Adds to beginning of Path (**--add** only)
|
||||
|
||||
# Exit Codes
|
||||
|
||||
The following table lists typical exit codes when not using **--test** (**-t**).
|
||||
|
||||
| Exit Code | Description
|
||||
| --------- | -----------
|
||||
| 0 | No errors
|
||||
| 2 | The Path value is not present in the registry
|
||||
| 3 | The specified directory does not exist in the Path
|
||||
| 5 | Access is denied
|
||||
| 87 | Incorrect parameter(s)
|
||||
| 183 | The specified directory already exists in the Path
|
||||
|
||||
The following table lists typical exit codes when using **--test** (**-t**).
|
||||
|
||||
| Exit Code | Description
|
||||
| --------- | -----------
|
||||
| 1 | The specified directory exists in the unexpanded Path
|
||||
| 2 | The specified directory exists in the expanded Path
|
||||
| 3 | The specified directory does not exist in the Path
|
||||
|
||||
# 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.
|
||||
|
||||
* 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 **--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 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
|
||||
|
||||
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`.
|
||||
|
||||
2. `EditPath --user --add "%LOCALAPPDATA%\Programs\MyApp"`
|
||||
|
||||
Adds the specified directory name to the user Path.
|
||||
|
||||
3. `EditPath -s -r "C:\Program Files\MyApp\bin"`
|
||||
|
||||
Removes the specified directory from the system Path.
|
||||
|
||||
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.
|
||||
# EditPath
|
||||
|
||||
EditPath is a Windows console (text-based, command-line) program for managing the system Path and user Path.
|
||||
|
||||
# Author
|
||||
|
||||
Bill Stewart - bstewart at iname dot com
|
||||
|
||||
# License
|
||||
|
||||
EditPath.exe is covered by the GNU Lesser Public License (LPGL). See the file `LICENSE` for details.
|
||||
|
||||
# Download
|
||||
|
||||
https://github.com/Bill-Stewart/PathMgr/releases/
|
||||
|
||||
# Background
|
||||
|
||||
The system Path is found in the following location in the Windows registry:
|
||||
|
||||
Root: `HKEY_LOCAL_MACHINE`
|
||||
Subkey: `SYSTEM\CurrentControlSet\Control\Session Manager\Environment`
|
||||
Value name: `Path`
|
||||
|
||||
The current user Path is found in the following location in the registry:
|
||||
|
||||
Root: `HKEY_CURRENT_USER`
|
||||
Subkey: `Environment`
|
||||
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.)
|
||||
|
||||
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`).
|
||||
|
||||
# Usage
|
||||
|
||||
The following describes the command-line usage for the program. Parameters are case-sensitive.
|
||||
|
||||
**EditPath** [_options_] _type_ _action_
|
||||
|
||||
You must specify only one of the following _type_ parameters:
|
||||
|
||||
| _type_ | Abbreviation | Description
|
||||
| ------- | ------------ | -----------
|
||||
| **--system** | **-s** | Specifies the system Path
|
||||
| **--user** | **-u** | Specifies the user Path
|
||||
|
||||
You must specify only one of the following _action_ parameters:
|
||||
|
||||
| _action_ | Abbreviation | Description
|
||||
| -------- | ------------ | -----------
|
||||
| **--list** | **-l** | Lists directories in Path
|
||||
| **--test "**_dirname_**"** | **-t "**_dirname_**"** | Tests if directory exists in Path
|
||||
| **--add "**_dirname_**"** | **-a "**_dirname_**"** | Adds directory to Path
|
||||
| **--remove "**_dirname_**"** | **-r "**_dirname_**"** | Removes directory from Path
|
||||
|
||||
The following parameters are optional:
|
||||
|
||||
| _options_ | Abbreviation | Description
|
||||
| --------- | ------------ | -----------
|
||||
| **--quiet** | **-q** | Suppresses result messages
|
||||
| **--expand** | **-x** | Expands environment variables (**--list** only)
|
||||
| **--beginning** | **-b** | Adds to beginning of Path (**--add** only)
|
||||
|
||||
# Exit Codes
|
||||
|
||||
The following table lists typical exit codes when not using **--test** (**-t**).
|
||||
|
||||
| Exit Code | Description
|
||||
| --------- | -----------
|
||||
| 0 | No errors
|
||||
| 2 | The Path value is not present in the registry
|
||||
| 3 | The specified directory does not exist in the Path
|
||||
| 5 | Access is denied
|
||||
| 87 | Incorrect parameter(s)
|
||||
| 183 | The specified directory already exists in the Path
|
||||
|
||||
The following table lists typical exit codes when using **--test** (**-t**).
|
||||
|
||||
| Exit Code | Description
|
||||
| --------- | -----------
|
||||
| 1 | The specified directory exists in the unexpanded Path
|
||||
| 2 | The specified directory exists in the expanded Path
|
||||
| 3 | The specified directory does not exist in the Path
|
||||
|
||||
# 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.
|
||||
|
||||
* 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 **--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 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
|
||||
|
||||
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`.
|
||||
|
||||
2. `EditPath --user --add "%LOCALAPPDATA%\Programs\MyApp"`
|
||||
|
||||
Adds the specified directory name to the user Path.
|
||||
|
||||
3. `EditPath -s -r "C:\Program Files\MyApp\bin"`
|
||||
|
||||
Removes the specified directory from the system Path.
|
||||
|
||||
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.
|
||||
|
||||
276
library/PDFSTREAM
Normal file
276
library/PDFSTREAM
Normal file
@@ -0,0 +1,276 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 1-Oct-2023 20:53:05" {WMEDLEY}<library>PDFSTREAM.;54 13917
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS SEE-PDF)
|
||||
|
||||
:PREVIOUS-DATE " 1-Oct-2023 15:29:33" {WMEDLEY}<library>PDFSTREAM.;53)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PDFSTREAMCOMS)
|
||||
|
||||
(RPAQQ PDFSTREAMCOMS
|
||||
((FILES (SYSLOAD)
|
||||
POSTSCRIPTSTREAM)
|
||||
[COMS (* ; "Hook into hardcopy interface")
|
||||
[ADDVARS [PRINTERTYPES ((PDF)
|
||||
(CANPRINT (PDF))
|
||||
(STATUS TRUE)
|
||||
(PROPERTIES NILL)
|
||||
(SEND POSTSCRIPTSEND)
|
||||
(BITMAPSCALE POSTSCRIPT.BITMAPSCALE)
|
||||
(BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION
|
||||
ROTATION TITLE]
|
||||
[PRINTFILETYPES (PDF (TEST PDFFILEP)
|
||||
(EXTENSION (PDF))
|
||||
(CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT]
|
||||
(IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM)
|
||||
(FONTCREATE POSTSCRIPT.FONTCREATE)
|
||||
(FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
|
||||
(CREATECHARSET \CREATECHARSET.PSC]
|
||||
(VARS (DEFAULTPRINTERTYPE 'PDF))
|
||||
(FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT)
|
||||
(P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT]
|
||||
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Implementation of PDF streams")
|
||||
|
||||
(INITVARS (PDFCONVERTER 'ps2pdf))
|
||||
(* ; "Mac with ghostscript?")
|
||||
(ALISTS (PDF-CONVERTER-TEMPLATES ps2pdf pstopdf))
|
||||
(GLOBALVARS PDFCONVERTER PDF-CONVERTER-TEMPLATES)
|
||||
(FNS OPEN-PDF-STREAM CLOSE-PDF-STREAM PS-TO-PDF)
|
||||
(FNS SEE-PDF)))
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
POSTSCRIPTSTREAM)
|
||||
|
||||
|
||||
|
||||
(* ; "Hook into hardcopy interface")
|
||||
|
||||
|
||||
(ADDTOVAR PRINTERTYPES ((PDF)
|
||||
(CANPRINT (PDF))
|
||||
(STATUS TRUE)
|
||||
(PROPERTIES NILL)
|
||||
(SEND POSTSCRIPTSEND)
|
||||
(BITMAPSCALE POSTSCRIPT.BITMAPSCALE)
|
||||
(BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))))
|
||||
|
||||
(ADDTOVAR PRINTFILETYPES (PDF (TEST PDFFILEP)
|
||||
(EXTENSION (PDF))
|
||||
(CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT))))
|
||||
|
||||
(ADDTOVAR IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM)
|
||||
(FONTCREATE POSTSCRIPT.FONTCREATE)
|
||||
(FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
|
||||
(CREATECHARSET \CREATECHARSET.PSC)))
|
||||
|
||||
(RPAQQ DEFAULTPRINTERTYPE PDF)
|
||||
(DEFINEQ
|
||||
|
||||
(PDFFILEP
|
||||
[LAMBDA (FILE) (* ; "Edited 23-Jun-2023 14:43 by rmk")
|
||||
(* ; "Edited 5-Mar-93 21:40 by rmk:")
|
||||
(* ; "Edited 14-Jan-93 10:56 by jds")
|
||||
(OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION)
|
||||
'("PDF")
|
||||
:TEST
|
||||
(FUNCTION STRING-EQUAL))
|
||||
(CL:WHEN (STREAMP FILE)
|
||||
(SETFILEPTR FILE 0)
|
||||
(PROG1 (AND (EQ (BIN FILE)
|
||||
(CHARCODE %%))
|
||||
(EQ (BIN FILE)
|
||||
(CHARCODE P))
|
||||
(EQ (BIN FILE)
|
||||
(CHARCODE D))
|
||||
(EQ (BIN FILE)
|
||||
(CHARCODE F)))
|
||||
(SETFILEPTR FILE 0)))])
|
||||
|
||||
(PDF.HARDCOPYW
|
||||
[LAMBDA (PDFFILE BITMAP SCALEFACTOR REGION Landscape? TITLE)
|
||||
(* ; "Edited 24-Jul-2023 10:37 by rmk")
|
||||
(* ; "Edited 23-Jun-2023 13:28 by rmk")
|
||||
(* ; "Edited 6-Mar-2023 22:43 by rmk")
|
||||
(LET ((PSTTMP (PACKFILENAME 'EXTENSION 'TMPPS 'BODY PDFFILE)))
|
||||
(PS-TO-PDF (POSTSCRIPT.HARDCOPYW PSTTMP BITMAP SCALEFACTOR REGION Landscape? TITLE)
|
||||
PDFFILE])
|
||||
|
||||
(PDF.TEXT
|
||||
[LAMBDA (FILE PDFFILE FONTS HEADING TABS) (* ; "Edited 1-Oct-2023 15:24 by rmk")
|
||||
(* ; "Edited 23-Jun-2023 13:23 by rmk")
|
||||
(* ; "Edited 7-Mar-2023 08:39 by rmk")
|
||||
(TEXTTOIMAGEFILE FILE PDFFILE 'PDF FONTS HEADING TABS `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION
|
||||
ROTATION ,(NOT (NOT
|
||||
POSTSCRIPT.TEXTFILE.LANDSCAPE
|
||||
])
|
||||
|
||||
(PDF.TEDIT
|
||||
[LAMBDA (FILE PDFFILE) (* ; "Edited 23-Jun-2023 13:22 by rmk")
|
||||
(* ; "Edited 7-Mar-2023 08:39 by rmk")
|
||||
(LET ((TSTREAM (OPENTEXTSTREAM FILE)))
|
||||
(TEDIT.FORMAT.HARDCOPY FILE PDFFILE T NIL NIL NIL 'PDF)
|
||||
(CLOSEF TSTREAM])
|
||||
)
|
||||
|
||||
(FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT)
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "Implementation of PDF streams")
|
||||
|
||||
|
||||
(RPAQ? PDFCONVERTER 'ps2pdf)
|
||||
|
||||
|
||||
|
||||
(* ; "Mac with ghostscript?")
|
||||
|
||||
|
||||
(ADDTOVAR PDF-CONVERTER-TEMPLATES (ps2pdf " " PSFILE " " PDFFILE " 2> " ERRORFILE)
|
||||
(pstopdf " " PSFILE " -o " PDFFILE " 2> " ERRORFILE))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS PDFCONVERTER PDF-CONVERTER-TEMPLATES)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(OPEN-PDF-STREAM
|
||||
[LAMBDA (FILE OPTIONS) (* ; "Edited 23-Sep-2023 15:38 by rmk")
|
||||
(* ; "Edited 22-Sep-2023 11:04 by rmk")
|
||||
(* ; "Edited 24-Jun-2023 14:49 by rmk")
|
||||
|
||||
(* ;; "Open a temporary PS file, but set it up so that at closing it gets converted to PDF using an operating-system utility (if available), and then gets renamed to the original intended filename.")
|
||||
|
||||
(* ;; "We have to stash the original filename someplace. We could put it in the tmp filename and then parse it out, but then we would have to worry about how unix filenames might parse against our {, }, etc. ")
|
||||
|
||||
(* ;;
|
||||
"Simplest thing for now is to just add an extra field at the end of the \POSTSCRIPTDATA record.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(if [AND NIL (EQ 'LPT (FILENAMEFIELD FILE 'HOST]
|
||||
then
|
||||
(* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting. But then we would alo have to lie and give it a PDF extension so it thinks that we are heading to a PDF printer.")
|
||||
|
||||
(OPENPOSTSCRIPTSTREAM FILE OPTIONS)
|
||||
else (CL:UNLESS (OR (ASSOC (OR PDFCONVERTER (MKATOM (UNIX-GETENV "MEDLEY-PDFCONVERTER")))
|
||||
PDF-CONVERTER-TEMPLATES))
|
||||
(ERROR "POSTSCRIPT-to-PDF converter is not specified"))
|
||||
(SETQ FILE (OR (AND (NEQ FILE T)
|
||||
(OUTFILEP FILE))
|
||||
(ERROR "PDF target file not found" FILE)))
|
||||
(LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE)
|
||||
"-"
|
||||
(RAND)
|
||||
".ps")
|
||||
OPTIONS)))
|
||||
(STREAMPROP PSSTREAM 'AFTERCLOSE (CONS (FUNCTION CLOSE-PDF-STREAM)))
|
||||
(STREAMPROP PSSTREAM 'PDFTARGETINFO FILE)
|
||||
PSSTREAM])
|
||||
|
||||
(CLOSE-PDF-STREAM
|
||||
[LAMBDA (PSSTREAM) (* ; "Edited 22-Sep-2023 11:18 by rmk")
|
||||
(* ; "Edited 24-Jul-2023 10:37 by rmk")
|
||||
(* ; "Edited 17-Jul-2023 22:32 by rmk")
|
||||
(* ; "Edited 24-Jun-2023 13:57 by rmk")
|
||||
|
||||
(* ;; "PSSTREAM is a postscript (maybe in tmp) rendition of what is intended to end up as a pdf. If we are going directly to a printer, we can probably just pass it along without worrying about conversion. In fact, in that case we probably should not have bothered even setting up the PDF stream.")
|
||||
|
||||
(* ;; "But for a file we execute the PDFCONVERTER as a shell command to make a pdf, and then we rename it to the intended filename")
|
||||
|
||||
(STREAMPROP PSSTREAM 'AFTERCLOSE NIL) (* ;
|
||||
"Maybe just remove only CLOSE-PDF-STREAMfrom the list?")
|
||||
(LET ((TARGETINFO (STREAMPROP PSSTREAM 'PDFTARGETINFO NIL)))
|
||||
(CL:IF TARGETINFO
|
||||
(RENAMEFILE (PS-TO-PDF PSSTREAM)
|
||||
TARGETINFO)
|
||||
PSSTREAM)])
|
||||
|
||||
(PS-TO-PDF
|
||||
[LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 1-Oct-2023 15:18 by rmk")
|
||||
(* ; "Edited 23-Sep-2023 22:54 by rmk")
|
||||
(* ; "Edited 23-Jul-2023 22:30 by rmk")
|
||||
(* ; "Edited 24-Jun-2023 15:01 by rmk")
|
||||
(* ; "Edited 16-Jul-2022 13:06 by rmk")
|
||||
(* ; "Edited 8-Jul-2022 10:20 by rmk")
|
||||
(* ; "Edited 7-May-2022 22:40 by rmk")
|
||||
(* ; "Edited 7-Oct-2021 11:15 by rmk:")
|
||||
|
||||
(* ;; "PSFILE is the name of a closed PS file on a DSK/UNIX device. This function uses the PDFCONVERTER utility to convert that to a parallel pdf file, which is then renamed to PDFFILE. ")
|
||||
|
||||
(* ;; "DONTDELETE is just for debugging, keeps the /tmp/ files")
|
||||
|
||||
(SETQ PSFILE (FULLNAME (TRUEFILENAME PSFILE)))
|
||||
(CL:UNLESS (INFILEP PSFILE)
|
||||
(ERROR "NO PS FILE TO CONVERT"))
|
||||
(SETQ PDFFILE (if PDFFILE
|
||||
then (TRUEFILENAME PDFFILE)
|
||||
else (PACKFILENAME 'EXTENSION 'pdf 'BODY PSFILE)))
|
||||
(LET ((ERRORFILE (PACKFILENAME 'EXTENSION 'error 'BODY PSFILE))
|
||||
COMPLETIONCODE)
|
||||
|
||||
(* ;; "PROCESS-COMMAND is currently from GITFNS. Not sure whether ShellCommand in UNIXUTILS is appropriate.")
|
||||
|
||||
(* ;;
|
||||
"We have to map the filenames down to Unix conventions: (not pseudohost or host, slashes, etc.")
|
||||
|
||||
[SETQ COMPLETIONCODE (PROCESS-COMMAND (CONCATLIST (SUBLIS
|
||||
`((PSFILE \, (SLASHIT (TRUEFILENAME
|
||||
PSFILE)
|
||||
NIL T))
|
||||
(PDFFILE \, (SLASHIT (TRUEFILENAME
|
||||
PDFFILE)
|
||||
NIL T))
|
||||
(ERRORFILE \, (SLASHIT (TRUEFILENAME
|
||||
ERRORFILE)
|
||||
NIL T)))
|
||||
(ASSOC (OR PDFCONVERTER
|
||||
(MKATOM (UNIX-GETENV
|
||||
"MEDLEY-PDFCONVERTER"
|
||||
)))
|
||||
PDF-CONVERTER-TEMPLATES]
|
||||
|
||||
(* ;; "Now use Medley names")
|
||||
|
||||
(CLOSEF? PSFILE)
|
||||
(CL:UNLESS DONTDELETE (DELFILE PSFILE))
|
||||
(CLOSEF? ERRORFILE)
|
||||
(CL:WHEN (INFILEP ERRORFILE)
|
||||
(CL:WHEN (IGREATERP (PROG1 (GETFILEINFO ERRORFILE 'LENGTH)
|
||||
(CL:UNLESS DONTDELETE (DELFILE ERRORFILE)))
|
||||
0)
|
||||
(ERROR "Cannot create PDF file for " PDFFILE)))
|
||||
(CL:WHEN (IGREATERP COMPLETIONCODE 0)
|
||||
(ERROR "Cannot create PDF file for " PDFFILE))
|
||||
PDFFILE])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(SEE-PDF
|
||||
[LAMBDA (PDFFILE) (* ; "Edited 1-Oct-2023 20:47 by rmk")
|
||||
(* ; "Edited 26-Sep-2023 16:52 by rmk")
|
||||
|
||||
(* ;; "Good for Mac, not sure about Windows etc.")
|
||||
|
||||
(ShellCommand (CONCAT "open -a Preview " (UNIX-FILE-NAME (PACKFILENAME 'BODY PDFFILE 'EXTENSION
|
||||
'PDF)
|
||||
'INPUT])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3078 5692 (PDFFILEP 3088 . 4002) (PDF.HARDCOPYW 4004 . 4602) (PDF.TEXT 4604 . 5321) (
|
||||
PDF.TEDIT 5323 . 5690)) (6136 13355 (OPEN-PDF-STREAM 6146 . 8324) (CLOSE-PDF-STREAM 8326 . 9613) (
|
||||
PS-TO-PDF 9615 . 13353)) (13356 13894 (SEE-PDF 13366 . 13892)))))
|
||||
STOP
|
||||
BIN
library/PDFSTREAM.LCOM
Normal file
BIN
library/PDFSTREAM.LCOM
Normal file
Binary file not shown.
@@ -1,28 +1,40 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "18-Jan-2023 20:36:10" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;7 5091
|
||||
(FILECREATED " 8-Oct-2023 15:06:52" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;15 14696
|
||||
|
||||
:CHANGES-TO (FNS ShellBrowser ShellBrowse ShellOpen)
|
||||
:CHANGES-TO (FNS ShellOpen UNIX-FILE-NAME ShellBrowser ShellBrowse ShellOpener)
|
||||
(VARS UNIXUTILSCOMS)
|
||||
(FUNCTIONS ShellWhich)
|
||||
|
||||
:PREVIOUS-DATE "18-Jan-2023 13:22:28" {DSK}<home>frank>il>medley>gmedley>greetfiles>UNIXUTILS.;1
|
||||
:PREVIOUS-DATE " 8-Oct-2023 02:35:47" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;14
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UNIXUTILSCOMS)
|
||||
|
||||
(RPAQQ UNIXUTILSCOMS ((GLOBALVARS ShellBrowser)
|
||||
(INITVARS (ShellBrowser))
|
||||
(FUNCTIONS ShellCommand ShellWhich)
|
||||
(FNS ShellBrowser ShellBrowse)))
|
||||
(RPAQQ UNIXUTILSCOMS
|
||||
((DECLARE%: EVAL@COMPILE DONTCOPY (* ; "For PROCESS-COMMAND")
|
||||
(FILES (FROM LOADUPS)
|
||||
EXPORTS.ALL))
|
||||
(GLOBALVARS ShellBrowser ShellOpener)
|
||||
(INITVARS (ShellBrowser)
|
||||
(ShellOpener))
|
||||
(FUNCTIONS ShellCommand ShellWhich)
|
||||
(FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME)
|
||||
(PROPS (UNIXUTILS FILETYPE))))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(FILESLOAD (FROM LOADUPS)
|
||||
EXPORTS.ALL)
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS ShellBrowser)
|
||||
(GLOBALVARS ShellBrowser ShellOpener)
|
||||
)
|
||||
|
||||
(RPAQ? ShellBrowser )
|
||||
|
||||
(RPAQ? ShellOpener )
|
||||
|
||||
(CL:DEFUN ShellCommand (Cmd &OPTIONAL (Output T))
|
||||
(CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM Cmd))
|
||||
(CL:TAGBODY [SETFILEINFO s 'ENDOFSTREAMOP #'(CL:LAMBDA (s)
|
||||
@@ -34,62 +46,56 @@
|
||||
|
||||
(CL:DEFUN ShellWhich (Cmd) (* ; "Edited 18-Jan-2023 13:19 by FGH")
|
||||
[CL:WITH-OPEN-STREAM (S (OPENSTREAM '{NODIRCORE} 'BOTH))
|
||||
(ShellCommand (CONCAT "which " Cmd)
|
||||
(ShellCommand (CONCAT "command -v " Cmd)
|
||||
S)
|
||||
(COND
|
||||
((EQ (GETEOFPTR S)
|
||||
0)
|
||||
NIL)
|
||||
(T (SETFILEPTR S 0)
|
||||
(MKSTRING (READ S])
|
||||
(RSTRING S])
|
||||
(DEFINEQ
|
||||
|
||||
(ShellBrowser
|
||||
[LAMBDA NIL (* ; "Edited 18-Jan-2023 20:30 by FGH")
|
||||
(OR ShellBrowser (SETQ ShellBrowser (LET (CMDPATH)
|
||||
(if (STRPOS "darwin" (OR (UNIX-GETENV "OSTYPE")
|
||||
(UNIX-GETENV "PATH")))
|
||||
then
|
||||
(* ;; " MacOS")
|
||||
|
||||
"open"
|
||||
elseif (SETQ CMDPATH (ShellWhich "wslview"))
|
||||
then
|
||||
(* ;; "windows with WSL")
|
||||
(* ;; "Figure out the browser to use for the ShellOpen/ShellBrowse functions. ")
|
||||
|
||||
CMDPATH
|
||||
elseif (SETQ CMDPATH (ShellWhich "xdg-open"))
|
||||
then
|
||||
(* ;; "Linux systems with xdg-utils installed ")
|
||||
(* ;; " Ordinarily, this would be the same as the generic ShellOpener.")
|
||||
|
||||
CMDPATH
|
||||
elseif (SETQ CMDPATH (ShellWhich "git"))
|
||||
then
|
||||
(* ;; " Systems with git installed")
|
||||
(* ;; " But if a generic ShellOpener is not found, then there are some additional")
|
||||
|
||||
(CONCAT CMDPATH " web--browse")
|
||||
(* ; "")
|
||||
elseif (SETQ CMDPATH (ShellWhich "lynx"))
|
||||
then
|
||||
(* ;; " Systems with lynx installed")
|
||||
(* ;; " possibilities that will work for http/https URLs. If one of these exists return it.")
|
||||
|
||||
(LET (CMDPATH2)
|
||||
(if (SETQ CMDPATH2 (ShellWhich "xterm"))
|
||||
then (CONCAT CMDPATH2 " -e " CMDPATH)
|
||||
else (LIST CMDPATH)))
|
||||
else
|
||||
(* ;;
|
||||
" Out of ideas - just return a dummy function")
|
||||
(OR ShellBrowser (SETQ ShellBrowser
|
||||
(if (NOT (STREQUAL (ShellOpener)
|
||||
"true"))
|
||||
then ShellOpener
|
||||
else (LET (CMDPATH)
|
||||
(if (SETQ CMDPATH (ShellWhich "git"))
|
||||
then
|
||||
(* ;; " Systems with git installed")
|
||||
|
||||
"true"])
|
||||
CMDPATH
|
||||
elseif (SETQ CMDPATH (ShellWhich "lynx"))
|
||||
then
|
||||
(* ;; " Systems with lynx installed")
|
||||
|
||||
(LET (CMDPATH2)
|
||||
(if (SETQ CMDPATH2 (ShellWhich "xterm"))
|
||||
then (CONCAT CMDPATH2 " -e " CMDPATH)
|
||||
else (LIST CMDPATH)))
|
||||
else
|
||||
(* ;; " Out of ideas - just return a dummy function")
|
||||
|
||||
"true"])
|
||||
|
||||
(ShellBrowse
|
||||
[LAMBDA (URL) (* ; "Edited 18-Jan-2023 20:32 by FGH")
|
||||
|
||||
(* ;; " Open the web page specified by URL using an external browser via shell call")
|
||||
|
||||
(* ;;
|
||||
" URL must start with http:// or https:// (case ireelevant) or this function will just return NIL.")
|
||||
(* ;; " URL must start with http:// or https:// or file:/// (case ireelevant) or this function will just return NIL.")
|
||||
|
||||
(* ;; " Returns T otherwise.")
|
||||
|
||||
@@ -97,17 +103,189 @@
|
||||
(if (OR (EQ (STRPOS "http://" (L-CASE URL))
|
||||
1)
|
||||
(EQ (STRPOS "https://" (L-CASE URL))
|
||||
1)
|
||||
(EQ (STRPOS "file:///" (L-CASE URL))
|
||||
1))
|
||||
then (ShellOpen URL)
|
||||
else NIL])
|
||||
|
||||
(ShellOpener
|
||||
[LAMBDA NIL
|
||||
|
||||
(* ;; "Find an %"opener%" that will open files (and URLs) using the appropriate/default app on this machine")
|
||||
|
||||
(OR ShellOpener (SETQ ShellOpener (LET (CMDPATH)
|
||||
(if (SETQ CMDPATH (ShellWhich "wslview"))
|
||||
then
|
||||
(* ;; "windows with WSL")
|
||||
|
||||
CMDPATH
|
||||
elseif (SETQ CMDPATH (ShellWhich "cygstart"))
|
||||
then
|
||||
(* ;; "windows with cygwin")
|
||||
|
||||
CMDPATH
|
||||
elseif (SETQ CMDPATH (ShellWhich "xdg-open"))
|
||||
then
|
||||
(* ;; "Linux systems with xdg-utils installed ")
|
||||
|
||||
CMDPATH
|
||||
elseif (SETQ CMDPATH (ShellWhich "open"))
|
||||
then
|
||||
(* ;; " MacOS open")
|
||||
|
||||
CMDPATH
|
||||
else
|
||||
(* ;;
|
||||
" Out of ideas - just return a dummy function")
|
||||
|
||||
"true"])
|
||||
|
||||
(ShellOpen
|
||||
[LAMBDA (FilenameOrURL)
|
||||
|
||||
(* ;; "Open the file or URL using the generic %"opener%" for this machine via a shell call.")
|
||||
|
||||
(* ;; " If FilenameOrURL starts with %"http://%" or %"https://%" or %"file:///%", then we use (ShellBrowser) as")
|
||||
|
||||
(* ;; " the %"opener%" (which includes some browsers on a machine without a generic opener).")
|
||||
|
||||
(* ;;
|
||||
" Otherwise FilenameOrURL is assumed to be a filename and will be opened using (ShellOpener).")
|
||||
|
||||
(* ;; " Returns T is all goes well; returns an error string if all does not go well")
|
||||
|
||||
(SETQ FilenameOrURL (MKSTRING FilenameOrURL))
|
||||
(if (OR (EQ (STRPOS "http://" (L-CASE FilenameOrURL))
|
||||
1)
|
||||
(EQ (STRPOS "https://" (L-CASE FilenameOrURL))
|
||||
1)
|
||||
(EQ (STRPOS "file://" (L-CASE FilenameOrURL))
|
||||
1))
|
||||
then (LET ((BROWSER (ShellBrowser)))
|
||||
(if (LISTP BROWSER)
|
||||
then (CHAT 'SHELL NIL (CONCAT (CAR BROWSER)
|
||||
" '" URL "'"))
|
||||
else (ShellCommand (CONCAT BROWSER " '" URL "'"
|
||||
" >>/tmp/ShellBrowser-warnings-$$.txt")))
|
||||
T)
|
||||
else NIL])
|
||||
(if (NOT (STREQUAL BROWSER "true"))
|
||||
then (if (LISTP BROWSER)
|
||||
then (CHAT 'SHELL NIL (CONCAT (CAR BROWSER)
|
||||
" '" FilenameOrURL "'"))
|
||||
else (ShellCommand (CONCAT BROWSER " '" FilenameOrURL "'"
|
||||
" >>/tmp/ShellBrowser-warnings-$$.txt"))
|
||||
T)
|
||||
else (CONCAT "Unable to find a browser to open: " FilenameOrURL)))
|
||||
else
|
||||
(LET ((OPENER (ShellOpener))
|
||||
(UNIXFILE (UNIX-FILE-NAME FilenameOrURL 'INPUT T)))
|
||||
(if (NOT UNIXFILE)
|
||||
then (CONCAT "File not found: " FilenameOrURL)
|
||||
elseif (NOT (STREQUAL OPENER "true"))
|
||||
then (CL:WITH-OPEN-STREAM
|
||||
(SHELLSTREAM (OPENSTREAM (CONCAT "{CORE}SHELLOUT" (RAND))
|
||||
'BOTH))
|
||||
(ShellCommand (CONCAT OPENER " '" UNIXFILE "'"
|
||||
" >>/tmp/ShellOpener-warnings-$$.txt")
|
||||
SHELLSTREAM)
|
||||
(if (EQ (GETFILEPTR SHELLSTREAM)
|
||||
0)
|
||||
then T
|
||||
else (LET* ((OUTSTRING (ALLOCSTRING (GETFILEPTR SHELLSTREAM)
|
||||
" ")))
|
||||
(CL:WITH-OPEN-STREAM (STRINGSTREAM (OPENSTRINGSTREAM OUTSTRING
|
||||
'OUTPUT))
|
||||
(SETFILEPTR SHELLSTREAM 0)
|
||||
(CL:TAGBODY [SETFILEINFO SHELLSTREAM 'ENDOFSTREAMOP
|
||||
#'(CL:LAMBDA (s)
|
||||
(GO OUT]
|
||||
(CL:LOOP (PRINTCCODE (READCCODE SHELLSTREAM)
|
||||
STRINGSTREAM))
|
||||
OUT))
|
||||
OUTSTRING)))
|
||||
else (CONCAT "Unable to find a file opener to open: " FilenameOrURL])
|
||||
|
||||
(PROCESS-COMMAND
|
||||
[LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk")
|
||||
|
||||
(* ;; "This sets up an asynchronous process and waits until it returns with an exit code. Typically 0 means success.")
|
||||
|
||||
(CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM CMD))
|
||||
(BIND CODE WHILE (EQ T (SETQ CODE (OR (SUBRCALL UNIX-HANDLECOMM 7 (fetch (STREAM F1)
|
||||
of PS))
|
||||
0))) DO (BLOCK) FINALLY (RETURN CODE])
|
||||
|
||||
(SLASHIT
|
||||
[LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 23-Sep-2023 15:27 by rmk")
|
||||
|
||||
(* ;; "It would also be nice to use the generic unpackfilename/packfilename tools. But packfilename sticks in brackets again, and sticks a dot on when removing the version.")
|
||||
|
||||
(* ;; "Perhaps this should be a per file-device operation that maps device names into the local file system.")
|
||||
|
||||
(* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file. For now, this just involves replacing directory brackets with /, removing the host, and perhaps lower-casing the directory. It probably should be extended to deal with version number translation, for now it just keeps the ; version. ")
|
||||
|
||||
(LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X)
|
||||
0]
|
||||
[SETQ SLASHED (CONCATCODES (FOR I C FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I))
|
||||
COLLECT (SELCHARQ C
|
||||
((< >)
|
||||
(SETQ LASTDIRPOS I)
|
||||
(CHARCODE /))
|
||||
(/ (SETQ LASTDIRPOS I)
|
||||
C)
|
||||
C]
|
||||
(CL:WHEN (AND LCASEDIRS LASTDIRPOS)
|
||||
(SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS)))
|
||||
(SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS))
|
||||
(OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS))
|
||||
""))))
|
||||
(CL:IF (OR (EQ DIRPOS 1)
|
||||
NOHOST)
|
||||
SLASHED
|
||||
(CONCAT (SUBSTRING X 1 (SUB1 DIRPOS))
|
||||
SLASHED))])
|
||||
|
||||
(UNIX-FILE-NAME
|
||||
[LAMBDA (FILE ACCESS COPY) (* ; "Edited 1-Oct-2023 20:52 by rmk")
|
||||
|
||||
(* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file is doesn't have the Medley version convention. If FILE does not have a corresponding Unix name, COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.")
|
||||
|
||||
(CL:WHEN (\GETSTREAM FILE ACCESS T)
|
||||
(SETQ FILE (OR (FULLNAME FILE)
|
||||
FILE))) (* ; "Might catch NODIRCORE")
|
||||
(CL:WHEN FILE
|
||||
(SETQ FILE (TRUEFILENAME FILE))
|
||||
(CL:UNLESS (STREAMP FILE)
|
||||
[SETQ FILE (\GETFILENAME FILE (SELECTQ ACCESS
|
||||
(OUTPUT 'NEW)
|
||||
(INPUT 'OLD)
|
||||
(NIL (SETQ ACCESS 'INPUT)
|
||||
'OLD)
|
||||
(\ILLEGAL.ARG ACCESS])
|
||||
[SELECTQ (FILENAMEFIELD FILE 'HOST)
|
||||
(UNIX [SUBSTRING FILE (ADD1 (CONSTANT (NCHARS "{UNIX}"])
|
||||
(DSK (LET [(VERSION (FILENAMEFIELD FILE 'VERSION]
|
||||
(SETQ FILE (SLASHIT (PACKFILENAME 'HOST NIL 'VERSION NIL 'BODY FILE)))
|
||||
(CL:IF (AND VERSION (IGREATERP VERSION 1))
|
||||
(CONCAT FILE (CL:IF (FILENAMEFIELD FILE 'EXTENSION)
|
||||
"."
|
||||
"")
|
||||
"~" VERSION "~")
|
||||
FILE)))
|
||||
(CL:WHEN (AND COPY (EQ ACCESS 'INPUT)
|
||||
FILE)
|
||||
(RESETLST
|
||||
(CL:WHEN (\GETSTREAM FILE 'INPUT T) (* ; "Hope is randaccess")
|
||||
[RESETSAVE (GETFILEPTR FILE)
|
||||
`(PROGN (SETFILEPTR ,FILE OLDVALUE])
|
||||
(COPYFILE FILE (CONCAT "{UNIX}/tmp/medley-" (L-CASE COPY)
|
||||
"-"
|
||||
(IDATE)
|
||||
"-"
|
||||
(RAND)
|
||||
(CL:IF (FILENAMEFIELD FILE 'EXTENSION)
|
||||
(CONCAT "." (FILENAMEFIELD FILE 'EXTENSION))
|
||||
"")))))])])
|
||||
)
|
||||
|
||||
(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (764 1137 (ShellCommand 764 . 1137)) (1139 1538 (ShellWhich 1139 . 1538)) (1539 5068 (
|
||||
ShellBrowser 1549 . 4072) (ShellBrowse 4074 . 5066)))))
|
||||
(FILEMAP (NIL (1144 1517 (ShellCommand 1144 . 1517)) (1519 1916 (ShellWhich 1519 . 1916)) (1917 14618
|
||||
(ShellBrowser 1927 . 3675) (ShellBrowse 3677 . 4362) (ShellOpener 4364 . 6052) (ShellOpen 6054 . 9357)
|
||||
(PROCESS-COMMAND 9359 . 9972) (SLASHIT 9974 . 12016) (UNIX-FILE-NAME 12018 . 14616)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,27 +1,26 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "11-Dec-87 14:48:16" {DSK}<XAVIER>COMMON-MAKE.;5 15290
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (VARS COMMON-MAKECOMS)
|
||||
(FNS COMMON-FILE-COMMAND COMMON-MAKEFILE)
|
||||
(PROPS (COMMON-MAKE MAKEFILE-ENVIRONMENT))
|
||||
(FILECREATED "13-Oct-2023 16:40:48" {LU}COMMON-MAKE.;2 14315
|
||||
|
||||
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)
|
||||
|
||||
(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)
|
||||
(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
|
||||
|
||||
@@ -227,30 +226,20 @@ Copyright (c) 1987 by Unisys Corp.. All rights reserved.
|
||||
(CLOSEF *STANDARD-OUTPUT*])
|
||||
)
|
||||
|
||||
(PUTPROPS COMMON-MAKE MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
|
||||
(PUTPROPS COMMON-MAKE MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
|
||||
(DECLARE%: DONTCOPY
|
||||
|
||||
(ADDTOVAR EDITHISTALIST (COMMON-MAKE ("11-Dec-87 12:54:22" DJVB {DSK}<XAVIER>COMMON-MAKE.;1
|
||||
(COMMON-FILE-COMMAND COMMON-MAKEFILE))
|
||||
("11-Dec-87 13:35:35" DJVB {DSK}<XAVIER>COMMON-MAKE.;2 (
|
||||
COMMON-FILE-COMMAND
|
||||
|
||||
COMMON-MAKEFILE
|
||||
)
|
||||
(GETTING DETAILS RIGHT))
|
||||
("11-Dec-87 13:40:48" DJVB {DSK}<XAVIER>COMMON-MAKE.;3 (
|
||||
COMMON-FILE-COMMAND
|
||||
))
|
||||
("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))))
|
||||
(ADDTOVAR EDITHISTALIST
|
||||
(COMMON-MAKE ("11-Dec-87 12:54:22" DJVB {DSK}<XAVIER>COMMON-MAKE.;1 (COMMON-FILE-COMMAND
|
||||
COMMON-MAKEFILE))
|
||||
("11-Dec-87 13:35:35" DJVB {DSK}<XAVIER>COMMON-MAKE.;2 (COMMON-FILE-COMMAND
|
||||
COMMON-MAKEFILE)
|
||||
(GETTING DETAILS RIGHT))
|
||||
("11-Dec-87 13:40:48" DJVB {DSK}<XAVIER>COMMON-MAKE.;3 (COMMON-FILE-COMMAND))
|
||||
("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
|
||||
(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
|
||||
ÿ
|
||||
BIN
lispusers/COMMON-MAKE.LCOM
Normal file
BIN
lispusers/COMMON-MAKE.LCOM
Normal file
Binary file not shown.
324
lispusers/GITFNS
324
lispusers/GITFNS
@@ -1,10 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "30-Mar-2023 09:08:48" {WMEDLEY}<lispusers>GITFNS.;469 119763
|
||||
(FILECREATED "23-Sep-2023 13:02:15" {WMEDLEY}<lispusers>GITFNS.;483 124031
|
||||
|
||||
:CHANGES-TO (FNS GIT-MAKE-PROJECT)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "11-Mar-2023 23:12:35" {WMEDLEY}<lispusers>GITFNS.;468)
|
||||
:CHANGES-TO (FNS CDGITDIR)
|
||||
|
||||
:PREVIOUS-DATE "22-Sep-2023 12:08:14" {WMEDLEY}<lispusers>GITFNS.;482)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
@@ -47,6 +49,7 @@
|
||||
(INITVARS (GIT-MERGE-COMPARES T)
|
||||
(GIT-CDBROWSER-SEPARATE-DIRECTIONS T))
|
||||
(COMMANDS gwc bbc prc cob b? cdg cdw)
|
||||
(FNS PRC-COMMAND)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -65,7 +68,7 @@
|
||||
|
||||
(FNS GIT-COMMIT GIT-PUSH GIT-PULL GIT-APPROVAL GIT-GET-FILE GIT-FILE-EXISTS?
|
||||
GIT-REMOTE-UPDATE GIT-REMOTE-ADD GIT-FILE-DATE GIT-FILE-HISTORY GIT-PRINT-FILE-HISTORY
|
||||
GIT-FETCH)
|
||||
GIT-FETCH GIT-PR-BRANCHES)
|
||||
|
||||
(* ;; "Differences")
|
||||
|
||||
@@ -77,8 +80,8 @@
|
||||
(* ;; "Branches")
|
||||
|
||||
(FNS GIT-BRANCH-NUM GIT-CHECKOUT GIT-WHICH-BRANCH GIT-MAKE-BRANCH GIT-BRANCHES
|
||||
GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-PRC-MENU GIT-PULL-REQUESTS GIT-SHORT-BRANCH-NAME
|
||||
GIT-LONG-NAME)
|
||||
GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-BRANCH-MENU GIT-PULL-REQUESTS
|
||||
GIT-SHORT-BRANCH-NAME GIT-LONG-NAME GIT-PRC-BRANCHES)
|
||||
|
||||
(* ;; "My branches")
|
||||
|
||||
@@ -98,7 +101,7 @@
|
||||
|
||||
(FNS GIT-GET-DIFFERENT-FILES GIT-BRANCHES-COMPARE-DIRECTORIES GIT-WORKING-COMPARE-DIRECTORIES
|
||||
GIT-COMPARE-WORKTREE GITCDOBJBUTTONFN GIT-CD-LABELFN GIT-CD-MENUFN
|
||||
GIT-WORKING-COMPARE-FILES GIT-BRANCHES-COMPARE-FILES)
|
||||
GIT-WORKING-COMPARE-FILES GIT-BRANCHES-COMPARE-FILES GIT-PR-COMPARE)
|
||||
(INITVARS (FROMGITN 0))
|
||||
|
||||
(* ;; "")
|
||||
@@ -106,8 +109,8 @@
|
||||
|
||||
(* ;; "Utilities")
|
||||
|
||||
(FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE PROCESS-COMMAND
|
||||
GIT-RESULT-TO-LINES STRIPLOCAL)
|
||||
(FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE GIT-RESULT-TO-LINES
|
||||
STRIPLOCAL)
|
||||
(PROPS (GITFNS FILETYPE))))
|
||||
|
||||
|
||||
@@ -314,7 +317,8 @@
|
||||
PROJECT))])
|
||||
|
||||
(GIT-PUT-PROJECT-FIELD
|
||||
[LAMBDA (PROJECT FIELD NEWVALUE) (* ; "Edited 11-Mar-2023 23:00 by rmk")
|
||||
[LAMBDA (PROJECT FIELD NEWVALUE) (* ; "Edited 10-Jun-2023 21:48 by rmk")
|
||||
(* ; "Edited 11-Mar-2023 23:00 by rmk")
|
||||
(* ; "Edited 7-Jul-2022 11:25 by rmk")
|
||||
(* ; "Edited 13-May-2022 10:40 by rmk")
|
||||
(* ; "Edited 9-May-2022 20:02 by rmk")
|
||||
@@ -322,24 +326,17 @@
|
||||
|
||||
(* ;; "Replaces the value of a project field with NEWVALUE. The project record is DONTCOPY, to avoid potential name conflicts, so this provides a functional interface. One use: augment EXCLUSIONS with a list of temporary debug and testing files that you don't want to see in the various file listings")
|
||||
|
||||
(CL:WHEN (SETQ PROJECT (IF (TYPE? GIT-PROJECT PROJECT)
|
||||
THEN PROJECT
|
||||
ELSEIF (CDR (ASSOC (OR (U-CASE PROJECT)
|
||||
GIT-DEFAULT-PROJECT)
|
||||
GIT-PROJECTS))
|
||||
ELSEIF NOERROR
|
||||
THEN NIL
|
||||
ELSE (ERROR "NOT A GIT-PROJECT" PROJECT)))
|
||||
(SELECTQ FIELD
|
||||
(PROJECTNAME (REPLACE PROJECTNAME OF PROJECT WITH NEWVALUE))
|
||||
(WHOST (REPLACE WHOST OF PROJECT WITH NEWVALUE))
|
||||
(GITHOST (REPLACE GITHOST OF PROJECT WITH NEWVALUE))
|
||||
(EXCLUSIONS (REPLACE EXCLUSIONS OF PROJECT WITH NEWVALUE))
|
||||
(DEFAULTSUBDIRS
|
||||
(REPLACE DEFAULTSUBDIRS OF PROJECT WITH NEWVALUE))
|
||||
(CLONEPATH (REPLACE CLONEPATH OF PROJECT WITH NEWVALUE))
|
||||
(MAINBRANCH (REPLACE MAINBRANCH OF PROJECT WITH NEWVALUE))
|
||||
PROJECT))])
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(SELECTQ FIELD
|
||||
(PROJECTNAME (REPLACE PROJECTNAME OF PROJECT WITH NEWVALUE))
|
||||
(WHOST (REPLACE WHOST OF PROJECT WITH NEWVALUE))
|
||||
(GITHOST (REPLACE GITHOST OF PROJECT WITH NEWVALUE))
|
||||
(EXCLUSIONS (REPLACE EXCLUSIONS OF PROJECT WITH NEWVALUE))
|
||||
(DEFAULTSUBDIRS
|
||||
(REPLACE DEFAULTSUBDIRS OF PROJECT WITH NEWVALUE))
|
||||
(CLONEPATH (REPLACE CLONEPATH OF PROJECT WITH NEWVALUE))
|
||||
(MAINBRANCH (REPLACE MAINBRANCH OF PROJECT WITH NEWVALUE))
|
||||
PROJECT])
|
||||
|
||||
(GIT-PROJECT-PATH
|
||||
[LAMBDA (PROJECTNAME PROJECTPATH) (* ; "Edited 8-May-2022 15:10 by rmk")
|
||||
@@ -478,29 +475,7 @@
|
||||
|
||||
(* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment")
|
||||
|
||||
(LET ((RB REMOTEBRANCH)
|
||||
(DR DRAFTS)
|
||||
(PRS))
|
||||
(IF PROJECT
|
||||
THEN (SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
ELSEIF (GIT-GET-PROJECT RB NIL T)
|
||||
THEN (SETQ PROJECT RB)
|
||||
(SETQ RB NIL)
|
||||
ELSEIF (GIT-GET-PROJECT DRAFTS NIL T)
|
||||
THEN (SETQ PROJECT DRAFTS)
|
||||
(SETQ DRFTS NIL))
|
||||
(CL:WHEN (MEMB (U-CASE RB)
|
||||
'(DRAFT DRAFTS))
|
||||
(SETQ RB NIL)
|
||||
(SETQ DR T))
|
||||
(GIT-FETCH PROJECT)
|
||||
(SETQ PRS (GIT-PULL-REQUESTS T DR PROJECT))
|
||||
(IF PRS
|
||||
THEN (CL:WHEN (OR RB (SETQ RB (GIT-PICK-BRANCH (GIT-PRC-MENU DR PROJECT PRS)
|
||||
"Pull requests")))
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES (GIT-MAINBRANCH PROJECT)
|
||||
RB NIL PROJECT))
|
||||
ELSE "No open pull requests")))
|
||||
(PRC-COMMAND REMOTEBRANCH DRAFTS PROJECT))
|
||||
|
||||
(DEFCOMMAND cob (BRANCH NEXTTITLESTRING PROJECT)
|
||||
|
||||
@@ -553,6 +528,46 @@
|
||||
(SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'WHOST)
|
||||
(OR SUBDIR "")))
|
||||
T))
|
||||
(DEFINEQ
|
||||
|
||||
(PRC-COMMAND
|
||||
[LAMBDA (REMOTEBRANCH DRAFTS PROJECT) (* ; "Edited 28-Jul-2023 09:03 by rmk")
|
||||
(LET (PRS PRMENU)
|
||||
(IF PROJECT
|
||||
THEN (SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
ELSEIF (GIT-GET-PROJECT REMOTEBRANCH NIL T)
|
||||
THEN (SETQ PROJECT REMOTEBRANCH)
|
||||
(SETQ REMOTEBRANCH NIL)
|
||||
ELSEIF (GIT-GET-PROJECT DRAFTS NIL T)
|
||||
THEN (SETQ PROJECT DRAFTS)
|
||||
(SETQ DRAFTS NIL))
|
||||
(CL:WHEN (MEMB (U-CASE REMOTEBRANCH)
|
||||
'(DRAFT DRAFTS))
|
||||
(SETQ REMOTEBRANCH NIL)
|
||||
(SETQ DRAFTS T))
|
||||
(GIT-FETCH PROJECT)
|
||||
(SETQ PRS (GIT-PULL-REQUESTS T DRAFTS PROJECT))
|
||||
(CL:WHEN (AND REMOTEBRANCH (NEQ REMOTEBRANCH 'PinMenu))
|
||||
(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
|
||||
finally (CL:WHEN $$VAL (SETQ PRS $$VAL))
|
||||
(SETQ REMOTEBRANCH NIL)))
|
||||
(IF PRS
|
||||
THEN (CL:UNLESS REMOTEBRANCH
|
||||
(SETQ PRS (GIT-PRC-BRANCHES DRAFTS PROJECT PRS))
|
||||
(SETQ PRMENU (GIT-BRANCH-MENU PRS (CONCAT (LENGTH PRS)
|
||||
" pull requests")
|
||||
NIL))
|
||||
(SETQ REMOTEBRANCH (MENU PRMENU)))
|
||||
(if (EQ 'PinMenu REMOTEBRANCH)
|
||||
then (ADDMENU (GIT-BRANCH-MENU PRS (CONCAT (LENGTH PRS)
|
||||
" pull requests")))
|
||||
elseif REMOTEBRANCH
|
||||
then (GIT-PR-COMPARE REMOTEBRANCH PROJECT))
|
||||
ELSE "No open pull requests"])
|
||||
)
|
||||
|
||||
|
||||
|
||||
@@ -1004,6 +1019,35 @@
|
||||
(GIT-FETCH
|
||||
[LAMBDA (PROJECT) (* ; "Edited 8-Jul-2022 10:32 by rmk")
|
||||
(GIT-COMMAND "git fetch" T NIL PROJECT])
|
||||
|
||||
(GIT-PR-BRANCHES
|
||||
[LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk")
|
||||
(* ; "Edited 4-Aug-2022 18:55 by rmk")
|
||||
(* ; "Edited 9-Jul-2022 19:01 by rmk")
|
||||
(* ; "Edited 16-May-2022 19:44 by rmk")
|
||||
(CL:UNLESS PRS
|
||||
(SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT)))
|
||||
(CL:WHEN PRS
|
||||
(LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR)))
|
||||
NIL T PROJECT)))
|
||||
(SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS))
|
||||
(EQUALS _ (CADR RELATIONS)) IN PRS
|
||||
COLLECT (SETQ PRNAME (fetch PRNAME of PR))
|
||||
(SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR)
|
||||
" "
|
||||
(IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS]
|
||||
THEN (CONCAT PRNAME " > " REL)
|
||||
ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS]
|
||||
THEN (CONCAT PRNAME " = " REL)
|
||||
ELSE PRNAME)))
|
||||
(LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR))
|
||||
(CONCAT LABEL " (draft)")
|
||||
LABEL)
|
||||
(GITORIGIN PRNAME)
|
||||
(CONCAT " " (FETCH PRDESCRIPTION OF PR)
|
||||
" #"
|
||||
(FETCH PRNUMBER OF PR]
|
||||
T)))])
|
||||
)
|
||||
|
||||
|
||||
@@ -1321,41 +1365,24 @@
|
||||
THEN (ERROR "Unknown branch" BRANCH])
|
||||
|
||||
(GIT-PICK-BRANCH
|
||||
[LAMBDA (BRANCHES TITLE) (* ; "Edited 18-May-2022 13:44 by rmk")
|
||||
(CL:WHEN (MKLIST BRANCHES)
|
||||
(MENU (CREATE MENU
|
||||
TITLE _ (OR TITLE 'Branches)
|
||||
ITEMS _ BRANCHES
|
||||
MENUFONT _ DEFAULTFONT)))])
|
||||
[LAMBDA (BRANCHES TITLE) (* ; "Edited 6-Jul-2023 22:31 by rmk")
|
||||
(* ; "Edited 30-Jun-2023 16:58 by rmk")
|
||||
(* ; "Edited 18-May-2022 13:44 by rmk")
|
||||
(MENU (GIT-BRANCH-MENU BRANCHES (OR TITLE (CONCAT (LENGTH BRANCHES)
|
||||
" branches"])
|
||||
|
||||
(GIT-PRC-MENU
|
||||
[LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk")
|
||||
(* ; "Edited 4-Aug-2022 18:55 by rmk")
|
||||
(* ; "Edited 9-Jul-2022 19:01 by rmk")
|
||||
(* ; "Edited 16-May-2022 19:44 by rmk")
|
||||
(CL:UNLESS PRS
|
||||
(SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT)))
|
||||
(CL:WHEN PRS
|
||||
(LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR)))
|
||||
NIL T PROJECT)))
|
||||
(SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS))
|
||||
(EQUALS _ (CADR RELATIONS)) IN PRS
|
||||
COLLECT (SETQ PRNAME (fetch PRNAME of PR))
|
||||
(SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR)
|
||||
" "
|
||||
(IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS]
|
||||
THEN (CONCAT PRNAME " > " REL)
|
||||
ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS]
|
||||
THEN (CONCAT PRNAME " = " REL)
|
||||
ELSE PRNAME)))
|
||||
(LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR))
|
||||
(CONCAT LABEL " (draft)")
|
||||
LABEL)
|
||||
(GITORIGIN PRNAME)
|
||||
(CONCAT " " (FETCH PRDESCRIPTION OF PR)
|
||||
" #"
|
||||
(FETCH PRNUMBER OF PR]
|
||||
T)))])
|
||||
(GIT-BRANCH-MENU
|
||||
[LAMBDA (BRANCHES TITLE PIN?) (* ; "Edited 6-Jul-2023 22:31 by rmk")
|
||||
(* ; "Edited 30-Jun-2023 16:58 by rmk")
|
||||
(* ; "Edited 18-May-2022 13:44 by rmk")
|
||||
(CL:WHEN (SETQ BRANCHES (MKLIST BRANCHES))
|
||||
(CL:WHEN PIN?
|
||||
[SETQ BRANCHES (APPEND BRANCHES '((" Pin menu" 'PinMenu])
|
||||
(CREATE MENU
|
||||
TITLE _ (OR TITLE (CONCAT (LENGTH BRANCHES)
|
||||
" branches"))
|
||||
ITEMS _ BRANCHES
|
||||
MENUFONT _ DEFAULTFONT))])
|
||||
|
||||
(GIT-PULL-REQUESTS
|
||||
[LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 8-Aug-2022 13:12 by rmk")
|
||||
@@ -1402,6 +1429,35 @@
|
||||
(* ;; "Allows short-hand reference to branch: rmk40 will return rmk40--xyz")
|
||||
|
||||
(FIND B IN (GIT-BRANCHES WHERE PROJECT EXCLUDEMERGED) SUCHTHAT (STRPOS BRANCH B])
|
||||
|
||||
(GIT-PRC-BRANCHES
|
||||
[LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk")
|
||||
(* ; "Edited 4-Aug-2022 18:55 by rmk")
|
||||
(* ; "Edited 9-Jul-2022 19:01 by rmk")
|
||||
(* ; "Edited 16-May-2022 19:44 by rmk")
|
||||
(CL:UNLESS PRS
|
||||
(SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT)))
|
||||
(CL:WHEN PRS
|
||||
(LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR)))
|
||||
NIL T PROJECT)))
|
||||
(SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS))
|
||||
(EQUALS _ (CADR RELATIONS)) IN PRS
|
||||
COLLECT (SETQ PRNAME (fetch PRNAME of PR))
|
||||
(SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR)
|
||||
" "
|
||||
(IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS]
|
||||
THEN (CONCAT PRNAME " > " REL)
|
||||
ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS]
|
||||
THEN (CONCAT PRNAME " = " REL)
|
||||
ELSE PRNAME)))
|
||||
(LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR))
|
||||
(CONCAT LABEL " (draft)")
|
||||
LABEL)
|
||||
(GITORIGIN PRNAME)
|
||||
(CONCAT " " (FETCH PRDESCRIPTION OF PR)
|
||||
" #"
|
||||
(FETCH PRNUMBER OF PR]
|
||||
T)))])
|
||||
)
|
||||
|
||||
|
||||
@@ -1664,7 +1720,8 @@
|
||||
(LIST DIR1 DIR2 MAPPINGS))])
|
||||
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES
|
||||
[LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 12-Sep-2022 14:41 by rmk")
|
||||
[LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 10-Jun-2023 17:28 by rmk")
|
||||
(* ; "Edited 12-Sep-2022 14:41 by rmk")
|
||||
(* ; "Edited 20-Jul-2022 21:18 by rmk")
|
||||
(* ; "Edited 22-May-2022 22:47 by rmk")
|
||||
(* ; "Edited 9-May-2022 15:14 by rmk")
|
||||
@@ -1683,10 +1740,11 @@
|
||||
(SETQ MAPPINGS (CADDR DIRS))
|
||||
(IF DIRS
|
||||
THEN (TERPRI T)
|
||||
(SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS)
|
||||
[SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS)
|
||||
(CADR DIRS)
|
||||
'(> < ~= -* *-)
|
||||
'*>*.*))
|
||||
'*>*.*
|
||||
(GIT-GET-PROJECT PROJECT 'EXCLUSIONS]
|
||||
|
||||
(* ;; "We know that both sides come from Unix/unversioned, even if they have been copied into versioned FROMGIT, so we make a pass to remove the misleading versions.")
|
||||
|
||||
@@ -1754,6 +1812,10 @@
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES
|
||||
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
|
||||
|
||||
(* ;; "Edited 17-Jun-2023 22:54 by rmk")
|
||||
|
||||
(* ;; "Edited 10-Jun-2023 21:32 by rmk")
|
||||
|
||||
(* ;; "Edited 20-Jul-2022 21:18 by rmk")
|
||||
|
||||
(* ;; "Edited 25-Jun-2022 21:37 by rmk")
|
||||
@@ -1793,7 +1855,13 @@
|
||||
(GITSUBDIR SUBDIR T PROJECT)
|
||||
(OR SELECT '(> < ~= -* *-))
|
||||
NIL
|
||||
(FETCH EXCLUSIONS OF PROJECT)
|
||||
(for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS)
|
||||
collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E
|
||||
'DIRECTORY)
|
||||
1 NIL T T FILEDIRCASEARRAY))
|
||||
(CL:IF DPOS
|
||||
(SUBSTRING E (ADD1 DPOS))
|
||||
E))
|
||||
NIL NIL NIL FIXDIRECTORYDATES))
|
||||
[FOR CDE IN (FETCH CDENTRIES OF CDVAL)
|
||||
DO (CL:WHEN (FETCH INFO1 OF CDE)
|
||||
@@ -2067,6 +2135,11 @@
|
||||
" " FILE)
|
||||
(CONCAT (GIT-SHORT-BRANCH-NAME BRANCH2)
|
||||
" " FILE])
|
||||
|
||||
(GIT-PR-COMPARE
|
||||
[LAMBDA (RB PROJECT) (* ; "Edited 6-Jul-2023 22:22 by rmk")
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES (GIT-MAINBRANCH PROJECT)
|
||||
RB NIL PROJECT])
|
||||
)
|
||||
|
||||
(RPAQ? FROMGITN 0)
|
||||
@@ -2083,11 +2156,13 @@
|
||||
(DEFINEQ
|
||||
|
||||
(CDGITDIR
|
||||
[LAMBDA (PROJECT) (* ; "Edited 8-Jul-2022 10:34 by rmk")
|
||||
[LAMBDA (PROJECT) (* ; "Edited 23-Sep-2023 13:01 by rmk")
|
||||
(* ; "Edited 8-Jul-2022 10:34 by rmk")
|
||||
(* ; "Edited 7-Jul-2022 09:36 by rmk")
|
||||
(* ; "Edited 7-May-2022 22:41 by rmk")
|
||||
(* ; "Edited 2-Nov-2021 21:12 by rmk:")
|
||||
(CONCAT "cd " [SLASHIT (STRIPHOST (TRUEFILENAME (FETCH GITHOST OF PROJECT]
|
||||
(CONCAT "cd " (SLASHIT (TRUEFILENAME (FETCH GITHOST OF PROJECT))
|
||||
NIL T)
|
||||
" && "])
|
||||
|
||||
(GIT-COMMAND
|
||||
@@ -2198,16 +2273,6 @@
|
||||
(ERROR (CONCAT "Command failed: " CMD)))
|
||||
NIL])
|
||||
|
||||
(PROCESS-COMMAND
|
||||
[LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk")
|
||||
|
||||
(* ;; "This sets up an asynchronous process and waits until it returns with an exit code. Typically 0 means success.")
|
||||
|
||||
(CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM CMD))
|
||||
(BIND CODE WHILE (EQ T (SETQ CODE (OR (SUBRCALL UNIX-HANDLECOMM 7 (fetch (STREAM F1)
|
||||
of PS))
|
||||
0))) DO (BLOCK) FINALLY (RETURN CODE])
|
||||
|
||||
(GIT-RESULT-TO-LINES
|
||||
[LAMBDA (FILE ALL) (* ; "Edited 16-Jul-2022 22:21 by rmk")
|
||||
|
||||
@@ -2234,32 +2299,33 @@
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3979 20805 (GIT-CLONEP 3989 . 5252) (GIT-INIT 5254 . 5884) (GIT-MAKE-PROJECT 5886 .
|
||||
13487) (GIT-GET-PROJECT 13489 . 15414) (GIT-PUT-PROJECT-FIELD 15416 . 17433) (GIT-PROJECT-PATH 17435
|
||||
. 18479) (FIND-ANCESTOR-DIRECTORY 18481 . 18830) (GIT-FIND-CLONE 18832 . 19913) (GIT-MAINBRANCH 19915
|
||||
. 20310) (GIT-MAINBRANCH? 20312 . 20803)) (27232 30020 (ALLSUBDIRS 27242 . 28528) (MEDLEYSUBDIRS
|
||||
28530 . 29223) (GITSUBDIRS 29225 . 30018)) (30021 34811 (TOGIT 30031 . 31437) (FROMGIT 31439 . 32420)
|
||||
(GIT-DELETE-FILE 32422 . 33268) (MYMEDLEY-DELETE-FILES 33270 . 34809)) (34812 37815 (MYMEDLEYSUBDIR
|
||||
34822 . 35278) (GITSUBDIR 35280 . 35723) (STRIPDIR 35725 . 36096) (STRIPHOST 36098 . 36338) (STRIPNAME
|
||||
36340 . 37093) (STRIPWHERE 37095 . 37813)) (37816 39718 (GFILE4MFILE 37826 . 38189) (MFILE4GFILE
|
||||
38191 . 38760) (GIT-REPO-FILENAME 38762 . 39716)) (39767 49589 (GIT-COMMIT 39777 . 40603) (GIT-PUSH
|
||||
40605 . 41249) (GIT-PULL 41251 . 41863) (GIT-APPROVAL 41865 . 42214) (GIT-GET-FILE 42216 . 44181) (
|
||||
GIT-FILE-EXISTS? 44183 . 44457) (GIT-REMOTE-UPDATE 44459 . 45183) (GIT-REMOTE-ADD 45185 . 45492) (
|
||||
GIT-FILE-DATE 45494 . 46425) (GIT-FILE-HISTORY 46427 . 48361) (GIT-PRINT-FILE-HISTORY 48363 . 49413) (
|
||||
GIT-FETCH 49415 . 49587)) (49619 60212 (GIT-BRANCH-DIFF 49629 . 55969) (GIT-COMMIT-DIFFS 55971 . 56524
|
||||
) (GIT-BRANCH-RELATIONS 56526 . 60210)) (60257 72489 (GIT-BRANCH-NUM 60267 . 60840) (GIT-CHECKOUT
|
||||
60842 . 61901) (GIT-WHICH-BRANCH 61903 . 62201) (GIT-MAKE-BRANCH 62203 . 64416) (GIT-BRANCHES 64418 .
|
||||
66686) (GIT-BRANCH-EXISTS? 66688 . 67392) (GIT-PICK-BRANCH 67394 . 67722) (GIT-PRC-MENU 67724 . 69727)
|
||||
(GIT-PULL-REQUESTS 69729 . 71875) (GIT-SHORT-BRANCH-NAME 71877 . 72168) (GIT-LONG-NAME 72170 . 72487)
|
||||
) (72519 75854 (GIT-MY-CURRENT-BRANCH 72529 . 72899) (GIT-MY-BRANCHP 72901 . 73406) (
|
||||
GIT-MY-NEXT-BRANCH 73408 . 73902) (GIT-MY-BRANCHES 73904 . 75852)) (75900 79852 (GIT-ADD-WORKTREE
|
||||
75910 . 77394) (GIT-REMOVE-WORKTREE 77396 . 78326) (GIT-LIST-WORKTREES 78328 . 79132) (WORKTREEDIR
|
||||
79134 . 79850)) (79900 111109 (GIT-GET-DIFFERENT-FILES 79910 . 86334) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 86336 . 92493) (GIT-WORKING-COMPARE-DIRECTORIES 92495 . 97321) (
|
||||
GIT-COMPARE-WORKTREE 97323 . 101301) (GITCDOBJBUTTONFN 101303 . 105793) (GIT-CD-LABELFN 105795 .
|
||||
106877) (GIT-CD-MENUFN 106879 . 109319) (GIT-WORKING-COMPARE-FILES 109321 . 109941) (
|
||||
GIT-BRANCHES-COMPARE-FILES 109943 . 111107)) (111179 119696 (CDGITDIR 111189 . 111749) (GIT-COMMAND
|
||||
111751 . 113309) (GITORIGIN 113311 . 114008) (GIT-INITIALS 114010 . 114314) (GIT-COMMAND-TO-FILE
|
||||
114316 . 117805) (PROCESS-COMMAND 117807 . 118420) (GIT-RESULT-TO-LINES 118422 . 119029) (STRIPLOCAL
|
||||
119031 . 119694)))))
|
||||
(FILEMAP (NIL (4053 20503 (GIT-CLONEP 4063 . 5326) (GIT-INIT 5328 . 5958) (GIT-MAKE-PROJECT 5960 .
|
||||
13561) (GIT-GET-PROJECT 13563 . 15488) (GIT-PUT-PROJECT-FIELD 15490 . 17131) (GIT-PROJECT-PATH 17133
|
||||
. 18177) (FIND-ANCESTOR-DIRECTORY 18179 . 18528) (GIT-FIND-CLONE 18530 . 19611) (GIT-MAINBRANCH 19613
|
||||
. 20008) (GIT-MAINBRANCH? 20010 . 20501)) (25911 28038 (PRC-COMMAND 25921 . 28036)) (28094 30882 (
|
||||
ALLSUBDIRS 28104 . 29390) (MEDLEYSUBDIRS 29392 . 30085) (GITSUBDIRS 30087 . 30880)) (30883 35673 (
|
||||
TOGIT 30893 . 32299) (FROMGIT 32301 . 33282) (GIT-DELETE-FILE 33284 . 34130) (MYMEDLEY-DELETE-FILES
|
||||
34132 . 35671)) (35674 38677 (MYMEDLEYSUBDIR 35684 . 36140) (GITSUBDIR 36142 . 36585) (STRIPDIR 36587
|
||||
. 36958) (STRIPHOST 36960 . 37200) (STRIPNAME 37202 . 37955) (STRIPWHERE 37957 . 38675)) (38678 40580
|
||||
(GFILE4MFILE 38688 . 39051) (MFILE4GFILE 39053 . 39622) (GIT-REPO-FILENAME 39624 . 40578)) (40629
|
||||
52459 (GIT-COMMIT 40639 . 41465) (GIT-PUSH 41467 . 42111) (GIT-PULL 42113 . 42725) (GIT-APPROVAL 42727
|
||||
. 43076) (GIT-GET-FILE 43078 . 45043) (GIT-FILE-EXISTS? 45045 . 45319) (GIT-REMOTE-UPDATE 45321 .
|
||||
46045) (GIT-REMOTE-ADD 46047 . 46354) (GIT-FILE-DATE 46356 . 47287) (GIT-FILE-HISTORY 47289 . 49223) (
|
||||
GIT-PRINT-FILE-HISTORY 49225 . 50275) (GIT-FETCH 50277 . 50449) (GIT-PR-BRANCHES 50451 . 52457)) (
|
||||
52489 63082 (GIT-BRANCH-DIFF 52499 . 58839) (GIT-COMMIT-DIFFS 58841 . 59394) (GIT-BRANCH-RELATIONS
|
||||
59396 . 63080)) (63127 76230 (GIT-BRANCH-NUM 63137 . 63710) (GIT-CHECKOUT 63712 . 64771) (
|
||||
GIT-WHICH-BRANCH 64773 . 65071) (GIT-MAKE-BRANCH 65073 . 67286) (GIT-BRANCHES 67288 . 69556) (
|
||||
GIT-BRANCH-EXISTS? 69558 . 70262) (GIT-PICK-BRANCH 70264 . 70754) (GIT-BRANCH-MENU 70756 . 71459) (
|
||||
GIT-PULL-REQUESTS 71461 . 73607) (GIT-SHORT-BRANCH-NAME 73609 . 73900) (GIT-LONG-NAME 73902 . 74219) (
|
||||
GIT-PRC-BRANCHES 74221 . 76228)) (76260 79595 (GIT-MY-CURRENT-BRANCH 76270 . 76640) (GIT-MY-BRANCHP
|
||||
76642 . 77147) (GIT-MY-NEXT-BRANCH 77149 . 77643) (GIT-MY-BRANCHES 77645 . 79593)) (79641 83593 (
|
||||
GIT-ADD-WORKTREE 79651 . 81135) (GIT-REMOVE-WORKTREE 81137 . 82067) (GIT-LIST-WORKTREES 82069 . 82873)
|
||||
(WORKTREEDIR 82875 . 83591)) (83641 115865 (GIT-GET-DIFFERENT-FILES 83651 . 90075) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 90077 . 96422) (GIT-WORKING-COMPARE-DIRECTORIES 96424 . 101848) (
|
||||
GIT-COMPARE-WORKTREE 101850 . 105828) (GITCDOBJBUTTONFN 105830 . 110320) (GIT-CD-LABELFN 110322 .
|
||||
111404) (GIT-CD-MENUFN 111406 . 113846) (GIT-WORKING-COMPARE-FILES 113848 . 114468) (
|
||||
GIT-BRANCHES-COMPARE-FILES 114470 . 115634) (GIT-PR-COMPARE 115636 . 115863)) (115935 123964 (CDGITDIR
|
||||
115945 . 116632) (GIT-COMMAND 116634 . 118192) (GITORIGIN 118194 . 118891) (GIT-INITIALS 118893 .
|
||||
119197) (GIT-COMMAND-TO-FILE 119199 . 122688) (GIT-RESULT-TO-LINES 122690 . 123297) (STRIPLOCAL 123299
|
||||
. 123962)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,16 +1,15 @@
|
||||
(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)
|
||||
(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)
|
||||
|
||||
(RPAQQ MANAGERCOMS
|
||||
@@ -52,11 +51,12 @@ Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation.
|
||||
(* ;; "")
|
||||
|
||||
(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-FILE-OPERATIONS-COMMANDS MANAGER-FILE-FILE-RELATION-COMMANDS
|
||||
MANAGER-MAIN-MENU-ITEMS MANAGER-ACTIVITY-WINDOW-TITLE BackgroundMenuCommands
|
||||
BackgroundMenu)
|
||||
MANAGER-MAIN-MENU-ITEMS MANAGER-ACTIVITY-WINDOW-TITLE MANAGER-MAIN-WINDOW
|
||||
MANAGER-MAIN-ICONW Manager.WINDOW-ANCHOR MANAGER.BM MANAGER.BM.MASK
|
||||
BackgroundMenuCommands BackgroundMenu)
|
||||
(VARS *UNMANAGED-TYPES* MANAGER-ACTIVITY-WINDOW-TITLE (MANAGER-CASES)
|
||||
(MANAGER-ADDTOFILES?)
|
||||
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)
|
||||
(INITVARS (Manager.ACTIVEFLG NIL)
|
||||
(Manager.SORTFILELSTFLG T)
|
||||
(Manager.WINDOW-ANCHOR 'ANCHOR-BL)
|
||||
(Manager.MENUROWS 20)
|
||||
(Manager.DATASPACE NIL)
|
||||
(MANAGER-WINDOWS 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-FILE-MENU NIL)
|
||||
(MANAGER-FILELST-MENU NIL)
|
||||
(MANAGER-FILE-OPERATIONS-MENU NIL)
|
||||
(MANAGER-FILE-FILE-RELATION-MENU NIL)
|
||||
(MANAGER-MARKED-SHADE BOLDMENUFONT))
|
||||
(FILES FILEBROWSER)
|
||||
(* ; "for SEE command")
|
||||
(FILES DATABASEFNS FILEBROWSER (FROM LISPUSERS)
|
||||
COMMON-MAKE)
|
||||
(* ; "FILEBROWSER for SEE command")
|
||||
(FNS MANAGER MANAGER.RESET Manager.ADDADV Manager.ADDTOFILES? Manager.ALTERMARKING
|
||||
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.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.SORT.COMS Manager.SORTBYCOLUMN)
|
||||
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))
|
||||
@@ -181,10 +186,11 @@ Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation.
|
||||
)
|
||||
(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-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))
|
||||
@@ -368,6 +374,12 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
("Edit FILELST" 'EDIT
|
||||
"Edit the variable which lists the files noticed by the file package")))
|
||||
("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
|
||||
"Shut down all manager windows"
|
||||
)
|
||||
@@ -385,6 +397,8 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
|
||||
(RPAQ? Manager.SORTFILELSTFLG T)
|
||||
|
||||
(RPAQ? Manager.WINDOW-ANCHOR 'ANCHOR-BL)
|
||||
|
||||
(RPAQ? Manager.MENUROWS 20)
|
||||
|
||||
(RPAQ? Manager.DATASPACE NIL)
|
||||
@@ -393,6 +407,9 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
|
||||
(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-FILE-MENU NIL)
|
||||
@@ -405,11 +422,12 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
|
||||
(RPAQ? MANAGER-MARKED-SHADE BOLDMENUFONT)
|
||||
|
||||
(FILESLOAD FILEBROWSER)
|
||||
(FILESLOAD DATABASEFNS FILEBROWSER (FROM LISPUSERS)
|
||||
COMMON-MAKE)
|
||||
|
||||
|
||||
|
||||
(* ; "for SEE command")
|
||||
(* ; "FILEBROWSER for SEE command")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -522,11 +540,30 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
(Manager.HIGHLIGHT ITEM MENU MARKING?))) finally (Manager.MAINUPDATE
|
||||
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
|
||||
[LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 15-Sep-2022 23:35 by Matt Heffron")
|
||||
(* ; "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")
|
||||
[LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "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.")
|
||||
)
|
||||
@@ -719,15 +756,22 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
(Manager.HIGHLIGHT FILE MENU)))
|
||||
else (* ; "single item")
|
||||
(UNMARKASCHANGED ITEM COMSTYPE)))
|
||||
(SEE (FB.FASTSEE.ONEFILE
|
||||
NIL FILE (LET [(W (CREATEW NIL (CONCAT "Seeing " FILE
|
||||
"..."]
|
||||
(DSPSCROLL 'ON W)
|
||||
(WINDOWPROP W 'PAGEFULLFN
|
||||
'FB.SEEFULLFN)
|
||||
(TTYDISPLAYSTREAM W)
|
||||
W)))
|
||||
(TEDIT-SEE (TEDIT-SEE FILE))
|
||||
(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)
|
||||
@@ -748,18 +792,20 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
then NIL
|
||||
else (LIST COMMAND]
|
||||
(printout T .FONT DEFAULTFONT T)))
|
||||
(COMMON-MAKEFILE
|
||||
(FILESLOAD 'COMMON-MAKEFILE)
|
||||
(if FILE
|
||||
then (printout T .FONT LAMBDAFONT
|
||||
"Writing CommonLisp source into " FILE
|
||||
".LSP" .FONT DEFAULTFONT T)
|
||||
(PRINT (USER::COMMON-MAKEFILE FILE)
|
||||
T)
|
||||
else (CL:FORMAT 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)
|
||||
@@ -821,68 +867,42 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
|
||||
(* ;; "DATABASEFNS stuff")
|
||||
|
||||
(DB
|
||||
(FILESLOAD 'DATABASEFNS)
|
||||
(CL:FORMAT T
|
||||
(DB (CL:FORMAT T
|
||||
"~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a"
|
||||
SAVEDBFLG LOADBFLG))
|
||||
SAVEDBFLG LOADDBFLG))
|
||||
(DBFILE
|
||||
(FILESLOAD 'DATABASEFNS)
|
||||
(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 LOADBFLG))
|
||||
SAVEDBFLG LOADDBFLG))
|
||||
(DBON
|
||||
(FILESLOAD 'DATABASEFNS)
|
||||
(SETQ LOADBFLG 'ON)
|
||||
(SETQ LOADDBFLG 'ON)
|
||||
(SETQ SAVEDBFLG 'ON))
|
||||
(DBOFF
|
||||
(FILESLOAD 'DATABASEFNS)
|
||||
(SETQ LOADBFLG 'OFF)
|
||||
(SETQ SAVEDBFLG 'OFF))
|
||||
(SETQ LOADDBFLG 'NO)
|
||||
(SETQ SAVEDBFLG 'NO))
|
||||
(DBASK
|
||||
(FILESLOAD 'DATABASEFNS)
|
||||
(SETQ LOADBFLG 'ASK)
|
||||
(SETQ LOADDBFLG 'ASK)
|
||||
(SETQ SAVEDBFLG 'ASK))
|
||||
(DBLOADON
|
||||
(FILESLOAD 'DATABASEFNS)
|
||||
(SETQ LOADBFLG 'ON))
|
||||
(DBSAVEON
|
||||
(FILESLOAD 'DATABASEFNS)
|
||||
(SETQ SAVEDBFLG 'ON))
|
||||
(DBLOADOFF
|
||||
(FILESLOAD 'DATABASEFNS)
|
||||
(SETQ LOADBFLG 'OFF))
|
||||
(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))
|
||||
(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)
|
||||
(FILESLOAD 'DATABASEFNS)
|
||||
(DUMPDB FILE))
|
||||
(LOADDB
|
||||
(printout T .FONT LAMBDAFONT
|
||||
"Loading the Masterscope Database for file " FILE
|
||||
.FONT DEFAULTFONT T)
|
||||
(FILESLOAD 'DATABASEFNS)
|
||||
(LOADDB FILE))
|
||||
(COMPILE
|
||||
(printout T .FONT LAMBDAFONT "Compiling..." .FONT
|
||||
@@ -1372,7 +1392,7 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
FILE])
|
||||
|
||||
(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.")
|
||||
|
||||
@@ -1387,31 +1407,30 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
|
||||
(ADDMENU MANAGER-FILE-MENU
|
||||
(SETQ MANAGER-MAIN-WINDOW
|
||||
(CREATEW (with POSITION
|
||||
(with MENU MANAGER-FILE-MENU (SETQ IW (MIN (WIDTHIFWINDOW IMAGEWIDTH)
|
||||
SCREENWIDTH))
|
||||
(CREATEW (with POSITION (with MENU MANAGER-FILE-MENU (SETQ IW (MIN (WIDTHIFWINDOW
|
||||
IMAGEWIDTH)
|
||||
SCREENWIDTH))
|
||||
(* ;
|
||||
"width of file menu. Actually unlikely to be wider than screenwidth (!)")
|
||||
(SETQ IH (MIN (HEIGHTIFWINDOW IMAGEHEIGHT T)
|
||||
SCREENHEIGHT))
|
||||
(SETQ IH (MIN (HEIGHTIFWINDOW IMAGEHEIGHT T)
|
||||
SCREENHEIGHT))
|
||||
(* ;
|
||||
"height of window; could possibly be higher than screen if lots of files")
|
||||
(if (POSITIONP POSITION)
|
||||
then (* ;
|
||||
(if (POSITIONP POSITION)
|
||||
then (* ;
|
||||
"gave an initial position for the manager file menu")
|
||||
POSITION
|
||||
elseif (WINDOWP MANAGER-MAIN-WINDOW)
|
||||
then (* ;
|
||||
POSITION
|
||||
elseif (WINDOWP MANAGER-MAIN-WINDOW)
|
||||
then (* ;
|
||||
"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
|
||||
'REGION)
|
||||
(create POSITION
|
||||
XCOORD _ LEFT
|
||||
YCOORD _ BOTTOM))
|
||||
(CLOSEW MANAGER-MAIN-WINDOW))
|
||||
else (* ;
|
||||
(PROG1 (Manager.ANCHORED-SET-POSITION IW IH)
|
||||
|
||||
(* ;; "(with REGION (WINDOWPROP MANAGER-MAIN-WINDOW (QUOTE REGION)) (create POSITION XCOORD _ LEFT YCOORD _ BOTTOM))")
|
||||
|
||||
(CLOSEW MANAGER-MAIN-WINDOW))
|
||||
else (* ;
|
||||
"let user say where to put the menu")
|
||||
(GETBOXPOSITION IW IH)))
|
||||
(GETBOXPOSITION IW IH)))
|
||||
(create REGION
|
||||
LEFT _ XCOORD
|
||||
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")
|
||||
|
||||
[WINDOWPROP MANAGER-MAIN-WINDOW 'ICONFN (FUNCTION (LAMBDA (WIN OICON)
|
||||
(LET ((IW (if (NULL OICON)
|
||||
then (ICONW MANAGER.BM
|
||||
MANAGER.BM.MASK
|
||||
)
|
||||
else OICON)))
|
||||
[WINDOWPROP IW 'EXPANDFN
|
||||
(FUNCTION (LAMBDA NIL
|
||||
(
|
||||
Manager.MAINUPDATE
|
||||
NIL]
|
||||
IW]
|
||||
(SETQ MANAGER-MAIN-ICONW
|
||||
(if (NULL OICON)
|
||||
then (OR MANAGER-MAIN-ICONW
|
||||
(ICONW MANAGER.BM
|
||||
MANAGER.BM.MASK))
|
||||
else OICON))
|
||||
[WINDOWPROP MANAGER-MAIN-ICONW
|
||||
'EXPANDFN
|
||||
(FUNCTION (LAMBDA NIL
|
||||
(Manager.MAINUPDATE
|
||||
NIL]
|
||||
MANAGER-MAIN-ICONW]
|
||||
(SETQ Manager.ACTIVEFLG T)
|
||||
(Manager.MAINUPDATE T])
|
||||
|
||||
@@ -1545,6 +1565,12 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
(CONCAT "Creates a " TYPE
|
||||
" 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
|
||||
[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 )
|
||||
)
|
||||
(PUTPROPS MANAGER COPYRIGHT ("Xerox Corporation" 1986 1987 1900 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (24415 101274 (MANAGER 24425 . 25224) (MANAGER.RESET 25226 . 26740) (Manager.ADDADV
|
||||
26742 . 28095) (Manager.ADDTOFILES? 28097 . 28375) (Manager.ALTERMARKING 28377 . 29987) (
|
||||
Manager.DO.COMMAND 29989 . 61755) (Manager.HIGHLIGHT 61757 . 62054) (Manager.PROMPT 62056 . 62369) (
|
||||
Manager.WINDOW 62371 . 63004) (Manager.insurefilehighlights 63006 . 64077) (Manager.CHANGED? 64079 .
|
||||
64628) (Manager.CHECKFILE 64630 . 65729) (Manager.COLLECTCOMS 65731 . 67169) (Manager.COMS.WSF 67171
|
||||
. 69841) (Manager.COMSOPEN 69843 . 74581) (Manager.COMSUPDATE 74583 . 75675) (Manager.HIGHLIGHTED
|
||||
75677 . 75983) (Manager.INSUREHIGHLIGHTS 75985 . 76543) (Manager.FILECHANGES 76545 . 76844) (
|
||||
Manager.FILELSTCHANGED? 76846 . 77174) (Manager.FILESUBTYPES 77176 . 77814) (Manager.GET.ENVIRONMENT
|
||||
77816 . 80354) (Manager.GETFILE 80356 . 82670) (Manager.INTITLE? 82672 . 83350) (Manager.MAIN.WSF
|
||||
83352 . 85996) (Manager.MAINCLOSE 85998 . 87108) (Manager.MAINMENUITEMS 87110 . 88187) (
|
||||
Manager.MAINOPEN 88189 . 93565) (Manager.MAINUPDATE 93567 . 94203) (Manager.MAKEFILE.ADV 94205 . 95241
|
||||
) (Manager.MENUCOLUMNS 95243 . 96047) (Manager.MENUHASITEM 96049 . 96406) (Manager.MENUITEMS 96408 .
|
||||
96653) (Manager.REMOVE.DUPLICATE.ADVICE 96655 . 98261) (Manager.RESETSUBITEMS 98263 . 99500) (
|
||||
Manager.SORT.COMS 99502 . 100034) (Manager.SORTBYCOLUMN 100036 . 101272)))))
|
||||
(FILEMAP (NIL (25676 102848 (MANAGER 25686 . 26485) (MANAGER.RESET 26487 . 28001) (Manager.ADDADV
|
||||
28003 . 29356) (Manager.ADDTOFILES? 29358 . 29636) (Manager.ALTERMARKING 29638 . 31248) (
|
||||
Manager.ANCHORED-SET-POSITION 31250 . 32353) (Manager.DO.COMMAND 32355 . 62991) (Manager.HIGHLIGHT
|
||||
62993 . 63290) (Manager.PROMPT 63292 . 63605) (Manager.WINDOW 63607 . 64240) (
|
||||
Manager.insurefilehighlights 64242 . 65313) (Manager.CHANGED? 65315 . 65864) (Manager.CHECKFILE 65866
|
||||
. 66965) (Manager.COLLECTCOMS 66967 . 68405) (Manager.COMS.WSF 68407 . 71077) (Manager.COMSOPEN 71079
|
||||
. 75817) (Manager.COMSUPDATE 75819 . 76911) (Manager.HIGHLIGHTED 76913 . 77219) (
|
||||
Manager.INSUREHIGHLIGHTS 77221 . 77779) (Manager.FILECHANGES 77781 . 78080) (Manager.FILELSTCHANGED?
|
||||
78082 . 78410) (Manager.FILESUBTYPES 78412 . 79050) (Manager.GET.ENVIRONMENT 79052 . 81590) (
|
||||
Manager.GETFILE 81592 . 83906) (Manager.INTITLE? 83908 . 84586) (Manager.MAIN.WSF 84588 . 87232) (
|
||||
Manager.MAINCLOSE 87234 . 88344) (Manager.MAINMENUITEMS 88346 . 89423) (Manager.MAINOPEN 89425 . 94818
|
||||
) (Manager.MAINUPDATE 94820 . 95456) (Manager.MAKEFILE.ADV 95458 . 96494) (Manager.MENUCOLUMNS 96496
|
||||
. 97300) (Manager.MENUHASITEM 97302 . 97659) (Manager.MENUITEMS 97661 . 97906) (
|
||||
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
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,14 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Jul-2023 09:17:48" {WMEDLEY}<lispusers>PSEUDOHOSTS.;153 27674
|
||||
(FILECREATED "22-Sep-2023 15:29:50" {WMEDLEY}<lispusers>PSEUDOHOSTS.;158 26638
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE)
|
||||
(MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL)
|
||||
:CHANGES-TO (FNS PSEUDOHOST SLASHIT CONTRACT.PH)
|
||||
(VARS PSEUDOHOSTSCOMS)
|
||||
|
||||
:PREVIOUS-DATE "18-Jul-2023 13:12:35" {WMEDLEY}<lispusers>PSEUDOHOSTS.;152)
|
||||
:PREVIOUS-DATE "26-Jul-2023 12:34:37" {WMEDLEY}<lispusers>PSEUDOHOSTS.;155)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PSEUDOHOSTSCOMS)
|
||||
@@ -21,7 +20,7 @@
|
||||
|
||||
(* ;; "Internals")
|
||||
|
||||
(FNS EXPAND.PH CONTRACT.PH SLASHIT UNSLASHIT GETHOSTINFO.PH)
|
||||
(FNS EXPAND.PH CONTRACT.PH UNSLASHIT GETHOSTINFO.PH)
|
||||
(FNS OPENFILE.PH GETFILENAME.PH DIRECTORYNAMEP.PH CLOSEFILE.PH REOPENFILE.PH DELETEFILE.PH
|
||||
OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH
|
||||
SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH)
|
||||
@@ -42,6 +41,8 @@
|
||||
(PSEUDOHOST
|
||||
[LAMBDA (HOST PREFIX)
|
||||
|
||||
(* ;; "Edited 22-Sep-2023 15:29 by rmk")
|
||||
|
||||
(* ;; "Edited 25-Jun-2022 17:00 by rmk")
|
||||
|
||||
(* ;; "Edited 24-Feb-2022 23:56 by rmk: Expand prefix so that it is rooted in a real host and not a previously defined pseudohost.")
|
||||
@@ -81,7 +82,7 @@
|
||||
(SELECTQ TARGETHOST
|
||||
((DSK CORE)
|
||||
(SETQ PREFIX (UNSLASHIT PREFIX)))
|
||||
(UNIX (SETQ PREFIX (SLASHIT PREFIX)))
|
||||
(UNIX (SETQ PREFIX (SLASHIT PREFIX)))
|
||||
NIL)
|
||||
(SETQ TARGETDEVICE (OR (\GETDEVICEFROMHOSTNAME TARGETHOST)
|
||||
(ERROR "UNKNOWN TARGET HOST" TARGETHOST)))
|
||||
@@ -153,26 +154,32 @@
|
||||
(FETCH (FDEV DEVICENAME) OF (FETCH (PHDEVICE TARGETDEV) OF (\GETDEVICEFROMNAME HOST))))])
|
||||
|
||||
(TRUEFILENAME
|
||||
[LAMBDA (FILE) (* ; "Edited 26-Jan-2022 23:33 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 26-Jul-2023 07:53 by rmk")
|
||||
(* ; "Edited 26-Jan-2022 23:33 by rmk")
|
||||
(* ; "Edited 25-Jan-2022 08:47 by rmk")
|
||||
(LET (FILENAME DEVICE)
|
||||
(IF (STREAMP FILE)
|
||||
THEN (SETQ FILENAME (FETCH (STREAM FULLFILENAME) OF FILE))
|
||||
(SETQ DEVICE (FETCH (STREAM DEVICE) OF FILE))
|
||||
ELSE (SETQ FILENAME (\ADD.CONNECTED.DIR FILE))
|
||||
(SETQ DEVICE (\GETDEVICEFROMNAME FILENAME)))
|
||||
(CL:IF (TYPE? PHDEVICE DEVICE)
|
||||
(EXPAND.PH FILENAME DEVICE)
|
||||
FILENAME)])
|
||||
(if (LISTP FILE)
|
||||
then (for F in FILE collect (TRUEFILENAME F))
|
||||
else (LET (FILENAME DEVICE)
|
||||
(IF (STREAMP FILE)
|
||||
THEN (SETQ FILENAME (FETCH (STREAM FULLFILENAME) OF FILE))
|
||||
(SETQ DEVICE (FETCH (STREAM DEVICE) OF FILE))
|
||||
ELSE (SETQ FILENAME (\ADD.CONNECTED.DIR FILE))
|
||||
(SETQ DEVICE (\GETDEVICEFROMNAME FILENAME)))
|
||||
(CL:IF (TYPE? PHDEVICE DEVICE)
|
||||
(EXPAND.PH FILENAME DEVICE)
|
||||
FILENAME)])
|
||||
|
||||
(PSEUDOFILENAME
|
||||
[LAMBDA (FILE) (* ; "Edited 29-Jan-2022 23:08 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 26-Jul-2023 12:34 by rmk")
|
||||
(* ; "Edited 29-Jan-2022 23:08 by rmk")
|
||||
(* ; "Edited 28-Jan-2022 09:06 by rmk")
|
||||
(FOR D PN (FILENAME _ (IF (STREAMP FILE)
|
||||
THEN (FETCH (STREAM FULLFILENAME) OF FILE)
|
||||
ELSE (\ADD.CONNECTED.DIR FILE))) IN \FILEDEVICES
|
||||
WHEN (TYPE? PHDEVICE D) UNLESS (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D)))
|
||||
DO (RETURN PN) FINALLY (RETURN FILENAME])
|
||||
(if (LISTP FILE)
|
||||
then (for F in FILE collect (PSEUDOFILENAME F))
|
||||
else (FOR D PN (FILENAME _ (IF (STREAMP FILE)
|
||||
THEN (FETCH (STREAM FULLFILENAME) OF FILE)
|
||||
ELSE (\ADD.CONNECTED.DIR FILE))) IN \FILEDEVICES
|
||||
WHEN (TYPE? PHDEVICE D) UNLESS (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D)))
|
||||
DO (RETURN PN) FINALLY (RETURN FILENAME])
|
||||
)
|
||||
|
||||
|
||||
@@ -209,6 +216,8 @@
|
||||
(CONTRACT.PH
|
||||
[LAMBDA (NAME PHDEV)
|
||||
|
||||
(* ;; "Edited 22-Sep-2023 14:30 by rmk")
|
||||
|
||||
(* ;; "Edited 30-Jan-2022 00:20 by rmk: the smallest pseudoname for NAME. If the NAME was constructed by expanding, then")
|
||||
|
||||
(* ;; "Finds the smallest pseudoname for NAME. The PHDEV is used only to find its targetdev, that's where we scan for matching prefixes. This is so we can find the lowest matching pseudohost in the target's prefix map. If the hosts are defined as {DSK}...{H1}...{H2}, DSK knows the prefixes that lead to H1 and H2, picks the longest matching prefix and replaces it by the corresponding host.")
|
||||
@@ -234,7 +243,7 @@
|
||||
|
||||
(SETQ CONNECTOR (CADDR PM))
|
||||
[SETQ SUFFIX (CONCAT CONNECTOR (IF (EQ CONNECTOR '/)
|
||||
THEN (SLASHIT SUFFIX)
|
||||
THEN (SLASHIT SUFFIX)
|
||||
ELSE (UNSLASHIT SUFFIX])
|
||||
(RETURN (PACK* '{ (CADR PM)
|
||||
"}"
|
||||
@@ -244,31 +253,6 @@
|
||||
|
||||
(RETURN NAME)))])
|
||||
|
||||
(SLASHIT
|
||||
[LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:08 by rmk")
|
||||
(* ; "Edited 3-Jan-2022 11:44 by rmk")
|
||||
(* ; "Edited 22-Dec-2021 20:18 by rmk")
|
||||
(* ; "Edited 2-Nov-2021 22:54 by rmk:")
|
||||
(LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X)
|
||||
0]
|
||||
[SETQ SLASHED (CONCATCODES (FOR I C FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I))
|
||||
COLLECT (SELCHARQ C
|
||||
((< >)
|
||||
(SETQ LASTDIRPOS I)
|
||||
(CHARCODE /))
|
||||
(/ (SETQ LASTDIRPOS I)
|
||||
C)
|
||||
C]
|
||||
(CL:WHEN (AND LCASEDIRS LASTDIRPOS)
|
||||
(SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS)))
|
||||
(SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS))
|
||||
(OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS))
|
||||
""))))
|
||||
(CL:IF (EQ DIRPOS 1)
|
||||
SLASHED
|
||||
(CONCAT (SUBSTRING X 1 (SUB1 DIRPOS))
|
||||
SLASHED))])
|
||||
|
||||
(UNSLASHIT
|
||||
[LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:09 by rmk")
|
||||
(* ; "Edited 22-Dec-2021 20:18 by rmk")
|
||||
@@ -527,13 +511,12 @@
|
||||
EXPORTS.ALL)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1397 9433 (PSEUDOHOST 1407 . 6966) (PSEUDOHOSTP 6968 . 7481) (PSEUDOHOSTS 7483 . 7844)
|
||||
(TARGETHOST 7846 . 8120) (TRUEFILENAME 8122 . 8809) (PSEUDOFILENAME 8811 . 9431)) (9461 17000 (
|
||||
EXPAND.PH 9471 . 10724) (CONTRACT.PH 10726 . 13391) (SLASHIT 13393 . 14961) (UNSLASHIT 14963 . 16709)
|
||||
(GETHOSTINFO.PH 16711 . 16998)) (17001 25021 (OPENFILE.PH 17011 . 18084) (GETFILENAME.PH 18086 . 18375
|
||||
) (DIRECTORYNAMEP.PH 18377 . 19001) (CLOSEFILE.PH 19003 . 19470) (REOPENFILE.PH 19472 . 20037) (
|
||||
DELETEFILE.PH 20039 . 20323) (OPENP.PH 20325 . 20620) (UNREGISTERFILE.PH 20622 . 21164) (
|
||||
REGISTERFILE.PH 21166 . 21700) (GENERATEFILES.PH 21702 . 22746) (GETFILEINFO.PH 22748 . 23050) (
|
||||
SETFILEINFO.PH 23052 . 23251) (NEXTFILEFN.PH 23253 . 23799) (FILEINFOFN.PH 23801 . 24076) (
|
||||
RENAMEFILE.PH 24078 . 25019)))))
|
||||
(FILEMAP (NIL (1315 9921 (PSEUDOHOST 1325 . 6930) (PSEUDOHOSTP 6932 . 7445) (PSEUDOHOSTS 7447 . 7808)
|
||||
(TARGETHOST 7810 . 8084) (TRUEFILENAME 8086 . 9048) (PSEUDOFILENAME 9050 . 9919)) (9949 15964 (
|
||||
EXPAND.PH 9959 . 11212) (CONTRACT.PH 11214 . 13925) (UNSLASHIT 13927 . 15673) (GETHOSTINFO.PH 15675 .
|
||||
15962)) (15965 23985 (OPENFILE.PH 15975 . 17048) (GETFILENAME.PH 17050 . 17339) (DIRECTORYNAMEP.PH
|
||||
17341 . 17965) (CLOSEFILE.PH 17967 . 18434) (REOPENFILE.PH 18436 . 19001) (DELETEFILE.PH 19003 . 19287
|
||||
) (OPENP.PH 19289 . 19584) (UNREGISTERFILE.PH 19586 . 20128) (REGISTERFILE.PH 20130 . 20664) (
|
||||
GENERATEFILES.PH 20666 . 21710) (GETFILEINFO.PH 21712 . 22014) (SETFILEINFO.PH 22016 . 22215) (
|
||||
NEXTFILEFN.PH 22217 . 22763) (FILEINFOFN.PH 22765 . 23040) (RENAMEFILE.PH 23042 . 23983)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,3 +1,3 @@
|
||||
@echo off
|
||||
powershell medley.ps1 %*
|
||||
|
||||
@echo off
|
||||
powershell medley.ps1 %*
|
||||
|
||||
|
||||
@@ -57,8 +57,7 @@ export MEDLEYDIR=$(cd ${SCRIPTDIR}; cd ../..; pwd)
|
||||
IL_DIR=$(cd ${MEDLEYDIR}; cd ..; pwd)
|
||||
export LOGINDIR=${HOME}/il
|
||||
|
||||
# Are we running under Docker or if not under WSL
|
||||
# or under Darwin?
|
||||
# Are we running under Docker or WSL or Darwin or Cygwin?
|
||||
#
|
||||
docker=false
|
||||
wsl=false
|
||||
@@ -70,7 +69,8 @@ then
|
||||
elif [ -n "${MEDLEY_DOCKER_BUILD_DATE}" ];
|
||||
then
|
||||
docker='true'
|
||||
else
|
||||
elif [ $(uname -s | head --bytes 6) != "CYGWIN" ];
|
||||
then
|
||||
wsl_ver=0
|
||||
# WSL2
|
||||
grep --ignore-case --quiet wsl /proc/sys/kernel/osrelease
|
||||
@@ -93,8 +93,6 @@ else
|
||||
echo "Exiting"
|
||||
exit 23
|
||||
fi
|
||||
else
|
||||
wsl='false'
|
||||
fi
|
||||
fi
|
||||
fi
|
||||
|
||||
@@ -97,7 +97,7 @@ check_file_readable() {
|
||||
|
||||
check_dir_writeable_or_creatable() {
|
||||
local msg_core="\"$2\" given as the value of the \"$1\" flag"
|
||||
if [[ -e "$%2" ]];
|
||||
if [[ -e "$2" ]];
|
||||
then
|
||||
if [[ ! -d "$2" ]];
|
||||
then
|
||||
|
||||
141
sources/HARDCOPY
141
sources/HARDCOPY
@@ -1,10 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "18-Oct-2022 18:47:42" {DSK}<home>larry>ilisp>medley>sources>HARDCOPY.;2 103854
|
||||
(FILECREATED "22-Jun-2023 17:31:38" {WMEDLEY}<sources>HARDCOPY.;11 104907
|
||||
|
||||
:CHANGES-TO (FNS HARDCOPYIMAGEW.TOPRINTER)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "20-Jul-2022 17:14:14" {DSK}<home>larry>ilisp>medley>sources>HARDCOPY.;1)
|
||||
:CHANGES-TO (FNS MakeMenuOfPrinters)
|
||||
|
||||
:PREVIOUS-DATE " 3-Mar-2023 23:49:09" {WMEDLEY}<sources>HARDCOPY.;10)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -46,7 +48,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
|
||||
(INITVARS (TEXTDEFAULTTABS (LIST 20320))
|
||||
(TEXTDEFAULTPAGEREGION (CREATEREGION 2794 1905 18415 24765)))
|
||||
(* ;
|
||||
"TEXTDEFAULTTABS Hack, mica equivalent of 8 inches")
|
||||
"TEXTDEFAULTTABS Hack, mica equivalent of 8 inches. NOT USED ANYWHERE")
|
||||
(GLOBALVARS TEXTDEFAULTTABS TEXTDEFAULTPAGEREGION)
|
||||
(FNS TEXTTOIMAGEFILE COPY.TEXT.TO.IMAGE))
|
||||
(COMS (FNS \BLTSHADE.GENERICPRINTER)
|
||||
@@ -62,7 +64,9 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
|
||||
\HDCPYDSPPRINTCHAR \SLOWHDCPYBLTCHAR \CHANGECHARSET.HDCPYDISPLAY)
|
||||
[DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (CONSTANTS (MICASPERPT (FQUOTIENT 2540 72))
|
||||
(IHALFMICASPERPT 17)
|
||||
(IMICASPERPT 35]
|
||||
(IMICASPERPT 35)
|
||||
(DEFAULTTAB 36]
|
||||
(* ; "screen-points: 1/2 inch")
|
||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (FUNCTIONS \MICASTOPTS)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\HDCPYDISPLAYINIT]
|
||||
[COMS (* ;
|
||||
@@ -168,20 +172,24 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(MakeMenuOfPrinters
|
||||
[LAMBDA (MENUTITLE) (* ; "Edited 29-May-93 14:18 by rmk:")
|
||||
(* ; "Edited 11-Jul-90 13:35 by jds")
|
||||
[LAMBDA (MENUTITLE) (* ; "Edited 22-Jun-2023 17:30 by rmk")
|
||||
(* ; "Edited 29-May-93 14:18 by rmk:")
|
||||
(* ; "Edited 11-Jul-90 13:35 by jds")
|
||||
(DECLARE (GLOBALVARS DEFAULTPRINTINGHOST))
|
||||
(CREATE MENU
|
||||
ITEMS _ (APPEND (FOR P INSIDE DEFAULTPRINTINGHOST
|
||||
COLLECT (LIST (COND
|
||||
((LISTP P)
|
||||
(IF (CADDR P)
|
||||
THEN (CONCAT (CADR P)
|
||||
" "
|
||||
(CADDR P))
|
||||
ELSE (CADR P)))
|
||||
(T P))
|
||||
(KWOTE P)))
|
||||
((LISTP P)
|
||||
(IF (CADDR P)
|
||||
THEN (CONCAT (CADR P)
|
||||
" "
|
||||
(CADDR P))
|
||||
ELSE (CADR P)))
|
||||
(T (CL:IF (OR (NULL P)
|
||||
(ZEROP (NCHARS P)))
|
||||
"(Default printer)"
|
||||
P)))
|
||||
(KWOTE P)))
|
||||
(LIST (LIST "Other..." (KWOTE 'OTHER)
|
||||
"You will be prompted for a printer")))
|
||||
TITLE _ MENUTITLE
|
||||
@@ -686,7 +694,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
|
||||
|
||||
|
||||
|
||||
(* ; "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches")
|
||||
(* ; "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches. NOT USED ANYWHERE")
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -729,7 +737,8 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
|
||||
(CLOSEF IMAGESTREAM])])
|
||||
|
||||
(COPY.TEXT.TO.IMAGE
|
||||
[LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 20-Jul-2022 17:14 by rmk")
|
||||
[LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 3-Mar-2023 23:46 by rmk")
|
||||
(* ; "Edited 20-Jul-2022 17:14 by rmk")
|
||||
(* ; "Edited 8-Oct-2021 22:23 by rmk:")
|
||||
(* ; "Edited 10-Apr-95 21:23 by rmk:")
|
||||
|
||||
@@ -741,7 +750,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
|
||||
(FONTARRAY (FONTMAPARRAY FONTS))
|
||||
(MAXFONT (ARRAYSIZE FONTARRAY))
|
||||
(INSTRM (GETSTREAM INFILE 'INPUT))
|
||||
DEFAULTTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP]
|
||||
DEFTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP]
|
||||
|
||||
(* ;;
|
||||
"RMK: EOS function changed to NILL from ZERO. 0 in low-order bits is OK in UNICODE, when we switch")
|
||||
@@ -775,17 +784,19 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
|
||||
(\OUTCHAR IMAGESTREAM (CHARCODE ^T))
|
||||
(RETURN))
|
||||
|
||||
(* ;; "TEXTDEFAULTTABS is a hack, since it depends on the units of the stream. Should really be a property of the stream or imagetype, or defined in terms of standard scale")
|
||||
(* ;; "DEFAULTTAB is now a constant defined here as 36 = 1/2 inch. Maybe that should be scaled by the stream's scale factor vis a vis points, not related to the current font. If you are tabbing for alignment, you wouldn't want it to be ragged based on what font one line is in compare to another. TEXTDEFAULTTAB is a hack that should be removed.")
|
||||
|
||||
[SETQ FC
|
||||
(IF TABS
|
||||
THEN (OR (CAR (NTH TABS FC))
|
||||
(ERROR "Undefined absolute tab number" FC))
|
||||
ELSE (TIMES FC (OR DEFAULTTAB
|
||||
(SETQ DEFAULTTAB
|
||||
(TIMES 8 (CHARWIDTH (CHARCODE SPACE)
|
||||
(FONTCREATE (ELT FONTARRAY 1)
|
||||
NIL NIL NIL IMAGESTREAM]
|
||||
ELSE (TIMES FC (OR DEFTAB (SETQ DEFTAB
|
||||
(TIMES 8
|
||||
(CHARWIDTH (CHARCODE SPACE)
|
||||
(FONTCREATE (ELT FONTARRAY
|
||||
1)
|
||||
NIL NIL NIL
|
||||
IMAGESTREAM]
|
||||
(DSPXPOSITION FC IMAGESTREAM))
|
||||
(NIL (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
|
||||
(* ; "EOS after ^F")
|
||||
@@ -912,15 +923,23 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
|
||||
|
||||
(RPAQQ IMICASPERPT 35)
|
||||
|
||||
(RPAQQ DEFAULTTAB 36)
|
||||
|
||||
|
||||
(CONSTANTS (MICASPERPT (FQUOTIENT 2540 72))
|
||||
(IHALFMICASPERPT 17)
|
||||
(IMICASPERPT 35))
|
||||
(IMICASPERPT 35)
|
||||
(DEFAULTTAB 36))
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ; "screen-points: 1/2 inch")
|
||||
|
||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")
|
||||
(DEFMACRO \MICASTOPTS (MICAS)
|
||||
@@ -1083,40 +1102,40 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
|
||||
(PUTPROPS HARDCOPY COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1992
|
||||
1993 1999 2018 2021 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6168 10934 (HARDCOPY.SOMEHOW 6178 . 7536) (HARDCOPYIMAGEW 7538 . 7690) (
|
||||
HARDCOPYIMAGEW.TOFILE 7692 . 8000) (HARDCOPYIMAGEW.TOPRINTER 8002 . 9249) (HARDCOPYREGION.TOFILE 9251
|
||||
. 9549) (HARDCOPYREGION.TOPRINTER 9551 . 10173) (COPY.WINDOW.TO.BITMAP 10175 . 10932)) (11006 21556 (
|
||||
MakeMenuOfPrinters 11016 . 12241) (PRINTERS.WHENSELECTEDFN 12243 . 13985) (MakeMenuOfImageTypes 13987
|
||||
. 14505) (GetNewPrinterFromUser 14507 . 14935) (PopUpWindowAndGetAtom 14937 . 16322) (
|
||||
PopUpWindowAndGetList 16324 . 17890) (NewPrinter 17892 . 18840) (GetPrinterName 18842 . 19122) (
|
||||
GetImageFile 19124 . 21411) (FetchDefaultPrinter 21413 . 21554)) (21591 22129 (
|
||||
ExtensionForPrintFileType 21601 . 21794) (PRINTFILETYPE.FROM.EXTENSION 21796 . 22127)) (22184 38568 (
|
||||
DEFAULTPRINTER 22194 . 22354) (CAN.PRINT.DIRECTLY 22356 . 22512) (CONVERT.FILE.TO.TYPE.FOR.PRINTER
|
||||
22514 . 23558) (EMPRESS 23560 . 23873) (HARDCOPYW 23875 . 26835) (LISTFILES1 26837 . 27010) (
|
||||
PRINTER.BITMAPFILE 27012 . 27259) (PRINTER.BITMAPSCALE 27261 . 27526) (PRINTER.SCRATCH.FILE 27528 .
|
||||
27651) (PRINTERPROP 27653 . 27836) (PRINTERSTATUS 27838 . 28027) (PRINTERTYPE 28029 . 30338) (
|
||||
PRINTERNAME 30340 . 30642) (PRINTFILEPROP 30644 . 30835) (PRINTFILETYPE 30837 . 32781) (
|
||||
\EXPECTED.FILE.TYPE 32783 . 33565) (SEND.FILE.TO.PRINTER 33567 . 38566)) (38569 43551 (PRINTERDEVICE
|
||||
38579 . 43549)) (44366 52124 (TEXTTOIMAGEFILE 44376 . 46566) (COPY.TEXT.TO.IMAGE 46568 . 52122)) (
|
||||
52125 53260 (\BLTSHADE.GENERICPRINTER 52135 . 53258)) (53388 72140 (MAKEHARDCOPYSTREAM 53398 . 54402)
|
||||
(UNMAKEHARDCOPYSTREAM 54404 . 55088) (HARDCOPYSTREAMTYPE 55090 . 55369) (\CHARWIDTH.HDCPYDISPLAY 55371
|
||||
. 55802) (\DSPFONT.HDCPYDISPLAY 55804 . 57209) (\DSPRIGHTMARGIN.HDCPYDISPLAY 57211 . 57788) (
|
||||
\DSPXPOSITION.HDCPYDISPLAY 57790 . 58051) (\DSPYPOSITION.HDCPYDISPLAY 58053 . 58314) (
|
||||
\STRINGWIDTH.HDCPYDISPLAY 58316 . 58823) (\STRINGWIDTH.HCPYDISPLAYAUX 58825 . 61157) (\HDCPYBLTCHAR
|
||||
61159 . 63694) (\HDCPYDISPLAY.FIX.XPOS 63696 . 64116) (\HDCPYDISPLAY.FIX.YPOS 64118 . 64538) (
|
||||
\HDCPYDISPLAYINIT 64540 . 65317) (\HDCPYDSPPRINTCHAR 65319 . 67479) (\SLOWHDCPYBLTCHAR 67481 . 70984)
|
||||
(\CHANGECHARSET.HDCPYDISPLAY 70986 . 72138)) (72550 72691 (\MICASTOPTS 72550 . 72691)) (72862 103159 (
|
||||
MAKEHARDCOPYMODESTREAM 72872 . 74781) (UNMAKEHARDCOPYMODESTREAM 74783 . 75861) (\BLTSHADE.HCPYMODE
|
||||
75863 . 76310) (\BITBLT.HCPYMODE 76312 . 76934) (\BRUSHCONVERT.HCPYMODE 76936 . 77173) (
|
||||
\CHANGECHARSET.HCPYMODE 77175 . 78942) (\DASHINGCONVERT.HCPYMODE 78944 . 79207) (\CHARWIDTH.HCPYMODE
|
||||
79209 . 79496) (\DRAWLINE.HCPYMODE 79498 . 79810) (\DRAWCURVE.HCPYMODE 79812 . 80241) (
|
||||
\DRAWCIRCLE.HCPYMODE 80243 . 80638) (\DRAWELLIPSE.HCPYMODE 80640 . 81152) (\DSPFONT.HCPYMODE 81154 .
|
||||
82310) (\DSPLEFTMARGIN.HCPYMODE 82312 . 82896) (\DSPLINEFEED.HCPYMODE 82898 . 83308) (
|
||||
\DSPRIGHTMARGIN.HCPYMODE 83310 . 83939) (\DSPSPACEFACTOR.HCPYMODE 83941 . 84462) (
|
||||
\DSPXPOSITION.HCPYMODE 84464 . 85045) (\DSPYPOSITION.HCPYMODE 85047 . 85452) (\MOVETO.HCPYMODE 85454
|
||||
. 85606) (\FONTCREATE.HCPYMODE.PRESS 85608 . 86620) (\CREATECHARSET.HCPYMODE.PRESS 86622 . 87593) (
|
||||
\FONTCREATE.HCPYMODE.INTERPRESS 87595 . 88629) (\CREATECHARSET.HCPYMODE.INTERPRESS 88631 . 89619) (
|
||||
\STRINGWIDTH.HCPYMODE 89621 . 90055) (\HCPYMODEBLTCHAR 90057 . 93026) (\HCPYMODEDISPLAYINIT 93028 .
|
||||
95959) (\HCPYMODEDSPPRINTCHAR 95961 . 98142) (\SLOWHCPYMODEBLTCHAR 98144 . 101658) (\SFFixY.HCPYMODE
|
||||
101660 . 103157)))))
|
||||
(FILEMAP (NIL (6322 11088 (HARDCOPY.SOMEHOW 6332 . 7690) (HARDCOPYIMAGEW 7692 . 7844) (
|
||||
HARDCOPYIMAGEW.TOFILE 7846 . 8154) (HARDCOPYIMAGEW.TOPRINTER 8156 . 9403) (HARDCOPYREGION.TOFILE 9405
|
||||
. 9703) (HARDCOPYREGION.TOPRINTER 9705 . 10327) (COPY.WINDOW.TO.BITMAP 10329 . 11086)) (11160 22017 (
|
||||
MakeMenuOfPrinters 11170 . 12702) (PRINTERS.WHENSELECTEDFN 12704 . 14446) (MakeMenuOfImageTypes 14448
|
||||
. 14966) (GetNewPrinterFromUser 14968 . 15396) (PopUpWindowAndGetAtom 15398 . 16783) (
|
||||
PopUpWindowAndGetList 16785 . 18351) (NewPrinter 18353 . 19301) (GetPrinterName 19303 . 19583) (
|
||||
GetImageFile 19585 . 21872) (FetchDefaultPrinter 21874 . 22015)) (22052 22590 (
|
||||
ExtensionForPrintFileType 22062 . 22255) (PRINTFILETYPE.FROM.EXTENSION 22257 . 22588)) (22645 39029 (
|
||||
DEFAULTPRINTER 22655 . 22815) (CAN.PRINT.DIRECTLY 22817 . 22973) (CONVERT.FILE.TO.TYPE.FOR.PRINTER
|
||||
22975 . 24019) (EMPRESS 24021 . 24334) (HARDCOPYW 24336 . 27296) (LISTFILES1 27298 . 27471) (
|
||||
PRINTER.BITMAPFILE 27473 . 27720) (PRINTER.BITMAPSCALE 27722 . 27987) (PRINTER.SCRATCH.FILE 27989 .
|
||||
28112) (PRINTERPROP 28114 . 28297) (PRINTERSTATUS 28299 . 28488) (PRINTERTYPE 28490 . 30799) (
|
||||
PRINTERNAME 30801 . 31103) (PRINTFILEPROP 31105 . 31296) (PRINTFILETYPE 31298 . 33242) (
|
||||
\EXPECTED.FILE.TYPE 33244 . 34026) (SEND.FILE.TO.PRINTER 34028 . 39027)) (39030 44012 (PRINTERDEVICE
|
||||
39040 . 44010)) (44847 53086 (TEXTTOIMAGEFILE 44857 . 47047) (COPY.TEXT.TO.IMAGE 47049 . 53084)) (
|
||||
53087 54222 (\BLTSHADE.GENERICPRINTER 53097 . 54220)) (54350 73102 (MAKEHARDCOPYSTREAM 54360 . 55364)
|
||||
(UNMAKEHARDCOPYSTREAM 55366 . 56050) (HARDCOPYSTREAMTYPE 56052 . 56331) (\CHARWIDTH.HDCPYDISPLAY 56333
|
||||
. 56764) (\DSPFONT.HDCPYDISPLAY 56766 . 58171) (\DSPRIGHTMARGIN.HDCPYDISPLAY 58173 . 58750) (
|
||||
\DSPXPOSITION.HDCPYDISPLAY 58752 . 59013) (\DSPYPOSITION.HDCPYDISPLAY 59015 . 59276) (
|
||||
\STRINGWIDTH.HDCPYDISPLAY 59278 . 59785) (\STRINGWIDTH.HCPYDISPLAYAUX 59787 . 62119) (\HDCPYBLTCHAR
|
||||
62121 . 64656) (\HDCPYDISPLAY.FIX.XPOS 64658 . 65078) (\HDCPYDISPLAY.FIX.YPOS 65080 . 65500) (
|
||||
\HDCPYDISPLAYINIT 65502 . 66279) (\HDCPYDSPPRINTCHAR 66281 . 68441) (\SLOWHDCPYBLTCHAR 68443 . 71946)
|
||||
(\CHANGECHARSET.HDCPYDISPLAY 71948 . 73100)) (73603 73744 (\MICASTOPTS 73603 . 73744)) (73915 104212 (
|
||||
MAKEHARDCOPYMODESTREAM 73925 . 75834) (UNMAKEHARDCOPYMODESTREAM 75836 . 76914) (\BLTSHADE.HCPYMODE
|
||||
76916 . 77363) (\BITBLT.HCPYMODE 77365 . 77987) (\BRUSHCONVERT.HCPYMODE 77989 . 78226) (
|
||||
\CHANGECHARSET.HCPYMODE 78228 . 79995) (\DASHINGCONVERT.HCPYMODE 79997 . 80260) (\CHARWIDTH.HCPYMODE
|
||||
80262 . 80549) (\DRAWLINE.HCPYMODE 80551 . 80863) (\DRAWCURVE.HCPYMODE 80865 . 81294) (
|
||||
\DRAWCIRCLE.HCPYMODE 81296 . 81691) (\DRAWELLIPSE.HCPYMODE 81693 . 82205) (\DSPFONT.HCPYMODE 82207 .
|
||||
83363) (\DSPLEFTMARGIN.HCPYMODE 83365 . 83949) (\DSPLINEFEED.HCPYMODE 83951 . 84361) (
|
||||
\DSPRIGHTMARGIN.HCPYMODE 84363 . 84992) (\DSPSPACEFACTOR.HCPYMODE 84994 . 85515) (
|
||||
\DSPXPOSITION.HCPYMODE 85517 . 86098) (\DSPYPOSITION.HCPYMODE 86100 . 86505) (\MOVETO.HCPYMODE 86507
|
||||
. 86659) (\FONTCREATE.HCPYMODE.PRESS 86661 . 87673) (\CREATECHARSET.HCPYMODE.PRESS 87675 . 88646) (
|
||||
\FONTCREATE.HCPYMODE.INTERPRESS 88648 . 89682) (\CREATECHARSET.HCPYMODE.INTERPRESS 89684 . 90672) (
|
||||
\STRINGWIDTH.HCPYMODE 90674 . 91108) (\HCPYMODEBLTCHAR 91110 . 94079) (\HCPYMODEDISPLAYINIT 94081 .
|
||||
97012) (\HCPYMODEDSPPRINTCHAR 97014 . 99195) (\SLOWHCPYMODEBLTCHAR 99197 . 102711) (\SFFixY.HCPYMODE
|
||||
102713 . 104210)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user