Merge pull request #1532 from Interlisp/mth4--Add-default-to-suppress-DUMPDB-asking-copyright-owner

DUMPDB annoyingly always asked COPYRIGHT owner when dumping DB

library/DATABASEFNS

@@ -1,14 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "27-Oct-2021 10:55:18" {DSK}<home>larry>medley>library>DATABASEFNS.;7
 16051  
+
(FILECREATED "19-Feb-2024 16:29:44" {LIB}DATABASEFNS.;15
 17624  
 
-      changes to%:  (FNS DUMPDB)
+      :EDIT-BY "mth"
 
-      previous date%: "24-Oct-2021 20:18:51" {DSK}<home>larry>medley>library>DATABASEFNS.;6)
+      :CHANGES-TO (VARS DATABASEFNSCOMS)
+                  (FNS DUMPDB)
+
+      :PREVIOUS-DATE "27-Oct-2021 10:55:18" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;1)
 
 
 (* ; "
-Copyright (c) 1986, 1990-1993 by Xerox Corporation.
+Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT DATABASEFNSCOMS)
@@ -31,7 +34,8 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
         (INITVARS (LOADDBFLG 'ASK)
                (SAVEDBFLG 'ASK))
         (ADDVARS (MAKEFILEFORMS (MAKEDB FILE)))
-        (INITVARS (MSFILETABLE))
+        (INITVARS (MSFILETABLE)
+               (DEFAULTDATABASECOPYRIGHTOWNER 'NEVER))
                                                              (* ; "To permit MSHASH interface")

         (LOCALVARS . T)
         (BLOCKS (LOADDB LOADDB DBFILE DBFILE1 DBFILE2 (NOLINKFNS . T)))
@@ -161,26 +165,52 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
 (DEFINEQ
 
 (DUMPDB

-  [LAMBDA (FILE PROPFLG)                                     (* ; 
-
                                                           "Edited 27-Oct-2021 10:51 by larry")

-                                                             (* ; 
-
                                                           "Edited 24-Oct-2021 16:24 by rmk:")

+  [LAMBDA (FILE PROPFLG)
                                     (* ; "Edited  7-Feb-2024 18:26 by mth")


+                                                           (* ; "Edited 27-Oct-2021 10:51 by larry")


+                                                            (* ; "Edited 24-Oct-2021 16:24 by rmk:")

 
     (* ;; "Dumps a Masterscope database for functions in FILE.  Checks the DATABASE property if PROPFLG=T which is how the MAKEFILE advice calls it.  A user-level call would default PROPFLG to NIL.")

 
-    (* ;; 
-
  "The FILE check is because MAKEFILE returns a list when it doesn't understand the options")

+    (* ;; "The FILE check is because MAKEFILE returns a list when it doesn't understand the options")

 
-    (DECLARE
 (GLOBALVARS MSFILETABLE SAVEDBFLG))
+    (DECLARE
 (GLOBALVARS MSFILETABLE SAVEDBFLG)
+           (SPECVARS DEFAULTDATABASECOPYRIGHTOWNER COPYRIGHTFLG DEFAULTCOPYRIGHTOWNER))
     (CL:WHEN (AND FILE (OR (LITATOM FILE)
                            (STRINGP FILE)))
-        (PROG (DBFILE
 (FL (NAMEFIELD FILE))
-                     (FNS (FILEFNSLST FILE)))
+        (PROG (DBFILE
 DBFN FLCPR (FL (NAMEFIELD FILE))
+                     (FNS (FILEFNSLST FILE))
+                     (COPYRIGHTFLG COPYRIGHTFLG)
+                     (DEFAULTCOPYRIGHTOWNER DEFAULTCOPYRIGHTOWNER))
+              (SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE))
+              (CL:UNLESS (OR (EQ COPYRIGHTFLG 'NEVER)
+                             (NULL DEFAULTDATABASECOPYRIGHTOWNER)
+                             (GETPROP DBFN 'COPYRIGHT))
+                  (SELECTQ DEFAULTDATABASECOPYRIGHTOWNER
+                      ((NONE NEVER) 
+                                    (* ;; "Set the COPYRIGHT to NONE (I.e., never mention it again.)")

+
+                           (/PUT DBFN 'COPYRIGHT (LIST 'NONE)))
+                      (SAME 
+                            (* ;; 
+
                         "Same as the source file. If it doesn't have one, then just normal handling")

+
+                            (CL:WHEN (SETQ FLCPR (GETPROP FL 'COPYRIGHT))
+                                (/PUT DBFN 'COPYRIGHT (LIST (CAR FLCPR)))))
+                      (DEFAULT 
+                               (* ;; "Use the general default for copyright")

+
+                               (SETQ COPYRIGHTFLG 'DEFAULT))
+                      (PROGN (SETQ COPYRIGHTFLG 'DEFAULT)
+
+                             (* ;; 
+
                        "Hopefully, DEFAULTDATABASECOPYRIGHTOWNER is one of the COPYRIGHTOWNERS keys")

+
+                             (SETQ DEFAULTCOPYRIGHTOWNER DEFAULTDATABASECOPYRIGHTOWNER))))
               (COND
                  (FNS)
                  ((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE)))
                                                              (* ; 
-
                                                           "Always dump if this is a known file")

+
                                                             "Always dump if this is a known file")

                   (SETQ PROPFLG NIL))
                  (T (COND
                        (PROPFLG (/REMPROP FL 'DATABASE))
@@ -193,8 +223,7 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
                            (AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
                   (CL:WHEN MSFILETABLE
                       [STORETABLE FL MSFILETABLE (CAR (GETPROP FL 'FILEDATES])
-                  [SETQ DBFILE (PRETTYDEF NIL (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL
-                                                     'BODY FILE)
+                  [SETQ DBFILE (PRETTYDEF NIL DBFN
                                       `((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
                                                   (ERROR!)))
                                         (E [PRINT (CAR (GETPROP ',FILE 'FILEDATES]
@@ -203,9 +232,9 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
                      (PROPFLG (PRINT (FULLNAME DBFILE)
                                      T))
                      (T (/PUT FL 'DATABASEFILENAME DBFILE)   (* ; 
-
                                                   "Remember that we have this file valid already.")

+
                                                     "Remember that we have this file valid already.")

                         (/PUT FL 'DATABASE 'YES]             (* ; 
-
                                                   "Take future note of the databae on a user call")

+
                                                     "Take future note of the databae on a user call")

                   (RETURN DBFILE))))])
 
 (LOADDB

@@ -321,6 +350,8 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
 
 (RPAQ? MSFILETABLE
 )
 
+(RPAQ? DEFAULTDATABASECOPYRIGHTOWNER
 'NEVER)
+
 
 
 (* ; "To permit MSHASH interface")

@@ -337,9 +368,9 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
 
 (RESETSAVE DWIMIFYCOMPFLG T)
 )
-(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993))
+(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993 2024))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1679 6704 (DBFILE 1689 . 3334) (DBFILE1 3336 . 4846) (DBFILE2 4848 . 6070) (LOAD 6072
- . 6302) (LOADFROM 6304 . 6492) (MAKEFILE 6494 . 6702)) (6760 15499 (DUMPDB 6770 . 9534) (LOADDB 9536
- . 14411) (MAKEDB 14413 . 15497)))))
+  (FILEMAP (NIL (1778 6803 (DBFILE 1788 . 3433) (DBFILE1 3435 . 4945) (DBFILE2 4947 . 6169) (LOAD 6171
+ . 6401) (LOADFROM 6403 . 6591) (MAKEFILE 6593 . 6801)) (6859 17017 (DUMPDB 6869 . 11052) (LOADDB 
+11054 . 15929) (MAKEDB 15931 . 17015)))))
 STOP

library/POSTSCRIPTSTREAM

@@ -1,14 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "28-Jan-2024 19:48:39" {LIB}POSTSCRIPTSTREAM.;4
 261407 
+
(FILECREATED "21-Nov-2023 17:06:12" {WMEDLEY}<library>POSTSCRIPTSTREAM.;12
 258100 
 
-      :EDIT-BY "mth"
+      :EDIT-BY rmk
 
-      :CHANGES-TO (FNS READ-ADOBE-GLYPH-FILE)
-                  (VARS POSTSCRIPTSTREAMCOMS)
-                  (FILES UNICODE)
+      :CHANGES-TO (FNS POSTSCRIPTFILEP)
 
-      :PREVIOUS-DATE "21-Nov-2023 17:06:12" {LIB}POSTSCRIPTSTREAM.;1)
+      :PREVIOUS-DATE "21-Jun-2021 20:29:32" {WMEDLEY}<library>POSTSCRIPTSTREAM.;11)
 
 
 (PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS)
@@ -19,7 +17,7 @@
 
         (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS FONTID PSCFONT \POSTSCRIPTDATA POSTSCRIPTXFORM))
         (INITRECORDS \POSTSCRIPTDATA)
-        (FNS POSTSCRIPT.INIT READ-ADOBE-GLYPH-FILE)
+        (FNS POSTSCRIPT.INIT)
         (ADDVARS (DEFAULTFILETYPELIST (PS . TEXT)
                         (PSC . TEXT)
                         (PSF . BINARY)
@@ -70,8 +68,6 @@
         (COMS 
               (* ;; "Character-output, plus special-cases:")

 
-              (FILES (SYSLOAD)
-                     UNICODE)
               (FNS \POSTSCRIPT.CHANGECHARSET \POSTSCRIPT.OUTCHARFN \POSTSCRIPT.PRINTSLUG 
                    \POSTSCRIPT.SPECIALOUTCHARFN \UPDATE.PSC \POSTSCRIPT.ACCENTFN 
                    \POSTSCRIPT.ACCENTPAIR)
@@ -485,65 +481,6 @@
                                      IMPOPSTATE _ (FUNCTION \DSPPOPSTATE.PSC)))
     (SETQ *POSTSCRIPT-NS-HASH* (HARRAY 255))
     (\POSTSCRIPT.NSHASH
 *POSTSCRIPT-NS-TRANSLATIONS*])
-
-(READ-ADOBE-GLYPH-FILE

-  [LAMBDA (FILESPEC)
                                         (* ; "Edited 28-Jan-2024 19:46 by mth")

-
-    (* ;; "Read the file of PostScript glyphs as provided by Adobe at ")

-
-    (* ;; "         https://github.com/adobe-type-tools/agl-aglfn/glyphlist.txt")

-
-    (* ;; " The file is assumed to be local. (i.e., this does not fetch the file from github.com)")

-
-    (* ;; "")

-
-    (* ;; "The file format is:")

-
-    (* ;; "Comment lines begin with #, ignore these lines (as well as blank lines)")

-
-    (* ;; "Glyph lines consist of two semicolon delimited fields")

-
-    (* ;; "  (1)  glyph name -- upper/lowercase letters and digits")

-
-    (* ;; "  (2) Unicode scalar value -- four uppercase hexadecimal digits")

-
-    (* ;; "* Note that some entries have multiple Unicode values. ")

-
-    (* ;; "   These are cases of a single glyph name for composite character. ")

-
-    (* ;; "      These must be handled separately. ")

-
-    (* ;; 
-
    "      (It might work just to ignore them as the composite characters may just work separately.)")

-
-    (* ;; "")

-
-    (* ;; "Result is a list of (glyph-name-string  Unicode-values)")

-
-    (CL:WITH-OPEN-FILE (STREAM FILESPEC :DIRECTION :INPUT :EXTERNAL-FORMAT :UTF-8-RAW)
-           (bind
 LINE NAME CODE SPLIT START [SEPBITTABLE _ (MAKEBITTABLE (CHARCODE (TAB SPACE]
-              while
 (AND (SETQ LINE (CL:READ-LINE STREAM NIL NIL))
-                         (SETQ LINE (CL:STRING-TRIM " " LINE)))
-              when
 (SETQ START (STRPOSL SEPBITTABLE LINE 1 T))
-              unless
 [OR (STREQUAL LINE "")
-                         (EQ (CHARCODE %#)
-                             (NTHCHARCODE LINE START))
-                         (NOT (SETQ SPLIT (STRPOS ";" LINE]
-              collect
                                        (* (PROGN (SETQ NAME
-
                                                             (CL:STRING-RIGHT-TRIM " "
-
                                                             (SUBSTRING LINE START
-
                                                             (SUB1 SPLIT)))) (SETQ CODE
-
                                                             (HEXNUM? (SUBSTRING LINE
-
                                                             (ADD1 SPLIT)))) (LIST CODE NAME)))

-                    (CONS (PROG1 (CL:STRING-RIGHT-TRIM " " (SUBSTRING LINE START (SUB1 SPLIT)))
-                              (SETQ START (ADD1 SPLIT)))
-                          (bind
 END while
 [SETQ END (OR (STRPOSL SEPBITTABLE LINE START)
-                                                        (ADD1 (NCHARS LINE]
-                             collect
 [HEXNUM? (SUBSTRING LINE START (SUB1 END)
-                                                     (CONSTANT (CONCAT]
-                             repeatwhile
 (AND (SETQ START (STRPOSL SEPBITTABLE LINE END T))
-                                              (NEQ (CHARCODE %#)
-                                                   (NTHCHARCODE LINE START])
 )
 
 (ADDTOVAR DEFAULTFILETYPELIST
 (PS . TEXT)
@@ -3134,9 +3071,6 @@
 
 (* ;; "Character-output, plus special-cases:")

 
-
-(FILESLOAD (SYSLOAD)
-       UNICODE)
 (DEFINEQ
 
 (\POSTSCRIPT.CHANGECHARSET

@@ -4448,40 +4382,39 @@
 
 (ADDTOVAR LAMA
 POSTSCRIPT.PUTCOMMAND)
 )
-(PUTPROPS POSTSCRIPTSTREAM COPYRIGHT (NONE))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (22342 32527 (POSTSCRIPT.INIT 22352 . 29444) (READ-ADOBE-GLYPH-FILE 29446 . 32525)) (
-33507 68291 (PSCFONT.READFONT 33517 . 35425) (PSCFONT.SPELLFILE 35427 . 36005) (PSCFONT.COERCEFILE 
-36007 . 37579) (PSCFONTFROMCACHE.SPELLFILE 37581 . 38566) (PSCFONTFROMCACHE.COERCEFILE 38568 . 40220) 
-(PSCFONT.WRITEFONT 40222 . 41237) (READ-AFM-FILE 41239 . 47110) (CONVERT-AFM-FILES 47112 . 48324) (
-POSTSCRIPT.GETFONTID 48326 . 49721) (POSTSCRIPT.FONTCREATE 49723 . 62122) (
-\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 62124 . 64521) (POSTSCRIPT.FONTSAVAILABLE 64523 . 68289)) (68846 
-77992 (OPENPOSTSCRIPTSTREAM 68856 . 77658) (CLOSEPOSTSCRIPTSTREAM 77660 . 77990)) (78037 84329 (
-POSTSCRIPT.HARDCOPYW 78047 . 81396) (POSTSCRIPT.TEDIT 81398 . 81878) (POSTSCRIPT.TEXT 81880 . 82171) (
-POSTSCRIPTFILEP 82173 . 83280) (MAKEEPSFILE 83282 . 84327)) (84330 129216 (POSTSCRIPT.BITMAPSCALE 
-84340 . 86796) (POSTSCRIPT.CLOSESTRING 86798 . 87332) (POSTSCRIPT.ENDPAGE 87334 . 88205) (
-POSTSCRIPT.OUTSTR 88207 . 89228) (POSTSCRIPT.PUTBITMAPBYTES 89230 . 97701) (POSTSCRIPT.PUTCOMMAND 
-97703 . 98752) (POSTSCRIPT.SET-FAKE-LANDSCAPE 98754 . 104202) (POSTSCRIPT.SHOWACCUM 104204 . 106442) (
-POSTSCRIPT.STARTPAGE 106444 . 109023) (\POSTSCRIPTTAB 109025 . 109896) (\PS.BOUTFIXP 109898 . 111248) 
-(\PS.SCALEHACK 111250 . 114079) (\PS.SCALEREGION 114081 . 114641) (\SCALEDBITBLT.PSC 114643 . 118943) 
-(\SETPOS.PSC 118945 . 119407) (\SETXFORM.PSC 119409 . 121228) (\STRINGWIDTH.PSC 121230 . 121684) (
-\SWITCHFONTS.PSC 121686 . 127843) (\TERPRI.PSC 127845 . 129214)) (129251 184971 (\BITBLT.PSC 129261 . 
-129814) (\BLTSHADE.PSC 129816 . 134098) (\CHARWIDTH.PSC 134100 . 134867) (\CREATECHARSET.PSC 134869 . 
-136567) (\DRAWARC.PSC 136569 . 139049) (\DRAWCIRCLE.PSC 139051 . 141460) (\DRAWCURVE.PSC 141462 . 
-145483) (\DRAWELLIPSE.PSC 145485 . 147962) (\DRAWLINE.PSC 147964 . 150314) (\DRAWPOINT.PSC 150316 . 
-150904) (\DRAWPOLYGON.PSC 150906 . 154020) (\DSPBOTTOMMARGIN.PSC 154022 . 154587) (
-\DSPCLIPPINGREGION.PSC 154589 . 156032) (\DSPCOLOR.PSC 156034 . 156875) (\DSPFONT.PSC 156877 . 161087)
- (\DSPLEFTMARGIN.PSC 161089 . 161658) (\DSPLINEFEED.PSC 161660 . 162236) (\DSPPUSHSTATE.PSC 162238 . 
-164001) (\DSPPOPSTATE.PSC 164003 . 166512) (\DSPRESET.PSC 166514 . 167160) (\DSPRIGHTMARGIN.PSC 167162
- . 167734) (\DSPROTATE.PSC 167736 . 168759) (\DSPSCALE.PSC 168761 . 169692) (\DSPSCALE2.PSC 169694 . 
-170513) (\DSPSPACEFACTOR.PSC 170515 . 171487) (\DSPTOPMARGIN.PSC 171489 . 172206) (\DSPTRANSLATE.PSC 
-172208 . 174782) (\DSPXPOSITION.PSC 174784 . 175383) (\DSPYPOSITION.PSC 175385 . 175957) (
-\FILLCIRCLE.PSC 175959 . 178605) (\FILLPOLYGON.PSC 178607 . 182523) (\FIXLINELENGTH.PSC 182525 . 
-184019) (\MOVETO.PSC 184021 . 184772) (\NEWPAGE.PSC 184774 . 184969)) (185065 208217 (
-\POSTSCRIPT.CHANGECHARSET 185075 . 185879) (\POSTSCRIPT.OUTCHARFN 185881 . 198738) (
-\POSTSCRIPT.PRINTSLUG 198740 . 200707) (\POSTSCRIPT.SPECIALOUTCHARFN 200709 . 203141) (\UPDATE.PSC 
-203143 . 204366) (\POSTSCRIPT.ACCENTFN 204368 . 205310) (\POSTSCRIPT.ACCENTPAIR 205312 . 208215)) (
-208315 209960 (\PSC.SPACEDISP 208325 . 208604) (\PSC.SPACEWID 208606 . 209225) (\PSC.SYMBOLS 209227 . 
-209958)) (210069 213060 (\POSTSCRIPT.NSHASH 210079 . 213058)) (257535 258249 (POSTSCRIPTSEND 257545 . 
-258247)))))
+  (FILEMAP (NIL (22199 29303 (POSTSCRIPT.INIT 22209 . 29301)) (30283 65067 (PSCFONT.READFONT 30293 . 
+32201) (PSCFONT.SPELLFILE 32203 . 32781) (PSCFONT.COERCEFILE 32783 . 34355) (
+PSCFONTFROMCACHE.SPELLFILE 34357 . 35342) (PSCFONTFROMCACHE.COERCEFILE 35344 . 36996) (
+PSCFONT.WRITEFONT 36998 . 38013) (READ-AFM-FILE 38015 . 43886) (CONVERT-AFM-FILES 43888 . 45100) (
+POSTSCRIPT.GETFONTID 45102 . 46497) (POSTSCRIPT.FONTCREATE 46499 . 58898) (
+\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 58900 . 61297) (POSTSCRIPT.FONTSAVAILABLE 61299 . 65065)) (65622 
+74768 (OPENPOSTSCRIPTSTREAM 65632 . 74434) (CLOSEPOSTSCRIPTSTREAM 74436 . 74766)) (74813 81105 (
+POSTSCRIPT.HARDCOPYW 74823 . 78172) (POSTSCRIPT.TEDIT 78174 . 78654) (POSTSCRIPT.TEXT 78656 . 78947) (
+POSTSCRIPTFILEP 78949 . 80056) (MAKEEPSFILE 80058 . 81103)) (81106 125992 (POSTSCRIPT.BITMAPSCALE 
+81116 . 83572) (POSTSCRIPT.CLOSESTRING 83574 . 84108) (POSTSCRIPT.ENDPAGE 84110 . 84981) (
+POSTSCRIPT.OUTSTR 84983 . 86004) (POSTSCRIPT.PUTBITMAPBYTES 86006 . 94477) (POSTSCRIPT.PUTCOMMAND 
+94479 . 95528) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95530 . 100978) (POSTSCRIPT.SHOWACCUM 100980 . 103218) (
+POSTSCRIPT.STARTPAGE 103220 . 105799) (\POSTSCRIPTTAB 105801 . 106672) (\PS.BOUTFIXP 106674 . 108024) 
+(\PS.SCALEHACK 108026 . 110855) (\PS.SCALEREGION 110857 . 111417) (\SCALEDBITBLT.PSC 111419 . 115719) 
+(\SETPOS.PSC 115721 . 116183) (\SETXFORM.PSC 116185 . 118004) (\STRINGWIDTH.PSC 118006 . 118460) (
+\SWITCHFONTS.PSC 118462 . 124619) (\TERPRI.PSC 124621 . 125990)) (126027 181747 (\BITBLT.PSC 126037 . 
+126590) (\BLTSHADE.PSC 126592 . 130874) (\CHARWIDTH.PSC 130876 . 131643) (\CREATECHARSET.PSC 131645 . 
+133343) (\DRAWARC.PSC 133345 . 135825) (\DRAWCIRCLE.PSC 135827 . 138236) (\DRAWCURVE.PSC 138238 . 
+142259) (\DRAWELLIPSE.PSC 142261 . 144738) (\DRAWLINE.PSC 144740 . 147090) (\DRAWPOINT.PSC 147092 . 
+147680) (\DRAWPOLYGON.PSC 147682 . 150796) (\DSPBOTTOMMARGIN.PSC 150798 . 151363) (
+\DSPCLIPPINGREGION.PSC 151365 . 152808) (\DSPCOLOR.PSC 152810 . 153651) (\DSPFONT.PSC 153653 . 157863)
+ (\DSPLEFTMARGIN.PSC 157865 . 158434) (\DSPLINEFEED.PSC 158436 . 159012) (\DSPPUSHSTATE.PSC 159014 . 
+160777) (\DSPPOPSTATE.PSC 160779 . 163288) (\DSPRESET.PSC 163290 . 163936) (\DSPRIGHTMARGIN.PSC 163938
+ . 164510) (\DSPROTATE.PSC 164512 . 165535) (\DSPSCALE.PSC 165537 . 166468) (\DSPSCALE2.PSC 166470 . 
+167289) (\DSPSPACEFACTOR.PSC 167291 . 168263) (\DSPTOPMARGIN.PSC 168265 . 168982) (\DSPTRANSLATE.PSC 
+168984 . 171558) (\DSPXPOSITION.PSC 171560 . 172159) (\DSPYPOSITION.PSC 172161 . 172733) (
+\FILLCIRCLE.PSC 172735 . 175381) (\FILLPOLYGON.PSC 175383 . 179299) (\FIXLINELENGTH.PSC 179301 . 
+180795) (\MOVETO.PSC 180797 . 181548) (\NEWPAGE.PSC 181550 . 181745)) (181803 204955 (
+\POSTSCRIPT.CHANGECHARSET 181813 . 182617) (\POSTSCRIPT.OUTCHARFN 182619 . 195476) (
+\POSTSCRIPT.PRINTSLUG 195478 . 197445) (\POSTSCRIPT.SPECIALOUTCHARFN 197447 . 199879) (\UPDATE.PSC 
+199881 . 201104) (\POSTSCRIPT.ACCENTFN 201106 . 202048) (\POSTSCRIPT.ACCENTPAIR 202050 . 204953)) (
+205053 206698 (\PSC.SPACEDISP 205063 . 205342) (\PSC.SPACEWID 205344 . 205963) (\PSC.SYMBOLS 205965 . 
+206696)) (206807 209798 (\POSTSCRIPT.NSHASH 206817 . 209796)) (254273 254987 (POSTSCRIPTSEND 254283 . 
+254985)))))
 STOP

lispusers/MODERNIZE

@@ -1,12 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "29-Oct-2023 10:56:48" {WMEDLEY}<lispusers>MODERNIZE.;48
 30909  
+
(FILECREATED "27-Jan-2024 13:38:15" {DSK}<home>frank>il>medley>gmedley>lispusers>MODERNIZE.;7
 30816  
 
-      :EDIT-BY rmk
+      :CHANGES-TO (FNS \MODERNIZED.TEDIT.BUTTONEVENTFN)
 
-      :CHANGES-TO (FNS NEARESTCORNER)
-
-      :PREVIOUS-DATE "29-Jul-2023 10:48:55" {WMEDLEY}<lispusers>MODERNIZE.;47)
+      :PREVIOUS-DATE "27-Jan-2024 13:28:36" {DSK}<home>frank>il>medley>gmedley>lispusers>MODERNIZE.;6
+)
 
 
 (PRETTYCOMPRINT MODERNIZECOMS)
@@ -368,26 +367,24 @@
          (\CURSORPOSITION X Y])
 
 (INCORNER.REGION

-  [LAMBDA (CORNERREGION TOPMARGIN)
                      (* ; "Edited 13-Oct-2021 15:04 by rmk:")

+  [LAMBDA (CORNERREGION TOPMARGIN)
                          (* ; "Edited 13-Oct-2021 15:04 by rmk:")

 
     (* ;; "CORNERREGION, LASTMOUSEX, LASTMOUSEY in screen coordinates.")

 
     (* ;; "TOPMARGIN is the height of the titlebar for titled windows, otherwise the margin at the top of the window's content that we regard as the top. ")

 
-    (IF
 (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH
 LEFT OF
 CORNERREGION)))
-                  MODERN-WINDOW-MARGIN)
-        THEN
 (IF
 (NEARTOP
 CORNERREGION TOPMARGIN)
-                     THEN
 'LEFTTOP
-                   ELSEIF
 (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (FETCH
 BOTTOM
-                                                                              OF
 CORNERREGION)))
-                     THEN
 'LEFTBOTTOM)
-      ELSEIF
 (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH
 RIGHT OF
 CORNERREGION)))
-                       MODERN-WINDOW-MARGIN)
-        THEN
 (IF
 (NEARTOP
 CORNERREGION TOPMARGIN)
-                     THEN
 'RIGHTTOP
-                   ELSEIF
 (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (FETCH
 BOTTOM
-                                                                              OF
 CORNERREGION)))
-                     THEN
 'RIGHTBOTTOM])
+    (if
 (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (fetch
 LEFT of
 CORNERREGION)))
+              MODERN-WINDOW-MARGIN)
+        then
 (if
 (NEARTOP
 CORNERREGION TOPMARGIN)
+                 then
 'LEFTTOP
+               elseif
 (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (fetch
 BOTTOM of
 CORNERREGION)))
+                 then
 'LEFTBOTTOM)
+      elseif
 (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (fetch
 RIGHT of
 CORNERREGION)))
+                   MODERN-WINDOW-MARGIN)
+        then
 (if
 (NEARTOP
 CORNERREGION TOPMARGIN)
+                 then
 'RIGHTTOP
+               elseif
 (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (fetch
 BOTTOM of
 CORNERREGION)))
+                 then
 'RIGHTBOTTOM])
 )
 
 
@@ -510,9 +507,11 @@
     (* ;; "We pass the pane that received the click, because that's what the original \TEDIT.BUTTONEVENTFN needs to see, if we decide not to shape or move.")

 
     (MODERNWINDOW.BUTTONEVENTFN
 W (FUNCTION MODERN-ORIG-\TEDIT.BUTTONEVENTFN)
-           NIL NIL [APPLY (FUNCTION UNIONREGIONS)
-                          (bind
 PANE _ (CENTRALWINDOW W) collect
 (WINDOWPROP PANE 'REGION)
-                             repeatwhile
 (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN]
+           NIL
+           (WINDOWPROP W 'MODERNIZE.TITLEPROPORTION)
+           [APPLY (FUNCTION UNIONREGIONS)
+                  (bind
 PANE _ (CENTRALWINDOW W) collect
 (WINDOWPROP PANE 'REGION)
+                     repeatwhile
 (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN]
            (WINDOWPROP (CENTRALWINDOW W)
                   'TITLE])
 )
@@ -615,11 +614,11 @@
 (ADDTOVAR LAMA
 MODERN-ADD-EXEC)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5048 11410 (MODERNWINDOW 5058 . 6598) (MODERNWINDOW.SETUP 6600 . 9549) (UNMODERNWINDOW 
-9551 . 9945) (MODERNWINDOW.UNSETUP 9947 . 10759) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10761 . 11408)) (
-11475 22625 (MODERNWINDOW.BUTTONEVENTFN 11485 . 18512) (NEARTOP 18514 . 19442) (NEARESTCORNER 19444 . 
-21311) (INCORNER.REGION 21313 . 22623)) (22683 25155 (MODERN-ADD-EXEC 22693 . 23124) (MODERN-SNAPW 
-23126 . 23669) (TOTOPW.MODERNIZE 23671 . 24099) (MODERN-MENUBUTTONFN 24101 . 25153)) (25156 27585 (
-\MODERNIZED.FREEMENU.BUTTONEVENTFN 25166 . 25813) (MODERNIZED.TB.BUTTONEVENTFN 25815 . 27583)) (27626 
-29148 (TEDIT.MODERNIZE 27636 . 27989) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27991 . 29146)))))
+  (FILEMAP (NIL (5095 11457 (MODERNWINDOW 5105 . 6645) (MODERNWINDOW.SETUP 6647 . 9596) (UNMODERNWINDOW 
+9598 . 9992) (MODERNWINDOW.UNSETUP 9994 . 10806) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10808 . 11455)) (
+11522 22488 (MODERNWINDOW.BUTTONEVENTFN 11532 . 18559) (NEARTOP 18561 . 19489) (NEARESTCORNER 19491 . 
+21358) (INCORNER.REGION 21360 . 22486)) (22546 25018 (MODERN-ADD-EXEC 22556 . 22987) (MODERN-SNAPW 
+22989 . 23532) (TOTOPW.MODERNIZE 23534 . 23962) (MODERN-MENUBUTTONFN 23964 . 25016)) (25019 27448 (
+\MODERNIZED.FREEMENU.BUTTONEVENTFN 25029 . 25676) (MODERNIZED.TB.BUTTONEVENTFN 25678 . 27446)) (27489 
+29055 (TEDIT.MODERNIZE 27499 . 27852) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27854 . 29053)))))
 STOP