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


(FILECREATED "25-Sep-2022 11:00:07" 
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>TEDIT-PF-SEE.;113
 7734   

      :PREVIOUS-DATE " 5-May-2022 23:48:59" 
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>TEDIT-PF-SEE.;112)


(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 (810 7208 (PF-TEDIT 820 . 7206)))))
STOP