You signed in with another tab or window. Reload to refresh your session.You signed out in another tab or window. Reload to refresh your session.You switched accounts on another tab or window. Reload to refresh your session.Dismiss alert
* 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
"No easy way to mark cleanly the date of an advised function")
648
-
(RETURN))
649
-
(COND
650
-
((AND (EQ (CAAR E)
651
-
COMMENTFLG)
652
-
(EQ (CADAR E)
653
-
'DECLARATIONS%:))
631
+
[LAMBDA (EXPR)
632
+
633
+
(* ;; "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.")
634
+
(* ; "Edited 3-Dec-2021 15:03 by rmk")
635
+
(* ; "Edited 22-Oct-2021 16:58 by rmk:")
636
+
(* ; "Edited 27-Sep-2018 22:04 by rmk:")
637
+
(* ; "Edited 31-Mar-2000 17:13 by rmk:")
638
+
(* ; "Edited 17-Jul-89 11:13 by jtm:")
639
+
(* ; "18-JUL-78 21:11")
640
+
641
+
(* ;; "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.")
642
+
643
+
(CL:WHEN (AND INITIALS (LISTP EXPR)
644
+
(LISTP (CDR EXPR)))
645
+
(PROG (E)
646
+
647
+
(* ;; "Normalize out the colon, add it back if needed.")
648
+
649
+
(COND
650
+
((FMEMB (CAR EXPR)
651
+
LAMBDASPLST)
652
+
653
+
(* ;; "insert the edit date after the argument list")
654
+
655
+
(SETQ E (CDDR EXPR)))
656
+
[(FMEMB (GETPROP (CAR EXPR)
657
+
':DEFINER-FOR)
658
+
EDITDATE-ARGLIST-DEFINERS)
659
+
660
+
(* ;; "insert the edit date after the argument list")
661
+
662
+
(SETQ E (CDDR EXPR))
663
+
(while (NOT (CL:LISTP (CAR E))) do (SETQ E (CDR E)) finally (SETQ E (CDR E]
664
+
((FMEMB (GETPROP (CAR EXPR)
665
+
':DEFINER- FOR)
666
+
EDITDATE-NAME-DEFINERS)
667
+
668
+
(* ;; "insert the edit date after the name")
669
+
670
+
(SETQ E (CDDR EXPR)))
671
+
(T (RETURN)))
672
+
RETRY
673
+
[COND
674
+
((NLISTP E)
675
+
(RETURN))
676
+
((LISTP (CAR E))
677
+
(SELECTQ (CAAR E)
678
+
((CLISP%: DECLARE)
654
679
(SETQ E (CDR E))
655
-
(GO RETRY]
656
-
(COND
657
-
((AND (LISTP (CDR E))
658
-
(EDITDATE? (CAR E)))
659
-
(/RPLACA E (EDITDATE (CAR E)
660
-
INITIALS)))
661
-
(T (/ATTACH (EDITDATE NIL INITIALS)
662
-
E)))
663
-
(RETURN EXPR])
680
+
(GO RETRY))
681
+
(BREAK1 (COND
682
+
((EQ (CAR (CADAR E))
683
+
'PROGN)
684
+
(SETQ E (CDR (CADAR E)))
685
+
(GO RETRY))))
686
+
(ADV-PROG (* ;
687
+
"No easy way to mark cleanly the date of an advised function")
688
+
(RETURN))
689
+
(COND
690
+
((AND (EQ (CAAR E)
691
+
COMMENTFLG)
692
+
(EQ (CADAR E)
693
+
'DECLARATIONS%:))
694
+
(SETQ E (CDR E))
695
+
(GO RETRY]
696
+
697
+
(* ;; "E is now the cell that the date will attach to or whose CAR will be updated.")
698
+
699
+
(LET (PARSE (INITLS (CL:IF (EQ (CHARCODE %:)
700
+
(NTHCHARCODE INITIALS -1))
701
+
(SUBSTRING INITIALS 1 -2)
702
+
INITIALS)))
703
+
(IF *REPLACE-OLD-EDIT-DATES*
704
+
THEN
705
+
(* ;; "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.")
706
+
707
+
(BIND (TAIL _ E) WHILE (AND (LISTP TAIL)
708
+
(EDITDATE? (CAR TAIL)))
709
+
DO (SETQ TAIL (CDR TAIL)) FINALLY (CL:UNLESS (EQ E TAIL)
710
+
(/RPLACD E TAIL)))
711
+
712
+
(* ;;
713
+
"Now (CAR E) may or may not be a (no-REST) editdate, but there are none afterwards.")
714
+
715
+
(IF (SETQ PARSE (EDITDATE? (CAR E)
716
+
T))
717
+
THEN (* ; "Smash it")
718
+
(EDITDATE (CAR E)
719
+
INITLS
720
+
(CADDR PARSE))
721
+
ELSE (/ATTACH (EDITDATE NIL INITLS)
722
+
E))
723
+
ELSEIF (SETQ PARSE (EDITDATE? (CAR E)
724
+
T))
725
+
THEN
726
+
(* ;; "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.")
727
+
728
+
(* ;; "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. ")
729
+
730
+
(IF (STRING.EQUAL INITLS (CADR PARSE))
731
+
THEN
732
+
733
+
(* ;; "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.")
734
+
735
+
[IF (OR (NULL (CAR PARSE))
736
+
(IGREATERP (IDIFFERENCE (IDATE)
737
+
(IDATE (CAR PARSE)))
738
+
(TIMES 24 3600)))
739
+
THEN
740
+
(* ;; "If no date, must have been %"INITIALS: xxx%" and we definitely want to upgraded to the Edited... format")
741
+
742
+
(/ATTACH (EDITDATE NIL INITLS (CADDR PARSE))
743
+
E)
744
+
ELSE
745
+
(* ;; "Same author, within a day. ")
746
+
747
+
(/RPLACA E (EDITDATE NIL INITLS (CADDR PARSE]
748
+
ELSE
749
+
(* ;;
750
+
"Not a previous date, or not one with this author. Add a new one.")
751
+
752
+
(/ATTACH (EDITDATE NIL INITLS (CADDR PARSE))
753
+
E))
754
+
ELSE
755
+
(* ;; "Need a new date, didn't even see %"<initials: xxx%"")
756
+
757
+
(/ATTACH (EDITDATE NIL INITLS)
758
+
E)))
759
+
(RETURN EXPR)))])
664
760
665
761
(EDITDATE?
666
-
(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)))))))
667
-
)
762
+
[LAMBDA (COMMENT RESTOK) (* ; "Edited 3-Dec-2021 14:35 by rmk")
763
+
764
+
(* ;;; "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).")
765
+
766
+
(* ;;; "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. ")
767
+
768
+
(* ;;; "")
769
+
770
+
(* ;;;
771
+
"The caller can compare against current time and current user to decide whether to smash or add.")
772
+
773
+
(* ;;; "There is no harm in not recognizing prehistoric formats, new dates will always be added on.")
0 commit comments