WINDOWOBJ: Install classname in IMAGEFNS (#1788 )

IMAGEFNSCREATE had an argument CLASSNAME and the IMAGEFNS datatype had a field IMAGECLASSNAME, but the CLASSNAME wasn't being installed in the field
WINDOWOBJ: Install classname in IMAGEFNS
2026-04-25 20:01:51 +00:00 · 2024-07-22 15:02:26 -07:00 · 2024-07-17 23:39:33 -07:00 · 2024-07-15 05:56:53 -07:00 · 2024-07-11 15:59:22 -07:00
9 changed files with 380 additions and 58 deletions
--- a/.github/workflows/buildReleaseInclDocker.yml
+++ b/.github/workflows/buildReleaseInclDocker.yml
@@ -110,6 +110,16 @@ jobs:
        force: ${{ needs.inputs.outputs.force }}
    secrets: inherit

+######################################################################################
+
+  # Run HCFILES and push to files.interlisp.org
+  do_HCFILES:
+    needs: [inputs, do_release]
+    uses: ./.github/workflows/doHCFILES.yml
+    with:
+        draft: ${{ needs.inputs.outputs.draft }}
+    secrets: inherit
+
 ######################################################################################

  # Kickoff workflow in online repo to build and deploy Medley docker image to oio
--- a/.github/workflows/doHCFILES.yml
+++ b/.github/workflows/doHCFILES.yml
@@ -0,0 +1,139 @@
+#*******************************************************************************
+# doHCFILES.yml
+#
+# Interlisp workflow to run HCFILES.  HCFILES prints out PDF files for all of the
+# files in the Medley directory and posts them on files.interlisp.org.
+#  
+# This workflow is designed to be kickjed off by the buildReleaseInclDocker
+# workflow running in the Medley repo, once the release has been completed successfully
+#
+# Copyright 2024 by Interlisp.org
+#
+# ******************************************************************************
+
+name: Run HCFILES
+
+# Run this workflow on ...
+on:
+  workflow_dispatch:
+    inputs:
+      draft:
+        description: "Mark this as a draft release"
+        type: choice
+        options:
+        - 'false'
+        - 'true'
+
+  workflow_call:
+    inputs:
+      draft:
+        description: "Mark this as a draft release"
+        required: false
+        type: string
+        default: 'false'
+    secrets:
+      OIO_SSH_KEY:
+        required: true
+      MU_TOKEN:
+        required: true
+
+defaults:
+  run:
+    shell: bash
+
+jobs:
+
+  run_HCFILES:
+
+    runs-on: ubuntu-latest
+
+    steps:
+
+      - name: Checkout Medley repo
+        uses: actions/checkout@v4
+
+      - name: Checkout notecards
+        uses: actions/checkout@v4
+        with:
+          repository: ${{ github.repository_owner }}/notecards
+          path: ./notecards
+
+      - name: Checkout loops
+        uses: actions/checkout@v4
+        with:
+          repository: ${{ github.repository_owner }}/loops
+          path: ./loops
+
+      - name: Checkout test
+        uses: actions/checkout@v4
+        with:
+          repository: ${{ github.repository_owner }}/test
+          path: ./test
+
+      - name: Cleanup .git for notecards, loops, test
+        run: rm -rf ./notecards/.git ./loops/.git ./test/.git
+
+      - name: Download Maiko
+        run: |
+          gh release download --output /tmp/maiko.tgz \
+                              --repo ${{ github.repository_owner }}/maiko \
+                              --pattern '*-linux.x86_64.tgz'
+          tar -xzf /tmp/maiko.tgz
+        env:
+          GH_TOKEN: ${{ secrets.MU_TOKEN }}
+
+      - name: Install vnc & ghostscript (ps2pdf)
+        run: |
+          sudo apt-get update
+          sudo apt-get install -y tightvncserver
+          sudo apt-get install -y ghostscript
+
+      - name: Build apps.sysout
+        run: |
+          Xvnc -geometry 1280x720 :0 &
+          export DISPLAY=":0"
+          scripts/loadup-all.sh -apps
+
+      - name: Run HCFILES
+        run: |
+          export DISPLAY=":0"
+          scripts/do_hcfiles.sh
+
+      - name: Push Medley files (including created pdf files) to files.interlisp.org
+        run: |
+            # create a tar file of all of the directories to be pushed
+            tarfile=/tmp/source-$$.tgz
+            tar -c -z -f ${tarfile} --exclude=.git .
+            # set up ssh identity
+            eval $(ssh-agent)
+            ssh-add - <<< "${SSH_KEY}"
+            # set destination directory on files.interlisp.org
+            if [ "${{ inputs.draft }}" = "true" ]
+            then
+              dest=/srv/oio/files/development/medley
+            else
+              dest=/srv/oio/files/production/medley
+            fi
+            # Push tar file up to files.interlisp.org
+            batchfile=/tmp/batch-$$
+            echo "-put ${tarfile} ${dest}.tgz" > ${batchfile}
+            sftp -o StrictHostKeyChecking=no -b ${batchfile} ubuntu@files.interlisp.org
+            # now tar is up, untar it and juggle backups
+            scriptfile=/tmp/script-$$
+            # create script file to do the work
+            cat > ${scriptfile} <<EOF
+            rm -rf ${dest}.new
+            mkdir -p ${dest}.new
+            tar -C ${dest}.new -x -z -f ${dest}.tgz
+            rm -f ${dest}.tgz
+            rm -rf ${dest}.oldold
+            if [ -e ${dest}.old ]; then mv ${dest}.old ${dest}.oldold; fi
+            if [ -e ${dest} ]; then mv ${dest} ${dest}.old; fi
+            mv ${dest}.new ${dest}
+            EOF
+            # execute the script file via ssh
+            ssh -aTxo BatchMode=yes ubuntu@files.interlisp.org /bin/sh -s < ${scriptfile}
+        env:
+            SSH_KEY: ${{ secrets.OIO_SSH_KEY }}
+
+
--- a/internal/MEDLEY-UTILS
+++ b/internal/MEDLEY-UTILS
@@ -1,12 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

-(FILECREATED "30-Jun-2024 08:28:44" {DSK}<Users>larry>il>medley>internal>MEDLEY-UTILS.;2 28720  
+(FILECREATED "14-Jul-2024 12:51:12" {DSK}<home>frank>il>medley>internal>MEDLEY-UTILS.;16 30093  

-      :EDIT-BY "lmm"
+      :CHANGES-TO (FNS MAKE-INDEX-HTMLS)

-      :CHANGES-TO (FNS HCFILES)
-
-      :PREVIOUS-DATE "29-Apr-2024 16:25:20" {DSK}<Users>larry>il>medley>internal>MEDLEY-UTILS.;1)
+      :PREVIOUS-DATE "13-Jul-2024 23:39:43" {DSK}<home>frank>il>medley>internal>MEDLEY-UTILS.;14)


 (PRETTYCOMPRINT MEDLEY-UTILSCOMS)
@@ -126,13 +124,16 @@
           "Welcome to Fuller sysout"])

 (MAKE-INDEX-HTMLS
-  [LAMBDA (BASE TOP)                                         (* ; "Edited 29-Apr-2024 14:18 by lmm")
+  [LAMBDA (BASE TOP LEVEL)                                   (* ; "Edited 29-Apr-2024 14:18 by lmm")
                                                             (* ; "Edited 26-Apr-2024 16:15 by lmm")
                                                             (* ; "Edited 20-Apr-2024 12:34 by lmm")
                                                             (* ; "Edited 13-Apr-2024 21:18 by lmm")
    [OR BASE (SETQ BASE (PSEUDOFILENAME (MEDLEYDIR]
    (OR (DIRECTORYNAMEP BASE)
        (ERROR BASE "not a directory name"))
+    (OR (AND (NUMBERP LEVEL)
+             (IGREATERP LEVEL 0))
+        (SETQ LEVEL 1))
    (LET* ((SUBDIRS NIL)
           (DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
           (PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
@@ -140,9 +141,20 @@
           SLASHED SHORTNAME)
          (CL:WITH-OPEN-FILE
           (S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
-           (CL:FORMAT S "<HTML><HEAD><TITLE>Index page for ~a</TITLE></HEAD>~%%" (SETQ SLASHED
-                                                                                  (SLASHIT BASE)))
+           (CL:FORMAT S "<HTML>~%%<HEAD>~%%")
+           (CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
+           (CL:FORMAT S "<SCRIPT>~%%")
+           (CL:FORMAT S "    function up_onclick(){~%%")
+           (CL:FORMAT S "        var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
+           (CL:FORMAT S "        location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
+           (CL:FORMAT S "     }~%%")
+           (CL:FORMAT S "</SCRIPT>~%%")
+           (CL:FORMAT S "</HEAD>~%%")
           (CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
+           (CL:UNLESS (EQ LEVEL 1)
+                  (CL:FORMAT S 
+      "<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
+                         ))
           (CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
           (FOR FULLNAME IN (DIRECTORY (CONCAT BASE "*.*;"))
              DO (IF (EQ (NTHCHAR FULLNAME -1)
@@ -183,7 +195,8 @@

                   ELSE (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
           (CL:FORMAT S "</UL></BODY></HTML>~%%"))
-          (NCONC SUBDIRS (FOR D IN SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE])
+          (NCONC SUBDIRS (FOR D IN SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE)
+                                                       (ADD1 LEVEL])

 (MEDLEY-FIX-LINKS
  [LAMBDA (UNIXPATH)                                       (* ; "Edited 18-Jan-2021 12:01 by larry")
@@ -336,13 +349,16 @@
                         (PRINTOUT T "DONE" T))])

 (MAKE-INDEX-HTMLS
-  [LAMBDA (BASE TOP)                                         (* ; "Edited 29-Apr-2024 14:18 by lmm")
+  [LAMBDA (BASE TOP LEVEL)                                   (* ; "Edited 29-Apr-2024 14:18 by lmm")
                                                             (* ; "Edited 26-Apr-2024 16:15 by lmm")
                                                             (* ; "Edited 20-Apr-2024 12:34 by lmm")
                                                             (* ; "Edited 13-Apr-2024 21:18 by lmm")
    [OR BASE (SETQ BASE (PSEUDOFILENAME (MEDLEYDIR]
    (OR (DIRECTORYNAMEP BASE)
        (ERROR BASE "not a directory name"))
+    (OR (AND (NUMBERP LEVEL)
+             (IGREATERP LEVEL 0))
+        (SETQ LEVEL 1))
    (LET* ((SUBDIRS NIL)
           (DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
           (PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
@@ -350,9 +366,20 @@
           SLASHED SHORTNAME)
          (CL:WITH-OPEN-FILE
           (S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
-           (CL:FORMAT S "<HTML><HEAD><TITLE>Index page for ~a</TITLE></HEAD>~%%" (SETQ SLASHED
-                                                                                  (SLASHIT BASE)))
+           (CL:FORMAT S "<HTML>~%%<HEAD>~%%")
+           (CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
+           (CL:FORMAT S "<SCRIPT>~%%")
+           (CL:FORMAT S "    function up_onclick(){~%%")
+           (CL:FORMAT S "        var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
+           (CL:FORMAT S "        location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
+           (CL:FORMAT S "     }~%%")
+           (CL:FORMAT S "</SCRIPT>~%%")
+           (CL:FORMAT S "</HEAD>~%%")
           (CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
+           (CL:UNLESS (EQ LEVEL 1)
+                  (CL:FORMAT S 
+      "<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
+                         ))
           (CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
           (FOR FULLNAME IN (DIRECTORY (CONCAT BASE "*.*;"))
              DO (IF (EQ (NTHCHAR FULLNAME -1)
@@ -393,7 +420,8 @@

                   ELSE (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
           (CL:FORMAT S "</UL></BODY></HTML>~%%"))
-          (NCONC SUBDIRS (FOR D IN SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE])
+          (NCONC SUBDIRS (FOR D IN SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE)
+                                                       (ADD1 LEVEL])
 )

 (PUTPROPS MEDLEY-UTILS FILETYPE :COMPILE-FILE)
@@ -500,9 +528,9 @@
 (ADDTOVAR LAMA )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1099 11665 (GATHER-INFO 1109 . 6491) (MAKE-FULLER-DB 6493 . 7270) (MAKE-INDEX-HTMLS 
-7272 . 11034) (MEDLEY-FIX-LINKS 11036 . 11429) (MEDLEY-FIX-DATES 11431 . 11663)) (12844 15632 (
-MAKE-EXPORTS-ALL 12854 . 13913) (MAKE-WHEREIS-HASH 13915 . 15104) (MAKE-WHEREIS-LOOPS 15106 . 15630)) 
-(15633 23672 (HCFILES 15643 . 19906) (MAKE-INDEX-HTMLS 19908 . 23670)) (23922 28534 (RECOMPILE-ONE 
-23932 . 25829) (RECMPL 25831 . 26434) (COMPILE-SETUP 26436 . 27060) (REMAKEFILES 27062 . 28532)))))
+  (FILEMAP (NIL (1086 12345 (GATHER-INFO 1096 . 6478) (MAKE-FULLER-DB 6480 . 7257) (MAKE-INDEX-HTMLS 
+7259 . 11714) (MEDLEY-FIX-LINKS 11716 . 12109) (MEDLEY-FIX-DATES 12111 . 12343)) (13524 16312 (
+MAKE-EXPORTS-ALL 13534 . 14593) (MAKE-WHEREIS-HASH 14595 . 15784) (MAKE-WHEREIS-LOOPS 15786 . 16310)) 
+(16313 25045 (HCFILES 16323 . 20586) (MAKE-INDEX-HTMLS 20588 . 25043)) (25295 29907 (RECOMPILE-ONE 
+25305 . 27202) (RECMPL 27204 . 27807) (COMPILE-SETUP 27809 . 28433) (REMAKEFILES 28435 . 29905)))))
 STOP
--- a/internal/MEDLEY-UTILS.DFASL
+++ b/internal/MEDLEY-UTILS.DFASL
--- a/library/tedit/TEDIT-FILE
+++ b/library/tedit/TEDIT-FILE
@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

-(FILECREATED " 7-Apr-2024 17:22:52" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;531 155019 
+(FILECREATED "11-Jul-2024 14:26:05" {MEDLEY}<library>TEDIT>TEDIT-FILE.;23 155256 

      :EDIT-BY rmk

-      :CHANGES-TO (FNS \TEDIT.GET.CHARLOOKS.LIST \TEDIT.GET.SINGLE.CHARLOOKS \TEDIT.GET.PIECES3)
+      :CHANGES-TO (FNS \TEDIT.GET.PIECES3)

-      :PREVIOUS-DATE " 2-Apr-2024 12:15:23" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;529)
+      :PREVIOUS-DATE " 7-Apr-2024 17:22:52" {MEDLEY}<library>TEDIT>TEDIT-FILE.;20)


 (PRETTYCOMPRINT TEDIT-FILECOMS)
@@ -855,7 +855,8 @@
 (DEFINEQ

 (\TEDIT.GET.PIECES3
-  [LAMBDA (TEXT TEXTOBJ PCCOUNT CURFILEBYTE# END)            (* ; "Edited  7-Apr-2024 17:20 by rmk")
+  [LAMBDA (TEXT TEXTOBJ PCCOUNT CURFILEBYTE# END)            (* ; "Edited 11-Jul-2024 14:20 by rmk")
+                                                             (* ; "Edited  7-Apr-2024 17:20 by rmk")
                                                             (* ; "Edited 20-Mar-2024 10:59 by rmk")
                                                             (* ; "Edited 15-Mar-2024 14:37 by rmk")
                                                             (* ; "Edited 14-Jan-2024 00:22 by rmk")
@@ -939,7 +940,9 @@
                                            (\TEDIT.GET.SINGLE.CHARLOOKS TEXT TEXTOBJ))))
              (\PieceDescriptorPAGEFRAME                     (* ; 
                                                             "This is page layout info for the file")
-                   (FSETTOBJ TEXTOBJ TXTPAGEFRAMES (\TEDIT.PARSE.PAGEFRAMES (READ TEXT))))
+                   (FSETTOBJ TEXTOBJ TXTPAGEFRAMES (\TEDIT.PARSE.PAGEFRAMES (READ TEXT 
+                                                                               *TEDIT-FILE-READTABLE*
+                                                                                  ))))
              (\PieceDescriptorCHARLOOKSLIST                 (* ; 
                                                 "Read the list of CHARLOOKSs used in this document.")
                   (add PCNO -1)                             (* ; 
@@ -2449,27 +2452,27 @@

 (RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4804 30415 (TEDIT.GET 4814 . 9656) (TEDIT.FORMATTEDFILEP 9658 . 10974) (TEDIT.FILEDATE 
-10976 . 12147) (TEDIT.INCLUDE 12149 . 19117) (TEDIT.RAW.INCLUDE 19119 . 19927) (TEDIT.PUT 19929 . 
-26872) (TEDIT.PUT.STREAM 26874 . 30413)) (30416 49580 (\TEDIT.GET.FOREIGN.FILE 30426 . 33611) (
-\TEDIT.GET.UNFORMATTED.FILE 33613 . 37487) (\TEDIT.GET.FORMATTED.FILE 37489 . 40277) (
-\TEDIT.FORMATTEDSTREAMP 40279 . 43179) (\ARBIN 43181 . 43901) (\ATMIN 43903 . 44440) (\DWIN 44442 . 
-44821) (\STRINGIN 44823 . 45531) (\TEDIT.GET.TRAILER 45533 . 48049) (\TEDIT.CACHEFILE 48051 . 49578)) 
-(49746 62858 (\TEDIT.GET.PIECES3 49756 . 59620) (\TEDIT.GET.IDATE3 59622 . 61017) (
-\TEDIT.MAKE.STRINGPIECE 61019 . 62856)) (62859 74802 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 62869 . 68985) 
-(\TEDIT.INTERPRET.XCCS.SHIFTS 68987 . 74800)) (74824 80846 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 74834 . 
-80844)) (80869 89373 (\TEDIT.GET.CHARLOOKS.LIST 80879 . 81610) (\TEDIT.GET.SINGLE.CHARLOOKS 81612 . 
-86185) (\TEDIT.GET.CHARLOOKS 86187 . 87517) (\TEDIT.GET.PARALOOKS.INDEX 87519 . 88063) (
-\TEDIT.GET.CHARLOOKS.INDEX 88065 . 89371)) (89374 97612 (\TEDIT.GET.PARALOOKS.LIST 89384 . 90006) (
-\TEDIT.GET.SINGLE.PARALOOKS 90008 . 97020) (\TEDIT.GET.PARALOOKS 97022 . 97610)) (97613 101012 (
-\TEDIT.GET.OBJECT 97623 . 101010)) (101074 133645 (\TEDIT.PUT.PCTB 101084 . 115087) (
-\TEDIT.PUT.TRAILER 115089 . 115856) (\TEDIT.PUT.PCTB.MERGEABLE 115858 . 119376) (
-\TEDIT.PUT.UTF8.SPLITPIECES 119378 . 124465) (\TEDIT.PUT.PCTB.NEXTNEW 124467 . 128242) (
-\TEDIT.INSERT.NEWPIECES 128244 . 131243) (\TEDIT.PUTRESET 131245 . 131487) (\ARBOUT 131489 . 132213) (
-\ATMOUT 132215 . 132820) (\DWOUT 132822 . 133101) (\STRINGOUT 133103 . 133643)) (133646 145039 (
-\TEDIT.PUT.CHARLOOKS.LIST 133656 . 135328) (\TEDIT.PUT.SINGLE.CHARLOOKS 135330 . 140574) (
-\TEDIT.PUT.CHARLOOKS 140576 . 141720) (\TEDIT.PUT.CHARLOOKS1 141722 . 142773) (\TEDIT.PUT.OBJECT 
-142775 . 145037)) (145040 153078 (\TEDIT.PUT.PARALOOKS.LIST 145050 . 145952) (
-\TEDIT.PUT.SINGLE.PARALOOKS 145954 . 152003) (\TEDIT.PUT.PARALOOKS 152005 . 153076)) (153173 154855 (
-TEDITFROMLISPSOURCE 153183 . 154853)))))
+  (FILEMAP (NIL (4746 30357 (TEDIT.GET 4756 . 9598) (TEDIT.FORMATTEDFILEP 9600 . 10916) (TEDIT.FILEDATE 
+10918 . 12089) (TEDIT.INCLUDE 12091 . 19059) (TEDIT.RAW.INCLUDE 19061 . 19869) (TEDIT.PUT 19871 . 
+26814) (TEDIT.PUT.STREAM 26816 . 30355)) (30358 49522 (\TEDIT.GET.FOREIGN.FILE 30368 . 33553) (
+\TEDIT.GET.UNFORMATTED.FILE 33555 . 37429) (\TEDIT.GET.FORMATTED.FILE 37431 . 40219) (
+\TEDIT.FORMATTEDSTREAMP 40221 . 43121) (\ARBIN 43123 . 43843) (\ATMIN 43845 . 44382) (\DWIN 44384 . 
+44763) (\STRINGIN 44765 . 45473) (\TEDIT.GET.TRAILER 45475 . 47991) (\TEDIT.CACHEFILE 47993 . 49520)) 
+(49688 63095 (\TEDIT.GET.PIECES3 49698 . 59857) (\TEDIT.GET.IDATE3 59859 . 61254) (
+\TEDIT.MAKE.STRINGPIECE 61256 . 63093)) (63096 75039 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 63106 . 69222) 
+(\TEDIT.INTERPRET.XCCS.SHIFTS 69224 . 75037)) (75061 81083 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 75071 . 
+81081)) (81106 89610 (\TEDIT.GET.CHARLOOKS.LIST 81116 . 81847) (\TEDIT.GET.SINGLE.CHARLOOKS 81849 . 
+86422) (\TEDIT.GET.CHARLOOKS 86424 . 87754) (\TEDIT.GET.PARALOOKS.INDEX 87756 . 88300) (
+\TEDIT.GET.CHARLOOKS.INDEX 88302 . 89608)) (89611 97849 (\TEDIT.GET.PARALOOKS.LIST 89621 . 90243) (
+\TEDIT.GET.SINGLE.PARALOOKS 90245 . 97257) (\TEDIT.GET.PARALOOKS 97259 . 97847)) (97850 101249 (
+\TEDIT.GET.OBJECT 97860 . 101247)) (101311 133882 (\TEDIT.PUT.PCTB 101321 . 115324) (
+\TEDIT.PUT.TRAILER 115326 . 116093) (\TEDIT.PUT.PCTB.MERGEABLE 116095 . 119613) (
+\TEDIT.PUT.UTF8.SPLITPIECES 119615 . 124702) (\TEDIT.PUT.PCTB.NEXTNEW 124704 . 128479) (
+\TEDIT.INSERT.NEWPIECES 128481 . 131480) (\TEDIT.PUTRESET 131482 . 131724) (\ARBOUT 131726 . 132450) (
+\ATMOUT 132452 . 133057) (\DWOUT 133059 . 133338) (\STRINGOUT 133340 . 133880)) (133883 145276 (
+\TEDIT.PUT.CHARLOOKS.LIST 133893 . 135565) (\TEDIT.PUT.SINGLE.CHARLOOKS 135567 . 140811) (
+\TEDIT.PUT.CHARLOOKS 140813 . 141957) (\TEDIT.PUT.CHARLOOKS1 141959 . 143010) (\TEDIT.PUT.OBJECT 
+143012 . 145274)) (145277 153315 (\TEDIT.PUT.PARALOOKS.LIST 145287 . 146189) (
+\TEDIT.PUT.SINGLE.PARALOOKS 146191 . 152240) (\TEDIT.PUT.PARALOOKS 152242 . 153313)) (153410 155092 (
+TEDITFROMLISPSOURCE 153420 . 155090)))))
 STOP
--- a/library/tedit/TEDIT-FILE.LCOM
+++ b/library/tedit/TEDIT-FILE.LCOM
--- a/scripts/do_hcfiles.sh
+++ b/scripts/do_hcfiles.sh
@@ -0,0 +1,141 @@
+#!/bin/sh
+
+main() {
+        MEDLEYDIR=$(cd "${SCRIPTDIR}/.." && pwd)
+        export MEDLEYDIR
+        logindir=/tmp/hcfiles-$$
+        mkdir -p "${logindir}"
+        cmfile=${logindir}/hcfiles.cm
+
+	cat >"${cmfile}" <<-"EOF"
+	"
+
+	(PROGN
+          (IL:MEDLEY-INIT-VARS 'IL:GREET)
+	  (IL:FILESLOAD MEDLEY-UTILS PDFSTREAM GITFNS))
+          (IL:DRIBBLE '{DSK}${logindir}/hcfiles.dribble)
+          (IL:SETQ IL:*UPPER-CASE-FILE-NAMES* NIL)
+          (IL:SETQ IL:NO-HELP NIL)
+          (IL:ADVISE 'IL:UNSAFE.TO.MODIFY :BEFORE '(RETURN NIL))
+          (IL:ADVISE 'IL:HELP :BEFORE '(IL:COND (IL:NO-HELP (IL:ERROR IL:MESS1 IL:MESS2 T))))
+          (IL:LET ((IL:NO-HELP T)) (DECLARE (SPECIAL IL:NO-HELP)) (IL:HCFILES))
+          (IL:MAKE-INDEX-HTMLS)
+          (IL:DRIBBLE)
+          (IL:LOGOUT T)
+	)
+
+	"
+	EOF
+
+
+        /bin/sh "${MEDLEYDIR}/scripts/medley/medley.command"     \
+             --config -                                          \
+             --id hcfiles_+                                      \
+             --geometry 1024x768                                 \
+             --noscroll                                          \
+             --logindir "${logindir}"                            \
+             --greet "${cmfile}"                                 \
+             --apps
+
+}
+
+# shellcheck disable=SC2164,SC2034
+if [ -z "${SCRIPTDIR}" ]
+then
+	#
+	#
+	# Some functions to determine what directory this script is being executed from
+	#
+	#
+	get_abs_filename() {
+	  # $1 : relative filename
+	  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+	}
+
+	# This function taken from
+	# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
+	rreadlink() (
+
+	  # Execute this function in a *subshell* to localize variables and the effect of `cd`.
+
+	  target=$1
+	  fname=
+	  targetDir=
+	  CDPATH=
+
+	  # Try to make the execution environment as predictable as possible:
+	  # All commands below are invoked via `command`, so we must make sure that `command`
+	  # itself is not redefined as an alias or shell function.
+	  # (Note that command is too inconsistent across shells, so we don't use it.)
+	  # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
+	  # an external utility version of it (e.g, Ubuntu).
+	  # `command` bypasses aliases and shell functions and also finds builtins 
+	  # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
+	  # to happen.
+	  { \unalias command; \unset -f command; } >/dev/null 2>&1
+	  [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
+
+	  while :; do # Resolve potential symlinks until the ultimate target is found.
+	      [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
+	      command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
+	      fname=$(command basename -- "$target") # Extract filename.
+	      [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
+	      if [ -L "$fname" ]; then
+	        # Extract [next] target path, which may be defined
+	        # *relative* to the symlink's own directory.
+	        # Note: We parse `ls -l` output to find the symlink target
+	        #       which is the only POSIX-compliant, albeit somewhat fragile, way.
+	        target=$(command ls -l "$fname")
+	        target=${target#* -> }
+	        continue # Resolve [next] symlink target.
+	      fi
+	      break # Ultimate target reached.
+	  done
+	  targetDir=$(command pwd -P) # Get canonical dir. path
+	  # Output the ultimate target's canonical path.
+	  # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
+	  if [ "$fname" = '.' ]; then
+	    command printf '%s\n' "${targetDir%/}"
+	  elif  [ "$fname" = '..' ]; then
+	    # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
+	    # AFTER canonicalization.
+	    command printf '%s\n' "$(command dirname -- "${targetDir}")"
+	  else
+	    command printf '%s\n' "${targetDir%/}/$fname"
+	  fi
+	)
+
+	get_script_dir() {
+
+	    # call this with $0 (from main script) as its (only) parameter
+	    # if you need to preserve cwd, run this is a subshell since
+	    # it can change cwd
+
+	    # set -x
+
+	    local_SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+	    while [ -h "$local_SCRIPT_PATH" ];
+	    do
+	        cd "$( dirname -- "$local_SCRIPT_PATH"; )";
+	        local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
+	    done
+
+	    cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
+	    local_SCRIPT_PATH="$( pwd; )";
+
+	    # set +x
+
+	    echo "${local_SCRIPT_PATH}"
+	}
+
+	# end of script directory functions
+	###############################################################################
+
+        # figure out the script dir
+        SCRIPTDIR="$(get_script_dir "$0")"
+	export SCRIPTDIR
+
+fi
+
+main "$@"
--- a/sources/WINDOWOBJ
+++ b/sources/WINDOWOBJ
@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

-(FILECREATED "23-Apr-2024 18:08:13" {WMEDLEY}<sources>WINDOWOBJ.;26 32448  
+(FILECREATED "17-Jul-2024 21:54:38" {WMEDLEY}<sources>WINDOWOBJ.;27 32550  

      :EDIT-BY rmk

-      :CHANGES-TO (FNS ENCAPSULATEDOBJP)
-                  (VARS WINDOWOBJCOMS)
+      :CHANGES-TO (FNS IMAGEFNSCREATE)

-      :PREVIOUS-DATE " 5-Dec-2023 21:15:38" {WMEDLEY}<sources>WINDOWOBJ.;23)
+      :PREVIOUS-DATE "23-Apr-2024 18:08:13" {WMEDLEY}<sources>WINDOWOBJ.;26)


 (PRETTYCOMPRINT WINDOWOBJCOMS)
@@ -133,6 +132,7 @@
 (IMAGEFNSCREATE
  [LAMBDA (DISPLAYFN IMAGEBOXFN PUTFN GETFN COPYFN BUTTONEVENTINFN COPYBUTTONEVENTINFN WHENMOVEDFN 
                 WHENINSERTEDFN WHENDELETEDFN WHENCOPIEDFN WHENOPERATEDONFN PREPRINTFN CLASSNAME)
+                                                             (* ; "Edited 17-Jul-2024 21:54 by rmk")
                                                             (* jds "19-Feb-85 09:33")

    (* ;; "returns a structure which contains the image functions for a type of image object.")
@@ -156,7 +156,8 @@
           WHENDELETEDFN _ WHENDELETEDFN
           WHENCOPIEDFN _ WHENCOPIEDFN
           WHENOPERATEDONFN _ WHENOPERATEDONFN
-           PREPRINTFN _ PREPRINTFN])
+           PREPRINTFN _ PREPRINTFN
+           IMAGECLASSNAME _ CLASSNAME])

 (IMAGEFNSP
  [LAMBDA (X)                                            (* rrb " 1-Feb-84 11:13")
@@ -595,11 +596,11 @@ Either delete this image object or load its support files." IMAGEOBJ)
 (ADDTOVAR LAMA IMAGEOBJPROP)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4826 23314 (COPYINSERT 4836 . 6363) (IMAGEBOX 6365 . 6545) (IMAGEFNSCREATE 6547 . 7742)
- (IMAGEFNSP 7744 . 7985) (IMAGEOBJCREATE 7987 . 8532) (IMAGEOBJP 8534 . 8775) (IMAGEOBJPROP 8777 . 
-14669) (\IMAGEUSERPROP 14671 . 15265) (HPRINT.IMAGEOBJ 15267 . 15856) (COPYIMAGEOBJ 15858 . 16601) (
-READIMAGEOBJ 16603 . 21960) (WRITEIMAGEOBJ 21962 . 23312)) (23528 32170 (
-ENCAPSULATEDOBJ.BUTTONEVENTINFN 23538 . 25321) (ENCAPSULATEDOBJ.PUTFN 25323 . 26438) (
-ENCAPSULATEDOBJ.DISPLAYFN 26440 . 28243) (ENCAPSULATEDOBJ.IMAGEBOXFN 28245 . 30421) (ENCAPSULATEDOBJP 
-30423 . 30731) (ENCAPSULATEDIMAGEFNS 30733 . 32168)))))
+  (FILEMAP (NIL (4785 23416 (COPYINSERT 4795 . 6322) (IMAGEBOX 6324 . 6504) (IMAGEFNSCREATE 6506 . 7844)
+ (IMAGEFNSP 7846 . 8087) (IMAGEOBJCREATE 8089 . 8634) (IMAGEOBJP 8636 . 8877) (IMAGEOBJPROP 8879 . 
+14771) (\IMAGEUSERPROP 14773 . 15367) (HPRINT.IMAGEOBJ 15369 . 15958) (COPYIMAGEOBJ 15960 . 16703) (
+READIMAGEOBJ 16705 . 22062) (WRITEIMAGEOBJ 22064 . 23414)) (23630 32272 (
+ENCAPSULATEDOBJ.BUTTONEVENTINFN 23640 . 25423) (ENCAPSULATEDOBJ.PUTFN 25425 . 26540) (
+ENCAPSULATEDOBJ.DISPLAYFN 26542 . 28345) (ENCAPSULATEDOBJ.IMAGEBOXFN 28347 . 30523) (ENCAPSULATEDOBJP 
+30525 . 30833) (ENCAPSULATEDIMAGEFNS 30835 . 32270)))))
 STOP
--- a/sources/WINDOWOBJ.LCOM
+++ b/sources/WINDOWOBJ.LCOM
Author	SHA1	Message	Date
Frank Halasz	244300de7b	WINDOWOBJ: Install classname in IMAGEFNS (#1788 ) IMAGEFNSCREATE had an argument CLASSNAME and the IMAGEFNS datatype had a field IMAGECLASSNAME, but the CLASSNAME wasn't being installed in the field	2024-07-22 15:02:26 -07:00
rmkaplan	e9200c73c9	WINDOWOBJ: Install classname in IMAGEFNS	2024-07-17 23:39:33 -07:00
Frank Halasz	1ffcde195a	Automate HCFILES workflow (also add "up one level" button to index.html pages) (#1784 ) * First pass at workflow for doing HCFILES on each release * Finish doHCFILES workflow * Fix delete of gh-page branch in DoHCFILES workflow * Redo doHCFILES workflow for files.interlisp.org; add indexing to do_hcfiles script * Fiddling with workflow names so that I can test doHCFILES.yml on a branch * in doHCFILES workflow fix use of GH_TOKEN * Fix typo in doHCFILES workflow * Debugging doHCFILES workflow * Fix multiple bugs in do_hcfiles script; fixed multiple bugs in doHCFILES workflow * Debugging move * in do_hcfiles.sh add back in Tedit file stoHCFILES run * Clean up do_hcfiles.sh a bit * Add debugging code to doHCFILES workflow * In MAKE-INDEX-HTMLS, add code to ensure that the original case of the files/directory names are preserved since (DIRECTORY) seems to return names ia all-caps, always * Debugging doHCFILES * Fiddling with debugging code in doHCFILES workflow * Add MEDLEY-INIT-VARS to cm file in do_hcfiles.sh * Undo effect of merging fgh_hcfiles-updates into fgh_hcfiles-workflow. fgh_hcfiles-update will be abadoned * Add up button to index.html files in MAKE-INDEX-HTMLS * Update MAKE-INDEX-HTMLS to include an up-on-level button in index.html files. Move fio files to medley instead of source. Streamline doHCFILES workflow * Debugging * In MAKE-INDEX-HTMLS, make sure that the up-one button does not appear in the top-level index.html * In doHCFILES workflow, add difference between development(draft) and production; add doHCFILES workflow into buildReleraseInclDocker workflow * Update MAKE-INDEX-HTMLS with new onclick script to handle directories properly * Fix typo in buildRelease workflow * Polishing up do_hcfiles.sh * Return buildDocker.yml to original state after using it to test doHCFILES.yml	2024-07-15 05:56:53 -07:00
rmkaplan	19015712de	Fix hardcopy under XCL exec #1781 (#1782 ) * TEDIT-FILE fixes #1781 * TEDIT-FILE fixes #1781	2024-07-11 15:59:22 -07:00