(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED " 5-May-2022 23:48:59" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TEDIT-PF-SEE.;112 7835   

      :CHANGES-TO (COMMANDS ts tf)
                  (FNS PF-TEDIT)
                  (VARS TEDIT-PF-SEECOMS)

      :PREVIOUS-DATE " 5-May-2022 23:26:29" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TEDIT-PF-SEE.;111)


(PRETTYCOMPRINT TEDIT-PF-SEECOMS)

(RPAQQ TEDIT-PF-SEECOMS
       [(FNS PF-TEDIT)
        (COMMANDS ts tf)
        (FILES (SYSLOAD)
               REGIONMANAGER)
        (P (MOVD? 'PFCOPYBYTES 'PFI.mAYBE.PP.DEFINITION))
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                             (NLAML)
                                                                             (LAMA])
(DEFINEQ

(PF-TEDIT
  [LAMBDA (FN IFILES REPRINT)                                (* ; "Edited  5-May-2022 23:11 by rmk")
                                                             (* ; "Edited 12-Jan-2022 13:15 by rmk")
                                                             (* ; "Edited 30-Dec-2021 23:17 by rmk")

    (* ;; "PF* to a read-only TEDIT window.  First argument is the function name, second if given is the input file.")

    (* ;; "This uses PFCOPYBYTES so we see what it looks like on the file.  But some functions were not prettyprinted, so they appear as useless garbage.")

    (* ;; "In that case, calling again with REPRINT=T will read and reprint.  And, invoking tf again with no arguments at all will also reprint the last function in the same window")

    (SETQ IFILES (MKLIST IFILES))
    (CL:WHEN (LISTP FN)
        (SETQ FN (CAR FN)))
    (SELECTQ FN
        ((t T NIL) 
             (SETQ REPRINT T)
             (SETQ FN LASTWORD))
        (SETQ LASTWORD FN))
    (CL:UNLESS FN (ERROR "No function to print"))
    (CL:WHEN (INTERSECTION '(T t)
                    IFILES)
        (SETQ REPRINT T)
        [SETQ IFILES (LDIFFERENCE IFILES '(t T])
    (IF [OR IFILES (SETQ IFILES (APPEND (WHEREIS FN 'FNS T)
                                       (WHEREIS FN 'FUNCTIONS T]
        THEN                                                 (* ; "skip compiled files")

        (* ;; "Since we are creating readonly Tedits, try to keep the TTY where it is.")

        (FOR IFILE LOC TSTREAM ENV EXPR TFPROP WINDOW INSIDE IFILES
           UNLESS (MEMB (FILENAMEFIELD IFILE 'EXTENSION)
                        *COMPILED-EXTENSIONS*)
           DO (SETQ LOC (FINDFNDEF FN IFILE))
              (IF (LISTP LOC)
                  THEN (SETQ TFPROP (LIST FN (CAR LOC)))
                       [SETQ WINDOW (FIND W IN (OPENWINDOWS)
                                       SUCHTHAT (AND (EQUAL TFPROP (WINDOWPROP W 'TF))
                                                     (WINDOWPROP W 'TEXTOBJ]
                       [IF (AND WINDOW (NOT REPRINT))
                           THEN 
                                (* ;; 
               "If already an open PF window on this function in this file, just raise it to the top")

                                (TOTOPW WINDOW)
                                (RETURN)
                         ELSE (CL:WITH-OPEN-FILE (ISTREAM (POP LOC)
                                                        :DIRECTION :INPUT)
                                     (SETQ ENV (LISPSOURCEFILEP ISTREAM))
                                     (SETFILEINFO ISTREAM 'FORMAT ENV)
                                     (SETQ TSTREAM (OPENTEXTSTREAM))
                                     (DSPFONT DEFAULTFONT TSTREAM)
                                     (PRINT-READER-ENVIRONMENT ENV TSTREAM)
                                     (IF REPRINT
                                         THEN (SETFILEPTR ISTREAM (POP LOC))
                                              (SETQ EXPR (WITH-READER-ENVIRONMENT ENV (READ ISTREAM))
                                               )
                                              (WITH-READER-ENVIRONMENT ENV
                                                  (IF (EQ FN (CAR EXPR))
                                                      THEN (DSPFONT BOLDFONT TSTREAM)
                                                           (PRINT FN TSTREAM)
                                                           (DSPFONT DEFAULTFONT TSTREAM)
                                                           (SETQ EXPR (CADR EXPR))
                                                           (PRINTDEF EXPR 3 T NIL NIL TSTREAM)
                                                    ELSEIF (EQ FN (CADR EXPR))
                                                      THEN 
                                                           (* ;; 
                                              "Presumably a DEFUN.  Print the CAR, boldface the cadr")

                                                           (PRINTOUT TSTREAM "(" .P2 (CAR EXPR)
                                                                  " " .FONT BOLDFONT .P2 (CADR EXPR)
                                                                  .FONT DEFAULTFONT " " .P2
                                                                  (CADDR EXPR)
                                                                  T 3)
                                                           (PRINTDEF (CDDDR EXPR)
                                                                  3 T T NIL TSTREAM)
                                                           (PRIN3 ")" TSTREAM)
                                                    ELSE (PRINTDEF EXPR 3 NIL NIL NIL TSTREAM)))
                                       ELSE (PFI.MAYBE.PP.DEFINITION ISTREAM TSTREAM (POP LOC)
                                                   (POP LOC)))
                                     (TERPRI TSTREAM)
                                     [TEDIT TSTREAM (OR WINDOW 'PF-TEDIT)
                                            NIL
                                            `(READONLY T LEAVETTY T TITLE ,(CONCAT FN "  from "
                                                                                  (FULLNAME ISTREAM]

                                 (* ;; "The windowprop allows for reprinting as a window action, or reprinting from a command that can find and reuse the previous (presumably unprettied) window.")

                                     (WINDOWPROP (WFROMDS TSTREAM)
                                            'TF TFPROP)

                                     (* ;; "Remove this when TEDIT honors the TITLE property")

                                     (WINDOWPROP (WFROMDS TSTREAM)
                                            'TITLE
                                            (CONCAT FN "  from " (FULLNAME ISTREAM]
                ELSEIF (EQ LOC 'FILE.NOT.FOUND)
                  THEN (printout T "file " IFILE " not found." T)
                ELSE (printout T FN " not found on " LOC "." T)))
        (SETQ *LAST-DF* FN)
      ELSE (PRINTOUT T FN " has no function definition" T])
)

(DEFCOMMAND ts (FILE WINDOW FORMAT) 
   (TEDIT-SEE (OR (FINDFILE-WITH-EXTENSIONS FILE NIL '(NIL TEDIT TED TXT TEXT TEX))
                  (ERROR "FILE NOT FOUND" FILE))
          (OR WINDOW 'SEE-TEDIT)
          FORMAT))

(DEFCOMMAND tf (FN . IFILES) (PF-TEDIT FN IFILES))

(FILESLOAD (SYSLOAD)
       REGIONMANAGER)

(MOVD? 'PFCOPYBYTES 'PFI.mAYBE.PP.DEFINITION)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (911 7309 (PF-TEDIT 921 . 7307)))))
STOP
