github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-02-18 21:57:15 +00:00
Code Issues Projects Releases Wiki Activity

Maintaining old edit dates #359 (#599)

Browse Source 
* 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
2021-12-03 20:18:21 -08:00
committed by GitHub
parent 7a27c26f01
commit 993bdb2e00
6 changed files with 323 additions and 291 deletions
Download Patch File Download Diff File Expand all files Collapse all files

295
sources/EDITINTERFACE
View File

@@ -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