GREP: avoids tedit-file formatting, font change chars in Lisp source files, adds TGREP (#1513)

* GREP: avoids tedit-file formatting, font change chars in Lisp source files, adds TGREP

* Oops, TAB is not a fontchange character

* Updated documentation GREP.TEDIT

* Avoids EXPORTS.ALL by doing SYSREC1

* Don't change the outcharfn

* Make it work on Tedit files

* Print out the filename instead of the stream for Tedit files

Author: rmkaplan

lispusers/GREP

@@ -1,32 +1,33 @@
 (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   
+
(FILECREATED "16-Mar-2024 11:16:38" {WMEDLEY}<lispusers>GREP.;31
 6115   
 
-      :CHANGES-TO (FNS DOGREP)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "26-Jun-2022 14:36:21" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GREP.;9)
+      :CHANGES-TO (FNS DOGREP)
 
+      :PREVIOUS-DATE "15-Mar-2024 16:28:09" {WMEDLEY}<lispusers>GREP.;29)
 
-(* ; "
-Copyright (c) 1984-1986 by Xerox Corporation.
-")
 
 (PRETTYCOMPRINT GREPCOMS)
 
-(RPAQQ GREPCOMS
 ((FNS DOGREP GREP PHONE)
-                 (INITVARS (PHONELISTFILES))))
+(RPAQQ GREPCOMS
 [(FNS DOGREP GREP TGREP)
+                 (P (MOVD? 'NILL 'TEDIT.FORMATTEDFILEP))
+                 (COMS (FNS PHONE)
+                       (INITVARS (PHONELISTFILES])
 (DEFINEQ
 
 (DOGREP

   [LAMBDA (STRS FILES OUTSTREAM)
 
+    (* ;; "Edited 16-Mar-2024 11:16 by rmk")

+
+    (* ;; "Edited 20-Jan-2024 13:12 by rmk")

+
     (* ;; "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")

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

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

@@ -46,58 +47,89 @@ Copyright (c) 1984-1986 by Xerox Corporation.
               (STREAM (OR (FINDFILE FILES T)
                           FILES)
                      :DIRECTION :INPUT)
-              (bind
 FOUND for
 STR inside
 STRS first
 (SETFILEINFO STREAM 'ENDOFSTREAMOP
-                                                           (FUNCTION NILL))
+              (for
 STR FOUND FILENAME inside
 STRS first
 (SETQ FILENAME (FULLNAME STREAM))
+                                                        (CL:WHEN (TEDIT.FORMATTEDFILEP STREAM)
+                                                            [SETQ STREAM (OPENTEXTSTREAM
+                                                                          STREAM NIL NIL NIL
+                                                                          '(OBJECTBYTE 0])
+                                                        (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))) 
+                    (bind
 POS STARTPOS while
 (SETQ POS (FFILEPOS STR STREAM NIL NIL NIL NIL 
+                                                              UPPERCASEARRAY))
+                       do
 (CL:UNLESS FOUND
+                              (PRINTOUT OUTSTREAM T T .FONT BOLDFONT "(from " FILENAME ")" .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)
+                          (SETQ STARTPOS (DO
 (SELCHARQ (\BACKCCODE.EOLC STREAM 'ANY)
+                                                  (EOL (\INCCODE.EOLC STREAM)
+                                                       (RETURN (GETFILEPTR STREAM)))
+                                                  (NIL (RETURN 0))
+                                                  NIL)))
+                          (FOR
 I C FROM
 1 TO
 (IDIFFERENCE POS STARTPOS)
+                             DO
 (SETQ C (\INCCODE.EOLC STREAM 'ANY))
+                                (CL:UNLESS (ILESSP C (CHARCODE TAB))
+                                       (PRINTCCODE C OUTSTREAM)))
                           (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))
+                          [BIND
 C DO
 (SELCHARQ (SETQ C (\INCCODE.EOLC STREAM 'ANY))
                                           ((EOL NIL) 
                                                (RETURN))
-                                          (PRINTCCODE C OUTSTREAM)))
+                                          (CL:UNLESS (ILESSP C (CHARCODE TAB))
+                                                 (PRINTCCODE C OUTSTREAM]
                           (TERPRI OUTSTREAM])
 
 (GREP

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

+    (* ;; "Edited 14-Oct-2023 14:43 by rmk")

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

+    (* ;; "Edited  1-Sep-2023 00:16 by rmk")

+
+    (* ;; "Edited 23-Jul-2023 19:55 by rmk")

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

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

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

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

+                                                             (* lmm " 1-Apr-85 15:27")

+                                                             (* lmm " 1-Apr-85 15:27")

     (RESETLST
+        [SELECTQ OUTSTREAM
+            (NIL (SETQ OUTSTREAM T))
+            (T)
+            (CL:UNLESS (GETSTREAM OUTSTREAM 'OUTPUT T)
+                [RESETSAVE (SETQ OUTSTREAM (OPENSTREAM OUTSTREAM 'OUTPUT 'NEW))
+                       `(PROGN (CLOSEF? OLDVALUE])]
         [RESETSAVE NIL `(PROGN (DSPFONT ,(DSPFONT NIL OUTSTREAM)
                                       ,OUTSTREAM]
-        (DOGREP
 STRS FILES T OUTSTREAM))])
+        [RESETSAVE (LINELENGTH T OUTSTREAM)
+               `(PROGN (LINELENGTH OLDVALUE ,OUTSTREAM]
+        (DOGREP
 STRS FILES OUTSTREAM)
+        OUTSTREAM)])
+
+(TGREP

+  [LAMBDA (STRS FILES)
                                       (* ; "Edited 20-Jan-2024 14:14 by rmk")

+    (TEXTSTREAM (TEDIT (GREP
 STRS FILES (OPENTEXTSTREAM))
+                       'TGREP NIL '(READONLY T])
+)
+
+(MOVD? 'NILL 'TEDIT.FORMATTEDFILEP)
+(DEFINEQ
 
 (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)))))
+  (FILEMAP (NIL (496 5830 (DOGREP 506 . 4544) (GREP 4546 . 5596) (TGREP 5598 . 5828)) (5868 6063 (PHONE 
+5878 . 6061)))))
 STOP