github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-12 00:42:56 +00:00
Code Issues Projects Releases Wiki Activity

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

Browse Source 
* 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
This commit is contained in:
rmkaplan 2024-03-18 16:21:06 -07:00 committed by GitHub
parent 8e07e25b9a
commit 5ad5083c6d
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
3 changed files with 67 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

102
lispusers/GREP
View File

@ -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
:EDIT-BY rmk
:CHANGES-TO (FNS DOGREP)
:PREVIOUS-DATE "26-Jun-2022 14:36:21"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GREP.;9)
: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,50 +47,81 @@ 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 14-Oct-2023 14:43 by rmk")
(* ;; "Edited 1-Sep-2023 00:16 by rmk")
(* ;; "Edited 23-Jul-2023 19:55 by rmk")
(* ;; "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")
(* 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")
@ -97,7 +129,7 @@ Copyright (c) 1984-1986 by Xerox Corporation.
)
(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

BIN
lispusers/GREP.LCOM
View File

Binary file not shown.

BIN
lispusers/GREP.TEDIT
View File

Binary file not shown.