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


(FILECREATED "19-Jul-2022 22:26:08" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GREP.;11
 4725   

      :CHANGES-TO (FNS DOGREP)

      :PREVIOUS-DATE "26-Jun-2022 14:36:21" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GREP.;9)


(* ; "
Copyright (c) 1984-1986 by Xerox Corporation.
")

(PRETTYCOMPRINT GREPCOMS)

(RPAQQ GREPCOMS
 ((FNS DOGREP GREP PHONE)
                 (INITVARS (PHONELISTFILES))))
(DEFINEQ

(DOGREP

  [LAMBDA (STRS FILES OUTSTREAM)

    (* ;; "Edited 19-Jul-2022 22:26 by rmk")


    (* ;; "Edited 26-Jun-2022 14:36 by rmk")


    (* ;; "Edited 18-Jun-2022 10:38 by rmk: Search for linebreaks directly, without calling BFILEPOS or FILEPOS just for EOL character.  Also now compatible with external formats (if FFILEPOS is), and upgraded to full directory specification")

                                                             (* Newman "14-May-86 08:04")


(* ;;; "Originally coded by Larry Masinter.")


(* ;;; "No longer permanently modifies the DSPFONT when DSPFONT is not the same as the DEFAULTFONT.  -DVN '14-May-86 08:03:59'")


         (* * No longer permanently modifies the DSPFONT when DSPFONT is not the same as 

         the DEFAULTFONT. -DVN "14-May-86 08:03:59")


    (if
 (LISTP FILES)
        then
 (for
 FILE in
 FILES do
 (DOGREP
 STRS FILE OUTSTREAM))
      elseif
 (STRPOS "*" FILES)
        then
 (DOGREP
 STRS (DIRECTORY FILES NIL "" "")
                    OUTSTREAM)
      elseif
 (DIRECTORYNAMEP FILES)
      elseif
 (CL:WITH-OPEN-FILE
              (STREAM (OR (FINDFILE FILES T)
                          FILES)
                     :DIRECTION :INPUT)
              (bind
 FOUND for
 STR inside
 STRS first
 (SETFILEINFO STREAM 'ENDOFSTREAMOP
                                                           (FUNCTION NILL))
                 do
 (SETFILEPTR STREAM 0)
                    (bind
 POS while
 (SETQ POS (FFILEPOS STR STREAM NIL NIL NIL NIL UPPERCASEARRAY))
                       do
 (OR FOUND (PROGN (PRINTOUT OUTSTREAM T .FONT COMMENTFONT "(from "
                                                  (FULLNAME STREAM)
                                                  ")" .FONT DEFAULTFONT T)
                                           (SETQ FOUND T))) 

                          (* ;; "Copying from the beginning of this line. Originally this used BFILEPOS (backwards FILEPOS?), which did repeated calls to forward FFILEPOS in what appears to be a binary set of probes.  But FFILEPOS is really SLOW-POS for a single character, and the last line-start is presumaby not that far back.  So just walk backwards.")


                          (COPYCHARS STREAM OUTSTREAM (DO
 (SELCHARQ (\BACKCCODE.EOLC STREAM
                                                                           'ANY)
                                                               (EOL (\INCCODE.EOLC STREAM)
                                                                    (RETURN (GETFILEPTR STREAM)))
                                                               (NIL (RETURN 0))
                                                               NIL))
                                 POS)
                          (DSPFONT BOLDFONT OUTSTREAM)
                          (COPYCHARS STREAM OUTSTREAM POS (ADD
 POS (NCHARS STR)))
                          (DSPFONT DEFAULTFONT OUTSTREAM) 

                          (* ;; "Copying to the end of this line (or end of file)")


                          (BIND
 C DO
 (SELCHARQ (SETQ C (\INCCODE.EOLC STREAM 'ANY))
                                          ((EOL NIL) 
                                               (RETURN))
                                          (PRINTCCODE C OUTSTREAM)))
                          (TERPRI OUTSTREAM])

(GREP

  [LAMBDA (STRS FILES OUTSTREAM)

    (* ;; "Edited 26-Jun-2022 13:28 by rmk: added OUTSTREAM")


    (* ;; "Edited 26-Jun-2022 13:25 by rmk")


    (* ;; "Edited 18-Jun-2022 09:50 by rmk")


    (CL:UNLESS OUTSTREAM (SETQ OUTSTREAM T))                 (* lmm " 1-Apr-85 15:27")

    (RESETLST
        [RESETSAVE NIL `(PROGN (DSPFONT ,(DSPFONT NIL OUTSTREAM)
                                      ,OUTSTREAM]
        (DOGREP
 STRS FILES T OUTSTREAM))])

(PHONE

  [LAMBDA (NAME)                                             (* lmm " 5-Mar-86 12:14")

    (GREP
 NAME (OR PHONELISTFILES (PROMPTFORWORD "Name of directory file: "])
)

(RPAQ? PHONELISTFILES
 )
(PUTPROPS GREP COPYRIGHT ("Xerox Corporation" 1984 1985 1986))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (518 4610 (DOGREP 528 . 3944) (GREP 3946 . 4423) (PHONE 4425 . 4608)))))
STOP