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

(FILECREATED "16-Apr-2018 21:40:32" {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>PRINTFN.;4
 14468  

      changes to%:  (FNS PF)

      previous date%: "28-Jun-99 17:09:59" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>PRINTFN.;3)


(* ; "
Copyright (c) 1986, 1987, 1990, 1999, 2018 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT PRINTFNCOMS)

(RPAQQ PRINTFNCOMS

       [(* * PRINTFN)
        (FNS PF PF* PMORE PRINTFN PRINTFNDEF FINDFNDEF PFCOPYBYTES DISPLAYP)
        (INITVARS PFDEFAULT (LASTFNDEF))
        (DECLARE%: DONTCOPY (MACROS PFPRINCHAR PFOUTCHAR))
        (P (MOVD? 'COPYBYTES 'PFCOPYBYTES))
        (USERMACROS PF)
        (GLOBALVARS **COMMENT**FLG LASTFNDEF LASTWORD PFDEFAULT FILERDTBL USEMAPFLG)
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA PF* PF)
                                                                             (NLAML)
                                                                             (LAMA])
(* * PRINTFN)


(DEFINEQ

(PF

  [NLAMBDA FN
                                           (* ; "Edited  4-Apr-2018 11:13 by rmk:")


    (* ;; "RMK; Fixed to skip compiled files, also to use FUNCTIONS as well as FNS.  That might not help, if FUNCTIONS are not included in the filemap.")


    (* ;; "Print from files known to masterscope database before looking at whereis database.  Note, however, that it also prefers the masterscope database to incore files")


    (* ;; "If FN is NIL, prints the function named by LASTWORD")


    (* ;; "If FN is a list, then extra args are interpreted as:")


    (* ;; " OUTPUT FILE")


    (* ;; "...")


    (RESETLST
        (PROG (OUT OTHERARGS IFILES)
              (SETQ FN (NLAMBDA.ARGS FN))                    (* ; "Grab the args as a list")

              [COND
                 ((LISTP FN)                                 (* ; 

                                     "If it's a list, take the first element as the function name.")

                  (SETQ OTHERARGS (CDR FN))
                  (SETQ FN (CAR FN]
              (COND
                 (FN                                         (* ; "FN name specified; use it.")

                     (SETQ LASTWORD FN))
                 (T                                          (* ; "Not specified, use LASTWORD")

                    (SETQ FN LASTWORD)))
              [SETQ IFILES (OR (CAR OTHERARGS)
                               (APPEND (WHEREIS FN 'FNS T)
                                      (WHEREIS FN 'FUNCTIONS T]
              [RESETSAVE (OUTPUT (COND
                                    ((CADR OTHERARGS)        (* ; 

                                   "An output file was specified; if not open for output, open it.")

                                     (OR (OPENP (CADR OTHERARGS)
                                                'OUTPUT)
                                         (WINDOWP (CADR OTHERARGS))
                                         (PROGN [RESETSAVE (SETQ OUT (OPENFILE (CADR OTHERARGS)
                                                                            'OUTPUT))
                                                       '(PROGN (CLOSEF? OLDVALUE]
                                                OUT)))
                                    (T                       (* ; "otherwise, use primary output.")

                                       T]                    (* ; "skip compiled files")

              (FOR
 FILE INSIDE
 IFILES UNLESS
 (MEMB (FILENAMEFIELD FILE 'EXTENSION)
                                                               *COMPILED-EXTENSIONS*)
                 DO
 (PRINTFN
 FN FILE))))])

(PF*

  [NLAMBDA FN
                                                (* ; "Edited 10-Jun-87 11:09 by jds")


(* ;;; "Print the function FN (or LASTWORD), with comments visible to the user.")


    (RESETVARS (**COMMENT**FLG)
               (APPLY (FUNCTION PF)
                      FN])

(PMORE

  [LAMBDA NIL
                                                (* lmm " 9-AUG-78 17:21")


                                                             (* lmm "17-MAY-78 15:38")

    (PRINTFNDEF
 (CAR LASTFNDEF)
           T
           (CADDR LASTFNDEF)
           -1
           (CADDDR LASTFNDEF])

(PRINTFN

  [LAMBDA (FN FROMFILE TOFILE)
                               (* lmm "14-Aug-84 14:16")

    (PROG ((LOC (FINDFNDEF
 FN FROMFILE)))
          (COND
             ((LISTP LOC)
              (SETQ LASTFNDEF LOC)
              (PRINTFNDEF
 (CAR LOC)
                     TOFILE
                     (CADR LOC)
                     (CADDR LOC)
                     (CADDDR LOC))
              (RETURN FN))
             ((EQ LOC 'FILE.NOT.FOUND)
              (printout TOFILE "file " FROMFILE " not found." T))
             (T (printout TOFILE FN " not found on " LOC "." T])

(PRINTFNDEF

  [LAMBDA (SRCFIL DSTFIL START END TYPE)
                     (* bvm%: " 9-Sep-86 15:54")

    (RESETLST (PROG (TEM)
                    [COND
                       ((SETQ TEM (GETSTREAM DSTFIL 'OUTPUT T))
                        (SETQ DSTFIL TEM))
                       (T (RESETSAVE (SETQ DSTFIL (OPENSTREAM DSTFIL 'OUTPUT))
                                 '(PROGN (CLOSEF? OLDVALUE]
                    [COND
                       ((SETQ TEM (GETSTREAM SRCFIL 'INPUT T))
                        (RESETSAVE NIL (LIST 'SETFILEPTR TEM (GETFILEPTR TEM)))
                        (SETQ SRCFIL TEM))
                       (T (RESETSAVE (SETQ SRCFIL (OPENSTREAM SRCFIL 'INPUT))
                                 '(PROGN (CLOSEF? OLDVALUE]
                    (PRIN1 "{from " DSTFIL)
                    (PRIN2 (FULLNAME SRCFIL)
                           DSTFIL T)
                    (PRIN1 "}
" DSTFIL))
           (COND
              ((OR (NOT (DISPLAYP
 DSTFIL))
                   (EQ PFDEFAULT 'COPYBYTES)
                   (EQ TYPE 'MAC))
               (COPYBYTES SRCFIL DSTFIL START END))
              (T (PFCOPYBYTES
 SRCFIL DSTFIL START END PFDEFAULT)))
           (TERPRI DSTFIL])

(FINDFNDEF

  [LAMBDA (FN FROMFILE)
                                      (* bvm%: "27-Aug-86 16:27")

          
          (* * "Locates FNS definition of FN on FROMFILE.  If found, returns a list (file start end type); if file not found, returns symbol FILE.NOT.FOUND; if file found but not fn, returns full name of file that was found")


    (LET (FULL MAP VALUE)
         (COND
            ((NOT (SETQ FULL (FINDFILE FROMFILE T)))
             'FILE.NOT.FOUND)
            [(COND
                ((SETQ MAP (OR (GETFILEMAP FULL)
                               (LOADFILEMAP FULL)))
          
          (* First clause is quick check when the file already has a map.

          LOADFILEMAP will find file map, rebuild if necessary and rewrite it on file if 

          updatemapflg is T.)


                 (AND (for
 GROUP in
 (CDR MAP) thereis
 (SETQ VALUE (FASSOC FN GROUP)))
                      (LIST FULL (CADR VALUE)
                            (CDDR VALUE)
                            'MAP]
            (T FULL])

(PFCOPYBYTES

  [LAMBDA (SRCFIL DSTFIL START END FLG)                      (* ; "Edited 29-Mar-96 11:51 by rmk")

                                                             (* ; "Edited 24-Mar-93 14:16 by rmk:")

                                                             (* lmm "28-Sep-86 14:38")


    (* ;; " copy from SRCFIL to DSTFIL, paying attention to font changes. Other stuff about truncating lines gone away.  Interprets all possible EOL conventions as EOL.  Has to call \NSIN macro in order to keep track of character count--READDCODE doesn't do that.")


    (DECLARE
 (GLOBALVARS CHANGECHAR COMMENTFLG **COMMENT**FLG))
    (RESETLST
        (PROG ((SSTRM (\INSTREAMARG SRCFIL))
               (DSTRM (\OUTSTREAMARG DSTFIL))
               FONTARRAY CHARCODE %#CHARS MAXFONT)
              (DECLARE
 (SPECVARS . T))
              (COND
                 ((IMAGESTREAMP DSTRM)
                  (SETQ FONTARRAY (FONTMAPARRAY))
                  (SETQ MAXFONT (ARRAYSIZE FONTARRAY))
                  (RESETSAVE NIL (LIST (FUNCTION DSPFONT)
                                       (DSPFONT NIL DSTRM)
                                       DSTRM))
                  (DSPFONT (ELT FONTARRAY 1)
                         DSTRM)))
              (SETQ %#CHARS (COND
                               (END (SETFILEPTR SSTRM START)

                                    (* ;; "Doesn't call \SETFILEPTR cause START has to be checked")


                                    (IDIFFERENCE (COND
                                                    ((EQ END -1)
                                                     (GETEOFPTR SSTRM))
                                                    (T END))
                                           START))
                               (START)
                               (T                            (* ; "Stop on end of file")

                                  (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (STREAM FN)
                                                                   (REPLACE
 ENDOFSTREAMOP
                                                                      OF
 STREAM WITH
 FN]
                                                       SSTRM
                                                       (FETCH
 ENDOFSTREAMOP OF
 SSTRM)))
                                  (REPLACE
 ENDOFSTREAMOP OF
 SSTRM
                                     WITH
 (FUNCTION NILL))
                                  MAX.SMALL.INTEGER)))
              (COND
                 ((AND START (ILEQ %#CHARS 0))
                  (RETURN T)))
          LP  [COND
                 ((ILEQ %#CHARS 0)
                  (COND
                     (START (RETURN T))
                     (T                                      (* ; 

                                                           "Just keep the counter going until EOF")

                        (SETQ %#CHARS MAX.SMALL.INTEGER]
              (SETQ CHARCODE (\NSIN SSTRM (UNFOLD (ACCESS-CHARSET SSTRM)
                                                 256)
                                    NIL %#CHARS))
              (SELCHARQ CHARCODE
                   ((LINEFEED EOL)                           (* ; 

                                                 "Output CR, since we don't rely on EOL convention")

                        (TERPRI DSTRM)
                        (GO LP))
                   (CR 
                       (* ;; "Consume next LF, since we don't rely on EOL convention")


                       (CL:WHEN (EQ (CHARCODE LF)
                                    (\PEEKBIN SSTRM T))
                           (\BIN SSTRM)
                           (SETQ %#CHARS (SUB1 %#CHARS)))
                       (TERPRI DSTRM)
                       (GO LP))
                   (NIL (TERPRI DSTRM)                       (* ; 

                                               "This is the EOF when we are copying the whole file")

                        (RETURN T))
                   (^F                                       (* ; 

                                                           "Don't do EOL interpretation after ^F")

                       (SETQ CHARCODE (\NSIN SSTRM (UNFOLD (ACCESS-CHARSET SSTRM)
                                                          256)
                                             NIL %#CHARS))
                       (COND
                          ((AND (IGEQ MAXFONT CHARCODE)
                                (NEQ CHARCODE 0))
                           (DSPFONT (ELT FONTARRAY CHARCODE)
                                  DSTRM)
                           (GO LP))))
                   NIL)
              (\OUTCHAR DSTRM CHARCODE)
              (GO LP)))])

(DISPLAYP

  [LAMBDA (STREAM)
                                           (* AJB "23-Sep-85 14:53")

    (LET ((STRM (\OUTSTREAMARG STREAM T)))
         (AND STRM (OR (DISPLAYSTREAMP STRM)
                       (IMAGESTREAMTYPEP STRM 'TEXT])
)

(RPAQ? PFDEFAULT
 NIL)

(RPAQ? LASTFNDEF
 )
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(PUTPROPS PFPRINCHAR
 MACRO
 ((CC)
                                    (COND
                                       (EOLFLG (TERPRI DSTRM)
                                              (SETQ EOLFLG NIL)
                                              (SETQ HPOS LMAR)))
                                    (COND
                                       ((NOT (ZEROP %#SPACES))
                                        (FRPTQ (COND
                                                  ((OR FLG STRFLG)
                                                   %#SPACES)
                                                  (T (FOLDHI %#SPACES 2)))
                                               (PFOUTCHAR (CHARCODE SPACE)))
                                        (SETQ %#SPACES 0)))
                                    (PFOUTCHAR CC)))

(PUTPROPS PFOUTCHAR
 MACRO
 ((CC)
                                   ([LAMBDA (WIDTH)
                                      (COND
                                         ((AND WIDTH (IGREATERP (add
 HPOS WIDTH)
                                                            RMAR))
                                                             (* past RIGHT margin, force eol)

                                          (TERPRI DSTRM)
                                          (SETQ HPOS WIDTH)))
                                      (\OUTCHAR DSTRM CC]
                                    (\STREAMCHARWIDTH CC DSTRM \PRIMTERMTABLE))))
)
)

(MOVD? 'COPYBYTES 'PFCOPYBYTES)

(ADDTOVAR EDITMACROS
 [PF NIL (ORR [(E (APPLY* 'PF (FIRSTATOM (%##]
                                      ((E 'PF?])

(ADDTOVAR EDITCOMSA
 PF)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS **COMMENT**FLG LASTFNDEF LASTWORD PFDEFAULT FILERDTBL USEMAPFLG)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 PF* PF)

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 )
)
(PUTPROPS PRINTFN COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1999 2018))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1112 12351 (PF 1122 . 3817) (PF* 3819 . 4117) (PMORE 4119 . 4442) (PRINTFN 4444 . 5039)
 (PRINTFNDEF 5041 . 6263) (FINDFNDEF 6265 . 7321) (PFCOPYBYTES 7323 . 12097) (DISPLAYP 12099 . 12349))
)))
STOP