Skip to content

Commit c2915bf

Browse files
rmkaplanrmkaplan
authored
Rmk8: Revised EDITINTERFACE, another attempt at SEDIT-TOPLEVEL (#619)
* EDITINTERFACE: further cleanup * SEDIT: Another attempt at adding a property interface
1 parent 40c10a7 commit c2915bf

File tree

10 files changed

+760
-399
lines changed

10 files changed

+760
-399
lines changed

‎sources/EDITINTERFACE‎

Lines changed: 83 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,12 @@
11
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
22

3-
(FILECREATED " 4-Dec-2021 10:40:27" 
4-
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;21 46036
3+
(FILECREATED " 8-Dec-2021 18:25:33" 
4+
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;29 47473
55

6-
changes to%: (FNS EDITDATE?)
6+
:CHANGES-TO (FNS EDITDATE? EDITDATE)
77

8-
previous date%: " 3-Dec-2021 15:45:20"
9-
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;19)
8+
:PREVIOUS-DATE " 8-Dec-2021 16:11:23"
9+
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;27)
1010

1111

1212
(* ; "
@@ -109,7 +109,7 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
109109
(DEFGLOBALVAR XCL::ED-LAST-INFO NIL
110110
"used in ED to stash last call info so (ED NIL) will restart last edit")
111111

112-
(CL:DEFUN ED (CL::NAME CL::OPTIONS) (* ; "Edited 5-Jul-88 16:03 by woz")
112+
(CL:DEFUN ED (CL::NAME CL::OPTIONS) (* ; "Edited 5-Jul-88 16:03 by woz")
113113

114114
(* ;;; "Standard Common Lisp editor entry. CLtL say's ED does something reasonable when passed a pathname. We coerce name into something that might be the name of something with an IL:FILES definition, & try to edit that. Then save call info in ED-LAST-INFO, so (ED) will start last edit over again.")
115115

@@ -629,21 +629,21 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
629629
(FIXEDITDATE
630630
[LAMBDA (EXPR)
631631

632-
(* ;; "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.")
633-
 (* ; "Edited 3-Dec-2021 15:03 by rmk")
632+
(* ;; "Edited 8-Dec-2021 16:11 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.")
633+
(* ; "Edited 3-Dec-2021 15:03 by rmk")
634634
(* ; "Edited 22-Oct-2021 16:58 by rmk:")
635635
(* ; "Edited 27-Sep-2018 22:04 by rmk:")
636636
(* ; "Edited 31-Mar-2000 17:13 by rmk:")
637637
(* ; "Edited 17-Jul-89 11:13 by jtm:")
638638
(* ; "18-JUL-78 21:11")
639639

640-
(* ;; "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.")
640+
(* ;; "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. ")
641641

642642
(CL:WHEN (AND INITIALS (LISTP EXPR)
643643
(LISTP (CDR EXPR)))
644644
(PROG (E)
645645

646-
(* ;; "Normalize out the colon, add it back if needed.")
646+
(* ;; "Normalize out the colon, add it back if needed. ")
647647

648648
(COND
649649
((FMEMB (CAR EXPR)
@@ -729,26 +729,36 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
729729
(IF (STRING.EQUAL INITLS (CADR PARSE))
730730
THEN
731731

732-
(* ;; "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.")
732+
(* ;; "Another edit by the same author. If not dated but contains a rest, then upgrade the rest comment with a date Otherwise,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.")
733733

734-
[IF (OR (NULL (CAR PARSE))
735-
(IGREATERP (IDIFFERENCE (IDATE)
736-
(IDATE (CAR PARSE)))
737-
(TIMES 24 3600)))
734+
[IF (NULL (CAR PARSE))
738735
THEN
739-
(* ;; "If no date, must have been %"INITIALS: xxx%" and we definitely want to upgraded to the Edited... format")
736+
(* ;; "If no date but %"INITIALS: xxx%", we definitely want to upgraded to the Edited... initials: xxx format")
737+
738+
(/RPLACA E (EDITDATE (CAR E)
739+
INITLS
740+
(CADDR PARSE)))
741+
ELSEIF (IGREATERP (IDIFFERENCE (IDATE)
742+
(IDATE (CAR PARSE)))
743+
(TIMES 24 3600))
744+
THEN
745+
(* ;;
746+
 "If we aren't upgrading, then we don't want to propagate the previous REST.")
740747

741-
(/ATTACH (EDITDATE NIL INITLS (CADDR PARSE))
748+
(/ATTACH (EDITDATE NIL INITLS)
742749
E)
743750
ELSE
744-
(* ;; "Same author, within a day. ")
751+
(* ;;
752+
 "Same author, within a day. Just change the date, keep the REST.")
745753

746-
(/RPLACA E (EDITDATE NIL INITLS (CADDR PARSE]
754+
(/RPLACA E (EDITDATE (CAR E)
755+
INITLS
756+
(CADDR PARSE]
747757
ELSE
748-
(* ;;
749-
 "Not a previous date, or not one with this author. Add a new one.")
750758

751-
(/ATTACH (EDITDATE NIL INITLS (CADDR PARSE))
759+
(* ;; "Not a previous date, or not one with this author. Add a new one. If rmk is editing and sees an lmm: rest, we don't want to attribute that rest to rmk in the new one.")
760+
761+
(/ATTACH (EDITDATE NIL INITLS)
752762
E))
753763
ELSE
754764
(* ;; "Need a new date, didn't even see %"<initials: xxx%"")
@@ -758,11 +768,14 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
758768
(RETURN EXPR)))])
759769

760770
(EDITDATE?
761-
[LAMBDA (COMMENT RESTOK) (* ; "Edited 4-Dec-2021 10:39 by rmk")
771+
[LAMBDA (COMMENT RESTOK) (* ; "Edited 8-Dec-2021 18:24 by rmk")
772+
773+
(* ;; "Edited 6-Dec-2021 16:04 by rmk: Return will have date/initial, initial/rest, or date/initial/rest. Always an initial and something, or NIL.")
774+
(* ; "Edited 4-Dec-2021 10:39 by rmk")
762775

763776
(* ;;; "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).")
764777

765-
(* ;;; "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. ")
778+
(* ;;; "If RESTOK, this also parses strings with additional stuff after the INITLS (%"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. ")
766779

767780
(* ;;; "")
768781

@@ -772,41 +785,55 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
772785
(* ;;; "There is no harm in not recognizing prehistoric formats, new dates will always be added on.")
773786

774787
(LET ((TAIL COMMENT)
775-
STRING BYPOS DATE I RESTPOS)
788+
STRING BYPOS (IPOS 1)
789+
DATE I IENDPOS RESTPOS)
776790
(CL:WHEN [AND (EQ COMMENTFLG (CAR (LISTP TAIL)))
777791
(MEMB [CAR (LISTP (SETQ TAIL (CDR TAIL]
778792
'(; ;; ;;;))
779793
(STRINGP (SETQ STRING (CAR (SETQ TAIL (CDR TAIL]
780794
(SETQ STRING (CL:STRING-TRIM `(#\Space)
781795
STRING))
782-
(CL:UNLESS [AND [STREQUAL "Edited " (SUBSTRING STRING 1 7 (CONSTANT (CONCAT]
783-
(SETQ BYPOS (STRPOS " by " STRING 8))
784-
[IDATE (SETQ DATE (CL:STRING-TRIM `(#\Space)
785-
(SUBSTRING STRING 8 (SUB1 BYPOS]
786-
(SETQ I (SUBSTRING STRING (IPLUS BYPOS 4)
787-
(OR (SETQ RESTPOS (STRPOS " " STRING (IPLUS BYPOS 4)))
788-
-1]
789-
790-
(* ;; "Could be %"<INITIALS>: abc%" to be upgraded with a date")
791-
792-
(CL:WHEN (SETQ RESTPOS (STRPOS " " STRING))
793-
(SETQ I (SUBSTRING STRING 1 (SUB1 RESTPOS)))))
794-
(CL:WHEN (AND I (ILESSP (NCHARS I)
795-
12)) (* ;
796+
(CL:WHEN [AND [STREQUAL "Edited " (SUBSTRING STRING 1 7 (CONSTANT (CONCAT]
797+
(SETQ BYPOS (STRPOS " by " STRING 8))
798+
(IDATE (SETQ DATE (CL:STRING-TRIM `(#\Space)
799+
(SUBSTRING STRING 8 (SUB1 BYPOS]
800+
801+
(* ;; "Standard format, initials should be next. ")
802+
803+
(SETQ IPOS (IPLUS BYPOS 4)))
804+
805+
(* ;; "Chomp off the next substring--initials?")
806+
807+
(CL:WHEN (IGREATERP (NCHARS STRING)
808+
IPOS)
809+
[SETQ IENDPOS (SUB1 (OR (STRPOS " " STRING IPOS)
810+
(ADD1 (NCHARS STRING]
811+
(SETQ I (SUBSTRING STRING IPOS IENDPOS))
812+
(CL:WHEN (ILESSP (NCHARS I)
813+
12) (* ;
796814
 "Sanity check: Initials should be short.")
797-
(CL:WHEN (EQ (CHARCODE %:)
798-
(NTHCHARCODE I -1)) (* ;
799-
 "Normalize out the colon in the return")
800-
(SETQ I (SUBSTRING I 1 -2)))
801-
(IF RESTOK
802-
THEN (LIST DATE I (AND RESTPOS (SUBSTRING STRING RESTPOS)))
803-
ELSEIF (AND DATE (NOT RESTPOS))
804-
THEN (LIST DATE I))))])
815+
(CL:WHEN (EQ (CHARCODE %:)
816+
(NTHCHARCODE I -1)) (* ; "Normalize out the colon")
817+
(SETQ I (SUBSTRING I 1 -2)))
818+
(CL:WHEN (SETQ REST (SUBSTRING STRING (ADD1 IENDPOS)))
819+
(SETQ REST (CL:STRING-TRIM `(#\Space)
820+
REST)))
821+
(IF (IGREATERP (NCHARS REST)
822+
0)
823+
THEN
824+
(* ;; "Could be %"<initials>: abc%" to be upgraded with a date")
825+
826+
(CL:WHEN RESTOK (LIST DATE I REST))
827+
ELSEIF DATE
828+
THEN
829+
(* ;; "If we saw just initials")
830+
831+
(LIST DATE I)))))])
805832

806833
(EDITDATE
807834
[LAMBDA (OLDDATE INITLS REST)
808835

809-
(* ;; "Edited 3-Dec-2021 13:17 by rmk: Upgraded to make sure that the comment includes REST")
836+
(* ;; "Edited 8-Dec-2021 17:58 by rmk: Upgraded to make sure that the comment includes REST")
810837
(* ; " 20-Nov-86 23:23 by Masinter")
811838

812839
(* ;; "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.")
@@ -815,7 +842,7 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
815842
" by " INITLS))
816843
NEWDATE OLDSEMI)
817844
(CL:WHEN REST
818-
(SETQ EDITSTRING (CONCAT EDITSTRING ":" REST)))
845+
(SETQ EDITSTRING (CONCAT EDITSTRING ": " REST)))
819846
(CL:WHEN OLDDATE
820847
(SETQ OLDSEMI (CADR OLDDATE)))
821848
(SETQ NEWDATE (LIST (CL:IF REST
@@ -901,11 +928,11 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
901928
)
902929
(PUTPROPS EDITINTERFACE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991))
903930
(DECLARE%: DONTCOPY
904-
(FILEMAP (NIL (4080 10379 (ED 4080 . 10379)) (10381 14357 (INSTALL-PROTOTYPE-DEFN 10381 . 14357)) (
905-
14358 31141 (EDITDEF.FNS 14368 . 15704) (EDITF 15706 . 16586) (EDITFB 16588 . 17436) (EDITFNS 17438 .
906-
18758) (EDITLOADFNS? 18760 . 22560) (EDITMODE 22562 . 24572) (EDITP 24574 . 25085) (EDITV 25087 .
907-
25726) (DC 25728 . 26409) (DF 26411 . 27453) (DP 27455 . 28539) (DV 28541 . 29113) (EDITPROP 29115 .
908-
29334) (EF 29336 . 29665) (EP 29667 . 29850) (EV 29852 . 30031) (EDITE 30033 . 30911) (EDITL 30913 .
909-
31139)) (31491 45181 (NEW/EDITDATE 31501 . 31723) (FIXEDITDATE 31725 . 39112) (EDITDATE? 39114 . 41927
910-
) (EDITDATE 41929 . 43184) (SETINITIALS 43186 . 45179)))))
931+
(FILEMAP (NIL (4086 10381 (ED 4086 . 10381)) (10383 14359 (INSTALL-PROTOTYPE-DEFN 10383 . 14359)) (
932+
14360 31143 (EDITDEF.FNS 14370 . 15706) (EDITF 15708 . 16588) (EDITFB 16590 . 17438) (EDITFNS 17440 .
933+
18760) (EDITLOADFNS? 18762 . 22562) (EDITMODE 22564 . 24574) (EDITP 24576 . 25087) (EDITV 25089 .
934+
25728) (DC 25730 . 26411) (DF 26413 . 27455) (DP 27457 . 28541) (DV 28543 . 29115) (EDITPROP 29117 .
935+
29336) (EF 29338 . 29667) (EP 29669 . 29852) (EV 29854 . 30033) (EDITE 30035 . 30913) (EDITL 30915 .
936+
31141)) (31493 46618 (NEW/EDITDATE 31503 . 31725) (FIXEDITDATE 31727 . 39874) (EDITDATE? 39876 . 43363
937+
) (EDITDATE 43365 . 44621) (SETINITIALS 44623 . 46616)))))
911938
STOP

‎sources/EDITINTERFACE.LCOM‎

102 Bytes
Binary file not shown.

0 commit comments

Comments
 (0)