Compare commits
1 Commits
medley-240
...
mth3--Exte
| Author | SHA1 | Date | |
|---|---|---|---|
|
7f9eb4d0ff |
@@ -1,17 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Feb-2024 16:29:44" {LIB}DATABASEFNS.;15 17624
|
||||
(FILECREATED "27-Oct-2021 10:55:18" {DSK}<home>larry>medley>library>DATABASEFNS.;7 16051
|
||||
|
||||
:EDIT-BY "mth"
|
||||
changes to%: (FNS DUMPDB)
|
||||
|
||||
:CHANGES-TO (VARS DATABASEFNSCOMS)
|
||||
(FNS DUMPDB)
|
||||
|
||||
:PREVIOUS-DATE "27-Oct-2021 10:55:18" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;1)
|
||||
previous date%: "24-Oct-2021 20:18:51" {DSK}<home>larry>medley>library>DATABASEFNS.;6)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
||||
Copyright (c) 1986, 1990-1993 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT DATABASEFNSCOMS)
|
||||
@@ -34,8 +31,7 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
||||
(INITVARS (LOADDBFLG 'ASK)
|
||||
(SAVEDBFLG 'ASK))
|
||||
(ADDVARS (MAKEFILEFORMS (MAKEDB FILE)))
|
||||
(INITVARS (MSFILETABLE)
|
||||
(DEFAULTDATABASECOPYRIGHTOWNER 'NEVER))
|
||||
(INITVARS (MSFILETABLE))
|
||||
(* ; "To permit MSHASH interface")
|
||||
(LOCALVARS . T)
|
||||
(BLOCKS (LOADDB LOADDB DBFILE DBFILE1 DBFILE2 (NOLINKFNS . T)))
|
||||
@@ -165,52 +161,26 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(DUMPDB
|
||||
[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:")
|
||||
[LAMBDA (FILE PROPFLG) (* ;
|
||||
"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)
|
||||
(SPECVARS DEFAULTDATABASECOPYRIGHTOWNER COPYRIGHTFLG DEFAULTCOPYRIGHTOWNER))
|
||||
(DECLARE (GLOBALVARS MSFILETABLE SAVEDBFLG))
|
||||
(CL:WHEN (AND FILE (OR (LITATOM FILE)
|
||||
(STRINGP 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))))
|
||||
(PROG (DBFILE (FL (NAMEFIELD FILE))
|
||||
(FNS (FILEFNSLST FILE)))
|
||||
(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))
|
||||
@@ -223,7 +193,8 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
||||
(AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
|
||||
(CL:WHEN MSFILETABLE
|
||||
[STORETABLE FL MSFILETABLE (CAR (GETPROP FL 'FILEDATES])
|
||||
[SETQ DBFILE (PRETTYDEF NIL DBFN
|
||||
[SETQ DBFILE (PRETTYDEF NIL (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL
|
||||
'BODY FILE)
|
||||
`((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
|
||||
(ERROR!)))
|
||||
(E [PRINT (CAR (GETPROP ',FILE 'FILEDATES]
|
||||
@@ -232,9 +203,9 @@ Copyright (c) 1986, 1990-1993, 2024 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
|
||||
@@ -350,8 +321,6 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
||||
|
||||
(RPAQ? MSFILETABLE )
|
||||
|
||||
(RPAQ? DEFAULTDATABASECOPYRIGHTOWNER 'NEVER)
|
||||
|
||||
|
||||
|
||||
(* ; "To permit MSHASH interface")
|
||||
@@ -368,9 +337,9 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
||||
|
||||
(RESETSAVE DWIMIFYCOMPFLG T)
|
||||
)
|
||||
(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993 2024))
|
||||
(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993))
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,11 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "27-Jan-2024 13:38:15" {DSK}<home>frank>il>medley>gmedley>lispusers>MODERNIZE.;7 30816
|
||||
(FILECREATED "29-Oct-2023 10:56:48" {WMEDLEY}<lispusers>MODERNIZE.;48 30909
|
||||
|
||||
:CHANGES-TO (FNS \MODERNIZED.TEDIT.BUTTONEVENTFN)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "27-Jan-2024 13:28:36" {DSK}<home>frank>il>medley>gmedley>lispusers>MODERNIZE.;6
|
||||
)
|
||||
:CHANGES-TO (FNS NEARESTCORNER)
|
||||
|
||||
:PREVIOUS-DATE "29-Jul-2023 10:48:55" {WMEDLEY}<lispusers>MODERNIZE.;47)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MODERNIZECOMS)
|
||||
@@ -367,24 +368,26 @@
|
||||
(\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])
|
||||
)
|
||||
|
||||
|
||||
@@ -507,11 +510,9 @@
|
||||
(* ;; "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
|
||||
(WINDOWPROP W 'MODERNIZE.TITLEPROPORTION)
|
||||
[APPLY (FUNCTION UNIONREGIONS)
|
||||
(bind PANE _ (CENTRALWINDOW W) collect (WINDOWPROP PANE 'REGION)
|
||||
repeatwhile (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN]
|
||||
NIL NIL [APPLY (FUNCTION UNIONREGIONS)
|
||||
(bind PANE _ (CENTRALWINDOW W) collect (WINDOWPROP PANE 'REGION)
|
||||
repeatwhile (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN]
|
||||
(WINDOWPROP (CENTRALWINDOW W)
|
||||
'TITLE])
|
||||
)
|
||||
@@ -614,11 +615,11 @@
|
||||
(ADDTOVAR LAMA MODERN-ADD-EXEC)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
159
sources/PRETTY
159
sources/PRETTY
@@ -1,16 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 8-Feb-2023 16:21:26" {DSK}<home>larry>il>medley>sources>PRETTY.;3 65500
|
||||
(FILECREATED " 2-Feb-2024 17:54:23" {DSK}<mnt>e>Interlisp>medley>sources>PRETTY.;2 66897
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS PRINTDATE1)
|
||||
:CHANGES-TO (FNS PRINTCOPYRIGHT1 PRINTCOPYRIGHT)
|
||||
|
||||
:PREVIOUS-DATE "19-Jan-2022 20:35:18" {DSK}<home>larry>il>medley>sources>PRETTY.;1)
|
||||
:PREVIOUS-DATE " 8-Feb-2023 16:21:26" {DSK}<mnt>e>Interlisp>medley>sources>PRETTY.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984-1990, 1999, 2018, 2023 by Venue & Xerox Corporation.
|
||||
Copyright (c) 1984-1990, 1999, 2018, 2023-2024 by Venue & Xerox Corporation.
|
||||
The following program was created in 1984 but has not been published
|
||||
within the meaning of the copyright law, is furnished under license,
|
||||
and may not be used, copied and/or disclosed except in accordance
|
||||
@@ -491,14 +491,15 @@ must replace the declare: by a nop addvars.") (SETQ PRTTYCOM (SUBPAIR (QUOTE (NL
|
||||
(DEFINEQ
|
||||
|
||||
(PRINTCOPYRIGHT
|
||||
[LAMBDA (FILENAME) (* ; "Edited 11-Sep-2021 09:07 by larry")
|
||||
(* ; "Edited 31-Aug-99 09:01 by rmk:")
|
||||
[LAMBDA (FILENAME) (* ; "Edited 2-Feb-2024 17:18 by mth")
|
||||
(* ; "Edited 11-Sep-2021 09:07 by larry")
|
||||
(* ; "Edited 31-Aug-99 09:01 by rmk:")
|
||||
(* edited%: " 1-Jan-85 20:16")
|
||||
|
||||
(* ;;; "CALLED BY PRETTYDEF TO PUT a copyright notice on a file. The globalvar COPYRIGHTOWNERS is used to determine the possible copyright owners when it is determined the file doesn't have a copyright yet and has never been asked if the programmer wanted one. The whole copyright mechanism can be turned off by setting COPYRIGHTFLG to NEVER -- originaly NIL. If the file is copyrighted, any year the file is editted the new year is tacked on to the list of copyright years. The copyright notice comes immediately after the FILECREATED expression ")
|
||||
|
||||
(* ;;
|
||||
"9/10/2021 LMM: Add COPYRIGHTFLG value PRESERVE meaning no new copyright (or year) but retain old")
|
||||
"9/10/2021 LMM: Add COPYRIGHTFLG value PRESERVE meaning no new copyright (or year) but retain old")
|
||||
|
||||
(PROG [(OWNER (GETPROP FILENAME 'COPYRIGHT]
|
||||
(AND [OR OWNER
|
||||
@@ -520,14 +521,14 @@ must replace the declare: by a nop addvars.") (SETQ PRTTYCOM (SUBPAIR (QUOTE (NL
|
||||
(CADR X)
|
||||
'CONFIRMFLG T]
|
||||
(CONS (if (SETQ OWNER (ASSOC DEFAULTCOPYRIGHTOWNER
|
||||
COPYRIGHTOWNERS))
|
||||
COPYRIGHTOWNERS))
|
||||
then (LIST (CONSTANT (CHARACTER (CHARCODE LF)))
|
||||
(CONCAT DEFAULTCOPYRIGHTOWNER "
|
||||
(CONCAT DEFAULTCOPYRIGHTOWNER "
|
||||
")
|
||||
'EXPLAINSTRING
|
||||
(CONCAT "<LF> - " (CADR OWNER)
|
||||
" [Default]")
|
||||
'NOECHOFLG T 'RETURN (CADR OWNER))
|
||||
'EXPLAINSTRING
|
||||
(CONCAT "<LF> - " (CADR OWNER)
|
||||
" [Default]")
|
||||
'NOECHOFLG T 'RETURN (CADR OWNER))
|
||||
else '(%
|
||||
"No copyright notice now
|
||||
" EXPLAINSTRING "<LF> - no copyright notice now [Default]" NOECHOFLG T RETURN NIL))
|
||||
@@ -537,67 +538,85 @@ must replace the declare: by a nop addvars.") (SETQ PRTTYCOM (SUBPAIR (QUOTE (NL
|
||||
(COND
|
||||
((NEQ (CAR OWNER)
|
||||
'NONE)
|
||||
(PROG ((CURRENTYEAR (SUBATOM (DATE (DATEFORMAT YEAR.LONG NO.TIME))
|
||||
-4 -1)))
|
||||
[PROG ((CURRENTYEAR (SUBATOM (DATE (DATEFORMAT YEAR.LONG NO.TIME))
|
||||
-4 -1))
|
||||
LATESTOWNER)
|
||||
|
||||
(* ;; " see github Interlisp/medley issue #207 (lmm 9/11/2021)")
|
||||
|
||||
(OR (EQ COPYRIGHTFLG 'PRESERVE)
|
||||
(MEMBER CURRENTYEAR (CDR OWNER))
|
||||
(NCONC1 OWNER CURRENTYEAR)))
|
||||
(if (NEQ COPYRIGHTFLG 'PRESERVE)
|
||||
then (if (LISTP (CAR OWNER))
|
||||
then (SETQ LATESTOWNER (CAR (LAST OWNER)))
|
||||
else (SETQ LATESTOWNER OWNER))
|
||||
(if (NEQ CURRENTYEAR (CAR (LAST LATESTOWNER)))
|
||||
then (NCONC1 LATESTOWNER CURRENTYEAR]
|
||||
(PRINTCOPYRIGHT1 OWNER])
|
||||
|
||||
(PRINTCOPYRIGHT1
|
||||
[LAMBDA (OWNER) (* ; "Edited 21-Feb-2021 10:58 by rmk:")
|
||||
(* ; "Edited 6-Apr-90 10:36 by jds")
|
||||
(PROG ((DATES (CDR OWNER))
|
||||
(SEMICOLON (AND (READTABLEPROP *READTABLE* 'COMMONLISP)
|
||||
"; "))
|
||||
(PRIVATE NIL))
|
||||
[LAMBDA (OWNER) (* ; "Edited 2-Feb-2024 17:45 by mth")
|
||||
(* ; "Edited 21-Feb-2021 10:58 by rmk:")
|
||||
(* ; "Edited 6-Apr-90 10:36 by jds")
|
||||
(PROG (DATES CREATEDYEAR (SEMICOLON (AND (READTABLEPROP *READTABLE* 'COMMONLISP)
|
||||
"; "))
|
||||
(PRIVATE NIL))
|
||||
(if (NOT (LISTP (CAR OWNER)))
|
||||
then (SETQ OWNER (LIST OWNER)) (* ;
|
||||
"Make the old format into the new format")
|
||||
)
|
||||
(COND
|
||||
((EQ (CAR DATES)
|
||||
T)
|
||||
(SETQ PRIVATE T)
|
||||
(pop DATES)))
|
||||
(COND
|
||||
(SEMICOLON (* ; "do CommonLisp style comment")
|
||||
(SEMICOLON (* ; "do CommonLisp style comment")
|
||||
(PRIN1 SEMICOLON))
|
||||
(T (* ;
|
||||
"Print IL-style comment, with a ; in it so the pretty printer will render it as a CL-style comment.")
|
||||
(T (* ;
|
||||
"Print IL-style comment, with a ; in it so the pretty printer will render it as a CL-style comment.")
|
||||
(printout NIL "(* ; %"" T)))
|
||||
(PRIN3 "Copyright (c) ")
|
||||
[for Y START END on DATES do (* ;
|
||||
"print years of copyright, e.g., 1985, 1986. Print intervals for successive years")
|
||||
(SETQ START (SETQ END (CAR Y)))
|
||||
(FOR NEXT IN (CDR Y)
|
||||
WHILE (EQ (ADD1 END)
|
||||
NEXT) DO (SETQ END NEXT)
|
||||
(POP Y))
|
||||
(PRIN3 START)
|
||||
(CL:UNLESS (EQ START END)
|
||||
(PRIN3 "-")
|
||||
(PRIN3 END))
|
||||
(COND
|
||||
((CDR Y)
|
||||
(PRIN3 ", "]
|
||||
(PRIN3 " by ")
|
||||
(PRIN3 (CAR OWNER))
|
||||
(PRIN3 ".")
|
||||
(for OT O on OWNER do [SETQ DATES (CDR (SETQ O (CAR OT]
|
||||
(COND
|
||||
((EQ (CAR DATES)
|
||||
T)
|
||||
(SETQ PRIVATE T)
|
||||
(pop DATES)))
|
||||
[for Y START END on DATES
|
||||
do (* ;
|
||||
"print years of copyright, e.g., 1985, 1986. Print intervals for successive years")
|
||||
(SETQ START (SETQ END (CAR Y)))
|
||||
|
||||
(* ;;
|
||||
"For the PRIVATE notice below. It is always the EARLIEST year")
|
||||
|
||||
(SETQ CREATEDYEAR (OR CREATEDYEAR START))
|
||||
(for NEXT in (CDR Y) while (EQ (ADD1 END)
|
||||
NEXT) do (SETQ END NEXT)
|
||||
(pop Y))
|
||||
(PRIN3 START)
|
||||
(CL:UNLESS (EQ START END)
|
||||
(PRIN3 "-")
|
||||
(PRIN3 END))
|
||||
(COND
|
||||
((CDR Y)
|
||||
(PRIN3 ", "]
|
||||
(PRIN3 " by ")
|
||||
(PRIN3 (CAR O))
|
||||
(PRIN3 ".")
|
||||
(if (CDR OT)
|
||||
then (TERPRI)
|
||||
(COND
|
||||
(SEMICOLON (PRIN1 SEMICOLON)))
|
||||
(PRIN3 " And ")))
|
||||
(AND COPYRIGHTSRESERVED (PRIN3 " All rights reserved."))
|
||||
(TERPRI)
|
||||
[COND
|
||||
(PRIVATE (for LINE in (CONS (CONCAT "The following program was created in "
|
||||
(CAR DATES)
|
||||
" but has not been published")
|
||||
'(
|
||||
(PRIVATE (for LINE in (CONS (CONCAT "The following program was created in " (CAR DATES)
|
||||
" but has not been published")
|
||||
'(
|
||||
"within the meaning of the copyright law, is furnished under license,"
|
||||
|
||||
|
||||
"and may not be used, copied and/or disclosed except in accordance"
|
||||
"with the terms of said license."))
|
||||
"with the terms of said license."))
|
||||
do (COND
|
||||
(SEMICOLON (PRIN1 SEMICOLON)))
|
||||
(PRIN3 LINE)
|
||||
(TERPRI]
|
||||
(SEMICOLON (PRIN1 SEMICOLON)))
|
||||
(PRIN3 LINE)
|
||||
(TERPRI]
|
||||
(COND
|
||||
((NOT SEMICOLON)
|
||||
(PRIN3 "%")")
|
||||
@@ -730,16 +749,16 @@ must replace the declare: by a nop addvars.") (SETQ PRTTYCOM (SUBPAIR (QUOTE (NL
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS PRETTY COPYRIGHT ("Venue & Xerox Corporation" T 1984 1985 1986 1987 1988 1989 1990 1999 2018
|
||||
2023))
|
||||
2023 2024))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5917 48569 (PRETTYDEF 5927 . 21600) (PRETTYDEFCOMS 21602 . 22284) (PRETTYDEF0 22286 .
|
||||
22477) (PRETTYDEF1 22479 . 24242) (PRINTDATE 24244 . 25480) (PRINTDATE1 25482 . 27260) (PRINTFNS 27262
|
||||
. 27831) (PRETTYCOM 27833 . 34174) (PRETTYVAR 34176 . 35214) (PRETTYVAR1 35216 . 37434) (PRETTYCOM1
|
||||
37436 . 38140) (ENDFILE 38142 . 38238) (MAKEDEFLIST 38240 . 38644) (PP 38646 . 38922) (PP* 38924 .
|
||||
39237) (PPT 39239 . 39558) (PRETTYPRINT 39560 . 42712) (PRETTYPRINT1 42714 . 44600) (PRETTYPRINT2
|
||||
44602 . 45918) (PRETTYPRINT3 45920 . 46875) (PRINTDEF1 46877 . 47813) (SUPERPRINTEQ 47815 . 47909) (
|
||||
SUPERPRINTGETPROP 47911 . 48055) (CHANGEFONT 48057 . 48567)) (48570 53916 (READARRAY 48580 . 49506) (
|
||||
PRINTARRAY 49508 . 51248) (READARRAY-FROM-LIST 51250 . 52355) (PRINTARRAY-TO-LIST 52357 . 53914)) (
|
||||
54043 61561 (PRINTCOPYRIGHT 54053 . 58130) (PRINTCOPYRIGHT1 58132 . 61256) (SAVECOPYRIGHT 61258 .
|
||||
61559)))))
|
||||
(FILEMAP (NIL (5946 48598 (PRETTYDEF 5956 . 21629) (PRETTYDEFCOMS 21631 . 22313) (PRETTYDEF0 22315 .
|
||||
22506) (PRETTYDEF1 22508 . 24271) (PRINTDATE 24273 . 25509) (PRINTDATE1 25511 . 27289) (PRINTFNS 27291
|
||||
. 27860) (PRETTYCOM 27862 . 34203) (PRETTYVAR 34205 . 35243) (PRETTYVAR1 35245 . 37463) (PRETTYCOM1
|
||||
37465 . 38169) (ENDFILE 38171 . 38267) (MAKEDEFLIST 38269 . 38673) (PP 38675 . 38951) (PP* 38953 .
|
||||
39266) (PPT 39268 . 39587) (PRETTYPRINT 39589 . 42741) (PRETTYPRINT1 42743 . 44629) (PRETTYPRINT2
|
||||
44631 . 45947) (PRETTYPRINT3 45949 . 46904) (PRINTDEF1 46906 . 47842) (SUPERPRINTEQ 47844 . 47938) (
|
||||
SUPERPRINTGETPROP 47940 . 48084) (CHANGEFONT 48086 . 48596)) (48599 53945 (READARRAY 48609 . 49535) (
|
||||
PRINTARRAY 49537 . 51277) (READARRAY-FROM-LIST 51279 . 52384) (PRINTARRAY-TO-LIST 52386 . 53943)) (
|
||||
54072 62953 (PRINTCOPYRIGHT 54082 . 58556) (PRINTCOPYRIGHT1 58558 . 62648) (SAVECOPYRIGHT 62650 .
|
||||
62951)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user