(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "14-Dec-2024 16:53:27" {WMEDLEY}TEDIT>TEDIT-FIXFILES.;14 9776 :EDIT-BY rmk :CHANGES-TO (FNS CR-LF-FONTFIX) (VARS TEDIT-FIXFILESCOMS) (ADVICE ELT) :PREVIOUS-DATE "12-Dec-2024 21:50:29" {WMEDLEY}TEDIT>TEDIT-FIXFILES.;10) (PRETTYCOMPRINT TEDIT-FIXFILESCOMS) (RPAQQ TEDIT-FIXFILESCOMS ( (* ;; "Hacks that may help in fixing broken Tedit files") (FILES TEDIT-DEBUG) (FNS CRLFSWAP CHANGEPLEN) (FNS CR-LF-FONTFIX) (P (MOVD 'CR-LF-FONTFIX '\TEDIT.GET.SINGLE.CHARLOOKS)) (ADVISE ELT))) (* ;; "Hacks that may help in fixing broken Tedit files") (FILESLOAD TEDIT-DEBUG) (DEFINEQ (CRLFSWAP [LAMBDA (INFILE OUTFILE) (* ; "Edited 12-Dec-2024 08:25 by rmk") (* ; "Edited 9-Dec-2024 13:33 by rmk") (CL:WITH-OPEN-FILE (INSTREAM INFILE :DIRECTION :INPUT) (CL:UNLESS OUTFILE (SETQ OUTFILE (PACKFILENAME 'VERSION NIL 'NAME (CONCAT (FILENAMEFIELD INSTREAM 'NAME) "-SWAPPED") 'BODY INSTREAM))) (CL:WITH-OPEN-FILE (OUTSTREAM OUTFILE :DIRECTION :OUTPUT) (for I B from 1 to (GETEOFPTR INSTREAM) do (BOUT OUTSTREAM (SELCHARQ (SETQ B (BIN INSTREAM)) (LF (CHARCODE CR)) (CR (CHARCODE LF)) B))) (FULLNAME OUTSTREAM]) (CHANGEPLEN [LAMBDA (PC DELTA ARG) (* ; "Edited 11-Dec-2024 15:18 by rmk") (* ;; "Change the length of piece PC by DELTA (negative = shorter).") (LET [(PC (SP PC 1 NIL (GTO ARG] (CL:WHEN (EQ 'Y (ASKUSER NIL NIL (CONCAT "Confirm changing PLEN by " DELTA " from " (PLEN PC) " to " (IPLUS (PLEN PC) DELTA) " ? "))) (FSETPC PC PLEN (IPLUS (PLEN PC) DELTA)) (SP PC 1 NIL (GTO ARG)))]) ) (DEFINEQ (CR-LF-FONTFIX [LAMBDA (FILE TEXTOBJ) (* ; "Edited 14-Dec-2024 14:31 by rmk") (* ; "Edited 12-Dec-2024 21:50 by rmk") (SI::%%WITH-CHANGED-CALLS ((|TEXTPROP in INTERLISP::\TEDIT.GET.SINGLE.CHARLOOKS| . TEXTPROP)) (* ; "Edited 12-Dec-2024 20:51 by rmk") (* ; "Edited 11-Dec-2024 17:11 by rmk") (* ; "Edited 9-Dec-2024 20:11 by rmk") (* ; "Edited 13-Aug-2024 08:49 by rmk") (* ; "Edited 31-Jul-2024 00:04 by rmk") (* ; "Edited 7-Apr-2024 17:21 by rmk") (* ; "Edited 16-Jan-2024 22:46 by rmk") (* ; "Edited 21-Dec-2023 23:54 by rmk") (* ; "Edited 19-Dec-2023 10:13 by rmk") (* ; "Edited 25-Nov-2023 23:21 by rmk") (* ; "Edited 24-Aug-2023 15:05 by rmk") (* ; "Edited 20-Feb-2022 12:42 by larry") (* ; "Edited 30-May-91 20:25 by jds") (* ;; "Read one CHARLOOKS from FILE. This gets and then sets the file pointer, based on the stored length. But that won't work if the file is not random access. Maybe that's not necessary?") (* ;; "TEXTOBJ only for printing in the local promptwindow, if necessary.") (PROG* ((LOOKS (create CHARLOOKS)) (FILEPOS (GETFILEPTR FILE)) (LOOKSLEN (\WIN FILE)) FONT NAME FACE SIZE SUPER PROPS STYLESTR) (SETQ NAME (\ARBIN FILE)) (* ; "The font name") (SETQ SIZE (\WIN FILE)) (* ; "Size of the type, in points") (SETQ SUPER (\SMALLPIN FILE)) (* ;  "Superscripting distance, could be negative") (FSETCLOOKS LOOKS CLSTYLE (OR (\ARBIN FILE) 0)) (FSETCLOOKS LOOKS CLUSERINFO (\ARBIN FILE)) (SETQ PROPS (\WIN FILE)) (with CHARLOOKS LOOKS [SETQ CLSELBEFORE (NOT (ZEROP (LOGAND 8192 PROPS] [SETQ CLUNBREAKABLE (NOT (ZEROP (LOGAND 4096 PROPS] [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS] [SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS] [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS] [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS] [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS] [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] [SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS] [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] (SETQ CLSIZE SIZE) (SETQ CLOFFSET SUPER)) (SETQ FACE (PACK* (CL:IF (FGETCLOOKS LOOKS CLBOLD) 'B 'M) (CL:IF (FGETCLOOKS LOOKS CLITAL) 'I 'R) 'R)) (if (LISTP NAME) then (* ;  "This was a font class. Restore it.") (SETQ FONT (FONTCLASS (pop NAME) NAME)) elseif (OR (NOT NAME) (ZEROP SIZE)) then (* ;; "This was a test in the original, seems bogus") elseif (SETQ FONT (FONTCREATE NAME SIZE FACE NIL NIL T)) elseif [AND (EQ SIZE 13) (SETQ FONT (FONTCREATE NAME 10 FACE NIL NIL T)) (SELECTQ (STREAMPROP FILE 'COERCEFONT) (YES T) (NO NIL) (SELECTQ [U-CASE (MKATOM (CL:IF TEXTOBJ (TEDIT.GETINPUT TEXTOBJ "Change font size 13 to 10 ? ") (ASKUSER NIL NIL "Change font size 13 to 10 ? "))] ((Y YES) (STREAMPROP FILE 'COERCEFONT 'YES) T) (PROGN (STREAMPROP FILE 'COERCEFONT 'NO) NIL] then (* ;; "A hack to deal with files that have CR-LF corruption") (SETQ SIZE 10) (FSETCLOOKS LOOKS CLSIZE 10) else (SETQ FONT (FONTCREATE NAME SIZE FACE))) (FSETCLOOKS LOOKS CLNAME (if (type? FONTCLASS FONT) then (* ;;  "Put the display family in the CLNAME spot. Better than NIL.") (CL:WHEN [SETQ NAME (FONTCOPY FONT '(DEVICE DISPLAY NOERROR T] (FONTPROP NAME 'FAMILY)) else NAME)) (FSETCLOOKS LOOKS CLFONT FONT) (SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN)) (RETURN LOOKS]) ) (MOVD 'CR-LF-FONTFIX '\TEDIT.GET.SINGLE.CHARLOOKS) [XCL:REINSTALL-ADVICE 'ELT :BEFORE '((:LAST (CL:WHEN (AND (EQ N 13) (ILESSP (ARRAYSIZE A) 13)) (SETQ N 10] (READVISE ELT) (DECLARE%: DONTCOPY (FILEMAP (NIL (912 2760 (CRLFSWAP 922 . 1990) (CHANGEPLEN 1992 . 2758)) (2761 9403 (CR-LF-FONTFIX 2771 . 9401))))) STOP