* PRINTFN: Allow suppression of gratuitous TERPRI in PFCOPYBYTES An odd feature of PFCOPYBYTES is that it was outputting a gratuitous EOL just in the case of copying a whole file, so copy-all+1. Don't know who depends on it as is, so I added an extra argument NOTERPRI to allow clients to suppress it. * Keep old editdates #359 Rework of the editdate capability, centralizing in EDITINTERFACE and removing the pieces that were also on FILEPKG. Also added a new capability--edit dates can include change-log-type information. See issue
This commit is contained in:
rmkaplan
GitHub
@@ -1,10 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "27-Nov-2021 13:28:18"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;2 37858
|
||||
(FILECREATED " 3-Dec-2021 15:45:20"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;19 45997
|
||||
|
||||
previous date%: " 7-Nov-91 18:15:13"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;1)
|
||||
changes to%: (VARS EDITINTERFACECOMS)
|
||||
(FNS FIXEDITDATE EDITDATE? EDITDATE)
|
||||
|
||||
previous date%: " 2-Dec-2021 23:20:07"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;7)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -34,7 +37,7 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
(FUNCTIONS ED INSTALL-PROTOTYPE-DEFN)
|
||||
(FNS EDITDEF.FNS EDITF EDITFB EDITFNS EDITLOADFNS? EDITMODE EDITP EDITV DC DF DP DV EDITPROP
|
||||
EF EP EV EDITE EDITL)
|
||||
[COMS
|
||||
(COMS
|
||||
(* ;; "Time stamp on functions when edited")
|
||||
|
||||
|
||||
@@ -44,8 +47,12 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
(INITVARS (INITIALS)
|
||||
(INITIALSLST)
|
||||
(DEFAULTINITIALS T))
|
||||
(VARIABLES *REPLACE-OLD-EDIT-DATES*)
|
||||
(P (MOVD? 'EDITDATE 'TTY/EDITDATE]
|
||||
(INITVARS (*REPLACE-OLD-EDIT-DATES* NIL))
|
||||
(P (MOVD? 'EDITDATE 'TTY/EDITDATE))
|
||||
(COMS (* ; "Moved from FILEPKG")
|
||||
[VARS (EDITDATE-ARGLIST-DEFINERS '(FUNCTIONS TYPES))
|
||||
(EDITDATE-NAME-DEFINERS '(STRUCTURES VARIABLES]
|
||||
(GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS)))
|
||||
[INITVARS (COMMON-SOURCE-MANAGER-TYPES '(FUNCTIONS VARIABLES STRUCTURES TYPES SETFS
|
||||
OPTIMIZERS]
|
||||
(PROP FILETYPE EDITINTERFACE)
|
||||
@@ -621,61 +628,207 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
OLDATE INITLS])
|
||||
|
||||
(FIXEDITDATE
|
||||
[LAMBDA (EXPR) (* NOBIND "18-JUL-78 21:11")
|
||||
(* ;
|
||||
"Inserts or replaces previous edit date")
|
||||
(AND INITIALS (LISTP EXPR)
|
||||
(FMEMB (CAR EXPR)
|
||||
LAMBDASPLST)
|
||||
(LISTP (CDR EXPR))
|
||||
(PROG ((E (CDDR EXPR)))
|
||||
RETRY
|
||||
[COND
|
||||
((NLISTP E)
|
||||
(RETURN))
|
||||
((LISTP (CAR E))
|
||||
(SELECTQ (CAAR E)
|
||||
((CLISP%: DECLARE)
|
||||
(SETQ E (CDR E))
|
||||
(GO RETRY))
|
||||
(BREAK1 (COND
|
||||
((EQ (CAR (CADAR E))
|
||||
'PROGN)
|
||||
(SETQ E (CDR (CADAR E)))
|
||||
(GO RETRY))))
|
||||
(ADV-PROG (* ;
|
||||
"No easy way to mark cleanly the date of an advised function")
|
||||
(RETURN))
|
||||
(COND
|
||||
((AND (EQ (CAAR E)
|
||||
COMMENTFLG)
|
||||
(EQ (CADAR E)
|
||||
'DECLARATIONS%:))
|
||||
[LAMBDA (EXPR)
|
||||
|
||||
(* ;; "Edited 3-Dec-2021 15:35 by rmk: Updated to add dates to the initial undated comments that begins with current-editor initials, to provide a kind of dated change-log capability.")
|
||||
(* ; "Edited 3-Dec-2021 15:03 by rmk")
|
||||
(* ; "Edited 22-Oct-2021 16:58 by rmk:")
|
||||
(* ; "Edited 27-Sep-2018 22:04 by rmk:")
|
||||
(* ; "Edited 31-Mar-2000 17:13 by rmk:")
|
||||
(* ; "Edited 17-Jul-89 11:13 by jtm:")
|
||||
(* ; "18-JUL-78 21:11")
|
||||
|
||||
(* ;; "Inserts or replaces previous edit date. This retains multiple edits (at least one day apart or by different editor) unless *REPLACE-OLD-EDIT-DATES*. Note that the new date doesn't show up within the current SEDIT session, you have to exit and re-edit to see it.")
|
||||
|
||||
(CL:WHEN (AND INITIALS (LISTP EXPR)
|
||||
(LISTP (CDR EXPR)))
|
||||
(PROG (E)
|
||||
|
||||
(* ;; "Normalize out the colon, add it back if needed.")
|
||||
|
||||
(COND
|
||||
((FMEMB (CAR EXPR)
|
||||
LAMBDASPLST)
|
||||
|
||||
(* ;; "insert the edit date after the argument list")
|
||||
|
||||
(SETQ E (CDDR EXPR)))
|
||||
[(FMEMB (GETPROP (CAR EXPR)
|
||||
':DEFINER-FOR)
|
||||
EDITDATE-ARGLIST-DEFINERS)
|
||||
|
||||
(* ;; "insert the edit date after the argument list")
|
||||
|
||||
(SETQ E (CDDR EXPR))
|
||||
(while (NOT (CL:LISTP (CAR E))) do (SETQ E (CDR E)) finally (SETQ E (CDR E]
|
||||
((FMEMB (GETPROP (CAR EXPR)
|
||||
':DEFINER- FOR)
|
||||
EDITDATE-NAME-DEFINERS)
|
||||
|
||||
(* ;; "insert the edit date after the name")
|
||||
|
||||
(SETQ E (CDDR EXPR)))
|
||||
(T (RETURN)))
|
||||
RETRY
|
||||
[COND
|
||||
((NLISTP E)
|
||||
(RETURN))
|
||||
((LISTP (CAR E))
|
||||
(SELECTQ (CAAR E)
|
||||
((CLISP%: DECLARE)
|
||||
(SETQ E (CDR E))
|
||||
(GO RETRY]
|
||||
(COND
|
||||
((AND (LISTP (CDR E))
|
||||
(EDITDATE? (CAR E)))
|
||||
(/RPLACA E (EDITDATE (CAR E)
|
||||
INITIALS)))
|
||||
(T (/ATTACH (EDITDATE NIL INITIALS)
|
||||
E)))
|
||||
(RETURN EXPR])
|
||||
(GO RETRY))
|
||||
(BREAK1 (COND
|
||||
((EQ (CAR (CADAR E))
|
||||
'PROGN)
|
||||
(SETQ E (CDR (CADAR E)))
|
||||
(GO RETRY))))
|
||||
(ADV-PROG (* ;
|
||||
"No easy way to mark cleanly the date of an advised function")
|
||||
(RETURN))
|
||||
(COND
|
||||
((AND (EQ (CAAR E)
|
||||
COMMENTFLG)
|
||||
(EQ (CADAR E)
|
||||
'DECLARATIONS%:))
|
||||
(SETQ E (CDR E))
|
||||
(GO RETRY]
|
||||
|
||||
(* ;; "E is now the cell that the date will attach to or whose CAR will be updated.")
|
||||
|
||||
(LET (PARSE (INITLS (CL:IF (EQ (CHARCODE %:)
|
||||
(NTHCHARCODE INITIALS -1))
|
||||
(SUBSTRING INITIALS 1 -2)
|
||||
INITIALS)))
|
||||
(IF *REPLACE-OLD-EDIT-DATES*
|
||||
THEN
|
||||
(* ;; "Strip out all previous modern-format edit dates. Since EDITDATE? only recognizes that format, hand editing is needed if prehistoric dates are really not desired. We don't strip out anything with a further comment.")
|
||||
|
||||
(BIND (TAIL _ E) WHILE (AND (LISTP TAIL)
|
||||
(EDITDATE? (CAR TAIL)))
|
||||
DO (SETQ TAIL (CDR TAIL)) FINALLY (CL:UNLESS (EQ E TAIL)
|
||||
(/RPLACD E TAIL)))
|
||||
|
||||
(* ;;
|
||||
"Now (CAR E) may or may not be a (no-REST) editdate, but there are none afterwards.")
|
||||
|
||||
(IF (SETQ PARSE (EDITDATE? (CAR E)
|
||||
T))
|
||||
THEN (* ; "Smash it")
|
||||
(EDITDATE (CAR E)
|
||||
INITLS
|
||||
(CADDR PARSE))
|
||||
ELSE (/ATTACH (EDITDATE NIL INITLS)
|
||||
E))
|
||||
ELSEIF (SETQ PARSE (EDITDATE? (CAR E)
|
||||
T))
|
||||
THEN
|
||||
(* ;; "Attach the new timestamp at the beginning of E, provided the new date is either more than a day later than the previous one or by a different editor.")
|
||||
|
||||
(* ;; "If edited by the same editor within a day, then update the previous timestamp rather than just leaving the original time. Presumably this is the next event in the same longer editing session, and it avoids stacking up uninformative dates from in-and-out editing during a session. ")
|
||||
|
||||
(IF (STRING.EQUAL INITLS (CADR PARSE))
|
||||
THEN
|
||||
|
||||
(* ;; "This is a previous date with this author. If more than a day later, add a new date. If less than a day, assume we are in essentially the same session, and update (CAR E) to the current time.")
|
||||
|
||||
[IF (OR (NULL (CAR PARSE))
|
||||
(IGREATERP (IDIFFERENCE (IDATE)
|
||||
(IDATE (CAR PARSE)))
|
||||
(TIMES 24 3600)))
|
||||
THEN
|
||||
(* ;; "If no date, must have been %"INITIALS: xxx%" and we definitely want to upgraded to the Edited... format")
|
||||
|
||||
(/ATTACH (EDITDATE NIL INITLS (CADDR PARSE))
|
||||
E)
|
||||
ELSE
|
||||
(* ;; "Same author, within a day. ")
|
||||
|
||||
(/RPLACA E (EDITDATE NIL INITLS (CADDR PARSE]
|
||||
ELSE
|
||||
(* ;;
|
||||
"Not a previous date, or not one with this author. Add a new one.")
|
||||
|
||||
(/ATTACH (EDITDATE NIL INITLS (CADDR PARSE))
|
||||
E))
|
||||
ELSE
|
||||
(* ;; "Need a new date, didn't even see %"<initials: xxx%"")
|
||||
|
||||
(/ATTACH (EDITDATE NIL INITLS)
|
||||
E)))
|
||||
(RETURN EXPR)))])
|
||||
|
||||
(EDITDATE?
|
||||
(LAMBDA (COMMENT) (* ; "Edited 29-Oct-87 16:41 by drc:") (* ;;; "Tests to see if a given common is in fact an edit date -- this has to be general enough to recognize the most comment comment forms while specific enough to not recognize things that are not edit dates. We settle for the conservative form of (* initials date-string), since only truly ancient edit dates look any different from that") (DECLARE (LOCALVARS . T)) (AND *REPLACE-OLD-EDIT-DATES* (LISTP COMMENT) (EQMEMB (CAR COMMENT) COMMENTFLG) (LISTP (CDR COMMENT)) (LISTP (CDDR COMMENT)) (NULL (CDDDR COMMENT)) (STRINGP (CADDR COMMENT)) (LET ((INITIALS? (CADR COMMENT))) (AND (NOT (EQMEMB INITIALS? COMMENTFLG)) (OR (EQ INITIALS? INITIALS) (if (LITATOM INITIALS?) then (if (for I from 1 to (NCHARS INITIALS?) always (EQ (NTHCHARCODE INITIALS? I) (CHARCODE ";"))) then (* ; " an sedit comment") (AND (EQ INITIALS? (QUOTE ;)) (STRPOS "Edited " (CADDR COMMENT) 1 NIL T) (>= (CL:LENGTH (CADDR COMMENT)) (CL:LENGTH "Edited 01-jan-86 00:00 by "))) else (* ; "an old-style comment") T) elseif (STRINGP INITIALS?) then (* ; "make sure it's not a string-body comment.") (ILESSP (NCHARS INITIALS?) 12)))))))
|
||||
)
|
||||
[LAMBDA (COMMENT RESTOK) (* ; "Edited 3-Dec-2021 14:35 by rmk")
|
||||
|
||||
(* ;;; "This determines whether this is a dated or initialed comment that is potentially reusable in the current context. Unless RESTOK, this only recognizes modern-format configurations of the form %"Edited <date> by <initials>%", and returns a parsed pair (DATE INITIALS).")
|
||||
|
||||
(* ;;; "If RESTOK, this also parses strings with additional stuff after the <initials> (%"Edited by <initials>: xxx%") and strings that appear to begin with initials but don't have a date (<initials>: xxx). In those cases the return is a triple (DATE INITIALS REST), where DATE may be NIL. ")
|
||||
|
||||
(* ;;; "")
|
||||
|
||||
(* ;;;
|
||||
"The caller can compare against current time and current user to decide whether to smash or add.")
|
||||
|
||||
(* ;;; "There is no harm in not recognizing prehistoric formats, new dates will always be added on.")
|
||||
|
||||
(LET ((TAIL COMMENT)
|
||||
STRING POS DATE I RESTPOS)
|
||||
(CL:WHEN [AND (EQ COMMENTFLG (CAR (LISTP TAIL)))
|
||||
(MEMB [CAR (LISTP (SETQ TAIL (CDR TAIL]
|
||||
'(; ;; ;;;))
|
||||
(STRINGP (SETQ STRING (CAR (SETQ TAIL (CDR TAIL]
|
||||
(SETQ STRING (CL:STRING-TRIM `(#\Space)
|
||||
STRING))
|
||||
(CL:UNLESS [AND [STREQUAL "Edited " (SUBSTRING STRING 1 8 (CONSTANT (CONCAT]
|
||||
(SETQ POS (STRPOS " by " STRING 9))
|
||||
[IDATE (SETQ DATE (SUBSTRING STRING 9 (SUB1 POS]
|
||||
(SETQ I (SUBSTRING STRING (IPLUS POS 4)
|
||||
(OR (SETQ RESTPOS (STRPOS " " STRING (IPLUS POS 4)))
|
||||
-1]
|
||||
|
||||
(* ;; "Could be %"<INITIALS>: abc%" to be upgraded with a date")
|
||||
|
||||
(SETQ RESTPOS (STRPOS " " STRING))
|
||||
(SETQ I (SUBSTRING STRING 1 (SUB1 RESTPOS))))
|
||||
(CL:WHEN (AND I (ILESSP (NCHARS I)
|
||||
12)) (* ;
|
||||
"Sanity check: Initials should be short.")
|
||||
(CL:WHEN (EQ (CHARCODE %:)
|
||||
(NTHCHARCODE I -1)) (* ;
|
||||
"Normalize out the colon in the return")
|
||||
(SETQ I (SUBSTRING I 1 -2)))
|
||||
(IF RESTOK
|
||||
THEN (LIST DATE I (AND RESTPOS (SUBSTRING STRING RESTPOS)))
|
||||
ELSEIF (AND DATE (NOT RESTPOS))
|
||||
THEN (LIST DATE I))))])
|
||||
|
||||
(EDITDATE
|
||||
[LAMBDA (OLDATE INITLS) (* ; "Edited 20-Nov-86 23:23 by Masinter")
|
||||
(* ;;
|
||||
"Generates a new date from an old one")
|
||||
(LET [(NEWDATE (LIST '; (CONCAT "Edited " (DATE (DATEFORMAT NO.SECONDS))
|
||||
" by " INITLS]
|
||||
[LAMBDA (OLDDATE INITLS REST)
|
||||
|
||||
(* ;; "Edited 3-Dec-2021 13:17 by rmk: Upgraded to make sure that the comment includes REST")
|
||||
(* ; " 20-Nov-86 23:23 by Masinter")
|
||||
|
||||
(* ;; "Generates a new date from an old one. Packs : onto INITLS if there is a REST. In the REST case we upgrade a singe semicolon to a double.")
|
||||
|
||||
(LET ((EDITSTRING (CONCAT "Edited " (DATE (DATEFORMAT NO.SECONDS))
|
||||
" by " INITLS))
|
||||
NEWDATE OLDSEMI)
|
||||
(CL:WHEN REST
|
||||
(SETQ EDITSTRING (CONCAT EDITSTRING ":" REST)))
|
||||
(CL:WHEN OLDDATE
|
||||
(SETQ OLDSEMI (CADR OLDDATE)))
|
||||
(SETQ NEWDATE (LIST (CL:IF REST
|
||||
(OR OLDSEMI ';;)
|
||||
';)
|
||||
EDITSTRING))
|
||||
(COND
|
||||
((EQMEMB (CAR (LISTP OLDATE))
|
||||
COMMENTFLG) (* ;; "Destructively alter old date. This is for benefit of DEDIT being able to find the old form to reprint")
|
||||
(/RPLACD OLDATE NEWDATE))
|
||||
((EQMEMB (CAR (LISTP OLDDATE))
|
||||
COMMENTFLG)
|
||||
|
||||
(* ;; "Destructively alter old date. This is for benefit of DEDIT being able to find the old form to reprint")
|
||||
|
||||
(/RPLACD OLDDATE NEWDATE))
|
||||
(T (CONS (OR (CAR (LISTP COMMENTFLG))
|
||||
COMMENTFLG)
|
||||
NEWDATE])
|
||||
@@ -718,11 +871,23 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
|
||||
(RPAQ? DEFAULTINITIALS T)
|
||||
|
||||
(CL:DEFVAR *REPLACE-OLD-EDIT-DATES* T
|
||||
"NIL or T; if NIL, old edit dates will not be replaced")
|
||||
(RPAQ? *REPLACE-OLD-EDIT-DATES* NIL)
|
||||
|
||||
(MOVD? 'EDITDATE 'TTY/EDITDATE)
|
||||
|
||||
|
||||
|
||||
(* ; "Moved from FILEPKG")
|
||||
|
||||
|
||||
(RPAQQ EDITDATE-ARGLIST-DEFINERS (FUNCTIONS TYPES))
|
||||
|
||||
(RPAQQ EDITDATE-NAME-DEFINERS (STRUCTURES VARIABLES))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS)
|
||||
)
|
||||
|
||||
(RPAQ? COMMON-SOURCE-MANAGER-TYPES '(FUNCTIONS VARIABLES STRUCTURES TYPES SETFS OPTIMIZERS))
|
||||
|
||||
(PUTPROPS EDITINTERFACE FILETYPE CL:COMPILE-FILE)
|
||||
@@ -736,11 +901,11 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS EDITINTERFACE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3710 10009 (ED 3710 . 10009)) (10011 13987 (INSTALL-PROTOTYPE-DEFN 10011 . 13987)) (
|
||||
13988 30771 (EDITDEF.FNS 13998 . 15334) (EDITF 15336 . 16216) (EDITFB 16218 . 17066) (EDITFNS 17068 .
|
||||
18388) (EDITLOADFNS? 18390 . 22190) (EDITMODE 22192 . 24202) (EDITP 24204 . 24715) (EDITV 24717 .
|
||||
25356) (DC 25358 . 26039) (DF 26041 . 27083) (DP 27085 . 28169) (DV 28171 . 28743) (EDITPROP 28745 .
|
||||
28964) (EF 28966 . 29295) (EP 29297 . 29480) (EV 29482 . 29661) (EDITE 29663 . 30541) (EDITL 30543 .
|
||||
30769)) (31121 37193 (NEW/EDITDATE 31131 . 31353) (FIXEDITDATE 31355 . 33197) (EDITDATE? 33199 . 34377
|
||||
) (EDITDATE 34379 . 35196) (SETINITIALS 35198 . 37191)))))
|
||||
(FILEMAP (NIL (4145 10444 (ED 4145 . 10444)) (10446 14422 (INSTALL-PROTOTYPE-DEFN 10446 . 14422)) (
|
||||
14423 31206 (EDITDEF.FNS 14433 . 15769) (EDITF 15771 . 16651) (EDITFB 16653 . 17501) (EDITFNS 17503 .
|
||||
18823) (EDITLOADFNS? 18825 . 22625) (EDITMODE 22627 . 24637) (EDITP 24639 . 25150) (EDITV 25152 .
|
||||
25791) (DC 25793 . 26474) (DF 26476 . 27518) (DP 27520 . 28604) (DV 28606 . 29178) (EDITPROP 29180 .
|
||||
29399) (EF 29401 . 29730) (EP 29732 . 29915) (EV 29917 . 30096) (EDITE 30098 . 30976) (EDITL 30978 .
|
||||
31204)) (31556 45142 (NEW/EDITDATE 31566 . 31788) (FIXEDITDATE 31790 . 39177) (EDITDATE? 39179 . 41888
|
||||
) (EDITDATE 41890 . 43145) (SETINITIALS 43147 . 45140)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
225
sources/FILEPKG
225
sources/FILEPKG
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 8-Nov-2021 10:52:49" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>FILEPKG.;15 284792
|
||||
(FILECREATED " 2-Dec-2021 23:35:54" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>FILEPKG.;17 278911
|
||||
|
||||
changes to%: (FNS COMPAREDEFS)
|
||||
changes to%: (VARS FILEPKGCOMS)
|
||||
|
||||
previous date%: "30-Oct-2021 20:03:07"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>FILEPKG.;14)
|
||||
previous date%: " 1-Dec-2021 17:05:26"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>FILEPKG.;16)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -116,13 +116,6 @@ with the terms of said license.
|
||||
GETDEFSAVED PUTDEF EDITDEF DEFAULT.EDITDEF EDITDEF.FILES LOADDEF DWIMDEF DELDEF
|
||||
DELFROMLIST HASDEF GETFILEDEF SAVEDEF UNSAVEDEF COMPAREDEFS COMPARE TYPESOF)
|
||||
(INITVARS (WHEREIS.HASH)))
|
||||
(* ; "Must come after PUTDEF")
|
||||
(FNS FIXEDITDATE EDITDATE?)
|
||||
(* ;
|
||||
"Edit date support for all kinds of definers (from PARC 6/10/92)")
|
||||
[VARS (EDITDATE-ARGLIST-DEFINERS '(FUNCTIONS TYPES))
|
||||
(EDITDATE-NAME-DEFINERS '(STRUCTURES VARIABLES]
|
||||
(GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS)
|
||||
(COMS
|
||||
(* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started.")
|
||||
|
||||
@@ -4094,132 +4087,6 @@ compiling " T)
|
||||
|
||||
|
||||
|
||||
(* ; "Must come after PUTDEF")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(FIXEDITDATE
|
||||
[LAMBDA (EXPR) (* ; "Edited 17-Jul-89 11:13 by jtm:")
|
||||
(* NOBIND "18-JUL-78 21:11")
|
||||
(* Inserts or replaces previous edit
|
||||
date)
|
||||
(AND INITIALS (LISTP EXPR)
|
||||
(LISTP (CDR EXPR))
|
||||
(PROG (E)
|
||||
(COND
|
||||
((FMEMB (CAR EXPR)
|
||||
LAMBDASPLST)
|
||||
|
||||
(* ;; "insert the edit date after the argument list")
|
||||
|
||||
(SETQ E (CDDR EXPR)))
|
||||
[(FMEMB (GETPROP (CAR EXPR)
|
||||
':DEFINER-FOR)
|
||||
EDITDATE-ARGLIST-DEFINERS)
|
||||
|
||||
(* ;; "insert the edit date after the argument list")
|
||||
|
||||
(SETQ E (CDDR EXPR))
|
||||
(while (NOT (CL:LISTP (CAR E))) do (SETQ E (CDR E))
|
||||
finally (SETQ E (CDR E]
|
||||
((FMEMB (GETPROP (CAR EXPR)
|
||||
':DEFINER-FOR)
|
||||
EDITDATE-NAME-DEFINERS)
|
||||
|
||||
(* ;; "insert the edit date after the name")
|
||||
|
||||
(SETQ E (CDDR EXPR)))
|
||||
(T (RETURN)))
|
||||
RETRY
|
||||
[COND
|
||||
((NLISTP E)
|
||||
(RETURN))
|
||||
((LISTP (CAR E))
|
||||
(SELECTQ (CAAR E)
|
||||
((CLISP%: DECLARE)
|
||||
(SETQ E (CDR E))
|
||||
(GO RETRY))
|
||||
(BREAK1 (COND
|
||||
((EQ (CAR (CADAR E))
|
||||
'PROGN)
|
||||
(SETQ E (CDR (CADAR E)))
|
||||
(GO RETRY))))
|
||||
(ADV-PROG (* No easy way to mark cleanly the
|
||||
date of an advised function)
|
||||
(RETURN))
|
||||
(COND
|
||||
((AND (EQ (CAAR E)
|
||||
COMMENTFLG)
|
||||
(EQ (CADAR E)
|
||||
'DECLARATIONS%:))
|
||||
(SETQ E (CDR E))
|
||||
(GO RETRY]
|
||||
(COND
|
||||
([for TAIL on E while (AND (LISTP (CAR TAIL))
|
||||
(EQ (CAAR TAIL)
|
||||
COMMENTFLG))
|
||||
do (COND
|
||||
((AND (LISTP (CDR TAIL))
|
||||
(EDITDATE? (CAR TAIL)))
|
||||
(/RPLACA TAIL (EDITDATE (CAR TAIL)
|
||||
INITIALS))
|
||||
(RETURN T] (* scans the comments for a
|
||||
timestamp for this user.)
|
||||
NIL)
|
||||
(T (* attach the new timestamp at the
|
||||
beginning of the comments.)
|
||||
(/ATTACH (EDITDATE NIL INITIALS)
|
||||
E)))
|
||||
(RETURN EXPR])
|
||||
|
||||
(EDITDATE?
|
||||
[LAMBDA (COMMENT) (* ; "Edited 11-Jun-92 16:44 by cat")
|
||||
(* ; "Edited 13-Jul-89 09:30 by jtm:")
|
||||
(* lmm "21-Mar-85 08:45")
|
||||
|
||||
(* Tests to see if a given common is in fact an edit date --
|
||||
this has to be general enough to recognize the most comment comment forms while
|
||||
specific enough to not recognize things that are not edit dates)
|
||||
|
||||
(DECLARE (LOCALVARS . T)) (* jtm%: changed test so that it
|
||||
creates one timestamp per user.)
|
||||
(COND
|
||||
[(LISTP COMMENT)
|
||||
(COND
|
||||
((EQ (CAR COMMENT)
|
||||
COMMENTFLG)
|
||||
[COND
|
||||
(NIL (NULL NORMALCOMMENTSFLG)
|
||||
(SETQ COMMENT (GETCOMMENT COMMENT]
|
||||
(COND
|
||||
([OR (NOT (LISTP (CDR COMMENT)))
|
||||
(NOT (LISTP (CDDR COMMENT]
|
||||
NIL)
|
||||
[(EQ (CADR COMMENT)
|
||||
';) (* ; "CL style comment")
|
||||
(STRPOS INITIALS (CADDR COMMENT)
|
||||
(IMINUS (NCHARS INITIALS]
|
||||
(T (* ; "IL style comment")
|
||||
(EQ (CADR COMMENT)
|
||||
INITIALS]
|
||||
((STRINGP COMMENT])
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ; "Edit date support for all kinds of definers (from PARC 6/10/92)")
|
||||
|
||||
|
||||
(RPAQQ EDITDATE-ARGLIST-DEFINERS (FUNCTIONS TYPES))
|
||||
|
||||
(RPAQQ EDITDATE-NAME-DEFINERS (STRUCTURES VARIABLES))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started."
|
||||
)
|
||||
@@ -5041,46 +4908,46 @@ compiling " T)
|
||||
(PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989
|
||||
1990 1991 1992 1993 1995 2018 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (19760 21465 (SEARCHPRETTYTYPELST 19770 . 20749) (PRETTYDEFMACROS 20751 . 21209) (
|
||||
FILEPKGCOMPROPS 21211 . 21463)) (22267 57085 (CLEANUP 22277 . 23665) (COMPILEFILES 23667 . 23943) (
|
||||
COMPILEFILES0 23945 . 24665) (CONTINUEDIT 24667 . 26087) (MAKEFILE 26089 . 38426) (FILECHANGES 38428
|
||||
. 40763) (FILEPKG.MERGECHANGES 40765 . 41588) (FILEPKG.CHANGEDFNS 41590 . 41902) (MAKEFILE1 41904 .
|
||||
46131) (COMPILE-FILE? 46133 . 47690) (MAKEFILES 47692 . 49385) (ADDFILE 49387 . 51908) (ADDFILE0 51910
|
||||
. 56046) (LISTFILES 56048 . 57083)) (57757 92997 (FILEPKGCHANGES 57767 . 59117) (GETFILEPKGTYPE 59119
|
||||
. 62192) (MARKASCHANGED 62194 . 63831) (FILECOMS 63833 . 64217) (WHEREIS 64219 . 65639) (
|
||||
SMASHFILECOMS 65641 . 65876) (FILEFNSLST 65878 . 66040) (FILECOMSLST 66042 . 66526) (UPDATEFILES 66528
|
||||
. 71828) (INFILECOMS? 71830 . 73733) (INFILECOMTAIL 73735 . 74875) (INFILECOMS 74877 . 75038) (
|
||||
INFILECOM 75040 . 85249) (INFILECOMSVALS 85251 . 85578) (INFILECOMSVAL 85580 . 86582) (INFILECOMSPROP
|
||||
86584 . 87413) (IFCPROPS 87415 . 88676) (IFCEXPRTYPE 88678 . 89189) (IFCPROPSCAN 89191 . 90244) (
|
||||
IFCDECLARE 90246 . 91557) (INFILEPAIRS 91559 . 91891) (INFILECOMSMACRO 91893 . 92995)) (93032 124452 (
|
||||
FILES? 93042 . 95235) (FILES?1 95237 . 95935) (FILES?PRINTLST 95937 . 96719) (ADDTOFILES? 96721 .
|
||||
107767) (ADDTOFILE 107769 . 108685) (WHATIS 108687 . 110663) (ADDTOCOMS 110665 . 112309) (ADDTOCOM
|
||||
112311 . 118858) (ADDTOCOM1 118860 . 120031) (ADDNEWCOM 120033 . 121083) (MAKENEWCOM 121085 . 122928)
|
||||
(DEFAULTMAKENEWCOM 122930 . 124450)) (124522 127339 (MERGEINSERT 124532 . 126875) (MERGEINSERT1 126877
|
||||
. 127337)) (127493 128850 (ADDTOFILEKEYLST 127503 . 128848)) (128967 139879 (DELFROMFILES 128977 .
|
||||
129827) (DELFROMCOMS 129829 . 131508) (DELFROMCOM 131510 . 137378) (DELFROMCOM1 137380 . 138177) (
|
||||
REMOVEITEM 138179 . 139053) (MOVETOFILE 139055 . 139877)) (140093 142462 (SAVEPUT 140103 . 142460)) (
|
||||
142587 150911 (UNMARKASCHANGED 142597 . 144305) (PREEDITFN 144307 . 146818) (POSTEDITPROPS 146820 .
|
||||
149321) (POSTEDITALISTS 149323 . 150909)) (151056 171610 (ALISTS.GETDEF 151066 . 151445) (
|
||||
ALISTS.WHENCHANGED 151447 . 152091) (CLEARCLISPARRAY 152093 . 153267) (EXPRESSIONS.WHENCHANGED 153269
|
||||
. 153643) (MAKEALISTCOMS 153645 . 154718) (MAKEFILESCOMS 154720 . 156157) (MAKELISPXMACROSCOMS 156159
|
||||
. 158177) (MAKEPROPSCOMS 158179 . 158877) (MAKEUSERMACROSCOMS 158879 . 160679) (PROPS.WHENCHANGED
|
||||
160681 . 161302) (FILEGETDEF.LISPXMACROS 161304 . 162746) (FILEGETDEF.ALISTS 162748 . 163367) (
|
||||
FILEGETDEF.RECORDS 163369 . 164300) (FILEGETDEF.PROPS 164302 . 165094) (FILEGETDEF.MACROS 165096 .
|
||||
166156) (FILEGETDEF.VARS 166158 . 166574) (FILEGETDEF.FNS 166576 . 167940) (FILEPKGCOMS.PUTDEF 167942
|
||||
. 170382) (FILES.PUTDEF 170384 . 171341) (VARS.PUTDEF 171343 . 171486) (FILES.WHENCHANGED 171488 .
|
||||
171608)) (173632 181065 (RENAME 173642 . 175043) (CHANGECALLERS 175045 . 181063)) (181066 229922 (
|
||||
SHOWDEF 181076 . 182269) (COPYDEF 182271 . 184745) (GETDEF 184747 . 187023) (GETDEFCOM 187025 . 187991
|
||||
) (GETDEFCOM0 187993 . 189339) (GETDEFCURRENT 189341 . 195761) (GETDEFERR 195763 . 197064) (
|
||||
GETDEFFROMFILE 197066 . 201346) (GETDEFSAVED 201348 . 202452) (PUTDEF 202454 . 203157) (EDITDEF 203159
|
||||
. 204136) (DEFAULT.EDITDEF 204138 . 206974) (EDITDEF.FILES 206976 . 207177) (LOADDEF 207179 . 207355)
|
||||
(DWIMDEF 207357 . 208211) (DELDEF 208213 . 211227) (DELFROMLIST 211229 . 211733) (HASDEF 211735 .
|
||||
218057) (GETFILEDEF 218059 . 218581) (SAVEDEF 218583 . 220242) (UNSAVEDEF 220244 . 221140) (
|
||||
COMPAREDEFS 221142 . 224952) (COMPARE 224954 . 225658) (TYPESOF 225660 . 229920)) (229989 235032 (
|
||||
FIXEDITDATE 229999 . 233502) (EDITDATE? 233504 . 235030)) (235451 244222 (FILEPKGCOM 235461 . 240394)
|
||||
(FILEPKGTYPE 240396 . 244220)) (256255 271187 (FINDCALLERS 256265 . 256780) (EDITCALLERS 256782 .
|
||||
264692) (EDITFROMFILE 264694 . 270502) (FINDATS 270504 . 270776) (LOOKIN 270778 . 271185)) (271188
|
||||
272915 (SEPRCASE 271198 . 272913)) (273432 278989 (IMPORTFILE 273442 . 274416) (IMPORTEVAL 274418 .
|
||||
275298) (IMPORTFILESCAN 275300 . 275721) (CHECKIMPORTS 275723 . 277059) (GATHEREXPORTS 277061 . 278399
|
||||
) (\DUMPEXPORTS 278401 . 278987)) (279327 281535 (CLEARFILEPKG 279337 . 281533)))))
|
||||
(FILEMAP (NIL (19258 20963 (SEARCHPRETTYTYPELST 19268 . 20247) (PRETTYDEFMACROS 20249 . 20707) (
|
||||
FILEPKGCOMPROPS 20709 . 20961)) (21765 56583 (CLEANUP 21775 . 23163) (COMPILEFILES 23165 . 23441) (
|
||||
COMPILEFILES0 23443 . 24163) (CONTINUEDIT 24165 . 25585) (MAKEFILE 25587 . 37924) (FILECHANGES 37926
|
||||
. 40261) (FILEPKG.MERGECHANGES 40263 . 41086) (FILEPKG.CHANGEDFNS 41088 . 41400) (MAKEFILE1 41402 .
|
||||
45629) (COMPILE-FILE? 45631 . 47188) (MAKEFILES 47190 . 48883) (ADDFILE 48885 . 51406) (ADDFILE0 51408
|
||||
. 55544) (LISTFILES 55546 . 56581)) (57255 92495 (FILEPKGCHANGES 57265 . 58615) (GETFILEPKGTYPE 58617
|
||||
. 61690) (MARKASCHANGED 61692 . 63329) (FILECOMS 63331 . 63715) (WHEREIS 63717 . 65137) (
|
||||
SMASHFILECOMS 65139 . 65374) (FILEFNSLST 65376 . 65538) (FILECOMSLST 65540 . 66024) (UPDATEFILES 66026
|
||||
. 71326) (INFILECOMS? 71328 . 73231) (INFILECOMTAIL 73233 . 74373) (INFILECOMS 74375 . 74536) (
|
||||
INFILECOM 74538 . 84747) (INFILECOMSVALS 84749 . 85076) (INFILECOMSVAL 85078 . 86080) (INFILECOMSPROP
|
||||
86082 . 86911) (IFCPROPS 86913 . 88174) (IFCEXPRTYPE 88176 . 88687) (IFCPROPSCAN 88689 . 89742) (
|
||||
IFCDECLARE 89744 . 91055) (INFILEPAIRS 91057 . 91389) (INFILECOMSMACRO 91391 . 92493)) (92530 123950 (
|
||||
FILES? 92540 . 94733) (FILES?1 94735 . 95433) (FILES?PRINTLST 95435 . 96217) (ADDTOFILES? 96219 .
|
||||
107265) (ADDTOFILE 107267 . 108183) (WHATIS 108185 . 110161) (ADDTOCOMS 110163 . 111807) (ADDTOCOM
|
||||
111809 . 118356) (ADDTOCOM1 118358 . 119529) (ADDNEWCOM 119531 . 120581) (MAKENEWCOM 120583 . 122426)
|
||||
(DEFAULTMAKENEWCOM 122428 . 123948)) (124020 126837 (MERGEINSERT 124030 . 126373) (MERGEINSERT1 126375
|
||||
. 126835)) (126991 128348 (ADDTOFILEKEYLST 127001 . 128346)) (128465 139377 (DELFROMFILES 128475 .
|
||||
129325) (DELFROMCOMS 129327 . 131006) (DELFROMCOM 131008 . 136876) (DELFROMCOM1 136878 . 137675) (
|
||||
REMOVEITEM 137677 . 138551) (MOVETOFILE 138553 . 139375)) (139591 141960 (SAVEPUT 139601 . 141958)) (
|
||||
142085 150409 (UNMARKASCHANGED 142095 . 143803) (PREEDITFN 143805 . 146316) (POSTEDITPROPS 146318 .
|
||||
148819) (POSTEDITALISTS 148821 . 150407)) (150554 171108 (ALISTS.GETDEF 150564 . 150943) (
|
||||
ALISTS.WHENCHANGED 150945 . 151589) (CLEARCLISPARRAY 151591 . 152765) (EXPRESSIONS.WHENCHANGED 152767
|
||||
. 153141) (MAKEALISTCOMS 153143 . 154216) (MAKEFILESCOMS 154218 . 155655) (MAKELISPXMACROSCOMS 155657
|
||||
. 157675) (MAKEPROPSCOMS 157677 . 158375) (MAKEUSERMACROSCOMS 158377 . 160177) (PROPS.WHENCHANGED
|
||||
160179 . 160800) (FILEGETDEF.LISPXMACROS 160802 . 162244) (FILEGETDEF.ALISTS 162246 . 162865) (
|
||||
FILEGETDEF.RECORDS 162867 . 163798) (FILEGETDEF.PROPS 163800 . 164592) (FILEGETDEF.MACROS 164594 .
|
||||
165654) (FILEGETDEF.VARS 165656 . 166072) (FILEGETDEF.FNS 166074 . 167438) (FILEPKGCOMS.PUTDEF 167440
|
||||
. 169880) (FILES.PUTDEF 169882 . 170839) (VARS.PUTDEF 170841 . 170984) (FILES.WHENCHANGED 170986 .
|
||||
171106)) (173130 180563 (RENAME 173140 . 174541) (CHANGECALLERS 174543 . 180561)) (180564 229420 (
|
||||
SHOWDEF 180574 . 181767) (COPYDEF 181769 . 184243) (GETDEF 184245 . 186521) (GETDEFCOM 186523 . 187489
|
||||
) (GETDEFCOM0 187491 . 188837) (GETDEFCURRENT 188839 . 195259) (GETDEFERR 195261 . 196562) (
|
||||
GETDEFFROMFILE 196564 . 200844) (GETDEFSAVED 200846 . 201950) (PUTDEF 201952 . 202655) (EDITDEF 202657
|
||||
. 203634) (DEFAULT.EDITDEF 203636 . 206472) (EDITDEF.FILES 206474 . 206675) (LOADDEF 206677 . 206853)
|
||||
(DWIMDEF 206855 . 207709) (DELDEF 207711 . 210725) (DELFROMLIST 210727 . 211231) (HASDEF 211233 .
|
||||
217555) (GETFILEDEF 217557 . 218079) (SAVEDEF 218081 . 219740) (UNSAVEDEF 219742 . 220638) (
|
||||
COMPAREDEFS 220640 . 224450) (COMPARE 224452 . 225156) (TYPESOF 225158 . 229418)) (229570 238341 (
|
||||
FILEPKGCOM 229580 . 234513) (FILEPKGTYPE 234515 . 238339)) (250374 265306 (FINDCALLERS 250384 . 250899
|
||||
) (EDITCALLERS 250901 . 258811) (EDITFROMFILE 258813 . 264621) (FINDATS 264623 . 264895) (LOOKIN
|
||||
264897 . 265304)) (265307 267034 (SEPRCASE 265317 . 267032)) (267551 273108 (IMPORTFILE 267561 .
|
||||
268535) (IMPORTEVAL 268537 . 269417) (IMPORTFILESCAN 269419 . 269840) (CHECKIMPORTS 269842 . 271178) (
|
||||
GATHEREXPORTS 271180 . 272518) (\DUMPEXPORTS 272520 . 273106)) (273446 275654 (CLEARFILEPKG 273456 .
|
||||
275652)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "17-Oct-2021 18:00:43"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRINTFN.;29 13073
|
||||
(FILECREATED " 2-Dec-2021 13:28:13" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>PRINTFN.;31 13158
|
||||
|
||||
changes to%: (VARS PRINTFNCOMS)
|
||||
(FNS PRINTFN)
|
||||
changes to%: (FNS PFCOPYBYTES)
|
||||
|
||||
previous date%: " 8-Oct-2021 00:20:48"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRINTFN.;28)
|
||||
previous date%: "17-Oct-2021 18:00:43"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>PRINTFN.;29)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -152,9 +150,12 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(T FULL])
|
||||
|
||||
(PFCOPYBYTES
|
||||
[LAMBDA (SRCFIL DSTFIL START END) (* ; "Edited 8-Oct-2021 00:17 by rmk:")
|
||||
(* ; "Edited 24-Mar-93 14:16 by rmk:")
|
||||
(* lmm "28-Sep-86 14:38")
|
||||
[LAMBDA (SRCFIL DSTFIL START END NOTERPRI) (* ; "Edited 2-Dec-2021 13:27 by rmk:")
|
||||
(* ; "Edited 8-Oct-2021 00:17 by rmk:")
|
||||
(* ; "Edited 24-Mar-93 14:16 by rmk:")
|
||||
|
||||
(* ;; "RMK: Added NOTERPRI to at least give caller control over whether a TERPRI is done just in the case of copying the whole file. ")
|
||||
(* lmm "28-Sep-86 14:38")
|
||||
|
||||
(* ;; "RMK: What does FLG do? It isn't referenced. It seems to be passed as the value of PFDEFAULT from PRINTFNDEF, and that variable is initialized to NIL. I'm removing it.")
|
||||
|
||||
@@ -167,8 +168,8 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(PROG ((SSTRM (\INSTREAMARG SRCFIL))
|
||||
(DSTRM (\OUTSTREAMARG DSTFIL))
|
||||
FONTARRAY CHARCODE %#CHARS MAXFONT)
|
||||
(DECLARE (SPECVARS . T)) (* ;
|
||||
"In particular, #CHARS must be a specvar for \INCCODE")
|
||||
(DECLARE (SPECVARS . T)) (* ;
|
||||
"In particular, #CHARS must be a specvar for \INCCODE")
|
||||
(COND
|
||||
((IMAGESTREAMP DSTRM)
|
||||
(SETQ FONTARRAY (FONTMAPARRAY))
|
||||
@@ -190,7 +191,7 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
START))
|
||||
(START)
|
||||
(T (* ;
|
||||
"Copy everything from here to the end-of-file")
|
||||
"Copy everything from here to the end-of-file")
|
||||
(SETQ START (GETFILEPTR SSTRM))
|
||||
(IDIFFERENCE (GETEOFPTR SSTRM)
|
||||
(GETFILEPTR SSTRM]
|
||||
@@ -200,21 +201,21 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
LP (COND
|
||||
((ILEQ %#CHARS 0)
|
||||
(CL:WHEN (AND (EQ START 0)
|
||||
(EOFP SSTRM)) (* ; "We copied the whole file")
|
||||
(TERPRI DSTRM))
|
||||
(EOFP SSTRM)) (* ;
|
||||
"RMK: We copied the whole file, why should we do a TERPRI")
|
||||
(OR NOTERPRI (TERPRI DSTRM)))
|
||||
(RETURN T)))
|
||||
(SETQ CHARCODE (\INCCODE.EOLC SSTRM ANY.EOLC '%#CHARS %#CHARS))
|
||||
(IF (EQ CHARCODE (CONSTANT (CHARCODE.DECODE FONTESCAPECHAR)))
|
||||
THEN
|
||||
(* ;;
|
||||
"No EOL check on font character, otherwise we would be limited to 9 fonts")
|
||||
|
||||
(* ;;
|
||||
"No EOL check on font character, otherwise we would be limited to 9 fonts")
|
||||
|
||||
(SETQ CHARCODE (\INCCODE SSTRM '%#CHARS %#CHARS))
|
||||
(CL:WHEN (AND (IGEQ MAXFONT CHARCODE)
|
||||
(NEQ CHARCODE 0))
|
||||
(DSPFONT (ELT FONTARRAY CHARCODE)
|
||||
DSTRM))
|
||||
(SETQ CHARCODE (\INCCODE SSTRM '%#CHARS %#CHARS))
|
||||
(CL:WHEN (AND (IGEQ MAXFONT CHARCODE)
|
||||
(NEQ CHARCODE 0))
|
||||
(DSPFONT (ELT FONTARRAY CHARCODE)
|
||||
DSTRM))
|
||||
ELSE (\OUTCHAR DSTRM CHARCODE))
|
||||
(GO LP)))])
|
||||
|
||||
@@ -230,37 +231,36 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS PFPRINCHAR MACRO ((CC)
|
||||
(COND
|
||||
(EOLFLG (TERPRI DSTRM)
|
||||
(SETQ EOLFLG NIL)
|
||||
(SETQ HPOS LMAR)))
|
||||
(COND
|
||||
((NOT (ZEROP %#SPACES))
|
||||
(FRPTQ (COND
|
||||
((OR FLG STRFLG)
|
||||
%#SPACES)
|
||||
(T (FOLDHI %#SPACES 2)))
|
||||
(PFOUTCHAR (CHARCODE SPACE)))
|
||||
(SETQ %#SPACES 0)))
|
||||
(PFOUTCHAR CC)))
|
||||
(COND
|
||||
(EOLFLG (TERPRI DSTRM)
|
||||
(SETQ EOLFLG NIL)
|
||||
(SETQ HPOS LMAR)))
|
||||
(COND
|
||||
((NOT (ZEROP %#SPACES))
|
||||
(FRPTQ (COND
|
||||
((OR FLG STRFLG)
|
||||
%#SPACES)
|
||||
(T (FOLDHI %#SPACES 2)))
|
||||
(PFOUTCHAR (CHARCODE SPACE)))
|
||||
(SETQ %#SPACES 0)))
|
||||
(PFOUTCHAR CC)))
|
||||
|
||||
(PUTPROPS PFOUTCHAR MACRO ((CC)
|
||||
([LAMBDA (WIDTH)
|
||||
(COND
|
||||
((AND WIDTH (IGREATERP (add HPOS WIDTH)
|
||||
RMAR))
|
||||
(* past RIGHT margin, force eol)
|
||||
(TERPRI DSTRM)
|
||||
(SETQ HPOS WIDTH)))
|
||||
(\OUTCHAR DSTRM CC]
|
||||
(\STREAMCHARWIDTH CC DSTRM \PRIMTERMTABLE))))
|
||||
([LAMBDA (WIDTH)
|
||||
(COND
|
||||
((AND WIDTH (IGREATERP (add HPOS WIDTH)
|
||||
RMAR)) (* past RIGHT margin, force eol)
|
||||
(TERPRI DSTRM)
|
||||
(SETQ HPOS WIDTH)))
|
||||
(\OUTCHAR DSTRM CC]
|
||||
(\STREAMCHARWIDTH CC DSTRM \PRIMTERMTABLE))))
|
||||
)
|
||||
)
|
||||
|
||||
(MOVD? 'COPYBYTES 'PFCOPYBYTES)
|
||||
|
||||
(ADDTOVAR EDITMACROS [PF NIL (ORR [(E (APPLY* 'PF (FIRSTATOM (%##]
|
||||
((E 'PF?])
|
||||
((E 'PF?])
|
||||
|
||||
(ADDTOVAR EDITCOMSA PF)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
@@ -277,6 +277,6 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS PRINTFN COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1999 2018 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1145 10976 (PF 1155 . 3850) (PF* 3852 . 4146) (PRINTFN 4148 . 4718) (PRINTFNDEF 4720 .
|
||||
5903) (FINDFNDEF 5905 . 6929) (PFCOPYBYTES 6931 . 10726) (DISPLAYP 10728 . 10974)))))
|
||||
(FILEMAP (NIL (1107 11292 (PF 1117 . 3812) (PF* 3814 . 4108) (PRINTFN 4110 . 4680) (PRINTFNDEF 4682 .
|
||||
5865) (FINDFNDEF 5867 . 6891) (PFCOPYBYTES 6893 . 11042) (DISPLAYP 11044 . 11290)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user