(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "11-Dec-87 13:33:22" {DSK}<XAVIER>COMMENTHACKS.;7 14426  

      changes to%:  (FNS MYSUPERPRINT/COMMENT2 MYSUPERPRINT/COMMENT EDITDEF.FUNCTIONS 
                         FIXDEFUNEDITDATE COMMENT2 MYEDITDATE? EDITDATE?)
                    (VARS COMMENTHACKSCOMS)
                    (FUNCTIONS FOOFUNCTIONS)
                    (PROPS (COMMENTHACKS MAKEFILE-ENVIRONMENT))

      previous date%: "10-Dec-87 10:58:48" {DSK}<XAVIER>COMMENTHACKS.;1)


(* "
Copyright (c) 1987 by Unisys Corp..  All rights reserved.
")

(PRETTYCOMPRINT COMMENTHACKSCOMS)

(RPAQQ COMMENTHACKSCOMS ((FNS EDITDEF.FUNCTIONS FIXDEFUNEDITDATE MYEDITDATE? MYSUPERPRINT/COMMENT 
                              MYSUPERPRINT/COMMENT2)
                         (P (MOVD 'MYEDITDATE? 'EDITDATE?)
                            (MOVD 'MYSUPERPRINT/COMMENT 'SUPERPRINT/COMMENT))
                         (PROP EDITDEF FUNCTIONS)
                         (PROP (MAKEFILE-ENVIRONMENT FILETYPE)
                               COMMENTHACKS)
                         (EDITHIST COMMENTHACKS)))
(DEFINEQ

(EDITDEF.FUNCTIONS
  [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS)                (* ; "Edited 10-Dec-87 10:37 by DJVB")

    (LET [(DEF (GETDEF NAME TYPE SOURCE '(EDIT NOCOPY]
         (SETQ RETRY NIL)
         (EDITE DEF EDITCOMS NAME TYPE [FUNCTION (LAMBDA (NAME DEF TYPE EXITFLG)
                                                   (MARKASCHANGED NAME TYPE 'CHANGED)
                                                   (FIXDEFUNEDITDATE DEF)
                                                   (PUTDEF NAME TYPE DEF]
                OPTIONS)                                     (* ; "AND SAY WE EDITED IT")

         T])

(FIXDEFUNEDITDATE
  [LAMBDA (EXPR)                                             (* ; "Edited 10-Dec-87 10:42 by DJVB")
          
          (* ;; "Inserts or replaces previous edit date in a (DEFUN f (args) (DECLARE --)... %"doc string%" EDITDATE body")

    (AND INITIALS (LISTP EXPR)
         (FMEMB (CAR EXPR)
                '(CL:DEFUN DEFMACRO )
)
         (LISTP (CDDR EXPR))
         (PROG ((E (CDDDR EXPR)))
           RETRY
               (COND
                  ((NLISTP E)
                   (RETURN))
                  ((LISTP (CAR E))
                   (SELECTQ (CAAR E)
                       ((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))
                       NIL))
                  ((STRINGP (CAR E))                         (* ; "DOC STRING")

                   (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])

(MYEDITDATE?
  [LAMBDA (COMMENT)                                          (* ; "Edited 10-Dec-87 13:50 by DJVB")

    (AND *REPLACE-OLD-EDIT-DATES* (LISTP COMMENT)
         (SUPERPRINTEQ (CAR COMMENT)
                COMMENTFLG)
         (LISTP (CDR COMMENT))
         (LISTP (CDDR COMMENT))
         (NULL (CDDDR COMMENT))
         (STRINGP (CADDR COMMENT))
         (LET ((C2 (CADR COMMENT)))
              (AND (NOT (SUPERPRINTEQ C2 COMMENTFLG))
                   (OR (EQ C2 INITIALS)
                       (COND
                          [(LITATOM C2)
                           (COND
                              [(EQ C2 ';)
                               (AND (STRPOS "Edited " (CADDR COMMENT)
                                           1 NIL T)
                                    (GREATERP (CL:LENGTH (CADDR COMMENT))
                                           (CONSTANT (CL:LENGTH "Edited 01-jan-86 00:00 by X"]
                              (T (NOT (for PC from 1 to (NCHARS C2)
                                         always (EQ (NTHCHARCODE C2 PC)
                                                    (CHARCODE ;]
                          (T (AND (STRINGP C2)
                                  (IGREATERP 12 (NCHARS C2])

(MYSUPERPRINT/COMMENT
  [LAMBDA (L FILE)                                           (* ; "Edited 11-Dec-87 13:32 by DJVB")

    (COND
       ((AND **COMMENT**FLG (NOT FILEFLG)
             (NOT MAKEMAP))
        (AND (GREATERP (PLUS (DSPXPOSITION NIL FILE)
                             (STRINGWIDTH **COMMENT**FLG FILE))
                    (DSPRIGHTMARGIN NIL FILE))
             (PRINENDLINE 0 FILE))
        (PRIN1S **COMMENT**FLG NIL FILE))
       (T (LET (COMMENT-LMARGIN COMMENT-RMARGIN RIGHTFLG FLUSH-LEFTP SEMIP BODY)
               (DECLARE (SPECVARS RIGHTFLG))
               [SETQ RIGHTFLG (NOT (if (SUPERPRINTEQ (CADR L)
                                              COMMENTFLG)
                                     elseif (SETQ SEMIP (SEMI-COLON-COMMENT-P L))
                                       then (NEQ SEMIP 1)
                                     else (GREATERP (LENGTH L)
                                                 10]
               [COND
                  (RIGHTFLG (SETQ COMMENT-LMARGIN (OR COMMENTCOL (SUPERPRINT/COMMENT1 L RMARGIN FILE)
                                                      ))
                         (SETQ COMMENT-RMARGIN RMARGIN))
                  ((AND (EQ SEMIP 3)
                        (NOT MAKEMAP))
                   (SETQ COMMENT-LMARGIN 0)
                   (SETQ COMMENT-RMARGIN RMARGIN))
                  (T (SETQ COMMENT-LMARGIN (FIXR (TIMES RMARGIN 0.1)))
                     (SETQ COMMENT-RMARGIN (DIFFERENCE RMARGIN COMMENT-LMARGIN))
                     (CL:IF (EQ COMMENT-LMARGIN (DSPXPOSITION NIL FILE))
                            (SETQ RIGHTFLG T]
               (CL:IF (GREATERP (DSPXPOSITION NIL FILE)
                             COMMENT-LMARGIN)
                      (PRINENDLINE COMMENT-LMARGIN FILE)
                      (DSPXPOSITION COMMENT-LMARGIN FILE))
               (OR RIGHTFLG (PRINENDLINE COMMENT-LMARGIN FILE))
               (SETFONT (PROG1 (SETFONT COMMENTFONT FILE)
                               (CL:IF (AND SEMIP (NOT MAKEMAP)
                                           [STRINGP (SETQ BODY
                                                     (CAR (LISTP (CDR (LISTP (CDR L]
                                           (NULL (CDDDR L))
                                           (OR (IMAGESTREAMP FILE)
                                               *PRINT-SEMICOLON-COMMENTS*))
                                      (PRIN2-LONG-STRING BODY FILE NIL NIL COMMENT-LMARGIN 
                                             COMMENT-RMARGIN T SEMIP)
                                      (MYSUPERPRINT/COMMENT2 L COMMENT-LMARGIN
                                             (IQUOTIENT (PLUS COMMENT-LMARGIN COMMENT-RMARGIN)
                                                    2)
                                             COMMENT-RMARGIN FILE)))
                      FILE)
               (CL:IF (OR (AND SEMIP (NOT MAKEMAP))
                          (NOT RIGHTFLG))
                      (PRINENDLINE 0 FILE))
               L])

(MYSUPERPRINT/COMMENT2
  [LAMBDA (CMT COMMENT-LMARGIN COMMENT-MIDPOINT COMMENT-RMARGIN FILE SEMIN)
                                                             (* ; "Edited 11-Dec-87 13:31 by DJVB")
                                                             (* ; 
                                              "SEMIN USED IN RECURSIVE CALLS TO PASS DOWN SEMI LEVEL")

    (if (EQ *PRINT-SEMICOLON-COMMENTS* 'ALL)
        then
          
          (* ;; "Print comment between given margins. Use 2 semis if (* * --) or (* --) over 10 long, otherwise use one semi.")

        (LET*
         ((SEMI (OR SEMIN (if (OR (AND (SUPERPRINTEQ (CADR CMT)
                                              COMMENTFLG)
                                       (SETQ CMT (CDR CMT)))
                                  (GREATERP (LENGTH CMT)
                                         10))
                              then 2
                            else 1)))
          (SEMIS (if (EQ SEMI 2)
                     then ";;"
                   else ";")))
         (OR SEMIN (SETQ CMT (CDR CMT)))                     (* ; "IF TOP LEVEL, SKIP *")

         (SETQ FILE (\GETSTREAM FILE 'OUTPUT))
         (AND (EQ (DSPXPOSITION NIL FILE)
                  COMMENT-LMARGIN)
              (PRINOPEN TAIL SEMIS FILE))                    (* ; 
                                                           "does PRIN3, but only do if still at left")

         (for TAIL on CMT bind LASTITEM THISITEM finally (if TAIL
                                                             then (PRINDOTP TAIL FILE))
            do (SETQ THISITEM (CAR TAIL))
               [if (OR (EQ LASTITEM '-)
                       (AND (GEQ (DSPXPOSITION NIL FILE)
                                 COMMENT-MIDPOINT)
                            (NOT (LISTP THISITEM))
                            (LITATOM LASTITEM)
                            (SELCHARQ (NTHCHARCODE LASTITEM -1)
                                 ((; %. -) 
                                      T)
                                 NIL)))
                   then (PRINENDLINE COMMENT-LMARGIN FILE)
                        (PRINOPEN TAIL SEMIS FILE)
                 else (if [AND (NEQ CMT TAIL)
                               (OR (LISTP LASTITEM)
                                   (NOT (MEMB THISITEM '(%. %, ; %:]
                          then (SUPERPRINT/SPACE FILE))
                      (OR (LISTP THISITEM)
                          (STRINGP THISITEM)
                          (if (GEQ (PLUS (DSPXPOSITION NIL FILE)
                                         (STRINGWIDTH THISITEM (OR FILE *STANDARD-OUTPUT*)
                                                T)
                                         (STRINGWIDTH (if (CDR TAIL)
                                                          then " "
                                                        else ")")
                                                (OR FILE *STANDARD-OUTPUT*)))
                                   COMMENT-RMARGIN)
                              then (PRINENDLINE COMMENT-LMARGIN FILE)
                                   (PRINOPEN TAIL SEMIS FILE]
               (SETQ LASTITEM THISITEM)
               (if (LISTP LASTITEM)
                   then (MYSUPERPRINT/COMMENT2 LASTITEM COMMENT-LMARGIN COMMENT-MIDPOINT 
                               COMMENT-RMARGIN FILE SEMI)
                 elseif (STRINGP LASTITEM)
                   then (PRIN2-LONG-STRING LASTITEM FILE NIL TAIL COMMENT-LMARGIN COMMENT-RMARGIN T 
                               SEMI)
                 else (PRIN2S LASTITEM TAIL FILE)))
         (PRINSHUT TAIL NIL FILE)                            (* ; "IN CASE MAKING MAP")
                                                             (* ; 
                                                          "AND FORCE NEWLINE IN MYSUPERPRINT/COMMENT")

         (SETQ RIGHTFLG NIL))
      else                                                   (* ; "Do it the old way as (* --)")

           (SUPERPRINT/COMMENT2 CMT COMMENT-LMARGIN COMMENT-MIDPOINT COMMENT-RMARGIN FILE])
)
(MOVD 'MYEDITDATE? 'EDITDATE?)
(MOVD 'MYSUPERPRINT/COMMENT 'SUPERPRINT/COMMENT)

(PUTPROPS FUNCTIONS EDITDEF EDITDEF.FUNCTIONS)

(PUTPROPS COMMENTHACKS MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))

(PUTPROPS COMMENTHACKS FILETYPE :TCOMPL)
(DECLARE%: DONTCOPY 

(ADDTOVAR EDITHISTALIST (COMMENTHACKS ("10-Dec-87 10:59:27" DJVB {DSK}<XAVIER>COMMENTHACKS.;1
                                             (COMMENT2 EDITDATE? MYEDITDATE? MYSUPERPRINT/COMMENT 
                                                    EDITDEF.FUNCTIONS FIXDEFUNEDITDATE))
                               ("10-Dec-87 17:09:35" DJVB {DSK}<XAVIER>COMMENTHACKS.;3
                                      (MYSUPERPRINT/COMMENT COMMENT2 MYSUPERPRINT/COMMENT2 
                                             MYEDITDATE?)
                                      (STUFF TO GET EDITDATE INTO FUNCTIONS AND PRINT SEMICOLON 
                                             COMMENTS FOR EVERYTHING))
                               ("11-Dec-87 12:49:30" DJVB {DSK}<XAVIER>COMMENTHACKS.;4 (
                                                                                MYSUPERPRINT/COMMENT2
                                                                                        ))
                               ("11-Dec-87 12:52:55" DJVB {DSK}<XAVIER>COMMENTHACKS.;6 (
                                                                                    EDITDEF.FUNCTIONS
                                                                                        
                                                                                     FIXDEFUNEDITDATE
                                                                                        )
                                      (FIXED DETAILS))
                               ("11-Dec-87 13:33:43" DJVB {DSK}<XAVIER>COMMENTHACKS.;7 (
                                                                                MYSUPERPRINT/COMMENT2
                                                                                        
                                                                                 MYSUPERPRINT/COMMENT
                                                                                        )
                                      (FIXING DETAILS))))
)
(PUTPROPS COMMENTHACKS COPYRIGHT ("Unisys Corp." 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1135 12019 (EDITDEF.FUNCTIONS 1145 . 1784) (FIXDEFUNEDITDATE 1786 . 3426) (MYEDITDATE? 
3428 . 4692) (MYSUPERPRINT/COMMENT 4694 . 7753) (MYSUPERPRINT/COMMENT2 7755 . 12017)))))
STOP
ΓΏ