;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*- ;;; Patch file for System version 126.103 ;;; Reason: ;;; Improvements to SRCCOM (Source Compare utilities): ;;; ;;; 1. Add new parameter, *ESCAPE-CHARACTER-IGNORE-FLAG*, which provides ;;; the capability of ignoring escape characters in input files (e.g., font changes). ;;; ;;; *ESCAPE-CHARACTER-IGNORE-FLAG*, if non-NIL, is either: ;;; a) A character to be ignored, or ;;; b) A list whose CAR is the escape character and whose CADR is the number ;;; of succeeding characters to ignore. ;;; ;;; This applies to :TEXT source comparison only. ;;; ;;; 2. Fix up SOURCE-COMPARE doc string. ;;; ;;; 3. SRCCOM:SOURCE-COMPARE is the most useful user interface routine provided. ;;; Export it, and import into USER package. ;;; Written 7-Oct-88 18:14:54 by keith (Keith Corbett) at site Gigamos Cambridge ;;; while running on Breaking Glass from band 3 ;;; with Experimental System 126.102, Experimental ZWEI 126.14, Experimental ZMail 74.9, Experimental Local-File 76.0, Experimental File-Server 25.0, Experimental Lambda-Diag 18.0, Experimental Unix-Interface 15.0, Experimental Tape 26.4, microcode 1762, SDU Boot Tape 3.14, SDU ROM 103. ;;;SRCCOM ;;; Added parameters and handling for igoring escaped characters. ;;; Currently supports a single known escape character, optionally ;;; followed by a number of characters to be ignored. 10/88 Keith ; From modified file DJ: L.IO1; SRCCOM.LISP#41 at 7-Oct-88 18:16:55 #8R SRCCOM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SRCCOM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO1; SRCCOM  " ;;;Make interface externally available: (export (intern "SOURCE-COMPARE" :srccom)) ;;(import (find-symbol "SOURCE-COMPARE" :srccom) :user) )) ; From modified file DJ: L.IO1; SRCCOM.LISP#41 at 7-Oct-88 18:15:02 #8R SRCCOM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SRCCOM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO1; SRCCOM  " (DEFUN CREATE-FILE (FILENAME &AUX STREAM MODE) "Make a SRCCOM:FILE object for a file to be source compared. FILENAME is opened and the SRCCOM:FILE object contains a stream for it." (SETQ STREAM (OPEN FILENAME '(:IN))) (LET ((GENERIC-PATHNAME (SEND FILENAME ':GENERIC-PATHNAME))) (FS:READ-ATTRIBUTE-LIST GENERIC-PATHNAME STREAM) (SETQ MODE (OR (SEND GENERIC-PATHNAME ':GET ':MODE) ':LISP))) (MAKE-FILE FILE-STREAM STREAM FILE-NAME (SEND STREAM ':TRUENAME) FILE-MAJOR-MODE MODE)) ;;;Escape handling: )) ; From modified file DJ: L.IO1; SRCCOM.LISP#41 at 7-Oct-88 18:15:06 #8R SRCCOM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SRCCOM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO1; SRCCOM  " (defparameter *escape-character-ignore-flag* nil "If non-NIL, either a) A character to be ignored, or b) A list whose CAR is the escape character and whose CADR is the number of succeeding characters to ignore. Applies to :TEXT source comparison only.") )) ; From modified file DJ: L.IO1; SRCCOM.LISP#41 at 7-Oct-88 18:15:08 #8R SRCCOM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SRCCOM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO1; SRCCOM  " (defun handle-escape-characters-in-line (line &optional (flag *escape-character-ignore-flag*)) (if (not (typep line '(or string array))) line (if (and (consp flag) (zerop (cadr flag))) (setq flag (car flag))) (typecase flag (null line) (atom (lisp:remove flag line :test #'char=)) (t (let (ch gotone (out 0) (len (array-active-length line)) (esc (character (car flag))) (nesc (cadr flag))) (do* ((in 0 (1+ in))) ((>= in len) (if (array-has-fill-pointer-p line) (and (setf (fill-pointer line) out) line) (subseq line 0 out))) (setq ch (aref line in)) (cond ((char-equal ch esc) ;Got an escape char, (setq gotone t) ; set flag, (incf in nesc)) ; skip escaped chars. ((null gotone) ;Just skip. (incf out)) (t (setf (char line out) (char line in)) ;Copy char (incf out))))))))) )) ; From modified file DJ: L.IO1; SRCCOM.LISP#41 at 7-Oct-88 18:15:10 #8R SRCCOM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SRCCOM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO1; SRCCOM  " (DEFUN GET-FILE-LINE (file line-no) ;; Modified to check FILE-COMPARE 8/5/83 (RAF @ TI-CSL60). "Get the line recorded in FILE, a SRCCOM:FILE structure, for line number LINE-NO. This will cause more data to be read from the stream if necessary. The line is simply a string containing the data on the line." (IF (< LINE-NO (FILE-LENGTH FILE)) (AREF FILE LINE-NO) (MULTIPLE-VALUE-BIND (LINE EOF) (ECASE (FILE-COMPARE FILE) (:TEXT (SEND (FILE-STREAM FILE) ':LINE-IN T)) (:FORM (LET ((X (READ (FILE-STREAM FILE) '**EOF**))) (IF (EQ X '**EOF**) (VALUES NIL T) ;No form, end of file (VALUES X NIL))))) (setq line (handle-escape-characters-in-line line)) (COND ((NOT (AND EOF (OR (NULL LINE) (EQUAL LINE "")))) (ARRAY-PUSH-EXTEND FILE LINE) LINE))))) )) ; From modified file DJ: L.IO1; SRCCOM.LISP#41 at 7-Oct-88 18:15:14 #8R SRCCOM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SRCCOM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO1; SRCCOM  " (DEFUN SOURCE-COMPARE (FILENAME-1 FILENAME-2 &OPTIONAL (OUTPUT-STREAM STANDARD-OUTPUT) (TYPE ':TEXT) &AUX FILE-1 FILE-2) "Source compare files FILENAME-1 and FILENAME-2. Output goes to OUTPUT-STREAM (defaults to STANDARD-OUTPUT). / TYPE argument determines how the files are compared: :TEXT => line by line textual comparison. :FORM => form by form (READ) comparison. / Some free variables serve as parameters: / *PRINT-LABELS* - T means print the preceding identifier (function name, etc.,) preceding each run of non-matching lines. *LINES-NEEDED-TO-MATCH* - number of lines that must match in order for the two files to begin to agree again. *LINES-TO-PRINT-BEFORE* - number of matching lines to print before each run of non-matching lines. *LINES-TO-PRINT-AFTER* - number of matching lines to print after each run of non-matching lines. *DIFFERENCE-PRINTER* - function to print out the differences. See SRCCOM:PRINT-DIFFERENCES for a sample. *LINES-THAT-MATCHED* - available to difference-printer. *ESCAPE-CHARACTER-IGNORE-FLAG* - controls whether//how to ignore escape characters within files for :TEXT comparison." (SETQ FILENAME-1 (FS:MERGE-AND-SET-PATHNAME-DEFAULTS FILENAME-1 *PATHNAME-DEFAULTS* ':UNSPECIFIC ':OLDEST) FILENAME-2 (FS:MERGE-PATHNAME-DEFAULTS FILENAME-2 FILENAME-1)) (UNWIND-PROTECT (PROGN (SETQ FILE-1 (CREATE-FILE FILENAME-1) FILE-2 (CREATE-FILE FILENAME-2)) (DESCRIBE-SRCCOM-SOURCES FILE-1 FILE-2 OUTPUT-STREAM) (SOURCE-COMPARE-FILES FILE-1 FILE-2 OUTPUT-STREAM TYPE)) (AND FILE-1 (SEND (FILE-STREAM FILE-1) ':CLOSE)) (AND FILE-2 (SEND (FILE-STREAM FILE-2) ':CLOSE)))) ;;; Useful interface for automatic comparison )) ; From modified file DJ: L.IO1; SRCCOM.LISP#41 at 7-Oct-88 18:15:17 #8R SRCCOM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SRCCOM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO1; SRCCOM  " (DEFUN SOURCE-COMPARE-FILES (FILE-1 FILE-2 &OPTIONAL (*OUTPUT-STREAM* STANDARD-OUTPUT) (TYPE ':TEXT)) "Source compare data from two SRCCOM:FILE objects, with output to *OUTPUT-STREAM*. SRCCOM:FILE objects are made with SRCCOM:CREATE-FILE, and contain input streams. See SRCCOM:SOURCE-COMPARE for more information." ;;; (SETF (FILE-COMPARE FILE-1) TYPE) (SETF (FILE-COMPARE FILE-2) TYPE) (IF (EQ TYPE ':FORM) (SET-FORM-VARIABLES 'START)) (LET ((FILES-IDENTICAL T)) (DO ((LINE-NO-1 0 (1+ LINE-NO-1)) (LINE-NO-2 0 (1+ LINE-NO-2)) (LINE-1) (LINE-2) (*lines-that-matched* 0)) (NIL) ;; Files are current matched up, check the next two lines (SETQ LINE-1 (GET-FILE-LINE FILE-1 LINE-NO-1) LINE-2 (GET-FILE-LINE FILE-2 LINE-NO-2)) (COND ((NULL (COMPARE-LINES LINE-1 LINE-2)) (SETQ FILES-IDENTICAL NIL) (MULTIPLE-VALUE (LINE-NO-1 LINE-NO-2 LINE-1) (HANDLE-DIFFERENCE FILE-1 LINE-NO-1 FILE-2 LINE-NO-2)) (setq *lines-that-matched* 0)) (t (incf *lines-that-matched*))) (OR LINE-1 (RETURN NIL))) ;When NULL lines match both files are at EOF (CLOSE (FILE-STREAM FILE-1)) (CLOSE (FILE-STREAM FILE-2)) FILES-IDENTICAL) (IF (EQ TYPE ':FORM) (SET-FORM-VARIABLES 'END))) ))